From 9624e08dd80d9f83f6c82104fe5dcbb8f01f6dc9 Mon Sep 17 00:00:00 2001
From: Tim Daly <daly@axiom-developer.org>
Date: Sat, 15 Aug 2015 15:28:36 -0400
Subject: [PATCH] books/bookvol10.* extract code for COQ proof system

Goal: Proving Axiom Correct

Collect all of the functions in the categories, domains, and packages
into obj/sys/proofs/coq.v
---
 books/bookvol10.2.pamphlet     |    2 +
 books/bookvol10.3.pamphlet     |78754 ++++++++++++++++++++++++++++++----------
 books/bookvol10.4.pamphlet     |59172 ++++++++++++++++++++++++++++--
 books/bookvolbib.pamphlet      |   15 +
 changelog                      |    5 +
 patch                          |    7 +-
 src/axiom-website/patches.html |    2 +
 7 files changed, 116794 insertions(+), 21163 deletions(-)

diff --git a/books/bookvol10.2.pamphlet b/books/bookvol10.2.pamphlet
index a8f2a63..9dc0c81 100644
--- a/books/bookvol10.2.pamphlet
+++ b/books/bookvol10.2.pamphlet
@@ -5192,6 +5192,8 @@ Aggregate: Category == Type with
 
 *)
 
+\end{chunk}
+
 \begin{chunk}{AGG.dotabb}
 "AGG" [color=lightblue,href="bookvol10.2.pdf#nameddest=AGG"];
 "AGG" -> "TYPE"
diff --git a/books/bookvol10.3.pamphlet b/books/bookvol10.3.pamphlet
index 661d0b4..0de9b22 100644
--- a/books/bookvol10.3.pamphlet
+++ b/books/bookvol10.3.pamphlet
@@ -19659,7 +19659,8 @@ AttributeButtons(): E == I where
 
     setAttributeButtonStep(n:F):F ==
       positive?(n)$F and (n<1$F) => attributeStep:F := n
-      error("setAttributeButtonStep","New value must be in (0..1)")$ErrorFunctions
+      error("setAttributeButtonStep",_
+            "New value must be in (0..1)")$ErrorFunctions
 
     resetAttributeButtons():Void ==
       attributeButtons := buttons()
@@ -19670,7 +19671,8 @@ AttributeButtons(): E == I where
       f case Float => 
         n>=0$F and n<=1$F => 
           setelt(attributeButtons,routineName attributeName,n)$Rep
-        error("setAttributeButtonStep","New value must be in [0..1]")$ErrorFunctions
+        error("setAttributeButtonStep",_
+              "New value must be in [0..1]")$ErrorFunctions
       error("setButtonValue","attribute name " attributeName 
              " not found for routine " routineName)$ErrorFunctions
 
@@ -19741,6 +19743,114 @@ AttributeButtons(): E == I where
 \begin{chunk}{COQ ATTRBUT}
 (* domain ATTRBUT *)
 (*
+
+    Rep := StringTable(F)
+    import Rep
+
+    buttons:() -> $
+    buttons():$ == 
+      eList := empty()$List(Record(key:ST,entry:F))
+      l1:List String := ["stability","stiffness","accuracy","expense"]
+      l2:List String := ["functionEvaluations"]
+      ro1 := selectODEIVPRoutines(r := routines()$RoutinesTable)$RoutinesTable
+      ro2 := selectIntegrationRoutines(r)$RoutinesTable
+      k1:List String := [string(i)$Symbol for i in keys(ro1)$RoutinesTable]
+      k2:List String := [string(i)$Symbol for i in keys(ro2)$RoutinesTable]
+      for i in k1 repeat
+        for j in l1 repeat
+          e:Record(key:ST,entry:F) := [i j,0.5]
+          eList := cons(e,eList)$List(Record(key:ST,entry:F))
+      for i in k2 repeat
+        for j in l2 repeat
+          e:Record(key:ST,entry:F) := [i j,0.5]
+          eList := cons(e,eList)$List(Record(key:ST,entry:F))
+      construct(eList)$Rep
+
+    attributeButtons:$ := buttons()
+
+    attributeStep:F := 0.5
+
+    setAttributeButtonStep(n:F):F ==
+      positive?(n)$F and (n<1$F) => attributeStep:F := n
+      error("setAttributeButtonStep",_
+            "New value must be in (0..1)")$ErrorFunctions
+
+    resetAttributeButtons():Void ==
+      attributeButtons := buttons()
+      void()$Void
+
+    setButtonValue(routineName:ST,attributeName:ST,n:F):F ==
+      f := search(routineName attributeName,attributeButtons)$Rep
+      f case Float => 
+        n>=0$F and n<=1$F => 
+          setelt(attributeButtons,routineName attributeName,n)$Rep
+        error("setAttributeButtonStep",_
+              "New value must be in [0..1]")$ErrorFunctions
+      error("setButtonValue","attribute name " attributeName 
+             " not found for routine " routineName)$ErrorFunctions
+
+    setButtonValue(attributeName:ST,n:F):F ==
+      ro1 := selectODEIVPRoutines(r := routines()$RoutinesTable)$RoutinesTable
+      ro2 := selectIntegrationRoutines(r)$RoutinesTable
+      l1:List String := ["stability","stiffness","accuracy","expense"]
+      l2:List String := ["functionEvaluations"]
+      if attributeName="functionEvaluations" then
+        for i in keys(ro2)$RoutinesTable repeat
+          setButtonValue(string(i)$Symbol,attributeName,n)
+      else
+        for i in keys(ro1)$RoutinesTable repeat
+          setButtonValue(string(i)$Symbol,attributeName,n)
+      n
+
+    increase(routineName:ST,attributeName:ST):F ==
+      f := search(routineName attributeName,attributeButtons)$Rep
+      f case Float => 
+        newValue:F := (1$F-attributeStep)*f+attributeStep
+        setButtonValue(routineName,attributeName,newValue)
+      error("increase","attribute name " attributeName 
+             " not found for routine " routineName)$ErrorFunctions
+
+    increase(attributeName:ST):F ==
+      ro1 := selectODEIVPRoutines(r := routines()$RoutinesTable)$RoutinesTable
+      ro2 := selectIntegrationRoutines(r)$RoutinesTable
+      l1:List String := ["stability","stiffness","accuracy","expense"]
+      l2:List String := ["functionEvaluations"]
+      if attributeName="functionEvaluations" then
+        for i in keys(ro2)$RoutinesTable repeat
+          increase(string(i)$Symbol,attributeName)
+      else
+        for i in keys(ro1)$RoutinesTable repeat
+          increase(string(i)$Symbol,attributeName)
+      getButtonValue(string(i)$Symbol,attributeName)
+
+    decrease(routineName:ST,attributeName:ST):F ==
+      f := search(routineName attributeName,attributeButtons)$Rep
+      f case Float => 
+        newValue:F := (1$F-attributeStep)*f
+        setButtonValue(routineName,attributeName,newValue)
+      error("increase","attribute name " attributeName 
+             " not found for routine " routineName)$ErrorFunctions
+
+    decrease(attributeName:ST):F ==
+      ro1 := selectODEIVPRoutines(r := routines()$RoutinesTable)$RoutinesTable
+      ro2 := selectIntegrationRoutines(r)$RoutinesTable
+      l1:List String := ["stability","stiffness","accuracy","expense"]
+      l2:List String := ["functionEvaluations"]
+      if attributeName="functionEvaluations" then
+        for i in keys(ro2)$RoutinesTable repeat
+          decrease(string(i)$Symbol,attributeName)
+      else
+        for i in keys(ro1)$RoutinesTable repeat
+          decrease(string(i)$Symbol,attributeName)
+      getButtonValue(string(i)$Symbol,attributeName)
+
+
+    getButtonValue(routineName:ST,attributeName:ST):F == 
+      f := search(routineName attributeName,attributeButtons)$Rep
+      f case Float => f
+      error("getButtonValue","attribute name " attributeName 
+              " not found for routine " routineName)$ErrorFunctions
+
 *)
 
 \end{chunk}
@@ -19852,6 +19962,7 @@ Automorphism(R:Ring): Join(Group, Eltable(R, R)) with
       morphism: ((R, Integer) -> R) -> %
         ++ morphism(f) returns the morphism given by \spad{f^n(x) = f(x,n)}.
    == add
+
       err:   R -> R
       ident: (R, Integer) -> R
       iter:  (R -> R, NonNegativeInteger, R) -> R
@@ -19861,16 +19972,27 @@ Automorphism(R:Ring): Join(Group, Eltable(R, R)) with
       Rep := ((R, Integer) -> R)
  
       1                               == ident
+
       err r                           == error "Morphism is not invertible"
+
       ident(r, n)                     == r
+
       f = g                           == EQ(f, g)$Lisp
+
       elt(f, r)                       == apply(f, r, 1)
+
       inv f  == (r1:R, i2:Integer):R +-> apply(f, r1, - i2)
+
       f ** n == (r1:R, i2:Integer):R +-> apply(f, r1, n * i2)
+
       coerce(f:%):OutputForm          == message("R -> R")
+
       morphism(f:(R, Integer) -> R):% == f
+
       morphism(f:R -> R):%            == morphism(f, err)
+
       morphism(f, g) == (r1:R, i2:Integer):R +-> iterat(f, g, i2, r1)
+
       apply(f, r, n) == (g := f pretend ((R, Integer) -> R); g(r, n))
  
       iterat(f, g, n, r) ==
@@ -19893,6 +20015,54 @@ Automorphism(R:Ring): Join(Group, Eltable(R, R)) with
 \begin{chunk}{COQ AUTOMOR}
 (* domain AUTOMOR *)
 (*
+
+ 
+      Rep := ((R, Integer) -> R)
+ 
+      1 == ident
+
+      err:   R -> R
+      err r == error "Morphism is not invertible"
+
+      ident: (R, Integer) -> R
+      ident(r, n) == r
+
+      f = g == EQ(f, g)$Lisp
+
+      elt(f, r) == apply(f, r, 1)
+
+      inv f  == (r1:R, i2:Integer):R +-> apply(f, r1, - i2)
+
+      f ** n == (r1:R, i2:Integer):R +-> apply(f, r1, n * i2)
+
+      coerce(f:%):OutputForm == message("R -> R")
+
+      morphism(f:(R, Integer) -> R):% == f
+
+      morphism(f:R -> R):% == morphism(f, err)
+
+      morphism(f, g) == (r1:R, i2:Integer):R +-> iterat(f, g, i2, r1)
+
+      apply: (%, R, Integer) -> R
+      apply(f, r, n) == (g := f pretend ((R, Integer) -> R); g(r, n))
+ 
+      iterat: (R -> R, R -> R, Integer, R) -> R
+      iterat(f, g, n, r) ==
+          n < 0 => iter(g, (-n)::NonNegativeInteger, r)
+          iter(f, n::NonNegativeInteger, r)
+ 
+      iter:  (R -> R, NonNegativeInteger, R) -> R
+      iter(f, n, r) ==
+          for i in 1..n repeat r := f r
+          r
+ 
+      f * g ==
+        f = g => f**2
+        (r1:R, i2:Integer):R +-> 
+          iterat((u1:R):R +-> f g u1, 
+                 (v1:R):R +-> (inv g)(inv f) v1, 
+                 i2, r1)
+
 *)
 
 \end{chunk}
@@ -20295,14 +20465,13 @@ BalancedBinaryTree(S: SetCategory): Exports == Implementation where
       ++X t2
 
   Implementation == BinaryTree(S) add
+
     Rep := BinaryTree(S)
+
     leaf? x ==
       empty? x => false
       empty? left x and empty? right x
---    balancedBinaryTree(x: S, u: List S) ==
---      n := #u
---      n = 0 => empty()
---      setleaves_!(balancedBinaryTree(n, x), u)
+
     setleaves_!(t, u) ==
       n := #u
       n = 0 =>
@@ -20319,16 +20488,19 @@ BalancedBinaryTree(S: SetCategory): Exports == Implementation where
       setleaves_!(left t, reverse_! acc)
       setleaves_!(right t, u)
       t
+
     balancedBinaryTree(n: NonNegativeInteger, val: S) ==
       n = 0 => empty()
       n = 1 => node(empty(),val,empty())
       m := n quo 2
       node(balancedBinaryTree(m, val), val,
            balancedBinaryTree((n - m) pretend NonNegativeInteger, val))
+
     mapUp_!(x,fn) ==
       empty? x => error "mapUp! called on a null tree"
       leaf? x  => x.value
       x.value := fn(mapUp_!(x.left,fn),mapUp_!(x.right,fn))
+
     mapUp_!(x,y,fn) ==
       empty? x  => error "mapUp! is called on a null tree"
       leaf? x  =>
@@ -20339,12 +20511,14 @@ BalancedBinaryTree(S: SetCategory): Exports == Implementation where
       mapUp_!(x.right,y.right,fn)
       x.value := fn(x.left.value,x.right.value,y.left.value,y.right.value)
       x
+
     mapDown_!(x: %, p: S, fn: (S,S) -> S ) ==
       empty? x => x
       x.value := fn(p, x.value)
       mapDown_!(x.left, x.value, fn)
       mapDown_!(x.right, x.value, fn)
       x
+
     mapDown_!(x: %, p: S, fn: (S,S,S) -> List S) ==
       empty? x => x
       x.value := p
@@ -20359,6 +20533,70 @@ BalancedBinaryTree(S: SetCategory): Exports == Implementation where
 \begin{chunk}{COQ BBTREE}
 (* domain BBTREE *)
 (*
+ BinaryTree(S) add
+
+    Rep := BinaryTree(S)
+
+    leaf? x ==
+      empty? x => false
+      empty? left x and empty? right x
+
+    setleaves_!(t, u) ==
+      n := #u
+      n = 0 =>
+        empty? t => t
+        error "the tree and list must have the same number of elements"
+      n = 1 =>
+        setvalue_!(t,first u)
+        t
+      m := n quo 2
+      acc := empty()$(List S)
+      for i in 1..m repeat
+        acc := [first u,:acc]
+        u := rest u
+      setleaves_!(left t, reverse_! acc)
+      setleaves_!(right t, u)
+      t
+
+    balancedBinaryTree(n: NonNegativeInteger, val: S) ==
+      n = 0 => empty()
+      n = 1 => node(empty(),val,empty())
+      m := n quo 2
+      node(balancedBinaryTree(m, val), val,
+           balancedBinaryTree((n - m) pretend NonNegativeInteger, val))
+
+    mapUp_!(x,fn) ==
+      empty? x => error "mapUp! called on a null tree"
+      leaf? x  => x.value
+      x.value := fn(mapUp_!(x.left,fn),mapUp_!(x.right,fn))
+
+    mapUp_!(x,y,fn) ==
+      empty? x  => error "mapUp! is called on a null tree"
+      leaf? x  =>
+        leaf? y => x
+        error "balanced binary trees are incompatible"
+      leaf? y  =>  error "balanced binary trees are incompatible"
+      mapUp_!(x.left,y.left,fn)
+      mapUp_!(x.right,y.right,fn)
+      x.value := fn(x.left.value,x.right.value,y.left.value,y.right.value)
+      x
+
+    mapDown_!(x: %, p: S, fn: (S,S) -> S ) ==
+      empty? x => x
+      x.value := fn(p, x.value)
+      mapDown_!(x.left, x.value, fn)
+      mapDown_!(x.right, x.value, fn)
+      x
+
+    mapDown_!(x: %, p: S, fn: (S,S,S) -> List S) ==
+      empty? x => x
+      x.value := p
+      leaf? x => x
+      u := fn(x.left.value, x.right.value, p)
+      mapDown_!(x.left, u.1, fn)
+      mapDown_!(x.right, u.2, fn)
+      x
+
 *)
 
 \end{chunk}
@@ -20930,6 +21168,47 @@ BasicFunctions():  E == I where
 \begin{chunk}{COQ BFUNCT}
 (* domain BFUNCT *)
 (*
+
+    Rep := Table(Symbol,RS)
+    import Rep, SDF
+
+    f(x:DF):DF ==
+      positive?(x) => -x
+      -x+1
+
+    bf():$ ==
+      import RS
+      dpi := pi()$DF
+      ndpi:SDF := map(x1+->x1*dpi,(z := generate(f,0))) -- [n pi for n in Z]
+      n1dpi:SDF := map(x1+->-(2*(x1)-1)*dpi/2,z) -- [(n+1) pi /2]
+      n2dpi:SDF := map(x1+->2*x1*dpi,z) -- [2 n pi for n in Z]
+      n3dpi:SDF := map(x1+->-(4*(x1)-1)*dpi/4,z)
+      n4dpi:SDF := map(x1+->-(4*(x1)-1)*dpi/2,z)
+      sinEntry:RS := [ndpi, n4dpi, empty()$SDF]
+      cosEntry:RS := [n1dpi, n2dpi, esdf := empty()$SDF]
+      tanEntry:RS := [ndpi, n3dpi, n1dpi]
+      asinEntry:RS := [construct([0$DF])$SDF,
+                        construct([float(8414709848078965,-16,10)$DF]), esdf]
+      acosEntry:RS := [construct([1$DF])$SDF,
+                        construct([float(54030230586813977,-17,10)$DF]), esdf]
+      atanEntry:RS := [construct([0$DF])$SDF,
+                        construct([float(15574077246549023,-16,10)$DF]), esdf]
+      secEntry:RS := [esdf, n2dpi, n1dpi]
+      cscEntry:RS := [esdf, n4dpi, ndpi]
+      cotEntry:RS := [n1dpi, n3dpi, ndpi]
+      logEntry:RS := [construct([1$DF])$SDF,esdf, construct([0$DF])$SDF]
+      entryList:List(Record(key:Symbol,entry:RS)) :=
+         [[sin@Symbol, sinEntry], [cos@Symbol, cosEntry],
+           [tan@Symbol, tanEntry], [sec@Symbol, secEntry],
+            [csc@Symbol, cscEntry], [cot@Symbol, cotEntry],
+             [asin@Symbol, asinEntry], [acos@Symbol, acosEntry], 
+              [atan@Symbol, atanEntry], [log@Symbol, logEntry]]
+      construct(entryList)$Rep
+
+    bfKeys():List Symbol == keys(bf())$Rep
+
+    bfEntry(k:Symbol):RS == qelt(bf(),k)$Rep
+
 *)
 
 \end{chunk}
@@ -21432,27 +21711,47 @@ BasicOperator(): Exports == Implementation where
     oper: (Symbol, SingleInteger, P) -> $
 
     is?(op, s)           == name(op) = s
+
     name op              == op.opname
+
     properties op        == op.props
+
     setProperties(op, l) == (op.props := l; op)
+
     operator s           == oper(s, -1::SingleInteger, table())
+
     operator(s, n)       == oper(s, n::Integer::SingleInteger, table())
+
     property(op, name)   == search(name, op.props)
+
     assert(op, s)        == setProperty(op, s, NIL$Lisp)
+
     has?(op, name)       == key?(name, op.props)
+
     oper(se, n, prop)    == [se, n, prop]
+
     weight(op, n)        == setProperty(op, WEIGHT, n pretend None)
+
     nullary? op          == zero?(op.narg)
---    unary? op            == one?(op.narg)
+
     unary? op            == ((op.narg) = 1)
+
     nary? op             == negative?(op.narg)
+
     equality(op, func)   == setProperty(op, EQUAL?, func pretend None)
+
     comparison(op, func) == setProperty(op, LESS?, func pretend None)
+
     display(op:$, f:O -> O)        == display(op,(x1:List(O)):O +-> f first x1)
+
     deleteProperty_!(op, name)     == (remove_!(name, properties op); op)
+
     setProperty(op, name, valu)    == (op.props.name := valu; op)
+
     coerce(op:$):OutputForm        == name(op)::OutputForm
+
     input(op:$, f:List SEX -> SEX) == setProperty(op, SEXPR, f pretend None)
+
     display(op:$, f:List O -> O)   == setProperty(op, DISPLAY, f pretend None)
 
     display op ==
@@ -21512,6 +21811,107 @@ BasicOperator(): Exports == Implementation where
 \begin{chunk}{COQ BOP}
 (* domain BOP *)
 (*
+    -- if narg < 0 then the operator has variable arity.
+    Rep := Record(opname:Symbol, narg:SingleInteger, props:P)
+
+    oper: (Symbol, SingleInteger, P) -> $
+
+    is?(op, s) == name(op) = s
+
+    name op == op.opname
+
+    properties op == op.props
+
+    setProperties(op, l) == (op.props := l; op)
+
+    operator s == oper(s, -1::SingleInteger, table())
+
+    operator(s, n) == oper(s, n::Integer::SingleInteger, table())
+
+    property(op, name) == search(name, op.props)
+
+    assert(op, s) == setProperty(op, s, NIL$Lisp)
+
+    has?(op, name) == key?(name, op.props)
+
+    oper(se, n, prop) == [se, n, prop]
+
+    weight(op, n) == setProperty(op, WEIGHT, n pretend None)
+
+    nullary? op == zero?(op.narg)
+
+    unary? op == ((op.narg) = 1)
+
+    nary? op == negative?(op.narg)
+
+    equality(op, func) == setProperty(op, EQUAL?, func pretend None)
+
+    comparison(op, func) == setProperty(op, LESS?, func pretend None)
+
+    display(op:$, f:O -> O) == display(op,(x1:List(O)):O +-> f first x1)
+
+    deleteProperty_!(op, name) == (remove_!(name, properties op); op)
+
+    setProperty(op, name, valu) == (op.props.name := valu; op)
+
+    coerce(op:$):OutputForm == name(op)::OutputForm
+
+    input(op:$, f:List SEX -> SEX) == setProperty(op, SEXPR, f pretend None)
+
+    display(op:$, f:List O -> O)  == setProperty(op, DISPLAY, f pretend None)
+
+    display op ==
+      (u := property(op, DISPLAY)) case "failed" => "failed"
+      (u::None) pretend (List O -> O)
+
+    input op ==
+      (u := property(op, SEXPR)) case "failed" => "failed"
+      (u::None) pretend (List SEX -> SEX)
+
+    arity op ==
+      negative?(n := op.narg) => "failed"
+      convert(n)@Integer :: NonNegativeInteger
+
+    copy op ==
+      oper(name op, op.narg,
+          table([[r.key, r.entry] for r in entries(properties op)@L]$L))
+
+-- property EQUAL? contains a function f: (BOP, BOP) -> Boolean
+-- such that f(o1, o2) is true iff o1 = o2
+    op1 = op2 ==
+      (EQ$Lisp)(op1, op2) => true
+      name(op1) ^= name(op2) => false
+      op1.narg ^= op2.narg => false
+      brace(keys properties op1)^=$Set(String) _
+                     brace(keys properties op2) => false
+      (func := property(op1, EQUAL?)) case None =>
+                   ((func::None) pretend (($, $) -> Boolean)) (op1, op2)
+      true
+
+-- property WEIGHT allows one to change the ordering around
+-- by default, every operator has weigth 1
+    weight op ==
+      (w := property(op, WEIGHT)) case "failed" => 1
+      (w::None) pretend NonNegativeInteger
+
+-- property LESS? contains a function f: (BOP, BOP) -> Boolean
+-- such that f(o1, o2) is true iff o1 < o2
+    op1 < op2 ==
+      (w1 := weight op1) ^= (w2 := weight op2) => w1 < w2
+      op1.narg ^= op2.narg => op1.narg < op2.narg
+      name(op1) ^= name(op2) => name(op1) < name(op2)
+      n1 := #(k1 := brace(keys(properties op1))$Set(String))
+      n2 := #(k2 := brace(keys(properties op2))$Set(String))
+      n1 ^= n2 => n1 < n2
+      not zero?(n1 := #(d1 := difference(k1, k2))) =>
+        n1 ^= (n2 := #(d2 := difference(k2, k1))) => n1 < n2
+        inspect(d1) < inspect(d2)
+      (func := property(op1, LESS?)) case None =>
+                   ((func::None) pretend (($, $) -> Boolean)) (op1, op2)
+      (func := property(op1, EQUAL?)) case None =>
+              not(((func::None) pretend (($, $) -> Boolean)) (op1, op2))
+      false
+
 *)
 
 \end{chunk}
@@ -22030,7 +22430,9 @@ BasicStochasticDifferential(): category == implementation where
    tableIto(X)
 
   copyBSD() == [ds::% for ds in members(setBSD)]
+
   copyIto() == tableIto
+
   getSmgl(ds:%):Union(Symbol,"failed") == tableBSD(ds)
 
 \end{chunk}
@@ -22038,6 +22440,41 @@ BasicStochasticDifferential(): category == implementation where
 \begin{chunk}{COQ BSD}
 (* domain BSD *)
 (*
+
+  Rep := Symbol
+
+  setBSD := empty()$Set(Symbol)
+  tableIto:Table(Symbol,%) := table()
+  tableBSD:Table(%,Symbol) := table()
+
+  convertIfCan(ds:Symbol):Union(%,"failed") ==
+   not(member?(ds,setBSD)) => "failed"
+   ds::%
+
+  convert(ds:Symbol):% ==
+   (du:=convertIfCan(ds)) 
+    case "failed" =>
+     print(hconcat(ds::Symbol::OF,
+       message(" is not a stochastic differential")$OF))
+     error "above causes failure in convert$BSD"
+   du
+
+  introduce!(X,dX) == 
+   member?(dX,setBSD) => "failed"
+   insert!(dX,setBSD)
+   tableBSD(dX::%) := X
+   tableIto(X) := dX::%
+
+  d(X) ==
+   search(X,tableIto) case "failed" => 0::INT
+   tableIto(X)
+
+  copyBSD() == [ds::% for ds in members(setBSD)]
+
+  copyIto() == tableIto
+
+  getSmgl(ds:%):Union(Symbol,"failed") == tableBSD(ds)
+
 *)
 
 \end{chunk}
@@ -22440,7 +22877,7 @@ BinaryExpansion(): Exports == Implementation where
     coerce: % -> Fraction Integer
       ++ coerce(b) converts a binary expansion to a rational number.
     coerce: % -> RadixExpansion(2)
-      ++ coerce(b) converts a binary expansion to a radix expansion with base 2.
+      ++ coerce(b) converts a binary expansion to a radix expansion with base 2
     fractionPart: % -> Fraction Integer
       ++ fractionPart(b) returns the fractional part of a binary expansion.
     binary: Fraction Integer -> %
@@ -22457,6 +22894,12 @@ BinaryExpansion(): Exports == Implementation where
 \begin{chunk}{COQ BINARY}
 (* domain BINARY *)
 (*
+ RadixExpansion(2) add
+
+    binary r == r :: %
+
+    coerce(x:%): RadixExpansion(2) == x pretend RadixExpansion(2)
+
 *)
 
 \end{chunk}
@@ -22575,22 +23018,13 @@ BinaryFile: Cat == Def where
                       fileState:  FileState,   _
                       fileIOmode: String)
  
---      direc : Symbol := INTERN("DIRECTION","KEYWORD")$Lisp
---      input : Symbol := INTERN("INPUT","KEYWORD")$Lisp
---      output : Symbol := INTERN("OUTPUT","KEYWORD")$Lisp
---      eltype : Symbol := INTERN("ELEMENT-TYPE","KEYWORD")$Lisp
---      bytesize : SExpression := LIST(QUOTE(UNSIGNED$Lisp)$Lisp,8)$Lisp
-   
-
         defstream(fn: FileName, mode: String): FileState ==
             mode = "input"  =>
               not readable? fn => error ["File is not readable", fn]
               BINARY__OPEN__INPUT(fn::String)$Lisp
---            OPEN(fn::String, direc, input, eltype, bytesize)$Lisp
             mode = "output" =>
               not writable? fn => error ["File is not writable", fn]
               BINARY__OPEN__OUTPUT(fn::String)$Lisp
---            OPEN(fn::String, direc, output, eltype, bytesize)$Lisp
             error ["IO mode must be input or output", mode]
 
         open(fname, mode) ==
@@ -22616,26 +23050,24 @@ BinaryFile: Cat == Def where
             f.fileIOmode ^= "input"  => error "File not in read state"
             BINARY__SELECT__INPUT(f.fileState)$Lisp 
             BINARY__READBYTE()$Lisp
---          READ_-BYTE(f.fileState)$Lisp
+
         readIfCan_! f ==
             f.fileIOmode ^= "input"  => error "File not in read state"
             BINARY__SELECT__INPUT(f.fileState)$Lisp 
             n:SingleInteger:=BINARY__READBYTE()$Lisp
             n = -1 => "failed"
             n::Union(SingleInteger,"failed")
---          READ_-BYTE(f.fileState,NIL$Lisp,
---                   "failed"::Union(SingleInteger,"failed"))$Lisp
+
         write_!(f, x) ==
             f.fileIOmode ^= "output" => error "File not in write state"
             x < 0 or x>255 => error "integer cannot be represented as a byte"
             BINARY__PRINBYTE(x)$Lisp
---          WRITE_-BYTE(x, f.fileState)$Lisp
             x
 
---      # f == FILE_-LENGTH(f.fileState)$Lisp
         position f == 
            f.fileIOmode ^= "input"  => error "file must be in read state"
            FILE_-POSITION(f.fileState)$Lisp
+
         position_!(f,i) == 
            f.fileIOmode ^= "input"  => error "file must be in read state"
            (FILE_-POSITION(f.fileState,i)$Lisp ; i) 
@@ -22645,6 +23077,68 @@ BinaryFile: Cat == Def where
 \begin{chunk}{COQ BINFILE}
 (* domain BINFILE *)
 (*
+    File(SingleInteger) add
+
+        FileState ==> SExpression
+ 
+        Rep := Record(fileName:   FileName,    _
+                      fileState:  FileState,   _
+                      fileIOmode: String)
+ 
+        defstream(fn: FileName, mode: String): FileState ==
+            mode = "input"  =>
+              not readable? fn => error ["File is not readable", fn]
+              BINARY__OPEN__INPUT(fn::String)$Lisp
+            mode = "output" =>
+              not writable? fn => error ["File is not writable", fn]
+              BINARY__OPEN__OUTPUT(fn::String)$Lisp
+            error ["IO mode must be input or output", mode]
+
+        open(fname, mode) ==
+            fstream := defstream(fname, mode)
+            [fname, fstream, mode]
+
+        reopen_!(f, mode) ==
+            fname := f.fileName
+            f.fileState := defstream(fname, mode)
+            f.fileIOmode:= mode
+            f
+
+        close_! f ==
+            f.fileIOmode = "output" => 
+                 BINARY__CLOSE__OUTPUT()$Lisp
+                 f
+            f.fileIOmode = "input" => 
+                  BINARY__CLOSE__INPUT()$Lisp
+                  f
+            error "file must be in read or write state"
+
+        read! f ==
+            f.fileIOmode ^= "input"  => error "File not in read state"
+            BINARY__SELECT__INPUT(f.fileState)$Lisp 
+            BINARY__READBYTE()$Lisp
+
+        readIfCan_! f ==
+            f.fileIOmode ^= "input"  => error "File not in read state"
+            BINARY__SELECT__INPUT(f.fileState)$Lisp 
+            n:SingleInteger:=BINARY__READBYTE()$Lisp
+            n = -1 => "failed"
+            n::Union(SingleInteger,"failed")
+
+        write_!(f, x) ==
+            f.fileIOmode ^= "output" => error "File not in write state"
+            x < 0 or x>255 => error "integer cannot be represented as a byte"
+            BINARY__PRINBYTE(x)$Lisp
+            x
+
+        position f == 
+           f.fileIOmode ^= "input"  => error "file must be in read state"
+           FILE_-POSITION(f.fileState)$Lisp
+
+        position_!(f,i) == 
+           f.fileIOmode ^= "input"  => error "file must be in read state"
+           (FILE_-POSITION(f.fileState,i)$Lisp ; i) 
+
 *)
 
 \end{chunk}
@@ -23024,12 +23518,15 @@ BinarySearchTree(S: OrderedSet): Exports == Implementation where
      ++X split(3,t1)
 
   Implementation == BinaryTree(S) add
+
     Rep := BinaryTree(S)
+
     binarySearchTree(u:List S) ==
       null u => empty()
       tree := binaryTree(first u)
       for x in rest u repeat insert_!(x,tree)
       tree
+
     insert_!(x,t) ==
       empty? t => binaryTree(x)
       x >= value t =>
@@ -23037,6 +23534,7 @@ BinarySearchTree(S: OrderedSet): Exports == Implementation where
         t
       setleft_!(t,insert_!(x,left t))
       t
+
     split(x,t) ==
       empty? t => [empty(),empty()]
       x > value t =>
@@ -23044,6 +23542,7 @@ BinarySearchTree(S: OrderedSet): Exports == Implementation where
         [node(left t, value t, a.less), a.greater]
       a := split(x,left t)
       [a.less, node(a.greater, value t, right t)]
+
     insertRoot_!(x,t) ==
       a := split(x,t)
       node(a.less, x, a.greater)
@@ -23053,6 +23552,36 @@ BinarySearchTree(S: OrderedSet): Exports == Implementation where
 \begin{chunk}{COQ BSTREE}
 (* domain BSTREE *)
 (*
+ BinaryTree(S) add
+
+    Rep := BinaryTree(S)
+
+    binarySearchTree(u:List S) ==
+      null u => empty()
+      tree := binaryTree(first u)
+      for x in rest u repeat insert_!(x,tree)
+      tree
+
+    insert_!(x,t) ==
+      empty? t => binaryTree(x)
+      x >= value t =>
+        setright_!(t,insert_!(x,right t))
+        t
+      setleft_!(t,insert_!(x,left t))
+      t
+
+    split(x,t) ==
+      empty? t => [empty(),empty()]
+      x > value t =>
+        a := split(x,right t)
+        [node(left t, value t, a.less), a.greater]
+      a := split(x,left t)
+      [a.less, node(a.greater, value t, right t)]
+
+    insertRoot_!(x,t) ==
+      a := split(x,t)
+      node(a.less, x, a.greater)
+
 *)
 
 \end{chunk}
@@ -23229,12 +23758,15 @@ BinaryTournament(S: OrderedSet): Exports == Implementation where
       ++X t1
 
   Implementation == BinaryTree(S) add
+
     Rep := BinaryTree(S)
+
     binaryTournament(u:List S) ==
       null u => empty()
       tree := binaryTree(first u)
       for x in rest u repeat insert_!(x,tree)
       tree
+
     insert_!(x,t) ==
       empty? t => binaryTree(x)
       x > value t =>
@@ -23249,6 +23781,25 @@ BinaryTournament(S: OrderedSet): Exports == Implementation where
 \begin{chunk}{COQ BTOURN}
 (* domain BTOURN *)
 (*
+ BinaryTree(S) add
+
+    Rep := BinaryTree(S)
+
+    binaryTournament(u:List S) ==
+      null u => empty()
+      tree := binaryTree(first u)
+      for x in rest u repeat insert_!(x,tree)
+      tree
+
+    insert_!(x,t) ==
+      empty? t => binaryTree(x)
+      x > value t =>
+        setleft_!(t,copy t)
+        setvalue_!(t,x)
+        setright_!(t,empty())
+      setright_!(t,insert_!(x,right t))
+      t
+
 *)
 
 \end{chunk}
@@ -23422,32 +23973,47 @@ BinaryTree(S: SetCategory): Exports == Implementation where
     ++X binaryTree(t1,[7,8,9],t2)
     
   Implementation == add
+
      Rep := List Tree S
+
      t1 = t2 == (t1::Rep) =$Rep (t2::Rep)
+
      empty()== [] pretend %
+
      empty()== [] pretend %
+
      node(l,v,r) == cons(tree(v,l:Rep),r:Rep)
+
      binaryTree(l,v,r) == node(l,v,r)
+
      binaryTree(v:S) == node(empty(),v,empty())
+
      empty? t == empty?(t)$Rep
+
      leaf? t  == empty? t or empty? left t and empty? right t
+
      right t ==
        empty? t => error "binaryTree:no right"
        rest t
+
      left t ==
        empty? t => error "binaryTree:no left"
        children first t
+
      value t==
        empty? t => error "binaryTree:no value"
        value first t
+
      setvalue_! (t,nd)==
        empty? t => error "binaryTree:no value to set"
        setvalue_!(first(t:Rep),nd)
        nd
+
      setleft_!(t1,t2) ==
        empty? t1 => error "binaryTree:no left to set"
        setchildren_!(first(t1:Rep),t2:Rep)
        t1
+
      setright_!(t1,t2) ==
        empty? t1 => error "binaryTree:no right to set"
        setrest_!(t1:List Tree S,t2)
@@ -23457,6 +24023,51 @@ BinaryTree(S: SetCategory): Exports == Implementation where
 \begin{chunk}{COQ BTREE}
 (* domain BTREE *)
 (*
+
+     Rep := List Tree S
+
+     t1 = t2 == (t1::Rep) =$Rep (t2::Rep)
+
+     empty()== [] pretend %
+
+     empty()== [] pretend %
+
+     node(l,v,r) == cons(tree(v,l:Rep),r:Rep)
+
+     binaryTree(l,v,r) == node(l,v,r)
+
+     binaryTree(v:S) == node(empty(),v,empty())
+
+     empty? t == empty?(t)$Rep
+
+     leaf? t  == empty? t or empty? left t and empty? right t
+
+     right t ==
+       empty? t => error "binaryTree:no right"
+       rest t
+
+     left t ==
+       empty? t => error "binaryTree:no left"
+       children first t
+
+     value t==
+       empty? t => error "binaryTree:no value"
+       value first t
+
+     setvalue_! (t,nd)==
+       empty? t => error "binaryTree:no value to set"
+       setvalue_!(first(t:Rep),nd)
+       nd
+
+     setleft_!(t1,t2) ==
+       empty? t1 => error "binaryTree:no left to set"
+       setchildren_!(first(t1:Rep),t2:Rep)
+       t1
+
+     setright_!(t1,t2) ==
+       empty? t1 => error "binaryTree:no right to set"
+       setrest_!(t1:List Tree S,t2)
+
 *)
 
 \end{chunk}
@@ -23674,6 +24285,7 @@ Bits(): Exports == Implementation where
     bits: (NonNegativeInteger, Boolean) -> %
       ++ bits(n,b) creates bits with n values of b
   Implementation == IndexedBits(1) add
+
     bits(n,b)    == new(n,b)
 
 \end{chunk}
@@ -23681,6 +24293,10 @@ Bits(): Exports == Implementation where
 \begin{chunk}{COQ BITS}
 (* domain BITS *)
 (*
+ IndexedBits(1) add
+
+    bits(n,b)    == new(n,b)
+
 *)
 
 \end{chunk}
@@ -23773,6 +24389,7 @@ BlowUpWithHamburgerNoether: Exports == Implementation where
   Exports ==> BlowUpMethodCategory with HamburgerNoether
     
   Implementation ==  add
+
     Rep := MetRec
 
     infClsPt_? a == a.infClsPt
@@ -23792,11 +24409,33 @@ BlowUpWithHamburgerNoether: Exports == Implementation where
     type a == a.type
 
     coerce(c:%):OutputForm== ( (c :: Rep ) :: MetRec) :: OutputForm  
+
 \end{chunk}
 
 \begin{chunk}{COQ BLHN}
 (* domain BLHN *)
 (*
+
+    Rep := MetRec
+
+    infClsPt_? a == a.infClsPt
+
+    createHN( a,b,c,d,e,f,g)==[a,b,c,d,e,f,g]$Rep
+
+    excepCoord a == a.ex
+
+    chartCoord a == a.ch
+
+    transCoord a == a.tr
+
+    ramifMult a == a.ramif
+
+    quotValuation a == a.quotVal
+
+    type a == a.type
+
+    coerce(c:%):OutputForm== ( (c :: Rep ) :: MetRec) :: OutputForm  
+
 *)
 
 \end{chunk}
@@ -23890,6 +24529,7 @@ BlowUpWithQuadTrans: Exports == Implementation where
     QuadraticTransform
     
   Implementation ==  add
+
     Rep := MetRec
 
     coerce(la:List(Integer)):% == [la.1, la.2,la.3,  1 ]$Rep
@@ -23915,6 +24555,27 @@ BlowUpWithQuadTrans: Exports == Implementation where
 \begin{chunk}{COQ BLQT}
 (* domain BLQT *)
 (*
+
+    Rep := MetRec
+
+    coerce(la:List(Integer)):% == [la.1, la.2,la.3,  1 ]$Rep
+
+    ramifMult a == One$Integer
+
+    excepCoord a == a.ex
+
+    chartCoord a == a.ch
+
+    transCoord a == a.tr
+
+    ramifMult a == a.ramif
+
+    quotValuation a == One$Integer
+
+    coerce(c:%):OutputForm== 
+      oo: outRec := [ excepCoord(c) , chartCoord(c) ]$outRec
+      oo :: OutputForm 
+
 *)
 
 \end{chunk}
@@ -24056,32 +24717,51 @@ Boolean(): Join(OrderedSet, Finite, Logic, ConvertibleTo InputForm) with
       ++ test(b) returns b and is provided for compatibility with the 
       ++ new compiler.
   == add
+
     nt: % -> %
 
     test a        == a pretend Boolean
 
     nt b          == (b pretend Boolean => false; true)
+
     true          == EQ(2,2)$Lisp   --well, 1 is rather special
+
     false         == NIL$Lisp
+
     sample()      == true
+
     not b         == (test b => false; true)
+
     _^ b          == (test b => false; true)
+
     _~ b          == (test b => false; true)
+
     _and(a, b)    == (test a => b; false)
+
     _/_\(a, b)    == (test a => b; false)
+
     _or(a, b)     == (test a => true; b)
+
     _\_/(a, b)     == (test a => true; b)
+
     xor(a, b)     == (test a => nt b; b)
+
     nor(a, b)     == (test a => false; nt b)
+
     nand(a, b)    == (test a => nt b; true)
+
     a = b         == BooleanEquality(a, b)$Lisp
+
     implies(a, b) == (test a => b; true)
+
     a < b         == (test b => not(test a);false)
 
     size()        == 2
+
     index i       ==
       even?(i::Integer) => false
       true
+
     lookup a      ==
       a pretend Boolean => 1
       2
@@ -24102,6 +24782,67 @@ Boolean(): Join(OrderedSet, Finite, Logic, ConvertibleTo InputForm) with
 \begin{chunk}{COQ BOOLEAN}
 (* domain BOOLEAN *)
 (*
+
+    nt: % -> %
+
+    test a        == a pretend Boolean
+
+    nt b          == (b pretend Boolean => false; true)
+
+    true          == EQ(2,2)$Lisp   --well, 1 is rather special
+
+    false         == NIL$Lisp
+
+    sample()      == true
+
+    not b         == (test b => false; true)
+
+    _^ b          == (test b => false; true)
+
+    _~ b          == (test b => false; true)
+
+    _and(a, b)    == (test a => b; false)
+
+    _/_\(a, b)    == (test a => b; false)
+
+    _or(a, b)     == (test a => true; b)
+
+    _\_/(a, b)     == (test a => true; b)
+
+    xor(a, b)     == (test a => nt b; b)
+
+    nor(a, b)     == (test a => false; nt b)
+
+    nand(a, b)    == (test a => nt b; true)
+
+    a = b         == BooleanEquality(a, b)$Lisp
+
+    implies(a, b) == (test a => b; true)
+
+    a < b         == (test b => not(test a);false)
+
+    size()        == 2
+
+    index i       ==
+      even?(i::Integer) => false
+      true
+
+    lookup a      ==
+      a pretend Boolean => 1
+      2
+
+    random()      ==
+      even?(random()$Integer) => false
+      true
+
+    convert(x:%):InputForm ==
+      x pretend Boolean => convert("true"::Symbol)
+      convert("false"::Symbol)
+
+    coerce(x:%):OutputForm ==
+      x pretend Boolean => message "true"
+      message "false"
+
 *)
 
 \end{chunk}
@@ -24620,8 +25361,11 @@ CardinalNumber: Join(OrderedSet, AbelianMonoid, Monoid,
  
         -- Creation
         0           == [FINord, 0]
+
         1           == [FINord, 1]
+
         coerce(n:NonNegativeInteger):% == [FINord, n]
+
         Aleph n     == [n, DUMMYval]
  
         -- Output
@@ -24636,27 +25380,33 @@ CardinalNumber: Join(OrderedSet, AbelianMonoid, Monoid,
             x.order ^= y.order => false
             finite? x          => x.ival = y.ival
             true     -- equal transfinites
+
         x < y ==
             x.order < y.order => true
             x.order > y.order => false
             finite? x         => x.ival < y.ival
             false    -- equal transfinites
+
         x:% + y:% ==
             finite? x and finite? y => [FINord, x.ival+y.ival]
             max(x, y)
+
         x - y ==
             x < y     => "failed"
             finite? x => [FINord, x.ival-y.ival]
             x > y     => x
             "failed" -- equal transfinites
+
         x:% * y:% ==
             finite? x and finite? y => [FINord, x.ival*y.ival]
             x = 0 or y = 0          => 0
             max(x, y)
+
         n:NonNegativeInteger * x:% ==
             finite? x => [FINord, n*x.ival]
             n = 0     => 0
             x
+
         x**y ==
             y = 0 =>
                 x ^= 0 => 1
@@ -24670,6 +25420,7 @@ CardinalNumber: Join(OrderedSet, AbelianMonoid, Monoid,
             error "Transfinite exponentiation only implemented under GCH"
  
         finite? x    == x.order = FINord
+
         countable? x == x.order < 1
  
         retract(x:%):NonNegativeInteger ==
@@ -24682,6 +25433,7 @@ CardinalNumber: Join(OrderedSet, AbelianMonoid, Monoid,
  
         -- State manipulation
         generalizedContinuumHypothesisAssumed?() == GCHypothesis()
+
         generalizedContinuumHypothesisAssumed b == (GCHypothesis() := b)
 
 \end{chunk}
@@ -24689,6 +25441,91 @@ CardinalNumber: Join(OrderedSet, AbelianMonoid, Monoid,
 \begin{chunk}{COQ CARD}
 (* domain CARD *)
 (*
+        NNI ==> NonNegativeInteger
+        FINord   ==> -1
+        DUMMYval ==> -1
+ 
+        Rep := Record(order: Integer, ival: Integer)
+ 
+        GCHypothesis: Reference(Boolean) := ref false
+ 
+        -- Creation
+        0           == [FINord, 0]
+
+        1           == [FINord, 1]
+
+        coerce(n:NonNegativeInteger):% == [FINord, n]
+
+        Aleph n     == [n, DUMMYval]
+ 
+        -- Output
+        ALEPHexpr := "Aleph"::OutputForm
+ 
+        coerce(x: %): OutputForm ==
+            x.order = FINord => (x.ival)::OutputForm
+            prefix(ALEPHexpr, [(x.order)::OutputForm])
+ 
+        -- Manipulation
+        x = y ==
+            x.order ^= y.order => false
+            finite? x          => x.ival = y.ival
+            true     -- equal transfinites
+
+        x < y ==
+            x.order < y.order => true
+            x.order > y.order => false
+            finite? x         => x.ival < y.ival
+            false    -- equal transfinites
+
+        x:% + y:% ==
+            finite? x and finite? y => [FINord, x.ival+y.ival]
+            max(x, y)
+
+        x - y ==
+            x < y     => "failed"
+            finite? x => [FINord, x.ival-y.ival]
+            x > y     => x
+            "failed" -- equal transfinites
+
+        x:% * y:% ==
+            finite? x and finite? y => [FINord, x.ival*y.ival]
+            x = 0 or y = 0          => 0
+            max(x, y)
+
+        n:NonNegativeInteger * x:% ==
+            finite? x => [FINord, n*x.ival]
+            n = 0     => 0
+            x
+
+        x**y ==
+            y = 0 =>
+                x ^= 0 => 1
+                error "0**0 not defined for cardinal numbers."
+            finite? y =>
+                not finite? x => x
+                [FINord,x.ival**(y.ival):NNI]
+            x = 0 => 0
+            x = 1 => 1
+            GCHypothesis() => [max(x.order-1, y.order) + 1, DUMMYval]
+            error "Transfinite exponentiation only implemented under GCH"
+ 
+        finite? x    == x.order = FINord
+
+        countable? x == x.order < 1
+ 
+        retract(x:%):NonNegativeInteger ==
+          finite? x => (x.ival)::NNI
+          error "Not finite"
+ 
+        retractIfCan(x:%):Union(NonNegativeInteger, "failed") ==
+          finite? x => (x.ival)::NNI
+          "failed"
+ 
+        -- State manipulation
+        generalizedContinuumHypothesisAssumed?() == GCHypothesis()
+
+        generalizedContinuumHypothesisAssumed b == (GCHypothesis() := b)
+
 *)
 
 \end{chunk}
@@ -25963,7 +26800,6 @@ CartesianTensor(minix, dim, R): Exports == Implementation where
         PERM  ==> Vector Integer  -- 1-based entries from 1..n
         INDEX ==> Vector Integer  -- 1-based entries from minix..minix+dim-1
 
-
         get   ==> elt$Rep
         set_! ==> setelt$Rep
 
@@ -25982,6 +26818,7 @@ CartesianTensor(minix, dim, R): Exports == Implementation where
         dim4: NNI := dim**4
 
         sample()==kroneckerDelta()$%
+
         int2index(n: Integer, indv: INDEX): INDEX ==
             n < 0 => error "Index error (too small)"
             rnk := #indv
@@ -26059,7 +26896,6 @@ CartesianTensor(minix, dim, R): Exports == Implementation where
             odd? totTrans => -1
             1
 
-
         ---- Exported functions
         ravel x ==
             [get(x,i) for i in 0..#x-1]
@@ -26095,15 +26931,19 @@ CartesianTensor(minix, dim, R): Exports == Implementation where
         elt(x) ==
             #x ^= 1    => error "Index error (the rank is not 0)"
             get(x,0)
+
         elt(x, i: I) ==
             #x ^= dim  => error "Index error (the rank is not 1)"
             get(x,(i-minix))
+
         elt(x, i: I, j: I) ==
             #x ^= dim2 => error "Index error (the rank is not 2)"
             get(x,(dim*(i-minix) + (j-minix)))
+
         elt(x, i: I, j: I, k: I) ==
             #x ^= dim3 => error "Index error (the rank is not 3)"
             get(x,(dim2*(i-minix) + dim*(j-minix) + (k-minix)))
+
         elt(x, i: I, j: I, k: I, l: I) ==
             #x ^= dim4 => error "Index error (the rank is not 4)"
             get(x,(dim3*(i-minix)+dim2*(j-minix)+dim*(k-minix)+(l-minix)))
@@ -26122,6 +26962,7 @@ CartesianTensor(minix, dim, R): Exports == Implementation where
             z := new(dim, 0)
             for r in lr for i in 0..dim-1 repeat set_!(z, i, r)
             z
+
         coerce(lx: List %): % ==
             #lx ^= dim => error "Incorrect number of slices"
             rx := rank first lx
@@ -26136,6 +26977,7 @@ CartesianTensor(minix, dim, R): Exports == Implementation where
         retractIfCan(x:%):Union(R,"failed") ==
             zero? rank(x) => x()
             "failed"
+
         Outf ==> OutputForm
 
         mkOutf(x:%, i0:I, rnk:NNI): Outf ==
@@ -26153,6 +26995,7 @@ CartesianTensor(minix, dim, R): Exports == Implementation where
             mkOutf(x, 0, rank x)
 
         0 == 0$R::Rep
+
         1 == 1$R::Rep
 
         --coerce(n: I): % == new(1, n::R)
@@ -26177,43 +27020,51 @@ CartesianTensor(minix, dim, R): Exports == Implementation where
             for i in 0..#x-1 repeat
                if get(x,i) ^= get(y,i) then return false
             true
+
         x + y ==
             #x ^= #y => error "Rank mismatch"
             -- z := [xi + yi for xi in x for yi in y]
             z := new(#x, 0)
             for i in 0..#x-1 repeat set_!(z, i, get(x,i) + get(y,i))
             z
+
         x - y ==
             #x ^= #y => error "Rank mismatch"
             -- [xi - yi for xi in x for yi in y]
             z := new(#x, 0)
             for i in 0..#x-1 repeat set_!(z, i, get(x,i) - get(y,i))
             z
+
         - x ==
             -- [-xi for xi in x]
             z := new(#x, 0)
             for i in 0..#x-1 repeat set_!(z, i, -get(x,i))
             z
+
         n * x ==
             -- [n * xi for xi in x]
             z := new(#x, 0)
             for i in 0..#x-1 repeat set_!(z, i, n * get(x,i))
             z
+
         x * n ==
             -- [n * xi for xi in x]
             z := new(#x, 0)
             for i in 0..#x-1 repeat set_!(z, i, n* get(x,i))  -- Commutative!!
             z
+
         r * x ==
             -- [r * xi for xi in x]
             z := new(#x, 0)
             for i in 0..#x-1 repeat set_!(z, i, r * get(x,i))
             z
+
         x * r ==
             -- [xi*r for xi in x]
             z := new(#x, 0)
             for i in 0..#x-1 repeat set_!(z, i, r* get(x,i))  -- Commutative!!
             z
+
         product(x, y) ==
             nx := #x; ny := #y
             z  := new(nx * ny, 0)
@@ -26284,6 +27135,7 @@ CartesianTensor(minix, dim, R): Exports == Implementation where
 
         transpose x ==
             transpose(x, 1, rank x)
+
         transpose(x, i, j) ==
             rx := rank x
             i < 1 or i > rx or j < 1 or j > rx or i = j =>
@@ -26324,6 +27176,381 @@ CartesianTensor(minix, dim, R): Exports == Implementation where
 \begin{chunk}{COQ CARTEN}
 (* domain CARTEN *)
 (*
+
+        PERM  ==> Vector Integer  -- 1-based entries from 1..n
+        INDEX ==> Vector Integer  -- 1-based entries from minix..minix+dim-1
+
+        get   ==> elt$Rep
+        set_! ==> setelt$Rep
+
+        -- Use row-major order:
+        --   x[h,i,j] <-> x[(h-minix)*dim**2+(i-minix)*dim+(j-minix)]
+
+        Rep := IndexedVector(R,0)
+
+        n:     Integer
+        r,s:   R
+        x,y,z: %
+
+        ---- Local stuff
+        dim2: NNI := dim**2
+        dim3: NNI := dim**3
+        dim4: NNI := dim**4
+
+        sample()==kroneckerDelta()$%
+
+        int2index(n: Integer, indv: INDEX): INDEX ==
+            n < 0 => error "Index error (too small)"
+            rnk := #indv
+            for i in 1..rnk repeat
+                qr := divide(n, dim)
+                n  := qr.quotient
+                indv.((rnk-i+1) pretend NNI) := qr.remainder + minix
+            n ^= 0 => error "Index error (too big)"
+            indv
+
+        index2int(indv: INDEX): Integer ==
+            n: I := 0
+            for i in 1..#indv repeat
+                ix := indv.i - minix
+                ix<0 or ix>dim-1 => error "Index error (out of range)"
+                n := dim*n + ix
+            n
+
+        lengthRankOrElse(v: Integer): NNI ==
+            v = 1    => 0
+            v = dim  => 1
+            v = dim2 => 2
+            v = dim3 => 3
+            v = dim4 => 4
+            rx := 0
+            while v ^= 0 repeat
+                qr := divide(v, dim)
+                v  := qr.quotient
+                if v ^= 0 then
+                    qr.remainder ^= 0 => error "Rank is not a whole number"
+                    rx := rx + 1
+            rx
+
+        -- l must be a list of the numbers 1..#l
+        mkPerm(n: NNI, l: List Integer): PERM ==
+            #l ^= n =>
+                error "The list is not a permutation."
+            p:    PERM           := new(n, 0)
+            seen: Vector Boolean := new(n, false)
+            for i in 1..n for e in l repeat
+                e < 1 or e > n => error "The list is not a permutation."
+                p.i    := e
+                seen.e := true
+            for e in 1..n repeat
+                not seen.e => error "The list is not a permutation."
+            p
+
+        -- permute s according to p into result t.
+        permute_!(t: INDEX, s: INDEX, p: PERM): INDEX ==
+            for i in 1..#p repeat t.i := s.(p.i)
+            t
+
+        -- permsign!(v) = 1, 0, or -1  according as
+        -- v is an even, is not, or is an odd permutation of minix..minix+#v-1.
+        permsign_!(v: INDEX): Integer ==
+            -- sum minix..minix+#v-1.
+            maxix := minix+#v-1
+            psum  := (((maxix+1)*maxix - minix*(minix-1)) exquo 2)::Integer
+            -- +/v ^= psum => 0
+            n := 0
+            for i in 1..#v repeat n := n + v.i
+            n ^= psum => 0
+            -- Bubble sort!  This is pretty grotesque.
+            totTrans: Integer := 0
+            nTrans:   Integer := 1
+            while nTrans ^= 0 repeat
+                nTrans := 0
+                for i in 1..#v-1 for j in 2..#v repeat
+                    if v.i > v.j then
+                        nTrans := nTrans + 1
+                        e := v.i; v.i := v.j; v.j := e
+                totTrans := totTrans + nTrans
+            for i in 1..dim repeat
+                if v.i ^= minix+i-1 then return 0
+            odd? totTrans => -1
+            1
+
+        ---- Exported functions
+        ravel x ==
+            [get(x,i) for i in 0..#x-1]
+
+        unravel l ==
+            -- lengthRankOrElse #l gives sytnax error
+            nz: NNI := # l
+            lengthRankOrElse nz
+            z := new(nz, 0)
+            for i in 0..nz-1 for r in l repeat set_!(z, i, r)
+            z
+
+        kroneckerDelta() ==
+            z := new(dim2, 0)
+            for i in 1..dim for zi in 0.. by (dim+1) repeat set_!(z, zi, 1)
+            z
+        leviCivitaSymbol() ==
+            nz := dim**dim
+            z  := new(nz, 0)
+            indv: INDEX := new(dim, 0)
+            for i in 0..nz-1 repeat
+                set_!(z, i, permsign_!(int2index(i, indv))::R)
+            z
+
+        -- from GradedModule
+        degree x ==
+            rank x
+
+        rank x ==
+            n := #x
+            lengthRankOrElse n
+
+        elt(x) ==
+            #x ^= 1    => error "Index error (the rank is not 0)"
+            get(x,0)
+
+        elt(x, i: I) ==
+            #x ^= dim  => error "Index error (the rank is not 1)"
+            get(x,(i-minix))
+
+        elt(x, i: I, j: I) ==
+            #x ^= dim2 => error "Index error (the rank is not 2)"
+            get(x,(dim*(i-minix) + (j-minix)))
+
+        elt(x, i: I, j: I, k: I) ==
+            #x ^= dim3 => error "Index error (the rank is not 3)"
+            get(x,(dim2*(i-minix) + dim*(j-minix) + (k-minix)))
+
+        elt(x, i: I, j: I, k: I, l: I) ==
+            #x ^= dim4 => error "Index error (the rank is not 4)"
+            get(x,(dim3*(i-minix)+dim2*(j-minix)+dim*(k-minix)+(l-minix)))
+
+        elt(x, i: List I) ==
+            #i ^= rank x => error "Index error (wrong rank)"
+            n: I := 0
+            for ii in i repeat
+                ix := ii - minix
+                ix<0 or ix>dim-1 => error "Index error (out of range)"
+                n := dim*n + ix
+            get(x,n)
+
+        coerce(lr: List R): % ==
+            #lr ^= dim => error "Incorrect number of components"
+            z := new(dim, 0)
+            for r in lr for i in 0..dim-1 repeat set_!(z, i, r)
+            z
+
+        coerce(lx: List %): % ==
+            #lx ^= dim => error "Incorrect number of slices"
+            rx := rank first lx
+            for x in lx repeat
+                rank x ^= rx => error "Inhomogeneous slice ranks"
+            nx := # first lx
+            z  := new(dim * nx, 0)
+            for x in lx for offz in 0.. by nx repeat
+                for i in 0..nx-1 repeat set_!(z, offz + i, get(x,i))
+            z
+
+        retractIfCan(x:%):Union(R,"failed") ==
+            zero? rank(x) => x()
+            "failed"
+
+        Outf ==> OutputForm
+
+        mkOutf(x:%, i0:I, rnk:NNI): Outf ==
+            odd? rnk =>
+                rnk1  := (rnk-1) pretend NNI
+                nskip := dim**rnk1
+                [mkOutf(x, i0+nskip*i, rnk1) for i in 0..dim-1]::Outf
+            rnk = 0 =>
+                get(x,i0)::Outf
+            rnk1  := (rnk-2) pretend NNI
+            nskip := dim**rnk1
+            matrix [[mkOutf(x, i0+nskip*(dim*i + j), rnk1)
+                             for j in 0..dim-1] for i in 0..dim-1]
+        coerce(x): Outf ==
+            mkOutf(x, 0, rank x)
+
+        0 == 0$R::Rep
+
+        1 == 1$R::Rep
+
+        --coerce(n: I): % == new(1, n::R)
+        coerce(r: R): % == new(1,r)
+
+        coerce(v: DP(dim,R)): % ==
+            z := new(dim, 0)
+            for i in 0..dim-1 for j in minIndex v .. maxIndex v repeat
+                set_!(z, i, v.j)
+            z
+        coerce(m: SM(dim,R)): % ==
+            z := new(dim**2, 0)
+            offz := 0
+            for i in 0..dim-1 repeat
+                for j in 0..dim-1 repeat
+                    set_!(z, offz + j, m(i+1,j+1))
+                offz := offz + dim
+            z
+
+        x = y ==
+            #x ^= #y => false
+            for i in 0..#x-1 repeat
+               if get(x,i) ^= get(y,i) then return false
+            true
+
+        x + y ==
+            #x ^= #y => error "Rank mismatch"
+            -- z := [xi + yi for xi in x for yi in y]
+            z := new(#x, 0)
+            for i in 0..#x-1 repeat set_!(z, i, get(x,i) + get(y,i))
+            z
+
+        x - y ==
+            #x ^= #y => error "Rank mismatch"
+            -- [xi - yi for xi in x for yi in y]
+            z := new(#x, 0)
+            for i in 0..#x-1 repeat set_!(z, i, get(x,i) - get(y,i))
+            z
+
+        - x ==
+            -- [-xi for xi in x]
+            z := new(#x, 0)
+            for i in 0..#x-1 repeat set_!(z, i, -get(x,i))
+            z
+
+        n * x ==
+            -- [n * xi for xi in x]
+            z := new(#x, 0)
+            for i in 0..#x-1 repeat set_!(z, i, n * get(x,i))
+            z
+
+        x * n ==
+            -- [n * xi for xi in x]
+            z := new(#x, 0)
+            for i in 0..#x-1 repeat set_!(z, i, n* get(x,i))  -- Commutative!!
+            z
+
+        r * x ==
+            -- [r * xi for xi in x]
+            z := new(#x, 0)
+            for i in 0..#x-1 repeat set_!(z, i, r * get(x,i))
+            z
+
+        x * r ==
+            -- [xi*r for xi in x]
+            z := new(#x, 0)
+            for i in 0..#x-1 repeat set_!(z, i, r* get(x,i))  -- Commutative!!
+            z
+
+        product(x, y) ==
+            nx := #x; ny := #y
+            z  := new(nx * ny, 0)
+            for i in 0..nx-1 for ioff in 0.. by ny repeat
+                for j in 0..ny-1 repeat
+                    set_!(z, ioff + j, get(x,i) * get(y,j))
+            z
+        x * y ==
+            rx := rank x
+            ry := rank y
+            rx = 0 => get(x,0) * y
+            ry = 0 => x * get(y,0)
+            contract(x, rx, y, 1)
+
+        contract(x, i, j) ==
+            rx := rank x
+            i < 1 or i > rx or j < 1 or j > rx or i = j =>
+                error "Improper index for contraction"
+            if i > j then (i,j) := (j,i)
+
+            rl:= (rx- j) pretend NNI; nl:= dim**rl; zol:= 1;     xol:= zol
+            rm:= (j-i-1) pretend NNI; nm:= dim**rm; zom:= nl;    xom:= zom*dim
+            rh:= (i - 1) pretend NNI; nh:= dim**rh; zoh:= nl*nm
+            xoh:= zoh*dim**2
+            xok := nl*(1 + nm*dim)
+            z   := new(nl*nm*nh, 0)
+            for h in 1..nh _
+            for xh in 0.. by xoh for zh in 0.. by zoh repeat
+                for m in 1..nm _
+                for xm in xh.. by xom for zm in zh.. by zom repeat
+                    for l in 1..nl _
+                    for xl in xm.. by xol for zl in zm.. by zol repeat
+                        set_!(z, zl, 0)
+                        for k in 1..dim for xk in xl.. by xok repeat
+                            set_!(z, zl, get(z,zl) + get(x,xk))
+            z
+
+        contract(x, i, y, j) ==
+            rx := rank x
+            ry := rank y
+
+            i < 1 or i > rx or j < 1 or j > ry =>
+                error "Improper index for contraction"
+
+            rly:= (ry-j) pretend NNI;  nly:= dim**rly;  oly:= 1;    zoly:= 1
+            rhy:= (j -1) pretend NNI; nhy:= dim**rhy 
+            ohy:= nly*dim; zohy:= zoly*nly
+            rlx:= (rx-i) pretend NNI;  nlx:= dim**rlx  
+            olx:= 1;        zolx:= zohy*nhy
+            rhx:= (i -1) pretend NNI;  nhx:= dim**rhx
+            ohx:= nlx*dim;  zohx:= zolx*nlx
+
+            z := new(nlx*nhx*nly*nhy, 0)
+
+            for dxh in 1..nhx _
+            for xh in 0.. by ohx for zhx in 0.. by zohx repeat
+                for dxl in 1..nlx _
+                for xl in xh.. by olx for zlx in zhx.. by zolx repeat
+                    for dyh in 1..nhy _
+                    for yh in 0.. by ohy for zhy in zlx.. by zohy repeat
+                        for dyl in 1..nly _
+                        for yl in yh.. by oly for zly in zhy.. by zoly repeat
+                            set_!(z, zly, 0)
+                            for k in 1..dim _
+                            for xk in xl.. by nlx for yk in yl.. by nly repeat
+                                set_!(z, zly, get(z,zly)+get(x,xk)*get(y,yk))
+            z
+
+        transpose x ==
+            transpose(x, 1, rank x)
+
+        transpose(x, i, j) ==
+            rx := rank x
+            i < 1 or i > rx or j < 1 or j > rx or i = j =>
+                error "Improper indicies for transposition"
+            if i > j then (i,j) := (j,i)
+
+            rl:= (rx- j) pretend NNI; nl:= dim**rl; zol:= 1;      zoi := zol*nl
+            rm:= (j-i-1) pretend NNI; nm:= dim**rm; zom:= nl*dim; zoj := zom*nm
+            rh:= (i - 1) pretend NNI; nh:= dim**rh; zoh:= nl*nm*dim**2
+            z   := new(#x, 0)
+            for h in 1..nh for zh in 0..  by zoh repeat _
+            for m in 1..nm for zm in zh.. by zom repeat _
+            for l in 1..nl for zl in zm.. by zol repeat _
+                for p in 1..dim _
+                for zp in zl.. by zoi for xp in zl.. by zoj repeat
+                    for q in 1..dim _
+                    for zq in zp.. by zoj for xq in xp.. by zoi repeat
+                        set_!(z, zq, get(x,xq))
+            z
+
+        reindex(x, l) ==
+            nx := #x
+            z: % := new(nx, 0)
+
+            rx := rank x
+            p  := mkPerm(rx, l)
+            xiv: INDEX := new(rx, 0)
+            ziv: INDEX := new(rx, 0)
+
+            -- Use permutation
+            for i in 0..#x-1 repeat
+                pi := index2int(permute_!(ziv, int2index(i,xiv),p))
+                set_!(z, pi, get(x,i))
+            z
+
 *)
 
 \end{chunk}
@@ -26476,6 +27703,50 @@ Cell(TheField) : PUB == PRIV where
 \begin{chunk}{COQ CELL}
 (* domain CELL *)
 (*
+
+    Rep := List(SCELL)
+
+    coerce(c:%):O == 
+      paren [sc::O for sc in c]
+
+    projection(cell) ==
+      null cell => error "projection: should not appear"
+      r := rest(cell)
+      null r => "failed"
+      r
+
+    makeCell(l:List(SCELL)) == l
+
+    makeCell(scell,toAdd) == cons(scell,toAdd)
+
+    mainVariableOf(cell) == 
+      null(cell) => 
+        error "Should not appear"
+      variableOf(first(cell))
+
+    variablesOf(cell) ==
+      null(cell) => []
+      cons(mainVariableOf(cell),variablesOf(rest(cell)::%))
+
+    dimension(cell) ==
+      null(cell) => 0
+      hasDimension?(first(cell)) => 1+dimension(rest(cell))
+      dimension(rest(cell))
+
+    hasDimension?(cell,var) ==
+      null(cell) => 
+        error "Should not appear"
+      sc : SCELL := first(cell)
+      v := variableOf(sc)
+      v = var => hasDimension?(sc)
+      v < var => false
+      v > var => true
+      error "Caca Prout"
+
+    samplePoint(cell) ==
+      null(cell) => []
+      cons(samplePoint(first(cell)),samplePoint(rest(cell)))
+
 *)
 
 \end{chunk}
@@ -26857,22 +28128,39 @@ Character: OrderedFinite() with
   minChar := minIndex OutChars
 
   a = b                  == a =$Rep b
+
   a < b                  == a <$Rep b
+
   size()                 == 256
+
   index n                == char((n - 1)::Integer)
+
   lookup c               == (1 + ord c)::PositiveInteger
+
   char(n:Integer)        == n::%
+
   ord c                  == convert(c)$Rep
+
   random()               == char(random()$Integer rem size())
+
   space                  == QENUM("   ", 0$Lisp)$Lisp
+
   quote                  == QENUM("_" ", 0$Lisp)$Lisp
+
   escape                 == QENUM("__ ", 0$Lisp)$Lisp
+
   coerce(c:%):OutputForm == OutChars(minChar + ord c)
+
   digit? c               == member?(c pretend Character, digit())
+
   hexDigit? c            == member?(c pretend Character, hexDigit())
+
   upperCase? c           == member?(c pretend Character, upperCase())
+
   lowerCase? c           == member?(c pretend Character, lowerCase())
+
   alphabetic? c          == member?(c pretend Character, alphabetic())
+
   alphanumeric? c        == member?(c pretend Character, alphanumeric())
 
   latex c ==
@@ -26894,6 +28182,67 @@ Character: OrderedFinite() with
 \begin{chunk}{COQ CHAR}
 (* domain CHAR *)
 (*
+
+  Rep := SingleInteger  -- 0..255
+
+  CC ==> CharacterClass()
+  import CC
+
+  OutChars:PrimitiveArray(OutputForm) :=
+   construct [CODE_-CHAR(i)$Lisp for i in 0..255]
+
+  minChar := minIndex OutChars
+
+  a = b                  == a =$Rep b
+
+  a < b                  == a <$Rep b
+
+  size()                 == 256
+
+  index n                == char((n - 1)::Integer)
+
+  lookup c               == (1 + ord c)::PositiveInteger
+
+  char(n:Integer)        == n::%
+
+  ord c                  == convert(c)$Rep
+
+  random()               == char(random()$Integer rem size())
+
+  space                  == QENUM("   ", 0$Lisp)$Lisp
+
+  quote                  == QENUM("_" ", 0$Lisp)$Lisp
+
+  escape                 == QENUM("__ ", 0$Lisp)$Lisp
+
+  coerce(c:%):OutputForm == OutChars(minChar + ord c)
+
+  digit? c               == member?(c pretend Character, digit())
+
+  hexDigit? c            == member?(c pretend Character, hexDigit())
+
+  upperCase? c           == member?(c pretend Character, upperCase())
+
+  lowerCase? c           == member?(c pretend Character, lowerCase())
+
+  alphabetic? c          == member?(c pretend Character, alphabetic())
+
+  alphanumeric? c        == member?(c pretend Character, alphanumeric())
+
+  latex c ==
+    concat("\mbox{`", concat(new(1,c pretend Character)$String, "'}")_
+       $String)$String
+
+  char(s:String) ==
+   (#s) = 1 => s(minIndex s) pretend %
+   error "String is not a single character"
+
+  upperCase c ==
+    QENUM(PNAME(UPCASE(CODE_-CHAR(ord c)$Lisp)$Lisp)$Lisp,0$Lisp)$Lisp
+
+  lowerCase c ==
+    QENUM(PNAME(DOWNCASE(CODE_-CHAR(ord c)$Lisp)$Lisp)$Lisp,0$Lisp)$Lisp
+
 *)
 
 \end{chunk}
@@ -27331,22 +28680,32 @@ CharacterClass: Join(SetCategory, ConvertibleTo String,
         a, b: %
 
         digit()         == charClass "0123456789"
+
         hexDigit()      == charClass "0123456789abcdefABCDEF"
+
         upperCase()     == charClass "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+
         lowerCase()     == charClass "abcdefghijklmnopqrstuvwxyz"
+
         alphabetic()    == union(upperCase(), lowerCase())
+
         alphanumeric()  == union(alphabetic(), digit())
 
         a = b           == a =$Rep b
 
         member?(c, a)   == a(ord c)
+
         union(a,b)      == Or(a, b)
+
         intersect (a,b) == And(a, b)
+
         difference(a,b) == And(a, Not b)
+
         complement a    == Not a
 
         convert(cl):String ==
           construct(convert(cl)@List(Character))
+
         convert(cl:%):List(Character) ==
           [char(i) for i in 0..N-1 | cl.i]
 
@@ -27363,11 +28722,15 @@ CharacterClass: Join(SetCategory, ConvertibleTo String,
         coerce(cl):OutputForm == (convert(cl)@String)::OutputForm
 
         -- Stuff to make a legal SetAggregate view
+
         # a == (n := 0; for i in 0..N-1 | a.i repeat n := n+1; n)
+
         empty():% == charClass []
+
         brace():% == charClass []
 
         insert_!(c, a) == (a(ord c) := true; a)
+
         remove_!(c, a) == (a(ord c) := false; a)
 
         inspect(a) ==
@@ -27386,6 +28749,7 @@ CharacterClass: Join(SetCategory, ConvertibleTo String,
             b
 
         temp: % := new(N, false)$Rep
+
         map_!(f, a) ==
             fill_!(temp, false)
             for i in 0..N-1 | a.i repeat temp(ord f char i) := true
@@ -27399,6 +28763,90 @@ CharacterClass: Join(SetCategory, ConvertibleTo String,
 \begin{chunk}{COQ CCLASS}
 (* domain CCLASS *)
 (*
+        Rep := IndexedBits(0)
+        N   := size()$Character
+
+        a, b: %
+
+        digit()         == charClass "0123456789"
+
+        hexDigit()      == charClass "0123456789abcdefABCDEF"
+
+        upperCase()     == charClass "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+
+        lowerCase()     == charClass "abcdefghijklmnopqrstuvwxyz"
+
+        alphabetic()    == union(upperCase(), lowerCase())
+
+        alphanumeric()  == union(alphabetic(), digit())
+
+        a = b           == a =$Rep b
+
+        member?(c, a)   == a(ord c)
+
+        union(a,b)      == Or(a, b)
+
+        intersect (a,b) == And(a, b)
+
+        difference(a,b) == And(a, Not b)
+
+        complement a    == Not a
+
+        convert(cl):String ==
+          construct(convert(cl)@List(Character))
+
+        convert(cl:%):List(Character) ==
+          [char(i) for i in 0..N-1 | cl.i]
+
+        charClass(s: String) ==
+          cl := new(N, false)
+          for i in minIndex(s)..maxIndex(s) repeat cl(ord s.i) := true
+          cl
+
+        charClass(l: List Character) ==
+          cl := new(N, false)
+          for c in l repeat cl(ord c) := true
+          cl
+
+        coerce(cl):OutputForm == (convert(cl)@String)::OutputForm
+
+        -- Stuff to make a legal SetAggregate view
+
+        # a == (n := 0; for i in 0..N-1 | a.i repeat n := n+1; n)
+
+        empty():% == charClass []
+
+        brace():% == charClass []
+
+        insert_!(c, a) == (a(ord c) := true; a)
+
+        remove_!(c, a) == (a(ord c) := false; a)
+
+        inspect(a) ==
+            for i in 0..N-1 | a.i repeat
+                 return char i
+            error "Cannot take a character from an empty class."
+        extract_!(a) ==
+            for i in 0..N-1 | a.i repeat
+                 a.i := false
+                 return char i
+            error "Cannot take a character from an empty class."
+
+        map(f, a) ==
+            b := new(N, false)
+            for i in 0..N-1 | a.i repeat b(ord f char i) := true
+            b
+
+        temp: % := new(N, false)$Rep
+
+        map_!(f, a) ==
+            fill_!(temp, false)
+            for i in 0..N-1 | a.i repeat temp(ord f char i) := true
+            copyInto_!(a, temp, 0)
+
+        parts a ==
+            [char i for i in 0..N-1 | a.i]
+
 *)
 
 \end{chunk}
@@ -28326,7 +29774,9 @@ CliffordAlgebra(n, K, Q): T == Impl where
           ++ if x is not invertible.
  
     Impl ==> add
+
         Qeelist :=  [Q unitVector(i::PositiveInteger) for i in 1..n]
+
         dim     :=  2**n
  
         Rep     := PrimitiveArray K
@@ -28338,6 +29788,7 @@ CliffordAlgebra(n, K, Q): T == Impl where
         m: Integer
  
         characteristic() == characteristic()$K
+
         dimension()      == dim::CardinalNumber
  
         x = y ==
@@ -28346,14 +29797,21 @@ CliffordAlgebra(n, K, Q): T == Impl where
             true
  
         x + y == (z := New; for i in 0..dim-1 repeat z.i := x.i + y.i; z)
+
         x - y == (z := New; for i in 0..dim-1 repeat z.i := x.i - y.i; z)
+
         - x   == (z := New; for i in 0..dim-1 repeat z.i := - x.i; z)
+
         m * x == (z := New; for i in 0..dim-1 repeat z.i := m*x.i; z)
+
         c * x == (z := New; for i in 0..dim-1 repeat z.i := c*x.i; z)
  
         0            == New
+
         1            == (z := New; z.0 := 1; z)
+
         coerce(m): % == (z := New; z.0 := m::K; z)
+
         coerce(c): % == (z := New; z.0 := c; z)
  
         e b ==
@@ -28423,6 +29881,7 @@ CliffordAlgebra(n, K, Q): T == Impl where
             z := New
             z r.basel := r.coef
             z
+
         coefficient(z, lb) ==
             r := canonMonom(1, lb)
             r.coef = 0 => error "Cannot take coef of 0"
@@ -28483,6 +29942,169 @@ CliffordAlgebra(n, K, Q): T == Impl where
 \begin{chunk}{COQ CLIF}
 (* domain CLIF *)
 (*
+
+        Qeelist :=  [Q unitVector(i::PositiveInteger) for i in 1..n]
+
+        dim     :=  2**n
+ 
+        Rep     := PrimitiveArray K
+ 
+        New     ==> new(dim, 0$K)$Rep
+ 
+        x, y, z: %
+        c: K
+        m: Integer
+ 
+        characteristic() == characteristic()$K
+
+        dimension()      == dim::CardinalNumber
+ 
+        x = y ==
+            for i in 0..dim-1 repeat
+                if x.i ^= y.i then return false
+            true
+ 
+        x + y == (z := New; for i in 0..dim-1 repeat z.i := x.i + y.i; z)
+
+        x - y == (z := New; for i in 0..dim-1 repeat z.i := x.i - y.i; z)
+
+        - x   == (z := New; for i in 0..dim-1 repeat z.i := - x.i; z)
+
+        m * x == (z := New; for i in 0..dim-1 repeat z.i := m*x.i; z)
+
+        c * x == (z := New; for i in 0..dim-1 repeat z.i := c*x.i; z)
+ 
+        0            == New
+
+        1            == (z := New; z.0 := 1; z)
+
+        coerce(m): % == (z := New; z.0 := m::K; z)
+
+        coerce(c): % == (z := New; z.0 := c; z)
+ 
+        e b ==
+            b::NNI > n => error "No such basis element"
+            iz := 2**((b-1)::NNI)
+            z := New; z.iz := 1; z
+ 
+        -- The ei*ej products could instead be precomputed in
+        -- a (2**n)**2 multiplication table.
+        addMonomProd(c1: K, b1: NNI, c2: K, b2: NNI, z: %): % ==
+            c  := c1 * c2
+            bz := b2
+            for i in 0..n-1 | bit?(b1,i) repeat
+                -- Apply rule  ei*ej = -ej*ei for i^=j
+                k := 0
+                for j in i+1..n-1 | bit?(b1, j) repeat k := k+1
+                for j in 0..i-1   | bit?(bz, j) repeat k := k+1
+                if odd? k then c := -c
+                -- Apply rule  ei**2 = Q(ei)
+                if bit?(bz,i) then
+                    c := c * Qeelist.(i+1)
+                    bz:= (bz - 2**i)::NNI
+                else
+                    bz:= bz + 2**i
+            z.bz := z.bz + c
+            z
+ 
+        x * y ==
+            z := New
+            for ix in 0..dim-1 repeat
+                if x.ix ^= 0 then for iy in 0..dim-1 repeat
+                    if y.iy ^= 0 then addMonomProd(x.ix,ix,y.iy,iy,z)
+            z
+ 
+        canonMonom(c: K, lb: List PI): Record(coef: K, basel: NNI) ==
+            -- 0. Check input
+            for b in lb repeat b > n => error "No such basis element"
+ 
+            -- 1. Apply identity ei*ej = -ej*ei, i^=j.
+            -- The Rep assumes n is small so bubble sort is ok.
+            -- Using bubble sort keeps the exchange info obvious.
+            wasordered   := false
+            exchanges := 0
+            while not wasordered repeat
+                wasordered := true
+                for i in 1..#lb-1 repeat
+                    if lb.i > lb.(i+1) then
+                        t := lb.i; lb.i := lb.(i+1); lb.(i+1) := t
+                        exchanges := exchanges + 1
+                        wasordered := false
+            if odd? exchanges then c := -c
+ 
+            -- 2. Prepare the basis element
+            -- Apply identity ei*ei = Q(ei).
+            bz := 0
+            for b in lb repeat
+                bn := (b-1)::NNI
+                if bit?(bz, bn) then
+                    c := c * Qeelist bn
+                    bz:= ( bz - 2**bn )::NNI
+                else
+                    bz:= bz + 2**bn
+            [c, bz::NNI]
+ 
+        monomial(c, lb) ==
+            r := canonMonom(c, lb)
+            z := New
+            z r.basel := r.coef
+            z
+
+        coefficient(z, lb) ==
+            r := canonMonom(1, lb)
+            r.coef = 0 => error "Cannot take coef of 0"
+            z r.basel/r.coef
+ 
+        Ex ==> OutputForm
+ 
+        coerceMonom(c: K, b: NNI): Ex ==
+            b = 0 => c::Ex
+            ml := [sub("e"::Ex, i::Ex) for i in 1..n | bit?(b,i-1)]
+            be := reduce("*", ml)
+            c = 1 => be
+            c::Ex * be
+
+        coerce(x): Ex ==
+            tl := [coerceMonom(x.i,i) for i in 0..dim-1 | x.i^=0]
+            null tl => "0"::Ex
+            reduce("+", tl)
+
+        localPowerSets(j:NNI): List(List(PI)) ==
+          l: List List PI := list []
+          j = 0 => l
+          Sm := localPowerSets((j-1)::NNI)
+          Sn: List List PI := []
+          for x in Sm repeat Sn := cons(cons(j pretend PI, x),Sn)
+          append(Sn, Sm)
+
+        powerSets(j:NNI):List List PI == map(reverse, localPowerSets j)
+
+        Pn:List List PI := powerSets(n)
+
+        recip(x: %): Union(%, "failed") ==
+          one:% := 1
+          -- tmp:c := x*yC - 1$C
+          rhsEqs : List K := []
+          lhsEqs: List List K := []
+          lhsEqi: List K
+          for pi in Pn repeat
+            rhsEqs := cons(coefficient(one, pi), rhsEqs)
+
+            lhsEqi := []
+            for pj in Pn repeat
+                lhsEqi := cons(coefficient(x*monomial(1,pj),pi),lhsEqi)
+            lhsEqs := cons(reverse(lhsEqi),lhsEqs)
+          ans := particularSolution(matrix(lhsEqs),vector(rhsEqs)_
+             )$LinearSystemMatrixPackage(K, Vector K, Vector K, Matrix K)
+          ans case "failed" => "failed"
+          ansP := parts(ans)
+          ansC:% := 0
+          for pj in Pn repeat
+            cj:= first ansP
+            ansP := rest ansP
+            ansC := ansC + cj*monomial(1,pj)
+          ansC
+
 *)
 
 \end{chunk}
@@ -28630,13 +30252,21 @@ Color(): Exports == Implementation where
      [ans,1]
  
     x = y     == (x.hue = y.hue) and (x.weight = y.weight)
+
     red()     == [1,1]
+
     yellow()  == [11::I,1]
+
     green()   == [14::I,1]
+
     blue()    == [22::I,1]
+
     sample()  == red()
+
     hue c     == c.hue
+
     i:PositiveInteger * c:% == i::SF * c
+
     numberOfHues() == totalHues 
 
     color i ==
@@ -28653,6 +30283,62 @@ Color(): Exports == Implementation where
 \begin{chunk}{COQ COLOR}
 (* domain COLOR *)
 (*
+    totalHues   ==> 27  --see  (header.h file) for the current number
+
+    Rep := Record(hue:I, weight:SF)
+ 
+
+    f:SF * c:% ==
+      -- s * c returns the color c, whose weighted shade has been scaled by s
+      zero? f => c
+      -- 0 is the identitly function...or maybe an error is better?
+      [c.hue, f * c.weight]
+ 
+    x + y ==
+     x.hue = y.hue => [x.hue, x.weight + y.weight]
+     if y.weight > x.weight then  -- let x be color with bigger weight
+       c := x
+       x := y
+       y := c
+     diff := x.hue - y.hue
+     if (xHueSmaller:= (diff < 0)) then diff := -diff
+     if (moreThanHalf:=(diff > totalHues quo 2)) then diff := totalHues-diff
+     offset : I := wholePart(round (diff::SF/(2::SF)**(x.weight/y.weight)) )
+     if (xHueSmaller and ^moreThanHalf) or (^xHueSmaller and moreThanHalf) then
+       ans := x.hue + offset
+     else
+       ans := x.hue - offset
+     if (ans < 0) then ans := totalHues + ans
+     else if (ans > totalHues) then ans := ans - totalHues
+     [ans,1]
+ 
+    x = y     == (x.hue = y.hue) and (x.weight = y.weight)
+
+    red()     == [1,1]
+
+    yellow()  == [11::I,1]
+
+    green()   == [14::I,1]
+
+    blue()    == [22::I,1]
+
+    sample()  == red()
+
+    hue c     == c.hue
+
+    i:PositiveInteger * c:% == i::SF * c
+
+    numberOfHues() == totalHues 
+
+    color i ==
+      if (i<0) or (i>totalHues) then
+       error concat("Color should be in the range 1..",totalHues::String)
+      [i::I, 1]
+ 
+    coerce(c:%):OutputForm ==
+      hconcat ["Hue: "::OutputForm, (c.hue)::OutputForm,
+               "  Weight: "::OutputForm, (c.weight)::OutputForm]
+
 *)
 
 \end{chunk}
@@ -28743,9 +30429,13 @@ Commutator: Export == Implement where
        ++ mkcomm(i,j) is not documented
 
    Implement == add
+
      P   :=  Record(left:%,right:%)
+
      Rep := Union(OSI,P)
+
      x,y: %
+
      i  : I
 
      x = y ==
@@ -28757,6 +30447,7 @@ Commutator: Export == Implement where
         false
 
      mkcomm(i) == i::OSI
+
      mkcomm(x,y) == construct(x,y)$P
 
      coerce(x: %): O ==
@@ -28769,6 +30460,32 @@ Commutator: Export == Implement where
 \begin{chunk}{COQ COMM}
 (* domain COMM *)
 (*
+
+     P   :=  Record(left:%,right:%)
+
+     Rep := Union(OSI,P)
+
+     x,y: %
+
+     i  : I
+
+     x = y ==
+        (x case OSI) and (y case OSI) => x::OSI = y::OSI
+        (x case P) and (y case P) =>
+           xx:P := x::P
+           yy:P := y::P
+           (xx.right = yy.right) and (xx.left = yy.left)
+        false
+
+     mkcomm(i) == i::OSI
+
+     mkcomm(x,y) == construct(x,y)$P
+
+     coerce(x: %): O ==
+        x case OSI => x::OSI::O
+        xx := x::P
+        bracket([xx.left::O,xx.right::O])$O
+
 *)
 
 \end{chunk}
@@ -29397,9 +31114,11 @@ o )show Complex
 Complex(R:CommutativeRing): ComplexCategory(R) with
      if R has OpenMath then OpenMath
    == add
+
        Rep := Record(real:R, imag:R)
 
        if R has OpenMath then 
+
          writeOMComplex(dev: OpenMathDevice, x: %): Void ==
           OMputApp(dev)
           OMputSymbol(dev, "complex1", "complex__cartesian")
@@ -29444,16 +31163,24 @@ Complex(R:CommutativeRing): ComplexCategory(R) with
             OMputEndObject(dev)
 
        0                == [0, 0]
+
        1                == [1, 0]
+
        zero? x          == zero?(x.real) and zero?(x.imag)
---       one? x           == one?(x.real) and zero?(x.imag)
+
        one? x           == ((x.real) = 1) and zero?(x.imag)
+
        coerce(r:R):%    == [r, 0]
+
        complex(r, i)   == [r, i]
+
        real x           == x.real
+
        imag x           == x.imag
+
        x + y            == [x.real + y.real, x.imag + y.imag]
                            -- by re-defining this here, we save 5 fn calls
+
        x:% * y:% ==
          [x.real * y.real - x.imag * y.imag,
           x.imag * y.real + y.imag * x.real] -- here we save nine!
@@ -29469,6 +31196,83 @@ Complex(R:CommutativeRing): ComplexCategory(R) with
 \begin{chunk}{COQ COMPLEX}
 (* domain COMPLEX *)
 (*
+
+       Rep := Record(real:R, imag:R)
+
+       if R has OpenMath then 
+
+         writeOMComplex(dev: OpenMathDevice, x: %): Void ==
+          OMputApp(dev)
+          OMputSymbol(dev, "complex1", "complex__cartesian")
+          OMwrite(dev, real x)
+          OMwrite(dev, imag x)
+          OMputEndApp(dev)
+
+         OMwrite(x: %): String ==
+          s: String := ""
+          sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+          dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
+          OMputObject(dev)
+          writeOMComplex(dev, x)
+          OMputEndObject(dev)
+          OMclose(dev)
+          s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+          s
+
+         OMwrite(x: %, wholeObj: Boolean): String ==
+          s: String := ""
+          sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+          dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
+          if wholeObj then
+            OMputObject(dev)
+          writeOMComplex(dev, x)
+          if wholeObj then
+            OMputEndObject(dev)
+          OMclose(dev)
+          s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+          s
+
+         OMwrite(dev: OpenMathDevice, x: %): Void ==
+          OMputObject(dev)
+          writeOMComplex(dev, x)
+          OMputEndObject(dev)
+
+         OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void ==
+          if wholeObj then
+            OMputObject(dev)
+          writeOMComplex(dev, x)
+          if wholeObj then
+            OMputEndObject(dev)
+
+       0                == [0, 0]
+
+       1                == [1, 0]
+
+       zero? x          == zero?(x.real) and zero?(x.imag)
+
+       one? x           == ((x.real) = 1) and zero?(x.imag)
+
+       coerce(r:R):%    == [r, 0]
+
+       complex(r, i)   == [r, i]
+
+       real x           == x.real
+
+       imag x           == x.imag
+
+       x + y            == [x.real + y.real, x.imag + y.imag]
+                           -- by re-defining this here, we save 5 fn calls
+
+       x:% * y:% ==
+         [x.real * y.real - x.imag * y.imag,
+          x.imag * y.real + y.imag * x.real] -- here we save nine!
+
+
+       if R has IntegralDomain then
+         _exquo(x:%, y:%) == -- to correct bad defaulting problem
+           zero? y.imag => x exquo y.real
+           x * conjugate(y) exquo norm(y)
+
 *)
 
 \end{chunk}
@@ -29772,17 +31576,25 @@ ComplexDoubleFloatMatrix : MatrixCategory(Complex DoubleFloat,
     Qnew ==> MAKE_-CDOUBLE_-MATRIX$Lisp
     
     minRowIndex x == 0
+
     minColIndex x == 0
+
     nrows x == Qnrows(x)
+
     ncols x == Qncols(x)
+
     maxRowIndex x == Qnrows(x) - 1
+
     maxColIndex x == Qncols(x) - 1
 
     qelt(m, i, j) == Qelt2(m, i, j)
+
     qsetelt_!(m, i, j, r) == Qsetelt2(m, i, j, r)
 
     empty() == Qnew(0$Integer, 0$Integer)
+
     qnew(rows, cols) == Qnew(rows, cols)
+
     new(rows, cols, a) ==
         res := Qnew(rows, cols)
         for i in 0..(rows - 1) repeat
@@ -29795,6 +31607,41 @@ ComplexDoubleFloatMatrix : MatrixCategory(Complex DoubleFloat,
 \begin{chunk}{COQ CDFMAT}
 (* domain CDFMAT *)
 (*
+
+    NNI ==> Integer
+    Qelt2 ==> CDAREF2$Lisp
+    Qsetelt2 ==> CDSETAREF2$Lisp
+    Qnrows ==> CDANROWS$Lisp
+    Qncols ==> CDANCOLS$Lisp
+    Qnew ==> MAKE_-CDOUBLE_-MATRIX$Lisp
+    
+    minRowIndex x == 0
+
+    minColIndex x == 0
+
+    nrows x == Qnrows(x)
+
+    ncols x == Qncols(x)
+
+    maxRowIndex x == Qnrows(x) - 1
+
+    maxColIndex x == Qncols(x) - 1
+
+    qelt(m, i, j) == Qelt2(m, i, j)
+
+    qsetelt_!(m, i, j, r) == Qsetelt2(m, i, j, r)
+
+    empty() == Qnew(0$Integer, 0$Integer)
+
+    qnew(rows, cols) == Qnew(rows, cols)
+
+    new(rows, cols, a) ==
+        res := Qnew(rows, cols)
+        for i in 0..(rows - 1) repeat
+            for j in 0..(cols - 1) repeat
+                Qsetelt2(res, i, j, a)
+        res
+
 *)
 
 \end{chunk}
@@ -30096,25 +31943,38 @@ ComplexDoubleFloatVector : VectorCategory Complex DoubleFloat with
   == add
     
     Qelt1 ==> CDELT$Lisp
+
     Qsetelt1 ==> CDSETELT$Lisp
 
     qelt(x, i) == Qelt1(x, i)
+
     qsetelt_!(x, i, s) == Qsetelt1(x, i, s)
+
     Qsize ==> CDLEN$Lisp
+
     Qnew ==> MAKE_-CDOUBLE_-VECTOR$Lisp
 
     #x                          == Qsize x
+
     minIndex x                  == 0
+
     empty()                     == Qnew(0$Lisp)
+
     qnew(n)                     == Qnew(n)
+
     new(n, x)                   ==
         res := Qnew(n)
         fill_!(res, x)
+
     qelt(x, i)                  == Qelt1(x, i)
+
     elt(x:%, i:Integer)         == Qelt1(x, i)
+
     qsetelt_!(x, i, s)          == Qsetelt1(x, i, s)
+
     setelt(x : %, i : Integer, s : Complex DoubleFloat) ==
         Qsetelt1(x, i, s)
+
     fill_!(x, s)       ==
         for i in 0..((Qsize(x)) - 1) repeat Qsetelt1(x, i, s)
         x
@@ -30124,6 +31984,44 @@ ComplexDoubleFloatVector : VectorCategory Complex DoubleFloat with
 \begin{chunk}{COQ CDFVEC}
 (* domain CDFVEC *)
 (*
+    
+    Qelt1 ==> CDELT$Lisp
+
+    Qsetelt1 ==> CDSETELT$Lisp
+
+    qelt(x, i) == Qelt1(x, i)
+
+    qsetelt_!(x, i, s) == Qsetelt1(x, i, s)
+
+    Qsize ==> CDLEN$Lisp
+
+    Qnew ==> MAKE_-CDOUBLE_-VECTOR$Lisp
+
+    #x                          == Qsize x
+
+    minIndex x                  == 0
+
+    empty()                     == Qnew(0$Lisp)
+
+    qnew(n)                     == Qnew(n)
+
+    new(n, x)                   ==
+        res := Qnew(n)
+        fill_!(res, x)
+
+    qelt(x, i)                  == Qelt1(x, i)
+
+    elt(x:%, i:Integer)         == Qelt1(x, i)
+
+    qsetelt_!(x, i, s)          == Qsetelt1(x, i, s)
+
+    setelt(x : %, i : Integer, s : Complex DoubleFloat) ==
+        Qsetelt1(x, i, s)
+
+    fill_!(x, s)       ==
+        for i in 0..((Qsize(x)) - 1) repeat Qsetelt1(x, i, s)
+        x
+
 *)
 
 \end{chunk}
@@ -30910,25 +32808,34 @@ ContinuedFraction(R): Exports == Implementation where
 
   Implementation ==> add
 
- -- isOrdered  ==> R is Integer
     isOrdered  ==> R has OrderedRing and R has multiplicativeValuation
+
     canReduce? ==> isOrdered or R has additiveValuation
 
     Rec ==> Record(num: R, den: R)
+
     Str ==> Stream Rec
+
     Rep :=  Record(value: Record(whole: R, fract: Str), reduced?: Boolean)
 
     import Str
 
     genFromSequence:     Stream Q -> %
+
     genReducedForm:      (Q, Stream Q, MT)    -> Stream Rec
+
     genFractionA:        (Stream R,Stream R)  -> Stream Rec
+
     genFractionB:        (Stream R,Stream R)  -> Stream Rec
+
     genNumDen:           (R,R, Stream Rec)    -> Stream R
 
     genApproximants:     (R,R,R,R,Stream Rec) -> Stream Q
+
     genConvergents:      (R,R,R,R,Stream Rec) -> Stream Q
+
     iGenApproximants:    (R,R,R,R,Stream Rec) -> Stream Q
+
     iGenConvergents:     (R,R,R,R,Stream Rec) -> Stream Q
 
     reducedForm c == 
@@ -30976,6 +32883,7 @@ ContinuedFraction(R): Exports == Implementation where
             d < 0 => error "Denominators must be greater than 0."
             concat([n,d]$Rec, delay genFractionA(rst nums,rst dens))
     else
+
         continuedFraction(wh,nums,dens) == [[wh,genFractionB(nums,dens)],false]
 
         genFractionB(nums,dens) ==
@@ -30988,6 +32896,7 @@ ContinuedFraction(R): Exports == Implementation where
         continuedFraction(wh, repeating [1], dens)
 
     coerce(n:Integer):% == [[n::R,empty()], true]
+
     coerce(r:R):%       == [[r,   empty()], true]
 
     coerce(a: Q): % ==
@@ -31007,7 +32916,6 @@ ContinuedFraction(R): Exports == Implementation where
 
     characteristic() == characteristic()$Q
 
-
     genFromSequence apps ==
         lo := first apps; apps := rst apps
         hi := first apps; apps := rst apps
@@ -31031,26 +32939,33 @@ ContinuedFraction(R): Exports == Implementation where
 
     wholePart c == 
       c.value.whole
+
     partialNumerators c == 
       map(x1+->x1.num, c.value.fract)$StreamFunctions2(Rec,R)
+
     partialDenominators c == 
       map(x1+->x1.den, c.value.fract)$StreamFunctions2(Rec,R)
+
     partialQuotients c == 
       concat(c.value.whole, partialDenominators c)
 
     approximants c ==
       empty? c.value.fract => repeating [c.value.whole::Q]
       genApproximants(1,0,c.value.whole,1,c.value.fract)
+
     convergents c ==
       empty? c.value.fract => concat(c.value.whole::Q, empty())
       genConvergents (1,0,c.value.whole,1,c.value.fract)
+
     numerators c ==
       empty? c.value.fract => concat(c.value.whole, empty())
       genNumDen(1,c.value.whole,c.value.fract)
+
     denominators c ==
       genNumDen(0,1,c.value.fract)
 
     extend(x,n) == (extend(x.value.fract,n); x)
+
     complete(x) == (complete(x.value.fract); x)
 
     iGenApproximants(pm2,qm2,pm1,qm1,fr) == delay
@@ -31078,6 +32993,7 @@ ContinuedFraction(R): Exports == Implementation where
       concat(m1,delay genNumDen(m1,m2*frst(fr).num + m1*frst(fr).den,rst fr))
 
     gen  ==> genFromSequence
+
     apx  ==> approximants
 
     c, d: %
@@ -31086,16 +33002,25 @@ ContinuedFraction(R): Exports == Implementation where
     n: Integer
 
     0 == (0$R) :: %
+
     1 == (1$R) :: %
 
     c + d   == genFromSequence map((x,y) +-> x + y, apx c, apx d)
+
     c - d   == genFromSequence map((x,y) +-> x - y, apx c, rest apx d)
+
     - c     == genFromSequence map(x +-> - x, rest apx c)
+
     c * d   == genFromSequence map((x,y) +-> x * y, apx c, apx d)
+
     a * d   == genFromSequence map(x +-> a * x, apx d)
+
     q * d   == genFromSequence map(x +-> q * x, apx d)
+
     n * d   == genFromSequence map(x +-> n * x, apx d)
+
     c / d   == genFromSequence map((x,y) +-> x / y, apx c, rest apx d)
+
     recip c ==(c = 0 => "failed";
        genFromSequence map(x +-> 1/x, rest apx c))
 
@@ -31130,6 +33055,249 @@ ContinuedFraction(R): Exports == Implementation where
 \begin{chunk}{COQ CONTFRAC}
 (* domain CONTFRAC *)
 (*
+
+    isOrdered  ==> R has OrderedRing and R has multiplicativeValuation
+
+    canReduce? ==> isOrdered or R has additiveValuation
+
+    Rec ==> Record(num: R, den: R)
+
+    Str ==> Stream Rec
+
+    Rep :=  Record(value: Record(whole: R, fract: Str), reduced?: Boolean)
+
+    import Str
+
+    genFromSequence:     Stream Q -> %
+
+    genReducedForm:      (Q, Stream Q, MT)    -> Stream Rec
+
+    genFractionA:        (Stream R,Stream R)  -> Stream Rec
+
+    genFractionB:        (Stream R,Stream R)  -> Stream Rec
+
+    genNumDen:           (R,R, Stream Rec)    -> Stream R
+
+    genApproximants:     (R,R,R,R,Stream Rec) -> Stream Q
+
+    genConvergents:      (R,R,R,R,Stream Rec) -> Stream Q
+
+    iGenApproximants:    (R,R,R,R,Stream Rec) -> Stream Q
+
+    iGenConvergents:     (R,R,R,R,Stream Rec) -> Stream Q
+
+    reducedForm c == 
+        c.reduced? => c
+        explicitlyFinite? c.value.fract =>
+                      continuedFraction last complete convergents c
+        canReduce? => genFromSequence approximants c
+        error "Reduced form not defined for this continued fraction."
+
+    eucWhole(a: Q): R == numer a quo denom a
+
+    eucWhole0(a: Q): R ==
+        isOrdered =>
+            n := numer a
+            d := denom a
+            q := n quo d
+            r := n - q*d
+            if r < 0 then q := q - 1
+            q
+        eucWhole a
+
+    x = y ==
+        x := reducedForm x
+        y := reducedForm y
+
+        x.value.whole ^= y.value.whole => false
+
+        xl := x.value.fract; yl := y.value.fract
+
+        while not empty? xl and not empty? yl repeat
+            frst.xl.den ^= frst.yl.den => return false
+            xl := rst xl; yl := rst yl
+        empty? xl and empty? yl
+
+    continuedFraction q == q :: %
+
+    if isOrdered then
+        continuedFraction(wh,nums,dens) == [[wh,genFractionA(nums,dens)],false]
+
+        genFractionA(nums,dens) ==
+            empty? nums or empty? dens => empty()
+            n := frst nums
+            d := frst dens
+            n < 0 => error "Numerators must be greater than 0."
+            d < 0 => error "Denominators must be greater than 0."
+            concat([n,d]$Rec, delay genFractionA(rst nums,rst dens))
+    else
+
+        continuedFraction(wh,nums,dens) == [[wh,genFractionB(nums,dens)],false]
+
+        genFractionB(nums,dens) ==
+            empty? nums or empty? dens => empty()
+            n := frst nums
+            d := frst dens
+            concat([n,d]$Rec, delay genFractionB(rst nums,rst dens))
+
+    reducedContinuedFraction(wh,dens) ==
+        continuedFraction(wh, repeating [1], dens)
+
+    coerce(n:Integer):% == [[n::R,empty()], true]
+
+    coerce(r:R):%       == [[r,   empty()], true]
+
+    coerce(a: Q): % ==
+      wh := eucWhole0 a
+      fr := a - wh::Q
+      zero? fr => [[wh, empty()], true]
+
+      l : List Rec := empty()
+      n := numer fr
+      d := denom fr
+      while not zero? d repeat
+        qr := divide(n,d)
+        l  := concat([1,qr.quotient],l)
+        n  := d
+        d  := qr.remainder
+      [[wh, construct rest reverse_! l], true]
+
+    characteristic() == characteristic()$Q
+
+    genFromSequence apps ==
+        lo := first apps; apps := rst apps
+        hi := first apps; apps := rst apps
+        while eucWhole0 lo ^= eucWhole0 hi repeat
+            lo := first apps; apps := rst apps
+            hi := first apps; apps := rst apps
+        wh := eucWhole0 lo
+        [[wh, genReducedForm(wh::Q, apps, moebius(1,0,0,1))], canReduce?]
+
+    genReducedForm(wh0, apps, mt) ==
+        lo: Q := first apps - wh0; apps := rst apps
+        hi: Q := first apps - wh0; apps := rst apps
+        lo = hi and zero? eval(mt, lo) => empty()
+        mt  := recip mt
+        wlo := eucWhole eval(mt, lo)
+        whi := eucWhole eval(mt, hi)
+        while wlo ^= whi repeat
+            wlo := eucWhole eval(mt, first apps - wh0); apps := rst apps
+            whi := eucWhole eval(mt, first apps - wh0); apps := rst apps
+        concat([1,wlo], delay genReducedForm(wh0, apps, shift(mt, -wlo::Q)))
+
+    wholePart c == 
+      c.value.whole
+
+    partialNumerators c == 
+      map(x1+->x1.num, c.value.fract)$StreamFunctions2(Rec,R)
+
+    partialDenominators c == 
+      map(x1+->x1.den, c.value.fract)$StreamFunctions2(Rec,R)
+
+    partialQuotients c == 
+      concat(c.value.whole, partialDenominators c)
+
+    approximants c ==
+      empty? c.value.fract => repeating [c.value.whole::Q]
+      genApproximants(1,0,c.value.whole,1,c.value.fract)
+
+    convergents c ==
+      empty? c.value.fract => concat(c.value.whole::Q, empty())
+      genConvergents (1,0,c.value.whole,1,c.value.fract)
+
+    numerators c ==
+      empty? c.value.fract => concat(c.value.whole, empty())
+      genNumDen(1,c.value.whole,c.value.fract)
+
+    denominators c ==
+      genNumDen(0,1,c.value.fract)
+
+    extend(x,n) == (extend(x.value.fract,n); x)
+
+    complete(x) == (complete(x.value.fract); x)
+
+    iGenApproximants(pm2,qm2,pm1,qm1,fr) == delay
+      nd := frst fr
+      pm := nd.num*pm2 + nd.den*pm1
+      qm := nd.num*qm2 + nd.den*qm1
+      genApproximants(pm1,qm1,pm,qm,rst fr)
+
+    genApproximants(pm2,qm2,pm1,qm1,fr) ==
+      empty? fr => repeating [pm1/qm1]
+      concat(pm1/qm1,iGenApproximants(pm2,qm2,pm1,qm1,fr))
+
+    iGenConvergents(pm2,qm2,pm1,qm1,fr) == delay
+      nd := frst fr
+      pm := nd.num*pm2 + nd.den*pm1
+      qm := nd.num*qm2 + nd.den*qm1
+      genConvergents(pm1,qm1,pm,qm,rst fr)
+
+    genConvergents(pm2,qm2,pm1,qm1,fr) ==
+      empty? fr => concat(pm1/qm1, empty())
+      concat(pm1/qm1,iGenConvergents(pm2,qm2,pm1,qm1,fr))
+
+    genNumDen(m2,m1,fr) ==
+      empty? fr => concat(m1,empty())
+      concat(m1,delay genNumDen(m1,m2*frst(fr).num + m1*frst(fr).den,rst fr))
+
+    gen  ==> genFromSequence
+
+    apx  ==> approximants
+
+    c, d: %
+    a: R
+    q: Q
+    n: Integer
+
+    0 == (0$R) :: %
+
+    1 == (1$R) :: %
+
+    c + d   == genFromSequence map((x,y) +-> x + y, apx c, apx d)
+
+    c - d   == genFromSequence map((x,y) +-> x - y, apx c, rest apx d)
+
+    - c     == genFromSequence map(x +-> - x, rest apx c)
+
+    c * d   == genFromSequence map((x,y) +-> x * y, apx c, apx d)
+
+    a * d   == genFromSequence map(x +-> a * x, apx d)
+
+    q * d   == genFromSequence map(x +-> q * x, apx d)
+
+    n * d   == genFromSequence map(x +-> n * x, apx d)
+
+    c / d   == genFromSequence map((x,y) +-> x / y, apx c, rest apx d)
+
+    recip c ==(c = 0 => "failed";
+       genFromSequence map(x +-> 1/x, rest apx c))
+
+    showAll?: () -> Boolean
+    showAll?() ==
+      NULL(_$streamsShowAll$Lisp)$Lisp => false
+      true
+
+    zagRec(t:Rec):OUT == zag(t.num :: OUT,t.den :: OUT)
+
+    coerce(c:%): OUT ==
+      wh := c.value.whole
+      fr := c.value.fract
+      empty? fr => wh :: OUT
+      count : NonNegativeInteger := _$streamCount$Lisp
+      l : List OUT := empty()
+      for n in 1..count while not empty? fr repeat
+        l  := concat(zagRec frst fr,l)
+        fr := rst fr
+      if showAll?() then
+        for n in (count + 1).. while explicitEntries? fr repeat
+          l  := concat(zagRec frst fr,l)
+          fr := rst fr
+      if not explicitlyEmpty? fr then l := concat("..." :: OUT,l)
+      l := reverse_! l
+      e := reduce("+",l)
+      zero? wh => e
+      (wh :: OUT) + e
+
 *)
 
 \end{chunk}
@@ -31237,8 +33405,8 @@ Database(S): Exports == Implementation where
     _+: (%,%) -> %
       ++ db1+db2 returns the merge of databases db1 and db2
     _-: (%,%) -> %
-      ++ db1-db2 returns the difference of databases db1 and db2 i.e. consisting
-      ++ of elements in db1 but not in db2 
+      ++ db1-db2 returns the difference of databases db1 and db2 i.e. 
+      ++ consisting of elements in db1 but not in db2 
     coerce: List S -> %
       ++ coerce(l) makes a database out of a list
     display: % -> Void
@@ -31249,19 +33417,30 @@ Database(S): Exports == Implementation where
       ++ fullDisplay(db,start,end ) prints full details of entries in the range
       ++ \axiom{start..end} in \axiom{db}.
   Implementation == List S add
+
     s: Symbol
+
     Rep := List S
+
     coerce(u: List S):% == u@%
+
     elt(data: %,s: Symbol) == [x.s for x in data] :: DataList(String)
+
     elt(data: %,eq: QueryEquation) ==
       field := variable eq
       val := value eq
       [x for x in data | stringMatches?(val,x.field)$Lisp]
+
     x+y==removeDuplicates_! merge(x,y)
+
     x-y==mergeDifference(copy(x::Rep),y::Rep)$MergeThing(S)
+
     coerce(data): OutputForm == (#data):: OutputForm
+
     display(data) ==  for x in data repeat display x
+
     fullDisplay(data) == for x in data repeat fullDisplay x
+
     fullDisplay(data,n,m) == for x in data for i in 1..m repeat
       if i >= n then fullDisplay x
 
@@ -31270,6 +33449,33 @@ Database(S): Exports == Implementation where
 \begin{chunk}{COQ DBASE}
 (* domain DBASE *)
 (*
+
+    s: Symbol
+
+    Rep := List S
+
+    coerce(u: List S):% == u@%
+
+    elt(data: %,s: Symbol) == [x.s for x in data] :: DataList(String)
+
+    elt(data: %,eq: QueryEquation) ==
+      field := variable eq
+      val := value eq
+      [x for x in data | stringMatches?(val,x.field)$Lisp]
+
+    x+y==removeDuplicates_! merge(x,y)
+
+    x-y==mergeDifference(copy(x::Rep),y::Rep)$MergeThing(S)
+
+    coerce(data): OutputForm == (#data):: OutputForm
+
+    display(data) ==  for x in data repeat display x
+
+    fullDisplay(data) == for x in data repeat fullDisplay x
+
+    fullDisplay(data,n,m) == for x in data for i in 1..m repeat
+      if i >= n then fullDisplay x
+
 *)
 
 \end{chunk}
@@ -31563,12 +33769,19 @@ DataList(S:OrderedSet) : Exports == Implementation where
     elt: (%,"count") -> NonNegativeInteger
       ++ \axiom{l."count"} returns the number of elements in \axiom{l}.
   Implementation == List(S) add
+
     elt(x,"unique") == removeDuplicates(x)
+
     elt(x,"sort") == sort(x)
+
     elt(x,"count") == #x
+
     coerce(x:List S) == x pretend %
+
     coerce(x:%):List S == x pretend (List S)
+
     coerce(x:%): OutputForm == (x :: List S) :: OutputForm
+
     datalist(x:List S) == x::%
 
 \end{chunk}
@@ -31576,6 +33789,21 @@ DataList(S:OrderedSet) : Exports == Implementation where
 \begin{chunk}{COQ DLIST}
 (* domain DLIST *)
 (*
+
+    elt(x,"unique") == removeDuplicates(x)
+
+    elt(x,"sort") == sort(x)
+
+    elt(x,"count") == #x
+
+    coerce(x:List S) == x pretend %
+
+    coerce(x:%):List S == x pretend (List S)
+
+    coerce(x:%): OutputForm == (x :: List S) :: OutputForm
+
+    datalist(x:List S) == x::%
+
 *)
 
 \end{chunk}
@@ -31974,7 +34202,9 @@ DecimalExpansion(): Exports == Implementation where
       ++ decimal(r) converts a rational number to a decimal expansion.
 
   Implementation ==> RadixExpansion(10) add
+
     decimal r == r :: %
+
     coerce(x:%): RadixExpansion(10) == x pretend RadixExpansion(10)
 
 \end{chunk}
@@ -31982,6 +34212,12 @@ DecimalExpansion(): Exports == Implementation where
 \begin{chunk}{COQ DECIMAL}
 (* domain DECIMAL *)
 (*
+ RadixExpansion(10) add
+
+    decimal r == r :: %
+
+    coerce(x:%): RadixExpansion(10) == x pretend RadixExpansion(10)
+
 *)
 
 \end{chunk}
@@ -34539,13 +36775,6 @@ DenavitHartenbergMatrix(R): Exports == Implementation where
 
     identity() == matrix([[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]])
 
---    inverse(x) == (inverse(x pretend (Matrix R))$Matrix(R)) pretend %
---    dhinverse(x) == matrix( _
---        [[nx,ny,nz,-(px*nx+py*ny+pz*nz)],_
---         [ox,oy,oz,-(px*ox+py*oy+pz*oz)],_
---         [ax,ay,az,-(px*ax+py*ay+pz*az)],_
---         [ 0, 0, 0, 1]])
-
     d * p ==
        v := p pretend Vector R
        v := concat(v, 1$R)
@@ -34567,6 +36796,26 @@ DenavitHartenbergMatrix(R): Exports == Implementation where
 \begin{chunk}{COQ DHMATRIX}
 (* domain DHMATRIX *)
 (*
+ Matrix(R) add
+
+    identity() == matrix([[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]])
+
+    d * p ==
+       v := p pretend Vector R
+       v := concat(v, 1$R)
+       v := d * v
+       point ([v.1, v.2, v.3]$List(R))
+
+\getchunk{rotatex}
+
+\getchunk{rotatey}
+
+\getchunk{rotatez}
+
+\getchunk{scale}
+
+\getchunk{translate}
+ 
 *)
 
 \end{chunk}
@@ -35739,9 +37988,13 @@ Dequeue(S:SetCategory): DequeueAggregate S with
         ++X count(4,a)
 
   == Queue S add
+
     Rep := Reference List S
+
     bottom! d == extractBottom! d
+
     dequeue d == ref copy d
+
     extractBottom! d ==
         if empty? d then error "empty dequeue"
         p := deref d
@@ -35754,21 +38007,30 @@ Dequeue(S:SetCategory): DequeueAggregate S with
         r := first rest q
         q.rest := []
         r
+
     top! d == extractTop! d
+
     extractTop! d ==
         if empty? d then error "empty dequeue"
         e := top d
         setref(d,rest deref d)
         e
+
     height d == # deref d
+
     depth d == # deref d
+
     insertTop!(e,d) == (setref(d,cons(e,deref d)); e)
+
     lastTail==> LAST$Lisp
+
     insertBottom!(e,d) ==
         if empty? d then setref(d, list e)
         else lastTail.(deref d).rest := list e
         e
+
     top d == if empty? d then error "empty dequeue" else first deref d
+
     reverse! d == (setref(d,reverse deref d); d)
 
 \end{chunk}
@@ -35776,6 +38038,52 @@ Dequeue(S:SetCategory): DequeueAggregate S with
 \begin{chunk}{COQ DEQUEUE}
 (* domain DEQUEUE *)
 (*
+ Queue S add
+
+    Rep := Reference List S
+
+    bottom! d == extractBottom! d
+
+    dequeue d == ref copy d
+
+    extractBottom! d ==
+        if empty? d then error "empty dequeue"
+        p := deref d
+        n := maxIndex p
+        n = 1 =>
+           r := first p
+           setref(d,[])
+           r
+        q := rest(p,(n-2)::NonNegativeInteger)
+        r := first rest q
+        q.rest := []
+        r
+
+    top! d == extractTop! d
+
+    extractTop! d ==
+        if empty? d then error "empty dequeue"
+        e := top d
+        setref(d,rest deref d)
+        e
+
+    height d == # deref d
+
+    depth d == # deref d
+
+    insertTop!(e,d) == (setref(d,cons(e,deref d)); e)
+
+    lastTail==> LAST$Lisp
+
+    insertBottom!(e,d) ==
+        if empty? d then setref(d, list e)
+        else lastTail.(deref d).rest := list e
+        e
+
+    top d == if empty? d then error "empty dequeue" else first deref d
+
+    reverse! d == (setref(d,reverse deref d); d)
+
 *)
 
 \end{chunk}
@@ -39422,6 +41730,142 @@ DeRhamComplex(CoefRing,listIndVar:List Symbol): Export == Implement where
 \begin{chunk}{COQ DERHAM}
 (* domain DERHAM *)
 (*
+ ASY add
+      Rep := ASY 
+
+      dim := #listIndVar
+
+      totalDifferential(f) ==
+        divs:=[differentiate(f,listIndVar.i)*generator(i)$ASY for i in 1..dim]
+        reduce("+",divs)
+
+      termDiff : (R, %) -> %
+      termDiff(r,e) ==
+        totalDifferential(r) * e
+
+      exteriorDifferential(x) ==
+        x = 0 => 0
+        termDiff(leadingCoefficient(x)$Rep,leadingBasisTerm x) + _
+          exteriorDifferential(reductum x)
+
+      lv := [concat("d",string(liv))$String::Symbol for liv in listIndVar]
+
+      displayList:EAB -> O
+      displayList(x):O ==
+        le: L I := exponents(x)$EAB
+        reduce(_*,[(lv.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)
+
+      terms : % -> List Record(k: EAB, c: R)
+      terms(a) ==
+        -- it is the case that there are at least two terms in a
+        a pretend List Record(k: EAB, c: R)
+        
+      err1:="CoefRing has not IntegralDomain"
+      err2:="Metric tensor is not symmetric"
+      err3:="Degenerate metric"
+      err4:="Index out of range" 
+
+      -- coord space dimension
+      dim(f) == dim
+
+      -- flip 0->1, 1->0
+      flip(b:ExtAlgBasis):ExtAlgBasis ==
+        bl := b pretend List(NNI)
+        [(i+1) rem 2 for i in bl] pretend ExtAlgBasis
+
+      -- list the positions of a's (a=0,1) in x
+      pos(x:EAB, a:NNI):List(NNI) ==
+        y:= x pretend List(NNI)
+        [j for j in 1..#y | y.j=a]
+
+      -- compute dot of singletons
+      dot1(r:Record(k:EAB,c:R),s:Record(k:EAB,c:R),g:SMR):R ==
+        not CoefRing has IntegralDomain => error(err1)
+        test(r.k ^= s.k) => 0::R
+        idx := pos(r.k,1)
+        idx = [] => r.c * s.c
+        reduce("*",[1/g(j,j) for j in idx]::List(R))*r.c*s.c
+
+      -- compute dot of singleton terms, general symmetric g
+      dot2(r:REABR, s:REABR, g:SMR):R ==
+        not CoefRing has IntegralDomain => error(err1)
+        pr := pos(r.k,1) -- list positions of 1 in r
+        ps := pos(s.k,1) -- list positions of 1 in s
+        test(#pr ^= #ps) => 0::R -- not same degree => 0
+        pr = [] => r.c * s.c -- empty pr,ps => product of coefs
+        G := inverse(g)::SMR -- compute the inverse of the metric g
+        test(#pr = 1) => G(pr.1,ps.1)::R * r.c * s.c -- only one element
+        M:Matrix(R) -- the minor
+        M := matrix([[G(pr.i,ps.j)::R for j in 1..#ps] for i in 1..#pr])
+        determinant(M)::R * r.c * s.c
+
+      -- export
+      dot(x,y,g) ==
+        not symmetric? g => error(err2)
+        tx:=terms(x)
+        ty:=terms(y)
+        tx = [] or ty = [] => 0::R
+        if diagonal? g then -- better performance
+          reduce("+",[dot2(tx.j,ty.j,g) for j in 1..#tx])
+        else
+          reduce("+",[dot1(tx.j,ty.j,g) for j in 1..#tx])
+     
+      -- export
+      hodgeStar(x,g) ==
+        not CoefRing has IntegralDomain => error(err1)
+        not diagonal? g => error(err2)
+        v := sqrt(abs(determinant(g))) -- volume factor
+        v = 0 => error(err3)
+        t:=terms(x)
+        s:=[copy(r) for r in t] -- we need a copy of x
+        for j in 1..#t repeat
+          s.j.k := flip(s.j.k)
+          fs:=[s.j] pretend %
+          ft:=[t.j] pretend %
+          s.j.c := s.j.c * v * dot1(t.j,t.j,g)/leadingCoefficient(ft*fs)
+        s pretend %
+
+      -- export
+      proj(x,p) ==
+        p < 0 or p > dim => error(err4)
+        t := terms(x)
+        idx := [j for j in 1..#t | #pos(t.j.k,1)=p]
+        s := [copy(t.j) for j in idx::List(NNI)]
+        s pretend %
+
+      interiorProduct(v,x,g) ==
+        not CoefRing has IntegralDomain => error(err1)
+        f := reduce("+",[generator(i)$% for i in 1..dim]::List(%))
+        t := terms(f)
+        for j in 1..dim repeat
+          t.(dim-j+1).c := g(j,j)*v(j) -- reverse order
+        f -- term manipulations are destructive
+        dg:R := determinant(g)
+        sg:R := dg/abs(dg)
+        if odd?(dim) then
+          m:R := sg
+        else
+          m:R := (-1)**degree(x)*sg
+        m * hodgeStar(f*hodgeStar(x,g),g)
+
+      lieDerivative(v,x,g) ==
+        a:= exteriorDifferential(interiorProduct(v,x,g))
+        b:= interiorProduct(v,exteriorDifferential(x),g)
+        a+b
+
+      coerce(a):O ==
+        a = 0$Rep => 0$I::O
+        ta := terms a
+        null ta.rest => makeTerm(ta.first.c, ta.first.k)
+        reduce(_+,[makeTerm(t.c,t.k) for t in ta])$L(O)
+
 *)
 
 \end{chunk}
@@ -39630,6 +42074,52 @@ DesingTree(S: SetCategory): T==C where
 \begin{chunk}{COQ DSTREE}
 (* domain DSTREE *)
 (*
+    Rep ==> Record(value: S, args: List %)
+
+    fullOut(t:%): OutputForm ==
+      empty? children t => (value t) ::OutputForm
+      prefix((value t)::OutputForm, [fullOut(tr) for tr in children t])
+
+    fullOutputFlag:Boolean:=false()
+
+    fullOutput(f)== fullOutputFlag:=f
+
+    fullOutput == fullOutputFlag
+    
+    leaves(t)==
+      empty?(chdr:=children(t)) => list(value(t))
+      concat([leaves(subt) for subt in chdr])
+
+    t1=t2 == value t1 = value t2 and children t1 = children t2
+
+    coerce(t:%):OutputForm== 
+      ^fullOutput() => encode(t) :: OutputForm
+      fullOut(t)
+
+    tree(s,ls) == ([s,ls]:Rep):%
+
+    tree(s:S) == ([s,[]]:Rep):%
+
+    tree(ls:List(S))==
+      empty?(ls) => 
+        error "Cannot create a tree with an empty list"
+      f:=first(ls)
+      empty?(rs:=rest(ls)) =>
+        tree(f)
+      tree(f,[tree(rs)])
+
+    value t == (t:Rep).value
+
+    children t == ((t:Rep).args):List %
+
+    setchildren_!(t,ls) == ((t:Rep).args:=ls;t pretend %)
+
+    setvalue_!(t,s) == ((t:Rep).value:=s;s)
+
+    encode(t)==
+      empty?(chtr:=children(t)) => empty()$String
+      concat([concat(["U",encode(arb),"."]) for arb in chtr])
+
 *)
 
 \end{chunk}
@@ -39955,6 +42445,7 @@ DifferentialSparseMultivariatePolynomial(R, S, V):
                    RetractableTo SMP)
 
   Implementation ==> P add
+
     retractIfCan(p:$):Union(SMP, "failed") ==
       zero? order p =>
         map(x+->retract(x)@S :: SMP,y+->y::SMP, p)$PCL(
@@ -39969,6 +42460,17 @@ DifferentialSparseMultivariatePolynomial(R, S, V):
 \begin{chunk}{COQ DSMP}
 (* domain DSMP *)
 (*
+ P add
+
+    retractIfCan(p:$):Union(SMP, "failed") ==
+      zero? order p =>
+        map(x+->retract(x)@S :: SMP,y+->y::SMP, p)$PCL(
+                                  IndexedExponents V, V, R, $, SMP)
+      "failed"
+
+    coerce(p:SMP):$ ==
+      map(x+->x::V::$, y+->y::$, p)$PCL(IndexedExponents S, S, R, SMP, $)
+
 *)
 
 \end{chunk}
@@ -40301,6 +42803,83 @@ DirectProduct(dim:NonNegativeInteger, R:Type):
 \begin{chunk}{COQ DIRPROD}
 (* domain DIRPROD *)
 (*
+ Vector R add
+ 
+      Rep := Vector R
+ 
+      coerce(z:%):Vector(R)        == copy(z)$Rep pretend Vector(R)
+      coerce(r:R):%                == new(dim, r)$Rep
+ 
+      parts x == VEC2LIST(x)$Lisp
+ 
+      directProduct z ==
+        size?(z, dim) => copy(z)$Rep
+        error "Not of the correct length"
+ 
+ 
+      if R has SetCategory then
+        same?: % -> Boolean
+        same? z == every?(x +-> x = z(minIndex z), z)
+ 
+        x = y == _and/[qelt(x,i)$Rep = qelt(y,i)$Rep for i in 1..dim]
+ 
+        retract(z:%):R ==
+          same? z => z(minIndex z)
+          error "Not retractable"
+ 
+        retractIfCan(z:%):Union(R, "failed") ==
+          same? z => z(minIndex z)
+          "failed"
+ 
+ 
+      if R has AbelianSemiGroup then
+        u:% + v:% == map(_+ , u, v)$Rep
+ 
+      if R has AbelianMonoid then
+        0 == zero(dim)$Vector(R) pretend %
+ 
+      if R has Monoid then
+        1 == new(dim, 1)$Vector(R) pretend %
+        u:% * r:R       == map(x +-> x * r, u)
+        r:R * u:%       == map(x +-> r * x, u)
+        x:% * y:% == [x.i * y.i for i in 1..dim]$Vector(R) pretend %
+ 
+      if R has CancellationAbelianMonoid then
+        subtractIfCan(u:%, v:%):Union(%,"failed") ==
+          w := new(dim,0)$Vector(R)
+          for i in 1..dim repeat
+            (c:=subtractIfCan(qelt(u, i)$Rep, qelt(v,i)$Rep)) case "failed" =>
+                    return "failed"
+            qsetelt_!(w, i, c::R)$Rep
+          w pretend %
+ 
+      if R has Ring then
+ 
+        u:% * v:%                    == map(_* , u, v)$Rep
+ 
+        recip z ==
+          w := new(dim,0)$Vector(R)
+          for i in minIndex w .. maxIndex w repeat
+            (u := recip qelt(z, i)) case "failed" => return "failed"
+            qsetelt_!(w, i, u::R)
+          w pretend %
+ 
+        unitVector i ==
+          v:= new(dim,0)$Vector(R)
+          v.i := 1
+          v pretend %
+ 
+      if R has OrderedSet then
+        x < y ==
+          for i in 1..dim repeat
+             qelt(x,i) < qelt(y,i) => return true
+             qelt(x,i) > qelt(y,i) => return false
+          false
+
+      if R has OrderedAbelianMonoidSup then sup(x, y) == map(sup, x, y)
+ 
+--)bo $noSubsumption := false
+
 *)
 
 \end{chunk}
@@ -40548,11 +43127,14 @@ DirectProductMatrixModule(n, R, M, S): DPcategory == DPcapsule where
     M: SquareMatrixCategory(n,R,RowCol,RowCol)
     S: LeftModule(R)
 
-    DPcategory == Join(DirectProductCategory(n,S), LeftModule(R), LeftModule(M))
+    DPcategory == Join(DirectProductCategory(n,S),LeftModule(R), LeftModule(M))
 
     DPcapsule == DirectProduct(n, S) add
+
         Rep := Vector(S)
+
         r:R * x:$ == [r*x.i for i in 1..n]
+
         m:M * x:$ == [ +/[m(i,j)*x.j for j in 1..n] for i in 1..n]
 
 \end{chunk}
@@ -40560,6 +43142,14 @@ DirectProductMatrixModule(n, R, M, S): DPcategory == DPcapsule where
 \begin{chunk}{COQ DPMM}
 (* domain DPMM *)
 (*
+ DirectProduct(n, S) add
+
+        Rep := Vector(S)
+
+        r:R * x:$ == [r*x.i for i in 1..n]
+
+        m:M * x:$ == [ +/[m(i,j)*x.j for j in 1..n] for i in 1..n]
+
 *)
 
 \end{chunk}
@@ -40817,6 +43407,18 @@ DirectProductModule(n, R, S): DPcategory == DPcapsule where
 \begin{chunk}{COQ DPMO}
 (* domain DPMO *)
 (*
+    n: NonNegativeInteger
+    R: Ring
+    S: LeftModule(R)
+
+    DPcategory == Join(DirectProductCategory(n,S), LeftModule(R))
+    --  with if S has Algebra(R) then Algebra(R)
+    --  <above line leads to matchMmCond: unknown form of condition>
+
+    DPcapsule == DirectProduct(n,S) add
+        Rep := Vector(S)
+        r:R * x:$ == [r * x.i for i in 1..n]
+
 *)
 
 \end{chunk}
@@ -41248,6 +43850,102 @@ DirichletRing(Coef: Ring):
 \begin{chunk}{COQ DIRRING}
 (* domain DIRRING *)
 (*
+
+        Rep := Record(function: FUN)
+
+        per(f: Rep): % == f pretend %   
+        rep(a: %): Rep == a pretend Rep 
+
+        elt(a: %, n: PI): Coef ==
+            f: FUN := (rep a).function
+            f n
+
+        coerce(a: %): FUN == (rep a).function
+
+        coerce(f: FUN): % == per [f]
+
+        indices: Stream Integer 
+                := integers(1)$StreamTaylorSeriesOperations(Integer)
+
+        coerce(a: %): Stream Coef ==
+            f: FUN := (rep a).function
+            map((n: Integer): Coef +-> f(n::PI), indices)
+               $StreamFunctions2(Integer, Coef)
+
+        coerce(f: Stream Coef): % == 
+            ((n: PI): Coef +-> f.(n::Integer))::%
+
+        coerce(f: %): OutputForm == f::Stream Coef::OutputForm
+
+        1: % == 
+            ((n: PI): Coef +-> (if one? n then 1$Coef else 0$Coef))::%
+
+        0: % == 
+            ((n: PI): Coef +-> 0$Coef)::%
+
+        zeta: % ==
+            ((n: PI): Coef +-> 1$Coef)::%
+
+        (f: %) + (g: %) == 
+            ((n: PI): Coef +-> f(n)+g(n))::%
+
+        - (f: %) ==
+            ((n: PI): Coef +-> -f(n))::%
+
+        (a: Integer) * (f: %) ==
+            ((n: PI): Coef +-> a*f(n))::%
+
+        (a: Coef) * (f: %) ==
+            ((n: PI): Coef +-> a*f(n))::%
+
+        import IntegerNumberTheoryFunctions
+
+        (f: %) * (g: %) == 
+          conv := (n: PI): Coef +-> _
+            reduce((a: Coef, b: Coef): Coef +-> a + b, _
+              [f(d::PI) * g((n quo d)::PI) for d in divisors(n::Integer)], 0)
+                        $ListFunctions2(Coef, Coef)
+          conv::%
+
+        unit?(a: %): Boolean == not (recip(a(1$PI))$Coef case "failed")
+
+        qrecip: (%, Coef, PI) -> Coef
+        qrecip(f: %, f1inv: Coef, n: PI): Coef ==
+          if one? n then f1inv
+          else 
+              -f1inv * reduce(_+, [f(d::PI) * qrecip(f, f1inv, (n quo d)::PI) _
+                                   for d in rest divisors(n)], 0) _
+                             $ListFunctions2(Coef, Coef)
+
+        recip f ==
+            if (f1inv := recip(f(1$PI))$Coef) case "failed" then "failed"
+            else 
+                mp := (n: PI): Coef +-> qrecip(f, f1inv, n)
+
+                mp::%::Union(%, "failed")
+
+        multiplicative?(a, n) ==
+            for i in 2..n repeat 
+                fl := factors(factor i)$Factored(Integer)
+                rl := [a.(((f.factor)::PI)**((f.exponent)::PI)) for f in fl]
+                if a.(i::PI) ~= reduce((r:Coef, s:Coef):Coef +-> r*s, rl)
+                then 
+                    output(i::OutputForm)$OutputPackage
+                    output(rl::OutputForm)$OutputPackage
+                    return false
+            true
+
+        additive?(a, n) ==
+            for i in 2..n repeat
+                fl := factors(factor i)$Factored(Integer)
+                rl := [a.(((f.factor)::PI)**((f.exponent)::PI)) for f in fl]
+                if a.(i::PI) ~= reduce((r:Coef, s:Coef):Coef +-> r+s, rl)
+                then 
+                    output(i::OutputForm)$OutputPackage
+                    output(rl::OutputForm)$OutputPackage
+                    return false
+            true
+
 *)
 
 \end{chunk}
@@ -41990,6 +44688,130 @@ Divisor(S:SetCategoryWithDegree):Exports == Implementation where
 \begin{chunk}{COQ DIV}
 (* domain DIV *)
 (*
+ List PT add
+
+    Rep := List PT
+    
+    incr(d)==
+      [ [ pt.gen , pt.exp + 1 ] for pt in d ]    
+    
+    inOut: PT -> OutputForm
+
+    inOut(pp)==
+      one?(pp.exp) => pp.gen :: OutputForm
+      bl:OutputForm:= " " ::OutputForm
+      (pp.exp :: OutputForm) * hconcat(bl,pp.gen :: OutputForm) 
+
+    coerce(d:%):OutputForm==
+      zero?(d) => ("0"::OutputForm)
+      ll:List OutputForm:=[inOut df  for df in d]
+      reduce("+",ll)
+
+    reductum(d)==
+      zero?(d) => d
+      dl:Rep:= d pretend Rep
+      dlr := rest dl
+      empty?(dlr) => 0
+      dlr
+
+    head(d)==
+      zero?(d) => error "Cannot take head of zero"
+      dl:Rep:= d pretend Rep
+      first dl
+
+    coerce(s:S) == [[s,1]$PT]::%
+
+    split(a) == 
+      zero?(a) => []
+      [[r]::% for r in a]
+
+    coefficient(s,a)==
+      r:INT:=0
+      for pt in terms(a) repeat
+        if pt.gen=s then
+          r:=pt.exp
+      r
+
+    terms(a)==a::Rep
+
+    0==empty()$Rep
+
+    supp(a)==
+      aa:=terms(collect(a))
+      [p.gen for p in aa | ^zero?(p.exp)]  
+
+    suppOfZero(a)==
+      aa:=terms(collect(a))
+      [p.gen for p in aa | (p.exp) > 0 ]  
+
+    suppOfPole(a)==
+      aa:=terms(collect(a))
+      [p.gen for p in aa | p.exp < 0 ]  
+
+    divOfZero(a)==
+      aa:=terms(collect(a))
+      [p for p in aa | (p.exp) > 0 ]::%  
+
+    divOfPole(a)==
+      aa:=terms(collect(a))
+      [p for p in aa | p.exp < 0 ]::%  
+
+    zero?(a)==
+      ((collect(a)::Rep)=empty()$Rep)::BOOLEAN
+
+    collect(d)==
+      a:=d::Rep
+      empty?(a) => 0      
+      t:Rep:=empty()
+      ff:PT:=first(a)
+      one?(#(a)) =>
+        if zero?(ff.exp) then
+          t::%
+        else
+          a::%
+      inList?:Boolean:=false()
+      newC:INT
+      restred:=terms(collect((rest(a)::%)))
+      zero?(ff.exp) =>
+        restred::%
+      for bb in restred repeat
+        b:=bb::PT
+        if b.gen=ff.gen then
+          newC:=b.exp+ff.exp
+          if ^zero?(newC) then
+            t:=concat(t,[b.gen,newC]$PT)
+          inList?:=true()
+        else
+          t:=concat(t,b)
+      if ^inList? then
+        t:=cons(ff,t)
+      t::%  
+
+    a:% + b:% ==
+      collect(concat(a pretend Rep,b pretend Rep))
+
+    a:% - b:% ==
+      a + (-1)*b 
+
+    -a:% == (-1)*a
+
+    n:INT * a:% ==
+      zero?(n) => 0
+      t:Rep:=empty()
+      for p in a pretend Rep repeat
+        t:=concat(t,[ p.gen, n*p.exp]$PT)
+      t::%
+
+    a:% <= b:% ==
+      bma:= b - a
+      effective? bma => true 
+      false
+
+    effective?(a)== empty?(suppOfPole(a))
+
+    degree(d:%):Integer==
+      reduce("+",[(p.exp * degree(p.gen)) for p in d @ Rep],0$INT)          
+
 *)
 
 \end{chunk}
@@ -42719,7 +45541,9 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
         ++X integerDecode a
 
  == add
+
    format: String := "~G"
+
    MER ==> Record(MANTISSA:Integer,EXPONENT:Integer)
 
    manexp: % -> MER
@@ -42783,89 +45607,160 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
      [numer,exp,sign]
 
    base()           == FLOAT_-RADIX(0$%)$Lisp
+
    mantissa x       == manexp(x).MANTISSA
+
    exponent x       == manexp(x).EXPONENT
+
    precision()      == FLOAT_-DIGITS(0$%)$Lisp
+
    bits()           ==
      base() = 2 => precision()
      base() = 16 => 4*precision()
      wholePart(precision()*log2(base()::%))::PositiveInteger
+
    max()            == MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp
+
    min()            == MOST_-NEGATIVE_-DOUBLE_-FLOAT$Lisp
+
    order(a) == precision() + exponent a - 1
+
    0                == FLOAT(0$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp
+
    1                == FLOAT(1$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp
    -- rational approximation to e accurate to 23 digits
+
    exp1()  == FLOAT(534625820200,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp / _
               FLOAT(196677847971,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp
+
    pi()    == FLOAT(PI$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp
+
    coerce(x:%):OutputForm == 
      x >= 0 => message(FORMAT(NIL$Lisp,format,x)$Lisp @ String)
      - (message(FORMAT(NIL$Lisp,format,-x)$Lisp @ String))
+
    convert(x:%):InputForm == convert(x pretend DoubleFloat)$InputForm
+
    x < y            == DFLESSTHAN(x,y)$Lisp
+
    - x              == DFUNARYMINUS(x)$Lisp
+
    x + y            == DFADD(x,y)$Lisp
+
    x:% - y:%        == DFSUBTRACT(x,y)$Lisp
+
    x:% * y:%        == DFMULTIPLY(x,y)$Lisp
+
    i:Integer * x:%  == DFINTEGERMULTIPLY(i,x)$Lisp
+
    max(x,y)         == DFMAX(x,y)$Lisp
+
    min(x,y)         == DFMIN(x,y)$Lisp
+
    x = y            == DFEQL(x,y)$Lisp
+
    x:% / i:Integer  == DFINTEGERDIVIDE(x,i)$Lisp
+
    sqrt x           == checkComplex DFSQRT(x)$Lisp
+
    log10 x          == checkComplex DFLOG(x,10)$Lisp
+
    x:% ** i:Integer == DFINTEGEREXPT(x,i)$Lisp
+
    x:% ** y:%       == checkComplex DFEXPT(x,y)$Lisp
+
    coerce(i:Integer):% == FLOAT(i,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp
+
    exp x            == DFEXP(x)$Lisp
+
    log x            == checkComplex DFLOGE(x)$Lisp
+
    log2 x           == checkComplex DFLOG(x,2)$Lisp
+
    sin x            == DFSIN(x)$Lisp
+
    cos x            == DFCOS(x)$Lisp
+
    tan x            == DFTAN(x)$Lisp
+
    cot x            == COT(x)$Lisp
+
    sec x            == SEC(x)$Lisp
+
    csc x            == CSC(x)$Lisp
+
    asin x           == checkComplex DFASIN(x)$Lisp -- can be complex
+
    acos x           == checkComplex DFACOS(x)$Lisp -- can be complex
+
    atan x           == DFATAN(x)$Lisp
+
    acsc x           == checkComplex ACSC(x)$Lisp
+
    acot x           == ACOT(x)$Lisp
+
    asec x           == checkComplex ASEC(x)$Lisp
+
    sinh x           == SINH(x)$Lisp
+
    cosh x           == COSH(x)$Lisp
+
    tanh x           == TANH(x)$Lisp
+
    csch x           == CSCH(x)$Lisp
+
    coth x           == COTH(x)$Lisp
+
    sech x           == SECH(x)$Lisp
+
    asinh x          == DFASINH(x)$Lisp
+
    acosh x          == checkComplex DFACOSH(x)$Lisp -- can be complex
+
    atanh x          == checkComplex DFATANH(x)$Lisp -- can be complex
+
    acsch x          == ACSCH(x)$Lisp
+
    acoth x          == checkComplex ACOTH(x)$Lisp
+
    asech x          == checkComplex ASECH(x)$Lisp
+
    x:% / y:%        == DFDIVIDE(x,y)$Lisp
+
    negative? x      == DFMINUSP(x)$Lisp
+
    zero? x          == ZEROP(x)$Lisp
+
    hash x           == SXHASH(x)$Lisp
+
    recip(x)         == (zero? x => "failed"; 1 / x)
+
    differentiate x  == 0
 
    SFSFUN           ==> DoubleFloatSpecialFunctions()
+
    sfx              ==> x pretend DoubleFloat
+
    sfy              ==> y pretend DoubleFloat
+
    airyAi x         == airyAi(sfx)$SFSFUN pretend %
+
    airyBi x         == airyBi(sfx)$SFSFUN pretend %
+
    besselI(x,y)     == besselI(sfx,sfy)$SFSFUN pretend %
+
    besselJ(x,y)     == besselJ(sfx,sfy)$SFSFUN pretend %
+
    besselK(x,y)     == besselK(sfx,sfy)$SFSFUN pretend %
+
    besselY(x,y)     == besselY(sfx,sfy)$SFSFUN pretend %
+
    Beta(x,y)        == Beta(sfx,sfy)$SFSFUN pretend %
+
    digamma x        == digamma(sfx)$SFSFUN pretend %
+
    Gamma x          == Gamma(sfx)$SFSFUN pretend %
--- not implemented in SFSFUN
---   Gamma(x,y)       == Gamma(sfx,sfy)$SFSFUN pretend %
+
    polygamma(x,y)   ==
        if (n := retractIfCan(x@%)@Union(Integer, "failed")) case Integer _
           and n >= 0
@@ -42873,9 +45768,13 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
        else error "polygamma: first argument should be a nonnegative integer"
 
    wholePart x            == TRUNCATE(x)$Lisp
+
    float(ma,ex,b)   == ma*(b::%)**ex
+
    convert(x:%):DoubleFloat == x pretend DoubleFloat
+
    convert(x:%):Float == convert(x pretend DoubleFloat)$Float
+
    rationalApproximation(x, d) == rationalApproximation(x, d, 10)
 
    atan(x,y) ==
@@ -42915,24 +45814,6 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
       two53:= base()**precision()
       [s*wholePart(two53 * me.man ),me.exp-precision()]
 
--- rationalApproximation(y,d,b) ==
---    this is the quotient remainder algorithm (requires wholePart operation)
---    x := y
---    if b < 2 then error "base must be > 1"
---    tol := (b::%)**d
---    p0,p1,q0,q1 : Integer
---    p0 := 0; p1 := 1; q0 := 1; q1 := 0
---    repeat
---       a := wholePart x
---       x := fractionPart x
---       p2 := p0+a*p1
---       q2 := q0+a*q1
---       if x = 0 or tol*abs(q2*y-(p2::%)) < abs(q2*y) then
---          return (p2/q2)
---       (p0,p1) := (p1,p2)
---       (q0,q1) := (q1,q2)
---       x := 1/x
-
    rationalApproximation(f,d,b) ==
       -- this algorithm expresses f as n / d where d = BASE ** k
       -- then all arithmetic operations are done over the integers
@@ -42958,9 +45839,7 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
          zero? r => error "0**0 is undefined"
          negative? r => error "division by 0"
          0
---      zero? r or one? x => 1
       zero? r or (x = 1) => 1
---      one?  r => x
       (r = 1) => x
       n := numer r
       d := denom r
@@ -42977,6 +45856,316 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath,
 \begin{chunk}{COQ DFLOAT}
 (* domain DFLOAT *)
 (*
+
+   format: String := "~G"
+
+   MER ==> Record(MANTISSA:Integer,EXPONENT:Integer)
+
+   manexp: % -> MER
+
+   doubleFloatFormat(s:String): String ==
+     ss: String := format
+     format := s
+     ss
+
+   OMwrite(x: %): String ==
+     s: String := ""
+     sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+     dev: OpenMathDevice := OMopenString(sp @ String, OMencodingXML)
+     OMputObject(dev)
+     OMputFloat(dev, convert x)
+     OMputEndObject(dev)
+     OMclose(dev)
+     s := OM_-STRINGPTRTOSTRING(sp)$Lisp @ String
+     s
+
+   OMwrite(x: %, wholeObj: Boolean): String ==
+     s: String := ""
+     sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+     dev: OpenMathDevice := OMopenString(sp @ String, OMencodingXML)
+     if wholeObj then
+       OMputObject(dev)
+     OMputFloat(dev, convert x)
+     if wholeObj then
+       OMputEndObject(dev)
+     OMclose(dev)
+     s := OM_-STRINGPTRTOSTRING(sp)$Lisp @ String
+     s
+
+   OMwrite(dev: OpenMathDevice, x: %): Void ==
+     OMputObject(dev)
+     OMputFloat(dev, convert x)
+     OMputEndObject(dev)
+
+   OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void ==
+     if wholeObj then
+       OMputObject(dev)
+     OMputFloat(dev, convert x)
+     if wholeObj then
+       OMputEndObject(dev)
+
+   checkComplex(x:%):% == C_-TO_-R(x)$Lisp
+   -- In AKCL we used to have to make the arguments to ASIN ACOS ACOSH ATANH
+   -- complex to get the correct behaviour.
+   --makeComplex(x: %):% == COMPLEX(x, 0$%)$Lisp
+
+   machineFraction(df:%):Fraction(Integer) ==
+     numer:Integer:=INTEGER_-DECODE_-FLOAT_-NUMERATOR(df)$Lisp
+     denom:Integer:=INTEGER_-DECODE_-FLOAT_-DENOMINATOR(df)$Lisp
+     sign:Integer:=INTEGER_-DECODE_-FLOAT_-SIGN(df)$Lisp
+     sign*numer/denom
+
+   integerDecode(df:%):List(Integer) ==
+     numer:Integer:=INTEGER_-DECODE_-FLOAT_-NUMERATOR(df)$Lisp
+     exp:Integer:=INTEGER_-DECODE_-FLOAT_-EXPONENT(df)$Lisp
+     sign:Integer:=INTEGER_-DECODE_-FLOAT_-SIGN(df)$Lisp
+     [numer,exp,sign]
+
+   base()           == FLOAT_-RADIX(0$%)$Lisp
+
+   mantissa x       == manexp(x).MANTISSA
+
+   exponent x       == manexp(x).EXPONENT
+
+   precision()      == FLOAT_-DIGITS(0$%)$Lisp
+
+   bits()           ==
+     base() = 2 => precision()
+     base() = 16 => 4*precision()
+     wholePart(precision()*log2(base()::%))::PositiveInteger
+
+   max()            == MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp
+
+   min()            == MOST_-NEGATIVE_-DOUBLE_-FLOAT$Lisp
+
+   order(a) == precision() + exponent a - 1
+
+   0                == FLOAT(0$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp
+
+   1                == FLOAT(1$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp
+   -- rational approximation to e accurate to 23 digits
+
+   exp1()  == FLOAT(534625820200,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp / _
+              FLOAT(196677847971,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp
+
+   pi()    == FLOAT(PI$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp
+
+   coerce(x:%):OutputForm == 
+     x >= 0 => message(FORMAT(NIL$Lisp,format,x)$Lisp @ String)
+     - (message(FORMAT(NIL$Lisp,format,-x)$Lisp @ String))
+
+   convert(x:%):InputForm == convert(x pretend DoubleFloat)$InputForm
+
+   x < y            == DFLESSTHAN(x,y)$Lisp
+
+   - x              == DFUNARYMINUS(x)$Lisp
+
+   x + y            == DFADD(x,y)$Lisp
+
+   x:% - y:%        == DFSUBTRACT(x,y)$Lisp
+
+   x:% * y:%        == DFMULTIPLY(x,y)$Lisp
+
+   i:Integer * x:%  == DFINTEGERMULTIPLY(i,x)$Lisp
+
+   max(x,y)         == DFMAX(x,y)$Lisp
+
+   min(x,y)         == DFMIN(x,y)$Lisp
+
+   x = y            == DFEQL(x,y)$Lisp
+
+   x:% / i:Integer  == DFINTEGERDIVIDE(x,i)$Lisp
+
+   sqrt x           == checkComplex DFSQRT(x)$Lisp
+
+   log10 x          == checkComplex DFLOG(x,10)$Lisp
+
+   x:% ** i:Integer == DFINTEGEREXPT(x,i)$Lisp
+
+   x:% ** y:%       == checkComplex DFEXPT(x,y)$Lisp
+
+   coerce(i:Integer):% == FLOAT(i,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp
+
+   exp x            == DFEXP(x)$Lisp
+
+   log x            == checkComplex DFLOGE(x)$Lisp
+
+   log2 x           == checkComplex DFLOG(x,2)$Lisp
+
+   sin x            == DFSIN(x)$Lisp
+
+   cos x            == DFCOS(x)$Lisp
+
+   tan x            == DFTAN(x)$Lisp
+
+   cot x            == COT(x)$Lisp
+
+   sec x            == SEC(x)$Lisp
+
+   csc x            == CSC(x)$Lisp
+
+   asin x           == checkComplex DFASIN(x)$Lisp -- can be complex
+
+   acos x           == checkComplex DFACOS(x)$Lisp -- can be complex
+
+   atan x           == DFATAN(x)$Lisp
+
+   acsc x           == checkComplex ACSC(x)$Lisp
+
+   acot x           == ACOT(x)$Lisp
+
+   asec x           == checkComplex ASEC(x)$Lisp
+
+   sinh x           == SINH(x)$Lisp
+
+   cosh x           == COSH(x)$Lisp
+
+   tanh x           == TANH(x)$Lisp
+
+   csch x           == CSCH(x)$Lisp
+
+   coth x           == COTH(x)$Lisp
+
+   sech x           == SECH(x)$Lisp
+
+   asinh x          == DFASINH(x)$Lisp
+
+   acosh x          == checkComplex DFACOSH(x)$Lisp -- can be complex
+
+   atanh x          == checkComplex DFATANH(x)$Lisp -- can be complex
+
+   acsch x          == ACSCH(x)$Lisp
+
+   acoth x          == checkComplex ACOTH(x)$Lisp
+
+   asech x          == checkComplex ASECH(x)$Lisp
+
+   x:% / y:%        == DFDIVIDE(x,y)$Lisp
+
+   negative? x      == DFMINUSP(x)$Lisp
+
+   zero? x          == ZEROP(x)$Lisp
+
+   hash x           == SXHASH(x)$Lisp
+
+   recip(x)         == (zero? x => "failed"; 1 / x)
+
+   differentiate x  == 0
+
+   SFSFUN           ==> DoubleFloatSpecialFunctions()
+
+   sfx              ==> x pretend DoubleFloat
+
+   sfy              ==> y pretend DoubleFloat
+
+   airyAi x         == airyAi(sfx)$SFSFUN pretend %
+
+   airyBi x         == airyBi(sfx)$SFSFUN pretend %
+
+   besselI(x,y)     == besselI(sfx,sfy)$SFSFUN pretend %
+
+   besselJ(x,y)     == besselJ(sfx,sfy)$SFSFUN pretend %
+
+   besselK(x,y)     == besselK(sfx,sfy)$SFSFUN pretend %
+
+   besselY(x,y)     == besselY(sfx,sfy)$SFSFUN pretend %
+
+   Beta(x,y)        == Beta(sfx,sfy)$SFSFUN pretend %
+
+   digamma x        == digamma(sfx)$SFSFUN pretend %
+
+   Gamma x          == Gamma(sfx)$SFSFUN pretend %
+
+   polygamma(x,y)   ==
+       if (n := retractIfCan(x@%)@Union(Integer, "failed")) case Integer _
+          and n >= 0
+       then polygamma(n::Integer::NonNegativeInteger,sfy)$SFSFUN pretend %
+       else error "polygamma: first argument should be a nonnegative integer"
+
+   wholePart x            == TRUNCATE(x)$Lisp
+
+   float(ma,ex,b)   == ma*(b::%)**ex
+
+   convert(x:%):DoubleFloat == x pretend DoubleFloat
+
+   convert(x:%):Float == convert(x pretend DoubleFloat)$Float
+
+   rationalApproximation(x, d) == rationalApproximation(x, d, 10)
+
+   atan(x,y) ==
+      x = 0 =>
+         y > 0 => pi()/2
+         y < 0 => -pi()/2
+         0
+      -- Only count on first quadrant being on principal branch.
+      theta := atan abs(y/x)
+      if x < 0 then theta := pi() - theta
+      if y < 0 then theta := - theta
+      theta
+
+   retract(x:%):Fraction(Integer) ==
+     rationalApproximation(x, (precision() - 1)::NonNegativeInteger, base())
+
+   retractIfCan(x:%):Union(Fraction Integer, "failed") ==
+     rationalApproximation(x, (precision() - 1)::NonNegativeInteger, base())
+
+   retract(x:%):Integer ==
+     x = ((n := wholePart x)::%) => n
+     error "Not an integer"
+
+   retractIfCan(x:%):Union(Integer, "failed") ==
+     x = ((n := wholePart x)::%) => n
+     "failed"
+
+   sign(x) == retract FLOAT_-SIGN(x,1)$Lisp
+
+   abs x   == FLOAT_-SIGN(1,x)$Lisp
+
+   manexp(x) ==
+      zero? x => [0,0]
+      s := sign x; x := abs x
+      if x > max()$% then return [s*mantissa(max())+1,exponent max()]
+      me:Record(man:%,exp:Integer) := MANEXP(x)$Lisp 
+      two53:= base()**precision()
+      [s*wholePart(two53 * me.man ),me.exp-precision()]
+
+   rationalApproximation(f,d,b) ==
+      -- this algorithm expresses f as n / d where d = BASE ** k
+      -- then all arithmetic operations are done over the integers
+      (nu, ex) := manexp f
+      BASE := base()
+      ex >= 0 => (nu * BASE ** (ex::NonNegativeInteger))::Fraction(Integer)
+      de :Integer := BASE**((-ex)::NonNegativeInteger)
+      b < 2 => error "base must be > 1"
+      tol := b**d
+      s := nu; t := de
+      p0:Integer := 0; p1:Integer := 1; q0:Integer := 1; q1:Integer := 0
+      repeat
+         (q,r) := divide(s, t)
+         p2 := q*p1+p0
+         q2 := q*q1+q0
+         r = 0 or tol*abs(nu*q2-de*p2) < de*abs(p2) => return(p2/q2)
+         (p0,p1) := (p1,p2)
+         (q0,q1) := (q1,q2)
+         (s,t) := (t,r)
+
+   x:% ** r:Fraction Integer ==
+      zero? x =>
+         zero? r => error "0**0 is undefined"
+         negative? r => error "division by 0"
+         0
+      zero? r or (x = 1) => 1
+      (r = 1) => x
+      n := numer r
+      d := denom r
+      negative? x =>
+         odd? d =>
+            odd? n => return -((-x)**r)
+            return ((-x)**r)
+         error "negative root"
+      d = 2 => sqrt(x) ** n
+      x ** (n::% / d::%)
+
 *)
 
 \end{chunk}
@@ -43283,24 +46472,37 @@ DoubleFloatMatrix : MatrixCategory(DoubleFloat,
   == add
 
     Qelt2 ==> DAREF2$Lisp
+
     Qsetelt2 ==> DSETAREF2$Lisp
+
     Qnrows ==> DANROWS$Lisp
+
     Qncols ==> DANCOLS$Lisp
+
     Qnew ==> MAKE_-DOUBLE_-MATRIX$Lisp
+
     Qnew1 ==> MAKE_-DOUBLE_-MATRIX1$Lisp
     
     minRowIndex x == 0
+
     minColIndex x == 0
+
     nrows x == Qnrows(x)
+
     ncols x == Qncols(x)
+
     maxRowIndex x == Qnrows(x) - 1
+
     maxColIndex x == Qncols(x) - 1
 
     qelt(m, i, j) == Qelt2(m, i, j)
+
     qsetelt_!(m, i, j, r) == Qsetelt2(m, i, j, r)
 
     empty() == Qnew(0$Integer, 0$Integer)
+
     qnew(rows, cols) == Qnew(rows, cols)
+
     new(rows, cols, a) == Qnew1(rows, cols, a)
 
 \end{chunk}
@@ -43308,6 +46510,41 @@ DoubleFloatMatrix : MatrixCategory(DoubleFloat,
 \begin{chunk}{COQ DFMAT}
 (* domain DFMAT *)
 (*
+
+    Qelt2 ==> DAREF2$Lisp
+
+    Qsetelt2 ==> DSETAREF2$Lisp
+
+    Qnrows ==> DANROWS$Lisp
+
+    Qncols ==> DANCOLS$Lisp
+
+    Qnew ==> MAKE_-DOUBLE_-MATRIX$Lisp
+
+    Qnew1 ==> MAKE_-DOUBLE_-MATRIX1$Lisp
+    
+    minRowIndex x == 0
+
+    minColIndex x == 0
+
+    nrows x == Qnrows(x)
+
+    ncols x == Qncols(x)
+
+    maxRowIndex x == Qnrows(x) - 1
+
+    maxColIndex x == Qncols(x) - 1
+
+    qelt(m, i, j) == Qelt2(m, i, j)
+
+    qsetelt_!(m, i, j, r) == Qsetelt2(m, i, j, r)
+
+    empty() == Qnew(0$Integer, 0$Integer)
+
+    qnew(rows, cols) == Qnew(rows, cols)
+
+    new(rows, cols, a) == Qnew1(rows, cols, a)
+
 *)
 
 \end{chunk}
@@ -43602,23 +46839,37 @@ DoubleFloatVector : VectorCategory DoubleFloat with
   == add
     
     Qelt1 ==> DELT$Lisp
+
     Qsetelt1 ==> DSETELT$Lisp
 
     qelt(x, i) == Qelt1(x, i)
+
     qsetelt_!(x, i, s) == Qsetelt1(x, i, s)
+
     Qsize ==> DLEN$Lisp
+
     Qnew ==> MAKE_-DOUBLE_-VECTOR$Lisp
+
     Qnew1 ==> MAKE_-DOUBLE_-VECTOR1$Lisp
 
     #x                          == Qsize x
+
     minIndex x                  == 0
+
     empty()                     == Qnew(0$Lisp)
+
     qnew(n)                     == Qnew(n)
+
     new(n, x)                   == Qnew1(n, x)
+
     qelt(x, i)                  == Qelt1(x, i)
+
     elt(x:%, i:Integer)         == Qelt1(x, i)
+
     qsetelt_!(x, i, s)          == Qsetelt1(x, i, s)
+
     setelt(x : %, i : Integer, s : DoubleFloat) == Qsetelt1(x, i, s)
+
     fill_!(x, s)       ==
         for i in 0..((Qsize(x)) - 1) repeat Qsetelt1(x, i, s)
         x
@@ -43628,6 +46879,43 @@ DoubleFloatVector : VectorCategory DoubleFloat with
 \begin{chunk}{COQ DFVEC}
 (* domain DFVEC *)
 (*
+    
+    Qelt1 ==> DELT$Lisp
+
+    Qsetelt1 ==> DSETELT$Lisp
+
+    qelt(x, i) == Qelt1(x, i)
+
+    qsetelt_!(x, i, s) == Qsetelt1(x, i, s)
+
+    Qsize ==> DLEN$Lisp
+
+    Qnew ==> MAKE_-DOUBLE_-VECTOR$Lisp
+
+    Qnew1 ==> MAKE_-DOUBLE_-VECTOR1$Lisp
+
+    #x                          == Qsize x
+
+    minIndex x                  == 0
+
+    empty()                     == Qnew(0$Lisp)
+
+    qnew(n)                     == Qnew(n)
+
+    new(n, x)                   == Qnew1(n, x)
+
+    qelt(x, i)                  == Qelt1(x, i)
+
+    elt(x:%, i:Integer)         == Qelt1(x, i)
+
+    qsetelt_!(x, i, s)          == Qsetelt1(x, i, s)
+
+    setelt(x : %, i : Integer, s : DoubleFloat) == Qsetelt1(x, i, s)
+
+    fill_!(x, s)       ==
+        for i in 0..((Qsize(x)) - 1) repeat Qsetelt1(x, i, s)
+        x
+
 *)
 
 \end{chunk}
@@ -43885,30 +47173,45 @@ DrawOption(): Exports == Implementation where
     ["viewpoint"::Symbol, vp::Any]
 
   title s == ["title"::Symbol, s::Any]
+
   style s == ["style"::Symbol, s::Any]
+
   toScale b == ["toScale"::Symbol, b::Any]
+
   clip(b:Boolean) == ["clipBoolean"::Symbol, b::Any]
+
   adaptive b == ["adaptive"::Symbol, b::Any]
 
   pointColor(x:Float) == ["pointColorFloat"::Symbol, x::Any]
+
   pointColor(c:PAL) == ["pointColorPalette"::Symbol, c::Any]
+
   curveColor(x:Float) == ["curveColorFloat"::Symbol, x::Any]
+
   curveColor(c:PAL) == ["curveColorPalette"::Symbol, c::Any]
+
   colorFunction(f:SF -> SF) == ["colorFunction1"::Symbol, f::Any]
+
   colorFunction(f:(SF,SF) -> SF) == ["colorFunction2"::Symbol, f::Any]
+
   colorFunction(f:(SF,SF,SF) -> SF) == ["colorFunction3"::Symbol, f::Any]
+
   clip(tup:List SEG) == 
     length tup > 3 =>
       error "clip: at most 3 segments may be specified"
     ["clipSegment"::Symbol, tup::Any]
+
   coordinates f == ["coordinates"::Symbol, f::Any]
+
   tubeRadius x == ["tubeRadius"::Symbol, x::Any]
+
   range(tup:List Segment Float) == 
     ((n := length tup) > 3) =>
       error "range: at most 3 segments may be specified"
     n < 2 =>
       error "range: at least 2 segments may be specified"
     ["rangeFloat"::Symbol, tup::Any]
+
   range(tup:List Segment Fraction Integer) == 
     ((n := lengthR tup) > 3) =>
       error "range: at most 3 segments may be specified"
@@ -43917,13 +47220,21 @@ DrawOption(): Exports == Implementation where
     ["rangeRat"::Symbol, tup::Any]
 
   ranges s               == ["ranges"::Symbol, s::Any]
+
   space s                == ["space"::Symbol, s::Any]
+
   var1Steps s            == ["var1Steps"::Symbol, s::Any]
+
   var2Steps s            == ["var2Steps"::Symbol, s::Any]
+
   tubePoints s           == ["tubePoints"::Symbol, s::Any]
+
   coord s                == ["coord"::Symbol, s::Any]
+
   unit s                 == ["unit"::Symbol, s::Any]
+
   coerce(x:%):OutputForm == x.keyword::OutputForm = x.value::OutputForm
+
   x:% = y:%              == x.keyword = y.keyword and x.value = y.value
 
   option?(l, s) ==
@@ -43941,6 +47252,117 @@ DrawOption(): Exports == Implementation where
 \begin{chunk}{COQ DROPT}
 (* domain DROPT *)
 (*
+  import AnyFunctions1(String)
+  import AnyFunctions1(Segment Float)
+  import AnyFunctions1(VIEWPT)
+  import AnyFunctions1(List Segment Float)
+  import AnyFunctions1(List Segment Fraction Integer)
+  import AnyFunctions1(List Integer)
+  import AnyFunctions1(PositiveInteger)
+  import AnyFunctions1(Boolean)
+  import AnyFunctions1(RANGE)
+  import AnyFunctions1(UNIT)
+  import AnyFunctions1(Float)
+  import AnyFunctions1(POINT -> POINT)
+  import AnyFunctions1(SF -> SF)
+  import AnyFunctions1((SF,SF) -> SF)
+  import AnyFunctions1((SF,SF,SF) -> SF)
+  import AnyFunctions1(POINT)
+  import AnyFunctions1(PAL)
+  import AnyFunctions1(SPACE3)
+
+  Rep := Record(keyword:Symbol, value:Any)
+
+  length:List SEG -> NonNegativeInteger
+  -- these lists will become tuples in a later version
+  length tup == # tup
+
+  lengthR:List Segment Fraction Integer -> NonNegativeInteger
+  -- these lists will become tuples in a later version
+  lengthR tup == # tup
+
+  lengthI:List Integer -> NonNegativeInteger
+  -- these lists will become tuples in a later version
+  lengthI tup == # tup
+
+  viewpoint vp == 
+    ["viewpoint"::Symbol, vp::Any]
+
+  title s == ["title"::Symbol, s::Any]
+
+  style s == ["style"::Symbol, s::Any]
+
+  toScale b == ["toScale"::Symbol, b::Any]
+
+  clip(b:Boolean) == ["clipBoolean"::Symbol, b::Any]
+
+  adaptive b == ["adaptive"::Symbol, b::Any]
+
+  pointColor(x:Float) == ["pointColorFloat"::Symbol, x::Any]
+
+  pointColor(c:PAL) == ["pointColorPalette"::Symbol, c::Any]
+
+  curveColor(x:Float) == ["curveColorFloat"::Symbol, x::Any]
+
+  curveColor(c:PAL) == ["curveColorPalette"::Symbol, c::Any]
+
+  colorFunction(f:SF -> SF) == ["colorFunction1"::Symbol, f::Any]
+
+  colorFunction(f:(SF,SF) -> SF) == ["colorFunction2"::Symbol, f::Any]
+
+  colorFunction(f:(SF,SF,SF) -> SF) == ["colorFunction3"::Symbol, f::Any]
+
+  clip(tup:List SEG) == 
+    length tup > 3 =>
+      error "clip: at most 3 segments may be specified"
+    ["clipSegment"::Symbol, tup::Any]
+
+  coordinates f == ["coordinates"::Symbol, f::Any]
+
+  tubeRadius x == ["tubeRadius"::Symbol, x::Any]
+
+  range(tup:List Segment Float) == 
+    ((n := length tup) > 3) =>
+      error "range: at most 3 segments may be specified"
+    n < 2 =>
+      error "range: at least 2 segments may be specified"
+    ["rangeFloat"::Symbol, tup::Any]
+
+  range(tup:List Segment Fraction Integer) == 
+    ((n := lengthR tup) > 3) =>
+      error "range: at most 3 segments may be specified"
+    n < 2 =>
+      error "range: at least 2 segments may be specified"
+    ["rangeRat"::Symbol, tup::Any]
+
+  ranges s               == ["ranges"::Symbol, s::Any]
+
+  space s                == ["space"::Symbol, s::Any]
+
+  var1Steps s            == ["var1Steps"::Symbol, s::Any]
+
+  var2Steps s            == ["var2Steps"::Symbol, s::Any]
+
+  tubePoints s           == ["tubePoints"::Symbol, s::Any]
+
+  coord s                == ["coord"::Symbol, s::Any]
+
+  unit s                 == ["unit"::Symbol, s::Any]
+
+  coerce(x:%):OutputForm == x.keyword::OutputForm = x.value::OutputForm
+
+  x:% = y:%              == x.keyword = y.keyword and x.value = y.value
+
+  option?(l, s) ==
+    for x in l repeat
+      x.keyword = s => return true
+    false
+
+  option(l, s) ==
+    for x in l repeat
+      x.keyword = s => return(x.value)
+    "failed"
+
 *)
 
 \end{chunk}
@@ -44071,6 +47493,43 @@ d01ajfAnnaType(): NumericalIntegrationCategory == Result add
 \begin{chunk}{COQ D01AJFA}
 (* domain D01AJFA *)
 (*
+  EF2   ==> ExpressionFunctions2
+  EDF   ==> Expression DoubleFloat
+  LDF   ==> List DoubleFloat
+  SDF   ==> Stream DoubleFloat
+  DF    ==> DoubleFloat
+  FI    ==> Fraction Integer
+  EFI   ==> Expression Fraction Integer
+  SOCDF ==> Segment OrderedCompletion DoubleFloat
+  NIA   ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF)
+  MDNIA ==> Record(fn:EDF,range:List SOCDF,abserr:DF,relerr:DF)
+  INT   ==> Integer
+  BOP   ==> BasicOperator
+  S     ==> Symbol
+  ST    ==> String
+  LST   ==> List String
+  RT    ==> RoutinesTable
+  Rep:=Result
+  import Rep, NagIntegrationPackage, d01AgentsPackage
+
+  measure(R:RT,args:NIA) ==
+    ext:Result := empty()$Result
+    pp:SDF := singularitiesOf(args)
+    not (empty?(pp)$SDF) =>
+      [0.1,"d01ajf: There is a possible problem at the following point(s): "
+           commaSeparate(sdf2lst(pp)) ,ext]
+    [getMeasure(R,d01ajf :: S)$RT,
+       "The general routine d01ajf is our default",ext]
+
+  numericalIntegration(args:NIA,hints:Result) ==
+    ArgsFn := map(x+->convert(x)$DF,args.fn)$EF2(DF,Float)
+    b:Float := getButtonValue("d01ajf","functionEvaluations")$AttributeButtons
+    fEvals:INT := wholePart exp(1.1513*(1.0/(2.0*(1.0-b))))
+    iw:INT := 75*fEvals
+    f : Union(fn:FileName,fp:Asp1(F)) := [retract(ArgsFn)$Asp1(F)]
+    d01ajf(getlo(args.range),gethi(args.range),args.abserr,_
+           args.relerr,4*iw,iw,-1,f)
+
 *)
 
 \end{chunk}
@@ -44206,6 +47665,48 @@ d01akfAnnaType(): NumericalIntegrationCategory == Result add
 \begin{chunk}{COQ D01AKFA}
 (* domain D01AKFA *)
 (*
+  EF2   ==> ExpressionFunctions2
+  EDF   ==> Expression DoubleFloat
+  LDF   ==> List DoubleFloat
+  SDF   ==> Stream DoubleFloat
+  DF    ==> DoubleFloat
+  FI    ==> Fraction Integer
+  EFI   ==> Expression Fraction Integer
+  SOCDF ==> Segment OrderedCompletion DoubleFloat
+  NIA   ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF)
+  MDNIA ==> Record(fn:EDF,range:List SOCDF,abserr:DF,relerr:DF)
+  INT   ==> Integer
+  BOP   ==> BasicOperator
+  S     ==> Symbol
+  ST    ==> String
+  LST   ==> List String
+  RT    ==> RoutinesTable
+  Rep:=Result
+  import Rep, d01AgentsPackage, NagIntegrationPackage
+
+  measure(R:RT,args:NIA) ==
+    ext:Result := empty()$Result
+    pp:SDF := singularitiesOf(args)
+    not (empty?(pp)$SDF) =>
+      [0.0,"d01akf: There is a possible problem at the following point(s): "
+              commaSeparate(sdf2lst(pp)) ,ext]
+    o:Float := functionIsOscillatory(args)
+    one := 1.0
+    m:Float := (getMeasure(R,d01akf@S)$RT)*(one-one/(one+sqrt(o)))**2
+    m > 0.8 => [m,"d01akf: The expression shows much oscillation",ext]
+    m > 0.6 => [m,"d01akf: The expression shows some oscillation",ext]
+    m > 0.5 => [m,"d01akf: The expression shows little oscillation",ext]
+    [m,"d01akf: The expression shows little or no oscillation",ext]
+
+  numericalIntegration(args:NIA,hints:Result) ==
+    ArgsFn := map(x+->convert(x)$DF,args.fn)$EF2(DF,Float)
+    b:Float := getButtonValue("d01akf","functionEvaluations")$AttributeButtons
+    fEvals:INT := wholePart exp(1.1513*(1.0/(2.0*(1.0-b))))
+    iw:INT := 75*fEvals
+    f : Union(fn:FileName,fp:Asp1(F)) := [retract(ArgsFn)$Asp1(F)]
+    d01akf(getlo(args.range),gethi(args.range),args.abserr,_
+           args.relerr,4*iw,iw,-1,f)
+
 *)
 
 \end{chunk}
@@ -44328,7 +47829,6 @@ d01alfAnnaType(): NumericalIntegrationCategory == Result add
       st:ST := "Recommended is d01alf with the singularities "
                      commaSeparate(listOfZeros)
       m := 
---        one?(numberOfZeros) => 0.4
         (numberOfZeros = 1) => 0.4
         getMeasure(R,d01alf@S)$RT
       [m, st, ext]
@@ -44353,6 +47853,59 @@ d01alfAnnaType(): NumericalIntegrationCategory == Result add
 \begin{chunk}{COQ D01ALFA}
 (* domain D01ALFA *)
 (*
+  EF2   ==> ExpressionFunctions2
+  EDF   ==> Expression DoubleFloat
+  LDF   ==> List DoubleFloat
+  SDF  ==> Stream DoubleFloat
+  DF  ==> DoubleFloat
+  FI  ==> Fraction Integer
+  EFI  ==> Expression Fraction Integer
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  NIA  ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF)
+  MDNIA  ==> Record(fn:EDF,range:List SOCDF,abserr:DF,relerr:DF)
+  INT  ==> Integer
+  BOP  ==> BasicOperator
+  S  ==> Symbol
+  ST  ==> String
+  LST  ==> List String
+  RT  ==> RoutinesTable
+  Rep:=Result
+  import Rep, d01AgentsPackage, NagIntegrationPackage
+
+  measure(R:RT,args:NIA) ==
+    ext:Result := empty()$Result
+    streamOfZeros:SDF := singularitiesOf(args)
+    listOfZeros:LST := removeDuplicates!(sdf2lst(streamOfZeros))
+    numberOfZeros:INT := # listOfZeros
+    (numberOfZeros > 15)@Boolean => 
+      [0.0,"d01alf: The list of singularities is too long", ext]
+    positive?(numberOfZeros) =>
+      l:LDF := entries(complete(streamOfZeros)$SDF)$SDF
+      lany:Any := coerce(l)$AnyFunctions1(LDF)
+      ex:Record(key:S,entry:Any) := [d01alfextra@S,lany]
+      ext := insert!(ex,ext)$Result
+      st:ST := "Recommended is d01alf with the singularities "
+                     commaSeparate(listOfZeros)
+      m := 
+        (numberOfZeros = 1) => 0.4
+        getMeasure(R,d01alf@S)$RT
+      [m, st, ext]
+    [0.0, "d01alf: A list of suitable singularities has not been found", ext]
+
+  numericalIntegration(args:NIA,hints:Result) ==
+    la:Any := coerce(search((d01alfextra@S),hints)$Result)@Any
+    listOfZeros:LDF := retract(la)$AnyFunctions1(LDF)
+    l:= removeDuplicates(listOfZeros)$LDF
+    n:Integer := (#(l))$List(DF)
+    M:Matrix DF := matrix([l])$(Matrix DF)
+    b:Float := getButtonValue("d01alf","functionEvaluations")$AttributeButtons
+    fEvals:INT := wholePart exp(1.1513*(1.0/(2.0*(1.0-b))))
+    iw:INT := 75*fEvals
+    ArgsFn := map(x+->convert(x)$DF,args.fn)$EF2(DF,Float)
+    f : Union(fn:FileName,fp:Asp1(F)) := [retract(ArgsFn)$Asp1(F)]
+    d01alf(getlo(args.range),gethi(args.range),n,M,_
+           args.abserr,args.relerr,2*n*iw,n*iw,-1,f)
+
 *)
 
 \end{chunk}
@@ -44497,6 +48050,56 @@ d01amfAnnaType(): NumericalIntegrationCategory == Result add
 \begin{chunk}{COQ D01AMFA}
 (* domain D01AMFA *)
 (*
+  EF2  ==> ExpressionFunctions2
+  EDF  ==> Expression DoubleFloat
+  LDF  ==> List DoubleFloat
+  SDF  ==> Stream DoubleFloat
+  DF  ==> DoubleFloat
+  FI  ==> Fraction Integer
+  EFI  ==> Expression Fraction Integer
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  NIA  ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF)
+  MDNIA  ==> Record(fn:EDF,range:List SOCDF,abserr:DF,relerr:DF)
+  INT  ==> Integer
+  BOP  ==> BasicOperator
+  S  ==> Symbol
+  ST  ==> String
+  LST  ==> List String
+  RT  ==> RoutinesTable
+  Rep:=Result
+  import Rep, d01AgentsPackage, NagIntegrationPackage
+
+  measure(R:RT,args:NIA) ==
+    ext:Result := empty()$Result
+    Range:=rangeIsFinite(args)
+    pp:SDF := singularitiesOf(args)
+    not (empty?(pp)$SDF) =>
+      [0.0,"d01amf: There is a possible problem at the following point(s): "
+                     commaSeparate(sdf2lst(pp)), ext]
+    [getMeasure(R,d01amf@S)$RT, "d01amf is a reasonable choice if the "
+         "integral is infinite or semi-infinite and d01transform cannot "
+           "do better than using general routines",ext]
+
+  numericalIntegration(args:NIA,hints:Result) ==
+    r:INT
+    bound:DF
+    ArgsFn := map(x+->convert(x)$DF,args.fn)$EF2(DF,Float)
+    b:Float := getButtonValue("d01amf","functionEvaluations")$AttributeButtons
+    fEvals:INT := wholePart exp(1.1513*(1.0/(2.0*(1.0-b))))
+    iw:INT := 150*fEvals
+    f : Union(fn:FileName,fp:Asp1(F)) := [retract(ArgsFn)$Asp1(F)]
+    Range:=rangeIsFinite(args)
+    if (Range case upperInfinite) then
+      bound := getlo(args.range)
+      r := 1
+    else if (Range case lowerInfinite) then
+      bound := gethi(args.range)
+      r := -1
+    else 
+      bound := 0$DF
+      r := 2
+    d01amf(bound,r,args.abserr,args.relerr,4*iw,iw,-1,f)
+
 *)
 
 \end{chunk}
@@ -44643,6 +48246,58 @@ d01anfAnnaType(): NumericalIntegrationCategory == Result add
 \begin{chunk}{COQ D01ANFA}
 (* domain D01ANFA *)
 (*
+  EF2  ==> ExpressionFunctions2
+  EDF  ==> Expression DoubleFloat
+  LDF  ==> List DoubleFloat
+  SDF  ==> Stream DoubleFloat
+  DF  ==> DoubleFloat
+  FI  ==> Fraction Integer
+  EFI  ==> Expression Fraction Integer
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  NIA  ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF)
+  MDNIA  ==> Record(fn:EDF,range:List SOCDF,abserr:DF,relerr:DF)
+  INT  ==> Integer
+  BOP  ==> BasicOperator
+  S  ==> Symbol
+  ST  ==> String
+  LST  ==> List String
+  RT  ==> RoutinesTable
+  Rep:=Result
+  import Rep, d01WeightsPackage, d01AgentsPackage, NagIntegrationPackage
+
+  measure(R:RT,args:NIA) ==
+    ext:Result := empty()$Result
+    weight:Union(Record(op:BOP,w:DF),"failed") :=
+      exprHasWeightCosWXorSinWX(args)
+    weight case "failed" => 
+      [0.0,"d01anf: A suitable weight has not been found", ext]
+    weight case Record(op:BOP,w:DF) =>
+      wany := coerce(weight)$AnyFunctions1(Record(op:BOP,w:DF))
+      ex:Record(key:S,entry:Any) := [d01anfextra@S,wany]
+      ext := insert!(ex,ext)$Result
+      ws:ST := string(name(weight.op)$BOP)$S "(" df2st(weight.w)
+                          string(args.var)$S ")"
+      [getMeasure(R,d01anf@S)$RT,
+        "d01anf: The expression has a suitable weight:- " ws, ext]
+    
+  numericalIntegration(args:NIA,hints:Result) ==
+    a:INT
+    r:Any := coerce(search((d01anfextra@S),hints)$Result)@Any
+    rec:Record(op:BOP,w:DF) := retract(r)$AnyFunctions1(Record(op:BOP,w:DF))
+    Var := args.var :: EDF
+    o:BOP := rec.op
+    den:EDF := o((rec.w*Var)$EDF)
+    Argsfn:EDF := args.fn/den
+    if (name(o) = cos@S)@Boolean then a := 1
+    else a := 2
+    b:Float := getButtonValue("d01anf","functionEvaluations")$AttributeButtons
+    fEvals:INT := wholePart exp(1.1513*(1.0/(2.0*(1.0-b))))
+    iw:INT := 75*fEvals
+    ArgsFn := map(x+->convert(x)$DF,Argsfn)$EF2(DF,Float)
+    f : Union(fn:FileName,fp:Asp1(G)) := [retract(ArgsFn)$Asp1(G)]
+    d01anf(getlo(args.range),gethi(args.range),rec.w,a,_
+           args.abserr,args.relerr,4*iw,iw,-1,f)
+
 *)
 
 \end{chunk}
@@ -44760,7 +48415,6 @@ d01apfAnnaType(): NumericalIntegrationCategory == Result add
       if  (a.1 > -1) then c := a.1
       if  (a.2 > -1) then d := a.2
     l:INT := exprHasLogarithmicWeights(args)
---    (zero? c) and (zero? d) and (one? l) =>
     (zero? c) and (zero? d) and (l = 1) =>
         [0.0,"d01apf: A suitable singularity has not been found", ext]
     out:LDF := [c,d,l :: DF]
@@ -44803,6 +48457,69 @@ d01apfAnnaType(): NumericalIntegrationCategory == Result add
 \begin{chunk}{COQ D01APFA}
 (* domain D01APFA *)
 (*
+  EF2  ==> ExpressionFunctions2
+  EDF  ==> Expression DoubleFloat
+  LDF  ==> List DoubleFloat
+  SDF  ==> Stream DoubleFloat
+  DF  ==> DoubleFloat
+  FI  ==> Fraction Integer
+  EFI  ==> Expression Fraction Integer
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  NIA  ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF)
+  MDNIA  ==> Record(fn:EDF,range:List SOCDF,abserr:DF,relerr:DF)
+  INT  ==> Integer
+  BOP  ==> BasicOperator
+  S  ==> Symbol
+  ST  ==> String
+  LST  ==> List String
+  RT  ==> RoutinesTable
+  Rep:=Result
+  import Rep, NagIntegrationPackage, d01AgentsPackage, d01WeightsPackage
+
+  measure(R:RT,args:NIA) ==
+    ext:Result := empty()$Result
+    d := (c := 0$DF)
+    if ((a := exprHasAlgebraicWeight(args)) case LDF) then
+      if  (a.1 > -1) then c := a.1
+      if  (a.2 > -1) then d := a.2
+    l:INT := exprHasLogarithmicWeights(args)
+    (zero? c) and (zero? d) and (l = 1) =>
+        [0.0,"d01apf: A suitable singularity has not been found", ext]
+    out:LDF := [c,d,l :: DF]
+    outany:Any := coerce(out)$AnyFunctions1(LDF)
+    ex:Record(key:S,entry:Any) := [d01apfextra@S,outany]
+    ext := insert!(ex,ext)$Result
+    st:ST :=  "Recommended is d01apf with c = " df2st(c) ", d = " 
+                            df2st(d) " and l = " string(l)$ST
+    [getMeasure(R,d01apf@S)$RT, st, ext]
+
+  numericalIntegration(args:NIA,hints:Result) ==
+
+    Var:EDF := coerce(args.var)$EDF
+    la:Any := coerce(search((d01apfextra@S),hints)$Result)@Any
+    list:LDF := retract(la)$AnyFunctions1(LDF)
+    Fac1:EDF := (Var - (getlo(args.range) :: EDF))$EDF
+    Fac2:EDF := ((gethi(args.range) :: EDF) - Var)$EDF
+    c := first(list)$LDF
+    d := second(list)$LDF
+    l := (retract(third(list)$LDF)@INT)$DF
+    thebiz:EDF := (Fac1**(c :: EDF))*(Fac2**(d :: EDF))
+    if l > 1 then
+      if l = 2 then
+        thebiz := thebiz*log(Fac1)
+      else if l = 3 then
+        thebiz := thebiz*log(Fac2)
+      else
+        thebiz := thebiz*log(Fac1)*log(Fac2)
+    Fn :=  (args.fn/thebiz)$EDF
+    ArgsFn := map(x+->convert(x)$DF,Fn)$EF2(DF,Float)
+    b:Float := getButtonValue("d01apf","functionEvaluations")$AttributeButtons
+    fEvals:INT := wholePart exp(1.1513*(1.0/(2.0*(1.0-b))))
+    iw:INT := 75*fEvals
+    f : Union(fn:FileName,fp:Asp1(G)) := [retract(ArgsFn)$Asp1(G)]
+    d01apf(getlo(args.range),gethi(args.range),c,d,l,_
+           args.abserr,args.relerr,4*iw,iw,-1,f)
+
 *)
 
 \end{chunk}
@@ -44915,7 +48632,6 @@ d01aqfAnnaType(): NumericalIntegrationCategory == Result add
   measure(R:RT,args:NIA) ==
     ext:Result := empty()$Result
     Den := denominator(args.fn)
---    one? Den =>
     (Den = 1) =>
       [0.0,"d01aqf: A suitable weight function has not been found", ext]
     listOfZeros:LDF := problemPoints(args.fn,args.var,args.range)
@@ -44956,6 +48672,63 @@ d01aqfAnnaType(): NumericalIntegrationCategory == Result add
 \begin{chunk}{COQ D01AQFA}
 (* domain D01AQFA *)
 (*
+  EF2  ==> ExpressionFunctions2
+  EDF  ==> Expression DoubleFloat
+  LDF  ==> List DoubleFloat
+  SDF  ==> Stream DoubleFloat
+  DF  ==> DoubleFloat
+  FI  ==> Fraction Integer
+  EFI  ==> Expression Fraction Integer
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  NIA  ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF)
+  MDNIA  ==> Record(fn:EDF,range:List SOCDF,abserr:DF,relerr:DF)
+  INT  ==> Integer
+  BOP  ==> BasicOperator
+  S  ==> Symbol
+  ST  ==> String
+  LST  ==> List String
+  RT  ==> RoutinesTable
+  Rep:=Result
+  import Rep, d01AgentsPackage, NagIntegrationPackage
+
+  measure(R:RT,args:NIA) ==
+    ext:Result := empty()$Result
+    Den := denominator(args.fn)
+    (Den = 1) =>
+      [0.0,"d01aqf: A suitable weight function has not been found", ext]
+    listOfZeros:LDF := problemPoints(args.fn,args.var,args.range)
+    numberOfZeros := (#(listOfZeros))$LDF
+    zero?(numberOfZeros) =>
+      [0.0,"d01aqf: A suitable weight function has not been found", ext]
+    numberOfZeros = 1 =>
+      s:SDF := singularitiesOf(args)
+      more?(s,1)$SDF => 
+        [0.0,"d01aqf: Too many singularities have been found", ext]
+      cFloat:Float := (convert(first(listOfZeros)$LDF)@Float)$DF
+      cString:ST := (convert(cFloat)@ST)$Float
+      lany:Any := coerce(listOfZeros)$AnyFunctions1(LDF)
+      ex:Record(key:S,entry:Any) := [d01aqfextra@S,lany]
+      ext := insert!(ex,ext)$Result
+      [getMeasure(R,d01aqf@S)$RT, "Recommended is d01aqf with the "
+        "hilbertian weight function of 1/(x-c) where c = " cString, ext]
+    [0.0,"d01aqf: More than one factor has been found and so does not "
+                "have a suitable weight function",ext]
+
+  numericalIntegration(args:NIA,hints:Result) ==
+    Args := copy args
+    ca:Any :=  coerce(search((d01aqfextra@S),hints)$Result)@Any
+    c:DF := first(retract(ca)$AnyFunctions1(LDF))$LDF
+    ci:FI := df2fi(c)$ExpertSystemToolsPackage
+    Var:EFI := Args.var :: EFI
+    Gx:EFI := (Var-(ci::EFI))*(edf2efi(Args.fn)$ExpertSystemToolsPackage)
+    ArgsFn := map(x+->convert(x)$FI,Gx)$EF2(FI,Float)
+    b:Float := getButtonValue("d01aqf","functionEvaluations")$AttributeButtons
+    fEvals:INT := wholePart exp(1.1513*(1.0/(2.0*(1.0-b))))
+    iw:INT := 75*fEvals
+    f : Union(fn:FileName,fp:Asp1(G)) := [retract(ArgsFn)$Asp1(G)]
+    d01aqf(getlo(Args.range),gethi(Args.range),c,_
+           Args.abserr,Args.relerr,4*iw,iw,-1,f)
+
 *)
 
 \end{chunk}
@@ -45110,6 +48883,63 @@ d01asfAnnaType(): NumericalIntegrationCategory == Result add
 \begin{chunk}{COQ D01ASFA}
 (* domain D01ASFA *)
 (*
+  EF2  ==> ExpressionFunctions2
+  EDF  ==> Expression DoubleFloat
+  LDF  ==> List DoubleFloat
+  SDF  ==> Stream DoubleFloat
+  DF  ==> DoubleFloat
+  FI  ==> Fraction Integer
+  EFI  ==> Expression Fraction Integer
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  NIA  ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF)
+  MDNIA  ==> Record(fn:EDF,range:List SOCDF,abserr:DF,relerr:DF)
+  INT  ==> Integer
+  BOP  ==> BasicOperator
+  S  ==> Symbol
+  ST  ==> String
+  LST  ==> List String
+  RT  ==> RoutinesTable
+  Rep:=Result
+  import Rep, d01WeightsPackage, d01AgentsPackage, NagIntegrationPackage
+
+  measure(R:RT,args:NIA) ==
+    ext:Result := empty()$Result
+    Range := rangeIsFinite(args)
+    not(Range case upperInfinite) =>
+      [0.0,"d01asf is not a suitable routine for infinite integrals",ext]
+    weight: Union(Record(op:BOP,w:DF),"failed") :=
+      exprHasWeightCosWXorSinWX(args)
+    weight case "failed" => 
+      [0.0,"d01asf: A suitable weight has not been found", ext]
+    weight case Record(op:BOP,w:DF) =>
+      wany := coerce(weight)$AnyFunctions1(Record(op:BOP,w:DF))
+      ex:Record(key:S,entry:Any) := [d01asfextra@S,wany]
+      ext := insert!(ex,ext)$Result
+      ws:ST := string(name(weight.op)$BOP)$S "(" df2st(weight.w)
+                          string(args.var)$S ")"
+      [getMeasure(R,d01asf@S)$RT,
+        "d01asf: A suitable weight has been found:- " ws, ext]
+    
+  numericalIntegration(args:NIA,hints:Result) ==
+    i:INT
+    r:Any := coerce(search((d01asfextra@S),hints)$Result)@Any
+    rec:Record(op:BOP,w:DF) := retract(r)$AnyFunctions1(Record(op:BOP,w:DF))
+    Var := args.var :: EDF
+    o:BOP := rec.op
+    den:EDF := o((rec.w*Var)$EDF)
+    Argsfn:EDF := args.fn/den
+    if (name(o) = cos@S)@Boolean then i := 1
+    else i := 2
+    b:Float := getButtonValue("d01asf","functionEvaluations")$AttributeButtons
+    fEvals:INT := wholePart exp(1.1513*(1.0/(2.0*(1.0-b))))
+    iw:INT := 75*fEvals
+    ArgsFn := map(x +-> convert(x)$DF,Argsfn)$EF2(DF,Float)
+    f : Union(fn:FileName,fp:Asp1(G)) := [retract(ArgsFn)$Asp1(G)]
+    err :=
+      positive?(args.abserr) => args.abserr
+      args.relerr
+    d01asf(getlo(args.range),rec.w,i,err,50,4*iw,2*iw,-1,f)
+
 *)
 
 \end{chunk}
@@ -45252,6 +49082,54 @@ d01fcfAnnaType(): NumericalIntegrationCategory == Result add
 \begin{chunk}{COQ D01FCFA}
 (* domain D01FCFA *)
 (*
+  EF2  ==> ExpressionFunctions2
+  EDF  ==> Expression DoubleFloat
+  LDF  ==> List DoubleFloat
+  SDF  ==> Stream DoubleFloat
+  DF  ==> DoubleFloat
+  FI  ==> Fraction Integer
+  EFI  ==> Expression Fraction Integer
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  NIA  ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF)
+  MDNIA  ==> Record(fn:EDF,range:List SOCDF,abserr:DF,relerr:DF)
+  INT  ==> Integer
+  BOP  ==> BasicOperator
+  S  ==> Symbol
+  ST  ==> String
+  LST  ==> List String
+  RT  ==> RoutinesTable
+  Rep:=Result
+  import Rep, d01AgentsPackage, NagIntegrationPackage
+
+  measure(R:RT,args:MDNIA) ==
+    ext:Result := empty()$Result
+    segs := args.range
+    vars := variables(args.fn)$EDF
+    for i in 1..# vars repeat
+      nia:NIA := [vars.i,args.fn,segs.i,args.abserr,args.relerr]
+      not rangeIsFinite(nia) case finite => return
+        [0.0,"d01fcf is not a suitable routine for infinite integrals",ext]
+    [getMeasure(R,d01fcf@S)$RT, "Recommended is d01fcf", ext]
+
+  numericalIntegration(args:MDNIA,hints:Result) ==
+    import Integer
+    segs := args.range
+    dim := # segs
+    err := args.relerr
+    low:Matrix DF := matrix([[getlo(segs.i) for i in 1..dim]])$(Matrix DF)
+    high:Matrix DF := matrix([[gethi(segs.i) for i in 1..dim]])$(Matrix DF)
+    b:Float := getButtonValue("d01fcf","functionEvaluations")$AttributeButtons
+    a:Float:= exp(1.1513*(1.0/(2.0*(1.0-b))))
+    alpha:INT := 2**dim+2*dim**2+2*dim+1
+    d:Float := max(1.e-3,nthRoot(convert(err)@Float,4))$Float
+    minpts:INT := (fEvals := wholePart(a))*wholePart(alpha::Float/d)
+    maxpts:INT := 5*minpts
+    lenwrk:INT := (dim+2)*(1+(33*fEvals))
+    ArgsFn := map(x+->convert(x)$DF,args.fn)$EF2(DF,Float)
+    f : Union(fn:FileName,fp:Asp4(FUNCTN)) := [retract(ArgsFn)$Asp4(FUNCTN)]
+    out:Result := d01fcf(dim,low,high,maxpts,err,lenwrk,minpts,-1,f)
+    changeName(finval@Symbol,result@Symbol,out)
+
 *)
 
 \end{chunk}
@@ -45396,6 +49274,56 @@ d01gbfAnnaType(): NumericalIntegrationCategory == Result add
 \begin{chunk}{COQ D01GBFA}
 (* domain D01GBFA *)
 (*
+  EF2  ==> ExpressionFunctions2
+  EDF  ==> Expression DoubleFloat
+  LDF  ==> List DoubleFloat
+  SDF  ==> Stream DoubleFloat
+  DF  ==> DoubleFloat
+  FI  ==> Fraction Integer
+  EFI  ==> Expression Fraction Integer
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  NIA  ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF)
+  MDNIA  ==> Record(fn:EDF,range:List SOCDF,abserr:DF,relerr:DF)
+  INT  ==> Integer
+  BOP  ==> BasicOperator
+  S  ==> Symbol
+  ST  ==> String
+  LST  ==> List String
+  RT  ==> RoutinesTable
+  Rep:=Result
+  import Rep, d01AgentsPackage, NagIntegrationPackage
+
+  measure(R:RT,args:MDNIA) ==
+    ext:Result := empty()$Result
+    (rel := args.relerr) < 0.01 :: DF => 
+      [0.1, "d01gbf: The relative error requirement is too small",ext]
+    segs := args.range
+    vars := variables(args.fn)$EDF
+    for i in 1..# vars repeat
+      nia:NIA := [vars.i,args.fn,segs.i,args.abserr,rel]
+      not rangeIsFinite(nia) case finite => return
+        [0.0,"d01gbf is not a suitable routine for infinite integrals",ext]
+    [getMeasure(R,d01gbf@S)$RT, "Recommended is d01gbf", ext]
+
+  numericalIntegration(args:MDNIA,hints:Result) ==
+    import Integer
+    segs := args.range
+    dim:INT := # segs
+    low:Matrix DF := matrix([[getlo(segs.i) for i in 1..dim]])$(Matrix DF)
+    high:Matrix DF := matrix([[gethi(segs.i) for i in 1..dim]])$(Matrix DF)
+    b:Float := getButtonValue("d01gbf","functionEvaluations")$AttributeButtons
+    a:Float:= exp(1.1513*(1.0/(2.0*(1.0-b))))
+    maxcls:INT := 1500*(dim+1)*(fEvals:INT := wholePart(a))
+    mincls:INT := 300*fEvals
+    c:Float := nthRoot((maxcls::Float)/4.0,dim)$Float
+    lenwrk:INT := 3*dim*(d:INT := wholePart(c))+10*dim
+    wrkstr:Matrix DF := matrix([[0$DF for i in 1..lenwrk]])$(Matrix DF)
+    ArgsFn := map(x+->convert(x)$DF,args.fn)$EF2(DF,Float)
+    f : Union(fn:FileName,fp:Asp4(FUNCTN)) := [retract(ArgsFn)$Asp4(FUNCTN)]
+    out:Result := _
+       d01gbf(dim,low,high,maxcls,args.relerr,lenwrk,mincls,wrkstr,-1,f)
+    changeName(finest@Symbol,result@Symbol,out)
+
 *)
 
 \end{chunk}
@@ -45632,6 +49560,128 @@ d01TransformFunctionType():NumericalIntegrationCategory == Result add
 \begin{chunk}{COQ D01TRNS}
 (* domain D01TRNS *)
 (*
+  Rep:=Result
+  import d01AgentsPackage,Rep
+
+  rec2any(re:Record(str:ST,fn:EDF,range:SOCDF)):Any ==
+    coerce(re)$AnyFunctions1(Record(str:ST,fn:EDF,range:SOCDF))
+
+  changeName(ans:Result,name:ST):Result ==
+    sy:S := coerce(name "Answer")$S
+    anyAns:Any := coerce(ans)$AnyFunctions1(Result)
+    construct([[sy,anyAns]])$Result
+
+  getIntegral(args:NIA,hint:HINT) : Result ==
+   Args := copy args
+   Args.fn := hint.fn
+   Args.range := hint.range
+   integrate(Args::NumericalIntegrationProblem)$AnnaNumericalIntegrationPackage
+
+  transformFunction(args:NIA) : NIA ==
+    Args := copy args    
+    Var := Args.var :: EFI                 -- coerce Symbol to EFI
+    NewVar:EFI := inv(Var)$EFI             -- invert it
+    VarEqn:EEFI:=equation(Var,NewVar)$EEFI -- turn it into an equation
+    Afn:EFI := edf2efi(Args.fn)$ExpertSystemToolsPackage
+    Afn := subst(Afn,VarEqn)$EFI           -- substitute into function
+    Var2:EFI := Var**2
+    Afn:= simplify(Afn/Var2)$TranscendentalManipulations(FI,EFI)
+    Args.fn:= map(x+->convert(x)$FI,Afn)$EF2(FI,DF)
+    Args
+
+  doit(seg:SOCDF,args:NIA):MS ==
+    Args := copy args
+    Args.range := seg
+    measure(Args::NumericalIntegrationProblem)$AnnaNumericalIntegrationPackage
+
+  transform(c:Boolean,args:NIA):Measure ==
+    if c then
+      l := coerce(recip(lo(args.range)))@OCDF
+      Seg:SOCDF := segment(0$OCDF,l)
+    else
+      h := coerce(recip(hi(args.range)))@OCDF
+      Seg:SOCDF := segment(h,0$OCDF)
+    Args := transformFunction(args)
+    m:MS := doit(Seg,Args)
+    out1:ST := 
+       "The recommendation is to transform the function and use " m.name
+    out2:List(HINT) := [[m.name,Args.fn,Seg,m.extra]]
+    out2Any:Any := coerce(out2)$AnyFunctions1(List(HINT))
+    ex:Record(key:S,entry:Any) := [d01transformextra@S,out2Any]
+    extr:Result := construct([ex])$Result
+    [m.measure,out1,extr]
+      
+  split(c:PI,args:NIA):Measure ==
+    Args := copy args
+    Args.relerr := Args.relerr/2
+    Args.abserr := Args.abserr/2
+    if (c = 1)@Boolean then 
+      seg1:SOCDF := segment(-1$OCDF,1$OCDF)
+    else if (c = 2)@Boolean then
+      seg1 := segment(lo(Args.range),1$OCDF)
+    else
+      seg1 := segment(-1$OCDF,hi(Args.range))
+    m1:MS := doit(seg1,Args)
+    Args := transformFunction Args
+    if (c = 2)@Boolean then
+      seg2:SOCDF := segment(0$OCDF,1$OCDF)
+    else if (c = 3)@Boolean then
+      seg2 := segment(-1$OCDF,0$OCDF)
+    else seg2 := seg1
+    m2:MS := doit(seg2,Args)
+    m1m:F := m1.measure
+    m2m:F := m2.measure
+    m:F := m1m*m2m/((m1m*m2m)+(1.0-m1m)*(1.0-m2m))
+    out1:ST := "The recommendation is to transform the function and use "
+                               m1.name " and " m2.name
+    out2:List(HINT) :=
+             [[m1.name,args.fn,seg1,m1.extra],[m2.name,Args.fn,seg2,m2.extra]]
+    out2Any:Any := coerce(out2)$AnyFunctions1(List(HINT))
+    ex:Record(key:S,entry:Any) := [d01transformextra@S,out2Any]
+    extr:Result := construct([ex])$Result
+    [m,out1,extr]
+
+  measure(R:RoutinesTable,args:NIA) ==
+    Range:=rangeIsFinite(args)
+    Range case bothInfinite => split(1,args)
+    Range case upperInfinite =>
+      positive?(lo(args.range))$OCDF =>
+        transform(true,args)
+      split(2,args)
+    Range case lowerInfinite =>
+      negative?(hi(args.range))$OCDF =>
+        transform(false,args)
+      split(3,args)
+
+  numericalIntegration(args:NIA,hints:Result) ==
+    mainResult:DF := mainAbserr:DF := 0$DF
+    ans:Result := empty()$Result
+    hla:Any := coerce(search((d01transformextra@S),hints)$Result)@Any
+    hintList := retract(hla)$AnyFunctions1(List(HINT))
+    methodName:ST := empty()$ST
+    repeat
+      if (empty?(hintList)$(List(HINT))) 
+        then leave
+      item := first(hintList)$List(HINT)
+      a:Result := getIntegral(args,item)
+      anyRes := coerce(search((result@S),a)$Result)@Any
+      midResult := retract(anyRes)$AnyFunctions1(DF)
+      anyErr := coerce(search((abserr pretend S),a)$Result)@Any
+      midAbserr := retract(anyErr)$AnyFunctions1(DF)
+      mainResult := mainResult+midResult
+      mainAbserr := mainAbserr+midAbserr
+      if (methodName = item.str)@Boolean then
+        methodName := concat([item.str,"1"])$ST
+      else
+        methodName := item.str
+      ans := concat(ans,changeName(a,methodName))$ExpertSystemToolsPackage
+      hintList := rest(hintList)$(List(HINT))
+    anyResult := coerce(mainResult)$AnyFunctions1(DF)
+    anyAbserr := coerce(mainAbserr)$AnyFunctions1(DF)
+    recResult:Record(key:S,entry:Any):=[result@S,anyResult]
+    recAbserr:Record(key:S,entry:Any):=[abserr pretend S,anyAbserr]
+    insert!(recAbserr,insert!(recResult,ans))$Result
+ 
 *)
 
 \end{chunk}
@@ -45799,6 +49849,79 @@ d02bbfAnnaType():OrdinaryDifferentialEquationsSolverCategory == Result add
 \begin{chunk}{COQ D02BBFA}
 (* domain D02BBFA *)
 (*
+  -- Runge Kutta
+
+  EDF  ==> Expression DoubleFloat
+  LDF  ==> List DoubleFloat
+  MDF  ==> Matrix DoubleFloat
+  DF  ==> DoubleFloat
+  F  ==> Float
+  FI  ==> Fraction Integer
+  EFI  ==> Expression Fraction Integer
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  VEDF  ==> Vector Expression DoubleFloat
+  VEF  ==> Vector Expression Float
+  EF  ==> Expression Float
+  VDF  ==> Vector DoubleFloat
+  VMF  ==> Vector MachineFloat
+  MF  ==> MachineFloat
+  ODEA  ==> Record(xinit:DF,xend:DF,fn:VEDF,yinit:LDF,intvals:LDF,_
+                      g:EDF,abserr:DF,relerr:DF)
+  RSS  ==> Record(stiffnessFactor:F,stabilityFactor:F)
+  INT  ==> Integer
+  EF2  ==> ExpressionFunctions2
+
+  import d02AgentsPackage, NagOrdinaryDifferentialEquationsPackage
+  import AttributeButtons
+
+  accuracyCF(ode:ODEA):F ==
+    b := getButtonValue("d02bbf","accuracy")$AttributeButtons
+    accuracyIntensityValue := combineFeatureCompatibility(b,accuracyIF(ode))
+    accuracyIntensityValue > 0.999 => 0$F
+    0.8*exp(-((10*accuracyIntensityValue)**3)$F/266)$F
+
+  stiffnessCF(stiffnessIntensityValue:F):F ==
+    b := getButtonValue("d02bbf","stiffness")$AttributeButtons
+    0.5*exp(-(2*combineFeatureCompatibility(b,stiffnessIntensityValue))**2)$F
+
+  stabilityCF(stabilityIntensityValue:F):F ==
+    b := getButtonValue("d02bbf","stability")$AttributeButtons
+    0.5 * cos(combineFeatureCompatibility(b,stabilityIntensityValue))$F
+
+  expenseOfEvaluationCF(ode:ODEA):F ==
+    b := getButtonValue("d02bbf","expense")$AttributeButtons
+    expenseOfEvaluationIntensityValue := 
+      combineFeatureCompatibility(b,expenseOfEvaluationIF(ode))
+    0.35+0.2*exp(-(2.0*expenseOfEvaluationIntensityValue)**3)$F
+    
+  measure(R:RoutinesTable,args:ODEA) ==
+    m := getMeasure(R,d02bbf :: Symbol)$RoutinesTable
+    ssf := stiffnessAndStabilityOfODEIF args
+    m := combineFeatureCompatibility(m,[accuracyCF(args),
+            stiffnessCF(ssf.stiffnessFactor),
+              expenseOfEvaluationCF(args),
+                stabilityCF(ssf.stabilityFactor)])
+    [m,"Runge-Kutta Merson method"]
+
+  ODESolve(ode:ODEA) ==
+    i:LDF := ode.intvals
+    M := inc(# i)$INT
+    irelab := 0$INT
+    if positive?(a := ode.abserr) then 
+      inc(irelab)$INT
+    if positive?(r := ode.relerr) then
+      inc(irelab)$INT
+    if positive?(a+r) then
+      tol:DF := a + r
+    else
+      tol := float(1,-4,10)$DF
+    asp7:Union(fn:FileName,fp:Asp7(FCN)) :=
+      [retract(vedf2vef(ode.fn)$ExpertSystemToolsPackage)$Asp7(FCN)]
+    asp8:Union(fn:FileName,fp:Asp8(OUTPUT)) := 
+      [coerce(ldf2vmf(i)$ExpertSystemToolsPackage)$Asp8(OUTPUT)]
+    d02bbf(ode.xend,M,# ode.fn,irelab,ode.xinit,matrix([ode.yinit])$MDF,
+             tol,-1,asp7,asp8)
+
 *)
 
 \end{chunk}
@@ -45963,6 +50086,76 @@ d02bhfAnnaType():OrdinaryDifferentialEquationsSolverCategory == Result add
 \begin{chunk}{COQ D02BHFA}
 (* domain D02BHFA *)
 (*
+  -- Runge Kutta
+  EDF  ==> Expression DoubleFloat
+  LDF  ==> List DoubleFloat
+  MDF  ==> Matrix DoubleFloat
+  DF  ==> DoubleFloat
+  F  ==> Float
+  FI  ==> Fraction Integer
+  EFI  ==> Expression Fraction Integer
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  VEDF  ==> Vector Expression DoubleFloat
+  VEF  ==> Vector Expression Float
+  EF  ==> Expression Float
+  VDF  ==> Vector DoubleFloat
+  VMF  ==> Vector MachineFloat
+  MF  ==> MachineFloat
+  ODEA  ==> Record(xinit:DF,xend:DF,fn:VEDF,yinit:LDF,intvals:LDF,_
+                      g:EDF,abserr:DF,relerr:DF)
+  RSS  ==> Record(stiffnessFactor:F,stabilityFactor:F)
+  INT  ==> Integer
+  EF2  ==> ExpressionFunctions2
+
+  import d02AgentsPackage, NagOrdinaryDifferentialEquationsPackage
+  import AttributeButtons
+
+  accuracyCF(ode:ODEA):F ==
+    b := getButtonValue("d02bhf","accuracy")$AttributeButtons
+    accuracyIntensityValue := combineFeatureCompatibility(b,accuracyIF(ode))
+    accuracyIntensityValue > 0.999 => 0$F
+    0.8*exp(-((10*accuracyIntensityValue)**3)$F/266)$F
+
+  stiffnessCF(stiffnessIntensityValue:F):F ==
+    b := getButtonValue("d02bhf","stiffness")$AttributeButtons
+    0.5*exp(-(2*combineFeatureCompatibility(b,stiffnessIntensityValue))**2)$F
+
+  stabilityCF(stabilityIntensityValue:F):F ==
+    b := getButtonValue("d02bhf","stability")$AttributeButtons
+    0.5 * cos(combineFeatureCompatibility(b,stabilityIntensityValue))$F
+
+  expenseOfEvaluationCF(ode:ODEA):F ==
+    b := getButtonValue("d02bhf","expense")$AttributeButtons
+    expenseOfEvaluationIntensityValue := 
+      combineFeatureCompatibility(b,expenseOfEvaluationIF(ode))
+    0.35+0.2*exp(-(2.0*expenseOfEvaluationIntensityValue)**3)$F
+    
+  measure(R:RoutinesTable,args:ODEA) ==
+    m := getMeasure(R,d02bhf :: Symbol)$RoutinesTable
+    ssf := stiffnessAndStabilityOfODEIF args
+    m := combineFeatureCompatibility(m,[accuracyCF(args),
+            stiffnessCF(ssf.stiffnessFactor),
+              expenseOfEvaluationCF(args),
+                stabilityCF(ssf.stabilityFactor)])
+    [m,"Runge-Kutta Merson method"]
+
+  ODESolve(ode:ODEA) ==
+    irelab := 0$INT
+    if positive?(a := ode.abserr) then 
+      inc(irelab)$INT
+    if positive?(r := ode.relerr) then
+      inc(irelab)$INT
+    if positive?(a+r) then
+      tol := max(a,r)$DF
+    else
+      tol:DF := float(1,-4,10)$DF
+    asp7:Union(fn:FileName,fp:Asp7(FCN)) := 
+      [retract(e:VEF := vedf2vef(ode.fn)$ExpertSystemToolsPackage)$Asp7(FCN)]
+    asp9:Union(fn:FileName,fp:Asp9(G)) := 
+      [retract(edf2ef(ode.g)$ExpertSystemToolsPackage)$Asp9(G)]
+    d02bhf(ode.xend,# e,irelab,0$DF,ode.xinit,matrix([ode.yinit])$MDF,
+             tol,-1,asp9,asp7)
+
 *)
 
 \end{chunk}
@@ -46120,6 +50313,69 @@ d02cjfAnnaType():OrdinaryDifferentialEquationsSolverCategory == Result add
 \begin{chunk}{COQ D02CJFA}
 (* domain D02CJFA *)
 (*
+  -- Adams
+  EDF  ==> Expression DoubleFloat
+  LDF  ==> List DoubleFloat
+  MDF  ==> Matrix DoubleFloat
+  DF  ==> DoubleFloat
+  F  ==> Float
+  FI  ==> Fraction Integer
+  EFI  ==> Expression Fraction Integer
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  VEDF  ==> Vector Expression DoubleFloat
+  VEF  ==> Vector Expression Float
+  EF  ==> Expression Float
+  VDF  ==> Vector DoubleFloat
+  VMF  ==> Vector MachineFloat
+  MF  ==> MachineFloat
+  ODEA  ==> Record(xinit:DF,xend:DF,fn:VEDF,yinit:LDF,intvals:LDF,_
+                      g:EDF,abserr:DF,relerr:DF)
+  RSS  ==> Record(stiffnessFactor:F,stabilityFactor:F)
+  INT  ==> Integer
+  EF2  ==> ExpressionFunctions2
+
+  import d02AgentsPackage, NagOrdinaryDifferentialEquationsPackage
+
+  accuracyCF(ode:ODEA):F ==
+    b := getButtonValue("d02cjf","accuracy")$AttributeButtons
+    accuracyIntensityValue := combineFeatureCompatibility(b,accuracyIF(ode))
+    accuracyIntensityValue > 0.9999 => 0$F
+    0.6*(cos(accuracyIntensityValue*(pi()$F)/2)$F)**0.755
+
+  stiffnessCF(ode:ODEA):F ==
+    b := getButtonValue("d02cjf","stiffness")$AttributeButtons
+    ssf := stiffnessAndStabilityOfODEIF ode
+    stiffnessIntensityValue := 
+      combineFeatureCompatibility(b,ssf.stiffnessFactor)
+    0.5*exp(-(1.1*stiffnessIntensityValue)**3)$F
+
+  measure(R:RoutinesTable,args:ODEA) ==
+    m := getMeasure(R,d02cjf :: Symbol)$RoutinesTable
+    m := combineFeatureCompatibility(m,[accuracyCF(args), stiffnessCF(args)])
+    [m,"Adams method"]
+
+  ODESolve(ode:ODEA) ==
+    i:LDF := ode.intvals
+    if empty?(i) then
+      i := [ode.xend]
+    M := inc(# i)$INT
+    if positive?((a := ode.abserr)*(r := ode.relerr))$DF then
+      ire:String := "D"
+    else 
+      if positive?(a) then
+        ire:String := "A"
+      else 
+        ire:String := "R"
+    tol := max(a,r)$DF
+    asp7:Union(fn:FileName,fp:Asp7(FCN)) := 
+      [retract(e:VEF := vedf2vef(ode.fn)$ExpertSystemToolsPackage)$Asp7(FCN)]
+    asp8:Union(fn:FileName,fp:Asp8(OUTPUT)) := 
+      [coerce(ldf2vmf(i)$ExpertSystemToolsPackage)$Asp8(OUTPUT)]
+    asp9:Union(fn:FileName,fp:Asp9(G)) := 
+      [retract(edf2ef(ode.g)$ExpertSystemToolsPackage)$Asp9(G)]
+    d02cjf(ode.xend,M,# e,tol,ire,ode.xinit,matrix([ode.yinit])$MDF,
+             -1,asp9,asp7,asp8)
+
 *)
 
 \end{chunk}
@@ -46302,6 +50558,94 @@ d02ejfAnnaType():OrdinaryDifferentialEquationsSolverCategory == Result add
 \begin{chunk}{COQ D02EJFA}
 (* domain D02EJFA *)
 (*
+  -- BDF "Stiff"
+  EDF  ==> Expression DoubleFloat
+  LDF  ==> List DoubleFloat
+  MDF  ==> Matrix DoubleFloat
+  DF  ==> DoubleFloat
+  F  ==> Float
+  FI  ==> Fraction Integer
+  EFI  ==> Expression Fraction Integer
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  VEDF  ==> Vector Expression DoubleFloat
+  VEF  ==> Vector Expression Float
+  EF  ==> Expression Float
+  VDF  ==> Vector DoubleFloat
+  VMF  ==> Vector MachineFloat
+  MF  ==> MachineFloat
+  ODEA  ==> Record(xinit:DF,xend:DF,fn:VEDF,yinit:LDF,intvals:LDF,_
+                      g:EDF,abserr:DF,relerr:DF)
+  RSS  ==> Record(stiffnessFactor:F,stabilityFactor:F)
+  INT  ==> Integer
+  EF2  ==> ExpressionFunctions2
+
+  import d02AgentsPackage, NagOrdinaryDifferentialEquationsPackage
+
+  accuracyCF(ode:ODEA):F ==
+    b := getButtonValue("d02ejf","accuracy")$AttributeButtons
+    accuracyIntensityValue :=  combineFeatureCompatibility(b,accuracyIF(ode))
+    accuracyIntensityValue > 0.999 => 0$F
+    0.5*exp(-((10*accuracyIntensityValue)**3)$F/250)$F
+
+  intermediateResultsCF(ode:ODEA):F ==
+    intermediateResultsIntensityValue := intermediateResultsIF(ode)
+    i := 0.5 * exp(-(intermediateResultsIntensityValue/1.649)**3)$F
+    a := accuracyCF(ode)
+    i+(0.5-i)*(0.5-a)
+
+  stabilityCF(ode:ODEA):F ==
+    b := getButtonValue("d02ejf","stability")$AttributeButtons
+    ssf := stiffnessAndStabilityOfODEIF ode
+    stabilityIntensityValue := 
+      combineFeatureCompatibility(b,ssf.stabilityFactor)
+    0.68 - 0.5 * exp(-(stabilityIntensityValue)**3)$F
+
+  expenseOfEvaluationCF(ode:ODEA):F ==
+    b := getButtonValue("d02ejf","expense")$AttributeButtons
+    expenseOfEvaluationIntensityValue := 
+      combineFeatureCompatibility(b,expenseOfEvaluationIF(ode))
+    0.5 * exp(-(1.7*expenseOfEvaluationIntensityValue)**3)$F
+    
+  systemSizeCF(args:ODEA):F ==
+    (1$F - systemSizeIF(args))/2.0
+
+  measure(R:RoutinesTable,args:ODEA) ==
+    arg := copy args
+    m := getMeasure(R,d02ejf :: Symbol)$RoutinesTable
+    m := combineFeatureCompatibility(m,[intermediateResultsCF(arg),
+           accuracyCF(arg),
+             systemSizeCF(arg),
+               expenseOfEvaluationCF(arg),
+                 stabilityCF(arg)])
+    [m,"BDF method for Stiff Systems"]
+
+  ODESolve(ode:ODEA) ==
+    i:LDF := ode.intvals
+    m := inc(# i)$INT
+    if positive?((a := ode.abserr)*(r := ode.relerr))$DF then
+      ire:String := "D"
+    else 
+      if positive?(a) then
+        ire:String := "A"
+      else 
+        ire:String := "R"
+    if positive?(a+r)$DF then
+      tol := max(a,r)$DF
+    else 
+      tol := float(1,-4,10)$DF
+    asp7:Union(fn:FileName,fp:Asp7(FCN)) := 
+      [retract(e:VEF := vedf2vef(ode.fn)$ExpertSystemToolsPackage)$Asp7(FCN)]
+    asp31:Union(fn:FileName,fp:Asp31(PEDERV)) := 
+      [retract(e)$Asp31(PEDERV)]
+    asp8:Union(fn:FileName,fp:Asp8(OUTPUT)) := 
+      [coerce(ldf2vmf(i)$ExpertSystemToolsPackage)$Asp8(OUTPUT)]
+    asp9:Union(fn:FileName,fp:Asp9(G)) :=
+      [retract(edf2ef(ode.g)$ExpertSystemToolsPackage)$Asp9(G)]
+    n:INT := # ode.yinit
+    iw:INT := (12+n)*n+50
+    ans := d02ejf(ode.xend,m,n,ire,iw,ode.xinit,matrix([ode.yinit])$MDF,
+             tol,-1,asp9,asp7,asp31,asp8)
+
 *)
 
 \end{chunk}
@@ -46451,6 +50795,65 @@ d03eefAnnaType():PartialDifferentialEquationsSolverCategory == Result add
 \begin{chunk}{COQ D03EEFA}
 (* domain D03EEFA *)
 (*
+  -- 2D Elliptic PDE
+  LEDF  ==> List Expression DoubleFloat
+  EDF  ==> Expression DoubleFloat
+  LDF  ==> List DoubleFloat
+  MDF  ==> Matrix DoubleFloat
+  DF  ==> DoubleFloat
+  F  ==> Float
+  FI  ==> Fraction Integer
+  VEF  ==> Vector Expression Float
+  EF  ==> Expression Float
+  MEF  ==> Matrix Expression Float
+  NNI  ==> NonNegativeInteger
+  INT  ==> Integer
+  PDEC  ==> Record(start:DF, finish:DF, grid:NNI, boundaryType:INT,
+                      dStart:MDF, dFinish:MDF)
+  PDEB  ==> Record(pde:LEDF, constraints:List PDEC,
+                      f:List LEDF, st:String, tol:DF)
+
+  import d03AgentsPackage, NagPartialDifferentialEquationsPackage
+  import ExpertSystemToolsPackage
+
+  measure(R:RoutinesTable,args:PDEB) ==
+    (# (args.constraints) > 2)@Boolean =>
+      [0$F,"d03eef/d03edf is unsuitable for PDEs of order more than 2"]
+    elliptic?(args) => 
+      m := getMeasure(R,d03eef :: Symbol)$RoutinesTable
+      [m,"d03eef/d03edf is suitable"]
+    [0$F,"d03eef/d03edf is unsuitable for hyperbolic or parabolic PDEs"]
+
+  PDESolve(args:PDEB) ==
+    xcon := first(args.constraints)
+    ycon := second(args.constraints) 
+    nx := xcon.grid
+    ny := ycon.grid 
+    p := args.pde
+    x1 := xcon.start
+    x2 := xcon.finish
+    y1 := ycon.start
+    y2 := ycon.finish
+    lda := ((4*(nx+1)*(ny+1)+2) quo 3)$INT
+    scheme:String :=
+     central?((x2-x1)/2,(y2-y1)/2,args.pde) => "C"
+     "U"
+    asp73:Union(fn:FileName,fp:Asp73(PDEF)) :=
+     [retract(vector([edf2ef u for u in p])$VEF)$Asp73(PDEF)]
+    asp74:Union(fn:FileName,fp:Asp74(BNDY)) := 
+     [retract(matrix([[edf2ef v for v in w] for w in args.f])$MEF)$Asp74(BNDY)]
+    fde := d03eef(x1,x2,y1,y2,nx,ny,lda,scheme,-1,asp73,asp74)
+    ub := new(1,nx*ny,0$DF)$MDF
+    A := search(a::Symbol,fde)$Result
+    A case "failed" => empty()$Result
+    AA := A::Any
+    fdea := retract(AA)$AnyFunctions1(MDF)
+    r := search(rhs::Symbol,fde)$Result
+    r case "failed" => empty()$Result
+    rh := r::Any
+    fderhs := retract(rh)$AnyFunctions1(MDF)
+    d03edf(nx,ny,lda,15,args.tol,0,fdea,fderhs,ub,-1)
+
 *)
 
 \end{chunk}
@@ -46561,6 +50964,32 @@ d03fafAnnaType():PartialDifferentialEquationsSolverCategory == Result add
 \begin{chunk}{COQ D03FAFAs}
 (* domain D03FAFAs *)
 (*
+  -- 3D Helmholtz PDE
+  LEDF  ==> List Expression DoubleFloat
+  EDF  ==> Expression DoubleFloat
+  LDF  ==> List DoubleFloat
+  MDF  ==> Matrix DoubleFloat
+  DF  ==> DoubleFloat
+  F  ==> Float
+  FI  ==> Fraction Integer
+  VEF  ==> Vector Expression Float
+  EF  ==> Expression Float
+  MEF  ==> Matrix Expression Float
+  NNI  ==> NonNegativeInteger
+  INT  ==> Integer
+  PDEC  ==> Record(start:DF, finish:DF, grid:NNI, boundaryType:INT,
+                      dStart:MDF, dFinish:MDF)
+  PDEB  ==> Record(pde:LEDF, constraints:List PDEC,
+                      f:List LEDF, st:String, tol:DF)
+
+  import d03AgentsPackage, NagPartialDifferentialEquationsPackage
+  import ExpertSystemToolsPackage
+
+  measure(R:RoutinesTable,args:PDEB) ==
+    (# (args.constraints) < 3)@Boolean =>
+      [0$F,"d03faf is unsuitable for PDEs of order other than 3"]
+    [0$F,"d03faf isn't finished"]
+
 *)
 
 \end{chunk}
@@ -46828,7 +51257,6 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_
     nthRootUTS:(UTS,I) -> Union(UTS,"failed")
     nthRootUTS(uts,n) ==
       -- assumed: n > 1, uts has non-zero constant term
---      one? coefficient(uts,0) => uts ** inv(n::RN)
       coefficient(uts,0) = 1 => uts ** inv(n::RN)
       RATPOWERS => uts ** inv(n::RN)
       "failed"
@@ -46849,7 +51277,6 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_
     if Coef has Field then
        (uls:ULS) ** (r:RN) ==
          num := numer r; den := denom r
---         one? den => uls ** num
          den = 1 => uls ** num
          deg := degree uls
          if zero? (coef := coefficient(uls,deg)) then
@@ -46870,19 +51297,33 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_
       fcn(uts :: UTS) :: ULS
  
     expIfCan   uls == applyIfCan(exp,uls)
+
     sinIfCan   uls == applyIfCan(sin,uls)
+
     cosIfCan   uls == applyIfCan(cos,uls)
+
     asinIfCan  uls == applyIfCan(asin,uls)
+
     acosIfCan  uls == applyIfCan(acos,uls)
+
     asecIfCan  uls == applyIfCan(asec,uls)
+
     acscIfCan  uls == applyIfCan(acsc,uls)
+
     sinhIfCan  uls == applyIfCan(sinh,uls)
+
     coshIfCan  uls == applyIfCan(cosh,uls)
+
     asinhIfCan uls == applyIfCan(asinh,uls)
+
     acoshIfCan uls == applyIfCan(acosh,uls)
+
     atanhIfCan uls == applyIfCan(atanh,uls)
+
     acothIfCan uls == applyIfCan(acoth,uls)
+
     asechIfCan uls == applyIfCan(asech,uls)
+
     acschIfCan uls == applyIfCan(acsch,uls)
  
     logIfCan uls ==
@@ -46994,28 +51435,51 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_
       ans :: ULS
  
     exp uls   == applyOrError(expIfCan,"exp",uls)
+
     log uls   == applyOrError(logIfCan,"log",uls)
+
     sin uls   == applyOrError(sinIfCan,"sin",uls)
+
     cos uls   == applyOrError(cosIfCan,"cos",uls)
+
     tan uls   == applyOrError(tanIfCan,"tan",uls)
+
     cot uls   == applyOrError(cotIfCan,"cot",uls)
+
     sec uls   == applyOrError(secIfCan,"sec",uls)
+
     csc uls   == applyOrError(cscIfCan,"csc",uls)
+
     asin uls  == applyOrError(asinIfCan,"asin",uls)
+
     acos uls  == applyOrError(acosIfCan,"acos",uls)
+
     asec uls  == applyOrError(asecIfCan,"asec",uls)
+
     acsc uls  == applyOrError(acscIfCan,"acsc",uls)
+
     sinh uls  == applyOrError(sinhIfCan,"sinh",uls)
+
     cosh uls  == applyOrError(coshIfCan,"cosh",uls)
+
     tanh uls  == applyOrError(tanhIfCan,"tanh",uls)
+
     coth uls  == applyOrError(cothIfCan,"coth",uls)
+
     sech uls  == applyOrError(sechIfCan,"sech",uls)
+
     csch uls  == applyOrError(cschIfCan,"csch",uls)
+
     asinh uls == applyOrError(asinhIfCan,"asinh",uls)
+
     acosh uls == applyOrError(acoshIfCan,"acosh",uls)
+
     atanh uls == applyOrError(atanhIfCan,"atanh",uls)
+
     acoth uls == applyOrError(acothIfCan,"acoth",uls)
+
     asech uls == applyOrError(asechIfCan,"asech",uls)
+
     acsch uls == applyOrError(acschIfCan,"acsch",uls)
 
     atan uls ==
@@ -47066,6 +51530,284 @@ ElementaryFunctionsUnivariateLaurentSeries(Coef,UTS,ULS):_
 \begin{chunk}{COQ EFULS}
 (* domain EFULS *)
 (*
+ 
+--% roots
+ 
+    RATPOWERS : Boolean := Coef has "**":(Coef,RN) -> Coef
+    TRANSFCN  : Boolean := Coef has TranscendentalFunctionCategory
+    RATS      : Boolean := Coef has retractIfCan: Coef -> Union(RN,"failed")
+ 
+    nthRootUTS:(UTS,I) -> Union(UTS,"failed")
+    nthRootUTS(uts,n) ==
+      -- assumed: n > 1, uts has non-zero constant term
+      coefficient(uts,0) = 1 => uts ** inv(n::RN)
+      RATPOWERS => uts ** inv(n::RN)
+      "failed"
+ 
+    nthRootIfCan(uls,nn) ==
+      (n := nn :: I) < 1 => error "nthRootIfCan: n must be positive"
+      n = 1 => uls
+      deg := degree uls
+      if zero? (coef := coefficient(uls,deg)) then
+        uls := removeZeroes(1000,uls); deg := degree uls
+        zero? (coef := coefficient(uls,deg)) =>
+          error "root of series with many leading zero coefficients"
+      (k := deg exquo n) case "failed" => "failed"
+      uts := taylor(uls * monomial(1,-deg))
+      (root := nthRootUTS(uts,n)) case "failed" => "failed"
+      monomial(1,k :: I) * (root :: UTS :: ULS)
+ 
+    if Coef has Field then
+       (uls:ULS) ** (r:RN) ==
+         num := numer r; den := denom r
+         den = 1 => uls ** num
+         deg := degree uls
+         if zero? (coef := coefficient(uls,deg)) then
+           uls := removeZeroes(1000,uls); deg := degree uls
+           zero? (coef := coefficient(uls,deg)) =>
+             error "power of series with many leading zero coefficients"
+         (k := deg exquo den) case "failed" =>
+           error "**: rational power does not exist"
+         uts := taylor(uls * monomial(1,-deg)) ** r
+         monomial(1,(k :: I) * num) * (uts :: ULS)
+ 
+--% transcendental functions
+ 
+    applyIfCan: (UTS -> UTS,ULS) -> Union(ULS,"failed")
+    applyIfCan(fcn,uls) ==
+      uts := taylorIfCan uls
+      uts case "failed" => "failed"
+      fcn(uts :: UTS) :: ULS
+ 
+    expIfCan   uls == applyIfCan(exp,uls)
+
+    sinIfCan   uls == applyIfCan(sin,uls)
+
+    cosIfCan   uls == applyIfCan(cos,uls)
+
+    asinIfCan  uls == applyIfCan(asin,uls)
+
+    acosIfCan  uls == applyIfCan(acos,uls)
+
+    asecIfCan  uls == applyIfCan(asec,uls)
+
+    acscIfCan  uls == applyIfCan(acsc,uls)
+
+    sinhIfCan  uls == applyIfCan(sinh,uls)
+
+    coshIfCan  uls == applyIfCan(cosh,uls)
+
+    asinhIfCan uls == applyIfCan(asinh,uls)
+
+    acoshIfCan uls == applyIfCan(acosh,uls)
+
+    atanhIfCan uls == applyIfCan(atanh,uls)
+
+    acothIfCan uls == applyIfCan(acoth,uls)
+
+    asechIfCan uls == applyIfCan(asech,uls)
+
+    acschIfCan uls == applyIfCan(acsch,uls)
+ 
+    logIfCan uls ==
+      uts := taylorIfCan uls
+      uts case "failed" => "failed"
+      zero? coefficient(ts := uts :: UTS,0) => "failed"
+      log(ts) :: ULS
+ 
+    tanIfCan uls ==
+      -- don't call 'tan' on a UTS (tan(uls) may have a singularity)
+      uts := taylorIfCan uls
+      uts case "failed" => "failed"
+      sc := sincos(coefficients(uts :: UTS))$STTF
+      (cosInv := recip(series(sc.cos) :: ULS)) case "failed" => "failed"
+      (series(sc.sin) :: ULS) * (cosInv :: ULS)
+ 
+    cotIfCan uls ==
+      -- don't call 'cot' on a UTS (cot(uls) may have a singularity)
+      uts := taylorIfCan uls
+      uts case "failed" => "failed"
+      sc := sincos(coefficients(uts :: UTS))$STTF
+      (sinInv := recip(series(sc.sin) :: ULS)) case "failed" => "failed"
+      (series(sc.cos) :: ULS) * (sinInv :: ULS)
+ 
+    secIfCan uls ==
+      cos := cosIfCan uls
+      cos case "failed" => "failed"
+      (cosInv := recip(cos :: ULS)) case "failed" => "failed"
+      cosInv :: ULS
+ 
+    cscIfCan uls ==
+      sin := sinIfCan uls
+      sin case "failed" => "failed"
+      (sinInv := recip(sin :: ULS)) case "failed" => "failed"
+      sinInv :: ULS
+
+    atanIfCan uls ==
+      coef := coefficient(uls,0)
+      (ord := order(uls,0)) = 0 and coef * coef = -1 => "failed"
+      cc : Coef := 
+        ord < 0 =>
+          TRANSFCN =>
+            RATS =>
+              lc := coefficient(uls,ord)
+              (rat := retractIfCan(lc)@Union(RN,"failed")) case "failed" =>
+                (1/2) * pi()
+              (rat :: RN) > 0 => (1/2) * pi()
+              (-1/2) * pi()
+            (1/2) * pi()
+          return "failed"
+        coef = 0 => 0
+        TRANSFCN => atan coef
+        return "failed"
+      (z := recip(1 + uls*uls)) case "failed" => "failed"
+      (cc :: ULS) + integrate(differentiate(uls) * (z :: ULS))
+
+    acotIfCan uls ==
+      coef := coefficient(uls,0)
+      (ord := order(uls,0)) = 0 and coef * coef = -1 => "failed"
+      cc : Coef := 
+        ord < 0 =>
+          RATS =>
+            lc := coefficient(uls,ord)
+            (rat := retractIfCan(lc)@Union(RN,"failed")) case "failed" => 0
+            (rat :: RN) > 0 => 0
+            TRANSFCN => pi()
+            return "failed"
+          0
+        TRANSFCN => acot coef
+        return "failed"
+      (z := recip(1 + uls*uls)) case "failed" => "failed"
+      (cc :: ULS) - integrate(differentiate(uls) * (z :: ULS))
+ 
+    tanhIfCan uls ==
+      -- don't call 'tanh' on a UTS (tanh(uls) may have a singularity)
+      uts := taylorIfCan uls
+      uts case "failed" => "failed"
+      sc := sinhcosh(coefficients(uts :: UTS))$STTF
+      (coshInv := recip(series(sc.cosh) :: ULS)) case "failed" =>
+        "failed"
+      (series(sc.sinh) :: ULS) * (coshInv :: ULS)
+ 
+    cothIfCan uls ==
+      -- don't call 'coth' on a UTS (coth(uls) may have a singularity)
+      uts := taylorIfCan uls
+      uts case "failed" => "failed"
+      sc := sinhcosh(coefficients(uts :: UTS))$STTF
+      (sinhInv := recip(series(sc.sinh) :: ULS)) case "failed" =>
+        "failed"
+      (series(sc.cosh) :: ULS) * (sinhInv :: ULS)
+ 
+    sechIfCan uls ==
+      cosh := coshIfCan uls
+      cosh case "failed" => "failed"
+      (coshInv := recip(cosh :: ULS)) case "failed" => "failed"
+      coshInv :: ULS
+ 
+    cschIfCan uls ==
+      sinh := sinhIfCan uls
+      sinh case "failed" => "failed"
+      (sinhInv := recip(sinh :: ULS)) case "failed" => "failed"
+      sinhInv :: ULS
+ 
+    applyOrError:(ULS -> Union(ULS,"failed"),S,ULS) -> ULS
+    applyOrError(fcn,name,uls) ==
+      ans := fcn uls
+      ans case "failed" =>
+        error concat(name," of function with singularity")
+      ans :: ULS
+ 
+    exp uls   == applyOrError(expIfCan,"exp",uls)
+
+    log uls   == applyOrError(logIfCan,"log",uls)
+
+    sin uls   == applyOrError(sinIfCan,"sin",uls)
+
+    cos uls   == applyOrError(cosIfCan,"cos",uls)
+
+    tan uls   == applyOrError(tanIfCan,"tan",uls)
+
+    cot uls   == applyOrError(cotIfCan,"cot",uls)
+
+    sec uls   == applyOrError(secIfCan,"sec",uls)
+
+    csc uls   == applyOrError(cscIfCan,"csc",uls)
+
+    asin uls  == applyOrError(asinIfCan,"asin",uls)
+
+    acos uls  == applyOrError(acosIfCan,"acos",uls)
+
+    asec uls  == applyOrError(asecIfCan,"asec",uls)
+
+    acsc uls  == applyOrError(acscIfCan,"acsc",uls)
+
+    sinh uls  == applyOrError(sinhIfCan,"sinh",uls)
+
+    cosh uls  == applyOrError(coshIfCan,"cosh",uls)
+
+    tanh uls  == applyOrError(tanhIfCan,"tanh",uls)
+
+    coth uls  == applyOrError(cothIfCan,"coth",uls)
+
+    sech uls  == applyOrError(sechIfCan,"sech",uls)
+
+    csch uls  == applyOrError(cschIfCan,"csch",uls)
+
+    asinh uls == applyOrError(asinhIfCan,"asinh",uls)
+
+    acosh uls == applyOrError(acoshIfCan,"acosh",uls)
+
+    atanh uls == applyOrError(atanhIfCan,"atanh",uls)
+
+    acoth uls == applyOrError(acothIfCan,"acoth",uls)
+
+    asech uls == applyOrError(asechIfCan,"asech",uls)
+
+    acsch uls == applyOrError(acschIfCan,"acsch",uls)
+
+    atan uls ==
+    -- code is duplicated so that correct error messages will be returned
+      coef := coefficient(uls,0)
+      (ord := order(uls,0)) = 0 and coef * coef = -1 =>
+        error "atan: series expansion has logarithmic term"
+      cc : Coef := 
+        ord < 0 =>
+          TRANSFCN =>
+            RATS =>
+              lc := coefficient(uls,ord)
+              (rat := retractIfCan(lc)@Union(RN,"failed")) case "failed" =>
+                (1/2) * pi()
+              (rat :: RN) > 0 => (1/2) * pi()
+              (-1/2) * pi()
+            (1/2) * pi()
+          error "atan: series expansion involves transcendental constants"
+        coef = 0 => 0
+        TRANSFCN => atan coef
+        error "atan: series expansion involves transcendental constants"
+      (z := recip(1 + uls*uls)) case "failed" =>
+        error "atan: leading coefficient not invertible"
+      (cc :: ULS) + integrate(differentiate(uls) * (z :: ULS))
+
+    acot uls ==
+    -- code is duplicated so that correct error messages will be returned
+      coef := coefficient(uls,0)
+      (ord := order(uls,0)) = 0 and coef * coef = -1 =>
+        error "acot: series expansion has logarithmic term"
+      cc : Coef := 
+        ord < 0 =>
+          RATS =>
+            lc := coefficient(uls,ord)
+            (rat := retractIfCan(lc)@Union(RN,"failed")) case "failed" => 0
+            (rat :: RN) > 0 => 0
+            TRANSFCN => pi()
+            error "acot: series expansion involves transcendental constants"
+          0
+        TRANSFCN => acot coef
+        error "acot: series expansion involves transcendental constants"
+      (z := recip(1 + uls*uls)) case "failed" =>
+        error "acot: leading coefficient not invertible"
+      (cc :: ULS) - integrate(differentiate(uls) * (z :: ULS))
+
 *)
 
 \end{chunk}
@@ -47327,7 +52069,6 @@ ElementaryFunctionsUnivariatePuiseuxSeries(Coef,ULS,UPXS,EFULS):_
 --% roots
  
     nthRootIfCan(upxs,n) ==
---      one? n => upxs
       n = 1 => upxs
       r := rationalPower upxs; uls := laurentRep upxs
       deg := degree uls
@@ -47342,7 +52083,6 @@ ElementaryFunctionsUnivariatePuiseuxSeries(Coef,ULS,UPXS,EFULS):_
     if Coef has Field then
        (upxs:UPXS) ** (q:RN) ==
          num := numer q; den := denom q
---         one? den => upxs ** num
          den = 1 => upxs ** num
          r := rationalPower upxs; uls := laurentRep upxs
          deg := degree uls
@@ -47362,26 +52102,47 @@ ElementaryFunctionsUnivariatePuiseuxSeries(Coef,ULS,UPXS,EFULS):_
       puiseux(rationalPower upxs,uls :: ULS)
  
     expIfCan   upxs == applyIfCan(expIfCan,upxs)
+
     logIfCan   upxs == applyIfCan(logIfCan,upxs)
+
     sinIfCan   upxs == applyIfCan(sinIfCan,upxs)
+
     cosIfCan   upxs == applyIfCan(cosIfCan,upxs)
+
     tanIfCan   upxs == applyIfCan(tanIfCan,upxs)
+
     cotIfCan   upxs == applyIfCan(cotIfCan,upxs)
+
     secIfCan   upxs == applyIfCan(secIfCan,upxs)
+
     cscIfCan   upxs == applyIfCan(cscIfCan,upxs)
+
     atanIfCan  upxs == applyIfCan(atanIfCan,upxs)
+
     acotIfCan  upxs == applyIfCan(acotIfCan,upxs)
+
     sinhIfCan  upxs == applyIfCan(sinhIfCan,upxs)
+
     coshIfCan  upxs == applyIfCan(coshIfCan,upxs)
+
     tanhIfCan  upxs == applyIfCan(tanhIfCan,upxs)
+
     cothIfCan  upxs == applyIfCan(cothIfCan,upxs)
+
     sechIfCan  upxs == applyIfCan(sechIfCan,upxs)
+
     cschIfCan  upxs == applyIfCan(cschIfCan,upxs)
+
     asinhIfCan upxs == applyIfCan(asinhIfCan,upxs)
+
     acoshIfCan upxs == applyIfCan(acoshIfCan,upxs)
+
     atanhIfCan upxs == applyIfCan(atanhIfCan,upxs)
+
     acothIfCan upxs == applyIfCan(acothIfCan,upxs)
+
     asechIfCan upxs == applyIfCan(asechIfCan,upxs)
+
     acschIfCan upxs == applyIfCan(acschIfCan,upxs)
 
     asinIfCan upxs ==
@@ -47452,30 +52213,55 @@ ElementaryFunctionsUnivariatePuiseuxSeries(Coef,ULS,UPXS,EFULS):_
       ans :: UPXS
  
     exp upxs   == applyOrError(expIfCan,"exp",upxs)
+
     log upxs   == applyOrError(logIfCan,"log",upxs)
+
     sin upxs   == applyOrError(sinIfCan,"sin",upxs)
+
     cos upxs   == applyOrError(cosIfCan,"cos",upxs)
+
     tan upxs   == applyOrError(tanIfCan,"tan",upxs)
+
     cot upxs   == applyOrError(cotIfCan,"cot",upxs)
+
     sec upxs   == applyOrError(secIfCan,"sec",upxs)
+
     csc upxs   == applyOrError(cscIfCan,"csc",upxs)
+
     asin upxs  == applyOrError(asinIfCan,"asin",upxs)
+
     acos upxs  == applyOrError(acosIfCan,"acos",upxs)
+
     atan upxs  == applyOrError(atanIfCan,"atan",upxs)
+
     acot upxs  == applyOrError(acotIfCan,"acot",upxs)
+
     asec upxs  == applyOrError(asecIfCan,"asec",upxs)
+
     acsc upxs  == applyOrError(acscIfCan,"acsc",upxs)
+
     sinh upxs  == applyOrError(sinhIfCan,"sinh",upxs)
+
     cosh upxs  == applyOrError(coshIfCan,"cosh",upxs)
+
     tanh upxs  == applyOrError(tanhIfCan,"tanh",upxs)
+
     coth upxs  == applyOrError(cothIfCan,"coth",upxs)
+
     sech upxs  == applyOrError(sechIfCan,"sech",upxs)
+
     csch upxs  == applyOrError(cschIfCan,"csch",upxs)
+
     asinh upxs == applyOrError(asinhIfCan,"asinh",upxs)
+
     acosh upxs == applyOrError(acoshIfCan,"acosh",upxs)
+
     atanh upxs == applyOrError(atanhIfCan,"atanh",upxs)
+
     acoth upxs == applyOrError(acothIfCan,"acoth",upxs)
+
     asech upxs == applyOrError(asechIfCan,"asech",upxs)
+
     acsch upxs == applyOrError(acschIfCan,"acsch",upxs)
 
 \end{chunk}
@@ -47483,6 +52269,207 @@ ElementaryFunctionsUnivariatePuiseuxSeries(Coef,ULS,UPXS,EFULS):_
 \begin{chunk}{COQ EFUPXS}
 (* domain EFUPXS *)
 (*
+
+    TRANSFCN : Boolean := Coef has TranscendentalFunctionCategory
+ 
+--% roots
+ 
+    nthRootIfCan(upxs,n) ==
+      n = 1 => upxs
+      r := rationalPower upxs; uls := laurentRep upxs
+      deg := degree uls
+      if zero?(coef := coefficient(uls,deg)) then
+        deg := order(uls,deg + 1000)
+        zero?(coef := coefficient(uls,deg)) =>
+          error "root of series with many leading zero coefficients"
+      uls := uls * monomial(1,-deg)$ULS
+      (ulsRoot := nthRootIfCan(uls,n)) case "failed" => "failed"
+      puiseux(r,ulsRoot :: ULS) * monomial(1,deg * r * inv(n :: RN))
+ 
+    if Coef has Field then
+       (upxs:UPXS) ** (q:RN) ==
+         num := numer q; den := denom q
+         den = 1 => upxs ** num
+         r := rationalPower upxs; uls := laurentRep upxs
+         deg := degree uls
+         if zero?(coef := coefficient(uls,deg)) then
+           deg := order(uls,deg + 1000)
+           zero?(coef := coefficient(uls,deg)) =>
+             error "power of series with many leading zero coefficients"
+         ulsPow := (uls * monomial(1,-deg)$ULS) ** q
+         puiseux(r,ulsPow) * monomial(1,deg*q*r)
+ 
+--% transcendental functions
+ 
+    applyIfCan: (ULS -> Union(ULS,"failed"),UPXS) -> Union(UPXS,"failed")
+    applyIfCan(fcn,upxs) ==
+      uls := fcn laurentRep upxs
+      uls case "failed" => "failed"
+      puiseux(rationalPower upxs,uls :: ULS)
+ 
+    expIfCan   upxs == applyIfCan(expIfCan,upxs)
+
+    logIfCan   upxs == applyIfCan(logIfCan,upxs)
+
+    sinIfCan   upxs == applyIfCan(sinIfCan,upxs)
+
+    cosIfCan   upxs == applyIfCan(cosIfCan,upxs)
+
+    tanIfCan   upxs == applyIfCan(tanIfCan,upxs)
+
+    cotIfCan   upxs == applyIfCan(cotIfCan,upxs)
+
+    secIfCan   upxs == applyIfCan(secIfCan,upxs)
+
+    cscIfCan   upxs == applyIfCan(cscIfCan,upxs)
+
+    atanIfCan  upxs == applyIfCan(atanIfCan,upxs)
+
+    acotIfCan  upxs == applyIfCan(acotIfCan,upxs)
+
+    sinhIfCan  upxs == applyIfCan(sinhIfCan,upxs)
+
+    coshIfCan  upxs == applyIfCan(coshIfCan,upxs)
+
+    tanhIfCan  upxs == applyIfCan(tanhIfCan,upxs)
+
+    cothIfCan  upxs == applyIfCan(cothIfCan,upxs)
+
+    sechIfCan  upxs == applyIfCan(sechIfCan,upxs)
+
+    cschIfCan  upxs == applyIfCan(cschIfCan,upxs)
+
+    asinhIfCan upxs == applyIfCan(asinhIfCan,upxs)
+
+    acoshIfCan upxs == applyIfCan(acoshIfCan,upxs)
+
+    atanhIfCan upxs == applyIfCan(atanhIfCan,upxs)
+
+    acothIfCan upxs == applyIfCan(acothIfCan,upxs)
+
+    asechIfCan upxs == applyIfCan(asechIfCan,upxs)
+
+    acschIfCan upxs == applyIfCan(acschIfCan,upxs)
+
+    asinIfCan upxs ==
+      order(upxs,0) < 0 => "failed"
+      (coef := coefficient(upxs,0)) = 0 =>
+        integrate((1 - upxs*upxs)**(-1/2) * (differentiate upxs))
+      TRANSFCN =>
+        cc := asin(coef) :: UPXS
+        cc + integrate((1 - upxs*upxs)**(-1/2) * (differentiate upxs))
+      "failed"
+
+    acosIfCan upxs ==
+      order(upxs,0) < 0 => "failed"
+      TRANSFCN =>
+        cc := acos(coefficient(upxs,0)) :: UPXS
+        cc + integrate(-(1 - upxs*upxs)**(-1/2) * (differentiate upxs))
+      "failed"
+
+    asecIfCan upxs ==
+      order(upxs,0) < 0 => "failed"
+      TRANSFCN =>
+        cc := asec(coefficient(upxs,0)) :: UPXS
+        f := (upxs*upxs - 1)**(-1/2) * (differentiate upxs)
+        (rec := recip upxs) case "failed" => "failed"
+        cc + integrate(f * (rec :: UPXS))
+      "failed"
+
+    acscIfCan upxs ==
+      order(upxs,0) < 0 => "failed"
+      TRANSFCN =>
+        cc := acsc(coefficient(upxs,0)) :: UPXS
+        f := -(upxs*upxs - 1)**(-1/2) * (differentiate upxs)
+        (rec := recip upxs) case "failed" => "failed"
+        cc + integrate(f * (rec :: UPXS))
+      "failed"
+
+    asinhIfCan upxs ==
+      order(upxs,0) < 0 => "failed"
+      TRANSFCN or (coefficient(upxs,0) = 0) =>
+        log(upxs + (1 + upxs*upxs)**(1/2))
+      "failed"
+
+    acoshIfCan upxs ==
+      TRANSFCN =>
+        order(upxs,0) < 0 => "failed"
+        log(upxs + (upxs*upxs - 1)**(1/2))
+      "failed"
+
+    asechIfCan upxs ==
+      TRANSFCN =>
+        order(upxs,0) < 0 => "failed"
+        (rec := recip upxs) case "failed" => "failed"
+        log((1 + (1 - upxs*upxs)*(1/2)) * (rec :: UPXS))
+      "failed"
+
+    acschIfCan upxs ==
+      TRANSFCN =>
+        order(upxs,0) < 0 => "failed"
+        (rec := recip upxs) case "failed" => "failed"
+        log((1 + (1 + upxs*upxs)*(1/2)) * (rec :: UPXS))
+      "failed"
+ 
+    applyOrError:(UPXS -> Union(UPXS,"failed"),String,UPXS) -> UPXS
+    applyOrError(fcn,name,upxs) ==
+      ans := fcn upxs
+      ans case "failed" =>
+        error concat(name," of function with singularity")
+      ans :: UPXS
+ 
+    exp upxs   == applyOrError(expIfCan,"exp",upxs)
+
+    log upxs   == applyOrError(logIfCan,"log",upxs)
+
+    sin upxs   == applyOrError(sinIfCan,"sin",upxs)
+
+    cos upxs   == applyOrError(cosIfCan,"cos",upxs)
+
+    tan upxs   == applyOrError(tanIfCan,"tan",upxs)
+
+    cot upxs   == applyOrError(cotIfCan,"cot",upxs)
+
+    sec upxs   == applyOrError(secIfCan,"sec",upxs)
+
+    csc upxs   == applyOrError(cscIfCan,"csc",upxs)
+
+    asin upxs  == applyOrError(asinIfCan,"asin",upxs)
+
+    acos upxs  == applyOrError(acosIfCan,"acos",upxs)
+
+    atan upxs  == applyOrError(atanIfCan,"atan",upxs)
+
+    acot upxs  == applyOrError(acotIfCan,"acot",upxs)
+
+    asec upxs  == applyOrError(asecIfCan,"asec",upxs)
+
+    acsc upxs  == applyOrError(acscIfCan,"acsc",upxs)
+
+    sinh upxs  == applyOrError(sinhIfCan,"sinh",upxs)
+
+    cosh upxs  == applyOrError(coshIfCan,"cosh",upxs)
+
+    tanh upxs  == applyOrError(tanhIfCan,"tanh",upxs)
+
+    coth upxs  == applyOrError(cothIfCan,"coth",upxs)
+
+    sech upxs  == applyOrError(sechIfCan,"sech",upxs)
+
+    csch upxs  == applyOrError(cschIfCan,"csch",upxs)
+
+    asinh upxs == applyOrError(asinhIfCan,"asinh",upxs)
+
+    acosh upxs == applyOrError(acoshIfCan,"acosh",upxs)
+
+    atanh upxs == applyOrError(atanhIfCan,"atanh",upxs)
+
+    acoth upxs == applyOrError(acothIfCan,"acoth",upxs)
+
+    asech upxs == applyOrError(asechIfCan,"asech",upxs)
+
+    acsch upxs == applyOrError(acschIfCan,"acsch",upxs)
+
 *)
 
 \end{chunk}
@@ -47838,7 +52825,8 @@ Equation(S: Type): public == private where
            eval: ($, $) -> $
                ++ eval(eqn, x=f) replaces x by f in equation eqn.
            eval: ($, List $) -> $
-               ++ eval(eqn, [x1=v1, ... xn=vn]) replaces xi by vi in equation eqn.
+               ++ eval(eqn, [x1=v1, ... xn=vn]) 
+               ++ replaces xi by vi in equation eqn.
     if S has AbelianSemiGroup then
         AbelianSemiGroup
         "+": (S, $) -> $
@@ -47857,8 +52845,8 @@ Equation(S: Type): public == private where
             ++ x-eqn produces a new equation by subtracting both sides of
             ++ equation eqn from x.
         "-": ($, S) -> $
-            ++ eqn-x produces a new equation by subtracting x from  both sides of
-            ++ equation eqn.
+            ++ eqn-x produces a new equation by subtracting x from  both sides
+            ++ of the equation eqn.
     if S has SemiGroup then
         SemiGroup
         "*": (S, $) -> $
@@ -47906,19 +52894,29 @@ Equation(S: Type): public == private where
 
   private ==> add
     Rep := Record(lhs: S, rhs: S)
+
     eq1,eq2: $
+
     s : S
+
     if S has IntegralDomain then
+
         factorAndSplit eq ==
           (S has factor : S -> Factored S) =>
             eq0 := rightZero eq
             [equation(rcf.factor,0) for rcf in factors factor lhs eq0]
           [eq]
+
     l:S = r:S      == [l, r]
+
     equation(l, r) == [l, r]    -- hack!  See comment above.
+
     lhs eqn        == eqn.lhs
+
     rhs eqn        == eqn.rhs
+
     swap eqn     == [rhs eqn, lhs eqn]
+
     map(fn, eqn)   == equation(fn(eqn.lhs), fn(eqn.rhs))
 
     if S has InnerEvalable(Symbol,S) then
@@ -47926,61 +52924,101 @@ Equation(S: Type): public == private where
         ls:List Symbol
         x:S
         lx:List S
+
         eval(eqn,s,x) == eval(eqn.lhs,s,x) = eval(eqn.rhs,s,x)
+
         eval(eqn,ls,lx) == eval(eqn.lhs,ls,lx) = eval(eqn.rhs,ls,lx)
+
     if S has Evalable(S) then
+
         eval(eqn1:$, eqn2:$):$ ==
            eval(eqn1.lhs, eqn2 pretend Equation S) =
                eval(eqn1.rhs, eqn2 pretend Equation S)
+
         eval(eqn1:$, leqn2:List $):$ ==
            eval(eqn1.lhs, leqn2 pretend List Equation S) =
                eval(eqn1.rhs, leqn2 pretend List Equation S)
+
     if S has SetCategory then
+
         eq1 = eq2 == (eq1.lhs = eq2.lhs)@Boolean and
                      (eq1.rhs = eq2.rhs)@Boolean
+
         coerce(eqn:$):Ex == eqn.lhs::Ex = eqn.rhs::Ex
+
         coerce(eqn:$):Boolean == eqn.lhs = eqn.rhs
+
     if S has AbelianSemiGroup then
+
         eq1 + eq2 == eq1.lhs + eq2.lhs = eq1.rhs + eq2.rhs
+
         s + eq2 == [s,s] + eq2
+
         eq1 + s == eq1 + [s,s]
+
     if S has AbelianGroup then
+
         - eq == (- lhs eq) = (-rhs eq)
+
         s - eq2 == [s,s] - eq2
+
         eq1 - s == eq1 - [s,s]
+
         leftZero eq == 0 = rhs eq - lhs eq
+
         rightZero eq == lhs eq - rhs eq = 0
+
         0 == equation(0$S,0$S)
+
         eq1 - eq2 == eq1.lhs - eq2.lhs = eq1.rhs - eq2.rhs
+
     if S has SemiGroup then
+
         eq1:$ * eq2:$ == eq1.lhs * eq2.lhs = eq1.rhs * eq2.rhs
+
         l:S   * eqn:$ == l       * eqn.lhs = l       * eqn.rhs
+
         l:S * eqn:$  ==  l * eqn.lhs    =    l * eqn.rhs
+
         eqn:$ * l:S  ==  eqn.lhs * l    =    eqn.rhs * l
         -- We have to be a bit careful here: raising to a +ve integer is OK
         -- (since it's the equivalent of repeated multiplication)
         -- but other powers may cause contradictions
         -- Watch what else you add here! JHD 2/Aug 1990
+
     if S has Monoid then
+
         1 == equation(1$S,1$S)
+
         recip eq ==
           (lh := recip lhs eq) case "failed" => "failed"
           (rh := recip rhs eq) case "failed" => "failed"
           [lh :: S, rh :: S]
+
         leftOne eq ==
           (re := recip lhs eq) case "failed" => "failed"
           1 = rhs eq * re
+
         rightOne eq ==
           (re := recip rhs eq) case "failed" => "failed"
           lhs eq * re = 1
+
     if S has Group then
+
         inv eq == [inv lhs eq, inv rhs eq]
+
         leftOne eq == 1 = rhs eq * inv rhs eq
+
         rightOne eq == lhs eq * inv rhs eq = 1
+
     if S has Ring then
+
         characteristic() == characteristic()$S
+
         i:Integer * eq:$ == (i::S) * eq
+
     if S has IntegralDomain then
+
         factorAndSplit eq ==
           (S has factor : S -> Factored S) =>
             eq0 := rightZero eq
@@ -47990,16 +53028,25 @@ Equation(S: Type): public == private where
             MF ==> MultivariateFactorize(Symbol, IndexedExponents Symbol, _
                Integer, Polynomial Integer)
             p : Polynomial Integer := (lhs eq0) pretend Polynomial Integer
-            [equation((rcf.factor) pretend S,0) for rcf in factors factor(p)$MF]
+            [equation((rcf.factor) pretend S,0) _
+              for rcf in factors factor(p)$MF]
           [eq]
+
     if S has PartialDifferentialRing(Symbol) then
+
         differentiate(eq:$, sym:Symbol):$ ==
            [differentiate(lhs eq, sym), differentiate(rhs eq, sym)]
+
     if S has Field then
+
         dimension() == 2 :: CardinalNumber
+
         eq1:$ / eq2:$ == eq1.lhs / eq2.lhs = eq1.rhs / eq2.rhs
+
         inv eq == [inv lhs eq, inv rhs eq]
+
     if S has ExpressionSpace then
+
         subst(eq1,eq2) ==
             eq3 := eq2 pretend Equation S
             [subst(lhs eq1,eq3),subst(rhs eq1,eq3)]
@@ -48009,6 +53056,164 @@ Equation(S: Type): public == private where
 \begin{chunk}{COQ EQ}
 (* domain EQ *)
 (*
+    Rep := Record(lhs: S, rhs: S)
+
+    eq1,eq2: $
+
+    s : S
+
+    if S has IntegralDomain then
+
+        factorAndSplit eq ==
+          (S has factor : S -> Factored S) =>
+            eq0 := rightZero eq
+            [equation(rcf.factor,0) for rcf in factors factor lhs eq0]
+          [eq]
+
+    l:S = r:S      == [l, r]
+
+    equation(l, r) == [l, r]    -- hack!  See comment above.
+
+    lhs eqn        == eqn.lhs
+
+    rhs eqn        == eqn.rhs
+
+    swap eqn     == [rhs eqn, lhs eqn]
+
+    map(fn, eqn)   == equation(fn(eqn.lhs), fn(eqn.rhs))
+
+    if S has InnerEvalable(Symbol,S) then
+        s:Symbol
+        ls:List Symbol
+        x:S
+        lx:List S
+
+        eval(eqn,s,x) == eval(eqn.lhs,s,x) = eval(eqn.rhs,s,x)
+
+        eval(eqn,ls,lx) == eval(eqn.lhs,ls,lx) = eval(eqn.rhs,ls,lx)
+
+    if S has Evalable(S) then
+
+        eval(eqn1:$, eqn2:$):$ ==
+           eval(eqn1.lhs, eqn2 pretend Equation S) =
+               eval(eqn1.rhs, eqn2 pretend Equation S)
+
+        eval(eqn1:$, leqn2:List $):$ ==
+           eval(eqn1.lhs, leqn2 pretend List Equation S) =
+               eval(eqn1.rhs, leqn2 pretend List Equation S)
+
+    if S has SetCategory then
+
+        eq1 = eq2 == (eq1.lhs = eq2.lhs)@Boolean and
+                     (eq1.rhs = eq2.rhs)@Boolean
+
+        coerce(eqn:$):Ex == eqn.lhs::Ex = eqn.rhs::Ex
+
+        coerce(eqn:$):Boolean == eqn.lhs = eqn.rhs
+
+    if S has AbelianSemiGroup then
+
+        eq1 + eq2 == eq1.lhs + eq2.lhs = eq1.rhs + eq2.rhs
+
+        s + eq2 == [s,s] + eq2
+
+        eq1 + s == eq1 + [s,s]
+
+    if S has AbelianGroup then
+
+        - eq == (- lhs eq) = (-rhs eq)
+
+        s - eq2 == [s,s] - eq2
+
+        eq1 - s == eq1 - [s,s]
+
+        leftZero eq == 0 = rhs eq - lhs eq
+
+        rightZero eq == lhs eq - rhs eq = 0
+
+        0 == equation(0$S,0$S)
+
+        eq1 - eq2 == eq1.lhs - eq2.lhs = eq1.rhs - eq2.rhs
+
+    if S has SemiGroup then
+
+        eq1:$ * eq2:$ == eq1.lhs * eq2.lhs = eq1.rhs * eq2.rhs
+
+        l:S   * eqn:$ == l       * eqn.lhs = l       * eqn.rhs
+
+        l:S * eqn:$  ==  l * eqn.lhs    =    l * eqn.rhs
+
+        eqn:$ * l:S  ==  eqn.lhs * l    =    eqn.rhs * l
+        -- We have to be a bit careful here: raising to a +ve integer is OK
+        -- (since it's the equivalent of repeated multiplication)
+        -- but other powers may cause contradictions
+        -- Watch what else you add here! JHD 2/Aug 1990
+
+    if S has Monoid then
+
+        1 == equation(1$S,1$S)
+
+        recip eq ==
+          (lh := recip lhs eq) case "failed" => "failed"
+          (rh := recip rhs eq) case "failed" => "failed"
+          [lh :: S, rh :: S]
+
+        leftOne eq ==
+          (re := recip lhs eq) case "failed" => "failed"
+          1 = rhs eq * re
+
+        rightOne eq ==
+          (re := recip rhs eq) case "failed" => "failed"
+          lhs eq * re = 1
+
+    if S has Group then
+
+        inv eq == [inv lhs eq, inv rhs eq]
+
+        leftOne eq == 1 = rhs eq * inv rhs eq
+
+        rightOne eq == lhs eq * inv rhs eq = 1
+
+    if S has Ring then
+
+        characteristic() == characteristic()$S
+
+        i:Integer * eq:$ == (i::S) * eq
+
+    if S has IntegralDomain then
+
+        factorAndSplit eq ==
+          (S has factor : S -> Factored S) =>
+            eq0 := rightZero eq
+            [equation(rcf.factor,0) for rcf in factors factor lhs eq0]
+          (S has Polynomial Integer) =>
+            eq0 := rightZero eq
+            MF ==> MultivariateFactorize(Symbol, IndexedExponents Symbol, _
+               Integer, Polynomial Integer)
+            p : Polynomial Integer := (lhs eq0) pretend Polynomial Integer
+            [equation((rcf.factor) pretend S,0) _
+              for rcf in factors factor(p)$MF]
+          [eq]
+
+    if S has PartialDifferentialRing(Symbol) then
+
+        differentiate(eq:$, sym:Symbol):$ ==
+           [differentiate(lhs eq, sym), differentiate(rhs eq, sym)]
+
+    if S has Field then
+
+        dimension() == 2 :: CardinalNumber
+
+        eq1:$ / eq2:$ == eq1.lhs / eq2.lhs = eq1.rhs / eq2.rhs
+
+        inv eq == [inv lhs eq, inv rhs eq]
+
+    if S has ExpressionSpace then
+
+        subst(eq1,eq2) ==
+            eq3 := eq2 pretend Equation S
+            [subst(lhs eq1,eq3),subst(rhs eq1,eq3)]
+
 *)
 
 \end{chunk}
@@ -48472,6 +53677,7 @@ EuclideanModularRing(S,R,Mod,reduction:(R,Mod) -> R,
 
     --representation
       Rep:= Record(val:R,modulo:Mod)
+
     --declarations
       x,y,z: %
 
@@ -48481,7 +53687,6 @@ EuclideanModularRing(S,R,Mod,reduction:(R,Mod) -> R,
         xm:=t::Mod
         yv:=y.val
         invlcy:R
---        if one? leadingCoefficient yv then invlcy:=1
         if (leadingCoefficient yv = 1) then invlcy:=1
         else
           invlcy:=(inv reduce((leadingCoefficient yv)::R,xm)).val
@@ -48490,13 +53695,13 @@ EuclideanModularRing(S,R,Mod,reduction:(R,Mod) -> R,
         [reduce(invlcy*r.quotient,xm),reduce(r.remainder,xm)]
 
       if R has fmecg:(R,NonNegativeInteger,S,R)->R
+
          then x rem y  ==
            t:=merge(x.modulo,y.modulo)
            t case "failed" => error "incompatible moduli"
            xm:=t::Mod
            yv:=y.val
            invlcy:R
---           if not one? leadingCoefficient yv then
            if not (leadingCoefficient yv = 1) then
              invlcy:=(inv reduce((leadingCoefficient yv)::R,xm)).val
              yv:=reduction(invlcy*yv,xm)
@@ -48507,13 +53712,13 @@ EuclideanModularRing(S,R,Mod,reduction:(R,Mod) -> R,
                                      leadingCoefficient xv,yv),xm)
                  xv = 0 => return [xv,xm]$Rep
            [xv,xm]$Rep
+
          else x rem y  == 
            t:=merge(x.modulo,y.modulo)
            t case "failed" => error "incompatible moduli"
            xm:=t::Mod
            yv:=y.val
            invlcy:R
---           if not one? leadingCoefficient yv then
            if not (leadingCoefficient yv = 1) then
              invlcy:=(inv reduce((leadingCoefficient yv)::R,xm)).val
              yv:=reduction(invlcy*yv,xm)
@@ -48525,13 +53730,11 @@ EuclideanModularRing(S,R,Mod,reduction:(R,Mod) -> R,
       unitCanonical x ==
         zero? x => x
         degree(x.val) = 0 => 1
---        one? leadingCoefficient(x.val) => x
         (leadingCoefficient(x.val) = 1) => x
         invlcx:%:=inv reduce((leadingCoefficient(x.val))::R,x.modulo)
         invlcx * x
 
       unitNormal x ==
---        zero?(x) or one?(leadingCoefficient(x.val)) => [1, x, 1]
         zero?(x) or ((leadingCoefficient(x.val)) = 1) => [1, x, 1]
         lcx := reduce((leadingCoefficient(x.val))::R,x.modulo)
         invlcx:=inv lcx
@@ -48545,6 +53748,75 @@ EuclideanModularRing(S,R,Mod,reduction:(R,Mod) -> R,
 \begin{chunk}{COQ EMR}
 (* domain EMR *)
 (*
+
+    --representation
+      Rep:= Record(val:R,modulo:Mod)
+
+    --declarations
+      x,y,z: %
+
+      divide(x,y) ==
+        t:=merge(x.modulo,y.modulo)
+        t case "failed" => error "incompatible moduli"
+        xm:=t::Mod
+        yv:=y.val
+        invlcy:R
+        if (leadingCoefficient yv = 1) then invlcy:=1
+        else
+          invlcy:=(inv reduce((leadingCoefficient yv)::R,xm)).val
+          yv:=reduction(invlcy*yv,xm)
+        r:=monicDivide(x.val,yv)
+        [reduce(invlcy*r.quotient,xm),reduce(r.remainder,xm)]
+
+      if R has fmecg:(R,NonNegativeInteger,S,R)->R
+
+         then x rem y  ==
+           t:=merge(x.modulo,y.modulo)
+           t case "failed" => error "incompatible moduli"
+           xm:=t::Mod
+           yv:=y.val
+           invlcy:R
+           if not (leadingCoefficient yv = 1) then
+             invlcy:=(inv reduce((leadingCoefficient yv)::R,xm)).val
+             yv:=reduction(invlcy*yv,xm)
+           dy:=degree yv
+           xv:=x.val
+           while (d:=degree xv - dy)>=0 repeat
+                 xv:=reduction(fmecg(xv,d::NonNegativeInteger,
+                                     leadingCoefficient xv,yv),xm)
+                 xv = 0 => return [xv,xm]$Rep
+           [xv,xm]$Rep
+
+         else x rem y  == 
+           t:=merge(x.modulo,y.modulo)
+           t case "failed" => error "incompatible moduli"
+           xm:=t::Mod
+           yv:=y.val
+           invlcy:R
+           if not (leadingCoefficient yv = 1) then
+             invlcy:=(inv reduce((leadingCoefficient yv)::R,xm)).val
+             yv:=reduction(invlcy*yv,xm)
+           r:=monicDivide(x.val,yv)
+           reduce(r.remainder,xm)
+
+      euclideanSize x == degree x.val
+
+      unitCanonical x ==
+        zero? x => x
+        degree(x.val) = 0 => 1
+        (leadingCoefficient(x.val) = 1) => x
+        invlcx:%:=inv reduce((leadingCoefficient(x.val))::R,x.modulo)
+        invlcx * x
+
+      unitNormal x ==
+        zero?(x) or ((leadingCoefficient(x.val)) = 1) => [1, x, 1]
+        lcx := reduce((leadingCoefficient(x.val))::R,x.modulo)
+        invlcx:=inv lcx
+        degree(x.val) = 0 => [lcx, 1, invlcx]
+        [lcx, invlcx * x, invlcx]
+
+      elt(x : %,s : R) : R == reduction(elt(x.val,s),x.modulo)
+
 *)
 
 \end{chunk}
@@ -48702,7 +53974,9 @@ o )show Exit
 ++ one half of a type-balanced \spad{if}.
 
 Exit: SetCategory == add
+
         coerce(n:%) == error "Cannot use an Exit value."
+
         n1 = n2     == error "Cannot use an Exit value."
 
 \end{chunk}
@@ -48710,6 +53984,11 @@ Exit: SetCategory == add
 \begin{chunk}{COQ EXIT}
 (* domain EXIT *)
 (*
+
+        coerce(n:%) == error "Cannot use an Exit value."
+
+        n1 = n2     == error "Cannot use an Exit value."
+
 *)
 
 \end{chunk}
@@ -49004,10 +54283,15 @@ ExponentialExpansion(R,FE,var,cen): Exports == Implementation where
       ++ an \spadtype{ExponentialExpansion}.
 
   Implementation ==> Fraction(UPXSSING) add
+
     coeff : Term -> UPXS
+
     exponent : Term -> EXPUPXS
+
     upxssingIfCan : % -> Union(UPXSSING,"failed")
+
     seriesQuotientLimit: (UPXS,UPXS) -> Union(OFE,"failed")
+
     seriesQuotientInfinity: (UPXS,UPXS) -> Union(OFE,"failed")
 
     Rep := Fraction UPXSSING
@@ -49015,13 +54299,13 @@ ExponentialExpansion(R,FE,var,cen): Exports == Implementation where
     ZEROCOUNT : RN := 1000/1
 
     coeff term == term.%coef
+
     exponent term == term.%expon
 
     --!! why is this necessary?
     --!! code can run forever in retractIfCan if original assignment
     --!! for 'ff' is used
     upxssingIfCan f ==
---      one? denom f => numer f
       (denom f = 1) => numer f
       "failed"
 
@@ -49110,6 +54394,113 @@ ExponentialExpansion(R,FE,var,cen): Exports == Implementation where
 \begin{chunk}{COQ EXPEXPAN}
 (* domain EXPEXPAN *)
 (*
+ Fraction(UPXSSING) add
+
+    coeff : Term -> UPXS
+
+    exponent : Term -> EXPUPXS
+
+    upxssingIfCan : % -> Union(UPXSSING,"failed")
+
+    seriesQuotientLimit: (UPXS,UPXS) -> Union(OFE,"failed")
+
+    seriesQuotientInfinity: (UPXS,UPXS) -> Union(OFE,"failed")
+
+    Rep := Fraction UPXSSING
+
+    ZEROCOUNT : RN := 1000/1
+
+    coeff term == term.%coef
+
+    exponent term == term.%expon
+
+    --!! why is this necessary?
+    --!! code can run forever in retractIfCan if original assignment
+    --!! for 'ff' is used
+    upxssingIfCan f ==
+      (denom f = 1) => numer f
+      "failed"
+
+    retractIfCan(f:%):Union(UPXS,"failed") ==
+      --ff := (retractIfCan$Rep)(f)@Union(UPXSSING,"failed")
+      --ff case "failed" => "failed"
+      (ff := upxssingIfCan f) case "failed" => "failed"
+      (fff := retractIfCan(ff::UPXSSING)@Union(UPXS,"failed")) case "failed" =>
+        "failed"
+      fff :: UPXS
+
+    f:UPXSSING / g:UPXSSING ==
+      (rec := recip g) case "failed" => f /$Rep g
+      f * (rec :: UPXSSING) :: %
+
+    f:% / g:% ==
+      (rec := recip numer g) case "failed" => f /$Rep g
+      (rec :: UPXSSING) * (denom g) * f
+
+    coerce(f:UPXS) == f :: UPXSSING :: %
+
+    seriesQuotientLimit(num,den) ==
+      -- limit of the quotient of two series
+      series := num / den
+      (ord := order(series,1)) > 0 => 0
+      coef := coefficient(series,ord)
+      member?(var,variables coef) => "failed"
+      ord = 0 => coef :: OFE
+      (sig := sign(coef)$SIGNEF) case "failed" => return "failed"
+      (sig :: Integer) = 1 => plusInfinity()
+      minusInfinity()
+
+    seriesQuotientInfinity(num,den) ==
+      -- infinite limit: plus or minus?
+      -- look at leading coefficients of series to tell
+      (numOrd := order(num,ZEROCOUNT)) = ZEROCOUNT => "failed"
+      (denOrd := order(den,ZEROCOUNT)) = ZEROCOUNT => "failed"
+      cc := coefficient(num,numOrd)/coefficient(den,denOrd)
+      member?(var,variables cc) => "failed"
+      (sig := sign(cc)$SIGNEF) case "failed" => return "failed"
+      (sig :: Integer) = 1 => plusInfinity()
+      minusInfinity()
+
+    limitPlus f ==
+      zero? f => 0
+      (den := denom f) = 1 => limitPlus numer f
+      (numerTerm := dominantTerm(num := numer f)) case "failed" => "failed"
+      numType := (numTerm := numerTerm :: TypedTerm).%type
+      (denomTerm := dominantTerm den) case "failed" => "failed"
+      denType := (denTerm := denomTerm :: TypedTerm).%type
+      numExpon := exponent numTerm.%term; denExpon := exponent denTerm.%term
+      numCoef := coeff numTerm.%term; denCoef := coeff denTerm.%term
+      -- numerator tends to zero exponentially
+      (numType = "zero") =>
+        -- denominator tends to zero exponentially
+        (denType = "zero") =>
+          (exponDiff := numExpon - denExpon) = 0 =>
+            seriesQuotientLimit(numCoef,denCoef)
+          expCoef := coefficient(exponDiff,order exponDiff)
+          (sig := sign(expCoef)$SIGNEF) case "failed" => return "failed"
+          (sig :: Integer) = -1 => 0
+          seriesQuotientInfinity(numCoef,denCoef)
+        0 -- otherwise limit is zero
+      -- numerator is a Puiseux series
+      (numType = "series") =>
+        -- denominator tends to zero exponentially
+        (denType = "zero") =>
+          seriesQuotientInfinity(numCoef,denCoef)
+        -- denominator is a series
+        (denType = "series") => seriesQuotientLimit(numCoef,denCoef)
+        0
+      -- remaining case: numerator tends to infinity exponentially
+      -- denominator tends to infinity exponentially
+      (denType = "infinity") =>
+        (exponDiff := numExpon - denExpon) = 0 =>
+          seriesQuotientLimit(numCoef,denCoef)
+        expCoef := coefficient(exponDiff,order exponDiff)
+        (sig := sign(expCoef)$SIGNEF) case "failed" => return "failed"
+        (sig :: Integer) = -1 => 0
+        seriesQuotientInfinity(numCoef,denCoef)
+      -- denominator tends to zero exponentially or is a series
+      seriesQuotientInfinity(numCoef,denCoef)
+
 *)
 
 \end{chunk}
@@ -49949,9 +55340,11 @@ Expression(R:OrderedSet): Exports == Implementation where
       if R has RetractableTo Integer then RetractableTo AN
 
   Implementation ==> add
+
     import KernelFunctions2(R, %)
 
     retNotUnit     : % -> R
+
     retNotUnitIfCan: % -> Union(R, "failed")
 
     belong? op == true
@@ -49965,26 +55358,43 @@ Expression(R:OrderedSet): Exports == Implementation where
       constantIfCan(r::K)
 
     if R has IntegralDomain then
+
       reduc  : (%, List Kernel %) -> %
+
       commonk   : (%, %) -> List K
+
       commonk0  : (List K, List K) -> List K
+
       toprat    : % -> %
+
       algkernels: List K -> List K
+
       evl       : (MP, K, SparseUnivariatePolynomial %) -> Fraction MP
+
       evl0      : (MP, K) -> SparseUnivariatePolynomial Fraction MP
 
       Rep := Fraction MP
+
       0                == 0$Rep
+
       1                == 1$Rep
---      one? x           == one?(x)$Rep
+
       one? x           == (x = 1)$Rep
+
       zero? x          == zero?(x)$Rep
+
       - x:%            == -$Rep x
+
       n:Integer * x:%  == n *$Rep x
+
       coerce(n:Integer) ==  coerce(n)$Rep@Rep::%
+
       x:% * y:%        == reduc(x *$Rep y, commonk(x, y))
+
       x:% + y:%        == reduc(x +$Rep y, commonk(x, y))
+
       (x:% - y:%):%    == reduc(x -$Rep y, commonk(x, y))
+
       x:% / y:%        == reduc(x /$Rep y, commonk(x, y))
 
       number?(x:%):Boolean ==
@@ -50023,13 +55433,21 @@ Expression(R:OrderedSet): Exports == Implementation where
            simplifyPower(denominator x,n pretend Integer)
 
       x:% < y:%        == x <$Rep y
+
       x:% = y:%        == x =$Rep y
+
       numer x          == numer(x)$Rep
+
       denom x          == denom(x)$Rep
+
       coerce(p:MP):%   == coerce(p)$Rep
+
       reduce x         == reduc(x, algkernels kernels x)
+
       commonk(x, y)    == commonk0(algkernels kernels x, algkernels kernels y)
+
       algkernels l     == select_!(x +-> has?(operator x, ALGOP), l)
+
       toprat f == ratDenom(f,algkernels kernels f)$AlgebraicManipulations(R, %)
 
       x:MP / y:MP ==
@@ -50056,67 +55474,123 @@ Expression(R:OrderedSet): Exports == Implementation where
         ans
 
       rootOf(x:SparseUnivariatePolynomial %, v:Symbol) == rootOf(x,v)$AF
+
       pi()                      == pi()$EF
+
       exp x                     == exp(x)$EF
+
       log x                     == log(x)$EF
+
       sin x                     == sin(x)$EF
+
       cos x                     == cos(x)$EF
+
       tan x                     == tan(x)$EF
+
       cot x                     == cot(x)$EF
+
       sec x                     == sec(x)$EF
+
       csc x                     == csc(x)$EF
+
       asin x                    == asin(x)$EF
+
       acos x                    == acos(x)$EF
+
       atan x                    == atan(x)$EF
+
       acot x                    == acot(x)$EF
+
       asec x                    == asec(x)$EF
+
       acsc x                    == acsc(x)$EF
+
       sinh x                    == sinh(x)$EF
+
       cosh x                    == cosh(x)$EF
+
       tanh x                    == tanh(x)$EF
+
       coth x                    == coth(x)$EF
+
       sech x                    == sech(x)$EF
+
       csch x                    == csch(x)$EF
+
       asinh x                   == asinh(x)$EF
+
       acosh x                   == acosh(x)$EF
+
       atanh x                   == atanh(x)$EF
+
       acoth x                   == acoth(x)$EF
+
       asech x                   == asech(x)$EF
+
       acsch x                   == acsch(x)$EF
 
       abs x                     == abs(x)$FSF
+
       Gamma x                   == Gamma(x)$FSF
+
       Gamma(a, x)               == Gamma(a, x)$FSF
+
       Beta(x,y)                 == Beta(x,y)$FSF
+
       digamma x                 == digamma(x)$FSF
+
       polygamma(k,x)            == polygamma(k,x)$FSF
+
       besselJ(v,x)              == besselJ(v,x)$FSF
+
       besselY(v,x)              == besselY(v,x)$FSF
+
       besselI(v,x)              == besselI(v,x)$FSF
+
       besselK(v,x)              == besselK(v,x)$FSF
+
       airyAi x                  == airyAi(x)$FSF
+
       airyBi x                  == airyBi(x)$FSF
 
       x:% ** y:%                == x **$CF y
+
       factorial x               == factorial(x)$CF
+
       binomial(n, m)            == binomial(n, m)$CF
+
       permutation(n, m)         == permutation(n, m)$CF
+
       factorials x              == factorials(x)$CF
+
       factorials(x, n)          == factorials(x, n)$CF
+
       summation(x:%, n:Symbol)           == summation(x, n)$CF
+
       summation(x:%, s:SegmentBinding %) == summation(x, s)$CF
+
       product(x:%, n:Symbol)             == product(x, n)$CF
+
       product(x:%, s:SegmentBinding %)   == product(x, s)$CF
 
       erf x                              == erf(x)$LF
+
       Ei x                               == Ei(x)$LF
+
       Si x                               == Si(x)$LF
+
       Ci x                               == Ci(x)$LF
+
       li x                               == li(x)$LF
+
       dilog x                            == dilog(x)$LF
+
       fresnelS x                         == fresnelS(x)$LF
+
       fresnelC x                         == fresnelC(x)$LF
+
       integral(x:%, n:Symbol)            == integral(x, n)$LF
+
       integral(x:%, s:SegmentBinding %)  == integral(x, s)$LF
 
       operator op ==
@@ -50147,9 +55621,10 @@ Expression(R:OrderedSet): Exports == Implementation where
       evl(p, k, m) ==
         degree(p, k) < degree m => p::Fraction(MP)
         (((evl0(p, k) pretend SparseUnivariatePolynomial($)) rem m)
-           pretend SparseUnivariatePolynomial Fraction MP) (k::MP::Fraction(MP))
+          pretend SparseUnivariatePolynomial Fraction MP) (k::MP::Fraction(MP))
 
       if R has GcdDomain then
+
         noalg?: SUP % -> Boolean
 
         noalg? p ==
@@ -50179,21 +55654,32 @@ Expression(R:OrderedSet): Exports == Implementation where
         coerce(x:AN):% == (monomial(x, 0$IndexedExponents(K))$MP)::%
 
       if (R has RetractableTo Integer) then
+
         x:% ** r:Q                           == x **$AF r
+
         minPoly k                            == minPoly(k)$AF
+
         definingPolynomial x                 == definingPolynomial(x)$AF
+
         retract(x:%):Q                       == retract(x)$Rep
+
         retractIfCan(x:%):Union(Q, "failed") == retractIfCan(x)$Rep
 
         if not(R is AN) then
+
           k2expr  : KAN -> %
+
           smp2expr: SparseMultivariatePolynomial(Integer, KAN) -> %
+
           R2AN    : R  -> Union(AN, "failed")
+
           k2an    : K  -> Union(AN, "failed")
+
           smp2an  : MP -> Union(AN, "failed")
 
 
           coerce(x:AN):% == smp2expr(numer x) / smp2expr(denom x)
+
           k2expr k       == map(x+->x::%, k)$ExpressionSpaceFunctions2(AN, %)
 
           smp2expr p ==
@@ -50225,17 +55711,22 @@ Expression(R:OrderedSet): Exports == Implementation where
             (t  := k2an k) case "failed" => "failed"
             ans:AN := 0
             while not ground? up repeat
-              (c:=smp2an leadingCoefficient up) case "failed" => return "failed"
+              (c:=smp2an leadingCoefficient up) case "failed" _
+                => return "failed"
               ans := ans + (c::AN) * (t::AN) ** (degree up)
               up  := reductum up
             (c := smp2an leadingCoefficient up) case "failed" => "failed"
             ans + c::AN
 
       if R has ConvertibleTo InputForm then
+
         convert(x:%):InputForm == convert(x)$Rep
+
         import MakeUnaryCompiledFunction(%, %, %)
+
         eval(f:%, op: BasicOperator, g:%, x:Symbol):% == 
           eval(f,[op],[g],x)
+
         eval(f:%, ls:List BasicOperator, lg:List %, x:Symbol) ==
           -- handle subsrcipted symbols by renaming -> eval -> renaming back
           llsym:List List Symbol:=[variables g for g in lg]
@@ -50243,22 +55734,28 @@ Expression(R:OrderedSet): Exports == Implementation where
           lsd:List Symbol:=select (scripted?,lsym)
           empty? lsd=> eval(f,ls,[compiledFunction(g, x) for g in lg])
           ns:List Symbol:=[new()$Symbol for i in lsd]
-          lforwardSubs:List Equation % := [(i::%)= (j::%) for i in lsd for j in ns]
-          lbackwardSubs:List Equation % := [(j::%)= (i::%) for i in lsd for j in ns]
+          lforwardSubs:List Equation % := _
+            [(i::%)= (j::%) for i in lsd for j in ns]
+          lbackwardSubs:List Equation % := _
+            [(j::%)= (i::%) for i in lsd for j in ns]
           nlg:List % :=[subst(g,lforwardSubs) for g in lg]
           res:% :=eval(f, ls, [compiledFunction(g, x) for g in nlg])
           subst(res,lbackwardSubs)
+
       if R has PatternMatchable Integer then
+
         patternMatch(x:%, p:Pattern Integer,
          l:PatternMatchResult(Integer, %)) ==
           patternMatch(x, p, l)$PatternMatchFunctionSpace(Integer, R, %)
 
       if R has PatternMatchable Float then
+
         patternMatch(x:%, p:Pattern Float,
          l:PatternMatchResult(Float, %)) ==
           patternMatch(x, p, l)$PatternMatchFunctionSpace(Float, R, %)
 
     else  -- R is not an integral domain
+
       operator op ==
         belong?(op)$FSD => operator(op)$FSD
         belong?(op)$ESD => operator(op)$ESD
@@ -50267,16 +55764,27 @@ Expression(R:OrderedSet): Exports == Implementation where
         operator(name op, n::NonNegativeInteger)
 
       if R has Ring then
+
         Rep := MP
+
         0              == 0$Rep
+
         1              == 1$Rep
+
         - x:%          == -$Rep x
+
         n:Integer *x:% == n *$Rep x
+
         x:% * y:%      == x *$Rep y
+
         x:% + y:%      == x +$Rep y
+
         x:% = y:%      == x =$Rep y
+
         x:% < y:%      == x <$Rep y
+
         numer x        == x@Rep
+
         coerce(p:MP):% == p
 
         reducedSystem(m:Matrix %):Matrix(R) ==
@@ -50287,9 +55795,11 @@ Expression(R:OrderedSet): Exports == Implementation where
           reducedSystem(m, v)$Rep
 
         if R has ConvertibleTo InputForm then
+
           convert(x:%):InputForm == convert(x)$Rep
 
         if R has PatternMatchable Integer then
+
           kintmatch: (K,Pattern Integer,PatternMatchResult(Integer,Rep))
                                      -> PatternMatchResult(Integer, Rep)
 
@@ -50308,6 +55818,7 @@ Expression(R:OrderedSet): Exports == Implementation where
                               pretend PatternMatchResult(Integer, %)
 
         if R has PatternMatchable Float then
+
           kfltmatch: (K, Pattern Float, PatternMatchResult(Float, Rep))
                                      -> PatternMatchResult(Float, Rep)
 
@@ -50326,23 +55837,35 @@ Expression(R:OrderedSet): Exports == Implementation where
                               pretend PatternMatchResult(Float, %)
 
       else   -- R is not even a ring
+
         if R has AbelianMonoid then
+
           import ListToMap(K, %)
 
           kereval        : (K, List K, List %) -> %
+
           subeval        : (K, List K, List %) -> %
 
           Rep := FreeAbelianGroup K
 
           0              == 0$Rep
+
           x:% + y:%      == x +$Rep y
+
           x:% = y:%      == x =$Rep y
+
           x:% < y:%      == x <$Rep y
+
           coerce(k:K):%  == coerce(k)$Rep
+
           kernels x      == [f.gen for f in terms x]
+
           coerce(x:R):%  == (zero? x => 0; constantKernel(x)::%)
+
           retract(x:%):R == (zero? x => 0; retNotUnit x)
+
           coerce(x:%):OutputForm == coerce(x)$Rep
+
           kereval(k, lk, lv) == 
            match(lk, lv, k, (x2:K):% +-> map(x1 +-> eval(x1, lk, lv), x2))
 
@@ -50372,36 +55895,26 @@ Expression(R:OrderedSet): Exports == Implementation where
 
           if R has AbelianGroup then -(x:%) == -$Rep x
 
---      else      -- R is not an AbelianMonoid
---        if R has SemiGroup then
---    Rep := FreeGroup K
---    1              == 1$Rep
---    x:% * y:%      == x *$Rep y
---    x:% = y:%      == x =$Rep y
---    coerce(k:K):%  == k::Rep
---    kernels x      == [f.gen for f in factors x]
---    coerce(x:R):%  == (one? x => 1; constantKernel x)
---    retract(x:%):R == (one? x => 1; retNotUnit x)
---    coerce(x:%):OutputForm == coerce(x)$Rep
-
---    retractIfCan(x:%):Union(R, "failed") ==
---      one? x => 1
---      retNotUnitIfCan x
-
---    if R has Group then inv(x:%):% == inv(x)$Rep
-
         else   -- R is nothing
+
             import ListToMap(K, %)
 
             Rep := K
 
             x:% < y:%      == x <$Rep y
+
             x:% = y:%      == x =$Rep y
+
             coerce(k:K):%  == k
+
             kernels x      == [x pretend K]
+
             coerce(x:R):%  == constantKernel x
+
             retract(x:%):R == retNotUnit x
+
             retractIfCan(x:%):Union(R, "failed") == retNotUnitIfCan x
+
             coerce(x:%):OutputForm               == coerce(x)$Rep
 
             eval(x:%, lk:List K, lv:List %) ==
@@ -50416,25 +55929,600 @@ Expression(R:OrderedSet): Exports == Implementation where
             if R has ConvertibleTo InputForm then
               convert(x:%):InputForm == convert(x)$Rep
 
---          if R has PatternMatchable Integer then
---            convert(x:%):Pattern(Integer) == convert(x)$Rep
---
---            patternMatch(x:%, p:Pattern Integer,
---             l:PatternMatchResult(Integer, %)) ==
---              patternMatch(x pretend K,p,l)$PatternMatchKernel(Integer, %)
---
---          if R has PatternMatchable Float then
---            convert(x:%):Pattern(Float) == convert(x)$Rep
---
---            patternMatch(x:%, p:Pattern Float,
---             l:PatternMatchResult(Float, %)) ==
---              patternMatch(x pretend K, p, l)$PatternMatchKernel(Float, %)
-
 \end{chunk}
 
 \begin{chunk}{COQ EXPR}
 (* domain EXPR *)
 (*
+
+    import KernelFunctions2(R, %)
+
+    retNotUnit     : % -> R
+
+    retNotUnitIfCan: % -> Union(R, "failed")
+
+    belong? op == true
+
+    retNotUnit x ==
+      (u := constantIfCan(k := retract(x)@K)) case R => u::R
+      error "Not retractable"
+
+    retNotUnitIfCan x ==
+      (r := retractIfCan(x)@Union(K,"failed")) case "failed" => "failed"
+      constantIfCan(r::K)
+
+    if R has IntegralDomain then
+
+      reduc  : (%, List Kernel %) -> %
+
+      commonk   : (%, %) -> List K
+
+      commonk0  : (List K, List K) -> List K
+
+      toprat    : % -> %
+
+      algkernels: List K -> List K
+
+      evl       : (MP, K, SparseUnivariatePolynomial %) -> Fraction MP
+
+      evl0      : (MP, K) -> SparseUnivariatePolynomial Fraction MP
+
+      Rep := Fraction MP
+
+      0                == 0$Rep
+
+      1                == 1$Rep
+
+      one? x           == (x = 1)$Rep
+
+      zero? x          == zero?(x)$Rep
+
+      - x:%            == -$Rep x
+
+      n:Integer * x:%  == n *$Rep x
+
+      coerce(n:Integer) ==  coerce(n)$Rep@Rep::%
+
+      x:% * y:%        == reduc(x *$Rep y, commonk(x, y))
+
+      x:% + y:%        == reduc(x +$Rep y, commonk(x, y))
+
+      (x:% - y:%):%    == reduc(x -$Rep y, commonk(x, y))
+
+      x:% / y:%        == reduc(x /$Rep y, commonk(x, y))
+
+      number?(x:%):Boolean ==
+        if R has RetractableTo(Integer) then
+          ground?(x) or ((retractIfCan(x)@Union(Q,"failed")) case Q)
+        else
+          ground?(x)
+
+      simplifyPower(x:%,n:Integer):% ==
+        k : List K := kernels x
+        is?(x,POWER) =>
+          -- Look for a power of a number in case we can do a simplification
+          args : List % := argument first k
+          not(#args = 2) => error "Too many arguments to **"
+          number?(args.1) =>
+             reduc((args.1) **$Rep n, algkernels kernels (args.1))**(args.2)
+          (first args)**(n*second(args))
+        reduc(x **$Rep n, algkernels k)
+
+      x:% ** n:NonNegativeInteger ==
+        n = 0 => 1$%
+        n = 1 => x
+        simplifyPower(numerator x,n pretend Integer) / 
+           simplifyPower(denominator x,n pretend Integer)
+
+      x:% ** n:Integer ==
+        n = 0 => 1$%
+        n = 1 => x
+        n = -1 => 1/x
+        simplifyPower(numerator x,n) / 
+           simplifyPower(denominator x,n)
+
+      x:% ** n:PositiveInteger == 
+        n = 1 => x
+        simplifyPower(numerator x,n pretend Integer) / 
+           simplifyPower(denominator x,n pretend Integer)
+
+      x:% < y:%        == x <$Rep y
+
+      x:% = y:%        == x =$Rep y
+
+      numer x          == numer(x)$Rep
+
+      denom x          == denom(x)$Rep
+
+      coerce(p:MP):%   == coerce(p)$Rep
+
+      reduce x         == reduc(x, algkernels kernels x)
+
+      commonk(x, y)    == commonk0(algkernels kernels x, algkernels kernels y)
+
+      algkernels l     == select_!(x +-> has?(operator x, ALGOP), l)
+
+      toprat f == ratDenom(f,algkernels kernels f)$AlgebraicManipulations(R, %)
+
+      x:MP / y:MP ==
+       reduc(x /$Rep y,commonk0(algkernels variables x,algkernels variables y))
+
+-- since we use the reduction from FRAC SMP which asssumes that the
+-- variables are independent, we must remove algebraic from the denominators
+      reducedSystem(m:Matrix %):Matrix(R) ==
+        mm:Matrix(MP) := reducedSystem(map(toprat, m))$Rep
+        reducedSystem(mm)$MP
+
+-- since we use the reduction from FRAC SMP which asssumes that the
+-- variables are independent, we must remove algebraic from the denominators
+      reducedSystem(m:Matrix %, v:Vector %):
+       Record(mat:Matrix R, vec:Vector R) ==
+        r:Record(mat:Matrix MP, vec:Vector MP) :=
+          reducedSystem(map(toprat, m), map(toprat, v))$Rep
+        reducedSystem(r.mat, r.vec)$MP
+
+-- The result MUST be left sorted deepest first   MB 3/90
+      commonk0(x, y) ==
+        ans := empty()$List(K)
+        for k in reverse_! x repeat if member?(k, y) then ans := concat(k, ans)
+        ans
+
+      rootOf(x:SparseUnivariatePolynomial %, v:Symbol) == rootOf(x,v)$AF
+
+      pi()                      == pi()$EF
+
+      exp x                     == exp(x)$EF
+
+      log x                     == log(x)$EF
+
+      sin x                     == sin(x)$EF
+
+      cos x                     == cos(x)$EF
+
+      tan x                     == tan(x)$EF
+
+      cot x                     == cot(x)$EF
+
+      sec x                     == sec(x)$EF
+
+      csc x                     == csc(x)$EF
+
+      asin x                    == asin(x)$EF
+
+      acos x                    == acos(x)$EF
+
+      atan x                    == atan(x)$EF
+
+      acot x                    == acot(x)$EF
+
+      asec x                    == asec(x)$EF
+
+      acsc x                    == acsc(x)$EF
+
+      sinh x                    == sinh(x)$EF
+
+      cosh x                    == cosh(x)$EF
+
+      tanh x                    == tanh(x)$EF
+
+      coth x                    == coth(x)$EF
+
+      sech x                    == sech(x)$EF
+
+      csch x                    == csch(x)$EF
+
+      asinh x                   == asinh(x)$EF
+
+      acosh x                   == acosh(x)$EF
+
+      atanh x                   == atanh(x)$EF
+
+      acoth x                   == acoth(x)$EF
+
+      asech x                   == asech(x)$EF
+
+      acsch x                   == acsch(x)$EF
+
+      abs x                     == abs(x)$FSF
+
+      Gamma x                   == Gamma(x)$FSF
+
+      Gamma(a, x)               == Gamma(a, x)$FSF
+
+      Beta(x,y)                 == Beta(x,y)$FSF
+
+      digamma x                 == digamma(x)$FSF
+
+      polygamma(k,x)            == polygamma(k,x)$FSF
+
+      besselJ(v,x)              == besselJ(v,x)$FSF
+
+      besselY(v,x)              == besselY(v,x)$FSF
+
+      besselI(v,x)              == besselI(v,x)$FSF
+
+      besselK(v,x)              == besselK(v,x)$FSF
+
+      airyAi x                  == airyAi(x)$FSF
+
+      airyBi x                  == airyBi(x)$FSF
+
+      x:% ** y:%                == x **$CF y
+
+      factorial x               == factorial(x)$CF
+
+      binomial(n, m)            == binomial(n, m)$CF
+
+      permutation(n, m)         == permutation(n, m)$CF
+
+      factorials x              == factorials(x)$CF
+
+      factorials(x, n)          == factorials(x, n)$CF
+
+      summation(x:%, n:Symbol)           == summation(x, n)$CF
+
+      summation(x:%, s:SegmentBinding %) == summation(x, s)$CF
+
+      product(x:%, n:Symbol)             == product(x, n)$CF
+
+      product(x:%, s:SegmentBinding %)   == product(x, s)$CF
+
+      erf x                              == erf(x)$LF
+
+      Ei x                               == Ei(x)$LF
+
+      Si x                               == Si(x)$LF
+
+      Ci x                               == Ci(x)$LF
+
+      li x                               == li(x)$LF
+
+      dilog x                            == dilog(x)$LF
+
+      fresnelS x                         == fresnelS(x)$LF
+
+      fresnelC x                         == fresnelC(x)$LF
+
+      integral(x:%, n:Symbol)            == integral(x, n)$LF
+
+      integral(x:%, s:SegmentBinding %)  == integral(x, s)$LF
+
+      operator op ==
+        belong?(op)$AF  => operator(op)$AF
+        belong?(op)$EF  => operator(op)$EF
+        belong?(op)$CF  => operator(op)$CF
+        belong?(op)$LF  => operator(op)$LF
+        belong?(op)$FSF => operator(op)$FSF
+        belong?(op)$FSD => operator(op)$FSD
+        belong?(op)$ESD => operator(op)$ESD
+        nullary? op and has?(op, SYMBOL) => operator(kernel(name op)$K)
+        (n := arity op) case "failed" => operator name op
+        operator(name op, n::NonNegativeInteger)
+
+      reduc(x, l) ==
+        for k in l repeat
+          p := minPoly k
+          x := evl(numer x, k, p) /$Rep evl(denom x, k, p)
+        x
+
+      evl0(p, k) ==
+        numer univariate(p::Fraction(MP),
+                     k)$PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                                                            K,R,MP,Fraction MP)
+
+      -- uses some operations from Rep instead of % in order not to
+      -- reduce recursively during those operations.
+      evl(p, k, m) ==
+        degree(p, k) < degree m => p::Fraction(MP)
+        (((evl0(p, k) pretend SparseUnivariatePolynomial($)) rem m)
+          pretend SparseUnivariatePolynomial Fraction MP) (k::MP::Fraction(MP))
+
+      if R has GcdDomain then
+
+        noalg?: SUP % -> Boolean
+
+        noalg? p ==
+          while p ^= 0 repeat
+            not empty? algkernels kernels leadingCoefficient p => return false
+            p := reductum p
+          true
+
+        gcdPolynomial(p:SUP %, q:SUP %) ==
+          noalg? p and noalg? q => gcdPolynomial(p, q)$Rep
+          gcdPolynomial(p, q)$GcdDomain_&(%)
+
+        factorPolynomial(x:SUP %) : Factored SUP % ==
+          uf:= factor(x pretend SUP(Rep))$SupFractionFactorizer(
+                                          IndexedExponents K,K,R,MP)
+          uf pretend Factored SUP %
+
+        squareFreePolynomial(x:SUP %) : Factored SUP % ==
+          uf:= squareFree(x pretend SUP(Rep))$SupFractionFactorizer(
+                                          IndexedExponents K,K,R,MP)
+          uf pretend Factored SUP %
+
+      if R is AN then
+        -- this is to force the coercion R -> EXPR R to be used
+        -- instead of the coercioon AN -> EXPR R which loops.
+        -- simpler looking code will fail! MB 10/91
+        coerce(x:AN):% == (monomial(x, 0$IndexedExponents(K))$MP)::%
+
+      if (R has RetractableTo Integer) then
+
+        x:% ** r:Q                           == x **$AF r
+
+        minPoly k                            == minPoly(k)$AF
+
+        definingPolynomial x                 == definingPolynomial(x)$AF
+
+        retract(x:%):Q                       == retract(x)$Rep
+
+        retractIfCan(x:%):Union(Q, "failed") == retractIfCan(x)$Rep
+
+        if not(R is AN) then
+
+          k2expr  : KAN -> %
+
+          smp2expr: SparseMultivariatePolynomial(Integer, KAN) -> %
+
+          R2AN    : R  -> Union(AN, "failed")
+
+          k2an    : K  -> Union(AN, "failed")
+
+          smp2an  : MP -> Union(AN, "failed")
+
+
+          coerce(x:AN):% == smp2expr(numer x) / smp2expr(denom x)
+
+          k2expr k       == map(x+->x::%, k)$ExpressionSpaceFunctions2(AN, %)
+
+          smp2expr p ==
+            map(k2expr,x+->x::%,p)_
+              $PolynomialCategoryLifting(IndexedExponents KAN,
+                   KAN, Integer, SparseMultivariatePolynomial(Integer, KAN), %)
+
+          retractIfCan(x:%):Union(AN, "failed") ==
+            ((n:= smp2an numer x) case AN) and ((d:= smp2an denom x) case AN)
+                 => (n::AN) / (d::AN)
+            "failed"
+
+          R2AN r ==
+            (u := retractIfCan(r::%)@Union(Q, "failed")) case Q => u::Q::AN
+            "failed"
+
+          k2an k ==
+            not(belong?(op := operator k)$AN) => "failed"
+            arg:List(AN) := empty()
+            for x in argument k repeat
+              if (a := retractIfCan(x)@Union(AN, "failed")) case "failed" then
+                return "failed"
+              else arg := concat(a::AN, arg)
+            (operator(op)$AN) reverse_!(arg)
+
+          smp2an p ==
+            (x1 := mainVariable p) case "failed" => R2AN leadingCoefficient p
+            up := univariate(p, k := x1::K)
+            (t  := k2an k) case "failed" => "failed"
+            ans:AN := 0
+            while not ground? up repeat
+              (c:=smp2an leadingCoefficient up) case "failed" _
+                => return "failed"
+              ans := ans + (c::AN) * (t::AN) ** (degree up)
+              up  := reductum up
+            (c := smp2an leadingCoefficient up) case "failed" => "failed"
+            ans + c::AN
+
+      if R has ConvertibleTo InputForm then
+
+        convert(x:%):InputForm == convert(x)$Rep
+
+        import MakeUnaryCompiledFunction(%, %, %)
+
+        eval(f:%, op: BasicOperator, g:%, x:Symbol):% == 
+          eval(f,[op],[g],x)
+
+        eval(f:%, ls:List BasicOperator, lg:List %, x:Symbol) ==
+          -- handle subsrcipted symbols by renaming -> eval -> renaming back
+          llsym:List List Symbol:=[variables g for g in lg]
+          lsym:List Symbol:= removeDuplicates concat llsym
+          lsd:List Symbol:=select (scripted?,lsym)
+          empty? lsd=> eval(f,ls,[compiledFunction(g, x) for g in lg])
+          ns:List Symbol:=[new()$Symbol for i in lsd]
+          lforwardSubs:List Equation % := _
+            [(i::%)= (j::%) for i in lsd for j in ns]
+          lbackwardSubs:List Equation % := _
+            [(j::%)= (i::%) for i in lsd for j in ns]
+          nlg:List % :=[subst(g,lforwardSubs) for g in lg]
+          res:% :=eval(f, ls, [compiledFunction(g, x) for g in nlg])
+          subst(res,lbackwardSubs)
+
+      if R has PatternMatchable Integer then
+
+        patternMatch(x:%, p:Pattern Integer,
+         l:PatternMatchResult(Integer, %)) ==
+          patternMatch(x, p, l)$PatternMatchFunctionSpace(Integer, R, %)
+
+      if R has PatternMatchable Float then
+
+        patternMatch(x:%, p:Pattern Float,
+         l:PatternMatchResult(Float, %)) ==
+          patternMatch(x, p, l)$PatternMatchFunctionSpace(Float, R, %)
+
+    else  -- R is not an integral domain
+
+      operator op ==
+        belong?(op)$FSD => operator(op)$FSD
+        belong?(op)$ESD => operator(op)$ESD
+        nullary? op and has?(op, SYMBOL) => operator(kernel(name op)$K)
+        (n := arity op) case "failed" => operator name op
+        operator(name op, n::NonNegativeInteger)
+
+      if R has Ring then
+
+        Rep := MP
+
+        0              == 0$Rep
+
+        1              == 1$Rep
+
+        - x:%          == -$Rep x
+
+        n:Integer *x:% == n *$Rep x
+
+        x:% * y:%      == x *$Rep y
+
+        x:% + y:%      == x +$Rep y
+
+        x:% = y:%      == x =$Rep y
+
+        x:% < y:%      == x <$Rep y
+
+        numer x        == x@Rep
+
+        coerce(p:MP):% == p
+
+        reducedSystem(m:Matrix %):Matrix(R) ==
+          reducedSystem(m)$Rep
+
+        reducedSystem(m:Matrix %, v:Vector %):
+         Record(mat:Matrix R, vec:Vector R) ==
+          reducedSystem(m, v)$Rep
+
+        if R has ConvertibleTo InputForm then
+
+          convert(x:%):InputForm == convert(x)$Rep
+
+        if R has PatternMatchable Integer then
+
+          kintmatch: (K,Pattern Integer,PatternMatchResult(Integer,Rep))
+                                     -> PatternMatchResult(Integer, Rep)
+
+          kintmatch(k, p, l) ==
+            patternMatch(k, p, l pretend PatternMatchResult(Integer, %)
+              )$PatternMatchKernel(Integer, %)
+                pretend PatternMatchResult(Integer, Rep)
+
+          patternMatch(x:%, p:Pattern Integer,
+           l:PatternMatchResult(Integer, %)) ==
+            patternMatch(x@Rep, p,
+                         l pretend PatternMatchResult(Integer, Rep),
+                          kintmatch
+                           )$PatternMatchPolynomialCategory(Integer,
+                            IndexedExponents K, K, R, Rep)
+                              pretend PatternMatchResult(Integer, %)
+
+        if R has PatternMatchable Float then
+
+          kfltmatch: (K, Pattern Float, PatternMatchResult(Float, Rep))
+                                     -> PatternMatchResult(Float, Rep)
+
+          kfltmatch(k, p, l) ==
+            patternMatch(k, p, l pretend PatternMatchResult(Float, %)
+              )$PatternMatchKernel(Float, %)
+                pretend PatternMatchResult(Float, Rep)
+
+          patternMatch(x:%, p:Pattern Float,
+           l:PatternMatchResult(Float, %)) ==
+            patternMatch(x@Rep, p,
+                         l pretend PatternMatchResult(Float, Rep),
+                          kfltmatch
+                           )$PatternMatchPolynomialCategory(Float,
+                            IndexedExponents K, K, R, Rep)
+                              pretend PatternMatchResult(Float, %)
+
+      else   -- R is not even a ring
+
+        if R has AbelianMonoid then
+
+          import ListToMap(K, %)
+
+          kereval        : (K, List K, List %) -> %
+
+          subeval        : (K, List K, List %) -> %
+
+          Rep := FreeAbelianGroup K
+
+          0              == 0$Rep
+
+          x:% + y:%      == x +$Rep y
+
+          x:% = y:%      == x =$Rep y
+
+          x:% < y:%      == x <$Rep y
+
+          coerce(k:K):%  == coerce(k)$Rep
+
+          kernels x      == [f.gen for f in terms x]
+
+          coerce(x:R):%  == (zero? x => 0; constantKernel(x)::%)
+
+          retract(x:%):R == (zero? x => 0; retNotUnit x)
+
+          coerce(x:%):OutputForm == coerce(x)$Rep
+
+          kereval(k, lk, lv) == 
+           match(lk, lv, k, (x2:K):% +-> map(x1 +-> eval(x1, lk, lv), x2))
+
+          subeval(k, lk, lv) ==
+            match(lk, lv, k,
+             (x:K):% +->
+               kernel(operator x, [subst(a, lk, lv) for a in argument x]))
+
+          isPlus x ==
+            empty?(l := terms x) or empty? rest l => "failed"
+            [t.exp *$Rep t.gen for t in l]$List(%)
+
+          isMult x ==
+            empty?(l := terms x) or not empty? rest l => "failed"
+            t := first l
+            [t.exp, t.gen]
+
+          eval(x:%, lk:List K, lv:List %) ==
+            _+/[t.exp * kereval(t.gen, lk, lv) for t in terms x]
+
+          subst(x:%, lk:List K, lv:List %) ==
+            _+/[t.exp * subeval(t.gen, lk, lv) for t in terms x]
+
+          retractIfCan(x:%):Union(R, "failed") ==
+            zero? x => 0
+            retNotUnitIfCan x
+
+          if R has AbelianGroup then -(x:%) == -$Rep x
+
+        else   -- R is nothing
+
+            import ListToMap(K, %)
+
+            Rep := K
+
+            x:% < y:%      == x <$Rep y
+
+            x:% = y:%      == x =$Rep y
+
+            coerce(k:K):%  == k
+
+            kernels x      == [x pretend K]
+
+            coerce(x:R):%  == constantKernel x
+
+            retract(x:%):R == retNotUnit x
+
+            retractIfCan(x:%):Union(R, "failed") == retNotUnitIfCan x
+
+            coerce(x:%):OutputForm               == coerce(x)$Rep
+
+            eval(x:%, lk:List K, lv:List %) ==
+              match(lk, lv, x pretend K, 
+               (x1:K):% +-> map(x2 +-> eval(x2, lk, lv), x1))
+
+            subst(x, lk, lv) ==
+              match(lk, lv, x pretend K,
+               (x1:K):% +-> 
+                 kernel(operator x1, [subst(a, lk, lv) for a in argument x1]))
+
+            if R has ConvertibleTo InputForm then
+              convert(x:%):InputForm == convert(x)$Rep
+
 *)
 
 \end{chunk}
@@ -50771,7 +56859,9 @@ ExponentialOfUnivariatePuiseuxSeries(FE,var,cen):_
     Rep := UPXS
 
     exponential f == complete f
+
     exponent f == f pretend UPXS
+
     exponentialOrder f == order(exponent f,0)
 
     zero? f == empty? entries complete terms f
@@ -50798,6 +56888,34 @@ ExponentialOfUnivariatePuiseuxSeries(FE,var,cen):_
 \begin{chunk}{COQ EXPUPXS}
 (* domain EXPUPXS *)
 (*
+
+    Rep := UPXS
+
+    exponential f == complete f
+
+    exponent f == f pretend UPXS
+
+    exponentialOrder f == order(exponent f,0)
+
+    zero? f == empty? entries complete terms f
+
+    f = g ==
+    -- we redefine equality because we know that we are dealing with
+    -- a FINITE series, so there is no danger in computing all terms
+      (entries complete terms f) = (entries complete terms g)
+
+    f < g ==
+      zero? f => not zero? g
+      zero? g => false
+      (ordf := exponentialOrder f) > (ordg := exponentialOrder g) => true
+      ordf < ordg => false
+      (fCoef := coefficient(f,ordf)) = (gCoef := coefficient(g,ordg)) =>
+        reductum(f) < reductum(g)
+      fCoef < gCoef  -- this is "random" if FE is EXPR INT
+
+    coerce(f:%):OutputForm ==
+      ("%e" :: OutputForm) ** ((coerce$Rep)(complete f)@OutputForm)
+
 *)
 
 \end{chunk}
@@ -50938,7 +57056,9 @@ ExtAlgBasis(): Export == Implement where
         ++ by n generators.
  
    Implement == add
+
      Rep := L I
+
      x,y :  %
 
      x = y == x =$Rep y
@@ -50958,14 +57078,6 @@ ExtAlgBasis(): Export == Implement where
 
      exponents x      == copy(x @ Rep)
 
---   subscripts x     ==
---      cntr:I := 1
---      result: L I := []
---      for j in x repeat
---        if j = 1 then result := cons(cntr,result)
---        cntr:=cntr+1
---      reverse_! result
-
      Nul n            == [0 for i in 1..n]
 
      coerce x         == coerce(x @ Rep)$(L I)
@@ -50975,6 +57087,32 @@ ExtAlgBasis(): Export == Implement where
 \begin{chunk}{COQ EAB}
 (* domain EAB *)
 (*
+
+     Rep := L I
+
+     x,y :  %
+
+     x = y == x =$Rep y
+
+     x < y ==
+       null x            => not null y 
+       null y            => false
+       first x = first y => rest x < rest y
+       first x > first y
+
+     coerce(li:(L I)) == 
+       for x in li repeat
+         if x ^= 1 and x ^= 0 then error "coerce: values can only be 0 and 1"
+       li
+
+     degree x         == (_+/x)::NNI
+
+     exponents x      == copy(x @ Rep)
+
+     Nul n            == [0 for i in 1..n]
+
+     coerce x         == coerce(x @ Rep)$(L I)
+
 *)
 
 \end{chunk}
@@ -51129,6 +57267,59 @@ e04dgfAnnaType(): NumericalOptimizationCategory == Result add
 \begin{chunk}{COQ E04DGFA}
 (* domain E04DGFA *)
 (*
+  DF  ==> DoubleFloat
+  EF  ==> Expression Float
+  EDF  ==> Expression DoubleFloat
+  PDF  ==> Polynomial DoubleFloat
+  VPDF  ==> Vector Polynomial DoubleFloat
+  LDF  ==> List DoubleFloat
+  LOCDF  ==> List OrderedCompletion DoubleFloat
+  MDF  ==> Matrix DoubleFloat
+  MPDF  ==> Matrix Polynomial DoubleFloat
+  MF  ==> Matrix Float
+  MEF  ==> Matrix Expression Float
+  LEDF  ==> List Expression DoubleFloat
+  VEF  ==> Vector Expression Float
+  NOA  ==> Record(fn:EDF, init:LDF, lb:LOCDF, cf:LEDF, ub:LOCDF)
+  LSA  ==> Record(lfn:LEDF, init:LDF)
+  EF2  ==> ExpressionFunctions2
+  MI  ==> Matrix Integer
+  INT  ==> Integer
+  F  ==> Float
+  NNI  ==> NonNegativeInteger
+  S  ==> Symbol
+  LS  ==> List Symbol
+  MVCF  ==> MultiVariableCalculusFunctions
+  ESTOOLS2 ==> ExpertSystemToolsPackage2
+  SDF  ==> Stream DoubleFloat
+  LSDF  ==> List Stream DoubleFloat
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  OCDF  ==> OrderedCompletion DoubleFloat
+
+  Rep:=Result
+  import Rep, NagOptimisationPackage, ExpertSystemToolsPackage
+
+  measure(R:RoutinesTable,args:NOA) ==
+    string:String := "e04dgf is "
+    positive?(#(args.cf) + #(args.lb) + #(args.ub)) =>
+      string := concat(string,"unsuitable for constrained problems. ")
+      [0.0,string]
+    string := concat(string,"recommended")
+    [getMeasure(R,e04dgf@Symbol)$RoutinesTable, string]
+
+  numericalOptimization(args:NOA) ==
+    argsFn:EDF := args.fn
+    n:NNI := #(variables(argsFn)$EDF)
+    fu:DF := float(4373903597,-24,10)$DF
+    it:INT := max(50,5*n)
+    lin:DF := float(9,-1,10)$DF
+    ma:DF := float(1,20,10)$DF
+    op:DF := float(326,-14,10)$DF
+    x:MDF := mat(args.init,n)
+    ArgsFn:Expression Float := edf2ef(argsFn)
+    f:Union(fn:FileName,fp:Asp49(OBJFUN)) := [retract(ArgsFn)$Asp49(OBJFUN)]
+    e04dgf(n,1$DF,fu,it,lin,true,ma,op,1,1,n,0,x,-1,f)
+
 *)
 
 \end{chunk}
@@ -51264,12 +57455,14 @@ e04fdfAnnaType(): NumericalOptimizationCategory == Result add
       [0.0,string]
     n:NNI := #(variables(argsFn)$EDF)
     (n>1)@Boolean => 
-      string := concat(string,"unsuitable for single instances of multivariate problems. ")
+      string := concat(string,_
+                 "unsuitable for single instances of multivariate problems. ")
       [0.0,string]
     sumOfSquares(argsFn) case "failed" =>
       string := concat(string,"unsuitable.")
       [0.0,string]
-    string := concat(string,"recommended since the function is a sum of squares.")
+    string := concat(string,_
+                  "recommended since the function is a sum of squares.")
     [getMeasure(R,e04fdf@Symbol)$RoutinesTable, string]
 
   measure(R:RoutinesTable,args:LSA) ==
@@ -51282,7 +57475,7 @@ e04fdfAnnaType(): NumericalOptimizationCategory == Result add
     x := mat(args.init,1)
     (a := sumOfSquares(argsFn)) case EDF => 
       ArgsFn := vector([edf2ef(a)])$VEF
-      f : Union(fn:FileName,fp:Asp50(LSFUN1)) := [retract(ArgsFn)$Asp50(LSFUN1)]
+      f : Union(fn:FileName,fp:Asp50(LSFUN1)):= [retract(ArgsFn)$Asp50(LSFUN1)]
       out:Result := e04fdf(1,1,1,lw,x,-1,f)
       changeNameToObjf(fsumsq@Symbol,out)
     empty()$Result
@@ -51293,7 +57486,6 @@ e04fdfAnnaType(): NumericalOptimizationCategory == Result add
     n:NNI := #(variables(args))
     nn:INT := n
     lw:INT := 
---      one?(nn) => 9+5*m
       (nn = 1) => 9+5*m
       nn*(7+n+2*m+((nn-1) quo 2)$INT)+3*m
     x := mat(args.init,n)
@@ -51307,6 +57499,86 @@ e04fdfAnnaType(): NumericalOptimizationCategory == Result add
 \begin{chunk}{COQ E04FDFA}
 (* domain E04FDFA *)
 (*
+  DF  ==> DoubleFloat
+  EF  ==> Expression Float
+  EDF  ==> Expression DoubleFloat
+  PDF  ==> Polynomial DoubleFloat
+  VPDF  ==> Vector Polynomial DoubleFloat
+  LDF  ==> List DoubleFloat
+  LOCDF  ==> List OrderedCompletion DoubleFloat
+  MDF  ==> Matrix DoubleFloat
+  MPDF  ==> Matrix Polynomial DoubleFloat
+  MF  ==> Matrix Float
+  MEF  ==> Matrix Expression Float
+  LEDF  ==> List Expression DoubleFloat
+  VEF  ==> Vector Expression Float
+  NOA  ==> Record(fn:EDF, init:LDF, lb:LOCDF, cf:LEDF, ub:LOCDF)
+  LSA  ==> Record(lfn:LEDF, init:LDF)
+  EF2  ==> ExpressionFunctions2
+  MI  ==> Matrix Integer
+  INT  ==> Integer
+  F  ==> Float
+  NNI  ==> NonNegativeInteger
+  S  ==> Symbol
+  LS  ==> List Symbol
+  MVCF  ==> MultiVariableCalculusFunctions
+  ESTOOLS2 ==> ExpertSystemToolsPackage2
+  SDF  ==> Stream DoubleFloat
+  LSDF  ==> List Stream DoubleFloat
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  OCDF  ==> OrderedCompletion DoubleFloat
+
+  Rep:=Result
+  import Rep, NagOptimisationPackage
+  import e04AgentsPackage,ExpertSystemToolsPackage
+
+  measure(R:RoutinesTable,args:NOA) ==
+    argsFn := args.fn
+    string:String := "e04fdf is "
+    positive?(#(args.cf) + #(args.lb) + #(args.ub)) =>
+      string := concat(string,"unsuitable for constrained problems. ")
+      [0.0,string]
+    n:NNI := #(variables(argsFn)$EDF)
+    (n>1)@Boolean => 
+      string := concat(string,_
+                 "unsuitable for single instances of multivariate problems. ")
+      [0.0,string]
+    sumOfSquares(argsFn) case "failed" =>
+      string := concat(string,"unsuitable.")
+      [0.0,string]
+    string := concat(string,_
+                  "recommended since the function is a sum of squares.")
+    [getMeasure(R,e04fdf@Symbol)$RoutinesTable, string]
+
+  measure(R:RoutinesTable,args:LSA) ==
+    string:String := "e04fdf is recommended"
+    [getMeasure(R,e04fdf@Symbol)$RoutinesTable, string]
+
+  numericalOptimization(args:NOA) ==
+    argsFn := args.fn
+    lw:INT := 14
+    x := mat(args.init,1)
+    (a := sumOfSquares(argsFn)) case EDF => 
+      ArgsFn := vector([edf2ef(a)])$VEF
+      f : Union(fn:FileName,fp:Asp50(LSFUN1)):= [retract(ArgsFn)$Asp50(LSFUN1)]
+      out:Result := e04fdf(1,1,1,lw,x,-1,f)
+      changeNameToObjf(fsumsq@Symbol,out)
+    empty()$Result
+
+  numericalOptimization(args:LSA) ==
+    argsFn := copy args.lfn
+    m:INT := #(argsFn)
+    n:NNI := #(variables(args))
+    nn:INT := n
+    lw:INT := 
+      (nn = 1) => 9+5*m
+      nn*(7+n+2*m+((nn-1) quo 2)$INT)+3*m
+    x := mat(args.init,n)
+    ArgsFn := vector([edf2ef(i)$ExpertSystemToolsPackage for i in argsFn])$VEF
+    f : Union(fn:FileName,fp:Asp50(LSFUN1)) := [retract(ArgsFn)$Asp50(LSFUN1)]
+    out:Result := e04fdf(m,n,1,lw,x,-1,f)
+    changeNameToObjf(fsumsq@Symbol,out)
+
 *)
 
 \end{chunk}
@@ -51442,7 +57714,8 @@ e04gcfAnnaType(): NumericalOptimizationCategory == Result add
       [0.0,string]
     n:NNI := #(variables(argsFn)$EDF)
     (n>1)@Boolean => 
-      string := concat(string,"unsuitable for single instances of multivariate problems. ")
+      string := concat(string,_
+               "unsuitable for single instances of multivariate problems. ")
       [0.0,string]
     a := coerce(float(10,0,10))$OCDF
     seg:SOCDF := -a..a
@@ -51454,14 +57727,16 @@ e04gcfAnnaType(): NumericalOptimizationCategory == Result add
     sumOfSquares(args.fn) case "failed" =>
       string := concat(string,"unsuitable.")
       [0.0,string]
-    string := concat(string,"recommended since the function is a sum of squares.")
+    string := concat(string,_
+                       "recommended since the function is a sum of squares.")
     [getMeasure(R,e04gcf@Symbol)$RoutinesTable, string]
 
   measure(R:RoutinesTable,args:LSA) ==
     string:String := "e04gcf is "
     a := coerce(float(10,0,10))$OCDF
     seg:SOCDF := -a..a
-    sings := concat([singularitiesOf(i,variables(args),seg) for i in args.lfn])$SDF
+    sings := _
+      concat([singularitiesOf(i,variables(args),seg) for i in args.lfn])$SDF
     s := #(sdf2lst(sings))
     positive? s => 
       string := concat(string,"not recommended for discontinuous functions.")
@@ -51477,7 +57752,7 @@ e04gcfAnnaType(): NumericalOptimizationCategory == Result add
     x := mat(args.init,1)
     (a := sumOfSquares(argsFn)) case EDF => 
       ArgsFn := vector([edf2ef(a)$ExpertSystemToolsPackage])$VEF
-      f : Union(fn:FileName,fp:Asp19(LSFUN2)) := [retract(ArgsFn)$Asp19(LSFUN2)]
+      f : Union(fn:FileName,fp:Asp19(LSFUN2)):= [retract(ArgsFn)$Asp19(LSFUN2)]
       out:Result := e04gcf(1,1,1,lw,x,-1,f)
       changeNameToObjf(fsumsq@Symbol,out)
     empty()$Result
@@ -51487,7 +57762,6 @@ e04gcfAnnaType(): NumericalOptimizationCategory == Result add
     m:NNI := #(argsFn)
     n:NNI := #(variables(args))
     lw:INT := 
---      one?(n) => 11+5*m
       (n = 1) => 11+5*m
       2*n*(4+n+m)+3*m
     x := mat(args.init,n)
@@ -51501,6 +57775,103 @@ e04gcfAnnaType(): NumericalOptimizationCategory == Result add
 \begin{chunk}{COQ E04GCFA}
 (* domain E04GCFA *)
 (*
+  DF  ==> DoubleFloat
+  EF  ==> Expression Float
+  EDF  ==> Expression DoubleFloat
+  PDF  ==> Polynomial DoubleFloat
+  VPDF  ==> Vector Polynomial DoubleFloat
+  LDF  ==> List DoubleFloat
+  LOCDF  ==> List OrderedCompletion DoubleFloat
+  MDF  ==> Matrix DoubleFloat
+  MPDF  ==> Matrix Polynomial DoubleFloat
+  MF  ==> Matrix Float
+  MEF  ==> Matrix Expression Float
+  LEDF  ==> List Expression DoubleFloat
+  VEF  ==> Vector Expression Float
+  NOA  ==> Record(fn:EDF, init:LDF, lb:LOCDF, cf:LEDF, ub:LOCDF)
+  LSA  ==> Record(lfn:LEDF, init:LDF)
+  EF2  ==> ExpressionFunctions2
+  MI  ==> Matrix Integer
+  INT  ==> Integer
+  F  ==> Float
+  NNI  ==> NonNegativeInteger
+  S  ==> Symbol
+  LS  ==> List Symbol
+  MVCF  ==> MultiVariableCalculusFunctions
+  ESTOOLS2 ==> ExpertSystemToolsPackage2
+  SDF  ==> Stream DoubleFloat
+  LSDF  ==> List Stream DoubleFloat
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  OCDF  ==> OrderedCompletion DoubleFloat
+
+  Rep:=Result
+  import Rep, NagOptimisationPackage,ExpertSystemContinuityPackage
+  import e04AgentsPackage,ExpertSystemToolsPackage
+
+  measure(R:RoutinesTable,args:NOA) ==
+    argsFn:EDF := args.fn
+    string:String := "e04gcf is "
+    positive?(#(args.cf) + #(args.lb) + #(args.ub)) =>
+      string := concat(string,"unsuitable for constrained problems. ")
+      [0.0,string]
+    n:NNI := #(variables(argsFn)$EDF)
+    (n>1)@Boolean => 
+      string := concat(string,_
+               "unsuitable for single instances of multivariate problems. ")
+      [0.0,string]
+    a := coerce(float(10,0,10))$OCDF
+    seg:SOCDF := -a..a
+    sings := singularitiesOf(argsFn,variables(argsFn)$EDF,seg)
+    s := #(sdf2lst(sings))
+    positive? s => 
+      string := concat(string,"not recommended for discontinuous functions.")
+      [0.0,string]
+    sumOfSquares(args.fn) case "failed" =>
+      string := concat(string,"unsuitable.")
+      [0.0,string]
+    string := concat(string,_
+                       "recommended since the function is a sum of squares.")
+    [getMeasure(R,e04gcf@Symbol)$RoutinesTable, string]
+
+  measure(R:RoutinesTable,args:LSA) ==
+    string:String := "e04gcf is "
+    a := coerce(float(10,0,10))$OCDF
+    seg:SOCDF := -a..a
+    sings := _
+      concat([singularitiesOf(i,variables(args),seg) for i in args.lfn])$SDF
+    s := #(sdf2lst(sings))
+    positive? s => 
+      string := concat(string,"not recommended for discontinuous functions.")
+      [0.0,string]
+    string := concat(string,"recommended.")
+    m := getMeasure(R,e04gcf@Symbol)$RoutinesTable
+    m := m-(1-exp(-(expenseOfEvaluation(args))**3))
+    [m, string]
+
+  numericalOptimization(args:NOA) ==
+    argsFn:EDF := args.fn
+    lw:INT := 16
+    x := mat(args.init,1)
+    (a := sumOfSquares(argsFn)) case EDF => 
+      ArgsFn := vector([edf2ef(a)$ExpertSystemToolsPackage])$VEF
+      f : Union(fn:FileName,fp:Asp19(LSFUN2)):= [retract(ArgsFn)$Asp19(LSFUN2)]
+      out:Result := e04gcf(1,1,1,lw,x,-1,f)
+      changeNameToObjf(fsumsq@Symbol,out)
+    empty()$Result
+
+  numericalOptimization(args:LSA) ==
+    argsFn := copy args.lfn
+    m:NNI := #(argsFn)
+    n:NNI := #(variables(args))
+    lw:INT := 
+      (n = 1) => 11+5*m
+      2*n*(4+n+m)+3*m
+    x := mat(args.init,n)
+    ArgsFn := vector([edf2ef(i)$ExpertSystemToolsPackage for i in argsFn])$VEF
+    f : Union(fn:FileName,fp:Asp19(LSFUN2)) := [retract(ArgsFn)$Asp19(LSFUN2)]
+    out:Result := e04gcf(m,n,1,lw,x,-1,f)
+    changeNameToObjf(fsumsq@Symbol,out)
+
 *)
 
 \end{chunk}
@@ -51630,9 +58001,7 @@ e04jafAnnaType(): NumericalOptimizationCategory == Result add
 
   bound(a:LOCDF,b:LOCDF):Integer ==  
     empty?(concat(a,b)) => 1
---    one?(#(removeDuplicates(a))) and  zero?(first(a)) => 2
     (#(removeDuplicates(a)) = 1) and  zero?(first(a)) => 2
---    one?(#(removeDuplicates(a))) and one?(#(removeDuplicates(b))) => 3
     (#(removeDuplicates(a)) = 1) and (#(removeDuplicates(b)) = 1) => 3
     0  
 
@@ -51641,7 +58010,8 @@ e04jafAnnaType(): NumericalOptimizationCategory == Result add
     if positive?(#(args.cf)) then
       if not simpleBounds?(args.cf) then
         string := 
-          concat(string,"suitable for simple bounds only, not constraint functions.")
+          concat(string,_
+            "suitable for simple bounds only, not constraint functions.")
     (# string) < 20 => 
       if zero?(#(args.lb) + #(args.ub)) then
         string := concat(string, "usable if there are no constraints")
@@ -51670,6 +58040,75 @@ e04jafAnnaType(): NumericalOptimizationCategory == Result add
 \begin{chunk}{COQ E04JAFA}
 (* domain E04JAFA *)
 (*
+  DF  ==> DoubleFloat
+  EF  ==> Expression Float
+  EDF  ==> Expression DoubleFloat
+  PDF  ==> Polynomial DoubleFloat
+  VPDF  ==> Vector Polynomial DoubleFloat
+  LDF  ==> List DoubleFloat
+  LOCDF  ==> List OrderedCompletion DoubleFloat
+  MDF  ==> Matrix DoubleFloat
+  MPDF  ==> Matrix Polynomial DoubleFloat
+  MF  ==> Matrix Float
+  MEF  ==> Matrix Expression Float
+  LEDF  ==> List Expression DoubleFloat
+  VEF  ==> Vector Expression Float
+  NOA  ==> Record(fn:EDF, init:LDF, lb:LOCDF, cf:LEDF, ub:LOCDF)
+  LSA  ==> Record(lfn:LEDF, init:LDF)
+  EF2  ==> ExpressionFunctions2
+  MI  ==> Matrix Integer
+  INT  ==> Integer
+  F  ==> Float
+  NNI  ==> NonNegativeInteger
+  S  ==> Symbol
+  LS  ==> List Symbol
+  MVCF  ==> MultiVariableCalculusFunctions
+  ESTOOLS2 ==> ExpertSystemToolsPackage2
+  SDF  ==> Stream DoubleFloat
+  LSDF  ==> List Stream DoubleFloat
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  OCDF  ==> OrderedCompletion DoubleFloat
+
+  Rep:=Result
+  import Rep, NagOptimisationPackage
+  import e04AgentsPackage,ExpertSystemToolsPackage
+
+  bound(a:LOCDF,b:LOCDF):Integer ==  
+    empty?(concat(a,b)) => 1
+    (#(removeDuplicates(a)) = 1) and  zero?(first(a)) => 2
+    (#(removeDuplicates(a)) = 1) and (#(removeDuplicates(b)) = 1) => 3
+    0  
+
+  measure(R:RoutinesTable,args:NOA) ==
+    string:String := "e04jaf is "
+    if positive?(#(args.cf)) then
+      if not simpleBounds?(args.cf) then
+        string := 
+          concat(string,_
+            "suitable for simple bounds only, not constraint functions.")
+    (# string) < 20 => 
+      if zero?(#(args.lb) + #(args.ub)) then
+        string := concat(string, "usable if there are no constraints")
+        [getMeasure(R,e04jaf@Symbol)$RoutinesTable*0.5,string]
+      else
+        string := concat(string,"recommended")
+        [getMeasure(R,e04jaf@Symbol)$RoutinesTable, string]
+    [0.0,string]
+
+  numericalOptimization(args:NOA) ==
+    argsFn:EDF := args.fn
+    n:NNI := #(variables(argsFn)$EDF)
+    ibound:INT := bound(args.lb,args.ub)
+    m:INT := n 
+    lw:INT := max(13,12 * m + ((m * (m - 1)) quo 2)$INT)$INT
+    bl := mat(finiteBound(args.lb,float(1,6,10)$DF),n)
+    bu := mat(finiteBound(args.ub,float(1,6,10)$DF),n)
+    x := mat(args.init,n)
+    ArgsFn:EF := edf2ef(argsFn)
+    fr:Union(fn:FileName,fp:Asp24(FUNCT1)) := [retract(ArgsFn)$Asp24(FUNCT1)]
+    out:Result := e04jaf(n,ibound,n+2,lw,bl,bu,x,-1,fr)
+    changeNameToObjf(f@Symbol,out)
+
 *)
 
 \end{chunk}
@@ -51805,7 +58244,8 @@ e04mbfAnnaType(): NumericalOptimizationCategory == Result add
   numericalOptimization(args:NOA) ==
     argsFn:EDF := args.fn
     c := args.cf
-    listVars:List LS := concat(variables(argsFn)$EDF,[variables(z)$EDF for z in c])
+    listVars:List LS := _
+       concat(variables(argsFn)$EDF,[variables(z)$EDF for z in c])
     n:NNI := #(v := removeDuplicates(concat(listVars)$LS)$LS)
     A:MDF := linearMatrix(args.cf,n)
     nclin:NNI := # linearPart(c)
@@ -51817,7 +58257,8 @@ e04mbfAnnaType(): NumericalOptimizationCategory == Result add
     lwork:INT := 
       nclin < n => 2*nclin*(nclin+4)+2+6*n+nrowa
       2*(n+3)*n+4*nclin+nrowa
-    out:Result := e04mbf(20,1,n,nclin,n+nclin,nrowa,A,bl,bu,cvec,true,2*n,lwork,x,-1)
+    out:Result := _
+      e04mbf(20,1,n,nclin,n+nclin,nrowa,A,bl,bu,cvec,true,2*n,lwork,x,-1)
     changeNameToObjf(objlp@Symbol,out)
 
 \end{chunk}
@@ -51825,13 +58266,71 @@ e04mbfAnnaType(): NumericalOptimizationCategory == Result add
 \begin{chunk}{COQ E04MBFA}
 (* domain E04MBFA *)
 (*
-*)
+  DF  ==> DoubleFloat
+  EF  ==> Expression Float
+  EDF  ==> Expression DoubleFloat
+  PDF  ==> Polynomial DoubleFloat
+  VPDF  ==> Vector Polynomial DoubleFloat
+  LDF  ==> List DoubleFloat
+  LOCDF  ==> List OrderedCompletion DoubleFloat
+  MDF  ==> Matrix DoubleFloat
+  MPDF  ==> Matrix Polynomial DoubleFloat
+  MF  ==> Matrix Float
+  MEF  ==> Matrix Expression Float
+  LEDF  ==> List Expression DoubleFloat
+  VEF  ==> Vector Expression Float
+  NOA  ==> Record(fn:EDF, init:LDF, lb:LOCDF, cf:LEDF, ub:LOCDF)
+  LSA  ==> Record(lfn:LEDF, init:LDF)
+  EF2  ==> ExpressionFunctions2
+  MI  ==> Matrix Integer
+  INT  ==> Integer
+  F  ==> Float
+  NNI  ==> NonNegativeInteger
+  S  ==> Symbol
+  LS  ==> List Symbol
+  MVCF  ==> MultiVariableCalculusFunctions
+  ESTOOLS2 ==> ExpertSystemToolsPackage2
+  SDF  ==> Stream DoubleFloat
+  LSDF  ==> List Stream DoubleFloat
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  OCDF  ==> OrderedCompletion DoubleFloat
 
-\end{chunk}
+  Rep:=Result
+  import Rep, NagOptimisationPackage
+  import e04AgentsPackage,ExpertSystemToolsPackage
 
-\begin{chunk}{E04MBFA.dotabb}
-"E04MBFA" [color="#88FF44",href="bookvol10.3.pdf#nameddest=E04MBFA"]
-"TRANFUN" [color="#4488FF",href="bookvol10.2.pdf#nameddest=TRANFUN"]
+  measure(R:RoutinesTable,args:NOA) ==
+    (not linear?([args.fn])) or (not linear?(args.cf)) => 
+      [0.0,"e04mbf is for a linear objective function and constraints only."]
+    [getMeasure(R,e04mbf@Symbol)$RoutinesTable,"e04mbf is recommended" ]
+
+  numericalOptimization(args:NOA) ==
+    argsFn:EDF := args.fn
+    c := args.cf
+    listVars:List LS := _
+       concat(variables(argsFn)$EDF,[variables(z)$EDF for z in c])
+    n:NNI := #(v := removeDuplicates(concat(listVars)$LS)$LS)
+    A:MDF := linearMatrix(args.cf,n)
+    nclin:NNI := # linearPart(c)
+    nrowa:NNI := max(1,nclin)
+    bl:MDF := mat(finiteBound(args.lb,float(1,21,10)$DF),n)
+    bu:MDF := mat(finiteBound(args.ub,float(1,21,10)$DF),n)
+    cvec:MDF := mat(coefficients(retract(argsFn)@PDF)$PDF,n)
+    x := mat(args.init,n)
+    lwork:INT := 
+      nclin < n => 2*nclin*(nclin+4)+2+6*n+nrowa
+      2*(n+3)*n+4*nclin+nrowa
+    out:Result := _
+      e04mbf(20,1,n,nclin,n+nclin,nrowa,A,bl,bu,cvec,true,2*n,lwork,x,-1)
+    changeNameToObjf(objlp@Symbol,out)
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{E04MBFA.dotabb}
+"E04MBFA" [color="#88FF44",href="bookvol10.3.pdf#nameddest=E04MBFA"]
+"TRANFUN" [color="#4488FF",href="bookvol10.2.pdf#nameddest=TRANFUN"]
 "E04MBFA" -> "TRANFUN"
 
 \end{chunk}
@@ -51966,7 +58465,8 @@ e04nafAnnaType(): NumericalOptimizationCategory == Result add
   numericalOptimization(args:NOA) ==
     argsFn:EDF := args.fn
     c := args.cf
-    listVars:List LS := concat(variables(argsFn)$EDF,[variables(z)$EDF for z in c])
+    listVars:List LS := _
+       concat(variables(argsFn)$EDF,[variables(z)$EDF for z in c])
     n:NNI := #(v := sort(removeDuplicates(concat(listVars)$LS)$LS)$LS)
     A:MDF := linearMatrix(c,n)
     nclin:NNI := # linearPart(c)
@@ -51995,6 +58495,78 @@ e04nafAnnaType(): NumericalOptimizationCategory == Result add
 \begin{chunk}{COQ E04NAFA}
 (* domain E04NAFA *)
 (*
+  DF  ==> DoubleFloat
+  EF  ==> Expression Float
+  EDF  ==> Expression DoubleFloat
+  PDF  ==> Polynomial DoubleFloat
+  VPDF  ==> Vector Polynomial DoubleFloat
+  LDF  ==> List DoubleFloat
+  LOCDF  ==> List OrderedCompletion DoubleFloat
+  MDF  ==> Matrix DoubleFloat
+  MPDF  ==> Matrix Polynomial DoubleFloat
+  MF  ==> Matrix Float
+  MEF  ==> Matrix Expression Float
+  LEDF  ==> List Expression DoubleFloat
+  VEF  ==> Vector Expression Float
+  NOA  ==> Record(fn:EDF, init:LDF, lb:LOCDF, cf:LEDF, ub:LOCDF)
+  LSA  ==> Record(lfn:LEDF, init:LDF)
+  EF2  ==> ExpressionFunctions2
+  MI  ==> Matrix Integer
+  INT  ==> Integer
+  F  ==> Float
+  NNI  ==> NonNegativeInteger
+  S  ==> Symbol
+  LS  ==> List Symbol
+  MVCF  ==> MultiVariableCalculusFunctions
+  ESTOOLS2 ==> ExpertSystemToolsPackage2
+  SDF  ==> Stream DoubleFloat
+  LSDF  ==> List Stream DoubleFloat
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  OCDF  ==> OrderedCompletion DoubleFloat
+
+  Rep:=Result
+  import Rep, NagOptimisationPackage
+  import e04AgentsPackage,ExpertSystemToolsPackage
+
+  measure(R:RoutinesTable,args:NOA) ==
+    string:String := "e04naf is "
+    argsFn:EDF := args.fn
+    if not (quadratic?(argsFn) and linear?(args.cf)) then
+      string :=
+        concat(string,"for a quadratic function with linear constraints only.")
+    (# string) < 20 => 
+      string := concat(string,"recommended")
+      [getMeasure(R,e04naf@Symbol)$RoutinesTable, string]
+    [0.0,string]
+
+  numericalOptimization(args:NOA) ==
+    argsFn:EDF := args.fn
+    c := args.cf
+    listVars:List LS := _
+       concat(variables(argsFn)$EDF,[variables(z)$EDF for z in c])
+    n:NNI := #(v := sort(removeDuplicates(concat(listVars)$LS)$LS)$LS)
+    A:MDF := linearMatrix(c,n)
+    nclin:NNI := # linearPart(c)
+    nrowa:NNI := max(1,nclin)
+    big:DF := float(1,10,10)$DF
+    fea:MDF := new(1,n+nclin,float(1053,-11,10)$DF)$MDF
+    bl:MDF := mat(finiteBound(args.lb,float(1,21,10)$DF),n)
+    bu:MDF := mat(finiteBound(args.ub,float(1,21,10)$DF),n)
+    alin:EDF := splitLinear(argsFn)
+    p:PDF := retract(alin)@PDF
+    pl:List PDF := [coefficient(p,i,1)$PDF for i in v]
+    cvec:MDF := mat([pdf2df j for j in pl],n)
+    h1:MPDF := hessian(p,v)$MVCF(S,PDF,VPDF,LS)
+    hess:MDF := map(pdf2df,h1)$ESTOOLS2(PDF,DF)
+    h2:MEF := map(df2ef,hess)$ESTOOLS2(DF,EF)
+    x := mat(args.init,n)
+    istate:MI := zero(1,n+nclin)$MI
+    lwork:INT := 2*n*(n+2*nclin)+nrowa
+    qphess:Union(fn:FileName,fp:Asp20(QPHESS)) := [retract(h2)$Asp20(QPHESS)]
+    out:Result := e04naf(20,1,n,nclin,n+nclin,nrowa,n,n,big,A,bl,bu,cvec,fea,
+                           hess,true,false,true,2*n,lwork,x,istate,-1,qphess)
+    changeNameToObjf(obj@Symbol,out)
+
 *)
 
 \end{chunk}
@@ -52123,18 +58695,20 @@ e04ucfAnnaType(): NumericalOptimizationCategory == Result add
   import e04AgentsPackage,ExpertSystemToolsPackage
 
   measure(R:RoutinesTable,args:NOA) ==
-    zero?(#(args.lb) + #(args.ub)) =>
-      [0.0,"e04ucf is not recommended if there are no bounds specified"]
-    zero?(#(args.cf)) =>
-      string:String := "e04ucf is usable but not always recommended if there are no constraints"
-      [getMeasure(R,e04ucf@Symbol)$RoutinesTable*0.5,string]
-    [getMeasure(R,e04ucf@Symbol)$RoutinesTable,"e04ucf is recommended"]
+   zero?(#(args.lb) + #(args.ub)) =>
+     [0.0,"e04ucf is not recommended if there are no bounds specified"]
+   zero?(#(args.cf)) =>
+     string:String := _
+      "e04ucf is usable but not always recommended if there are no constraints"
+     [getMeasure(R,e04ucf@Symbol)$RoutinesTable*0.5,string]
+   [getMeasure(R,e04ucf@Symbol)$RoutinesTable,"e04ucf is recommended"]
 
   numericalOptimization(args:NOA) ==
     Args := sortConstraints(args)
     argsFn := Args.fn
     c := Args.cf
-    listVars:List LS := concat(variables(argsFn)$EDF,[variables(z)$EDF for z in c])
+    listVars:List LS := _
+      concat(variables(argsFn)$EDF,[variables(z)$EDF for z in c])
     n:NNI := #(v := sort(removeDuplicates(concat(listVars)$LS)$LS)$LS)
     lin:NNI := #(linearPart(c))
     nlcf := nonLinearPart(c)
@@ -52170,8 +58744,8 @@ e04ucfAnnaType(): NumericalOptimizationCategory == Result add
     x:MDF := mat(Args.init,n)
     VectCF:VEF := vector([edf2ef e for e in nlcf])$VEF
     ArgsFn:EF := edf2ef(argsFn)
-    fasp : Union(fn:FileName,fp:Asp49(OBJFUN)) := [retract(ArgsFn)$Asp49(OBJFUN)]
-    casp : Union(fn:FileName,fp:Asp55(CONFUN)) := [retract(VectCF)$Asp55(CONFUN)]
+    fasp : Union(fn:FileName,fp:Asp49(OBJFUN)):=[retract(ArgsFn)$Asp49(OBJFUN)]
+    casp : Union(fn:FileName,fp:Asp55(CONFUN)):=[retract(VectCF)$Asp55(CONFUN)]
     e04ucf(n,lin,nonlin,nrowa,nrowj,n,A,bl,bu,liwork,lwork,false,cra,3,fea,
             fun,true,infb,infb,fea,lint,true,maji,1,mini,0,-1,nonf,opt,ste,1,
              1,n,n,3,istate,cjac,clambda,r,x,-1,casp,fasp)
@@ -52181,6 +58755,95 @@ e04ucfAnnaType(): NumericalOptimizationCategory == Result add
 \begin{chunk}{COQ E04UCFA}
 (* domain E04UCFA *)
 (*
+  DF  ==> DoubleFloat
+  EF  ==> Expression Float
+  EDF  ==> Expression DoubleFloat
+  PDF  ==> Polynomial DoubleFloat
+  VPDF  ==> Vector Polynomial DoubleFloat
+  LDF  ==> List DoubleFloat
+  LOCDF  ==> List OrderedCompletion DoubleFloat
+  MDF  ==> Matrix DoubleFloat
+  MPDF  ==> Matrix Polynomial DoubleFloat
+  MF  ==> Matrix Float
+  MEF  ==> Matrix Expression Float
+  LEDF  ==> List Expression DoubleFloat
+  VEF  ==> Vector Expression Float
+  NOA  ==> Record(fn:EDF, init:LDF, lb:LOCDF, cf:LEDF, ub:LOCDF)
+  LSA  ==> Record(lfn:LEDF, init:LDF)
+  EF2  ==> ExpressionFunctions2
+  MI  ==> Matrix Integer
+  INT  ==> Integer
+  F  ==> Float
+  NNI  ==> NonNegativeInteger
+  S  ==> Symbol
+  LS  ==> List Symbol
+  MVCF  ==> MultiVariableCalculusFunctions
+  ESTOOLS2 ==> ExpertSystemToolsPackage2
+  SDF  ==> Stream DoubleFloat
+  LSDF  ==> List Stream DoubleFloat
+  SOCDF  ==> Segment OrderedCompletion DoubleFloat
+  OCDF  ==> OrderedCompletion DoubleFloat
+
+  Rep:=Result
+  import Rep,NagOptimisationPackage
+  import e04AgentsPackage,ExpertSystemToolsPackage
+
+  measure(R:RoutinesTable,args:NOA) ==
+   zero?(#(args.lb) + #(args.ub)) =>
+     [0.0,"e04ucf is not recommended if there are no bounds specified"]
+   zero?(#(args.cf)) =>
+     string:String := _
+      "e04ucf is usable but not always recommended if there are no constraints"
+     [getMeasure(R,e04ucf@Symbol)$RoutinesTable*0.5,string]
+   [getMeasure(R,e04ucf@Symbol)$RoutinesTable,"e04ucf is recommended"]
+
+  numericalOptimization(args:NOA) ==
+    Args := sortConstraints(args)
+    argsFn := Args.fn
+    c := Args.cf
+    listVars:List LS := _
+      concat(variables(argsFn)$EDF,[variables(z)$EDF for z in c])
+    n:NNI := #(v := sort(removeDuplicates(concat(listVars)$LS)$LS)$LS)
+    lin:NNI := #(linearPart(c))
+    nlcf := nonLinearPart(c)
+    nonlin:NNI := #(nlcf)
+    if empty?(nlcf) then 
+      nlcf := new(n,coerce(first(v)$LS)$EDF)$LEDF
+    nrowa:NNI := max(1,lin)
+    nrowj:NNI := max(1,nonlin)
+    A:MDF := linearMatrix(c,n)
+    bl:MDF := mat(finiteBound(Args.lb,float(1,25,10)$DF),n)
+    bu:MDF := mat(finiteBound(Args.ub,float(1,25,10)$DF),n)
+    liwork:INT := 3*n+lin+2*nonlin
+    lwork:INT :=
+      zero?(lin+nonlin) => 20*n
+      zero?(nonlin) => 2*n*(n+10)+11*lin
+      2*n*(n+nonlin+10)+(11+n)*lin + 21*nonlin
+    cra:DF := float(1,-2,10)$DF
+    fea:DF := float(1053671201,-17,10)$DF
+    fun:DF := float(4373903597,-24,10)$DF
+    infb:DF := float(1,15,10)$DF
+    lint:DF := float(9,-1,10)$DF
+    maji:INT := max(50,3*(n+lin)+10*nonlin)
+    mini:INT := max(50,3*(n+lin+nonlin))
+    nonf:DF := float(105,-10,10)$DF
+    opt:DF := float(326,-10,10)$DF
+    ste:DF := float(2,0,10)$DF
+    istate:MI := zero(1,n+lin+nonlin)$MI
+    cjac:MDF := 
+      positive?(nonlin) => zero(nrowj,n)$MDF
+      zero(nrowj,1)$MDF
+    clambda:MDF := zero(1,n+lin+nonlin)$MDF
+    r:MDF := zero(n,n)$MDF
+    x:MDF := mat(Args.init,n)
+    VectCF:VEF := vector([edf2ef e for e in nlcf])$VEF
+    ArgsFn:EF := edf2ef(argsFn)
+    fasp : Union(fn:FileName,fp:Asp49(OBJFUN)):=[retract(ArgsFn)$Asp49(OBJFUN)]
+    casp : Union(fn:FileName,fp:Asp55(CONFUN)):=[retract(VectCF)$Asp55(CONFUN)]
+    e04ucf(n,lin,nonlin,nrowa,nrowj,n,A,bl,bu,liwork,lwork,false,cra,3,fea,
+            fun,true,infb,infb,fea,lint,true,maji,1,mini,0,-1,nonf,opt,ste,1,
+             1,n,n,3,istate,cjac,clambda,r,x,-1,casp,fasp)
+
 *)
 
 \end{chunk}
@@ -53172,24 +59835,27 @@ Factored(R: IntegralDomain): Exports == Implementation where
         empty?(lf := reverse factorList x) => convert(unit x)@InputForm
         l := empty()$List(InputForm)
         for rec in lf repeat
---          one?(rec.fctr) => l
           ((rec.fctr) = 1) => l
-          iFactor : InputForm := binary( convert("::" :: Symbol)@InputForm, [convert(rec.fctr)@InputForm, (devaluate R)$Lisp :: InputForm ]$List(InputForm) )
+          iFactor : InputForm := _
+            binary( convert("::" :: Symbol)@InputForm, _
+                    [convert(rec.fctr)@InputForm, _
+                    (devaluate R)$Lisp :: InputForm ]$List(InputForm) )
           iExpon  : InputForm := convert(rec.xpnt)@InputForm
           iFun    : List InputForm :=
             rec.flg case "nil" =>
-               [convert("nilFactor" :: Symbol)@InputForm, iFactor, iExpon]$List(InputForm)
+               [convert("nilFactor" :: Symbol)@InputForm, iFactor, _
+                 iExpon]$List(InputForm)
             rec.flg case "sqfr" =>
-               [convert("sqfrFactor" :: Symbol)@InputForm, iFactor, iExpon]$List(InputForm)
+               [convert("sqfrFactor" :: Symbol)@InputForm, iFactor, _
+                 iExpon]$List(InputForm)
             rec.flg case "prime" =>
-               [convert("primeFactor" :: Symbol)@InputForm, iFactor, iExpon]$List(InputForm)
+               [convert("primeFactor" :: Symbol)@InputForm, iFactor, _
+                 iExpon]$List(InputForm)
             rec.flg case "irred" =>
-               [convert("irreducibleFactor" :: Symbol)@InputForm, iFactor, iExpon]$List(InputForm)
+               [convert("irreducibleFactor" :: Symbol)@InputForm, iFactor, _
+                 iExpon]$List(InputForm)
             nil$List(InputForm)
           l := concat( iFun pretend InputForm, l )
---        one?(rec.xpnt) =>
---          l := concat(convert(rec.fctr)@InputForm, l)
---        l := concat(convert(rec.fctr)@InputForm ** rec.xpnt, l)
         empty? l => convert(unit x)@InputForm
         if unit x ^= 1 then l := concat(convert(unit x)@InputForm,l)
         empty? rest l => first l
@@ -53199,49 +59865,71 @@ Factored(R: IntegralDomain): Exports == Implementation where
 
   -- Private function signatures:
     reciprocal              : % -> %
+
     qexpand                 : % -> R
+
     negexp?                 : % -> Boolean
+
     SimplifyFactorization   : List FF -> List FF
+
     LispLessP               : (FF, FF) -> Boolean
+
     mkFF                    : (R, List FF) -> %
+
     SimplifyFactorization1  : (FF, List FF) -> List FF
+
     stricterFlag            : (fUnion, fUnion) -> fUnion
 
     nilFactor(r, i)      == flagFactor(r, i, "nil")
+
     sqfrFactor(r, i)     == flagFactor(r, i, "sqfr")
+
     irreducibleFactor(r, i)      == flagFactor(r, i, "irred")
+
     primeFactor(r, i)    == flagFactor(r, i, "prime")
+
     unit? u              == (empty? u.fct) and (not zero? u.unt)
+
     factorList u         == u.fct
+
     unit u               == u.unt
+
     numberOfFactors u    == # u.fct
+
     0                    == [1, [["nil", 0, 1]$FF]]
+
     zero? u              == # u.fct = 1 and
                              (first u.fct).flg case "nil" and
                               zero? (first u.fct).fctr and
---                               one? u.unt
                                (u.unt = 1)
+
     1                    == [1, empty()]
+
     one? u               == empty? u.fct and u.unt = 1
+
     mkFF(r, x)           == [r, x]
+
     coerce(j:Integer):%  == (j::R)::%
+
     characteristic()     == characteristic()$R
+
     i:Integer * u:%      == (i :: %) * u
+
     r:R * u:%            == (r :: %) * u
+
     factors u            == [[fe.fctr, fe.xpnt] for fe in factorList u]
+
     expand u             == retract u
+
     negexp? x           == "or"/[negative?(y.xpnt) for y in factorList x]
 
     makeFR(u, l) ==
--- normalizing code to be installed when contents are handled better
--- current squareFree returns the content as a unit part.
---        if (not unit?(u)) then
---            l := cons(["nil", u, 1]$FF,l)
---            u := 1
         unitNormalize mkFF(u, SimplifyFactorization l)
 
     if R has IntegerNumberSystem then
+
       rational? x     == true
+
       rationalIfCan x == rational x
 
       rational x ==
@@ -53250,26 +59938,20 @@ Factored(R: IntegralDomain): Exports == Implementation where
                                     ** f.xpnt for f in factorList x]
 
     if R has Eltable(R, R) then
+
       elt(x:%, v:%) == x(expand v)
 
     if R has Evalable(R) then
+
       eval(x:%, l:List Equation %) ==
         eval(x,[expand lhs e = expand rhs e for e in l]$List(Equation R))
 
     if R has InnerEvalable(Symbol, R) then
+
       eval(x:%, ls:List Symbol, lv:List %) ==
         eval(x, ls, [expand v for v in lv]$List(R))
 
     if R has RealConstant then
-  --! negcount and rest commented out since RealConstant doesn't support
-  --! positive? or negative?
-  --  negcount: % -> Integer
-  --  positive?(x:%):Boolean == not(zero? x) and even?(negcount x)
-  --  negative?(x:%):Boolean == not(zero? x) and odd?(negcount x)
-  --  negcount x ==
-  --    n := count(negative?(#1.fctr), factorList x)$List(FF)
-  --    negative? unit x => n + 1
-  --    n
 
       convert(x:%):Float ==
         convert(unit x)@Float *
@@ -53281,9 +59963,7 @@ Factored(R: IntegralDomain): Exports == Implementation where
 
     u:% * v:% ==
       zero? u or zero? v => 0
---      one? u => v
       (u = 1) => v
---      one? v => u
       (v = 1) => u
       mkFF(unit u * unit v,
           SimplifyFactorization concat(factorList u, copy factorList v))
@@ -53315,9 +59995,7 @@ Factored(R: IntegralDomain): Exports == Implementation where
       empty?(lf := reverse factorList x) => (unit x)::OutputForm
       l := empty()$List(OutputForm)
       for rec in lf repeat
---        one?(rec.fctr) => l
         ((rec.fctr) = 1) => l
---        one?(rec.xpnt) =>
         ((rec.xpnt) = 1) =>
           l := concat(rec.fctr :: OutputForm, l)
         l := concat(rec.fctr::OutputForm ** rec.xpnt::OutputForm, l)
@@ -53368,7 +60046,6 @@ Factored(R: IntegralDomain): Exports == Implementation where
               unitNormalize(squareFree(r) pretend %)
           else
             coerce(r:R):% ==
---              one? r => 1
               (r = 1) => 1
               unitNormalize mkFF(1, [["nil", r, 1]$FF])
 
@@ -53421,7 +60098,8 @@ Factored(R: IntegralDomain): Exports == Implementation where
        ((u exquo nilFactor(fact.fctr, 1))::%) for fact in factorList u])
 
     map(fn, u) ==
-     fn(unit u) * _*/[irreducibleFactor(fn(f.fctr),f.xpnt) for f in factorList u]
+     fn(unit u) * _*/[irreducibleFactor(fn(f.fctr),f.xpnt)_
+         for f in factorList u]
 
     u exquo v ==
       empty?(x1 := factorList v) =>  unitNormal(retract v).associate *  u
@@ -53449,7 +60127,6 @@ Factored(R: IntegralDomain): Exports == Implementation where
           else
             un := un * (ucar.unit ** e)
             as := as * (ucar.associate ** e)
---        if not one?(ucar.canonical) then
         if not ((ucar.canonical) = 1) then
           vl := concat([x.flg, ucar.canonical, x.xpnt], vl)
       [mkFF(un, empty()), mkFF(1, reverse_! vl), mkFF(as, empty())]
@@ -53459,6 +60136,7 @@ Factored(R: IntegralDomain): Exports == Implementation where
       mkFF(unit(uca.unit)*unit(uca.canonical),factorList(uca.canonical))
 
     if R has GcdDomain then
+
       u + v ==
         zero? u => v
         zero? v => u
@@ -53466,7 +60144,6 @@ Factored(R: IntegralDomain): Exports == Implementation where
         (expand(u * v1) + expand(v * v1)) * u1
 
       gcd(u, v) ==
---        one? u or one? v => 1
         (u = 1) or (v = 1) => 1
         zero? u => v
         zero? v => u
@@ -53500,15 +60177,16 @@ Factored(R: IntegralDomain): Exports == Implementation where
         mkFF(1, x1)
 
     else   -- R not a GCD domain
+
       u + v ==
         zero? u => v
         zero? v => u
         irreducibleFactor(expand u + expand v, 1)
 
     if R has UniqueFactorizationDomain then
+
       prime? u ==
         not(empty?(l := factorList u)) and (empty? rest l) and
---                       one?(l.first.xpnt) and (l.first.flg case "prime")
                        ((l.first.xpnt) = 1) and (l.first.flg case "prime")
 
 \end{chunk}
@@ -53516,6 +60194,371 @@ Factored(R: IntegralDomain): Exports == Implementation where
 \begin{chunk}{COQ FR}
 (* domain FR *)
 (*
+
+  -- Representation:
+    -- Note: exponents are allowed to be integers so that some special cases
+    -- may be used in simplications
+    Rep := Record(unt:R, fct:List FF)
+
+    if R has ConvertibleTo InputForm then
+      convert(x:%):InputForm ==
+        empty?(lf := reverse factorList x) => convert(unit x)@InputForm
+        l := empty()$List(InputForm)
+        for rec in lf repeat
+          ((rec.fctr) = 1) => l
+          iFactor : InputForm := _
+            binary( convert("::" :: Symbol)@InputForm, _
+                    [convert(rec.fctr)@InputForm, _
+                    (devaluate R)$Lisp :: InputForm ]$List(InputForm) )
+          iExpon  : InputForm := convert(rec.xpnt)@InputForm
+          iFun    : List InputForm :=
+            rec.flg case "nil" =>
+               [convert("nilFactor" :: Symbol)@InputForm, iFactor, _
+                 iExpon]$List(InputForm)
+            rec.flg case "sqfr" =>
+               [convert("sqfrFactor" :: Symbol)@InputForm, iFactor, _
+                 iExpon]$List(InputForm)
+            rec.flg case "prime" =>
+               [convert("primeFactor" :: Symbol)@InputForm, iFactor, _
+                 iExpon]$List(InputForm)
+            rec.flg case "irred" =>
+               [convert("irreducibleFactor" :: Symbol)@InputForm, iFactor, _
+                 iExpon]$List(InputForm)
+            nil$List(InputForm)
+          l := concat( iFun pretend InputForm, l )
+        empty? l => convert(unit x)@InputForm
+        if unit x ^= 1 then l := concat(convert(unit x)@InputForm,l)
+        empty? rest l => first l
+        binary(convert(_*::Symbol)@InputForm, l)@InputForm
+
+    orderedR? := R has OrderedSet
+
+  -- Private function signatures:
+    reciprocal              : % -> %
+
+    qexpand                 : % -> R
+
+    negexp?                 : % -> Boolean
+
+    SimplifyFactorization   : List FF -> List FF
+
+    LispLessP               : (FF, FF) -> Boolean
+
+    mkFF                    : (R, List FF) -> %
+
+    SimplifyFactorization1  : (FF, List FF) -> List FF
+
+    stricterFlag            : (fUnion, fUnion) -> fUnion
+
+    nilFactor(r, i)      == flagFactor(r, i, "nil")
+
+    sqfrFactor(r, i)     == flagFactor(r, i, "sqfr")
+
+    irreducibleFactor(r, i)      == flagFactor(r, i, "irred")
+
+    primeFactor(r, i)    == flagFactor(r, i, "prime")
+
+    unit? u              == (empty? u.fct) and (not zero? u.unt)
+
+    factorList u         == u.fct
+
+    unit u               == u.unt
+
+    numberOfFactors u    == # u.fct
+
+    0                    == [1, [["nil", 0, 1]$FF]]
+
+    zero? u              == # u.fct = 1 and
+                             (first u.fct).flg case "nil" and
+                              zero? (first u.fct).fctr and
+                               (u.unt = 1)
+
+    1                    == [1, empty()]
+
+    one? u               == empty? u.fct and u.unt = 1
+
+    mkFF(r, x)           == [r, x]
+
+    coerce(j:Integer):%  == (j::R)::%
+
+    characteristic()     == characteristic()$R
+
+    i:Integer * u:%      == (i :: %) * u
+
+    r:R * u:%            == (r :: %) * u
+
+    factors u            == [[fe.fctr, fe.xpnt] for fe in factorList u]
+
+    expand u             == retract u
+
+    negexp? x           == "or"/[negative?(y.xpnt) for y in factorList x]
+
+    makeFR(u, l) ==
+        unitNormalize mkFF(u, SimplifyFactorization l)
+
+    if R has IntegerNumberSystem then
+
+      rational? x     == true
+
+      rationalIfCan x == rational x
+
+      rational x ==
+        convert(unit x)@Integer *
+           _*/[(convert(f.fctr)@Integer)::Fraction(Integer)
+                                    ** f.xpnt for f in factorList x]
+
+    if R has Eltable(R, R) then
+
+      elt(x:%, v:%) == x(expand v)
+
+    if R has Evalable(R) then
+
+      eval(x:%, l:List Equation %) ==
+        eval(x,[expand lhs e = expand rhs e for e in l]$List(Equation R))
+
+    if R has InnerEvalable(Symbol, R) then
+
+      eval(x:%, ls:List Symbol, lv:List %) ==
+        eval(x, ls, [expand v for v in lv]$List(R))
+
+    if R has RealConstant then
+
+      convert(x:%):Float ==
+        convert(unit x)@Float *
+                _*/[convert(f.fctr)@Float ** f.xpnt for f in factorList x]
+
+      convert(x:%):DoubleFloat ==
+        convert(unit x)@DoubleFloat *
+          _*/[convert(f.fctr)@DoubleFloat ** f.xpnt for f in factorList x]
+
+    u:% * v:% ==
+      zero? u or zero? v => 0
+      (u = 1) => v
+      (v = 1) => u
+      mkFF(unit u * unit v,
+          SimplifyFactorization concat(factorList u, copy factorList v))
+
+    u:% ** n:NonNegativeInteger ==
+      mkFF(unit(u)**n, [[x.flg, x.fctr, n * x.xpnt] for x in factorList u])
+
+    SimplifyFactorization x ==
+      empty? x => empty()
+      x := sort_!(LispLessP, x)
+      x := SimplifyFactorization1(first x, rest x)
+      if orderedR? then x := sort_!(LispLessP, x)
+      x
+
+    SimplifyFactorization1(f, x) ==
+      empty? x =>
+        zero?(f.xpnt) => empty()
+        list f
+      f1 := first x
+      f.fctr = f1.fctr =>
+        SimplifyFactorization1([stricterFlag(f.flg, f1.flg),
+                                      f.fctr, f.xpnt + f1.xpnt], rest x)
+      l := SimplifyFactorization1(first x, rest x)
+      zero?(f.xpnt) => l
+      concat(f, l)
+
+
+    coerce(x:%):OutputForm ==
+      empty?(lf := reverse factorList x) => (unit x)::OutputForm
+      l := empty()$List(OutputForm)
+      for rec in lf repeat
+        ((rec.fctr) = 1) => l
+        ((rec.xpnt) = 1) =>
+          l := concat(rec.fctr :: OutputForm, l)
+        l := concat(rec.fctr::OutputForm ** rec.xpnt::OutputForm, l)
+      empty? l => (unit x) :: OutputForm
+      e :=
+        empty? rest l => first l
+        reduce(_*, l)
+      1 = unit x => e
+      (unit x)::OutputForm * e
+
+    retract(u:%):R ==
+      negexp? u =>  error "Negative exponent in factored object"
+      qexpand u
+
+    qexpand u ==
+      unit u *
+         _*/[y.fctr ** (y.xpnt::NonNegativeInteger) for y in factorList u]
+
+    retractIfCan(u:%):Union(R, "failed") ==
+      negexp? u => "failed"
+      qexpand u
+
+    LispLessP(y, y1) ==
+      orderedR? => y.fctr < y1.fctr
+      GGREATERP(y.fctr, y1.fctr)$Lisp => false
+      true
+
+    stricterFlag(fl1, fl2) ==
+      fl1 case "prime"   => fl1
+      fl1 case "irred"   =>
+        fl2 case "prime" => fl2
+        fl1
+      fl1 case "sqfr"    =>
+        fl2 case "nil"   => fl1
+        fl2
+      fl2
+
+    if R has IntegerNumberSystem
+      then
+        coerce(r:R):% ==
+          factor(r)$IntegerFactorizationPackage(R) pretend %
+      else
+        if R has UniqueFactorizationDomain
+          then
+            coerce(r:R):% ==
+              zero? r => 0
+              unit? r => mkFF(r, empty())
+              unitNormalize(squareFree(r) pretend %)
+          else
+            coerce(r:R):% ==
+              (r = 1) => 1
+              unitNormalize mkFF(1, [["nil", r, 1]$FF])
+
+    u = v ==
+      (unit u = unit v) and # u.fct = # v.fct and
+        set(factors u)$SRFE =$SRFE set(factors v)$SRFE
+
+    - u ==
+      zero? u => u
+      mkFF(- unit u, factorList u)
+
+    recip u  ==
+      not empty? factorList u => "failed"
+      (r := recip unit u) case "failed" => "failed"
+      mkFF(r::R, empty())
+
+    reciprocal u ==
+      mkFF((recip unit u)::R,
+                    [[y.flg, y.fctr, - y.xpnt]$FF for y in factorList u])
+
+    exponent u ==  -- exponent of first factor
+      empty?(fl := factorList u) or zero? u => 0
+      first(fl).xpnt
+
+    nthExponent(u, i) ==
+      l := factorList u
+      zero? u or i < 1 or i > #l => 0
+      (l.(minIndex(l) + i - 1)).xpnt
+
+    nthFactor(u, i) ==
+      zero? u => 0
+      zero? i => unit u
+      l := factorList u
+      negative? i or i > #l => 1
+      (l.(minIndex(l) + i - 1)).fctr
+
+    nthFlag(u, i) ==
+      l := factorList u
+      zero? u or i < 1 or i > #l => "nil"
+      (l.(minIndex(l) + i - 1)).flg
+
+    flagFactor(r, i, fl) ==
+      zero? i => 1
+      zero? r => 0
+      unitNormalize mkFF(1, [[fl, r, i]$FF])
+
+    differentiate(u:%, deriv: R -> R) ==
+      ans := deriv(unit u) * ((u exquo unit(u)::%)::%)
+      ans + (_+/[fact.xpnt * deriv(fact.fctr) *
+       ((u exquo nilFactor(fact.fctr, 1))::%) for fact in factorList u])
+
+    map(fn, u) ==
+     fn(unit u) * _*/[irreducibleFactor(fn(f.fctr),f.xpnt)_
+         for f in factorList u]
+
+    u exquo v ==
+      empty?(x1 := factorList v) =>  unitNormal(retract v).associate *  u
+      empty? factorList u => "failed"
+      v1 := u * reciprocal v
+      goodQuotient:Boolean := true
+      while (goodQuotient and (not empty? x1)) repeat
+        if x1.first.xpnt < 0
+          then goodQuotient := false
+          else x1 := rest x1
+      goodQuotient => v1
+      "failed"
+
+    unitNormal u == -- does a bunch of work, but more canonical
+      (ur := recip(un := unit u)) case "failed" => [1, u, 1]
+      as := ur::R
+      vl := empty()$List(FF)
+      for x in factorList u repeat
+        ucar := unitNormal(x.fctr)
+        e := abs(x.xpnt)::NonNegativeInteger
+        if x.xpnt < 0
+          then  --  associate is recip of unit
+            un := un * (ucar.associate ** e)
+            as := as * (ucar.unit ** e)
+          else
+            un := un * (ucar.unit ** e)
+            as := as * (ucar.associate ** e)
+        if not ((ucar.canonical) = 1) then
+          vl := concat([x.flg, ucar.canonical, x.xpnt], vl)
+      [mkFF(un, empty()), mkFF(1, reverse_! vl), mkFF(as, empty())]
+
+    unitNormalize u ==
+      uca := unitNormal u
+      mkFF(unit(uca.unit)*unit(uca.canonical),factorList(uca.canonical))
+
+    if R has GcdDomain then
+
+      u + v ==
+        zero? u => v
+        zero? v => u
+        v1 := reciprocal(u1 := gcd(u, v))
+        (expand(u * v1) + expand(v * v1)) * u1
+
+      gcd(u, v) ==
+        (u = 1) or (v = 1) => 1
+        zero? u => v
+        zero? v => u
+        f1 := empty()$List(Integer)  -- list of used factor indices in x
+        f2 := f1      -- list of indices corresponding to a given factor
+        f3 := empty()$List(List Integer)    -- list of f2-like lists
+        x := concat(factorList u, factorList v)
+        for i in minIndex x .. maxIndex x repeat
+          if not member?(i, f1) then
+            f1 := concat(i, f1)
+            f2 := [i]
+            for j in i+1..maxIndex x repeat
+              if x.i.fctr = x.j.fctr then
+                  f1 := concat(j, f1)
+                  f2 := concat(j, f2)
+            f3 := concat(f2, f3)
+        x1 := empty()$List(FF)
+        while not empty? f3 repeat
+          f1 := first f3
+          if #f1 > 1 then
+            i  := first f1
+            y  := copy x.i
+            f1 := rest f1
+            while not empty? f1 repeat
+              i := first f1
+              if x.i.xpnt < y.xpnt then y.xpnt := x.i.xpnt
+              f1 := rest f1
+            x1 := concat(y, x1)
+          f3 := rest f3
+        if orderedR? then x1 := sort_!(LispLessP, x1)
+        mkFF(1, x1)
+
+    else   -- R not a GCD domain
+
+      u + v ==
+        zero? u => v
+        zero? v => u
+        irreducibleFactor(expand u + expand v, 1)
+
+    if R has UniqueFactorizationDomain then
+
+      prime? u ==
+        not(empty?(l := factorList u)) and (empty? rest l) and
+                       ((l.first.xpnt) = 1) and (l.first.flg case "prime")
+
 *)
 
 \end{chunk}
@@ -54202,19 +61245,25 @@ o )show FileName
 FileName(): FileNameCategory == add
  
         f1 = f2                  == EQUAL(f1, f2)$Lisp
+
         coerce(f: %): OutputForm == f::String::OutputForm
  
         coerce(f: %): String     == NAMESTRING(f)$Lisp
+
         coerce(s: String): %     == PARSE_-NAMESTRING(s)$Lisp
 
         filename(d,n,e)          == fnameMake(d,n,e)$Lisp
 
         directory(f:%): String   == fnameDirectory(f)$Lisp
+
         name(f:%): String        == fnameName(f)$Lisp
+
         extension(f:%): String   == fnameType(f)$Lisp
  
         exists? f                == fnameExists?(f)$Lisp
+
         readable? f              == fnameReadable?(f)$Lisp
+
         writable? f              == fnameWritable?(f)$Lisp
 
         new(d,pref,e)            == fnameNew(d,pref,e)$Lisp
@@ -54224,6 +61273,31 @@ FileName(): FileNameCategory == add
 \begin{chunk}{COQ FNAME}
 (* domain FNAME *)
 (*
+ 
+        f1 = f2                  == EQUAL(f1, f2)$Lisp
+
+        coerce(f: %): OutputForm == f::String::OutputForm
+ 
+        coerce(f: %): String     == NAMESTRING(f)$Lisp
+
+        coerce(s: String): %     == PARSE_-NAMESTRING(s)$Lisp
+
+        filename(d,n,e)          == fnameMake(d,n,e)$Lisp
+
+        directory(f:%): String   == fnameDirectory(f)$Lisp
+
+        name(f:%): String        == fnameName(f)$Lisp
+
+        extension(f:%): String   == fnameType(f)$Lisp
+ 
+        exists? f                == fnameExists?(f)$Lisp
+
+        readable? f              == fnameReadable?(f)$Lisp
+
+        writable? f              == fnameWritable?(f)$Lisp
+
+        new(d,pref,e)            == fnameNew(d,pref,e)$Lisp
+
 *)
 
 \end{chunk}
@@ -54376,20 +61450,31 @@ FiniteDivisor(F, UP, UPUP, R): Exports == Implementation where
       import UnivariatePolynomialCommonDenominator(UP, RF, UPUP)
 
       makeDivisor : (UP, UPUP, UP) -> %
+
       intReduce   : (R, UP) -> R
 
       ww := integralBasis()$R
 
       0                       == [1, empty()]
+
       divisor(i:ID)           == [i, empty()]
+
       divisor(f:R)            == divisor ideal [f]
+
       coerce(d:%):OutputForm  == ideal(d)::OutputForm
+
       ideal d                 == d.id
+
       decompose d             == [ideal d, 1]
+
       d1 = d2                 == basis(ideal d1) = basis(ideal d2)
+
       n * d                   == divisor(ideal(d) ** n)
+
       d1 + d2                 == divisor(ideal d1 * ideal d2)
+
       - d                     == divisor inv ideal d
+
       divisor(h, d, dp, g, r) == makeDivisor(d, lift h - (r * dp)::RF::UPUP, g)
 
       intReduce(h, b) ==
@@ -54453,6 +61538,95 @@ FiniteDivisor(F, UP, UPUP, R): Exports == Implementation where
 \begin{chunk}{COQ FDIV}
 (* domain FDIV *)
 (*
+      Rep := Record(id:ID, fbasis:Vector(R))
+
+      import CommonDenominator(UP, RF, Vector RF)
+      import UnivariatePolynomialCommonDenominator(UP, RF, UPUP)
+
+      makeDivisor : (UP, UPUP, UP) -> %
+
+      intReduce   : (R, UP) -> R
+
+      ww := integralBasis()$R
+
+      0                       == [1, empty()]
+
+      divisor(i:ID)           == [i, empty()]
+
+      divisor(f:R)            == divisor ideal [f]
+
+      coerce(d:%):OutputForm  == ideal(d)::OutputForm
+
+      ideal d                 == d.id
+
+      decompose d             == [ideal d, 1]
+
+      d1 = d2                 == basis(ideal d1) = basis(ideal d2)
+
+      n * d                   == divisor(ideal(d) ** n)
+
+      d1 + d2                 == divisor(ideal d1 * ideal d2)
+
+      - d                     == divisor inv ideal d
+
+      divisor(h, d, dp, g, r) == makeDivisor(d, lift h - (r * dp)::RF::UPUP, g)
+
+      intReduce(h, b) ==
+        v := integralCoordinates(h).num
+        integralRepresents(
+                      [qelt(v, i) rem b for i in minIndex v .. maxIndex v], 1)
+
+      divisor(a, b) ==
+        x := monomial(1, 1)$UP
+        not ground? gcd(d := x - a::UP, retract(discriminant())@UP) =>
+                                          error "divisor: point is singular"
+        makeDivisor(d, monomial(1, 1)$UPUP - b::UP::RF::UPUP, 1)
+
+      divisor(a, b, n) ==
+        not(ground? gcd(d := monomial(1, 1)$UP - a::UP,
+            retract(discriminant())@UP)) and
+                  ((n exquo rank()) case "failed") =>
+                                    error "divisor: point is singular"
+        m:N :=
+          n < 0 => (-n)::N
+          n::N
+        g := makeDivisor(d**m,(monomial(1,1)$UPUP - b::UP::RF::UPUP)**m,1)
+        n < 0 => -g
+        g
+
+      reduce d ==
+        (i := minimize(j := ideal d)) = j => d
+        #(n := numer i) ^= 2 => divisor i
+        cd := splitDenominator lift n(1 + minIndex n)
+        b  := gcd(cd.den * retract(retract(n minIndex n)@RF)@UP,
+                  retract(norm reduce(cd.num))@UP)
+        e  := cd.den * denom i
+        divisor ideal([(b / e)::R,
+          reduce map((s:RF):RF+->(retract(s)@UP rem b)/e, cd.num)]$Vector(R))
+
+      finiteBasis d ==
+        if empty?(d.fbasis) then
+          d.fbasis := normalizeAtInfinity
+                        basis module(ideal d)$FramedModule(UP, RF, UPUP, R, ww)
+        d.fbasis
+
+      generator d ==
+        bsis := finiteBasis d
+        for i in minIndex bsis .. maxIndex bsis repeat
+          integralAtInfinity? qelt(bsis, i) =>
+            return primitivePart qelt(bsis,i)
+        "failed"
+
+      lSpaceBasis d ==
+        map_!(primitivePart, reduceBasisAtInfinity finiteBasis(-d))
+
+-- b = center, hh = integral function, g = gcd(b, discriminant)
+      makeDivisor(b, hh, g) ==
+        b := gcd(b, retract(norm(h := reduce hh))@UP)
+        h := intReduce(h, b)
+        if not ground? gcd(g, b) then h := intReduce(h ** rank(), b)
+        divisor ideal [b::RF::R, h]$Vector(R)
+
 *)
 
 \end{chunk}
@@ -54987,13 +62161,14 @@ FiniteFieldCyclicGroup(p,extdeg):_
   p : PositiveInteger
   extdeg   : PositiveInteger
   PI       ==> PositiveInteger
-  FFPOLY         ==> FiniteFieldPolynomialPackage(PrimeField(p))
+  FFPOLY   ==> FiniteFieldPolynomialPackage(PrimeField(p))
   SI       ==> SingleInteger
   Exports  ==> FiniteAlgebraicExtensionField(PrimeField(p)) with
     getZechTable:() -> PrimitiveArray(SingleInteger)
       ++ getZechTable() returns the zech logarithm table of the field.
       ++ This table is used to perform additions in the field quickly.
-  Implementation ==> FiniteFieldCyclicGroupExtensionByPolynomial(PrimeField(p),_
+  Implementation ==> 
+   FiniteFieldCyclicGroupExtensionByPolynomial(PrimeField(p),_
                           createPrimitivePoly(extdeg)$FFPOLY)
 
 \end{chunk}
@@ -55599,6 +62774,252 @@ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_
     sizeFG:SI:=(sizeCG quo (size()$GF-1)) pretend SI
     -- the order of the factor group
 
+    zechlog:ARR:=new(((sizeFF+1) quo 2)::NNI,-1::SI)$ARR
+    -- the table for the zech logarithm
+
+    alpha :=new()$Symbol :: OutputForm
+    -- get a new symbol for the output representation of
+    -- the elements
+
+    primEltGF:GF:=
+      odd?(extdeg)$I => -$GF coefficient(defpol,0)$(SUP GF)
+      coefficient(defpol,0)$(SUP GF)
+    -- the corresponding primitive element of the groundfield
+    -- equals the trace of the primitive element w.r.t. the groundfield
+
+    facOfGroupSize := nil()$(List Record(factor:Integer,exponent:Integer))
+    -- the factorization of sizeCG
+
+    initzech?:Boolean:=true
+    -- gets false after initialization of the zech logarithm array
+
+    initelt?:Boolean:=true
+    -- gets false after initialization of the normal element
+
+    normalElt:SI:=0
+    -- the global variable containing a normal element
+
+-- functions ==========================================================
+
+    -- for completeness we have to give a dummy implementation for
+    -- 'tableForDiscreteLogarithm', although this function is not
+    -- necessary in the cyclic group representation case
+
+    tableForDiscreteLogarithm(fac) == table()$TBL
+
+    getZechTable() == zechlog
+
+    initializeZech:() -> Void
+
+    initializeElt: () -> Void
+
+    order(x:$):PI ==
+      zero?(x) =>
+        error"order: order of zero undefined"
+      (sizeCG quo gcd(sizeCG,x pretend NNI))::PI
+
+    primitive?(x:$) ==
+      zero?(x) or (x = 1) => false
+      gcd(x::Rep,sizeCG)$Rep = 1$Rep => true
+      false
+
+    coordinates(x:$) ==
+      x=0 => new(extdeg,0)$(Vector GF)
+      primElement:SAE:=convert(monomial(1,1)$(SUP GF))$SAE
+      -- the primitive element in the corresponding algebraic extension
+      coordinates(primElement **$SAE (x pretend SI))$SAE
+
+    x:$ + y:$ ==
+      if initzech? then initializeZech()
+      zero? x => y
+      zero? y => x
+      d:Rep:=positiveRemainder(y -$Rep x,sizeCG)$Rep
+      (d pretend SI) <= shift(sizeCG,-$SI (1$SI)) =>
+        zechlog.(d pretend SI) =$SI -1::SI => 0
+        addmod(x,zechlog.(d pretend SI) pretend Rep,sizeCG)$Rep
+      --d:Rep:=positiveRemainder(x -$Rep y,sizeCG)$Rep
+      d:Rep:=(sizeCG -$SI d)::Rep
+      addmod(y,zechlog.(d pretend SI) pretend Rep,sizeCG)$Rep
+      --positiveRemainder(x +$Rep zechlog.(d pretend SI) -$Rep d,sizeCG)$Rep
+
+    initializeZech() ==
+      zechlog:=createZechTable(defpol)$FFF
+      -- set initialization flag
+      initzech? := false
+      void()$Void
+
+    basis(n:PI) ==
+      extensionDegree() rem n ^= 0 =>
+        error("argument must divide extension degree")
+      m:=sizeCG quo (size()$GF**n-1)
+      [index((1+i*m) ::PI) for i in 0..(n-1)]::Vector $
+
+    n:I * x:$ == ((n::GF)::$) * x
+
+    minimalPolynomial(a) ==
+      f:SUP $:=monomial(1,1)$(SUP $) - monomial(a,0)$(SUP $)
+      u:$:=Frobenius(a)
+      while not(u = a) repeat
+        f:=f * (monomial(1,1)$(SUP $) - monomial(u,0)$(SUP $))
+        u:=Frobenius(u)
+      p:SUP GF:=0$(SUP GF)
+      while not zero?(f)$(SUP $) repeat
+        g:GF:=retract(leadingCoefficient(f)$(SUP $))
+        p:=p+monomial(g,_
+                      degree(f)$(SUP $))$(SUP GF)
+        f:=reductum(f)$(SUP $)
+      p
+
+    factorsOfCyclicGroupSize() ==
+      if empty? facOfGroupSize then initializeElt()
+      facOfGroupSize
+
+    representationType() == "cyclic"
+
+    definingPolynomial() == defpol
+
+    random() ==
+      positiveRemainder(random()$Rep,sizeFF pretend Rep)$Rep -$Rep 1$Rep
+
+    represents(v) ==
+      u:FFP:=represents(v)$FFP
+      u =$FFP 0$FFP => 0
+      discreteLog(u)$FFP pretend Rep
+
+    coerce(e:GF):$ ==
+      zero?(e)$GF => 0
+      log:I:=discreteLog(primEltGF,e)$GF::NNI *$I sizeFG
+      -- version before 10.20.92: log pretend Rep
+      -- 1$GF is coerced to sizeCG pretend Rep by old version
+      -- now 1$GF is coerced to 0$Rep which is correct.
+      positiveRemainder(log,sizeCG) pretend Rep
+
+    retractIfCan(x:$) ==
+      zero? x => 0$GF
+      u:= (x::Rep) exquo$Rep (sizeFG pretend Rep)
+      u = "failed" => "failed"
+      primEltGF **$GF ((u::$) pretend SI)
+
+    retract(x:$) ==
+      a:=retractIfCan(x)
+      a="failed" => error "element not in groundfield"
+      a :: GF
+
+    basis() == [index(i :: PI) for i in 1..extdeg]::Vector $
+
+    inGroundField?(x) ==
+      zero? x=> true
+      positiveRemainder(x::Rep,sizeFG pretend Rep)$Rep =$Rep 0$Rep => true
+      false
+
+    discreteLog(b:$,x:$) ==
+      zero? x => "failed"
+      e:= extendedEuclidean(b,sizeCG,x)$Rep
+      e = "failed" => "failed"
+      e1:Record(coef1:$,coef2:$) := e :: Record(coef1:$,coef2:$)
+      positiveRemainder(e1.coef1,sizeCG)$Rep pretend NNI
+
+    - x:$ ==
+        zero? x => 0
+        characteristic() =$I 2 => x
+        addmod(x,shift(sizeCG,-1)$SI pretend Rep,sizeCG)
+
+    generator() == 1$SI
+    createPrimitiveElement() == 1$SI
+    primitiveElement() == 1$SI
+
+    discreteLog(x:$) ==
+      zero? x => error "discrete logarithm error"
+      x pretend NNI
+
+    normalElement() ==
+      if initelt? then initializeElt()
+      normalElt::$
+
+    initializeElt() ==
+      facOfGroupSize := factors(factor(sizeCG)$Integer)
+      normalElt:=createNormalElement() pretend SI
+      initelt?:=false
+      void()$Void
+
+    extensionDegree() == extdeg pretend PI
+
+    characteristic() == characteristic()$GF
+
+    lookup(x:$) ==
+      x =$Rep (-$Rep 1$Rep) => sizeFF pretend PI
+      (x +$Rep 1$Rep) pretend PI
+
+    index(a:PI) ==
+      positiveRemainder(a,sizeFF)$I pretend Rep -$Rep 1$Rep
+
+    0 == (-$Rep 1$Rep)
+
+    1 == 0$Rep
+
+-- to get a "exponent like" output form
+    coerce(x:$):OUT ==
+      x =$Rep (-$Rep 1$Rep) => "0"::OUT
+      x =$Rep 0$Rep => "1"::OUT
+      y:I:=lookup(x)-1
+      alpha **$OUT (y::OUT)
+
+    x:$ = y:$ ==  x =$Rep y
+
+    x:$ * y:$ ==
+      x = 0 => 0
+      y = 0 => 0
+      addmod(x,y,sizeCG)$Rep
+
+    a:GF * x:$ == coerce(a)@$ * x
+
+    x:$/a:GF == x/coerce(a)@$
+
+    inv(x:$)  ==
+      zero?(x) => error "inv: not invertible"
+      (x = 1) => 1
+      sizeCG -$Rep x
+
+    x:$ ** n:PI == x ** n::I
+
+    x:$ ** n:NNI == x ** n::I
+
+    x:$ ** n:I ==
+      m:Rep:=positiveRemainder(n,sizeCG)$I pretend Rep
+      m =$Rep 0$Rep => 1
+      x = 0 => 0
+      mulmod(m,x,sizeCG::Rep)$Rep
+
+\end{chunk}
+
+\begin{chunk}{COQ FFCGP}
+(* domain FFCGP *)
+(*
+
+    Rep:= SI
+    -- elements are represented by small integers in the range
+    -- (-1)..(size()-2). The (-1) representing the field element zero,
+    -- the other small integers representing the corresponding power
+    -- of the primitive element, the root of the defining polynomial
+
+    -- it would be very nice if we could use the representation
+    -- Rep:= Union("zero", IntegerMod(size()$GF ** degree(defpol) -1)),
+    -- why doesn't the compiler like this ?
+
+    extdeg:NNI  :=degree(defpol)$(SUP GF)::NNI
+    -- the extension degree
+
+    sizeFF:NNI:=(size()$GF ** extdeg) pretend NNI
+    -- the size of the field
+
+    if sizeFF > 2**20 then
+      error "field too large for this representation"
+
+    sizeCG:SI:=(sizeFF - 1) pretend SI
+    -- the order of the cyclic group
+
+    sizeFG:SI:=(sizeCG quo (size()$GF-1)) pretend SI
+    -- the order of the factor group
 
     zechlog:ARR:=new(((sizeFF+1) quo 2)::NNI,-1::SI)$ARR
     -- the table for the zech logarithm
@@ -55633,9 +63054,10 @@ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_
 
     tableForDiscreteLogarithm(fac) == table()$TBL
 
-
     getZechTable() == zechlog
+
     initializeZech:() -> Void
+
     initializeElt: () -> Void
 
     order(x:$):PI ==
@@ -55644,7 +63066,6 @@ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_
       (sizeCG quo gcd(sizeCG,x pretend NNI))::PI
 
     primitive?(x:$) ==
---      zero?(x) or one?(x) => false
       zero?(x) or (x = 1) => false
       gcd(x::Rep,sizeCG)$Rep = 1$Rep => true
       false
@@ -55652,7 +63073,7 @@ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_
     coordinates(x:$) ==
       x=0 => new(extdeg,0)$(Vector GF)
       primElement:SAE:=convert(monomial(1,1)$(SUP GF))$SAE
--- the primitive element in the corresponding algebraic extension
+      -- the primitive element in the corresponding algebraic extension
       coordinates(primElement **$SAE (x pretend SI))$SAE
 
     x:$ + y:$ ==
@@ -55668,7 +63089,6 @@ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_
       addmod(y,zechlog.(d pretend SI) pretend Rep,sizeCG)$Rep
       --positiveRemainder(x +$Rep zechlog.(d pretend SI) -$Rep d,sizeCG)$Rep
 
-
     initializeZech() ==
       zechlog:=createZechTable(defpol)$FFF
       -- set initialization flag
@@ -55713,8 +63133,6 @@ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_
       u =$FFP 0$FFP => 0
       discreteLog(u)$FFP pretend Rep
 
-
-
     coerce(e:GF):$ ==
       zero?(e)$GF => 0
       log:I:=discreteLog(primEltGF,e)$GF::NNI *$I sizeFG
@@ -55723,7 +63141,6 @@ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_
       -- now 1$GF is coerced to 0$Rep which is correct.
       positiveRemainder(log,sizeCG) pretend Rep
 
-
     retractIfCan(x:$) ==
       zero? x => 0$GF
       u:= (x::Rep) exquo$Rep (sizeFG pretend Rep)
@@ -55737,7 +63154,6 @@ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_
 
     basis() == [index(i :: PI) for i in 1..extdeg]::Vector $
 
-
     inGroundField?(x) ==
       zero? x=> true
       positiveRemainder(x::Rep,sizeFG pretend Rep)$Rep =$Rep 0$Rep => true
@@ -55803,15 +63219,11 @@ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_
       addmod(x,y,sizeCG)$Rep
 
     a:GF * x:$ == coerce(a)@$ * x
-    x:$/a:GF == x/coerce(a)@$
 
---    x:$ / a:GF ==
---      a = 0$GF => error "division by zero"
---      x * inv(coerce(a))
+    x:$/a:GF == x/coerce(a)@$
 
     inv(x:$)  ==
       zero?(x) => error "inv: not invertible"
---      one?(x) => 1
       (x = 1) => 1
       sizeCG -$Rep x
 
@@ -55825,11 +63237,6 @@ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_
       x = 0 => 0
       mulmod(m,x,sizeCG::Rep)$Rep
 
-\end{chunk}
-
-\begin{chunk}{COQ FFCGP}
-(* domain FFCGP *)
-(*
 *)
 
 \end{chunk}
@@ -56402,7 +63809,6 @@ FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_
     -- gets false after initialization of the primitive and the
     -- normal element
 
-
     discLogTable:Table(PI,TBL):=table()$Table(PI,TBL)
     -- tables indexed by the factors of sizeCG,
     -- discLogTable(factor) is a table  with keys
@@ -56412,19 +63818,14 @@ FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_
 
 -- functions ===========================================================
 
---    createNormalElement() ==
---      a:=primitiveElement()
---      nElt:=generator()
---      for i in 1.. repeat
---        normal? nElt => return nElt
---        nElt:=nElt*a
---      nElt
-
     generator() == reduce(monomial(1,1)$SUP(GF))$Rep
+
     norm x   == resultant(defpol, lift x)
 
     initializeElt: () -> Void
+
     initializeLog: () -> Void
+
     basis(n:PI) ==
       (extdeg rem n) ^= 0 => error "argument must divide extension degree"
       a:$:=norm(primitiveElement(),n)
@@ -56457,30 +63858,46 @@ FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_
       ((rank matrix(l)$(Matrix GF)) = extdeg::NNI) => true
       false
 
-
     a:GF * x:$ == a *$Rep x
+
     n:I * x:$ == n *$Rep x
+
     -x == -$Rep x
+
     random() == random()$Rep
+
     coordinates(x:$) == coordinates(x)$Rep
+
     represents(v) == represents(v)$Rep
+
     coerce(x:GF):$ == coerce(x)$Rep
+
     definingPolynomial() == defpol
+
     retract(x) == retract(x)$Rep
+
     retractIfCan(x) == retractIfCan(x)$Rep
+
     index(x) == index(x)$Rep
+
     lookup(x) == lookup(x)$Rep
+
     x:$/y:$ == x /$Rep y
+
     x:$/a:GF == x/coerce(a)
---    x:$ / a:GF ==
---      a = 0$GF => error "division by zero"
---      x * inv(coerce(a))
+
     x:$ * y:$ == x *$Rep y
+
     x:$ + y:$ == x +$Rep y
+
     x:$ - y:$ == x -$Rep y
+
     x:$ = y:$ == x =$Rep y
+
     basis() == basis()$Rep
+
     0 == 0$Rep
+
     1 == 1$Rep
 
     factorsOfCyclicGroupSize() ==
@@ -56521,9 +63938,9 @@ FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_
 
     initializeLog() ==
       if initelt? then initializeElt()
--- set up tables for discrete logarithm
+      -- set up tables for discrete logarithm
       limit:Integer:=30
-    -- the minimum size for the discrete logarithm table
+      -- the minimum size for the discrete logarithm table
       for f in facOfGroupSize repeat
         fac:=f.factor
         base:$:=primitiveElement() ** (sizeCG quo fac)
@@ -56553,8 +63970,6 @@ FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_
 
     size() == (sizeCG + 1) pretend NNI
 
---  sizeOfGroundField() == size()$GF
-
     inGroundField?(x) ==
       retractIfCan(x) = "failed" => false
       true
@@ -56566,6 +63981,203 @@ FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_
 \begin{chunk}{COQ FFP}
 (* domain FFP *)
 (*
+
+    Rep:=SAE
+
+    extdeg:PI        := degree(defpol)$(SUP GF) pretend PI
+    -- the extension degree
+
+    alpha            := new()$Symbol :: OutputForm
+    -- a new symbol for the output form of field elements
+
+    sizeCG:Integer := size()$GF**extdeg - 1
+    -- the order of the multiplicative group
+
+    facOfGroupSize := nil()$(List Record(factor:Integer,exponent:Integer))
+    -- the factorization of sizeCG
+
+    normalElt:PI:=1
+    -- for the lookup of the normal Element computed by
+    -- createNormalElement
+
+    primitiveElt:PI:=1
+    -- for the lookup of the primitive Element computed by
+    -- createPrimitiveElement()
+
+    initlog?:Boolean:=true
+    -- gets false after initialization of the discrete logarithm table
+
+    initelt?:Boolean:=true
+    -- gets false after initialization of the primitive and the
+    -- normal element
+
+    discLogTable:Table(PI,TBL):=table()$Table(PI,TBL)
+    -- tables indexed by the factors of sizeCG,
+    -- discLogTable(factor) is a table  with keys
+    -- primitiveElement() ** (i * (sizeCG quo factor)) and entries i for
+    -- i in 0..n-1, n computed in initialize() in order to use
+    -- the minimal size limit 'limit' optimal.
+
+-- functions ===========================================================
+
+    generator() == reduce(monomial(1,1)$SUP(GF))$Rep
+
+    norm x   == resultant(defpol, lift x)
+
+    initializeElt: () -> Void
+
+    initializeLog: () -> Void
+
+    basis(n:PI) ==
+      (extdeg rem n) ^= 0 => error "argument must divide extension degree"
+      a:$:=norm(primitiveElement(),n)
+      vector [a**i for i in 0..n-1]
+
+    degree(x) ==
+      y:$:=1
+      m:=zero(extdeg,extdeg+1)$(Matrix GF)
+      for i in 1..extdeg+1 repeat
+        setColumn_!(m,i,coordinates(y))$(Matrix GF)
+        y:=y*x
+      rank(m)::PI
+
+    minimalPolynomial(x:$) ==
+      y:$:=1
+      m:=zero(extdeg,extdeg+1)$(Matrix GF)
+      for i in 1..extdeg+1 repeat
+        setColumn_!(m,i,coordinates(y))$(Matrix GF)
+        y:=y*x
+      v:=first nullSpace(m)$(Matrix GF)
+      +/[monomial(v.(i+1),i)$(SUP GF) for i in 0..extdeg]
+
+
+    normal?(x) ==
+      l:List List GF:=[entries coordinates x]
+      a:=x
+      for i in 2..extdeg repeat
+        a:=Frobenius(a)
+        l:=concat(l,entries coordinates a)$(List List GF)
+      ((rank matrix(l)$(Matrix GF)) = extdeg::NNI) => true
+      false
+
+    a:GF * x:$ == a *$Rep x
+
+    n:I * x:$ == n *$Rep x
+
+    -x == -$Rep x
+
+    random() == random()$Rep
+
+    coordinates(x:$) == coordinates(x)$Rep
+
+    represents(v) == represents(v)$Rep
+
+    coerce(x:GF):$ == coerce(x)$Rep
+
+    definingPolynomial() == defpol
+
+    retract(x) == retract(x)$Rep
+
+    retractIfCan(x) == retractIfCan(x)$Rep
+
+    index(x) == index(x)$Rep
+
+    lookup(x) == lookup(x)$Rep
+
+    x:$/y:$ == x /$Rep y
+
+    x:$/a:GF == x/coerce(a)
+
+    x:$ * y:$ == x *$Rep y
+
+    x:$ + y:$ == x +$Rep y
+
+    x:$ - y:$ == x -$Rep y
+
+    x:$ = y:$ == x =$Rep y
+
+    basis() == basis()$Rep
+
+    0 == 0$Rep
+
+    1 == 1$Rep
+
+    factorsOfCyclicGroupSize() ==
+      if empty? facOfGroupSize then initializeElt()
+      facOfGroupSize
+
+    representationType() == "polynomial"
+
+    tableForDiscreteLogarithm(fac) ==
+      if initlog? then initializeLog()
+      tbl:=search(fac::PI,discLogTable)$Table(PI,TBL)
+      tbl case "failed" =>
+        error "tableForDiscreteLogarithm: argument must be prime divisor_
+ of the order of the multiplicative group"
+      tbl pretend TBL
+
+    primitiveElement() ==
+      if initelt? then initializeElt()
+      index(primitiveElt)
+
+    normalElement() ==
+      if initelt? then initializeElt()
+      index(normalElt)
+
+    initializeElt() ==
+      facOfGroupSize:=factors(factor(sizeCG)$Integer)
+      -- get a primitive element
+      pE:=createPrimitiveElement()
+      primitiveElt:=lookup(pE)
+      -- create a normal element
+      nElt:=generator()
+      while not normal? nElt repeat
+        nElt:=nElt*pE
+      normalElt:=lookup(nElt)
+      -- set elements initialization flag
+      initelt? := false
+      void()$Void
+
+    initializeLog() ==
+      if initelt? then initializeElt()
+      -- set up tables for discrete logarithm
+      limit:Integer:=30
+      -- the minimum size for the discrete logarithm table
+      for f in facOfGroupSize repeat
+        fac:=f.factor
+        base:$:=primitiveElement() ** (sizeCG quo fac)
+        l:Integer:=length(fac)$Integer
+        n:Integer:=0
+        if odd?(l)$Integer then n:=shift(fac,-(l quo 2))
+                           else n:=shift(1,(l quo 2))
+        if n < limit then
+          d:=(fac-1) quo limit + 1
+          n:=(fac-1) quo d + 1
+        tbl:TBL:=table()$TBL
+        a:$:=1
+        for i in (0::NNI)..(n-1)::NNI repeat
+          insert_!([lookup(a),i::NNI]$R,tbl)$TBL
+          a:=a*base
+        insert_!([fac::PI,copy(tbl)$TBL]_
+               $Record(key:PI,entry:TBL),discLogTable)$Table(PI,TBL)
+      -- set logarithm initialization flag
+      initlog? := false
+      -- tell user about initialization
+      --print("discrete logarithm tables initialized"::OUT)
+      void()$Void
+
+    coerce(e:$):OutputForm == outputForm(lift(e),alpha)
+
+    extensionDegree() == extdeg
+
+    size() == (sizeCG + 1) pretend NNI
+
+    inGroundField?(x) ==
+      retractIfCan(x) = "failed" => false
+      true
+
+    characteristic() == characteristic()$GF
+
 *)
 
 \end{chunk}
@@ -56851,7 +64463,8 @@ FiniteFieldNormalBasis(p,extdeg):_
       ++ multiplication table of the field. Note: The time of multiplication
       ++ of field elements depends on this size.
 
-  Implementation ==> FiniteFieldNormalBasisExtensionByPolynomial(PrimeField(p),_
+  Implementation ==>
+     FiniteFieldNormalBasisExtensionByPolynomial(PrimeField(p),_
                     createLowComplexityNormalBasis(extdeg)$FFF)
 
 \end{chunk}
@@ -57495,18 +65108,16 @@ FiniteFieldNormalBasisExtensionByPolynomial(GF,uni): Exports == _
       append([alpha, alpha **$OUT qs],_
         [alpha **$OUT (qs **$OUT i::OUT) for i in 2..extdeg-1] )
 
-
     facOfGroupSize :=nil()$(List Record(factor:Integer,exponent:Integer))
     -- the factorization of the cyclic group size
 
-
     traceAlpha:GF:=-$GF coefficient(defpol,(degree(defpol)-1)::NNI)
     -- the inverse of the trace of the normalElt
     -- is computed here. It defines the imbedding of
     -- GF in the extension field
 
     primitiveElt:PI:=1
-    -- for the lookup the primitive Element computed by createPrimitiveElement()
+    -- lookup the primitive Element computed by createPrimitiveElement()
 
     discLogTable:Table(PI,TBL):=table()$Table(PI,TBL)
     -- tables indexed by the factors of sizeCG,
@@ -57518,9 +65129,10 @@ FiniteFieldNormalBasisExtensionByPolynomial(GF,uni): Exports == _
 -- functions ===========================================================
 
     initializeLog: ()     -> Void
+
     initializeElt: ()     -> Void
-    initializeMult: ()     -> Void
 
+    initializeMult: ()     -> Void
 
     coerce(v:GF):$  == new(extdeg,v /$GF traceAlpha)$Rep
     represents(v)   ==  v::$
@@ -57537,10 +65149,13 @@ FiniteFieldNormalBasisExtensionByPolynomial(GF,uni): Exports == _
       xm:SUP(GF):=monomial(1$GF,extdeg)$(SUP GF) - 1$(SUP GF)
       r:= (f * pol(x::Rep)$INBFF) rem xm
       vectorise(r,extdeg)$(SUP GF)
+
     linearAssociatedLog(x) ==  pol(x::Rep)$INBFF
+
     linearAssociatedOrder(x) ==
       xm:SUP(GF):=monomial(1$GF,extdeg)$(SUP GF) - 1$(SUP GF)
       xm quo gcd(xm,pol(x::Rep)$INBFF)
+
     linearAssociatedLog(b,x) ==
       zero? x => 0
       xm:SUP(GF):=monomial(1$GF,extdeg)$(SUP GF) - 1$(SUP GF)
@@ -57552,16 +65167,21 @@ FiniteFieldNormalBasisExtensionByPolynomial(GF,uni): Exports == _
     getMultiplicationTable() ==
       if initmult? then initializeMult()
       multTable
+
     getMultiplicationMatrix() ==
       if initmult? then initializeMult()
       createMultiplicationMatrix(multTable)$FFF
+
     sizeMultiplication() ==
       if initmult? then initializeMult()
       sizeMultiplication(multTable)$FFF
 
     trace(a:$) == retract trace(a,1)
+
     norm(a:$) == retract norm(a,1)
+
     generator() == normalElement(extdeg)$INBFF
+
     basis(n:PI) ==
       (extdeg rem n) ^= 0 => error "argument must divide extension degree"
       [Frobenius(trace(normalElement,n),i) for i in 0..(n-1)]::(Vector $)
@@ -57569,10 +65189,6 @@ FiniteFieldNormalBasisExtensionByPolynomial(GF,uni): Exports == _
     a:GF * x:$ == a *$Rep x
 
     x:$/a:GF == x/coerce(a)
---    x:$ / a:GF ==
---      a = 0$GF => error "division by zero"
---      x * inv(coerce(a))
-
 
     coordinates(x:$)  == x::Rep
 
@@ -57589,16 +65205,14 @@ FiniteFieldNormalBasisExtensionByPolynomial(GF,uni): Exports == _
         x.1 *$GF traceAlpha
       error("element not in ground field")
 
--- to get a "normal basis like" output form
+    -- to get a "normal basis like" output form
     coerce(x:$):OUT ==
       l:List OUT:=nil()$(List OUT)
       n : PI := extdeg
---      one? n => (x.1) :: OUT
       (n = 1) => (x.1) :: OUT
       for i in 1..n for b in basisOutput repeat
         if not zero? x.i then
           mon : OUT :=
---            one? x.i => b
             (x.i = 1) => b
             ((x.i)::OUT) *$OUT b
           l:=cons(mon,l)$(List OUT)
@@ -57685,7 +65299,6 @@ divisor of the order of the multiplicative group"
       setFieldInfo(multTable,traceAlpha)$INBFF
       x::Rep *$INBFF y::Rep
 
-
     1 == new(extdeg,inv(traceAlpha)$GF)$Rep
 
     0 == zero(extdeg)$Rep
@@ -57696,12 +65309,10 @@ divisor of the order of the multiplicative group"
 
     lookup(x:$) == lookup(x::Rep)$INBFF
 
-
     basis() ==
       a:=basis(extdeg)$INBFF
       vector([e::$ for e in entries a])
 
-
     x:$ ** e:I ==
       if initmult? then initializeMult()
       setFieldInfo(multTable,traceAlpha)$INBFF
@@ -57710,13 +65321,14 @@ divisor of the order of the multiplicative group"
     normal?(x) == normal?(x::Rep)$INBFF
 
     -(x:$) == -$Rep x
+
     x:$ + y:$ == x +$Rep y
-    x:$ - y:$ == x -$Rep y
-    x:$ = y:$ == x =$Rep y
-    n:I * x:$ == x *$Rep (n::GF)
 
+    x:$ - y:$ == x -$Rep y
 
+    x:$ = y:$ == x =$Rep y
 
+    n:I * x:$ == x *$Rep (n::GF)
 
     representationType() == "normal"
 
@@ -57725,7 +65337,7 @@ divisor of the order of the multiplicative group"
       setFieldInfo(multTable,traceAlpha)$INBFF
       minimalPolynomial(a::Rep)$INBFF
 
--- is x an element of the ground field GF ?
+    -- is x an element of the ground field GF ?
     inGroundField?(x) ==
       erg:=true
       for i in 2..extdeg repeat
@@ -57754,6 +65366,301 @@ divisor of the order of the multiplicative group"
 \begin{chunk}{COQ FFNBP}
 (* domain FFNBP *)
 (*
+
+    Rep:= V     -- elements are represented by vectors over GF
+
+    alpha       :=new()$Symbol :: OutputForm
+    -- get a new Symbol for the output representation of the elements
+
+    initlog?:Boolean:=true
+    -- gets false after initialization of the logarithm table
+
+    initelt?:Boolean:=true
+    -- gets false after initialization of the primitive element
+
+    initmult?:Boolean:=true
+    -- gets false after initialization of the multiplication
+    -- table or the primitive element
+
+    extdeg:PI   :=1
+
+    defpol:SUP(GF):=0$SUP(GF)
+    -- the defining polynomial
+
+    multTable:Vector List TERM:=new(1,nil()$(List TERM))
+    -- global variable containing the multiplication table
+
+    if uni case (Vector List TERM) then
+      multTable:=uni :: (Vector List TERM)
+      extdeg:= (#multTable) pretend PI
+      vv:V:=new(extdeg,0)$V
+      vv.1:=1$GF
+      setFieldInfo(multTable,1$GF)$INBFF
+      defpol:=minimalPolynomial(vv)$INBFF
+      initmult?:=false
+     else
+      defpol:=uni :: SUP(GF)
+      extdeg:=degree(defpol)$(SUP GF) pretend PI
+      multTable:Vector List TERM:=new(extdeg,nil()$(List TERM))
+
+    basisOutput : List OUT :=
+      qs:OUT:=(q::Symbol)::OUT
+      append([alpha, alpha **$OUT qs],_
+        [alpha **$OUT (qs **$OUT i::OUT) for i in 2..extdeg-1] )
+
+    facOfGroupSize :=nil()$(List Record(factor:Integer,exponent:Integer))
+    -- the factorization of the cyclic group size
+
+    traceAlpha:GF:=-$GF coefficient(defpol,(degree(defpol)-1)::NNI)
+    -- the inverse of the trace of the normalElt
+    -- is computed here. It defines the imbedding of
+    -- GF in the extension field
+
+    primitiveElt:PI:=1
+    -- lookup the primitive Element computed by createPrimitiveElement()
+
+    discLogTable:Table(PI,TBL):=table()$Table(PI,TBL)
+    -- tables indexed by the factors of sizeCG,
+    -- discLogTable(factor) is a table with keys
+    -- primitiveElement() ** (i * (sizeCG quo factor)) and entries i for
+    -- i in 0..n-1, n computed in initialize() in order to use
+    -- the minimal size limit 'limit' optimal.
+
+-- functions ===========================================================
+
+    initializeLog: ()     -> Void
+
+    initializeElt: ()     -> Void
+
+    initializeMult: ()     -> Void
+
+    coerce(v:GF):$  == new(extdeg,v /$GF traceAlpha)$Rep
+    represents(v)   ==  v::$
+
+    degree(a) ==
+      d:PI:=1
+      b:= qPot(a::Rep,1)$INBFF
+      while (b^=a) repeat
+        b:= qPot(b::Rep,1)$INBFF
+        d:=d+1
+      d
+
+    linearAssociatedExp(x,f) ==
+      xm:SUP(GF):=monomial(1$GF,extdeg)$(SUP GF) - 1$(SUP GF)
+      r:= (f * pol(x::Rep)$INBFF) rem xm
+      vectorise(r,extdeg)$(SUP GF)
+
+    linearAssociatedLog(x) ==  pol(x::Rep)$INBFF
+
+    linearAssociatedOrder(x) ==
+      xm:SUP(GF):=monomial(1$GF,extdeg)$(SUP GF) - 1$(SUP GF)
+      xm quo gcd(xm,pol(x::Rep)$INBFF)
+
+    linearAssociatedLog(b,x) ==
+      zero? x => 0
+      xm:SUP(GF):=monomial(1$GF,extdeg)$(SUP GF) - 1$(SUP GF)
+      e:= extendedEuclidean(pol(b::Rep)$INBFF,xm,pol(x::Rep)$INBFF)$(SUP GF)
+      e = "failed" => "failed"
+      e1:= e :: Record(coef1:(SUP GF),coef2:(SUP GF))
+      e1.coef1
+
+    getMultiplicationTable() ==
+      if initmult? then initializeMult()
+      multTable
+
+    getMultiplicationMatrix() ==
+      if initmult? then initializeMult()
+      createMultiplicationMatrix(multTable)$FFF
+
+    sizeMultiplication() ==
+      if initmult? then initializeMult()
+      sizeMultiplication(multTable)$FFF
+
+    trace(a:$) == retract trace(a,1)
+
+    norm(a:$) == retract norm(a,1)
+
+    generator() == normalElement(extdeg)$INBFF
+
+    basis(n:PI) ==
+      (extdeg rem n) ^= 0 => error "argument must divide extension degree"
+      [Frobenius(trace(normalElement,n),i) for i in 0..(n-1)]::(Vector $)
+
+    a:GF * x:$ == a *$Rep x
+
+    x:$/a:GF == x/coerce(a)
+
+    coordinates(x:$)  == x::Rep
+
+    Frobenius(e) == qPot(e::Rep,1)$INBFF
+    Frobenius(e,n) == qPot(e::Rep,n)$INBFF
+
+    retractIfCan(x) ==
+      inGroundField?(x) =>
+        x.1 *$GF traceAlpha
+      "failed"
+
+    retract(x) ==
+      inGroundField?(x) =>
+        x.1 *$GF traceAlpha
+      error("element not in ground field")
+
+    -- to get a "normal basis like" output form
+    coerce(x:$):OUT ==
+      l:List OUT:=nil()$(List OUT)
+      n : PI := extdeg
+      (n = 1) => (x.1) :: OUT
+      for i in 1..n for b in basisOutput repeat
+        if not zero? x.i then
+          mon : OUT :=
+            (x.i = 1) => b
+            ((x.i)::OUT) *$OUT b
+          l:=cons(mon,l)$(List OUT)
+      null(l)$(List OUT) => (0::OUT)
+      r:=reduce("+",l)$(List OUT)
+      r
+
+    initializeElt() ==
+      facOfGroupSize := factors factor(size()$GF**extdeg-1)$I
+      -- get a primitive element
+      primitiveElt:=lookup(createPrimitiveElement())
+      initelt?:=false
+      void()$Void
+
+    initializeMult() ==
+      multTable:=createMultiplicationTable(defpol)$FFF
+      setFieldInfo(multTable,traceAlpha)$INBFF
+      -- reset initialize flag
+      initmult?:=false
+      void()$Void
+
+    initializeLog() ==
+      if initelt? then initializeElt()
+      -- set up tables for discrete logarithm
+      limit:Integer:=30
+      -- the minimum size for the discrete logarithm table
+      for f in facOfGroupSize repeat
+        fac:=f.factor
+        base:$:=index(primitiveElt)**((size()$GF**extdeg -$I 1$I) quo$I fac)
+        l:Integer:=length(fac)$Integer
+        n:Integer:=0
+        if odd?(l)$I then n:=shift(fac,-$I (l quo$I 2))$I
+                     else n:=shift(1,l quo$I 2)$I
+        if n <$I limit then
+          d:=(fac -$I 1$I) quo$I limit +$I 1$I
+          n:=(fac -$I 1$I) quo$I d +$I 1$I
+        tbl:TBL:=table()$TBL
+        a:$:=1
+        for i in (0::NNI)..(n-1)::NNI repeat
+          insert_!([lookup(a),i::NNI]$R,tbl)$TBL
+          a:=a*base
+        insert_!([fac::PI,copy(tbl)$TBL]_
+               $Record(key:PI,entry:TBL),discLogTable)$Table(PI,TBL)
+      initlog?:=false
+      -- tell user about initialization
+      --print("discrete logarithm table initialized"::OUT)
+      void()$Void
+
+    tableForDiscreteLogarithm(fac) ==
+      if initlog? then initializeLog()
+      tbl:=search(fac::PI,discLogTable)$Table(PI,TBL)
+      tbl case "failed" =>
+        error "tableForDiscreteLogarithm: argument must be prime _
+divisor of the order of the multiplicative group"
+      tbl :: TBL
+
+    primitiveElement() ==
+      if initelt? then initializeElt()
+      index(primitiveElt)
+
+    factorsOfCyclicGroupSize() ==
+      if empty? facOfGroupSize then initializeElt()
+      facOfGroupSize
+
+    extensionDegree() == extdeg
+
+    sizeOfGroundField() == size()$GF pretend NNI
+
+    definingPolynomial() == defpol
+
+    trace(a,d) ==
+      v:=trace(a::Rep,d)$INBFF
+      erg:=v
+      for i in 2..(extdeg quo d) repeat
+        erg:=concat(erg,v)$Rep
+      erg
+
+    characteristic() == characteristic()$GF
+
+    random() == random(extdeg)$INBFF
+
+    x:$ * y:$ ==
+      if initmult? then initializeMult()
+      setFieldInfo(multTable,traceAlpha)$INBFF
+      x::Rep *$INBFF y::Rep
+
+    1 == new(extdeg,inv(traceAlpha)$GF)$Rep
+
+    0 == zero(extdeg)$Rep
+
+    size() == size()$GF ** extdeg
+
+    index(n:PI) == index(extdeg,n)$INBFF
+
+    lookup(x:$) == lookup(x::Rep)$INBFF
+
+    basis() ==
+      a:=basis(extdeg)$INBFF
+      vector([e::$ for e in entries a])
+
+    x:$ ** e:I ==
+      if initmult? then initializeMult()
+      setFieldInfo(multTable,traceAlpha)$INBFF
+      (x::Rep) **$INBFF e
+
+    normal?(x) == normal?(x::Rep)$INBFF
+
+    -(x:$) == -$Rep x
+
+    x:$ + y:$ == x +$Rep y
+
+    x:$ - y:$ == x -$Rep y
+
+    x:$ = y:$ == x =$Rep y
+
+    n:I * x:$ == x *$Rep (n::GF)
+
+    representationType() == "normal"
+
+    minimalPolynomial(a) ==
+      if initmult? then initializeMult()
+      setFieldInfo(multTable,traceAlpha)$INBFF
+      minimalPolynomial(a::Rep)$INBFF
+
+    -- is x an element of the ground field GF ?
+    inGroundField?(x) ==
+      erg:=true
+      for i in 2..extdeg repeat
+        not(x.i =$GF x.1) => erg:=false
+      erg
+
+    x:$ / y:$ ==
+      if initmult? then initializeMult()
+      setFieldInfo(multTable,traceAlpha)$INBFF
+      x::Rep /$INBFF y::Rep
+
+    inv(a) ==
+      if initmult? then initializeMult()
+      setFieldInfo(multTable,traceAlpha)$INBFF
+      inv(a::Rep)$INBFF
+
+    norm(a,d) ==
+      if initmult? then initializeMult()
+      setFieldInfo(multTable,traceAlpha)$INBFF
+      norm(a::Rep,d)$INBFF
+
+    normalElement() == normalElement(extdeg)$INBFF
+
 *)
 
 \end{chunk}
@@ -59650,42 +67557,70 @@ Float():
       ++ outputGeneral(n) sets the output mode to general notation
       ++ with n significant digits displayed.
    outputSpacing: N -> Void
-      ++ outputSpacing(n) inserts a space after n (default 10) digits on output;
+      ++ outputSpacing(n) inserts space after n (default 10) digits on output;
       ++ outputSpacing(0) means no spaces are inserted.
    arbitraryPrecision
    arbitraryExponent
   == add
+
    BASE ==> 2
+
    BITS:Reference(PI) := ref 68 -- 20 digits
+
    LENGTH ==> INTEGER_-LENGTH$Lisp
+
    ISQRT ==> approxSqrt$IntegerRoots(I)
+
    Rep := Record( mantissa:I, exponent:I )
+
    StoredConstant ==> Record( precision:PI, value:% )
+
    UCA ==> Record( unit:%, coef:%, associate:% )
+
    inc ==> increasePrecision
+
    dec ==> decreasePrecision
 
    -- local utility operations
+
    shift2 : (I,I) -> I           -- WSP: fix bug in shift
+
    times : (%,%) -> %            -- multiply x and y with no rounding
+
    itimes: (I,%) -> %            -- multiply by a small integer
+
    chop: (%,PI) -> %             -- chop x at p bits of precision
+
    dvide: (%,%) -> %             -- divide x by y with no rounding
+
    square: (%,I) -> %            -- repeated squaring with chopping
+
    power: (%,I) -> %             -- x ** n with chopping
+
    plus: (%,%) -> %              -- addition with no rounding
+
    sub: (%,%) -> %               -- subtraction with no rounding
+
    negate: % -> %                -- negation with no rounding
+
    ceillog10base2: PI -> PI      -- rational approximation
+
    floorln2: PI -> PI            -- rational approximation
 
    atanSeries: % -> %            -- atan(x) by taylor series |x| < 1/2
+
    atanInverse: I -> %           -- atan(1/n) for n an integer > 1
+
    expInverse: I -> %            -- exp(1/n) for n an integer
+
    expSeries: % -> %             -- exp(x) by taylor series  |x| < 1/2
+
    logSeries: % -> %             -- log(x) by taylor series 1/2 < x < 2
+
    sinSeries: % -> %             -- sin(x) by taylor series |x| < 1/2
+
    cosSeries: % -> %             -- cos(x) by taylor series |x| < 1/2
+
    piRamanujan: () -> %          -- pi using Ramanujans series
 
    writeOMFloat(dev: OpenMathDevice, x: %): Void ==
@@ -59737,7 +67672,6 @@ Float():
    asin x ==
       zero? x => 0
       negative? x => -asin(-x)
---      one? x => pi()/2
       (x = 1) => pi()/2
       x > 1 => error "asin: argument > 1 in magnitude"
       inc 5; r := atan(x/sqrt(sub(1,times(x,x)))); dec 5
@@ -59746,7 +67680,6 @@ Float():
    acos x ==
       zero? x => pi()/2
       negative? x => (inc 3; r := pi()-acos(-x); dec 3; normalize r)
---      one? x => 0
       (x = 1) => 0
       x > 1 => error "acos: argument > 1 in magnitude"
       inc 5; r := atan(sqrt(sub(1,times(x,x)))/x); dec 5
@@ -59768,7 +67701,8 @@ Float():
       negative? x => -atan(-x)
       if x > 1 then
          inc 4
-         r := if zero? fractionPart x and x < [bits(),0] then atanInverse wholePart x
+         r := if zero? fractionPart x and x < [bits(),0] _
+                 then atanInverse wholePart x
                  else atan(1/x)
          r := pi/2 - r
          dec 4
@@ -59859,8 +67793,6 @@ Float():
      bits p
      s * r
 
-
-
    cosSeries x ==
       -- cos(x) = 1 - x**2/2! + x**4/4! - x**6/6! + ... |x| < 1/2
       p := bits() + LENGTH bits() + 1
@@ -59884,6 +67816,7 @@ Float():
       s * t
 
    P:StoredConstant := [1,[1,2]]
+
    pi() ==
       -- We use Ramanujan's identity to compute pi.
       -- The running time is quadratic in the precision.
@@ -59978,6 +67911,7 @@ Float():
       y * [s,1-p]
 
    L2:StoredConstant := [1,1]
+
    log2() ==
       --  log x  =  2 * sum( ((x-1)/(x+1))**(2*k+1)/(2*k+1), k=1.. )
       --  log 2  =  2 * sum( 1/9**k / (2*k+1), k=0..n ) / 3
@@ -59993,6 +67927,7 @@ Float():
       normalize L2.value
 
    L10:StoredConstant := [1,[1,1]]
+
    log10() ==
       --  log x  =  2 * sum( ((x-1)/(x+1))**(2*k+1)/(2*k+1), k=0.. )
       --  log 5/4  =  2 * sum( 1/81**k / (2*k+1), k=0.. ) / 9
@@ -60009,6 +67944,7 @@ Float():
       normalize L10.value
 
    log2(x) == (inc 2; r := log(x)/log2; dec 2; normalize r)
+
    log10(x) == (inc 2; r := log(x)/log10; dec 2; normalize r)
 
    exp(x) ==
@@ -60050,6 +67986,7 @@ Float():
       dvide([p1,0],[q1,0])
 
    E:StoredConstant := [1,[1,1]]
+
    exp1() ==
       if bits() > E.precision then E := [bits(),expInverse 1]
       normalize E.value
@@ -60066,36 +68003,57 @@ Float():
       normalize [i,(e-p) quo 2]
 
    bits() == BITS()
+
    bits(n) == (t := bits(); BITS() := n; t)
+
    precision() == bits()
+
    precision(n) == bits(n)
+
    increasePrecision n == (b := bits(); bits((b + n)::PI); b)
+
    decreasePrecision n == (b := bits(); bits((b - n)::PI); b)
+
    ceillog10base2 n == ((13301 * n + 4003) quo 4004) :: PI
+
    digits() == max(1,4004 * (bits()-1) quo 13301)::PI
+
    digits(n) == (t := digits(); bits (1 + ceillog10base2 n); t)
 
    order(a) == LENGTH a.mantissa + a.exponent - 1
+
    relerror(a,b) == order((a-b)/b)
+
    0 == [0,0]
+
    1 == [1,0]
+
    base() == BASE
+
    mantissa x == x.mantissa
+
    exponent x == x.exponent
+
    one? a == a = 1
+
    zero? a == zero?(a.mantissa)
+
    negative? a == negative?(a.mantissa)
+
    positive? a == positive?(a.mantissa)
 
    chop(x,p) ==
       e : I := LENGTH x.mantissa - p
       if e > 0 then x := [shift2(x.mantissa,-e),x.exponent+e]
       x
+
    float(m,e) == normalize [m,e]
+
    float(m,e,b) ==
       m = 0 => 0
       inc 4; r := m * [b,0] ** e; dec 4
       normalize r
+
    normalize x ==
       m := x.mantissa
       m = 0 => 0
@@ -60110,10 +68068,12 @@ Float():
          else y := y quo 2
          x := [y,x.exponent+e]
       x
+
    shift(x:%,n:I) == [x.mantissa,x.exponent+n]
 
    x = y ==
       order x = order y and sign x = sign y and zero? (x - y)
+
    x < y ==
       y.mantissa = 0 => x.mantissa < 0
       x.mantissa = 0 => y.mantissa > 0
@@ -60124,24 +68084,37 @@ Float():
       negative? (x-y)
 
    abs x == if negative? x then -x else normalize x
+
    ceiling x ==
       if negative? x then return (-floor(-x))
       if zero? fractionPart x then x else truncate x + 1
+
    wholePart x == shift2(x.mantissa,x.exponent)
+
    floor x == if negative? x then -ceiling(-x) else truncate x
+
    round x == (half := [sign x,-1]; truncate(x + half))
+
    sign x == if x.mantissa < 0 then -1 else 1
+
    truncate x ==
       if x.exponent >= 0 then return x
       normalize [shift2(x.mantissa,x.exponent),0]
+
    recip(x) == if x=0 then "failed" else 1/x
+
    differentiate x == 0
 
    - x == normalize negate x
+
    negate x == [-x.mantissa,x.exponent]
+
    x + y == normalize plus(x,y)
+
    x - y == normalize plus(x,negate y)
+
    sub(x,y) == plus(x,negate y)
+
    plus(x,y) ==
       mx := x.mantissa; my := y.mantissa
       mx = 0 => y
@@ -60156,15 +68129,20 @@ Float():
       [mw,ey]
 
    x:% * y:% == normalize times (x,y)
+
    x:I * y:% ==
       if LENGTH x > bits() then normalize [x,0] * y
       else normalize [x * y.mantissa,y.exponent]
+
    x:% / y:% == normalize dvide(x,y)
+
    x:% / y:I ==
       if LENGTH y > bits() then x / normalize [y,0] else x / [y,0]
+
    inv x == 1 / x
 
    times(x:%,y:%) == [x.mantissa * y.mantissa, x.exponent + y.exponent]
+
    itimes(n:I,y:%) == [n * y.mantissa,y.exponent]
 
    dvide(x,y) ==
@@ -60237,14 +68215,23 @@ Float():
       normalize y
 
    -- Utility routines for conversion to decimal
+
    ceilLength10: I -> I
+
    chop10: (%,I) -> %
+
    convert10:(%,I) -> %
+
    floorLength10: I -> I
+
    length10: I -> I
+
    normalize10: (%,I) -> %
+
    quotient10: (%,%,I) -> %
+
    power10: (%,I,I) -> %
+
    times10: (%,%,I) -> %
 
    convert10(x,d) ==
@@ -60259,8 +68246,9 @@ Float():
       else times10([m,0],h,d)
 
    ceilLength10 n == 146 * LENGTH n quo 485 + 1
+
    floorLength10 n == 643 *  LENGTH n quo 2136
---   length10 n == DECIMAL_-LENGTH(n)$Lisp
+
    length10 n ==
       ln := LENGTH(n:=abs n)
       upper := 76573 * ln quo 254370
@@ -60276,6 +68264,7 @@ Float():
       e : I := floorLength10 x.mantissa - p
       if e > 0 then x := [x.mantissa quo 10**e::N,x.exponent+e]
       x
+
    normalize10(x,p) ==
       ma := x.mantissa
       ex := x.exponent
@@ -60288,13 +68277,16 @@ Float():
             ma := ma + 1
             if ma = 10**p::N then (ma := 1; ex := ex + p)
       [ma,ex]
+
    times10(x,y,p) == normalize10(times(x,y),p)
+
    quotient10(x,y,p) ==
       ew := floorLength10 y.mantissa - ceilLength10 x.mantissa + p + 2
       if ew < 0 then ew := 0
       mw := (x.mantissa * 10**ew::N) quo y.mantissa
       ew := x.exponent - y.exponent - ew
       normalize10([mw,ew],p)
+
    power10(x,n,d) ==
       x = 0 => 0
       n = 0 => 1
@@ -60313,14 +68305,19 @@ Float():
    -- Output routines for Floats --
    --------------------------------
    zero ==> char("0")
+
    separator ==> space()$Character
 
    SPACING : Reference(N) := ref 10
+
    OUTMODE : Reference(S) := ref "general"
+
    OUTPREC : Reference(I) := ref(-1)
 
    fixed : % -> S
+
    floating : % -> S
+
    general : % -> S
 
    padFromLeft(s:S):S ==
@@ -60433,11 +68430,17 @@ Float():
          concat ["0.", t, s, convert(e+n)@S]
 
    outputSpacing n == SPACING() := n
+
    outputFixed() == (OUTMODE() := "fixed"; OUTPREC() := -1)
+
    outputFixed n == (OUTMODE() := "fixed"; OUTPREC() := n::I)
+
    outputGeneral() == (OUTMODE() := "general"; OUTPREC() := -1)
+
    outputGeneral n == (OUTMODE() := "general"; OUTPREC() := n::I)
+
    outputFloating() == (OUTMODE() := "floating"; OUTPREC() := -1)
+
    outputFloating n == (OUTMODE() := "floating"; OUTPREC() := n::I)
 
    convert(f):S ==
@@ -60463,9 +68466,13 @@ Float():
               convert exponent f, convert base()]$List(InputForm)
 
    -- Conversion routines
+
    convert(x:%):Float == x pretend Float
+
    convert(x:%):SF == makeSF(x.mantissa,x.exponent)$Lisp
+
    coerce(x:%):SF == convert(x)@SF
+
    convert(sf:SF):% == float(mantissa sf,exponent sf,base()$SF)
 
    retract(f:%):RN == rationalApproximation(f,(bits()-1)::N,BASE)
@@ -60507,1357 +68514,1059 @@ Float():
 \begin{chunk}{COQ FLOAT}
 (* domain FLOAT *)
 (*
-*)
 
-\end{chunk}
+   BASE ==> 2
 
-\begin{chunk}{FLOAT.dotabb}
-"FLOAT" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FLOAT"]
-"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
-"FLOAT" -> "ALIST"
+   BITS:Reference(PI) := ref 68 -- 20 digits
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FC FortranCode}
+   LENGTH ==> INTEGER_-LENGTH$Lisp
 
-\begin{chunk}{FortranCode.input}
-)set break resume
-)sys rm -f FortranCode.output
-)spool FortranCode.output
-)set message test on
-)set message auto off
-)clear all
+   ISQRT ==> approxSqrt$IntegerRoots(I)
 
---S 1 of 1
-)show FortranCode
---R 
---R FortranCode  is a domain constructor
---R Abbreviation for FortranCode is FC 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FC 
---R
---R------------------------------- Operations --------------------------------
---R ?=? : (%,%) -> Boolean                assign : (Symbol,String) -> %
---R block : List(%) -> %                  call : String -> %
---R coerce : % -> OutputForm              comment : List(String) -> %
---R comment : String -> %                 common : (Symbol,List(Symbol)) -> %
---R cond : (Switch,%,%) -> %              cond : (Switch,%) -> %
---R continue : SingleInteger -> %         getCode : % -> SExpression
---R goto : SingleInteger -> %             hash : % -> SingleInteger
---R latex : % -> String                   printCode : % -> Void
---R repeatUntilLoop : (Switch,%) -> %     returns : Expression(Integer) -> %
---R returns : Expression(Float) -> %      returns : () -> %
---R save : () -> %                        stop : () -> %
---R whileLoop : (Switch,%) -> %           ?~=? : (%,%) -> Boolean
---R assign : (Symbol,List(Polynomial(Integer)),Expression(Complex(Float))) -> %
---R assign : (Symbol,List(Polynomial(Integer)),Expression(Float)) -> %
---R assign : (Symbol,List(Polynomial(Integer)),Expression(Integer)) -> %
---R assign : (Symbol,Vector(Expression(Complex(Float)))) -> %
---R assign : (Symbol,Vector(Expression(Float))) -> %
---R assign : (Symbol,Vector(Expression(Integer))) -> %
---R assign : (Symbol,Matrix(Expression(Complex(Float)))) -> %
---R assign : (Symbol,Matrix(Expression(Float))) -> %
---R assign : (Symbol,Matrix(Expression(Integer))) -> %
---R assign : (Symbol,Expression(Complex(Float))) -> %
---R assign : (Symbol,Expression(Float)) -> %
---R assign : (Symbol,Expression(Integer)) -> %
---R assign : (Symbol,List(Polynomial(Integer)),Expression(MachineComplex)) -> %
---R assign : (Symbol,List(Polynomial(Integer)),Expression(MachineFloat)) -> %
---R assign : (Symbol,List(Polynomial(Integer)),Expression(MachineInteger)) -> %
---R assign : (Symbol,Vector(Expression(MachineComplex))) -> %
---R assign : (Symbol,Vector(Expression(MachineFloat))) -> %
---R assign : (Symbol,Vector(Expression(MachineInteger))) -> %
---R assign : (Symbol,Matrix(Expression(MachineComplex))) -> %
---R assign : (Symbol,Matrix(Expression(MachineFloat))) -> %
---R assign : (Symbol,Matrix(Expression(MachineInteger))) -> %
---R assign : (Symbol,Vector(MachineComplex)) -> %
---R assign : (Symbol,Vector(MachineFloat)) -> %
---R assign : (Symbol,Vector(MachineInteger)) -> %
---R assign : (Symbol,Matrix(MachineComplex)) -> %
---R assign : (Symbol,Matrix(MachineFloat)) -> %
---R assign : (Symbol,Matrix(MachineInteger)) -> %
---R assign : (Symbol,Expression(MachineComplex)) -> %
---R assign : (Symbol,Expression(MachineFloat)) -> %
---R assign : (Symbol,Expression(MachineInteger)) -> %
---R code : % -> Union(nullBranch: null,assignmentBranch: Record(var: Symbol,arrayIndex: List(Polynomial(Integer)),rand: Record(ints2Floats?: Boolean,expr: OutputForm)),arrayAssignmentBranch: Record(var: Symbol,rand: OutputForm,ints2Floats?: Boolean),conditionalBranch: Record(switch: Switch,thenClause: %,elseClause: %),returnBranch: Record(empty?: Boolean,value: Record(ints2Floats?: Boolean,expr: OutputForm)),blockBranch: List(%),commentBranch: List(String),callBranch: String,forBranch: Record(range: SegmentBinding(Polynomial(Integer)),span: Polynomial(Integer),body: %),labelBranch: SingleInteger,loopBranch: Record(switch: Switch,body: %),commonBranch: Record(name: Symbol,contents: List(Symbol)),printBranch: List(OutputForm))
---R forLoop : (SegmentBinding(Polynomial(Integer)),Polynomial(Integer),%) -> %
---R forLoop : (SegmentBinding(Polynomial(Integer)),%) -> %
---R operation : % -> Union(Null: null,Assignment: assignment,Conditional: conditional,Return: return,Block: block,Comment: comment,Call: call,For: for,While: while,Repeat: repeat,Goto: goto,Continue: continue,ArrayAssignment: arrayAssignment,Save: save,Stop: stop,Common: common,Print: print)
---R printStatement : List(OutputForm) -> %
---R returns : Expression(Complex(Float)) -> %
---R returns : Expression(MachineComplex) -> %
---R returns : Expression(MachineInteger) -> %
---R returns : Expression(MachineFloat) -> %
---R setLabelValue : SingleInteger -> SingleInteger
---R
---E 1
+   Rep := Record( mantissa:I, exponent:I )
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{FortranCode.help}
-====================================================================
-FortranCode examples
-====================================================================
+   StoredConstant ==> Record( precision:PI, value:% )
 
-This domain builds representations of program code segments for use with
-the FortranProgram domain.
+   UCA ==> Record( unit:%, coef:%, associate:% )
 
-See Also:
-o )show FortranCode
+   inc ==> increasePrecision
 
-\end{chunk}
+   dec ==> decreasePrecision
 
-\pagehead{FortranCode}{FC}
-\pagepic{ps/v103fortrancode.ps}{FC}{1.00}
-{\bf See}\\
-\pageto{Result}{RESULT}
-\pageto{FortranProgram}{FORTRAN}
-\pageto{ThreeDimensionalMatrix}{M3D}
-\pageto{SimpleFortranProgram}{SFORT}
-\pageto{Switch}{SWITCH}
-\pageto{FortranTemplate}{FTEM}
-\pageto{FortranExpression}{FEXPR}
+   -- local utility operations
 
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{FC}{assign} &
-\cross{FC}{block} &
-\cross{FC}{call} &
-\cross{FC}{code} &
-\cross{FC}{coerce} \\
-\cross{FC}{comment} &
-\cross{FC}{common} &
-\cross{FC}{cond} &
-\cross{FC}{continue} &
-\cross{FC}{forLoop} \\
-\cross{FC}{getCode} &
-\cross{FC}{goto} &
-\cross{FC}{hash} &
-\cross{FC}{latex} &
-\cross{FC}{operation} \\
-\cross{FC}{printCode} &
-\cross{FC}{printStatement} &
-\cross{FC}{repeatUntilLoop} &
-\cross{FC}{returns} &
-\cross{FC}{save} \\
-\cross{FC}{setLabelValue} &
-\cross{FC}{stop} &
-\cross{FC}{whileLoop} &
-\cross{FC}{?=?} &
-\cross{FC}{?~=?} 
-\end{tabular}
+   shift2 : (I,I) -> I           -- WSP: fix bug in shift
 
-\begin{chunk}{domain FC FortranCode}
-)abbrev domain FC FortranCode
-++ Author: Mike Dewar
-++ Date Created: April 1991
-++ Date Last Updated: 9 January 1995 Added fortran2Lines to getCall, MCD
-++ Description:
-++ This domain builds representations of program code segments for use with
-++ the FortranProgram domain.
+   times : (%,%) -> %            -- multiply x and y with no rounding
 
-FortranCode(): public == private where
-  L ==> List
-  PI ==> PositiveInteger
-  PIN ==> Polynomial Integer
-  SEX ==> SExpression
-  O ==> OutputForm
-  OP ==> Union(Null:"null",
-               Assignment:"assignment",
-               Conditional:"conditional",
-               Return:"return",
-               Block:"block",
-               Comment:"comment",
-               Call:"call",
-               For:"for",
-               While:"while",
-               Repeat:"repeat",
-               Goto:"goto",
-               Continue:"continue",
-               ArrayAssignment:"arrayAssignment",
-               Save:"save",
-               Stop:"stop",
-               Common:"common",
-               Print:"print")
-  ARRAYASS ==> Record(var:Symbol, rand:O, ints2Floats?:Boolean)
-  EXPRESSION ==> Record(ints2Floats?:Boolean,expr:O)
-  ASS ==> Record(var:Symbol,
-                 arrayIndex:L PIN,
-                 rand:EXPRESSION
-                )
-  COND ==> Record(switch: Switch(),
-                  thenClause: $,
-                  elseClause: $
-                 )
-  RETURN ==> Record(empty?:Boolean,value:EXPRESSION)
-  BLOCK ==> List $
-  COMMENT ==> List String
-  COMMON ==> Record(name:Symbol,contents:List Symbol)
-  CALL ==> String
-  FOR ==> Record(range:SegmentBinding PIN, span:PIN,  body:$)
-  LABEL ==> SingleInteger
-  LOOP ==> Record(switch:Switch(),body:$)
-  PRINTLIST ==> List O
-  OPREC ==> Union(nullBranch:"null", assignmentBranch:ASS,
-                  arrayAssignmentBranch:ARRAYASS,
-                  conditionalBranch:COND, returnBranch:RETURN,
-                  blockBranch:BLOCK, commentBranch:COMMENT, callBranch:CALL,
-                  forBranch:FOR, labelBranch:LABEL, loopBranch:LOOP,
-                  commonBranch:COMMON, printBranch:PRINTLIST)
+   itimes: (I,%) -> %            -- multiply by a small integer
 
-  public == SetCategory with
-    coerce: $ -> O
-      ++ coerce(f) returns an object of type OutputForm.
-    forLoop: (SegmentBinding PIN,$) -> $
-     ++ forLoop(i=1..10,c) creates a representation of a FORTRAN DO loop with
-     ++ \spad{i} ranging over the values 1 to 10.
-    forLoop: (SegmentBinding PIN,PIN,$) -> $
-     ++ forLoop(i=1..10,n,c) creates a representation of a FORTRAN DO loop with
-     ++ \spad{i} ranging over the values 1 to 10 by n.
-    whileLoop: (Switch,$) -> $
-     ++ whileLoop(s,c) creates a while loop in FORTRAN.
-    repeatUntilLoop: (Switch,$) -> $
-     ++ repeatUntilLoop(s,c) creates a repeat ... until loop in FORTRAN.
-    goto: SingleInteger -> $
-      ++ goto(l) creates a representation of a FORTRAN GOTO statement
-    continue: SingleInteger -> $
-      ++ continue(l) creates a representation of a FORTRAN CONTINUE labelled 
-      ++ with l
-    comment: String -> $
-      ++ comment(s) creates a representation of the String s as a single FORTRAN
-      ++ comment.  
-    comment: List String -> $
-      ++ comment(s) creates a representation of the Strings s as a multi-line
-      ++ FORTRAN comment.  
-    call: String -> $
-      ++ call(s) creates a representation of a FORTRAN CALL statement
-    returns: () -> $
-      ++ returns() creates a representation of a FORTRAN RETURN statement.
-    returns: Expression MachineFloat -> $
-      ++ returns(e) creates a representation of a FORTRAN RETURN statement
-      ++ with a returned value.
-    returns: Expression MachineInteger -> $
-      ++ returns(e) creates a representation of a FORTRAN RETURN statement
-      ++ with a returned value.
-    returns: Expression MachineComplex -> $
-      ++ returns(e) creates a representation of a FORTRAN RETURN statement
-      ++ with a returned value.
-    returns: Expression Float -> $
-      ++ returns(e) creates a representation of a FORTRAN RETURN statement
-      ++ with a returned value.
-    returns: Expression Integer -> $
-      ++ returns(e) creates a representation of a FORTRAN RETURN statement
-      ++ with a returned value.
-    returns: Expression Complex Float -> $
-      ++ returns(e) creates a representation of a FORTRAN RETURN statement
-      ++ with a returned value.
-    cond: (Switch,$) -> $
-      ++ cond(s,e) creates a representation of the FORTRAN expression
-      ++ IF (s) THEN e.
-    cond: (Switch,$,$) -> $
-      ++ cond(s,e,f) creates a representation of the FORTRAN expression
-      ++ IF (s) THEN e ELSE f.
-    assign: (Symbol,String) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Expression MachineInteger) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Expression MachineFloat) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Expression MachineComplex) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Matrix MachineInteger) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Matrix MachineFloat) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Matrix MachineComplex) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Vector MachineInteger) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Vector MachineFloat) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Vector MachineComplex) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Matrix Expression MachineInteger) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Matrix Expression MachineFloat) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Matrix Expression MachineComplex) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Vector Expression MachineInteger) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Vector Expression MachineFloat) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Vector Expression MachineComplex) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,L PIN,Expression MachineInteger) -> $
-      ++ assign(x,l,y) creates a representation of the assignment of \spad{y}
-      ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of
-      ++ indices).
-    assign: (Symbol,L PIN,Expression MachineFloat) -> $
-      ++ assign(x,l,y) creates a representation of the assignment of \spad{y}
-      ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of
-      ++ indices).
-    assign: (Symbol,L PIN,Expression MachineComplex) -> $
-      ++ assign(x,l,y) creates a representation of the assignment of \spad{y}
-      ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of
-      ++ indices).
-    assign: (Symbol,Expression Integer) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Expression Float) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Expression Complex Float) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Matrix Expression Integer) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Matrix Expression Float) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Matrix Expression Complex Float) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Vector Expression Integer) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Vector Expression Float) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,Vector Expression Complex Float) -> $
-      ++ assign(x,y) creates a representation of the FORTRAN expression
-      ++ x=y.
-    assign: (Symbol,L PIN,Expression Integer) -> $
-      ++ assign(x,l,y) creates a representation of the assignment of \spad{y}
-      ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of
-      ++ indices).
-    assign: (Symbol,L PIN,Expression Float) -> $
-      ++ assign(x,l,y) creates a representation of the assignment of \spad{y}
-      ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of
-      ++ indices).
-    assign: (Symbol,L PIN,Expression Complex Float) -> $
-      ++ assign(x,l,y) creates a representation of the assignment of \spad{y}
-      ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of
-      ++ indices).
-    block: List($) -> $
-      ++ block(l) creates a representation of the statements in l as a block.
-    stop: () -> $
-      ++ stop() creates a representation of a STOP statement.
-    save: () -> $
-      ++ save() creates a representation of a SAVE statement.
-    printStatement: List O -> $
-      ++ printStatement(l) creates a representation of a PRINT statement.
-    common: (Symbol,List Symbol) -> $
-      ++ common(name,contents) creates a representation a named common block.
-    operation: $ -> OP
-      ++ operation(f) returns the name of the operation represented by \spad{f}.
-    code: $ -> OPREC
-      ++ code(f) returns the internal representation of the object represented
-      ++ by \spad{f}.
-    printCode: $ -> Void
-      ++ printCode(f) prints out \spad{f} in FORTRAN notation.
-    getCode: $ -> SEX
-      ++ getCode(f) returns a Lisp list of strings representing \spad{f}
-      ++ in Fortran notation.  This is used by the FortranProgram domain.
-    setLabelValue:SingleInteger -> SingleInteger
-      ++ setLabelValue(i) resets the counter which produces labels to i
+   chop: (%,PI) -> %             -- chop x at p bits of precision
 
-  private == add
-    import Void
-    import ASS
-    import COND
-    import RETURN
-    import L PIN
-    import O
-    import SEX
-    import FortranType
-    import TheSymbolTable
+   dvide: (%,%) -> %             -- divide x by y with no rounding
 
-    Rep := Record(op: OP, data: OPREC)
+   square: (%,I) -> %            -- repeated squaring with chopping
 
-    -- We need to be able to generate unique labels
-    labelValue:SingleInteger := 25000::SingleInteger
-    setLabelValue(u:SingleInteger):SingleInteger == labelValue := u
-    newLabel():SingleInteger ==
-      labelValue := labelValue + 1$SingleInteger
-      labelValue
+   power: (%,I) -> %             -- x ** n with chopping
 
-    commaSep(l:List String):List(String) ==
-      [(l.1),:[:[",",u] for u in rest(l)]]
+   plus: (%,%) -> %              -- addition with no rounding
 
-    getReturn(rec:RETURN):SEX ==
-      returnToken : SEX := convert("RETURN"::Symbol::O)$SEX
-      elt(rec,empty?)$RETURN =>
-        getStatement(returnToken,NIL$Lisp)$Lisp
-      rt : EXPRESSION := elt(rec,value)$RETURN
-      rv : O := elt(rt,expr)$EXPRESSION
-      getStatement([returnToken,convert(rv)$SEX]$Lisp,
-                   elt(rt,ints2Floats?)$EXPRESSION )$Lisp
+   sub: (%,%) -> %               -- subtraction with no rounding
 
-    getStop():SEX ==
-      fortran2Lines(LIST("STOP")$Lisp)$Lisp
+   negate: % -> %                -- negation with no rounding
 
-    getSave():SEX ==
-      fortran2Lines(LIST("SAVE")$Lisp)$Lisp
+   ceillog10base2: PI -> PI      -- rational approximation
 
-    getCommon(u:COMMON):SEX ==
-      fortran2Lines(APPEND(LIST("COMMON"," /",string (u.name),"/ ")$Lisp,_
-                    addCommas(u.contents)$Lisp)$Lisp)$Lisp
- 
-    getPrint(l:PRINTLIST):SEX ==
-      ll : SEX := LIST("PRINT*")$Lisp
-      for i in l repeat 
-        ll := APPEND(ll,CONS(",",expression2Fortran(i)$Lisp)$Lisp)$Lisp
-      fortran2Lines(ll)$Lisp
+   floorln2: PI -> PI            -- rational approximation
 
-    getBlock(rec:BLOCK):SEX ==
-      indentFortLevel(convert(1@Integer)$SEX)$Lisp
-      expr : SEX := LIST()$Lisp
-      for u in rec repeat
-        expr := APPEND(expr,getCode(u))$Lisp
-      indentFortLevel(convert(-1@Integer)$SEX)$Lisp
-      expr
+   atanSeries: % -> %            -- atan(x) by taylor series |x| < 1/2
 
-    getBody(f:$):SEX ==
-      operation(f) case Block => getCode f
-      indentFortLevel(convert(1@Integer)$SEX)$Lisp
-      expr := getCode f
-      indentFortLevel(convert(-1@Integer)$SEX)$Lisp
-      expr
+   atanInverse: I -> %           -- atan(1/n) for n an integer > 1
 
-    getElseIf(f:$):SEX ==
-      rec := code f
-      expr :=
-       fortFormatElseIf(elt(rec.conditionalBranch,switch)$COND::O)$Lisp
-      expr := 
-       APPEND(expr,getBody elt(rec.conditionalBranch,thenClause)$COND)$Lisp
-      elseBranch := elt(rec.conditionalBranch,elseClause)$COND
-      not(operation(elseBranch) case Null) =>
-        operation(elseBranch) case Conditional => 
-          APPEND(expr,getElseIf elseBranch)$Lisp
-        expr := APPEND(expr, getStatement(ELSE::O,NIL$Lisp)$Lisp)$Lisp
-        expr := APPEND(expr, getBody elseBranch)$Lisp
-      expr
+   expInverse: I -> %            -- exp(1/n) for n an integer
 
-    getContinue(label:SingleInteger):SEX ==
-      lab : O := label::O
-      if (width(lab) > 6) then error "Label too big"
-      cnt : O := "CONTINUE"::O
-      --sp  : O := hspace(6-width lab)
-      sp  : O := hspace(_$fortIndent$Lisp -width lab)
-      LIST(STRCONC(PRINC_-TO_-STRING(lab)$Lisp,sp,cnt)$Lisp)$Lisp
+   expSeries: % -> %             -- exp(x) by taylor series  |x| < 1/2
 
-    getGoto(label:SingleInteger):SEX ==
-     fortran2Lines(
-      LIST(STRCONC("GOTO ",PRINC_-TO_-STRING(label::O)$Lisp)$Lisp)$Lisp)$Lisp
+   logSeries: % -> %             -- log(x) by taylor series 1/2 < x < 2
 
-    getRepeat(repRec:LOOP):SEX ==
-      sw : Switch := NOT elt(repRec,switch)$LOOP
-      lab := newLabel()
-      bod := elt(repRec,body)$LOOP
-      APPEND(getContinue lab,getBody bod,
-           fortFormatIfGoto(sw::O,lab)$Lisp)$Lisp
+   sinSeries: % -> %             -- sin(x) by taylor series |x| < 1/2
 
-    getWhile(whileRec:LOOP):SEX ==
-      sw := NOT elt(whileRec,switch)$LOOP
-      lab1 := newLabel()
-      lab2 := newLabel()
-      bod := elt(whileRec,body)$LOOP
-      APPEND(fortFormatLabelledIfGoto(sw::O,lab1,lab2)$Lisp,
-           getBody bod, getBody goto(lab1), getContinue lab2)$Lisp
+   cosSeries: % -> %             -- cos(x) by taylor series |x| < 1/2
 
-    getArrayAssign(rec:ARRAYASS):SEX ==
-      getfortarrayexp((rec.var)::O,rec.rand,rec.ints2Floats?)$Lisp
+   piRamanujan: () -> %          -- pi using Ramanujans series
 
-    getAssign(rec:ASS):SEX ==
-      indices : L PIN := elt(rec,arrayIndex)$ASS
-      if indices = []::(L PIN) then
-        lhs := elt(rec,var)$ASS::O
-      else
-        lhs := cons(elt(rec,var)$ASS::PIN,indices)::O
-        -- Must get the index brackets correct:
-        lhs := (cdr car cdr convert(lhs)$SEX::SEX)::O -- Yuck!
-      elt(elt(rec,rand)$ASS,ints2Floats?)$EXPRESSION =>
-        assignment2Fortran1(lhs,elt(elt(rec,rand)$ASS,expr)$EXPRESSION)$Lisp
-      integerAssignment2Fortran1(lhs,elt(elt(rec,rand)$ASS,expr)$EXPRESSION)$Lisp
+   writeOMFloat(dev: OpenMathDevice, x: %): Void ==
+      OMputApp(dev)
+      OMputSymbol(dev, "bigfloat1", "bigfloat")
+      OMputInteger(dev, mantissa x)
+      OMputInteger(dev, 2)
+      OMputInteger(dev, exponent x)
+      OMputEndApp(dev)
 
-    getCond(rec:COND):SEX ==
-      expr := APPEND(fortFormatIf(elt(rec,switch)$COND::O)$Lisp,
-                     getBody elt(rec,thenClause)$COND)$Lisp
-      elseBranch := elt(rec,elseClause)$COND
-      if not(operation(elseBranch) case Null) then
-        operation(elseBranch) case Conditional =>
-          expr := APPEND(expr,getElseIf elseBranch)$Lisp
-        expr := APPEND(expr,getStatement(ELSE::O,NIL$Lisp)$Lisp,
-                       getBody elseBranch)$Lisp
-      APPEND(expr,getStatement(ENDIF::O,NIL$Lisp)$Lisp)$Lisp
+   OMwrite(x: %): String ==
+      s: String := ""
+      sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+      dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
+      OMputObject(dev)
+      writeOMFloat(dev, x)
+      OMputEndObject(dev)
+      OMclose(dev)
+      s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+      s
 
-    getComment(rec:COMMENT):SEX ==
-      convert([convert(concat("C     ",c)$String)@SEX for c in rec])@SEX
+   OMwrite(x: %, wholeObj: Boolean): String ==
+      s: String := ""
+      sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+      dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
+      if wholeObj then
+         OMputObject(dev)
+      writeOMFloat(dev, x)
+      if wholeObj then
+         OMputEndObject(dev)
+      OMclose(dev)
+      s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+      s
 
-    getCall(rec:CALL):SEX ==
-      expr := concat("CALL ",rec)$String
-      #expr > 1320 => error "Fortran CALL too large"
-      fortran2Lines(convert([convert(expr)@SEX ])@SEX)$Lisp
+   OMwrite(dev: OpenMathDevice, x: %): Void ==
+      OMputObject(dev)
+      writeOMFloat(dev, x)
+      OMputEndObject(dev)
 
-    getFor(rec:FOR):SEX ==
-      rnge : SegmentBinding PIN := elt(rec,range)$FOR
-      increment : PIN := elt(rec,span)$FOR
-      lab : SingleInteger := newLabel()
-      declare!(variable rnge,fortranInteger())
-      expr := fortFormatDo(variable rnge, (lo segment rnge)::O,_
-        (hi segment rnge)::O,increment::O,lab)$Lisp
-      APPEND(expr, getBody elt(rec,body)$FOR, getContinue(lab))$Lisp
- 
-    getCode(f:$):SEX ==
-      opp:OP := operation f
-      rec:OPREC:= code f
-      opp case Assignment => getAssign(rec.assignmentBranch)
-      opp case ArrayAssignment => getArrayAssign(rec.arrayAssignmentBranch)
-      opp case Conditional => getCond(rec.conditionalBranch)
-      opp case Return => getReturn(rec.returnBranch)
-      opp case Block => getBlock(rec.blockBranch)
-      opp case Comment => getComment(rec.commentBranch)
-      opp case Call => getCall(rec.callBranch)
-      opp case For => getFor(rec.forBranch)
-      opp case Continue => getContinue(rec.labelBranch)
-      opp case Goto => getGoto(rec.labelBranch)
-      opp case Repeat => getRepeat(rec.loopBranch)
-      opp case While => getWhile(rec.loopBranch)
-      opp case Save => getSave()
-      opp case Stop => getStop()
-      opp case Print => getPrint(rec.printBranch)
-      opp case Common => getCommon(rec.commonBranch)
-      error "Unsupported program construct."
-      convert(0)@SEX
+   OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void ==
+      if wholeObj then
+         OMputObject(dev)
+      writeOMFloat(dev, x)
+      if wholeObj then
+         OMputEndObject(dev)
+   
+   shift2(x,y) == sign(x)*shift(sign(x)*x,y)
 
-    printCode(f:$):Void ==
-      displayLines1$Lisp getCode f
-      void()$Void
+   asin x ==
+      zero? x => 0
+      negative? x => -asin(-x)
+      (x = 1) => pi()/2
+      x > 1 => error "asin: argument > 1 in magnitude"
+      inc 5; r := atan(x/sqrt(sub(1,times(x,x)))); dec 5
+      normalize r
 
-    code (f:$):OPREC ==
-      elt(f,data)$Rep
+   acos x ==
+      zero? x => pi()/2
+      negative? x => (inc 3; r := pi()-acos(-x); dec 3; normalize r)
+      (x = 1) => 0
+      x > 1 => error "acos: argument > 1 in magnitude"
+      inc 5; r := atan(sqrt(sub(1,times(x,x)))/x); dec 5
+      normalize r
 
-    operation (f:$):OP ==
-      elt(f,op)$Rep
+   atan(x,y) ==
+      x = 0 =>
+         y > 0 => pi()/2
+         y < 0 => -pi()/2
+         0
+      -- Only count on first quadrant being on principal branch.
+      theta := atan abs(y/x)
+      if x < 0 then theta := pi() - theta
+      if y < 0 then theta := - theta
+      theta
 
-    common(name:Symbol,contents:List Symbol):$ ==
-      [["common"]$OP,[[name,contents]$COMMON]$OPREC]$Rep
+   atan x ==
+      zero? x => 0
+      negative? x => -atan(-x)
+      if x > 1 then
+         inc 4
+         r := if zero? fractionPart x and x < [bits(),0] _
+                 then atanInverse wholePart x
+                 else atan(1/x)
+         r := pi/2 - r
+         dec 4
+         return normalize r
+      -- make |x| < O( 2**(-sqrt p) ) < 1/2 to speed series convergence
+      -- by using the formula  atan(x) = 2*atan(x/(1+sqrt(1+x**2)))
+      k := ISQRT (bits()-100)::I quo 5
+      k := max(0,2 + k + order x)
+      inc(2*k)
+      for i in 1..k repeat x := x/(1+sqrt(1+x*x))
+      t := atanSeries x
+      dec(2*k)
+      t := shift(t,k)
+      normalize t
 
-    stop():$ ==
-      [["stop"]$OP,["null"]$OPREC]$Rep
+   atanSeries x ==
+      -- atan(x) = x (1 - x**2/3 + x**4/5 - x**6/7 + ...)  |x| < 1
+      p := bits() + LENGTH bits() + 2
+      s:I := d:I := shift(1,p)
+      y := times(x,x)
+      t := m := - shift2(y.mantissa,y.exponent+p)
+      for i in 3.. by 2 while t ^= 0 repeat
+         s := s + t quo i
+         t := (m * t) quo d
+      x * [s,-p]
 
-    save():$ ==
-      [["save"]$OP,["null"]$OPREC]$Rep
+   atanInverse n ==
+      -- compute atan(1/n) for an integer n > 1
+      -- atan n = 1/n - 1/n**3/3 + 1/n**5/4 - ...
+      --   pi = 16 atan(1/5) - 4 atan(1/239)
+      n2 := -n*n
+      e:I := bits() + LENGTH bits() + LENGTH n + 1
+      s:I := shift(1,e) quo n
+      t:I := s quo n2
+      for k in 3.. by 2 while t ^= 0 repeat
+         s := s + t quo k
+         t := t quo n2
+      normalize [s,-e]
 
-    printStatement(l:List O):$ ==
-      [["print"]$OP,[l]$OPREC]$Rep
+   sin x ==
+      s := sign x; x := abs x; p := bits(); inc 4
+      if x > [6,0] then (inc p; x := 2*pi*fractionPart(x/pi/2); bits p)
+      if x > [3,0] then (inc p; s := -s; x := x - pi; bits p)
+      if x > [3,-1] then (inc p; x := pi - x; dec p)
+      -- make |x| < O( 2**(-sqrt p) ) < 1/2 to speed series convergence
+      -- by using the formula  sin(3*x/3) = 3 sin(x/3) - 4 sin(x/3)**3
+      -- the running time is O( sqrt p M(p) ) assuming |x| < 1
+      k := ISQRT (bits()-100)::I quo 4
+      k := max(0,2 + k + order x)
+      if k > 0 then (inc k; x := x / 3**k::N)
+      r := sinSeries x
+      for i in 1..k repeat r := itimes(3,r)-shift(r**3,2)
+      bits p
+      s * r
 
-    comment(s:List String):$ ==
-      [["comment"]$OP,[s]$OPREC]$Rep
+   sinSeries x ==
+      -- sin(x) = x (1 - x**2/3! + x**4/5! - x**6/7! + ... |x| < 1/2
+      p := bits() + LENGTH bits() + 2
+      y := times(x,x)
+      s:I := d:I := shift(1,p)
+      m:I := - shift2(y.mantissa,y.exponent+p)
+      t:I := m quo 6
+      for i in 4.. by 2 while t ^= 0 repeat
+         s := s + t
+         t := (m * t) quo (i*(i+1))
+         t := t quo d
+      x * [s,-p]
 
-    comment(s:String):$ ==
-      [["comment"]$OP,[list s]$OPREC]$Rep
+   cos x ==
+     s:I := 1; x := abs x; p := bits(); inc 4
+     if x > [6,0] then (inc p; x := 2*pi*fractionPart(x/pi/2); dec p)
+     if x > [3,0] then (inc p; s := -s; x := x-pi; dec p)
+     if x > [1,0] then
+         -- take care of the accuracy problem near pi/2
+         inc p; x := pi/2-x; bits p; x := normalize x
+         return (s * sin x)
+      -- make |x| < O( 2**(-sqrt p) ) < 1/2 to speed series convergence
+      -- by using the formula  cos(2*x/2) = 2 cos(x/2)**2 - 1
+      -- the running time is O( sqrt p M(p) ) assuming |x| < 1
+     k := ISQRT (bits()-100)::I quo 3
+     k := max(0,2 + k + order x)
+      -- need to increase precision by more than k, otherwise recursion
+      -- causes loss of accuracy.
+      -- Michael Monagan suggests adding a factor of log(k)
+     if k > 0 then (inc(k+length(k)**2); x := shift(x,-k))
+     r := cosSeries x
+     for i in 1..k repeat r := shift(r*r,1)-1
+     bits p
+     s * r
 
-    forLoop(r:SegmentBinding PIN,body:$):$ ==
-      [["for"]$OP,[[r,(incr segment r)::PIN,body]$FOR]$OPREC]$Rep
+   cosSeries x ==
+      -- cos(x) = 1 - x**2/2! + x**4/4! - x**6/6! + ... |x| < 1/2
+      p := bits() + LENGTH bits() + 1
+      y := times(x,x)
+      s:I := d:I := shift(1,p)
+      m:I := - shift2(y.mantissa,y.exponent+p)
+      t:I := m quo 2
+      for i in 3.. by 2 while t ^= 0 repeat
+         s := s + t
+         t := (m * t) quo (i*(i+1))
+         t := t quo d
+      normalize [s,-p]
 
-    forLoop(r:SegmentBinding PIN,increment:PIN,body:$):$ ==
-      [["for"]$OP,[[r,increment,body]$FOR]$OPREC]$Rep
+   tan x ==
+      s := sign x; x := abs x; p := bits(); inc 6
+      if x > [3,0] then (inc p; x := pi()*fractionPart(x/pi()); dec p)
+      if x > [3,-1] then (inc p; x := pi()-x; s := -s; dec p)
+      if x > 1 then (c := cos x; t := sqrt(1-c*c)/c)
+      else (c := sin x; t := c/sqrt(1-c*c))
+      bits p
+      s * t
 
-    goto(l:SingleInteger):$ ==
-      [["goto"]$OP,[l]$OPREC]$Rep
+   P:StoredConstant := [1,[1,2]]
 
-    continue(l:SingleInteger):$ ==
-      [["continue"]$OP,[l]$OPREC]$Rep
+   pi() ==
+      -- We use Ramanujan's identity to compute pi.
+      -- The running time is quadratic in the precision.
+      -- This is about twice as fast as Machin's identity on Lisp/VM
+      --   pi = 16 atan(1/5) - 4 atan(1/239)
+      bits() <= P.precision => normalize P.value
+      (P := [bits(), piRamanujan()]) value
 
-    whileLoop(sw:Switch,b:$):$ ==
-      [["while"]$OP,[[sw,b]$LOOP]$OPREC]$Rep
+   piRamanujan() ==
+      -- Ramanujans identity for 1/pi
+      -- Reference: Shanks and Wrench, Math Comp, 1962
+      -- "Calculation of pi to 100,000 Decimals".
+      n := bits() + LENGTH bits() + 11
+      t:I := shift(1,n) quo 882
+      d:I := 4*882**2
+      s:I := 0
+      for i in 2.. by 2 for j in 1123.. by 21460 while t ^= 0 repeat
+         s := s + j*t
+         m := -(i-1)*(2*i-1)*(2*i-3)
+         t := (m*t) quo (d*i**3)
+      1 / [s,-n-2]
 
-    repeatUntilLoop(sw:Switch,b:$):$ ==
-      [["repeat"]$OP,[[sw,b]$LOOP]$OPREC]$Rep
+   sinh x ==
+      zero? x => 0
+      lost:I := max(- order x,0)
+      2*lost > bits() => x
+      inc(5+lost); e := exp x; s := (e-1/e)/2; dec(5+lost)
+      normalize s
 
-    returns():$ ==
-      v := [false,0::O]$EXPRESSION
-      [["return"]$OP,[[true,v]$RETURN]$OPREC]$Rep
+   cosh x ==
+      (inc 5; e := exp x; c := (e+1/e)/2; dec 5; normalize c)
 
-    returns(v:Expression MachineInteger):$ ==
-      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
+   tanh x ==
+      zero? x => 0
+      lost:I := max(- order x,0)
+      2*lost > bits() => x
+      inc(6+lost); e := exp x; e := e*e; t := (e-1)/(e+1); dec(6+lost)
+      normalize t
 
-    returns(v:Expression MachineFloat):$ ==
-      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
+   asinh x ==
+      p := min(0,order x)
+      if zero? x or 2*p < -bits() then return x
+      inc(5-p); r := log(x+sqrt(1+x*x)); dec(5-p)
+      normalize r
 
-    returns(v:Expression MachineComplex):$ ==
-      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
+   acosh x ==
+      if x < 1 then error "invalid argument to acosh"
+      inc 5; r := log(x+sqrt(sub(times(x,x),1))); dec 5
+      normalize r
 
-    returns(v:Expression Integer):$ ==
-      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
+   atanh x ==
+      if x > 1 or x < -1 then error "invalid argument to atanh"
+      p := min(0,order x)
+      if zero? x or 2*p < -bits() then return x
+      inc(5-p); r := log((x+1)/(1-x))/2; dec(5-p)
+      normalize r
 
-    returns(v:Expression Float):$ ==
-      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
+   log x ==
+      negative? x => error "negative log"
+      zero? x => error "log 0 generated"
+      p := bits(); inc 5
+      -- apply  log(x) = n log 2 + log(x/2**n)  so that  1/2 < x < 2
+      if (n := order x) < 0 then n := n+1
+      l := if n = 0 then 0 else (x := shift(x,-n); n * log2)
+      -- speed the series convergence by finding m and k such that
+      -- | exp(m/2**k) x - 1 |  <  1 / 2 ** O(sqrt p)
+      -- write  log(exp(m/2**k) x) as m/2**k + log x
+      k := ISQRT (p-100)::I quo 3
+      if k > 1 then
+         k := max(1,k+order(x-1))
+         inc k
+         ek := expInverse (2**k::N)
+         dec(p quo 2); m := order square(x,k); inc(p quo 2)
+         m := (6847196937 * m) quo 9878417065   -- m := m log 2
+         x := x * ek ** (-m)
+         l := l + [m,-k]
+      l := l + logSeries x
+      bits p
+      normalize l
 
-    returns(v:Expression Complex Float):$ ==
-      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
+   logSeries x ==
+      -- log(x) = 2 y (1 + y**2/3 + y**4/5 ...)  for  y = (x-1) / (x+1)
+      -- given 1/2 < x < 2 on input we have -1/3 < y < 1/3
+      p := bits() + (g := LENGTH bits() + 3)
+      inc g; y := (x-1)/(x+1); dec g
+      s:I := d:I := shift(1,p)
+      z := times(y,y)
+      t := m := shift2(z.mantissa,z.exponent+p)
+      for i in 3.. by 2 while t ^= 0 repeat
+         s := s + t quo i
+         t := m * t quo d
+      y * [s,1-p]
 
-    block(l:List $):$ ==
-      [["block"]$OP,[l]$OPREC]$Rep
-      
-    cond(sw:Switch,thenC:$):$ ==
-      [["conditional"]$OP,
-       [[sw,thenC,[["null"]$OP,["null"]$OPREC]$Rep]$COND]$OPREC]$Rep
+   L2:StoredConstant := [1,1]
 
-    cond(sw:Switch,thenC:$,elseC:$):$ ==
-      [["conditional"]$OP,[[sw,thenC,elseC]$COND]$OPREC]$Rep
+   log2() ==
+      --  log x  =  2 * sum( ((x-1)/(x+1))**(2*k+1)/(2*k+1), k=1.. )
+      --  log 2  =  2 * sum( 1/9**k / (2*k+1), k=0..n ) / 3
+      n := bits() :: N
+      n <= L2.precision => normalize L2.value
+      n := n + LENGTH n + 3  -- guard bits
+      s:I := shift(1,n+1) quo 3
+      t:I := s quo 9
+      for k in 3.. by 2 while t ^= 0 repeat
+         s := s + t quo k
+         t := t quo 9
+      L2 := [bits(),[s,-n]]
+      normalize L2.value
 
-    coerce(f : $):O ==
-      (f.op)::O
+   L10:StoredConstant := [1,[1,1]]
 
-    assign(v:Symbol,rhs:String):$ ==
-      [["assignment"]$OP,[[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+   log10() ==
+      --  log x  =  2 * sum( ((x-1)/(x+1))**(2*k+1)/(2*k+1), k=0.. )
+      --  log 5/4  =  2 * sum( 1/81**k / (2*k+1), k=0.. ) / 9
+      n := bits() :: N
+      n <= L10.precision => normalize L10.value
+      n := n + LENGTH n + 5  -- guard bits
+      s:I := shift(1,n+1) quo 9
+      t:I := s quo 81
+      for k in 3.. by 2 while t ^= 0 repeat
+         s := s + t quo k
+         t := t quo 81
+      -- We have log 10 = log 5 + log 2 and log 5/4 = log 5 - 2 log 2
+      inc 2; L10 := [bits(),[s,-n] + 3*log2]; dec 2
+      normalize L10.value
 
-    assign(v:Symbol,rhs:Matrix MachineInteger):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
+   log2(x) == (inc 2; r := log(x)/log2; dec 2; normalize r)
 
-    assign(v:Symbol,rhs:Matrix MachineFloat):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+   log10(x) == (inc 2; r := log(x)/log10; dec 2; normalize r)
 
-    assign(v:Symbol,rhs:Matrix MachineComplex):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+   exp(x) ==
+      -- exp(n+x) = exp(1)**n exp(x) for n such that |x| < 1
+      p := bits(); inc 5; e1:% := 1
+      if (n := wholePart x) ^= 0 then
+         inc LENGTH n; e1 := exp1 ** n; dec LENGTH n
+         x := fractionPart x
+      if zero? x then (bits p; return normalize e1)
+      -- make |x| < O( 2**(-sqrt p) ) < 1/2 to speed series convergence
+      -- by repeated use of the formula exp(2*x/2) = exp(x/2)**2
+      -- results in an overall running time of O( sqrt p M(p) )
+      k := ISQRT (p-100)::I quo 3
+      k := max(0,2 + k + order x)
+      if k > 0 then (inc k; x := shift(x,-k))
+      e := expSeries x
+      if k > 0 then e := square(e,k)
+      bits p
+      e * e1
 
-    assign(v:Symbol,rhs:Vector MachineInteger):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
+   expSeries x ==
+      -- exp(x) = 1 + x + x**2/2 + ... + x**i/i!  valid for all x
+      p := bits() + LENGTH bits() + 1
+      s:I := d:I := shift(1,p)
+      t:I := n:I := shift2(x.mantissa,x.exponent+p)
+      for i in 2.. while t ^= 0 repeat
+         s := s + t
+         t := (n * t) quo i
+         t := t quo d
+      normalize [s,-p]
 
-    assign(v:Symbol,rhs:Vector MachineFloat):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+   expInverse k ==
+      -- computes exp(1/k) via continued fraction
+      p0:I := 2*k+1; p1:I := 6*k*p0+1
+      q0:I := 2*k-1; q1:I := 6*k*q0+1
+      for i in 10*k.. by 4*k while 2 * LENGTH p0 < bits() repeat
+         (p0,p1) := (p1,i*p1+p0)
+         (q0,q1) := (q1,i*q1+q0)
+      dvide([p1,0],[q1,0])
 
-    assign(v:Symbol,rhs:Vector MachineComplex):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+   E:StoredConstant := [1,[1,1]]
 
-    assign(v:Symbol,rhs:Matrix Expression MachineInteger):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
+   exp1() ==
+      if bits() > E.precision then E := [bits(),expInverse 1]
+      normalize E.value
 
-    assign(v:Symbol,rhs:Matrix Expression MachineFloat):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+   sqrt x ==
+      negative? x => error "negative sqrt"
+      m := x.mantissa; e := x.exponent
+      l := LENGTH m
+      p := 2 * bits() - l + 2
+      if odd?(e-l) then p := p - 1
+      i := shift2(x.mantissa,p)
+      -- ISQRT uses a variable precision newton iteration
+      i := ISQRT i
+      normalize [i,(e-p) quo 2]
 
-    assign(v:Symbol,rhs:Matrix Expression MachineComplex):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+   bits() == BITS()
 
-    assign(v:Symbol,rhs:Vector Expression MachineInteger):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
+   bits(n) == (t := bits(); BITS() := n; t)
 
-    assign(v:Symbol,rhs:Vector Expression MachineFloat):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+   precision() == bits()
 
-    assign(v:Symbol,rhs:Vector Expression MachineComplex):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+   precision(n) == bits(n)
 
-    assign(v:Symbol,index:L PIN,rhs:Expression MachineInteger):$ ==
-      [["assignment"]$OP,[[v,index,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+   increasePrecision n == (b := bits(); bits((b + n)::PI); b)
 
-    assign(v:Symbol,index:L PIN,rhs:Expression MachineFloat):$ ==
-      [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+   decreasePrecision n == (b := bits(); bits((b - n)::PI); b)
 
-    assign(v:Symbol,index:L PIN,rhs:Expression MachineComplex):$ ==
-      [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+   ceillog10base2 n == ((13301 * n + 4003) quo 4004) :: PI
 
-    assign(v:Symbol,rhs:Expression MachineInteger):$ ==
-      [["assignment"]$OP,[[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+   digits() == max(1,4004 * (bits()-1) quo 13301)::PI
 
-    assign(v:Symbol,rhs:Expression MachineFloat):$ ==
-      [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+   digits(n) == (t := digits(); bits (1 + ceillog10base2 n); t)
 
-    assign(v:Symbol,rhs:Expression MachineComplex):$ ==
-      [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+   order(a) == LENGTH a.mantissa + a.exponent - 1
 
-    assign(v:Symbol,rhs:Matrix Expression Integer):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
+   relerror(a,b) == order((a-b)/b)
 
-    assign(v:Symbol,rhs:Matrix Expression Float):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+   0 == [0,0]
 
-    assign(v:Symbol,rhs:Matrix Expression Complex Float):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+   1 == [1,0]
 
-    assign(v:Symbol,rhs:Vector Expression Integer):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
+   base() == BASE
 
-    assign(v:Symbol,rhs:Vector Expression Float):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+   mantissa x == x.mantissa
 
-    assign(v:Symbol,rhs:Vector Expression Complex Float):$ ==
-      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+   exponent x == x.exponent
 
-    assign(v:Symbol,index:L PIN,rhs:Expression Integer):$ ==
-      [["assignment"]$OP,[[v,index,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+   one? a == a = 1
 
-    assign(v:Symbol,index:L PIN,rhs:Expression Float):$ ==
-      [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+   zero? a == zero?(a.mantissa)
 
-    assign(v:Symbol,index:L PIN,rhs:Expression Complex Float):$ ==
-      [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+   negative? a == negative?(a.mantissa)
 
-    assign(v:Symbol,rhs:Expression Integer):$ ==
-      [["assignment"]$OP,[[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+   positive? a == positive?(a.mantissa)
 
-    assign(v:Symbol,rhs:Expression Float):$ ==
-      [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+   chop(x,p) ==
+      e : I := LENGTH x.mantissa - p
+      if e > 0 then x := [shift2(x.mantissa,-e),x.exponent+e]
+      x
 
-    assign(v:Symbol,rhs:Expression Complex Float):$ ==
-      [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+   float(m,e) == normalize [m,e]
 
-    call(s:String):$ ==
-      [["call"]$OP,[s]$OPREC]$Rep
+   float(m,e,b) ==
+      m = 0 => 0
+      inc 4; r := m * [b,0] ** e; dec 4
+      normalize r
 
-\end{chunk}
+   normalize x ==
+      m := x.mantissa
+      m = 0 => 0
+      e : I := LENGTH m - bits()
+      if e > 0 then
+         y := shift2(m,1-e)
+         if odd? y then
+            y := (if y>0 then y+1 else y-1) quo 2
+            if LENGTH y > bits() then
+               y := y quo 2
+               e := e+1
+         else y := y quo 2
+         x := [y,x.exponent+e]
+      x
 
-\begin{chunk}{COQ FC}
-(* domain FC *)
-(*
-*)
+   shift(x:%,n:I) == [x.mantissa,x.exponent+n]
 
-\end{chunk}
+   x = y ==
+      order x = order y and sign x = sign y and zero? (x - y)
 
-\begin{chunk}{FC.dotabb}
-"FC" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FC"]
-"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
-"COMPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=COMPCAT"]
-"FC" -> "COMPCAT"
-"FC" -> "FS"
+   x < y ==
+      y.mantissa = 0 => x.mantissa < 0
+      x.mantissa = 0 => y.mantissa > 0
+      negative? x and positive? y => true
+      negative? y and positive? x => false
+      order x < order y => positive? x
+      order x > order y => negative? x
+      negative? (x-y)
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FEXPR FortranExpression}
+   abs x == if negative? x then -x else normalize x
 
-\begin{chunk}{FortranExpression.input}
-)set break resume
-)sys rm -f FortranExpression.output
-)spool FortranExpression.output
-)set message test on
-)set message auto off
-)clear all
+   ceiling x ==
+      if negative? x then return (-floor(-x))
+      if zero? fractionPart x then x else truncate x + 1
 
---S 1 of 1
-)show FortranExpression
---R 
---R FortranExpression(basicSymbols: List(Symbol),subscriptedSymbols: List(Symbol),R: FortranMachineTypeCategory)  is a domain constructor
---R Abbreviation for FortranExpression is FEXPR 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FEXPR 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (PositiveInteger,%) -> %        ?*? : (NonNegativeInteger,%) -> %
---R ?*? : (Integer,%) -> %                ?*? : (%,%) -> %
---R ?*? : (%,R) -> %                      ?*? : (R,%) -> %
---R ?**? : (%,PositiveInteger) -> %       ?**? : (%,NonNegativeInteger) -> %
---R ?+? : (%,%) -> %                      -? : % -> %
---R ?-? : (%,%) -> %                      ?<? : (%,%) -> Boolean
---R ?<=? : (%,%) -> Boolean               ?=? : (%,%) -> Boolean
---R ?>? : (%,%) -> Boolean                ?>=? : (%,%) -> Boolean
---R D : (%,Symbol) -> %                   D : (%,List(Symbol)) -> %
---R 1 : () -> %                           0 : () -> %
---R ?^? : (%,PositiveInteger) -> %        ?^? : (%,NonNegativeInteger) -> %
---R abs : % -> %                          acos : % -> %
---R asin : % -> %                         atan : % -> %
---R belong? : BasicOperator -> Boolean    box : List(%) -> %
---R box : % -> %                          coerce : % -> Expression(R)
---R coerce : Integer -> %                 coerce : R -> %
---R coerce : Kernel(%) -> %               coerce : % -> OutputForm
---R cos : % -> %                          cosh : % -> %
---R differentiate : (%,Symbol) -> %       distribute : (%,%) -> %
---R distribute : % -> %                   elt : (BasicOperator,List(%)) -> %
---R elt : (BasicOperator,%,%,%) -> %      elt : (BasicOperator,%,%) -> %
---R elt : (BasicOperator,%) -> %          eval : (%,Symbol,(% -> %)) -> %
---R eval : (%,List(%),List(%)) -> %       eval : (%,%,%) -> %
---R eval : (%,Equation(%)) -> %           eval : (%,List(Equation(%))) -> %
---R eval : (%,Kernel(%),%) -> %           exp : % -> %
---R freeOf? : (%,Symbol) -> Boolean       freeOf? : (%,%) -> Boolean
---R hash : % -> SingleInteger             height : % -> NonNegativeInteger
---R is? : (%,Symbol) -> Boolean           is? : (%,BasicOperator) -> Boolean
---R kernel : (BasicOperator,%) -> %       kernels : % -> List(Kernel(%))
---R latex : % -> String                   log : % -> %
---R log10 : % -> %                        map : ((% -> %),Kernel(%)) -> %
---R max : (%,%) -> %                      min : (%,%) -> %
---R one? : % -> Boolean                   paren : List(%) -> %
---R paren : % -> %                        pi : () -> %
---R recip : % -> Union(%,"failed")        retract : Symbol -> %
---R retract : Expression(R) -> %          retract : % -> R
---R retract : % -> Kernel(%)              sample : () -> %
---R sin : % -> %                          sinh : % -> %
---R sqrt : % -> %                         subst : (%,Equation(%)) -> %
---R tan : % -> %                          tanh : % -> %
---R tower : % -> List(Kernel(%))          useNagFunctions : Boolean -> Boolean
---R useNagFunctions : () -> Boolean       variables : % -> List(Symbol)
---R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
---R D : (%,Symbol,NonNegativeInteger) -> %
---R D : (%,List(Symbol),List(NonNegativeInteger)) -> %
---R characteristic : () -> NonNegativeInteger
---R definingPolynomial : % -> % if $ has RING
---R differentiate : (%,List(Symbol)) -> %
---R differentiate : (%,Symbol,NonNegativeInteger) -> %
---R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> %
---R elt : (BasicOperator,%,%,%,%) -> %
---R eval : (%,BasicOperator,(% -> %)) -> %
---R eval : (%,BasicOperator,(List(%) -> %)) -> %
---R eval : (%,List(BasicOperator),List((List(%) -> %))) -> %
---R eval : (%,List(BasicOperator),List((% -> %))) -> %
---R eval : (%,Symbol,(List(%) -> %)) -> %
---R eval : (%,List(Symbol),List((List(%) -> %))) -> %
---R eval : (%,List(Symbol),List((% -> %))) -> %
---R eval : (%,List(Kernel(%)),List(%)) -> %
---R even? : % -> Boolean if $ has RETRACT(INT)
---R kernel : (BasicOperator,List(%)) -> %
---R mainKernel : % -> Union(Kernel(%),"failed")
---R minPoly : Kernel(%) -> SparseUnivariatePolynomial(%) if $ has RING
---R odd? : % -> Boolean if $ has RETRACT(INT)
---R operator : BasicOperator -> BasicOperator
---R operators : % -> List(BasicOperator)
---R retract : Polynomial(Float) -> % if R has RETRACT(FLOAT)
---R retract : Fraction(Polynomial(Float)) -> % if R has RETRACT(FLOAT)
---R retract : Expression(Float) -> % if R has RETRACT(FLOAT)
---R retract : Polynomial(Integer) -> % if R has RETRACT(INT)
---R retract : Fraction(Polynomial(Integer)) -> % if R has RETRACT(INT)
---R retract : Expression(Integer) -> % if R has RETRACT(INT)
---R retractIfCan : Polynomial(Float) -> Union(%,"failed") if R has RETRACT(FLOAT)
---R retractIfCan : Fraction(Polynomial(Float)) -> Union(%,"failed") if R has RETRACT(FLOAT)
---R retractIfCan : Expression(Float) -> Union(%,"failed") if R has RETRACT(FLOAT)
---R retractIfCan : Polynomial(Integer) -> Union(%,"failed") if R has RETRACT(INT)
---R retractIfCan : Fraction(Polynomial(Integer)) -> Union(%,"failed") if R has RETRACT(INT)
---R retractIfCan : Expression(Integer) -> Union(%,"failed") if R has RETRACT(INT)
---R retractIfCan : Symbol -> Union(%,"failed")
---R retractIfCan : Expression(R) -> Union(%,"failed")
---R retractIfCan : % -> Union(R,"failed")
---R retractIfCan : % -> Union(Kernel(%),"failed")
---R subst : (%,List(Kernel(%)),List(%)) -> %
---R subst : (%,List(Equation(%))) -> %
---R subtractIfCan : (%,%) -> Union(%,"failed")
---R
---E 1
+   wholePart x == shift2(x.mantissa,x.exponent)
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{FortranExpression.help}
-====================================================================
-FortranExpression examples
-====================================================================
+   floor x == if negative? x then -ceiling(-x) else truncate x
 
-A domain of expressions involving functions which can be translated into 
-standard Fortran-77, with some extra extensions from the NAG Fortran Library.  
+   round x == (half := [sign x,-1]; truncate(x + half))
 
-See Also:
-o )show FortranExpression
+   sign x == if x.mantissa < 0 then -1 else 1
 
-\end{chunk}
+   truncate x ==
+      if x.exponent >= 0 then return x
+      normalize [shift2(x.mantissa,x.exponent),0]
 
-\pagehead{FortranExpression}{FEXPR}
-\pagepic{ps/v103fortranexpression.ps}{FEXPR}{1.00}
-{\bf See}\\
-\pageto{Result}{RESULT}
-\pageto{FortranCode}{FC}
-\pageto{FortranProgram}{FORTRAN}
-\pageto{ThreeDimensionalMatrix}{M3D}
-\pageto{SimpleFortranProgram}{SFORT}
-\pageto{Switch}{SWITCH}
-\pageto{FortranTemplate}{FTEM}
+   recip(x) == if x=0 then "failed" else 1/x
 
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{FEXPR}{0} &
-\cross{FEXPR}{1} &
-\cross{FEXPR}{abs} &
-\cross{FEXPR}{acos} &
-\cross{FEXPR}{asin} \\
-\cross{FEXPR}{atan} &
-\cross{FEXPR}{belong?} &
-\cross{FEXPR}{box} &
-\cross{FEXPR}{characteristic} &
-\cross{FEXPR}{coerce} \\
-\cross{FEXPR}{cos} &
-\cross{FEXPR}{cosh} &
-\cross{FEXPR}{D} &
-\cross{FEXPR}{definingPolynomial} &
-\cross{FEXPR}{differentiate} \\
-\cross{FEXPR}{distribute} &
-\cross{FEXPR}{elt} &
-\cross{FEXPR}{eval} &
-\cross{FEXPR}{even?} &
-\cross{FEXPR}{exp} \\
-\cross{FEXPR}{freeOf?} &
-\cross{FEXPR}{hash} &
-\cross{FEXPR}{height} &
-\cross{FEXPR}{is?} &
-\cross{FEXPR}{kernel} \\
-\cross{FEXPR}{kernels} &
-\cross{FEXPR}{latex} &
-\cross{FEXPR}{log} &
-\cross{FEXPR}{log10} &
-\cross{FEXPR}{mainKernel} \\
-\cross{FEXPR}{map} &
-\cross{FEXPR}{max} &
-\cross{FEXPR}{min} &
-\cross{FEXPR}{minPoly} &
-\cross{FEXPR}{odd?} \\
-\cross{FEXPR}{one?} &
-\cross{FEXPR}{operator} &
-\cross{FEXPR}{operators} &
-\cross{FEXPR}{paren} &
-\cross{FEXPR}{pi} \\
-\cross{FEXPR}{recip} &
-\cross{FEXPR}{retract} &
-\cross{FEXPR}{retractIfCan} &
-\cross{FEXPR}{sample} &
-\cross{FEXPR}{sin} \\
-\cross{FEXPR}{sinh} &
-\cross{FEXPR}{sqrt} &
-\cross{FEXPR}{subst} &
-\cross{FEXPR}{subtractIfCan} &
-\cross{FEXPR}{tan} \\
-\cross{FEXPR}{tanh} &
-\cross{FEXPR}{tower} &
-\cross{FEXPR}{useNagFunctions} &
-\cross{FEXPR}{variables} &
-\cross{FEXPR}{zero?} \\
-\cross{FEXPR}{?*?} &
-\cross{FEXPR}{?**?} &
-\cross{FEXPR}{?+?} &
-\cross{FEXPR}{-?} &
-\cross{FEXPR}{?-?} \\
-\cross{FEXPR}{?$<$?} &
-\cross{FEXPR}{?$<=$?} &
-\cross{FEXPR}{?=?} &
-\cross{FEXPR}{?$>$?} &
-\cross{FEXPR}{?$>=$?} \\
-\cross{FEXPR}{?\^{}?} &
-\cross{FEXPR}{?\~{}=?} &&&
-\end{tabular}
+   differentiate x == 0
 
-\begin{chunk}{domain FEXPR FortranExpression}
-)abbrev domain FEXPR FortranExpression
-++ Author: Mike Dewar
-++ Date Created:  December 1993
-++ Date Last Updated: 12 July 1994 added RetractableTo(R)
-++ Description: 
-++ A domain of expressions involving functions which can be
-++ translated into standard Fortran-77, with some extra extensions from
-++ the NAG Fortran Library.  
+   - x == normalize negate x
 
-FortranExpression(basicSymbols,subscriptedSymbols,R):
-                                Exports==Implementation where
-  basicSymbols : List Symbol
-  subscriptedSymbols : List Symbol
-  R : FortranMachineTypeCategory
+   negate x == [-x.mantissa,x.exponent]
 
-  EXPR ==> Expression
-  EXF2 ==> ExpressionFunctions2
-  S    ==> Symbol
-  L    ==> List
-  BO   ==> BasicOperator
-  FRAC ==> Fraction
-  POLY ==> Polynomial
+   x + y == normalize plus(x,y)
 
-  Exports ==> Join(ExpressionSpace,Algebra(R),RetractableTo(R),
-                   PartialDifferentialRing(Symbol)) with
-    retract : EXPR R -> $
-      ++ retract(e) takes e and transforms it into a 
-      ++ FortranExpression checking that it contains no non-Fortran
-      ++ functions, and that it only contains the given basic symbols
-      ++ and subscripted symbols which correspond to scalar and array
-      ++ parameters respectively.
-    retractIfCan : EXPR R -> Union($,"failed")
-      ++ retractIfCan(e) takes e and tries to transform it into a 
-      ++ FortranExpression checking that it contains no non-Fortran
-      ++ functions, and that it only contains the given basic symbols
-      ++ and subscripted symbols which correspond to scalar and array
-      ++ parameters respectively.
-    retract : S -> $
-      ++ retract(e) takes e and transforms it into a FortranExpression
-      ++ checking that it is one of the given basic symbols
-      ++ or subscripted symbols which correspond to scalar and array
-      ++ parameters respectively.
-    retractIfCan : S -> Union($,"failed")
-      ++ retractIfCan(e) takes e and tries to transform it into a 
-      ++ FortranExpression checking that it is one of the given basic symbols
-      ++ or subscripted symbols which correspond to scalar and array
-      ++ parameters respectively.
-    coerce : $ -> EXPR R
-      ++ coerce(x) is not documented
-    if (R has RetractableTo(Integer)) then
-      retract : EXPR Integer -> $
-        ++ retract(e) takes e and transforms it into a 
-        ++ FortranExpression checking that it contains no non-Fortran
-        ++ functions, and that it only contains the given basic symbols
-        ++ and subscripted symbols which correspond to scalar and array
-        ++ parameters respectively.
-      retractIfCan : EXPR Integer -> Union($,"failed")
-        ++ retractIfCan(e) takes e and tries to transform it into a 
-        ++ FortranExpression checking that it contains no non-Fortran
-        ++ functions, and that it only contains the given basic symbols
-        ++ and subscripted symbols which correspond to scalar and array
-        ++ parameters respectively.
-      retract : FRAC POLY  Integer -> $
-        ++ retract(e) takes e and transforms it into a 
-        ++ FortranExpression checking that it contains no non-Fortran
-        ++ functions, and that it only contains the given basic symbols
-        ++ and subscripted symbols which correspond to scalar and array
-        ++ parameters respectively.
-      retractIfCan : FRAC POLY  Integer -> Union($,"failed")
-        ++ retractIfCan(e) takes e and tries to transform it into a 
-        ++ FortranExpression checking that it contains no non-Fortran
-        ++ functions, and that it only contains the given basic symbols
-        ++ and subscripted symbols which correspond to scalar and array
-        ++ parameters respectively.
-      retract : POLY  Integer -> $
-        ++ retract(e) takes e and transforms it into a 
-        ++ FortranExpression checking that it contains no non-Fortran
-        ++ functions, and that it only contains the given basic symbols
-        ++ and subscripted symbols which correspond to scalar and array
-        ++ parameters respectively.
-      retractIfCan : POLY  Integer -> Union($,"failed")
-        ++ retractIfCan(e) takes e and tries to transform it into a 
-        ++ FortranExpression checking that it contains no non-Fortran
-        ++ functions, and that it only contains the given basic symbols
-        ++ and subscripted symbols which correspond to scalar and array
-        ++ parameters respectively.
-    if (R has RetractableTo(Float)) then
-      retract : EXPR Float -> $
-        ++ retract(e) takes e and transforms it into a 
-        ++ FortranExpression checking that it contains no non-Fortran
-        ++ functions, and that it only contains the given basic symbols
-        ++ and subscripted symbols which correspond to scalar and array
-        ++ parameters respectively.
-      retractIfCan : EXPR Float -> Union($,"failed")
-        ++ retractIfCan(e) takes e and tries to transform it into a 
-        ++ FortranExpression checking that it contains no non-Fortran
-        ++ functions, and that it only contains the given basic symbols
-        ++ and subscripted symbols which correspond to scalar and array
-        ++ parameters respectively.
-      retract : FRAC POLY  Float -> $
-        ++ retract(e) takes e and transforms it into a 
-        ++ FortranExpression checking that it contains no non-Fortran
-        ++ functions, and that it only contains the given basic symbols
-        ++ and subscripted symbols which correspond to scalar and array
-        ++ parameters respectively.
-      retractIfCan : FRAC POLY  Float -> Union($,"failed")
-        ++ retractIfCan(e) takes e and tries to transform it into a 
-        ++ FortranExpression checking that it contains no non-Fortran
-        ++ functions, and that it only contains the given basic symbols
-        ++ and subscripted symbols which correspond to scalar and array
-        ++ parameters respectively.
-      retract : POLY  Float -> $
-        ++ retract(e) takes e and transforms it into a 
-        ++ FortranExpression checking that it contains no non-Fortran
-        ++ functions, and that it only contains the given basic symbols
-        ++ and subscripted symbols which correspond to scalar and array
-        ++ parameters respectively.
-      retractIfCan : POLY  Float -> Union($,"failed")
-        ++ retractIfCan(e) takes e and tries to transform it into a 
-        ++ FortranExpression checking that it contains no non-Fortran
-        ++ functions, and that it only contains the given basic symbols
-        ++ and subscripted symbols which correspond to scalar and array
-        ++ parameters respectively.
-    abs    : $ -> $
-      ++ abs(x) represents the Fortran intrinsic function ABS
-    sqrt   : $ -> $
-      ++ sqrt(x) represents the Fortran intrinsic function SQRT
-    exp    : $ -> $
-      ++ exp(x) represents the Fortran intrinsic function EXP
-    log    : $ -> $
-      ++ log(x) represents the Fortran intrinsic function LOG
-    log10  : $ -> $
-      ++ log10(x) represents the Fortran intrinsic function LOG10
-    sin    : $ -> $
-      ++ sin(x) represents the Fortran intrinsic function SIN
-    cos    : $ -> $
-      ++ cos(x) represents the Fortran intrinsic function COS
-    tan    : $ -> $
-      ++ tan(x) represents the Fortran intrinsic function TAN
-    asin   : $ -> $
-      ++ asin(x) represents the Fortran intrinsic function ASIN
-    acos   : $ -> $
-      ++ acos(x) represents the Fortran intrinsic function ACOS
-    atan   : $ -> $
-      ++ atan(x) represents the Fortran intrinsic function ATAN
-    sinh   : $ -> $
-      ++ sinh(x) represents the Fortran intrinsic function SINH
-    cosh   : $ -> $
-      ++ cosh(x) represents the Fortran intrinsic function COSH
-    tanh   : $ -> $
-      ++ tanh(x) represents the Fortran intrinsic function TANH
-    pi     : () -> $
-      ++ pi(x) represents the NAG Library function X01AAF which returns 
-      ++  an approximation to the value of pi
-    variables : $ -> L S
-      ++ variables(e) return a list of all the variables in \spad{e}.
-    useNagFunctions : () -> Boolean
-      ++ useNagFunctions() indicates whether NAG functions are being used
-      ++  for mathematical and machine constants.
-    useNagFunctions : Boolean -> Boolean
-      ++ useNagFunctions(v) sets the flag which controls whether NAG functions 
-      ++  are being used for mathematical and machine constants.  The previous
-      ++  value is returned.
+   x - y == normalize plus(x,negate y)
 
-  Implementation ==> EXPR R add
+   sub(x,y) == plus(x,negate y)
 
-    -- The standard FORTRAN-77 intrinsic functions, plus nthRoot which
-    -- can be translated into an arithmetic expression:
-    f77Functions : L S := [abs,sqrt,exp,log,log10,sin,cos,tan,asin,acos,
-                           atan,sinh,cosh,tanh,nthRoot,%power]
-    nagFunctions : L S := [pi, X01AAF]
-    useNagFunctionsFlag : Boolean := true
+   plus(x,y) ==
+      mx := x.mantissa; my := y.mantissa
+      mx = 0 => y
+      my = 0 => x
+      ex := x.exponent; ey := y.exponent
+      ex = ey => [mx+my,ex]
+      de := ex + LENGTH mx - ey - LENGTH my
+      de > bits()+1 => x
+      de < -(bits()+1) => y
+      if ex < ey then (mx,my,ex,ey) := (my,mx,ey,ex)
+      mw := my + shift2(mx,ex-ey)
+      [mw,ey]
 
-    -- Local functions to check for "unassigned" symbols etc.
+   x:% * y:% == normalize times (x,y)
 
-    mkEqn(s1:Symbol,s2:Symbol):Equation EXPR(R) ==
-      equation(s2::EXPR(R),script(s1,scripts(s2))::EXPR(R))
+   x:I * y:% ==
+      if LENGTH x > bits() then normalize [x,0] * y
+      else normalize [x * y.mantissa,y.exponent]
 
-    fixUpSymbols(u:EXPR R):Union(EXPR R,"failed") ==
-      -- If its a univariate expression then just fix it up:
-      syms   : L S := variables(u)
---      one?(#basicSymbols) and zero?(#subscriptedSymbols) =>
-      (#basicSymbols = 1) and zero?(#subscriptedSymbols) =>
---        not one?(#syms) => "failed"
-        not (#syms = 1) => "failed"
-        subst(u,equation(first(syms)::EXPR(R),first(basicSymbols)::EXPR(R)))
-      -- We have one variable but it is subscripted:
---      zero?(#basicSymbols) and one?(#subscriptedSymbols) =>
-      zero?(#basicSymbols) and (#subscriptedSymbols = 1) =>
-        -- Make sure we don't have both X and X_i
-        for s in syms repeat
-          not scripted?(s) => return "failed"
---        not one?(#(syms:=removeDuplicates! [name(s) for s in syms]))=> "failed"
-        not ((#(syms:=removeDuplicates! [name(s) for s in syms])) = 1)=> "failed"
-        sym : Symbol := first subscriptedSymbols
-        subst(u,[mkEqn(sym,i) for i in variables(u)]) 
-      "failed"
+   x:% / y:% == normalize dvide(x,y)
 
-    extraSymbols?(u:EXPR R):Boolean ==
-      syms   : L S := [name(v) for v in variables(u)]
-      extras : L S := setDifference(syms,
-                                    setUnion(basicSymbols,subscriptedSymbols))
-      not empty? extras
+   x:% / y:I ==
+      if LENGTH y > bits() then x / normalize [y,0] else x / [y,0]
 
-    checkSymbols(u:EXPR R):EXPR(R) ==
-      syms   : L S := [name(v) for v in variables(u)]
-      extras : L S := setDifference(syms,
-                                    setUnion(basicSymbols,subscriptedSymbols))
-      not empty? extras => 
-        m := fixUpSymbols(u)
-        m case EXPR(R) => m::EXPR(R)
-        error("Extra symbols detected:",[string(v) for v in extras]$L(String))
-      u
+   inv x == 1 / x
 
-    notSymbol?(v:BO):Boolean ==
-      s : S := name v
-      member?(s,basicSymbols) or 
-        scripted?(s) and member?(name s,subscriptedSymbols) => false
-      true
+   times(x:%,y:%) == [x.mantissa * y.mantissa, x.exponent + y.exponent]
 
-    extraOperators?(u:EXPR R):Boolean ==
-      ops    : L S := [name v for v in operators(u) | notSymbol?(v)]
-      if useNagFunctionsFlag then
-        fortranFunctions : L S := append(f77Functions,nagFunctions)
-      else
-        fortranFunctions : L S := f77Functions
-      extras : L S := setDifference(ops,fortranFunctions)
-      not empty? extras
+   itimes(n:I,y:%) == [n * y.mantissa,y.exponent]
 
-    checkOperators(u:EXPR R):Void ==
-      ops    : L S := [name v for v in operators(u) | notSymbol?(v)]
-      if useNagFunctionsFlag then
-        fortranFunctions : L S := append(f77Functions,nagFunctions)
-      else
-        fortranFunctions : L S := f77Functions
-      extras : L S := setDifference(ops,fortranFunctions)
-      not empty? extras => 
-        error("Non FORTRAN-77 functions detected:",[string(v) for v in extras])
-      void()
+   dvide(x,y) ==
+      ew := LENGTH y.mantissa - LENGTH x.mantissa + bits() + 1
+      mw := shift2(x.mantissa,ew) quo y.mantissa
+      ew := x.exponent - y.exponent - ew
+      [mw,ew]
 
-    checkForNagOperators(u:EXPR R):$ ==
-      useNagFunctionsFlag =>
-        import Pi
-        import PiCoercions(R)
-        piOp : BasicOperator := operator X01AAF
-        piSub : Equation EXPR R :=
-          equation(pi()$Pi::EXPR(R),kernel(piOp,0::EXPR(R))$EXPR(R))
-        subst(u,piSub) pretend $
-      u pretend $
+   square(x,n) ==
+      ma := x.mantissa; ex := x.exponent
+      for k in 1..n repeat
+         ma := ma * ma; ex := ex + ex
+         l:I := bits()::I - LENGTH ma
+         ma := shift2(ma,l); ex := ex - l
+      [ma,ex]
 
-    -- Conditional retractions:
+   power(x,n) ==
+      y:% := 1; z:% := x
+      repeat
+         if odd? n then y := chop( times(y,z), bits() )
+         if (n := n quo 2) = 0 then return y
+         z := chop( times(z,z), bits() )
 
-    if R has RetractableTo(Integer) then 
+   x:% ** y:% ==
+      x = 0 =>
+         y = 0 => error "0**0 is undefined"
+         y < 0 => error "division by 0"
+         y > 0 => 0
+      y = 0 => 1
+      y = 1 => x
+      x = 1 => 1
+      p := abs order y + 5
+      inc p; r := exp(y*log(x)); dec p
+      normalize r
 
-      retractIfCan(u:POLY Integer):Union($,"failed") ==
-        retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed")
+   x:% ** r:RN ==
+      x = 0 =>
+         r = 0 => error "0**0 is undefined"
+         r < 0 => error "division by 0"
+         r > 0 => 0
+      r = 0 => 1
+      r = 1 => x
+      x = 1 => 1
+      n := numer r
+      d := denom r
+      negative? x =>
+         odd? d =>
+            odd? n => return -((-x)**r)
+            return ((-x)**r)
+         error "negative root"
+      if d = 2 then
+         inc LENGTH n; y := sqrt(x); y := y**n; dec LENGTH n
+         return normalize y
+      y := [n,0]/[d,0]
+      x ** y
 
-      retract(u:POLY Integer):$ ==
-        retract((u::EXPR Integer)$EXPR(Integer))@$
+   x:% ** n:I ==
+      x = 0 =>
+         n = 0 => error "0**0 is undefined"
+         n < 0 => error "division by 0"
+         n > 0 => 0
+      n = 0 => 1
+      n = 1 => x
+      x = 1 => 1
+      p := bits()
+      bits(p + LENGTH n + 2)
+      y := power(x,abs n)
+      if n < 0 then y := dvide(1,y)
+      bits p
+      normalize y
 
-      retractIfCan(u:FRAC POLY Integer):Union($,"failed") ==
-        retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed")
+   -- Utility routines for conversion to decimal
 
-      retract(u:FRAC POLY  Integer):$ ==
-        retract((u::EXPR Integer)$EXPR(Integer))@$
+   ceilLength10: I -> I
 
-      int2R(u:Integer):R == u::R
+   chop10: (%,I) -> %
 
-      retractIfCan(u:EXPR Integer):Union($,"failed") ==
-        retractIfCan(map(int2R,u)$EXF2(Integer,R))@Union($,"failed")
+   convert10:(%,I) -> %
 
-      retract(u:EXPR Integer):$ ==
-        retract(map(int2R,u)$EXF2(Integer,R))@$
+   floorLength10: I -> I
 
-    if R has RetractableTo(Float) then 
+   length10: I -> I
 
-      retractIfCan(u:POLY Float):Union($,"failed") ==
-        retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed")
+   normalize10: (%,I) -> %
 
-      retract(u:POLY Float):$ ==
-        retract((u::EXPR Float)$EXPR(Float))@$
+   quotient10: (%,%,I) -> %
 
-      retractIfCan(u:FRAC POLY Float):Union($,"failed") ==
-        retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed")
+   power10: (%,I,I) -> %
 
-      retract(u:FRAC POLY  Float):$ ==
-        retract((u::EXPR Float)$EXPR(Float))@$
+   times10: (%,%,I) -> %
 
-      float2R(u:Float):R == (u::R)
+   convert10(x,d) ==
+      m := x.mantissa; e := x.exponent
+      --!! deal with bits here
+      b := bits(); (q,r) := divide(abs e, b)
+      b := 2**b::N; r := 2**r::N
+      -- compute 2**e = b**q * r
+      h := power10([b,0],q,d+5)
+      h := chop10([r*h.mantissa,h.exponent],d+5)
+      if e < 0 then h := quotient10([m,0],h,d)
+      else times10([m,0],h,d)
 
-      retractIfCan(u:EXPR Float):Union($,"failed") ==
-        retractIfCan(map(float2R,u)$EXF2(Float,R))@Union($,"failed")
+   ceilLength10 n == 146 * LENGTH n quo 485 + 1
 
-      retract(u:EXPR Float):$ ==
-        retract(map(float2R,u)$EXF2(Float,R))@$
+   floorLength10 n == 643 *  LENGTH n quo 2136
 
-    -- Exported Functions
+   length10 n ==
+      ln := LENGTH(n:=abs n)
+      upper := 76573 * ln quo 254370
+      lower := 21306 * (ln-1) quo 70777
+      upper = lower => upper + 1
+      n := n quo (10**lower::N)
+      while n >= 10 repeat
+         n:= n quo 10
+         lower := lower + 1
+      lower + 1
 
-    useNagFunctions():Boolean == useNagFunctionsFlag
-    useNagFunctions(v:Boolean):Boolean == 
-      old := useNagFunctionsFlag
-      useNagFunctionsFlag := v
-      old
- 
-    log10(x:$):$ ==
-      kernel(operator log10,x)
+   chop10(x,p) ==
+      e : I := floorLength10 x.mantissa - p
+      if e > 0 then x := [x.mantissa quo 10**e::N,x.exponent+e]
+      x
 
-    pi():$ == kernel(operator X01AAF,0)
+   normalize10(x,p) ==
+      ma := x.mantissa
+      ex := x.exponent
+      e : I := length10 ma - p
+      if e > 0 then
+         ma := ma quo 10**(e-1)::N
+         ex := ex + e
+         (ma,r) := divide(ma, 10)
+         if r > 4 then
+            ma := ma + 1
+            if ma = 10**p::N then (ma := 1; ex := ex + p)
+      [ma,ex]
 
-    coerce(u:$):EXPR R == u pretend EXPR(R)
+   times10(x,y,p) == normalize10(times(x,y),p)
 
-    retractIfCan(u:EXPR R):Union($,"failed") ==
-      if (extraSymbols? u) then 
-        m := fixUpSymbols(u)
-        m case "failed" => return "failed"
-        u := m::EXPR(R)
-      extraOperators? u => "failed"
-      checkForNagOperators(u)
+   quotient10(x,y,p) ==
+      ew := floorLength10 y.mantissa - ceilLength10 x.mantissa + p + 2
+      if ew < 0 then ew := 0
+      mw := (x.mantissa * 10**ew::N) quo y.mantissa
+      ew := x.exponent - y.exponent - ew
+      normalize10([mw,ew],p)
 
-    retract(u:EXPR R):$ ==
-      u:=checkSymbols(u)
-      checkOperators(u)
-      checkForNagOperators(u)
+   power10(x,n,d) ==
+      x = 0 => 0
+      n = 0 => 1
+      n = 1 => x
+      x = 1 => 1
+      p:I := d + LENGTH n + 1
+      e:I := n
+      y:% := 1
+      z:% := x
+      repeat
+         if odd? e then y := chop10(times(y,z),p)
+         if (e := e quo 2) = 0 then return y
+         z := chop10(times(z,z),p)
 
-    retractIfCan(u:Symbol):Union($,"failed") ==
-      not (member?(u,basicSymbols) or
-           scripted?(u) and member?(name u,subscriptedSymbols)) => "failed"
-      (((u::EXPR(R))$(EXPR R))pretend Rep)::$
+   --------------------------------
+   -- Output routines for Floats --
+   --------------------------------
+   zero ==> char("0")
 
-    retract(u:Symbol):$ ==
-      res : Union($,"failed") := retractIfCan(u)
-      res case "failed" => error("Illegal Symbol Detected:",u::String)
-      res::$
+   separator ==> space()$Character
 
-\end{chunk}
+   SPACING : Reference(N) := ref 10
+
+   OUTMODE : Reference(S) := ref "general"
+
+   OUTPREC : Reference(I) := ref(-1)
+
+   fixed : % -> S
+
+   floating : % -> S
+
+   general : % -> S
+
+   padFromLeft(s:S):S ==
+      zero? SPACING() => s
+      n:I := #s - 1
+      t := new( (n + 1 + n quo SPACING()) :: N , separator )
+      for i in 0..n for j in minIndex t .. repeat
+         t.j := s.(i + minIndex s)
+         if (i+1) rem SPACING() = 0 then j := j+1
+      t
+   padFromRight(s:S):S ==
+      SPACING() = 0 => s
+      n:I := #s - 1
+      t := new( (n + 1 + n quo SPACING()) :: N , separator )
+      for i in n..0 by -1 for j in maxIndex t .. by -1 repeat
+         t.j := s.(i + minIndex s)
+         if (n-i+1) rem SPACING() = 0 then j := j-1
+      t
+
+   fixed f ==
+      d := if OUTPREC() = -1 then digits::I else OUTPREC()
+      dpos:N:= if (d > 0) then d::N else 1::N
+      zero? f =>
+        OUTPREC() = -1 => "0.0"
+        concat("0",concat(".",padFromLeft new(dpos,zero)))
+      zero? exponent f =>
+        concat(padFromRight convert(mantissa f)@S,
+               concat(".",padFromLeft new(dpos,zero)))
+      negative? f => concat("-", fixed abs f)
+      bl := LENGTH(f.mantissa) + f.exponent
+      dd :=
+        OUTPREC() = -1 => d
+        bl > 0 => (146*bl) quo 485 + 1 + d
+        d
+      g := convert10(abs f,dd)
+      m := g.mantissa
+      e := g.exponent
+      if OUTPREC() ^= -1 then
+         -- round g to OUTPREC digits after the decimal point
+         l := length10 m
+         if -e > OUTPREC() and -e < 2*digits::I then
+            g := normalize10(g,l+e+OUTPREC())
+            m := g.mantissa; e := g.exponent
+      s := convert(m)@S; n := #s; o := e+n
+      p := if OUTPREC() = -1 then n::I else OUTPREC()
+      t:S
+      if e >= 0 then
+         s := concat(s, new(e::N, zero))
+         t := ""
+      else if o <= 0 then
+         t := concat(new((-o)::N,zero), s)
+         s := "0"
+      else
+         t := s(o + minIndex s .. n + minIndex s - 1)
+         s := s(minIndex s .. o + minIndex s - 1)
+      n := #t
+      if OUTPREC() = -1 then
+         t := rightTrim(t,zero)
+         if t = "" then t := "0"
+      else if n > p then t := t(minIndex t .. p + minIndex t- 1)
+                    else t := concat(t, new((p-n)::N,zero))
+      concat(padFromRight s, concat(".", padFromLeft t))
+
+   floating f ==
+      zero? f => "0.0"
+      negative? f => concat("-", floating abs f)
+      t:S := if zero? SPACING() then "E" else " E "
+      zero? exponent f =>
+        s := convert(mantissa f)@S
+        concat ["0.", padFromLeft s, t, convert(#s)@S]
+      -- base conversion to decimal rounded to the requested precision
+      d := if OUTPREC() = -1 then digits::I else OUTPREC()
+      g := convert10(f,d); m := g.mantissa; e := g.exponent
+      -- I'm assuming that length10 m = # s given n > 0
+      s := convert(m)@S; n := #s; o := e+n
+      s := padFromLeft s
+      concat ["0.", s, t, convert(o)@S]
+
+   general(f) ==
+      zero? f => "0.0"
+      negative? f => concat("-", general abs f)
+      d := if OUTPREC() = -1 then digits::I else OUTPREC()
+      zero? exponent f =>
+        d := d + 1
+        s := convert(mantissa f)@S
+        OUTPREC() ^= -1 and (e := #s) > d =>
+          t:S := if zero? SPACING() then "E" else " E "
+          concat ["0.", padFromLeft s, t, convert(e)@S]
+        padFromRight concat(s, ".0")
+      -- base conversion to decimal rounded to the requested precision
+      g := convert10(f,d); m := g.mantissa; e := g.exponent
+      -- I'm assuming that length10 m = # s given n > 0
+      s := convert(m)@S; n := #s; o := n + e
+      -- Note: at least one digit is displayed after the decimal point
+      -- and trailing zeroes after the decimal point are dropped
+      if o > 0 and o <= max(n,d) then
+         -- fixed format: add trailing zeroes before the decimal point
+         if o > n then s := concat(s, new((o-n)::N,zero))
+         t := rightTrim(s(o + minIndex s .. n + minIndex s - 1), zero)
+         if t = "" then t := "0" else t := padFromLeft t
+         s := padFromRight s(minIndex s .. o + minIndex s - 1)
+         concat(s, concat(".", t))
+      else if o <= 0 and o >= -5 then
+         -- fixed format: up to 5 leading zeroes after the decimal point
+         concat("0.",padFromLeft concat(new((-o)::N,zero),rightTrim(s,zero)))
+      else
+         -- print using E format written  0.mantissa E exponent
+         t := padFromLeft rightTrim(s,zero)
+         s := if zero? SPACING() then "E" else " E "
+         concat ["0.", t, s, convert(e+n)@S]
+
+   outputSpacing n == SPACING() := n
+
+   outputFixed() == (OUTMODE() := "fixed"; OUTPREC() := -1)
+
+   outputFixed n == (OUTMODE() := "fixed"; OUTPREC() := n::I)
+
+   outputGeneral() == (OUTMODE() := "general"; OUTPREC() := -1)
+
+   outputGeneral n == (OUTMODE() := "general"; OUTPREC() := n::I)
+
+   outputFloating() == (OUTMODE() := "floating"; OUTPREC() := -1)
+
+   outputFloating n == (OUTMODE() := "floating"; OUTPREC() := n::I)
+
+   convert(f):S ==
+      b:Integer :=
+        OUTPREC() = -1 and not zero? f =>
+          bits(length(abs mantissa f)::PositiveInteger)
+        0
+      s :=
+        OUTMODE() = "fixed" => fixed f
+        OUTMODE() = "floating" => floating f
+        OUTMODE() = "general" => general f
+        empty()$String
+      if b > 0 then bits(b::PositiveInteger)
+      s = empty()$String => error "bad output mode"
+      s
+
+   coerce(f):OutputForm ==
+     f >= 0 => message(convert(f)@S)
+     - (coerce(-f)@OutputForm)
+
+   convert(f):InputForm ==
+     convert [convert("float"::Symbol), convert mantissa f,
+              convert exponent f, convert base()]$List(InputForm)
+
+   -- Conversion routines
+
+   convert(x:%):Float == x pretend Float
+
+   convert(x:%):SF == makeSF(x.mantissa,x.exponent)$Lisp
+
+   coerce(x:%):SF == convert(x)@SF
+
+   convert(sf:SF):% == float(mantissa sf,exponent sf,base()$SF)
+
+   retract(f:%):RN == rationalApproximation(f,(bits()-1)::N,BASE)
+
+   retractIfCan(f:%):Union(RN, "failed") ==
+     rationalApproximation(f,(bits()-1)::N,BASE)
+
+   retract(f:%):I ==
+     (f = (n := wholePart f)::%) => n
+     error "Not an integer"
+
+   retractIfCan(f:%):Union(I, "failed") ==
+     (f = (n := wholePart f)::%) => n
+     "failed"
+
+   rationalApproximation(f,d) == rationalApproximation(f,d,10)
+
+   rationalApproximation(f,d,b) ==
+      t: Integer
+      nu := f.mantissa; ex := f.exponent
+      if ex >= 0 then return ((nu*BASE**(ex::N))/1)
+      de := BASE**((-ex)::N)
+      if b < 2 then error "base must be > 1"
+      tol := b**d
+      s := nu; t := de
+      p0,p1,q0,q1 : Integer
+      p0 := 0; p1 := 1; q0 := 1; q1 := 0
+      repeat
+         (q,r) := divide(s, t)
+         p2 := q*p1+p0
+         q2 := q*q1+q0
+         if r = 0 or tol*abs(nu*q2-de*p2) < de*abs(p2) then return (p2/q2)
+         (p0,p1) := (p1,p2)
+         (q0,q1) := (q1,q2)
+         (s,t) := (t,r)
 
-\begin{chunk}{COQ FEXPR}
-(* domain FEXPR *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{FEXPR.dotabb}
-"FEXPR" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FEXPR"]
+\begin{chunk}{FLOAT.dotabb}
+"FLOAT" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FLOAT"]
 "ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
-"FEXPR" -> "ALIST"
+"FLOAT" -> "ALIST"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FORTRAN FortranProgram}
+\section{domain FC FortranCode}
 
-\begin{chunk}{FortranProgram.input}
+\begin{chunk}{FortranCode.input}
 )set break resume
-)sys rm -f FortranProgram.output
-)spool FortranProgram.output
+)sys rm -f FortranCode.output
+)spool FortranCode.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show FortranProgram
+)show FortranCode
 --R 
---R FortranProgram(name: Symbol,returnType: Union(fst: FortranScalarType,void: void),arguments: List(Symbol),symbols: SymbolTable)  is a domain constructor
---R Abbreviation for FortranProgram is FORTRAN 
+--R FortranCode  is a domain constructor
+--R Abbreviation for FortranCode is FC 
 --R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FORTRAN 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FC 
 --R
 --R------------------------------- Operations --------------------------------
---R coerce : Expression(Float) -> %       coerce : Expression(Integer) -> %
---R coerce : List(FortranCode) -> %       coerce : FortranCode -> %
---R coerce : % -> OutputForm              outputAsFortran : % -> Void
---R coerce : Equation(Expression(Complex(Float))) -> %
---R coerce : Equation(Expression(Float)) -> %
---R coerce : Equation(Expression(Integer)) -> %
---R coerce : Expression(Complex(Float)) -> %
---R coerce : Equation(Expression(MachineComplex)) -> %
---R coerce : Equation(Expression(MachineFloat)) -> %
---R coerce : Equation(Expression(MachineInteger)) -> %
---R coerce : Expression(MachineComplex) -> %
---R coerce : Expression(MachineFloat) -> %
---R coerce : Expression(MachineInteger) -> %
---R coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> %
+--R ?=? : (%,%) -> Boolean                assign : (Symbol,String) -> %
+--R block : List(%) -> %                  call : String -> %
+--R coerce : % -> OutputForm              comment : List(String) -> %
+--R comment : String -> %                 common : (Symbol,List(Symbol)) -> %
+--R cond : (Switch,%,%) -> %              cond : (Switch,%) -> %
+--R continue : SingleInteger -> %         getCode : % -> SExpression
+--R goto : SingleInteger -> %             hash : % -> SingleInteger
+--R latex : % -> String                   printCode : % -> Void
+--R repeatUntilLoop : (Switch,%) -> %     returns : Expression(Integer) -> %
+--R returns : Expression(Float) -> %      returns : () -> %
+--R save : () -> %                        stop : () -> %
+--R whileLoop : (Switch,%) -> %           ?~=? : (%,%) -> Boolean
+--R assign : (Symbol,List(Polynomial(Integer)),Expression(Complex(Float))) -> %
+--R assign : (Symbol,List(Polynomial(Integer)),Expression(Float)) -> %
+--R assign : (Symbol,List(Polynomial(Integer)),Expression(Integer)) -> %
+--R assign : (Symbol,Vector(Expression(Complex(Float)))) -> %
+--R assign : (Symbol,Vector(Expression(Float))) -> %
+--R assign : (Symbol,Vector(Expression(Integer))) -> %
+--R assign : (Symbol,Matrix(Expression(Complex(Float)))) -> %
+--R assign : (Symbol,Matrix(Expression(Float))) -> %
+--R assign : (Symbol,Matrix(Expression(Integer))) -> %
+--R assign : (Symbol,Expression(Complex(Float))) -> %
+--R assign : (Symbol,Expression(Float)) -> %
+--R assign : (Symbol,Expression(Integer)) -> %
+--R assign : (Symbol,List(Polynomial(Integer)),Expression(MachineComplex)) -> %
+--R assign : (Symbol,List(Polynomial(Integer)),Expression(MachineFloat)) -> %
+--R assign : (Symbol,List(Polynomial(Integer)),Expression(MachineInteger)) -> %
+--R assign : (Symbol,Vector(Expression(MachineComplex))) -> %
+--R assign : (Symbol,Vector(Expression(MachineFloat))) -> %
+--R assign : (Symbol,Vector(Expression(MachineInteger))) -> %
+--R assign : (Symbol,Matrix(Expression(MachineComplex))) -> %
+--R assign : (Symbol,Matrix(Expression(MachineFloat))) -> %
+--R assign : (Symbol,Matrix(Expression(MachineInteger))) -> %
+--R assign : (Symbol,Vector(MachineComplex)) -> %
+--R assign : (Symbol,Vector(MachineFloat)) -> %
+--R assign : (Symbol,Vector(MachineInteger)) -> %
+--R assign : (Symbol,Matrix(MachineComplex)) -> %
+--R assign : (Symbol,Matrix(MachineFloat)) -> %
+--R assign : (Symbol,Matrix(MachineInteger)) -> %
+--R assign : (Symbol,Expression(MachineComplex)) -> %
+--R assign : (Symbol,Expression(MachineFloat)) -> %
+--R assign : (Symbol,Expression(MachineInteger)) -> %
+--R code : % -> Union(nullBranch: null,assignmentBranch: Record(var: Symbol,arrayIndex: List(Polynomial(Integer)),rand: Record(ints2Floats?: Boolean,expr: OutputForm)),arrayAssignmentBranch: Record(var: Symbol,rand: OutputForm,ints2Floats?: Boolean),conditionalBranch: Record(switch: Switch,thenClause: %,elseClause: %),returnBranch: Record(empty?: Boolean,value: Record(ints2Floats?: Boolean,expr: OutputForm)),blockBranch: List(%),commentBranch: List(String),callBranch: String,forBranch: Record(range: SegmentBinding(Polynomial(Integer)),span: Polynomial(Integer),body: %),labelBranch: SingleInteger,loopBranch: Record(switch: Switch,body: %),commonBranch: Record(name: Symbol,contents: List(Symbol)),printBranch: List(OutputForm))
+--R forLoop : (SegmentBinding(Polynomial(Integer)),Polynomial(Integer),%) -> %
+--R forLoop : (SegmentBinding(Polynomial(Integer)),%) -> %
+--R operation : % -> Union(Null: null,Assignment: assignment,Conditional: conditional,Return: return,Block: block,Comment: comment,Call: call,For: for,While: while,Repeat: repeat,Goto: goto,Continue: continue,ArrayAssignment: arrayAssignment,Save: save,Stop: stop,Common: common,Print: print)
+--R printStatement : List(OutputForm) -> %
+--R returns : Expression(Complex(Float)) -> %
+--R returns : Expression(MachineComplex) -> %
+--R returns : Expression(MachineInteger) -> %
+--R returns : Expression(MachineFloat) -> %
+--R setLabelValue : SingleInteger -> SingleInteger
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{FortranProgram.help}
+\begin{chunk}{FortranCode.help}
 ====================================================================
-FortranProgram examples
+FortranCode examples
 ====================================================================
 
-FortranProgram allows the user to build and manipulate simple models of 
-FORTRAN subprograms.  These can then be transformed into actual FORTRAN 
-notation.
+This domain builds representations of program code segments for use with
+the FortranProgram domain.
 
 See Also:
-o )show FortranProgram
+o )show FortranCode
 
 \end{chunk}
 
-\pagehead{FortranProgram}{FORTRAN}
-\pagepic{ps/v103fortranprogram.ps}{FORTRAN}{1.00}
+\pagehead{FortranCode}{FC}
+\pagepic{ps/v103fortrancode.ps}{FC}{1.00}
 {\bf See}\\
 \pageto{Result}{RESULT}
-\pageto{FortranCode}{FC}
+\pageto{FortranProgram}{FORTRAN}
 \pageto{ThreeDimensionalMatrix}{M3D}
 \pageto{SimpleFortranProgram}{SFORT}
 \pageto{Switch}{SWITCH}
@@ -61865,1001 +69574,1098 @@ o )show FortranProgram
 \pageto{FortranExpression}{FEXPR}
 
 {\bf Exports:}\\
-\begin{tabular}{ll}
-\cross{FORTRAN}{coerce} &
-\cross{FORTRAN}{outputAsFortran}
+\begin{tabular}{lllll}
+\cross{FC}{assign} &
+\cross{FC}{block} &
+\cross{FC}{call} &
+\cross{FC}{code} &
+\cross{FC}{coerce} \\
+\cross{FC}{comment} &
+\cross{FC}{common} &
+\cross{FC}{cond} &
+\cross{FC}{continue} &
+\cross{FC}{forLoop} \\
+\cross{FC}{getCode} &
+\cross{FC}{goto} &
+\cross{FC}{hash} &
+\cross{FC}{latex} &
+\cross{FC}{operation} \\
+\cross{FC}{printCode} &
+\cross{FC}{printStatement} &
+\cross{FC}{repeatUntilLoop} &
+\cross{FC}{returns} &
+\cross{FC}{save} \\
+\cross{FC}{setLabelValue} &
+\cross{FC}{stop} &
+\cross{FC}{whileLoop} &
+\cross{FC}{?=?} &
+\cross{FC}{?~=?} 
 \end{tabular}
 
-\begin{chunk}{domain FORTRAN FortranProgram}
-)abbrev domain FORTRAN FortranProgram
+\begin{chunk}{domain FC FortranCode}
+)abbrev domain FC FortranCode
 ++ Author: Mike Dewar
-++ Date Created: October 1992
-++ Date Last Updated: 23 January 1995 Added support for intrinsic functions
+++ Date Created: April 1991
+++ Date Last Updated: 9 January 1995 Added fortran2Lines to getCall, MCD
 ++ Description:
-++ \axiomType{FortranProgram} allows the user to build and manipulate simple 
-++ models of FORTRAN subprograms.  These can then be transformed into 
-++ actual FORTRAN notation.
+++ This domain builds representations of program code segments for use with
+++ the FortranProgram domain.
 
-FortranProgram(name,returnType,arguments,symbols): Exports == Implement where
-  name       : Symbol
-  returnType : Union(fst:FortranScalarType,void:"void")
-  arguments  : List Symbol
-  symbols    : SymbolTable
+FortranCode(): public == private where
+  L ==> List
+  PI ==> PositiveInteger
+  PIN ==> Polynomial Integer
+  SEX ==> SExpression
+  O ==> OutputForm
+  OP ==> Union(Null:"null",
+               Assignment:"assignment",
+               Conditional:"conditional",
+               Return:"return",
+               Block:"block",
+               Comment:"comment",
+               Call:"call",
+               For:"for",
+               While:"while",
+               Repeat:"repeat",
+               Goto:"goto",
+               Continue:"continue",
+               ArrayAssignment:"arrayAssignment",
+               Save:"save",
+               Stop:"stop",
+               Common:"common",
+               Print:"print")
+  ARRAYASS ==> Record(var:Symbol, rand:O, ints2Floats?:Boolean)
+  EXPRESSION ==> Record(ints2Floats?:Boolean,expr:O)
+  ASS ==> Record(var:Symbol,
+                 arrayIndex:L PIN,
+                 rand:EXPRESSION
+                )
+  COND ==> Record(switch: Switch(),
+                  thenClause: $,
+                  elseClause: $
+                 )
+  RETURN ==> Record(empty?:Boolean,value:EXPRESSION)
+  BLOCK ==> List $
+  COMMENT ==> List String
+  COMMON ==> Record(name:Symbol,contents:List Symbol)
+  CALL ==> String
+  FOR ==> Record(range:SegmentBinding PIN, span:PIN,  body:$)
+  LABEL ==> SingleInteger
+  LOOP ==> Record(switch:Switch(),body:$)
+  PRINTLIST ==> List O
+  OPREC ==> Union(nullBranch:"null", assignmentBranch:ASS,
+                  arrayAssignmentBranch:ARRAYASS,
+                  conditionalBranch:COND, returnBranch:RETURN,
+                  blockBranch:BLOCK, commentBranch:COMMENT, callBranch:CALL,
+                  forBranch:FOR, labelBranch:LABEL, loopBranch:LOOP,
+                  commonBranch:COMMON, printBranch:PRINTLIST)
 
-  FC     ==> FortranCode
-  EXPR   ==> Expression
-  INT    ==> Integer
-  CMPX   ==> Complex
-  MINT   ==> MachineInteger
-  MFLOAT ==> MachineFloat
-  MCMPLX ==> MachineComplex
-  REP    ==> Record(localSymbols : SymbolTable, code : List FortranCode)
+  public == SetCategory with
+    coerce: $ -> O
+      ++ coerce(f) returns an object of type OutputForm.
+    forLoop: (SegmentBinding PIN,$) -> $
+     ++ forLoop(i=1..10,c) creates a representation of a FORTRAN DO loop with
+     ++ \spad{i} ranging over the values 1 to 10.
+    forLoop: (SegmentBinding PIN,PIN,$) -> $
+     ++ forLoop(i=1..10,n,c) creates a representation of a FORTRAN DO loop with
+     ++ \spad{i} ranging over the values 1 to 10 by n.
+    whileLoop: (Switch,$) -> $
+     ++ whileLoop(s,c) creates a while loop in FORTRAN.
+    repeatUntilLoop: (Switch,$) -> $
+     ++ repeatUntilLoop(s,c) creates a repeat ... until loop in FORTRAN.
+    goto: SingleInteger -> $
+      ++ goto(l) creates a representation of a FORTRAN GOTO statement
+    continue: SingleInteger -> $
+      ++ continue(l) creates a representation of a FORTRAN CONTINUE labelled 
+      ++ with l
+    comment: String -> $
+      ++ comment(s) creates a representation of the String s as a single FORTRAN
+      ++ comment.  
+    comment: List String -> $
+      ++ comment(s) creates a representation of the Strings s as a multi-line
+      ++ FORTRAN comment.  
+    call: String -> $
+      ++ call(s) creates a representation of a FORTRAN CALL statement
+    returns: () -> $
+      ++ returns() creates a representation of a FORTRAN RETURN statement.
+    returns: Expression MachineFloat -> $
+      ++ returns(e) creates a representation of a FORTRAN RETURN statement
+      ++ with a returned value.
+    returns: Expression MachineInteger -> $
+      ++ returns(e) creates a representation of a FORTRAN RETURN statement
+      ++ with a returned value.
+    returns: Expression MachineComplex -> $
+      ++ returns(e) creates a representation of a FORTRAN RETURN statement
+      ++ with a returned value.
+    returns: Expression Float -> $
+      ++ returns(e) creates a representation of a FORTRAN RETURN statement
+      ++ with a returned value.
+    returns: Expression Integer -> $
+      ++ returns(e) creates a representation of a FORTRAN RETURN statement
+      ++ with a returned value.
+    returns: Expression Complex Float -> $
+      ++ returns(e) creates a representation of a FORTRAN RETURN statement
+      ++ with a returned value.
+    cond: (Switch,$) -> $
+      ++ cond(s,e) creates a representation of the FORTRAN expression
+      ++ IF (s) THEN e.
+    cond: (Switch,$,$) -> $
+      ++ cond(s,e,f) creates a representation of the FORTRAN expression
+      ++ IF (s) THEN e ELSE f.
+    assign: (Symbol,String) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Expression MachineInteger) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Expression MachineFloat) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Expression MachineComplex) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Matrix MachineInteger) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Matrix MachineFloat) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Matrix MachineComplex) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Vector MachineInteger) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Vector MachineFloat) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Vector MachineComplex) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Matrix Expression MachineInteger) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Matrix Expression MachineFloat) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Matrix Expression MachineComplex) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Vector Expression MachineInteger) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Vector Expression MachineFloat) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Vector Expression MachineComplex) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,L PIN,Expression MachineInteger) -> $
+      ++ assign(x,l,y) creates a representation of the assignment of \spad{y}
+      ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of
+      ++ indices).
+    assign: (Symbol,L PIN,Expression MachineFloat) -> $
+      ++ assign(x,l,y) creates a representation of the assignment of \spad{y}
+      ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of
+      ++ indices).
+    assign: (Symbol,L PIN,Expression MachineComplex) -> $
+      ++ assign(x,l,y) creates a representation of the assignment of \spad{y}
+      ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of
+      ++ indices).
+    assign: (Symbol,Expression Integer) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Expression Float) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Expression Complex Float) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Matrix Expression Integer) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Matrix Expression Float) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Matrix Expression Complex Float) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Vector Expression Integer) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Vector Expression Float) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,Vector Expression Complex Float) -> $
+      ++ assign(x,y) creates a representation of the FORTRAN expression
+      ++ x=y.
+    assign: (Symbol,L PIN,Expression Integer) -> $
+      ++ assign(x,l,y) creates a representation of the assignment of \spad{y}
+      ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of
+      ++ indices).
+    assign: (Symbol,L PIN,Expression Float) -> $
+      ++ assign(x,l,y) creates a representation of the assignment of \spad{y}
+      ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of
+      ++ indices).
+    assign: (Symbol,L PIN,Expression Complex Float) -> $
+      ++ assign(x,l,y) creates a representation of the assignment of \spad{y}
+      ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of
+      ++ indices).
+    block: List($) -> $
+      ++ block(l) creates a representation of the statements in l as a block.
+    stop: () -> $
+      ++ stop() creates a representation of a STOP statement.
+    save: () -> $
+      ++ save() creates a representation of a SAVE statement.
+    printStatement: List O -> $
+      ++ printStatement(l) creates a representation of a PRINT statement.
+    common: (Symbol,List Symbol) -> $
+      ++ common(name,contents) creates a representation a named common block.
+    operation: $ -> OP
+      ++ operation(f) returns the name of the operation represented by \spad{f}.
+    code: $ -> OPREC
+      ++ code(f) returns the internal representation of the object represented
+      ++ by \spad{f}.
+    printCode: $ -> Void
+      ++ printCode(f) prints out \spad{f} in FORTRAN notation.
+    getCode: $ -> SEX
+      ++ getCode(f) returns a Lisp list of strings representing \spad{f}
+      ++ in Fortran notation.  This is used by the FortranProgram domain.
+    setLabelValue:SingleInteger -> SingleInteger
+      ++ setLabelValue(i) resets the counter which produces labels to i
 
-  Exports ==> FortranProgramCategory with
-    coerce : FortranCode -> $
-        ++ coerce(fc) is not documented
-    coerce : List FortranCode -> $
-        ++ coerce(lfc) is not documented
-    coerce : REP -> $
-        ++ coerce(r) is not documented
-    coerce : EXPR MINT -> $
-        ++ coerce(e) is not documented
-    coerce : EXPR MFLOAT -> $
-        ++ coerce(e) is not documented
-    coerce : EXPR MCMPLX -> $
-        ++ coerce(e) is not documented
-    coerce : Equation EXPR MINT -> $
-        ++ coerce(eq) is not documented
-    coerce : Equation EXPR MFLOAT -> $
-        ++ coerce(eq) is not documented
-    coerce : Equation EXPR MCMPLX -> $
-        ++ coerce(eq) is not documented
-    coerce : EXPR INT -> $
-        ++ coerce(e) is not documented
-    coerce : EXPR Float -> $
-        ++ coerce(e) is not documented
-    coerce : EXPR CMPX Float -> $
-        ++ coerce(e) is not documented
-    coerce : Equation EXPR INT -> $
-        ++ coerce(eq) is not documented
-    coerce : Equation EXPR Float -> $
-        ++ coerce(eq) is not documented
-    coerce : Equation EXPR CMPX Float -> $
-        ++ coerce(eq) is not documented
+  private == add
+    import Void
+    import ASS
+    import COND
+    import RETURN
+    import L PIN
+    import O
+    import SEX
+    import FortranType
+    import TheSymbolTable
 
-  Implement ==> add
+    Rep := Record(op: OP, data: OPREC)
 
-    Rep := REP
+    -- We need to be able to generate unique labels
+    labelValue:SingleInteger := 25000::SingleInteger
 
-    import SExpression
-    import TheSymbolTable
-    import FortranCode
+    setLabelValue(u:SingleInteger):SingleInteger == labelValue := u
 
-    makeRep(b:List FortranCode):$ ==
-      construct(empty()$SymbolTable,b)$REP
+    newLabel():SingleInteger ==
+      labelValue := labelValue + 1$SingleInteger
+      labelValue
 
-    codeFrom(u:$):List FortranCode ==
-      elt(u::Rep,code)$REP
+    commaSep(l:List String):List(String) ==
+      [(l.1),:[:[",",u] for u in rest(l)]]
 
-    outputAsFortran(p:$):Void ==
-      setLabelValue(25000::SingleInteger)$FC
-      -- Do this first to catch any extra type declarations:
-      tempName := "FPTEMP"::Symbol
-      newSubProgram(tempName)
-      initialiseIntrinsicList()$Lisp
-      body : List SExpression := [getCode(l)$FortranCode for l in codeFrom(p)]
-      intrinsics : SExpression := getIntrinsicList()$Lisp
-      endSubProgram()
-      fortFormatHead(returnType::OutputForm, name::OutputForm, _
-                     arguments::OutputForm)$Lisp
-      printTypes(symbols)$SymbolTable
-      printTypes((p::Rep).localSymbols)$SymbolTable
-      printTypes(tempName)$TheSymbolTable
-      fortFormatIntrinsics(intrinsics)$Lisp
-      clearTheSymbolTable(tempName)
-      for expr in body repeat displayLines1(expr)$Lisp
-      dispStatement(END::OutputForm)$Lisp
-      void()$Void
+    getReturn(rec:RETURN):SEX ==
+      returnToken : SEX := convert("RETURN"::Symbol::O)$SEX
+      elt(rec,empty?)$RETURN =>
+        getStatement(returnToken,NIL$Lisp)$Lisp
+      rt : EXPRESSION := elt(rec,value)$RETURN
+      rv : O := elt(rt,expr)$EXPRESSION
+      getStatement([returnToken,convert(rv)$SEX]$Lisp,
+                   elt(rt,ints2Floats?)$EXPRESSION )$Lisp
 
-    mkString(l:List Symbol):String ==
-      unparse(convert(l::OutputForm)@InputForm)$InputForm
+    getStop():SEX ==
+      fortran2Lines(LIST("STOP")$Lisp)$Lisp
 
-    checkVariables(user:List Symbol,target:List Symbol):Void ==
-      -- We don't worry about whether the user has subscripted the
-      -- variables or not.
-      setDifference(map(name$Symbol,user),target) ^= empty()$List(Symbol) =>
-        s1 : String := mkString(user)
-        s2 : String := mkString(target)
-        error ["Incompatible variable lists:", s1, s2]
-      void()$Void
+    getSave():SEX ==
+      fortran2Lines(LIST("SAVE")$Lisp)$Lisp
 
-    coerce(u:EXPR MINT) : $ ==
-      checkVariables(variables(u)$EXPR(MINT),arguments)
-      l : List(FC) := [assign(name,u)$FC,returns()$FC]
-      makeRep l
+    getCommon(u:COMMON):SEX ==
+      fortran2Lines(APPEND(LIST("COMMON"," /",string (u.name),"/ ")$Lisp,_
+                    addCommas(u.contents)$Lisp)$Lisp)$Lisp
+ 
+    getPrint(l:PRINTLIST):SEX ==
+      ll : SEX := LIST("PRINT*")$Lisp
+      for i in l repeat 
+        ll := APPEND(ll,CONS(",",expression2Fortran(i)$Lisp)$Lisp)$Lisp
+      fortran2Lines(ll)$Lisp
 
-    coerce(u:Equation EXPR MINT) : $ ==
-      retractIfCan(lhs u)@Union(Kernel(EXPR MINT),"failed") case "failed" =>
-        error "left hand side is not a kernel"
-      vList : List Symbol := variables lhs u
-      #vList ^= #arguments =>
-        error "Incorrect number of arguments"
-      veList : List EXPR MINT := [w::EXPR(MINT) for w in vList]
-      aeList : List EXPR MINT := [w::EXPR(MINT) for w in arguments]
-      eList : List Equation EXPR MINT := 
-        [equation(w,v) for w in veList for v in aeList]
-      (subst(rhs u,eList))::$
+    getBlock(rec:BLOCK):SEX ==
+      indentFortLevel(convert(1@Integer)$SEX)$Lisp
+      expr : SEX := LIST()$Lisp
+      for u in rec repeat
+        expr := APPEND(expr,getCode(u))$Lisp
+      indentFortLevel(convert(-1@Integer)$SEX)$Lisp
+      expr
 
-    coerce(u:EXPR MFLOAT) : $ ==
-      checkVariables(variables(u)$EXPR(MFLOAT),arguments)
-      l : List(FC) := [assign(name,u)$FC,returns()$FC]
-      makeRep l 
+    getBody(f:$):SEX ==
+      operation(f) case Block => getCode f
+      indentFortLevel(convert(1@Integer)$SEX)$Lisp
+      expr := getCode f
+      indentFortLevel(convert(-1@Integer)$SEX)$Lisp
+      expr
 
-    coerce(u:Equation EXPR MFLOAT) : $ ==
-      retractIfCan(lhs u)@Union(Kernel(EXPR MFLOAT),"failed") case "failed" =>
-        error "left hand side is not a kernel"
-      vList : List Symbol := variables lhs u
-      #vList ^= #arguments =>
-        error "Incorrect number of arguments"
-      veList : List EXPR MFLOAT := [w::EXPR(MFLOAT) for w in vList]
-      aeList : List EXPR MFLOAT := [w::EXPR(MFLOAT) for w in arguments]
-      eList : List Equation EXPR MFLOAT := 
-        [equation(w,v) for w in veList for v in aeList]
-      (subst(rhs u,eList))::$
+    getElseIf(f:$):SEX ==
+      rec := code f
+      expr :=
+       fortFormatElseIf(elt(rec.conditionalBranch,switch)$COND::O)$Lisp
+      expr := 
+       APPEND(expr,getBody elt(rec.conditionalBranch,thenClause)$COND)$Lisp
+      elseBranch := elt(rec.conditionalBranch,elseClause)$COND
+      not(operation(elseBranch) case Null) =>
+        operation(elseBranch) case Conditional => 
+          APPEND(expr,getElseIf elseBranch)$Lisp
+        expr := APPEND(expr, getStatement(ELSE::O,NIL$Lisp)$Lisp)$Lisp
+        expr := APPEND(expr, getBody elseBranch)$Lisp
+      expr
 
-    coerce(u:EXPR MCMPLX) : $ ==
-      checkVariables(variables(u)$EXPR(MCMPLX),arguments)
-      l : List(FC) := [assign(name,u)$FC,returns()$FC]
-      makeRep l
+    getContinue(label:SingleInteger):SEX ==
+      lab : O := label::O
+      if (width(lab) > 6) then error "Label too big"
+      cnt : O := "CONTINUE"::O
+      --sp  : O := hspace(6-width lab)
+      sp  : O := hspace(_$fortIndent$Lisp -width lab)
+      LIST(STRCONC(PRINC_-TO_-STRING(lab)$Lisp,sp,cnt)$Lisp)$Lisp
 
-    coerce(u:Equation EXPR MCMPLX) : $ ==
-      retractIfCan(lhs u)@Union(Kernel EXPR MCMPLX,"failed") case "failed"=>
-        error "left hand side is not a kernel"
-      vList : List Symbol := variables lhs u
-      #vList ^= #arguments =>
-        error "Incorrect number of arguments"
-      veList : List EXPR MCMPLX := [w::EXPR(MCMPLX) for w in vList]
-      aeList : List EXPR MCMPLX := [w::EXPR(MCMPLX) for w in arguments]
-      eList : List Equation EXPR MCMPLX := 
-        [equation(w,v) for w in veList for v in aeList]
-      (subst(rhs u,eList))::$
+    getGoto(label:SingleInteger):SEX ==
+     fortran2Lines(
+      LIST(STRCONC("GOTO ",PRINC_-TO_-STRING(label::O)$Lisp)$Lisp)$Lisp)$Lisp
 
+    getRepeat(repRec:LOOP):SEX ==
+      sw : Switch := NOT elt(repRec,switch)$LOOP
+      lab := newLabel()
+      bod := elt(repRec,body)$LOOP
+      APPEND(getContinue lab,getBody bod,
+           fortFormatIfGoto(sw::O,lab)$Lisp)$Lisp
 
-    coerce(u:REP):$ ==
-      u@Rep
+    getWhile(whileRec:LOOP):SEX ==
+      sw := NOT elt(whileRec,switch)$LOOP
+      lab1 := newLabel()
+      lab2 := newLabel()
+      bod := elt(whileRec,body)$LOOP
+      APPEND(fortFormatLabelledIfGoto(sw::O,lab1,lab2)$Lisp,
+           getBody bod, getBody goto(lab1), getContinue lab2)$Lisp
 
-    coerce(u:$):OutputForm ==
-      coerce(name)$Symbol
+    getArrayAssign(rec:ARRAYASS):SEX ==
+      getfortarrayexp((rec.var)::O,rec.rand,rec.ints2Floats?)$Lisp
 
-    coerce(c:List FortranCode):$ ==
-      makeRep c
+    getAssign(rec:ASS):SEX ==
+      indices : L PIN := elt(rec,arrayIndex)$ASS
+      if indices = []::(L PIN) then
+        lhs := elt(rec,var)$ASS::O
+      else
+        lhs := cons(elt(rec,var)$ASS::PIN,indices)::O
+        -- Must get the index brackets correct:
+        lhs := (cdr car cdr convert(lhs)$SEX::SEX)::O -- Yuck!
+      elt(elt(rec,rand)$ASS,ints2Floats?)$EXPRESSION =>
+        assignment2Fortran1(lhs,elt(elt(rec,rand)$ASS,expr)$EXPRESSION)$Lisp
+      integerAssignment2Fortran1(lhs,_
+       elt(elt(rec,rand)$ASS,expr)$EXPRESSION)$Lisp
 
-    coerce(c:FortranCode):$ ==
-      makeRep [c]
+    getCond(rec:COND):SEX ==
+      expr := APPEND(fortFormatIf(elt(rec,switch)$COND::O)$Lisp,
+                     getBody elt(rec,thenClause)$COND)$Lisp
+      elseBranch := elt(rec,elseClause)$COND
+      if not(operation(elseBranch) case Null) then
+        operation(elseBranch) case Conditional =>
+          expr := APPEND(expr,getElseIf elseBranch)$Lisp
+        expr := APPEND(expr,getStatement(ELSE::O,NIL$Lisp)$Lisp,
+                       getBody elseBranch)$Lisp
+      APPEND(expr,getStatement(ENDIF::O,NIL$Lisp)$Lisp)$Lisp
 
-    coerce(u:EXPR INT) : $ ==
-      checkVariables(variables(u)$EXPR(INT),arguments)
-      l : List(FC) := [assign(name,u)$FC,returns()$FC]
-      makeRep l
+    getComment(rec:COMMENT):SEX ==
+      convert([convert(concat("C     ",c)$String)@SEX for c in rec])@SEX
 
-    coerce(u:Equation EXPR INT) : $ ==
-      retractIfCan(lhs u)@Union(Kernel(EXPR INT),"failed") case "failed" =>
-        error "left hand side is not a kernel"
-      vList : List Symbol := variables lhs u
-      #vList ^= #arguments =>
-        error "Incorrect number of arguments"
-      veList : List EXPR INT := [w::EXPR(INT) for w in vList]
-      aeList : List EXPR INT := [w::EXPR(INT) for w in arguments]
-      eList : List Equation EXPR INT := 
-        [equation(w,v) for w in veList for v in aeList]
-      (subst(rhs u,eList))::$
+    getCall(rec:CALL):SEX ==
+      expr := concat("CALL ",rec)$String
+      #expr > 1320 => error "Fortran CALL too large"
+      fortran2Lines(convert([convert(expr)@SEX ])@SEX)$Lisp
 
-    coerce(u:EXPR Float) : $ ==
-      checkVariables(variables(u)$EXPR(Float),arguments)
-      l : List(FC) := [assign(name,u)$FC,returns()$FC]
-      makeRep l 
+    getFor(rec:FOR):SEX ==
+      rnge : SegmentBinding PIN := elt(rec,range)$FOR
+      increment : PIN := elt(rec,span)$FOR
+      lab : SingleInteger := newLabel()
+      declare!(variable rnge,fortranInteger())
+      expr := fortFormatDo(variable rnge, (lo segment rnge)::O,_
+        (hi segment rnge)::O,increment::O,lab)$Lisp
+      APPEND(expr, getBody elt(rec,body)$FOR, getContinue(lab))$Lisp
+ 
+    getCode(f:$):SEX ==
+      opp:OP := operation f
+      rec:OPREC:= code f
+      opp case Assignment => getAssign(rec.assignmentBranch)
+      opp case ArrayAssignment => getArrayAssign(rec.arrayAssignmentBranch)
+      opp case Conditional => getCond(rec.conditionalBranch)
+      opp case Return => getReturn(rec.returnBranch)
+      opp case Block => getBlock(rec.blockBranch)
+      opp case Comment => getComment(rec.commentBranch)
+      opp case Call => getCall(rec.callBranch)
+      opp case For => getFor(rec.forBranch)
+      opp case Continue => getContinue(rec.labelBranch)
+      opp case Goto => getGoto(rec.labelBranch)
+      opp case Repeat => getRepeat(rec.loopBranch)
+      opp case While => getWhile(rec.loopBranch)
+      opp case Save => getSave()
+      opp case Stop => getStop()
+      opp case Print => getPrint(rec.printBranch)
+      opp case Common => getCommon(rec.commonBranch)
+      error "Unsupported program construct."
+      convert(0)@SEX
 
-    coerce(u:Equation EXPR Float) : $ ==
-      retractIfCan(lhs u)@Union(Kernel(EXPR Float),"failed") case "failed" =>
-        error "left hand side is not a kernel"
-      vList : List Symbol := variables lhs u
-      #vList ^= #arguments =>
-        error "Incorrect number of arguments"
-      veList : List EXPR Float := [w::EXPR(Float) for w in vList]
-      aeList : List EXPR Float := [w::EXPR(Float) for w in arguments]
-      eList : List Equation EXPR Float := 
-        [equation(w,v) for w in veList for v in aeList]
-      (subst(rhs u,eList))::$
+    printCode(f:$):Void ==
+      displayLines1$Lisp getCode f
+      void()$Void
 
-    coerce(u:EXPR Complex Float) : $ ==
-      checkVariables(variables(u)$EXPR(Complex Float),arguments)
-      l : List(FC) := [assign(name,u)$FC,returns()$FC]
-      makeRep l
+    code (f:$):OPREC ==
+      elt(f,data)$Rep
 
-    coerce(u:Equation EXPR CMPX Float) : $ ==
-      retractIfCan(lhs u)@Union(Kernel EXPR CMPX Float,"failed") case "failed"=>
-        error "left hand side is not a kernel"
-      vList : List Symbol := variables lhs u
-      #vList ^= #arguments =>
-        error "Incorrect number of arguments"
-      veList : List EXPR CMPX Float := [w::EXPR(CMPX Float) for w in vList]
-      aeList : List EXPR CMPX Float := [w::EXPR(CMPX Float) for w in arguments]
-      eList : List Equation EXPR CMPX Float := 
-        [equation(w,v) for w in veList for v in aeList]
-      (subst(rhs u,eList))::$
+    operation (f:$):OP ==
+      elt(f,op)$Rep
 
-\end{chunk}
+    common(name:Symbol,contents:List Symbol):$ ==
+      [["common"]$OP,[[name,contents]$COMMON]$OPREC]$Rep
 
-\begin{chunk}{COQ FORTRAN}
-(* domain FORTRAN *)
-(*
-*)
+    stop():$ ==
+      [["stop"]$OP,["null"]$OPREC]$Rep
 
-\end{chunk}
+    save():$ ==
+      [["save"]$OP,["null"]$OPREC]$Rep
 
-\begin{chunk}{FORTRAN.dotabb}
-"FORTRAN" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FORTRAN"]
-"COMPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=COMPCAT"]
-"FORTRAN" -> "COMPCAT"
+    printStatement(l:List O):$ ==
+      [["print"]$OP,[l]$OPREC]$Rep
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FST FortranScalarType}
+    comment(s:List String):$ ==
+      [["comment"]$OP,[s]$OPREC]$Rep
 
-\begin{chunk}{FortranScalarType.input}
-)set break resume
-)sys rm -f FortranScalarType.output
-)spool FortranScalarType.output
-)set message test on
-)set message auto off
-)clear all
+    comment(s:String):$ ==
+      [["comment"]$OP,[list s]$OPREC]$Rep
 
---S 1 of 1
-)show FortranScalarType
---R 
---R FortranScalarType  is a domain constructor
---R Abbreviation for FortranScalarType is FST 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FST 
---R
---R------------------------------- Operations --------------------------------
---R ?=? : (%,%) -> Boolean                character? : % -> Boolean
---R coerce : % -> SExpression             coerce : % -> Symbol
---R coerce : Symbol -> %                  coerce : String -> %
---R coerce : % -> OutputForm              complex? : % -> Boolean
---R double? : % -> Boolean                doubleComplex? : % -> Boolean
---R integer? : % -> Boolean               logical? : % -> Boolean
---R real? : % -> Boolean                 
---R
---E 1
+    forLoop(r:SegmentBinding PIN,body:$):$ ==
+      [["for"]$OP,[[r,(incr segment r)::PIN,body]$FOR]$OPREC]$Rep
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{FortranScalarType.help}
-====================================================================
-FortranScalarType examples
-====================================================================
+    forLoop(r:SegmentBinding PIN,increment:PIN,body:$):$ ==
+      [["for"]$OP,[[r,increment,body]$FOR]$OPREC]$Rep
 
-Creates and manipulates objects which correspond to the
-basic FORTRAN data types: REAL, INTEGER, COMPLEX, LOGICAL and CHARACTER
+    goto(l:SingleInteger):$ ==
+      [["goto"]$OP,[l]$OPREC]$Rep
 
-See Also:
-o )show FortranScalarType
+    continue(l:SingleInteger):$ ==
+      [["continue"]$OP,[l]$OPREC]$Rep
 
-\end{chunk}
+    whileLoop(sw:Switch,b:$):$ ==
+      [["while"]$OP,[[sw,b]$LOOP]$OPREC]$Rep
 
-\pagehead{FortranScalarType}{FST}
-\pagepic{ps/v103fortranscalartype.ps}{FST}{1.00}
-{\bf See}\\
-\pageto{FortranType}{FT}
-\pageto{SymbolTable}{SYMTAB}
-\pageto{TheSymbolTable}{SYMS}
+    repeatUntilLoop(sw:Switch,b:$):$ ==
+      [["repeat"]$OP,[[sw,b]$LOOP]$OPREC]$Rep
 
-{\bf Exports:}\\
-\begin{tabular}{lllllllll}
-\cross{FST}{character?} &
-\cross{FST}{coerce} &
-\cross{FST}{complex?} &
-\cross{FST}{double?} &
-\cross{FST}{doubleComplex?} &
-\cross{FST}{integer?} &
-\cross{FST}{logical?} &
-\cross{FST}{real?} &
-\cross{FST}{?=?} 
-\end{tabular}
+    returns():$ ==
+      v := [false,0::O]$EXPRESSION
+      [["return"]$OP,[[true,v]$RETURN]$OPREC]$Rep
 
-\begin{chunk}{domain FST FortranScalarType}
-)abbrev domain FST FortranScalarType
-++ Author: Mike Dewar
-++ Date Created:  October 1992
-++ Description:
-++ Creates and manipulates objects which correspond to the
-++ basic FORTRAN data types: REAL, INTEGER, COMPLEX, LOGICAL and CHARACTER
+    returns(v:Expression MachineInteger):$ ==
+      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
 
-FortranScalarType() : exports == implementation where
+    returns(v:Expression MachineFloat):$ ==
+      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
 
-  exports == CoercibleTo OutputForm with
-    coerce : String -> $     
-      ++ coerce(s) transforms the string s into an element of 
-      ++ FortranScalarType provided s is one of "real", "double precision",
-      ++ "complex", "logical", "integer", "character", "REAL",
-      ++ "COMPLEX", "LOGICAL", "INTEGER", "CHARACTER", 
-      ++ "DOUBLE PRECISION"
-    coerce : Symbol -> $ 
-      ++ coerce(s) transforms the symbol s into an element of 
-      ++ FortranScalarType provided s is one of real, complex,double precision,
-      ++ logical, integer, character, REAL, COMPLEX, LOGICAL,
-      ++ INTEGER, CHARACTER, DOUBLE PRECISION
-    coerce : $ -> Symbol
-      ++ coerce(x) returns the symbol associated with x
-    coerce : $ -> SExpression
-      ++ coerce(x) returns the s-expression associated with x
-    real?  : $ -> Boolean
-      ++ real?(t) tests whether t is equivalent to the FORTRAN type REAL.
-    double? : $ -> Boolean
-      ++ double?(t) tests whether t is equivalent to the FORTRAN type
-      ++ DOUBLE PRECISION
-    integer?  : $ -> Boolean
-      ++ integer?(t) tests whether t is equivalent to the FORTRAN type INTEGER.
-    complex?  : $ -> Boolean
-      ++ complex?(t) tests whether t is equivalent to the FORTRAN type COMPLEX.
-    doubleComplex?  : $ -> Boolean
-      ++ doubleComplex?(t) tests whether t is equivalent to the (non-standard)
-      ++ FORTRAN type DOUBLE COMPLEX.
-    character?  : $ -> Boolean
-      ++ character?(t) tests whether t is equivalent to the FORTRAN type 
-      ++ CHARACTER.
-    logical?  : $ -> Boolean
-      ++ logical?(t) tests whether t is equivalent to the FORTRAN type LOGICAL.
-    "=" : ($,$) -> Boolean
-      ++ x=y tests for equality
+    returns(v:Expression MachineComplex):$ ==
+      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
 
-  implementation == add
+    returns(v:Expression Integer):$ ==
+      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
 
-    U == Union(RealThing:"real",
-               IntegerThing:"integer",
-               ComplexThing:"complex",
-               CharacterThing:"character",
-               LogicalThing:"logical",
-               DoublePrecisionThing:"double precision",
-               DoubleComplexThing:"double complex")
-    Rep := U
+    returns(v:Expression Float):$ ==
+      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
 
-    doubleSymbol : Symbol := "double precision"::Symbol
-    upperDoubleSymbol : Symbol := "DOUBLE PRECISION"::Symbol
-    doubleComplexSymbol : Symbol := "double complex"::Symbol
-    upperDoubleComplexSymbol : Symbol := "DOUBLE COMPLEX"::Symbol
+    returns(v:Expression Complex Float):$ ==
+      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
 
-    u = v ==
-      u case RealThing and v case RealThing => true
-      u case IntegerThing and v case IntegerThing => true
-      u case ComplexThing and v case ComplexThing => true
-      u case LogicalThing and v case LogicalThing => true
-      u case CharacterThing and v case CharacterThing => true
-      u case DoublePrecisionThing and v case DoublePrecisionThing => true
-      u case DoubleComplexThing and v case DoubleComplexThing => true
-      false
+    block(l:List $):$ ==
+      [["block"]$OP,[l]$OPREC]$Rep
+      
+    cond(sw:Switch,thenC:$):$ ==
+      [["conditional"]$OP,
+       [[sw,thenC,[["null"]$OP,["null"]$OPREC]$Rep]$COND]$OPREC]$Rep
 
-    coerce(t:$):OutputForm ==
-      t case RealThing => coerce(REAL)$Symbol
-      t case IntegerThing => coerce(INTEGER)$Symbol
-      t case ComplexThing => coerce(COMPLEX)$Symbol
-      t case CharacterThing => coerce(CHARACTER)$Symbol
-      t case DoublePrecisionThing => coerce(upperDoubleSymbol)$Symbol
-      t case DoubleComplexThing => coerce(upperDoubleComplexSymbol)$Symbol
-      coerce(LOGICAL)$Symbol
+    cond(sw:Switch,thenC:$,elseC:$):$ ==
+      [["conditional"]$OP,[[sw,thenC,elseC]$COND]$OPREC]$Rep
 
-    coerce(t:$):SExpression ==
-      t case RealThing => convert(real::Symbol)@SExpression
-      t case IntegerThing => convert(integer::Symbol)@SExpression
-      t case ComplexThing => convert(complex::Symbol)@SExpression
-      t case CharacterThing => convert(character::Symbol)@SExpression
-      t case DoublePrecisionThing => convert(doubleSymbol)@SExpression
-      t case DoubleComplexThing => convert(doubleComplexSymbol)@SExpression
-      convert(logical::Symbol)@SExpression
+    coerce(f : $):O ==
+      (f.op)::O
 
-    coerce(t:$):Symbol ==
-      t case RealThing => real::Symbol
-      t case IntegerThing => integer::Symbol
-      t case ComplexThing => complex::Symbol
-      t case CharacterThing => character::Symbol
-      t case DoublePrecisionThing => doubleSymbol
-      t case DoublePrecisionThing => doubleComplexSymbol
-      logical::Symbol
+    assign(v:Symbol,rhs:String):$ ==
+      [["assignment"]$OP,_
+       [[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
 
-    coerce(s:Symbol):$ ==
-      s = real => ["real"]$Rep
-      s = REAL => ["real"]$Rep
-      s = integer => ["integer"]$Rep
-      s = INTEGER => ["integer"]$Rep
-      s = complex => ["complex"]$Rep
-      s = COMPLEX => ["complex"]$Rep
-      s = character => ["character"]$Rep
-      s = CHARACTER => ["character"]$Rep
-      s = logical => ["logical"]$Rep
-      s = LOGICAL => ["logical"]$Rep
-      s = doubleSymbol => ["double precision"]$Rep
-      s = upperDoubleSymbol => ["double precision"]$Rep
-      s = doubleComplexSymbol => ["double complex"]$Rep
-      s = upperDoubleCOmplexSymbol => ["double complex"]$Rep
+    assign(v:Symbol,rhs:Matrix MachineInteger):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
 
-    coerce(s:String):$ ==
-      s = "real" => ["real"]$Rep
-      s = "integer" => ["integer"]$Rep
-      s = "complex" => ["complex"]$Rep
-      s = "character" => ["character"]$Rep
-      s = "logical" => ["logical"]$Rep
-      s = "double precision" => ["double precision"]$Rep
-      s = "double complex" => ["double complex"]$Rep
-      s = "REAL" => ["real"]$Rep
-      s = "INTEGER" => ["integer"]$Rep
-      s = "COMPLEX" => ["complex"]$Rep
-      s = "CHARACTER" => ["character"]$Rep
-      s = "LOGICAL" => ["logical"]$Rep
-      s = "DOUBLE PRECISION" => ["double precision"]$Rep
-      s = "DOUBLE COMPLEX" => ["double complex"]$Rep
-      error concat([s," is invalid as a Fortran Type"])$String
+    assign(v:Symbol,rhs:Matrix MachineFloat):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
 
-    real?(t:$):Boolean == t case RealThing
+    assign(v:Symbol,rhs:Matrix MachineComplex):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
 
-    double?(t:$):Boolean == t case DoublePrecisionThing
+    assign(v:Symbol,rhs:Vector MachineInteger):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
 
-    logical?(t:$):Boolean == t case LogicalThing
+    assign(v:Symbol,rhs:Vector MachineFloat):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
 
-    integer?(t:$):Boolean == t case IntegerThing
+    assign(v:Symbol,rhs:Vector MachineComplex):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
 
-    character?(t:$):Boolean == t case CharacterThing
+    assign(v:Symbol,rhs:Matrix Expression MachineInteger):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
 
-    complex?(t:$):Boolean == t case ComplexThing
+    assign(v:Symbol,rhs:Matrix Expression MachineFloat):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
 
-    doubleComplex?(t:$):Boolean == t case DoubleComplexThing
+    assign(v:Symbol,rhs:Matrix Expression MachineComplex):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
 
-\end{chunk}
+    assign(v:Symbol,rhs:Vector Expression MachineInteger):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
 
-\begin{chunk}{COQ FST}
-(* domain FST *)
-(*
-*)
+    assign(v:Symbol,rhs:Vector Expression MachineFloat):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
 
-\end{chunk}
+    assign(v:Symbol,rhs:Vector Expression MachineComplex):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
 
-\begin{chunk}{FST.dotabb}
-"FST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FST"]
-"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
-"FST" -> "ALIST"
+    assign(v:Symbol,index:L PIN,rhs:Expression MachineInteger):$ ==
+      [["assignment"]$OP,[[v,index,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FTEM FortranTemplate}
+    assign(v:Symbol,index:L PIN,rhs:Expression MachineFloat):$ ==
+      [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
 
-\begin{chunk}{FortranTemplate.input}
-)set break resume
-)sys rm -f FortranTemplate.output
-)spool FortranTemplate.output
-)set message test on
-)set message auto off
-)clear all
+    assign(v:Symbol,index:L PIN,rhs:Expression MachineComplex):$ ==
+      [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
 
---S 1 of 1
-)show FortranTemplate
---R 
---R FortranTemplate  is a domain constructor
---R Abbreviation for FortranTemplate is FTEM 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FTEM 
---R
---R------------------------------- Operations --------------------------------
---R ?=? : (%,%) -> Boolean                close! : % -> %
---R coerce : % -> OutputForm              flush : % -> Void
---R fortranCarriageReturn : () -> Void    fortranLiteral : String -> Void
---R fortranLiteralLine : String -> Void   hash : % -> SingleInteger
---R iomode : % -> String                  latex : % -> String
---R name : % -> FileName                  open : (FileName,String) -> %
---R open : FileName -> %                  read! : % -> String
---R reopen! : (%,String) -> %             write! : (%,String) -> String
---R ?~=? : (%,%) -> Boolean              
---R processTemplate : FileName -> FileName
---R processTemplate : (FileName,FileName) -> FileName
---R
---E 1
+    assign(v:Symbol,rhs:Expression MachineInteger):$ ==
+      [["assignment"]$OP,_
+       [[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{FortranTemplate.help}
-====================================================================
-FortranTemplate examples
-====================================================================
+    assign(v:Symbol,rhs:Expression MachineFloat):$ ==
+      [["assignment"]$OP,_
+       [[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
 
-Code to manipulate Fortran templates
+    assign(v:Symbol,rhs:Expression MachineComplex):$ ==
+      [["assignment"]$OP,_
+       [[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
 
-See Also:
-o )show FortranTemplate
+    assign(v:Symbol,rhs:Matrix Expression Integer):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
 
-\end{chunk}
+    assign(v:Symbol,rhs:Matrix Expression Float):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
 
-\pagehead{FortranTemplate}{FTEM}
-\pagepic{ps/v103fortrantemplate.ps}{FTEM}{1.00}
-{\bf See}\\
-\pageto{Result}{RESULT}
-\pageto{FortranCode}{FC}
-\pageto{FortranProgram}{FORTRAN}
-\pageto{ThreeDimensionalMatrix}{M3D}
-\pageto{SimpleFortranProgram}{SFORT}
-\pageto{Switch}{SWITCH}
-\pageto{FortranExpression}{FEXPR}
+    assign(v:Symbol,rhs:Matrix Expression Complex Float):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
 
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{FTEM}{close!} &
-\cross{FTEM}{coerce} &
-\cross{FTEM}{fortranCarriageReturn} &
-\cross{FTEM}{fortranLiteral} &
-\cross{FTEM}{fortranLiteralLine} \\
-\cross{FTEM}{hash} &
-\cross{FTEM}{iomode} &
-\cross{FTEM}{latex} &
-\cross{FTEM}{name} &
-\cross{FTEM}{open} \\
-\cross{FTEM}{processTemplate} &
-\cross{FTEM}{read!} &
-\cross{FTEM}{reopen!} &
-\cross{FTEM}{write!} &
-\cross{FTEM}{?=?} \\
-\cross{FTEM}{?\~{}=?} &&&&
-\end{tabular}
+    assign(v:Symbol,rhs:Vector Expression Integer):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
 
-\begin{chunk}{domain FTEM FortranTemplate}
-)abbrev domain FTEM FortranTemplate
-++ Author: Mike Dewar
-++ Date Created:  October 1992
-++ Description:
-++ Code to manipulate Fortran templates
+    assign(v:Symbol,rhs:Vector Expression Float):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
 
-FortranTemplate() : specification == implementation where
+    assign(v:Symbol,rhs:Vector Expression Complex Float):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
 
-  specification == FileCategory(FileName, String) with
+    assign(v:Symbol,index:L PIN,rhs:Expression Integer):$ ==
+      [["assignment"]$OP,[[v,index,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
 
-    processTemplate : (FileName, FileName) -> FileName
-      ++ processTemplate(tp,fn) processes the template tp, writing the
-      ++ result out to fn.
-    processTemplate : (FileName) -> FileName
-      ++ processTemplate(tp) processes the template tp, writing the
-      ++ result to the current FORTRAN output stream.
-    fortranLiteralLine : String -> Void
-      ++ fortranLiteralLine(s) writes s to the current Fortran output stream,
-      ++ followed by a carriage return
-    fortranLiteral : String -> Void
-      ++ fortranLiteral(s) writes s to the current Fortran output stream
-    fortranCarriageReturn : () -> Void
-      ++ fortranCarriageReturn() produces a carriage return on the current
-      ++ Fortran output stream
+    assign(v:Symbol,index:L PIN,rhs:Expression Float):$ ==
+      [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
 
-  implementation == TextFile add
+    assign(v:Symbol,index:L PIN,rhs:Expression Complex Float):$ ==
+      [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
 
-    import TemplateUtilities
-    import FortranOutputStackPackage
+    assign(v:Symbol,rhs:Expression Integer):$ ==
+      [["assignment"]$OP,_
+       [[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
 
-    Rep := TextFile
+    assign(v:Symbol,rhs:Expression Float):$ ==
+      [["assignment"]$OP,_
+       [[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
 
-    fortranLiteralLine(s:String):Void ==
-      PRINC(s,_$fortranOutputStream$Lisp)$Lisp
-      TERPRI(_$fortranOutputStream$Lisp)$Lisp 
+    assign(v:Symbol,rhs:Expression Complex Float):$ ==
+      [["assignment"]$OP,_
+       [[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
 
-    fortranLiteral(s:String):Void ==
-      PRINC(s,_$fortranOutputStream$Lisp)$Lisp
+    call(s:String):$ ==
+      [["call"]$OP,[s]$OPREC]$Rep
 
-    fortranCarriageReturn():Void ==
-      TERPRI(_$fortranOutputStream$Lisp)$Lisp
+\end{chunk}
 
-    writePassiveLine!(line:String):Void ==
-    -- We might want to be a bit clever here and look for new SubPrograms etc.
-      fortranLiteralLine line
+\begin{chunk}{COQ FC}
+(* domain FC *)
+(*
+    import Void
+    import ASS
+    import COND
+    import RETURN
+    import L PIN
+    import O
+    import SEX
+    import FortranType
+    import TheSymbolTable
 
-    processTemplate(tp:FileName, fn:FileName):FileName == 
-      pushFortranOutputStack(fn)
-      processTemplate(tp)
-      popFortranOutputStack()
-      fn
+    Rep := Record(op: OP, data: OPREC)
 
-    getLine(fp:TextFile):String ==
-      line : String := stripCommentsAndBlanks readLine!(fp)
-      while not empty?(line) and elt(line,maxIndex line) = char "__" repeat
-        setelt(line,maxIndex line,char " ")
-        line := concat(line, stripCommentsAndBlanks readLine!(fp))$String
-      line
+    -- We need to be able to generate unique labels
+    labelValue:SingleInteger := 25000::SingleInteger
 
-    processTemplate(tp:FileName):FileName == 
-      fp : TextFile := open(tp,"input")
-      active : Boolean := true
-      line : String
-      endInput : Boolean := false
-      while not (endInput or endOfFile? fp) repeat
-        if active then
-          line := getLine fp
-          line = "endInput" => endInput := true
-          if line = "beginVerbatim" then
-            active := false
-          else
-            not empty? line => interpretString line
-        else
-          line := readLine!(fp)
-          if line = "endVerbatim" then
-            active := true
-          else
-            writePassiveLine! line
-      close!(fp)
-      if not active then 
-        error concat(["Missing `endVerbatim' line in ",tp::String])$String
-      string(_$fortranOutputFile$Lisp)::FileName
+    setLabelValue(u:SingleInteger):SingleInteger == labelValue := u
 
-\end{chunk}
+    newLabel():SingleInteger ==
+      labelValue := labelValue + 1$SingleInteger
+      labelValue
 
-\begin{chunk}{COQ FTEM}
-(* domain FTEM *)
-(*
-*)
+    commaSep(l:List String):List(String) ==
+      [(l.1),:[:[",",u] for u in rest(l)]]
 
-\end{chunk}
+    getReturn(rec:RETURN):SEX ==
+      returnToken : SEX := convert("RETURN"::Symbol::O)$SEX
+      elt(rec,empty?)$RETURN =>
+        getStatement(returnToken,NIL$Lisp)$Lisp
+      rt : EXPRESSION := elt(rec,value)$RETURN
+      rv : O := elt(rt,expr)$EXPRESSION
+      getStatement([returnToken,convert(rv)$SEX]$Lisp,
+                   elt(rt,ints2Floats?)$EXPRESSION )$Lisp
 
-\begin{chunk}{FTEM.dotabb}
-"FTEM" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FTEM"]
-"STRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=STRING"]
-"FTEM" -> "STRING"
+    getStop():SEX ==
+      fortran2Lines(LIST("STOP")$Lisp)$Lisp
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FT FortranType}
+    getSave():SEX ==
+      fortran2Lines(LIST("SAVE")$Lisp)$Lisp
 
-\begin{chunk}{FortranType.input}
-)set break resume
-)sys rm -f FortranType.output
-)spool FortranType.output
-)set message test on
-)set message auto off
-)clear all
+    getCommon(u:COMMON):SEX ==
+      fortran2Lines(APPEND(LIST("COMMON"," /",string (u.name),"/ ")$Lisp,_
+                    addCommas(u.contents)$Lisp)$Lisp)$Lisp
+ 
+    getPrint(l:PRINTLIST):SEX ==
+      ll : SEX := LIST("PRINT*")$Lisp
+      for i in l repeat 
+        ll := APPEND(ll,CONS(",",expression2Fortran(i)$Lisp)$Lisp)$Lisp
+      fortran2Lines(ll)$Lisp
 
---S 1 of 1
-)show FortranType
---R 
---R FortranType  is a domain constructor
---R Abbreviation for FortranType is FT 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FT 
---R
---R------------------------------- Operations --------------------------------
---R ?=? : (%,%) -> Boolean                coerce : FortranScalarType -> %
---R coerce : % -> OutputForm              external? : % -> Boolean
---R fortranCharacter : () -> %            fortranComplex : () -> %
---R fortranDouble : () -> %               fortranDoubleComplex : () -> %
---R fortranInteger : () -> %              fortranLogical : () -> %
---R fortranReal : () -> %                 hash : % -> SingleInteger
---R latex : % -> String                   ?~=? : (%,%) -> Boolean
---R construct : (Union(fst: FortranScalarType,void: void),List(Polynomial(Integer)),Boolean) -> %
---R construct : (Union(fst: FortranScalarType,void: void),List(Symbol),Boolean) -> %
---R dimensionsOf : % -> List(Polynomial(Integer))
---R scalarTypeOf : % -> Union(fst: FortranScalarType,void: void)
---R
---E 1
+    getBlock(rec:BLOCK):SEX ==
+      indentFortLevel(convert(1@Integer)$SEX)$Lisp
+      expr : SEX := LIST()$Lisp
+      for u in rec repeat
+        expr := APPEND(expr,getCode(u))$Lisp
+      indentFortLevel(convert(-1@Integer)$SEX)$Lisp
+      expr
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{FortranType.help}
-====================================================================
-FortranType examples
-====================================================================
+    getBody(f:$):SEX ==
+      operation(f) case Block => getCode f
+      indentFortLevel(convert(1@Integer)$SEX)$Lisp
+      expr := getCode f
+      indentFortLevel(convert(-1@Integer)$SEX)$Lisp
+      expr
 
-Creates and manipulates objects which correspond to FORTRAN data types, 
-including array dimensions.
+    getElseIf(f:$):SEX ==
+      rec := code f
+      expr :=
+       fortFormatElseIf(elt(rec.conditionalBranch,switch)$COND::O)$Lisp
+      expr := 
+       APPEND(expr,getBody elt(rec.conditionalBranch,thenClause)$COND)$Lisp
+      elseBranch := elt(rec.conditionalBranch,elseClause)$COND
+      not(operation(elseBranch) case Null) =>
+        operation(elseBranch) case Conditional => 
+          APPEND(expr,getElseIf elseBranch)$Lisp
+        expr := APPEND(expr, getStatement(ELSE::O,NIL$Lisp)$Lisp)$Lisp
+        expr := APPEND(expr, getBody elseBranch)$Lisp
+      expr
 
-See Also:
-o )show FortranType
+    getContinue(label:SingleInteger):SEX ==
+      lab : O := label::O
+      if (width(lab) > 6) then error "Label too big"
+      cnt : O := "CONTINUE"::O
+      --sp  : O := hspace(6-width lab)
+      sp  : O := hspace(_$fortIndent$Lisp -width lab)
+      LIST(STRCONC(PRINC_-TO_-STRING(lab)$Lisp,sp,cnt)$Lisp)$Lisp
 
-\end{chunk}
+    getGoto(label:SingleInteger):SEX ==
+     fortran2Lines(
+      LIST(STRCONC("GOTO ",PRINC_-TO_-STRING(label::O)$Lisp)$Lisp)$Lisp)$Lisp
 
-\pagehead{FortranType}{FT}
-\pagepic{ps/v103fortrantype.ps}{FT}{1.00}
-{\bf See}\\
-\pageto{FortranScalarType}{FST}
-\pageto{SymbolTable}{SYMTAB}
-\pageto{TheSymbolTable}{SYMS}
+    getRepeat(repRec:LOOP):SEX ==
+      sw : Switch := NOT elt(repRec,switch)$LOOP
+      lab := newLabel()
+      bod := elt(repRec,body)$LOOP
+      APPEND(getContinue lab,getBody bod,
+           fortFormatIfGoto(sw::O,lab)$Lisp)$Lisp
 
-{\bf Exports:}\\
-\begin{tabular}{llll}
-\cross{FT}{coerce} &
-\cross{FT}{construct} &
-\cross{FT}{dimensionsOf} &
-\cross{FT}{external?} \\
-\cross{FT}{fortranCharacter} &
-\cross{FT}{fortranComplex} &
-\cross{FT}{fortranDouble} &
-\cross{FT}{fortranDoubleComplex} \\
-\cross{FT}{fortranInteger} &
-\cross{FT}{fortranLogical} &
-\cross{FT}{fortranReal} &
-\cross{FT}{hash} \\
-\cross{FT}{latex} &
-\cross{FT}{scalarTypeOf} &
-\cross{FT}{?=?} &
-\cross{FT}{?\~{}=?} 
-\end{tabular}
+    getWhile(whileRec:LOOP):SEX ==
+      sw := NOT elt(whileRec,switch)$LOOP
+      lab1 := newLabel()
+      lab2 := newLabel()
+      bod := elt(whileRec,body)$LOOP
+      APPEND(fortFormatLabelledIfGoto(sw::O,lab1,lab2)$Lisp,
+           getBody bod, getBody goto(lab1), getContinue lab2)$Lisp
 
-\begin{chunk}{domain FT FortranType}
-)abbrev domain FT FortranType
-++ Author: Mike Dewar
-++ Date Created:  October 1992
-++ Description: 
-++ Creates and manipulates objects which correspond to FORTRAN
-++ data types, including array dimensions.
+    getArrayAssign(rec:ARRAYASS):SEX ==
+      getfortarrayexp((rec.var)::O,rec.rand,rec.ints2Floats?)$Lisp
 
-FortranType() : exports == implementation where
+    getAssign(rec:ASS):SEX ==
+      indices : L PIN := elt(rec,arrayIndex)$ASS
+      if indices = []::(L PIN) then
+        lhs := elt(rec,var)$ASS::O
+      else
+        lhs := cons(elt(rec,var)$ASS::PIN,indices)::O
+        -- Must get the index brackets correct:
+        lhs := (cdr car cdr convert(lhs)$SEX::SEX)::O -- Yuck!
+      elt(elt(rec,rand)$ASS,ints2Floats?)$EXPRESSION =>
+        assignment2Fortran1(lhs,elt(elt(rec,rand)$ASS,expr)$EXPRESSION)$Lisp
+      integerAssignment2Fortran1(lhs,_
+       elt(elt(rec,rand)$ASS,expr)$EXPRESSION)$Lisp
 
-  FST    ==> FortranScalarType
-  FSTU   ==> Union(fst:FST,void:"void")
+    getCond(rec:COND):SEX ==
+      expr := APPEND(fortFormatIf(elt(rec,switch)$COND::O)$Lisp,
+                     getBody elt(rec,thenClause)$COND)$Lisp
+      elseBranch := elt(rec,elseClause)$COND
+      if not(operation(elseBranch) case Null) then
+        operation(elseBranch) case Conditional =>
+          expr := APPEND(expr,getElseIf elseBranch)$Lisp
+        expr := APPEND(expr,getStatement(ELSE::O,NIL$Lisp)$Lisp,
+                       getBody elseBranch)$Lisp
+      APPEND(expr,getStatement(ENDIF::O,NIL$Lisp)$Lisp)$Lisp
 
-  exports == SetCategory with
-    coerce : $ -> OutputForm
-      ++ coerce(x) provides a printable form for x
-    coerce : FST -> $
-      ++ coerce(t) creates an element from a scalar type
-    scalarTypeOf : $ -> FSTU
-      ++ scalarTypeOf(t) returns the FORTRAN data type of t
-    dimensionsOf : $ -> List Polynomial Integer
-      ++ dimensionsOf(t) returns the dimensions of t
-    external? : $ -> Boolean
-      ++ external?(u) returns true if u is declared to be EXTERNAL
-    construct : (FSTU,List Symbol,Boolean) -> $
-      ++ construct(type,dims) creates an element of FortranType
-    construct : (FSTU,List Polynomial Integer,Boolean) -> $
-      ++ construct(type,dims) creates an element of FortranType
-    fortranReal : () -> $
-      ++ fortranReal() returns REAL, an element of FortranType
-    fortranDouble : () -> $
-      ++ fortranDouble() returns DOUBLE PRECISION, an element of FortranType
-    fortranInteger : () -> $
-      ++ fortranInteger() returns INTEGER, an element of FortranType
-    fortranLogical : () -> $
-      ++ fortranLogical() returns LOGICAL, an element of FortranType
-    fortranComplex : () -> $
-      ++ fortranComplex() returns COMPLEX, an element of FortranType
-    fortranDoubleComplex: () -> $
-      ++ fortranDoubleComplex() returns DOUBLE COMPLEX, an element of 
-      ++ FortranType
-    fortranCharacter : () -> $
-      ++ fortranCharacter() returns CHARACTER, an element of FortranType
+    getComment(rec:COMMENT):SEX ==
+      convert([convert(concat("C     ",c)$String)@SEX for c in rec])@SEX
 
-  implementation == add
+    getCall(rec:CALL):SEX ==
+      expr := concat("CALL ",rec)$String
+      #expr > 1320 => error "Fortran CALL too large"
+      fortran2Lines(convert([convert(expr)@SEX ])@SEX)$Lisp
 
-    Dims == List Polynomial Integer
-    Rep := Record(type : FSTU, dimensions : Dims, external : Boolean)
+    getFor(rec:FOR):SEX ==
+      rnge : SegmentBinding PIN := elt(rec,range)$FOR
+      increment : PIN := elt(rec,span)$FOR
+      lab : SingleInteger := newLabel()
+      declare!(variable rnge,fortranInteger())
+      expr := fortFormatDo(variable rnge, (lo segment rnge)::O,_
+        (hi segment rnge)::O,increment::O,lab)$Lisp
+      APPEND(expr, getBody elt(rec,body)$FOR, getContinue(lab))$Lisp
+ 
+    getCode(f:$):SEX ==
+      opp:OP := operation f
+      rec:OPREC:= code f
+      opp case Assignment => getAssign(rec.assignmentBranch)
+      opp case ArrayAssignment => getArrayAssign(rec.arrayAssignmentBranch)
+      opp case Conditional => getCond(rec.conditionalBranch)
+      opp case Return => getReturn(rec.returnBranch)
+      opp case Block => getBlock(rec.blockBranch)
+      opp case Comment => getComment(rec.commentBranch)
+      opp case Call => getCall(rec.callBranch)
+      opp case For => getFor(rec.forBranch)
+      opp case Continue => getContinue(rec.labelBranch)
+      opp case Goto => getGoto(rec.labelBranch)
+      opp case Repeat => getRepeat(rec.loopBranch)
+      opp case While => getWhile(rec.loopBranch)
+      opp case Save => getSave()
+      opp case Stop => getStop()
+      opp case Print => getPrint(rec.printBranch)
+      opp case Common => getCommon(rec.commonBranch)
+      error "Unsupported program construct."
+      convert(0)@SEX
 
-    coerce(a:$):OutputForm ==
-     t : OutputForm
-     if external?(a) then
-      if scalarTypeOf(a) case void then
-        t := "EXTERNAL"::OutputForm
-      else
-        t := blankSeparate(["EXTERNAL"::OutputForm,
-                           coerce(scalarTypeOf a)$FSTU])$OutputForm
-     else
-      t := coerce(scalarTypeOf a)$FSTU
-     empty? dimensionsOf(a) => t
-     sub(t,
-         paren([u::OutputForm for u in dimensionsOf(a)])$OutputForm)$OutputForm
+    printCode(f:$):Void ==
+      displayLines1$Lisp getCode f
+      void()$Void
 
-    scalarTypeOf(u:$):FSTU ==
-      u.type
+    code (f:$):OPREC ==
+      elt(f,data)$Rep
 
-    dimensionsOf(u:$):Dims ==
-      u.dimensions
+    operation (f:$):OP ==
+      elt(f,op)$Rep
 
-    external?(u:$):Boolean ==
-      u.external
+    common(name:Symbol,contents:List Symbol):$ ==
+      [["common"]$OP,[[name,contents]$COMMON]$OPREC]$Rep
 
-    construct(t:FSTU, d:List Symbol, e:Boolean):$ ==
-      e and not empty? d => error "EXTERNAL objects cannot have dimensions"
-      not(e) and t case void => error "VOID objects must be EXTERNAL"
-      construct(t,[l::Polynomial(Integer) for l in d],e)$Rep
+    stop():$ ==
+      [["stop"]$OP,["null"]$OPREC]$Rep
 
-    construct(t:FSTU, d:List Polynomial Integer, e:Boolean):$ ==
-      e and not empty? d => error "EXTERNAL objects cannot have dimensions"
-      not(e) and t case void => error "VOID objects must be EXTERNAL"
-      construct(t,d,e)$Rep
+    save():$ ==
+      [["save"]$OP,["null"]$OPREC]$Rep
 
-    coerce(u:FST):$ ==
-      construct([u]$FSTU,[]@List Polynomial Integer,false)
+    printStatement(l:List O):$ ==
+      [["print"]$OP,[l]$OPREC]$Rep
 
-    fortranReal():$ == ("real"::FST)::$
+    comment(s:List String):$ ==
+      [["comment"]$OP,[s]$OPREC]$Rep
 
-    fortranDouble():$ == ("double precision"::FST)::$
+    comment(s:String):$ ==
+      [["comment"]$OP,[list s]$OPREC]$Rep
 
-    fortranInteger():$ == ("integer"::FST)::$
+    forLoop(r:SegmentBinding PIN,body:$):$ ==
+      [["for"]$OP,[[r,(incr segment r)::PIN,body]$FOR]$OPREC]$Rep
 
-    fortranComplex():$ == ("complex"::FST)::$
+    forLoop(r:SegmentBinding PIN,increment:PIN,body:$):$ ==
+      [["for"]$OP,[[r,increment,body]$FOR]$OPREC]$Rep
 
-    fortranDoubleComplex():$ == ("double complex"::FST)::$
+    goto(l:SingleInteger):$ ==
+      [["goto"]$OP,[l]$OPREC]$Rep
 
-    fortranCharacter():$ == ("character"::FST)::$
+    continue(l:SingleInteger):$ ==
+      [["continue"]$OP,[l]$OPREC]$Rep
 
-    fortranLogical():$ == ("logical"::FST)::$
+    whileLoop(sw:Switch,b:$):$ ==
+      [["while"]$OP,[[sw,b]$LOOP]$OPREC]$Rep
 
-\end{chunk}
+    repeatUntilLoop(sw:Switch,b:$):$ ==
+      [["repeat"]$OP,[[sw,b]$LOOP]$OPREC]$Rep
 
-\begin{chunk}{COQ FT}
-(* domain FT *)
-(*
-*)
+    returns():$ ==
+      v := [false,0::O]$EXPRESSION
+      [["return"]$OP,[[true,v]$RETURN]$OPREC]$Rep
 
-\end{chunk}
+    returns(v:Expression MachineInteger):$ ==
+      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
 
-\begin{chunk}{FT.dotabb}
-"FT" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FT"]
-"PID" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PID"]
-"OAGROUP" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAGROUP"]
-"FT" -> "PID"
-"FT" -> "OAGROUP"
+    returns(v:Expression MachineFloat):$ ==
+      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FCOMP FourierComponent}
+    returns(v:Expression MachineComplex):$ ==
+      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
 
-\begin{chunk}{FourierComponent.input}
-)set break resume
-)sys rm -f FourierComponent.output
-)spool FourierComponent.output
-)set message test on
-)set message auto off
-)clear all
+    returns(v:Expression Integer):$ ==
+      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
 
---S 1 of 1
-)show FourierComponent
---R 
---R FourierComponent(E: OrderedSet)  is a domain constructor
---R Abbreviation for FourierComponent is FCOMP 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FCOMP 
---R
---R------------------------------- Operations --------------------------------
---R ?<? : (%,%) -> Boolean                ?<=? : (%,%) -> Boolean
---R ?=? : (%,%) -> Boolean                ?>? : (%,%) -> Boolean
---R ?>=? : (%,%) -> Boolean               argument : % -> E
---R coerce : % -> OutputForm              cos : E -> %
---R hash : % -> SingleInteger             latex : % -> String
---R max : (%,%) -> %                      min : (%,%) -> %
---R sin : E -> %                          sin? : % -> Boolean
---R ?~=? : (%,%) -> Boolean              
---R
---E 1
+    returns(v:Expression Float):$ ==
+      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{FourierComponent.help}
-====================================================================
-FourierComponent examples
-====================================================================
+    returns(v:Expression Complex Float):$ ==
+      [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep
 
-This domain creates kernels for use in Fourier series
+    block(l:List $):$ ==
+      [["block"]$OP,[l]$OPREC]$Rep
+      
+    cond(sw:Switch,thenC:$):$ ==
+      [["conditional"]$OP,
+       [[sw,thenC,[["null"]$OP,["null"]$OPREC]$Rep]$COND]$OPREC]$Rep
 
-See Also:
-o )show FourierComponent
+    cond(sw:Switch,thenC:$,elseC:$):$ ==
+      [["conditional"]$OP,[[sw,thenC,elseC]$COND]$OPREC]$Rep
 
-\end{chunk}
+    coerce(f : $):O ==
+      (f.op)::O
 
-\pagehead{FourierComponent}{FCOMP}
-\pagepic{ps/v103fouriercomponent.ps}{FCOMP}{1.00}
-{\bf See}\\
-\pageto{FourierSeries}{FSERIES}
+    assign(v:Symbol,rhs:String):$ ==
+      [["assignment"]$OP,_
+       [[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
 
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{FCOMP}{argument} &
-\cross{FCOMP}{coerce} &
-\cross{FCOMP}{cos} &
-\cross{FCOMP}{hash} &
-\cross{FCOMP}{latex} \\
-\cross{FCOMP}{max} &
-\cross{FCOMP}{min} &
-\cross{FCOMP}{sin} &
-\cross{FCOMP}{sin?} &
-\cross{FCOMP}{?\~{}=?} \\
-\cross{FCOMP}{?$<$?} &
-\cross{FCOMP}{?$<=$?} &
-\cross{FCOMP}{?=?} &
-\cross{FCOMP}{?$>$?} &
-\cross{FCOMP}{?$>=$?} 
-\end{tabular}
+    assign(v:Symbol,rhs:Matrix MachineInteger):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
 
-\begin{chunk}{domain FCOMP FourierComponent}
-)abbrev domain FCOMP FourierComponent
-++ Author: James Davenport
-++ Date Created: 17 April 1992
-++ Date Last Updated: 12 June 1992
-++ Description: 
-++ This domain creates kernels for use in Fourier series
+    assign(v:Symbol,rhs:Matrix MachineFloat):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
 
-FourierComponent(E:OrderedSet):
-       OrderedSet with
-         sin: E -> $
-         ++ sin(x) makes a sin kernel for use in Fourier series
-         cos: E -> $
-         ++ cos(x) makes a cos kernel for use in Fourier series
-         sin?: $ -> Boolean
-         ++ sin?(x) returns true if term is a sin, otherwise false
-         argument: $ -> E
-         ++ argument(x) returns the argument of a given sin/cos expressions
-    ==
-  add
-   --representations
-   Rep:=Record(SinIfTrue:Boolean, arg:E)
-   e:E
-   x,y:$
-   sin e == [true,e]
-   cos e == [false,e]
-   sin? x == x.SinIfTrue
-   argument x == x.arg
-   coerce(x):OutputForm ==
-     hconcat((if x.SinIfTrue then "sin" else "cos")::OutputForm,
-              bracket((x.arg)::OutputForm))
-   x<y ==
-     x.arg < y.arg => true
-     y.arg < x.arg => false
-     x.SinIfTrue => false
-     y.SinIfTrue
+    assign(v:Symbol,rhs:Matrix MachineComplex):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
 
-\end{chunk}
+    assign(v:Symbol,rhs:Vector MachineInteger):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Vector MachineFloat):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Vector MachineComplex):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Matrix Expression MachineInteger):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Matrix Expression MachineFloat):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Matrix Expression MachineComplex):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Vector Expression MachineInteger):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Vector Expression MachineFloat):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Vector Expression MachineComplex):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+
+    assign(v:Symbol,index:L PIN,rhs:Expression MachineInteger):$ ==
+      [["assignment"]$OP,[[v,index,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+
+    assign(v:Symbol,index:L PIN,rhs:Expression MachineFloat):$ ==
+      [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+
+    assign(v:Symbol,index:L PIN,rhs:Expression MachineComplex):$ ==
+      [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Expression MachineInteger):$ ==
+      [["assignment"]$OP,_
+       [[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Expression MachineFloat):$ ==
+      [["assignment"]$OP,_
+       [[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Expression MachineComplex):$ ==
+      [["assignment"]$OP,_
+       [[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Matrix Expression Integer):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Matrix Expression Float):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Matrix Expression Complex Float):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Vector Expression Integer):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Vector Expression Float):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Vector Expression Complex Float):$ ==
+      [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep
+
+    assign(v:Symbol,index:L PIN,rhs:Expression Integer):$ ==
+      [["assignment"]$OP,[[v,index,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+
+    assign(v:Symbol,index:L PIN,rhs:Expression Float):$ ==
+      [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+
+    assign(v:Symbol,index:L PIN,rhs:Expression Complex Float):$ ==
+      [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Expression Integer):$ ==
+      [["assignment"]$OP,_
+       [[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Expression Float):$ ==
+      [["assignment"]$OP,_
+       [[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+
+    assign(v:Symbol,rhs:Expression Complex Float):$ ==
+      [["assignment"]$OP,_
+       [[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep
+
+    call(s:String):$ ==
+      [["call"]$OP,[s]$OPREC]$Rep
 
-\begin{chunk}{COQ FCOMP}
-(* domain FCOMP *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{FCOMP.dotabb}
-"FCOMP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FCOMP"]
-"ORDSET" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ORDSET"]
-"FCOMP" -> "ORDSET"
+\begin{chunk}{FC.dotabb}
+"FC" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FC"]
+"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
+"COMPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=COMPCAT"]
+"FC" -> "COMPCAT"
+"FC" -> "FS"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FSERIES FourierSeries}
+\section{domain FEXPR FortranExpression}
 
-\begin{chunk}{FourierSeries.input}
+\begin{chunk}{FortranExpression.input}
 )set break resume
-)sys rm -f FourierSeries.output
-)spool FourierSeries.output
+)sys rm -f FortranExpression.output
+)spool FortranExpression.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show FourierSeries
+)show FortranExpression
 --R 
---R FourierSeries(R: Join(CommutativeRing,Algebra(Fraction(Integer))),E: Join(OrderedSet,AbelianGroup))  is a domain constructor
---R Abbreviation for FourierSeries is FSERIES 
+--R FortranExpression(basicSymbols: List(Symbol),subscriptedSymbols: List(Symbol),R: FortranMachineTypeCategory)  is a domain constructor
+--R Abbreviation for FortranExpression is FEXPR 
 --R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FSERIES 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FEXPR 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (R,%) -> %                      ?*? : (%,R) -> %
---R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
---R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
---R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
---R -? : % -> %                           ?=? : (%,%) -> Boolean
+--R ?*? : (PositiveInteger,%) -> %        ?*? : (NonNegativeInteger,%) -> %
+--R ?*? : (Integer,%) -> %                ?*? : (%,%) -> %
+--R ?*? : (%,R) -> %                      ?*? : (R,%) -> %
+--R ?**? : (%,PositiveInteger) -> %       ?**? : (%,NonNegativeInteger) -> %
+--R ?+? : (%,%) -> %                      -? : % -> %
+--R ?-? : (%,%) -> %                      ?<? : (%,%) -> Boolean
+--R ?<=? : (%,%) -> Boolean               ?=? : (%,%) -> Boolean
+--R ?>? : (%,%) -> Boolean                ?>=? : (%,%) -> Boolean
+--R D : (%,Symbol) -> %                   D : (%,List(Symbol)) -> %
 --R 1 : () -> %                           0 : () -> %
---R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
---R coerce : FourierComponent(E) -> %     coerce : R -> %
---R coerce : Integer -> %                 coerce : % -> OutputForm
---R hash : % -> SingleInteger             latex : % -> String
---R makeCos : (E,R) -> %                  makeSin : (E,R) -> %
---R one? : % -> Boolean                   recip : % -> Union(%,"failed")
---R sample : () -> %                      zero? : % -> Boolean
---R ?~=? : (%,%) -> Boolean              
+--R ?^? : (%,PositiveInteger) -> %        ?^? : (%,NonNegativeInteger) -> %
+--R abs : % -> %                          acos : % -> %
+--R asin : % -> %                         atan : % -> %
+--R belong? : BasicOperator -> Boolean    box : List(%) -> %
+--R box : % -> %                          coerce : % -> Expression(R)
+--R coerce : Integer -> %                 coerce : R -> %
+--R coerce : Kernel(%) -> %               coerce : % -> OutputForm
+--R cos : % -> %                          cosh : % -> %
+--R differentiate : (%,Symbol) -> %       distribute : (%,%) -> %
+--R distribute : % -> %                   elt : (BasicOperator,List(%)) -> %
+--R elt : (BasicOperator,%,%,%) -> %      elt : (BasicOperator,%,%) -> %
+--R elt : (BasicOperator,%) -> %          eval : (%,Symbol,(% -> %)) -> %
+--R eval : (%,List(%),List(%)) -> %       eval : (%,%,%) -> %
+--R eval : (%,Equation(%)) -> %           eval : (%,List(Equation(%))) -> %
+--R eval : (%,Kernel(%),%) -> %           exp : % -> %
+--R freeOf? : (%,Symbol) -> Boolean       freeOf? : (%,%) -> Boolean
+--R hash : % -> SingleInteger             height : % -> NonNegativeInteger
+--R is? : (%,Symbol) -> Boolean           is? : (%,BasicOperator) -> Boolean
+--R kernel : (BasicOperator,%) -> %       kernels : % -> List(Kernel(%))
+--R latex : % -> String                   log : % -> %
+--R log10 : % -> %                        map : ((% -> %),Kernel(%)) -> %
+--R max : (%,%) -> %                      min : (%,%) -> %
+--R one? : % -> Boolean                   paren : List(%) -> %
+--R paren : % -> %                        pi : () -> %
+--R recip : % -> Union(%,"failed")        retract : Symbol -> %
+--R retract : Expression(R) -> %          retract : % -> R
+--R retract : % -> Kernel(%)              sample : () -> %
+--R sin : % -> %                          sinh : % -> %
+--R sqrt : % -> %                         subst : (%,Equation(%)) -> %
+--R tan : % -> %                          tanh : % -> %
+--R tower : % -> List(Kernel(%))          useNagFunctions : Boolean -> Boolean
+--R useNagFunctions : () -> Boolean       variables : % -> List(Symbol)
+--R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
+--R D : (%,Symbol,NonNegativeInteger) -> %
+--R D : (%,List(Symbol),List(NonNegativeInteger)) -> %
 --R characteristic : () -> NonNegativeInteger
+--R definingPolynomial : % -> % if $ has RING
+--R differentiate : (%,List(Symbol)) -> %
+--R differentiate : (%,Symbol,NonNegativeInteger) -> %
+--R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> %
+--R elt : (BasicOperator,%,%,%,%) -> %
+--R eval : (%,BasicOperator,(% -> %)) -> %
+--R eval : (%,BasicOperator,(List(%) -> %)) -> %
+--R eval : (%,List(BasicOperator),List((List(%) -> %))) -> %
+--R eval : (%,List(BasicOperator),List((% -> %))) -> %
+--R eval : (%,Symbol,(List(%) -> %)) -> %
+--R eval : (%,List(Symbol),List((List(%) -> %))) -> %
+--R eval : (%,List(Symbol),List((% -> %))) -> %
+--R eval : (%,List(Kernel(%)),List(%)) -> %
+--R even? : % -> Boolean if $ has RETRACT(INT)
+--R kernel : (BasicOperator,List(%)) -> %
+--R mainKernel : % -> Union(Kernel(%),"failed")
+--R minPoly : Kernel(%) -> SparseUnivariatePolynomial(%) if $ has RING
+--R odd? : % -> Boolean if $ has RETRACT(INT)
+--R operator : BasicOperator -> BasicOperator
+--R operators : % -> List(BasicOperator)
+--R retract : Polynomial(Float) -> % if R has RETRACT(FLOAT)
+--R retract : Fraction(Polynomial(Float)) -> % if R has RETRACT(FLOAT)
+--R retract : Expression(Float) -> % if R has RETRACT(FLOAT)
+--R retract : Polynomial(Integer) -> % if R has RETRACT(INT)
+--R retract : Fraction(Polynomial(Integer)) -> % if R has RETRACT(INT)
+--R retract : Expression(Integer) -> % if R has RETRACT(INT)
+--R retractIfCan : Polynomial(Float) -> Union(%,"failed") if R has RETRACT(FLOAT)
+--R retractIfCan : Fraction(Polynomial(Float)) -> Union(%,"failed") if R has RETRACT(FLOAT)
+--R retractIfCan : Expression(Float) -> Union(%,"failed") if R has RETRACT(FLOAT)
+--R retractIfCan : Polynomial(Integer) -> Union(%,"failed") if R has RETRACT(INT)
+--R retractIfCan : Fraction(Polynomial(Integer)) -> Union(%,"failed") if R has RETRACT(INT)
+--R retractIfCan : Expression(Integer) -> Union(%,"failed") if R has RETRACT(INT)
+--R retractIfCan : Symbol -> Union(%,"failed")
+--R retractIfCan : Expression(R) -> Union(%,"failed")
+--R retractIfCan : % -> Union(R,"failed")
+--R retractIfCan : % -> Union(Kernel(%),"failed")
+--R subst : (%,List(Kernel(%)),List(%)) -> %
+--R subst : (%,List(Equation(%))) -> %
 --R subtractIfCan : (%,%) -> Union(%,"failed")
 --R
 --E 1
@@ -62867,2561 +70673,2084 @@ FourierComponent(E:OrderedSet):
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{FourierSeries.help}
+\begin{chunk}{FortranExpression.help}
 ====================================================================
-FourierSeries examples
+FortranExpression examples
 ====================================================================
 
-This domain converts terms into Fourier series
+A domain of expressions involving functions which can be translated into 
+standard Fortran-77, with some extra extensions from the NAG Fortran Library.  
 
 See Also:
-o )show FourierSeries
+o )show FortranExpression
 
 \end{chunk}
 
-\pagehead{FourierSeries}{FSERIES}
-\pagepic{ps/v103fourierseries.ps}{FSERIES}{1.00}
+\pagehead{FortranExpression}{FEXPR}
+\pagepic{ps/v103fortranexpression.ps}{FEXPR}{1.00}
 {\bf See}\\
-\pageto{FourierComponent}{FCOMP}
+\pageto{Result}{RESULT}
+\pageto{FortranCode}{FC}
+\pageto{FortranProgram}{FORTRAN}
+\pageto{ThreeDimensionalMatrix}{M3D}
+\pageto{SimpleFortranProgram}{SFORT}
+\pageto{Switch}{SWITCH}
+\pageto{FortranTemplate}{FTEM}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{FSERIES}{0} &
-\cross{FSERIES}{1} &
-\cross{FSERIES}{characteristic} &
-\cross{FSERIES}{coerce} &
-\cross{FSERIES}{hash} \\
-\cross{FSERIES}{latex} &
-\cross{FSERIES}{makeCos} &
-\cross{FSERIES}{makeSin} &
-\cross{FSERIES}{one?} &
-\cross{FSERIES}{recip} \\
-\cross{FSERIES}{sample} &
-\cross{FSERIES}{subtractIfCan} &
-\cross{FSERIES}{zero?} &
-\cross{FSERIES}{?\~{}=?} &
-\cross{FSERIES}{?*?} \\
-\cross{FSERIES}{?**?} &
-\cross{FSERIES}{?\^{}?} &
-\cross{FSERIES}{?+?} &
-\cross{FSERIES}{?-?} &
-\cross{FSERIES}{-?} \\
-\cross{FSERIES}{?=?} &&&&
+\cross{FEXPR}{0} &
+\cross{FEXPR}{1} &
+\cross{FEXPR}{abs} &
+\cross{FEXPR}{acos} &
+\cross{FEXPR}{asin} \\
+\cross{FEXPR}{atan} &
+\cross{FEXPR}{belong?} &
+\cross{FEXPR}{box} &
+\cross{FEXPR}{characteristic} &
+\cross{FEXPR}{coerce} \\
+\cross{FEXPR}{cos} &
+\cross{FEXPR}{cosh} &
+\cross{FEXPR}{D} &
+\cross{FEXPR}{definingPolynomial} &
+\cross{FEXPR}{differentiate} \\
+\cross{FEXPR}{distribute} &
+\cross{FEXPR}{elt} &
+\cross{FEXPR}{eval} &
+\cross{FEXPR}{even?} &
+\cross{FEXPR}{exp} \\
+\cross{FEXPR}{freeOf?} &
+\cross{FEXPR}{hash} &
+\cross{FEXPR}{height} &
+\cross{FEXPR}{is?} &
+\cross{FEXPR}{kernel} \\
+\cross{FEXPR}{kernels} &
+\cross{FEXPR}{latex} &
+\cross{FEXPR}{log} &
+\cross{FEXPR}{log10} &
+\cross{FEXPR}{mainKernel} \\
+\cross{FEXPR}{map} &
+\cross{FEXPR}{max} &
+\cross{FEXPR}{min} &
+\cross{FEXPR}{minPoly} &
+\cross{FEXPR}{odd?} \\
+\cross{FEXPR}{one?} &
+\cross{FEXPR}{operator} &
+\cross{FEXPR}{operators} &
+\cross{FEXPR}{paren} &
+\cross{FEXPR}{pi} \\
+\cross{FEXPR}{recip} &
+\cross{FEXPR}{retract} &
+\cross{FEXPR}{retractIfCan} &
+\cross{FEXPR}{sample} &
+\cross{FEXPR}{sin} \\
+\cross{FEXPR}{sinh} &
+\cross{FEXPR}{sqrt} &
+\cross{FEXPR}{subst} &
+\cross{FEXPR}{subtractIfCan} &
+\cross{FEXPR}{tan} \\
+\cross{FEXPR}{tanh} &
+\cross{FEXPR}{tower} &
+\cross{FEXPR}{useNagFunctions} &
+\cross{FEXPR}{variables} &
+\cross{FEXPR}{zero?} \\
+\cross{FEXPR}{?*?} &
+\cross{FEXPR}{?**?} &
+\cross{FEXPR}{?+?} &
+\cross{FEXPR}{-?} &
+\cross{FEXPR}{?-?} \\
+\cross{FEXPR}{?$<$?} &
+\cross{FEXPR}{?$<=$?} &
+\cross{FEXPR}{?=?} &
+\cross{FEXPR}{?$>$?} &
+\cross{FEXPR}{?$>=$?} \\
+\cross{FEXPR}{?\^{}?} &
+\cross{FEXPR}{?\~{}=?} &&&
 \end{tabular}
 
-\begin{chunk}{domain FSERIES FourierSeries}
-)abbrev domain FSERIES FourierSeries
-++ Author: James Davenport
-++ Date Created: 17 April 1992
-++ Description:
-++ This domain converts terms into Fourier series
-
-FourierSeries(R:Join(CommutativeRing,Algebra(Fraction Integer)),
-              E:Join(OrderedSet,AbelianGroup)):
-       Algebra(R) with
-         if E has canonical and R has canonical then canonical
-         coerce: R -> $
-           ++ coerce(r) converts coefficients into Fourier Series
-         coerce: FourierComponent(E) -> $
-           ++ coerce(c) converts sin/cos terms into Fourier Series
-         makeSin: (E,R) -> $
-           ++ makeSin(e,r) makes a sin expression with given 
-           ++ argument and coefficient
-         makeCos: (E,R) -> $
-           ++ makeCos(e,r) makes a sin expression with given 
-           ++argument and coefficient
-    == FreeModule(R,FourierComponent(E))
-  add
-   --representations
-   Term := Record(k:FourierComponent(E),c:R)
-   Rep  := List Term
-   multiply : (Term,Term) -> $
-   w,x1,x2:$
-   t1,t2:Term
-   n:NonNegativeInteger
-   z:Integer
-   e:FourierComponent(E)
-   a:E
-   r:R
-   1 == [[cos 0,1]]
-   coerce e ==
-      sin? e and zero? argument e => 0
-      if argument e < 0  then
-           not sin? e => e:=cos(- argument e)
-           return [[sin(- argument e),-1]]
-      [[e,1]]
-   multiply(t1,t2) ==
-     r:=(t1.c*t2.c)*(1/2)
-     s1:=argument t1.k
-     s2:=argument t2.k
-     sum:=s1+s2
-     diff:=s1-s2
-     sin? t1.k =>
-       sin? t2.k =>
-         makeCos(diff,r) + makeCos(sum,-r)
-       makeSin(sum,r) + makeSin(diff,r)
-     sin? t2.k =>
-       makeSin(sum,r) + makeSin(diff,r)
-     makeCos(diff,r) + makeCos(sum,r)
-   x1*x2 ==
-     null x1 => 0
-     null x2 => 0
-     +/[+/[multiply(t1,t2) for t2 in x2] for t1 in x1]
-   makeCos(a,r) ==
-      a<0 => [[cos(-a),r]]
-      [[cos a,r]]
-   makeSin(a,r) ==
-      zero? a => []
-      a<0 => [[sin(-a),-r]]
-      [[sin a,r]]
-
-\end{chunk}
-
-\begin{chunk}{COQ FSERIES}
-(* domain FSERIES *)
-(*
-*)
-
-\end{chunk}
-
-\begin{chunk}{FSERIES.dotabb}
-"FSERIES" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FSERIES"]
-"PID" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PID"]
-"OAGROUP" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAGROUP"]
-"FSERIES" -> "PID"
-"FSERIES" -> "OAGROUP"
-
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FRAC Fraction}
+\begin{chunk}{domain FEXPR FortranExpression}
+)abbrev domain FEXPR FortranExpression
+++ Author: Mike Dewar
+++ Date Created:  December 1993
+++ Date Last Updated: 12 July 1994 added RetractableTo(R)
+++ Description: 
+++ A domain of expressions involving functions which can be
+++ translated into standard Fortran-77, with some extra extensions from
+++ the NAG Fortran Library.  
 
-\begin{chunk}{Fraction.input}
-)set break resume
-)sys rm -f Fraction.output
-)spool Fraction.output
-)set message test on
-)set message auto off
-)clear all
+FortranExpression(basicSymbols,subscriptedSymbols,R):
+                                Exports==Implementation where
+  basicSymbols : List Symbol
+  subscriptedSymbols : List Symbol
+  R : FortranMachineTypeCategory
 
---S 1 of 13
-a := 11/12
---R 
---R
---R        11
---R   (1)  --
---R        12
---R                                                      Type: Fraction(Integer)
---E 1
+  EXPR ==> Expression
+  EXF2 ==> ExpressionFunctions2
+  S    ==> Symbol
+  L    ==> List
+  BO   ==> BasicOperator
+  FRAC ==> Fraction
+  POLY ==> Polynomial
 
---S 2 of 13
-b := 23/24
---R 
---R
---R        23
---R   (2)  --
---R        24
---R                                                      Type: Fraction(Integer)
---E 2
+  Exports ==> Join(ExpressionSpace,Algebra(R),RetractableTo(R),
+                   PartialDifferentialRing(Symbol)) with
+    retract : EXPR R -> $
+      ++ retract(e) takes e and transforms it into a 
+      ++ FortranExpression checking that it contains no non-Fortran
+      ++ functions, and that it only contains the given basic symbols
+      ++ and subscripted symbols which correspond to scalar and array
+      ++ parameters respectively.
+    retractIfCan : EXPR R -> Union($,"failed")
+      ++ retractIfCan(e) takes e and tries to transform it into a 
+      ++ FortranExpression checking that it contains no non-Fortran
+      ++ functions, and that it only contains the given basic symbols
+      ++ and subscripted symbols which correspond to scalar and array
+      ++ parameters respectively.
+    retract : S -> $
+      ++ retract(e) takes e and transforms it into a FortranExpression
+      ++ checking that it is one of the given basic symbols
+      ++ or subscripted symbols which correspond to scalar and array
+      ++ parameters respectively.
+    retractIfCan : S -> Union($,"failed")
+      ++ retractIfCan(e) takes e and tries to transform it into a 
+      ++ FortranExpression checking that it is one of the given basic symbols
+      ++ or subscripted symbols which correspond to scalar and array
+      ++ parameters respectively.
+    coerce : $ -> EXPR R
+      ++ coerce(x) is not documented
+    if (R has RetractableTo(Integer)) then
+      retract : EXPR Integer -> $
+        ++ retract(e) takes e and transforms it into a 
+        ++ FortranExpression checking that it contains no non-Fortran
+        ++ functions, and that it only contains the given basic symbols
+        ++ and subscripted symbols which correspond to scalar and array
+        ++ parameters respectively.
+      retractIfCan : EXPR Integer -> Union($,"failed")
+        ++ retractIfCan(e) takes e and tries to transform it into a 
+        ++ FortranExpression checking that it contains no non-Fortran
+        ++ functions, and that it only contains the given basic symbols
+        ++ and subscripted symbols which correspond to scalar and array
+        ++ parameters respectively.
+      retract : FRAC POLY  Integer -> $
+        ++ retract(e) takes e and transforms it into a 
+        ++ FortranExpression checking that it contains no non-Fortran
+        ++ functions, and that it only contains the given basic symbols
+        ++ and subscripted symbols which correspond to scalar and array
+        ++ parameters respectively.
+      retractIfCan : FRAC POLY  Integer -> Union($,"failed")
+        ++ retractIfCan(e) takes e and tries to transform it into a 
+        ++ FortranExpression checking that it contains no non-Fortran
+        ++ functions, and that it only contains the given basic symbols
+        ++ and subscripted symbols which correspond to scalar and array
+        ++ parameters respectively.
+      retract : POLY  Integer -> $
+        ++ retract(e) takes e and transforms it into a 
+        ++ FortranExpression checking that it contains no non-Fortran
+        ++ functions, and that it only contains the given basic symbols
+        ++ and subscripted symbols which correspond to scalar and array
+        ++ parameters respectively.
+      retractIfCan : POLY  Integer -> Union($,"failed")
+        ++ retractIfCan(e) takes e and tries to transform it into a 
+        ++ FortranExpression checking that it contains no non-Fortran
+        ++ functions, and that it only contains the given basic symbols
+        ++ and subscripted symbols which correspond to scalar and array
+        ++ parameters respectively.
+    if (R has RetractableTo(Float)) then
+      retract : EXPR Float -> $
+        ++ retract(e) takes e and transforms it into a 
+        ++ FortranExpression checking that it contains no non-Fortran
+        ++ functions, and that it only contains the given basic symbols
+        ++ and subscripted symbols which correspond to scalar and array
+        ++ parameters respectively.
+      retractIfCan : EXPR Float -> Union($,"failed")
+        ++ retractIfCan(e) takes e and tries to transform it into a 
+        ++ FortranExpression checking that it contains no non-Fortran
+        ++ functions, and that it only contains the given basic symbols
+        ++ and subscripted symbols which correspond to scalar and array
+        ++ parameters respectively.
+      retract : FRAC POLY  Float -> $
+        ++ retract(e) takes e and transforms it into a 
+        ++ FortranExpression checking that it contains no non-Fortran
+        ++ functions, and that it only contains the given basic symbols
+        ++ and subscripted symbols which correspond to scalar and array
+        ++ parameters respectively.
+      retractIfCan : FRAC POLY  Float -> Union($,"failed")
+        ++ retractIfCan(e) takes e and tries to transform it into a 
+        ++ FortranExpression checking that it contains no non-Fortran
+        ++ functions, and that it only contains the given basic symbols
+        ++ and subscripted symbols which correspond to scalar and array
+        ++ parameters respectively.
+      retract : POLY  Float -> $
+        ++ retract(e) takes e and transforms it into a 
+        ++ FortranExpression checking that it contains no non-Fortran
+        ++ functions, and that it only contains the given basic symbols
+        ++ and subscripted symbols which correspond to scalar and array
+        ++ parameters respectively.
+      retractIfCan : POLY  Float -> Union($,"failed")
+        ++ retractIfCan(e) takes e and tries to transform it into a 
+        ++ FortranExpression checking that it contains no non-Fortran
+        ++ functions, and that it only contains the given basic symbols
+        ++ and subscripted symbols which correspond to scalar and array
+        ++ parameters respectively.
+    abs    : $ -> $
+      ++ abs(x) represents the Fortran intrinsic function ABS
+    sqrt   : $ -> $
+      ++ sqrt(x) represents the Fortran intrinsic function SQRT
+    exp    : $ -> $
+      ++ exp(x) represents the Fortran intrinsic function EXP
+    log    : $ -> $
+      ++ log(x) represents the Fortran intrinsic function LOG
+    log10  : $ -> $
+      ++ log10(x) represents the Fortran intrinsic function LOG10
+    sin    : $ -> $
+      ++ sin(x) represents the Fortran intrinsic function SIN
+    cos    : $ -> $
+      ++ cos(x) represents the Fortran intrinsic function COS
+    tan    : $ -> $
+      ++ tan(x) represents the Fortran intrinsic function TAN
+    asin   : $ -> $
+      ++ asin(x) represents the Fortran intrinsic function ASIN
+    acos   : $ -> $
+      ++ acos(x) represents the Fortran intrinsic function ACOS
+    atan   : $ -> $
+      ++ atan(x) represents the Fortran intrinsic function ATAN
+    sinh   : $ -> $
+      ++ sinh(x) represents the Fortran intrinsic function SINH
+    cosh   : $ -> $
+      ++ cosh(x) represents the Fortran intrinsic function COSH
+    tanh   : $ -> $
+      ++ tanh(x) represents the Fortran intrinsic function TANH
+    pi     : () -> $
+      ++ pi(x) represents the NAG Library function X01AAF which returns 
+      ++  an approximation to the value of pi
+    variables : $ -> L S
+      ++ variables(e) return a list of all the variables in \spad{e}.
+    useNagFunctions : () -> Boolean
+      ++ useNagFunctions() indicates whether NAG functions are being used
+      ++  for mathematical and machine constants.
+    useNagFunctions : Boolean -> Boolean
+      ++ useNagFunctions(v) sets the flag which controls whether NAG functions 
+      ++  are being used for mathematical and machine constants.  The previous
+      ++  value is returned.
 
---S 3 of 13
-3 - a*b**2 + a + b/a
---R 
---R
---R        313271
---R   (3)  ------
---R         76032
---R                                                      Type: Fraction(Integer)
---E 3
+  Implementation ==> EXPR R add
 
---S 4 of 13
-numer(a)
---R 
---R
---R   (4)  11
---R                                                        Type: PositiveInteger
---E 4
+    -- The standard FORTRAN-77 intrinsic functions, plus nthRoot which
+    -- can be translated into an arithmetic expression:
+    f77Functions : L S := [abs,sqrt,exp,log,log10,sin,cos,tan,asin,acos,
+                           atan,sinh,cosh,tanh,nthRoot,%power]
 
---S 5 of 13
-denom(b)
---R 
---R
---R   (5)  24
---R                                                        Type: PositiveInteger
---E 5
+    nagFunctions : L S := [pi, X01AAF]
 
---S 6 of 13
-r := (x**2 + 2*x + 1)/(x**2 - 2*x + 1)
---R 
---R
---R         2
---R        x  + 2x + 1
---R   (6)  -----------
---R         2
---R        x  - 2x + 1
---R                                          Type: Fraction(Polynomial(Integer))
---E 6
+    useNagFunctionsFlag : Boolean := true
 
---S 7 of 13
-factor(r)
---R 
---R
---R         2
---R        x  + 2x + 1
---R   (7)  -----------
---R         2
---R        x  - 2x + 1
---R                                Type: Factored(Fraction(Polynomial(Integer)))
---E 7
+    -- Local functions to check for "unassigned" symbols etc.
 
---S 8 of 13
-map(factor,r)
---R 
---R
---R               2
---R        (x + 1)
---R   (8)  --------
---R               2
---R        (x - 1)
---R                                Type: Fraction(Factored(Polynomial(Integer)))
---E 8
+    mkEqn(s1:Symbol,s2:Symbol):Equation EXPR(R) ==
+      equation(s2::EXPR(R),script(s1,scripts(s2))::EXPR(R))
 
---S 9 of 13
-continuedFraction(7/12)
---R 
---R
---R          1 |     1 |     1 |     1 |
---R   (9)  +---+ + +---+ + +---+ + +---+
---R        | 1     | 1     | 2     | 2
---R                                             Type: ContinuedFraction(Integer)
---E 9
+    fixUpSymbols(u:EXPR R):Union(EXPR R,"failed") ==
+      -- If its a univariate expression then just fix it up:
+      syms   : L S := variables(u)
+      (#basicSymbols = 1) and zero?(#subscriptedSymbols) =>
+        not (#syms = 1) => "failed"
+        subst(u,equation(first(syms)::EXPR(R),first(basicSymbols)::EXPR(R)))
+      -- We have one variable but it is subscripted:
+      zero?(#basicSymbols) and (#subscriptedSymbols = 1) =>
+        -- Make sure we don't have both X and X_i
+        for s in syms repeat
+          not scripted?(s) => return "failed"
+        not ((#(syms:=removeDuplicates! [name(s) for s in syms]))=1)=> "failed"
+        sym : Symbol := first subscriptedSymbols
+        subst(u,[mkEqn(sym,i) for i in variables(u)]) 
+      "failed"
 
---S 10 of 13
-partialFraction(7,12)
---R 
---R
---R              3   1
---R   (10)  1 - -- + -
---R              2   3
---R             2
---R                                               Type: PartialFraction(Integer)
---E 10
+    extraSymbols?(u:EXPR R):Boolean ==
+      syms   : L S := [name(v) for v in variables(u)]
+      extras : L S := setDifference(syms,
+                                    setUnion(basicSymbols,subscriptedSymbols))
+      not empty? extras
 
---S 11 of 13
-g := 2/3 + 4/5*%i
---R 
---R
---R         2   4
---R   (11)  - + - %i
---R         3   5
---R                                             Type: Complex(Fraction(Integer))
---E 11
+    checkSymbols(u:EXPR R):EXPR(R) ==
+      syms   : L S := [name(v) for v in variables(u)]
+      extras : L S := setDifference(syms,
+                                    setUnion(basicSymbols,subscriptedSymbols))
+      not empty? extras => 
+        m := fixUpSymbols(u)
+        m case EXPR(R) => m::EXPR(R)
+        error("Extra symbols detected:",[string(v) for v in extras]$L(String))
+      u
 
---S 12 of 13
-g :: FRAC COMPLEX INT
---R 
---R
---R         10 + 12%i
---R   (12)  ---------
---R             15
---R                                             Type: Fraction(Complex(Integer))
---E 12
+    notSymbol?(v:BO):Boolean ==
+      s : S := name v
+      member?(s,basicSymbols) or 
+        scripted?(s) and member?(name s,subscriptedSymbols) => false
+      true
 
---S 13 of 13
-)show Fraction
---R 
---R Fraction(S: IntegralDomain)  is a domain constructor
---R Abbreviation for Fraction is FRAC 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FRAC 
---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 OMwrite : (OpenMathDevice,%,Boolean) -> Void if S has INS and S has OM
---R OMwrite : (OpenMathDevice,%) -> Void if S has INS and S has OM
---R OMwrite : (%,Boolean) -> String if S has INS and S has OM
---R OMwrite : % -> String if S has INS and S has OM
---R characteristic : () -> NonNegativeInteger
---R charthRoot : % -> Union(%,"failed") if $ has CHARNZ and S has PFECAT or S has CHARNZ
---R coerce : Symbol -> % if S has RETRACT(SYMBOL)
---R conditionP : Matrix(%) -> Union(Vector(%),"failed") if $ has CHARNZ and S has PFECAT
---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
---E 13
+    extraOperators?(u:EXPR R):Boolean ==
+      ops    : L S := [name v for v in operators(u) | notSymbol?(v)]
+      if useNagFunctionsFlag then
+        fortranFunctions : L S := append(f77Functions,nagFunctions)
+      else
+        fortranFunctions : L S := f77Functions
+      extras : L S := setDifference(ops,fortranFunctions)
+      not empty? extras
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{Fraction.help}
-====================================================================
-Fraction examples
-====================================================================
+    checkOperators(u:EXPR R):Void ==
+      ops    : L S := [name v for v in operators(u) | notSymbol?(v)]
+      if useNagFunctionsFlag then
+        fortranFunctions : L S := append(f77Functions,nagFunctions)
+      else
+        fortranFunctions : L S := f77Functions
+      extras : L S := setDifference(ops,fortranFunctions)
+      not empty? extras => 
+        error("Non FORTRAN-77 functions detected:",[string(v) for v in extras])
+      void()
 
-The Fraction domain implements quotients.  The elements must
-belong to a domain of category IntegralDomain: multiplication
-must be commutative and the product of two non-zero elements must not
-be zero.  This allows you to make fractions of most things you would
-think of, but don't expect to create a fraction of two matrices!  The
-abbreviation for Fraction is FRAC.
+    checkForNagOperators(u:EXPR R):$ ==
+      useNagFunctionsFlag =>
+        import Pi
+        import PiCoercions(R)
+        piOp : BasicOperator := operator X01AAF
+        piSub : Equation EXPR R :=
+          equation(pi()$Pi::EXPR(R),kernel(piOp,0::EXPR(R))$EXPR(R))
+        subst(u,piSub) pretend $
+      u pretend $
 
-Use / to create a fraction.
+    -- Conditional retractions:
 
-  a := 11/12
-    11
-    --
-    12
-                   Type: Fraction Integer
+    if R has RetractableTo(Integer) then 
 
-  b := 23/24
-    23
-    --
-    24
-                   Type: Fraction Integer
+      retractIfCan(u:POLY Integer):Union($,"failed") ==
+        retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed")
 
-The standard arithmetic operations are available.
+      retract(u:POLY Integer):$ ==
+        retract((u::EXPR Integer)$EXPR(Integer))@$
 
-  3 - a*b**2 + a + b/a
-    313271
-    ------
-     76032
-                   Type: Fraction Integer
+      retractIfCan(u:FRAC POLY Integer):Union($,"failed") ==
+        retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed")
 
-Extract the numerator and denominator by using numer and denom,
-respectively.
+      retract(u:FRAC POLY  Integer):$ ==
+        retract((u::EXPR Integer)$EXPR(Integer))@$
 
-  numer(a)
-    11
-                   Type: PositiveInteger
+      int2R(u:Integer):R == u::R
 
-  denom(b)
-    24
-                   Type: PositiveInteger
+      retractIfCan(u:EXPR Integer):Union($,"failed") ==
+        retractIfCan(map(int2R,u)$EXF2(Integer,R))@Union($,"failed")
 
-Operations like max, min, negative?, positive? and zero?
-are all available if they are provided for the numerators and
-denominators.  
+      retract(u:EXPR Integer):$ ==
+        retract(map(int2R,u)$EXF2(Integer,R))@$
 
-Don't expect a useful answer from factor, gcd or lcm if you apply
-them to fractions.
+    if R has RetractableTo(Float) then 
 
-  r := (x**2 + 2*x + 1)/(x**2 - 2*x + 1)
-     2
-    x  + 2x + 1
-    -----------
-     2
-    x  - 2x + 1
-                  Type: Fraction Polynomial Integer
+      retractIfCan(u:POLY Float):Union($,"failed") ==
+        retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed")
 
-Since all non-zero fractions are invertible, these operations have trivial
-definitions.
+      retract(u:POLY Float):$ ==
+        retract((u::EXPR Float)$EXPR(Float))@$
 
-  factor(r)
-     2
-    x  + 2x + 1
-    -----------
-     2
-    x  - 2x + 1
-                  Type: Factored Fraction Polynomial Integer
+      retractIfCan(u:FRAC POLY Float):Union($,"failed") ==
+        retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed")
 
-Use map to apply factor to the numerator and denominator, which is
-probably what you mean.
+      retract(u:FRAC POLY  Float):$ ==
+        retract((u::EXPR Float)$EXPR(Float))@$
 
-  map(factor,r)
-           2
-    (x + 1)
-    --------
-           2
-    (x - 1)
-                  Type: Fraction Factored Polynomial Integer
+      float2R(u:Float):R == (u::R)
 
-Other forms of fractions are available.  Use continuedFraction to
-create a continued fraction.
+      retractIfCan(u:EXPR Float):Union($,"failed") ==
+        retractIfCan(map(float2R,u)$EXF2(Float,R))@Union($,"failed")
 
-  continuedFraction(7/12)
-      1 |     1 |     1 |     1 |
-    +---+ + +---+ + +---+ + +---+
-    | 1     | 1     | 2     | 2
-                  Type: ContinuedFraction Integer
+      retract(u:EXPR Float):$ ==
+        retract(map(float2R,u)$EXF2(Float,R))@$
 
-Use partialFraction to create a partial fraction.
+    -- Exported Functions
 
-  partialFraction(7,12)
-          3   1
-     1 - -- + -
-          2   3
-         2
-                  Type: PartialFraction Integer
+    useNagFunctions():Boolean == useNagFunctionsFlag
 
-Use conversion to create alternative views of fractions with objects
-moved in and out of the numerator and denominator.
+    useNagFunctions(v:Boolean):Boolean == 
+      old := useNagFunctionsFlag
+      useNagFunctionsFlag := v
+      old
+ 
+    log10(x:$):$ ==
+      kernel(operator log10,x)
 
-  g := 2/3 + 4/5*%i
-     2   4
-     - + - %i
-     3   5
-                  Type: Complex Fraction Integer
+    pi():$ == kernel(operator X01AAF,0)
 
-  g :: FRAC COMPLEX INT
-    10 + 12%i
-    ---------
-        15
-                  Type: Fraction Complex Integer
+    coerce(u:$):EXPR R == u pretend EXPR(R)
 
-See Also: 
-o )help ContinuedFraction
-o )help PartialFraction
-o )help Integer
-o )show Fraction
+    retractIfCan(u:EXPR R):Union($,"failed") ==
+      if (extraSymbols? u) then 
+        m := fixUpSymbols(u)
+        m case "failed" => return "failed"
+        u := m::EXPR(R)
+      extraOperators? u => "failed"
+      checkForNagOperators(u)
 
-\end{chunk}
-\pagehead{Fraction}{FRAC}
-\pagepic{ps/v103fraction.ps}{FRAC}{1.00}
-{\bf See}\\
-\pageto{Localize}{LO}
-\pageto{LocalAlgebra}{LA}
+    retract(u:EXPR R):$ ==
+      u:=checkSymbols(u)
+      checkOperators(u)
+      checkForNagOperators(u)
 
-{\bf Exports:}\\
-\begin{tabular}{lll}
-\cross{FRAC}{0} &
-\cross{FRAC}{1} &
-\cross{FRAC}{abs} \\
-\cross{FRAC}{associates?} &
-\cross{FRAC}{characteristic} &
-\cross{FRAC}{charthRoot} \\
-\cross{FRAC}{ceiling} &
-\cross{FRAC}{coerce} &
-\cross{FRAC}{conditionP} \\
-\cross{FRAC}{convert} &
-\cross{FRAC}{D} &
-\cross{FRAC}{denom} \\
-\cross{FRAC}{denominator} &
-\cross{FRAC}{differentiate} &
-\cross{FRAC}{divide} \\
-\cross{FRAC}{euclideanSize} &
-\cross{FRAC}{eval} &
-\cross{FRAC}{expressIdealMember} \\
-\cross{FRAC}{exquo} &
-\cross{FRAC}{extendedEuclidean} &
-\cross{FRAC}{factor} \\
-\cross{FRAC}{factorPolynomial} &
-\cross{FRAC}{factorSquareFreePolynomial} &
-\cross{FRAC}{floor} \\
-\cross{FRAC}{fractionPart} &
-\cross{FRAC}{gcd} &
-\cross{FRAC}{gcdPolynomial} \\
-\cross{FRAC}{hash} &
-\cross{FRAC}{init} &
-\cross{FRAC}{inv} \\
-\cross{FRAC}{latex} &
-\cross{FRAC}{lcm} &
-\cross{FRAC}{map} \\
-\cross{FRAC}{max} &
-\cross{FRAC}{min} &
-\cross{FRAC}{multiEuclidean} \\
-\cross{FRAC}{negative?} &
-\cross{FRAC}{nextItem} &
-\cross{FRAC}{numer} \\
-\cross{FRAC}{numerator} &
-\cross{FRAC}{OMwrite} &
-\cross{FRAC}{one?} \\
-\cross{FRAC}{patternMatch} &
-\cross{FRAC}{positive?} &
-\cross{FRAC}{prime?} \\
-\cross{FRAC}{principalIdeal} &
-\cross{FRAC}{random} &
-\cross{FRAC}{recip} \\
-\cross{FRAC}{reducedSystem} &
-\cross{FRAC}{retract} &
-\cross{FRAC}{retractIfCan} \\
-\cross{FRAC}{sample} &
-\cross{FRAC}{sign} &
-\cross{FRAC}{sizeLess?} \\
-\cross{FRAC}{solveLinearPolynomialEquation} &
-\cross{FRAC}{squareFree} &
-\cross{FRAC}{squareFreePart} \\
-\cross{FRAC}{squareFreePolynomial} &
-\cross{FRAC}{subtractIfCan} &
-\cross{FRAC}{unit?} \\
-\cross{FRAC}{unitCanonical} &
-\cross{FRAC}{unitNormal} &
-\cross{FRAC}{wholePart} \\
-\cross{FRAC}{zero?} &
-\cross{FRAC}{?*?} &
-\cross{FRAC}{?**?} \\
-\cross{FRAC}{?+?} &
-\cross{FRAC}{?-?} &
-\cross{FRAC}{-?} \\
-\cross{FRAC}{?/?} &
-\cross{FRAC}{?=?} &
-\cross{FRAC}{?\^{}?} \\
-\cross{FRAC}{?\~{}=?} &
-\cross{FRAC}{?$<$?} &
-\cross{FRAC}{?$<=$?} \\
-\cross{FRAC}{?$>$?} &
-\cross{FRAC}{?$>=$?} &
-\cross{FRAC}{?.?} \\
-\cross{FRAC}{?quo?} &
-\cross{FRAC}{?rem?} &
-\end{tabular}
+    retractIfCan(u:Symbol):Union($,"failed") ==
+      not (member?(u,basicSymbols) or
+           scripted?(u) and member?(name u,subscriptedSymbols)) => "failed"
+      (((u::EXPR(R))$(EXPR R))pretend Rep)::$
 
-\begin{chunk}{domain FRAC Fraction}
-)abbrev domain FRAC Fraction
-++ Author: Mark Botch
-++ Date Last Updated: 12 February 1992
-++ Basic Functions: Field, numer, denom
-++ Description:
-++ Fraction takes an IntegralDomain S and produces
-++ the domain of Fractions with numerators and denominators from S.
-++ If S is also a GcdDomain, then gcd's between numerator and
-++ denominator will be cancelled during all operations.
+    retract(u:Symbol):$ ==
+      res : Union($,"failed") := retractIfCan(u)
+      res case "failed" => error("Illegal Symbol Detected:",u::String)
+      res::$
 
-Fraction(S: IntegralDomain): QuotientFieldCategory S with 
-       if S has IntegerNumberSystem and S has OpenMath then OpenMath
-       if S has canonical and S has GcdDomain and S has canonicalUnitNormal
-          then canonical
-           ++ \spad{canonical} means that equal elements are in fact identical.
-  == LocalAlgebra(S, S, S) add
-    Rep:= Record(num:S, den:S)
-    coerce(d:S):% == [d,1]
-    zero?(x:%) == zero? x.num
+\end{chunk}
 
+\begin{chunk}{COQ FEXPR}
+(* domain FEXPR *)
+(*
+ EXPR R add
 
-    if S has GcdDomain and S has canonicalUnitNormal then
-      retract(x:%):S ==
---        one?(x.den) => x.num
-        ((x.den) = 1) => x.num
-        error "Denominator not equal to 1"
+    -- The standard FORTRAN-77 intrinsic functions, plus nthRoot which
+    -- can be translated into an arithmetic expression:
+    f77Functions : L S := [abs,sqrt,exp,log,log10,sin,cos,tan,asin,acos,
+                           atan,sinh,cosh,tanh,nthRoot,%power]
 
-      retractIfCan(x:%):Union(S, "failed") ==
---        one?(x.den) => x.num
-        ((x.den) = 1) => x.num
-        "failed"
-    else
-      retract(x:%):S ==
-        (a:= x.num exquo x.den) case "failed" =>
-           error "Denominator not equal to 1"
-        a
-      retractIfCan(x:%):Union(S,"failed") == x.num exquo x.den
+    nagFunctions : L S := [pi, X01AAF]
 
-    if S has EuclideanDomain then
-      wholePart x ==
---        one?(x.den) => x.num
-        ((x.den) = 1) => x.num
-        x.num quo x.den
+    useNagFunctionsFlag : Boolean := true
 
-    if S has IntegerNumberSystem then
+    -- Local functions to check for "unassigned" symbols etc.
 
-      floor x ==
---        one?(x.den) => x.num
-        ((x.den) = 1) => x.num
-        x < 0 => -ceiling(-x)
-        wholePart x
+    mkEqn(s1:Symbol,s2:Symbol):Equation EXPR(R) ==
+      equation(s2::EXPR(R),script(s1,scripts(s2))::EXPR(R))
 
-      ceiling x ==
---        one?(x.den) => x.num
-        ((x.den) = 1) => x.num
-        x < 0 => -floor(-x)
-        1 + wholePart x
+    fixUpSymbols(u:EXPR R):Union(EXPR R,"failed") ==
+      -- If its a univariate expression then just fix it up:
+      syms   : L S := variables(u)
+      (#basicSymbols = 1) and zero?(#subscriptedSymbols) =>
+        not (#syms = 1) => "failed"
+        subst(u,equation(first(syms)::EXPR(R),first(basicSymbols)::EXPR(R)))
+      -- We have one variable but it is subscripted:
+      zero?(#basicSymbols) and (#subscriptedSymbols = 1) =>
+        -- Make sure we don't have both X and X_i
+        for s in syms repeat
+          not scripted?(s) => return "failed"
+        not ((#(syms:=removeDuplicates! [name(s) for s in syms]))=1)=> "failed"
+        sym : Symbol := first subscriptedSymbols
+        subst(u,[mkEqn(sym,i) for i in variables(u)]) 
+      "failed"
 
-      if S has OpenMath then
-        -- TODO: somwhere this file does something which redefines the division
-        -- operator. Doh!
+    extraSymbols?(u:EXPR R):Boolean ==
+      syms   : L S := [name(v) for v in variables(u)]
+      extras : L S := setDifference(syms,
+                                    setUnion(basicSymbols,subscriptedSymbols))
+      not empty? extras
 
-        writeOMFrac(dev: OpenMathDevice, x: %): Void ==
-          OMputApp(dev)
-          OMputSymbol(dev, "nums1", "rational")
-          OMwrite(dev, x.num, false)
-          OMwrite(dev, x.den, false)
-          OMputEndApp(dev)
+    checkSymbols(u:EXPR R):EXPR(R) ==
+      syms   : L S := [name(v) for v in variables(u)]
+      extras : L S := setDifference(syms,
+                                    setUnion(basicSymbols,subscriptedSymbols))
+      not empty? extras => 
+        m := fixUpSymbols(u)
+        m case EXPR(R) => m::EXPR(R)
+        error("Extra symbols detected:",[string(v) for v in extras]$L(String))
+      u
 
-        OMwrite(x: %): String ==
-          s: String := ""
-          sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
-          dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
-          OMputObject(dev)
-          writeOMFrac(dev, x)
-          OMputEndObject(dev)
-          OMclose(dev)
-          s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
-          s
+    notSymbol?(v:BO):Boolean ==
+      s : S := name v
+      member?(s,basicSymbols) or 
+        scripted?(s) and member?(name s,subscriptedSymbols) => false
+      true
 
-        OMwrite(x: %, wholeObj: Boolean): String ==
-          s: String := ""
-          sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
-          dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
-          if wholeObj then
-            OMputObject(dev)
-          writeOMFrac(dev, x)
-          if wholeObj then
-            OMputEndObject(dev)
-          OMclose(dev)
-          s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
-          s
+    extraOperators?(u:EXPR R):Boolean ==
+      ops    : L S := [name v for v in operators(u) | notSymbol?(v)]
+      if useNagFunctionsFlag then
+        fortranFunctions : L S := append(f77Functions,nagFunctions)
+      else
+        fortranFunctions : L S := f77Functions
+      extras : L S := setDifference(ops,fortranFunctions)
+      not empty? extras
 
-        OMwrite(dev: OpenMathDevice, x: %): Void ==
-          OMputObject(dev)
-          writeOMFrac(dev, x)
-          OMputEndObject(dev)
+    checkOperators(u:EXPR R):Void ==
+      ops    : L S := [name v for v in operators(u) | notSymbol?(v)]
+      if useNagFunctionsFlag then
+        fortranFunctions : L S := append(f77Functions,nagFunctions)
+      else
+        fortranFunctions : L S := f77Functions
+      extras : L S := setDifference(ops,fortranFunctions)
+      not empty? extras => 
+        error("Non FORTRAN-77 functions detected:",[string(v) for v in extras])
+      void()
 
-        OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void ==
-          if wholeObj then
-            OMputObject(dev)
-          writeOMFrac(dev, x)
-          if wholeObj then
-            OMputEndObject(dev)
+    checkForNagOperators(u:EXPR R):$ ==
+      useNagFunctionsFlag =>
+        import Pi
+        import PiCoercions(R)
+        piOp : BasicOperator := operator X01AAF
+        piSub : Equation EXPR R :=
+          equation(pi()$Pi::EXPR(R),kernel(piOp,0::EXPR(R))$EXPR(R))
+        subst(u,piSub) pretend $
+      u pretend $
 
-    if S has GcdDomain then
-      cancelGcd: % -> S
-      normalize: % -> %
+    -- Conditional retractions:
 
-      normalize x ==
-        zero?(x.num) => 0
---        one?(x.den) => x
-        ((x.den) = 1) => x
-        uca := unitNormal(x.den)
-        zero?(x.den := uca.canonical) => error "division by zero"
-        x.num := x.num * uca.associate
-        x
+    if R has RetractableTo(Integer) then 
 
-      recip x ==
-        zero?(x.num) => "failed"
-        normalize [x.den, x.num]
+      retractIfCan(u:POLY Integer):Union($,"failed") ==
+        retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed")
 
-      cancelGcd x ==
---        one?(x.den) => x.den
-        ((x.den) = 1) => x.den
-        d := gcd(x.num, x.den)
-        xn := x.num exquo d
-        xn case "failed" =>
-          error "gcd not gcd in QF cancelGcd (numerator)"
-        xd := x.den exquo d
-        xd case "failed" =>
-          error "gcd not gcd in QF cancelGcd (denominator)"
-        x.num := xn :: S
-        x.den := xd :: S
-        d
+      retract(u:POLY Integer):$ ==
+        retract((u::EXPR Integer)$EXPR(Integer))@$
 
-      nn:S / dd:S ==
-        zero? dd => error "division by zero"
-        cancelGcd(z := [nn, dd])
-        normalize z
+      retractIfCan(u:FRAC POLY Integer):Union($,"failed") ==
+        retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed")
 
-      x + y  ==
-        zero? y => x
-        zero? x => y
-        z := [x.den,y.den]
-        d := cancelGcd z
-        g := [z.den * x.num + z.num * y.num, d]
-        cancelGcd g
-        g.den := g.den * z.num * z.den
-        normalize g
+      retract(u:FRAC POLY  Integer):$ ==
+        retract((u::EXPR Integer)$EXPR(Integer))@$
 
-      -- We can not rely on the defaulting mechanism
-      -- to supply a definition for -, even though this
-      -- definition would do, for thefollowing reasons:
-      --  1) The user could have defined a subtraction
-      --     in Localize, which would not work for
-      --     QuotientField;
-      --  2) even if he doesn't, the system currently
-      --     places a default definition in Localize,
-      --     which uses Localize's +, which does not
-      --     cancel gcds
-      x - y  ==
-        zero? y => x
-        z := [x.den, y.den]
-        d := cancelGcd z
-        g := [z.den * x.num - z.num * y.num, d]
-        cancelGcd g
-        g.den := g.den * z.num * z.den
-        normalize g
+      int2R(u:Integer):R == u::R
 
-      x:% * y:%  ==
-        zero? x or zero? y => 0
---        one? x => y
-        (x = 1) => y
---        one? y => x
-        (y = 1) => x
-        (x, y) := ([x.num, y.den], [y.num, x.den])
-        cancelGcd x; cancelGcd y;
-        normalize [x.num * y.num, x.den * y.den]
+      retractIfCan(u:EXPR Integer):Union($,"failed") ==
+        retractIfCan(map(int2R,u)$EXF2(Integer,R))@Union($,"failed")
 
-      n:Integer * x:% ==
-        y := [n::S, x.den]
-        cancelGcd y
-        normalize [x.num * y.num, y.den]
+      retract(u:EXPR Integer):$ ==
+        retract(map(int2R,u)$EXF2(Integer,R))@$
 
-      nn:S * x:% ==
-        y := [nn, x.den]
-        cancelGcd y
-        normalize [x.num * y.num, y.den]
+    if R has RetractableTo(Float) then 
 
-      differentiate(x:%, deriv:S -> S) ==
-        y := [deriv(x.den), x.den]
-        d := cancelGcd(y)
-        y.num := deriv(x.num) * y.den - x.num * y.num
-        (d, y.den) := (y.den, d)
-        cancelGcd y
-        y.den := y.den * d * d
-        normalize y
+      retractIfCan(u:POLY Float):Union($,"failed") ==
+        retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed")
 
-      if S has canonicalUnitNormal then
-        x = y == (x.num = y.num) and (x.den = y.den)
-    --x / dd == (cancelGcd (z:=[x.num,dd*x.den]); normalize z)
+      retract(u:POLY Float):$ ==
+        retract((u::EXPR Float)$EXPR(Float))@$
 
---        one? x == one? (x.num) and one? (x.den)
-        one? x == ((x.num) = 1) and ((x.den) = 1)
-                  -- again assuming canonical nature of representation
+      retractIfCan(u:FRAC POLY Float):Union($,"failed") ==
+        retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed")
 
-    else
-      nn:S/dd:S == if zero? dd then error "division by zero" else [nn,dd]
+      retract(u:FRAC POLY  Float):$ ==
+        retract((u::EXPR Float)$EXPR(Float))@$
 
-      recip x ==
-        zero?(x.num) => "failed"
-        [x.den, x.num]
+      float2R(u:Float):R == (u::R)
 
-    if (S has RetractableTo Fraction Integer) then
-      retract(x:%):Fraction(Integer) == retract(retract(x)@S)
+      retractIfCan(u:EXPR Float):Union($,"failed") ==
+        retractIfCan(map(float2R,u)$EXF2(Float,R))@Union($,"failed")
 
-      retractIfCan(x:%):Union(Fraction Integer, "failed") ==
-        (u := retractIfCan(x)@Union(S, "failed")) case "failed" => "failed"
-        retractIfCan(u::S)
+      retract(u:EXPR Float):$ ==
+        retract(map(float2R,u)$EXF2(Float,R))@$
 
-    else if (S has RetractableTo Integer) then
-      retract(x:%):Fraction(Integer) ==
-        retract(numer x) / retract(denom x)
+    -- Exported Functions
 
-      retractIfCan(x:%):Union(Fraction Integer, "failed") ==
-        (n := retractIfCan numer x) case "failed" => "failed"
-        (d := retractIfCan denom x) case "failed" => "failed"
-        (n::Integer) / (d::Integer)
+    useNagFunctions():Boolean == useNagFunctionsFlag
 
-    QFP ==> SparseUnivariatePolynomial %
-    DP ==> SparseUnivariatePolynomial S
-    import UnivariatePolynomialCategoryFunctions2(%,QFP,S,DP)
-    import UnivariatePolynomialCategoryFunctions2(S,DP,%,QFP)
+    useNagFunctions(v:Boolean):Boolean == 
+      old := useNagFunctionsFlag
+      useNagFunctionsFlag := v
+      old
+ 
+    log10(x:$):$ ==
+      kernel(operator log10,x)
 
-    if S has GcdDomain then
-       gcdPolynomial(pp,qq) ==
-          zero? pp => qq
-          zero? qq => pp
-          zero? degree pp or zero? degree qq => 1
-          denpp:="lcm"/[denom u for u in coefficients pp]
-          ppD:DP:=map(x+->retract(x*denpp),pp)
-          denqq:="lcm"/[denom u for u in coefficients qq]
-          qqD:DP:=map(x+->retract(x*denqq),qq)
-          g:=gcdPolynomial(ppD,qqD)
-          zero? degree g => 1
---          one? (lc:=leadingCoefficient g) => map(#1::%,g)
-          ((lc:=leadingCoefficient g) = 1) => map(x+->x::%,g)
-          map(x+->x/lc,g)
+    pi():$ == kernel(operator X01AAF,0)
 
-    if (S has PolynomialFactorizationExplicit) then
-       -- we'll let the solveLinearPolynomialEquations operator
-       -- default from Field
-       pp,qq: QFP
-       lpp: List QFP
-       import Factored SparseUnivariatePolynomial %
-       if S has CharacteristicNonZero then
-          if S has canonicalUnitNormal and S has GcdDomain then
-             charthRoot x ==
-               n:= charthRoot x.num
-               n case "failed" => "failed"
-               d:=charthRoot x.den
-               d case "failed" => "failed"
-               n/d
-          else
-             charthRoot x ==
-               -- to find x = p-th root of n/d
-               -- observe that xd is p-th root of n*d**(p-1)
-               ans:=charthRoot(x.num *
-                      (x.den)**(characteristic()$%-1)::NonNegativeInteger)
-               ans case "failed" => "failed"
-               ans / x.den
-          clear: List % -> List S
-          clear l ==
-             d:="lcm"/[x.den for x in l]
-             [ x.num * (d exquo x.den)::S for x in l]
-          mat: Matrix %
-          conditionP mat ==
-            matD: Matrix S
-            matD:= matrix [ clear l for l in listOfLists mat ]
-            ansD := conditionP matD
-            ansD case "failed" => "failed"
-            ansDD:=ansD :: Vector(S)
-            [ ansDD(i)::% for i in 1..#ansDD]$Vector(%)
+    coerce(u:$):EXPR R == u pretend EXPR(R)
 
-       factorPolynomial(pp) ==
-          zero? pp => 0
-          denpp:="lcm"/[denom u for u in coefficients pp]
-          ppD:DP:=map(x+->retract(x*denpp),pp)
-          ff:=factorPolynomial ppD
-          den1:%:=denpp::%
-          lfact:List Record(flg:Union("nil", "sqfr", "irred", "prime"),
-                             fctr:QFP, xpnt:Integer)
-          lfact:= [[w.flg,
-                    if leadingCoefficient w.fctr =1 then 
-                           map(x+->x::%,w.fctr)
-                    else (lc:=(leadingCoefficient w.fctr)::%;
-                           den1:=den1/lc**w.xpnt;
-                            map(x+->x::%/lc,w.fctr)),
-                   w.xpnt] for w in factorList ff]
-          makeFR(map(x+->x::%/den1,unit(ff)),lfact)
-       factorSquareFreePolynomial(pp) ==
-          zero? pp => 0
-          degree pp = 0 => makeFR(pp,empty())
-          lcpp:=leadingCoefficient pp
-          pp:=pp/lcpp
-          denpp:="lcm"/[denom u for u in coefficients pp]
-          ppD:DP:=map(x+->retract(x*denpp),pp)
-          ff:=factorSquareFreePolynomial ppD
-          den1:%:=denpp::%/lcpp
-          lfact:List Record(flg:Union("nil", "sqfr", "irred", "prime"),
-                             fctr:QFP, xpnt:Integer)
-          lfact:= [[w.flg,
-                    if leadingCoefficient w.fctr =1 then 
-                           map(x+->x::%,w.fctr)
-                    else (lc:=(leadingCoefficient w.fctr)::%;
-                           den1:=den1/lc**w.xpnt;
-                            map(x+->x::%/lc,w.fctr)),
-                   w.xpnt] for w in factorList ff]
-          makeFR(map(x+->x::%/den1,unit(ff)),lfact)
+    retractIfCan(u:EXPR R):Union($,"failed") ==
+      if (extraSymbols? u) then 
+        m := fixUpSymbols(u)
+        m case "failed" => return "failed"
+        u := m::EXPR(R)
+      extraOperators? u => "failed"
+      checkForNagOperators(u)
 
-\end{chunk}
+    retract(u:EXPR R):$ ==
+      u:=checkSymbols(u)
+      checkOperators(u)
+      checkForNagOperators(u)
+
+    retractIfCan(u:Symbol):Union($,"failed") ==
+      not (member?(u,basicSymbols) or
+           scripted?(u) and member?(name u,subscriptedSymbols)) => "failed"
+      (((u::EXPR(R))$(EXPR R))pretend Rep)::$
+
+    retract(u:Symbol):$ ==
+      res : Union($,"failed") := retractIfCan(u)
+      res case "failed" => error("Illegal Symbol Detected:",u::String)
+      res::$
 
-\begin{chunk}{COQ FRAC}
-(* domain FRAC *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{FRAC.dotabb}
-"FRAC" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FRAC"]
-"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"]
-"FRAC" -> "PFECAT"
+\begin{chunk}{FEXPR.dotabb}
+"FEXPR" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FEXPR"]
+"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
+"FEXPR" -> "ALIST"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FRIDEAL FractionalIdeal}
+\section{domain FORTRAN FortranProgram}
 
-\begin{chunk}{FractionalIdeal.input}
+\begin{chunk}{FortranProgram.input}
 )set break resume
-)sys rm -f FractionalIdeal.output
-)spool FractionalIdeal.output
+)sys rm -f FortranProgram.output
+)spool FortranProgram.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show FractionalIdeal
+)show FortranProgram
 --R 
---R FractionalIdeal(R: EuclideanDomain,F: QuotientFieldCategory(R),UP: UnivariatePolynomialCategory(F),A: Join(FramedAlgebra(F,UP),RetractableTo(F)))  is a domain constructor
---R Abbreviation for FractionalIdeal is FRIDEAL 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FRIDEAL 
+--R FortranProgram(name: Symbol,returnType: Union(fst: FortranScalarType,void: void),arguments: List(Symbol),symbols: SymbolTable)  is a domain constructor
+--R Abbreviation for FortranProgram is FORTRAN 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FORTRAN 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (%,%) -> %                      ?**? : (%,Integer) -> %
---R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
---R ?/? : (%,%) -> %                      ?=? : (%,%) -> Boolean
---R 1 : () -> %                           ?^? : (%,Integer) -> %
---R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
---R basis : % -> Vector(A)                coerce : % -> OutputForm
---R commutator : (%,%) -> %               conjugate : (%,%) -> %
---R denom : % -> R                        hash : % -> SingleInteger
---R ideal : Vector(A) -> %                inv : % -> %
---R latex : % -> String                   minimize : % -> %
---R norm : % -> F                         numer : % -> Vector(A)
---R one? : % -> Boolean                   recip : % -> Union(%,"failed")
---R sample : () -> %                      ?~=? : (%,%) -> Boolean
---R randomLC : (NonNegativeInteger,Vector(A)) -> A
+--R coerce : Expression(Float) -> %       coerce : Expression(Integer) -> %
+--R coerce : List(FortranCode) -> %       coerce : FortranCode -> %
+--R coerce : % -> OutputForm              outputAsFortran : % -> Void
+--R coerce : Equation(Expression(Complex(Float))) -> %
+--R coerce : Equation(Expression(Float)) -> %
+--R coerce : Equation(Expression(Integer)) -> %
+--R coerce : Expression(Complex(Float)) -> %
+--R coerce : Equation(Expression(MachineComplex)) -> %
+--R coerce : Equation(Expression(MachineFloat)) -> %
+--R coerce : Equation(Expression(MachineInteger)) -> %
+--R coerce : Expression(MachineComplex) -> %
+--R coerce : Expression(MachineFloat) -> %
+--R coerce : Expression(MachineInteger) -> %
+--R coerce : Record(localSymbols: SymbolTable,code: List(FortranCode)) -> %
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{FractionalIdeal.help}
+\begin{chunk}{FortranProgram.help}
 ====================================================================
-FractionalIdeal examples
+FortranProgram examples
 ====================================================================
 
-Fractional ideals in a framed algebra.
+FortranProgram allows the user to build and manipulate simple models of 
+FORTRAN subprograms.  These can then be transformed into actual FORTRAN 
+notation.
 
 See Also:
-o )show FractionalIdeal
+o )show FortranProgram
 
 \end{chunk}
 
-\pagehead{FractionalIdeal}{FRIDEAL}
-\pagepic{ps/v103fractionalideal.ps}{FRIDEAL}{1.00}
+\pagehead{FortranProgram}{FORTRAN}
+\pagepic{ps/v103fortranprogram.ps}{FORTRAN}{1.00}
 {\bf See}\\
-\pageto{FramedModule}{FRMOD}
-\pageto{HyperellipticFiniteDivisor}{HELLFDIV}
-\pageto{FiniteDivisor}{FDIV}
+\pageto{Result}{RESULT}
+\pageto{FortranCode}{FC}
+\pageto{ThreeDimensionalMatrix}{M3D}
+\pageto{SimpleFortranProgram}{SFORT}
+\pageto{Switch}{SWITCH}
+\pageto{FortranTemplate}{FTEM}
+\pageto{FortranExpression}{FEXPR}
 
 {\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{FRIDEAL}{1} &
-\cross{FRIDEAL}{basis} &
-\cross{FRIDEAL}{coerce} &
-\cross{FRIDEAL}{commutator} &
-\cross{FRIDEAL}{conjugate} \\
-\cross{FRIDEAL}{denom} &
-\cross{FRIDEAL}{hash} &
-\cross{FRIDEAL}{ideal} &
-\cross{FRIDEAL}{inv} &
-\cross{FRIDEAL}{latex} \\
-\cross{FRIDEAL}{minimize} &
-\cross{FRIDEAL}{norm} &
-\cross{FRIDEAL}{numer} &
-\cross{FRIDEAL}{one?} &
-\cross{FRIDEAL}{randomLC} \\
-\cross{FRIDEAL}{recip} &
-\cross{FRIDEAL}{sample} &
-\cross{FRIDEAL}{?\~{}=?} &
-\cross{FRIDEAL}{?**?} &
-\cross{FRIDEAL}{?\^{}?} \\
-\cross{FRIDEAL}{?*?} &
-\cross{FRIDEAL}{?**?} &
-\cross{FRIDEAL}{?/?} &
-\cross{FRIDEAL}{?=?} &
-\cross{FRIDEAL}{?\^{}?} 
+\begin{tabular}{ll}
+\cross{FORTRAN}{coerce} &
+\cross{FORTRAN}{outputAsFortran}
 \end{tabular}
 
-\begin{chunk}{domain FRIDEAL FractionalIdeal}
-)abbrev domain FRIDEAL FractionalIdeal
-++ Author: Manuel Bronstein
-++ Date Created: 27 Jan 1989
-++ Date Last Updated: 30 July 1993
+\begin{chunk}{domain FORTRAN FortranProgram}
+)abbrev domain FORTRAN FortranProgram
+++ Author: Mike Dewar
+++ Date Created: October 1992
+++ Date Last Updated: 23 January 1995 Added support for intrinsic functions
 ++ Description:
-++ Fractional ideals in a framed algebra.
-
-FractionalIdeal(R, F, UP, A): Exports == Implementation where
-  R : EuclideanDomain
-  F : QuotientFieldCategory R
-  UP: UnivariatePolynomialCategory F
-  A : Join(FramedAlgebra(F, UP), RetractableTo F)
-
-  VF  ==> Vector F
-  VA  ==> Vector A
-  UPA ==> SparseUnivariatePolynomial A
-  QF  ==> Fraction UP
+++ \axiomType{FortranProgram} allows the user to build and manipulate simple 
+++ models of FORTRAN subprograms.  These can then be transformed into 
+++ actual FORTRAN notation.
 
-  Exports ==> Group with
-    ideal   : VA -> %
-      ++ ideal([f1,...,fn]) returns the ideal \spad{(f1,...,fn)}.
-    basis   : %  -> VA
-      ++ basis((f1,...,fn)) returns the vector \spad{[f1,...,fn]}.
-    norm    : %  -> F
-      ++ norm(I) returns the norm of the ideal I.
-    numer   : %  -> VA
-      ++ numer(1/d * (f1,...,fn)) = the vector \spad{[f1,...,fn]}.
-    denom   : %  -> R
-      ++ denom(1/d * (f1,...,fn)) returns d.
-    minimize: %  -> %
-      ++ minimize(I) returns a reduced set of generators for \spad{I}.
-    randomLC: (NonNegativeInteger, VA) -> A
-      ++ randomLC(n,x) should be local but conditional.
+FortranProgram(name,returnType,arguments,symbols): Exports == Implement where
+  name       : Symbol
+  returnType : Union(fst:FortranScalarType,void:"void")
+  arguments  : List Symbol
+  symbols    : SymbolTable
 
-  Implementation ==> add
-    import CommonDenominator(R, F, VF)
-    import MatrixCommonDenominator(UP, QF)
-    import InnerCommonDenominator(R, F, List R, List F)
-    import MatrixCategoryFunctions2(F, Vector F, Vector F, Matrix F,
-                        UP, Vector UP, Vector UP, Matrix UP)
-    import MatrixCategoryFunctions2(UP, Vector UP, Vector UP,
-                        Matrix UP, F, Vector F, Vector F, Matrix F)
-    import MatrixCategoryFunctions2(UP, Vector UP, Vector UP,
-                        Matrix UP, QF, Vector QF, Vector QF, Matrix QF)
+  FC     ==> FortranCode
+  EXPR   ==> Expression
+  INT    ==> Integer
+  CMPX   ==> Complex
+  MINT   ==> MachineInteger
+  MFLOAT ==> MachineFloat
+  MCMPLX ==> MachineComplex
+  REP    ==> Record(localSymbols : SymbolTable, code : List FortranCode)
 
-    Rep := Record(num:VA, den:R)
+  Exports ==> FortranProgramCategory with
+    coerce : FortranCode -> $
+        ++ coerce(fc) is not documented
+    coerce : List FortranCode -> $
+        ++ coerce(lfc) is not documented
+    coerce : REP -> $
+        ++ coerce(r) is not documented
+    coerce : EXPR MINT -> $
+        ++ coerce(e) is not documented
+    coerce : EXPR MFLOAT -> $
+        ++ coerce(e) is not documented
+    coerce : EXPR MCMPLX -> $
+        ++ coerce(e) is not documented
+    coerce : Equation EXPR MINT -> $
+        ++ coerce(eq) is not documented
+    coerce : Equation EXPR MFLOAT -> $
+        ++ coerce(eq) is not documented
+    coerce : Equation EXPR MCMPLX -> $
+        ++ coerce(eq) is not documented
+    coerce : EXPR INT -> $
+        ++ coerce(e) is not documented
+    coerce : EXPR Float -> $
+        ++ coerce(e) is not documented
+    coerce : EXPR CMPX Float -> $
+        ++ coerce(e) is not documented
+    coerce : Equation EXPR INT -> $
+        ++ coerce(eq) is not documented
+    coerce : Equation EXPR Float -> $
+        ++ coerce(eq) is not documented
+    coerce : Equation EXPR CMPX Float -> $
+        ++ coerce(eq) is not documented
 
-    poly    : % -> UPA
-    invrep  : Matrix F -> A
-    upmat   : (A, NonNegativeInteger) -> Matrix UP
-    summat  : % -> Matrix UP
-    num2O   : VA -> OutputForm
-    agcd    : List A -> R
-    vgcd    : VF -> R
-    mkIdeal : (VA, R) -> %
-    intIdeal: (List A, R) -> %
-    ret?    : VA -> Boolean
-    tryRange: (NonNegativeInteger, VA, R, %) -> Union(%, "failed")
+  Implement ==> add
 
-    1               == [[1]$VA, 1]
-    numer i         == i.num
-    denom i         == i.den
-    mkIdeal(v, d)   == [v, d]
-    invrep m        == represents(transpose(m) * coordinates(1$A))
-    upmat(x, i)     == map(s +-> monomial(s, i)$UP, regularRepresentation x)
-    ret? v          == any?(s+->retractIfCan(s)@Union(F,"failed") case F, v)
-    x = y           == denom(x) = denom(y) and numer(x) = numer(y)
-    agcd l  == reduce("gcd", [vgcd coordinates a for a in l]$List(R), 0)
+    Rep := REP
 
-    norm i ==
-      ("gcd"/[retract(u)@R for u in coefficients determinant summat i])
-              / denom(i) ** rank()$A
+    import SExpression
+    import TheSymbolTable
+    import FortranCode
 
-    tryRange(range, nm, nrm, i) ==
-      for j in 0..10 repeat
-        a := randomLC(10 * range, nm)
-        unit? gcd((retract(norm a)@R exquo nrm)::R, nrm) =>
-                                return intIdeal([nrm::F::A, a], denom i)
-      "failed"
+    makeRep(b:List FortranCode):$ ==
+      construct(empty()$SymbolTable,b)$REP
 
-    summat i ==
-      m := minIndex(v := numer i)
-      reduce("+",
-            [upmat(qelt(v, j + m), j) for j in 0..#v-1]$List(Matrix UP))
+    codeFrom(u:$):List FortranCode ==
+      elt(u::Rep,code)$REP
 
-    inv i ==
-      m  := inverse(map(s+->s::QF, summat i))::Matrix(QF)
-      cd  := splitDenominator(denom(i)::F::UP::QF * m)
-      cd2 := splitDenominator coefficients(cd.den)
-      invd:= cd2.den / reduce("gcd", cd2.num)
-      d   := reduce("max", [degree p for p in parts(cd.num)])
-      ideal
-        [invd * invrep map(s+->coefficient(s, j), cd.num) for j in 0..d]$VA
+    outputAsFortran(p:$):Void ==
+      setLabelValue(25000::SingleInteger)$FC
+      -- Do this first to catch any extra type declarations:
+      tempName := "FPTEMP"::Symbol
+      newSubProgram(tempName)
+      initialiseIntrinsicList()$Lisp
+      body : List SExpression := [getCode(l)$FortranCode for l in codeFrom(p)]
+      intrinsics : SExpression := getIntrinsicList()$Lisp
+      endSubProgram()
+      fortFormatHead(returnType::OutputForm, name::OutputForm, _
+                     arguments::OutputForm)$Lisp
+      printTypes(symbols)$SymbolTable
+      printTypes((p::Rep).localSymbols)$SymbolTable
+      printTypes(tempName)$TheSymbolTable
+      fortFormatIntrinsics(intrinsics)$Lisp
+      clearTheSymbolTable(tempName)
+      for expr in body repeat displayLines1(expr)$Lisp
+      dispStatement(END::OutputForm)$Lisp
+      void()$Void
 
-    ideal v ==
-      d := reduce("lcm", [commonDenominator coordinates qelt(v, i)
-                          for i in minIndex v .. maxIndex v]$List(R))
-      intIdeal([d::F * qelt(v, i) for i in minIndex v .. maxIndex v], d)
+    mkString(l:List Symbol):String ==
+      unparse(convert(l::OutputForm)@InputForm)$InputForm
 
-    intIdeal(l, d) ==
-      lr := empty()$List(R)
-      nr := empty()$List(A)
-      for x in removeDuplicates l repeat
-        if (u := retractIfCan(x)@Union(F, "failed")) case F
-          then lr := concat(retract(u::F)@R, lr)
-          else nr := concat(x, nr)
-      r    := reduce("gcd", lr, 0)
-      g    := agcd nr
-      a    := (r quo (b := gcd(gcd(d, r), g)))::F::A
-      d    := d quo b
-      r ^= 0 and ((g exquo r) case R) => mkIdeal([a], d)
-      invb := inv(b::F)
-      va:VA := [invb * m for m in nr]
-      zero? a => mkIdeal(va, d)
-      mkIdeal(concat(a, va), d)
+    checkVariables(user:List Symbol,target:List Symbol):Void ==
+      -- We don't worry about whether the user has subscripted the
+      -- variables or not.
+      setDifference(map(name$Symbol,user),target) ^= empty()$List(Symbol) =>
+        s1 : String := mkString(user)
+        s2 : String := mkString(target)
+        error ["Incompatible variable lists:", s1, s2]
+      void()$Void
 
-    vgcd v ==
-      reduce("gcd",
-             [retract(v.i)@R for i in minIndex v .. maxIndex v]$List(R))
+    coerce(u:EXPR MINT) : $ ==
+      checkVariables(variables(u)$EXPR(MINT),arguments)
+      l : List(FC) := [assign(name,u)$FC,returns()$FC]
+      makeRep l
 
-    poly i ==
-      m := minIndex(v := numer i)
-      +/[monomial(qelt(v, i + m), i) for i in 0..#v-1]
+    coerce(u:Equation EXPR MINT) : $ ==
+      retractIfCan(lhs u)@Union(Kernel(EXPR MINT),"failed") case "failed" =>
+        error "left hand side is not a kernel"
+      vList : List Symbol := variables lhs u
+      #vList ^= #arguments =>
+        error "Incorrect number of arguments"
+      veList : List EXPR MINT := [w::EXPR(MINT) for w in vList]
+      aeList : List EXPR MINT := [w::EXPR(MINT) for w in arguments]
+      eList : List Equation EXPR MINT := 
+        [equation(w,v) for w in veList for v in aeList]
+      (subst(rhs u,eList))::$
 
-    i1 * i2 ==
-      intIdeal(coefficients(poly i1 * poly i2), denom i1 * denom i2)
+    coerce(u:EXPR MFLOAT) : $ ==
+      checkVariables(variables(u)$EXPR(MFLOAT),arguments)
+      l : List(FC) := [assign(name,u)$FC,returns()$FC]
+      makeRep l 
 
-    i:$ ** m:Integer ==
-      m < 0 => inv(i) ** (-m)
-      n := m::NonNegativeInteger
-      v := numer i
-      intIdeal([qelt(v, j) ** n for j in minIndex v .. maxIndex v],
-               denom(i) ** n)
+    coerce(u:Equation EXPR MFLOAT) : $ ==
+      retractIfCan(lhs u)@Union(Kernel(EXPR MFLOAT),"failed") case "failed" =>
+        error "left hand side is not a kernel"
+      vList : List Symbol := variables lhs u
+      #vList ^= #arguments =>
+        error "Incorrect number of arguments"
+      veList : List EXPR MFLOAT := [w::EXPR(MFLOAT) for w in vList]
+      aeList : List EXPR MFLOAT := [w::EXPR(MFLOAT) for w in arguments]
+      eList : List Equation EXPR MFLOAT := 
+        [equation(w,v) for w in veList for v in aeList]
+      (subst(rhs u,eList))::$
 
-    num2O v ==
-      paren [qelt(v, i)::OutputForm
-             for i in minIndex v .. maxIndex v]$List(OutputForm)
+    coerce(u:EXPR MCMPLX) : $ ==
+      checkVariables(variables(u)$EXPR(MCMPLX),arguments)
+      l : List(FC) := [assign(name,u)$FC,returns()$FC]
+      makeRep l
 
-    basis i ==
-      v := numer i
-      d := inv(denom(i)::F)
-      [d * qelt(v, j) for j in minIndex v .. maxIndex v]
+    coerce(u:Equation EXPR MCMPLX) : $ ==
+      retractIfCan(lhs u)@Union(Kernel EXPR MCMPLX,"failed") case "failed"=>
+        error "left hand side is not a kernel"
+      vList : List Symbol := variables lhs u
+      #vList ^= #arguments =>
+        error "Incorrect number of arguments"
+      veList : List EXPR MCMPLX := [w::EXPR(MCMPLX) for w in vList]
+      aeList : List EXPR MCMPLX := [w::EXPR(MCMPLX) for w in arguments]
+      eList : List Equation EXPR MCMPLX := 
+        [equation(w,v) for w in veList for v in aeList]
+      (subst(rhs u,eList))::$
 
-    coerce(i:$):OutputForm ==
-      nm := num2O numer i
---      one? denom i => nm
-      (denom i = 1) => nm
-      (1::Integer::OutputForm) / (denom(i)::OutputForm) * nm
+    coerce(u:REP):$ ==
+      u@Rep
 
-    if F has Finite then
-      randomLC(m, v) ==
-        +/[random()$F * qelt(v, j) for j in minIndex v .. maxIndex v]
-    else
-      randomLC(m, v) ==
-        +/[(random()$Integer rem m::Integer) * qelt(v, j)
-            for j in minIndex v .. maxIndex v]
+    coerce(u:$):OutputForm ==
+      coerce(name)$Symbol
 
-    minimize i ==
-      n := (#(nm := numer i))
---      one?(n) or (n < 3 and ret? nm) => i
-      (n = 1) or (n < 3 and ret? nm) => i
-      nrm    := retract(norm mkIdeal(nm, 1))@R
-      for range in 1..5 repeat
-        (u := tryRange(range, nm, nrm, i)) case $ => return(u::$)
-      i
+    coerce(c:List FortranCode):$ ==
+      makeRep c
 
-\end{chunk}
+    coerce(c:FortranCode):$ ==
+      makeRep [c]
 
-\begin{chunk}{COQ FRIDEAL}
-(* domain FRIDEAL *)
-(*
-*)
+    coerce(u:EXPR INT) : $ ==
+      checkVariables(variables(u)$EXPR(INT),arguments)
+      l : List(FC) := [assign(name,u)$FC,returns()$FC]
+      makeRep l
 
-\end{chunk}
+    coerce(u:Equation EXPR INT) : $ ==
+      retractIfCan(lhs u)@Union(Kernel(EXPR INT),"failed") case "failed" =>
+        error "left hand side is not a kernel"
+      vList : List Symbol := variables lhs u
+      #vList ^= #arguments =>
+        error "Incorrect number of arguments"
+      veList : List EXPR INT := [w::EXPR(INT) for w in vList]
+      aeList : List EXPR INT := [w::EXPR(INT) for w in arguments]
+      eList : List Equation EXPR INT := 
+        [equation(w,v) for w in veList for v in aeList]
+      (subst(rhs u,eList))::$
 
-\begin{chunk}{FRIDEAL.dotabb}
-"FRIDEAL" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FRIDEAL"]
-"FRAMALG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FRAMALG"]
-"FRIDEAL" -> "FRAMALG"
+    coerce(u:EXPR Float) : $ ==
+      checkVariables(variables(u)$EXPR(Float),arguments)
+      l : List(FC) := [assign(name,u)$FC,returns()$FC]
+      makeRep l 
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FRMOD FramedModule}
+    coerce(u:Equation EXPR Float) : $ ==
+      retractIfCan(lhs u)@Union(Kernel(EXPR Float),"failed") case "failed" =>
+        error "left hand side is not a kernel"
+      vList : List Symbol := variables lhs u
+      #vList ^= #arguments =>
+        error "Incorrect number of arguments"
+      veList : List EXPR Float := [w::EXPR(Float) for w in vList]
+      aeList : List EXPR Float := [w::EXPR(Float) for w in arguments]
+      eList : List Equation EXPR Float := 
+        [equation(w,v) for w in veList for v in aeList]
+      (subst(rhs u,eList))::$
 
-\begin{chunk}{FramedModule.input}
-)set break resume
-)sys rm -f FramedModule.output
-)spool FramedModule.output
-)set message test on
-)set message auto off
-)clear all
+    coerce(u:EXPR Complex Float) : $ ==
+      checkVariables(variables(u)$EXPR(Complex Float),arguments)
+      l : List(FC) := [assign(name,u)$FC,returns()$FC]
+      makeRep l
 
---S 1 of 1
-)show FramedModule
---R 
---R FramedModule(R: EuclideanDomain,F: QuotientFieldCategory(R),UP: UnivariatePolynomialCategory(F),A: FramedAlgebra(F,UP),ibasis: Vector(A))  is a domain constructor
---R Abbreviation for FramedModule is FRMOD 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FRMOD 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (%,%) -> %                      ?**? : (%,NonNegativeInteger) -> %
---R ?**? : (%,PositiveInteger) -> %       ?=? : (%,%) -> Boolean
---R 1 : () -> %                           ?^? : (%,NonNegativeInteger) -> %
---R ?^? : (%,PositiveInteger) -> %        basis : % -> Vector(A)
---R coerce : % -> OutputForm              hash : % -> SingleInteger
---R latex : % -> String                   module : Vector(A) -> %
---R norm : % -> F                         one? : % -> Boolean
---R recip : % -> Union(%,"failed")        sample : () -> %
---R ?~=? : (%,%) -> Boolean              
---R module : FractionalIdeal(R,F,UP,A) -> % if A has RETRACT(F)
---R
---E 1
+    coerce(u:Equation EXPR CMPX Float) : $ ==
+      retractIfCan(lhs u)@Union(Kernel EXPR CMPX Float,"failed")_
+       case "failed"=>
+        error "left hand side is not a kernel"
+      vList : List Symbol := variables lhs u
+      #vList ^= #arguments =>
+        error "Incorrect number of arguments"
+      veList : List EXPR CMPX Float := [w::EXPR(CMPX Float) for w in vList]
+      aeList : List EXPR CMPX Float := [w::EXPR(CMPX Float) for w in arguments]
+      eList : List Equation EXPR CMPX Float := 
+        [equation(w,v) for w in veList for v in aeList]
+      (subst(rhs u,eList))::$
 
-)spool
-)lisp (bye)
 \end{chunk}
-\begin{chunk}{FramedModule.help}
-====================================================================
-FramedModule examples
-====================================================================
 
-Module representation of fractional ideals.
+\begin{chunk}{COQ FORTRAN}
+(* domain FORTRAN *)
+(*
 
-See Also:
-o )show FramedModule
+    Rep := REP
 
-\end{chunk}
+    import SExpression
+    import TheSymbolTable
+    import FortranCode
 
-\pagehead{FramedModule}{FRMOD}
-\pagepic{ps/v103framedmodule.ps}{FRMOD}{1.00}
-{\bf See}\\
-\pageto{FractionalIdeal}{FRIDEAL}
-\pageto{HyperellipticFiniteDivisor}{HELLFDIV}
-\pageto{FiniteDivisor}{FDIV}
+    makeRep(b:List FortranCode):$ ==
+      construct(empty()$SymbolTable,b)$REP
 
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{FRMOD}{1} &
-\cross{FRMOD}{basis} &
-\cross{FRMOD}{coerce} &
-\cross{FRMOD}{hash} &
-\cross{FRMOD}{latex} \\
-\cross{FRMOD}{module} &
-\cross{FRMOD}{norm} &
-\cross{FRMOD}{one?} &
-\cross{FRMOD}{recip} &
-\cross{FRMOD}{sample} \\
-\cross{FRMOD}{?\~{}=?} &
-\cross{FRMOD}{?**?} &
-\cross{FRMOD}{?\^{}?} &
-\cross{FRMOD}{?*?} &
-\cross{FRMOD}{?**?} \\
-\cross{FRMOD}{?=?} &&&&
-\end{tabular}
+    codeFrom(u:$):List FortranCode ==
+      elt(u::Rep,code)$REP
 
-\begin{chunk}{domain FRMOD FramedModule}
-)abbrev domain FRMOD FramedModule
-++ Author: Manuel Bronstein
-++ Date Created: 27 Jan 1989
-++ Date Last Updated: 24 Jul 1990
-++ Description:
-++ Module representation of fractional ideals.
+    outputAsFortran(p:$):Void ==
+      setLabelValue(25000::SingleInteger)$FC
+      -- Do this first to catch any extra type declarations:
+      tempName := "FPTEMP"::Symbol
+      newSubProgram(tempName)
+      initialiseIntrinsicList()$Lisp
+      body : List SExpression := [getCode(l)$FortranCode for l in codeFrom(p)]
+      intrinsics : SExpression := getIntrinsicList()$Lisp
+      endSubProgram()
+      fortFormatHead(returnType::OutputForm, name::OutputForm, _
+                     arguments::OutputForm)$Lisp
+      printTypes(symbols)$SymbolTable
+      printTypes((p::Rep).localSymbols)$SymbolTable
+      printTypes(tempName)$TheSymbolTable
+      fortFormatIntrinsics(intrinsics)$Lisp
+      clearTheSymbolTable(tempName)
+      for expr in body repeat displayLines1(expr)$Lisp
+      dispStatement(END::OutputForm)$Lisp
+      void()$Void
 
-FramedModule(R, F, UP, A, ibasis): Exports == Implementation where
-  R     : EuclideanDomain
-  F     : QuotientFieldCategory R
-  UP    : UnivariatePolynomialCategory F
-  A     : FramedAlgebra(F, UP)
-  ibasis: Vector A
+    mkString(l:List Symbol):String ==
+      unparse(convert(l::OutputForm)@InputForm)$InputForm
 
-  VR  ==> Vector R
-  VF  ==> Vector F
-  VA  ==> Vector A
-  M   ==> Matrix F
+    checkVariables(user:List Symbol,target:List Symbol):Void ==
+      -- We don't worry about whether the user has subscripted the
+      -- variables or not.
+      setDifference(map(name$Symbol,user),target) ^= empty()$List(Symbol) =>
+        s1 : String := mkString(user)
+        s2 : String := mkString(target)
+        error ["Incompatible variable lists:", s1, s2]
+      void()$Void
 
-  Exports ==> Monoid with
-    basis : %  -> VA
-      ++ basis((f1,...,fn)) = the vector \spad{[f1,...,fn]}.
-    norm  : %  -> F
-      ++ norm(f) returns the norm of the module f.
-    module: VA -> %
-      ++ module([f1,...,fn]) = the module generated by \spad{(f1,...,fn)}
-      ++ over R.
-    if A has RetractableTo F then
-      module: FractionalIdeal(R, F, UP, A) -> %
-        ++ module(I) returns I viewed has a module over R.
+    coerce(u:EXPR MINT) : $ ==
+      checkVariables(variables(u)$EXPR(MINT),arguments)
+      l : List(FC) := [assign(name,u)$FC,returns()$FC]
+      makeRep l
 
-  Implementation ==> add
-    import MatrixCommonDenominator(R, F)
-    import ModularHermitianRowReduction(R)
+    coerce(u:Equation EXPR MINT) : $ ==
+      retractIfCan(lhs u)@Union(Kernel(EXPR MINT),"failed") case "failed" =>
+        error "left hand side is not a kernel"
+      vList : List Symbol := variables lhs u
+      #vList ^= #arguments =>
+        error "Incorrect number of arguments"
+      veList : List EXPR MINT := [w::EXPR(MINT) for w in vList]
+      aeList : List EXPR MINT := [w::EXPR(MINT) for w in arguments]
+      eList : List Equation EXPR MINT := 
+        [equation(w,v) for w in veList for v in aeList]
+      (subst(rhs u,eList))::$
 
-    Rep  := VA
+    coerce(u:EXPR MFLOAT) : $ ==
+      checkVariables(variables(u)$EXPR(MFLOAT),arguments)
+      l : List(FC) := [assign(name,u)$FC,returns()$FC]
+      makeRep l 
 
-    iflag?:Reference(Boolean) := ref true
-    wflag?:Reference(Boolean) := ref true
-    imat := new(#ibasis, #ibasis, 0)$M
-    wmat := new(#ibasis, #ibasis, 0)$M
+    coerce(u:Equation EXPR MFLOAT) : $ ==
+      retractIfCan(lhs u)@Union(Kernel(EXPR MFLOAT),"failed") case "failed" =>
+        error "left hand side is not a kernel"
+      vList : List Symbol := variables lhs u
+      #vList ^= #arguments =>
+        error "Incorrect number of arguments"
+      veList : List EXPR MFLOAT := [w::EXPR(MFLOAT) for w in vList]
+      aeList : List EXPR MFLOAT := [w::EXPR(MFLOAT) for w in arguments]
+      eList : List Equation EXPR MFLOAT := 
+        [equation(w,v) for w in veList for v in aeList]
+      (subst(rhs u,eList))::$
 
-    rowdiv      : (VR, R)  -> VF
-    vectProd    : (VA, VA) -> VA
-    wmatrix     : VA -> M
-    W2A         : VF -> A
-    intmat      : () -> M
-    invintmat   : () -> M
-    getintmat   : () -> Boolean
-    getinvintmat: () -> Boolean
+    coerce(u:EXPR MCMPLX) : $ ==
+      checkVariables(variables(u)$EXPR(MCMPLX),arguments)
+      l : List(FC) := [assign(name,u)$FC,returns()$FC]
+      makeRep l
 
-    1                      == ibasis
-    module(v:VA)           == v
-    basis m                == m pretend VA
-    rowdiv(r, f)           == [r.i / f for i in minIndex r..maxIndex r]
-    coerce(m:%):OutputForm == coerce(basis m)$VA
-    W2A v                  == represents(v * intmat())
-    wmatrix v              == coordinates(v) * invintmat()
+    coerce(u:Equation EXPR MCMPLX) : $ ==
+      retractIfCan(lhs u)@Union(Kernel EXPR MCMPLX,"failed") case "failed"=>
+        error "left hand side is not a kernel"
+      vList : List Symbol := variables lhs u
+      #vList ^= #arguments =>
+        error "Incorrect number of arguments"
+      veList : List EXPR MCMPLX := [w::EXPR(MCMPLX) for w in vList]
+      aeList : List EXPR MCMPLX := [w::EXPR(MCMPLX) for w in arguments]
+      eList : List Equation EXPR MCMPLX := 
+        [equation(w,v) for w in veList for v in aeList]
+      (subst(rhs u,eList))::$
 
-    getinvintmat() ==
-      m := inverse(intmat())::M
-      for i in minRowIndex m .. maxRowIndex m repeat
-        for j in minColIndex m .. maxColIndex m repeat
-          imat(i, j) := qelt(m, i, j)
-      false
+    coerce(u:REP):$ ==
+      u@Rep
 
-    getintmat() ==
-      m := coordinates ibasis
-      for i in minRowIndex m .. maxRowIndex m repeat
-        for j in minColIndex m .. maxColIndex m repeat
-          wmat(i, j) := qelt(m, i, j)
-      false
+    coerce(u:$):OutputForm ==
+      coerce(name)$Symbol
 
-    invintmat() ==
-      if iflag?() then iflag?() := getinvintmat()
-      imat
+    coerce(c:List FortranCode):$ ==
+      makeRep c
 
-    intmat() ==
-      if wflag?() then wflag?() := getintmat()
-      wmat
+    coerce(c:FortranCode):$ ==
+      makeRep [c]
 
-    vectProd(v1, v2) ==
-      k := minIndex(v := new(#v1 * #v2, 0)$VA)
-      for i in minIndex v1 .. maxIndex v1 repeat
-        for j in minIndex v2 .. maxIndex v2 repeat
-          qsetelt_!(v, k, qelt(v1, i) * qelt(v2, j))
-          k := k + 1
-      v pretend VA
+    coerce(u:EXPR INT) : $ ==
+      checkVariables(variables(u)$EXPR(INT),arguments)
+      l : List(FC) := [assign(name,u)$FC,returns()$FC]
+      makeRep l
 
-    norm m ==
-      #(basis m) ^= #ibasis => error "Module not of rank n"
-      determinant(coordinates(basis m) * invintmat())
+    coerce(u:Equation EXPR INT) : $ ==
+      retractIfCan(lhs u)@Union(Kernel(EXPR INT),"failed") case "failed" =>
+        error "left hand side is not a kernel"
+      vList : List Symbol := variables lhs u
+      #vList ^= #arguments =>
+        error "Incorrect number of arguments"
+      veList : List EXPR INT := [w::EXPR(INT) for w in vList]
+      aeList : List EXPR INT := [w::EXPR(INT) for w in arguments]
+      eList : List Equation EXPR INT := 
+        [equation(w,v) for w in veList for v in aeList]
+      (subst(rhs u,eList))::$
 
-    m1 * m2 ==
-      m := rowEch((cd := splitDenominator wmatrix(
-                                     vectProd(basis m1, basis m2))).num)
-      module [u for i in minRowIndex m .. maxRowIndex m |
-                           (u := W2A rowdiv(row(m, i), cd.den)) ^= 0]$VA
+    coerce(u:EXPR Float) : $ ==
+      checkVariables(variables(u)$EXPR(Float),arguments)
+      l : List(FC) := [assign(name,u)$FC,returns()$FC]
+      makeRep l 
 
-    if A has RetractableTo F then
-      module(i:FractionalIdeal(R, F, UP, A)) ==
-        module(basis i) * module(ibasis)
+    coerce(u:Equation EXPR Float) : $ ==
+      retractIfCan(lhs u)@Union(Kernel(EXPR Float),"failed") case "failed" =>
+        error "left hand side is not a kernel"
+      vList : List Symbol := variables lhs u
+      #vList ^= #arguments =>
+        error "Incorrect number of arguments"
+      veList : List EXPR Float := [w::EXPR(Float) for w in vList]
+      aeList : List EXPR Float := [w::EXPR(Float) for w in arguments]
+      eList : List Equation EXPR Float := 
+        [equation(w,v) for w in veList for v in aeList]
+      (subst(rhs u,eList))::$
 
-\end{chunk}
+    coerce(u:EXPR Complex Float) : $ ==
+      checkVariables(variables(u)$EXPR(Complex Float),arguments)
+      l : List(FC) := [assign(name,u)$FC,returns()$FC]
+      makeRep l
+
+    coerce(u:Equation EXPR CMPX Float) : $ ==
+      retractIfCan(lhs u)@Union(Kernel EXPR CMPX Float,"failed")_
+       case "failed"=>
+        error "left hand side is not a kernel"
+      vList : List Symbol := variables lhs u
+      #vList ^= #arguments =>
+        error "Incorrect number of arguments"
+      veList : List EXPR CMPX Float := [w::EXPR(CMPX Float) for w in vList]
+      aeList : List EXPR CMPX Float := [w::EXPR(CMPX Float) for w in arguments]
+      eList : List Equation EXPR CMPX Float := 
+        [equation(w,v) for w in veList for v in aeList]
+      (subst(rhs u,eList))::$
 
-\begin{chunk}{COQ FRMOD}
-(* domain FRMOD *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{FRMOD.dotabb}
-"FRMOD" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FRMOD"]
-"FRAMALG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FRAMALG"]
-"FRMOD" -> "FRAMALG"
+\begin{chunk}{FORTRAN.dotabb}
+"FORTRAN" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FORTRAN"]
+"COMPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=COMPCAT"]
+"FORTRAN" -> "COMPCAT"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FAGROUP FreeAbelianGroup}
+\section{domain FST FortranScalarType}
 
-\begin{chunk}{FreeAbelianGroup.input}
+\begin{chunk}{FortranScalarType.input}
 )set break resume
-)sys rm -f FreeAbelianGroup.output
-)spool FreeAbelianGroup.output
+)sys rm -f FortranScalarType.output
+)spool FortranScalarType.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show FreeAbelianGroup
+)show FortranScalarType
 --R 
---R FreeAbelianGroup(S: SetCategory)  is a domain constructor
---R Abbreviation for FreeAbelianGroup is FAGROUP 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FAGROUP 
+--R FortranScalarType  is a domain constructor
+--R Abbreviation for FortranScalarType is FST 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FST 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (Integer,S) -> %                ?*? : (%,Integer) -> %
---R ?*? : (Integer,%) -> %                ?*? : (NonNegativeInteger,%) -> %
---R ?*? : (PositiveInteger,%) -> %        ?+? : (S,%) -> %
---R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
---R -? : % -> %                           ?=? : (%,%) -> Boolean
---R 0 : () -> %                           coefficient : (S,%) -> Integer
---R coerce : S -> %                       coerce : % -> OutputForm
---R hash : % -> SingleInteger             latex : % -> String
---R mapGen : ((S -> S),%) -> %            max : (%,%) -> % if S has ORDSET
---R min : (%,%) -> % if S has ORDSET      nthCoef : (%,Integer) -> Integer
---R nthFactor : (%,Integer) -> S          retract : % -> S
---R sample : () -> %                      size : % -> NonNegativeInteger
---R zero? : % -> Boolean                  ?~=? : (%,%) -> 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 highCommonTerms : (%,%) -> % if Integer has OAMON
---R mapCoef : ((Integer -> Integer),%) -> %
---R retractIfCan : % -> Union(S,"failed")
---R subtractIfCan : (%,%) -> Union(%,"failed")
---R terms : % -> List(Record(gen: S,exp: Integer))
+--R ?=? : (%,%) -> Boolean                character? : % -> Boolean
+--R coerce : % -> SExpression             coerce : % -> Symbol
+--R coerce : Symbol -> %                  coerce : String -> %
+--R coerce : % -> OutputForm              complex? : % -> Boolean
+--R double? : % -> Boolean                doubleComplex? : % -> Boolean
+--R integer? : % -> Boolean               logical? : % -> Boolean
+--R real? : % -> Boolean                 
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{FreeAbelianGroup.help}
+\begin{chunk}{FortranScalarType.help}
 ====================================================================
-FreeAbelianGroup examples
+FortranScalarType examples
 ====================================================================
 
-Free abelian group on any set of generators
-The free abelian group on a set S is the monoid of finite sums of
-the form reduce(+,[ni * si]) where the si's are in S, and the ni's
-are integers. The operation is commutative.
+Creates and manipulates objects which correspond to the
+basic FORTRAN data types: REAL, INTEGER, COMPLEX, LOGICAL and CHARACTER
 
 See Also:
-o )show FreeAbelianGroup
+o )show FortranScalarType
 
 \end{chunk}
 
-\pagehead{FreeAbelianGroup}{FAGROUP}
-\pagepic{ps/v103freeabeliangroup.ps}{FAGROUP}{1.00}
+\pagehead{FortranScalarType}{FST}
+\pagepic{ps/v103fortranscalartype.ps}{FST}{1.00}
 {\bf See}\\
-\pageto{ListMonoidOps}{LMOPS}
-\pageto{FreeMonoid}{FMONOID}
-\pageto{FreeGroup}{FGROUP}
-\pageto{InnerFreeAbelianMonoid}{IFAMON}
-\pageto{FreeAbelianMonoid}{FAMONOID}
+\pageto{FortranType}{FT}
+\pageto{SymbolTable}{SYMTAB}
+\pageto{TheSymbolTable}{SYMS}
 
 {\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{FAGROUP}{0} &
-\cross{FAGROUP}{coefficient} &
-\cross{FAGROUP}{coerce} &
-\cross{FAGROUP}{hash} &
-\cross{FAGROUP}{highCommonTerms} \\
-\cross{FAGROUP}{latex} &
-\cross{FAGROUP}{mapCoef} &
-\cross{FAGROUP}{mapGen} &
-\cross{FAGROUP}{max} &
-\cross{FAGROUP}{min} \\
-\cross{FAGROUP}{nthCoef} &
-\cross{FAGROUP}{nthFactor} &
-\cross{FAGROUP}{retract} &
-\cross{FAGROUP}{retractIfCan} &
-\cross{FAGROUP}{sample} \\
-\cross{FAGROUP}{size} &
-\cross{FAGROUP}{subtractIfCan} &
-\cross{FAGROUP}{terms} &
-\cross{FAGROUP}{zero?} &
-\cross{FAGROUP}{?\~{}=?} \\
-\cross{FAGROUP}{?*?} &
-\cross{FAGROUP}{?$<$?} &
-\cross{FAGROUP}{?$<=$?} &
-\cross{FAGROUP}{?$>$?} &
-\cross{FAGROUP}{?$>=$?} \\
-\cross{FAGROUP}{?+?} &
-\cross{FAGROUP}{?-?} &
-\cross{FAGROUP}{-?} &
-\cross{FAGROUP}{?=?} &
+\begin{tabular}{lllllllll}
+\cross{FST}{character?} &
+\cross{FST}{coerce} &
+\cross{FST}{complex?} &
+\cross{FST}{double?} &
+\cross{FST}{doubleComplex?} &
+\cross{FST}{integer?} &
+\cross{FST}{logical?} &
+\cross{FST}{real?} &
+\cross{FST}{?=?} 
 \end{tabular}
 
-\begin{chunk}{domain FAGROUP FreeAbelianGroup}
-)abbrev domain FAGROUP FreeAbelianGroup
-++ Author: Manuel Bronstein
-++ Date Created: November 1989
-++ Date Last Updated: 6 June 1991
+\begin{chunk}{domain FST FortranScalarType}
+)abbrev domain FST FortranScalarType
+++ Author: Mike Dewar
+++ Date Created:  October 1992
 ++ Description:
-++ Free abelian group on any set of generators
-++ The free abelian group on a set S is the monoid of finite sums of
-++ the form \spad{reduce(+,[ni * si])} where the si's are in S, and the ni's
-++ are integers. The operation is commutative.
-
-FreeAbelianGroup(S:SetCategory): Exports == Implementation where
-  Exports ==> Join(AbelianGroup, Module Integer,
-                   FreeAbelianMonoidCategory(S, Integer)) with
-    if S has OrderedSet then OrderedSet
+++ Creates and manipulates objects which correspond to the
+++ basic FORTRAN data types: REAL, INTEGER, COMPLEX, LOGICAL and CHARACTER
 
-  Implementation ==> InnerFreeAbelianMonoid(S, Integer, 1) add
-    - f == mapCoef("-", f)
+FortranScalarType() : exports == implementation where
 
-    if S has OrderedSet then
-      inmax: List Record(gen: S, exp: Integer) -> Record(gen: S, exp:Integer)
+  exports == CoercibleTo OutputForm with
+    coerce : String -> $     
+      ++ coerce(s) transforms the string s into an element of 
+      ++ FortranScalarType provided s is one of "real", "double precision",
+      ++ "complex", "logical", "integer", "character", "REAL",
+      ++ "COMPLEX", "LOGICAL", "INTEGER", "CHARACTER", 
+      ++ "DOUBLE PRECISION"
+    coerce : Symbol -> $ 
+      ++ coerce(s) transforms the symbol s into an element of 
+      ++ FortranScalarType provided s is one of real, complex,double precision,
+      ++ logical, integer, character, REAL, COMPLEX, LOGICAL,
+      ++ INTEGER, CHARACTER, DOUBLE PRECISION
+    coerce : $ -> Symbol
+      ++ coerce(x) returns the symbol associated with x
+    coerce : $ -> SExpression
+      ++ coerce(x) returns the s-expression associated with x
+    real?  : $ -> Boolean
+      ++ real?(t) tests whether t is equivalent to the FORTRAN type REAL.
+    double? : $ -> Boolean
+      ++ double?(t) tests whether t is equivalent to the FORTRAN type
+      ++ DOUBLE PRECISION
+    integer?  : $ -> Boolean
+      ++ integer?(t) tests whether t is equivalent to the FORTRAN type INTEGER.
+    complex?  : $ -> Boolean
+      ++ complex?(t) tests whether t is equivalent to the FORTRAN type COMPLEX.
+    doubleComplex?  : $ -> Boolean
+      ++ doubleComplex?(t) tests whether t is equivalent to the (non-standard)
+      ++ FORTRAN type DOUBLE COMPLEX.
+    character?  : $ -> Boolean
+      ++ character?(t) tests whether t is equivalent to the FORTRAN type 
+      ++ CHARACTER.
+    logical?  : $ -> Boolean
+      ++ logical?(t) tests whether t is equivalent to the FORTRAN type LOGICAL.
+    "=" : ($,$) -> Boolean
+      ++ x=y tests for equality
 
-      inmax l ==
-        mx := first l
-        for t in rest l repeat
-          if mx.gen < t.gen then mx := t
-        mx
+  implementation == add
 
-      -- lexicographic order
-      a < b ==
-        zero? a  =>
-          zero? b => false
-          0 < (inmax terms b).exp
-        ta := inmax terms a
-        zero? b => ta.exp < 0
-        tb := inmax terms b
-        ta.gen < tb.gen => 0 < tb.exp
-        tb.gen < ta.gen => ta.exp < 0
-        ta.exp < tb.exp => true
-        tb.exp < ta.exp => false
-        lc := ta.exp * ta.gen
-        (a - lc) < (b - lc)
+    U == Union(RealThing:"real",
+               IntegerThing:"integer",
+               ComplexThing:"complex",
+               CharacterThing:"character",
+               LogicalThing:"logical",
+               DoublePrecisionThing:"double precision",
+               DoubleComplexThing:"double complex")
+    Rep := U
 
-\end{chunk}
+    doubleSymbol : Symbol := "double precision"::Symbol
 
-\begin{chunk}{COQ FAGROUP}
-(* domain FAGROUP *)
-(*
-*)
+    upperDoubleSymbol : Symbol := "DOUBLE PRECISION"::Symbol
 
-\end{chunk}
+    doubleComplexSymbol : Symbol := "double complex"::Symbol
 
-\begin{chunk}{FAGROUP.dotabb}
-"FAGROUP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FAGROUP"]
-"PID" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PID"]
-"OAGROUP" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAGROUP"]
-"FAGROUP" -> "PID"
-"FAGROUP" -> "OAGROUP"
+    upperDoubleComplexSymbol : Symbol := "DOUBLE COMPLEX"::Symbol
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FAMONOID FreeAbelianMonoid}
+    u = v ==
+      u case RealThing and v case RealThing => true
+      u case IntegerThing and v case IntegerThing => true
+      u case ComplexThing and v case ComplexThing => true
+      u case LogicalThing and v case LogicalThing => true
+      u case CharacterThing and v case CharacterThing => true
+      u case DoublePrecisionThing and v case DoublePrecisionThing => true
+      u case DoubleComplexThing and v case DoubleComplexThing => true
+      false
 
-\begin{chunk}{FreeAbelianMonoid.input}
-)set break resume
-)sys rm -f FreeAbelianMonoid.output
-)spool FreeAbelianMonoid.output
-)set message test on
-)set message auto off
-)clear all
+    coerce(t:$):OutputForm ==
+      t case RealThing => coerce(REAL)$Symbol
+      t case IntegerThing => coerce(INTEGER)$Symbol
+      t case ComplexThing => coerce(COMPLEX)$Symbol
+      t case CharacterThing => coerce(CHARACTER)$Symbol
+      t case DoublePrecisionThing => coerce(upperDoubleSymbol)$Symbol
+      t case DoubleComplexThing => coerce(upperDoubleComplexSymbol)$Symbol
+      coerce(LOGICAL)$Symbol
 
---S 1 of 1
-)show FreeAbelianMonoid
---R 
---R FreeAbelianMonoid(S: SetCategory)  is a domain constructor
---R Abbreviation for FreeAbelianMonoid is FAMONOID 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FAMONOID 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (NonNegativeInteger,S) -> %     ?*? : (NonNegativeInteger,%) -> %
---R ?*? : (PositiveInteger,%) -> %        ?+? : (S,%) -> %
---R ?+? : (%,%) -> %                      ?=? : (%,%) -> Boolean
---R 0 : () -> %                           coerce : S -> %
---R coerce : % -> OutputForm              hash : % -> SingleInteger
---R latex : % -> String                   mapGen : ((S -> S),%) -> %
---R nthFactor : (%,Integer) -> S          retract : % -> S
---R sample : () -> %                      size : % -> NonNegativeInteger
---R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
---R coefficient : (S,%) -> NonNegativeInteger
---R highCommonTerms : (%,%) -> % if NonNegativeInteger has OAMON
---R mapCoef : ((NonNegativeInteger -> NonNegativeInteger),%) -> %
---R nthCoef : (%,Integer) -> NonNegativeInteger
---R retractIfCan : % -> Union(S,"failed")
---R subtractIfCan : (%,%) -> Union(%,"failed")
---R terms : % -> List(Record(gen: S,exp: NonNegativeInteger))
---R
---E 1
+    coerce(t:$):SExpression ==
+      t case RealThing => convert(real::Symbol)@SExpression
+      t case IntegerThing => convert(integer::Symbol)@SExpression
+      t case ComplexThing => convert(complex::Symbol)@SExpression
+      t case CharacterThing => convert(character::Symbol)@SExpression
+      t case DoublePrecisionThing => convert(doubleSymbol)@SExpression
+      t case DoubleComplexThing => convert(doubleComplexSymbol)@SExpression
+      convert(logical::Symbol)@SExpression
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{FreeAbelianMonoid.help}
-====================================================================
-FreeAbelianMonoid examples
-====================================================================
+    coerce(t:$):Symbol ==
+      t case RealThing => real::Symbol
+      t case IntegerThing => integer::Symbol
+      t case ComplexThing => complex::Symbol
+      t case CharacterThing => character::Symbol
+      t case DoublePrecisionThing => doubleSymbol
+      t case DoublePrecisionThing => doubleComplexSymbol
+      logical::Symbol
 
-Free abelian monoid on any set of generators
-The free abelian monoid on a set S is the monoid of finite sums of
-the form reduce(+,[ni * si]) where the si's are in S, and the ni's
-are non-negative integers. The operation is commutative.
+    coerce(s:Symbol):$ ==
+      s = real => ["real"]$Rep
+      s = REAL => ["real"]$Rep
+      s = integer => ["integer"]$Rep
+      s = INTEGER => ["integer"]$Rep
+      s = complex => ["complex"]$Rep
+      s = COMPLEX => ["complex"]$Rep
+      s = character => ["character"]$Rep
+      s = CHARACTER => ["character"]$Rep
+      s = logical => ["logical"]$Rep
+      s = LOGICAL => ["logical"]$Rep
+      s = doubleSymbol => ["double precision"]$Rep
+      s = upperDoubleSymbol => ["double precision"]$Rep
+      s = doubleComplexSymbol => ["double complex"]$Rep
+      s = upperDoubleCOmplexSymbol => ["double complex"]$Rep
 
-See Also:
-o )show FreeAbelianMonoid
+    coerce(s:String):$ ==
+      s = "real" => ["real"]$Rep
+      s = "integer" => ["integer"]$Rep
+      s = "complex" => ["complex"]$Rep
+      s = "character" => ["character"]$Rep
+      s = "logical" => ["logical"]$Rep
+      s = "double precision" => ["double precision"]$Rep
+      s = "double complex" => ["double complex"]$Rep
+      s = "REAL" => ["real"]$Rep
+      s = "INTEGER" => ["integer"]$Rep
+      s = "COMPLEX" => ["complex"]$Rep
+      s = "CHARACTER" => ["character"]$Rep
+      s = "LOGICAL" => ["logical"]$Rep
+      s = "DOUBLE PRECISION" => ["double precision"]$Rep
+      s = "DOUBLE COMPLEX" => ["double complex"]$Rep
+      error concat([s," is invalid as a Fortran Type"])$String
 
-\end{chunk}
+    real?(t:$):Boolean == t case RealThing
 
-\pagehead{FreeAbelianMonoid}{FAMONOID}
-\pagepic{ps/v103freeabelianmonoid.ps}{FAMONOID}{1.00}
-{\bf See}\\
-\pageto{ListMonoidOps}{LMOPS}
-\pageto{FreeMonoid}{FMONOID}
-\pageto{FreeGroup}{FGROUP}
-\pageto{InnerFreeAbelianMonoid}{IFAMON}
-\pageto{FreeAbelianGroup}{FAGROUP}
+    double?(t:$):Boolean == t case DoublePrecisionThing
 
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{FAMONOID}{0} &
-\cross{FAMONOID}{coefficient} &
-\cross{FAMONOID}{coerce} &
-\cross{FAMONOID}{hash} &
-\cross{FAMONOID}{highCommonTerms} \\
-\cross{FAMONOID}{latex} &
-\cross{FAMONOID}{mapCoef} &
-\cross{FAMONOID}{mapGen} &
-\cross{FAMONOID}{nthCoef} &
-\cross{FAMONOID}{nthFactor} \\
-\cross{FAMONOID}{retract} &
-\cross{FAMONOID}{retractIfCan} &
-\cross{FAMONOID}{sample} &
-\cross{FAMONOID}{size} &
-\cross{FAMONOID}{subtractIfCan} \\
-\cross{FAMONOID}{terms} &
-\cross{FAMONOID}{zero?} &
-\cross{FAMONOID}{?\~{}=?} &
-\cross{FAMONOID}{?*?} &
-\cross{FAMONOID}{?+?} \\
-\cross{FAMONOID}{?=?} &&&&
-\end{tabular}
+    logical?(t:$):Boolean == t case LogicalThing
 
-\begin{chunk}{domain FAMONOID FreeAbelianMonoid}
-)abbrev domain FAMONOID FreeAbelianMonoid
-++ Author: Manuel Bronstein
-++ Date Created: November 1989
-++ Date Last Updated: 6 June 1991
-++ Description:
-++ Free abelian monoid on any set of generators
-++ The free abelian monoid on a set S is the monoid of finite sums of
-++ the form \spad{reduce(+,[ni * si])} where the si's are in S, and the ni's
-++ are non-negative integers. The operation is commutative.
+    integer?(t:$):Boolean == t case IntegerThing
 
-FreeAbelianMonoid(S: SetCategory):
-  FreeAbelianMonoidCategory(S, NonNegativeInteger)
-    == InnerFreeAbelianMonoid(S, NonNegativeInteger, 1)
+    character?(t:$):Boolean == t case CharacterThing
+
+    complex?(t:$):Boolean == t case ComplexThing
+
+    doubleComplex?(t:$):Boolean == t case DoubleComplexThing
 
 \end{chunk}
 
-\begin{chunk}{COQ FAMONOID}
-(* domain FAMONOID *)
+\begin{chunk}{COQ FST}
+(* domain FST *)
 (*
+
+    U == Union(RealThing:"real",
+               IntegerThing:"integer",
+               ComplexThing:"complex",
+               CharacterThing:"character",
+               LogicalThing:"logical",
+               DoublePrecisionThing:"double precision",
+               DoubleComplexThing:"double complex")
+    Rep := U
+
+    doubleSymbol : Symbol := "double precision"::Symbol
+
+    upperDoubleSymbol : Symbol := "DOUBLE PRECISION"::Symbol
+
+    doubleComplexSymbol : Symbol := "double complex"::Symbol
+
+    upperDoubleComplexSymbol : Symbol := "DOUBLE COMPLEX"::Symbol
+
+    u = v ==
+      u case RealThing and v case RealThing => true
+      u case IntegerThing and v case IntegerThing => true
+      u case ComplexThing and v case ComplexThing => true
+      u case LogicalThing and v case LogicalThing => true
+      u case CharacterThing and v case CharacterThing => true
+      u case DoublePrecisionThing and v case DoublePrecisionThing => true
+      u case DoubleComplexThing and v case DoubleComplexThing => true
+      false
+
+    coerce(t:$):OutputForm ==
+      t case RealThing => coerce(REAL)$Symbol
+      t case IntegerThing => coerce(INTEGER)$Symbol
+      t case ComplexThing => coerce(COMPLEX)$Symbol
+      t case CharacterThing => coerce(CHARACTER)$Symbol
+      t case DoublePrecisionThing => coerce(upperDoubleSymbol)$Symbol
+      t case DoubleComplexThing => coerce(upperDoubleComplexSymbol)$Symbol
+      coerce(LOGICAL)$Symbol
+
+    coerce(t:$):SExpression ==
+      t case RealThing => convert(real::Symbol)@SExpression
+      t case IntegerThing => convert(integer::Symbol)@SExpression
+      t case ComplexThing => convert(complex::Symbol)@SExpression
+      t case CharacterThing => convert(character::Symbol)@SExpression
+      t case DoublePrecisionThing => convert(doubleSymbol)@SExpression
+      t case DoubleComplexThing => convert(doubleComplexSymbol)@SExpression
+      convert(logical::Symbol)@SExpression
+
+    coerce(t:$):Symbol ==
+      t case RealThing => real::Symbol
+      t case IntegerThing => integer::Symbol
+      t case ComplexThing => complex::Symbol
+      t case CharacterThing => character::Symbol
+      t case DoublePrecisionThing => doubleSymbol
+      t case DoublePrecisionThing => doubleComplexSymbol
+      logical::Symbol
+
+    coerce(s:Symbol):$ ==
+      s = real => ["real"]$Rep
+      s = REAL => ["real"]$Rep
+      s = integer => ["integer"]$Rep
+      s = INTEGER => ["integer"]$Rep
+      s = complex => ["complex"]$Rep
+      s = COMPLEX => ["complex"]$Rep
+      s = character => ["character"]$Rep
+      s = CHARACTER => ["character"]$Rep
+      s = logical => ["logical"]$Rep
+      s = LOGICAL => ["logical"]$Rep
+      s = doubleSymbol => ["double precision"]$Rep
+      s = upperDoubleSymbol => ["double precision"]$Rep
+      s = doubleComplexSymbol => ["double complex"]$Rep
+      s = upperDoubleCOmplexSymbol => ["double complex"]$Rep
+
+    coerce(s:String):$ ==
+      s = "real" => ["real"]$Rep
+      s = "integer" => ["integer"]$Rep
+      s = "complex" => ["complex"]$Rep
+      s = "character" => ["character"]$Rep
+      s = "logical" => ["logical"]$Rep
+      s = "double precision" => ["double precision"]$Rep
+      s = "double complex" => ["double complex"]$Rep
+      s = "REAL" => ["real"]$Rep
+      s = "INTEGER" => ["integer"]$Rep
+      s = "COMPLEX" => ["complex"]$Rep
+      s = "CHARACTER" => ["character"]$Rep
+      s = "LOGICAL" => ["logical"]$Rep
+      s = "DOUBLE PRECISION" => ["double precision"]$Rep
+      s = "DOUBLE COMPLEX" => ["double complex"]$Rep
+      error concat([s," is invalid as a Fortran Type"])$String
+
+    real?(t:$):Boolean == t case RealThing
+
+    double?(t:$):Boolean == t case DoublePrecisionThing
+
+    logical?(t:$):Boolean == t case LogicalThing
+
+    integer?(t:$):Boolean == t case IntegerThing
+
+    character?(t:$):Boolean == t case CharacterThing
+
+    complex?(t:$):Boolean == t case ComplexThing
+
+    doubleComplex?(t:$):Boolean == t case DoubleComplexThing
+
 *)
 
 \end{chunk}
 
-\begin{chunk}{FAMONOID.dotabb}
-"FAMONOID" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FAMONOID"]
-"OAMONS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAMONS"]
-"FAMONOID" -> "OAMONS"
+\begin{chunk}{FST.dotabb}
+"FST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FST"]
+"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
+"FST" -> "ALIST"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FGROUP FreeGroup}
+\section{domain FTEM FortranTemplate}
 
-\begin{chunk}{FreeGroup.input}
+\begin{chunk}{FortranTemplate.input}
 )set break resume
-)sys rm -f FreeGroup.output
-)spool FreeGroup.output
+)sys rm -f FortranTemplate.output
+)spool FortranTemplate.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show FreeGroup
+)show FortranTemplate
 --R 
---R FreeGroup(S: SetCategory)  is a domain constructor
---R Abbreviation for FreeGroup is FGROUP 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FGROUP 
+--R FortranTemplate  is a domain constructor
+--R Abbreviation for FortranTemplate is FTEM 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FTEM 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (%,S) -> %                      ?*? : (S,%) -> %
---R ?*? : (%,%) -> %                      ?**? : (S,Integer) -> %
---R ?**? : (%,Integer) -> %               ?**? : (%,NonNegativeInteger) -> %
---R ?**? : (%,PositiveInteger) -> %       ?/? : (%,%) -> %
---R ?=? : (%,%) -> Boolean                1 : () -> %
---R ?^? : (%,Integer) -> %                ?^? : (%,NonNegativeInteger) -> %
---R ?^? : (%,PositiveInteger) -> %        coerce : S -> %
---R coerce : % -> OutputForm              commutator : (%,%) -> %
---R conjugate : (%,%) -> %                hash : % -> SingleInteger
---R inv : % -> %                          latex : % -> String
---R mapGen : ((S -> S),%) -> %            nthExpon : (%,Integer) -> Integer
---R nthFactor : (%,Integer) -> S          one? : % -> Boolean
---R recip : % -> Union(%,"failed")        retract : % -> S
---R sample : () -> %                      size : % -> NonNegativeInteger
+--R ?=? : (%,%) -> Boolean                close! : % -> %
+--R coerce : % -> OutputForm              flush : % -> Void
+--R fortranCarriageReturn : () -> Void    fortranLiteral : String -> Void
+--R fortranLiteralLine : String -> Void   hash : % -> SingleInteger
+--R iomode : % -> String                  latex : % -> String
+--R name : % -> FileName                  open : (FileName,String) -> %
+--R open : FileName -> %                  read! : % -> String
+--R reopen! : (%,String) -> %             write! : (%,String) -> String
 --R ?~=? : (%,%) -> Boolean              
---R factors : % -> List(Record(gen: S,exp: Integer))
---R mapExpon : ((Integer -> Integer),%) -> %
---R retractIfCan : % -> Union(S,"failed")
+--R processTemplate : FileName -> FileName
+--R processTemplate : (FileName,FileName) -> FileName
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{FreeGroup.help}
+\begin{chunk}{FortranTemplate.help}
 ====================================================================
-FreeGroup examples
+FortranTemplate examples
 ====================================================================
 
-Free group on any set of generators
-The free group on a set S is the group of finite products of
-the form reduce(*,[si ** ni]) where the si's are in S, and the ni's
-are integers. The multiplication is not commutative.
+Code to manipulate Fortran templates
 
 See Also:
-o )show FreeGroup
+o )show FortranTemplate
 
 \end{chunk}
 
-\pagehead{FreeGroup}{FGROUP}
-\pagepic{ps/v103freegroup.ps}{FGROUP}{1.00}
+\pagehead{FortranTemplate}{FTEM}
+\pagepic{ps/v103fortrantemplate.ps}{FTEM}{1.00}
 {\bf See}\\
-\pageto{ListMonoidOps}{LMOPS}
-\pageto{FreeMonoid}{FMONOID}
-\pageto{InnerFreeAbelianMonoid}{IFAMON}
-\pageto{FreeAbelianMonoid}{FAMONOID}
-\pageto{FreeAbelianGroup}{FAGROUP}
+\pageto{Result}{RESULT}
+\pageto{FortranCode}{FC}
+\pageto{FortranProgram}{FORTRAN}
+\pageto{ThreeDimensionalMatrix}{M3D}
+\pageto{SimpleFortranProgram}{SFORT}
+\pageto{Switch}{SWITCH}
+\pageto{FortranExpression}{FEXPR}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{FGROUP}{1} &
-\cross{FGROUP}{coerce} &
-\cross{FGROUP}{commutator} &
-\cross{FGROUP}{conjugate} &
-\cross{FGROUP}{factors} \\
-\cross{FGROUP}{hash} &
-\cross{FGROUP}{inv} &
-\cross{FGROUP}{latex} &
-\cross{FGROUP}{mapExpon} &
-\cross{FGROUP}{mapGen} \\
-\cross{FGROUP}{nthExpon} &
-\cross{FGROUP}{nthFactor} &
-\cross{FGROUP}{one?} &
-\cross{FGROUP}{recip} &
-\cross{FGROUP}{retract} \\
-\cross{FGROUP}{retractIfCan} &
-\cross{FGROUP}{sample} &
-\cross{FGROUP}{size} &
-\cross{FGROUP}{?\~{}=?} &
-\cross{FGROUP}{?**?} \\
-\cross{FGROUP}{?\^{}?} &
-\cross{FGROUP}{?*?} &
-\cross{FGROUP}{?/?} &
-\cross{FGROUP}{?=?} &
+\cross{FTEM}{close!} &
+\cross{FTEM}{coerce} &
+\cross{FTEM}{fortranCarriageReturn} &
+\cross{FTEM}{fortranLiteral} &
+\cross{FTEM}{fortranLiteralLine} \\
+\cross{FTEM}{hash} &
+\cross{FTEM}{iomode} &
+\cross{FTEM}{latex} &
+\cross{FTEM}{name} &
+\cross{FTEM}{open} \\
+\cross{FTEM}{processTemplate} &
+\cross{FTEM}{read!} &
+\cross{FTEM}{reopen!} &
+\cross{FTEM}{write!} &
+\cross{FTEM}{?=?} \\
+\cross{FTEM}{?\~{}=?} &&&&
 \end{tabular}
 
-\begin{chunk}{domain FGROUP FreeGroup}
-)abbrev domain FGROUP FreeGroup
-++ Author: Stephen M. Watt
-++ Date Last Updated: 6 June 1991
+\begin{chunk}{domain FTEM FortranTemplate}
+)abbrev domain FTEM FortranTemplate
+++ Author: Mike Dewar
+++ Date Created:  October 1992
 ++ Description:
-++ Free group on any set of generators
-++ The free group on a set S is the group of finite products of
-++ the form \spad{reduce(*,[si ** ni])} where the si's are in S, and the ni's
-++ are integers. The multiplication is not commutative.
+++ Code to manipulate Fortran templates
 
-FreeGroup(S: SetCategory): Join(Group, RetractableTo S) with
-        "*":    (S, $) -> $
-          ++ s * x returns the product of x by s on the left.
-        "*":    ($, S) -> $
-          ++ x * s returns the product of x by s on the right.
-        "**"         : (S, Integer) -> $
-          ++ s ** n returns the product of s by itself n times.
-        size         : $ -> NonNegativeInteger
-          ++ size(x) returns the number of monomials in x.
-        nthExpon     : ($, Integer) -> Integer
-          ++ nthExpon(x, n) returns the exponent of the n^th monomial of x.
-        nthFactor    : ($, Integer) -> S
-          ++ nthFactor(x, n) returns the factor of the n^th monomial of x.
-        mapExpon     : (Integer -> Integer, $) -> $
-          ++ mapExpon(f, a1\^e1 ... an\^en) returns 
-          ++ \spad{a1\^f(e1) ... an\^f(en)}.
-        mapGen       : (S -> S, $) -> $
-          ++ mapGen(f, a1\^e1 ... an\^en) returns 
-          ++ \spad{f(a1)\^e1 ... f(an)\^en}.
-        factors      : $ -> List Record(gen: S, exp: Integer)
-          ++ factors(a1\^e1,...,an\^en) returns \spad{[[a1, e1],...,[an, en]]}.
-    == ListMonoidOps(S, Integer, 1) add
-        Rep := ListMonoidOps(S, Integer, 1)
+FortranTemplate() : specification == implementation where
 
-        1                       == makeUnit()
-        one? f                  == empty? listOfMonoms f
-        s:S ** n:Integer        == makeTerm(s, n)
-        f:$ * s:S               == rightMult(f, s)
-        s:S * f:$               == leftMult(s, f)
-        inv f                   == reverse_! mapExpon("-", f)
-        factors f               == copy listOfMonoms f
-        mapExpon(f, x)          == mapExpon(f, x)$Rep
-        mapGen(f, x)            == mapGen(f, x)$Rep
-        coerce(f:$):OutputForm  == outputForm(f, "*", "**", 1)
+  specification == FileCategory(FileName, String) with
 
-        f:$ * g:$ ==
-            one? f => g
-            one? g => f
-            r := reverse listOfMonoms f
-            q := copy listOfMonoms g
-            while not empty? r and not empty? q and r.first.gen = q.first.gen
-                and r.first.exp = -q.first.exp repeat
-                     r := rest r
-                     q := rest q
-            empty? r => makeMulti q
-            empty? q => makeMulti reverse_! r
-            r.first.gen = q.first.gen =>
-              setlast_!(h := reverse_! r,
-                                [q.first.gen, q.first.exp + r.first.exp])
-              makeMulti concat_!(h, rest q)
-            makeMulti concat_!(reverse_! r, q)
+    processTemplate : (FileName, FileName) -> FileName
+      ++ processTemplate(tp,fn) processes the template tp, writing the
+      ++ result out to fn.
+    processTemplate : (FileName) -> FileName
+      ++ processTemplate(tp) processes the template tp, writing the
+      ++ result to the current FORTRAN output stream.
+    fortranLiteralLine : String -> Void
+      ++ fortranLiteralLine(s) writes s to the current Fortran output stream,
+      ++ followed by a carriage return
+    fortranLiteral : String -> Void
+      ++ fortranLiteral(s) writes s to the current Fortran output stream
+    fortranCarriageReturn : () -> Void
+      ++ fortranCarriageReturn() produces a carriage return on the current
+      ++ Fortran output stream
+
+  implementation == TextFile add
+
+    import TemplateUtilities
+    import FortranOutputStackPackage
+
+    Rep := TextFile
+
+    fortranLiteralLine(s:String):Void ==
+      PRINC(s,_$fortranOutputStream$Lisp)$Lisp
+      TERPRI(_$fortranOutputStream$Lisp)$Lisp 
+
+    fortranLiteral(s:String):Void ==
+      PRINC(s,_$fortranOutputStream$Lisp)$Lisp
+
+    fortranCarriageReturn():Void ==
+      TERPRI(_$fortranOutputStream$Lisp)$Lisp
+
+    writePassiveLine!(line:String):Void ==
+    -- We might want to be a bit clever here and look for new SubPrograms etc.
+      fortranLiteralLine line
+
+    processTemplate(tp:FileName, fn:FileName):FileName == 
+      pushFortranOutputStack(fn)
+      processTemplate(tp)
+      popFortranOutputStack()
+      fn
+
+    getLine(fp:TextFile):String ==
+      line : String := stripCommentsAndBlanks readLine!(fp)
+      while not empty?(line) and elt(line,maxIndex line) = char "__" repeat
+        setelt(line,maxIndex line,char " ")
+        line := concat(line, stripCommentsAndBlanks readLine!(fp))$String
+      line
+
+    processTemplate(tp:FileName):FileName == 
+      fp : TextFile := open(tp,"input")
+      active : Boolean := true
+      line : String
+      endInput : Boolean := false
+      while not (endInput or endOfFile? fp) repeat
+        if active then
+          line := getLine fp
+          line = "endInput" => endInput := true
+          if line = "beginVerbatim" then
+            active := false
+          else
+            not empty? line => interpretString line
+        else
+          line := readLine!(fp)
+          if line = "endVerbatim" then
+            active := true
+          else
+            writePassiveLine! line
+      close!(fp)
+      if not active then 
+        error concat(["Missing `endVerbatim' line in ",tp::String])$String
+      string(_$fortranOutputFile$Lisp)::FileName
 
 \end{chunk}
 
-\begin{chunk}{COQ FGROUP}
-(* domain FGROUP *)
+\begin{chunk}{COQ FTEM}
+(* domain FTEM *)
 (*
+
+    import TemplateUtilities
+    import FortranOutputStackPackage
+
+    Rep := TextFile
+
+    fortranLiteralLine(s:String):Void ==
+      PRINC(s,_$fortranOutputStream$Lisp)$Lisp
+      TERPRI(_$fortranOutputStream$Lisp)$Lisp 
+
+    fortranLiteral(s:String):Void ==
+      PRINC(s,_$fortranOutputStream$Lisp)$Lisp
+
+    fortranCarriageReturn():Void ==
+      TERPRI(_$fortranOutputStream$Lisp)$Lisp
+
+    writePassiveLine!(line:String):Void ==
+    -- We might want to be a bit clever here and look for new SubPrograms etc.
+      fortranLiteralLine line
+
+    processTemplate(tp:FileName, fn:FileName):FileName == 
+      pushFortranOutputStack(fn)
+      processTemplate(tp)
+      popFortranOutputStack()
+      fn
+
+    getLine(fp:TextFile):String ==
+      line : String := stripCommentsAndBlanks readLine!(fp)
+      while not empty?(line) and elt(line,maxIndex line) = char "__" repeat
+        setelt(line,maxIndex line,char " ")
+        line := concat(line, stripCommentsAndBlanks readLine!(fp))$String
+      line
+
+    processTemplate(tp:FileName):FileName == 
+      fp : TextFile := open(tp,"input")
+      active : Boolean := true
+      line : String
+      endInput : Boolean := false
+      while not (endInput or endOfFile? fp) repeat
+        if active then
+          line := getLine fp
+          line = "endInput" => endInput := true
+          if line = "beginVerbatim" then
+            active := false
+          else
+            not empty? line => interpretString line
+        else
+          line := readLine!(fp)
+          if line = "endVerbatim" then
+            active := true
+          else
+            writePassiveLine! line
+      close!(fp)
+      if not active then 
+        error concat(["Missing `endVerbatim' line in ",tp::String])$String
+      string(_$fortranOutputFile$Lisp)::FileName
+
 *)
 
 \end{chunk}
 
-\begin{chunk}{FGROUP.dotabb}
-"FGROUP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FGROUP"]
-"FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"]
-"FLAGG-" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FLAGG"]
-"FGROUP" -> "FLAGG"
-"FGROUP" -> "FLAGG-"
+\begin{chunk}{FTEM.dotabb}
+"FTEM" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FTEM"]
+"STRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=STRING"]
+"FTEM" -> "STRING"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FM FreeModule}
+\section{domain FT FortranType}
 
-\begin{chunk}{FreeModule.input}
+\begin{chunk}{FortranType.input}
 )set break resume
-)sys rm -f FreeModule.output
-)spool FreeModule.output
+)sys rm -f FortranType.output
+)spool FortranType.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show FreeModule
+)show FortranType
 --R 
---R FreeModule(R: Ring,S: OrderedSet)  is a domain constructor
---R Abbreviation for FreeModule is FM 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FM 
+--R FortranType  is a domain constructor
+--R Abbreviation for FortranType is FT 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FT 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (%,R) -> %                      ?*? : (R,%) -> %
---R ?*? : (Integer,%) -> %                ?*? : (NonNegativeInteger,%) -> %
---R ?*? : (PositiveInteger,%) -> %        ?+? : (%,%) -> %
---R ?-? : (%,%) -> %                      -? : % -> %
---R ?=? : (%,%) -> Boolean                0 : () -> %
---R coerce : % -> OutputForm              hash : % -> SingleInteger
---R latex : % -> String                   leadingCoefficient : % -> R
---R leadingSupport : % -> S               map : ((R -> R),%) -> %
---R monomial : (R,S) -> %                 reductum : % -> %
---R sample : () -> %                      zero? : % -> Boolean
---R ?~=? : (%,%) -> Boolean              
---R subtractIfCan : (%,%) -> Union(%,"failed")
+--R ?=? : (%,%) -> Boolean                coerce : FortranScalarType -> %
+--R coerce : % -> OutputForm              external? : % -> Boolean
+--R fortranCharacter : () -> %            fortranComplex : () -> %
+--R fortranDouble : () -> %               fortranDoubleComplex : () -> %
+--R fortranInteger : () -> %              fortranLogical : () -> %
+--R fortranReal : () -> %                 hash : % -> SingleInteger
+--R latex : % -> String                   ?~=? : (%,%) -> Boolean
+--R construct : (Union(fst: FortranScalarType,void: void),List(Polynomial(Integer)),Boolean) -> %
+--R construct : (Union(fst: FortranScalarType,void: void),List(Symbol),Boolean) -> %
+--R dimensionsOf : % -> List(Polynomial(Integer))
+--R scalarTypeOf : % -> Union(fst: FortranScalarType,void: void)
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{FreeModule.help}
+\begin{chunk}{FortranType.help}
 ====================================================================
-FreeModule examples
+FortranType examples
 ====================================================================
 
-A bi-module is a free module over a ring with generators indexed by an
-ordered set.  Each element can be expressed as a finite linear
-combination of generators. Only non-zero terms are stored.
+Creates and manipulates objects which correspond to FORTRAN data types, 
+including array dimensions.
 
 See Also:
-o )show FreeModule
+o )show FortranType
 
 \end{chunk}
 
-\pagehead{FreeModule}{FM}
-\pagepic{ps/v103freemodule.ps}{FM}{1.00}
+\pagehead{FortranType}{FT}
+\pagepic{ps/v103fortrantype.ps}{FT}{1.00}
 {\bf See}\\
-\pageto{PolynomialRing}{PR}
-\pageto{SparseUnivariatePolynomial}{SUP}
-\pageto{UnivariatePolynomial}{UP}
+\pageto{FortranScalarType}{FST}
+\pageto{SymbolTable}{SYMTAB}
+\pageto{TheSymbolTable}{SYMS}
 
 {\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{FM}{0} &
-\cross{FM}{coerce} &
-\cross{FM}{hash} &
-\cross{FM}{latex} &
-\cross{FM}{leadingCoefficient} \\
-\cross{FM}{leadingSupport} &
-\cross{FM}{map} &
-\cross{FM}{monomial} &
-\cross{FM}{reductum} &
-\cross{FM}{sample} \\
-\cross{FM}{subtractIfCan} &
-\cross{FM}{zero?} &
-\cross{FM}{?\~{}=?} &
-\cross{FM}{?*?} &
-\cross{FM}{?+?} \\
-\cross{FM}{?-?} &
-\cross{FM}{-?} &
-\cross{FM}{?=?} &&
+\begin{tabular}{llll}
+\cross{FT}{coerce} &
+\cross{FT}{construct} &
+\cross{FT}{dimensionsOf} &
+\cross{FT}{external?} \\
+\cross{FT}{fortranCharacter} &
+\cross{FT}{fortranComplex} &
+\cross{FT}{fortranDouble} &
+\cross{FT}{fortranDoubleComplex} \\
+\cross{FT}{fortranInteger} &
+\cross{FT}{fortranLogical} &
+\cross{FT}{fortranReal} &
+\cross{FT}{hash} \\
+\cross{FT}{latex} &
+\cross{FT}{scalarTypeOf} &
+\cross{FT}{?=?} &
+\cross{FT}{?\~{}=?} 
 \end{tabular}
 
-\begin{chunk}{domain FM FreeModule}
-)abbrev domain FM FreeModule
-++ Author: Dave Barton, James Davenport, Barry Trager
-++ Description:
-++ A bi-module is a free module
-++ over a ring with generators indexed by an ordered set.
-++ Each element can be expressed as a finite linear combination of
-++ generators. Only non-zero terms are stored.
+\begin{chunk}{domain FT FortranType}
+)abbrev domain FT FortranType
+++ Author: Mike Dewar
+++ Date Created:  October 1992
+++ Description: 
+++ Creates and manipulates objects which correspond to FORTRAN
+++ data types, including array dimensions.
 
-FreeModule(R:Ring,S:OrderedSet):
-        Join(BiModule(R,R),IndexedDirectProductCategory(R,S)) with
-    if R has CommutativeRing then Module(R)
- == IndexedDirectProductAbelianGroup(R,S) add
-    --representations
-       Term:=  Record(k:S,c:R)
-       Rep:=  List Term
-    --declarations
-       x,y: %
-       r: R
-       n: Integer
-       f: R -> R
-       s: S
-    --define
-       if R has EntireRing then 
-         r * x  ==
-             zero? r => 0
---             one? r => x
-             (r = 1) => x
-           --map(r*#1,x)
-             [[u.k,r*u.c] for u in x ]
-       else
-         r * x  ==
-             zero? r => 0
---             one? r => x
-             (r = 1) => x
-           --map(r*#1,x)
-             [[u.k,a] for u in x | (a:=r*u.c) ^= 0$R]
-       if R has EntireRing then
-         x * r  ==
-             zero? r => 0
---             one? r => x
-             (r = 1) => x
-           --map(r*#1,x)
-             [[u.k,u.c*r] for u in x ]
-       else
-         x * r  ==
-             zero? r => 0
---             one? r => x
-             (r = 1) => x
-           --map(r*#1,x)
-             [[u.k,a] for u in x | (a:=u.c*r) ^= 0$R]
+FortranType() : exports == implementation where
 
-       coerce(x) : OutputForm ==
-         null x => (0$R) :: OutputForm
-         le : List OutputForm := nil
-         for rec in reverse x repeat
-           rec.c = 1 => le := cons(rec.k :: OutputForm, le)
-           le := cons(rec.c :: OutputForm *  rec.k :: OutputForm, le)
-         reduce("+",le)
+  FST    ==> FortranScalarType
+  FSTU   ==> Union(fst:FST,void:"void")
+
+  exports == SetCategory with
+    coerce : $ -> OutputForm
+      ++ coerce(x) provides a printable form for x
+    coerce : FST -> $
+      ++ coerce(t) creates an element from a scalar type
+    scalarTypeOf : $ -> FSTU
+      ++ scalarTypeOf(t) returns the FORTRAN data type of t
+    dimensionsOf : $ -> List Polynomial Integer
+      ++ dimensionsOf(t) returns the dimensions of t
+    external? : $ -> Boolean
+      ++ external?(u) returns true if u is declared to be EXTERNAL
+    construct : (FSTU,List Symbol,Boolean) -> $
+      ++ construct(type,dims) creates an element of FortranType
+    construct : (FSTU,List Polynomial Integer,Boolean) -> $
+      ++ construct(type,dims) creates an element of FortranType
+    fortranReal : () -> $
+      ++ fortranReal() returns REAL, an element of FortranType
+    fortranDouble : () -> $
+      ++ fortranDouble() returns DOUBLE PRECISION, an element of FortranType
+    fortranInteger : () -> $
+      ++ fortranInteger() returns INTEGER, an element of FortranType
+    fortranLogical : () -> $
+      ++ fortranLogical() returns LOGICAL, an element of FortranType
+    fortranComplex : () -> $
+      ++ fortranComplex() returns COMPLEX, an element of FortranType
+    fortranDoubleComplex: () -> $
+      ++ fortranDoubleComplex() returns DOUBLE COMPLEX, an element of 
+      ++ FortranType
+    fortranCharacter : () -> $
+      ++ fortranCharacter() returns CHARACTER, an element of FortranType
+
+  implementation == add
+
+    Dims == List Polynomial Integer
+
+    Rep := Record(type : FSTU, dimensions : Dims, external : Boolean)
+
+    coerce(a:$):OutputForm ==
+     t : OutputForm
+     if external?(a) then
+      if scalarTypeOf(a) case void then
+        t := "EXTERNAL"::OutputForm
+      else
+        t := blankSeparate(["EXTERNAL"::OutputForm,
+                           coerce(scalarTypeOf a)$FSTU])$OutputForm
+     else
+      t := coerce(scalarTypeOf a)$FSTU
+     empty? dimensionsOf(a) => t
+     sub(t,
+         paren([u::OutputForm for u in dimensionsOf(a)])$OutputForm)$OutputForm
+
+    scalarTypeOf(u:$):FSTU ==
+      u.type
+
+    dimensionsOf(u:$):Dims ==
+      u.dimensions
+
+    external?(u:$):Boolean ==
+      u.external
+
+    construct(t:FSTU, d:List Symbol, e:Boolean):$ ==
+      e and not empty? d => error "EXTERNAL objects cannot have dimensions"
+      not(e) and t case void => error "VOID objects must be EXTERNAL"
+      construct(t,[l::Polynomial(Integer) for l in d],e)$Rep
+
+    construct(t:FSTU, d:List Polynomial Integer, e:Boolean):$ ==
+      e and not empty? d => error "EXTERNAL objects cannot have dimensions"
+      not(e) and t case void => error "VOID objects must be EXTERNAL"
+      construct(t,d,e)$Rep
+
+    coerce(u:FST):$ ==
+      construct([u]$FSTU,[]@List Polynomial Integer,false)
+
+    fortranReal():$ == ("real"::FST)::$
+
+    fortranDouble():$ == ("double precision"::FST)::$
+
+    fortranInteger():$ == ("integer"::FST)::$
+
+    fortranComplex():$ == ("complex"::FST)::$
+
+    fortranDoubleComplex():$ == ("double complex"::FST)::$
+
+    fortranCharacter():$ == ("character"::FST)::$
+
+    fortranLogical():$ == ("logical"::FST)::$
 
 \end{chunk}
 
-\begin{chunk}{COQ FM}
-(* domain FM *)
+\begin{chunk}{COQ FT}
+(* domain FT *)
 (*
+
+    Dims == List Polynomial Integer
+
+    Rep := Record(type : FSTU, dimensions : Dims, external : Boolean)
+
+    coerce(a:$):OutputForm ==
+     t : OutputForm
+     if external?(a) then
+      if scalarTypeOf(a) case void then
+        t := "EXTERNAL"::OutputForm
+      else
+        t := blankSeparate(["EXTERNAL"::OutputForm,
+                           coerce(scalarTypeOf a)$FSTU])$OutputForm
+     else
+      t := coerce(scalarTypeOf a)$FSTU
+     empty? dimensionsOf(a) => t
+     sub(t,
+         paren([u::OutputForm for u in dimensionsOf(a)])$OutputForm)$OutputForm
+
+    scalarTypeOf(u:$):FSTU ==
+      u.type
+
+    dimensionsOf(u:$):Dims ==
+      u.dimensions
+
+    external?(u:$):Boolean ==
+      u.external
+
+    construct(t:FSTU, d:List Symbol, e:Boolean):$ ==
+      e and not empty? d => error "EXTERNAL objects cannot have dimensions"
+      not(e) and t case void => error "VOID objects must be EXTERNAL"
+      construct(t,[l::Polynomial(Integer) for l in d],e)$Rep
+
+    construct(t:FSTU, d:List Polynomial Integer, e:Boolean):$ ==
+      e and not empty? d => error "EXTERNAL objects cannot have dimensions"
+      not(e) and t case void => error "VOID objects must be EXTERNAL"
+      construct(t,d,e)$Rep
+
+    coerce(u:FST):$ ==
+      construct([u]$FSTU,[]@List Polynomial Integer,false)
+
+    fortranReal():$ == ("real"::FST)::$
+
+    fortranDouble():$ == ("double precision"::FST)::$
+
+    fortranInteger():$ == ("integer"::FST)::$
+
+    fortranComplex():$ == ("complex"::FST)::$
+
+    fortranDoubleComplex():$ == ("double complex"::FST)::$
+
+    fortranCharacter():$ == ("character"::FST)::$
+
+    fortranLogical():$ == ("logical"::FST)::$
+
 *)
 
 \end{chunk}
 
-\begin{chunk}{FM.dotabb}
-"FM" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FM"]
-"FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"]
-"FM" -> "FLAGG"
+\begin{chunk}{FT.dotabb}
+"FT" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FT"]
+"PID" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PID"]
+"OAGROUP" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAGROUP"]
+"FT" -> "PID"
+"FT" -> "OAGROUP"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FM1 FreeModule1}
+\section{domain FCOMP FourierComponent}
 
-\begin{chunk}{FreeModule1.input}
+\begin{chunk}{FourierComponent.input}
 )set break resume
-)sys rm -f FreeModule1.output
-)spool FreeModule1.output
+)sys rm -f FourierComponent.output
+)spool FourierComponent.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show FreeModule1
+)show FourierComponent
 --R 
---R FreeModule1(R: Ring,S: OrderedSet)  is a domain constructor
---R Abbreviation for FreeModule1 is FM1 
+--R FourierComponent(E: OrderedSet)  is a domain constructor
+--R Abbreviation for FourierComponent is FCOMP 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FM1 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FCOMP 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (S,R) -> %                      ?*? : (R,S) -> %
---R ?*? : (%,R) -> %                      ?*? : (R,%) -> %
---R ?*? : (Integer,%) -> %                ?*? : (NonNegativeInteger,%) -> %
---R ?*? : (PositiveInteger,%) -> %        ?+? : (%,%) -> %
---R ?-? : (%,%) -> %                      -? : % -> %
---R ?=? : (%,%) -> Boolean                0 : () -> %
---R coefficient : (%,S) -> R              coefficients : % -> List(R)
---R coerce : S -> %                       coerce : % -> OutputForm
+--R ?<? : (%,%) -> Boolean                ?<=? : (%,%) -> Boolean
+--R ?=? : (%,%) -> Boolean                ?>? : (%,%) -> Boolean
+--R ?>=? : (%,%) -> Boolean               argument : % -> E
+--R coerce : % -> OutputForm              cos : E -> %
 --R hash : % -> SingleInteger             latex : % -> String
---R leadingCoefficient : % -> R           leadingMonomial : % -> S
---R map : ((R -> R),%) -> %               monom : (S,R) -> %
---R monomial? : % -> Boolean              monomials : % -> List(%)
---R reductum : % -> %                     retract : % -> S
---R sample : () -> %                      zero? : % -> Boolean
+--R max : (%,%) -> %                      min : (%,%) -> %
+--R sin : E -> %                          sin? : % -> Boolean
 --R ?~=? : (%,%) -> Boolean              
---R leadingTerm : % -> Record(k: S,c: R)
---R listOfTerms : % -> List(Record(k: S,c: R))
---R numberOfMonomials : % -> NonNegativeInteger
---R retractIfCan : % -> Union(S,"failed")
---R subtractIfCan : (%,%) -> Union(%,"failed")
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{FreeModule1.help}
+\begin{chunk}{FourierComponent.help}
 ====================================================================
-FreeModule1 examples
+FourierComponent examples
 ====================================================================
 
-This domain implements linear combinations of elements from the domain
-S with coefficients in the domain R where S is an ordered set and R is
-a ring (which may be non-commutative).  This domain is used by domains
-of non-commutative algebra such as: XDistributedPolynomial,
-XRecursivePolynomial.
+This domain creates kernels for use in Fourier series
 
 See Also:
-o )show FreeModule1
+o )show FourierComponent
 
 \end{chunk}
 
-\pagehead{FreeModule1}{FM1}
-\pagepic{ps/v103freemodule1.ps}{FM1}{1.00}
+\pagehead{FourierComponent}{FCOMP}
+\pagepic{ps/v103fouriercomponent.ps}{FCOMP}{1.00}
+{\bf See}\\
+\pageto{FourierSeries}{FSERIES}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{FM1}{0} &
-\cross{FM1}{coefficient} &
-\cross{FM1}{coefficients} &
-\cross{FM1}{coerce} &
-\cross{FM1}{hash} \\
-\cross{FM1}{latex} &
-\cross{FM1}{leadingCoefficient} &
-\cross{FM1}{leadingMonomial} &
-\cross{FM1}{leadingTerm} &
-\cross{FM1}{listOfTerms} \\
-\cross{FM1}{map} &
-\cross{FM1}{monom} &
-\cross{FM1}{monomial?} &
-\cross{FM1}{monomials} &
-\cross{FM1}{numberOfMonomials} \\
-\cross{FM1}{reductum} &
-\cross{FM1}{retract} &
-\cross{FM1}{retractIfCan} &
-\cross{FM1}{sample} &
-\cross{FM1}{subtractIfCan} \\
-\cross{FM1}{zero?} &
-\cross{FM1}{?\~{}=?} &
-\cross{FM1}{?*?} &
-\cross{FM1}{?+?} &
-\cross{FM1}{?-?} \\
-\cross{FM1}{-?} &
-\cross{FM1}{?=?} &&&
+\cross{FCOMP}{argument} &
+\cross{FCOMP}{coerce} &
+\cross{FCOMP}{cos} &
+\cross{FCOMP}{hash} &
+\cross{FCOMP}{latex} \\
+\cross{FCOMP}{max} &
+\cross{FCOMP}{min} &
+\cross{FCOMP}{sin} &
+\cross{FCOMP}{sin?} &
+\cross{FCOMP}{?\~{}=?} \\
+\cross{FCOMP}{?$<$?} &
+\cross{FCOMP}{?$<=$?} &
+\cross{FCOMP}{?=?} &
+\cross{FCOMP}{?$>$?} &
+\cross{FCOMP}{?$>=$?} 
 \end{tabular}
 
-\begin{chunk}{domain FM1 FreeModule1}
-)abbrev domain FM1 FreeModule1
-++ Author: Michel Petitot petitot@lifl.fr
-++ Date Created: 91
-++ Date Last Updated: 7 Juillet 92
-++ Fix History: compilation v 2.1 le 13 dec 98
-++ Description:
-++ This domain implements linear combinations
-++ of elements from the domain \spad{S} with coefficients
-++ in the domain \spad{R} where \spad{S} is an ordered set
-++ and \spad{R} is a ring (which may be non-commutative).
-++ This domain is used by domains of non-commutative algebra such as:
-++ XDistributedPolynomial, XRecursivePolynomial.
-
-FreeModule1(R:Ring,S:OrderedSet): FMcat == FMdef where
-  EX ==> OutputForm
-  TERM ==> Record(k:S,c:R)
-
-  FMcat == FreeModuleCat(R,S) with
-    "*":(S,R) -> %
-      ++ \spad{s*r} returns the product \spad{r*s}
-      ++ used by \spadtype{XRecursivePolynomial} 
-  FMdef == FreeModule(R,S) add
-    -- representation
-      Rep := List TERM  
-
-    -- declarations
-      lt: List TERM 
-      x : %
-      r : R
-      s : S
-
-    -- define
-      numberOfMonomials p ==
-         # (p::Rep)
-
-      listOfTerms(x) == x:List TERM 
-
-      leadingTerm x == x.first
-      leadingMonomial x == x.first.k
-      coefficients x == [t.c for t in x]
-      monomials x == [ monom (t.k, t.c) for t in x]
-
-      retractIfCan x ==
-         numberOfMonomials(x) ^= 1 => "failed"
-         x.first.c = 1 => x.first.k
-         "failed"
-
-      coerce(s:S):% == [[s,1$R]]
-      retract x ==
-         (rr := retractIfCan x) case "failed" => error "FM1.retract impossible"
-         rr :: S
-
-      if R has noZeroDivisors then
-         r * x  ==
-             r = 0 => 0
-             [[u.k,r * u.c]$TERM for u in x]
-         x * r  == 
-             r = 0 => 0
-             [[u.k,u.c * r]$TERM for u in x]
-       else
-         r * x  ==
-             r = 0 => 0
-             [[u.k,a] for u in x | not (a:=r*u.c)= 0$R]
-         x * r  ==
-             r = 0 => 0
-             [[u.k,a] for u in x | not (a:=u.c*r)= 0$R]
+\begin{chunk}{domain FCOMP FourierComponent}
+)abbrev domain FCOMP FourierComponent
+++ Author: James Davenport
+++ Date Created: 17 April 1992
+++ Date Last Updated: 12 June 1992
+++ Description: 
+++ This domain creates kernels for use in Fourier series
 
-      r * s ==
-        r = 0 => 0
-        [[s,r]$TERM]
+FourierComponent(E:OrderedSet):
+       OrderedSet with
+         sin: E -> $
+         ++ sin(x) makes a sin kernel for use in Fourier series
+         cos: E -> $
+         ++ cos(x) makes a cos kernel for use in Fourier series
+         sin?: $ -> Boolean
+         ++ sin?(x) returns true if term is a sin, otherwise false
+         argument: $ -> E
+         ++ argument(x) returns the argument of a given sin/cos expressions
+    ==
+  add
+   --representations
+   Rep:=Record(SinIfTrue:Boolean, arg:E)
+   e:E
+   x,y:$
 
-      s * r ==
-        r = 0 => 0
-        [[s,r]$TERM]
+   sin e == [true,e]
 
-      monom(b,r):% == [[b,r]$TERM] 
+   cos e == [false,e]
 
-      outTerm(r:R, s:S):EX ==
-            r=1  => s::EX
-            r::EX * s::EX
+   sin? x == x.SinIfTrue
 
-      coerce(a:%):EX ==
-            empty? a => (0$R)::EX
-            reduce(_+, reverse_! [outTerm(t.c, t.k) for t in a])$List(EX)
+   argument x == x.arg
 
-      coefficient(x,s) ==
-         null x => 0$R
-         x.first.k > s => coefficient(rest x,s)
-         x.first.k = s => x.first.c
-         0$R
+   coerce(x):OutputForm ==
+     hconcat((if x.SinIfTrue then "sin" else "cos")::OutputForm,
+              bracket((x.arg)::OutputForm))
+   x<y ==
+     x.arg < y.arg => true
+     y.arg < x.arg => false
+     x.SinIfTrue => false
+     y.SinIfTrue
 
 \end{chunk}
 
-\begin{chunk}{COQ FM1}
-(* domain FM1 *)
+\begin{chunk}{COQ FCOMP}
+(* domain FCOMP *)
 (*
-*)
-
-\end{chunk}
-
-\begin{chunk}{FM1.dotabb}
-"FM1" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FM1"]
-"FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"]
-"FM1" -> "FLAGG"
-
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FMONOID FreeMonoid}
-
-\begin{chunk}{FreeMonoid.input}
-)set break resume
-)sys rm -f FreeMonoid.output
-)spool FreeMonoid.output
-)set message test on
-)set message auto off
-)clear all
-
---S 1 of 1
-)show FreeMonoid
---R 
---R FreeMonoid(S: SetCategory)  is a domain constructor
---R Abbreviation for FreeMonoid is FMONOID 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FMONOID 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (%,S) -> %                      ?*? : (S,%) -> %
---R ?*? : (%,%) -> %                      ?**? : (S,NonNegativeInteger) -> %
---R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
---R ?=? : (%,%) -> Boolean                1 : () -> %
---R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
---R coerce : S -> %                       coerce : % -> OutputForm
---R hash : % -> SingleInteger             hclf : (%,%) -> %
---R hcrf : (%,%) -> %                     latex : % -> String
---R lquo : (%,%) -> Union(%,"failed")     mapGen : ((S -> S),%) -> %
---R max : (%,%) -> % if S has ORDSET      min : (%,%) -> % if S has ORDSET
---R nthFactor : (%,Integer) -> S          one? : % -> Boolean
---R recip : % -> Union(%,"failed")        retract : % -> S
---R rquo : (%,%) -> Union(%,"failed")     sample : () -> %
---R size : % -> NonNegativeInteger        ?~=? : (%,%) -> 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 divide : (%,%) -> Union(Record(lm: %,rm: %),"failed")
---R factors : % -> List(Record(gen: S,exp: NonNegativeInteger))
---R mapExpon : ((NonNegativeInteger -> NonNegativeInteger),%) -> %
---R nthExpon : (%,Integer) -> NonNegativeInteger
---R overlap : (%,%) -> Record(lm: %,mm: %,rm: %)
---R retractIfCan : % -> Union(S,"failed")
---R
---E 1
-
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{FreeMonoid.help}
-====================================================================
-FreeMonoid examples
-====================================================================
-
-Free monoid on any set of generators.  The free monoid on a set S is
-the monoid of finite products of the form reduce(*,[si ** ni]) where
-the si's are in S, and the ni's are nonnegative integers. The
-multiplication is not commutative.
-
-See Also:
-o )show FreeMonoid
-
-\end{chunk}
-
-\pagehead{FreeMonoid}{FMONOID}
-\pagepic{ps/v103freemonoid.ps}{FMONOID}{1.00}
-{\bf See}\\
-\pageto{ListMonoidOps}{LMOPS}
-\pageto{FreeGroup}{FGROUP}
-\pageto{InnerFreeAbelianMonoid}{IFAMON}
-\pageto{FreeAbelianMonoid}{FAMONOID}
-\pageto{FreeAbelianGroup}{FAGROUP}
-
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{FMONOID}{1} &
-\cross{FMONOID}{coerce} &
-\cross{FMONOID}{divide} &
-\cross{FMONOID}{factors} &
-\cross{FMONOID}{hash} \\
-\cross{FMONOID}{hclf} &
-\cross{FMONOID}{hcrf} &
-\cross{FMONOID}{latex} &
-\cross{FMONOID}{lquo} &
-\cross{FMONOID}{mapExpon} \\
-\cross{FMONOID}{mapGen} &
-\cross{FMONOID}{max} &
-\cross{FMONOID}{min} &
-\cross{FMONOID}{nthExpon} &
-\cross{FMONOID}{nthFactor} \\
-\cross{FMONOID}{one?} &
-\cross{FMONOID}{overlap} &
-\cross{FMONOID}{recip} &
-\cross{FMONOID}{rquo} &
-\cross{FMONOID}{retract} \\
-\cross{FMONOID}{retractIfCan} &
-\cross{FMONOID}{sample} &
-\cross{FMONOID}{size} &
-\cross{FMONOID}{?\~{}=?} &
-\cross{FMONOID}{?**?} \\
-\cross{FMONOID}{?$<$?} &
-\cross{FMONOID}{?$<=$?} &
-\cross{FMONOID}{?$>$?} &
-\cross{FMONOID}{?$>=$?} &
-\cross{FMONOID}{?\^{}?} \\
-\cross{FMONOID}{?*?} &
-\cross{FMONOID}{?=?} &&&
-\end{tabular}
-
-\begin{chunk}{domain FMONOID FreeMonoid}
-)abbrev domain FMONOID FreeMonoid
-++ Author: Stephen M. Watt
-++ Date Last Updated: 6 June 1991
-++ Description:
-++ Free monoid on any set of generators
-++ The free monoid on a set S is the monoid of finite products of
-++ the form \spad{reduce(*,[si ** ni])} where the si's are in S, and the ni's
-++ are nonnegative integers. The multiplication is not commutative.
-
-FreeMonoid(S: SetCategory): FMcategory == FMdefinition where
-    NNI ==> NonNegativeInteger
-    REC ==> Record(gen: S, exp: NonNegativeInteger)
-    Ex  ==> OutputForm
-
-    FMcategory ==> Join(Monoid, RetractableTo S) with
-        "*":    (S, $) -> $
-          ++ s * x returns the product of x by s on the left.
-        "*":    ($, S) -> $
-          ++ x * s returns the product of x by s on the right.
-        "**":   (S, NonNegativeInteger) -> $
-          ++ s ** n returns the product of s by itself n times.
-        hclf:   ($, $) -> $
-          ++ hclf(x, y) returns the highest common left factor of x and y,
-          ++ i.e. the largest d such that \spad{x = d a} and \spad{y = d b}.
-        hcrf:   ($, $) -> $
-          ++ hcrf(x, y) returns the highest common right factor of x and y,
-          ++ i.e. the largest d such that \spad{x = a d} and \spad{y = b d}.
-        lquo:   ($, $) -> Union($, "failed")
-          ++ lquo(x, y) returns the exact left quotient of x by y i.e.
-          ++ q such that \spad{x = y * q},
-          ++ "failed" if x is not of the form \spad{y * q}.
-        rquo:   ($, $) -> Union($, "failed")
-          ++ rquo(x, y) returns the exact right quotient of x by y i.e.
-          ++ q such that \spad{x = q * y},
-          ++ "failed" if x is not of the form \spad{q * y}.
-        divide:   ($, $) -> Union(Record(lm: $, rm: $), "failed")
-          ++ divide(x, y) returns the left and right exact quotients of
-          ++ x by y, i.e. \spad{[l, r]} such that \spad{x = l * y * r},
-          ++ "failed" if x is not of the form \spad{l * y * r}.
-        overlap: ($, $) -> Record(lm: $, mm: $, rm: $)
-          ++ overlap(x, y) returns \spad{[l, m, r]} such that
-          ++ \spad{x = l * m}, \spad{y = m * r} and l and r have no overlap,
-          ++ i.e. \spad{overlap(l, r) = [l, 1, r]}.
-        size         :   $ -> NNI
-          ++ size(x) returns the number of monomials in x.
-        factors      : $ -> List Record(gen: S, exp: NonNegativeInteger)
-          ++ factors(a1\^e1,...,an\^en) returns \spad{[[a1, e1],...,[an, en]]}.
-        nthExpon     : ($, Integer) -> NonNegativeInteger
-          ++ nthExpon(x, n) returns the exponent of the n^th monomial of x.
-        nthFactor    : ($, Integer) -> S
-          ++ nthFactor(x, n) returns the factor of the n^th monomial of x.
-        mapExpon     : (NNI -> NNI, $) -> $
-          ++ mapExpon(f, a1\^e1 ... an\^en) returns \spad{a1\^f(e1) ... an\^f(en)}.
-        mapGen       : (S -> S, $) -> $
-          ++ mapGen(f, a1\^e1 ... an\^en) returns \spad{f(a1)\^e1 ... f(an)\^en}.
-        if S has OrderedSet then OrderedSet
-
-    FMdefinition ==> ListMonoidOps(S, NonNegativeInteger, 1) add
-        Rep := ListMonoidOps(S, NonNegativeInteger, 1)
-
-        1               == makeUnit()
-        one? f          == empty? listOfMonoms f
-        coerce(f:$): Ex == outputForm(f, "*", "**", 1)
-        hcrf(f, g)      == reverse_! hclf(reverse f, reverse g)
-        f:$ * s:S       == rightMult(f, s)
-        s:S * f:$       == leftMult(s, f)
-        factors f       == copy listOfMonoms f
-        mapExpon(f, x)  == mapExpon(f, x)$Rep
-        mapGen(f, x)    == mapGen(f, x)$Rep
-        s:S ** n:NonNegativeInteger == makeTerm(s, n)
-
-        f:$ * g:$ ==
---            one? f => g
-            (f = 1) => g
---            one? g => f
-            (g = 1) => f
-            lg := listOfMonoms g
-            ls := last(lf := listOfMonoms f)
-            ls.gen = lg.first.gen =>
-                setlast_!(h := copy lf,[lg.first.gen,lg.first.exp+ls.exp])
-                makeMulti concat(h, rest lg)
-            makeMulti concat(lf, lg)
-
-        overlap(la, ar) ==
---            one? la or one? ar => [la, 1, ar]
-            (la = 1) or (ar = 1) => [la, 1, ar]
-            lla := la0 := listOfMonoms la
-            lar := listOfMonoms ar
-            l:List(REC) := empty()
-            while not empty? lla repeat
-              if lla.first.gen = lar.first.gen then
-                if lla.first.exp < lar.first.exp and empty? rest lla then
-                      return [makeMulti l,
-                               makeTerm(lla.first.gen, lla.first.exp),
-                                 makeMulti concat([lar.first.gen,
-                                  (lar.first.exp - lla.first.exp)::NNI],
-                                                              rest lar)]
-                if lla.first.exp >= lar.first.exp then
-                  if (ru:= lquo(makeMulti rest lar,
-                    makeMulti rest lla)) case $ then
-                      if lla.first.exp > lar.first.exp then
-                        l := concat_!(l, [lla.first.gen,
-                                  (lla.first.exp - lar.first.exp)::NNI])
-                        m := concat([lla.first.gen, lar.first.exp],
-                                                               rest lla)
-                      else m := lla
-                      return [makeMulti l, makeMulti m, ru::$]
-              l  := concat_!(l, lla.first)
-              lla := rest lla
-            [makeMulti la0, 1, makeMulti lar]
-
-        divide(lar, a) ==
---            one? a => [lar, 1]
-            (a = 1) => [lar, 1]
-            Na   : Integer := #(la := listOfMonoms a)
-            Nlar : Integer := #(llar := listOfMonoms lar)
-            l:List(REC) := empty()
-            while Na <= Nlar repeat
-              if llar.first.gen = la.first.gen and
-                 llar.first.exp >= la.first.exp then
-                -- Can match a portion of this lar factor.
-                -- Now match tail.
-                (q:=lquo(makeMulti rest llar,makeMulti rest la))case $ =>
-                   if llar.first.exp > la.first.exp then
-                       l := concat_!(l, [la.first.gen,
-                                  (llar.first.exp - la.first.exp)::NNI])
-                   return [makeMulti l, q::$]
-              l    := concat_!(l, first llar)
-              llar  := rest llar
-              Nlar := Nlar - 1
-            "failed"
+   Rep:=Record(SinIfTrue:Boolean, arg:E)
+   e:E
+   x,y:$
 
-        hclf(f, g) ==
-            h:List(REC) := empty()
-            for f0 in listOfMonoms f for g0 in listOfMonoms g repeat
-                f0.gen ^= g0.gen => return makeMulti h
-                h := concat_!(h, [f0.gen, min(f0.exp, g0.exp)])
-                f0.exp ^= g0.exp => return makeMulti h
-            makeMulti h
+   sin e == [true,e]
 
-        lquo(aq, a) ==
-            size a > #(laq := copy listOfMonoms aq) => "failed"
-            for a0 in listOfMonoms a repeat
-                a0.gen ^= laq.first.gen or a0.exp > laq.first.exp =>
-                                                          return "failed"
-                if a0.exp = laq.first.exp then laq := rest laq
-                else setfirst_!(laq, [laq.first.gen,
-                                         (laq.first.exp - a0.exp)::NNI])
-            makeMulti laq
+   cos e == [false,e]
 
-        rquo(qa, a) ==
-            (u := lquo(reverse qa, reverse a)) case "failed" => "failed"
-            reverse_!(u::$)
+   sin? x == x.SinIfTrue
 
-        if S has OrderedSet then
-          a < b ==
-            la := listOfMonoms a
-            lb := listOfMonoms b
-            na: Integer := #la
-            nb: Integer := #lb
-            while na > 0 and nb > 0 repeat
-                la.first.gen > lb.first.gen => return false
-                la.first.gen < lb.first.gen => return true
-                if la.first.exp = lb.first.exp then
-                    la:=rest la
-                    lb:=rest lb
-                    na:=na - 1
-                    nb:=nb - 1
-                else if la.first.exp > lb.first.exp then
-                    la:=concat([la.first.gen,
-                           (la.first.exp - lb.first.exp)::NNI], rest lb)
-                    lb:=rest lb
-                    nb:=nb - 1
-                else
-                    lb:=concat([lb.first.gen,
-                             (lb.first.exp-la.first.exp)::NNI], rest la)
-                    la:=rest la
-                    na:=na-1
-            empty? la and not empty? lb
+   argument x == x.arg
 
-\end{chunk}
+   coerce(x):OutputForm ==
+     hconcat((if x.SinIfTrue then "sin" else "cos")::OutputForm,
+              bracket((x.arg)::OutputForm))
+   x<y ==
+     x.arg < y.arg => true
+     y.arg < x.arg => false
+     x.SinIfTrue => false
+     y.SinIfTrue
 
-\begin{chunk}{COQ FMONOID}
-(* domain FMONOID *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{FMONOID.dotabb}
-"FMONOID" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FMONOID"]
-"FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"]
-"FLAGG-" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FLAGG"]
-"FMONOID" -> "FLAGG-"
-"FMONOID" -> "FLAGG"
+\begin{chunk}{FCOMP.dotabb}
+"FCOMP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FCOMP"]
+"ORDSET" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ORDSET"]
+"FCOMP" -> "ORDSET"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FNLA FreeNilpotentLie}
+\section{domain FSERIES FourierSeries}
 
-\begin{chunk}{FreeNilpotentLie.input}
+\begin{chunk}{FourierSeries.input}
 )set break resume
-)sys rm -f FreeNilpotentLie.output
-)spool FreeNilpotentLie.output
+)sys rm -f FourierSeries.output
+)spool FourierSeries.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show FreeNilpotentLie
+)show FourierSeries
 --R 
---R FreeNilpotentLie(n: NonNegativeInteger,class: NonNegativeInteger,R: CommutativeRing)  is a domain constructor
---R Abbreviation for FreeNilpotentLie is FNLA 
+--R FourierSeries(R: Join(CommutativeRing,Algebra(Fraction(Integer))),E: Join(OrderedSet,AbelianGroup))  is a domain constructor
+--R Abbreviation for FourierSeries is FSERIES 
 --R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FNLA 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FSERIES 
 --R
 --R------------------------------- Operations --------------------------------
 --R ?*? : (R,%) -> %                      ?*? : (%,R) -> %
 --R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
 --R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?**? : (%,PositiveInteger) -> %       ?+? : (%,%) -> %
---R ?-? : (%,%) -> %                      -? : % -> %
---R ?=? : (%,%) -> Boolean                0 : () -> %
---R antiCommutator : (%,%) -> %           associator : (%,%,%) -> %
---R coerce : % -> OutputForm              commutator : (%,%) -> %
---R deepExpand : % -> OutputForm          dimension : () -> NonNegativeInteger
---R generator : NonNegativeInteger -> %   hash : % -> SingleInteger
---R latex : % -> String                   sample : () -> %
---R shallowExpand : % -> OutputForm       zero? : % -> Boolean
+--R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
+--R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
+--R -? : % -> %                           ?=? : (%,%) -> Boolean
+--R 1 : () -> %                           0 : () -> %
+--R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
+--R coerce : FourierComponent(E) -> %     coerce : R -> %
+--R coerce : Integer -> %                 coerce : % -> OutputForm
+--R hash : % -> SingleInteger             latex : % -> String
+--R makeCos : (E,R) -> %                  makeSin : (E,R) -> %
+--R one? : % -> Boolean                   recip : % -> Union(%,"failed")
+--R sample : () -> %                      zero? : % -> Boolean
 --R ?~=? : (%,%) -> Boolean              
---R leftPower : (%,PositiveInteger) -> %
---R plenaryPower : (%,PositiveInteger) -> %
---R rightPower : (%,PositiveInteger) -> %
+--R characteristic : () -> NonNegativeInteger
 --R subtractIfCan : (%,%) -> Union(%,"failed")
 --R
 --E 1
@@ -65429,7405 +72758,13235 @@ FreeMonoid(S: SetCategory): FMcategory == FMdefinition where
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{FreeNilpotentLie.help}
+\begin{chunk}{FourierSeries.help}
 ====================================================================
-FreeNilpotentLie examples
+FourierSeries examples
 ====================================================================
 
-Generate the Free Lie Algebra over a ring R with identity;
-A P. Hall basis is generated by a package call to HallBasis.
+This domain converts terms into Fourier series
 
 See Also:
-o )show FreeNilpotentLie
+o )show FourierSeries
 
 \end{chunk}
 
-\pagehead{FreeNilpotentLie}{FNLA}
-\pagepic{ps/v103freenilpotentlie.ps}{FNLA}{1.00}
+\pagehead{FourierSeries}{FSERIES}
+\pagepic{ps/v103fourierseries.ps}{FSERIES}{1.00}
 {\bf See}\\
-\pageto{OrdSetInts}{OSI}
-\pageto{Commutator}{COMM}
+\pageto{FourierComponent}{FCOMP}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{FNLA}{0} &
-\cross{FNLA}{antiCommutator} &
-\cross{FNLA}{associator} &
-\cross{FNLA}{coerce} &
-\cross{FNLA}{commutator} \\
-\cross{FNLA}{deepExpand} &
-\cross{FNLA}{dimension} &
-\cross{FNLA}{generator} &
-\cross{FNLA}{hash} &
-\cross{FNLA}{latex} \\
-\cross{FNLA}{leftPower} &
-\cross{FNLA}{plenaryPower} &
-\cross{FNLA}{rightPower} &
-\cross{FNLA}{sample} &
-\cross{FNLA}{shallowExpand} \\
-\cross{FNLA}{subtractIfCan} &
-\cross{FNLA}{zero?} &
-\cross{FNLA}{?\~{}=?} &
-\cross{FNLA}{?*?} &
-\cross{FNLA}{?**?} \\
-\cross{FNLA}{?+?} &
-\cross{FNLA}{?-?} &
-\cross{FNLA}{-?} &
-\cross{FNLA}{?=?} &
+\cross{FSERIES}{0} &
+\cross{FSERIES}{1} &
+\cross{FSERIES}{characteristic} &
+\cross{FSERIES}{coerce} &
+\cross{FSERIES}{hash} \\
+\cross{FSERIES}{latex} &
+\cross{FSERIES}{makeCos} &
+\cross{FSERIES}{makeSin} &
+\cross{FSERIES}{one?} &
+\cross{FSERIES}{recip} \\
+\cross{FSERIES}{sample} &
+\cross{FSERIES}{subtractIfCan} &
+\cross{FSERIES}{zero?} &
+\cross{FSERIES}{?\~{}=?} &
+\cross{FSERIES}{?*?} \\
+\cross{FSERIES}{?**?} &
+\cross{FSERIES}{?\^{}?} &
+\cross{FSERIES}{?+?} &
+\cross{FSERIES}{?-?} &
+\cross{FSERIES}{-?} \\
+\cross{FSERIES}{?=?} &&&&
 \end{tabular}
 
-\begin{chunk}{domain FNLA FreeNilpotentLie}
-)abbrev domain FNLA FreeNilpotentLie
-++ Author: Larry Lambe
-++ Date Created: July 1988
-++ Date Last Updated: March 13 1991
+\begin{chunk}{domain FSERIES FourierSeries}
+)abbrev domain FSERIES FourierSeries
+++ Author: James Davenport
+++ Date Created: 17 April 1992
 ++ Description:
-++ Generate the Free Lie Algebra over a ring R with identity;
-++ A P. Hall basis is generated by a package call to HallBasis.
+++ This domain converts terms into Fourier series
 
-FreeNilpotentLie(n:NNI,class:NNI,R: CommutativeRing): Export == Implement where
-   B   ==> Boolean
-   Com ==> Commutator
-   HB  ==> HallBasis
-   I   ==> Integer
-   NNI ==> NonNegativeInteger
-   O   ==> OutputForm
-   OSI ==> OrdSetInts
-   FM  ==> FreeModule(R,OSI)
-   VI  ==> Vector Integer
-   VLI ==> Vector List Integer
-   lC  ==> leadingCoefficient
-   lS  ==> leadingSupport
+FourierSeries(R:Join(CommutativeRing,Algebra(Fraction Integer)),
+              E:Join(OrderedSet,AbelianGroup)):
+       Algebra(R) with
+         if E has canonical and R has canonical then canonical
+         coerce: R -> $
+           ++ coerce(r) converts coefficients into Fourier Series
+         coerce: FourierComponent(E) -> $
+           ++ coerce(c) converts sin/cos terms into Fourier Series
+         makeSin: (E,R) -> $
+           ++ makeSin(e,r) makes a sin expression with given 
+           ++ argument and coefficient
+         makeCos: (E,R) -> $
+           ++ makeCos(e,r) makes a sin expression with given 
+           ++argument and coefficient
+    == FreeModule(R,FourierComponent(E))
+  add
+   --representations
+   Term := Record(k:FourierComponent(E),c:R)
+   Rep  := List Term
+   multiply : (Term,Term) -> $
+   w,x1,x2:$
+   t1,t2:Term
+   n:NonNegativeInteger
+   z:Integer
+   e:FourierComponent(E)
+   a:E
+   r:R
 
-   Export ==> NonAssociativeAlgebra(R) with
-     dimension : () -> NNI
-       ++ dimension() is the rank of this Lie algebra
-     deepExpand    : %   -> O
-       ++ deepExpand(x) is not documented
-     shallowExpand    : %   -> O
-       ++ shallowExpand(x) is not documented
-     generator : NNI -> %
-       ++ generator(i) is the ith Hall Basis element
+   1 == [[cos 0,1]]
 
-   Implement ==> FM add
-     Rep := FM
-     f,g : %
+   coerce e ==
+      sin? e and zero? argument e => 0
+      if argument e < 0  then
+           not sin? e => e:=cos(- argument e)
+           return [[sin(- argument e),-1]]
+      [[e,1]]
 
-     coms:VLI
-     coms := generate(n,class)$HB
+   multiply(t1,t2) ==
+     r:=(t1.c*t2.c)*(1/2)
+     s1:=argument t1.k
+     s2:=argument t2.k
+     sum:=s1+s2
+     diff:=s1-s2
+     sin? t1.k =>
+       sin? t2.k =>
+         makeCos(diff,r) + makeCos(sum,-r)
+       makeSin(sum,r) + makeSin(diff,r)
+     sin? t2.k =>
+       makeSin(sum,r) + makeSin(diff,r)
+     makeCos(diff,r) + makeCos(sum,r)
 
-     dimension == #coms
+   x1*x2 ==
+     null x1 => 0
+     null x2 => 0
+     +/[+/[multiply(t1,t2) for t2 in x2] for t1 in x1]
 
-     have : (I,I) -> %
-       -- have(left,right) is a lookup function for basic commutators
-       -- already generated; if the nth basic commutator is
-       -- [left,wt,right], then have(left,right) = n
-     have(i,j) ==
-        wt:I := coms(i).2 + coms(j).2
-        wt > class => 0
-        lo:I := 1
-        hi:I := dimension
-        while hi-lo > 1 repeat
-          mid:I := (hi+lo) quo 2
-          if coms(mid).2 < wt then lo := mid else hi := mid
-        while coms(hi).1 < i repeat hi := hi + 1
-        while coms(hi).3 < j repeat hi := hi + 1
-        monomial(1,hi::OSI)$FM
+   makeCos(a,r) ==
+      a<0 => [[cos(-a),r]]
+      [[cos a,r]]
 
-     generator(i) ==
-       i > dimension => 0$Rep
-       monomial(1,i::OSI)$FM
+   makeSin(a,r) ==
+      zero? a => []
+      a<0 => [[sin(-a),-r]]
+      [[sin a,r]]
 
-     putIn : I -> %
-     putIn(i) ==
-       monomial(1$R,i::OSI)$FM
+\end{chunk}
 
-     brkt : (I,%) -> %
-     brkt(k,f) ==
-       f = 0 => 0
-       dg:I := value lS f
-       reductum(f) = 0 =>
-         k = dg  => 0
-         k > dg  => -lC(f)*brkt(dg, putIn(k))
-         inHallBasis?(n,k,dg,coms(dg).1) => lC(f)*have(k, dg)
-         lC(f)*( brkt(coms(dg).1, _
-          brkt(k,putIn coms(dg).3)) - brkt(coms(dg).3, _
-           brkt(k,putIn coms(dg).1) ))
-       brkt(k,monomial(lC f,lS f)$FM)+brkt(k,reductum f)
+\begin{chunk}{COQ FSERIES}
+(* domain FSERIES *)
+(*
+   Term := Record(k:FourierComponent(E),c:R)
+   Rep  := List Term
+   multiply : (Term,Term) -> $
+   w,x1,x2:$
+   t1,t2:Term
+   n:NonNegativeInteger
+   z:Integer
+   e:FourierComponent(E)
+   a:E
+   r:R
 
-     f*g ==
-       reductum(f) = 0 =>
-         lC(f)*brkt(value(lS f),g)
-       monomial(lC f,lS f)$FM*g + reductum(f)*g
+   1 == [[cos 0,1]]
 
-     Fac : I -> Com
-       -- an auxilliary function used for output of Free Lie algebra
-       -- elements (see expand)
-     Fac(m) ==
-       coms(m).1 = 0 => mkcomm(m)$Com
-       mkcomm(Fac coms(m).1, Fac coms(m).3)
+   coerce e ==
+      sin? e and zero? argument e => 0
+      if argument e < 0  then
+           not sin? e => e:=cos(- argument e)
+           return [[sin(- argument e),-1]]
+      [[e,1]]
 
-     shallowE : (R,OSI) -> O
-     shallowE(r,s) ==
-       k := value s
-       r = 1 =>
-         k <= n => s::O
-         mkcomm(mkcomm(coms(k).1)$Com,mkcomm(coms(k).3)$Com)$Com::O
-       k <= n => r::O * s::O
-       r::O * mkcomm(mkcomm(coms(k).1)$Com,mkcomm(coms(k).3)$Com)$Com::O
+   multiply(t1,t2) ==
+     r:=(t1.c*t2.c)*(1/2)
+     s1:=argument t1.k
+     s2:=argument t2.k
+     sum:=s1+s2
+     diff:=s1-s2
+     sin? t1.k =>
+       sin? t2.k =>
+         makeCos(diff,r) + makeCos(sum,-r)
+       makeSin(sum,r) + makeSin(diff,r)
+     sin? t2.k =>
+       makeSin(sum,r) + makeSin(diff,r)
+     makeCos(diff,r) + makeCos(sum,r)
 
-     shallowExpand(f) ==
-       f = 0           => 0::O
-       reductum(f) = 0 => shallowE(lC f,lS f)
-       shallowE(lC f,lS f) + shallowExpand(reductum f)
+   x1*x2 ==
+     null x1 => 0
+     null x2 => 0
+     +/[+/[multiply(t1,t2) for t2 in x2] for t1 in x1]
 
-     deepExpand(f) ==
-       f = 0          => 0::O
-       reductum(f) = 0 =>
-         lC(f)=1 => Fac(value(lS f))::O
-         lC(f)::O * Fac(value(lS f))::O
-       lC(f)=1 => Fac(value(lS f))::O + deepExpand(reductum f)
-       lC(f)::O * Fac(value(lS f))::O + deepExpand(reductum f)
+   makeCos(a,r) ==
+      a<0 => [[cos(-a),r]]
+      [[cos a,r]]
 
-\end{chunk}
+   makeSin(a,r) ==
+      zero? a => []
+      a<0 => [[sin(-a),-r]]
+      [[sin a,r]]
 
-\begin{chunk}{COQ FNLA}
-(* domain FNLA *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{FNLA.dotabb}
-"FNLA" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FNLA"]
-"IVECTOR" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IVECTOR"]
-"FNLA" -> "IVECTOR"
+\begin{chunk}{FSERIES.dotabb}
+"FSERIES" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FSERIES"]
+"PID" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PID"]
+"OAGROUP" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAGROUP"]
+"FSERIES" -> "PID"
+"FSERIES" -> "OAGROUP"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FPARFRAC FullPartialFractionExpansion}
+\section{domain FRAC Fraction}
 
-\begin{chunk}{FullPartialFractionExpansion.input}
+\begin{chunk}{Fraction.input}
 )set break resume
-)sys rm -f FullPartialFractionExpansion.output
-)spool FullPartialFractionExpansion.output
+)sys rm -f Fraction.output
+)spool Fraction.output
 )set message test on
 )set message auto off
 )clear all
 
---S 1 of 17
-Fx := FRAC UP(x, FRAC INT)
+--S 1 of 13
+a := 11/12
 --R 
 --R
---R   (1)  Fraction(UnivariatePolynomial(x,Fraction(Integer)))
---R                                                                 Type: Domain
+--R        11
+--R   (1)  --
+--R        12
+--R                                                      Type: Fraction(Integer)
 --E 1
 
---S 2 of 17
-f : Fx := 36 / (x**5-2*x**4-2*x**3+4*x**2+x-2) 
+--S 2 of 13
+b := 23/24
 --R 
 --R
---R                     36
---R   (2)  ----------------------------
---R         5     4     3     2
---R        x  - 2x  - 2x  + 4x  + x - 2
---R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
+--R        23
+--R   (2)  --
+--R        24
+--R                                                      Type: Fraction(Integer)
 --E 2
 
---S 3 of 17
-g := fullPartialFraction f 
+--S 3 of 13
+3 - a*b**2 + a + b/a
 --R 
 --R
---R          4       4        --+      - 3%A - 6
---R   (3)  ----- - ----- +    >        ---------
---R        x - 2   x + 1      --+              2
---R                          2         (x - %A)
---R                        %A  - 1= 0
---RType: FullPartialFractionExpansion(Fraction(Integer),UnivariatePolynomial(x,Fraction(Integer)))
+--R        313271
+--R   (3)  ------
+--R         76032
+--R                                                      Type: Fraction(Integer)
 --E 3
 
---S 4 of 17
-g :: Fx
+--S 4 of 13
+numer(a)
 --R 
 --R
---R                     36
---R   (4)  ----------------------------
---R         5     4     3     2
---R        x  - 2x  - 2x  + 4x  + x - 2
---R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
+--R   (4)  11
+--R                                                        Type: PositiveInteger
 --E 4
 
---S 5 of 17
-g5 := D(g, 5)
+--S 5 of 13
+denom(b)
 --R 
 --R
---R             480        480        --+      2160%A + 4320
---R   (5)  - -------- + -------- +    >        -------------
---R                 6          6      --+                7
---R          (x - 2)    (x + 1)      2           (x - %A)
---R                                %A  - 1= 0
---RType: FullPartialFractionExpansion(Fraction(Integer),UnivariatePolynomial(x,Fraction(Integer)))
+--R   (5)  24
+--R                                                        Type: PositiveInteger
 --E 5
 
---S 6 of 17
-f5 := D(f, 5)
+--S 6 of 13
+r := (x**2 + 2*x + 1)/(x**2 - 2*x + 1)
 --R 
 --R
---R   (6)
---R                10           9            8            7            6
---R       - 544320x   + 4354560x  - 14696640x  + 28615680x  - 40085280x
---R     + 
---R                5            4            3           2
---R       46656000x  - 39411360x  + 18247680x  - 5870880x  + 3317760x + 246240
---R  /
---R        20      19      18      17       16       15       14        13
---R       x   - 12x   + 53x   - 76x   - 159x   + 676x   - 391x   - 1596x
---R     + 
---R            12        11        10        9        8        7        6        5
---R       2527x   + 1148x   - 4977x   + 1372x  + 4907x  - 3444x  - 2381x  + 2924x
---R     + 
---R           4        3       2
---R       276x  - 1184x  + 208x  + 192x - 64
---R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
+--R         2
+--R        x  + 2x + 1
+--R   (6)  -----------
+--R         2
+--R        x  - 2x + 1
+--R                                          Type: Fraction(Polynomial(Integer))
 --E 6
 
---S 7 of 17
-g5::Fx - f5
+--S 7 of 13
+factor(r)
 --R 
 --R
---R   (7)  0
---R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
+--R         2
+--R        x  + 2x + 1
+--R   (7)  -----------
+--R         2
+--R        x  - 2x + 1
+--R                                Type: Factored(Fraction(Polynomial(Integer)))
 --E 7
 
---S 8 of 17
-f : Fx := (x**5 * (x-1)) / ((x**2 + x + 1)**2 * (x-2)**3)
+--S 8 of 13
+map(factor,r)
 --R 
 --R
---R                       6    5
---R                      x  - x
---R   (8)  -----------------------------------
---R         7     6     5     3     2
---R        x  - 4x  + 3x  + 9x  - 6x  - 4x - 8
---R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
+--R               2
+--R        (x + 1)
+--R   (8)  --------
+--R               2
+--R        (x - 1)
+--R                                Type: Fraction(Factored(Polynomial(Integer)))
 --E 8
 
---S 9 of 17
-g := fullPartialFraction f 
+--S 9 of 13
+continuedFraction(7/12)
 --R 
 --R
---R   (9)
---R      1952       464        32                          179       135
---R      ----       ---        --                       - ---- %A + ----
---R      2401       343        49            --+          2401      2401
---R     ------ + -------- + -------- +       >          ----------------
---R      x - 2          2          3         --+             x - %A
---R              (x - 2)    (x - 2)      2
---R                                    %A  + %A + 1= 0
---R   + 
---R                       37        20
---R                      ---- %A + ----
---R           --+        1029      1029
---R           >          --------------
---R           --+                   2
---R       2                 (x - %A)
---R     %A  + %A + 1= 0
---RType: FullPartialFractionExpansion(Fraction(Integer),UnivariatePolynomial(x,Fraction(Integer)))
+--R          1 |     1 |     1 |     1 |
+--R   (9)  +---+ + +---+ + +---+ + +---+
+--R        | 1     | 1     | 2     | 2
+--R                                             Type: ContinuedFraction(Integer)
 --E 9
 
---S 10 of 17
-g :: Fx - f
+--S 10 of 13
+partialFraction(7,12)
 --R 
 --R
---R   (10)  0
---R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
+--R              3   1
+--R   (10)  1 - -- + -
+--R              2   3
+--R             2
+--R                                               Type: PartialFraction(Integer)
 --E 10
 
---S 11 of 17
-f : Fx := (2*x**7-7*x**5+26*x**3+8*x) / (x**8-5*x**6+6*x**4+4*x**2-8) 
+--S 11 of 13
+g := 2/3 + 4/5*%i
 --R 
 --R
---R             7     5      3
---R           2x  - 7x  + 26x  + 8x
---R   (11)  ------------------------
---R          8     6     4     2
---R         x  - 5x  + 6x  + 4x  - 8
---R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
+--R         2   4
+--R   (11)  - + - %i
+--R         3   5
+--R                                             Type: Complex(Fraction(Integer))
 --E 11
 
---S 12 of 17
-g := fullPartialFraction f
+--S 12 of 13
+g :: FRAC COMPLEX INT
 --R 
 --R
---R                        1                                            1
---R                        -                                            -
---R            --+         2        --+          1          --+         2
---R   (12)     >        ------ +    >        --------- +    >        ------
---R            --+      x - %A      --+              3      --+      x - %A
---R           2                    2         (x - %A)      2
---R         %A  - 2= 0           %A  - 2= 0              %A  + 1= 0
---RType: FullPartialFractionExpansion(Fraction(Integer),UnivariatePolynomial(x,Fraction(Integer)))
+--R         10 + 12%i
+--R   (12)  ---------
+--R             15
+--R                                             Type: Fraction(Complex(Integer))
 --E 12
 
---S 13 of 17
-g :: Fx - f 
---R 
---R
---R   (13)  0
---R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
---E 13
-
---S 14 of 17
-f:Fx := x**3 / (x**21 + 2*x**20 + 4*x**19 + 7*x**18 + 10*x**17 + 17*x**16 + 22*x**15 + 30*x**14 + 36*x**13 + 40*x**12 + 47*x**11 + 46*x**10 + 49*x**9 + 43*x**8 + 38*x**7 + 32*x**6 + 23*x**5 + 19*x**4 + 10*x**3 + 7*x**2 + 2*x + 1)
---R 
---R
---R   (14)
---R      3
---R     x
---R  /
---R        21     20     19     18      17      16      15      14      13      12
---R       x   + 2x   + 4x   + 7x   + 10x   + 17x   + 22x   + 30x   + 36x   + 40x
---R     + 
---R          11      10      9      8      7      6      5      4      3     2
---R       47x   + 46x   + 49x  + 43x  + 38x  + 32x  + 23x  + 19x  + 10x  + 7x  + 2x
---R     + 
---R       1
---R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
---E 14
-
---S 15 of 17
-g := fullPartialFraction f 
+--S 13 of 13
+)show Fraction
 --R 
---R
---R   (15)
---R                  1                        1      19
---R                  - %A                     - %A - --
---R        --+       2             --+        9      27
---R        >        ------ +       >          ---------
---R        --+      x - %A         --+          x - %A
---R       2                    2
---R     %A  + 1= 0           %A  + %A + 1= 0
---R   + 
---R                       1       1
---R                      -- %A - --
---R           --+        27      27
---R           >          ----------
---R           --+                 2
---R       2               (x - %A)
---R     %A  + %A + 1= 0
---R   + 
---R     SIGMA
---R          5     2
---R        %A  + %A  + 1= 0
---R    ,
---R               96556567040   4   420961732891   3    59101056149   2
---R            - ------------ %A  + ------------ %A  - ------------ %A
---R              912390759099       912390759099       912390759099
---R          + 
---R              373545875923      529673492498
---R            - ------------ %A + ------------
---R              912390759099      912390759099
---R       /
---R          x - %A
---R   + 
---R     SIGMA
---R          5     2
---R        %A  + %A  + 1= 0
---R    ,
---R           5580868   4    2024443   3    4321919   2    84614        5070620
---R        - -------- %A  - -------- %A  + -------- %A  - ------- %A - --------
---R          94070601       94070601       94070601       1542141      94070601
---R        --------------------------------------------------------------------
---R                                              2
---R                                      (x - %A)
---R   + 
---R     SIGMA
---R          5     2
---R        %A  + %A  + 1= 0
---R    ,
---R         1610957   4    2763014   3    2016775   2    266953        4529359
---R        -------- %A  + -------- %A  - -------- %A  + -------- %A + --------
---R        94070601       94070601       94070601       94070601      94070601
---R        -------------------------------------------------------------------
---R                                             3
---R                                     (x - %A)
---RType: FullPartialFractionExpansion(Fraction(Integer),UnivariatePolynomial(x,Fraction(Integer)))
---E 15
-
---S 16 of 17
-g :: Fx - f
---R 
---R
---R   (16)  0
---R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
---E 16
-
---S 17 of 17
-)show FullPartialFractionExpansion
---R 
---R FullPartialFractionExpansion(F: Join(Field,CharacteristicZero),UP: UnivariatePolynomialCategory(F))  is a domain constructor
---R Abbreviation for FullPartialFractionExpansion is FPARFRAC 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FPARFRAC 
+--R Fraction(S: IntegralDomain)  is a domain constructor
+--R Abbreviation for Fraction is FRAC 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FRAC 
 --R
 --R------------------------------- Operations --------------------------------
---R ?+? : (UP,%) -> %                     ?=? : (%,%) -> Boolean
---R D : (%,NonNegativeInteger) -> %       D : % -> %
---R coerce : % -> OutputForm              convert : % -> Fraction(UP)
---R differentiate : % -> %                hash : % -> SingleInteger
---R latex : % -> String                   polyPart : % -> UP
+--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 construct : List(Record(exponent: NonNegativeInteger,center: UP,num: UP)) -> %
---R differentiate : (%,NonNegativeInteger) -> %
---R fracPart : % -> List(Record(exponent: NonNegativeInteger,center: UP,num: UP))
---R fullPartialFraction : Fraction(UP) -> %
+--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 OMwrite : (OpenMathDevice,%,Boolean) -> Void if S has INS and S has OM
+--R OMwrite : (OpenMathDevice,%) -> Void if S has INS and S has OM
+--R OMwrite : (%,Boolean) -> String if S has INS and S has OM
+--R OMwrite : % -> String if S has INS and S has OM
+--R characteristic : () -> NonNegativeInteger
+--R charthRoot : % -> Union(%,"failed") if $ has CHARNZ and S has PFECAT or S has CHARNZ
+--R coerce : Symbol -> % if S has RETRACT(SYMBOL)
+--R conditionP : Matrix(%) -> Union(Vector(%),"failed") if $ has CHARNZ and S has PFECAT
+--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
---E 17
+--E 13
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{FullPartialFractionExpansion.help}
+\begin{chunk}{Fraction.help}
 ====================================================================
-FullPartialFractionExpansion expansion
+Fraction examples
 ====================================================================
 
-The domain FullPartialFractionExpansion implements factor-free
-conversion of quotients to full partial fractions.
-
-Our examples will all involve quotients of univariate polynomials
-with rational number coefficients.
-
-  Fx := FRAC UP(x, FRAC INT)
-    Fraction UnivariatePolynomial(x,Fraction Integer)
-                    Type: Domain
-
-Here is a simple-looking rational function.
-
-  f : Fx := 36 / (x**5-2*x**4-2*x**3+4*x**2+x-2) 
-                 36
-    ----------------------------
-     5     4     3     2
-    x  - 2x  - 2x  + 4x  + x - 2
-                    Type: Fraction UnivariatePolynomial(x,Fraction Integer)
+The Fraction domain implements quotients.  The elements must
+belong to a domain of category IntegralDomain: multiplication
+must be commutative and the product of two non-zero elements must not
+be zero.  This allows you to make fractions of most things you would
+think of, but don't expect to create a fraction of two matrices!  The
+abbreviation for Fraction is FRAC.
 
-We use fullPartialFraction to convert it to an object of type
-FullPartialFractionExpansion.
+Use / to create a fraction.
 
-  g := fullPartialFraction f 
-      4       4        --+      - 3%A - 6
-    ----- - ----- +    >        ---------
-    x - 2   x + 1      --+              2
-                      2         (x - %A)
-                    %A  - 1= 0
-Type: FullPartialFractionExpansion(Fraction Integer,
-                                   UnivariatePolynomial(x,Fraction Integer))
+  a := 11/12
+    11
+    --
+    12
+                   Type: Fraction Integer
 
-Use a coercion to change it back into a quotient.
+  b := 23/24
+    23
+    --
+    24
+                   Type: Fraction Integer
 
-  g :: Fx
-                 36
-    ----------------------------
-     5     4     3     2
-    x  - 2x  - 2x  + 4x  + x - 2
-                  Type: Fraction UnivariatePolynomial(x,Fraction Integer)
+The standard arithmetic operations are available.
 
-Full partial fractions differentiate faster than rational functions.
+  3 - a*b**2 + a + b/a
+    313271
+    ------
+     76032
+                   Type: Fraction Integer
 
-  g5 := D(g, 5)
-         480        480        --+      2160%A + 4320
-    - -------- + -------- +    >        -------------
-             6          6      --+                7
-      (x - 2)    (x + 1)      2           (x - %A)
-                            %A  - 1= 0
-Type: FullPartialFractionExpansion(Fraction Integer,
-                                   UnivariatePolynomial(x,Fraction Integer))
+Extract the numerator and denominator by using numer and denom,
+respectively.
 
-  f5 := D(f, 5)
-                10           9            8            7            6
-       - 544320x   + 4354560x  - 14696640x  + 28615680x  - 40085280x
-     + 
-                5            4            3           2
-       46656000x  - 39411360x  + 18247680x  - 5870880x  + 3317760x + 246240
-  /
-        20      19      18      17       16       15       14        13
-       x   - 12x   + 53x   - 76x   - 159x   + 676x   - 391x   - 1596x
-     + 
-            12        11        10        9        8        7        6        5
-       2527x   + 1148x   - 4977x   + 1372x  + 4907x  - 3444x  - 2381x  + 2924x
-     + 
-           4        3       2
-       276x  - 1184x  + 208x  + 192x - 64
-                      Type: Fraction UnivariatePolynomial(x,Fraction Integer)
+  numer(a)
+    11
+                   Type: PositiveInteger
 
-We can check that the two forms represent the same function.
+  denom(b)
+    24
+                   Type: PositiveInteger
 
-  g5::Fx - f5
-    0
-                      Type: Fraction UnivariatePolynomial(x,Fraction Integer)
+Operations like max, min, negative?, positive? and zero?
+are all available if they are provided for the numerators and
+denominators.  
 
-Here are some examples that are more complicated.
+Don't expect a useful answer from factor, gcd or lcm if you apply
+them to fractions.
 
-  f : Fx := (x**5 * (x-1)) / ((x**2 + x + 1)**2 * (x-2)**3)
-                   6    5
-                  x  - x
-    -----------------------------------
-     7     6     5     3     2
-    x  - 4x  + 3x  + 9x  - 6x  - 4x - 8
-                      Type: Fraction UnivariatePolynomial(x,Fraction Integer)
+  r := (x**2 + 2*x + 1)/(x**2 - 2*x + 1)
+     2
+    x  + 2x + 1
+    -----------
+     2
+    x  - 2x + 1
+                  Type: Fraction Polynomial Integer
 
-  g := fullPartialFraction f 
-      1952       464        32                          179       135
-      ----       ---        --                       - ---- %A + ----
-      2401       343        49            --+          2401      2401
-     ------ + -------- + -------- +       >          ----------------
-      x - 2          2          3         --+             x - %A
-              (x - 2)    (x - 2)      2
-                                    %A  + %A + 1= 0
-   + 
-                       37        20
-                      ---- %A + ----
-           --+        1029      1029
-           >          --------------
-           --+                   2
-       2                 (x - %A)
-     %A  + %A + 1= 0
-Type: FullPartialFractionExpansion(Fraction Integer,
-                                   UnivariatePolynomial(x,Fraction Integer))
+Since all non-zero fractions are invertible, these operations have trivial
+definitions.
 
-  g :: Fx - f
-    0
-                      Type: Fraction UnivariatePolynomial(x,Fraction Integer)
+  factor(r)
+     2
+    x  + 2x + 1
+    -----------
+     2
+    x  - 2x + 1
+                  Type: Factored Fraction Polynomial Integer
 
-  f : Fx := (2*x**7-7*x**5+26*x**3+8*x) / (x**8-5*x**6+6*x**4+4*x**2-8) 
-        7     5      3
-      2x  - 7x  + 26x  + 8x
-    ------------------------
-     8     6     4     2
-    x  - 5x  + 6x  + 4x  - 8
-                      Type: Fraction UnivariatePolynomial(x,Fraction Integer)
+Use map to apply factor to the numerator and denominator, which is
+probably what you mean.
 
-  g := fullPartialFraction f
-                   1                                            1
-                   -                                            -
-       --+         2        --+          1          --+         2
-       >        ------ +    >        --------- +    >        ------
-       --+      x - %A      --+              3      --+      x - %A
-      2                    2         (x - %A)      2
-    %A  - 2= 0           %A  - 2= 0              %A  + 1= 0
-Type: FullPartialFractionExpansion(Fraction Integer,
-                                   UnivariatePolynomial(x,Fraction Integer))
+  map(factor,r)
+           2
+    (x + 1)
+    --------
+           2
+    (x - 1)
+                  Type: Fraction Factored Polynomial Integer
 
-  g :: Fx - f 
-    0
-                     Type: Fraction UnivariatePolynomial(x,Fraction Integer)
+Other forms of fractions are available.  Use continuedFraction to
+create a continued fraction.
 
-  f:Fx := x**3 / (x**21 + 2*x**20 + 4*x**19 + 7*x**18 + 10*x**17 + 17*x**16 + 22*x**15 + 30*x**14 + 36*x**13 + 40*x**12 + 47*x**11 + 46*x**10 + 49*x**9 + 43*x**8 + 38*x**7 + 32*x**6 + 23*x**5 + 19*x**4 + 10*x**3 + 7*x**2 + 2*x + 1)
-      3
-     x
-  /
-        21     20     19     18      17      16      15      14      13      12
-       x   + 2x   + 4x   + 7x   + 10x   + 17x   + 22x   + 30x   + 36x   + 40x
-     + 
-          11      10      9      8      7      6      5      4      3     2
-      47x   + 46x   + 49x  + 43x  + 38x  + 32x  + 23x  + 19x  + 10x  + 7x  + 2x
-     + 
-       1
-                      Type: Fraction UnivariatePolynomial(x,Fraction Integer)
+  continuedFraction(7/12)
+      1 |     1 |     1 |     1 |
+    +---+ + +---+ + +---+ + +---+
+    | 1     | 1     | 2     | 2
+                  Type: ContinuedFraction Integer
 
-  g := fullPartialFraction f 
-                  1                        1      19
-                  - %A                     - %A - --
-        --+       2             --+        9      27
-        >        ------ +       >          ---------
-        --+      x - %A         --+          x - %A
-       2                    2
-     %A  + 1= 0           %A  + %A + 1= 0
-   + 
-                       1       1
-                      -- %A - --
-           --+        27      27
-           >          ----------
-           --+                 2
-       2               (x - %A)
-     %A  + %A + 1= 0
-   + 
-     SIGMA
-          5     2
-        %A  + %A  + 1= 0
-    ,
-               96556567040   4   420961732891   3    59101056149   2
-            - ------------ %A  + ------------ %A  - ------------ %A
-              912390759099       912390759099       912390759099
-          + 
-              373545875923      529673492498
-            - ------------ %A + ------------
-              912390759099      912390759099
-       /
-          x - %A
-   + 
-     SIGMA
-          5     2
-        %A  + %A  + 1= 0
-    ,
-           5580868   4    2024443   3    4321919   2    84614        5070620
-        - -------- %A  - -------- %A  + -------- %A  - ------- %A - --------
-          94070601       94070601       94070601       1542141      94070601
-        --------------------------------------------------------------------
-                                              2
-                                      (x - %A)
-   + 
-     SIGMA
-          5     2
-        %A  + %A  + 1= 0
-    ,
-         1610957   4    2763014   3    2016775   2    266953        4529359
-        -------- %A  + -------- %A  - -------- %A  + -------- %A + --------
-        94070601       94070601       94070601       94070601      94070601
-        -------------------------------------------------------------------
-                                             3
-                                     (x - %A)
-Type: FullPartialFractionExpansion(Fraction Integer,UnivariatePolynomial(x,Fraction Integer))
+Use partialFraction to create a partial fraction.
 
-This verification takes much longer than the conversion to partial fractions.
+  partialFraction(7,12)
+          3   1
+     1 - -- + -
+          2   3
+         2
+                  Type: PartialFraction Integer
 
-  g :: Fx - f
-    0
-                      Type: Fraction UnivariatePolynomial(x,Fraction Integer)
+Use conversion to create alternative views of fractions with objects
+moved in and out of the numerator and denominator.
 
-Use PartialFraction for standard partial fraction decompositions.
+  g := 2/3 + 4/5*%i
+     2   4
+     - + - %i
+     3   5
+                  Type: Complex Fraction Integer
 
-For more information, see the paper: Bronstein, M and Salvy, B.
-"Full Partial Fraction Decomposition of Rational Functions,"
-Proceedings of ISSAC'93, Kiev, ACM Press.  
+  g :: FRAC COMPLEX INT
+    10 + 12%i
+    ---------
+        15
+                  Type: Fraction Complex Integer
 
-See Also:
+See Also: 
+o )help ContinuedFraction
 o )help PartialFraction
-o )show FullPartialFractionExpansion
+o )help Integer
+o )show Fraction
 
 \end{chunk}
-\pagehead{FullPartialFractionExpansion}{FPARFRAC}
-\pagepic{ps/v103fullpartialfractionexpansion.ps}{FPARFRAC}{1.00}
+\pagehead{Fraction}{FRAC}
+\pagepic{ps/v103fraction.ps}{FRAC}{1.00}
+{\bf See}\\
+\pageto{Localize}{LO}
+\pageto{LocalAlgebra}{LA}
 
 {\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{FPARFRAC}{coerce} &
-\cross{FPARFRAC}{construct} &
-\cross{FPARFRAC}{convert} &
-\cross{FPARFRAC}{D} &
-\cross{FPARFRAC}{differentiate} \\
-\cross{FPARFRAC}{hash} &
-\cross{FPARFRAC}{latex} &
-\cross{FPARFRAC}{polyPart} &
-\cross{FPARFRAC}{fracPart} &
-\cross{FPARFRAC}{fullPartialFraction} \\
-\cross{FPARFRAC}{?\~{}=?} &
-\cross{FPARFRAC}{?+?} &
-\cross{FPARFRAC}{?=?} &&
+\begin{tabular}{lll}
+\cross{FRAC}{0} &
+\cross{FRAC}{1} &
+\cross{FRAC}{abs} \\
+\cross{FRAC}{associates?} &
+\cross{FRAC}{characteristic} &
+\cross{FRAC}{charthRoot} \\
+\cross{FRAC}{ceiling} &
+\cross{FRAC}{coerce} &
+\cross{FRAC}{conditionP} \\
+\cross{FRAC}{convert} &
+\cross{FRAC}{D} &
+\cross{FRAC}{denom} \\
+\cross{FRAC}{denominator} &
+\cross{FRAC}{differentiate} &
+\cross{FRAC}{divide} \\
+\cross{FRAC}{euclideanSize} &
+\cross{FRAC}{eval} &
+\cross{FRAC}{expressIdealMember} \\
+\cross{FRAC}{exquo} &
+\cross{FRAC}{extendedEuclidean} &
+\cross{FRAC}{factor} \\
+\cross{FRAC}{factorPolynomial} &
+\cross{FRAC}{factorSquareFreePolynomial} &
+\cross{FRAC}{floor} \\
+\cross{FRAC}{fractionPart} &
+\cross{FRAC}{gcd} &
+\cross{FRAC}{gcdPolynomial} \\
+\cross{FRAC}{hash} &
+\cross{FRAC}{init} &
+\cross{FRAC}{inv} \\
+\cross{FRAC}{latex} &
+\cross{FRAC}{lcm} &
+\cross{FRAC}{map} \\
+\cross{FRAC}{max} &
+\cross{FRAC}{min} &
+\cross{FRAC}{multiEuclidean} \\
+\cross{FRAC}{negative?} &
+\cross{FRAC}{nextItem} &
+\cross{FRAC}{numer} \\
+\cross{FRAC}{numerator} &
+\cross{FRAC}{OMwrite} &
+\cross{FRAC}{one?} \\
+\cross{FRAC}{patternMatch} &
+\cross{FRAC}{positive?} &
+\cross{FRAC}{prime?} \\
+\cross{FRAC}{principalIdeal} &
+\cross{FRAC}{random} &
+\cross{FRAC}{recip} \\
+\cross{FRAC}{reducedSystem} &
+\cross{FRAC}{retract} &
+\cross{FRAC}{retractIfCan} \\
+\cross{FRAC}{sample} &
+\cross{FRAC}{sign} &
+\cross{FRAC}{sizeLess?} \\
+\cross{FRAC}{solveLinearPolynomialEquation} &
+\cross{FRAC}{squareFree} &
+\cross{FRAC}{squareFreePart} \\
+\cross{FRAC}{squareFreePolynomial} &
+\cross{FRAC}{subtractIfCan} &
+\cross{FRAC}{unit?} \\
+\cross{FRAC}{unitCanonical} &
+\cross{FRAC}{unitNormal} &
+\cross{FRAC}{wholePart} \\
+\cross{FRAC}{zero?} &
+\cross{FRAC}{?*?} &
+\cross{FRAC}{?**?} \\
+\cross{FRAC}{?+?} &
+\cross{FRAC}{?-?} &
+\cross{FRAC}{-?} \\
+\cross{FRAC}{?/?} &
+\cross{FRAC}{?=?} &
+\cross{FRAC}{?\^{}?} \\
+\cross{FRAC}{?\~{}=?} &
+\cross{FRAC}{?$<$?} &
+\cross{FRAC}{?$<=$?} \\
+\cross{FRAC}{?$>$?} &
+\cross{FRAC}{?$>=$?} &
+\cross{FRAC}{?.?} \\
+\cross{FRAC}{?quo?} &
+\cross{FRAC}{?rem?} &
 \end{tabular}
 
-\begin{chunk}{domain FPARFRAC FullPartialFractionExpansion}
-)abbrev domain FPARFRAC FullPartialFractionExpansion
-++ Author: Manuel Bronstein
-++ Date Created: 9 December 1992
-++ Date Last Updated: 6 October 1993
-++ References: M.Bronstein & B.Salvy,
-++             Full Partial Fraction Decomposition of Rational Functions,
-++             in Proceedings of ISSAC'93, Kiev, ACM Press.
+\begin{chunk}{domain FRAC Fraction}
+)abbrev domain FRAC Fraction
+++ Author: Mark Botch
+++ Date Last Updated: 12 February 1992
+++ Basic Functions: Field, numer, denom
 ++ Description:
-++ Full partial fraction expansion of rational functions
+++ Fraction takes an IntegralDomain S and produces
+++ the domain of Fractions with numerators and denominators from S.
+++ If S is also a GcdDomain, then gcd's between numerator and
+++ denominator will be cancelled during all operations.
 
-FullPartialFractionExpansion(F, UP): Exports == Implementation where
-  F  : Join(Field, CharacteristicZero)
-  UP : UnivariatePolynomialCategory F
+Fraction(S: IntegralDomain): QuotientFieldCategory S with 
+       if S has IntegerNumberSystem and S has OpenMath then OpenMath
+       if S has canonical and S has GcdDomain and S has canonicalUnitNormal
+          then canonical
+           ++ \spad{canonical} means that equal elements are in fact identical.
+  == LocalAlgebra(S, S, S) add
 
-  N   ==> NonNegativeInteger
-  Q   ==> Fraction Integer
-  O   ==> OutputForm
-  RF  ==> Fraction UP
-  SUP ==> SparseUnivariatePolynomial RF
-  REC ==> Record(exponent: N, center: UP, num: UP)
-  ODV ==> OrderlyDifferentialVariable Symbol
-  ODP ==> OrderlyDifferentialPolynomial UP
-  ODF ==> Fraction ODP
-  FPF ==> Record(polyPart: UP, fracPart: List REC)
+    Rep:= Record(num:S, den:S)
 
-  Exports ==> Join(SetCategory, ConvertibleTo RF)  with
-    "+":                 (UP, $) -> $
-      ++ p + x returns the sum of p and x
-    fullPartialFraction: RF -> $
-      ++ fullPartialFraction(f) returns \spad{[p, [[j, Dj, Hj]...]]} such that
-      ++ \spad{f = p(x) + sum_{[j,Dj,Hj] in l} sum_{Dj(a)=0} Hj(a)/(x - a)\^j}.
-    polyPart:            $ -> UP
-      ++ polyPart(f) returns the polynomial part of f.
-    fracPart:            $  -> List REC
-      ++ fracPart(f) returns the list of summands of the fractional part of f.
-    construct:           List REC -> $
-      ++ construct(l) is the inverse of fracPart.
-    differentiate:       $ -> $
-      ++ differentiate(f) returns the derivative of f.
-    D:                    $ -> $
-      ++ D(f) returns the derivative of f.
-    differentiate:       ($, N) -> $
-      ++ differentiate(f, n) returns the n-th derivative of f.
-    D: ($, NonNegativeInteger) -> $
-      ++ D(f, n) returns the n-th derivative of f.
+    coerce(d:S):% == [d,1]
 
-  Implementation ==> add
-    Rep := FPF
+    zero?(x:%) == zero? x.num
 
-    fullParFrac: (UP, UP, UP, N) -> List REC
-    outputexp  : (O, N) -> O
-    output     : (N, UP, UP) -> O
-    REC2RF     : (UP, UP, N) -> RF
-    UP2SUP     : UP -> SUP
-    diffrec    : REC -> REC
-    FP2O       : List REC -> O
+    if S has GcdDomain and S has canonicalUnitNormal then
 
--- create a differential variable
-    u  := new()$Symbol
-    u0 := makeVariable(u, 0)$ODV
-    alpha := u::O
-    x  := monomial(1, 1)$UP
-    xx := x::O
-    zr := (0$N)::O
+      retract(x:%):S ==
+        ((x.den) = 1) => x.num
+        error "Denominator not equal to 1"
 
-    construct l     == [0, l]
-    D r             == differentiate r
-    D(r, n)         == differentiate(r,n)
-    polyPart f      == f.polyPart
-    fracPart f      == f.fracPart
-    p:UP + f:$      == [p + polyPart f, fracPart f]
+      retractIfCan(x:%):Union(S, "failed") ==
+        ((x.den) = 1) => x.num
+        "failed"
+    else
 
-    differentiate f ==
-      differentiate(polyPart f) + construct [diffrec rec for rec in fracPart f]
+      retract(x:%):S ==
+        (a:= x.num exquo x.den) case "failed" =>
+           error "Denominator not equal to 1"
+        a
 
-    differentiate(r, n) ==
-      for i in 1..n repeat r := differentiate r
-      r
+      retractIfCan(x:%):Union(S,"failed") == x.num exquo x.den
 
--- diffrec(sum_{rec.center(a) = 0} rec.num(a) / (x - a)^e) =
---         sum_{rec.center(a) = 0} -e rec.num(a) / (x - a)^{e+1}
---                where e = rec.exponent
-    diffrec rec ==
-      e := rec.exponent
-      [e + 1, rec.center, - e * rec.num]
+    if S has EuclideanDomain then
+      wholePart x ==
+        ((x.den) = 1) => x.num
+        x.num quo x.den
 
-    convert(f:$):RF ==
-      ans := polyPart(f)::RF
-      for rec in fracPart f repeat
-        ans := ans + REC2RF(rec.center, rec.num, rec.exponent)
-      ans
+    if S has IntegerNumberSystem then
 
-    UP2SUP p == map((z1:F):RF +-> z1::UP::RF, p)_
-        $UnivariatePolynomialCategoryFunctions2(F, UP, RF, SUP)
+      floor x ==
+        ((x.den) = 1) => x.num
+        x < 0 => -ceiling(-x)
+        wholePart x
 
-    -- returns Trace_k^k(a) (h(a) / (x - a)^n)  where d(a) = 0
-    REC2RF(d, h, n) ==
---      one?(m := degree d) =>
-      ((m := degree d) = 1) =>
-        a   := - (leadingCoefficient reductum d) / (leadingCoefficient d)
-        h(a)::UP / (x - a::UP)**n
-      dd  := UP2SUP d
-      hh  := UP2SUP h
-      aa  := monomial(1, 1)$SUP
-      p   := (x::RF::SUP - aa)**n rem dd
-      rec := extendedEuclidean(p, dd, hh)::Record(coef1:SUP, coef2:SUP)
-      t   := rec.coef1     -- we want Trace_k^k(a)(t) now
-      ans := coefficient(t, 0)
-      for i in 1..degree(d)-1 repeat
-        t   := (t * aa) rem dd
-        ans := ans + coefficient(t, i)
-      ans
+      ceiling x ==
+        ((x.den) = 1) => x.num
+        x < 0 => -floor(-x)
+        1 + wholePart x
 
-    fullPartialFraction f ==
-      qr := divide(numer f, d := denom f)
-      qr.quotient + construct concat
-                     [fullParFrac(qr.remainder, d, rec.factor, rec.exponent::N)
-                                         for rec in factors squareFree denom f]
+      if S has OpenMath then
+        -- TODO: somwhere this file does something which redefines the division
+        -- operator. Doh!
 
-    fullParFrac(a, d, q, n) ==
-      ans:List REC := empty()
-      em := e := d quo (q ** n)
-      rec := extendedEuclidean(e, q, 1)::Record(coef1:UP,coef2:UP)
-      bm := b := rec.coef1                  -- b = inverse of e modulo q
-      lvar:List(ODV) := [u0]
-      um := 1::ODP
-      un := (u1 := u0::ODP)**n
-      lval:List(UP)  := [q1 := q := differentiate(q0 := q)]
-      h:ODF := a::ODP / (e * un)
-      rec := extendedEuclidean(q1, q0, 1)::Record(coef1:UP,coef2:UP)
-      c := rec.coef1                        -- c = inverse of q' modulo q
-      cm := 1::UP
-      cn  := (c ** n) rem q0
-      for m in 1..n repeat
-        p    := retract(em * un * um * h)@ODP
-        pp   := retract(eval(p, lvar, lval))@UP
-        h    := inv(m::Q) * differentiate h
-        q    := differentiate q
-        lvar := concat(makeVariable(u, m), lvar)
-        lval := concat(inv((m+1)::F) * q, lval)
-        qq   := q0 quo gcd(pp, q0)                    -- new center
-        if (degree(qq) > 0) then
-          ans  := concat([(n + 1 - m)::N, qq, (pp * bm * cn * cm) rem qq], ans)
-        cm   := (c * cm) rem q0     -- cm = c**m modulo q now
-        um   := u1 * um             -- um = u**m now
-        em   := e * em              -- em = e**{m+1} now
-        bm   := (b * bm) rem q0     -- bm = b**{m+1} modulo q now
-      ans
+        writeOMFrac(dev: OpenMathDevice, x: %): Void ==
+          OMputApp(dev)
+          OMputSymbol(dev, "nums1", "rational")
+          OMwrite(dev, x.num, false)
+          OMwrite(dev, x.den, false)
+          OMputEndApp(dev)
 
-    coerce(f:$):O ==
-      ans := FP2O(l := fracPart f)
-      zero?(p := polyPart f) =>
-        empty? l => (0$N)::O
-        ans
-      p::O + ans
+        OMwrite(x: %): String ==
+          s: String := ""
+          sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+          dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
+          OMputObject(dev)
+          writeOMFrac(dev, x)
+          OMputEndObject(dev)
+          OMclose(dev)
+          s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+          s
 
-    FP2O l ==
-      empty? l => empty()
-      rec := first l
-      ans := output(rec.exponent, rec.center, rec.num)
-      for rec in rest l repeat
-        ans := ans + output(rec.exponent, rec.center, rec.num)
-      ans
+        OMwrite(x: %, wholeObj: Boolean): String ==
+          s: String := ""
+          sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+          dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
+          if wholeObj then
+            OMputObject(dev)
+          writeOMFrac(dev, x)
+          if wholeObj then
+            OMputEndObject(dev)
+          OMclose(dev)
+          s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+          s
 
-    output(n, d, h) ==
---      one? degree d =>
-      (degree d) = 1 =>
-        a := - leadingCoefficient(reductum d) / leadingCoefficient(d)
-        h(a)::O / outputexp((x - a::UP)::O, n)
-      sum(outputForm(makeSUP h, alpha) / outputexp(xx - alpha, n),
-          outputForm(makeSUP d, alpha) = zr)
+        OMwrite(dev: OpenMathDevice, x: %): Void ==
+          OMputObject(dev)
+          writeOMFrac(dev, x)
+          OMputEndObject(dev)
 
-    outputexp(f, n) ==
---      one? n => f
-      (n = 1) => f
-      f ** (n::O)
+        OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void ==
+          if wholeObj then
+            OMputObject(dev)
+          writeOMFrac(dev, x)
+          if wholeObj then
+            OMputEndObject(dev)
 
-\end{chunk}
+    if S has GcdDomain then
 
-\begin{chunk}{COQ FPARFRAC}
-(* domain FPARFRAC *)
-(*
-*)
+      cancelGcd: % -> S
 
-\end{chunk}
+      normalize: % -> %
 
-\begin{chunk}{FPARFRAC.dotabb}
-"FPARFRAC" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FPARFRAC"]
-"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
-"FPARFRAC" -> "ALIST"
+      normalize x ==
+        zero?(x.num) => 0
+        ((x.den) = 1) => x
+        uca := unitNormal(x.den)
+        zero?(x.den := uca.canonical) => error "division by zero"
+        x.num := x.num * uca.associate
+        x
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain FUNCTION FunctionCalled}
+      recip x ==
+        zero?(x.num) => "failed"
+        normalize [x.den, x.num]
 
-\begin{chunk}{FunctionCalled.input}
-)set break resume
-)sys rm -f FunctionCalled.output
-)spool FunctionCalled.output
-)set message test on
-)set message auto off
-)clear all
+      cancelGcd x ==
+        ((x.den) = 1) => x.den
+        d := gcd(x.num, x.den)
+        xn := x.num exquo d
+        xn case "failed" =>
+          error "gcd not gcd in QF cancelGcd (numerator)"
+        xd := x.den exquo d
+        xd case "failed" =>
+          error "gcd not gcd in QF cancelGcd (denominator)"
+        x.num := xn :: S
+        x.den := xd :: S
+        d
 
---S 1 of 1
-)show FunctionCalled
---R 
---R FunctionCalled(f: Symbol)  is a domain constructor
---R Abbreviation for FunctionCalled is FUNCTION 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for FUNCTION 
---R
---R------------------------------- Operations --------------------------------
---R ?=? : (%,%) -> Boolean                coerce : % -> OutputForm
---R hash : % -> SingleInteger             latex : % -> String
---R name : % -> Symbol                    ?~=? : (%,%) -> Boolean
---R
---E 1
+      nn:S / dd:S ==
+        zero? dd => error "division by zero"
+        cancelGcd(z := [nn, dd])
+        normalize z
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{FunctionCalled.help}
-====================================================================
-FunctionCalled examples
-====================================================================
+      x + y  ==
+        zero? y => x
+        zero? x => y
+        z := [x.den,y.den]
+        d := cancelGcd z
+        g := [z.den * x.num + z.num * y.num, d]
+        cancelGcd g
+        g.den := g.den * z.num * z.den
+        normalize g
 
-This domain implements named functions
+      -- We can not rely on the defaulting mechanism
+      -- to supply a definition for -, even though this
+      -- definition would do, for thefollowing reasons:
+      --  1) The user could have defined a subtraction
+      --     in Localize, which would not work for
+      --     QuotientField;
+      --  2) even if he doesn't, the system currently
+      --     places a default definition in Localize,
+      --     which uses Localize's +, which does not
+      --     cancel gcds
+      x - y  ==
+        zero? y => x
+        z := [x.den, y.den]
+        d := cancelGcd z
+        g := [z.den * x.num - z.num * y.num, d]
+        cancelGcd g
+        g.den := g.den * z.num * z.den
+        normalize g
 
-See Also:
-o )show FunctionCalled
+      x:% * y:%  ==
+        zero? x or zero? y => 0
+        (x = 1) => y
+        (y = 1) => x
+        (x, y) := ([x.num, y.den], [y.num, x.den])
+        cancelGcd x; cancelGcd y;
+        normalize [x.num * y.num, x.den * y.den]
 
-\end{chunk}
+      n:Integer * x:% ==
+        y := [n::S, x.den]
+        cancelGcd y
+        normalize [x.num * y.num, y.den]
 
-\pagehead{FunctionCalled}{FUNCTION}
-\pagepic{ps/v103functioncalled.ps}{FUNCTION}{1.00}
+      nn:S * x:% ==
+        y := [nn, x.den]
+        cancelGcd y
+        normalize [x.num * y.num, y.den]
 
-{\bf Exports:}\\
-\begin{tabular}{llllll}
-\cross{FUNCTION}{coerce} &
-\cross{FUNCTION}{hash} &
-\cross{FUNCTION}{latex} &
-\cross{FUNCTION}{name} &
-\cross{FUNCTION}{?=?} &
-\cross{FUNCTION}{?\~{}=?} 
-\end{tabular}
+      differentiate(x:%, deriv:S -> S) ==
+        y := [deriv(x.den), x.den]
+        d := cancelGcd(y)
+        y.num := deriv(x.num) * y.den - x.num * y.num
+        (d, y.den) := (y.den, d)
+        cancelGcd y
+        y.den := y.den * d * d
+        normalize y
 
-\begin{chunk}{domain FUNCTION FunctionCalled}
-)abbrev domain FUNCTION FunctionCalled
-++ Author: Mark Botch
-++ Description:
-++ This domain implements named functions
+      if S has canonicalUnitNormal then
 
-FunctionCalled(f:Symbol): SetCategory with 
-    name: % -> Symbol 
-      ++ name(x) returns the symbol
-  == add
-   name r                 == f
-   coerce(r:%):OutputForm == f::OutputForm
-   x = y                  == true
-   latex(x:%):String      == latex f
+        x = y == (x.num = y.num) and (x.den = y.den)
 
-\end{chunk}
+        one? x == ((x.num) = 1) and ((x.den) = 1)
+                  -- again assuming canonical nature of representation
 
-\begin{chunk}{COQ FUNCTION}
-(* domain FUNCTION *)
-(*
-*)
+    else
 
-\end{chunk}
+      nn:S/dd:S == if zero? dd then error "division by zero" else [nn,dd]
 
-\begin{chunk}{FUNCTION.dotabb}
-"FUNCTION" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FUNCTION"]
-"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
-"FUNCTION" -> "ALIST"
+      recip x ==
+        zero?(x.num) => "failed"
+        [x.den, x.num]
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\chapter{Chapter G}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain GDMP GeneralDistributedMultivariatePolynomial}
+    if (S has RetractableTo Fraction Integer) then
 
-\begin{chunk}{GeneralDistributedMultivariatePolynomial.input}
-)set break resume
-)sys rm -f GeneralDistributedMultivariatePolynomial.output
-)spool GeneralDistributedMultivariatePolynomial.output
-)set message test on
-)set message auto off
-)clear all
+      retract(x:%):Fraction(Integer) == retract(retract(x)@S)
 
---S 1 of 11
-(d1,d2,d3) : DMP([z,y,x],FRAC INT) 
---R 
---R                                                                   Type: Void
---E 1
+      retractIfCan(x:%):Union(Fraction Integer, "failed") ==
+        (u := retractIfCan(x)@Union(S, "failed")) case "failed" => "failed"
+        retractIfCan(u::S)
 
---S 2 of 11
-d1 := -4*z + 4*y**2*x + 16*x**2 + 1 
---R 
---R
---R                 2       2
---R   (2)  - 4z + 4y x + 16x  + 1
---R           Type: DistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
---E 2
+    else if (S has RetractableTo Integer) then
 
---S 3 of 11
-d2 := 2*z*y**2 + 4*x + 1 
---R 
---R
---R            2
---R   (3)  2z y  + 4x + 1
---R           Type: DistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
---E 3
+      retract(x:%):Fraction(Integer) ==
+        retract(numer x) / retract(denom x)
 
---S 4 of 11
-d3 := 2*z*x**2 - 2*y**2 - x 
---R 
---R
---R            2     2
---R   (4)  2z x  - 2y  - x
---R           Type: DistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
---E 4
+      retractIfCan(x:%):Union(Fraction Integer, "failed") ==
+        (n := retractIfCan numer x) case "failed" => "failed"
+        (d := retractIfCan denom x) case "failed" => "failed"
+        (n::Integer) / (d::Integer)
 
---S 5 of 11
-groebner [d1,d2,d3]
---R 
---R
---R   (5)
---R        1568  6   1264  5    6   4   182  3   2047  2    103      2857
---R   [z - ---- x  - ---- x  + --- x  + --- x  - ---- x  - ---- x - -----,
---R        2745       305      305      549       610      2745     10980
---R     2    112  6    84  5   1264  4    13  3    84  2   1772       2
---R    y  + ---- x  - --- x  - ---- x  - --- x  + --- x  + ---- x + ----,
---R         2745      305       305      549      305      2745     2745
---R     7   29  6   17  4   11  3    1  2   15     1
---R    x  + -- x  - -- x  - -- x  + -- x  + -- x + -]
---R          4      16       8      32      16     4
---R     Type: List(DistributedMultivariatePolynomial([z,y,x],Fraction(Integer)))
---E 5
+    QFP ==> SparseUnivariatePolynomial %
 
---S 6 of 11
-(n1,n2,n3) : HDMP([z,y,x],FRAC INT)
---R 
---R                                                                   Type: Void
---E 6
+    DP ==> SparseUnivariatePolynomial S
 
---S 7 of 11
-n1 := d1
---R 
---R
---R          2       2
---R   (7)  4y x + 16x  - 4z + 1
---RType: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
---E 7
+    import UnivariatePolynomialCategoryFunctions2(%,QFP,S,DP)
 
---S 8 of 11
-n2 := d2
---R 
---R
---R            2
---R   (8)  2z y  + 4x + 1
---RType: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
---E 8
+    import UnivariatePolynomialCategoryFunctions2(S,DP,%,QFP)
 
---S 9 of 11
-n3 := d3
---R 
---R
---R            2     2
---R   (9)  2z x  - 2y  - x
---RType: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
---E 9
+    if S has GcdDomain then
 
---S 10 of 11
-groebner [n1,n2,n3]
---R 
---R
---R   (10)
---R     4     3   3  2   1     1   4   29  3   1  2   7        9     1
---R   [y  + 2x  - - x  + - z - -, x  + -- x  - - y  - - z x - -- x - -,
---R               2      2     8        4      8      4       16     4
---R       2        1   2      2       1     2    2   1
---R    z y  + 2x + -, y x + 4x  - z + -, z x  - y  - - x,
---R                2                  4              2
---R     2     2     2   1     3
---R    z  - 4y  + 2x  - - z - - x]
---R                     4     2
---RType: List(HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer)))
---E 10
+       gcdPolynomial(pp,qq) ==
+          zero? pp => qq
+          zero? qq => pp
+          zero? degree pp or zero? degree qq => 1
+          denpp:="lcm"/[denom u for u in coefficients pp]
+          ppD:DP:=map(x+->retract(x*denpp),pp)
+          denqq:="lcm"/[denom u for u in coefficients qq]
+          qqD:DP:=map(x+->retract(x*denqq),qq)
+          g:=gcdPolynomial(ppD,qqD)
+          zero? degree g => 1
+          ((lc:=leadingCoefficient g) = 1) => map(x+->x::%,g)
+          map(x+->x/lc,g)
 
---S 11 of 11
-)show GeneralDistributedMultivariatePolynomial
---R 
---R GeneralDistributedMultivariatePolynomial(vl: List(Symbol),R: Ring,E: DirectProductCategory(#(vl),NonNegativeInteger))  is a domain constructor
---R Abbreviation for GeneralDistributedMultivariatePolynomial is GDMP 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for GDMP 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (%,R) -> %                      ?*? : (R,%) -> %
---R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
---R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
---R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
---R -? : % -> %                           ?/? : (%,R) -> % if R has FIELD
---R ?=? : (%,%) -> Boolean                1 : () -> %
---R 0 : () -> %                           ?^? : (%,NonNegativeInteger) -> %
---R ?^? : (%,PositiveInteger) -> %        coefficient : (%,E) -> R
---R coefficients : % -> List(R)           coerce : % -> % if R has INTDOM
---R coerce : R -> %                       coerce : Integer -> %
---R coerce : % -> OutputForm              content : % -> R if R has GCDDOM
---R degree : % -> E                       eval : (%,List(%),List(%)) -> %
---R eval : (%,%,%) -> %                   eval : (%,Equation(%)) -> %
---R eval : (%,List(Equation(%))) -> %     gcd : (%,%) -> % if R has GCDDOM
---R gcd : List(%) -> % if R has GCDDOM    ground : % -> R
---R ground? : % -> Boolean                hash : % -> SingleInteger
---R latex : % -> String                   lcm : (%,%) -> % if R has GCDDOM
---R lcm : List(%) -> % if R has GCDDOM    leadingCoefficient : % -> R
---R leadingMonomial : % -> %              map : ((R -> R),%) -> %
---R mapExponents : ((E -> E),%) -> %      max : (%,%) -> % if R has ORDSET
---R min : (%,%) -> % if R has ORDSET      minimumDegree : % -> E
---R monomial : (R,E) -> %                 monomial? : % -> Boolean
---R monomials : % -> List(%)              one? : % -> Boolean
---R pomopo! : (%,R,E,%) -> %              primitiveMonomials : % -> List(%)
---R recip : % -> Union(%,"failed")        reductum : % -> %
---R reorder : (%,List(Integer)) -> %      retract : % -> R
---R sample : () -> %                      zero? : % -> Boolean
---R ?~=? : (%,%) -> 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(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
---R D : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
---R D : (%,List(OrderedVariableList(vl))) -> %
---R D : (%,OrderedVariableList(vl)) -> %
---R associates? : (%,%) -> Boolean if R has INTDOM
---R binomThmExpt : (%,%,NonNegativeInteger) -> % if R has COMRING
---R characteristic : () -> NonNegativeInteger
---R charthRoot : % -> Union(%,"failed") if $ has CHARNZ and R has PFECAT or R has CHARNZ
---R coefficient : (%,List(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
---R coefficient : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
---R coerce : Fraction(Integer) -> % if R has ALGEBRA(FRAC(INT)) or R has RETRACT(FRAC(INT))
---R coerce : OrderedVariableList(vl) -> %
---R conditionP : Matrix(%) -> Union(Vector(%),"failed") if $ has CHARNZ and R has PFECAT
---R content : (%,OrderedVariableList(vl)) -> % if R has GCDDOM
---R convert : % -> InputForm if OrderedVariableList(vl) has KONVERT(INFORM) and R has KONVERT(INFORM)
---R convert : % -> Pattern(Integer) if OrderedVariableList(vl) has KONVERT(PATTERN(INT)) and R has KONVERT(PATTERN(INT))
---R convert : % -> Pattern(Float) if OrderedVariableList(vl) has KONVERT(PATTERN(FLOAT)) and R has KONVERT(PATTERN(FLOAT))
---R degree : (%,List(OrderedVariableList(vl))) -> List(NonNegativeInteger)
---R degree : (%,OrderedVariableList(vl)) -> NonNegativeInteger
---R differentiate : (%,List(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
---R differentiate : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
---R differentiate : (%,List(OrderedVariableList(vl))) -> %
---R differentiate : (%,OrderedVariableList(vl)) -> %
---R discriminant : (%,OrderedVariableList(vl)) -> % if R has COMRING
---R eval : (%,List(OrderedVariableList(vl)),List(%)) -> %
---R eval : (%,OrderedVariableList(vl),%) -> %
---R eval : (%,List(OrderedVariableList(vl)),List(R)) -> %
---R eval : (%,OrderedVariableList(vl),R) -> %
---R exquo : (%,%) -> Union(%,"failed") if R has INTDOM
---R exquo : (%,R) -> Union(%,"failed") 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 isExpt : % -> Union(Record(var: OrderedVariableList(vl),exponent: NonNegativeInteger),"failed")
---R isPlus : % -> Union(List(%),"failed")
---R isTimes : % -> Union(List(%),"failed")
---R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) if R has GCDDOM
---R mainVariable : % -> Union(OrderedVariableList(vl),"failed")
---R minimumDegree : (%,List(OrderedVariableList(vl))) -> List(NonNegativeInteger)
---R minimumDegree : (%,OrderedVariableList(vl)) -> NonNegativeInteger
---R monicDivide : (%,%,OrderedVariableList(vl)) -> Record(quotient: %,remainder: %)
---R monomial : (%,List(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
---R monomial : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
---R multivariate : (SparseUnivariatePolynomial(%),OrderedVariableList(vl)) -> %
---R multivariate : (SparseUnivariatePolynomial(R),OrderedVariableList(vl)) -> %
---R numberOfMonomials : % -> NonNegativeInteger
---R patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> PatternMatchResult(Integer,%) if OrderedVariableList(vl) has PATMAB(INT) and R has PATMAB(INT)
---R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) if OrderedVariableList(vl) has PATMAB(FLOAT) and R has PATMAB(FLOAT)
---R prime? : % -> Boolean if R has PFECAT
---R primitivePart : (%,OrderedVariableList(vl)) -> % if R has GCDDOM
---R primitivePart : % -> % if R has GCDDOM
---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 : (%,%,OrderedVariableList(vl)) -> % if R has COMRING
---R retract : % -> OrderedVariableList(vl)
---R retract : % -> Integer if R has RETRACT(INT)
---R retract : % -> Fraction(Integer) if R has RETRACT(FRAC(INT))
---R retractIfCan : % -> Union(OrderedVariableList(vl),"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 subtractIfCan : (%,%) -> Union(%,"failed")
---R totalDegree : (%,List(OrderedVariableList(vl))) -> 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 : (%,OrderedVariableList(vl)) -> SparseUnivariatePolynomial(%)
---R variables : % -> List(OrderedVariableList(vl))
---R
---E 11
+    if (S has PolynomialFactorizationExplicit) then
+       -- we'll let the solveLinearPolynomialEquations operator
+       -- default from Field
+       pp,qq: QFP
+       lpp: List QFP
+       import Factored SparseUnivariatePolynomial %
+
+       if S has CharacteristicNonZero then
+
+          if S has canonicalUnitNormal and S has GcdDomain then
+
+             charthRoot x ==
+               n:= charthRoot x.num
+               n case "failed" => "failed"
+               d:=charthRoot x.den
+               d case "failed" => "failed"
+               n/d
+
+          else
+
+             charthRoot x ==
+               -- to find x = p-th root of n/d
+               -- observe that xd is p-th root of n*d**(p-1)
+               ans:=charthRoot(x.num *
+                      (x.den)**(characteristic()$%-1)::NonNegativeInteger)
+               ans case "failed" => "failed"
+               ans / x.den
+
+          clear: List % -> List S
+
+          clear l ==
+             d:="lcm"/[x.den for x in l]
+             [ x.num * (d exquo x.den)::S for x in l]
+
+          mat: Matrix %
+
+          conditionP mat ==
+            matD: Matrix S
+            matD:= matrix [ clear l for l in listOfLists mat ]
+            ansD := conditionP matD
+            ansD case "failed" => "failed"
+            ansDD:=ansD :: Vector(S)
+            [ ansDD(i)::% for i in 1..#ansDD]$Vector(%)
+
+       factorPolynomial(pp) ==
+          zero? pp => 0
+          denpp:="lcm"/[denom u for u in coefficients pp]
+          ppD:DP:=map(x+->retract(x*denpp),pp)
+          ff:=factorPolynomial ppD
+          den1:%:=denpp::%
+          lfact:List Record(flg:Union("nil", "sqfr", "irred", "prime"),
+                             fctr:QFP, xpnt:Integer)
+          lfact:= [[w.flg,
+                    if leadingCoefficient w.fctr =1 then 
+                           map(x+->x::%,w.fctr)
+                    else (lc:=(leadingCoefficient w.fctr)::%;
+                           den1:=den1/lc**w.xpnt;
+                            map(x+->x::%/lc,w.fctr)),
+                   w.xpnt] for w in factorList ff]
+          makeFR(map(x+->x::%/den1,unit(ff)),lfact)
+
+       factorSquareFreePolynomial(pp) ==
+          zero? pp => 0
+          degree pp = 0 => makeFR(pp,empty())
+          lcpp:=leadingCoefficient pp
+          pp:=pp/lcpp
+          denpp:="lcm"/[denom u for u in coefficients pp]
+          ppD:DP:=map(x+->retract(x*denpp),pp)
+          ff:=factorSquareFreePolynomial ppD
+          den1:%:=denpp::%/lcpp
+          lfact:List Record(flg:Union("nil", "sqfr", "irred", "prime"),
+                             fctr:QFP, xpnt:Integer)
+          lfact:= [[w.flg,
+                    if leadingCoefficient w.fctr =1 then 
+                           map(x+->x::%,w.fctr)
+                    else (lc:=(leadingCoefficient w.fctr)::%;
+                           den1:=den1/lc**w.xpnt;
+                            map(x+->x::%/lc,w.fctr)),
+                   w.xpnt] for w in factorList ff]
+          makeFR(map(x+->x::%/den1,unit(ff)),lfact)
 
-)spool
-)lisp (bye)
 \end{chunk}
 
-\begin{chunk}{GeneralDistributedMultivariatePolynomial.help}
-====================================================================
-MultivariatePolynomial
-DistributedMultivariatePolynomial
-HomogeneousDistributedMultivariatePolynomial
-GeneralDistributedMultivariatePolynomial
-====================================================================
+\begin{chunk}{COQ FRAC}
+(* domain FRAC *)
+(*
 
-DistributedMultivariatePolynomial which is abbreviated as DMP and 
-HomogeneousDistributedMultivariatePolynomial, which is abbreviated
-as HDMP, are very similar to MultivariatePolynomial except that 
-they are represented and displayed in a non-recursive manner.
+    Rep:= Record(num:S, den:S)
 
-  (d1,d2,d3) : DMP([z,y,x],FRAC INT) 
-                      Type: Void
+    coerce(d:S):% == [d,1]
 
-The constructor DMP orders its monomials lexicographically while
-HDMP orders them by total order refined by reverse lexicographic
-order.
+    zero?(x:%) == zero? x.num
 
-  d1 := -4*z + 4*y**2*x + 16*x**2 + 1 
-            2       2
-   - 4z + 4y x + 16x  + 1
-            Type: DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+    if S has GcdDomain and S has canonicalUnitNormal then
 
-  d2 := 2*z*y**2 + 4*x + 1 
-       2
-   2z y  + 4x + 1
-            Type: DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+      retract(x:%):S ==
+        ((x.den) = 1) => x.num
+        error "Denominator not equal to 1"
 
-  d3 := 2*z*x**2 - 2*y**2 - x 
-       2     2
-   2z x  - 2y  - x
-            Type: DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+      retractIfCan(x:%):Union(S, "failed") ==
+        ((x.den) = 1) => x.num
+        "failed"
+    else
 
-These constructors are mostly used in Groebner basis calculations.
+      retract(x:%):S ==
+        (a:= x.num exquo x.den) case "failed" =>
+           error "Denominator not equal to 1"
+        a
 
-  groebner [d1,d2,d3]
-        1568  6   1264  5    6   4   182  3   2047  2    103      2857
-   [z - ---- x  - ---- x  + --- x  + --- x  - ---- x  - ---- x - -----,
-        2745       305      305      549       610      2745     10980
-     2    112  6    84  5   1264  4    13  3    84  2   1772       2
-    y  + ---- x  - --- x  - ---- x  - --- x  + --- x  + ---- x + ----,
-         2745      305       305      549      305      2745     2745
-     7   29  6   17  4   11  3    1  2   15     1
-    x  + -- x  - -- x  - -- x  + -- x  + -- x + -]
-          4      16       8      32      16     4
-       Type: List DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+      retractIfCan(x:%):Union(S,"failed") == x.num exquo x.den
 
-  (n1,n2,n3) : HDMP([z,y,x],FRAC INT)
-                      Type: Void
+    if S has EuclideanDomain then
+      wholePart x ==
+        ((x.den) = 1) => x.num
+        x.num quo x.den
 
-  n1 := d1
-     2       2
-   4y x + 16x  - 4z + 1
- Type: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+    if S has IntegerNumberSystem then
 
-  n2 := d2
-       2
-   2z y  + 4x + 1
- Type: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+      floor x ==
+        ((x.den) = 1) => x.num
+        x < 0 => -ceiling(-x)
+        wholePart x
 
-  n3 := d3
-       2     2
-   2z x  - 2y  - x
- Type: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+      ceiling x ==
+        ((x.den) = 1) => x.num
+        x < 0 => -floor(-x)
+        1 + wholePart x
 
-Note that we get a different Groebner basis when we use the HDMP
-polynomials, as expected.
+      if S has OpenMath then
+        -- TODO: somwhere this file does something which redefines the division
+        -- operator. Doh!
 
-  groebner [n1,n2,n3]
-     4     3   3  2   1     1   4   29  3   1  2   7        9     1
-   [y  + 2x  - - x  + - z - -, x  + -- x  - - y  - - z x - -- x - -,
-               2      2     8        4      8      4       16     4
-       2        1   2      2       1     2    2   1
-    z y  + 2x + -, y x + 4x  - z + -, z x  - y  - - x,
-                2                  4              2
-     2     2     2   1     3
-    z  - 4y  + 2x  - - z - - x]
-                     4     2
-      Type: List HomogeneousDistributedMultivariatePolynomial([z,y,x],
-                                                           Fraction Integer)
+        writeOMFrac(dev: OpenMathDevice, x: %): Void ==
+          OMputApp(dev)
+          OMputSymbol(dev, "nums1", "rational")
+          OMwrite(dev, x.num, false)
+          OMwrite(dev, x.den, false)
+          OMputEndApp(dev)
 
-GeneralDistributedMultivariatePolynomial is somewhat more flexible in
-the sense that as well as accepting a list of variables to specify the
-variable ordering, it also takes a predicate on exponent vectors to
-specify the term ordering.  With this polynomial type the user can
-experiment with the effect of using completely arbitrary term orderings.  
-This flexibility is mostly important for algorithms such as Groebner 
-basis calculations which can be very sensitive to term ordering.
+        OMwrite(x: %): String ==
+          s: String := ""
+          sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+          dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
+          OMputObject(dev)
+          writeOMFrac(dev, x)
+          OMputEndObject(dev)
+          OMclose(dev)
+          s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+          s
 
-See Also:
-o )help Polynomial
-o )help UnivariatePolynomial
-o )help MultivariatePolynomial
-o )help HomogeneousDistributedMultivariatePolynomial
-o )help DistributedMultivariatePolynomial
-o )show GeneralDistributedMultivariatePolynomial
+        OMwrite(x: %, wholeObj: Boolean): String ==
+          s: String := ""
+          sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+          dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
+          if wholeObj then
+            OMputObject(dev)
+          writeOMFrac(dev, x)
+          if wholeObj then
+            OMputEndObject(dev)
+          OMclose(dev)
+          s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+          s
 
-\end{chunk}
-\pagehead{GeneralDistributedMultivariatePolynomial}{GDMP}
-\pagepic{ps/v103generaldistributedmultivariatepolynomial.ps}{GDMP}{1.00}
-{\bf See}\\
-\pageto{DistributedMultivariatePolynomial}{DMP}
-\pageto{HomogeneousDistributedMultivariatePolynomial}{HDMP}
+        OMwrite(dev: OpenMathDevice, x: %): Void ==
+          OMputObject(dev)
+          writeOMFrac(dev, x)
+          OMputEndObject(dev)
 
-{\bf Exports:}\\
-\begin{tabular}{lll}
-\cross{GDMP}{0} &
-\cross{GDMP}{1} &
-\cross{GDMP}{associates?} \\
-\cross{GDMP}{binomThmExpt} &
-\cross{GDMP}{characteristic} &
-\cross{GDMP}{charthRoot} \\
-\cross{GDMP}{coefficient} &
-\cross{GDMP}{coefficients} &
-\cross{GDMP}{coerce} \\
-\cross{GDMP}{conditionP} &
-\cross{GDMP}{content} &
-\cross{GDMP}{D} \\
-\cross{GDMP}{degree} &
-\cross{GDMP}{differentiate} &
-\cross{GDMP}{discriminant} \\
-\cross{GDMP}{eval} &
-\cross{GDMP}{exquo} &
-\cross{GDMP}{factor} \\
-\cross{GDMP}{factorPolynomial} &
-\cross{GDMP}{factorSquareFreePolynomial} &
-\cross{GDMP}{gcd} \\
-\cross{GDMP}{gcdPolynomial} &
-\cross{GDMP}{ground} &
-\cross{GDMP}{ground?} \\
-\cross{GDMP}{hash} &
-\cross{GDMP}{isExpt} &
-\cross{GDMP}{isPlus} \\
-\cross{GDMP}{isTimes} &
-\cross{GDMP}{latex} &
-\cross{GDMP}{lcm} \\
-\cross{GDMP}{leadingCoefficient} &
-\cross{GDMP}{leadingMonomial} &
-\cross{GDMP}{mainVariable} \\
-\cross{GDMP}{map} &
-\cross{GDMP}{mapExponents} &
-\cross{GDMP}{max} \\
-\cross{GDMP}{min} &
-\cross{GDMP}{minimumDegree} &
-\cross{GDMP}{monicDivide} \\
-\cross{GDMP}{monomial} &
-\cross{GDMP}{monomial?} &
-\cross{GDMP}{monomials} \\
-\cross{GDMP}{multivariate} &
-\cross{GDMP}{numberOfMonomials} &
-\cross{GDMP}{one?} \\
-\cross{GDMP}{patternMatch} &
-\cross{GDMP}{pomopo!} &
-\cross{GDMP}{prime?} \\
-\cross{GDMP}{primitiveMonomials} &
-\cross{GDMP}{primitivePart} &
-\cross{GDMP}{recip} \\
-\cross{GDMP}{reducedSystem} &
-\cross{GDMP}{reductum} &
-\cross{GDMP}{reorder} \\
-\cross{GDMP}{resultant} &
-\cross{GDMP}{retract} &
-\cross{GDMP}{retractIfCan} \\
-\cross{GDMP}{sample} &
-\cross{GDMP}{solveLinearPolynomialEquation} &
-\cross{GDMP}{squareFree} \\
-\cross{GDMP}{squareFreePart} &
-\cross{GDMP}{squareFreePolynomial} &
-\cross{GDMP}{subtractIfCan} \\
-\cross{GDMP}{totalDegree} &
-\cross{GDMP}{unit?} &
-\cross{GDMP}{unitCanonical} \\
-\cross{GDMP}{unitNormal} &
-\cross{GDMP}{univariate} &
-\cross{GDMP}{variables} \\
-\cross{GDMP}{zero?} &
-\cross{GDMP}{?*?} &
-\cross{GDMP}{?**?} \\
-\cross{GDMP}{?+?} &
-\cross{GDMP}{?-?} &
-\cross{GDMP}{-?} \\
-\cross{GDMP}{?=?} &
-\cross{GDMP}{?\~{}=?} &
-\cross{GDMP}{?$<$?} \\
-\cross{GDMP}{?$<=$?} &
-\cross{GDMP}{?$>$?} &
-\cross{GDMP}{?$>=$?} \\
-\cross{GDMP}{?\^{}?} &&
-\end{tabular}
+        OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void ==
+          if wholeObj then
+            OMputObject(dev)
+          writeOMFrac(dev, x)
+          if wholeObj then
+            OMputEndObject(dev)
 
-\begin{chunk}{domain GDMP GeneralDistributedMultivariatePolynomial}
-)abbrev domain GDMP GeneralDistributedMultivariatePolynomial
-++ Author: Barry Trager
-++ Description:
-++ This type supports distributed multivariate polynomials
-++ whose variables are from a user specified list of symbols.
-++ The coefficient ring may be non commutative,
-++ but the variables are assumed to commute.
-++ The term ordering is specified by its third parameter.
-++ Suggested types which define term orderings include: 
-++ \spadtype{DirectProduct}, \spadtype{HomogeneousDirectProduct}, 
-++ \spadtype{SplitHomogeneousDirectProduct} and finally 
-++ \spadtype{OrderedDirectProduct} which accepts an arbitrary user
-++ function to define a term ordering.
+    if S has GcdDomain then
 
-GeneralDistributedMultivariatePolynomial(vl,R,E): public == private where
-  vl: List Symbol
-  R: Ring
-  E: DirectProductCategory(#vl,NonNegativeInteger)
-  OV  ==> OrderedVariableList(vl)
-  SUP ==> SparseUnivariatePolynomial
-  NNI ==> NonNegativeInteger
+      cancelGcd: % -> S
 
-  public == PolynomialCategory(R,E,OV) with
-      reorder: (%,List Integer) -> %
-        ++ reorder(p, perm) applies the permutation perm to the variables
-        ++ in a polynomial and returns the new correctly ordered polynomial
+      normalize: % -> %
 
-  private == PolynomialRing(R,E) add
-    --representations
-      Term := Record(k:E,c:R)
-      Rep := List Term
-      n := #vl
-      Vec ==> Vector(NonNegativeInteger)
-      zero?(p : %): Boolean == null(p : Rep)
+      normalize x ==
+        zero?(x.num) => 0
+        ((x.den) = 1) => x
+        uca := unitNormal(x.den)
+        zero?(x.den := uca.canonical) => error "division by zero"
+        x.num := x.num * uca.associate
+        x
 
-      totalDegree p ==
-         zero? p => 0
-         "max"/[reduce("+",(t.k)::(Vector NNI), 0) for t in p]
+      recip x ==
+        zero?(x.num) => "failed"
+        normalize [x.den, x.num]
 
-      monomial(p:%, v: OV,e: NonNegativeInteger):% ==
-         locv := lookup v
-         p*monomial(1,
-            directProduct [if z=locv then e else 0 for z in 1..n]$Vec)
+      cancelGcd x ==
+        ((x.den) = 1) => x.den
+        d := gcd(x.num, x.den)
+        xn := x.num exquo d
+        xn case "failed" =>
+          error "gcd not gcd in QF cancelGcd (numerator)"
+        xd := x.den exquo d
+        xd case "failed" =>
+          error "gcd not gcd in QF cancelGcd (denominator)"
+        x.num := xn :: S
+        x.den := xd :: S
+        d
 
-      coerce(v: OV):% == monomial(1,v,1)
+      nn:S / dd:S ==
+        zero? dd => error "division by zero"
+        cancelGcd(z := [nn, dd])
+        normalize z
 
-      listCoef(p : %): List R ==
-        rec : Term
-        [rec.c for rec in (p:Rep)]
+      x + y  ==
+        zero? y => x
+        zero? x => y
+        z := [x.den,y.den]
+        d := cancelGcd z
+        g := [z.den * x.num + z.num * y.num, d]
+        cancelGcd g
+        g.den := g.den * z.num * z.den
+        normalize g
 
-      mainVariable(p: %) ==
-         zero?(p) => "failed"
-         for v in vl repeat
-           vv := variable(v)::OV
-           if degree(p,vv)>0 then return vv
-         "failed"
+      -- We can not rely on the defaulting mechanism
+      -- to supply a definition for -, even though this
+      -- definition would do, for thefollowing reasons:
+      --  1) The user could have defined a subtraction
+      --     in Localize, which would not work for
+      --     QuotientField;
+      --  2) even if he doesn't, the system currently
+      --     places a default definition in Localize,
+      --     which uses Localize's +, which does not
+      --     cancel gcds
+      x - y  ==
+        zero? y => x
+        z := [x.den, y.den]
+        d := cancelGcd z
+        g := [z.den * x.num - z.num * y.num, d]
+        cancelGcd g
+        g.den := g.den * z.num * z.den
+        normalize g
 
-      ground?(p) == mainVariable(p) case "failed"
+      x:% * y:%  ==
+        zero? x or zero? y => 0
+        (x = 1) => y
+        (y = 1) => x
+        (x, y) := ([x.num, y.den], [y.num, x.den])
+        cancelGcd x; cancelGcd y;
+        normalize [x.num * y.num, x.den * y.den]
 
-      retract(p : %): R ==
-          not ground? p => error "not a constant"
-          leadingCoefficient p
+      n:Integer * x:% ==
+        y := [n::S, x.den]
+        cancelGcd y
+        normalize [x.num * y.num, y.den]
 
-      retractIfCan(p : %): Union(R,"failed") ==
-        ground?(p) => leadingCoefficient p
-        "failed"
+      nn:S * x:% ==
+        y := [nn, x.den]
+        cancelGcd y
+        normalize [x.num * y.num, y.den]
 
-      degree(p: %,v: OV) == degree(univariate(p,v))
-      minimumDegree(p: %,v: OV) == minimumDegree(univariate(p,v))
-      differentiate(p: %,v: OV) ==
-            multivariate(differentiate(univariate(p,v)),v)
+      differentiate(x:%, deriv:S -> S) ==
+        y := [deriv(x.den), x.den]
+        d := cancelGcd(y)
+        y.num := deriv(x.num) * y.den - x.num * y.num
+        (d, y.den) := (y.den, d)
+        cancelGcd y
+        y.den := y.den * d * d
+        normalize y
 
-      degree(p: %,lv: List OV) == [degree(p,v) for v in lv]
-      minimumDegree(p: %,lv: List OV) == [minimumDegree(p,v) for v in lv]
+      if S has canonicalUnitNormal then
 
-      numberOfMonomials(p:%) ==
-        l : Rep := p : Rep
-        null(l) => 1
-        #l
+        x = y == (x.num = y.num) and (x.den = y.den)
 
-      monomial?(p : %): Boolean ==
-        l : Rep := p : Rep
-        null(l) or null rest(l)
+        one? x == ((x.num) = 1) and ((x.den) = 1)
+                  -- again assuming canonical nature of representation
 
-      if R has OrderedRing then
-        maxNorm(p : %): R ==
-          l : List R := nil
-          r,m : R
-          m := 0
-          for r in listCoef(p) repeat
-            if r > m then m := r
-            else if (-r) > m then m := -r
-          m
+    else
 
-      --trailingCoef(p : %) ==
-      --  l : Rep := p : Rep
-      --  null l => 0
-      --  r : Term := last l
-      --  r.c
+      nn:S/dd:S == if zero? dd then error "division by zero" else [nn,dd]
 
-      --leadingPrimitiveMonomial(p : %) ==
-      --  ground?(p) => 1$%
-      --  r : Term := first(p:Rep)
-      --  r := [r.k,1$R]$Term     -- new cell
-      -- list(r)$Rep :: %
+      recip x ==
+        zero?(x.num) => "failed"
+        [x.den, x.num]
 
-    -- The following 2 defs are inherited from PolynomialRing
+    if (S has RetractableTo Fraction Integer) then
 
-      --leadingMonomial(p : %) ==
-      --  ground?(p) => p
-      --  r : Term := first(p:Rep)
-      --  r := [r.k,r.c]$Term     -- new cell
-      --  list(r)$Rep :: %
+      retract(x:%):Fraction(Integer) == retract(retract(x)@S)
 
-      --reductum(p : %): % ==
-      --  ground? p => 0$%
-      --  (rest(p:Rep)):%
+      retractIfCan(x:%):Union(Fraction Integer, "failed") ==
+        (u := retractIfCan(x)@Union(S, "failed")) case "failed" => "failed"
+        retractIfCan(u::S)
 
-      if R has Field then
-        (p : %) / (r : R) == inv(r) * p
+    else if (S has RetractableTo Integer) then
 
-      variables(p: %) ==
-         maxdeg:Vector(NonNegativeInteger) := new(n,0)
-         while not zero?(p) repeat
-            tdeg := degree p
-            p := reductum p
-            for i in 1..n repeat
-              maxdeg.i := max(maxdeg.i, tdeg.i)
-         [index(i:PositiveInteger) for i in 1..n | maxdeg.i^=0]
+      retract(x:%):Fraction(Integer) ==
+        retract(numer x) / retract(denom x)
 
-      reorder(p: %,perm: List Integer):% ==
-         #perm ^= n => error "must be a complete permutation of all vars"
-         q := [[directProduct [term.k.j for j in perm]$Vec,term.c]$Term
-                         for term in p]
-         sort((z1,z2) +-> z1.k > z2.k,q)
+      retractIfCan(x:%):Union(Fraction Integer, "failed") ==
+        (n := retractIfCan numer x) case "failed" => "failed"
+        (d := retractIfCan denom x) case "failed" => "failed"
+        (n::Integer) / (d::Integer)
 
-      --coerce(dp:DistributedMultivariatePolynomial(vl,R)):% ==
-      --   q:=dp:List(Term)
-      --   sort(#1.k > #2.k,q):%
+    QFP ==> SparseUnivariatePolynomial %
 
-      univariate(p: %,v: OV):SUP(%) ==
-         zero?(p) => 0
-         exp := degree p
-         locv := lookup v
-         deg:NonNegativeInteger := 0
-         nexp := directProduct [if i=locv then (deg :=exp.i;0) else exp.i
-                                        for i in 1..n]$Vec
-         monomial(monomial(leadingCoefficient p,nexp),deg)+
-                      univariate(reductum p,v)
+    DP ==> SparseUnivariatePolynomial S
 
-      eval(p: %,v: OV,val:%):% == univariate(p,v)(val)
+    import UnivariatePolynomialCategoryFunctions2(%,QFP,S,DP)
 
-      eval(p: %,v: OV,val:R):% == eval(p,v,val::%)$%
+    import UnivariatePolynomialCategoryFunctions2(S,DP,%,QFP)
 
-      eval(p: %,lv: List OV,lval: List R):% ==
-         lv = [] => p
-         eval(eval(p,first lv,(first lval)::%)$%, rest lv, rest lval)$%
+    if S has GcdDomain then
 
-      -- assume Lvar are sorted correctly
-      evalSortedVarlist(p: %,Lvar: List OV,Lpval: List %):% ==
-        v := mainVariable p
-        v case "failed" => p
-        pv := v:: OV
-        Lvar=[] or Lpval=[] => p
-        mvar := Lvar.first
-        mvar > pv => evalSortedVarlist(p,Lvar.rest,Lpval.rest)
-        pval := Lpval.first
-        pts:SUP(%):= map(x+->evalSortedVarlist(x,Lvar,Lpval),univariate(p,pv))
-        mvar=pv => pts(pval)
-        multivariate(pts,pv)
+       gcdPolynomial(pp,qq) ==
+          zero? pp => qq
+          zero? qq => pp
+          zero? degree pp or zero? degree qq => 1
+          denpp:="lcm"/[denom u for u in coefficients pp]
+          ppD:DP:=map(x+->retract(x*denpp),pp)
+          denqq:="lcm"/[denom u for u in coefficients qq]
+          qqD:DP:=map(x+->retract(x*denqq),qq)
+          g:=gcdPolynomial(ppD,qqD)
+          zero? degree g => 1
+          ((lc:=leadingCoefficient g) = 1) => map(x+->x::%,g)
+          map(x+->x/lc,g)
 
-      eval(p:%,Lvar:List OV,Lpval:List %) ==
-        nlvar:List OV := sort((x,y) +-> x > y,Lvar)
-        nlpval :=
-           Lvar = nlvar => Lpval
-           nlpval := [Lpval.position(mvar,Lvar) for mvar in nlvar]
-        evalSortedVarlist(p,nlvar,nlpval)
+    if (S has PolynomialFactorizationExplicit) then
+       -- we'll let the solveLinearPolynomialEquations operator
+       -- default from Field
+       pp,qq: QFP
+       lpp: List QFP
+       import Factored SparseUnivariatePolynomial %
 
-      multivariate(p1:SUP(%),v: OV):% ==
-        0=p1 => 0
-        degree p1 = 0 => leadingCoefficient p1
-        leadingCoefficient(p1)*(v::%)**degree(p1) +
-                  multivariate(reductum p1,v)
+       if S has CharacteristicNonZero then
 
-      univariate(p: %):SUP(R) ==
-        (v := mainVariable p) case "failed" =>
-                      monomial(leadingCoefficient p,0)
-        q := univariate(p,v:: OV)
-        ans:SUP(R) := 0
-        while q ^= 0 repeat
-          ans := ans + monomial(ground leadingCoefficient q,degree q)
-          q := reductum q
-        ans
+          if S has canonicalUnitNormal and S has GcdDomain then
 
-      multivariate(p:SUP(R),v: OV):% ==
-        0=p => 0
-        (leadingCoefficient p)*monomial(1,v,degree p) +
-                       multivariate(reductum p,v)
+             charthRoot x ==
+               n:= charthRoot x.num
+               n case "failed" => "failed"
+               d:=charthRoot x.den
+               d case "failed" => "failed"
+               n/d
 
-      if R has GcdDomain then
-        content(p: %):R ==
-          zero?(p) => 0
-          "gcd"/[t.c for t in p]
+          else
+
+             charthRoot x ==
+               -- to find x = p-th root of n/d
+               -- observe that xd is p-th root of n*d**(p-1)
+               ans:=charthRoot(x.num *
+                      (x.den)**(characteristic()$%-1)::NonNegativeInteger)
+               ans case "failed" => "failed"
+               ans / x.den
 
+          clear: List % -> List S
 
+          clear l ==
+             d:="lcm"/[x.den for x in l]
+             [ x.num * (d exquo x.den)::S for x in l]
 
-        if R has EuclideanDomain and not(R has FloatingPointSystem)  then
-          gcd(p: %,q:%):% ==
-            gcd(p,q)$PolynomialGcdPackage(E,OV,R,%)
+          mat: Matrix %
 
-        else gcd(p: %,q:%):% ==
-            r : R
-            (pv := mainVariable(p)) case "failed" =>
-              (r := leadingCoefficient p) = 0$R => q
-              gcd(r,content q)::%
-            (qv := mainVariable(q)) case "failed" =>
-              (r := leadingCoefficient q) = 0$R => p
-              gcd(r,content p)::%
-            pv<qv => gcd(p,content univariate(q,qv))
-            qv<pv => gcd(q,content univariate(p,pv))
-            multivariate(gcd(univariate(p,pv),univariate(q,qv)),pv)
+          conditionP mat ==
+            matD: Matrix S
+            matD:= matrix [ clear l for l in listOfLists mat ]
+            ansD := conditionP matD
+            ansD case "failed" => "failed"
+            ansDD:=ansD :: Vector(S)
+            [ ansDD(i)::% for i in 1..#ansDD]$Vector(%)
 
-      coerce(p: %) : OutputForm ==
-        zero?(p) => (0$R) :: OutputForm
-        l,lt : List OutputForm
-        lt := nil
-        vl1 := [v::OutputForm for v in vl]
-        for t in reverse p repeat
-          l := nil
-          for i in 1..#vl1 repeat
-            t.k.i = 0 => l
-            t.k.i = 1 => l := cons(vl1.i,l)
-            l := cons(vl1.i ** t.k.i ::OutputForm,l)
-          l := reverse l
-          if (t.c ^= 1) or (null l) then l := cons(t.c :: OutputForm,l)
-          1 = #l => lt := cons(first l,lt)
-          lt := cons(reduce("*",l),lt)
-        1 = #lt => first lt
-        reduce("+",lt)
+       factorPolynomial(pp) ==
+          zero? pp => 0
+          denpp:="lcm"/[denom u for u in coefficients pp]
+          ppD:DP:=map(x+->retract(x*denpp),pp)
+          ff:=factorPolynomial ppD
+          den1:%:=denpp::%
+          lfact:List Record(flg:Union("nil", "sqfr", "irred", "prime"),
+                             fctr:QFP, xpnt:Integer)
+          lfact:= [[w.flg,
+                    if leadingCoefficient w.fctr =1 then 
+                           map(x+->x::%,w.fctr)
+                    else (lc:=(leadingCoefficient w.fctr)::%;
+                           den1:=den1/lc**w.xpnt;
+                            map(x+->x::%/lc,w.fctr)),
+                   w.xpnt] for w in factorList ff]
+          makeFR(map(x+->x::%/den1,unit(ff)),lfact)
 
-\end{chunk}
+       factorSquareFreePolynomial(pp) ==
+          zero? pp => 0
+          degree pp = 0 => makeFR(pp,empty())
+          lcpp:=leadingCoefficient pp
+          pp:=pp/lcpp
+          denpp:="lcm"/[denom u for u in coefficients pp]
+          ppD:DP:=map(x+->retract(x*denpp),pp)
+          ff:=factorSquareFreePolynomial ppD
+          den1:%:=denpp::%/lcpp
+          lfact:List Record(flg:Union("nil", "sqfr", "irred", "prime"),
+                             fctr:QFP, xpnt:Integer)
+          lfact:= [[w.flg,
+                    if leadingCoefficient w.fctr =1 then 
+                           map(x+->x::%,w.fctr)
+                    else (lc:=(leadingCoefficient w.fctr)::%;
+                           den1:=den1/lc**w.xpnt;
+                            map(x+->x::%/lc,w.fctr)),
+                   w.xpnt] for w in factorList ff]
+          makeFR(map(x+->x::%/den1,unit(ff)),lfact)
 
-\begin{chunk}{COQ GDMP}
-(* domain GDMP *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{GDMP.dotabb}
-"GDMP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GDMP"]
-"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
-"GDMP" -> "ALIST"
+\begin{chunk}{FRAC.dotabb}
+"FRAC" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FRAC"]
+"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"]
+"FRAC" -> "PFECAT"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain GMODPOL GeneralModulePolynomial}
+\section{domain FRIDEAL FractionalIdeal}
 
-\begin{chunk}{GeneralModulePolynomial.input}
+\begin{chunk}{FractionalIdeal.input}
 )set break resume
-)sys rm -f GeneralModulePolynomial.output
-)spool GeneralModulePolynomial.output
+)sys rm -f FractionalIdeal.output
+)spool FractionalIdeal.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show GeneralModulePolynomial
+)show FractionalIdeal
 --R 
---R GeneralModulePolynomial(vl: List(Symbol),R: CommutativeRing,IS: OrderedSet,E: DirectProductCategory(#(vl),NonNegativeInteger),ff: ((Record(index: IS,exponent: E),Record(index: IS,exponent: E)) -> Boolean),P: PolynomialCategory(R,E,OrderedVariableList(vl)))  is a domain constructor
---R Abbreviation for GeneralModulePolynomial is GMODPOL 
+--R FractionalIdeal(R: EuclideanDomain,F: QuotientFieldCategory(R),UP: UnivariatePolynomialCategory(F),A: Join(FramedAlgebra(F,UP),RetractableTo(F)))  is a domain constructor
+--R Abbreviation for FractionalIdeal is FRIDEAL 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for GMODPOL 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FRIDEAL 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (R,%) -> %                      ?*? : (%,R) -> %
---R ?*? : (%,P) -> %                      ?*? : (P,%) -> %
---R ?*? : (Integer,%) -> %                ?*? : (NonNegativeInteger,%) -> %
---R ?*? : (PositiveInteger,%) -> %        ?+? : (%,%) -> %
---R ?-? : (%,%) -> %                      -? : % -> %
---R ?=? : (%,%) -> Boolean                0 : () -> %
---R build : (R,IS,E) -> %                 coerce : % -> OutputForm
---R hash : % -> SingleInteger             latex : % -> String
---R leadingCoefficient : % -> R           leadingExponent : % -> E
---R leadingIndex : % -> IS                multMonom : (R,E,%) -> %
---R reductum : % -> %                     sample : () -> %
---R unitVector : IS -> %                  zero? : % -> Boolean
---R ?~=? : (%,%) -> Boolean              
---R leadingMonomial : % -> ModuleMonomial(IS,E,ff)
---R monomial : (R,ModuleMonomial(IS,E,ff)) -> %
---R subtractIfCan : (%,%) -> Union(%,"failed")
+--R ?*? : (%,%) -> %                      ?**? : (%,Integer) -> %
+--R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
+--R ?/? : (%,%) -> %                      ?=? : (%,%) -> Boolean
+--R 1 : () -> %                           ?^? : (%,Integer) -> %
+--R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
+--R basis : % -> Vector(A)                coerce : % -> OutputForm
+--R commutator : (%,%) -> %               conjugate : (%,%) -> %
+--R denom : % -> R                        hash : % -> SingleInteger
+--R ideal : Vector(A) -> %                inv : % -> %
+--R latex : % -> String                   minimize : % -> %
+--R norm : % -> F                         numer : % -> Vector(A)
+--R one? : % -> Boolean                   recip : % -> Union(%,"failed")
+--R sample : () -> %                      ?~=? : (%,%) -> Boolean
+--R randomLC : (NonNegativeInteger,Vector(A)) -> A
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{GeneralModulePolynomial.help}
+\begin{chunk}{FractionalIdeal.help}
 ====================================================================
-GeneralModulePolynomial examples
+FractionalIdeal examples
 ====================================================================
 
-This package is undocumented
+Fractional ideals in a framed algebra.
 
 See Also:
-o )show GeneralModulePolynomial
+o )show FractionalIdeal
 
 \end{chunk}
 
-\pagehead{GeneralModulePolynomial}{GMODPOL}
-\pagepic{ps/v103generalmodulepolynomial.ps}{GMODPOL}{1.00}
+\pagehead{FractionalIdeal}{FRIDEAL}
+\pagepic{ps/v103fractionalideal.ps}{FRIDEAL}{1.00}
 {\bf See}\\
-\pageto{ModuleMonomial}{MODMONOM}
+\pageto{FramedModule}{FRMOD}
+\pageto{HyperellipticFiniteDivisor}{HELLFDIV}
+\pageto{FiniteDivisor}{FDIV}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{GMODPOL}{0} &
-\cross{GMODPOL}{build} &
-\cross{GMODPOL}{coerce} &
-\cross{GMODPOL}{hash} &
-\cross{GMODPOL}{latex} \\
-\cross{GMODPOL}{leadingCoefficient} &
-\cross{GMODPOL}{leadingExponent} &
-\cross{GMODPOL}{leadingIndex} &
-\cross{GMODPOL}{leadingMonomial} &
-\cross{GMODPOL}{monomial} \\
-\cross{GMODPOL}{multMonom} &
-\cross{GMODPOL}{reductum} &
-\cross{GMODPOL}{sample} &
-\cross{GMODPOL}{subtractIfCan} &
-\cross{GMODPOL}{unitVector} \\
-\cross{GMODPOL}{zero?} &
-\cross{GMODPOL}{?\~{}=?} &
-\cross{GMODPOL}{?*?} &
-\cross{GMODPOL}{?+?} &
-\cross{GMODPOL}{?-?} \\
-\cross{GMODPOL}{-?} &
-\cross{GMODPOL}{?=?} &&&
+\cross{FRIDEAL}{1} &
+\cross{FRIDEAL}{basis} &
+\cross{FRIDEAL}{coerce} &
+\cross{FRIDEAL}{commutator} &
+\cross{FRIDEAL}{conjugate} \\
+\cross{FRIDEAL}{denom} &
+\cross{FRIDEAL}{hash} &
+\cross{FRIDEAL}{ideal} &
+\cross{FRIDEAL}{inv} &
+\cross{FRIDEAL}{latex} \\
+\cross{FRIDEAL}{minimize} &
+\cross{FRIDEAL}{norm} &
+\cross{FRIDEAL}{numer} &
+\cross{FRIDEAL}{one?} &
+\cross{FRIDEAL}{randomLC} \\
+\cross{FRIDEAL}{recip} &
+\cross{FRIDEAL}{sample} &
+\cross{FRIDEAL}{?\~{}=?} &
+\cross{FRIDEAL}{?**?} &
+\cross{FRIDEAL}{?\^{}?} \\
+\cross{FRIDEAL}{?*?} &
+\cross{FRIDEAL}{?**?} &
+\cross{FRIDEAL}{?/?} &
+\cross{FRIDEAL}{?=?} &
+\cross{FRIDEAL}{?\^{}?} 
 \end{tabular}
 
-\begin{chunk}{domain GMODPOL GeneralModulePolynomial}
-)abbrev domain GMODPOL GeneralModulePolynomial
-++ Author: Mark Botch
+\begin{chunk}{domain FRIDEAL FractionalIdeal}
+)abbrev domain FRIDEAL FractionalIdeal
+++ Author: Manuel Bronstein
+++ Date Created: 27 Jan 1989
+++ Date Last Updated: 30 July 1993
 ++ Description:
-++ This package is undocumented
-
-GeneralModulePolynomial(vl, R, IS, E, ff, P): public  ==  private where
-  vl: List(Symbol)
-  R: CommutativeRing
-  IS: OrderedSet
-  NNI ==> NonNegativeInteger
-  E: DirectProductCategory(#vl, NNI)
-  MM ==> Record(index:IS, exponent:E)
-  ff: (MM, MM) -> Boolean
-  OV  ==> OrderedVariableList(vl)
-  P: PolynomialCategory(R, E, OV)
-  ModMonom ==> ModuleMonomial(IS, E, ff)
-
+++ Fractional ideals in a framed algebra.
 
-  public  ==  Join(Module(P), Module(R))  with
-    leadingCoefficient: $ -> R
-      ++ leadingCoefficient(x) is not documented
-    leadingMonomial: $ -> ModMonom
-      ++ leadingMonomial(x) is not documented
-    leadingExponent: $ -> E
-      ++ leadingExponent(x) is not documented
-    leadingIndex: $ -> IS
-      ++ leadingIndex(x) is not documented
-    reductum: $ -> $
-      ++ reductum(x) is not documented
-    monomial: (R, ModMonom) -> $
-      ++ monomial(r,x) is not documented
-    unitVector: IS -> $
-      ++ unitVector(x) is not documented
-    build: (R, IS, E) -> $
-      ++ build(r,i,e) is not documented
-    multMonom: (R, E, $) -> $
-      ++ multMonom(r,e,x) is not documented
-    "*": (P,$) -> $
-      ++ p*x is not documented
+FractionalIdeal(R, F, UP, A): Exports == Implementation where
+  R : EuclideanDomain
+  F : QuotientFieldCategory R
+  UP: UnivariatePolynomialCategory F
+  A : Join(FramedAlgebra(F, UP), RetractableTo F)
 
+  VF  ==> Vector F
+  VA  ==> Vector A
+  UPA ==> SparseUnivariatePolynomial A
+  QF  ==> Fraction UP
 
-  private  ==  FreeModule(R, ModMonom)  add
-        Rep:= FreeModule(R, ModMonom)
-        leadingMonomial(p:$):ModMonom == leadingSupport(p)$Rep
-        leadingExponent(p:$):E == exponent(leadingMonomial p)
-        leadingIndex(p:$):IS == index(leadingMonomial p)
-        unitVector(i:IS):$ == monomial(1,[i, 0$E]$ModMonom)
+  Exports ==> Group with
+    ideal   : VA -> %
+      ++ ideal([f1,...,fn]) returns the ideal \spad{(f1,...,fn)}.
+    basis   : %  -> VA
+      ++ basis((f1,...,fn)) returns the vector \spad{[f1,...,fn]}.
+    norm    : %  -> F
+      ++ norm(I) returns the norm of the ideal I.
+    numer   : %  -> VA
+      ++ numer(1/d * (f1,...,fn)) = the vector \spad{[f1,...,fn]}.
+    denom   : %  -> R
+      ++ denom(1/d * (f1,...,fn)) returns d.
+    minimize: %  -> %
+      ++ minimize(I) returns a reduced set of generators for \spad{I}.
+    randomLC: (NonNegativeInteger, VA) -> A
+      ++ randomLC(n,x) should be local but conditional.
 
+  Implementation ==> add
+    import CommonDenominator(R, F, VF)
+    import MatrixCommonDenominator(UP, QF)
+    import InnerCommonDenominator(R, F, List R, List F)
+    import MatrixCategoryFunctions2(F, Vector F, Vector F, Matrix F,
+                        UP, Vector UP, Vector UP, Matrix UP)
+    import MatrixCategoryFunctions2(UP, Vector UP, Vector UP,
+                        Matrix UP, F, Vector F, Vector F, Matrix F)
+    import MatrixCategoryFunctions2(UP, Vector UP, Vector UP,
+                        Matrix UP, QF, Vector QF, Vector QF, Matrix QF)
 
- -----------------------------------------------------------------------------
+    Rep := Record(num:VA, den:R)
 
-        build(c:R, i:IS, e:E):$  ==  monomial(c, construct(i, e))
+    poly    : % -> UPA
+    invrep  : Matrix F -> A
+    upmat   : (A, NonNegativeInteger) -> Matrix UP
+    summat  : % -> Matrix UP
+    num2O   : VA -> OutputForm
+    agcd    : List A -> R
+    vgcd    : VF -> R
+    mkIdeal : (VA, R) -> %
+    intIdeal: (List A, R) -> %
+    ret?    : VA -> Boolean
+    tryRange: (NonNegativeInteger, VA, R, %) -> Union(%, "failed")
 
- -----------------------------------------------------------------------------
+    1               == [[1]$VA, 1]
 
-     ----   WARNING: assumes c ^= 0
+    numer i         == i.num
 
-        multMonom(c:R, e:E, mp:$):$  ==
-            zero? mp => mp
-            monomial(c * leadingCoefficient mp, [leadingIndex mp,
-                     e + leadingExponent mp]) + multMonom(c, e, reductum mp)
+    denom i         == i.den
 
- -----------------------------------------------------------------------------
+    mkIdeal(v, d)   == [v, d]
 
+    invrep m        == represents(transpose(m) * coordinates(1$A))
 
-        ((p:P) * (mp:$)):$  ==
-            zero? p => 0
-            multMonom(leadingCoefficient p, degree p, mp) +
-               reductum(p) * mp
+    upmat(x, i)     == map(s +-> monomial(s, i)$UP, regularRepresentation x)
 
-\end{chunk}
+    ret? v          == any?(s+->retractIfCan(s)@Union(F,"failed") case F, v)
 
-\begin{chunk}{COQ GMODPOL}
-(* domain GMODPOL *)
-(*
-*)
+    x = y           == denom(x) = denom(y) and numer(x) = numer(y)
 
-\end{chunk}
+    agcd l  == reduce("gcd", [vgcd coordinates a for a in l]$List(R), 0)
 
-\begin{chunk}{GMODPOL.dotabb}
-"GMODPOL" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GMODPOL"]
-"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"]
-"DIRPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=DIRPCAT"]
-"GMODPOL" -> "PFECAT"
-"GMODPOL" -> "DIRPCAT"
+    norm i ==
+      ("gcd"/[retract(u)@R for u in coefficients determinant summat i])
+              / denom(i) ** rank()$A
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain GCNAALG GenericNonAssociativeAlgebra}
+    tryRange(range, nm, nrm, i) ==
+      for j in 0..10 repeat
+        a := randomLC(10 * range, nm)
+        unit? gcd((retract(norm a)@R exquo nrm)::R, nrm) =>
+                                return intIdeal([nrm::F::A, a], denom i)
+      "failed"
 
-\begin{chunk}{GenericNonAssociativeAlgebra.input}
-)set break resume
-)sys rm -f GenericNonAssociativeAlgebra.output
-)spool GenericNonAssociativeAlgebra.output
-)set message test on
-)set message auto off
-)clear all
+    summat i ==
+      m := minIndex(v := numer i)
+      reduce("+",
+            [upmat(qelt(v, j + m), j) for j in 0..#v-1]$List(Matrix UP))
 
---S 1 of 1
-)show GenericNonAssociativeAlgebra
---R 
---R GenericNonAssociativeAlgebra(R: CommutativeRing,n: PositiveInteger,ls: List(Symbol),gamma: Vector(Matrix(R)))  is a domain constructor
---R Abbreviation for GenericNonAssociativeAlgebra is GCNAALG 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for GCNAALG 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
---R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?**? : (%,PositiveInteger) -> %       ?+? : (%,%) -> %
---R ?-? : (%,%) -> %                      -? : % -> %
---R ?=? : (%,%) -> Boolean                0 : () -> %
---R alternative? : () -> Boolean          antiAssociative? : () -> Boolean
---R antiCommutative? : () -> Boolean      antiCommutator : (%,%) -> %
---R associative? : () -> Boolean          associator : (%,%,%) -> %
---R basis : () -> Vector(%)               coerce : % -> OutputForm
---R commutative? : () -> Boolean          commutator : (%,%) -> %
---R flexible? : () -> Boolean             generic : (Symbol,Vector(%)) -> %
---R generic : Vector(%) -> %              generic : Vector(Symbol) -> %
---R generic : Symbol -> %                 generic : () -> %
---R hash : % -> SingleInteger             jacobiIdentity? : () -> Boolean
---R jordanAdmissible? : () -> Boolean     jordanAlgebra? : () -> Boolean
---R latex : % -> String                   leftAlternative? : () -> Boolean
---R lieAdmissible? : () -> Boolean        lieAlgebra? : () -> Boolean
---R powerAssociative? : () -> Boolean     rank : () -> PositiveInteger
---R rightAlternative? : () -> Boolean     sample : () -> %
---R someBasis : () -> Vector(%)           zero? : % -> Boolean
---R ?~=? : (%,%) -> Boolean              
---R ?*? : (SquareMatrix(n,Fraction(Polynomial(R))),%) -> %
---R ?*? : (Fraction(Polynomial(R)),%) -> %
---R ?*? : (%,Fraction(Polynomial(R))) -> %
---R apply : (Matrix(Fraction(Polynomial(R))),%) -> %
---R associatorDependence : () -> List(Vector(Fraction(Polynomial(R)))) if Fraction(Polynomial(R)) has INTDOM
---R coerce : Vector(Fraction(Polynomial(R))) -> %
---R conditionsForIdempotents : () -> List(Polynomial(R)) if R has INTDOM
---R conditionsForIdempotents : Vector(%) -> List(Polynomial(R)) if R has INTDOM
---R conditionsForIdempotents : () -> List(Polynomial(Fraction(Polynomial(R))))
---R conditionsForIdempotents : Vector(%) -> List(Polynomial(Fraction(Polynomial(R))))
---R convert : Vector(Fraction(Polynomial(R))) -> %
---R convert : % -> Vector(Fraction(Polynomial(R)))
---R coordinates : Vector(%) -> Matrix(Fraction(Polynomial(R)))
---R coordinates : % -> Vector(Fraction(Polynomial(R)))
---R coordinates : (Vector(%),Vector(%)) -> Matrix(Fraction(Polynomial(R)))
---R coordinates : (%,Vector(%)) -> Vector(Fraction(Polynomial(R)))
---R ?.? : (%,Integer) -> Fraction(Polynomial(R))
---R generic : (Vector(Symbol),Vector(%)) -> %
---R genericLeftDiscriminant : () -> Fraction(Polynomial(R)) if R has INTDOM
---R genericLeftMinimalPolynomial : % -> SparseUnivariatePolynomial(Fraction(Polynomial(R))) if R has INTDOM
---R genericLeftNorm : % -> Fraction(Polynomial(R)) if R has INTDOM
---R genericLeftTrace : % -> Fraction(Polynomial(R)) if R has INTDOM
---R genericLeftTraceForm : (%,%) -> Fraction(Polynomial(R)) if R has INTDOM
---R genericRightDiscriminant : () -> Fraction(Polynomial(R)) if R has INTDOM
---R genericRightMinimalPolynomial : % -> SparseUnivariatePolynomial(Fraction(Polynomial(R))) if R has INTDOM
---R genericRightNorm : % -> Fraction(Polynomial(R)) if R has INTDOM
---R genericRightTrace : % -> Fraction(Polynomial(R)) if R has INTDOM
---R genericRightTraceForm : (%,%) -> Fraction(Polynomial(R)) if R has INTDOM
---R leftCharacteristicPolynomial : % -> SparseUnivariatePolynomial(Fraction(Polynomial(R)))
---R leftDiscriminant : () -> Fraction(Polynomial(R))
---R leftDiscriminant : Vector(%) -> Fraction(Polynomial(R))
---R leftMinimalPolynomial : % -> SparseUnivariatePolynomial(Fraction(Polynomial(R))) if Fraction(Polynomial(R)) has INTDOM
---R leftNorm : % -> Fraction(Polynomial(R))
---R leftPower : (%,PositiveInteger) -> %
---R leftRankPolynomial : () -> SparseUnivariatePolynomial(Fraction(Polynomial(R))) if R has INTDOM
---R leftRankPolynomial : () -> SparseUnivariatePolynomial(Polynomial(Fraction(Polynomial(R)))) if Fraction(Polynomial(R)) has FIELD
---R leftRecip : % -> Union(%,"failed") if Fraction(Polynomial(R)) has INTDOM
---R leftRegularRepresentation : % -> Matrix(Fraction(Polynomial(R)))
---R leftRegularRepresentation : (%,Vector(%)) -> Matrix(Fraction(Polynomial(R)))
---R leftTrace : % -> Fraction(Polynomial(R))
---R leftTraceMatrix : () -> Matrix(Fraction(Polynomial(R)))
---R leftTraceMatrix : Vector(%) -> Matrix(Fraction(Polynomial(R)))
---R leftUnit : () -> Union(%,"failed") if Fraction(Polynomial(R)) has INTDOM
---R leftUnits : () -> Union(Record(particular: %,basis: List(%)),"failed")
---R noncommutativeJordanAlgebra? : () -> Boolean
---R plenaryPower : (%,PositiveInteger) -> %
---R recip : % -> Union(%,"failed") if Fraction(Polynomial(R)) has INTDOM
---R represents : Vector(Fraction(Polynomial(R))) -> %
---R represents : (Vector(Fraction(Polynomial(R))),Vector(%)) -> %
---R rightCharacteristicPolynomial : % -> SparseUnivariatePolynomial(Fraction(Polynomial(R)))
---R rightDiscriminant : () -> Fraction(Polynomial(R))
---R rightDiscriminant : Vector(%) -> Fraction(Polynomial(R))
---R rightMinimalPolynomial : % -> SparseUnivariatePolynomial(Fraction(Polynomial(R))) if Fraction(Polynomial(R)) has INTDOM
---R rightNorm : % -> Fraction(Polynomial(R))
---R rightPower : (%,PositiveInteger) -> %
---R rightRankPolynomial : () -> SparseUnivariatePolynomial(Fraction(Polynomial(R))) if R has INTDOM
---R rightRankPolynomial : () -> SparseUnivariatePolynomial(Polynomial(Fraction(Polynomial(R)))) if Fraction(Polynomial(R)) has FIELD
---R rightRecip : % -> Union(%,"failed") if Fraction(Polynomial(R)) has INTDOM
---R rightRegularRepresentation : % -> Matrix(Fraction(Polynomial(R)))
---R rightRegularRepresentation : (%,Vector(%)) -> Matrix(Fraction(Polynomial(R)))
---R rightTrace : % -> Fraction(Polynomial(R))
---R rightTraceMatrix : () -> Matrix(Fraction(Polynomial(R)))
---R rightTraceMatrix : Vector(%) -> Matrix(Fraction(Polynomial(R)))
---R rightUnit : () -> Union(%,"failed") if Fraction(Polynomial(R)) has INTDOM
---R rightUnits : () -> Union(Record(particular: %,basis: List(%)),"failed")
---R structuralConstants : () -> Vector(Matrix(Fraction(Polynomial(R))))
---R structuralConstants : Vector(%) -> Vector(Matrix(Fraction(Polynomial(R))))
---R subtractIfCan : (%,%) -> Union(%,"failed")
---R unit : () -> Union(%,"failed") if Fraction(Polynomial(R)) has INTDOM
---R
---E 1
+    inv i ==
+      m  := inverse(map(s+->s::QF, summat i))::Matrix(QF)
+      cd  := splitDenominator(denom(i)::F::UP::QF * m)
+      cd2 := splitDenominator coefficients(cd.den)
+      invd:= cd2.den / reduce("gcd", cd2.num)
+      d   := reduce("max", [degree p for p in parts(cd.num)])
+      ideal
+        [invd * invrep map(s+->coefficient(s, j), cd.num) for j in 0..d]$VA
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{GenericNonAssociativeAlgebra.help}
-====================================================================
-GenericNonAssociativeAlgebra examples
-====================================================================
+    ideal v ==
+      d := reduce("lcm", [commonDenominator coordinates qelt(v, i)
+                          for i in minIndex v .. maxIndex v]$List(R))
+      intIdeal([d::F * qelt(v, i) for i in minIndex v .. maxIndex v], d)
 
-AlgebraGenericElementPackage allows you to create generic elements of an 
-algebra, i.e. the scalars are extended to include symbolic coefficients.
+    intIdeal(l, d) ==
+      lr := empty()$List(R)
+      nr := empty()$List(A)
+      for x in removeDuplicates l repeat
+        if (u := retractIfCan(x)@Union(F, "failed")) case F
+          then lr := concat(retract(u::F)@R, lr)
+          else nr := concat(x, nr)
+      r    := reduce("gcd", lr, 0)
+      g    := agcd nr
+      a    := (r quo (b := gcd(gcd(d, r), g)))::F::A
+      d    := d quo b
+      r ^= 0 and ((g exquo r) case R) => mkIdeal([a], d)
+      invb := inv(b::F)
+      va:VA := [invb * m for m in nr]
+      zero? a => mkIdeal(va, d)
+      mkIdeal(concat(a, va), d)
 
-See Also:
-o )show GenericNonAssociativeAlgebra
+    vgcd v ==
+      reduce("gcd",
+             [retract(v.i)@R for i in minIndex v .. maxIndex v]$List(R))
 
-\end{chunk}
+    poly i ==
+      m := minIndex(v := numer i)
+      +/[monomial(qelt(v, i + m), i) for i in 0..#v-1]
 
-\pagehead{GenericNonAssociativeAlgebra}{GCNAALG}
-\pagepic{ps/v103genericnonassociativealgebra.ps}{GCNAALG}{1.00}
+    i1 * i2 ==
+      intIdeal(coefficients(poly i1 * poly i2), denom i1 * denom i2)
 
-{\bf Exports:}\\
-\begin{tabular}{ll}
-\cross{GCNAALG}{0} &
-\cross{GCNAALG}{alternative?} \\
-\cross{GCNAALG}{antiAssociative?} &
-\cross{GCNAALG}{antiCommutative?} \\
-\cross{GCNAALG}{antiCommutator} &
-\cross{GCNAALG}{apply} \\
-\cross{GCNAALG}{associative?} &
-\cross{GCNAALG}{associator} \\
-\cross{GCNAALG}{associatorDependence} &
-\cross{GCNAALG}{basis} \\
-\cross{GCNAALG}{coerce} &
-\cross{GCNAALG}{commutative?} \\
-\cross{GCNAALG}{commutator} &
-\cross{GCNAALG}{conditionsForIdempotents} \\
-\cross{GCNAALG}{convert} &
-\cross{GCNAALG}{convert} \\
-\cross{GCNAALG}{coordinates} &
-\cross{GCNAALG}{coordinates} \\
-\cross{GCNAALG}{coordinates} &
-\cross{GCNAALG}{coordinates} \\
-\cross{GCNAALG}{flexible?} &
-\cross{GCNAALG}{generic} \\
-\cross{GCNAALG}{genericLeftDiscriminant} &
-\cross{GCNAALG}{genericLeftMinimalPolynomial} \\
-\cross{GCNAALG}{genericLeftNorm} &
-\cross{GCNAALG}{genericLeftTrace} \\
-\cross{GCNAALG}{genericLeftTraceForm} &
-\cross{GCNAALG}{genericRightDiscriminant} \\
-\cross{GCNAALG}{genericRightMinimalPolynomial} &
-\cross{GCNAALG}{genericRightNorm} \\
-\cross{GCNAALG}{genericRightTrace} &
-\cross{GCNAALG}{genericRightTraceForm} \\
-\cross{GCNAALG}{hash} &
-\cross{GCNAALG}{jacobiIdentity?} \\
-\cross{GCNAALG}{jordanAdmissible?} &
-\cross{GCNAALG}{jordanAlgebra?} \\
-\cross{GCNAALG}{latex} &
-\cross{GCNAALG}{leftAlternative?} \\
-\cross{GCNAALG}{leftCharacteristicPolynomial} &
-\cross{GCNAALG}{leftDiscriminant} \\
-\cross{GCNAALG}{leftDiscriminant} &
-\cross{GCNAALG}{leftMinimalPolynomial} \\
-\cross{GCNAALG}{leftNorm} &
-\cross{GCNAALG}{leftPower} \\
-\cross{GCNAALG}{leftRankPolynomial} &
-\cross{GCNAALG}{leftRankPolynomial} \\
-\cross{GCNAALG}{leftRecip} &
-\cross{GCNAALG}{leftRegularRepresentation} \\
-\cross{GCNAALG}{leftRegularRepresentation} &
-\cross{GCNAALG}{leftTrace} \\
-\cross{GCNAALG}{leftTraceMatrix} &
-\cross{GCNAALG}{leftTraceMatrix} \\
-\cross{GCNAALG}{leftUnit} &
-\cross{GCNAALG}{leftUnits} \\
-\cross{GCNAALG}{lieAdmissible?} &
-\cross{GCNAALG}{lieAlgebra?} \\
-\cross{GCNAALG}{noncommutativeJordanAlgebra?} &
-\cross{GCNAALG}{plenaryPower} \\
-\cross{GCNAALG}{powerAssociative?} &
-\cross{GCNAALG}{rank} \\
-\cross{GCNAALG}{recip} &
-\cross{GCNAALG}{represents} \\
-\cross{GCNAALG}{rightAlternative?} &
-\cross{GCNAALG}{rightCharacteristicPolynomial} \\
-\cross{GCNAALG}{rightDiscriminant} &
-\cross{GCNAALG}{rightDiscriminant} \\
-\cross{GCNAALG}{rightMinimalPolynomial} &
-\cross{GCNAALG}{rightNorm} \\
-\cross{GCNAALG}{rightPower} &
-\cross{GCNAALG}{rightRankPolynomial} \\
-\cross{GCNAALG}{rightRankPolynomial} &
-\cross{GCNAALG}{rightRecip} \\
-\cross{GCNAALG}{rightRegularRepresentation} &
-\cross{GCNAALG}{rightRegularRepresentation} \\
-\cross{GCNAALG}{rightTrace} &
-\cross{GCNAALG}{rightTraceMatrix} \\
-\cross{GCNAALG}{rightTraceMatrix} &
-\cross{GCNAALG}{rightUnit} \\
-\cross{GCNAALG}{rightUnits} &
-\cross{GCNAALG}{sample} \\
-\cross{GCNAALG}{someBasis} &
-\cross{GCNAALG}{structuralConstants} \\
-\cross{GCNAALG}{structuralConstants} &
-\cross{GCNAALG}{subtractIfCan} \\
-\cross{GCNAALG}{unit} &
-\cross{GCNAALG}{zero?} \\
-\cross{GCNAALG}{?*?} &
-\cross{GCNAALG}{?**?} \\
-\cross{GCNAALG}{?+?} &
-\cross{GCNAALG}{?-?} \\
-\cross{GCNAALG}{-?} &
-\cross{GCNAALG}{?=?} \\
-\cross{GCNAALG}{?.?} &
-\cross{GCNAALG}{?\~{}=?}
-\end{tabular}
+    i:$ ** m:Integer ==
+      m < 0 => inv(i) ** (-m)
+      n := m::NonNegativeInteger
+      v := numer i
+      intIdeal([qelt(v, j) ** n for j in minIndex v .. maxIndex v],
+               denom(i) ** n)
 
-\begin{chunk}{domain GCNAALG GenericNonAssociativeAlgebra}
-)abbrev domain GCNAALG GenericNonAssociativeAlgebra
-++ Authors: J. Grabmeier, R. Wisbauer
-++ Date Created: 26 June 1991
-++ Date Last Updated: 26 June 1991
-++ Reference:
-++  A. Woerz-Busekros: Algebra in Genetics
-++  Lectures Notes in Biomathematics 36,
-++  Springer-Verlag,  Heidelberg, 1980
-++ Description:
-++ AlgebraGenericElementPackage allows you to create generic elements
-++ of an algebra, i.e. the scalars are extended to include symbolic
-++ coefficients
+    num2O v ==
+      paren [qelt(v, i)::OutputForm
+             for i in minIndex v .. maxIndex v]$List(OutputForm)
 
-GenericNonAssociativeAlgebra(R : CommutativeRing, n : PositiveInteger,_
-  ls : List Symbol, gamma: Vector Matrix R ): public == private where
+    basis i ==
+      v := numer i
+      d := inv(denom(i)::F)
+      [d * qelt(v, j) for j in minIndex v .. maxIndex v]
 
-  NNI ==> NonNegativeInteger
-  V   ==> Vector
-  PR  ==> Polynomial R
-  FPR ==> Fraction Polynomial R
-  SUP ==> SparseUnivariatePolynomial
-  S   ==> Symbol
+    coerce(i:$):OutputForm ==
+      nm := num2O numer i
+      (denom i = 1) => nm
+      (1::Integer::OutputForm) / (denom(i)::OutputForm) * nm
 
-  public ==> Join(FramedNonAssociativeAlgebra(FPR), _
-      LeftModule(SquareMatrix(n,FPR)) ) with
+    if F has Finite then
 
-    coerce : Vector FPR -> %
-      ++ coerce(v) assumes that it is called with a vector
-      ++ of length equal to the dimension of the algebra, then
-      ++ a linear combination with the basis element is formed
-    leftUnits:() -> Union(Record(particular: %, basis: List %), "failed")
-      ++ leftUnits() returns the affine space of all left units of the
-      ++ algebra, or \spad{"failed"} if there is none
-    rightUnits:() -> Union(Record(particular: %, basis: List %), "failed")
-      ++ rightUnits() returns the affine space of all right units of the
-      ++ algebra, or \spad{"failed"} if there is none
-    generic : () -> %
-      ++ generic() returns a generic element, i.e. the linear combination
-      ++ of the fixed basis with the symbolic coefficients
-      ++ \spad{%x1,%x2,..}
-    generic : Symbol -> %
-      ++ generic(s) returns a generic element, i.e. the linear combination
-      ++ of the fixed basis with the symbolic coefficients
-      ++ \spad{s1,s2,..}
-    generic : Vector Symbol -> %
-      ++ generic(vs) returns a generic element, i.e. the linear combination
-      ++ of the fixed basis with the symbolic coefficients
-      ++ \spad{vs};
-      ++ error, if the vector of symbols is too short
-    generic : Vector % -> %
-      ++ generic(ve) returns a generic element, i.e. the linear combination
-      ++ of \spad{ve} basis with the symbolic coefficients
-      ++ \spad{%x1,%x2,..}
-    generic : (Symbol, Vector %) -> %
-      ++ generic(s,v) returns a generic element, i.e. the linear combination
-      ++ of v with the symbolic coefficients
-      ++ \spad{s1,s2,..}
-    generic : (Vector Symbol, Vector %) -> %
-      ++ generic(vs,ve) returns a generic element, i.e. the linear combination
-      ++ of \spad{ve} with the symbolic coefficients \spad{vs}
-      ++ error, if the vector of symbols is shorter than the vector of
-      ++ elements
-    if R has IntegralDomain then
-      leftRankPolynomial : () -> SparseUnivariatePolynomial FPR
-        ++ leftRankPolynomial() returns the left minimimal polynomial
-        ++ of the generic element
-      genericLeftMinimalPolynomial : % -> SparseUnivariatePolynomial FPR
-        ++ genericLeftMinimalPolynomial(a) substitutes the coefficients
-        ++ of {em a} for the generic coefficients in
-        ++ \spad{leftRankPolynomial()}
-      genericLeftTrace : % -> FPR
-        ++ genericLeftTrace(a) substitutes the coefficients
-        ++ of \spad{a} for the generic coefficients into the
-        ++ coefficient of the second highest term in
-        ++ \spadfun{leftRankPolynomial} and changes the sign.
-        ++  This is a linear form
-      genericLeftNorm : % -> FPR
-        ++ genericLeftNorm(a) substitutes the coefficients
-        ++ of \spad{a} for the generic coefficients into the
-        ++ coefficient of the constant term in \spadfun{leftRankPolynomial}
-        ++ and changes the sign if the degree of this polynomial is odd.
-        ++ This is a form of degree k
-      rightRankPolynomial : () -> SparseUnivariatePolynomial FPR
-        ++ rightRankPolynomial() returns the right minimimal polynomial
-        ++ of the generic element
-      genericRightMinimalPolynomial : % -> SparseUnivariatePolynomial FPR
-        ++ genericRightMinimalPolynomial(a) substitutes the coefficients
-        ++ of \spad{a} for the generic coefficients in
-        ++ \spadfun{rightRankPolynomial}
-      genericRightTrace : % -> FPR
-        ++ genericRightTrace(a) substitutes the coefficients
-        ++ of \spad{a} for the generic coefficients into the
-        ++ coefficient of the second highest term in
-        ++ \spadfun{rightRankPolynomial} and changes the sign
-      genericRightNorm : % -> FPR
-        ++ genericRightNorm(a) substitutes the coefficients
-        ++ of \spad{a} for the generic coefficients into the
-        ++ coefficient of the constant term in \spadfun{rightRankPolynomial}
-        ++ and changes the sign if the degree of this polynomial is odd
-      genericLeftTraceForm : (%,%) -> FPR
-        ++ genericLeftTraceForm (a,b) is defined to be
-        ++ \spad{genericLeftTrace (a*b)}, this defines
-        ++ a symmetric bilinear form on the algebra
-      genericLeftDiscriminant: () -> FPR
-        ++ genericLeftDiscriminant() is the determinant of the
-        ++ generic left trace forms of all products of basis element,
-        ++ if the generic left trace form is associative, an algebra
-        ++ is separable if the generic left discriminant is invertible,
-        ++ if it is non-zero, there is some ring extension which
-        ++ makes the algebra separable
-      genericRightTraceForm : (%,%) -> FPR
-        ++ genericRightTraceForm (a,b) is defined to be
-        ++ \spadfun{genericRightTrace (a*b)}, this defines
-        ++ a symmetric bilinear form on the algebra
-      genericRightDiscriminant: () -> FPR
-        ++ genericRightDiscriminant() is the determinant of the
-        ++ generic left trace forms of all products of basis element,
-        ++ if the generic left trace form is associative, an algebra
-        ++ is separable if the generic left discriminant is invertible,
-        ++ if it is non-zero, there is some ring extension which
-        ++ makes the algebra separable
-      conditionsForIdempotents: Vector % -> List Polynomial R
-        ++ conditionsForIdempotents([v1,...,vn]) determines a complete list
-        ++ of polynomial equations for the coefficients of idempotents
-        ++ with respect to the \spad{R}-module basis \spad{v1},...,\spad{vn}
-      conditionsForIdempotents: () -> List Polynomial R
-        ++ conditionsForIdempotents() determines a complete list
-        ++ of polynomial equations for the coefficients of idempotents
-        ++ with respect to the fixed \spad{R}-module basis
+      randomLC(m, v) ==
+        +/[random()$F * qelt(v, j) for j in minIndex v .. maxIndex v]
 
-  private ==> AlgebraGivenByStructuralConstants(FPR,n,ls,_
-         coerce(gamma)$CoerceVectorMatrixPackage(R) ) add
+    else
 
-    listOfNumbers : List String :=  [PRINC_-TO_-STRING(q)$Lisp for q in 1..n]
-    symbolsForCoef : V Symbol :=
-        [concat("%", concat("x", i))::Symbol  for i in listOfNumbers]
-    genericElement : % :=
-      v : Vector PR :=
-        [monomial(1$PR, [symbolsForCoef.i],[1]) for i in 1..n]
-      convert map(coerce,v)$VectorFunctions2(PR,FPR)
+      randomLC(m, v) ==
+        +/[(random()$Integer rem m::Integer) * qelt(v, j)
+            for j in minIndex v .. maxIndex v]
 
-    eval : (FPR, %) -> FPR
-    eval(rf,a) ==
-      -- for the moment we only substitute the numerators
-      -- of the coefficients
-      coefOfa : List PR :=
-        map(numer, entries coordinates a)$ListFunctions2(FPR,PR)
-      ls : List PR :=[monomial(1$PR, [s],[1]) for s in entries symbolsForCoef]
-      lEq : List Equation PR := []
-      for i in 1..maxIndex ls repeat
-        lEq := cons(equation(ls.i,coefOfa.i)$Equation(PR) , lEq)
-      top : PR := eval(numer(rf),lEq)$PR
-      bot : PR := eval(numer(rf),lEq)$PR
-      top/bot
+    minimize i ==
+      n := (#(nm := numer i))
+      (n = 1) or (n < 3 and ret? nm) => i
+      nrm    := retract(norm mkIdeal(nm, 1))@R
+      for range in 1..5 repeat
+        (u := tryRange(range, nm, nrm, i)) case $ => return(u::$)
+      i
 
+\end{chunk}
 
-    if R has IntegralDomain then
+\begin{chunk}{COQ FRIDEAL}
+(* domain FRIDEAL *)
+(*
+    import CommonDenominator(R, F, VF)
+    import MatrixCommonDenominator(UP, QF)
+    import InnerCommonDenominator(R, F, List R, List F)
+    import MatrixCategoryFunctions2(F, Vector F, Vector F, Matrix F,
+                        UP, Vector UP, Vector UP, Matrix UP)
+    import MatrixCategoryFunctions2(UP, Vector UP, Vector UP,
+                        Matrix UP, F, Vector F, Vector F, Matrix F)
+    import MatrixCategoryFunctions2(UP, Vector UP, Vector UP,
+                        Matrix UP, QF, Vector QF, Vector QF, Matrix QF)
 
-      genericLeftTraceForm(a,b) == genericLeftTrace(a*b)
-      genericLeftDiscriminant() ==
-        listBasis : List % := entries basis()$%
-        m : Matrix FPR := matrix
-          [[genericLeftTraceForm(a,b) for a in listBasis] for b in listBasis]
-        determinant m
+    Rep := Record(num:VA, den:R)
 
-      genericRightTraceForm(a,b) == genericRightTrace(a*b)
-      genericRightDiscriminant() ==
-        listBasis : List % := entries basis()$%
-        m : Matrix FPR := matrix
-          [[genericRightTraceForm(a,b) for a in listBasis] for b in listBasis]
-        determinant m
+    poly    : % -> UPA
+    invrep  : Matrix F -> A
+    upmat   : (A, NonNegativeInteger) -> Matrix UP
+    summat  : % -> Matrix UP
+    num2O   : VA -> OutputForm
+    agcd    : List A -> R
+    vgcd    : VF -> R
+    mkIdeal : (VA, R) -> %
+    intIdeal: (List A, R) -> %
+    ret?    : VA -> Boolean
+    tryRange: (NonNegativeInteger, VA, R, %) -> Union(%, "failed")
 
+    1               == [[1]$VA, 1]
 
+    numer i         == i.num
 
-      leftRankPoly : SparseUnivariatePolynomial FPR := 0
-      initLeft? : Boolean :=true
+    denom i         == i.den
 
-      initializeLeft: () -> Void
-      initializeLeft() ==
-        -- reset initialize flag
-        initLeft?:=false
-        leftRankPoly := leftMinimalPolynomial genericElement
-        void()$Void
+    mkIdeal(v, d)   == [v, d]
 
-      rightRankPoly : SparseUnivariatePolynomial FPR := 0
-      initRight? : Boolean :=true
+    invrep m        == represents(transpose(m) * coordinates(1$A))
 
-      initializeRight: () -> Void
-      initializeRight() ==
-        -- reset initialize flag
-        initRight?:=false
-        rightRankPoly := rightMinimalPolynomial genericElement
-        void()$Void
+    upmat(x, i)     == map(s +-> monomial(s, i)$UP, regularRepresentation x)
 
-      leftRankPolynomial() ==
-        if initLeft? then initializeLeft()
-        leftRankPoly
+    ret? v          == any?(s+->retractIfCan(s)@Union(F,"failed") case F, v)
 
-      rightRankPolynomial() ==
-        if initRight? then initializeRight()
-        rightRankPoly
+    x = y           == denom(x) = denom(y) and numer(x) = numer(y)
 
-      genericLeftMinimalPolynomial a ==
-        if initLeft? then initializeLeft()
-        map(x+->eval(x,a),leftRankPoly)$SUP(FPR)
+    agcd l  == reduce("gcd", [vgcd coordinates a for a in l]$List(R), 0)
 
-      genericRightMinimalPolynomial a ==
-        if initRight? then initializeRight()
-        map(x+->eval(x,a),rightRankPoly)$SUP(FPR)
+    norm i ==
+      ("gcd"/[retract(u)@R for u in coefficients determinant summat i])
+              / denom(i) ** rank()$A
 
-      genericLeftTrace a ==
-        if initLeft? then initializeLeft()
-        d1 : NNI := (degree leftRankPoly - 1) :: NNI
-        rf : FPR := coefficient(leftRankPoly, d1)
-        rf := eval(rf,a)
-        - rf
+    tryRange(range, nm, nrm, i) ==
+      for j in 0..10 repeat
+        a := randomLC(10 * range, nm)
+        unit? gcd((retract(norm a)@R exquo nrm)::R, nrm) =>
+                                return intIdeal([nrm::F::A, a], denom i)
+      "failed"
 
-      genericRightTrace a ==
-        if initRight? then initializeRight()
-        d1 : NNI := (degree rightRankPoly - 1) :: NNI
-        rf : FPR := coefficient(rightRankPoly, d1)
-        rf := eval(rf,a)
-        - rf
+    summat i ==
+      m := minIndex(v := numer i)
+      reduce("+",
+            [upmat(qelt(v, j + m), j) for j in 0..#v-1]$List(Matrix UP))
 
-      genericLeftNorm a ==
-        if initLeft? then initializeLeft()
-        rf : FPR := coefficient(leftRankPoly, 1)
-        if odd? degree leftRankPoly then rf := - rf
-        rf
+    inv i ==
+      m  := inverse(map(s+->s::QF, summat i))::Matrix(QF)
+      cd  := splitDenominator(denom(i)::F::UP::QF * m)
+      cd2 := splitDenominator coefficients(cd.den)
+      invd:= cd2.den / reduce("gcd", cd2.num)
+      d   := reduce("max", [degree p for p in parts(cd.num)])
+      ideal
+        [invd * invrep map(s+->coefficient(s, j), cd.num) for j in 0..d]$VA
 
-      genericRightNorm a ==
-        if initRight? then initializeRight()
-        rf : FPR := coefficient(rightRankPoly, 1)
-        if odd? degree rightRankPoly then rf := - rf
-        rf
+    ideal v ==
+      d := reduce("lcm", [commonDenominator coordinates qelt(v, i)
+                          for i in minIndex v .. maxIndex v]$List(R))
+      intIdeal([d::F * qelt(v, i) for i in minIndex v .. maxIndex v], d)
 
-    conditionsForIdempotents(b: V %) : List Polynomial R ==
-      x : % := generic(b)
-      map(numer,entries coordinates(x*x-x,b))$ListFunctions2(FPR,PR)
+    intIdeal(l, d) ==
+      lr := empty()$List(R)
+      nr := empty()$List(A)
+      for x in removeDuplicates l repeat
+        if (u := retractIfCan(x)@Union(F, "failed")) case F
+          then lr := concat(retract(u::F)@R, lr)
+          else nr := concat(x, nr)
+      r    := reduce("gcd", lr, 0)
+      g    := agcd nr
+      a    := (r quo (b := gcd(gcd(d, r), g)))::F::A
+      d    := d quo b
+      r ^= 0 and ((g exquo r) case R) => mkIdeal([a], d)
+      invb := inv(b::F)
+      va:VA := [invb * m for m in nr]
+      zero? a => mkIdeal(va, d)
+      mkIdeal(concat(a, va), d)
 
-    conditionsForIdempotents(): List Polynomial R ==
-      x : % := genericElement
-      map(numer,entries coordinates(x*x-x))$ListFunctions2(FPR,PR)
+    vgcd v ==
+      reduce("gcd",
+             [retract(v.i)@R for i in minIndex v .. maxIndex v]$List(R))
 
-    generic() ==  genericElement
+    poly i ==
+      m := minIndex(v := numer i)
+      +/[monomial(qelt(v, i + m), i) for i in 0..#v-1]
 
-    generic(vs:V S, ve: V %): % ==
-      maxIndex v > maxIndex ve =>
-        error "generic: too little symbols"
-      v : Vector PR :=
-        [monomial(1$PR, [vs.i],[1]) for i in 1..maxIndex ve]
-      represents(map(coerce,v)$VectorFunctions2(PR,FPR),ve)
+    i1 * i2 ==
+      intIdeal(coefficients(poly i1 * poly i2), denom i1 * denom i2)
 
-    generic(s: S, ve: V %): % ==
-      lON : List String :=  [PRINC_-TO_-STRING(q)$Lisp for q in 1..maxIndex ve]
-      sFC : Vector Symbol :=
-        [concat(s pretend String, i)::Symbol  for i in lON]
-      generic(sFC, ve)
+    i:$ ** m:Integer ==
+      m < 0 => inv(i) ** (-m)
+      n := m::NonNegativeInteger
+      v := numer i
+      intIdeal([qelt(v, j) ** n for j in minIndex v .. maxIndex v],
+               denom(i) ** n)
 
-    generic(ve : V %) ==
-      lON : List String :=  [PRINC_-TO_-STRING(q)$Lisp for q in 1..maxIndex ve]
-      sFC : Vector Symbol :=
-        [concat("%", concat("x", i))::Symbol  for i in lON]
-      v : Vector PR :=
-        [monomial(1$PR, [sFC.i],[1]) for i in 1..maxIndex ve]
-      represents(map(coerce,v)$VectorFunctions2(PR,FPR),ve)
+    num2O v ==
+      paren [qelt(v, i)::OutputForm
+             for i in minIndex v .. maxIndex v]$List(OutputForm)
 
-    generic(vs:V S): % == generic(vs, basis()$%)
+    basis i ==
+      v := numer i
+      d := inv(denom(i)::F)
+      [d * qelt(v, j) for j in minIndex v .. maxIndex v]
 
-    generic(s: S): % == generic(s, basis()$%)
+    coerce(i:$):OutputForm ==
+      nm := num2O numer i
+      (denom i = 1) => nm
+      (1::Integer::OutputForm) / (denom(i)::OutputForm) * nm
 
-    -- variations on eval
-    --coefOfa : List FPR := entries coordinates a
-    --ls : List Symbol := entries symbolsForCoef
-    -- a very dangerous sequential implementation for  the moment,
-    -- because the compiler doesn't manage the parallel code
-    -- also doesn't run:
-    -- not known that (Fraction (Polynomial R)) has (has (Polynomial R)
-    --  (Evalable (Fraction (Polynomial R))))
-    --res : FPR := rf
-    --for eq in lEq repeat res := eval(res,eq)$FPR
-    --res
-    --rf
-    --eval(rf, le)$FPR
-    --eval(rf, entries symbolsForCoef, coefOfa)$FPR
-    --eval(rf, ls, coefOfa)$FPR
-    --le : List Equation PR := [equation(lh,rh) for lh in ls for rh in coefOfa]
+    if F has Finite then
 
-\end{chunk}
+      randomLC(m, v) ==
+        +/[random()$F * qelt(v, j) for j in minIndex v .. maxIndex v]
+
+    else
+
+      randomLC(m, v) ==
+        +/[(random()$Integer rem m::Integer) * qelt(v, j)
+            for j in minIndex v .. maxIndex v]
+
+    minimize i ==
+      n := (#(nm := numer i))
+      (n = 1) or (n < 3 and ret? nm) => i
+      nrm    := retract(norm mkIdeal(nm, 1))@R
+      for range in 1..5 repeat
+        (u := tryRange(range, nm, nrm, i)) case $ => return(u::$)
+      i
 
-\begin{chunk}{COQ GCNAALG}
-(* domain GCNAALG *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{GCNAALG.dotabb}
-"GCNAALG" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GCNAALG"]
-"FRNAALG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FRNAALG"]
-"GCNAALG" -> "FRNAALG"
+\begin{chunk}{FRIDEAL.dotabb}
+"FRIDEAL" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FRIDEAL"]
+"FRAMALG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FRAMALG"]
+"FRIDEAL" -> "FRAMALG"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain GPOLSET GeneralPolynomialSet}
+\section{domain FRMOD FramedModule}
 
-\begin{chunk}{GeneralPolynomialSet.input}
+\begin{chunk}{FramedModule.input}
 )set break resume
-)sys rm -f GeneralPolynomialSet.output
-)spool GeneralPolynomialSet.output
+)sys rm -f FramedModule.output
+)spool FramedModule.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show GeneralPolynomialSet
+)show FramedModule
 --R 
---R GeneralPolynomialSet(R: Ring,E: OrderedAbelianMonoidSup,VarSet: OrderedSet,P: RecursivePolynomialCategory(R,E,VarSet))  is a domain constructor
---R Abbreviation for GeneralPolynomialSet is GPOLSET 
+--R FramedModule(R: EuclideanDomain,F: QuotientFieldCategory(R),UP: UnivariatePolynomialCategory(F),A: FramedAlgebra(F,UP),ibasis: Vector(A))  is a domain constructor
+--R Abbreviation for FramedModule is FRMOD 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for GPOLSET 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FRMOD 
 --R
 --R------------------------------- Operations --------------------------------
---R ?=? : (%,%) -> Boolean                coerce : % -> List(P)
---R coerce : % -> OutputForm              collect : (%,VarSet) -> %
---R collectUnder : (%,VarSet) -> %        collectUpper : (%,VarSet) -> %
---R construct : List(P) -> %              convert : List(P) -> %
---R copy : % -> %                         empty : () -> %
---R empty? : % -> Boolean                 eq? : (%,%) -> Boolean
---R hash : % -> SingleInteger             latex : % -> String
---R mainVariables : % -> List(VarSet)     map : ((P -> P),%) -> %
---R mvar : % -> VarSet                    retract : List(P) -> %
---R sample : () -> %                      trivialIdeal? : % -> Boolean
---R variables : % -> List(VarSet)         ?~=? : (%,%) -> Boolean
---R #? : % -> NonNegativeInteger if $ has finiteAggregate
---R any? : ((P -> Boolean),%) -> Boolean if $ has finiteAggregate
---R convert : % -> InputForm if P has KONVERT(INFORM)
---R count : ((P -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R count : (P,%) -> NonNegativeInteger if $ has finiteAggregate and P has SETCAT
---R eval : (%,List(Equation(P))) -> % if P has EVALAB(P) and P has SETCAT
---R eval : (%,Equation(P)) -> % if P has EVALAB(P) and P has SETCAT
---R eval : (%,P,P) -> % if P has EVALAB(P) and P has SETCAT
---R eval : (%,List(P),List(P)) -> % if P has EVALAB(P) and P has SETCAT
---R every? : ((P -> Boolean),%) -> Boolean if $ has finiteAggregate
---R find : ((P -> Boolean),%) -> Union(P,"failed")
---R headRemainder : (P,%) -> Record(num: P,den: R) if R has INTDOM
---R less? : (%,NonNegativeInteger) -> Boolean
---R mainVariable? : (VarSet,%) -> Boolean
---R map! : ((P -> P),%) -> % if $ has shallowlyMutable
---R member? : (P,%) -> Boolean if $ has finiteAggregate and P has SETCAT
---R members : % -> List(P) if $ has finiteAggregate
---R more? : (%,NonNegativeInteger) -> Boolean
---R parts : % -> List(P) if $ has finiteAggregate
---R reduce : (((P,P) -> P),%) -> P if $ has finiteAggregate
---R reduce : (((P,P) -> P),%,P) -> P if $ has finiteAggregate
---R reduce : (((P,P) -> P),%,P,P) -> P if $ has finiteAggregate and P has SETCAT
---R remainder : (P,%) -> Record(rnum: R,polnum: P,den: R) if R has INTDOM
---R remove : ((P -> Boolean),%) -> % if $ has finiteAggregate
---R remove : (P,%) -> % if $ has finiteAggregate and P has SETCAT
---R removeDuplicates : % -> % if $ has finiteAggregate and P has SETCAT
---R retractIfCan : List(P) -> Union(%,"failed")
---R rewriteIdealWithHeadRemainder : (List(P),%) -> List(P) if R has INTDOM
---R rewriteIdealWithRemainder : (List(P),%) -> List(P) if R has INTDOM
---R roughBase? : % -> Boolean if R has INTDOM
---R roughEqualIdeals? : (%,%) -> Boolean if R has INTDOM
---R roughSubIdeal? : (%,%) -> Boolean if R has INTDOM
---R roughUnitIdeal? : % -> Boolean if R has INTDOM
---R select : ((P -> Boolean),%) -> % if $ has finiteAggregate
---R size? : (%,NonNegativeInteger) -> Boolean
---R sort : (%,VarSet) -> Record(under: %,floor: %,upper: %)
---R triangular? : % -> Boolean if R has INTDOM
+--R ?*? : (%,%) -> %                      ?**? : (%,NonNegativeInteger) -> %
+--R ?**? : (%,PositiveInteger) -> %       ?=? : (%,%) -> Boolean
+--R 1 : () -> %                           ?^? : (%,NonNegativeInteger) -> %
+--R ?^? : (%,PositiveInteger) -> %        basis : % -> Vector(A)
+--R coerce : % -> OutputForm              hash : % -> SingleInteger
+--R latex : % -> String                   module : Vector(A) -> %
+--R norm : % -> F                         one? : % -> Boolean
+--R recip : % -> Union(%,"failed")        sample : () -> %
+--R ?~=? : (%,%) -> Boolean              
+--R module : FractionalIdeal(R,F,UP,A) -> % if A has RETRACT(F)
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{GeneralPolynomialSet.help}
+\begin{chunk}{FramedModule.help}
 ====================================================================
-GeneralPolynomialSet examples
+FramedModule examples
 ====================================================================
 
-A domain for polynomial sets.
+Module representation of fractional ideals.
 
 See Also:
-o )show GeneralPolynomialSet
+o )show FramedModule
 
 \end{chunk}
 
-\pagehead{GeneralPolynomialSet}{GPOLSET}
-\pagepic{ps/v103generalpolynomialset.ps}{GPOLSET}{1.00}
+\pagehead{FramedModule}{FRMOD}
+\pagepic{ps/v103framedmodule.ps}{FRMOD}{1.00}
+{\bf See}\\
+\pageto{FractionalIdeal}{FRIDEAL}
+\pageto{HyperellipticFiniteDivisor}{HELLFDIV}
+\pageto{FiniteDivisor}{FDIV}
 
 {\bf Exports:}\\
-\begin{tabular}{ll}
-\cross{GPOLSET}{any?} &
-\cross{GPOLSET}{coerce} \\
-\cross{GPOLSET}{collect} &
-\cross{GPOLSET}{collectUnder} \\
-\cross{GPOLSET}{collectUpper} &
-\cross{GPOLSET}{construct} \\
-\cross{GPOLSET}{convert} &
-\cross{GPOLSET}{copy} \\
-\cross{GPOLSET}{count} &
-\cross{GPOLSET}{empty} \\
-\cross{GPOLSET}{empty?} &
-\cross{GPOLSET}{eq?} \\
-\cross{GPOLSET}{eval} &
-\cross{GPOLSET}{every?} \\
-\cross{GPOLSET}{find} &
-\cross{GPOLSET}{hash} \\
-\cross{GPOLSET}{headRemainder} &
-\cross{GPOLSET}{latex} \\
-\cross{GPOLSET}{less?} &
-\cross{GPOLSET}{mainVariables} \\
-\cross{GPOLSET}{mainVariable?} &
-\cross{GPOLSET}{map} \\
-\cross{GPOLSET}{map!} &
-\cross{GPOLSET}{member?} \\
-\cross{GPOLSET}{members} &
-\cross{GPOLSET}{more?} \\
-\cross{GPOLSET}{mvar} &
-\cross{GPOLSET}{parts} \\
-\cross{GPOLSET}{reduce} &
-\cross{GPOLSET}{remainder} \\
-\cross{GPOLSET}{remove} &
-\cross{GPOLSET}{removeDuplicates} \\
-\cross{GPOLSET}{retract} &
-\cross{GPOLSET}{retractIfCan} \\
-\cross{GPOLSET}{rewriteIdealWithHeadRemainder} &
-\cross{GPOLSET}{rewriteIdealWithRemainder} \\
-\cross{GPOLSET}{roughBase?} &
-\cross{GPOLSET}{roughEqualIdeals?} \\
-\cross{GPOLSET}{roughSubIdeal?} &
-\cross{GPOLSET}{roughUnitIdeal?} \\
-\cross{GPOLSET}{sample} &
-\cross{GPOLSET}{select} \\
-\cross{GPOLSET}{size?} &
-\cross{GPOLSET}{sort} \\
-\cross{GPOLSET}{triangular?} &
-\cross{GPOLSET}{trivialIdeal?} \\
-\cross{GPOLSET}{variables} &
-\cross{GPOLSET}{\#{}?} \\
-\cross{GPOLSET}{?=?} &
-\cross{GPOLSET}{?\~{}=?} 
+\begin{tabular}{lllll}
+\cross{FRMOD}{1} &
+\cross{FRMOD}{basis} &
+\cross{FRMOD}{coerce} &
+\cross{FRMOD}{hash} &
+\cross{FRMOD}{latex} \\
+\cross{FRMOD}{module} &
+\cross{FRMOD}{norm} &
+\cross{FRMOD}{one?} &
+\cross{FRMOD}{recip} &
+\cross{FRMOD}{sample} \\
+\cross{FRMOD}{?\~{}=?} &
+\cross{FRMOD}{?**?} &
+\cross{FRMOD}{?\^{}?} &
+\cross{FRMOD}{?*?} &
+\cross{FRMOD}{?**?} \\
+\cross{FRMOD}{?=?} &&&&
 \end{tabular}
 
-\begin{chunk}{domain GPOLSET GeneralPolynomialSet}
-)abbrev domain GPOLSET GeneralPolynomialSet
-++ Author: Marc Moreno Maza
-++ Date Created: 04/26/1994
-++ Date Last Updated: 12/15/1998
-++ Description: 
-++ A domain for polynomial sets.
-
-GeneralPolynomialSet(R,E,VarSet,P) : Exports == Implementation where
+\begin{chunk}{domain FRMOD FramedModule}
+)abbrev domain FRMOD FramedModule
+++ Author: Manuel Bronstein
+++ Date Created: 27 Jan 1989
+++ Date Last Updated: 24 Jul 1990
+++ Description:
+++ Module representation of fractional ideals.
 
-  R:Ring
-  VarSet:OrderedSet
-  E:OrderedAbelianMonoidSup
-  P:RecursivePolynomialCategory(R,E,VarSet)
-  LP ==> List P
-  PtoP ==> P -> P
+FramedModule(R, F, UP, A, ibasis): Exports == Implementation where
+  R     : EuclideanDomain
+  F     : QuotientFieldCategory R
+  UP    : UnivariatePolynomialCategory F
+  A     : FramedAlgebra(F, UP)
+  ibasis: Vector A
 
-  Exports ==  PolynomialSetCategory(R,E,VarSet,P)  with
+  VR  ==> Vector R
+  VF  ==> Vector F
+  VA  ==> Vector A
+  M   ==> Matrix F
 
-     convert : LP -> $
-       ++ \axiom{convert(lp)} returns the polynomial set whose members 
-       ++ are the polynomials of \axiom{lp}.
+  Exports ==> Monoid with
+    basis : %  -> VA
+      ++ basis((f1,...,fn)) = the vector \spad{[f1,...,fn]}.
+    norm  : %  -> F
+      ++ norm(f) returns the norm of the module f.
+    module: VA -> %
+      ++ module([f1,...,fn]) = the module generated by \spad{(f1,...,fn)}
+      ++ over R.
+    if A has RetractableTo F then
+      module: FractionalIdeal(R, F, UP, A) -> %
+        ++ module(I) returns I viewed has a module over R.
 
-     finiteAggregate
-     shallowlyMutable
+  Implementation ==> add
 
-  Implementation == add
+    import MatrixCommonDenominator(R, F)
+    import ModularHermitianRowReduction(R)
 
-     Rep := List P
+    Rep  := VA
 
-     construct lp ==
-       (removeDuplicates(lp)$List(P))::$
+    iflag?:Reference(Boolean) := ref true
+    wflag?:Reference(Boolean) := ref true
+    imat := new(#ibasis, #ibasis, 0)$M
+    wmat := new(#ibasis, #ibasis, 0)$M
 
-     copy ps ==
-       construct(copy(members(ps)$$)$LP)$$
+    rowdiv      : (VR, R)  -> VF
+    vectProd    : (VA, VA) -> VA
+    wmatrix     : VA -> M
+    W2A         : VF -> A
+    intmat      : () -> M
+    invintmat   : () -> M
+    getintmat   : () -> Boolean
+    getinvintmat: () -> Boolean
 
-     empty() ==
-       []
+    1                      == ibasis
 
-     parts ps ==
-       ps pretend LP
+    module(v:VA)           == v
 
-     map (f : PtoP, ps : $) : $ ==
-       construct(map(f,members(ps))$LP)$$
+    basis m                == m pretend VA
 
-     map! (f : PtoP, ps : $) : $  ==
-       construct(map!(f,members(ps))$LP)$$
+    rowdiv(r, f)           == [r.i / f for i in minIndex r..maxIndex r]
 
-     member? (p,ps) ==
-       member?(p,members(ps))$LP
+    coerce(m:%):OutputForm == coerce(basis m)$VA
 
-     ps1 = ps2 ==
-       {p for p in parts(ps1)} =$(Set P) {p for p in parts(ps2)}
+    W2A v                  == represents(v * intmat())
 
-     coerce(ps:$) : OutputForm ==
-       lp : List(P) := sort(infRittWu?,members(ps))$(List P)
-       brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm
+    wmatrix v              == coordinates(v) * invintmat()
 
-     mvar ps ==
-       empty? ps => error"Error from GPOLSET in mvar : #1 is empty"
-       lv : List VarSet := variables(ps)
-       empty? lv => 
-        error "Error from GPOLSET in mvar : every polynomial in #1 is constant"
-       reduce(max,lv)$(List VarSet)
+    getinvintmat() ==
+      m := inverse(intmat())::M
+      for i in minRowIndex m .. maxRowIndex m repeat
+        for j in minColIndex m .. maxColIndex m repeat
+          imat(i, j) := qelt(m, i, j)
+      false
 
-     retractIfCan(lp) ==
-       (construct(lp))::Union($,"failed")
+    getintmat() ==
+      m := coordinates ibasis
+      for i in minRowIndex m .. maxRowIndex m repeat
+        for j in minColIndex m .. maxColIndex m repeat
+          wmat(i, j) := qelt(m, i, j)
+      false
 
-     coerce(ps:$) : (List P) ==
-       ps pretend (List P)
+    invintmat() ==
+      if iflag?() then iflag?() := getinvintmat()
+      imat
 
-     convert(lp:LP) : $ ==
-       construct lp
+    intmat() ==
+      if wflag?() then wflag?() := getintmat()
+      wmat
+
+    vectProd(v1, v2) ==
+      k := minIndex(v := new(#v1 * #v2, 0)$VA)
+      for i in minIndex v1 .. maxIndex v1 repeat
+        for j in minIndex v2 .. maxIndex v2 repeat
+          qsetelt_!(v, k, qelt(v1, i) * qelt(v2, j))
+          k := k + 1
+      v pretend VA
+
+    norm m ==
+      #(basis m) ^= #ibasis => error "Module not of rank n"
+      determinant(coordinates(basis m) * invintmat())
+
+    m1 * m2 ==
+      m := rowEch((cd := splitDenominator wmatrix(
+                                     vectProd(basis m1, basis m2))).num)
+      module [u for i in minRowIndex m .. maxRowIndex m |
+                           (u := W2A rowdiv(row(m, i), cd.den)) ^= 0]$VA
+
+    if A has RetractableTo F then
+
+      module(i:FractionalIdeal(R, F, UP, A)) ==
+        module(basis i) * module(ibasis)
 
 \end{chunk}
 
-\begin{chunk}{COQ GPOLSET}
-(* domain GPOLSET *)
+\begin{chunk}{COQ FRMOD}
+(* domain FRMOD *)
 (*
-*)
 
-\end{chunk}
+    import MatrixCommonDenominator(R, F)
+    import ModularHermitianRowReduction(R)
 
-\begin{chunk}{GPOLSET.dotabb}
-"GPOLSET" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GPOLSET"]
-"RPOLCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=RPOLCAT"]
-"GPOLSET" -> "RPOLCAT"
+    Rep  := VA
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain GSTBL GeneralSparseTable}
+    iflag?:Reference(Boolean) := ref true
+    wflag?:Reference(Boolean) := ref true
+    imat := new(#ibasis, #ibasis, 0)$M
+    wmat := new(#ibasis, #ibasis, 0)$M
 
-\begin{chunk}{GeneralSparseTable.input}
-)set break resume
-)sys rm -f GeneralSparseTable.output
-)spool GeneralSparseTable.output
-)set message test on
-)set message auto off
-)set break resume
-)clear all
+    rowdiv      : (VR, R)  -> VF
+    vectProd    : (VA, VA) -> VA
+    wmatrix     : VA -> M
+    W2A         : VF -> A
+    intmat      : () -> M
+    invintmat   : () -> M
+    getintmat   : () -> Boolean
+    getinvintmat: () -> Boolean
 
---S 1 of 8
-patrons: GeneralSparseTable(String, Integer, KeyedAccessFile(Integer), 0) := table() ; 
---E 1
+    1                      == ibasis
 
---S 2 of 8
-patrons."Smith" := 10500 
---E 2
+    module(v:VA)           == v
 
---S 3 of 8
-patrons."Jones" := 22000
---E 3
+    basis m                == m pretend VA
 
---S 4 of 8
-patrons."Jones" 
---E 4
+    rowdiv(r, f)           == [r.i / f for i in minIndex r..maxIndex r]
 
---S 5 of 8
-patrons."Stingy"
---E 5
+    coerce(m:%):OutputForm == coerce(basis m)$VA
 
---S 6 of 8
-reduce(+, entries patrons) 
---E 6
+    W2A v                  == represents(v * intmat())
 
---S 7 of 8
-)system rm -r kaf*.sdata
---E 7
+    wmatrix v              == coordinates(v) * invintmat()
 
---S 8 of 8
-)show GeneralSparseTable
---R 
---R GeneralSparseTable(Key: SetCategory,Entry: SetCategory,Tbl: TableAggregate(Key,Entry),dent: Entry)  is a domain constructor
---R Abbreviation for GeneralSparseTable is GSTBL 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for GSTBL 
---R
---R------------------------------- Operations --------------------------------
---R copy : % -> %                         dictionary : () -> %
---R elt : (%,Key,Entry) -> Entry          ?.? : (%,Key) -> Entry
---R empty : () -> %                       empty? : % -> Boolean
---R entries : % -> List(Entry)            eq? : (%,%) -> Boolean
---R index? : (Key,%) -> Boolean           indices : % -> List(Key)
---R key? : (Key,%) -> Boolean             keys : % -> List(Key)
---R map : ((Entry -> Entry),%) -> %       qelt : (%,Key) -> Entry
---R sample : () -> %                      setelt : (%,Key,Entry) -> Entry
---R table : () -> %                      
---R #? : % -> NonNegativeInteger if $ has finiteAggregate
---R ?=? : (%,%) -> Boolean if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
---R any? : ((Entry -> Boolean),%) -> Boolean if $ has finiteAggregate
---R any? : ((Record(key: Key,entry: Entry) -> Boolean),%) -> Boolean if $ has finiteAggregate
---R bag : List(Record(key: Key,entry: Entry)) -> %
---R coerce : % -> OutputForm if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
---R construct : List(Record(key: Key,entry: Entry)) -> %
---R convert : % -> InputForm if Record(key: Key,entry: Entry) has KONVERT(INFORM)
---R count : ((Entry -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R count : (Entry,%) -> NonNegativeInteger if $ has finiteAggregate and Entry has SETCAT
---R count : (Record(key: Key,entry: Entry),%) -> NonNegativeInteger if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
---R count : ((Record(key: Key,entry: Entry) -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R dictionary : List(Record(key: Key,entry: Entry)) -> %
---R entry? : (Entry,%) -> Boolean if $ has finiteAggregate and Entry has SETCAT
---R eval : (%,List(Equation(Entry))) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
---R eval : (%,Equation(Entry)) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
---R eval : (%,Entry,Entry) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
---R eval : (%,List(Entry),List(Entry)) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
---R eval : (%,List(Record(key: Key,entry: Entry)),List(Record(key: Key,entry: Entry))) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
---R eval : (%,Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
---R eval : (%,Equation(Record(key: Key,entry: Entry))) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
---R eval : (%,List(Equation(Record(key: Key,entry: Entry)))) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
---R every? : ((Entry -> Boolean),%) -> Boolean if $ has finiteAggregate
---R every? : ((Record(key: Key,entry: Entry) -> Boolean),%) -> Boolean if $ has finiteAggregate
---R extract! : % -> Record(key: Key,entry: Entry)
---R fill! : (%,Entry) -> % if $ has shallowlyMutable
---R find : ((Record(key: Key,entry: Entry) -> Boolean),%) -> Union(Record(key: Key,entry: Entry),"failed")
---R first : % -> Entry if Key has ORDSET
---R hash : % -> SingleInteger if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
---R insert! : (Record(key: Key,entry: Entry),%) -> %
---R inspect : % -> Record(key: Key,entry: Entry)
---R latex : % -> String if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
---R less? : (%,NonNegativeInteger) -> Boolean
---R map : (((Entry,Entry) -> Entry),%,%) -> %
---R map : ((Record(key: Key,entry: Entry) -> Record(key: Key,entry: Entry)),%) -> %
---R map! : ((Entry -> Entry),%) -> % if $ has shallowlyMutable
---R map! : ((Record(key: Key,entry: Entry) -> Record(key: Key,entry: Entry)),%) -> % if $ has shallowlyMutable
---R maxIndex : % -> Key if Key has ORDSET
---R member? : (Entry,%) -> Boolean if $ has finiteAggregate and Entry has SETCAT
---R member? : (Record(key: Key,entry: Entry),%) -> Boolean if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
---R members : % -> List(Entry) if $ has finiteAggregate
---R members : % -> List(Record(key: Key,entry: Entry)) if $ has finiteAggregate
---R minIndex : % -> Key if Key has ORDSET
---R more? : (%,NonNegativeInteger) -> Boolean
---R parts : % -> List(Entry) if $ has finiteAggregate
---R parts : % -> List(Record(key: Key,entry: Entry)) if $ has finiteAggregate
---R qsetelt! : (%,Key,Entry) -> Entry if $ has shallowlyMutable
---R reduce : (((Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry)),%) -> Record(key: Key,entry: Entry) if $ has finiteAggregate
---R reduce : (((Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry)),%,Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry) if $ has finiteAggregate
---R reduce : (((Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry)),%,Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry) if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
---R remove : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
---R remove : (Record(key: Key,entry: Entry),%) -> % if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
---R remove! : (Key,%) -> Union(Entry,"failed")
---R remove! : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
---R remove! : (Record(key: Key,entry: Entry),%) -> % if $ has finiteAggregate
---R removeDuplicates : % -> % if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
---R search : (Key,%) -> Union(Entry,"failed")
---R select : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
---R select! : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
---R size? : (%,NonNegativeInteger) -> Boolean
---R swap! : (%,Key,Key) -> Void if $ has shallowlyMutable
---R table : List(Record(key: Key,entry: Entry)) -> %
---R ?~=? : (%,%) -> Boolean if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
---R
---E 8
+    getinvintmat() ==
+      m := inverse(intmat())::M
+      for i in minRowIndex m .. maxRowIndex m repeat
+        for j in minColIndex m .. maxColIndex m repeat
+          imat(i, j) := qelt(m, i, j)
+      false
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{GeneralSparseTable.help}
-====================================================================
-GeneralSparseTable
-====================================================================
+    getintmat() ==
+      m := coordinates ibasis
+      for i in minRowIndex m .. maxRowIndex m repeat
+        for j in minColIndex m .. maxColIndex m repeat
+          wmat(i, j) := qelt(m, i, j)
+      false
 
-Sometimes when working with tables there is a natural value to use as
-the entry in all but a few cases.  The GeneralSparseTable constructor
-can be used to provide any table type with a default value for
-entries.
+    invintmat() ==
+      if iflag?() then iflag?() := getinvintmat()
+      imat
 
-Suppose we launched a fund-raising campaign to raise fifty thousand
-dollars.  To record the contributions, we want a table with strings as
-keys (for the names) and integer entries (for the amount).  In a data
-base of cash contributions, unless someone has been explicitly
-entered, it is reasonable to assume they have made a zero dollar
-contribution.
+    intmat() ==
+      if wflag?() then wflag?() := getintmat()
+      wmat
 
-This creates a keyed access file with default entry 0.
+    vectProd(v1, v2) ==
+      k := minIndex(v := new(#v1 * #v2, 0)$VA)
+      for i in minIndex v1 .. maxIndex v1 repeat
+        for j in minIndex v2 .. maxIndex v2 repeat
+          qsetelt_!(v, k, qelt(v1, i) * qelt(v2, j))
+          k := k + 1
+      v pretend VA
 
-  patrons: GeneralSparseTable(String, Integer, KeyedAccessFile(Integer), 0) := table() ; 
+    norm m ==
+      #(basis m) ^= #ibasis => error "Module not of rank n"
+      determinant(coordinates(basis m) * invintmat())
 
-Now patrons can be used just as any other table.  Here we record two gifts.
+    m1 * m2 ==
+      m := rowEch((cd := splitDenominator wmatrix(
+                                     vectProd(basis m1, basis m2))).num)
+      module [u for i in minRowIndex m .. maxRowIndex m |
+                           (u := W2A rowdiv(row(m, i), cd.den)) ^= 0]$VA
 
-  patrons."Smith" := 10500 
+    if A has RetractableTo F then
 
-  patrons."Jones" := 22000
+      module(i:FractionalIdeal(R, F, UP, A)) ==
+        module(basis i) * module(ibasis)
 
-Now let us look up the size of the contributions from Jones and Stingy.
+*)
 
-  patrons."Jones" 
+\end{chunk}
 
-  patrons."Stingy"
+\begin{chunk}{FRMOD.dotabb}
+"FRMOD" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FRMOD"]
+"FRAMALG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FRAMALG"]
+"FRMOD" -> "FRAMALG"
 
-Have we met our seventy thousand dollar goal?
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain FAGROUP FreeAbelianGroup}
 
-  reduce(+, entries patrons) 
+\begin{chunk}{FreeAbelianGroup.input}
+)set break resume
+)sys rm -f FreeAbelianGroup.output
+)spool FreeAbelianGroup.output
+)set message test on
+)set message auto off
+)clear all
 
-So the project is cancelled and we can delete the data base:
+--S 1 of 1
+)show FreeAbelianGroup
+--R 
+--R FreeAbelianGroup(S: SetCategory)  is a domain constructor
+--R Abbreviation for FreeAbelianGroup is FAGROUP 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FAGROUP 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (Integer,S) -> %                ?*? : (%,Integer) -> %
+--R ?*? : (Integer,%) -> %                ?*? : (NonNegativeInteger,%) -> %
+--R ?*? : (PositiveInteger,%) -> %        ?+? : (S,%) -> %
+--R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
+--R -? : % -> %                           ?=? : (%,%) -> Boolean
+--R 0 : () -> %                           coefficient : (S,%) -> Integer
+--R coerce : S -> %                       coerce : % -> OutputForm
+--R hash : % -> SingleInteger             latex : % -> String
+--R mapGen : ((S -> S),%) -> %            max : (%,%) -> % if S has ORDSET
+--R min : (%,%) -> % if S has ORDSET      nthCoef : (%,Integer) -> Integer
+--R nthFactor : (%,Integer) -> S          retract : % -> S
+--R sample : () -> %                      size : % -> NonNegativeInteger
+--R zero? : % -> Boolean                  ?~=? : (%,%) -> 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 highCommonTerms : (%,%) -> % if Integer has OAMON
+--R mapCoef : ((Integer -> Integer),%) -> %
+--R retractIfCan : % -> Union(S,"failed")
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R terms : % -> List(Record(gen: S,exp: Integer))
+--R
+--E 1
 
-  )system rm -r kaf*.sdata
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{FreeAbelianGroup.help}
+====================================================================
+FreeAbelianGroup examples
+====================================================================
+
+Free abelian group on any set of generators
+The free abelian group on a set S is the monoid of finite sums of
+the form reduce(+,[ni * si]) where the si's are in S, and the ni's
+are integers. The operation is commutative.
 
 See Also:
-o )show GeneralSparseTable
+o )show FreeAbelianGroup
 
 \end{chunk}
-\pagehead{GeneralSparseTable}{GSTBL}
-\pagepic{ps/v103generalsparsetable.ps}{GSTBL}{1.00}
+
+\pagehead{FreeAbelianGroup}{FAGROUP}
+\pagepic{ps/v103freeabeliangroup.ps}{FAGROUP}{1.00}
 {\bf See}\\
-\pageto{HashTable}{HASHTBL}
-\pageto{InnerTable}{INTABL}
-\pageto{Table}{TABLE}
-\pageto{EqTable}{EQTBL}
-\pageto{StringTable}{STRTBL}
-\pageto{SparseTable}{STBL}
+\pageto{ListMonoidOps}{LMOPS}
+\pageto{FreeMonoid}{FMONOID}
+\pageto{FreeGroup}{FGROUP}
+\pageto{InnerFreeAbelianMonoid}{IFAMON}
+\pageto{FreeAbelianMonoid}{FAMONOID}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{GSTBL}{any?} &
-\cross{GSTBL}{bag} &
-\cross{GSTBL}{coerce} &
-\cross{GSTBL}{construct} &
-\cross{GSTBL}{convert} \\
-\cross{GSTBL}{copy} &
-\cross{GSTBL}{count} &
-\cross{GSTBL}{dictionary} &
-\cross{GSTBL}{elt} &
-\cross{GSTBL}{empty} \\
-\cross{GSTBL}{empty?} &
-\cross{GSTBL}{entries} &
-\cross{GSTBL}{entry?} &
-\cross{GSTBL}{eq?} &
-\cross{GSTBL}{eval} \\
-\cross{GSTBL}{every?} &
-\cross{GSTBL}{extract!} &
-\cross{GSTBL}{fill!} &
-\cross{GSTBL}{find} &
-\cross{GSTBL}{first} \\
-\cross{GSTBL}{hash} &
-\cross{GSTBL}{index?} &
-\cross{GSTBL}{indices} &
-\cross{GSTBL}{insert!} &
-\cross{GSTBL}{inspect} \\
-\cross{GSTBL}{key?} &
-\cross{GSTBL}{keys} &
-\cross{GSTBL}{latex} &
-\cross{GSTBL}{less?} &
-\cross{GSTBL}{map} \\
-\cross{GSTBL}{map!} &
-\cross{GSTBL}{maxIndex} &
-\cross{GSTBL}{member?} &
-\cross{GSTBL}{members} &
-\cross{GSTBL}{minIndex} \\
-\cross{GSTBL}{more?} &
-\cross{GSTBL}{parts} &
-\cross{GSTBL}{qelt} &
-\cross{GSTBL}{qsetelt!} &
-\cross{GSTBL}{reduce} \\
-\cross{GSTBL}{remove} &
-\cross{GSTBL}{remove!} &
-\cross{GSTBL}{removeDuplicates} &
-\cross{GSTBL}{sample} &
-\cross{GSTBL}{search} \\
-\cross{GSTBL}{select} &
-\cross{GSTBL}{select!} &
-\cross{GSTBL}{setelt} &
-\cross{GSTBL}{size?} &
-\cross{GSTBL}{swap!} \\
-\cross{GSTBL}{table} &
-\cross{GSTBL}{\#{}?} &
-\cross{GSTBL}{?=?} &
-\cross{GSTBL}{?\~{}=?} &
-\cross{GSTBL}{?.?} 
+\cross{FAGROUP}{0} &
+\cross{FAGROUP}{coefficient} &
+\cross{FAGROUP}{coerce} &
+\cross{FAGROUP}{hash} &
+\cross{FAGROUP}{highCommonTerms} \\
+\cross{FAGROUP}{latex} &
+\cross{FAGROUP}{mapCoef} &
+\cross{FAGROUP}{mapGen} &
+\cross{FAGROUP}{max} &
+\cross{FAGROUP}{min} \\
+\cross{FAGROUP}{nthCoef} &
+\cross{FAGROUP}{nthFactor} &
+\cross{FAGROUP}{retract} &
+\cross{FAGROUP}{retractIfCan} &
+\cross{FAGROUP}{sample} \\
+\cross{FAGROUP}{size} &
+\cross{FAGROUP}{subtractIfCan} &
+\cross{FAGROUP}{terms} &
+\cross{FAGROUP}{zero?} &
+\cross{FAGROUP}{?\~{}=?} \\
+\cross{FAGROUP}{?*?} &
+\cross{FAGROUP}{?$<$?} &
+\cross{FAGROUP}{?$<=$?} &
+\cross{FAGROUP}{?$>$?} &
+\cross{FAGROUP}{?$>=$?} \\
+\cross{FAGROUP}{?+?} &
+\cross{FAGROUP}{?-?} &
+\cross{FAGROUP}{-?} &
+\cross{FAGROUP}{?=?} &
 \end{tabular}
 
-\begin{chunk}{domain GSTBL GeneralSparseTable}
-)abbrev domain GSTBL GeneralSparseTable
-++ Author: Stephen M. Watt
-++ Date Created: 1986
-++ Date Last Updated: June 21, 1991
+\begin{chunk}{domain FAGROUP FreeAbelianGroup}
+)abbrev domain FAGROUP FreeAbelianGroup
+++ Author: Manuel Bronstein
+++ Date Created: November 1989
+++ Date Last Updated: 6 June 1991
 ++ Description:
-++ A sparse table has a default entry, which is returned if no other
-++ value has been explicitly stored for a key.
+++ Free abelian group on any set of generators
+++ The free abelian group on a set S is the monoid of finite sums of
+++ the form \spad{reduce(+,[ni * si])} where the si's are in S, and the ni's
+++ are integers. The operation is commutative.
 
-GeneralSparseTable(Key, Entry, Tbl, dent): TableAggregate(Key, Entry) == Impl
-  where
-    Key, Entry: SetCategory
-    Tbl:  TableAggregate(Key, Entry)
-    dent: Entry
+FreeAbelianGroup(S:SetCategory): Exports == Implementation where
+  Exports ==> Join(AbelianGroup, Module Integer,
+                   FreeAbelianMonoidCategory(S, Integer)) with
+    if S has OrderedSet then OrderedSet
 
-    Impl ==> Tbl add
-        Rep := Tbl
+  Implementation ==> InnerFreeAbelianMonoid(S, Integer, 1) add
 
-        elt(t:%, k:Key) ==
-            (u := search(k, t)$Rep) case "failed" => dent
-            u::Entry
+    - f == mapCoef("-", f)
 
-        setelt(t:%, k:Key, e:Entry) ==
-            e = dent => (remove_!(k, t); e)
-            setelt(t, k, e)$Rep
+    if S has OrderedSet then
 
-        search(k:Key, t:%) ==
-            (u := search(k, t)$Rep) case "failed" => dent
-            u
+      inmax: List Record(gen: S, exp: Integer) -> Record(gen: S, exp:Integer)
+
+      inmax l ==
+        mx := first l
+        for t in rest l repeat
+          if mx.gen < t.gen then mx := t
+        mx
+
+      -- lexicographic order
+      a < b ==
+        zero? a  =>
+          zero? b => false
+          0 < (inmax terms b).exp
+        ta := inmax terms a
+        zero? b => ta.exp < 0
+        tb := inmax terms b
+        ta.gen < tb.gen => 0 < tb.exp
+        tb.gen < ta.gen => ta.exp < 0
+        ta.exp < tb.exp => true
+        tb.exp < ta.exp => false
+        lc := ta.exp * ta.gen
+        (a - lc) < (b - lc)
 
 \end{chunk}
 
-\begin{chunk}{COQ GSTBL}
-(* domain GSTBL *)
+\begin{chunk}{COQ FAGROUP}
+(* domain FAGROUP *)
 (*
+ InnerFreeAbelianMonoid(S, Integer, 1) add
+
+    - f == mapCoef("-", f)
+
+    if S has OrderedSet then
+
+      inmax: List Record(gen: S, exp: Integer) -> Record(gen: S, exp:Integer)
+
+      inmax l ==
+        mx := first l
+        for t in rest l repeat
+          if mx.gen < t.gen then mx := t
+        mx
+
+      -- lexicographic order
+      a < b ==
+        zero? a  =>
+          zero? b => false
+          0 < (inmax terms b).exp
+        ta := inmax terms a
+        zero? b => ta.exp < 0
+        tb := inmax terms b
+        ta.gen < tb.gen => 0 < tb.exp
+        tb.gen < ta.gen => ta.exp < 0
+        ta.exp < tb.exp => true
+        tb.exp < ta.exp => false
+        lc := ta.exp * ta.gen
+        (a - lc) < (b - lc)
+
 *)
 
 \end{chunk}
 
-\begin{chunk}{GSTBL.dotabb}
-"GSTBL" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GSTBL"]
-"TBAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=TBAGG"]
-"GSTBL" -> "TBAGG"
+\begin{chunk}{FAGROUP.dotabb}
+"FAGROUP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FAGROUP"]
+"PID" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PID"]
+"OAGROUP" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAGROUP"]
+"FAGROUP" -> "PID"
+"FAGROUP" -> "OAGROUP"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain GTSET GeneralTriangularSet}
+\section{domain FAMONOID FreeAbelianMonoid}
 
-\begin{chunk}{GeneralTriangularSet.input}
+\begin{chunk}{FreeAbelianMonoid.input}
 )set break resume
-)sys rm -f GeneralTriangularSet.output
-)spool GeneralTriangularSet.output
+)sys rm -f FreeAbelianMonoid.output
+)spool FreeAbelianMonoid.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show GeneralTriangularSet
+)show FreeAbelianMonoid
 --R 
---R GeneralTriangularSet(R: IntegralDomain,E: OrderedAbelianMonoidSup,V: OrderedSet,P: RecursivePolynomialCategory(R,E,V))  is a domain constructor
---R Abbreviation for GeneralTriangularSet is GTSET 
+--R FreeAbelianMonoid(S: SetCategory)  is a domain constructor
+--R Abbreviation for FreeAbelianMonoid is FAMONOID 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for GTSET 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FAMONOID 
 --R
 --R------------------------------- Operations --------------------------------
---R ?=? : (%,%) -> Boolean                algebraic? : (V,%) -> Boolean
---R algebraicVariables : % -> List(V)     coerce : % -> List(P)
---R coerce : % -> OutputForm              collect : (%,V) -> %
---R collectQuasiMonic : % -> %            collectUnder : (%,V) -> %
---R collectUpper : (%,V) -> %             construct : List(P) -> %
---R copy : % -> %                         degree : % -> NonNegativeInteger
---R empty : () -> %                       empty? : % -> Boolean
---R eq? : (%,%) -> Boolean                extend : (%,P) -> %
---R first : % -> Union(P,"failed")        hash : % -> SingleInteger
---R headReduce : (P,%) -> P               headReduced? : % -> Boolean
---R headReduced? : (P,%) -> Boolean       infRittWu? : (%,%) -> Boolean
---R initiallyReduce : (P,%) -> P          initiallyReduced? : % -> Boolean
---R initials : % -> List(P)               last : % -> Union(P,"failed")
---R latex : % -> String                   mainVariable? : (V,%) -> Boolean
---R mainVariables : % -> List(V)          map : ((P -> P),%) -> %
---R mvar : % -> V                         normalized? : % -> Boolean
---R normalized? : (P,%) -> Boolean        reduceByQuasiMonic : (P,%) -> P
---R removeZero : (P,%) -> P               rest : % -> Union(%,"failed")
---R retract : List(P) -> %                sample : () -> %
---R select : (%,V) -> Union(P,"failed")   stronglyReduce : (P,%) -> P
---R stronglyReduced? : % -> Boolean       stronglyReduced? : (P,%) -> Boolean
---R trivialIdeal? : % -> Boolean          variables : % -> List(V)
---R zeroSetSplit : List(P) -> List(%)     ?~=? : (%,%) -> Boolean
---R #? : % -> NonNegativeInteger if $ has finiteAggregate
---R any? : ((P -> Boolean),%) -> Boolean if $ has finiteAggregate
---R autoReduced? : (%,((P,List(P)) -> Boolean)) -> Boolean
---R basicSet : (List(P),(P -> Boolean),((P,P) -> Boolean)) -> Union(Record(bas: %,top: List(P)),"failed")
---R basicSet : (List(P),((P,P) -> Boolean)) -> Union(Record(bas: %,top: List(P)),"failed")
---R coHeight : % -> NonNegativeInteger if V has FINITE
---R convert : % -> InputForm if P has KONVERT(INFORM)
---R count : ((P -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R count : (P,%) -> NonNegativeInteger if $ has finiteAggregate and P has SETCAT
---R eval : (%,List(Equation(P))) -> % if P has EVALAB(P) and P has SETCAT
---R eval : (%,Equation(P)) -> % if P has EVALAB(P) and P has SETCAT
---R eval : (%,P,P) -> % if P has EVALAB(P) and P has SETCAT
---R eval : (%,List(P),List(P)) -> % if P has EVALAB(P) and P has SETCAT
---R every? : ((P -> Boolean),%) -> Boolean if $ has finiteAggregate
---R extendIfCan : (%,P) -> Union(%,"failed")
---R find : ((P -> Boolean),%) -> Union(P,"failed")
---R headRemainder : (P,%) -> Record(num: P,den: R) if R has INTDOM
---R initiallyReduced? : (P,%) -> Boolean
---R less? : (%,NonNegativeInteger) -> Boolean
---R map! : ((P -> P),%) -> % if $ has shallowlyMutable
---R member? : (P,%) -> Boolean if $ has finiteAggregate and P has SETCAT
---R members : % -> List(P) if $ has finiteAggregate
---R more? : (%,NonNegativeInteger) -> Boolean
---R parts : % -> List(P) if $ has finiteAggregate
---R quasiComponent : % -> Record(close: List(P),open: List(P))
---R reduce : (P,%,((P,P) -> P),((P,P) -> Boolean)) -> P
---R reduce : (((P,P) -> P),%) -> P if $ has finiteAggregate
---R reduce : (((P,P) -> P),%,P) -> P if $ has finiteAggregate
---R reduce : (((P,P) -> P),%,P,P) -> P if $ has finiteAggregate and P has SETCAT
---R reduced? : (P,%,((P,P) -> Boolean)) -> Boolean
---R remainder : (P,%) -> Record(rnum: R,polnum: P,den: R) if R has INTDOM
---R remove : ((P -> Boolean),%) -> % if $ has finiteAggregate
---R remove : (P,%) -> % if $ has finiteAggregate and P has SETCAT
---R removeDuplicates : % -> % if $ has finiteAggregate and P has SETCAT
---R retractIfCan : List(P) -> Union(%,"failed")
---R rewriteIdealWithHeadRemainder : (List(P),%) -> List(P) if R has INTDOM
---R rewriteIdealWithRemainder : (List(P),%) -> List(P) if R has INTDOM
---R rewriteSetWithReduction : (List(P),%,((P,P) -> P),((P,P) -> Boolean)) -> List(P)
---R roughBase? : % -> Boolean if R has INTDOM
---R roughEqualIdeals? : (%,%) -> Boolean if R has INTDOM
---R roughSubIdeal? : (%,%) -> Boolean if R has INTDOM
---R roughUnitIdeal? : % -> Boolean if R has INTDOM
---R select : ((P -> Boolean),%) -> % if $ has finiteAggregate
---R size? : (%,NonNegativeInteger) -> Boolean
---R sort : (%,V) -> Record(under: %,floor: %,upper: %)
---R triangular? : % -> Boolean if R has INTDOM
---R zeroSetSplitIntoTriangularSystems : List(P) -> List(Record(close: %,open: List(P)))
+--R ?*? : (NonNegativeInteger,S) -> %     ?*? : (NonNegativeInteger,%) -> %
+--R ?*? : (PositiveInteger,%) -> %        ?+? : (S,%) -> %
+--R ?+? : (%,%) -> %                      ?=? : (%,%) -> Boolean
+--R 0 : () -> %                           coerce : S -> %
+--R coerce : % -> OutputForm              hash : % -> SingleInteger
+--R latex : % -> String                   mapGen : ((S -> S),%) -> %
+--R nthFactor : (%,Integer) -> S          retract : % -> S
+--R sample : () -> %                      size : % -> NonNegativeInteger
+--R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
+--R coefficient : (S,%) -> NonNegativeInteger
+--R highCommonTerms : (%,%) -> % if NonNegativeInteger has OAMON
+--R mapCoef : ((NonNegativeInteger -> NonNegativeInteger),%) -> %
+--R nthCoef : (%,Integer) -> NonNegativeInteger
+--R retractIfCan : % -> Union(S,"failed")
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R terms : % -> List(Record(gen: S,exp: NonNegativeInteger))
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{GeneralTriangularSet.help}
+\begin{chunk}{FreeAbelianMonoid.help}
 ====================================================================
-GeneralTriangularSet examples
+FreeAbelianMonoid examples
 ====================================================================
 
-A domain constructor of the category TriangularSetCategory.  The only
-requirement for a list of polynomials to be a member of such a domain
-is the following: no polynomial is constant and two distinct
-polynomials have distinct main variables. Such a triangular set may
-not be auto-reduced or consistent. Triangular sets are stored as
-sorted lists w.r.t. the main variables of their members but they are
-displayed in reverse order.
+Free abelian monoid on any set of generators
+The free abelian monoid on a set S is the monoid of finite sums of
+the form reduce(+,[ni * si]) where the si's are in S, and the ni's
+are non-negative integers. The operation is commutative.
 
 See Also:
-o )show GeneralTriangularSet
+o )show FreeAbelianMonoid
 
 \end{chunk}
 
-\pagehead{GeneralTriangularSet}{GTSET}
-\pagepic{ps/v103generaltriangularset.ps}{GTSET}{1.00}
+\pagehead{FreeAbelianMonoid}{FAMONOID}
+\pagepic{ps/v103freeabelianmonoid.ps}{FAMONOID}{1.00}
 {\bf See}\\
-\pageto{WuWenTsunTriangularSet}{WUTSET}
+\pageto{ListMonoidOps}{LMOPS}
+\pageto{FreeMonoid}{FMONOID}
+\pageto{FreeGroup}{FGROUP}
+\pageto{InnerFreeAbelianMonoid}{IFAMON}
+\pageto{FreeAbelianGroup}{FAGROUP}
 
 {\bf Exports:}\\
-\begin{tabular}{ll}
-\cross{GTSET}{algebraic?} &
-\cross{GTSET}{algebraicVariables} \\
-\cross{GTSET}{any?} &
-\cross{GTSET}{autoReduced?} \\
-\cross{GTSET}{basicSet} &
-\cross{GTSET}{coerce} \\
-\cross{GTSET}{collect} &
-\cross{GTSET}{collectQuasiMonic} \\
-\cross{GTSET}{collectUnder} &
-\cross{GTSET}{collectUpper} \\
-\cross{GTSET}{coHeight} &
-\cross{GTSET}{construct} \\
-\cross{GTSET}{convert} &
-\cross{GTSET}{copy} \\
-\cross{GTSET}{count} &
-\cross{GTSET}{degree} \\
-\cross{GTSET}{empty} &
-\cross{GTSET}{empty?} \\
-\cross{GTSET}{eq?} &
-\cross{GTSET}{eval} \\
-\cross{GTSET}{every?} &
-\cross{GTSET}{extend} \\
-\cross{GTSET}{extendIfCan} &
-\cross{GTSET}{find} \\
-\cross{GTSET}{first} &
-\cross{GTSET}{hash} \\
-\cross{GTSET}{headReduce} &
-\cross{GTSET}{headReduced?} \\
-\cross{GTSET}{headReduced?} &
-\cross{GTSET}{headRemainder} \\
-\cross{GTSET}{infRittWu?} &
-\cross{GTSET}{initiallyReduce} \\
-\cross{GTSET}{initiallyReduced?} &
-\cross{GTSET}{initials} \\
-\cross{GTSET}{last} &
-\cross{GTSET}{latex} \\
-\cross{GTSET}{less?} &
-\cross{GTSET}{mainVariable?} \\
-\cross{GTSET}{mainVariables} &
-\cross{GTSET}{map} \\
-\cross{GTSET}{map!} &
-\cross{GTSET}{member?} \\
-\cross{GTSET}{members} &
-\cross{GTSET}{more?} \\
-\cross{GTSET}{mvar} &
-\cross{GTSET}{normalized?} \\
-\cross{GTSET}{normalized?} &
-\cross{GTSET}{parts} \\
-\cross{GTSET}{quasiComponent} &
-\cross{GTSET}{reduce} \\
-\cross{GTSET}{reduceByQuasiMonic} &
-\cross{GTSET}{reduced?} \\
-\cross{GTSET}{remainder} &
-\cross{GTSET}{remove} \\
-\cross{GTSET}{removeDuplicates} &
-\cross{GTSET}{removeZero} \\
-\cross{GTSET}{rest} &
-\cross{GTSET}{retract} \\
-\cross{GTSET}{retractIfCan} &
-\cross{GTSET}{rewriteIdealWithHeadRemainder} \\
-\cross{GTSET}{rewriteIdealWithRemainder} &
-\cross{GTSET}{rewriteSetWithReduction} \\
-\cross{GTSET}{roughBase?} &
-\cross{GTSET}{roughEqualIdeals?} \\
-\cross{GTSET}{roughSubIdeal?} &
-\cross{GTSET}{roughUnitIdeal?} \\
-\cross{GTSET}{sample} &
-\cross{GTSET}{select} \\
-\cross{GTSET}{size?} &
-\cross{GTSET}{sort} \\
-\cross{GTSET}{stronglyReduce} &
-\cross{GTSET}{stronglyReduced?} \\
-\cross{GTSET}{triangular?} &
-\cross{GTSET}{trivialIdeal?} \\
-\cross{GTSET}{variables} &
-\cross{GTSET}{zeroSetSplit} \\
-\cross{GTSET}{zeroSetSplitIntoTriangularSystems} &
-\cross{GTSET}{\#{}?} \\
-\cross{GTSET}{?=?} &
-\cross{GTSET}{?\~{}=?} 
+\begin{tabular}{lllll}
+\cross{FAMONOID}{0} &
+\cross{FAMONOID}{coefficient} &
+\cross{FAMONOID}{coerce} &
+\cross{FAMONOID}{hash} &
+\cross{FAMONOID}{highCommonTerms} \\
+\cross{FAMONOID}{latex} &
+\cross{FAMONOID}{mapCoef} &
+\cross{FAMONOID}{mapGen} &
+\cross{FAMONOID}{nthCoef} &
+\cross{FAMONOID}{nthFactor} \\
+\cross{FAMONOID}{retract} &
+\cross{FAMONOID}{retractIfCan} &
+\cross{FAMONOID}{sample} &
+\cross{FAMONOID}{size} &
+\cross{FAMONOID}{subtractIfCan} \\
+\cross{FAMONOID}{terms} &
+\cross{FAMONOID}{zero?} &
+\cross{FAMONOID}{?\~{}=?} &
+\cross{FAMONOID}{?*?} &
+\cross{FAMONOID}{?+?} \\
+\cross{FAMONOID}{?=?} &&&&
 \end{tabular}
 
-\begin{chunk}{domain GTSET GeneralTriangularSet}
-)abbrev domain GTSET GeneralTriangularSet
-++ Author: Marc Moreno Maza (marc@nag.co.uk)
-++ Date Created: 10/06/1995
-++ Date Last Updated: 06/12/1996
-++ References :
-++  [1] P. AUBRY, D. LAZARD and M. MORENO MAZA "On the Theories
-++      of Triangular Sets" Journal of Symbol. Comp. (to appear)
-++ Description: 
-++ A domain constructor of the category \axiomType{TriangularSetCategory}.
-++ The only requirement for a list of polynomials to be a member of such
-++ a domain is the following: no polynomial is constant and two distinct
-++ polynomials have distinct main variables. Such a triangular set may
-++ not be auto-reduced or consistent. Triangular sets are stored
-++ as sorted lists w.r.t. the main variables of their members but they
-++ are displayed in reverse order.
-
-GeneralTriangularSet(R,E,V,P) : Exports == Implementation where
-
-  R : IntegralDomain
-  E : OrderedAbelianMonoidSup
-  V : OrderedSet
-  P : RecursivePolynomialCategory(R,E,V)
-  N ==> NonNegativeInteger
-  Z ==> Integer
-  B ==> Boolean
-  LP ==> List P
-  PtoP ==> P -> P
-
-  Exports ==  TriangularSetCategory(R,E,V,P)
-
-  Implementation == add
-
-     Rep ==> LP
-
-     rep(s:$):Rep == s pretend Rep
-     per(l:Rep):$ == l pretend $
-
-     copy ts ==
-       per(copy(rep(ts))$LP)
-     empty() ==
-       per([])
-     empty?(ts:$) ==
-       empty?(rep(ts))
-     parts ts ==
-       rep(ts)
-     members ts ==
-       rep(ts)
-     map (f : PtoP, ts : $) : $ ==
-       construct(map(f,rep(ts))$LP)$$
-     map! (f : PtoP, ts : $) : $  ==
-       construct(map!(f,rep(ts))$LP)$$
-     member? (p,ts) ==
-       member?(p,rep(ts))$LP
-
-     unitIdealIfCan() ==
-       "failed"::Union($,"failed")
-     roughUnitIdeal? ts ==
-       false
-
-     -- the following assume that rep(ts) is decreasingly sorted
-     -- w.r.t. the main variavles of the polynomials in rep(ts)
-     coerce(ts:$) : OutputForm ==
-       lp : List(P) := reverse(rep(ts))
-       brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm
-     mvar ts ==
-       empty? ts => error"failed in mvar : $ -> V from GTSET"
-       mvar(first(rep(ts)))$P
-     first ts ==
-       empty? ts => "failed"::Union(P,"failed")
-       first(rep(ts))::Union(P,"failed")
-     last ts ==
-       empty? ts => "failed"::Union(P,"failed")
-       last(rep(ts))::Union(P,"failed")
-     rest ts ==
-       empty? ts => "failed"::Union($,"failed")
-       per(rest(rep(ts)))::Union($,"failed")
-     coerce(ts:$) : (List P) ==
-       rep(ts)
-     collectUpper (ts,v) ==
-       empty? ts => ts
-       lp := rep(ts)
-       newlp : Rep := []
-       while (not empty? lp) and (mvar(first(lp)) > v) repeat
-         newlp := cons(first(lp),newlp)
-         lp := rest lp
-       per(reverse(newlp))
-     collectUnder (ts,v) ==
-       empty? ts => ts
-       lp := rep(ts)
-       while (not empty? lp) and (mvar(first(lp)) >= v) repeat
-         lp := rest lp
-       per(lp)
+\begin{chunk}{domain FAMONOID FreeAbelianMonoid}
+)abbrev domain FAMONOID FreeAbelianMonoid
+++ Author: Manuel Bronstein
+++ Date Created: November 1989
+++ Date Last Updated: 6 June 1991
+++ Description:
+++ Free abelian monoid on any set of generators
+++ The free abelian monoid on a set S is the monoid of finite sums of
+++ the form \spad{reduce(+,[ni * si])} where the si's are in S, and the ni's
+++ are non-negative integers. The operation is commutative.
 
-     -- for another domain of TSETCAT build on this domain GTSET
-     -- the following operations must be redefined
-     extendIfCan(ts:$,p:P) ==
-       ground? p => "failed"::Union($,"failed")
-       empty? ts => (per([unitCanonical(p)]$LP))::Union($,"failed")
-       not (mvar(ts) < mvar(p)) => "failed"::Union($,"failed")
-       (per(cons(p,rep(ts))))::Union($,"failed")
+FreeAbelianMonoid(S: SetCategory):
+  FreeAbelianMonoidCategory(S, NonNegativeInteger)
+    == InnerFreeAbelianMonoid(S, NonNegativeInteger, 1)
 
 \end{chunk}
 
-\begin{chunk}{COQ GTSET}
-(* domain GTSET *)
+\begin{chunk}{COQ FAMONOID}
+(* domain FAMONOID *)
 (*
 *)
 
 \end{chunk}
 
-\begin{chunk}{GTSET.dotabb}
-"GTSET" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GTSET"]
-"RPOLCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=RPOLCAT"]
-"GTSET" -> "RPOLCAT"
+\begin{chunk}{FAMONOID.dotabb}
+"FAMONOID" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FAMONOID"]
+"OAMONS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAMONS"]
+"FAMONOID" -> "OAMONS"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain GSERIES GeneralUnivariatePowerSeries}
+\section{domain FGROUP FreeGroup}
 
-\begin{chunk}{GeneralUnivariatePowerSeries.input}
+\begin{chunk}{FreeGroup.input}
 )set break resume
-)sys rm -f GeneralUnivariatePowerSeries.output
-)spool GeneralUnivariatePowerSeries.output
+)sys rm -f FreeGroup.output
+)spool FreeGroup.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show GeneralUnivariatePowerSeries
+)show FreeGroup
 --R 
---R GeneralUnivariatePowerSeries(Coef: Ring,var: Symbol,cen: Coef)  is a domain constructor
---R Abbreviation for GeneralUnivariatePowerSeries is GSERIES 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for GSERIES 
+--R FreeGroup(S: SetCategory)  is a domain constructor
+--R Abbreviation for FreeGroup is FGROUP 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FGROUP 
 --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                    coerce : % -> % if Coef has INTDOM
---R coerce : Variable(var) -> %           coerce : Integer -> %
---R coerce : % -> OutputForm              complete : % -> %
---R degree : % -> Fraction(Integer)       ?.? : (%,Fraction(Integer)) -> Coef
---R hash : % -> SingleInteger             inv : % -> % if Coef has FIELD
---R latex : % -> String                   leadingCoefficient : % -> Coef
---R leadingMonomial : % -> %              map : ((Coef -> Coef),%) -> %
---R monomial? : % -> Boolean              one? : % -> Boolean
---R order : % -> Fraction(Integer)        pole? : % -> Boolean
---R recip : % -> Union(%,"failed")        reductum : % -> %
---R sample : () -> %                      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 ?**? : (%,Integer) -> % if Coef has FIELD
---R ?/? : (%,%) -> % if Coef has FIELD
---R ?/? : (%,Coef) -> % if Coef has FIELD
---R D : % -> % if Coef has *: (Fraction(Integer),Coef) -> Coef
---R D : (%,NonNegativeInteger) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef
---R D : (%,Symbol) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
---R D : (%,List(Symbol)) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
---R D : (%,Symbol,NonNegativeInteger) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
---R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
---R ?^? : (%,Integer) -> % if Coef has FIELD
---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 : (%,Fraction(Integer)) -> Coef if Coef has **: (Coef,Fraction(Integer)) -> 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 : (%,Fraction(Integer)) -> Coef
---R coerce : Fraction(Integer) -> % if Coef has ALGEBRA(FRAC(INT))
---R coerce : UnivariatePuiseuxSeries(Coef,var,cen) -> %
---R coerce : Coef -> % if Coef has COMRING
---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 : (%,Variable(var)) -> %
---R differentiate : % -> % if Coef has *: (Fraction(Integer),Coef) -> Coef
---R differentiate : (%,NonNegativeInteger) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef
---R differentiate : (%,Symbol) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
---R differentiate : (%,List(Symbol)) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
---R differentiate : (%,Symbol,NonNegativeInteger) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
---R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
---R divide : (%,%) -> Record(quotient: %,remainder: %) if Coef has FIELD
---R ?.? : (%,%) -> % if Fraction(Integer) has SGROUP
---R euclideanSize : % -> NonNegativeInteger if Coef has FIELD
---R eval : (%,Coef) -> Stream(Coef) if Coef has **: (Coef,Fraction(Integer)) -> Coef
---R exp : % -> % if Coef has ALGEBRA(FRAC(INT))
---R expressIdealMember : (List(%),%) -> Union(List(%),"failed") if Coef has FIELD
---R exquo : (%,%) -> Union(%,"failed") if Coef has INTDOM
---R extend : (%,Fraction(Integer)) -> %
---R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) if Coef has FIELD
---R extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") if Coef has FIELD
---R factor : % -> Factored(%) if Coef has FIELD
---R gcd : (%,%) -> % if Coef has FIELD
---R gcd : List(%) -> % if Coef has FIELD
---R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%) if Coef has FIELD
---R integrate : (%,Variable(var)) -> % if Coef has ALGEBRA(FRAC(INT))
---R integrate : (%,Symbol) -> % if Coef has integrate: (Coef,Symbol) -> Coef and Coef has variables: Coef -> List(Symbol) and Coef has ALGEBRA(FRAC(INT)) or Coef has ACFS(INT) and Coef has ALGEBRA(FRAC(INT)) and Coef has PRIMCAT and Coef has TRANFUN
---R integrate : % -> % if Coef has ALGEBRA(FRAC(INT))
---R lcm : (%,%) -> % if Coef has FIELD
---R lcm : List(%) -> % if Coef has FIELD
---R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) if Coef has FIELD
---R log : % -> % if Coef has ALGEBRA(FRAC(INT))
---R monomial : (%,List(SingletonAsOrderedSet),List(Fraction(Integer))) -> %
---R monomial : (%,SingletonAsOrderedSet,Fraction(Integer)) -> %
---R monomial : (Coef,Fraction(Integer)) -> %
---R multiEuclidean : (List(%),%) -> Union(List(%),"failed") if Coef has FIELD
---R multiplyExponents : (%,Fraction(Integer)) -> %
---R multiplyExponents : (%,PositiveInteger) -> %
---R nthRoot : (%,Integer) -> % if Coef has ALGEBRA(FRAC(INT))
---R order : (%,Fraction(Integer)) -> Fraction(Integer)
---R pi : () -> % if Coef has ALGEBRA(FRAC(INT))
---R prime? : % -> Boolean if Coef has FIELD
---R principalIdeal : List(%) -> Record(coef: List(%),generator: %) if Coef has FIELD
---R ?quo? : (%,%) -> % if Coef has FIELD
---R ?rem? : (%,%) -> % if Coef has FIELD
---R sec : % -> % if Coef has ALGEBRA(FRAC(INT))
---R sech : % -> % if Coef has ALGEBRA(FRAC(INT))
---R series : (NonNegativeInteger,Stream(Record(k: Fraction(Integer),c: Coef))) -> %
---R sin : % -> % if Coef has ALGEBRA(FRAC(INT))
---R sinh : % -> % if Coef has ALGEBRA(FRAC(INT))
---R sizeLess? : (%,%) -> Boolean if Coef has FIELD
---R sqrt : % -> % if Coef has ALGEBRA(FRAC(INT))
---R squareFree : % -> Factored(%) if Coef has FIELD
---R squareFreePart : % -> % if Coef has FIELD
---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: Fraction(Integer),c: Coef))
---R truncate : (%,Fraction(Integer),Fraction(Integer)) -> %
---R truncate : (%,Fraction(Integer)) -> %
---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 ?*? : (%,S) -> %                      ?*? : (S,%) -> %
+--R ?*? : (%,%) -> %                      ?**? : (S,Integer) -> %
+--R ?**? : (%,Integer) -> %               ?**? : (%,NonNegativeInteger) -> %
+--R ?**? : (%,PositiveInteger) -> %       ?/? : (%,%) -> %
+--R ?=? : (%,%) -> Boolean                1 : () -> %
+--R ?^? : (%,Integer) -> %                ?^? : (%,NonNegativeInteger) -> %
+--R ?^? : (%,PositiveInteger) -> %        coerce : S -> %
+--R coerce : % -> OutputForm              commutator : (%,%) -> %
+--R conjugate : (%,%) -> %                hash : % -> SingleInteger
+--R inv : % -> %                          latex : % -> String
+--R mapGen : ((S -> S),%) -> %            nthExpon : (%,Integer) -> Integer
+--R nthFactor : (%,Integer) -> S          one? : % -> Boolean
+--R recip : % -> Union(%,"failed")        retract : % -> S
+--R sample : () -> %                      size : % -> NonNegativeInteger
+--R ?~=? : (%,%) -> Boolean              
+--R factors : % -> List(Record(gen: S,exp: Integer))
+--R mapExpon : ((Integer -> Integer),%) -> %
+--R retractIfCan : % -> Union(S,"failed")
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{GeneralUnivariatePowerSeries.help}
+\begin{chunk}{FreeGroup.help}
 ====================================================================
-GeneralUnivariatePowerSeries examples
+FreeGroup examples
 ====================================================================
 
-This is a category of univariate Puiseux series constructed from 
-univariate Laurent series.  A Puiseux series is represented by a pair 
-[r,f(x)], where r is a positive rational number and f(x) is a Laurent 
-series.  This pair represents the Puiseux series f(x\^r).
-
-See Also:
-o )show GeneralUnivariatePowerSeries
+Free group on any set of generators
+The free group on a set S is the group of finite products of
+the form reduce(*,[si ** ni]) where the si's are in S, and the ni's
+are integers. The multiplication is not commutative.
+
+See Also:
+o )show FreeGroup
 
 \end{chunk}
 
-\pagehead{GeneralUnivariatePowerSeries}{GSERIES}
-\pagepic{ps/v103generalunivariatepowerseries.ps}{GSERIES}{1.00}
+\pagehead{FreeGroup}{FGROUP}
+\pagepic{ps/v103freegroup.ps}{FGROUP}{1.00}
+{\bf See}\\
+\pageto{ListMonoidOps}{LMOPS}
+\pageto{FreeMonoid}{FMONOID}
+\pageto{InnerFreeAbelianMonoid}{IFAMON}
+\pageto{FreeAbelianMonoid}{FAMONOID}
+\pageto{FreeAbelianGroup}{FAGROUP}
 
 {\bf Exports:}\\
-\begin{tabular}{llll}
-\cross{GSERIES}{0} &
-\cross{GSERIES}{1} &
-\cross{GSERIES}{acos} &
-\cross{GSERIES}{acosh} \\
-\cross{GSERIES}{acot} &
-\cross{GSERIES}{acoth} &
-\cross{GSERIES}{acsc} &
-\cross{GSERIES}{acsch} \\
-\cross{GSERIES}{approximate} &
-\cross{GSERIES}{asec} &
-\cross{GSERIES}{asech} &
-\cross{GSERIES}{asin} \\
-\cross{GSERIES}{asinh} &
-\cross{GSERIES}{associates?} &
-\cross{GSERIES}{atan} &
-\cross{GSERIES}{atanh} \\
-\cross{GSERIES}{center} &
-\cross{GSERIES}{characteristic} &
-\cross{GSERIES}{charthRoot} &
-\cross{GSERIES}{coefficient} \\
-\cross{GSERIES}{coerce} &
-\cross{GSERIES}{complete} &
-\cross{GSERIES}{cos} &
-\cross{GSERIES}{cosh} \\
-\cross{GSERIES}{cot} &
-\cross{GSERIES}{coth} &
-\cross{GSERIES}{csc} &
-\cross{GSERIES}{csch} \\
-\cross{GSERIES}{D} &
-\cross{GSERIES}{degree} &
-\cross{GSERIES}{differentiate} &
-\cross{GSERIES}{divide} \\
-\cross{GSERIES}{euclideanSize} &
-\cross{GSERIES}{eval} &
-\cross{GSERIES}{exp} &
-\cross{GSERIES}{expressIdealMember} \\
-\cross{GSERIES}{exquo} &
-\cross{GSERIES}{extend} &
-\cross{GSERIES}{extendedEuclidean} &
-\cross{GSERIES}{factor} \\
-\cross{GSERIES}{gcd} &
-\cross{GSERIES}{gcdPolynomial} &
-\cross{GSERIES}{hash} &
-\cross{GSERIES}{integrate} \\
-\cross{GSERIES}{inv} &
-\cross{GSERIES}{latex} &
-\cross{GSERIES}{lcm} &
-\cross{GSERIES}{leadingCoefficient} \\
-\cross{GSERIES}{leadingMonomial} &
-\cross{GSERIES}{log} &
-\cross{GSERIES}{map} &
-\cross{GSERIES}{monomial} \\
-\cross{GSERIES}{monomial?} &
-\cross{GSERIES}{multiEuclidean} &
-\cross{GSERIES}{multiplyExponents} &
-\cross{GSERIES}{nthRoot} \\
-\cross{GSERIES}{one?} &
-\cross{GSERIES}{order} &
-\cross{GSERIES}{pi} &
-\cross{GSERIES}{pole?} \\
-\cross{GSERIES}{prime?} &
-\cross{GSERIES}{principalIdeal} &
-\cross{GSERIES}{recip} &
-\cross{GSERIES}{reductum} \\
-\cross{GSERIES}{sample} &
-\cross{GSERIES}{sec} &
-\cross{GSERIES}{sech} &
-\cross{GSERIES}{series} \\
-\cross{GSERIES}{sin} &
-\cross{GSERIES}{sinh} &
-\cross{GSERIES}{sizeLess?} &
-\cross{GSERIES}{sqrt} \\
-\cross{GSERIES}{squareFree} &
-\cross{GSERIES}{squareFreePart} &
-\cross{GSERIES}{subtractIfCan} &
-\cross{GSERIES}{tan} \\
-\cross{GSERIES}{tanh} &
-\cross{GSERIES}{terms} &
-\cross{GSERIES}{truncate} &
-\cross{GSERIES}{unit?} \\
-\cross{GSERIES}{unitCanonical} &
-\cross{GSERIES}{unitNormal} &
-\cross{GSERIES}{variable} &
-\cross{GSERIES}{variables} \\
-\cross{GSERIES}{zero?} &
-\cross{GSERIES}{?+?} &
-\cross{GSERIES}{?-?} &
-\cross{GSERIES}{-?} \\
-\cross{GSERIES}{?=?} &
-\cross{GSERIES}{?\^{}?} &
-\cross{GSERIES}{?\~{}=?} &
-\cross{GSERIES}{?*?} \\
-\cross{GSERIES}{?**?} &
-\cross{GSERIES}{?/?} &
-\cross{GSERIES}{?.?} \\
-\cross{GSERIES}{?quo?} &
-\cross{GSERIES}{?rem?} &&
+\begin{tabular}{lllll}
+\cross{FGROUP}{1} &
+\cross{FGROUP}{coerce} &
+\cross{FGROUP}{commutator} &
+\cross{FGROUP}{conjugate} &
+\cross{FGROUP}{factors} \\
+\cross{FGROUP}{hash} &
+\cross{FGROUP}{inv} &
+\cross{FGROUP}{latex} &
+\cross{FGROUP}{mapExpon} &
+\cross{FGROUP}{mapGen} \\
+\cross{FGROUP}{nthExpon} &
+\cross{FGROUP}{nthFactor} &
+\cross{FGROUP}{one?} &
+\cross{FGROUP}{recip} &
+\cross{FGROUP}{retract} \\
+\cross{FGROUP}{retractIfCan} &
+\cross{FGROUP}{sample} &
+\cross{FGROUP}{size} &
+\cross{FGROUP}{?\~{}=?} &
+\cross{FGROUP}{?**?} \\
+\cross{FGROUP}{?\^{}?} &
+\cross{FGROUP}{?*?} &
+\cross{FGROUP}{?/?} &
+\cross{FGROUP}{?=?} &
 \end{tabular}
 
-\begin{chunk}{domain GSERIES GeneralUnivariatePowerSeries}
-)abbrev domain GSERIES GeneralUnivariatePowerSeries
-++ Author: Clifton J. Williamson
-++ Date Created: 22 September 1993
-++ Date Last Updated: 23 September 1993
+\begin{chunk}{domain FGROUP FreeGroup}
+)abbrev domain FGROUP FreeGroup
+++ Author: Stephen M. Watt
+++ Date Last Updated: 6 June 1991
 ++ Description:
-++ This is a category of univariate Puiseux series constructed
-++ from univariate Laurent series.  A Puiseux series is represented
-++ by a pair \spad{[r,f(x)]}, where r is a positive rational number and
-++ \spad{f(x)} is a Laurent series.  This pair represents the Puiseux
-++ series \spad{f(x\^r)}.
+++ Free group on any set of generators
+++ The free group on a set S is the group of finite products of
+++ the form \spad{reduce(*,[si ** ni])} where the si's are in S, and the ni's
+++ are integers. The multiplication is not commutative.
 
-GeneralUnivariatePowerSeries(Coef,var,cen): Exports == Implementation where
-  Coef : Ring
-  var  : Symbol
-  cen  : Coef
-  I      ==> Integer
-  UTS    ==> UnivariateTaylorSeries
-  ULS    ==> UnivariateLaurentSeries
-  UPXS   ==> UnivariatePuiseuxSeries
-  EFULS  ==> ElementaryFunctionsUnivariateLaurentSeries
-  EFUPXS ==> ElementaryFunctionsUnivariatePuiseuxSeries
-  FS2UPS ==> FunctionSpaceToUnivariatePowerSeries
+FreeGroup(S: SetCategory): Join(Group, RetractableTo S) with
+        "*":    (S, $) -> $
+          ++ s * x returns the product of x by s on the left.
+        "*":    ($, S) -> $
+          ++ x * s returns the product of x by s on the right.
+        "**"         : (S, Integer) -> $
+          ++ s ** n returns the product of s by itself n times.
+        size         : $ -> NonNegativeInteger
+          ++ size(x) returns the number of monomials in x.
+        nthExpon     : ($, Integer) -> Integer
+          ++ nthExpon(x, n) returns the exponent of the n^th monomial of x.
+        nthFactor    : ($, Integer) -> S
+          ++ nthFactor(x, n) returns the factor of the n^th monomial of x.
+        mapExpon     : (Integer -> Integer, $) -> $
+          ++ mapExpon(f, a1\^e1 ... an\^en) returns 
+          ++ \spad{a1\^f(e1) ... an\^f(en)}.
+        mapGen       : (S -> S, $) -> $
+          ++ mapGen(f, a1\^e1 ... an\^en) returns 
+          ++ \spad{f(a1)\^e1 ... f(an)\^en}.
+        factors      : $ -> List Record(gen: S, exp: Integer)
+          ++ factors(a1\^e1,...,an\^en) returns \spad{[[a1, e1],...,[an, en]]}.
+    == ListMonoidOps(S, Integer, 1) add
 
-  Exports ==> UnivariatePuiseuxSeriesCategory Coef with
-    coerce: Variable(var) -> %
-      ++ coerce(var) converts the series variable \spad{var} into a
-      ++ Puiseux series.
-    coerce: UPXS(Coef,var,cen) -> %
-      ++ coerce(f) converts a Puiseux series to a general power series.
-    differentiate: (%,Variable(var)) -> %
-      ++ \spad{differentiate(f(x),x)} returns the derivative of
-      ++ \spad{f(x)} with respect to \spad{x}.
-    if Coef has Algebra Fraction Integer then
-      integrate: (%,Variable(var)) -> %
-        ++ \spad{integrate(f(x))} returns an anti-derivative of the power
-        ++ series \spad{f(x)} with constant coefficient 0.
-        ++ We may integrate a series when we can divide coefficients
-        ++ by integers.
+        Rep := ListMonoidOps(S, Integer, 1)
 
-  Implementation ==> UnivariatePuiseuxSeries(Coef,var,cen) add
+        1                       == makeUnit()
 
-    coerce(upxs:UPXS(Coef,var,cen)) == upxs pretend %
+        one? f                  == empty? listOfMonoms f
 
-    puiseux: % -> UPXS(Coef,var,cen)
-    puiseux f == f pretend UPXS(Coef,var,cen)
+        s:S ** n:Integer        == makeTerm(s, n)
 
-    if Coef has Algebra Fraction Integer then
+        f:$ * s:S               == rightMult(f, s)
 
-      differentiate f ==
-        str1 : String := "'differentiate' unavailable on this domain;  "
-        str2 : String := "use 'approximate' first"
-        error concat(str1,str2)
+        s:S * f:$               == leftMult(s, f)
 
-      differentiate(f:%,v:Variable(var)) == differentiate f
+        inv f                   == reverse_! mapExpon("-", f)
 
-      if Coef has PartialDifferentialRing(Symbol) then
-        differentiate(f:%,s:Symbol) ==
-          (s = variable(f)) =>
-            str1 : String := "'differentiate' unavailable on this domain;  "
-            str2 : String := "use 'approximate' first"
-            error concat(str1,str2)
-          dcds := differentiate(center f,s)
-          deriv := differentiate(puiseux f) :: %
-          map(x+->differentiate(x,s),f) - dcds * deriv
+        factors f               == copy listOfMonoms f
 
-      integrate f ==
-        str1 : String := "'integrate' unavailable on this domain;  "
-        str2 : String := "use 'approximate' first"
-        error concat(str1,str2)
+        mapExpon(f, x)          == mapExpon(f, x)$Rep
 
-      integrate(f:%,v:Variable(var)) == integrate f
+        mapGen(f, x)            == mapGen(f, x)$Rep
 
-      if Coef has integrate: (Coef,Symbol) -> Coef and _
-         Coef has variables: Coef -> List Symbol then
+        coerce(f:$):OutputForm  == outputForm(f, "*", "**", 1)
 
-        integrate(f:%,s:Symbol) ==
-          (s = variable(f)) =>
-            str1 : String := "'integrate' unavailable on this domain;  "
-            str2 : String := "use 'approximate' first"
-            error concat(str1,str2)
-          not entry?(s,variables center f) => map(x+->integrate(x,s),f)
-          error "integrate: center is a function of variable of integration"
+        f:$ * g:$ ==
+            one? f => g
+            one? g => f
+            r := reverse listOfMonoms f
+            q := copy listOfMonoms g
+            while not empty? r and not empty? q and r.first.gen = q.first.gen
+                and r.first.exp = -q.first.exp repeat
+                     r := rest r
+                     q := rest q
+            empty? r => makeMulti q
+            empty? q => makeMulti reverse_! r
+            r.first.gen = q.first.gen =>
+              setlast_!(h := reverse_! r,
+                                [q.first.gen, q.first.exp + r.first.exp])
+              makeMulti concat_!(h, rest q)
+            makeMulti concat_!(reverse_! r, q)
 
-      if Coef has TranscendentalFunctionCategory and _
-         Coef has PrimitiveFunctionCategory and _
-         Coef has AlgebraicallyClosedFunctionSpace Integer then
+\end{chunk}
 
-        integrateWithOneAnswer: (Coef,Symbol) -> Coef
-        integrateWithOneAnswer(f,s) ==
-          res := integrate(f,s)$FunctionSpaceIntegration(Integer,Coef)
-          res case Coef => res :: Coef
-          first(res :: List Coef)
+\begin{chunk}{COQ FGROUP}
+(* domain FGROUP *)
+(*
 
-        integrate(f:%,s:Symbol) ==
-          (s = variable(f)) =>
-            str1 : String := "'integrate' unavailable on this domain;  "
-            str2 : String := "use 'approximate' first"
-            error concat(str1,str2)
-          not entry?(s,variables center f) =>
-            map(x+->integrateWithOneAnswer(x,s),f)
-          error "integrate: center is a function of variable of integration"
+        Rep := ListMonoidOps(S, Integer, 1)
 
-\end{chunk}
+        1                       == makeUnit()
+
+        one? f                  == empty? listOfMonoms f
+
+        s:S ** n:Integer        == makeTerm(s, n)
+
+        f:$ * s:S               == rightMult(f, s)
+
+        s:S * f:$               == leftMult(s, f)
+
+        inv f                   == reverse_! mapExpon("-", f)
+
+        factors f               == copy listOfMonoms f
+
+        mapExpon(f, x)          == mapExpon(f, x)$Rep
+
+        mapGen(f, x)            == mapGen(f, x)$Rep
+
+        coerce(f:$):OutputForm  == outputForm(f, "*", "**", 1)
+
+        f:$ * g:$ ==
+            one? f => g
+            one? g => f
+            r := reverse listOfMonoms f
+            q := copy listOfMonoms g
+            while not empty? r and not empty? q and r.first.gen = q.first.gen
+                and r.first.exp = -q.first.exp repeat
+                     r := rest r
+                     q := rest q
+            empty? r => makeMulti q
+            empty? q => makeMulti reverse_! r
+            r.first.gen = q.first.gen =>
+              setlast_!(h := reverse_! r,
+                                [q.first.gen, q.first.exp + r.first.exp])
+              makeMulti concat_!(h, rest q)
+            makeMulti concat_!(reverse_! r, q)
 
-\begin{chunk}{COQ GSERIES}
-(* domain GSERIES *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{GSERIES.dotabb}
-"GSERIES" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GSERIES"]
-"ACFS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACFS"]
-"GSERIES" -> "ACFS"
+\begin{chunk}{FGROUP.dotabb}
+"FGROUP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FGROUP"]
+"FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"]
+"FLAGG-" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FLAGG"]
+"FGROUP" -> "FLAGG"
+"FGROUP" -> "FLAGG-"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain GRIMAGE GraphImage}
+\section{domain FM FreeModule}
 
-\begin{chunk}{GraphImage.input}
+\begin{chunk}{FreeModule.input}
 )set break resume
-)sys rm -f GraphImage.output
-)spool GraphImage.output
+)sys rm -f FreeModule.output
+)spool FreeModule.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show GraphImage
+)show FreeModule
 --R 
---R GraphImage  is a domain constructor
---R Abbreviation for GraphImage is GRIMAGE 
+--R FreeModule(R: Ring,S: OrderedSet)  is a domain constructor
+--R Abbreviation for FreeModule is FM 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for GRIMAGE 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FM 
 --R
 --R------------------------------- Operations --------------------------------
---R ?=? : (%,%) -> Boolean                coerce : % -> OutputForm
---R graphImage : () -> %                  hash : % -> SingleInteger
---R key : % -> Integer                    latex : % -> String
---R makeGraphImage : % -> %               ranges : % -> List(Segment(Float))
---R units : % -> List(Float)              ?~=? : (%,%) -> Boolean
---R appendPoint : (%,Point(DoubleFloat)) -> Void
---R coerce : List(List(Point(DoubleFloat))) -> %
---R component : (%,Point(DoubleFloat),Palette,Palette,PositiveInteger) -> Void
---R component : (%,Point(DoubleFloat)) -> Void
---R component : (%,List(Point(DoubleFloat)),Palette,Palette,PositiveInteger) -> Void
---R figureUnits : List(List(Point(DoubleFloat))) -> List(DoubleFloat)
---R makeGraphImage : (List(List(Point(DoubleFloat))),List(Palette),List(Palette),List(PositiveInteger),List(DrawOption)) -> %
---R makeGraphImage : (List(List(Point(DoubleFloat))),List(Palette),List(Palette),List(PositiveInteger)) -> %
---R makeGraphImage : List(List(Point(DoubleFloat))) -> %
---R point : (%,Point(DoubleFloat),Palette) -> Void
---R pointLists : % -> List(List(Point(DoubleFloat)))
---R putColorInfo : (List(List(Point(DoubleFloat))),List(Palette)) -> List(List(Point(DoubleFloat)))
---R ranges : (%,List(Segment(Float))) -> List(Segment(Float))
---R units : (%,List(Float)) -> List(Float)
+--R ?*? : (%,R) -> %                      ?*? : (R,%) -> %
+--R ?*? : (Integer,%) -> %                ?*? : (NonNegativeInteger,%) -> %
+--R ?*? : (PositiveInteger,%) -> %        ?+? : (%,%) -> %
+--R ?-? : (%,%) -> %                      -? : % -> %
+--R ?=? : (%,%) -> Boolean                0 : () -> %
+--R coerce : % -> OutputForm              hash : % -> SingleInteger
+--R latex : % -> String                   leadingCoefficient : % -> R
+--R leadingSupport : % -> S               map : ((R -> R),%) -> %
+--R monomial : (R,S) -> %                 reductum : % -> %
+--R sample : () -> %                      zero? : % -> Boolean
+--R ?~=? : (%,%) -> Boolean              
+--R subtractIfCan : (%,%) -> Union(%,"failed")
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{GraphImage.help}
+\begin{chunk}{FreeModule.help}
 ====================================================================
-GraphImage examples
+FreeModule examples
 ====================================================================
 
-TwoDimensionalGraph creates virtual two dimensional graphs 
-(to be displayed on TwoDimensionalViewports).
+A bi-module is a free module over a ring with generators indexed by an
+ordered set.  Each element can be expressed as a finite linear
+combination of generators. Only non-zero terms are stored.
 
 See Also:
-o )show GraphImage
+o )show FreeModule
 
 \end{chunk}
 
-\pagehead{GraphImage}{GRIMAGE}
-\pagepic{ps/v103graphimage.ps}{GRIMAGE}{1.00}
+\pagehead{FreeModule}{FM}
+\pagepic{ps/v103freemodule.ps}{FM}{1.00}
+{\bf See}\\
+\pageto{PolynomialRing}{PR}
+\pageto{SparseUnivariatePolynomial}{SUP}
+\pageto{UnivariatePolynomial}{UP}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{GRIMAGE}{appendPoint} &
-\cross{GRIMAGE}{coerce} &
-\cross{GRIMAGE}{component} &
-\cross{GRIMAGE}{figureUnits} &
-\cross{GRIMAGE}{graphImage} \\
-\cross{GRIMAGE}{hash} &
-\cross{GRIMAGE}{key} &
-\cross{GRIMAGE}{latex} &
-\cross{GRIMAGE}{makeGraphImage} &
-\cross{GRIMAGE}{point} \\
-\cross{GRIMAGE}{pointLists} &
-\cross{GRIMAGE}{putColorInfo} &
-\cross{GRIMAGE}{ranges} &
-\cross{GRIMAGE}{units} &
-\cross{GRIMAGE}{?\~{}=?} \\
-\cross{GRIMAGE}{?=?} &&&&
+\cross{FM}{0} &
+\cross{FM}{coerce} &
+\cross{FM}{hash} &
+\cross{FM}{latex} &
+\cross{FM}{leadingCoefficient} \\
+\cross{FM}{leadingSupport} &
+\cross{FM}{map} &
+\cross{FM}{monomial} &
+\cross{FM}{reductum} &
+\cross{FM}{sample} \\
+\cross{FM}{subtractIfCan} &
+\cross{FM}{zero?} &
+\cross{FM}{?\~{}=?} &
+\cross{FM}{?*?} &
+\cross{FM}{?+?} \\
+\cross{FM}{?-?} &
+\cross{FM}{-?} &
+\cross{FM}{?=?} &&
 \end{tabular}
 
-\begin{chunk}{domain GRIMAGE GraphImage}
-)abbrev domain GRIMAGE GraphImage
-++ Author: Jim Wen
-++ Date Created: 27 April 1989
-++ Date Last Updated: 1995 September 20, Mike Richardson (MGR)
+\begin{chunk}{domain FM FreeModule}
+)abbrev domain FM FreeModule
+++ Author: Dave Barton, James Davenport, Barry Trager
 ++ Description:
-++ TwoDimensionalGraph creates virtual two dimensional graphs 
-++ (to be displayed on TwoDimensionalViewports).
-
-GraphImage (): Exports == Implementation where
-
-  VIEW    ==> VIEWPORTSERVER$Lisp
-  sendI   ==> SOCK_-SEND_-INT
-  sendSF  ==> SOCK_-SEND_-FLOAT
-  sendSTR ==> SOCK_-SEND_-STRING
-  getI    ==> SOCK_-GET_-INT
-  getSF   ==> SOCK_-GET_-FLOAT
-
-  typeGRAPH  ==> 2
-  typeVIEW2D ==> 3
-
-  makeGRAPH  ==> (-1)$SingleInteger
-  makeVIEW2D ==> (-1)$SingleInteger
- 
-  I   ==> Integer
-  PI  ==> PositiveInteger
-  NNI ==> NonNegativeInteger
-  SF  ==> DoubleFloat
-  F   ==> Float
-  L   ==> List
-  P   ==> Point(SF)
-  V   ==> Vector
-  SEG ==> Segment
-  RANGESF   ==> L SEG SF
-  RANGEF    ==> L SEG F
-  UNITSF   ==> L SF
-  UNITF    ==> L F
-  PAL ==> Palette
-  E   ==> OutputForm
-  DROP ==> DrawOption
-  PP ==> PointPackage(SF)
-  COORDSYS ==> CoordinateSystems(SF)
+++ A bi-module is a free module
+++ over a ring with generators indexed by an ordered set.
+++ Each element can be expressed as a finite linear combination of
+++ generators. Only non-zero terms are stored.
 
-  Exports ==> SetCategory with
-    graphImage      :  ()                                        -> $
-      ++ graphImage() returns an empty graph with 0 point lists 
-      ++ of the domain \spadtype{GraphImage}.  A graph image contains
-      ++ the graph data component of a two dimensional viewport.
-    makeGraphImage  :  $                                         -> $ 
-      ++ makeGraphImage(gi) takes the given graph, \spad{gi} of the
-      ++ domain \spadtype{GraphImage}, and sends it's data to the
-      ++ viewport manager where it waits to be included in a two-dimensional
-      ++ viewport window.  \spad{gi} cannot be an empty graph, and it's
-      ++ elements must have been created using the \spadfun{point} or
-      ++ \spadfun{component} functions, not by a previous
-      ++ \spadfun{makeGraphImage}.
-    makeGraphImage  :  (L L P)                                   -> $
-      ++ makeGraphImage(llp) returns a graph of the domain 
-      ++ \spadtype{GraphImage} which is composed of the points and 
-      ++ lines from the list of lists of points, \spad{llp}, with 
-      ++ default point size and default point and line colours. The graph
-      ++ data is then sent to the viewport manager where it waits to be
-      ++ included in a two-dimensional viewport window.
-    makeGraphImage  :  (L L P,L PAL,L PAL,L PI)                  -> $ 
-      ++ makeGraphImage(llp,lpal1,lpal2,lp) returns a graph of the
-      ++ domain \spadtype{GraphImage} which is composed of the points
-      ++ and lines from the list of lists of points, \spad{llp}, whose
-      ++ point colors are indicated by the list of palette colors,
-      ++ \spad{lpal1}, and whose lines are colored according to the list
-      ++ of palette colors, \spad{lpal2}.  The paramater lp is a list of
-      ++ integers which denote the size of the data points.  The graph
-      ++ data is then sent to the viewport manager where it waits to be
-      ++ included in a two-dimensional viewport window.
-    makeGraphImage  :  (L L P,L PAL,L PAL,L PI,L DROP)           -> $
-      ++ makeGraphImage(llp,lpal1,lpal2,lp,lopt) returns a graph of
-      ++ the domain \spadtype{GraphImage} which is composed of the 
-      ++ points and lines from the list of lists of points, \spad{llp},
-      ++ whose point colors are indicated by the list of palette colors,
-      ++ \spad{lpal1}, and whose lines are colored according to the list
-      ++ of palette colors, \spad{lpal2}.  The paramater lp is a list of
-      ++ integers which denote the size of the data points, and \spad{lopt}
-      ++ is the list of draw command options.  The graph data is then sent
-      ++ to the viewport manager where it waits to be included in a 
-      ++ two-dimensional viewport window.
-    pointLists      :  $                                         -> L L P
-      ++ pointLists(gi) returns the list of lists of points which compose
-      ++ the given graph, \spad{gi}, of the domain \spadtype{GraphImage}.
-    key             :  $                                         -> I
-      ++ key(gi) returns the process ID of the given graph, \spad{gi},
-      ++ of the domain \spadtype{GraphImage}.
-    ranges          :  $                                         -> RANGEF
-      ++ ranges(gi) returns the list of ranges of the point components from
-      ++ the indicated graph, \spad{gi}, of the domain \spadtype{GraphImage}.
-    ranges          :  ($,RANGEF)                                -> RANGEF
-      ++ ranges(gi,lr) modifies the list of ranges for the given graph,
-      ++ \spad{gi} of the domain \spadtype{GraphImage}, to be that of the
-      ++ list of range segments, \spad{lr}, and returns the new range list
-      ++ for \spad{gi}. 
-    units           :  $                                         -> UNITF
-      ++ units(gi) returns the list of unit increments for the x and y
-      ++ axes of the indicated graph, \spad{gi}, of the domain
-      ++ \spadtype{GraphImage}.
-    units           :  ($,UNITF)                                 -> UNITF
-      ++ units(gi,lu) modifies the list of unit increments for the x and y
-      ++ axes of the given graph, \spad{gi} of the domain
-      ++ \spadtype{GraphImage}, to be that of the list of unit increments,
-      ++ \spad{lu}, and returns the new list of units for \spad{gi}. 
-    component       :  ($,L P,PAL,PAL,PI)                        -> Void
-      ++ component(gi,lp,pal1,pal2,p) sets the components of the
-      ++ graph, \spad{gi} of the domain \spadtype{GraphImage}, to the
-      ++ values given.  The point list for \spad{gi} is set to the list
-      ++ \spad{lp}, the color of the points in \spad{lp} is set to
-      ++ the palette color \spad{pal1}, the color of the lines which
-      ++ connect the points \spad{lp} is set to the palette color
-      ++ \spad{pal2}, and the size of the points in \spad{lp} is given
-      ++ by the integer p.
-    component       :  ($,P)                                     -> Void
-      ++ component(gi,pt) modifies the graph \spad{gi} of the domain
-      ++ \spadtype{GraphImage} to contain one point component, \spad{pt}
-      ++ whose point color, line color and point size are determined by
-      ++ the default functions \spadfun{pointColorDefault},
-      ++ \spadfun{lineColorDefault}, and \spadfun{pointSizeDefault}.
-    component       :  ($,P,PAL,PAL,PI)                          -> Void
-      ++ component(gi,pt,pal1,pal2,ps) modifies the graph \spad{gi} of
-      ++ the domain \spadtype{GraphImage} to contain one point component,
-      ++ \spad{pt} whose point color is set to the palette color \spad{pal1},
-      ++ line color is set to the palette color \spad{pal2}, and point
-      ++ size is set to the positive integer \spad{ps}.
-    appendPoint     :  ($,P)                                     -> Void
-      ++ appendPoint(gi,pt) appends the point \spad{pt} to the end
-      ++ of the list of points component for the graph, \spad{gi}, which is
-      ++ of the domain \spadtype{GraphImage}.
-    point           :  ($,P,PAL)                                 -> Void
-      ++ point(gi,pt,pal) modifies the graph \spad{gi} of the domain
-      ++ \spadtype{GraphImage} to contain one point component, \spad{pt}
-      ++ whose point color is set to be the palette color \spad{pal}, and
-      ++ whose line color and point size are determined by the default
-      ++ functions \spadfun{lineColorDefault} and \spadfun{pointSizeDefault}.
-    coerce          :  L L P                                     -> $
-      ++ coerce(llp)
-      ++ component(gi,pt) creates and returns a graph of the domain
-      ++ \spadtype{GraphImage} which is composed of the list of list
-      ++ of points given by \spad{llp}, and whose point colors, line colors
-      ++ and point sizes are determined by the default functions 
-      ++ \spadfun{pointColorDefault}, \spadfun{lineColorDefault}, and
-      ++ \spadfun{pointSizeDefault}.  The graph data is then sent to the 
-      ++ viewport manager where it waits to be included in a two-dimensional
-      ++ viewport window.
-    coerce          :  $                                         -> E
-      ++ coerce(gi) returns the indicated graph, \spad{gi}, of domain
-      ++ \spadtype{GraphImage} as output of the domain \spadtype{OutputForm}.
-    putColorInfo    : (L L P,L PAL)                              -> L L P
-      ++ putColorInfo(llp,lpal) takes a list of list of points, \spad{llp},
-      ++ and returns the points with their hue and shade components
-      ++ set according to the list of palette colors, \spad{lpal}.
-    figureUnits : L L P                       -> UNITSF
+FreeModule(R:Ring,S:OrderedSet):
+        Join(BiModule(R,R),IndexedDirectProductCategory(R,S)) with
+    if R has CommutativeRing then Module(R)
+ == IndexedDirectProductAbelianGroup(R,S) add
 
-  Implementation ==> add
-    import Color()
-    import Palette()
-    import ViewDefaultsPackage()
-    import PlotTools()
-    import DrawOptionFunctions0
-    import P
-    import PP
-    import COORDSYS
+    --representations
+       Term:=  Record(k:S,c:R)
+       Rep:=  List Term
 
-    Rep := Record(key: I, rangesField: RANGESF, unitsField: UNITSF, _
-       llPoints: L L P, pointColors: L PAL, lineColors: L PAL, pointSizes: L PI, _
-       optionsField: L DROP)
+    --declarations
+       x,y: %
+       r: R
+       n: Integer
+       f: R -> R
+       s: S
 
---%Internal Functions
+    --define
 
-    graph       : RANGEF                          -> $
-    scaleStep   : SF                          -> SF
-    makeGraph   :  $                          -> $
+       if R has EntireRing then 
 
+         r * x  ==
+             zero? r => 0
+             (r = 1) => x
+           --map(r*#1,x)
+             [[u.k,r*u.c] for u in x ]
 
-    numberCheck(nums:Point SF):Void ==
-      for i in minIndex(nums)..maxIndex(nums) repeat
-        COMPLEXP(nums.(i::PositiveInteger))$Lisp =>
-          error "An unexpected complex number was encountered in the calculations."
-           
+       else
 
-    doOptions(g:Rep):Void ==    
-      lr : RANGEF := ranges(g.optionsField,ranges g)
-      if (#lr > 1$I) then
-        g.rangesField := [segment(convert(lo(lr.1))@SF,convert(hi(lr.1))@SF)$(Segment(SF)), 
-                           segment(convert(lo(lr.2))@SF,convert(hi(lr.2))@SF)$(Segment(SF))]
-      else
-        g.rangesField := []
-      lu : UNITF := units(g.optionsField,units g)
-      if (#lu > 1$I) then
-        g.unitsField := [convert(lu.1)@SF,convert(lu.2)@SF]
-      else
-        g.unitsField := []
-    -- etc - graphimage specific stuff...
+         r * x  ==
+             zero? r => 0
+             (r = 1) => x
+           --map(r*#1,x)
+             [[u.k,a] for u in x | (a:=r*u.c) ^= 0$R]
 
-    putColorInfo(llp,listOfPalettes) ==
-      llp2 : L L P := []
-      for lp in llp for pal in listOfPalettes repeat
-        lp2 : L P := []
-        daHue   := (hue(hue pal))::SF
-        daShade := (shade pal)::SF
-        for p in lp repeat
-          if (d := dimension p) < 3 then
-            p := extend(p,[daHue,daShade])
-          else
-            p.3 := daHue
-            d < 4 => p := extend(p,[daShade])
-            p.4 := daShade
-          lp2 := cons(p,lp2)
-        llp2 := cons(reverse_! lp2,llp2)
-      reverse_! llp2
+       if R has EntireRing then
 
-    graph demRanges ==
-      null demRanges =>  [ 0, [], [], [], [], [], [], [] ]
-      demRangesSF : RANGESF := _
-        [ segment(convert(lo demRanges.1)@SF,convert(hi demRanges.1)@SF)$(Segment(SF)), _
-          segment(convert(lo demRanges.1)@SF,convert(hi demRanges.1)@SF)$(Segment(SF)) ]
-      [ 0, demRangesSF, [], [], [], [], [], [] ]
+         x * r  ==
+             zero? r => 0
+             (r = 1) => x
+           --map(r*#1,x)
+             [[u.k,u.c*r] for u in x ]
 
-    scaleStep(range) ==                        -- MGR
-      
-      adjust:NNI
-      tryStep:SF
-      scaleDown:SF
-      numerals:String
-      adjust := 0
-      while range < 100.0::SF repeat
-        adjust := adjust + 1
-        range := range * 10.0::SF -- might as well take big steps
-      tryStep := range/10.0::SF
-      numerals := string(((retract(ceiling(tryStep)$SF)$SF)@I))$String
-      scaleDown := (10@I **$I (((#(numerals)@I) - 1$I) pretend PI))::SF
-      scaleDown*ceiling(tryStep/scaleDown - 0.5::SF)/((10 **$I adjust)::SF)
+       else
 
-    figureUnits(listOfListsOfPoints) ==
-        -- figure out the min/max and divide by 10 for unit markers
-      xMin := xMax := xCoord first first listOfListsOfPoints
-      yMin := yMax := yCoord first first listOfListsOfPoints
-      if xMin ~= xMin then xMin:=max()
-      if xMax ~= xMax then xMax:=min()
-      if yMin ~= yMin then yMin:=max()
-      if yMax ~= yMax then yMax:=min()
-      for pL in listOfListsOfPoints repeat
-        for p in pL repeat
-          if ((px := (xCoord p)) < xMin) then
-            xMin := px
-          if px > xMax then
-            xMax := px
-          if ((py := (yCoord p)) < yMin) then
-            yMin := py
-          if py > yMax then
-            yMax := py
-      if xMin = xMax then
-        xMin := xMin - convert(0.5)$Float
-        xMax := xMax + convert(0.5)$Float
-      if yMin = yMax then
-        yMin := yMin - convert(0.5)$Float
-        yMax := yMax + convert(0.5)$Float
-      [scaleStep(xMax-xMin),scaleStep(yMax-yMin)]
+         x * r  ==
+             zero? r => 0
+             (r = 1) => x
+           --map(r*#1,x)
+             [[u.k,a] for u in x | (a:=u.c*r) ^= 0$R]
 
-    plotLists(graf:Rep,listOfListsOfPoints:L L P,listOfPointColors:L PAL,listOfLineColors:L PAL,listOfPointSizes:L PI):$ ==
-      givenLen := #listOfListsOfPoints
-        -- take out point lists that are actually empty
-      listOfListsOfPoints := [ l for l in listOfListsOfPoints | ^null l ]
-      if (null listOfListsOfPoints) then
-        error "GraphImage was given a list that contained no valid point lists"
-      if ((len := #listOfListsOfPoints) ^= givenLen) then
-        sayBrightly(["   Warning: Ignoring pointless point list"::E]$List(E))$Lisp
-      graf.llPoints := listOfListsOfPoints
-        -- do point colors
-      if ((givenLen := #listOfPointColors) > len) then
-         -- pad or discard elements if given list has length different from the point list
-        graf.pointColors := concat(listOfPointColors,
-            new((len - givenLen)::NonNegativeInteger + 1, pointColorDefault()))
-      else graf.pointColors := first(listOfPointColors, len)
-        -- do line colors
-      if ((givenLen := #listOfLineColors) > len) then
-        graf.lineColors := concat(listOfLineColors,
-             new((len - givenLen)::NonNegativeInteger + 1, lineColorDefault()))
-      else graf.lineColors := first(listOfLineColors, len)
-        -- do point sizes
-      if ((givenLen := #listOfPointSizes) > len) then
-        graf.pointSizes := concat(listOfPointSizes,
-             new((len - givenLen)::NonNegativeInteger + 1, pointSizeDefault()))
-      else graf.pointSizes := first(listOfPointSizes, len)
-      graf
+       coerce(x) : OutputForm ==
+         null x => (0$R) :: OutputForm
+         le : List OutputForm := nil
+         for rec in reverse x repeat
+           rec.c = 1 => le := cons(rec.k :: OutputForm, le)
+           le := cons(rec.c :: OutputForm *  rec.k :: OutputForm, le)
+         reduce("+",le)
 
-    makeGraph graf ==
-      doOptions(graf)
-      (s := #(graf.llPoints)) = 0 =>
-        error "You are trying to make a graph with no points"
-      key graf ^= 0 => 
-        error "You are trying to draw over an existing graph"
-      transform := coord(graf.optionsField,cartesian$COORDSYS)$DrawOptionFunctions0 
-      graf.llPoints:= putColorInfo(graf.llPoints,graf.pointColors)
-      if null(ranges graf) then  -- figure out best ranges for points
-        graf.rangesField := calcRanges(graf.llPoints)  --::V SEG SF
-      if null(units graf) then  -- figure out best ranges for points
-        graf.unitsField := figureUnits(graf.llPoints)  --::V SEG SF
-      sayBrightly(["   Graph data being transmitted to the viewport manager..."::E]$List(E))$Lisp
-      sendI(VIEW,typeGRAPH)$Lisp
-      sendI(VIEW,makeGRAPH)$Lisp
-      tonto := (graf.rangesField)::RANGESF
-      sendSF(VIEW,lo(first tonto))$Lisp
-      sendSF(VIEW,hi(first tonto))$Lisp
-      sendSF(VIEW,lo(second tonto))$Lisp
-      sendSF(VIEW,hi(second tonto))$Lisp
-      sendSF(VIEW,first (graf.unitsField))$Lisp
-      sendSF(VIEW,second (graf.unitsField))$Lisp
-      sendI(VIEW,s)$Lisp     -- how many lists of points are being sent
-      for aList in graf.llPoints for pColor in graf.pointColors for lColor in graf.lineColors for s in graf.pointSizes repeat
-        sendI(VIEW,#aList)$Lisp  -- how many points in this list
-        for p in aList repeat
-          aPoint := transform p
-          sendSF(VIEW,xCoord aPoint)$Lisp
-          sendSF(VIEW,yCoord aPoint)$Lisp
-          sendSF(VIEW,hue(p)$PP)$Lisp  -- ?use aPoint as well...?
-          sendSF(VIEW,shade(p)$PP)$Lisp
-        hueShade := hue hue pColor + shade pColor * numberOfHues() 
-        sendI(VIEW,hueShade)$Lisp
-        hueShade := (hue hue lColor -1)*5 + shade lColor
-        sendI(VIEW,hueShade)$Lisp
-        sendI(VIEW,s)$Lisp
-      graf.key := getI(VIEW)$Lisp
-      graf        
+\end{chunk}
 
+\begin{chunk}{COQ FM}
+(* domain FM *)
+(*
+ IndexedDirectProductAbelianGroup(R,S) add
 
---%Exported Functions
-    makeGraphImage(graf:$)    == makeGraph graf
-    key graf                  == graf.key
-    pointLists graf           == graf.llPoints
-    ranges graf                == 
-      null graf.rangesField => []
-      [segment(convert(lo graf.rangesField.1)@F,convert(hi graf.rangesField.1)@F), _
-       segment(convert(lo graf.rangesField.2)@F,convert(hi graf.rangesField.2)@F)]
-    ranges(graf,rangesList)     == 
-      graf.rangesField := 
-        [segment(convert(lo rangesList.1)@SF,convert(hi rangesList.1)@SF), _
-         segment(convert(lo rangesList.2)@SF,convert(hi rangesList.2)@SF)]
-      rangesList
-    units graf                == 
-      null(graf.unitsField) => []
-      [convert(graf.unitsField.1)@F,convert(graf.unitsField.2)@F]
-    units (graf,unitsToBe)    == 
-      graf.unitsField := [convert(unitsToBe.1)@SF,convert(unitsToBe.2)@SF]
-      unitsToBe
-    graphImage                == graph []
+    --representations
+       Term:=  Record(k:S,c:R)
+       Rep:=  List Term
 
-    makeGraphImage(llp) ==
-      makeGraphImage(llp,
-        [pointColorDefault() for i in 1..(l:=#llp)],
-         [lineColorDefault() for i in 1..l], 
-          [pointSizeDefault() for i in 1..l])
+    --declarations
+       x,y: %
+       r: R
+       n: Integer
+       f: R -> R
+       s: S
 
-    makeGraphImage(llp,lpc,llc,lps) ==
-      makeGraphImage(llp,lpc,llc,lps,[])
+    --define
 
-    makeGraphImage(llp,lpc,llc,lps,opts) ==
-      graf := graph(ranges(opts,[]))
-      graf.optionsField := opts
-      graf := plotLists(graf,llp,lpc,llc,lps)
-      transform := coord(graf.optionsField,cartesian$COORDSYS)$DrawOptionFunctions0
-      for aList in graf.llPoints repeat
-        for p in aList repeat
-          aPoint := transform p
-          numberCheck aPoint
-      makeGraph graf
+       if R has EntireRing then 
 
-    component (graf:$,ListOfPoints:L P,PointColor:PAL,LineColor:PAL,PointSize:PI) ==
-      graf.llPoints    := append(graf.llPoints,[ListOfPoints])
-      graf.pointColors := append(graf.pointColors,[PointColor])
-      graf.lineColors  := append(graf.lineColors,[LineColor])
-      graf.pointSizes  := append(graf.pointSizes,[PointSize])     
+         r * x  ==
+             zero? r => 0
+             (r = 1) => x
+           --map(r*#1,x)
+             [[u.k,r*u.c] for u in x ]
 
-    component (graf,aPoint) ==
-      component(graf,aPoint,pointColorDefault(),lineColorDefault(),pointSizeDefault())
+       else
 
-    component (graf:$,aPoint:P,PointColor:PAL,LineColor:PAL,PointSize:PI) ==
-      component (graf,[aPoint],PointColor,LineColor,PointSize)
+         r * x  ==
+             zero? r => 0
+             (r = 1) => x
+           --map(r*#1,x)
+             [[u.k,a] for u in x | (a:=r*u.c) ^= 0$R]
 
-    appendPoint (graf,aPoint) ==
-      num : I  := #(graf.llPoints) - 1
-      num < 0 => error "No point lists to append to!"
-      (graf.llPoints.num) := append((graf.llPoints.num),[aPoint])
+       if R has EntireRing then
 
-    point (graf,aPoint,PointColor) ==
-      component(graf,aPoint,PointColor,lineColorDefault(),pointSizeDefault())
+         x * r  ==
+             zero? r => 0
+             (r = 1) => x
+           --map(r*#1,x)
+             [[u.k,u.c*r] for u in x ]
 
-    coerce (llp : L L P) : $ ==
-      makeGraphImage(llp,
-          [pointColorDefault() for i in 1..(l:=#llp)],
-           [lineColorDefault() for i in 1..l], 
-            [pointSizeDefault() for i in 1..l])
+       else
 
-    coerce (graf : $) : E ==
-      hconcat( ["Graph with " :: E,(p := # pointLists graf) :: E, 
-         (p=1 => " point list"; " point lists") :: E])
+         x * r  ==
+             zero? r => 0
+             (r = 1) => x
+           --map(r*#1,x)
+             [[u.k,a] for u in x | (a:=u.c*r) ^= 0$R]
 
-\end{chunk}
+       coerce(x) : OutputForm ==
+         null x => (0$R) :: OutputForm
+         le : List OutputForm := nil
+         for rec in reverse x repeat
+           rec.c = 1 => le := cons(rec.k :: OutputForm, le)
+           le := cons(rec.c :: OutputForm *  rec.k :: OutputForm, le)
+         reduce("+",le)
 
-\begin{chunk}{COQ GRIMAGE}
-(* domain GRIMAGE *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{GRIMAGE.dotabb}
-"GRIMAGE" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GRIMAGE"]
-"STRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=STRING"]
-"GRIMAGE" -> "STRING"
+\begin{chunk}{FM.dotabb}
+"FM" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FM"]
+"FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"]
+"FM" -> "FLAGG"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain GOPT GuessOption}
+\section{domain FM1 FreeModule1}
 
-\begin{chunk}{GuessOption.input}
+\begin{chunk}{FreeModule1.input}
 )set break resume
-)sys rm -f GuessOption.output
-)spool GuessOption.output
+)sys rm -f FreeModule1.output
+)spool FreeModule1.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show GuessOption
+)show FreeModule1
 --R 
---R GuessOption  is a domain constructor
---R Abbreviation for GuessOption is GOPT 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for GOPT 
+--R FreeModule1(R: Ring,S: OrderedSet)  is a domain constructor
+--R Abbreviation for FreeModule1 is FM1 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FM1 
 --R
 --R------------------------------- Operations --------------------------------
---R ?=? : (%,%) -> Boolean                allDegrees : Boolean -> %
---R checkExtraValues : Boolean -> %       coerce : % -> OutputForm
---R debug : Boolean -> %                  displayKind : Symbol -> %
---R functionName : Symbol -> %            functionNames : List(Symbol) -> %
---R hash : % -> SingleInteger             indexName : Symbol -> %
---R latex : % -> String                   one : Boolean -> %
---R safety : NonNegativeInteger -> %      variableName : Symbol -> %
+--R ?*? : (S,R) -> %                      ?*? : (R,S) -> %
+--R ?*? : (%,R) -> %                      ?*? : (R,%) -> %
+--R ?*? : (Integer,%) -> %                ?*? : (NonNegativeInteger,%) -> %
+--R ?*? : (PositiveInteger,%) -> %        ?+? : (%,%) -> %
+--R ?-? : (%,%) -> %                      -? : % -> %
+--R ?=? : (%,%) -> Boolean                0 : () -> %
+--R coefficient : (%,S) -> R              coefficients : % -> List(R)
+--R coerce : S -> %                       coerce : % -> OutputForm
+--R hash : % -> SingleInteger             latex : % -> String
+--R leadingCoefficient : % -> R           leadingMonomial : % -> S
+--R map : ((R -> R),%) -> %               monom : (S,R) -> %
+--R monomial? : % -> Boolean              monomials : % -> List(%)
+--R reductum : % -> %                     retract : % -> S
+--R sample : () -> %                      zero? : % -> Boolean
 --R ?~=? : (%,%) -> Boolean              
---R Somos : Union(PositiveInteger,Boolean) -> %
---R check : Union(skip,MonteCarlo,deterministic) -> %
---R homogeneous : Union(PositiveInteger,Boolean) -> %
---R maxDegree : Union(NonNegativeInteger,arbitrary) -> %
---R maxDerivative : Union(NonNegativeInteger,arbitrary) -> %
---R maxLevel : Union(NonNegativeInteger,arbitrary) -> %
---R maxMixedDegree : NonNegativeInteger -> %
---R maxPower : Union(PositiveInteger,arbitrary) -> %
---R maxShift : Union(NonNegativeInteger,arbitrary) -> %
---R maxSubst : Union(PositiveInteger,arbitrary) -> %
---R option : (List(%),Symbol) -> Union(Any,"failed")
+--R leadingTerm : % -> Record(k: S,c: R)
+--R listOfTerms : % -> List(Record(k: S,c: R))
+--R numberOfMonomials : % -> NonNegativeInteger
+--R retractIfCan : % -> Union(S,"failed")
+--R subtractIfCan : (%,%) -> Union(%,"failed")
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{GuessOption.help}
+\begin{chunk}{FreeModule1.help}
 ====================================================================
-GuessOption examples
+FreeModule1 examples
 ====================================================================
 
-GuessOption is a domain whose elements are various options used by Guess.
+This domain implements linear combinations of elements from the domain
+S with coefficients in the domain R where S is an ordered set and R is
+a ring (which may be non-commutative).  This domain is used by domains
+of non-commutative algebra such as: XDistributedPolynomial,
+XRecursivePolynomial.
 
 See Also:
-o )show GuessOption
+o )show FreeModule1
 
 \end{chunk}
 
-\pagehead{GuessOption}{GOPT}
-\pagepic{ps/v103guessoption.ps}{GOPT}{1.00}
+\pagehead{FreeModule1}{FM1}
+\pagepic{ps/v103freemodule1.ps}{FM1}{1.00}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{GOPT}{?=?} &
-\cross{GOPT}{?\~{}=?} &
-\cross{GOPT}{Somos} &
-\cross{GOPT}{allDegrees} &
-\cross{GOPT}{check} \\
-\cross{GOPT}{checkExtraValues} &
-\cross{GOPT}{coerce} &
-\cross{GOPT}{debug} &
-\cross{GOPT}{displayKind} &
-\cross{GOPT}{functionName} \\
-\cross{GOPT}{functionNames} &
-\cross{GOPT}{hash} &
-\cross{GOPT}{homogeneous} &
-\cross{GOPT}{indexName} &
-\cross{GOPT}{latex} \\
-\cross{GOPT}{maxDegree} &
-\cross{GOPT}{maxDerivative} &
-\cross{GOPT}{maxLevel} &
-\cross{GOPT}{maxMixedDegree} &
-\cross{GOPT}{maxPower} \\
-\cross{GOPT}{maxShift} &
-\cross{GOPT}{maxSubst} &
-\cross{GOPT}{one} &
-\cross{GOPT}{option} &
-\cross{GOPT}{safety} 
-\cross{GOPT}{variableName} 
-\end{tabular}
-
-\begin{chunk}{domain GOPT GuessOption}
-)abbrev domain GOPT GuessOption
-++ Author: Martin Rubey
-++ Description:
-++ GuessOption is a domain whose elements are various options used
-++ by Guess.
-GuessOption(): Exports == Implementation where
-
-  Exports == SetCategory with
-
-    maxDerivative: Union(NonNegativeInteger, "arbitrary") -> %
-      ++ maxDerivative(d) specifies the maximum derivative in an algebraic
-      ++ differential equation.  This option is expressed in the form
-      ++ \spad{maxDerivative == d}.
-
-    maxShift: Union(NonNegativeInteger, "arbitrary") -> %
-      ++ maxShift(d) specifies the maximum shift in a recurrence
-      ++ equation.  This option is expressed in the form \spad{maxShift == d}.
-
-    maxSubst: Union(PositiveInteger, "arbitrary") -> %
-      ++ maxSubst(d) specifies the maximum degree of the monomial substituted
-      ++ into the function we are looking for.  That is, if \spad{maxSubst ==
-      ++ d}, we look for polynomials such that $p(f(x), f(x^2), ...,
-      ++ f(x^d))=0$.  equation.  This option is expressed in the form
-      ++ \spad{maxSubst == d}.
+\cross{FM1}{0} &
+\cross{FM1}{coefficient} &
+\cross{FM1}{coefficients} &
+\cross{FM1}{coerce} &
+\cross{FM1}{hash} \\
+\cross{FM1}{latex} &
+\cross{FM1}{leadingCoefficient} &
+\cross{FM1}{leadingMonomial} &
+\cross{FM1}{leadingTerm} &
+\cross{FM1}{listOfTerms} \\
+\cross{FM1}{map} &
+\cross{FM1}{monom} &
+\cross{FM1}{monomial?} &
+\cross{FM1}{monomials} &
+\cross{FM1}{numberOfMonomials} \\
+\cross{FM1}{reductum} &
+\cross{FM1}{retract} &
+\cross{FM1}{retractIfCan} &
+\cross{FM1}{sample} &
+\cross{FM1}{subtractIfCan} \\
+\cross{FM1}{zero?} &
+\cross{FM1}{?\~{}=?} &
+\cross{FM1}{?*?} &
+\cross{FM1}{?+?} &
+\cross{FM1}{?-?} \\
+\cross{FM1}{-?} &
+\cross{FM1}{?=?} &&&
+\end{tabular}
 
-    maxPower: Union(PositiveInteger, "arbitrary") -> %
-      ++ maxPower(d) specifies the maximum degree in an algebraic differential
-      ++ equation. For example, the degree of (f'')^3 f' is 4. maxPower(-1)
-      ++ specifies that the maximum exponent can be arbitrary. This option is
-      ++ expressed in the form \spad{maxPower == d}.
+\begin{chunk}{domain FM1 FreeModule1}
+)abbrev domain FM1 FreeModule1
+++ Author: Michel Petitot petitot@lifl.fr
+++ Date Created: 91
+++ Date Last Updated: 7 Juillet 92
+++ Fix History: compilation v 2.1 le 13 dec 98
+++ Description:
+++ This domain implements linear combinations
+++ of elements from the domain \spad{S} with coefficients
+++ in the domain \spad{R} where \spad{S} is an ordered set
+++ and \spad{R} is a ring (which may be non-commutative).
+++ This domain is used by domains of non-commutative algebra such as:
+++ XDistributedPolynomial, XRecursivePolynomial.
 
-    homogeneous: Union(PositiveInteger, Boolean) -> %
-      ++ homogeneous(d) specifies whether we allow only homogeneous algebraic
-      ++ differential equations.  This option is expressed in the form
-      ++ \spad{homogeneous == d}.  If true, then maxPower must be
-      ++ set, too, and ADEs with constant total degree are allowed.
-      ++ If a PositiveInteger is given, only ADE's with this total degree are
-      ++ allowed.
+FreeModule1(R:Ring,S:OrderedSet): FMcat == FMdef where
+  EX ==> OutputForm
+  TERM ==> Record(k:S,c:R)
 
-    Somos: Union(PositiveInteger, Boolean) -> %
-      ++ Somos(d) specifies whether we want that the total degree of the
-      ++ differential operators is constant, and equal to d, or maxDerivative
-      ++ if true. If true, maxDerivative must be set, too.
+  FMcat == FreeModuleCat(R,S) with
+    "*":(S,R) -> %
+      ++ \spad{s*r} returns the product \spad{r*s}
+      ++ used by \spadtype{XRecursivePolynomial} 
+  FMdef == FreeModule(R,S) add
 
-    maxLevel: Union(NonNegativeInteger, "arbitrary") -> %
-      ++ maxLevel(d) specifies the maximum number of recursion levels operators
-      ++ guessProduct and guessSum will be applied. This option is expressed in
-      ++ the form spad{maxLevel == d}.
+    -- representation
+      Rep := List TERM  
 
-    maxDegree: Union(NonNegativeInteger, "arbitrary") -> %
-      ++ maxDegree(d) specifies the maximum degree of the coefficient
-      ++ polynomials in an algebraic differential equation or a recursion with
-      ++ polynomial coefficients. For rational functions with an exponential
-      ++ term, \spad{maxDegree} bounds the degree of the denominator
-      ++ polynomial.
-      ++ This option is expressed in the form \spad{maxDegree == d}.
+    -- declarations
+      lt: List TERM 
+      x : %
+      r : R
+      s : S
 
-    maxMixedDegree: NonNegativeInteger -> %
-      ++ maxMixedDegree(d) specifies the maximum q-degree of the coefficient
-      ++ polynomials in a recurrence with polynomial coefficients, in the case
-      ++ of mixed shifts.  Although slightly inconsistent, maxMixedDegree(0)
-      ++ specifies that no mixed shifts are allowed. This option is expressed
-      ++ in the form \spad{maxMixedDegree == d}.
+    -- define
+      numberOfMonomials p ==
+         # (p::Rep)
 
-    allDegrees: Boolean -> %
-      ++ allDegrees(d) specifies whether all possibilities of the degree vector
-      ++ - taking into account maxDegree - should be tried. This is mainly
-      ++ interesting for rational interpolation. This option is expressed in
-      ++ the form \spad{allDegrees == d}.
+      listOfTerms(x) == x:List TERM 
 
-    safety: NonNegativeInteger -> %
-      ++ safety(d) specifies the number of values reserved for testing any
-      ++ solutions found. This option is expressed in the form \spad{safety ==
-      ++ d}.
+      leadingTerm x == x.first
 
-    check: Union("skip", "MonteCarlo", "deterministic") -> %
-      ++ check(d) specifies how we want to check the solution.  If
-      ++ the value is "skip", we return the solutions found by the
-      ++ interpolation routine without checking.  If the value is
-      ++ "MonteCarlo", we use a probabilistic check.  This option is
-      ++ expressed in the form \spad{check == d}
+      leadingMonomial x == x.first.k
 
-    checkExtraValues: Boolean -> %
-      ++ checkExtraValues(d) specifies whether we want to check the
-      ++ solution beyond the order given by the degree bounds. This
-      ++ option is expressed in the form \spad{checkExtraValues == d}
+      coefficients x == [t.c for t in x]
 
-    one: Boolean -> %
-      ++ one(d) specifies whether we are happy with one solution. This option
-      ++ is expressed in the form \spad{one == d}.
+      monomials x == [ monom (t.k, t.c) for t in x]
 
-    debug: Boolean -> %
-      ++ debug(d) specifies whether we want additional output on the
-      ++ progress. This option is expressed in the form \spad{debug == d}.
+      retractIfCan x ==
+         numberOfMonomials(x) ^= 1 => "failed"
+         x.first.c = 1 => x.first.k
+         "failed"
 
-    functionName: Symbol -> %
-      ++ functionName(d) specifies the name of the function given by the
-      ++ algebraic differential equation or recurrence. This option is
-      ++ expressed in the form \spad{functionName == d}.
+      coerce(s:S):% == [[s,1$R]]
 
-    functionNames: List(Symbol) -> %
-      ++ functionNames(d) specifies the names for the function in
-      ++ algebraic dependence. This option is
-      ++ expressed in the form \spad{functionNames == d}.
+      retract x ==
+         (rr := retractIfCan x) case "failed" => error "FM1.retract impossible"
+         rr :: S
 
-    variableName: Symbol -> %
-      ++ variableName(d) specifies the variable used in by the algebraic
-      ++ differential equation. This option is expressed in the form
-      ++ \spad{variableName == d}.
+      if R has noZeroDivisors then
 
-    indexName: Symbol -> %
-      ++ indexName(d) specifies the index variable used for the formulas. This
-      ++ option is expressed in the form \spad{indexName == d}.
+         r * x  ==
+             r = 0 => 0
+             [[u.k,r * u.c]$TERM for u in x]
 
-    displayKind: Symbol -> %
-      ++ displayKind(d) specifies kind of the result: generating function,
-      ++ recurrence or equation. This option should not be set by the
-      ++ user, but rather by the HP-specification.
+         x * r  == 
+             r = 0 => 0
+             [[u.k,u.c * r]$TERM for u in x]
 
-    option : (List %, Symbol) -> Union(Any, "failed")
-      ++ option(l, option) returns which options are given.
+       else
 
-  Implementation ==> add
-    import AnyFunctions1(Boolean)
-    import AnyFunctions1(Symbol)
-    import AnyFunctions1(NonNegativeInteger)
-    import AnyFunctions1(Union(NonNegativeInteger, "arbitrary"))
-    import AnyFunctions1(Union(PositiveInteger, "arbitrary"))
-    import AnyFunctions1(Union(PositiveInteger, Boolean))
-    import AnyFunctions1(Union("skip", "MonteCarlo", "deterministic"))
+         r * x  ==
+             r = 0 => 0
+             [[u.k,a] for u in x | not (a:=r*u.c)= 0$R]
 
-    Rep := Record(keyword: Symbol, value: Any)
+         x * r  ==
+             r = 0 => 0
+             [[u.k,a] for u in x | not (a:=u.c*r)= 0$R]
 
-    maxLevel d       == ['maxLevel,       d::Any]
-    maxDerivative d  == ['maxDerivative,  d::Any]
-    maxShift d       == maxDerivative d
-    maxSubst d       ==
-        if d case PositiveInteger
-        then maxDerivative((d::Integer-1)::NonNegativeInteger)
-        else maxDerivative d
-    maxDegree d        == ['maxDegree,        d::Any]
-    maxMixedDegree d   == ['maxMixedDegree,   d::Any]
-    allDegrees d       == ['allDegrees,       d::Any]
-    maxPower d         == ['maxPower,         d::Any]
-    safety d           == ['safety,           d::Any]
-    homogeneous d      == ['homogeneous,      d::Any]
-    Somos d            == ['Somos,            d::Any]
-    debug d            == ['debug,            d::Any]
-    check d            == ['check,            d::Any]
-    checkExtraValues d == ['checkExtraValues, d::Any]
-    one d              == ['one,              d::Any]
-    functionName d     == ['functionName,     d::Any]
-    functionNames d ==
-        ['functionNames, coerce(d)$AnyFunctions1(List(Symbol))]
-    variableName d     == ['variableName,     d::Any]
-    indexName d        == ['indexName,        d::Any]
-    displayKind d      == ['displayKind,      d::Any]
+      r * s ==
+        r = 0 => 0
+        [[s,r]$TERM]
 
-    coerce(x:%):OutputForm == x.keyword::OutputForm = x.value::OutputForm
-    x:% = y:%              == x.keyword = y.keyword and x.value = y.value
+      s * r ==
+        r = 0 => 0
+        [[s,r]$TERM]
 
-    option(l, s) ==
-      for x in l repeat
-        x.keyword = s => return(x.value)
-      "failed"
+      monom(b,r):% == [[b,r]$TERM] 
+
+      outTerm(r:R, s:S):EX ==
+            r=1  => s::EX
+            r::EX * s::EX
+
+      coerce(a:%):EX ==
+            empty? a => (0$R)::EX
+            reduce(_+, reverse_! [outTerm(t.c, t.k) for t in a])$List(EX)
+
+      coefficient(x,s) ==
+         null x => 0$R
+         x.first.k > s => coefficient(rest x,s)
+         x.first.k = s => x.first.c
+         0$R
 
 \end{chunk}
 
-\begin{chunk}{COQ GOPT}
-(* domain GOPT *)
+\begin{chunk}{COQ FM1}
+(* domain FM1 *)
 (*
+ FreeModule(R,S) add
+
+    -- representation
+      Rep := List TERM  
+
+    -- declarations
+      lt: List TERM 
+      x : %
+      r : R
+      s : S
+
+    -- define
+      numberOfMonomials p ==
+         # (p::Rep)
+
+      listOfTerms(x) == x:List TERM 
+
+      leadingTerm x == x.first
+
+      leadingMonomial x == x.first.k
+
+      coefficients x == [t.c for t in x]
+
+      monomials x == [ monom (t.k, t.c) for t in x]
+
+      retractIfCan x ==
+         numberOfMonomials(x) ^= 1 => "failed"
+         x.first.c = 1 => x.first.k
+         "failed"
+
+      coerce(s:S):% == [[s,1$R]]
+
+      retract x ==
+         (rr := retractIfCan x) case "failed" => error "FM1.retract impossible"
+         rr :: S
+
+      if R has noZeroDivisors then
+
+         r * x  ==
+             r = 0 => 0
+             [[u.k,r * u.c]$TERM for u in x]
+
+         x * r  == 
+             r = 0 => 0
+             [[u.k,u.c * r]$TERM for u in x]
+
+       else
+
+         r * x  ==
+             r = 0 => 0
+             [[u.k,a] for u in x | not (a:=r*u.c)= 0$R]
+
+         x * r  ==
+             r = 0 => 0
+             [[u.k,a] for u in x | not (a:=u.c*r)= 0$R]
+
+      r * s ==
+        r = 0 => 0
+        [[s,r]$TERM]
+
+      s * r ==
+        r = 0 => 0
+        [[s,r]$TERM]
+
+      monom(b,r):% == [[b,r]$TERM] 
+
+      outTerm(r:R, s:S):EX ==
+            r=1  => s::EX
+            r::EX * s::EX
+
+      coerce(a:%):EX ==
+            empty? a => (0$R)::EX
+            reduce(_+, reverse_! [outTerm(t.c, t.k) for t in a])$List(EX)
+
+      coefficient(x,s) ==
+         null x => 0$R
+         x.first.k > s => coefficient(rest x,s)
+         x.first.k = s => x.first.c
+         0$R
+
 *)
 
 \end{chunk}
 
-\begin{chunk}{GOPT.dotabb}
-"GOPT" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GOPT"]
-"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
-"GOPT" -> "ALIST"
+\begin{chunk}{FM1.dotabb}
+"FM1" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FM1"]
+"FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"]
+"FM1" -> "FLAGG"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain GOPT0 GuessOptionFunctions0}
+\section{domain FMONOID FreeMonoid}
 
-\begin{chunk}{GuessOptionFunctions0.input}
+\begin{chunk}{FreeMonoid.input}
 )set break resume
-)sys rm -f GuessOptionFunctions0.output
-)spool GuessOptionFunctions0.output
+)sys rm -f FreeMonoid.output
+)spool FreeMonoid.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show GuessOptionFunctions0
+)show FreeMonoid
 --R 
---R GuessOptionFunctions0  is a domain constructor
---R Abbreviation for GuessOptionFunctions0 is GOPT0 
+--R FreeMonoid(S: SetCategory)  is a domain constructor
+--R Abbreviation for FreeMonoid is FMONOID 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for GOPT0 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FMONOID 
 --R
 --R------------------------------- Operations --------------------------------
---R ?=? : (%,%) -> Boolean                coerce : % -> OutputForm
---R debug : List(GuessOption) -> Boolean  hash : % -> SingleInteger
---R latex : % -> String                   one : List(GuessOption) -> Boolean
---R ?~=? : (%,%) -> Boolean              
---R Somos : List(GuessOption) -> Union(PositiveInteger,Boolean)
---R allDegrees : List(GuessOption) -> Boolean
---R check : List(GuessOption) -> Union(skip,MonteCarlo,deterministic)
---R checkExtraValues : List(GuessOption) -> Boolean
---R checkOptions : List(GuessOption) -> Void
---R displayAsGF : List(GuessOption) -> Boolean
---R functionName : List(GuessOption) -> Symbol
---R homogeneous : List(GuessOption) -> Union(PositiveInteger,Boolean)
---R indexName : List(GuessOption) -> Symbol
---R maxDegree : List(GuessOption) -> Union(NonNegativeInteger,arbitrary)
---R maxDerivative : List(GuessOption) -> Union(NonNegativeInteger,arbitrary)
---R maxLevel : List(GuessOption) -> Union(NonNegativeInteger,arbitrary)
---R maxMixedDegree : List(GuessOption) -> NonNegativeInteger
---R maxPower : List(GuessOption) -> Union(PositiveInteger,arbitrary)
---R maxShift : List(GuessOption) -> Union(NonNegativeInteger,arbitrary)
---R maxSubst : List(GuessOption) -> Union(PositiveInteger,arbitrary)
---R safety : List(GuessOption) -> NonNegativeInteger
---R variableName : List(GuessOption) -> Symbol
+--R ?*? : (%,S) -> %                      ?*? : (S,%) -> %
+--R ?*? : (%,%) -> %                      ?**? : (S,NonNegativeInteger) -> %
+--R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
+--R ?=? : (%,%) -> Boolean                1 : () -> %
+--R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
+--R coerce : S -> %                       coerce : % -> OutputForm
+--R hash : % -> SingleInteger             hclf : (%,%) -> %
+--R hcrf : (%,%) -> %                     latex : % -> String
+--R lquo : (%,%) -> Union(%,"failed")     mapGen : ((S -> S),%) -> %
+--R max : (%,%) -> % if S has ORDSET      min : (%,%) -> % if S has ORDSET
+--R nthFactor : (%,Integer) -> S          one? : % -> Boolean
+--R recip : % -> Union(%,"failed")        retract : % -> S
+--R rquo : (%,%) -> Union(%,"failed")     sample : () -> %
+--R size : % -> NonNegativeInteger        ?~=? : (%,%) -> 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 divide : (%,%) -> Union(Record(lm: %,rm: %),"failed")
+--R factors : % -> List(Record(gen: S,exp: NonNegativeInteger))
+--R mapExpon : ((NonNegativeInteger -> NonNegativeInteger),%) -> %
+--R nthExpon : (%,Integer) -> NonNegativeInteger
+--R overlap : (%,%) -> Record(lm: %,mm: %,rm: %)
+--R retractIfCan : % -> Union(S,"failed")
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{GuessOptionFunctions0.help}
+\begin{chunk}{FreeMonoid.help}
 ====================================================================
-GuessOptionFunctions0 examples
+FreeMonoid examples
 ====================================================================
 
-GuessOptionFunctions0 provides operations that extract the
-values of options for Guess.
+Free monoid on any set of generators.  The free monoid on a set S is
+the monoid of finite products of the form reduce(*,[si ** ni]) where
+the si's are in S, and the ni's are nonnegative integers. The
+multiplication is not commutative.
 
 See Also:
-o )show GuessOptionFunctions0
+o )show FreeMonoid
 
 \end{chunk}
-\pagehead{GuessOptionFunctions0}{GOPT0}
-\pagepic{ps/v103guessoptionfunctions0.eps}{GOPT0}{1.00}
+
+\pagehead{FreeMonoid}{FMONOID}
+\pagepic{ps/v103freemonoid.ps}{FMONOID}{1.00}
+{\bf See}\\
+\pageto{ListMonoidOps}{LMOPS}
+\pageto{FreeGroup}{FGROUP}
+\pageto{InnerFreeAbelianMonoid}{IFAMON}
+\pageto{FreeAbelianMonoid}{FAMONOID}
+\pageto{FreeAbelianGroup}{FAGROUP}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{GOPT0}{?=?} &
-\cross{GOPT0}{?\~{}=?} &
-\cross{GOPT0}{MonteCarlo} &
-\cross{GOPT0}{Somos} &
-\cross{GOPT0}{allDegrees} \\
-\cross{GOPT0}{check} &
-\cross{GOPT0}{checkOptions} &
-\cross{GOPT0}{coerce} &
-\cross{GOPT0}{debug} &
-\cross{GOPT0}{displayAsGF} \\
-\cross{GOPT0}{functionName} &
-\cross{GOPT0}{hash} &
-\cross{GOPT0}{homogeneous} &
-\cross{GOPT0}{indexName} &
-\cross{GOPT0}{latex} \\
-\cross{GOPT0}{maxDegree} &
-\cross{GOPT0}{maxDerivative} &
-\cross{GOPT0}{maxLevel} &
-\cross{GOPT0}{maxMixedDegree} &
-\cross{GOPT0}{maxPower} \\
-\cross{GOPT0}{maxShift} &
-\cross{GOPT0}{maxSubst} &
-\cross{GOPT0}{one} &
-\cross{GOPT0}{safety} &
-\cross{GOPT0}{variableName} 
+\cross{FMONOID}{1} &
+\cross{FMONOID}{coerce} &
+\cross{FMONOID}{divide} &
+\cross{FMONOID}{factors} &
+\cross{FMONOID}{hash} \\
+\cross{FMONOID}{hclf} &
+\cross{FMONOID}{hcrf} &
+\cross{FMONOID}{latex} &
+\cross{FMONOID}{lquo} &
+\cross{FMONOID}{mapExpon} \\
+\cross{FMONOID}{mapGen} &
+\cross{FMONOID}{max} &
+\cross{FMONOID}{min} &
+\cross{FMONOID}{nthExpon} &
+\cross{FMONOID}{nthFactor} \\
+\cross{FMONOID}{one?} &
+\cross{FMONOID}{overlap} &
+\cross{FMONOID}{recip} &
+\cross{FMONOID}{rquo} &
+\cross{FMONOID}{retract} \\
+\cross{FMONOID}{retractIfCan} &
+\cross{FMONOID}{sample} &
+\cross{FMONOID}{size} &
+\cross{FMONOID}{?\~{}=?} &
+\cross{FMONOID}{?**?} \\
+\cross{FMONOID}{?$<$?} &
+\cross{FMONOID}{?$<=$?} &
+\cross{FMONOID}{?$>$?} &
+\cross{FMONOID}{?$>=$?} &
+\cross{FMONOID}{?\^{}?} \\
+\cross{FMONOID}{?*?} &
+\cross{FMONOID}{?=?} &&&
 \end{tabular}
 
-\begin{chunk}{domain GOPT0 GuessOptionFunctions0}
-)abbrev domain GOPT0 GuessOptionFunctions0
-++ Author: Martin Rubey
-++ Description: 
-++ GuessOptionFunctions0 provides operations that extract the
-++ values of options for Guess.
-GuessOptionFunctions0(): Exports == Implementation where
-
-  LGOPT ==> List GuessOption
-
-  Exports == SetCategory with
-
-    maxDerivative: LGOPT -> Union(NonNegativeInteger, "arbitrary")
-      ++ maxDerivative returns the specified maxDerivative.
-
-    maxShift: LGOPT -> Union(NonNegativeInteger, "arbitrary")
-      ++ maxShift returns the specified maxShift.
-
-    maxSubst: LGOPT -> Union(PositiveInteger, "arbitrary")
-      ++ maxSubst returns the specified maxSubst.
-
-    maxPower: LGOPT -> Union(PositiveInteger, "arbitrary")
-      ++ maxPower returns the specified maxPower.
-
-    homogeneous: LGOPT -> Union(PositiveInteger, Boolean)
-      ++ homogeneous returns whether we allow only homogeneous algebraic
-      ++ differential equations, default being false
-
-    Somos: LGOPT -> Union(PositiveInteger, Boolean)
-      ++ Somos returns whether we allow only Somos-like operators, default
-      ++ being false
-
-    maxLevel: LGOPT -> Union(NonNegativeInteger, "arbitrary")
-      ++ maxLevel returns the specified maxLevel.
-
-    maxDegree: LGOPT -> Union(NonNegativeInteger, "arbitrary")
-      ++ maxDegree returns the specified maxDegree.
-
-    maxMixedDegree: LGOPT -> NonNegativeInteger
-      ++ maxMixedDegree returns the specified maxMixedDegree.
+\begin{chunk}{domain FMONOID FreeMonoid}
+)abbrev domain FMONOID FreeMonoid
+++ Author: Stephen M. Watt
+++ Date Last Updated: 6 June 1991
+++ Description:
+++ Free monoid on any set of generators
+++ The free monoid on a set S is the monoid of finite products of
+++ the form \spad{reduce(*,[si ** ni])} where the si's are in S, and the ni's
+++ are nonnegative integers. The multiplication is not commutative.
 
-    allDegrees: LGOPT -> Boolean
-      ++ allDegrees returns whether all possibilities of the degree vector
-      ++ should be tried, the default being false.
+FreeMonoid(S: SetCategory): FMcategory == FMdefinition where
+    NNI ==> NonNegativeInteger
+    REC ==> Record(gen: S, exp: NonNegativeInteger)
+    Ex  ==> OutputForm
 
-    safety: LGOPT -> NonNegativeInteger
-      ++ safety returns the specified safety or 1 as default.
+    FMcategory ==> Join(Monoid, RetractableTo S) with
+        "*":    (S, $) -> $
+          ++ s * x returns the product of x by s on the left.
+        "*":    ($, S) -> $
+          ++ x * s returns the product of x by s on the right.
+        "**":   (S, NonNegativeInteger) -> $
+          ++ s ** n returns the product of s by itself n times.
+        hclf:   ($, $) -> $
+          ++ hclf(x, y) returns the highest common left factor of x and y,
+          ++ i.e. the largest d such that \spad{x = d a} and \spad{y = d b}.
+        hcrf:   ($, $) -> $
+          ++ hcrf(x, y) returns the highest common right factor of x and y,
+          ++ i.e. the largest d such that \spad{x = a d} and \spad{y = b d}.
+        lquo:   ($, $) -> Union($, "failed")
+          ++ lquo(x, y) returns the exact left quotient of x by y i.e.
+          ++ q such that \spad{x = y * q},
+          ++ "failed" if x is not of the form \spad{y * q}.
+        rquo:   ($, $) -> Union($, "failed")
+          ++ rquo(x, y) returns the exact right quotient of x by y i.e.
+          ++ q such that \spad{x = q * y},
+          ++ "failed" if x is not of the form \spad{q * y}.
+        divide:   ($, $) -> Union(Record(lm: $, rm: $), "failed")
+          ++ divide(x, y) returns the left and right exact quotients of
+          ++ x by y, i.e. \spad{[l, r]} such that \spad{x = l * y * r},
+          ++ "failed" if x is not of the form \spad{l * y * r}.
+        overlap: ($, $) -> Record(lm: $, mm: $, rm: $)
+          ++ overlap(x, y) returns \spad{[l, m, r]} such that
+          ++ \spad{x = l * m}, \spad{y = m * r} and l and r have no overlap,
+          ++ i.e. \spad{overlap(l, r) = [l, 1, r]}.
+        size         :   $ -> NNI
+          ++ size(x) returns the number of monomials in x.
+        factors      : $ -> List Record(gen: S, exp: NonNegativeInteger)
+          ++ factors(a1\^e1,...,an\^en) returns \spad{[[a1, e1],...,[an, en]]}.
+        nthExpon     : ($, Integer) -> NonNegativeInteger
+          ++ nthExpon(x, n) returns the exponent of the n^th monomial of x.
+        nthFactor    : ($, Integer) -> S
+          ++ nthFactor(x, n) returns the factor of the n^th monomial of x.
+        mapExpon     : (NNI -> NNI, $) -> $
+          ++ mapExpon(f, a1\^e1 ... an\^en) 
+          ++ returns \spad{a1\^f(e1) ... an\^f(en)}.
+        mapGen       : (S -> S, $) -> $
+          ++ mapGen(f, a1\^e1 ... an\^en) returns 
+          ++\spad{f(a1)\^e1 ... f(an)\^en}.
+        if S has OrderedSet then OrderedSet
 
-    check: LGOPT -> Union("skip", "MonteCarlo", "deterministic")
-      ++ check(d) specifies how we want to check the solution.  If
-      ++ the value is "skip", we return the solutions found by the
-      ++ interpolation routine without checking.  If the value is
-      ++ "MonteCarlo", we use a probabilistic check.  The default is
-      ++ "deterministic".
+    FMdefinition ==> ListMonoidOps(S, NonNegativeInteger, 1) add
 
-    checkExtraValues: LGOPT -> Boolean
-      ++ checkExtraValues(d) specifies whether we want to check the
-      ++ solution beyond the order given by the degree bounds.  The
-      ++ default is true.
+        Rep := ListMonoidOps(S, NonNegativeInteger, 1)
 
-    one: LGOPT -> Boolean
-      ++ one returns whether we need only one solution, default being true.
+        1               == makeUnit()
 
-    functionName: LGOPT -> Symbol
-      ++ functionName returns the name of the function given by the algebraic
-      ++ differential equation, default being f
+        one? f          == empty? listOfMonoms f
 
-    variableName: LGOPT -> Symbol
-      ++ variableName returns the name of the variable used in by the
-      ++ algebraic differential equation, default being x
+        coerce(f:$): Ex == outputForm(f, "*", "**", 1)
 
-    indexName: LGOPT -> Symbol
-      ++ indexName returns the name of the index variable used for the
-      ++ formulas, default being n
+        hcrf(f, g)      == reverse_! hclf(reverse f, reverse g)
 
-    displayAsGF: LGOPT -> Boolean
-      ++ displayAsGF specifies whether the result is a generating function
-      ++ or a recurrence. This option should not be set by the user, but rather
-      ++ by the HP-specification, therefore, there is no default.
+        f:$ * s:S       == rightMult(f, s)
 
-    debug: LGOPT -> Boolean
-      ++ debug returns whether we want additional output on the progress,
-      ++ default being false
+        s:S * f:$       == leftMult(s, f)
 
-    checkOptions: LGOPT -> Void
-      ++ checkOptions checks whether the given options are consistent, and
-      ++ yields an error otherwise
+        factors f       == copy listOfMonoms f
 
-  Implementation == add
+        mapExpon(f, x)  == mapExpon(f, x)$Rep
 
-    maxLevel l ==
-      if (opt := option(l, 'maxLevel)) case "failed" then
-        "arbitrary"
-      else
-        retract(opt::Any)$AnyFunctions1(Union(NonNegativeInteger, "arbitrary"))
+        mapGen(f, x)    == mapGen(f, x)$Rep
 
-    maxDerivative l ==
-      if (opt := option(l, 'maxDerivative)) case "failed" then
-        "arbitrary"
-      else
-        retract(opt::Any)$AnyFunctions1(Union(NonNegativeInteger, "arbitrary"))
+        s:S ** n:NonNegativeInteger == makeTerm(s, n)
 
-    maxShift l == maxDerivative l
+        f:$ * g:$ ==
+            (f = 1) => g
+            (g = 1) => f
+            lg := listOfMonoms g
+            ls := last(lf := listOfMonoms f)
+            ls.gen = lg.first.gen =>
+                setlast_!(h := copy lf,[lg.first.gen,lg.first.exp+ls.exp])
+                makeMulti concat(h, rest lg)
+            makeMulti concat(lf, lg)
 
-    maxSubst l ==
-        d := maxDerivative l
-        if d case NonNegativeInteger
-        then (d+1)::PositiveInteger
-        else d
+        overlap(la, ar) ==
+            (la = 1) or (ar = 1) => [la, 1, ar]
+            lla := la0 := listOfMonoms la
+            lar := listOfMonoms ar
+            l:List(REC) := empty()
+            while not empty? lla repeat
+              if lla.first.gen = lar.first.gen then
+                if lla.first.exp < lar.first.exp and empty? rest lla then
+                      return [makeMulti l,
+                               makeTerm(lla.first.gen, lla.first.exp),
+                                 makeMulti concat([lar.first.gen,
+                                  (lar.first.exp - lla.first.exp)::NNI],
+                                                              rest lar)]
+                if lla.first.exp >= lar.first.exp then
+                  if (ru:= lquo(makeMulti rest lar,
+                    makeMulti rest lla)) case $ then
+                      if lla.first.exp > lar.first.exp then
+                        l := concat_!(l, [lla.first.gen,
+                                  (lla.first.exp - lar.first.exp)::NNI])
+                        m := concat([lla.first.gen, lar.first.exp],
+                                                               rest lla)
+                      else m := lla
+                      return [makeMulti l, makeMulti m, ru::$]
+              l  := concat_!(l, lla.first)
+              lla := rest lla
+            [makeMulti la0, 1, makeMulti lar]
 
-    maxDegree l ==
-      if (opt := option(l, 'maxDegree)) case "failed" then
-        "arbitrary"
-      else
-        retract(opt::Any)$AnyFunctions1(Union(NonNegativeInteger, "arbitrary"))
+        divide(lar, a) ==
+            (a = 1) => [lar, 1]
+            Na   : Integer := #(la := listOfMonoms a)
+            Nlar : Integer := #(llar := listOfMonoms lar)
+            l:List(REC) := empty()
+            while Na <= Nlar repeat
+              if llar.first.gen = la.first.gen and
+                 llar.first.exp >= la.first.exp then
+                -- Can match a portion of this lar factor.
+                -- Now match tail.
+                (q:=lquo(makeMulti rest llar,makeMulti rest la))case $ =>
+                   if llar.first.exp > la.first.exp then
+                       l := concat_!(l, [la.first.gen,
+                                  (llar.first.exp - la.first.exp)::NNI])
+                   return [makeMulti l, q::$]
+              l    := concat_!(l, first llar)
+              llar  := rest llar
+              Nlar := Nlar - 1
+            "failed"
 
-    maxMixedDegree l ==
-      if (opt := option(l, 'maxMixedDegree)) case "failed" then
-        0
-      else
-        retract(opt :: Any)$AnyFunctions1(NonNegativeInteger)
+        hclf(f, g) ==
+            h:List(REC) := empty()
+            for f0 in listOfMonoms f for g0 in listOfMonoms g repeat
+                f0.gen ^= g0.gen => return makeMulti h
+                h := concat_!(h, [f0.gen, min(f0.exp, g0.exp)])
+                f0.exp ^= g0.exp => return makeMulti h
+            makeMulti h
 
-    allDegrees l ==
-      if (opt := option(l, 'allDegrees)) case "failed" then
-        false
-      else
-        retract(opt :: Any)$AnyFunctions1(Boolean)
+        lquo(aq, a) ==
+            size a > #(laq := copy listOfMonoms aq) => "failed"
+            for a0 in listOfMonoms a repeat
+                a0.gen ^= laq.first.gen or a0.exp > laq.first.exp =>
+                                                          return "failed"
+                if a0.exp = laq.first.exp then laq := rest laq
+                else setfirst_!(laq, [laq.first.gen,
+                                         (laq.first.exp - a0.exp)::NNI])
+            makeMulti laq
 
-    maxPower l ==
-      if (opt := option(l, 'maxPower)) case "failed" then
-        "arbitrary"
-      else
-        retract(opt :: Any)$AnyFunctions1(Union(PositiveInteger, "arbitrary"))
+        rquo(qa, a) ==
+            (u := lquo(reverse qa, reverse a)) case "failed" => "failed"
+            reverse_!(u::$)
 
-    safety l ==
-      if (opt := option(l, 'safety)) case "failed" then
-        1$NonNegativeInteger
-      else
-        retract(opt :: Any)$AnyFunctions1(NonNegativeInteger)
+        if S has OrderedSet then
+          a < b ==
+            la := listOfMonoms a
+            lb := listOfMonoms b
+            na: Integer := #la
+            nb: Integer := #lb
+            while na > 0 and nb > 0 repeat
+                la.first.gen > lb.first.gen => return false
+                la.first.gen < lb.first.gen => return true
+                if la.first.exp = lb.first.exp then
+                    la:=rest la
+                    lb:=rest lb
+                    na:=na - 1
+                    nb:=nb - 1
+                else if la.first.exp > lb.first.exp then
+                    la:=concat([la.first.gen,
+                           (la.first.exp - lb.first.exp)::NNI], rest lb)
+                    lb:=rest lb
+                    nb:=nb - 1
+                else
+                    lb:=concat([lb.first.gen,
+                             (lb.first.exp-la.first.exp)::NNI], rest la)
+                    la:=rest la
+                    na:=na-1
+            empty? la and not empty? lb
 
-    check l ==
-       if (opt := option(l, 'check)) case "failed" then
-           "deterministic"
-       else
-           retract(opt::Any)$AnyFunctions1(_
-                                 Union("skip", "MonteCarlo", "deterministic"))
+\end{chunk}
 
-    checkExtraValues l ==
-       if (opt := option(l, 'checkExtraValues)) case "failed" then
-           true
-       else
-           retract(opt :: Any)$AnyFunctions1(Boolean)
+\begin{chunk}{COQ FMONOID}
+(* domain FMONOID *)
+(*
 
-    one l ==
-      if (opt := option(l, 'one)) case "failed" then
-        true
-      else
-        retract(opt :: Any)$AnyFunctions1(Boolean)
+        Rep := ListMonoidOps(S, NonNegativeInteger, 1)
 
-    debug l ==
-      if (opt := option(l, 'debug)) case "failed" then
-        false
-      else
-        retract(opt :: Any)$AnyFunctions1(Boolean)
+        1               == makeUnit()
 
-    homogeneous l ==
-      if (opt := option(l, 'homogeneous)) case "failed" then
-        false
-      else
-        retract(opt :: Any)$AnyFunctions1(Union(PositiveInteger, Boolean))
+        one? f          == empty? listOfMonoms f
 
-    Somos l ==
-      if (opt := option(l, 'Somos)) case "failed" then
-        false
-      else
-        retract(opt :: Any)$AnyFunctions1(Union(PositiveInteger, Boolean))
+        coerce(f:$): Ex == outputForm(f, "*", "**", 1)
 
-    variableName l ==
-      if (opt := option(l, 'variableName)) case "failed" then
-        'x
-      else
-        retract(opt :: Any)$AnyFunctions1(Symbol)
+        hcrf(f, g)      == reverse_! hclf(reverse f, reverse g)
 
-    functionName l ==
-      if (opt := option(l, 'functionName)) case "failed" then
-        'f
-      else
-        retract(opt :: Any)$AnyFunctions1(Symbol)
+        f:$ * s:S       == rightMult(f, s)
 
-    indexName l ==
-      if (opt := option(l, 'indexName)) case "failed" then
-        'n
-      else
-        retract(opt :: Any)$AnyFunctions1(Symbol)
+        s:S * f:$       == leftMult(s, f)
 
-    displayAsGF l ==
-      if (opt := option(l, 'displayAsGF)) case "failed" then
-        error "GuessOption: displayAsGF not set"
-      else
-        retract(opt :: Any)$AnyFunctions1(Boolean)
+        factors f       == copy listOfMonoms f
 
-    NNI ==> NonNegativeInteger
-    PI  ==> PositiveInteger
+        mapExpon(f, x)  == mapExpon(f, x)$Rep
 
-    checkOptions l ==
-      maxD := maxDerivative l
-      maxP := maxPower l
-      homo := homogeneous l
-      Somo := Somos l
+        mapGen(f, x)    == mapGen(f, x)$Rep
 
-      if Somo case PI then
-          if one? Somo then
-              error "Guess: Somos must be Boolean or at least two"
+        s:S ** n:NonNegativeInteger == makeTerm(s, n)
 
-          if maxP case PI and one? maxP then
-              error "Guess: Somos requires that maxPower is at least two"
+        f:$ * g:$ ==
+            (f = 1) => g
+            (g = 1) => f
+            lg := listOfMonoms g
+            ls := last(lf := listOfMonoms f)
+            ls.gen = lg.first.gen =>
+                setlast_!(h := copy lf,[lg.first.gen,lg.first.exp+ls.exp])
+                makeMulti concat(h, rest lg)
+            makeMulti concat(lf, lg)
 
-          if maxD case NNI and maxD > Somo then
-              err:String:=concat [_
-                "Guess: if Somos is an integer, it should be larger than ",_
-                "maxDerivative/maxShift or at least as big as maxSubst" ]
-              error err
-      else
-          if Somo then
-              if maxP case PI and one? maxP then
-                  error "Guess: Somos requires that maxPower is at least two"
+        overlap(la, ar) ==
+            (la = 1) or (ar = 1) => [la, 1, ar]
+            lla := la0 := listOfMonoms la
+            lar := listOfMonoms ar
+            l:List(REC) := empty()
+            while not empty? lla repeat
+              if lla.first.gen = lar.first.gen then
+                if lla.first.exp < lar.first.exp and empty? rest lla then
+                      return [makeMulti l,
+                               makeTerm(lla.first.gen, lla.first.exp),
+                                 makeMulti concat([lar.first.gen,
+                                  (lar.first.exp - lla.first.exp)::NNI],
+                                                              rest lar)]
+                if lla.first.exp >= lar.first.exp then
+                  if (ru:= lquo(makeMulti rest lar,
+                    makeMulti rest lla)) case $ then
+                      if lla.first.exp > lar.first.exp then
+                        l := concat_!(l, [lla.first.gen,
+                                  (lla.first.exp - lar.first.exp)::NNI])
+                        m := concat([lla.first.gen, lar.first.exp],
+                                                               rest lla)
+                      else m := lla
+                      return [makeMulti l, makeMulti m, ru::$]
+              l  := concat_!(l, lla.first)
+              lla := rest lla
+            [makeMulti la0, 1, makeMulti lar]
 
-              if not (maxD case NNI) or zero? maxD or one? maxD then
-                  err:String:= concat [_
-                    "Guess: Somos==true requires that maxDerivative/maxShift",_
-                    " is an integer, at least two, or maxSubst is an ",_
-                    "integer, at least three" ]
-                  error err
+        divide(lar, a) ==
+            (a = 1) => [lar, 1]
+            Na   : Integer := #(la := listOfMonoms a)
+            Nlar : Integer := #(llar := listOfMonoms lar)
+            l:List(REC) := empty()
+            while Na <= Nlar repeat
+              if llar.first.gen = la.first.gen and
+                 llar.first.exp >= la.first.exp then
+                -- Can match a portion of this lar factor.
+                -- Now match tail.
+                (q:=lquo(makeMulti rest llar,makeMulti rest la))case $ =>
+                   if llar.first.exp > la.first.exp then
+                       l := concat_!(l, [la.first.gen,
+                                  (llar.first.exp - la.first.exp)::NNI])
+                   return [makeMulti l, q::$]
+              l    := concat_!(l, first llar)
+              llar  := rest llar
+              Nlar := Nlar - 1
+            "failed"
 
-              if not (maxP case PI) and homo case Boolean and not homo then
-                  err:String:= concat [_
-                    "Guess: Somos requires that maxPower is set or ", _
-                    "homogeneous is not false" ]
-                  error err
+        hclf(f, g) ==
+            h:List(REC) := empty()
+            for f0 in listOfMonoms f for g0 in listOfMonoms g repeat
+                f0.gen ^= g0.gen => return makeMulti h
+                h := concat_!(h, [f0.gen, min(f0.exp, g0.exp)])
+                f0.exp ^= g0.exp => return makeMulti h
+            makeMulti h
 
-      if homo case PI then
-          if maxP case PI and maxP ~= homo then
-              err:String:= _
-                "Guess: only one of homogeneous and maxPower may be an integer"
-              error err
+        lquo(aq, a) ==
+            size a > #(laq := copy listOfMonoms aq) => "failed"
+            for a0 in listOfMonoms a repeat
+                a0.gen ^= laq.first.gen or a0.exp > laq.first.exp =>
+                                                          return "failed"
+                if a0.exp = laq.first.exp then laq := rest laq
+                else setfirst_!(laq, [laq.first.gen,
+                                         (laq.first.exp - a0.exp)::NNI])
+            makeMulti laq
 
-          if maxD case NNI and zero? maxD then
-              err:String:= concat [_
-                "Guess: homogeneous requires that maxShift/maxDerivative ",_
-                "is at least one or maxSubst is at least two" ]
-              error err
-      else
-          if homo then
-              if not maxP case PI then
-                  err:String:= concat [_
-                    "Guess: homogeneous==true requires that maxPower is ", _
-                    "an integer" ]
-                  error err
+        rquo(qa, a) ==
+            (u := lquo(reverse qa, reverse a)) case "failed" => "failed"
+            reverse_!(u::$)
 
-              if maxD case NNI and zero? maxD then
-                  err:String:= concat [_
-                    "Guess: homogeneous requires that maxShift/maxDerivative",_
-                    " is at least one or maxSubst is at least two" ]
-                  error err
-\end{chunk}
+        if S has OrderedSet then
+          a < b ==
+            la := listOfMonoms a
+            lb := listOfMonoms b
+            na: Integer := #la
+            nb: Integer := #lb
+            while na > 0 and nb > 0 repeat
+                la.first.gen > lb.first.gen => return false
+                la.first.gen < lb.first.gen => return true
+                if la.first.exp = lb.first.exp then
+                    la:=rest la
+                    lb:=rest lb
+                    na:=na - 1
+                    nb:=nb - 1
+                else if la.first.exp > lb.first.exp then
+                    la:=concat([la.first.gen,
+                           (la.first.exp - lb.first.exp)::NNI], rest lb)
+                    lb:=rest lb
+                    nb:=nb - 1
+                else
+                    lb:=concat([lb.first.gen,
+                             (lb.first.exp-la.first.exp)::NNI], rest la)
+                    la:=rest la
+                    na:=na-1
+            empty? la and not empty? lb
 
-\begin{chunk}{COQ GOPT0}
-(* domain GOPT0 *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{GOPT0.dotabb}
-"GOPT0" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GOPT0"]
-"STRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=STRING"]
-"GOPT0" -> "STRING"
+\begin{chunk}{FMONOID.dotabb}
+"FMONOID" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FMONOID"]
+"FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"]
+"FLAGG-" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FLAGG"]
+"FMONOID" -> "FLAGG-"
+"FMONOID" -> "FLAGG"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\chapter{Chapter H}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain HASHTBL HashTable}
+\section{domain FNLA FreeNilpotentLie}
 
-\begin{chunk}{HashTable.input}
+\begin{chunk}{FreeNilpotentLie.input}
 )set break resume
-)sys rm -f HashTable.output
-)spool HashTable.output
+)sys rm -f FreeNilpotentLie.output
+)spool FreeNilpotentLie.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show HashTable
+)show FreeNilpotentLie
 --R 
---R HashTable(Key: SetCategory,Entry: SetCategory,hashfn: String)  is a domain constructor
---R Abbreviation for HashTable is HASHTBL 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for HASHTBL 
+--R FreeNilpotentLie(n: NonNegativeInteger,class: NonNegativeInteger,R: CommutativeRing)  is a domain constructor
+--R Abbreviation for FreeNilpotentLie is FNLA 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FNLA 
 --R
 --R------------------------------- Operations --------------------------------
---R copy : % -> %                         dictionary : () -> %
---R elt : (%,Key,Entry) -> Entry          ?.? : (%,Key) -> Entry
---R empty : () -> %                       empty? : % -> Boolean
---R entries : % -> List(Entry)            eq? : (%,%) -> Boolean
---R index? : (Key,%) -> Boolean           indices : % -> List(Key)
---R key? : (Key,%) -> Boolean             keys : % -> List(Key)
---R map : ((Entry -> Entry),%) -> %       qelt : (%,Key) -> Entry
---R sample : () -> %                      setelt : (%,Key,Entry) -> Entry
---R table : () -> %                      
---R #? : % -> NonNegativeInteger if $ has finiteAggregate
---R ?=? : (%,%) -> Boolean if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
---R any? : ((Entry -> Boolean),%) -> Boolean if $ has finiteAggregate
---R any? : ((Record(key: Key,entry: Entry) -> Boolean),%) -> Boolean if $ has finiteAggregate
---R bag : List(Record(key: Key,entry: Entry)) -> %
---R coerce : % -> OutputForm if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
---R construct : List(Record(key: Key,entry: Entry)) -> %
---R convert : % -> InputForm if Record(key: Key,entry: Entry) has KONVERT(INFORM)
---R count : ((Entry -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R count : (Entry,%) -> NonNegativeInteger if $ has finiteAggregate and Entry has SETCAT
---R count : (Record(key: Key,entry: Entry),%) -> NonNegativeInteger if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
---R count : ((Record(key: Key,entry: Entry) -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R dictionary : List(Record(key: Key,entry: Entry)) -> %
---R entry? : (Entry,%) -> Boolean if $ has finiteAggregate and Entry has SETCAT
---R eval : (%,List(Equation(Entry))) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
---R eval : (%,Equation(Entry)) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
---R eval : (%,Entry,Entry) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
---R eval : (%,List(Entry),List(Entry)) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
---R eval : (%,List(Record(key: Key,entry: Entry)),List(Record(key: Key,entry: Entry))) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
---R eval : (%,Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
---R eval : (%,Equation(Record(key: Key,entry: Entry))) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
---R eval : (%,List(Equation(Record(key: Key,entry: Entry)))) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
---R every? : ((Entry -> Boolean),%) -> Boolean if $ has finiteAggregate
---R every? : ((Record(key: Key,entry: Entry) -> Boolean),%) -> Boolean if $ has finiteAggregate
---R extract! : % -> Record(key: Key,entry: Entry)
---R fill! : (%,Entry) -> % if $ has shallowlyMutable
---R find : ((Record(key: Key,entry: Entry) -> Boolean),%) -> Union(Record(key: Key,entry: Entry),"failed")
---R first : % -> Entry if Key has ORDSET
---R hash : % -> SingleInteger if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
---R insert! : (Record(key: Key,entry: Entry),%) -> %
---R inspect : % -> Record(key: Key,entry: Entry)
---R latex : % -> String if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
---R less? : (%,NonNegativeInteger) -> Boolean
---R map : (((Entry,Entry) -> Entry),%,%) -> %
---R map : ((Record(key: Key,entry: Entry) -> Record(key: Key,entry: Entry)),%) -> %
---R map! : ((Entry -> Entry),%) -> % if $ has shallowlyMutable
---R map! : ((Record(key: Key,entry: Entry) -> Record(key: Key,entry: Entry)),%) -> % if $ has shallowlyMutable
---R maxIndex : % -> Key if Key has ORDSET
---R member? : (Entry,%) -> Boolean if $ has finiteAggregate and Entry has SETCAT
---R member? : (Record(key: Key,entry: Entry),%) -> Boolean if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
---R members : % -> List(Entry) if $ has finiteAggregate
---R members : % -> List(Record(key: Key,entry: Entry)) if $ has finiteAggregate
---R minIndex : % -> Key if Key has ORDSET
---R more? : (%,NonNegativeInteger) -> Boolean
---R parts : % -> List(Entry) if $ has finiteAggregate
---R parts : % -> List(Record(key: Key,entry: Entry)) if $ has finiteAggregate
---R qsetelt! : (%,Key,Entry) -> Entry if $ has shallowlyMutable
---R reduce : (((Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry)),%) -> Record(key: Key,entry: Entry) if $ has finiteAggregate
---R reduce : (((Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry)),%,Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry) if $ has finiteAggregate
---R reduce : (((Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry)),%,Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry) if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
---R remove : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
---R remove : (Record(key: Key,entry: Entry),%) -> % if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
---R remove! : (Key,%) -> Union(Entry,"failed")
---R remove! : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
---R remove! : (Record(key: Key,entry: Entry),%) -> % if $ has finiteAggregate
---R removeDuplicates : % -> % if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
---R search : (Key,%) -> Union(Entry,"failed")
---R select : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
---R select! : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
---R size? : (%,NonNegativeInteger) -> Boolean
---R swap! : (%,Key,Key) -> Void if $ has shallowlyMutable
---R table : List(Record(key: Key,entry: Entry)) -> %
---R ?~=? : (%,%) -> Boolean if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
+--R ?*? : (R,%) -> %                      ?*? : (%,R) -> %
+--R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
+--R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
+--R ?**? : (%,PositiveInteger) -> %       ?+? : (%,%) -> %
+--R ?-? : (%,%) -> %                      -? : % -> %
+--R ?=? : (%,%) -> Boolean                0 : () -> %
+--R antiCommutator : (%,%) -> %           associator : (%,%,%) -> %
+--R coerce : % -> OutputForm              commutator : (%,%) -> %
+--R deepExpand : % -> OutputForm          dimension : () -> NonNegativeInteger
+--R generator : NonNegativeInteger -> %   hash : % -> SingleInteger
+--R latex : % -> String                   sample : () -> %
+--R shallowExpand : % -> OutputForm       zero? : % -> Boolean
+--R ?~=? : (%,%) -> Boolean              
+--R leftPower : (%,PositiveInteger) -> %
+--R plenaryPower : (%,PositiveInteger) -> %
+--R rightPower : (%,PositiveInteger) -> %
+--R subtractIfCan : (%,%) -> Union(%,"failed")
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{HashTable.help}
+\begin{chunk}{FreeNilpotentLie.help}
 ====================================================================
-HashTable examples
+FreeNilpotentLie examples
 ====================================================================
 
-This domain provides access to the underlying Lisp hash tables.
-By varying the hashfn parameter, tables suited for different 
-purposes can be obtained.
+Generate the Free Lie Algebra over a ring R with identity;
+A P. Hall basis is generated by a package call to HallBasis.
 
 See Also:
-o )show HashTable
+o )show FreeNilpotentLie
 
 \end{chunk}
 
-\pagehead{HashTable}{HASHTBL}
-\pagepic{ps/v103hashtable.ps}{HASHTBL}{1.00}
+\pagehead{FreeNilpotentLie}{FNLA}
+\pagepic{ps/v103freenilpotentlie.ps}{FNLA}{1.00}
 {\bf See}\\
-\pageto{InnerTable}{INTABL}
-\pageto{Table}{TABLE}
-\pageto{EqTable}{EQTBL}
-\pageto{StringTable}{STRTBL}
-\pageto{GeneralSparseTable}{GSTBL}
-\pageto{SparseTable}{STBL}
+\pageto{OrdSetInts}{OSI}
+\pageto{Commutator}{COMM}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{HASHTBL}{any?} &
-\cross{HASHTBL}{bag} &
-\cross{HASHTBL}{coerce} &
-\cross{HASHTBL}{construct} &
-\cross{HASHTBL}{convert} \\
-\cross{HASHTBL}{copy} &
-\cross{HASHTBL}{count} &
-\cross{HASHTBL}{dictionary} &
-\cross{HASHTBL}{entry?} &
-\cross{HASHTBL}{elt} \\
-\cross{HASHTBL}{empty} &
-\cross{HASHTBL}{empty?} &
-\cross{HASHTBL}{entries} &
-\cross{HASHTBL}{eq?} &
-\cross{HASHTBL}{eval} \\
-\cross{HASHTBL}{every?} &
-\cross{HASHTBL}{extract!} &
-\cross{HASHTBL}{fill!} &
-\cross{HASHTBL}{find} &
-\cross{HASHTBL}{first} \\
-\cross{HASHTBL}{hash} &
-\cross{HASHTBL}{index?} &
-\cross{HASHTBL}{indices} &
-\cross{HASHTBL}{insert!} &
-\cross{HASHTBL}{inspect} \\
-\cross{HASHTBL}{key?} &
-\cross{HASHTBL}{keys} &
-\cross{HASHTBL}{latex} &
-\cross{HASHTBL}{less?} &
-\cross{HASHTBL}{map} \\
-\cross{HASHTBL}{map!} &
-\cross{HASHTBL}{maxIndex} &
-\cross{HASHTBL}{member?} &
-\cross{HASHTBL}{members} &
-\cross{HASHTBL}{minIndex} \\
-\cross{HASHTBL}{more?} &
-\cross{HASHTBL}{parts} &
-\cross{HASHTBL}{qelt} &
-\cross{HASHTBL}{qsetelt!} &
-\cross{HASHTBL}{reduce} \\
-\cross{HASHTBL}{remove} &
-\cross{HASHTBL}{remove!} &
-\cross{HASHTBL}{removeDuplicates} &
-\cross{HASHTBL}{sample} &
-\cross{HASHTBL}{search} \\
-\cross{HASHTBL}{select} &
-\cross{HASHTBL}{select!} &
-\cross{HASHTBL}{setelt} &
-\cross{HASHTBL}{size?} &
-\cross{HASHTBL}{swap!} \\
-\cross{HASHTBL}{table} &
-\cross{HASHTBL}{\#{}?} &
-\cross{HASHTBL}{?=?} &
-\cross{HASHTBL}{?\~{}=?} &
-\cross{HASHTBL}{?.?} 
+\cross{FNLA}{0} &
+\cross{FNLA}{antiCommutator} &
+\cross{FNLA}{associator} &
+\cross{FNLA}{coerce} &
+\cross{FNLA}{commutator} \\
+\cross{FNLA}{deepExpand} &
+\cross{FNLA}{dimension} &
+\cross{FNLA}{generator} &
+\cross{FNLA}{hash} &
+\cross{FNLA}{latex} \\
+\cross{FNLA}{leftPower} &
+\cross{FNLA}{plenaryPower} &
+\cross{FNLA}{rightPower} &
+\cross{FNLA}{sample} &
+\cross{FNLA}{shallowExpand} \\
+\cross{FNLA}{subtractIfCan} &
+\cross{FNLA}{zero?} &
+\cross{FNLA}{?\~{}=?} &
+\cross{FNLA}{?*?} &
+\cross{FNLA}{?**?} \\
+\cross{FNLA}{?+?} &
+\cross{FNLA}{?-?} &
+\cross{FNLA}{-?} &
+\cross{FNLA}{?=?} &
 \end{tabular}
 
-\begin{chunk}{domain HASHTBL HashTable}
-)abbrev domain HASHTBL HashTable
-++ Author: Stephen M. Watt
-++ Date Created: 1985
-++ Date Last Updated: June 21, 1991
+\begin{chunk}{domain FNLA FreeNilpotentLie}
+)abbrev domain FNLA FreeNilpotentLie
+++ Author: Larry Lambe
+++ Date Created: July 1988
+++ Date Last Updated: March 13 1991
 ++ Description:
-++ This domain provides access to the underlying Lisp hash tables.
-++ By varying the hashfn parameter, tables suited for different 
-++ purposes can be obtained.
+++ Generate the Free Lie Algebra over a ring R with identity;
+++ A P. Hall basis is generated by a package call to HallBasis.
 
-HashTable(Key, Entry, hashfn): Exports == Implementation where
-    Key, Entry: SetCategory
-    hashfn: String --  Union("EQ", "UEQUAL", "CVEC", "ID")
+FreeNilpotentLie(n:NNI,class:NNI,R: CommutativeRing): Export == Implement where
+   B   ==> Boolean
+   Com ==> Commutator
+   HB  ==> HallBasis
+   I   ==> Integer
+   NNI ==> NonNegativeInteger
+   O   ==> OutputForm
+   OSI ==> OrdSetInts
+   FM  ==> FreeModule(R,OSI)
+   VI  ==> Vector Integer
+   VLI ==> Vector List Integer
+   lC  ==> leadingCoefficient
+   lS  ==> leadingSupport
 
-    Exports ==> TableAggregate(Key, Entry) with
-                     finiteAggregate
+   Export ==> NonAssociativeAlgebra(R) with
+     dimension : () -> NNI
+       ++ dimension() is the rank of this Lie algebra
+     deepExpand    : %   -> O
+       ++ deepExpand(x) is not documented
+     shallowExpand    : %   -> O
+       ++ shallowExpand(x) is not documented
+     generator : NNI -> %
+       ++ generator(i) is the ith Hall Basis element
 
-    Implementation ==> add
-        Pair ==> Record(key: Key, entry: Entry)
-        Ex   ==> OutputForm
-        failMsg := GENSYM()$Lisp
+   Implement ==> FM add
+     Rep := FM
+     f,g : %
 
-        t1 = t2              == EQ(t1, t2)$Lisp
-        keys t               == HKEYS(t)$Lisp
-        # t                  == HASH_-TABLE_-COUNT(t)$Lisp
-        setelt(t, k, e)      == HPUT(t,k,e)$Lisp
-        remove_!(k:Key, t:%) ==
-          r := HGET(t,k,failMsg)$Lisp
-          not EQ(r,failMsg)$Lisp =>
-            HREM(t, k)$Lisp
-            r pretend Entry
-          "failed"
+     coms:VLI
+     coms := generate(n,class)$HB
 
-        empty() ==
-            MAKE_-HASHTABLE(INTERN(hashfn)$Lisp,
-                            INTERN("STRONG")$Lisp)$Lisp
+     dimension == #coms
 
-        search(k:Key, t:%)  ==
-            r := HGET(t, k, failMsg)$Lisp
-            not EQ(r, failMsg)$Lisp => r pretend Entry
-            "failed"
+       -- have(left,right) is a lookup function for basic commutators
+       -- already generated; if the nth basic commutator is
+       -- [left,wt,right], then have(left,right) = n
+     have : (I,I) -> %
+     have(i,j) ==
+        wt:I := coms(i).2 + coms(j).2
+        wt > class => 0
+        lo:I := 1
+        hi:I := dimension
+        while hi-lo > 1 repeat
+          mid:I := (hi+lo) quo 2
+          if coms(mid).2 < wt then lo := mid else hi := mid
+        while coms(hi).1 < i repeat hi := hi + 1
+        while coms(hi).3 < j repeat hi := hi + 1
+        monomial(1,hi::OSI)$FM
+
+     generator(i) ==
+       i > dimension => 0$Rep
+       monomial(1,i::OSI)$FM
+
+     putIn : I -> %
+     putIn(i) ==
+       monomial(1$R,i::OSI)$FM
+
+     brkt : (I,%) -> %
+     brkt(k,f) ==
+       f = 0 => 0
+       dg:I := value lS f
+       reductum(f) = 0 =>
+         k = dg  => 0
+         k > dg  => -lC(f)*brkt(dg, putIn(k))
+         inHallBasis?(n,k,dg,coms(dg).1) => lC(f)*have(k, dg)
+         lC(f)*( brkt(coms(dg).1, _
+          brkt(k,putIn coms(dg).3)) - brkt(coms(dg).3, _
+           brkt(k,putIn coms(dg).1) ))
+       brkt(k,monomial(lC f,lS f)$FM)+brkt(k,reductum f)
+
+     f*g ==
+       reductum(f) = 0 =>
+         lC(f)*brkt(value(lS f),g)
+       monomial(lC f,lS f)$FM*g + reductum(f)*g
+
+       -- an auxilliary function used for output of Free Lie algebra
+       -- elements (see expand)
+     Fac : I -> Com
+     Fac(m) ==
+       coms(m).1 = 0 => mkcomm(m)$Com
+       mkcomm(Fac coms(m).1, Fac coms(m).3)
+
+     shallowE : (R,OSI) -> O
+     shallowE(r,s) ==
+       k := value s
+       r = 1 =>
+         k <= n => s::O
+         mkcomm(mkcomm(coms(k).1)$Com,mkcomm(coms(k).3)$Com)$Com::O
+       k <= n => r::O * s::O
+       r::O * mkcomm(mkcomm(coms(k).1)$Com,mkcomm(coms(k).3)$Com)$Com::O
+
+     shallowExpand(f) ==
+       f = 0           => 0::O
+       reductum(f) = 0 => shallowE(lC f,lS f)
+       shallowE(lC f,lS f) + shallowExpand(reductum f)
+
+     deepExpand(f) ==
+       f = 0          => 0::O
+       reductum(f) = 0 =>
+         lC(f)=1 => Fac(value(lS f))::O
+         lC(f)::O * Fac(value(lS f))::O
+       lC(f)=1 => Fac(value(lS f))::O + deepExpand(reductum f)
+       lC(f)::O * Fac(value(lS f))::O + deepExpand(reductum f)
 
 \end{chunk}
 
-\begin{chunk}{COQ HASHTBL}
-(* domain HASHTBL *)
+\begin{chunk}{COQ FNLA}
+(* domain FNLA *)
 (*
+ FM add
+     Rep := FM
+     f,g : %
+
+     coms:VLI
+     coms := generate(n,class)$HB
+
+     dimension == #coms
+
+       -- have(left,right) is a lookup function for basic commutators
+       -- already generated; if the nth basic commutator is
+       -- [left,wt,right], then have(left,right) = n
+     have : (I,I) -> %
+     have(i,j) ==
+        wt:I := coms(i).2 + coms(j).2
+        wt > class => 0
+        lo:I := 1
+        hi:I := dimension
+        while hi-lo > 1 repeat
+          mid:I := (hi+lo) quo 2
+          if coms(mid).2 < wt then lo := mid else hi := mid
+        while coms(hi).1 < i repeat hi := hi + 1
+        while coms(hi).3 < j repeat hi := hi + 1
+        monomial(1,hi::OSI)$FM
+
+     generator(i) ==
+       i > dimension => 0$Rep
+       monomial(1,i::OSI)$FM
+
+     putIn : I -> %
+     putIn(i) ==
+       monomial(1$R,i::OSI)$FM
+
+     brkt : (I,%) -> %
+     brkt(k,f) ==
+       f = 0 => 0
+       dg:I := value lS f
+       reductum(f) = 0 =>
+         k = dg  => 0
+         k > dg  => -lC(f)*brkt(dg, putIn(k))
+         inHallBasis?(n,k,dg,coms(dg).1) => lC(f)*have(k, dg)
+         lC(f)*( brkt(coms(dg).1, _
+          brkt(k,putIn coms(dg).3)) - brkt(coms(dg).3, _
+           brkt(k,putIn coms(dg).1) ))
+       brkt(k,monomial(lC f,lS f)$FM)+brkt(k,reductum f)
+
+     f*g ==
+       reductum(f) = 0 =>
+         lC(f)*brkt(value(lS f),g)
+       monomial(lC f,lS f)$FM*g + reductum(f)*g
+
+       -- an auxilliary function used for output of Free Lie algebra
+       -- elements (see expand)
+     Fac : I -> Com
+     Fac(m) ==
+       coms(m).1 = 0 => mkcomm(m)$Com
+       mkcomm(Fac coms(m).1, Fac coms(m).3)
+
+     shallowE : (R,OSI) -> O
+     shallowE(r,s) ==
+       k := value s
+       r = 1 =>
+         k <= n => s::O
+         mkcomm(mkcomm(coms(k).1)$Com,mkcomm(coms(k).3)$Com)$Com::O
+       k <= n => r::O * s::O
+       r::O * mkcomm(mkcomm(coms(k).1)$Com,mkcomm(coms(k).3)$Com)$Com::O
+
+     shallowExpand(f) ==
+       f = 0           => 0::O
+       reductum(f) = 0 => shallowE(lC f,lS f)
+       shallowE(lC f,lS f) + shallowExpand(reductum f)
+
+     deepExpand(f) ==
+       f = 0          => 0::O
+       reductum(f) = 0 =>
+         lC(f)=1 => Fac(value(lS f))::O
+         lC(f)::O * Fac(value(lS f))::O
+       lC(f)=1 => Fac(value(lS f))::O + deepExpand(reductum f)
+       lC(f)::O * Fac(value(lS f))::O + deepExpand(reductum f)
+
 *)
 
 \end{chunk}
 
-\begin{chunk}{HASHTBL.dotabb}
-"HASHTBL" [color="#88FF44",href="bookvol10.3.pdf#nameddest=HASHTBL"]
-"TBAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=TBAGG"]
-"HASHTBL" -> "TBAGG"
+\begin{chunk}{FNLA.dotabb}
+"FNLA" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FNLA"]
+"IVECTOR" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IVECTOR"]
+"FNLA" -> "IVECTOR"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain HEAP Heap}
+\section{domain FPARFRAC FullPartialFractionExpansion}
 
-\begin{chunk}{Heap.input}
+\begin{chunk}{FullPartialFractionExpansion.input}
 )set break resume
-)sys rm -f Heap.output
-)spool Heap.output
+)sys rm -f FullPartialFractionExpansion.output
+)spool FullPartialFractionExpansion.output
 )set message test on
 )set message auto off
 )clear all
 
---S 1 of 42
-a:Heap INT:= heap [1,2,3,4,5]
+--S 1 of 17
+Fx := FRAC UP(x, FRAC INT)
 --R 
 --R
---R   (1)  [5,4,2,1,3]
---R                                                          Type: Heap(Integer)
+--R   (1)  Fraction(UnivariatePolynomial(x,Fraction(Integer)))
+--R                                                                 Type: Domain
 --E 1
 
---S 2 of 42
-bag([1,2,3,4,5])$Heap(INT)
+--S 2 of 17
+f : Fx := 36 / (x**5-2*x**4-2*x**3+4*x**2+x-2) 
 --R 
 --R
---R   (2)  [5,4,3,1,2]
---R                                                          Type: Heap(Integer)
+--R                     36
+--R   (2)  ----------------------------
+--R         5     4     3     2
+--R        x  - 2x  - 2x  + 4x  + x - 2
+--R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
 --E 2
 
---S 3 of 42
-c:=copy a
+--S 3 of 17
+g := fullPartialFraction f 
 --R 
 --R
---R   (3)  [5,4,2,1,3]
---R                                                          Type: Heap(Integer)
+--R          4       4        --+      - 3%A - 6
+--R   (3)  ----- - ----- +    >        ---------
+--R        x - 2   x + 1      --+              2
+--R                          2         (x - %A)
+--R                        %A  - 1= 0
+--RType: FullPartialFractionExpansion(Fraction(Integer),UnivariatePolynomial(x,Fraction(Integer)))
 --E 3
 
---S 4 of 42
-empty? a
+--S 4 of 17
+g :: Fx
 --R 
 --R
---R   (4)  false
---R                                                                Type: Boolean
+--R                     36
+--R   (4)  ----------------------------
+--R         5     4     3     2
+--R        x  - 2x  - 2x  + 4x  + x - 2
+--R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
 --E 4
 
---S 5 of 42
-b:=empty()$(Heap INT)
+--S 5 of 17
+g5 := D(g, 5)
 --R 
 --R
---R   (5)  []
---R                                                          Type: Heap(Integer)
+--R             480        480        --+      2160%A + 4320
+--R   (5)  - -------- + -------- +    >        -------------
+--R                 6          6      --+                7
+--R          (x - 2)    (x + 1)      2           (x - %A)
+--R                                %A  - 1= 0
+--RType: FullPartialFractionExpansion(Fraction(Integer),UnivariatePolynomial(x,Fraction(Integer)))
 --E 5
 
---S 6 of 42
-empty? b
+--S 6 of 17
+f5 := D(f, 5)
 --R 
 --R
---R   (6)  true
---R                                                                Type: Boolean
+--R   (6)
+--R                10           9            8            7            6
+--R       - 544320x   + 4354560x  - 14696640x  + 28615680x  - 40085280x
+--R     + 
+--R                5            4            3           2
+--R       46656000x  - 39411360x  + 18247680x  - 5870880x  + 3317760x + 246240
+--R  /
+--R        20      19      18      17       16       15       14        13
+--R       x   - 12x   + 53x   - 76x   - 159x   + 676x   - 391x   - 1596x
+--R     + 
+--R            12        11        10        9        8        7        6        5
+--R       2527x   + 1148x   - 4977x   + 1372x  + 4907x  - 3444x  - 2381x  + 2924x
+--R     + 
+--R           4        3       2
+--R       276x  - 1184x  + 208x  + 192x - 64
+--R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
 --E 6
 
---S 7 of 42
-eq?(a,c)
+--S 7 of 17
+g5::Fx - f5
 --R 
 --R
---R   (7)  false
---R                                                                Type: Boolean
+--R   (7)  0
+--R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
 --E 7
 
---S 8 of 42
-extract! a
---R 
---R
---R   (8)  5
---R                                                        Type: PositiveInteger
---E 8
-
---S 8 of 42
-h:=heap [17,-4,9,-11,2,7,-7]
+--S 8 of 17
+f : Fx := (x**5 * (x-1)) / ((x**2 + x + 1)**2 * (x-2)**3)
 --R 
 --R
---R   (9)  [17,2,9,- 11,- 4,7,- 7]
---R                                                          Type: Heap(Integer)
+--R                       6    5
+--R                      x  - x
+--R   (8)  -----------------------------------
+--R         7     6     5     3     2
+--R        x  - 4x  + 3x  + 9x  - 6x  - 4x - 8
+--R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
 --E 8
 
---S 9 of 42
-[extract!(h) while not empty?(h)]
+--S 9 of 17
+g := fullPartialFraction f 
 --R 
 --R
---R   (10)  [17,9,7,2,- 4,- 7,- 11]
---R                                                          Type: List(Integer)
+--R   (9)
+--R      1952       464        32                          179       135
+--R      ----       ---        --                       - ---- %A + ----
+--R      2401       343        49            --+          2401      2401
+--R     ------ + -------- + -------- +       >          ----------------
+--R      x - 2          2          3         --+             x - %A
+--R              (x - 2)    (x - 2)      2
+--R                                    %A  + %A + 1= 0
+--R   + 
+--R                       37        20
+--R                      ---- %A + ----
+--R           --+        1029      1029
+--R           >          --------------
+--R           --+                   2
+--R       2                 (x - %A)
+--R     %A  + %A + 1= 0
+--RType: FullPartialFractionExpansion(Fraction(Integer),UnivariatePolynomial(x,Fraction(Integer)))
 --E 9
 
---S 10 of 42
-heapsort(x) == (empty? x => []; cons(extract!(x),heapsort x))
+--S 10 of 17
+g :: Fx - f
 --R 
---R                                                                   Type: Void
+--R
+--R   (10)  0
+--R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
 --E 10
 
---S 11 of 42
-h1 := heapsort heap [17,-4,9,-11,2,7,-7]
+--S 11 of 17
+f : Fx := (2*x**7-7*x**5+26*x**3+8*x) / (x**8-5*x**6+6*x**4+4*x**2-8) 
 --R 
---R   Compiling function heapsort with type Heap(Integer) -> List(Integer)
---R      
 --R
---R   (12)  [17,9,7,2,- 4,- 7,- 11]
---R                                                          Type: List(Integer)
+--R             7     5      3
+--R           2x  - 7x  + 26x  + 8x
+--R   (11)  ------------------------
+--R          8     6     4     2
+--R         x  - 5x  + 6x  + 4x  - 8
+--R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
 --E 11
 
---S 12 of 42
-(a=c)@Boolean
+--S 12 of 17
+g := fullPartialFraction f
 --R 
 --R
---R   (13)  false
---R                                                                Type: Boolean
+--R                        1                                            1
+--R                        -                                            -
+--R            --+         2        --+          1          --+         2
+--R   (12)     >        ------ +    >        --------- +    >        ------
+--R            --+      x - %A      --+              3      --+      x - %A
+--R           2                    2         (x - %A)      2
+--R         %A  - 2= 0           %A  - 2= 0              %A  + 1= 0
+--RType: FullPartialFractionExpansion(Fraction(Integer),UnivariatePolynomial(x,Fraction(Integer)))
 --E 12
 
---S 13 of 42
-(a~=c)
+--S 13 of 17
+g :: Fx - f 
 --R 
 --R
---R   (14)  true
---R                                                                Type: Boolean
+--R   (13)  0
+--R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
 --E 13
 
---S 14 of 42
-a
+--S 14 of 17
+f:Fx := x**3 / (x**21 + 2*x**20 + 4*x**19 + 7*x**18 + 10*x**17 + 17*x**16 + 22*x**15 + 30*x**14 + 36*x**13 + 40*x**12 + 47*x**11 + 46*x**10 + 49*x**9 + 43*x**8 + 38*x**7 + 32*x**6 + 23*x**5 + 19*x**4 + 10*x**3 + 7*x**2 + 2*x + 1)
 --R 
 --R
---R   (15)  [4,3,2,1]
---R                                                          Type: Heap(Integer)
+--R   (14)
+--R      3
+--R     x
+--R  /
+--R        21     20     19     18      17      16      15      14      13      12
+--R       x   + 2x   + 4x   + 7x   + 10x   + 17x   + 22x   + 30x   + 36x   + 40x
+--R     + 
+--R          11      10      9      8      7      6      5      4      3     2
+--R       47x   + 46x   + 49x  + 43x  + 38x  + 32x  + 23x  + 19x  + 10x  + 7x  + 2x
+--R     + 
+--R       1
+--R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
 --E 14
 
---S 15 of 42
-inspect a
+--S 15 of 17
+g := fullPartialFraction f 
 --R 
 --R
---R   (16)  4
---R                                                        Type: PositiveInteger
+--R   (15)
+--R                  1                        1      19
+--R                  - %A                     - %A - --
+--R        --+       2             --+        9      27
+--R        >        ------ +       >          ---------
+--R        --+      x - %A         --+          x - %A
+--R       2                    2
+--R     %A  + 1= 0           %A  + %A + 1= 0
+--R   + 
+--R                       1       1
+--R                      -- %A - --
+--R           --+        27      27
+--R           >          ----------
+--R           --+                 2
+--R       2               (x - %A)
+--R     %A  + %A + 1= 0
+--R   + 
+--R     SIGMA
+--R          5     2
+--R        %A  + %A  + 1= 0
+--R    ,
+--R               96556567040   4   420961732891   3    59101056149   2
+--R            - ------------ %A  + ------------ %A  - ------------ %A
+--R              912390759099       912390759099       912390759099
+--R          + 
+--R              373545875923      529673492498
+--R            - ------------ %A + ------------
+--R              912390759099      912390759099
+--R       /
+--R          x - %A
+--R   + 
+--R     SIGMA
+--R          5     2
+--R        %A  + %A  + 1= 0
+--R    ,
+--R           5580868   4    2024443   3    4321919   2    84614        5070620
+--R        - -------- %A  - -------- %A  + -------- %A  - ------- %A - --------
+--R          94070601       94070601       94070601       1542141      94070601
+--R        --------------------------------------------------------------------
+--R                                              2
+--R                                      (x - %A)
+--R   + 
+--R     SIGMA
+--R          5     2
+--R        %A  + %A  + 1= 0
+--R    ,
+--R         1610957   4    2763014   3    2016775   2    266953        4529359
+--R        -------- %A  + -------- %A  - -------- %A  + -------- %A + --------
+--R        94070601       94070601       94070601       94070601      94070601
+--R        -------------------------------------------------------------------
+--R                                             3
+--R                                     (x - %A)
+--RType: FullPartialFractionExpansion(Fraction(Integer),UnivariatePolynomial(x,Fraction(Integer)))
 --E 15
 
---S 16 of 42
-insert!(9,a)
+--S 16 of 17
+g :: Fx - f
 --R 
 --R
---R   (17)  [9,4,2,1,3]
---R                                                          Type: Heap(Integer)
+--R   (16)  0
+--R                    Type: Fraction(UnivariatePolynomial(x,Fraction(Integer)))
 --E 16
 
---S 17 of 42
-map(x+->x+10,a)
---R 
---R
---R   (18)  [19,14,12,11,13]
---R                                                          Type: Heap(Integer)
---E 17
-
---S 18 of 42
-a
---R 
---R
---R   (19)  [9,4,2,1,3]
---R                                                          Type: Heap(Integer)
---E 18
-
---S 19 of 42
-map!(x+->x+10,a)
---R 
---R
---R   (20)  [19,14,12,11,13]
---R                                                          Type: Heap(Integer)
---E 19
-
---S 20 of 42
-a
---R 
---R
---R   (21)  [19,14,12,11,13]
---R                                                          Type: Heap(Integer)
---E 20
-
---S 21 of 42
-max a
---R 
---R
---R   (22)  19
---R                                                        Type: PositiveInteger
---E 21
-
---S 22 of 42
-merge(a,c)
---R 
---R
---R   (23)  [19,14,12,11,13,5,4,2,1,3]
---R                                                          Type: Heap(Integer)
---E 22
-
---S 23 of 42
-a
---R 
---R
---R   (24)  [19,14,12,11,13]
---R                                                          Type: Heap(Integer)
---E 23
-
---S 24 of 42
-merge!(a,c)
---R 
---R
---R   (25)  [19,14,12,11,13,5,4,2,1,3]
---R                                                          Type: Heap(Integer)
---E 24
-
---S 25 of 42
-a
---R 
---R
---R   (26)  [19,14,12,11,13,5,4,2,1,3]
---R                                                          Type: Heap(Integer)
---E 25
-
---S 26 of 42
-c
---R 
---R
---R   (27)  [5,4,2,1,3]
---R                                                          Type: Heap(Integer)
---E 26
-
---S 27 of 42
-sample()$Heap(INT)
---R 
---R
---R   (28)  []
---R                                                          Type: Heap(Integer)
---E 27
-
---S 28 of 42
-#a
---R 
---R
---R   (29)  10
---R                                                        Type: PositiveInteger
---E 28
-
---S 29 of 42
-any?(x+->(x=14),a)
---R 
---R
---R   (30)  true
---R                                                                Type: Boolean
---E 29
-
---S 30 of 42
-every?(x+->(x=11),a)
---R 
---R
---R   (31)  false
---R                                                                Type: Boolean
---E 30
-
---S 31 of 42
-parts a
---R 
---R
---R   (32)  [19,14,12,11,13,5,4,2,1,3]
---R                                                          Type: List(Integer)
---E 31
-
---S 32 of 42
-size?(a,9)
---R 
---R
---R   (33)  false
---R                                                                Type: Boolean
---E 32
-
---S 33 of 42
-more?(a,9)
---R 
---R
---R   (34)  true
---R                                                                Type: Boolean
---E 33
-
---S 34 of 42
-less?(a,9)
---R 
---R
---R   (35)  false
---R                                                                Type: Boolean
---E 34
-
---S 35 of 42
-members a
---R 
---R
---R   (36)  [19,14,12,11,13,5,4,2,1,3]
---R                                                          Type: List(Integer)
---E 35
-
---S 36 of 42
-member?(14,a)
---R 
---R
---R   (37)  true
---R                                                                Type: Boolean
---E 36
-
---S 37 of 42
-latex a
---R 
---R
---R   (38)  "\mbox{\bf Unimplemented}"
---R                                                                 Type: String
---E 37
-
---S 38 of 42
-hash a
---R 
---R
---I   (39)  36647017
---R                                                          Type: SingleInteger
---E 38
-
---S 39 of 42
-count(14,a)
---R 
---R
---R   (40)  1
---R                                                        Type: PositiveInteger
---E 39
-
---S 40 of 42
-count(x+->(x>13),a)
---R 
---R
---R   (41)  2
---R                                                        Type: PositiveInteger
---E 40
-
---S 41 of 42
-coerce a
---R 
---R
---R   (42)  [19,14,12,11,13,5,4,2,1,3]
---R                                                             Type: OutputForm
---E 41
-
---S 42 of 42
-)show Heap
+--S 17 of 17
+)show FullPartialFractionExpansion
 --R 
---R Heap(S: OrderedSet)  is a domain constructor
---R Abbreviation for Heap is HEAP 
+--R FullPartialFractionExpansion(F: Join(Field,CharacteristicZero),UP: UnivariatePolynomialCategory(F))  is a domain constructor
+--R Abbreviation for FullPartialFractionExpansion is FPARFRAC 
 --R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for HEAP 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FPARFRAC 
 --R
 --R------------------------------- Operations --------------------------------
---R bag : List(S) -> %                    copy : % -> %
---R empty : () -> %                       empty? : % -> Boolean
---R eq? : (%,%) -> Boolean                extract! : % -> S
---R heap : List(S) -> %                   insert! : (S,%) -> %
---R inspect : % -> S                      latex : % -> String if S has SETCAT
---R map : ((S -> S),%) -> %               max : % -> S
---R merge : (%,%) -> %                    merge! : (%,%) -> %
---R sample : () -> %                     
---R #? : % -> NonNegativeInteger if $ has finiteAggregate
---R ?=? : (%,%) -> Boolean if S has SETCAT
---R any? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
---R coerce : % -> OutputForm if S has SETCAT
---R count : (S,%) -> NonNegativeInteger if $ has finiteAggregate and S has SETCAT
---R count : ((S -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R eval : (%,List(S),List(S)) -> % if S has EVALAB(S) and S has SETCAT
---R eval : (%,S,S) -> % if S has EVALAB(S) and S has SETCAT
---R eval : (%,Equation(S)) -> % if S has EVALAB(S) and S has SETCAT
---R eval : (%,List(Equation(S))) -> % if S has EVALAB(S) and S has SETCAT
---R every? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
---R hash : % -> SingleInteger if S has SETCAT
---R less? : (%,NonNegativeInteger) -> Boolean
---R map! : ((S -> S),%) -> % if $ has shallowlyMutable
---R member? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
---R members : % -> List(S) if $ has finiteAggregate
---R more? : (%,NonNegativeInteger) -> Boolean
---R parts : % -> List(S) if $ has finiteAggregate
---R size? : (%,NonNegativeInteger) -> Boolean
---R ?~=? : (%,%) -> Boolean if S has SETCAT
+--R ?+? : (UP,%) -> %                     ?=? : (%,%) -> Boolean
+--R D : (%,NonNegativeInteger) -> %       D : % -> %
+--R coerce : % -> OutputForm              convert : % -> Fraction(UP)
+--R differentiate : % -> %                hash : % -> SingleInteger
+--R latex : % -> String                   polyPart : % -> UP
+--R ?~=? : (%,%) -> Boolean              
+--R construct : List(Record(exponent: NonNegativeInteger,center: UP,num: UP)) -> %
+--R differentiate : (%,NonNegativeInteger) -> %
+--R fracPart : % -> List(Record(exponent: NonNegativeInteger,center: UP,num: UP))
+--R fullPartialFraction : Fraction(UP) -> %
 --R
---E 42
+--E 17
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{Heap.help}
+\begin{chunk}{FullPartialFractionExpansion.help}
 ====================================================================
-Heap examples
+FullPartialFractionExpansion expansion
 ====================================================================
 
-The domain Heap(S) implements a priority queue of objects of type S
-such that the operation extract! removes and returns the maximum
-element.  The implementation represents heaps as flexible arrays The
-representation and algorithms give complexity of O(log(n)) for
-insertion and extractions, and O(n) for construction.
-
-Create a heap of five elements:
-
-   a:Heap INT:= heap [1,2,3,4,5]
-        [5,4,2,1,3]
-
-Use bag to convert a Bag into a Heap:
-
-   bag([1,2,3,4,5])$Heap(INT)
-        [5,4,3,1,2]
-
-The operation copy can be used to copy a Heap:
+The domain FullPartialFractionExpansion implements factor-free
+conversion of quotients to full partial fractions.
 
-   c:=copy a
-        [5,4,2,1,3]
+Our examples will all involve quotients of univariate polynomials
+with rational number coefficients.
 
-Use empty? to check if the heap is empty:
+  Fx := FRAC UP(x, FRAC INT)
+    Fraction UnivariatePolynomial(x,Fraction Integer)
+                    Type: Domain
 
-   empty? a
-        false
+Here is a simple-looking rational function.
 
-Use empty to create a new, empty heap:
- 
-   b:=empty()$(Heap INT)
-        []
+  f : Fx := 36 / (x**5-2*x**4-2*x**3+4*x**2+x-2) 
+                 36
+    ----------------------------
+     5     4     3     2
+    x  - 2x  - 2x  + 4x  + x - 2
+                    Type: Fraction UnivariatePolynomial(x,Fraction Integer)
 
-and we can see that the newly created heap is empty:
+We use fullPartialFraction to convert it to an object of type
+FullPartialFractionExpansion.
 
-   empty? b
-        true
+  g := fullPartialFraction f 
+      4       4        --+      - 3%A - 6
+    ----- - ----- +    >        ---------
+    x - 2   x + 1      --+              2
+                      2         (x - %A)
+                    %A  - 1= 0
+Type: FullPartialFractionExpansion(Fraction Integer,
+                                   UnivariatePolynomial(x,Fraction Integer))
 
-The eq? function compares the reference of one heap to another:
+Use a coercion to change it back into a quotient.
 
-   eq?(a,c)
-        false
+  g :: Fx
+                 36
+    ----------------------------
+     5     4     3     2
+    x  - 2x  - 2x  + 4x  + x - 2
+                  Type: Fraction UnivariatePolynomial(x,Fraction Integer)
 
-The extract! function removes largest element of the heap:
+Full partial fractions differentiate faster than rational functions.
 
-   extract! a
-        5
+  g5 := D(g, 5)
+         480        480        --+      2160%A + 4320
+    - -------- + -------- +    >        -------------
+             6          6      --+                7
+      (x - 2)    (x + 1)      2           (x - %A)
+                            %A  - 1= 0
+Type: FullPartialFractionExpansion(Fraction Integer,
+                                   UnivariatePolynomial(x,Fraction Integer))
 
-Now extract! elements repeatedly until none are left, collecting
-the elements in a list.
+  f5 := D(f, 5)
+                10           9            8            7            6
+       - 544320x   + 4354560x  - 14696640x  + 28615680x  - 40085280x
+     + 
+                5            4            3           2
+       46656000x  - 39411360x  + 18247680x  - 5870880x  + 3317760x + 246240
+  /
+        20      19      18      17       16       15       14        13
+       x   - 12x   + 53x   - 76x   - 159x   + 676x   - 391x   - 1596x
+     + 
+            12        11        10        9        8        7        6        5
+       2527x   + 1148x   - 4977x   + 1372x  + 4907x  - 3444x  - 2381x  + 2924x
+     + 
+           4        3       2
+       276x  - 1184x  + 208x  + 192x - 64
+                      Type: Fraction UnivariatePolynomial(x,Fraction Integer)
 
-  [extract!(h) while not empty?(h)]
-    [9,7,3,2,- 4,- 7]
-                      Type: List Integer
+We can check that the two forms represent the same function.
 
-Another way to produce the same result is by defining a heapsort function.
+  g5::Fx - f5
+    0
+                      Type: Fraction UnivariatePolynomial(x,Fraction Integer)
 
-  heapsort(x) == (empty? x => []; cons(extract!(x),heapsort x))
-                      Type: Void
+Here are some examples that are more complicated.
 
-Create another sample heap.
+  f : Fx := (x**5 * (x-1)) / ((x**2 + x + 1)**2 * (x-2)**3)
+                   6    5
+                  x  - x
+    -----------------------------------
+     7     6     5     3     2
+    x  - 4x  + 3x  + 9x  - 6x  - 4x - 8
+                      Type: Fraction UnivariatePolynomial(x,Fraction Integer)
 
-  h1 := heap [17,-4,9,-11,2,7,-7]
-    [17,2,9,- 11,- 4,7,- 7]
-                      Type: Heap Integer
+  g := fullPartialFraction f 
+      1952       464        32                          179       135
+      ----       ---        --                       - ---- %A + ----
+      2401       343        49            --+          2401      2401
+     ------ + -------- + -------- +       >          ----------------
+      x - 2          2          3         --+             x - %A
+              (x - 2)    (x - 2)      2
+                                    %A  + %A + 1= 0
+   + 
+                       37        20
+                      ---- %A + ----
+           --+        1029      1029
+           >          --------------
+           --+                   2
+       2                 (x - %A)
+     %A  + %A + 1= 0
+Type: FullPartialFractionExpansion(Fraction Integer,
+                                   UnivariatePolynomial(x,Fraction Integer))
 
-Apply heapsort to present elements in order.
+  g :: Fx - f
+    0
+                      Type: Fraction UnivariatePolynomial(x,Fraction Integer)
 
-  heapsort h1
-    [17,9,7,2,- 4,- 7,- 11]
-                      Type: List Integer
+  f : Fx := (2*x**7-7*x**5+26*x**3+8*x) / (x**8-5*x**6+6*x**4+4*x**2-8) 
+        7     5      3
+      2x  - 7x  + 26x  + 8x
+    ------------------------
+     8     6     4     2
+    x  - 5x  + 6x  + 4x  - 8
+                      Type: Fraction UnivariatePolynomial(x,Fraction Integer)
 
-Heaps can be compared with =
+  g := fullPartialFraction f
+                   1                                            1
+                   -                                            -
+       --+         2        --+          1          --+         2
+       >        ------ +    >        --------- +    >        ------
+       --+      x - %A      --+              3      --+      x - %A
+      2                    2         (x - %A)      2
+    %A  - 2= 0           %A  - 2= 0              %A  + 1= 0
+Type: FullPartialFractionExpansion(Fraction Integer,
+                                   UnivariatePolynomial(x,Fraction Integer))
 
-   (a=c)@Boolean
-        false
+  g :: Fx - f 
+    0
+                     Type: Fraction UnivariatePolynomial(x,Fraction Integer)
 
-and ~=
+  f:Fx := x**3 / (x**21 + 2*x**20 + 4*x**19 + 7*x**18 + 10*x**17 + 17*x**16 + 22*x**15 + 30*x**14 + 36*x**13 + 40*x**12 + 47*x**11 + 46*x**10 + 49*x**9 + 43*x**8 + 38*x**7 + 32*x**6 + 23*x**5 + 19*x**4 + 10*x**3 + 7*x**2 + 2*x + 1)
+      3
+     x
+  /
+        21     20     19     18      17      16      15      14      13      12
+       x   + 2x   + 4x   + 7x   + 10x   + 17x   + 22x   + 30x   + 36x   + 40x
+     + 
+          11      10      9      8      7      6      5      4      3     2
+      47x   + 46x   + 49x  + 43x  + 38x  + 32x  + 23x  + 19x  + 10x  + 7x  + 2x
+     + 
+       1
+                      Type: Fraction UnivariatePolynomial(x,Fraction Integer)
 
-   (a~=c)
-       true
+  g := fullPartialFraction f 
+                  1                        1      19
+                  - %A                     - %A - --
+        --+       2             --+        9      27
+        >        ------ +       >          ---------
+        --+      x - %A         --+          x - %A
+       2                    2
+     %A  + 1= 0           %A  + %A + 1= 0
+   + 
+                       1       1
+                      -- %A - --
+           --+        27      27
+           >          ----------
+           --+                 2
+       2               (x - %A)
+     %A  + %A + 1= 0
+   + 
+     SIGMA
+          5     2
+        %A  + %A  + 1= 0
+    ,
+               96556567040   4   420961732891   3    59101056149   2
+            - ------------ %A  + ------------ %A  - ------------ %A
+              912390759099       912390759099       912390759099
+          + 
+              373545875923      529673492498
+            - ------------ %A + ------------
+              912390759099      912390759099
+       /
+          x - %A
+   + 
+     SIGMA
+          5     2
+        %A  + %A  + 1= 0
+    ,
+           5580868   4    2024443   3    4321919   2    84614        5070620
+        - -------- %A  - -------- %A  + -------- %A  - ------- %A - --------
+          94070601       94070601       94070601       1542141      94070601
+        --------------------------------------------------------------------
+                                              2
+                                      (x - %A)
+   + 
+     SIGMA
+          5     2
+        %A  + %A  + 1= 0
+    ,
+         1610957   4    2763014   3    2016775   2    266953        4529359
+        -------- %A  + -------- %A  - -------- %A  + -------- %A + --------
+        94070601       94070601       94070601       94070601      94070601
+        -------------------------------------------------------------------
+                                             3
+                                     (x - %A)
+Type: FullPartialFractionExpansion(Fraction Integer,UnivariatePolynomial(x,Fraction Integer))
 
-The inspect function shows the largest element in the heap:
+This verification takes much longer than the conversion to partial fractions.
 
-   inspect a
-       4
+  g :: Fx - f
+    0
+                      Type: Fraction UnivariatePolynomial(x,Fraction Integer)
 
-The insert! function adds an element to the heap:
+Use PartialFraction for standard partial fraction decompositions.
 
-   insert!(9,a)
-       [9,4,2,1,3]
+For more information, see the paper: Bronstein, M and Salvy, B.
+"Full Partial Fraction Decomposition of Rational Functions,"
+Proceedings of ISSAC'93, Kiev, ACM Press.  
 
-The map function applies a function to every element of the heap
-and returns a new heap:
+See Also:
+o )help PartialFraction
+o )show FullPartialFractionExpansion
 
-   map(x+->x+10,a)
-       [19,14,12,11,13]
+\end{chunk}
+\pagehead{FullPartialFractionExpansion}{FPARFRAC}
+\pagepic{ps/v103fullpartialfractionexpansion.ps}{FPARFRAC}{1.00}
 
-The original heap is unchanged:
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{FPARFRAC}{coerce} &
+\cross{FPARFRAC}{construct} &
+\cross{FPARFRAC}{convert} &
+\cross{FPARFRAC}{D} &
+\cross{FPARFRAC}{differentiate} \\
+\cross{FPARFRAC}{hash} &
+\cross{FPARFRAC}{latex} &
+\cross{FPARFRAC}{polyPart} &
+\cross{FPARFRAC}{fracPart} &
+\cross{FPARFRAC}{fullPartialFraction} \\
+\cross{FPARFRAC}{?\~{}=?} &
+\cross{FPARFRAC}{?+?} &
+\cross{FPARFRAC}{?=?} &&
+\end{tabular}
 
-   a
-       [9,4,2,1,3]
+\begin{chunk}{domain FPARFRAC FullPartialFractionExpansion}
+)abbrev domain FPARFRAC FullPartialFractionExpansion
+++ Author: Manuel Bronstein
+++ Date Created: 9 December 1992
+++ Date Last Updated: 6 October 1993
+++ References: M.Bronstein & B.Salvy,
+++             Full Partial Fraction Decomposition of Rational Functions,
+++             in Proceedings of ISSAC'93, Kiev, ACM Press.
+++ Description:
+++ Full partial fraction expansion of rational functions
 
-The map! function applies a function to every element of the heap
-and returns the original heap with modifications:
+FullPartialFractionExpansion(F, UP): Exports == Implementation where
+  F  : Join(Field, CharacteristicZero)
+  UP : UnivariatePolynomialCategory F
 
-   map!(x+->x+10,a)
-       [19,14,12,11,13]
+  N   ==> NonNegativeInteger
+  Q   ==> Fraction Integer
+  O   ==> OutputForm
+  RF  ==> Fraction UP
+  SUP ==> SparseUnivariatePolynomial RF
+  REC ==> Record(exponent: N, center: UP, num: UP)
+  ODV ==> OrderlyDifferentialVariable Symbol
+  ODP ==> OrderlyDifferentialPolynomial UP
+  ODF ==> Fraction ODP
+  FPF ==> Record(polyPart: UP, fracPart: List REC)
 
-The original heap has been modified:
+  Exports ==> Join(SetCategory, ConvertibleTo RF)  with
+    "+":                 (UP, $) -> $
+      ++ p + x returns the sum of p and x
+    fullPartialFraction: RF -> $
+      ++ fullPartialFraction(f) returns \spad{[p, [[j, Dj, Hj]...]]} such that
+      ++ \spad{f = p(x) + sum_{[j,Dj,Hj] in l} sum_{Dj(a)=0} Hj(a)/(x - a)\^j}.
+    polyPart:            $ -> UP
+      ++ polyPart(f) returns the polynomial part of f.
+    fracPart:            $  -> List REC
+      ++ fracPart(f) returns the list of summands of the fractional part of f.
+    construct:           List REC -> $
+      ++ construct(l) is the inverse of fracPart.
+    differentiate:       $ -> $
+      ++ differentiate(f) returns the derivative of f.
+    D:                    $ -> $
+      ++ D(f) returns the derivative of f.
+    differentiate:       ($, N) -> $
+      ++ differentiate(f, n) returns the n-th derivative of f.
+    D: ($, NonNegativeInteger) -> $
+      ++ D(f, n) returns the n-th derivative of f.
 
-   a
-       [19,14,12,11,13]
+  Implementation ==> add
 
-The max function returns the largest element in the heap:
+    Rep := FPF
 
-   max a
-       19
+    fullParFrac: (UP, UP, UP, N) -> List REC
+    outputexp  : (O, N) -> O
+    output     : (N, UP, UP) -> O
+    REC2RF     : (UP, UP, N) -> RF
+    UP2SUP     : UP -> SUP
+    diffrec    : REC -> REC
+    FP2O       : List REC -> O
 
-The merge function takes two heaps and creates a new heap with
-all of the elements:
+-- create a differential variable
+    u  := new()$Symbol
 
-   merge(a,c)
-       [19,14,12,11,13,5,4,2,1,3]
+    u0 := makeVariable(u, 0)$ODV
 
-Notice that the original heap is unchanged:
+    alpha := u::O
 
-   a
-       [19,14,12,11,13]
+    x  := monomial(1, 1)$UP
 
-The merge! function takes two heaps and modifies the first heap
-argument to contain all of the elements:
+    xx := x::O
 
-   merge!(a,c)
-       [19,14,12,11,13,5,4,2,1,3]
+    zr := (0$N)::O
 
-Notice that the first argument was modified:
+    construct l     == [0, l]
 
-   a
-       [19,14,12,11,13,5,4,2,1,3]
+    D r             == differentiate r
 
-but the second argument was not:
+    D(r, n)         == differentiate(r,n)
 
-   c
-       [5,4,2,1,3]
+    polyPart f      == f.polyPart
 
-A new, empty heap can be created with sample:
+    fracPart f      == f.fracPart
 
-   sample()$Heap(INT)
-       []
+    p:UP + f:$      == [p + polyPart f, fracPart f]
 
-The # function gives the size of the heap:
+    differentiate f ==
+      differentiate(polyPart f) + construct [diffrec rec for rec in fracPart f]
 
-   #a
-       10 
+    differentiate(r, n) ==
+      for i in 1..n repeat r := differentiate r
+      r
 
-The any? function tests each element against a predicate function
-and returns true if any pass:
+    diffrec rec ==
+      e := rec.exponent
+      [e + 1, rec.center, - e * rec.num]
 
-   any?(x+->(x=14),a)
-       true
+    convert(f:$):RF ==
+      ans := polyPart(f)::RF
+      for rec in fracPart f repeat
+        ans := ans + REC2RF(rec.center, rec.num, rec.exponent)
+      ans
 
-The every? function tests each element against a predicate function
-and returns true if they all pass:
+    UP2SUP p == map((z1:F):RF +-> z1::UP::RF, p)_
+        $UnivariatePolynomialCategoryFunctions2(F, UP, RF, SUP)
 
-   every?(x+->(x=11),a)
-       false
+    -- returns Trace_k^k(a) (h(a) / (x - a)^n)  where d(a) = 0
+    REC2RF(d, h, n) ==
+      ((m := degree d) = 1) =>
+        a   := - (leadingCoefficient reductum d) / (leadingCoefficient d)
+        h(a)::UP / (x - a::UP)**n
+      dd  := UP2SUP d
+      hh  := UP2SUP h
+      aa  := monomial(1, 1)$SUP
+      p   := (x::RF::SUP - aa)**n rem dd
+      rec := extendedEuclidean(p, dd, hh)::Record(coef1:SUP, coef2:SUP)
+      t   := rec.coef1     -- we want Trace_k^k(a)(t) now
+      ans := coefficient(t, 0)
+      for i in 1..degree(d)-1 repeat
+        t   := (t * aa) rem dd
+        ans := ans + coefficient(t, i)
+      ans
 
-The parts function returns a list of the elements in the heap:
+    fullPartialFraction f ==
+      qr := divide(numer f, d := denom f)
+      qr.quotient + construct concat
+                     [fullParFrac(qr.remainder, d, rec.factor, rec.exponent::N)
+                                         for rec in factors squareFree denom f]
 
-   parts a
-       [19,14,12,11,13,5,4,2,1,3]
+    fullParFrac(a, d, q, n) ==
+      ans:List REC := empty()
+      em := e := d quo (q ** n)
+      rec := extendedEuclidean(e, q, 1)::Record(coef1:UP,coef2:UP)
+      bm := b := rec.coef1                  -- b = inverse of e modulo q
+      lvar:List(ODV) := [u0]
+      um := 1::ODP
+      un := (u1 := u0::ODP)**n
+      lval:List(UP)  := [q1 := q := differentiate(q0 := q)]
+      h:ODF := a::ODP / (e * un)
+      rec := extendedEuclidean(q1, q0, 1)::Record(coef1:UP,coef2:UP)
+      c := rec.coef1                        -- c = inverse of q' modulo q
+      cm := 1::UP
+      cn  := (c ** n) rem q0
+      for m in 1..n repeat
+        p    := retract(em * un * um * h)@ODP
+        pp   := retract(eval(p, lvar, lval))@UP
+        h    := inv(m::Q) * differentiate h
+        q    := differentiate q
+        lvar := concat(makeVariable(u, m), lvar)
+        lval := concat(inv((m+1)::F) * q, lval)
+        qq   := q0 quo gcd(pp, q0)                    -- new center
+        if (degree(qq) > 0) then
+          ans  := concat([(n + 1 - m)::N, qq, (pp * bm * cn * cm) rem qq], ans)
+        cm   := (c * cm) rem q0     -- cm = c**m modulo q now
+        um   := u1 * um             -- um = u**m now
+        em   := e * em              -- em = e**{m+1} now
+        bm   := (b * bm) rem q0     -- bm = b**{m+1} modulo q now
+      ans
 
-The size? predicate compares the size of the heap to a value:
+    coerce(f:$):O ==
+      ans := FP2O(l := fracPart f)
+      zero?(p := polyPart f) =>
+        empty? l => (0$N)::O
+        ans
+      p::O + ans
 
-   size?(a,9)
-       false
+    FP2O l ==
+      empty? l => empty()
+      rec := first l
+      ans := output(rec.exponent, rec.center, rec.num)
+      for rec in rest l repeat
+        ans := ans + output(rec.exponent, rec.center, rec.num)
+      ans
 
-The more? predicate asks if the heap size is larger than a value:
+    output(n, d, h) ==
+      (degree d) = 1 =>
+        a := - leadingCoefficient(reductum d) / leadingCoefficient(d)
+        h(a)::O / outputexp((x - a::UP)::O, n)
+      sum(outputForm(makeSUP h, alpha) / outputexp(xx - alpha, n),
+          outputForm(makeSUP d, alpha) = zr)
 
-   more?(a,9)
-       true
+    outputexp(f, n) ==
+      (n = 1) => f
+      f ** (n::O)
 
-The less? predicate asks if the heap size is smaller than a value:
+\end{chunk}
 
-   less?(a,9)
-       false
+\begin{chunk}{COQ FPARFRAC}
+(* domain FPARFRAC *)
+(*
 
-The members function returns a list of the elements of the heap:
+    Rep := FPF
 
-   members a
-       [19,14,12,11,13,5,4,2,1,3]
+    fullParFrac: (UP, UP, UP, N) -> List REC
+    outputexp  : (O, N) -> O
+    output     : (N, UP, UP) -> O
+    REC2RF     : (UP, UP, N) -> RF
+    UP2SUP     : UP -> SUP
+    diffrec    : REC -> REC
+    FP2O       : List REC -> O
 
-The member? predicate asks if an element is in the heap:
+-- create a differential variable
+    u  := new()$Symbol
 
-   member?(14,a)
-       true
+    u0 := makeVariable(u, 0)$ODV
 
-The count function has two forms, one of which counts the number
-of copies of an element in the heap:
+    alpha := u::O
 
-   count(14,a)
-       1
+    x  := monomial(1, 1)$UP
 
-The second form of the count function accepts a predicate to test
-against each member of the heap and counts the number of true results:
+    xx := x::O
 
-   count(x+->(x>13),a)
-       2
+    zr := (0$N)::O
+
+    construct l     == [0, l]
+
+    D r             == differentiate r
+
+    D(r, n)         == differentiate(r,n)
+
+    polyPart f      == f.polyPart
+
+    fracPart f      == f.fracPart
+
+    p:UP + f:$      == [p + polyPart f, fracPart f]
+
+    differentiate f ==
+      differentiate(polyPart f) + construct [diffrec rec for rec in fracPart f]
+
+    differentiate(r, n) ==
+      for i in 1..n repeat r := differentiate r
+      r
+
+    diffrec rec ==
+      e := rec.exponent
+      [e + 1, rec.center, - e * rec.num]
+
+    convert(f:$):RF ==
+      ans := polyPart(f)::RF
+      for rec in fracPart f repeat
+        ans := ans + REC2RF(rec.center, rec.num, rec.exponent)
+      ans
+
+    UP2SUP p == map((z1:F):RF +-> z1::UP::RF, p)_
+        $UnivariatePolynomialCategoryFunctions2(F, UP, RF, SUP)
+
+    -- returns Trace_k^k(a) (h(a) / (x - a)^n)  where d(a) = 0
+    REC2RF(d, h, n) ==
+      ((m := degree d) = 1) =>
+        a   := - (leadingCoefficient reductum d) / (leadingCoefficient d)
+        h(a)::UP / (x - a::UP)**n
+      dd  := UP2SUP d
+      hh  := UP2SUP h
+      aa  := monomial(1, 1)$SUP
+      p   := (x::RF::SUP - aa)**n rem dd
+      rec := extendedEuclidean(p, dd, hh)::Record(coef1:SUP, coef2:SUP)
+      t   := rec.coef1     -- we want Trace_k^k(a)(t) now
+      ans := coefficient(t, 0)
+      for i in 1..degree(d)-1 repeat
+        t   := (t * aa) rem dd
+        ans := ans + coefficient(t, i)
+      ans
+
+    fullPartialFraction f ==
+      qr := divide(numer f, d := denom f)
+      qr.quotient + construct concat
+                     [fullParFrac(qr.remainder, d, rec.factor, rec.exponent::N)
+                                         for rec in factors squareFree denom f]
+
+    fullParFrac(a, d, q, n) ==
+      ans:List REC := empty()
+      em := e := d quo (q ** n)
+      rec := extendedEuclidean(e, q, 1)::Record(coef1:UP,coef2:UP)
+      bm := b := rec.coef1                  -- b = inverse of e modulo q
+      lvar:List(ODV) := [u0]
+      um := 1::ODP
+      un := (u1 := u0::ODP)**n
+      lval:List(UP)  := [q1 := q := differentiate(q0 := q)]
+      h:ODF := a::ODP / (e * un)
+      rec := extendedEuclidean(q1, q0, 1)::Record(coef1:UP,coef2:UP)
+      c := rec.coef1                        -- c = inverse of q' modulo q
+      cm := 1::UP
+      cn  := (c ** n) rem q0
+      for m in 1..n repeat
+        p    := retract(em * un * um * h)@ODP
+        pp   := retract(eval(p, lvar, lval))@UP
+        h    := inv(m::Q) * differentiate h
+        q    := differentiate q
+        lvar := concat(makeVariable(u, m), lvar)
+        lval := concat(inv((m+1)::F) * q, lval)
+        qq   := q0 quo gcd(pp, q0)                    -- new center
+        if (degree(qq) > 0) then
+          ans  := concat([(n + 1 - m)::N, qq, (pp * bm * cn * cm) rem qq], ans)
+        cm   := (c * cm) rem q0     -- cm = c**m modulo q now
+        um   := u1 * um             -- um = u**m now
+        em   := e * em              -- em = e**{m+1} now
+        bm   := (b * bm) rem q0     -- bm = b**{m+1} modulo q now
+      ans
+
+    coerce(f:$):O ==
+      ans := FP2O(l := fracPart f)
+      zero?(p := polyPart f) =>
+        empty? l => (0$N)::O
+        ans
+      p::O + ans
+
+    FP2O l ==
+      empty? l => empty()
+      rec := first l
+      ans := output(rec.exponent, rec.center, rec.num)
+      for rec in rest l repeat
+        ans := ans + output(rec.exponent, rec.center, rec.num)
+      ans
+
+    output(n, d, h) ==
+      (degree d) = 1 =>
+        a := - leadingCoefficient(reductum d) / leadingCoefficient(d)
+        h(a)::O / outputexp((x - a::UP)::O, n)
+      sum(outputForm(makeSUP h, alpha) / outputexp(xx - alpha, n),
+          outputForm(makeSUP d, alpha) = zr)
+
+    outputexp(f, n) ==
+      (n = 1) => f
+      f ** (n::O)
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{FPARFRAC.dotabb}
+"FPARFRAC" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FPARFRAC"]
+"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
+"FPARFRAC" -> "ALIST"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain FUNCTION FunctionCalled}
+
+\begin{chunk}{FunctionCalled.input}
+)set break resume
+)sys rm -f FunctionCalled.output
+)spool FunctionCalled.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show FunctionCalled
+--R 
+--R FunctionCalled(f: Symbol)  is a domain constructor
+--R Abbreviation for FunctionCalled is FUNCTION 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for FUNCTION 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?=? : (%,%) -> Boolean                coerce : % -> OutputForm
+--R hash : % -> SingleInteger             latex : % -> String
+--R name : % -> Symbol                    ?~=? : (%,%) -> Boolean
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{FunctionCalled.help}
+====================================================================
+FunctionCalled examples
+====================================================================
+
+This domain implements named functions
 
 See Also:
-o )show Stack
-o )show ArrayStack
-o )show Queue
-o )show Dequeue
-o )show Heap
-o )show BagAggregate
+o )show FunctionCalled
 
 \end{chunk}
-\pagehead{Heap}{HEAP}
-\pagepic{ps/v103heap.ps}{HEAP}{1.00}
-{\bf See}\\
-\pageto{Stack}{STACK}
-\pageto{ArrayStack}{ASTACK}
-\pageto{Queue}{QUEUE}
-\pageto{Dequeue}{DEQUEUE}
+
+\pagehead{FunctionCalled}{FUNCTION}
+\pagepic{ps/v103functioncalled.ps}{FUNCTION}{1.00}
 
 {\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{HEAP}{any?} &
-\cross{HEAP}{bag} &
-\cross{HEAP}{coerce} &
-\cross{HEAP}{copy} &
-\cross{HEAP}{count} \\
-\cross{HEAP}{empty} &
-\cross{HEAP}{empty?} &
-\cross{HEAP}{eq?} &
-\cross{HEAP}{eval} &
-\cross{HEAP}{every?} \\
-\cross{HEAP}{extract!} &
-\cross{HEAP}{hash} &
-\cross{HEAP}{heap} &
-\cross{HEAP}{insert!} &
-\cross{HEAP}{inspect} \\
-\cross{HEAP}{latex} &
-\cross{HEAP}{less?} &
-\cross{HEAP}{map} &
-\cross{HEAP}{map!} &
-\cross{HEAP}{max} \\
-\cross{HEAP}{member?} &
-\cross{HEAP}{members} &
-\cross{HEAP}{merge} &
-\cross{HEAP}{merge!} &
-\cross{HEAP}{more?} \\
-\cross{HEAP}{parts} &
-\cross{HEAP}{sample} &
-\cross{HEAP}{size?} &
-\cross{HEAP}{\#{}?} &
-\cross{HEAP}{?=?} \\
-\cross{HEAP}{?\~{}=?} &&&&
+\begin{tabular}{llllll}
+\cross{FUNCTION}{coerce} &
+\cross{FUNCTION}{hash} &
+\cross{FUNCTION}{latex} &
+\cross{FUNCTION}{name} &
+\cross{FUNCTION}{?=?} &
+\cross{FUNCTION}{?\~{}=?} 
 \end{tabular}
 
-\begin{chunk}{domain HEAP Heap}
-)abbrev domain HEAP Heap
-++ Author: Michael Monagan and Stephen Watt
-++ Date Created:June 86 and July 87
-++ Date Last Updated:Feb 92
+\begin{chunk}{domain FUNCTION FunctionCalled}
+)abbrev domain FUNCTION FunctionCalled
+++ Author: Mark Botch
 ++ Description:
-++ Heap implemented in a flexible array to allow for insertions
-++ Complexity: O(log n) insertion, extraction and O(n) construction
---% Dequeue and Heap data types
- 
-Heap(S:OrderedSet): Exports == Implementation where 
-  Exports == PriorityQueueAggregate S with
-    heap : List S -> %
-      ++ heap(ls) creates a heap of elements consisting of the 
-      ++ elements of ls.
-      ++
-      ++E i:Heap INT := heap [1,6,3,7,5,2,4]
+++ This domain implements named functions
 
- -- Inherited Signatures repeated for examples documentation
+FunctionCalled(f:Symbol): SetCategory with 
+    name: % -> Symbol 
+      ++ name(x) returns the symbol
+  == add
 
-    bag : List S -> %
-      ++
-      ++X bag([1,2,3,4,5])$Heap(INT)
-    copy : % -> %
-      ++
-      ++X a:Heap INT:= heap [1,2,3,4,5]
-      ++X copy a
-    empty? : % -> Boolean
-      ++
-      ++X a:Heap INT:= heap [1,2,3,4,5]
-      ++X empty? a
-    empty : () -> %
-      ++
-      ++X b:=empty()$(Heap INT)
-    eq? : (%,%) -> Boolean
-      ++
-      ++X a:Heap INT:= heap [1,2,3,4,5]
-      ++X b:=copy a
-      ++X eq?(a,b)
-    extract_! : % -> S
-      ++
-      ++X a:Heap INT:= heap [1,2,3,4,5]
-      ++X extract! a
-      ++X a
-    insert_! : (S,%) -> %
-      ++
-      ++X a:Heap INT:= heap [1,2,3,4,5]
-      ++X insert!(8,a)
-      ++X a
-    inspect : % -> S
-      ++
-      ++X a:Heap INT:= heap [1,2,3,4,5]
-      ++X inspect a
-    map :  ((S -> S),%) -> %
-      ++
-      ++X a:Heap INT:= heap [1,2,3,4,5]
-      ++X map(x+->x+10,a)
-      ++X a
-    max : % -> S
-      ++
-      ++X a:Heap INT:= heap [1,2,3,4,5]
-      ++X max a
-    merge : (%,%) -> %
-      ++
-      ++X a:Heap INT:= heap [1,2,3,4,5]
-      ++X b:Heap INT:= heap [6,7,8,9,10]
-      ++X merge(a,b)
-    merge! : (%,%) -> %
-      ++
-      ++X a:Heap INT:= heap [1,2,3,4,5]
-      ++X b:Heap INT:= heap [6,7,8,9,10]
-      ++X merge!(a,b)
-      ++X a
-      ++X b
-    sample : () -> %
-      ++
-      ++X sample()$Heap(INT)
-    less? : (%,NonNegativeInteger) -> Boolean
-      ++
-      ++X a:Heap INT:= heap [1,2,3,4,5]
-      ++X less?(a,9)
-    more? : (%,NonNegativeInteger) -> Boolean
-      ++
-      ++X a:Heap INT:= heap [1,2,3,4,5]
-      ++X more?(a,9)
-    size? : (%,NonNegativeInteger) -> Boolean
-      ++
-      ++X a:Heap INT:= heap [1,2,3,4,5]
-      ++X size?(a,5)
-    if $ has shallowlyMutable then
-      map! :  ((S -> S),%) -> %
-        ++
-        ++X a:Heap INT:= heap [1,2,3,4,5]
-        ++X map!(x+->x+10,a)
-        ++X a
-    if S has SetCategory then
-      latex : % -> String
-        ++
-        ++X a:Heap INT:= heap [1,2,3,4,5]
-        ++X latex a
-      hash : % -> SingleInteger
-        ++
-        ++X a:Heap INT:= heap [1,2,3,4,5]
-        ++X hash a
-      coerce : % -> OutputForm
-        ++
-        ++X a:Heap INT:= heap [1,2,3,4,5]
-        ++X coerce a
-      "=": (%,%) -> Boolean
-        ++
-        ++X a:Heap INT:= heap [1,2,3,4,5]
-        ++X b:Heap INT:= heap [1,2,3,4,5]
-        ++X (a=b)@Boolean
-      "~=" : (%,%) -> Boolean
-        ++
-        ++X a:Heap INT:= heap [1,2,3,4,5]
-        ++X b:=copy a
-        ++X (a~=b)
-    if % has finiteAggregate then
-      every? : ((S -> Boolean),%) -> Boolean
-        ++
-        ++X a:Heap INT:= heap [1,2,3,4,5]
-        ++X every?(x+->(x=4),a)
-      any? : ((S -> Boolean),%) -> Boolean
-        ++
-        ++X a:Heap INT:= heap [1,2,3,4,5]
-        ++X any?(x+->(x=4),a)
-      count :  ((S -> Boolean),%) -> NonNegativeInteger
-        ++
-        ++X a:Heap INT:= heap [1,2,3,4,5]
-        ++X count(x+->(x>2),a)
-      _# : % -> NonNegativeInteger
-        ++
-        ++X a:Heap INT:= heap [1,2,3,4,5]
-        ++X #a
-      parts : % -> List S
-        ++
-        ++X a:Heap INT:= heap [1,2,3,4,5]
-        ++X parts a
-      members : % -> List S
-        ++
-        ++X a:Heap INT:= heap [1,2,3,4,5]
-        ++X members a
-    if % has finiteAggregate and S has SetCategory then
-      member? : (S,%) -> Boolean
-        ++
-        ++X a:Heap INT:= heap [1,2,3,4,5]
-        ++X member?(3,a)
-      count : (S,%) -> NonNegativeInteger
-        ++
-        ++X a:Heap INT:= heap [1,2,3,4,5]
-        ++X count(4,a)
+   name r                 == f
 
-  Implementation == IndexedFlexibleArray(S,0) add
-    Rep := IndexedFlexibleArray( S,0)
-    empty() == empty()$Rep
-    heap l == 
-      n := #l
-      h := empty()
-      n = 0 => h
-      for x in l repeat insert_!(x,h)
-      h
-    siftUp: (%,Integer,Integer) -> Void
-    siftUp(r,i,n) ==
-       -- assertion 0 <= i < n
-       t := r.i
-       while (j := 2*i+1) < n repeat
-          if (k := j+1) < n and r.j < r.k then j := k
-          if t < r.j then (r.i := r.j; r.j := t; i := j) else leave
- 
-    extract_! r ==
-       -- extract the maximum from the heap O(log n)
-       n := #r :: Integer
-       n = 0 => error "empty heap"
-       t := r(0)
-       r(0) := r(n-1)
-       delete_!(r,n-1)
-       n = 1 => t
-       siftUp(r,0,n-1)
-       t
- 
-    insert_!(x,r) ==
-       -- Williams' insertion algorithm O(log n)
-       j := (#r) :: Integer
-       r:=concat_!(r,concat(x,empty()$Rep))
-       while j > 0 repeat
-          i := (j-1) quo 2
-          if r(i) >= x then leave
-          r(j) := r(i)
-          j := i
-       r(j):=x
-       r
- 
-    max r == if #r = 0 then error "empty heap" else r.0
-    inspect r == max r
- 
-    makeHeap(r:%):% ==
-       -- Floyd's heap construction algorithm O(n)
-       n := #r
-       for k in n quo 2 -1 .. 0 by -1 repeat siftUp(r,k,n)
-       r
-    bag l == makeHeap construct(l)$Rep
-    merge(a,b) == makeHeap concat(a,b)
-    merge_!(a,b) == makeHeap concat_!(a,b)
+   coerce(r:%):OutputForm == f::OutputForm
+
+   x = y                  == true
+
+   latex(x:%):String      == latex f
 
 \end{chunk}
 
-\begin{chunk}{COQ HEAP}
-(* domain HEAP *)
+\begin{chunk}{COQ FUNCTION}
+(* domain FUNCTION *)
 (*
+
+   name r                 == f
+
+   coerce(r:%):OutputForm == f::OutputForm
+
+   x = y                  == true
+
+   latex(x:%):String      == latex f
+
 *)
 
 \end{chunk}
 
-\begin{chunk}{HEAP.dotabb}
-"HEAP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=HEAP"]
-"A1AGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=A1AGG"]
-"HEAP" -> "A1AGG"
+\begin{chunk}{FUNCTION.dotabb}
+"FUNCTION" [color="#88FF44",href="bookvol10.3.pdf#nameddest=FUNCTION"]
+"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
+"FUNCTION" -> "ALIST"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain HEXADEC HexadecimalExpansion}
+\chapter{Chapter G}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain GDMP GeneralDistributedMultivariatePolynomial}
 
-\begin{chunk}{HexadecimalExpansion.input}
+\begin{chunk}{GeneralDistributedMultivariatePolynomial.input}
 )set break resume
-)sys rm -f HexadecimalExpansion.output
-)spool HexadecimalExpansion.output
+)sys rm -f GeneralDistributedMultivariatePolynomial.output
+)spool GeneralDistributedMultivariatePolynomial.output
 )set message test on
 )set message auto off
 )clear all
 
---S 1 of 8
-r := hex(22/7)
+--S 1 of 11
+(d1,d2,d3) : DMP([z,y,x],FRAC INT) 
 --R 
---R
---R          ___
---R   (1)  3.249
---R                                                   Type: HexadecimalExpansion
+--R                                                                   Type: Void
 --E 1
 
---S 2 of 8
-r + hex(6/7)
+--S 2 of 11
+d1 := -4*z + 4*y**2*x + 16*x**2 + 1 
 --R 
 --R
---R   (2)  4
---R                                                   Type: HexadecimalExpansion
+--R                 2       2
+--R   (2)  - 4z + 4y x + 16x  + 1
+--R           Type: DistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
 --E 2
 
---S 3 of 8
-[hex(1/i) for i in 350..354]
+--S 3 of 11
+d2 := 2*z*y**2 + 4*x + 1 
 --R 
 --R
---R   (3)
---R       _______________    _________      _____    ______________________
---R   [0.00BB3EE721A54D88, 0.00BAB6561, 0.00BA2E8, 0.00B9A7862A0FF465879D5F,
---R       _____________________________
---R    0.00B92143FA36F5E02E4850FE8DBD78]
---R                                             Type: List(HexadecimalExpansion)
+--R            2
+--R   (3)  2z y  + 4x + 1
+--R           Type: DistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
 --E 3
 
---S 4 of 8
-hex(1/1007)
+--S 4 of 11
+d3 := 2*z*x**2 - 2*y**2 - x 
 --R 
 --R
---R   (4)
---R   0.
---R     OVERBAR
---R        0041149783F0BF2C7D13933192AF6980619EE345E91EC2BB9D5CCA5C071E40926E54E8D
---R          DAE24196C0B2F8A0AAD60DBA57F5D4C8536262210C74F1
---R                                                   Type: HexadecimalExpansion
+--R            2     2
+--R   (4)  2z x  - 2y  - x
+--R           Type: DistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
 --E 4
 
---S 5 of 8
-p := hex(1/4)*x**2 + hex(2/3)*x + hex(4/9)
+--S 5 of 11
+groebner [d1,d2,d3]
 --R 
 --R
---R            2     _      ___
---R   (5)  0.4x  + 0.Ax + 0.71C
---R                                       Type: Polynomial(HexadecimalExpansion)
+--R   (5)
+--R        1568  6   1264  5    6   4   182  3   2047  2    103      2857
+--R   [z - ---- x  - ---- x  + --- x  + --- x  - ---- x  - ---- x - -----,
+--R        2745       305      305      549       610      2745     10980
+--R     2    112  6    84  5   1264  4    13  3    84  2   1772       2
+--R    y  + ---- x  - --- x  - ---- x  - --- x  + --- x  + ---- x + ----,
+--R         2745      305       305      549      305      2745     2745
+--R     7   29  6   17  4   11  3    1  2   15     1
+--R    x  + -- x  - -- x  - -- x  + -- x  + -- x + -]
+--R          4      16       8      32      16     4
+--R     Type: List(DistributedMultivariatePolynomial([z,y,x],Fraction(Integer)))
 --E 5
 
---S 6 of 8
-q := D(p, x)
+--S 6 of 11
+(n1,n2,n3) : HDMP([z,y,x],FRAC INT)
 --R 
---R
---R                 _
---R   (6)  0.8x + 0.A
---R                                       Type: Polynomial(HexadecimalExpansion)
+--R                                                                   Type: Void
 --E 6
 
---S 7 of 8
-g := gcd(p, q)
+--S 7 of 11
+n1 := d1
 --R 
 --R
---R              _
---R   (7)  x + 1.5
---R                                       Type: Polynomial(HexadecimalExpansion)
+--R          2       2
+--R   (7)  4y x + 16x  - 4z + 1
+--RType: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
 --E 7
 
---S 8 of 8
-)show HexadecimalExpansion
+--S 8 of 11
+n2 := d2
 --R 
---R HexadecimalExpansion  is a domain constructor
---R Abbreviation for HexadecimalExpansion is HEXADEC 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for HEXADEC 
+--R
+--R            2
+--R   (8)  2z y  + 4x + 1
+--RType: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
+--E 8
+
+--S 9 of 11
+n3 := d3
+--R 
+--R
+--R            2     2
+--R   (9)  2z x  - 2y  - x
+--RType: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
+--E 9
+
+--S 10 of 11
+groebner [n1,n2,n3]
+--R 
+--R
+--R   (10)
+--R     4     3   3  2   1     1   4   29  3   1  2   7        9     1
+--R   [y  + 2x  - - x  + - z - -, x  + -- x  - - y  - - z x - -- x - -,
+--R               2      2     8        4      8      4       16     4
+--R       2        1   2      2       1     2    2   1
+--R    z y  + 2x + -, y x + 4x  - z + -, z x  - y  - - x,
+--R                2                  4              2
+--R     2     2     2   1     3
+--R    z  - 4y  + 2x  - - z - - x]
+--R                     4     2
+--RType: List(HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer)))
+--E 10
+
+--S 11 of 11
+)show GeneralDistributedMultivariatePolynomial
+--R 
+--R GeneralDistributedMultivariatePolynomial(vl: List(Symbol),R: Ring,E: DirectProductCategory(#(vl),NonNegativeInteger))  is a domain constructor
+--R Abbreviation for GeneralDistributedMultivariatePolynomial is GDMP 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for GDMP 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (%,Integer) -> %                ?*? : (Integer,%) -> %
---R ?*? : (Fraction(Integer),%) -> %      ?*? : (%,Fraction(Integer)) -> %
+--R ?*? : (%,R) -> %                      ?*? : (R,%) -> %
 --R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
 --R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?**? : (%,Integer) -> %               ?**? : (%,NonNegativeInteger) -> %
---R ?**? : (%,PositiveInteger) -> %       ?+? : (%,%) -> %
---R ?-? : (%,%) -> %                      -? : % -> %
---R ?/? : (Integer,Integer) -> %          ?/? : (%,%) -> %
---R ?=? : (%,%) -> Boolean                D : (%,(Integer -> Integer)) -> %
---R D : % -> % if Integer has DIFRING     1 : () -> %
---R 0 : () -> %                           ?^? : (%,Integer) -> %
---R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
---R associates? : (%,%) -> Boolean        coerce : % -> RadixExpansion(16)
---R coerce : % -> Fraction(Integer)       coerce : Integer -> %
---R coerce : Fraction(Integer) -> %       coerce : % -> %
---R coerce : Integer -> %                 coerce : % -> OutputForm
---R denom : % -> Integer                  denominator : % -> %
---R factor : % -> Factored(%)             gcd : List(%) -> %
---R gcd : (%,%) -> %                      hash : % -> SingleInteger
---R hex : Fraction(Integer) -> %          init : () -> % if Integer has STEP
---R inv : % -> %                          latex : % -> String
---R lcm : List(%) -> %                    lcm : (%,%) -> %
---R numer : % -> Integer                  numerator : % -> %
---R one? : % -> Boolean                   prime? : % -> Boolean
---R ?quo? : (%,%) -> %                    random : () -> % if Integer has INS
---R recip : % -> Union(%,"failed")        ?rem? : (%,%) -> %
---R retract : % -> Integer                sample : () -> %
---R sizeLess? : (%,%) -> Boolean          squareFree : % -> Factored(%)
---R squareFreePart : % -> %               toint : String -> Integer
---R unit? : % -> Boolean                  unitCanonical : % -> %
---R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
---R ?<? : (%,%) -> Boolean if Integer has ORDSET
---R ?<=? : (%,%) -> Boolean if Integer has ORDSET
---R ?>? : (%,%) -> Boolean if Integer has ORDSET
---R ?>=? : (%,%) -> Boolean if Integer has ORDSET
---R D : (%,(Integer -> Integer),NonNegativeInteger) -> %
---R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if Integer has PDRING(SYMBOL)
---R D : (%,Symbol,NonNegativeInteger) -> % if Integer has PDRING(SYMBOL)
---R D : (%,List(Symbol)) -> % if Integer has PDRING(SYMBOL)
---R D : (%,Symbol) -> % if Integer has PDRING(SYMBOL)
---R D : (%,NonNegativeInteger) -> % if Integer has DIFRING
---R abs : % -> % if Integer has OINTDOM
---R ceiling : % -> Integer if Integer has INS
+--R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
+--R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
+--R -? : % -> %                           ?/? : (%,R) -> % if R has FIELD
+--R ?=? : (%,%) -> Boolean                1 : () -> %
+--R 0 : () -> %                           ?^? : (%,NonNegativeInteger) -> %
+--R ?^? : (%,PositiveInteger) -> %        coefficient : (%,E) -> R
+--R coefficients : % -> List(R)           coerce : % -> % if R has INTDOM
+--R coerce : R -> %                       coerce : Integer -> %
+--R coerce : % -> OutputForm              content : % -> R if R has GCDDOM
+--R degree : % -> E                       eval : (%,List(%),List(%)) -> %
+--R eval : (%,%,%) -> %                   eval : (%,Equation(%)) -> %
+--R eval : (%,List(Equation(%))) -> %     gcd : (%,%) -> % if R has GCDDOM
+--R gcd : List(%) -> % if R has GCDDOM    ground : % -> R
+--R ground? : % -> Boolean                hash : % -> SingleInteger
+--R latex : % -> String                   lcm : (%,%) -> % if R has GCDDOM
+--R lcm : List(%) -> % if R has GCDDOM    leadingCoefficient : % -> R
+--R leadingMonomial : % -> %              map : ((R -> R),%) -> %
+--R mapExponents : ((E -> E),%) -> %      max : (%,%) -> % if R has ORDSET
+--R min : (%,%) -> % if R has ORDSET      minimumDegree : % -> E
+--R monomial : (R,E) -> %                 monomial? : % -> Boolean
+--R monomials : % -> List(%)              one? : % -> Boolean
+--R pomopo! : (%,R,E,%) -> %              primitiveMonomials : % -> List(%)
+--R recip : % -> Union(%,"failed")        reductum : % -> %
+--R reorder : (%,List(Integer)) -> %      retract : % -> R
+--R sample : () -> %                      zero? : % -> Boolean
+--R ?~=? : (%,%) -> 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(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
+--R D : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
+--R D : (%,List(OrderedVariableList(vl))) -> %
+--R D : (%,OrderedVariableList(vl)) -> %
+--R associates? : (%,%) -> Boolean if R has INTDOM
+--R binomThmExpt : (%,%,NonNegativeInteger) -> % if R has COMRING
 --R characteristic : () -> NonNegativeInteger
---R charthRoot : % -> Union(%,"failed") if $ has CHARNZ and Integer has PFECAT or Integer has CHARNZ
---R coerce : Symbol -> % if Integer has RETRACT(SYMBOL)
---R conditionP : Matrix(%) -> Union(Vector(%),"failed") if $ has CHARNZ and Integer has PFECAT
---R convert : % -> DoubleFloat if Integer has REAL
---R convert : % -> Float if Integer has REAL
---R convert : % -> InputForm if Integer has KONVERT(INFORM)
---R convert : % -> Pattern(Float) if Integer has KONVERT(PATTERN(FLOAT))
---R convert : % -> Pattern(Integer) if Integer has KONVERT(PATTERN(INT))
---R differentiate : (%,(Integer -> Integer)) -> %
---R differentiate : (%,(Integer -> Integer),NonNegativeInteger) -> %
---R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if Integer has PDRING(SYMBOL)
---R differentiate : (%,Symbol,NonNegativeInteger) -> % if Integer has PDRING(SYMBOL)
---R differentiate : (%,List(Symbol)) -> % if Integer has PDRING(SYMBOL)
---R differentiate : (%,Symbol) -> % if Integer has PDRING(SYMBOL)
---R differentiate : (%,NonNegativeInteger) -> % if Integer has DIFRING
---R differentiate : % -> % if Integer has DIFRING
---R divide : (%,%) -> Record(quotient: %,remainder: %)
---R ?.? : (%,Integer) -> % if Integer has ELTAB(INT,INT)
---R euclideanSize : % -> NonNegativeInteger
---R eval : (%,Symbol,Integer) -> % if Integer has IEVALAB(SYMBOL,INT)
---R eval : (%,List(Symbol),List(Integer)) -> % if Integer has IEVALAB(SYMBOL,INT)
---R eval : (%,List(Equation(Integer))) -> % if Integer has EVALAB(INT)
---R eval : (%,Equation(Integer)) -> % if Integer has EVALAB(INT)
---R eval : (%,Integer,Integer) -> % if Integer has EVALAB(INT)
---R eval : (%,List(Integer),List(Integer)) -> % if Integer has EVALAB(INT)
---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 Integer has PFECAT
---R factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if Integer has PFECAT
---R floor : % -> Integer if Integer has INS
---R fractionPart : % -> Fraction(Integer)
---R fractionPart : % -> % if Integer has EUCDOM
---R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%)
---R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %)
---R map : ((Integer -> Integer),%) -> %
---R max : (%,%) -> % if Integer has ORDSET
---R min : (%,%) -> % if Integer has ORDSET
---R multiEuclidean : (List(%),%) -> Union(List(%),"failed")
---R negative? : % -> Boolean if Integer has OINTDOM
---R nextItem : % -> Union(%,"failed") if Integer has STEP
---R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) if Integer has PATMAB(FLOAT)
---R patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> PatternMatchResult(Integer,%) if Integer has PATMAB(INT)
---R positive? : % -> Boolean if Integer has OINTDOM
---R principalIdeal : List(%) -> Record(coef: List(%),generator: %)
---R reducedSystem : Matrix(%) -> Matrix(Integer)
---R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer))
---R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer)) if Integer has LINEXP(INT)
---R reducedSystem : Matrix(%) -> Matrix(Integer) if Integer has LINEXP(INT)
---R retract : % -> Integer if Integer has RETRACT(INT)
---R retract : % -> Fraction(Integer) if Integer has RETRACT(INT)
---R retract : % -> Symbol if Integer has RETRACT(SYMBOL)
---R retractIfCan : % -> Union(Integer,"failed") if Integer has RETRACT(INT)
---R retractIfCan : % -> Union(Fraction(Integer),"failed") if Integer has RETRACT(INT)
---R retractIfCan : % -> Union(Symbol,"failed") if Integer has RETRACT(SYMBOL)
---R retractIfCan : % -> Union(Integer,"failed")
---R sign : % -> Integer if Integer has OINTDOM
---R solveLinearPolynomialEquation : (List(SparseUnivariatePolynomial(%)),SparseUnivariatePolynomial(%)) -> Union(List(SparseUnivariatePolynomial(%)),"failed") if Integer has PFECAT
---R squareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if Integer has PFECAT
+--R charthRoot : % -> Union(%,"failed") if $ has CHARNZ and R has PFECAT or R has CHARNZ
+--R coefficient : (%,List(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
+--R coefficient : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
+--R coerce : Fraction(Integer) -> % if R has ALGEBRA(FRAC(INT)) or R has RETRACT(FRAC(INT))
+--R coerce : OrderedVariableList(vl) -> %
+--R conditionP : Matrix(%) -> Union(Vector(%),"failed") if $ has CHARNZ and R has PFECAT
+--R content : (%,OrderedVariableList(vl)) -> % if R has GCDDOM
+--R convert : % -> InputForm if OrderedVariableList(vl) has KONVERT(INFORM) and R has KONVERT(INFORM)
+--R convert : % -> Pattern(Integer) if OrderedVariableList(vl) has KONVERT(PATTERN(INT)) and R has KONVERT(PATTERN(INT))
+--R convert : % -> Pattern(Float) if OrderedVariableList(vl) has KONVERT(PATTERN(FLOAT)) and R has KONVERT(PATTERN(FLOAT))
+--R degree : (%,List(OrderedVariableList(vl))) -> List(NonNegativeInteger)
+--R degree : (%,OrderedVariableList(vl)) -> NonNegativeInteger
+--R differentiate : (%,List(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
+--R differentiate : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
+--R differentiate : (%,List(OrderedVariableList(vl))) -> %
+--R differentiate : (%,OrderedVariableList(vl)) -> %
+--R discriminant : (%,OrderedVariableList(vl)) -> % if R has COMRING
+--R eval : (%,List(OrderedVariableList(vl)),List(%)) -> %
+--R eval : (%,OrderedVariableList(vl),%) -> %
+--R eval : (%,List(OrderedVariableList(vl)),List(R)) -> %
+--R eval : (%,OrderedVariableList(vl),R) -> %
+--R exquo : (%,%) -> Union(%,"failed") if R has INTDOM
+--R exquo : (%,R) -> Union(%,"failed") 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 isExpt : % -> Union(Record(var: OrderedVariableList(vl),exponent: NonNegativeInteger),"failed")
+--R isPlus : % -> Union(List(%),"failed")
+--R isTimes : % -> Union(List(%),"failed")
+--R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) if R has GCDDOM
+--R mainVariable : % -> Union(OrderedVariableList(vl),"failed")
+--R minimumDegree : (%,List(OrderedVariableList(vl))) -> List(NonNegativeInteger)
+--R minimumDegree : (%,OrderedVariableList(vl)) -> NonNegativeInteger
+--R monicDivide : (%,%,OrderedVariableList(vl)) -> Record(quotient: %,remainder: %)
+--R monomial : (%,List(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
+--R monomial : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
+--R multivariate : (SparseUnivariatePolynomial(%),OrderedVariableList(vl)) -> %
+--R multivariate : (SparseUnivariatePolynomial(R),OrderedVariableList(vl)) -> %
+--R numberOfMonomials : % -> NonNegativeInteger
+--R patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> PatternMatchResult(Integer,%) if OrderedVariableList(vl) has PATMAB(INT) and R has PATMAB(INT)
+--R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) if OrderedVariableList(vl) has PATMAB(FLOAT) and R has PATMAB(FLOAT)
+--R prime? : % -> Boolean if R has PFECAT
+--R primitivePart : (%,OrderedVariableList(vl)) -> % if R has GCDDOM
+--R primitivePart : % -> % if R has GCDDOM
+--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 : (%,%,OrderedVariableList(vl)) -> % if R has COMRING
+--R retract : % -> OrderedVariableList(vl)
+--R retract : % -> Integer if R has RETRACT(INT)
+--R retract : % -> Fraction(Integer) if R has RETRACT(FRAC(INT))
+--R retractIfCan : % -> Union(OrderedVariableList(vl),"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 subtractIfCan : (%,%) -> Union(%,"failed")
---R unitNormal : % -> Record(unit: %,canonical: %,associate: %)
---R wholePart : % -> Integer if Integer has EUCDOM
+--R totalDegree : (%,List(OrderedVariableList(vl))) -> 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 : (%,OrderedVariableList(vl)) -> SparseUnivariatePolynomial(%)
+--R variables : % -> List(OrderedVariableList(vl))
 --R
---E 8
+--E 11
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{HexadecimalExpansion.help}
+
+\begin{chunk}{GeneralDistributedMultivariatePolynomial.help}
 ====================================================================
-HexadecimalExpansion
+MultivariatePolynomial
+DistributedMultivariatePolynomial
+HomogeneousDistributedMultivariatePolynomial
+GeneralDistributedMultivariatePolynomial
 ====================================================================
 
-All rationals have repeating hexadecimal expansions.  The operation
-hex returns these expansions of type HexadecimalExpansion.  Operations
-to access the individual numerals of a hexadecimal expansion can be
-obtained by converting the value to RadixExpansion(16).  More examples
-of expansions are available in the DecimalExpansion, BinaryExpansion,
-and RadixExpansion.
+DistributedMultivariatePolynomial which is abbreviated as DMP and 
+HomogeneousDistributedMultivariatePolynomial, which is abbreviated
+as HDMP, are very similar to MultivariatePolynomial except that 
+they are represented and displayed in a non-recursive manner.
 
-This is a hexadecimal expansion of a rational number.
+  (d1,d2,d3) : DMP([z,y,x],FRAC INT) 
+                      Type: Void
 
-  r := hex(22/7)
-      ___
-    3.249
-                      Type: HexadecimalExpansion
+The constructor DMP orders its monomials lexicographically while
+HDMP orders them by total order refined by reverse lexicographic
+order.
 
-Arithmetic is exact.
+  d1 := -4*z + 4*y**2*x + 16*x**2 + 1 
+            2       2
+   - 4z + 4y x + 16x  + 1
+            Type: DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
 
-  r + hex(6/7)
-    4
-                      Type: HexadecimalExpansion
+  d2 := 2*z*y**2 + 4*x + 1 
+       2
+   2z y  + 4x + 1
+            Type: DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
 
-The period of the expansion can be short or long ...
+  d3 := 2*z*x**2 - 2*y**2 - x 
+       2     2
+   2z x  - 2y  - x
+            Type: DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
 
-  [hex(1/i) for i in 350..354]
-       _______________    _________      _____    ______________________
-   [0.00BB3EE721A54D88, 0.00BAB6561, 0.00BA2E8, 0.00B9A7862A0FF465879D5F,
-       _____________________________
-    0.00B92143FA36F5E02E4850FE8DBD78]
-                      Type: List HexadecimalExpansion
+These constructors are mostly used in Groebner basis calculations.
 
-or very long!
+  groebner [d1,d2,d3]
+        1568  6   1264  5    6   4   182  3   2047  2    103      2857
+   [z - ---- x  - ---- x  + --- x  + --- x  - ---- x  - ---- x - -----,
+        2745       305      305      549       610      2745     10980
+     2    112  6    84  5   1264  4    13  3    84  2   1772       2
+    y  + ---- x  - --- x  - ---- x  - --- x  + --- x  + ---- x + ----,
+         2745      305       305      549      305      2745     2745
+     7   29  6   17  4   11  3    1  2   15     1
+    x  + -- x  - -- x  - -- x  + -- x  + -- x + -]
+          4      16       8      32      16     4
+       Type: List DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
 
-  hex(1/1007)
-     _______________________________________________________________________
-   0.0041149783F0BF2C7D13933192AF6980619EE345E91EC2BB9D5CCA5C071E40926E54E8D
-     ______________________________________________
-     DAE24196C0B2F8A0AAD60DBA57F5D4C8536262210C74F1
-                      Type: HexadecimalExpansion
+  (n1,n2,n3) : HDMP([z,y,x],FRAC INT)
+                      Type: Void
 
-These numbers are bona fide algebraic objects.
+  n1 := d1
+     2       2
+   4y x + 16x  - 4z + 1
+ Type: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction Integer)
 
-  p := hex(1/4)*x**2 + hex(2/3)*x + hex(4/9)
-        2     _      ___
-    0.4x  + 0.Ax + 0.71C
-                      Type: Polynomial HexadecimalExpansion
+  n2 := d2
+       2
+   2z y  + 4x + 1
+ Type: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction Integer)
 
-  q := D(p, x)
-             _
-    0.8x + 0.A
-                      Type: Polynomial HexadecimalExpansion
+  n3 := d3
+       2     2
+   2z x  - 2y  - x
+ Type: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction Integer)
 
-  g := gcd(p, q)
-          _
-    x + 1.5
-                      Type: Polynomial HexadecimalExpansion
+Note that we get a different Groebner basis when we use the HDMP
+polynomials, as expected.
+
+  groebner [n1,n2,n3]
+     4     3   3  2   1     1   4   29  3   1  2   7        9     1
+   [y  + 2x  - - x  + - z - -, x  + -- x  - - y  - - z x - -- x - -,
+               2      2     8        4      8      4       16     4
+       2        1   2      2       1     2    2   1
+    z y  + 2x + -, y x + 4x  - z + -, z x  - y  - - x,
+                2                  4              2
+     2     2     2   1     3
+    z  - 4y  + 2x  - - z - - x]
+                     4     2
+      Type: List HomogeneousDistributedMultivariatePolynomial([z,y,x],
+                                                           Fraction Integer)
+
+GeneralDistributedMultivariatePolynomial is somewhat more flexible in
+the sense that as well as accepting a list of variables to specify the
+variable ordering, it also takes a predicate on exponent vectors to
+specify the term ordering.  With this polynomial type the user can
+experiment with the effect of using completely arbitrary term orderings.  
+This flexibility is mostly important for algorithms such as Groebner 
+basis calculations which can be very sensitive to term ordering.
 
 See Also:
-o )help RadixExpansion
-o )help BinaryExpansion
-o )help DecimalExpansion
-o )show HexadecimalExpansion
+o )help Polynomial
+o )help UnivariatePolynomial
+o )help MultivariatePolynomial
+o )help HomogeneousDistributedMultivariatePolynomial
+o )help DistributedMultivariatePolynomial
+o )show GeneralDistributedMultivariatePolynomial
 
 \end{chunk}
-\pagehead{HexadecimalExpansion}{HEXADEC}
-\pagepic{ps/v103hexadecimalexpansion.ps}{HEXADEC}{1.00}
+\pagehead{GeneralDistributedMultivariatePolynomial}{GDMP}
+\pagepic{ps/v103generaldistributedmultivariatepolynomial.ps}{GDMP}{1.00}
 {\bf See}\\
-\pageto{RadixExpansion}{RADIX}
-\pageto{BinaryExpansion}{BINARY}
-\pageto{DecimalExpansion}{DECIMAL}
+\pageto{DistributedMultivariatePolynomial}{DMP}
+\pageto{HomogeneousDistributedMultivariatePolynomial}{HDMP}
 
 {\bf Exports:}\\
-\begin{tabular}{ll}
-\cross{HEXADEC}{0} &
-\cross{HEXADEC}{1} \\
-\cross{HEXADEC}{abs} &
-\cross{HEXADEC}{associates?} \\
-\cross{HEXADEC}{ceiling} &
-\cross{HEXADEC}{characteristic} \\
-\cross{HEXADEC}{charthRoot} &
-\cross{HEXADEC}{coerce} \\
-\cross{HEXADEC}{conditionP} &
-\cross{HEXADEC}{convert} \\
-\cross{HEXADEC}{D} &
-\cross{HEXADEC}{denom} \\
-\cross{HEXADEC}{denominator} &
-\cross{HEXADEC}{differentiate} \\
-\cross{HEXADEC}{divide} &
-\cross{HEXADEC}{euclideanSize} \\
-\cross{HEXADEC}{eval} &
-\cross{HEXADEC}{expressIdealMember} \\
-\cross{HEXADEC}{exquo} &
-\cross{HEXADEC}{extendedEuclidean} \\
-\cross{HEXADEC}{factor} &
-\cross{HEXADEC}{factorPolynomial} \\
-\cross{HEXADEC}{factorSquareFreePolynomial} &
-\cross{HEXADEC}{floor} \\
-\cross{HEXADEC}{fractionPart} &
-\cross{HEXADEC}{gcd} \\
-\cross{HEXADEC}{gcdPolynomial} &
-\cross{HEXADEC}{hash} \\
-\cross{HEXADEC}{hex} &
-\cross{HEXADEC}{init} \\
-\cross{HEXADEC}{inv} &
-\cross{HEXADEC}{latex} \\
-\cross{HEXADEC}{lcm} &
-\cross{HEXADEC}{map} \\
-\cross{HEXADEC}{max} &
-\cross{HEXADEC}{min} \\
-\cross{HEXADEC}{multiEuclidean} &
-\cross{HEXADEC}{negative?} \\
-\cross{HEXADEC}{nextItem} &
-\cross{HEXADEC}{numer} \\
-\cross{HEXADEC}{numerator} &
-\cross{HEXADEC}{one?} \\
-\cross{HEXADEC}{patternMatch} &
-\cross{HEXADEC}{positive?} \\
-\cross{HEXADEC}{prime?} &
-\cross{HEXADEC}{principalIdeal} \\
-\cross{HEXADEC}{random} &
-\cross{HEXADEC}{recip} \\
-\cross{HEXADEC}{reducedSystem} &
-\cross{HEXADEC}{retract} \\
-\cross{HEXADEC}{retractIfCan} &
-\cross{HEXADEC}{sample} \\
-\cross{HEXADEC}{sign} &
-\cross{HEXADEC}{sizeLess?} \\
-\cross{HEXADEC}{solveLinearPolynomialEquation} &
-\cross{HEXADEC}{squareFree} \\
-\cross{HEXADEC}{squareFreePart} &
-\cross{HEXADEC}{squareFreePolynomial} \\
-\cross{HEXADEC}{subtractIfCan} &
-\cross{HEXADEC}{unit?} \\
-\cross{HEXADEC}{unitCanonical} &
-\cross{HEXADEC}{unitNormal} \\
-\cross{HEXADEC}{wholePart} &
-\cross{HEXADEC}{zero?} \\
-\cross{HEXADEC}{?*?} &
-\cross{HEXADEC}{?**?} \\
-\cross{HEXADEC}{?+?} &
-\cross{HEXADEC}{?-?} \\
-\cross{HEXADEC}{-?} &
-\cross{HEXADEC}{?/?} \\
-\cross{HEXADEC}{?=?} &
-\cross{HEXADEC}{?\^{}?} \\
-\cross{HEXADEC}{?\~{}=?} &
-\cross{HEXADEC}{?$<$?} \\
-\cross{HEXADEC}{?$<=$?} &
-\cross{HEXADEC}{?$>$?} \\
-\cross{HEXADEC}{?$>=$?} &
-\cross{HEXADEC}{?.?} \\
-\cross{HEXADEC}{?quo?} &
-\cross{HEXADEC}{?rem?} 
+\begin{tabular}{lll}
+\cross{GDMP}{0} &
+\cross{GDMP}{1} &
+\cross{GDMP}{associates?} \\
+\cross{GDMP}{binomThmExpt} &
+\cross{GDMP}{characteristic} &
+\cross{GDMP}{charthRoot} \\
+\cross{GDMP}{coefficient} &
+\cross{GDMP}{coefficients} &
+\cross{GDMP}{coerce} \\
+\cross{GDMP}{conditionP} &
+\cross{GDMP}{content} &
+\cross{GDMP}{D} \\
+\cross{GDMP}{degree} &
+\cross{GDMP}{differentiate} &
+\cross{GDMP}{discriminant} \\
+\cross{GDMP}{eval} &
+\cross{GDMP}{exquo} &
+\cross{GDMP}{factor} \\
+\cross{GDMP}{factorPolynomial} &
+\cross{GDMP}{factorSquareFreePolynomial} &
+\cross{GDMP}{gcd} \\
+\cross{GDMP}{gcdPolynomial} &
+\cross{GDMP}{ground} &
+\cross{GDMP}{ground?} \\
+\cross{GDMP}{hash} &
+\cross{GDMP}{isExpt} &
+\cross{GDMP}{isPlus} \\
+\cross{GDMP}{isTimes} &
+\cross{GDMP}{latex} &
+\cross{GDMP}{lcm} \\
+\cross{GDMP}{leadingCoefficient} &
+\cross{GDMP}{leadingMonomial} &
+\cross{GDMP}{mainVariable} \\
+\cross{GDMP}{map} &
+\cross{GDMP}{mapExponents} &
+\cross{GDMP}{max} \\
+\cross{GDMP}{min} &
+\cross{GDMP}{minimumDegree} &
+\cross{GDMP}{monicDivide} \\
+\cross{GDMP}{monomial} &
+\cross{GDMP}{monomial?} &
+\cross{GDMP}{monomials} \\
+\cross{GDMP}{multivariate} &
+\cross{GDMP}{numberOfMonomials} &
+\cross{GDMP}{one?} \\
+\cross{GDMP}{patternMatch} &
+\cross{GDMP}{pomopo!} &
+\cross{GDMP}{prime?} \\
+\cross{GDMP}{primitiveMonomials} &
+\cross{GDMP}{primitivePart} &
+\cross{GDMP}{recip} \\
+\cross{GDMP}{reducedSystem} &
+\cross{GDMP}{reductum} &
+\cross{GDMP}{reorder} \\
+\cross{GDMP}{resultant} &
+\cross{GDMP}{retract} &
+\cross{GDMP}{retractIfCan} \\
+\cross{GDMP}{sample} &
+\cross{GDMP}{solveLinearPolynomialEquation} &
+\cross{GDMP}{squareFree} \\
+\cross{GDMP}{squareFreePart} &
+\cross{GDMP}{squareFreePolynomial} &
+\cross{GDMP}{subtractIfCan} \\
+\cross{GDMP}{totalDegree} &
+\cross{GDMP}{unit?} &
+\cross{GDMP}{unitCanonical} \\
+\cross{GDMP}{unitNormal} &
+\cross{GDMP}{univariate} &
+\cross{GDMP}{variables} \\
+\cross{GDMP}{zero?} &
+\cross{GDMP}{?*?} &
+\cross{GDMP}{?**?} \\
+\cross{GDMP}{?+?} &
+\cross{GDMP}{?-?} &
+\cross{GDMP}{-?} \\
+\cross{GDMP}{?=?} &
+\cross{GDMP}{?\~{}=?} &
+\cross{GDMP}{?$<$?} \\
+\cross{GDMP}{?$<=$?} &
+\cross{GDMP}{?$>$?} &
+\cross{GDMP}{?$>=$?} \\
+\cross{GDMP}{?\^{}?} &&
 \end{tabular}
 
-\begin{chunk}{domain HEXADEC HexadecimalExpansion}
-)abbrev domain HEXADEC HexadecimalExpansion
-++ Author: Clifton J. Williamson
-++ Date Created: April 26, 1990
-++ Date Last Updated: May 15, 1991
+\begin{chunk}{domain GDMP GeneralDistributedMultivariatePolynomial}
+)abbrev domain GDMP GeneralDistributedMultivariatePolynomial
+++ Author: Barry Trager
 ++ Description:
-++ This domain allows rational numbers to be presented as repeating
-++ hexadecimal expansions.
+++ This type supports distributed multivariate polynomials
+++ whose variables are from a user specified list of symbols.
+++ The coefficient ring may be non commutative,
+++ but the variables are assumed to commute.
+++ The term ordering is specified by its third parameter.
+++ Suggested types which define term orderings include: 
+++ \spadtype{DirectProduct}, \spadtype{HomogeneousDirectProduct}, 
+++ \spadtype{SplitHomogeneousDirectProduct} and finally 
+++ \spadtype{OrderedDirectProduct} which accepts an arbitrary user
+++ function to define a term ordering.
 
-HexadecimalExpansion(): Exports == Implementation where
-  INT ==> Integer
-  CHAR ==> Character
-  Exports ==> QuotientFieldCategory(Integer) with
+GeneralDistributedMultivariatePolynomial(vl,R,E): public == private where
+  vl: List Symbol
+  R: Ring
+  E: DirectProductCategory(#vl,NonNegativeInteger)
+  OV  ==> OrderedVariableList(vl)
+  SUP ==> SparseUnivariatePolynomial
+  NNI ==> NonNegativeInteger
 
-    coerce: % -> Fraction Integer
-      ++ coerce(h) converts a hexadecimal expansion to a rational number.
+  public == PolynomialCategory(R,E,OV) with
+      reorder: (%,List Integer) -> %
+        ++ reorder(p, perm) applies the permutation perm to the variables
+        ++ in a polynomial and returns the new correctly ordered polynomial
 
-    coerce: % -> RadixExpansion(16)
-      ++ coerce(h) converts a hexadecimal expansion to a radix expansion
-      ++ with base 16.
+  private == PolynomialRing(R,E) add
+    --representations
 
-    fractionPart: % -> Fraction Integer
-      ++ fractionPart(h) returns the fractional part of a hexadecimal expansion
+      Term := Record(k:E,c:R)
 
-    hex: Fraction Integer -> %
-      ++ hex(r) converts a rational number to a hexadecimal expansion.
+      Rep := List Term
 
-    toint: String -> Integer
-      ++ toint(s) converts a hex string to integer
-      ++
-      ++X toint("FE")
-      ++X toint("BFD25E8C")
+      n := #vl
 
-  Implementation ==> RadixExpansion(16) add
-  
-    hex r == 
-      r :: %
+      Vec ==> Vector(NonNegativeInteger)
 
-    coerce(x:%):RadixExpansion(16) ==
-      x pretend RadixExpansion(16)
+      zero?(p : %): Boolean == null(p : Rep)
 
-    toint(s) ==
-      dec:Integer := 0
-      for i in 1..#s repeat 
-        if (s.i = char "0")$CHAR then dec := 16*dec
-        if (s.i = char "1")$CHAR then dec := 16*dec+1
-        if (s.i = char "2")$CHAR then dec := 16*dec+2
-        if (s.i = char "3")$CHAR then dec := 16*dec+3
-        if (s.i = char "4")$CHAR then dec := 16*dec+4
-        if (s.i = char "5")$CHAR then dec := 16*dec+5
-        if (s.i = char "6")$CHAR then dec := 16*dec+6
-        if (s.i = char "7")$CHAR then dec := 16*dec+7
-        if (s.i = char "8")$CHAR then dec := 16*dec+8
-        if (s.i = char "9")$CHAR then dec := 16*dec+9
-        if (s.i = char "A")$CHAR then dec := 16*dec+10
-        if (s.i = char "a")$CHAR then dec := 16*dec+10
-        if (s.i = char "B")$CHAR then dec := 16*dec+11
-        if (s.i = char "b")$CHAR then dec := 16*dec+11
-        if (s.i = char "C")$CHAR then dec := 16*dec+12
-        if (s.i = char "c")$CHAR then dec := 16*dec+12
-        if (s.i = char "D")$CHAR then dec := 16*dec+13
-        if (s.i = char "d")$CHAR then dec := 16*dec+13
-        if (s.i = char "E")$CHAR then dec := 16*dec+14
-        if (s.i = char "e")$CHAR then dec := 16*dec+14
-        if (s.i = char "F")$CHAR then dec := 16*dec+15
-        if (s.i = char "f")$CHAR then dec := 16*dec+15
-      dec
+      totalDegree p ==
+         zero? p => 0
+         "max"/[reduce("+",(t.k)::(Vector NNI), 0) for t in p]
 
-\end{chunk}
+      monomial(p:%, v: OV,e: NonNegativeInteger):% ==
+         locv := lookup v
+         p*monomial(1,
+            directProduct [if z=locv then e else 0 for z in 1..n]$Vec)
 
-\begin{chunk}{COQ HEXADEC}
-(* domain HEXADEC *)
-(*
-*)
+      coerce(v: OV):% == monomial(1,v,1)
 
-\end{chunk}
+      listCoef(p : %): List R ==
+        rec : Term
+        [rec.c for rec in (p:Rep)]
 
-\begin{chunk}{HEXADEC.dotabb}
-"HEXADEC" [color="#88FF44",href="bookvol10.3.pdf#nameddest=HEXADEC"]
-"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"]
-"HEXADEC" -> "PFECAT"
+      mainVariable(p: %) ==
+         zero?(p) => "failed"
+         for v in vl repeat
+           vv := variable(v)::OV
+           if degree(p,vv)>0 then return vv
+         "failed"
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{package HTMLFORM HTMLFormat}
-Here I have put some information about 'how to use' and 'the benefits of'
-this HTML formatter. Also some information for programmers if they want
-to extend this package.
+      ground?(p) == mainVariable(p) case "failed"
 
-If you want information about creating output formatters in general then,
-rather than duplicating content here I refer you to mathml.spad.pamphlet
-containing the MathMLFormat domain by Arthur C. Ralfs. This contains useful
-information for writers of output formatters.
+      retract(p : %): R ==
+          not ground? p => error "not a constant"
+          leadingCoefficient p
 
-\subsection{Overview}
+      retractIfCan(p : %): Union(R,"failed") ==
+        ground?(p) => leadingCoefficient p
+        "failed"
 
-This package allows users to cut and paste output from the Axiom
-command line to a HTML page. This output is enabled by typing:
+      degree(p: %,v: OV) == degree(univariate(p,v))
 
-\begin{verbatim}
-)set output html on
-\end{verbatim}
+      minimumDegree(p: %,v: OV) == minimumDegree(univariate(p,v))
 
-After this the command line will output html (in addition to other formats
-that are enabled) and this html code can then be copied and pasted into a
-HTML document.
+      differentiate(p: %,v: OV) ==
+            multivariate(differentiate(univariate(p,v)),v)
 
-The HTML produced is well formed XML, that is, all tags have equivalent
-closing tags.
+      degree(p: %,lv: List OV) == [degree(p,v) for v in lv]
 
-\subsection{Why output to HTML?}
+      minimumDegree(p: %,lv: List OV) == [minimumDegree(p,v) for v in lv]
 
-In some ways HTMLFormat is a compromise between the standard text output and
-specialised formats like MathMLFormat. The potential quality is never
-going to be as good as output to a specialised maths renderer but on
-the other hand it is a lot better than the clunky fixed width font
-text output. The quality is not the only issue though, the direct output
-in any format is unlikely to be exactly what the user wants, so possibly
-more important than quality is the ability to edit the output.
+      numberOfMonomials(p:%) ==
+        l : Rep := p : Rep
+        null(l) => 1
+        #l
 
-HTMLFormat has advantages that the other output formats don't, for instance,
-\begin{itemize}
-\item It works with any browser without the need for plugins (as far as I know
-most computers should have the required fonts)
-\item Users can easily annotate and add comments using colour, bold, underline
-and so on.
-\item Annotations can easily be done with whatever html editor or text editor
-you are familiar with.
-\item Edits to the output will cause the width of columns and so on to be
-automatically adjusted, no need to try to insert spaces to get the
-superscripts to line up again!
-\item It is very easy to customise output so, for instance, we can fit a lot of
-information in a compact space on the page.
-\end{itemize}
+      monomial?(p : %): Boolean ==
+        l : Rep := p : Rep
+        null(l) or null rest(l)
 
-\section{Using the formatter}
-We can cause the command line interpreter to output in html by typing
-the following:
+      if R has OrderedRing then
+        maxNorm(p : %): R ==
+          l : List R := nil
+          r,m : R
+          m := 0
+          for r in listCoef(p) repeat
+            if r > m then m := r
+            else if (-r) > m then m := -r
+          m
 
-\begin{verbatim}
-)set output html on
-\end{verbatim}
+      if R has Field then
+        (p : %) / (r : R) == inv(r) * p
 
-After this the command line will output html (in addition to other formats
-that are enabled) and this html code can then be copied and pasted into an
-existing HTML document.
+      variables(p: %) ==
+         maxdeg:Vector(NonNegativeInteger) := new(n,0)
+         while not zero?(p) repeat
+            tdeg := degree p
+            p := reductum p
+            for i in 1..n repeat
+              maxdeg.i := max(maxdeg.i, tdeg.i)
+         [index(i:PositiveInteger) for i in 1..n | maxdeg.i^=0]
 
-If you do not already have an html page to copy the output to then you can
-create one with a text editor and entering the following:
+      reorder(p: %,perm: List Integer):% ==
+         #perm ^= n => error "must be a complete permutation of all vars"
+         q := [[directProduct [term.k.j for j in perm]$Vec,term.c]$Term
+                         for term in p]
+         sort((z1,z2) +-> z1.k > z2.k,q)
 
-\begin{verbatim}
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" 
- "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml" >
- <head>
-  <title>Enter Your Title Here</title>
- </head>
- <body>
-  Copy and paste the output from command line here.
- </body>
-</html>
-\end{verbatim}
+      univariate(p: %,v: OV):SUP(%) ==
+         zero?(p) => 0
+         exp := degree p
+         locv := lookup v
+         deg:NonNegativeInteger := 0
+         nexp := directProduct [if i=locv then (deg :=exp.i;0) else exp.i
+                                        for i in 1..n]$Vec
+         monomial(monomial(leadingCoefficient p,nexp),deg)+
+                      univariate(reductum p,v)
 
-Or using any program that will export to html such as OpenOffice.org
-writer.
+      eval(p: %,v: OV,val:%):% == univariate(p,v)(val)
 
-\section{Form of the output}
-\begin{verbatim}
-HTMLFormat does not try to interpret syntax, for instance in an example like:
-(1) -> integral(x^x,x)
-it just takes what OutputForm provides and does not try to replace
-%A with the bound variable x.
-\end{verbatim}
+      eval(p: %,v: OV,val:R):% == eval(p,v,val::%)$%
 
-\section{Matrix Formatting}
-A big requirement for me is to fit big matrices on ordinary web pages.
+      eval(p: %,lv: List OV,lval: List R):% ==
+         lv = [] => p
+         eval(eval(p,first lv,(first lval)::%)$%, rest lv, rest lval)$%
 
-At the moment the default output for a matrix is a grid, however it easy to
-modify this for a single matrix, or a whole page or whole site by using css
-(cascading style sheets). For instance we can get a more conventional looking
-matrix by adding the following style to the top of the page after the <head>
-tag:
+      -- assume Lvar are sorted correctly
+      evalSortedVarlist(p: %,Lvar: List OV,Lpval: List %):% ==
+        v := mainVariable p
+        v case "failed" => p
+        pv := v:: OV
+        Lvar=[] or Lpval=[] => p
+        mvar := Lvar.first
+        mvar > pv => evalSortedVarlist(p,Lvar.rest,Lpval.rest)
+        pval := Lpval.first
+        pts:SUP(%):= map(x+->evalSortedVarlist(x,Lvar,Lpval),univariate(p,pv))
+        mvar=pv => pts(pval)
+        multivariate(pts,pv)
 
-\begin{verbatim}
-<style type="text/css">
-#matl {border-left-style:solid}
-#matr {border-right-style:solid}
-#matlt {border-left-style:solid;border-top-style:solid}
-#matrt {border-right-style:solid;border-top-style:solid}
-#matlb {border-left-style:solid;border-bottom-style:solid}
-#matrb {border-right-style:solid;border-bottom-style:solid}
-</style>
-\end{verbatim}
+      eval(p:%,Lvar:List OV,Lpval:List %) ==
+        nlvar:List OV := sort((x,y) +-> x > y,Lvar)
+        nlpval :=
+           Lvar = nlvar => Lpval
+           nlpval := [Lpval.position(mvar,Lvar) for mvar in nlvar]
+        evalSortedVarlist(p,nlvar,nlpval)
 
-There are many other possibilities, for instance we can generate a matrix
-with bars either side to indicate a determinant. All we have to do is
-change the css for the site, page or individual element.
+      multivariate(p1:SUP(%),v: OV):% ==
+        0=p1 => 0
+        degree p1 = 0 => leadingCoefficient p1
+        leadingCoefficient(p1)*(v::%)**degree(p1) +
+                  multivariate(reductum p1,v)
 
-\section{Programmers Guide}
-This package converts from OutputForm, which is a hierarchical tree structure,
-to html which uses tags arranged in a hierarchical tree structure. So the
-package converts from one tree (graph) structure to another.
+      univariate(p: %):SUP(R) ==
+        (v := mainVariable p) case "failed" =>
+                      monomial(leadingCoefficient p,0)
+        q := univariate(p,v:: OV)
+        ans:SUP(R) := 0
+        while q ^= 0 repeat
+          ans := ans + monomial(ground leadingCoefficient q,degree q)
+          q := reductum q
+        ans
 
-This conversion is done in two stages using an intermediate Tree String
-structure. This Tree String structure represents HTML where:
-\begin{itemize}
-\item leafs represents unstructured text
-\item string in leafs contains the text
-\item non-leafs represents xml elements
-\item string in non-leafs represents xml attributes
-\end{itemize}
+      multivariate(p:SUP(R),v: OV):% ==
+        0=p => 0
+        (leadingCoefficient p)*monomial(1,v,degree p) +
+                       multivariate(reductum p,v)
 
-This is created by traversing OutputForm while building up the Tree String
-structure.
+      if R has GcdDomain then
 
-The second stage is to convert the Tree Structure to text. All text output
-is done using:
-\begin{verbatim}
-sayTeX$Lisp
-\end{verbatim}
-I have not produced and output to String as I don't know a way to append
-to a long string efficiently and I don't know how to insert carriage-
-returns into a String.
+        content(p: %):R ==
+          zero?(p) => 0
+          "gcd"/[t.c for t in p]
 
-\subsection{Future Developments}
-There would be some benefits in creating a XMLFormat category which would
-contain common elements for all xml formatted outputs such as HTMLFormat,
-MathMLFormat, SVGFormat and X3DFormat. However programming effort might
-be better spent creating a version of OutputForm which has better syntax
-information.
+        if R has EuclideanDomain and not(R has FloatingPointSystem)  then
 
-\begin{chunk}{HTMLFormat.input}
-)set break resume
-)sys rm -f HTMLFormat.output
-)spool HTMLFormat.output
-)set message test on
-)set message auto off
-)clear all
+          gcd(p: %,q:%):% ==
+            gcd(p,q)$PolynomialGcdPackage(E,OV,R,%)
 
---S 1 of 9
-)show HTMLFormat
---R 
---R HTMLFormat  is a domain constructor
---R Abbreviation for HTMLFormat is HTMLFORM 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for HTMLFORM 
---R
---R------------------------------- Operations --------------------------------
---R ?=? : (%,%) -> Boolean                coerce : OutputForm -> String
---R coerce : % -> OutputForm              coerceL : OutputForm -> String
---R coerceS : OutputForm -> String        display : String -> Void
---R exprex : OutputForm -> String         hash : % -> SingleInteger
---R latex : % -> String                   ?~=? : (%,%) -> Boolean
---R
---E 1
+        else 
+          gcd(p: %,q:%):% ==
+            r : R
+            (pv := mainVariable(p)) case "failed" =>
+              (r := leadingCoefficient p) = 0$R => q
+              gcd(r,content q)::%
+            (qv := mainVariable(q)) case "failed" =>
+              (r := leadingCoefficient q) = 0$R => p
+              gcd(r,content p)::%
+            pv<qv => gcd(p,content univariate(q,qv))
+            qv<pv => gcd(q,content univariate(p,pv))
+            multivariate(gcd(univariate(p,pv),univariate(q,qv)),pv)
 
---S 2 of 9
-coerce("3+4"::OutputForm)$HTMLFORM
---R 
---R"3+4"
---R
---R   (1)  " "
---R                                                                 Type: String
---E 2
+      coerce(p: %) : OutputForm ==
+        zero?(p) => (0$R) :: OutputForm
+        l,lt : List OutputForm
+        lt := nil
+        vl1 := [v::OutputForm for v in vl]
+        for t in reverse p repeat
+          l := nil
+          for i in 1..#vl1 repeat
+            t.k.i = 0 => l
+            t.k.i = 1 => l := cons(vl1.i,l)
+            l := cons(vl1.i ** t.k.i ::OutputForm,l)
+          l := reverse l
+          if (t.c ^= 1) or (null l) then l := cons(t.c :: OutputForm,l)
+          1 = #l => lt := cons(first l,lt)
+          lt := cons(reduce("*",l),lt)
+        1 = #lt => first lt
+        reduce("+",lt)
 
---S 3 of 9
-coerce("sqrt(3+4)"::OutputForm)$HTMLFORM
---R 
---R"sqrt(3+4)"
---R
---R   (2)  " "
---R                                                                 Type: String
---E 3
+\end{chunk}
 
---S 4 of 9
-coerce(sqrt(3+4)::OutputForm)$HTMLFORM
---R 
---R&radic;7
---R
---R   (3)  " "
---R                                                                 Type: String
---E 4
+\begin{chunk}{COQ GDMP}
+(* domain GDMP *)
+(*
+ PolynomialRing(R,E) add
+    --representations
 
---S 5 of 9
-coerce(sqrt(3+x)::OutputForm)$HTMLFORM
---R 
---R<table border='0' id='root'>
---R<tr id='root'>
---R<td id='root'>
---R&radic;
---R</td>
---R<td id='root' style='border-top-style:solid'>
---Rx+3
---R</td>
---R</tr>
---R</table>
---R
---R   (4)  " "
---R                                                                 Type: String
---E 5
+      Term := Record(k:E,c:R)
 
---S 6 of 9
-coerceS(sqrt(3+x)::OutputForm)$HTMLFORM
---R 
---R<table border='0' id='root'>
---R<tr id='root'>
---R<td id='root'>
---R&radic;
---R</td>
---R<td id='root' style='border-top-style:solid'>
---Rx+3
---R</td>
---R</tr>
---R</table>
---R
---R   (5)  " "
---R                                                                 Type: String
---E 6
+      Rep := List Term
 
---S 7 of 9
-coerceL(sqrt(3+x)::OutputForm)$HTMLFORM
---R 
---R<table border='0' id='root'>
---R<tr id='root'>
---R<td id='root'>
---R&radic;
---R</td>
---R<td id='root' style='border-top-style:solid'>
---Rx+3
---R</td>
---R</tr>
---R</table>
---R
---R   (6)  " "
---R                                                                 Type: String
---E 7
+      n := #vl
 
---S 8 of 9
-exprex(sqrt(3+x)::OutputForm)$HTMLFORM
---R 
---R
---R   (7)  "{{ROOT}{{+}{x}{3}}}"
---R                                                                 Type: String
---E 8
+      Vec ==> Vector(NonNegativeInteger)
 
---S 9 of 9
-display(coerce(sqrt(3+x)::OutputForm)$HTMLFORM)$HTMLFORM
---R 
---R<table border='0' id='root'>
---R<tr id='root'>
---R<td id='root'>
---R&radic;
---R</td>
---R<td id='root' style='border-top-style:solid'>
---Rx+3
---R</td>
---R</tr>
---R</table>
---R 
---R                                                                   Type: Void
---E 9
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{HTMLFormat.help}
-====================================================================
-HTMLFormat examples
-====================================================================
+      zero?(p : %): Boolean == null(p : Rep)
 
-HtmlFormat provides a coercion from OutputForm to html.
+      totalDegree p ==
+         zero? p => 0
+         "max"/[reduce("+",(t.k)::(Vector NNI), 0) for t in p]
 
-coerce("3+4"::OutputForm)$HTMLFORM
-  "3+4"
+      monomial(p:%, v: OV,e: NonNegativeInteger):% ==
+         locv := lookup v
+         p*monomial(1,
+            directProduct [if z=locv then e else 0 for z in 1..n]$Vec)
 
-coerce("sqrt(3+4)"::OutputForm)$HTMLFORM
-  "sqrt(3+4)"
+      coerce(v: OV):% == monomial(1,v,1)
 
-coerce(sqrt(3+4)::OutputForm)$HTMLFORM
-  &radic;7
+      listCoef(p : %): List R ==
+        rec : Term
+        [rec.c for rec in (p:Rep)]
 
-coerce(sqrt(3+x)::OutputForm)$HTMLFORM
-  <table border='0' id='root'>
-  <tr id='root'>
-  <td id='root'>
-  &radic;
-  </td>
-  <td id='root' style='border-top-style:solid'>
-  x+3
-  </td>
-  </tr>
-  </table>
+      mainVariable(p: %) ==
+         zero?(p) => "failed"
+         for v in vl repeat
+           vv := variable(v)::OV
+           if degree(p,vv)>0 then return vv
+         "failed"
 
-coerceS(sqrt(3+x)::OutputForm)$HTMLFORM
-  <table border='0' id='root'>
-  <tr id='root'>
-  <td id='root'>
-  &radic;
-  </td>
-  <td id='root' style='border-top-style:solid'>
-  x+3
-  </td>
-  </tr>
-  </table>
-
-coerceL(sqrt(3+x)::OutputForm)$HTMLFORM
-  <table border='0' id='root'>
-  <tr id='root'>
-  <td id='root'>
-  &radic;
-  </td>
-  <td id='root' style='border-top-style:solid'>
-  x+3
-  </td>
-  </tr>
-  </table>
+      ground?(p) == mainVariable(p) case "failed"
 
-exprex(sqrt(3+x)::OutputForm)$HTMLFORM
-  "{{ROOT}{{+}{x}{3}}}"
+      retract(p : %): R ==
+          not ground? p => error "not a constant"
+          leadingCoefficient p
 
-display(coerce(sqrt(3+x)::OutputForm)$HTMLFORM)$HTMLFORM
-  <table border='0' id='root'>
-  <tr id='root'>
-  <td id='root'>
-  &radic;
-  </td>
-  <td id='root' style='border-top-style:solid'>
-  x+3
-  </td>
-  </tr>
-  </table>
+      retractIfCan(p : %): Union(R,"failed") ==
+        ground?(p) => leadingCoefficient p
+        "failed"
 
-See Also:
-o )show HTMLFormat
+      degree(p: %,v: OV) == degree(univariate(p,v))
 
-\end{chunk}
+      minimumDegree(p: %,v: OV) == minimumDegree(univariate(p,v))
 
-\pagehead{HTMLFormat}{HTMLFORM}
-\pagepic{ps/v103htmlformat.eps}{HTMLFORM}{1.00}
-{\bf See}\\
-\pagefrom{SetCategory}{SETCAT}
+      differentiate(p: %,v: OV) ==
+            multivariate(differentiate(univariate(p,v)),v)
 
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{HTMLFORM}{?=?} &
-\cross{HTMLFORM}{?~=?} &
-\cross{HTMLFORM}{coerce} &
-\cross{HTMLFORM}{coerceL} &
-\cross{HTMLFORM}{coerceS} \\
-\cross{HTMLFORM}{display} &
-\cross{HTMLFORM}{exprex} &
-\cross{HTMLFORM}{hash} &
-\cross{HTMLFORM}{latex} &
-\end{tabular}
+      degree(p: %,lv: List OV) == [degree(p,v) for v in lv]
 
-\begin{chunk}{domain HTMLFORM HTMLFormat}
-)abbrev domain HTMLFORM HTMLFormat
-++ Author: Martin J Baker, Arthur C. Ralfs, Robert S. Sutor
-++ Date: January 2010
-++ Description:
-++ HtmlFormat provides a coercion from OutputForm to html.
-HTMLFormat(): public == private where
-  E      ==> OutputForm
-  I      ==> Integer
-  L      ==> List
-  S      ==> String
+      minimumDegree(p: %,lv: List OV) == [minimumDegree(p,v) for v in lv]
 
-  public == SetCategory with
-    coerce:    E -> S
-      ++ coerce(o) changes o in the standard output format to html format.
-      ++
-      ++X coerce(sqrt(3+x)::OutputForm)$HTMLFORM
-    coerceS:   E -> S
-      ++ coerceS(o) changes o in the standard output format to html
-      ++ format and displays formatted result.
-      ++
-      ++X coerceS(sqrt(3+x)::OutputForm)$HTMLFORM
-    coerceL:   E -> S
-      ++ coerceL(o) changes o in the standard output format to html
-      ++ format and displays result as one long string.
-      ++
-      ++X coerceL(sqrt(3+x)::OutputForm)$HTMLFORM
-    exprex:    E -> S
-      ++ exprex(o) coverts \spadtype{OutputForm} to \spadtype{String}
-      ++
-      ++X exprex(sqrt(3+x)::OutputForm)$HTMLFORM
-    display:   S -> Void
-      ++ display(o) prints the string returned by coerce.
-      ++
-      ++X display(coerce(sqrt(3+x)::OutputForm)$HTMLFORM)$HTMLFORM
+      numberOfMonomials(p:%) ==
+        l : Rep := p : Rep
+        null(l) => 1
+        #l
 
-  private == add
-    import OutputForm
-    import Character
-    import Integer
-    import List OutputForm
-    import List String
+      monomial?(p : %): Boolean ==
+        l : Rep := p : Rep
+        null(l) or null rest(l)
 
-    expr: E
-    prec,opPrec: I
-    str:  S
-    blank         : S := " \  "
+      if R has OrderedRing then
+        maxNorm(p : %): R ==
+          l : List R := nil
+          r,m : R
+          m := 0
+          for r in listCoef(p) repeat
+            if r > m then m := r
+            else if (-r) > m then m := -r
+          m
 
-    maxPrec       : I   := 1000000
-    minPrec       : I   := 0
+      if R has Field then
+        (p : %) / (r : R) == inv(r) * p
 
-    unaryOps      : L S := ["-"]$(L S)
-    unaryPrecs    : L I := [700]$(L I)
+      variables(p: %) ==
+         maxdeg:Vector(NonNegativeInteger) := new(n,0)
+         while not zero?(p) repeat
+            tdeg := degree p
+            p := reductum p
+            for i in 1..n repeat
+              maxdeg.i := max(maxdeg.i, tdeg.i)
+         [index(i:PositiveInteger) for i in 1..n | maxdeg.i^=0]
 
-    -- the precedence of / in the following is relatively low because
-    -- the bar obviates the need for parentheses.
-    binaryOps     : L S := ["+->","|","^","/","<",">","=","OVER"]$(L S)
-    binaryPrecs   : L I := [0,0,900,700,400,400,400,700]$(L I)
-    naryOps       : L S := ["-","+","*",blank,",",";"," ","ROW","",
-       " \cr ","&","/\","\/"]$(L S)
-    naryPrecs     : L I := [700,700,800,800,110,110,0,0,0,0,0,600,600]$(L I)
-    naryNGOps     : L S := ["ROW","&"]$(L S)
-    plexOps       : L S := ["SIGMA","SIGMA2","PI","PI2","INTSIGN",_
-                            "INDEFINTEGRAL"]$(L S)
-    plexPrecs     : L I := [700,800,700,800,700,700]$(L I)
-    specialOps    : L S := ["MATRIX","BRACKET","BRACE","CONCATB","VCONCAT",_
-                            "AGGLST","CONCAT","OVERBAR","ROOT","SUB","TAG",_
-                            "SUPERSUB","ZAG","AGGSET","SC","PAREN",_
-                            "SEGMENT","QUOTE","theMap", "SLASH"]
+      reorder(p: %,perm: List Integer):% ==
+         #perm ^= n => error "must be a complete permutation of all vars"
+         q := [[directProduct [term.k.j for j in perm]$Vec,term.c]$Term
+                         for term in p]
+         sort((z1,z2) +-> z1.k > z2.k,q)
 
-    -- the next two lists provide translations for some strings for
-    -- which HTML has some special character codes.
-    specialStrings : L S :=
-      ["cos", "cot", "csc", "log", "sec", "sin", "tan", _
-       "cosh", "coth", "csch", "sech", "sinh", "tanh", _
-       "acos","asin","atan","erf","...","$","infinity","Gamma", _
-       "%pi","%e","%i"]
-    specialStringsInHTML : L S :=
-      ["cos","cot","csc","log","sec","sin","tan", _
-       "cosh","coth","csch","sech","sinh","tanh", _
-       "arccos","arcsin","arctan","erf","&#x2026;","$","&#x221E;",_
-       "&#x0413;","&#x003C0;","&#x02147;","&#x02148;"]
+      univariate(p: %,v: OV):SUP(%) ==
+         zero?(p) => 0
+         exp := degree p
+         locv := lookup v
+         deg:NonNegativeInteger := 0
+         nexp := directProduct [if i=locv then (deg :=exp.i;0) else exp.i
+                                        for i in 1..n]$Vec
+         monomial(monomial(leadingCoefficient p,nexp),deg)+
+                      univariate(reductum p,v)
 
-    debug := false
+      eval(p: %,v: OV,val:%):% == univariate(p,v)(val)
 
-    atomize:E -> L E
+      eval(p: %,v: OV,val:R):% == eval(p,v,val::%)$%
 
-    formatBinary:(S,L E, I) -> Tree S
+      eval(p: %,lv: List OV,lval: List R):% ==
+         lv = [] => p
+         eval(eval(p,first lv,(first lval)::%)$%, rest lv, rest lval)$%
 
-    formatFunction:(Tree S,L E, I) -> Tree S
+      -- assume Lvar are sorted correctly
+      evalSortedVarlist(p: %,Lvar: List OV,Lpval: List %):% ==
+        v := mainVariable p
+        v case "failed" => p
+        pv := v:: OV
+        Lvar=[] or Lpval=[] => p
+        mvar := Lvar.first
+        mvar > pv => evalSortedVarlist(p,Lvar.rest,Lpval.rest)
+        pval := Lpval.first
+        pts:SUP(%):= map(x+->evalSortedVarlist(x,Lvar,Lpval),univariate(p,pv))
+        mvar=pv => pts(pval)
+        multivariate(pts,pv)
 
-    formatMatrix:L E -> Tree S
+      eval(p:%,Lvar:List OV,Lpval:List %) ==
+        nlvar:List OV := sort((x,y) +-> x > y,Lvar)
+        nlpval :=
+           Lvar = nlvar => Lpval
+           nlpval := [Lpval.position(mvar,Lvar) for mvar in nlvar]
+        evalSortedVarlist(p,nlvar,nlpval)
 
-    formatNary:(S,L E, I) -> Tree S
+      multivariate(p1:SUP(%),v: OV):% ==
+        0=p1 => 0
+        degree p1 = 0 => leadingCoefficient p1
+        leadingCoefficient(p1)*(v::%)**degree(p1) +
+                  multivariate(reductum p1,v)
 
-    formatNaryNoGroup:(S,L E, I) -> Tree S
+      univariate(p: %):SUP(R) ==
+        (v := mainVariable p) case "failed" =>
+                      monomial(leadingCoefficient p,0)
+        q := univariate(p,v:: OV)
+        ans:SUP(R) := 0
+        while q ^= 0 repeat
+          ans := ans + monomial(ground leadingCoefficient q,degree q)
+          q := reductum q
+        ans
 
-    formatNullary:S -> Tree S
+      multivariate(p:SUP(R),v: OV):% ==
+        0=p => 0
+        (leadingCoefficient p)*monomial(1,v,degree p) +
+                       multivariate(reductum p,v)
 
-    formatPlex:(S,L E, I) -> Tree S
+      if R has GcdDomain then
 
-    formatSpecial:(S,L E, I) -> Tree S
+        content(p: %):R ==
+          zero?(p) => 0
+          "gcd"/[t.c for t in p]
 
-    formatUnary:(S,  E, I) -> Tree S
+        if R has EuclideanDomain and not(R has FloatingPointSystem)  then
 
-    formatHtml:(E,I) -> Tree S
+          gcd(p: %,q:%):% ==
+            gcd(p,q)$PolynomialGcdPackage(E,OV,R,%)
 
-    precondition:E -> E
-      -- this function is applied to the OutputForm expression before
-      -- doing anything else.
+        else 
+          gcd(p: %,q:%):% ==
+            r : R
+            (pv := mainVariable(p)) case "failed" =>
+              (r := leadingCoefficient p) = 0$R => q
+              gcd(r,content q)::%
+            (qv := mainVariable(q)) case "failed" =>
+              (r := leadingCoefficient q) = 0$R => p
+              gcd(r,content p)::%
+            pv<qv => gcd(p,content univariate(q,qv))
+            qv<pv => gcd(q,content univariate(p,pv))
+            multivariate(gcd(univariate(p,pv),univariate(q,qv)),pv)
 
-    outputTree:Tree S -> Void
-      -- This function traverses the tree and linierises it into a string.
-      -- To get the formatting we use a nested set of tables. It also checks
-      -- for +- and removes the +. it may also need to remove the outer
-      -- set of brackets.
+      coerce(p: %) : OutputForm ==
+        zero?(p) => (0$R) :: OutputForm
+        l,lt : List OutputForm
+        lt := nil
+        vl1 := [v::OutputForm for v in vl]
+        for t in reverse p repeat
+          l := nil
+          for i in 1..#vl1 repeat
+            t.k.i = 0 => l
+            t.k.i = 1 => l := cons(vl1.i,l)
+            l := cons(vl1.i ** t.k.i ::OutputForm,l)
+          l := reverse l
+          if (t.c ^= 1) or (null l) then l := cons(t.c :: OutputForm,l)
+          1 = #l => lt := cons(first l,lt)
+          lt := cons(reduce("*",l),lt)
+        1 = #lt => first lt
+        reduce("+",lt)
 
-    stringify:E -> S
+*)
 
-    coerce(expr : E): S ==
-      outputTree formatHtml(precondition expr, minPrec)
-      " "
+\end{chunk}
 
-    coerceS(expr : E): S ==
-      outputTree formatHtml(precondition expr, minPrec)
-      " "
+\begin{chunk}{GDMP.dotabb}
+"GDMP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GDMP"]
+"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
+"GDMP" -> "ALIST"
 
-    coerceL(expr : E): S ==
-      outputTree formatHtml(precondition expr, minPrec)
-      " "
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain GMODPOL GeneralModulePolynomial}
 
-    display(html : S): Void ==
-      sayTeX$Lisp html
-      void()$Void
+\begin{chunk}{GeneralModulePolynomial.input}
+)set break resume
+)sys rm -f GeneralModulePolynomial.output
+)spool GeneralModulePolynomial.output
+)set message test on
+)set message auto off
+)clear all
 
-    newNode(tag:S,node: Tree S): (Tree S) ==
-      t := tree(S,[node])
-      setvalue!(t,tag)
-      t
+--S 1 of 1
+)show GeneralModulePolynomial
+--R 
+--R GeneralModulePolynomial(vl: List(Symbol),R: CommutativeRing,IS: OrderedSet,E: DirectProductCategory(#(vl),NonNegativeInteger),ff: ((Record(index: IS,exponent: E),Record(index: IS,exponent: E)) -> Boolean),P: PolynomialCategory(R,E,OrderedVariableList(vl)))  is a domain constructor
+--R Abbreviation for GeneralModulePolynomial is GMODPOL 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for GMODPOL 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (R,%) -> %                      ?*? : (%,R) -> %
+--R ?*? : (%,P) -> %                      ?*? : (P,%) -> %
+--R ?*? : (Integer,%) -> %                ?*? : (NonNegativeInteger,%) -> %
+--R ?*? : (PositiveInteger,%) -> %        ?+? : (%,%) -> %
+--R ?-? : (%,%) -> %                      -? : % -> %
+--R ?=? : (%,%) -> Boolean                0 : () -> %
+--R build : (R,IS,E) -> %                 coerce : % -> OutputForm
+--R hash : % -> SingleInteger             latex : % -> String
+--R leadingCoefficient : % -> R           leadingExponent : % -> E
+--R leadingIndex : % -> IS                multMonom : (R,E,%) -> %
+--R reductum : % -> %                     sample : () -> %
+--R unitVector : IS -> %                  zero? : % -> Boolean
+--R ?~=? : (%,%) -> Boolean              
+--R leadingMonomial : % -> ModuleMonomial(IS,E,ff)
+--R monomial : (R,ModuleMonomial(IS,E,ff)) -> %
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R
+--E 1
 
-    newNodes(tag:S,nodes: L Tree S): (Tree S) ==
-      t := tree(S,nodes)
-      setvalue!(t,tag)
-      t
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{GeneralModulePolynomial.help}
+====================================================================
+GeneralModulePolynomial examples
+====================================================================
 
-    -- returns true if this can be represented without a table
-    notTable?(node: Tree S): Boolean ==
-      empty?(node) => true
-      leaf?(node) => true
-      prefix?("table",value(node))$String => false
-      c := children(node)
-      for a in c repeat
-        if not notTable?(a) then return false
-      true
+This package is undocumented
 
-    -- this retuns a string representation of OutputForm arguments
-    -- it is used when debug is true to trace the calling of functions
-    -- in this package
-    argsToString(args : L E): S ==
-      sop : S := exprex first args
-      args := rest args
-      s : S := concat ["{",sop]
-      for a in args repeat
-          s1 : S := exprex a
-          s := concat [s,s1]
-      s := concat [s,"}"]
+See Also:
+o )show GeneralModulePolynomial
 
-    exprex(expr : E): S ==
-      -- This breaks down an expression into atoms and returns it as
-      -- a string.  It's for developmental purposes to help understand
-      -- the expressions.
-      a : E
-      expr := precondition expr
-      (ATOM(expr)$Lisp@Boolean) or (stringify expr = "NOTHING") =>
-        concat ["{",stringify expr,"}"]
-      le : L E := (expr pretend L E)
-      op := first le
-      sop : S := exprex op
-      args : L E := rest le
-      nargs : I := #args
-      s : S := concat ["{",sop]
-      if nargs > 0  then
-        for a in args repeat
-          s1 : S := exprex a
-          s := concat [s,s1]
-      s := concat [s,"}"]
+\end{chunk}
 
-    atomize(expr : E): L E ==
-      -- This breaks down an expression into a flat list of atomic
-      -- expressions.
-      -- expr should be preconditioned.
-      le : L E := nil()
-      a : E
-      letmp : L E
-      (ATOM(expr)$Lisp@Boolean) or (stringify expr = "NOTHING") =>
-        le := append(le,list(expr))
-      letmp := expr pretend L E
-      for a in letmp repeat
-        le := append(le,atomize a)
-      le
+\pagehead{GeneralModulePolynomial}{GMODPOL}
+\pagepic{ps/v103generalmodulepolynomial.ps}{GMODPOL}{1.00}
+{\bf See}\\
+\pageto{ModuleMonomial}{MODMONOM}
 
-    -- output html test using tables and
-    -- remove unnecessary '+' at end of first string
-    -- when second string starts with '-'
-    outputTree(t: Tree S): Void ==
-      endWithPlus:Boolean := false -- if the last string ends with '+'
-      -- and the next string starts with '-' then the '+' needs to be
-      -- removed
-      if empty?(t) then
-        --if debug then sayTeX$Lisp "outputTree empty"
-        return void()$Void
-      if leaf?(t) then
-        --if debug then sayTeX$Lisp concat("outputTree leaf:",value(t))
-        sayTeX$Lisp value(t)
-        return void()$Void
-      tagName := copy value(t)
-      tagPos := position(char(" "),tagName,1)$String
-      if tagPos > 1 then
-        tagName := split(tagName,char(" ")).1
-        --sayTeX$Lisp "outputTree: tagPos="string(tagPos)" "tagName
-      if value(t) ~= "" then sayTeX$Lisp concat ["<",value(t),">"]
-      c := children(t)
-      enableGrid:Boolean := (#c > 1) and not notTable?(t)
-      if enableGrid then
-        if tagName = "table" then enableGrid := false
-        if tagName = "tr" then enableGrid := false
-      b:List Boolean := [leaf?(c1) for c1 in c]
-      -- if all children are strings then no need to wrap in table
-      allString: Boolean := true
-      for c1 in c repeat if not leaf?(c1) then allString := false
-      if allString then
-        s:String := ""
-        for c1 in c repeat s := concat(s,value(c1))
-        sayTeX$Lisp s
-        if value(t) ~= "" then sayTeX$Lisp concat ["</",tagName,">"]
-        return void()$Void
-      if enableGrid then
-        sayTeX$Lisp "<table border='0'>"
-        sayTeX$Lisp "<tr>"
-      for c1 in c repeat
-        if enableGrid then sayTeX$Lisp "<td>"
-        outputTree(c1)
-        if enableGrid then sayTeX$Lisp "</td>"
-      if enableGrid then
-        sayTeX$Lisp "</tr>"
-        sayTeX$Lisp "</table>"
-      if value(t) ~= "" then sayTeX$Lisp concat ["</",tagName,">"]
-      void()$Void
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{GMODPOL}{0} &
+\cross{GMODPOL}{build} &
+\cross{GMODPOL}{coerce} &
+\cross{GMODPOL}{hash} &
+\cross{GMODPOL}{latex} \\
+\cross{GMODPOL}{leadingCoefficient} &
+\cross{GMODPOL}{leadingExponent} &
+\cross{GMODPOL}{leadingIndex} &
+\cross{GMODPOL}{leadingMonomial} &
+\cross{GMODPOL}{monomial} \\
+\cross{GMODPOL}{multMonom} &
+\cross{GMODPOL}{reductum} &
+\cross{GMODPOL}{sample} &
+\cross{GMODPOL}{subtractIfCan} &
+\cross{GMODPOL}{unitVector} \\
+\cross{GMODPOL}{zero?} &
+\cross{GMODPOL}{?\~{}=?} &
+\cross{GMODPOL}{?*?} &
+\cross{GMODPOL}{?+?} &
+\cross{GMODPOL}{?-?} \\
+\cross{GMODPOL}{-?} &
+\cross{GMODPOL}{?=?} &&&
+\end{tabular}
 
-    stringify expr == (mathObject2String$Lisp expr)@S
+\begin{chunk}{domain GMODPOL GeneralModulePolynomial}
+)abbrev domain GMODPOL GeneralModulePolynomial
+++ Author: Mark Botch
+++ Description:
+++ This package is undocumented
 
-    precondition expr ==
-      outputTran$Lisp expr
+GeneralModulePolynomial(vl, R, IS, E, ff, P): public  ==  private where
+  vl: List(Symbol)
+  R: CommutativeRing
+  IS: OrderedSet
+  NNI ==> NonNegativeInteger
+  E: DirectProductCategory(#vl, NNI)
+  MM ==> Record(index:IS, exponent:E)
+  ff: (MM, MM) -> Boolean
+  OV  ==> OrderedVariableList(vl)
+  P: PolynomialCategory(R, E, OV)
+  ModMonom ==> ModuleMonomial(IS, E, ff)
 
-    -- I dont know what SC is so put it in a table for now
-    formatSC(args : L E, prec : I)  : Tree S ==
-      if debug then sayTeX$Lisp "formatSC: "concat [" args=",_
-        argsToString(args)," prec=",string(prec)$S]
-      null args => tree("")
-      cells:L Tree S := [_
-        newNode("td id='sc' style='border-bottom-style:solid'",_
-        formatHtml(a,prec)) for a in args]
-      row:Tree S := newNodes("tr id='sc'",cells)
-      newNode("table border='0' id='sc'",row)
 
-    -- to build an overbar we put it in a single column,
-    -- single row table and set the top border to solid
-    buildOverbar(content : Tree S) : Tree S ==
-      if debug then sayTeX$Lisp "buildOverbar"
-      cell:Tree S := _
-        newNode("td id='overbar' style='border-top-style:solid'",content)
-      row:Tree S := newNode("tr id='overbar'",cell)
-      newNode("table border='0' id='overbar'",row)
+  public  ==  Join(Module(P), Module(R))  with
+    leadingCoefficient: $ -> R
+      ++ leadingCoefficient(x) is not documented
+    leadingMonomial: $ -> ModMonom
+      ++ leadingMonomial(x) is not documented
+    leadingExponent: $ -> E
+      ++ leadingExponent(x) is not documented
+    leadingIndex: $ -> IS
+      ++ leadingIndex(x) is not documented
+    reductum: $ -> $
+      ++ reductum(x) is not documented
+    monomial: (R, ModMonom) -> $
+      ++ monomial(r,x) is not documented
+    unitVector: IS -> $
+      ++ unitVector(x) is not documented
+    build: (R, IS, E) -> $
+      ++ build(r,i,e) is not documented
+    multMonom: (R, E, $) -> $
+      ++ multMonom(r,e,x) is not documented
+    "*": (P,$) -> $
+      ++ p*x is not documented
 
-    -- to build an square root we put it in a double column,
-    -- single row table and set the top border of the second column to
-    -- solid
-    buildRoot(content : Tree S) : Tree S ==
-      if debug then sayTeX$Lisp "buildRoot"
-      if leaf?(content) then
-        -- root of a single term so no need for overbar
-        return newNodes("",[tree("&radic;"),content])
-      cell1:Tree S := newNode("td id='root'",tree("&radic;"))
-      cell2:Tree S := _
-        newNode("td id='root' style='border-top-style:solid'",content)
-      row:Tree S := newNodes("tr id='root'",[cell1,cell2])
-      newNode("table border='0' id='root'",row)
 
-    -- to build an 'n'th root we put it in a double column,
-    -- single row table and set the top border of the second column to
-    -- solid
-    buildNRoot(content : Tree S,nth: Tree S) : Tree S ==
-      if debug then sayTeX$Lisp "buildNRoot"
-      power:Tree S := newNode("sup",nth)
-      if leaf?(content) then
-        -- root of a single term so no need for overbar
-        return newNodes("",[power,tree("&radic;"),content])
-      cell1:Tree S := newNodes("td id='nroot'",[power,tree("&radic;")])
-      cell2:Tree S := _
-        newNode("td id='nroot' style='border-top-style:solid'",content)
-      row:Tree S := newNodes("tr id='nroot'",[cell1,cell2])
-      newNode("table border='0' id='nroot'",row)
+  private  ==  FreeModule(R, ModMonom)  add
 
-    -- formatSpecial handles "theMap","AGGLST","AGGSET","TAG","SLASH",
-    -- "VCONCAT", "CONCATB","CONCAT","QUOTE","BRACKET","BRACE","PAREN",
-    -- "OVERBAR","ROOT", "SEGMENT","SC","MATRIX","ZAG"
-    -- note "SUB" and "SUPERSUB" are handled directly by formatHtml
-    formatSpecial(op : S, args : L E, prec : I) : Tree S ==
-      if debug then sayTeX$Lisp _
-        "formatSpecial: " concat ["op=",op," args=",argsToString(args),_
-          " prec=",string(prec)$S]
-      arg : E
-      prescript : Boolean := false
-      op = "theMap" => tree("theMap(...)")
-      op = "AGGLST" =>
-        formatNary(",",args,prec)
-      op = "AGGSET" =>
-        formatNary(";",args,prec)
-      op = "TAG" =>
-        newNodes("",[formatHtml(first args,prec),tree("&#x02192;"),_
-          formatHtml(second args,prec)])
-        --RightArrow
-      op = "SLASH" =>
-        newNodes("",[formatHtml(first args, prec),tree("/"),_
-          formatHtml(second args,prec)])
-      op = "VCONCAT" =>
-        newNodes("table",[newNode("td",formatHtml(u, minPrec))_
-           for u in args]::L Tree S)
-      op = "CONCATB" =>
-        formatNary(" ",args,prec)
-      op = "CONCAT" =>
-        formatNary("",args,minPrec)
-      op = "QUOTE" =>
-        newNodes("",[tree("'"),formatHtml(first args, minPrec)])
-      op = "BRACKET" =>
-        newNodes("",[tree("["),formatHtml(first args, minPrec),tree("]")])
-      op = "BRACE" =>
-        newNodes("",[tree("{"),formatHtml(first args, minPrec),tree("}")])
-      op = "PAREN" =>
-        newNodes("",[tree("("),formatHtml(first args, minPrec),tree(")")])
-      op = "OVERBAR" =>
-        null args => tree("")
-        buildOverbar(formatHtml(first args,minPrec))
-      op = "ROOT" and #args < 1 => tree("")
-      op = "ROOT" and #args = 1 => _
-        buildRoot(formatHtml(first args, minPrec))
-      op = "ROOT" and #args > 1 => _
-        buildNRoot(formatHtml(first args, minPrec),_
-          formatHtml(second args, minPrec))
-      op = "SEGMENT" =>
-        -- '..' indicates a range in a list for example
-        tmp : Tree S := newNodes("",[formatHtml(first args, minPrec),_
-          tree("..")])
-        null rest args =>  tmp
-        newNodes("",[tmp,formatHtml(first rest args, minPrec)])
-      op = "SC" => formatSC(args,minPrec)
-      op = "MATRIX" => formatMatrix rest args
-      op = "ZAG" =>
-        -- {{+}{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}}_
-        --      {{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
-        -- to format continued fraction traditionally need to intercept
-        -- it at the formatNary of the "+"
-        newNodes("",[tree(" \zag{"),formatHtml(first args, minPrec),
-          tree("}{"),
-          formatHtml(first rest args,minPrec),tree("}")])
-      tree("formatSpecial not implemented:"op)
+        Rep:= FreeModule(R, ModMonom)
 
-    formatSuperSub(expr : E, args : L E, opPrec : I) : Tree S ==
-      -- This one produces ordinary derivatives with differential notation,
-      -- it needs a little more work yet.
-      -- first have to divine the semantics, add cases as needed
-      if debug then sayTeX$Lisp _
-        "formatSuperSub: " concat ["expr=",stringify expr," args=",_
-          argsToString(args)," prec=",string(opPrec)$S]
-      atomE : L E := atomize(expr)
-      op : S := stringify first atomE
-      op ~= "SUPERSUB" => tree("Mistake in formatSuperSub: no SUPERSUB")
-      #args ~= 1 => tree("Mistake in SuperSub: #args <> 1")
-      var : E := first args
-      -- should be looking at something like {{SUPERSUB}{var}{ }{,,...,}}
-      -- for example here's the second derivative of y w.r.t. x
-      -- {{{SUPERSUB}{y}{ }{,,}}{x}}, expr is the first {} and args is the
-      -- {x}
-      funcS : S := stringify first rest atomE
-      bvarS : S := stringify first args
-      -- count the number of commas
-      commaS : S := stringify first rest rest rest atomE
-      commaTest : S := ","
-      ndiffs : I := 0
-      while position(commaTest,commaS,1) > 0 repeat
-        ndiffs := ndiffs+1
-        commaTest := commaTest","
-      res:Tree S := newNodes("",_
-        [tree("&#x02146;"string(ndiffs)""funcS"&#x02146;"),_
-          formatHtml(first args,minPrec),tree(""string(ndiffs)"&#x02061;"),_
-            formatHtml(first args,minPrec),tree(")")])
-      res
+        leadingMonomial(p:$):ModMonom == leadingSupport(p)$Rep
 
-    -- build structure such as integral as a table
-    buildPlex3(main:Tree S,supsc:Tree S,op:Tree S,subsc:Tree S) : Tree S ==
-      if debug then sayTeX$Lisp "buildPlex"
-      ssup:Tree S := newNode("td id='plex'",supsc)
-      sop:Tree S := newNode("td id='plex'",op)
-      ssub:Tree S := newNode("td id='plex'",subsc)
-      m:Tree S := newNode("td rowspan='3' id='plex'",main)
-      rows:(List Tree S) := [newNodes("tr id='plex'",[ssup,m]),_
-        newNode("tr id='plex'",sop),newNode("tr id='plex'",ssub)]
-      newNodes("table border='0' id='plex'",rows)
+        leadingExponent(p:$):E == exponent(leadingMonomial p)
 
-    -- build structure such as integral as a table
-    buildPlex2(main : Tree S,supsc : Tree S,op : Tree S) : Tree S ==
-      if debug then sayTeX$Lisp "buildPlex"
-      ssup:Tree S := newNode("td id='plex'",supsc)
-      sop:Tree S := newNode("td id='plex'",op)
-      m:Tree S := newNode("td rowspan='2' id='plex'",main)
-      rows:(List Tree S) := [newNodes("tr id='plex'",[sop,m]),_
-        newNode("tr id='plex'",ssup)]
-      newNodes("table border='0' id='plex'",rows)
+        leadingIndex(p:$):IS == index(leadingMonomial p)
 
-    -- format an integral
-    -- args.1 = "NOTHING"
-    -- args.2 = bound variable
-    -- args.3 = body, thing being integrated
-    --
-    -- axiom replaces the bound variable with somthing like
-    -- %A and puts the original variable used
-    -- in the input command as a superscript on the integral sign.
-    formatIntSign(args : L E, opPrec : I) : Tree S ==
-      -- the original OutputForm expression looks something like this:
-      -- {{INTSIGN}{NOTHING or lower limit?}
-      -- {bvar or upper limit?}{{*}{integrand}{{CONCAT}{d}{axiom var}}}}
-      -- the args list passed here consists of the rest of this list, i.e.
-      -- starting at the NOTHING or ...
-      if debug then sayTeX$Lisp "formatIntSign: " concat [" args=",_
-        argsToString(args)," prec=",string(opPrec)$S]
-      (stringify first args) = "NOTHING" =>
-        buildPlex2(formatHtml(args.3,opPrec),tree("&int;"),_
-          formatHtml(args.2,opPrec)) -- could use &#x0222B; or &int;
-      buildPlex3(formatHtml(first args,opPrec),formatHtml(args.3,opPrec),_
-        tree("&int;"),formatHtml(args.2,opPrec))
+        unitVector(i:IS):$ == monomial(1,[i, 0$E]$ModMonom)
 
-    -- plex ops are "SIGMA","SIGMA2","PI","PI2","INTSIGN","INDEFINTEGRAL"
-    -- expects 2 or 3 args
-    formatPlex(op : S, args : L E, prec : I) : Tree S ==
-      if debug then sayTeX$Lisp "formatPlex: " concat ["op=",op," args=",_
-        argsToString(args)," prec=",string(prec)$S]
-      checkarg:Boolean := false
-      hold : S
-      p : I := position(op,plexOps)
-      p < 1 => error "unknown plex op"
-      op = "INTSIGN" => formatIntSign(args,minPrec)
-      opPrec := plexPrecs.p
-      n : I := #args
-      (n ~= 2) and (n ~= 3) => error "wrong number of arguments for plex"
-      s : Tree S :=
-        op = "SIGMA"   =>
-          checkarg := true
-          tree("&#x02211;")
-        -- Sum
-        op = "SIGMA2"   =>
-          checkarg := true
-          tree("&#x02211;")
-        -- Sum
-        op = "PI"      =>
-          checkarg := true
-          tree("&#x0220F;")
-        -- Product
-        op = "PI2"     =>
-          checkarg := true
-          tree("&#x0220F;")
-        -- Product
-        op = "INTSIGN" => tree("&#x0222B;")
-        -- Integral, int
-        op = "INDEFINTEGRAL" => tree("&#x0222B;")
-        -- Integral, int
-        tree("formatPlex: unexpected op:"op)
-      -- if opPrec < prec then perhaps we should parenthesize?
-      -- but we need to be careful we don't get loads of unnecessary
-      -- brackets
-      if n=2 then return buildPlex2(formatHtml(first args,minPrec),_
-        formatHtml(args.2,minPrec),s)
-      buildPlex3(formatHtml(first args,minPrec),formatHtml(args.2,minPrec),_
-        s,formatHtml(args.3,minPrec))
+        build(c:R, i:IS, e:E):$  ==  monomial(c, construct(i, e))
 
-    -- an example is: op=ROW arg={{ROW}{1}{2}}
-    formatMatrixRow(op : S, arg : E, prec : I,y:I,h:I)  : L Tree S ==
-      if debug then sayTeX$Lisp "formatMatrixRow: " concat ["op=",op,_
-        " args=",stringify arg," prec=",string(prec)$S]
-      ATOM(arg)$Lisp@Boolean => [_
-        tree("formatMatrixRow does not contain row")]
-      l : L E := (arg pretend L E)
-      op : S := stringify first l
-      args : L E := rest l
-      --sayTeX$Lisp "formatMatrixRow op="op" args="argsToString(args)
-      w:I := #args
-      cells:(List Tree S) := empty()
-      for x in 1..w repeat
-        --sayTeX$Lisp "formatMatrixRow: x="string(x)$S" width="string(w)$S
-        attrib:S := "td id='mat'"
-        if x=1 then attrib := "td id='matl'"
-        if x=w then attrib := "td id='matr'"
-        if y=1 then attrib := "td id='matt'"
-        if y=h then attrib := "td id='matb'"
-        if x=1 and y=1 then attrib := "td id='matlt'"
-        if x=1 and y=h then attrib := "td id='matlb'"
-        if x=w and y=1  then attrib := "td id='matrt'"
-        if x=w and y=h  then attrib := "td id='matrb'"
-        cells := append(cells,[newNode(attrib,formatHtml(args.(x),prec))])
-      cells
+     ----   WARNING: assumes c ^= 0
+        multMonom(c:R, e:E, mp:$):$  ==
+            zero? mp => mp
+            monomial(c * leadingCoefficient mp, [leadingIndex mp,
+                     e + leadingExponent mp]) + multMonom(c, e, reductum mp)
 
-    -- an example is: op=MATRIX args={{ROW}{1}{2}}{{ROW}{3}{4}}
-    formatMatrixContent(op : S, args : L E, prec : I)  : L Tree S ==
-      if debug then sayTeX$Lisp "formatMatrixContent: " concat ["op=",op,_
-        " args=",argsToString(args)," prec=",string(prec)$S]
-      y:I := 0
-      rows:(List Tree S) := [newNodes("tr id='mat'",_
-        formatMatrixRow("ROW",e,prec,y:=y+1,#args)) for e in args]
-      rows
+        ((p:P) * (mp:$)):$  ==
+            zero? p => 0
+            multMonom(leadingCoefficient p, degree p, mp) +
+               reductum(p) * mp
 
-    formatMatrix(args : L E) : Tree S ==
-      -- format for args is [[ROW ...],[ROW ...],[ROW ...]]
-      -- generate string for formatting columns (centered)
-      if debug then sayTeX$Lisp "formatMatrix: " concat ["args=",_
-        argsToString(args)]
-      newNodes("table border='1' id='mat'",_
-        formatMatrixContent("MATRIX",args,minPrec))
+\end{chunk}
 
-    -- output arguments in column table
-    buildColumnTable(elements : List Tree S) : Tree S ==
-      if debug then sayTeX$Lisp "buildColumnTable"
-      cells:(List Tree S) := [newNode("td id='col'",j) for j in elements]
-      rows:(List Tree S) := [newNode("tr id='col'",i) for i in cells]
-      newNodes("table border='0' id='col'",rows)
+\begin{chunk}{COQ GMODPOL}
+(* domain GMODPOL *)
+(*
 
-    -- build superscript structure as either sup tag or
-    -- if it contains anything that won't go into a
-    -- sup tag then build it as a table
-    buildSuperscript(main : Tree S,super : Tree S) : Tree S ==
-      if debug then sayTeX$Lisp "buildSuperscript"
-      notTable?(super) => newNodes("",[main,newNode("sup",super)])
-      m:Tree S := newNode("td rowspan='2' id='sup'",main)
-      su:Tree S := newNode("td id='sup'",super)
-      e:Tree S := newNode("td id='sup'",tree("&nbsp;"))
-      rows:(List Tree S) := [newNodes("tr id='sup'",[m,su]),_
-        newNode("tr id='sup'",e)]
-      newNodes("table border='0' id='sup'",rows)
+        Rep:= FreeModule(R, ModMonom)
 
-    -- build subscript structure as either sub tag or
-    -- if it contains anything that won't go into a
-    -- sub tag then build it as a table
-    buildSubscript(main : Tree S,subsc : Tree S) : Tree S ==
-      if debug then sayTeX$Lisp "buildSubscript"
-      notTable?(subsc) => newNodes("",[main,newNode("sub",subsc)])
-      m:Tree S := newNode("td rowspan='2' id='sub'",main)
-      su:Tree S := newNode("td id='sub'",subsc)
-      e:Tree S := newNode("td id='sub'",tree("&nbsp;"))
-      rows:(List Tree S) := [newNodes("tr id='sub'",[m,e]),_
-        newNode("tr id='sub'",su)]
-      newNodes("table border='0' id='sub'",rows)
+        leadingMonomial(p:$):ModMonom == leadingSupport(p)$Rep
 
-    formatSub(expr : E, args : L E, opPrec : I) : Tree S ==
-      -- format subscript
-      -- this function expects expr to start with SUB
-      -- it expects first args to be the operator or value that
-      -- the subscript is applied to
-      -- and the rest args to be the subscript
-      if debug then sayTeX$Lisp "formatSub: " concat ["expr=",_
-        stringify expr," args=",argsToString(args)," prec=",_
-          string(opPrec)$S]
-      atomE : L E := atomize(expr)
-      if empty?(atomE) then
-        if debug then sayTeX$Lisp "formatSub: expr=empty"
-        return tree("formatSub: expr=empty")
-      op : S := stringify first atomE
-      op ~= "SUB" =>
-        if debug then sayTeX$Lisp "formatSub: expr~=SUB"
-        tree("formatSub: expr~=SUB")
-      -- assume args.1 is the expression and args.2 is its subscript
-      if #args < 2 then
-        if debug then sayTeX$Lisp concat("formatSub: num args=",_
-          string(#args)$String)$String
-        return tree(concat("formatSub: num args=",_
-          string(#args)$String)$String)
-      if #args > 2 then
-        if debug then sayTeX$Lisp concat("formatSub: num args=",_
-          string(#args)$String)$String
-        return buildSubscript(formatHtml(first args,opPrec),_
-          newNodes("",[formatHtml(e,opPrec) for e in rest args]))
-      buildSubscript(formatHtml(first args,opPrec),_
-        formatHtml(args.2,opPrec))
+        leadingExponent(p:$):E == exponent(leadingMonomial p)
 
-    formatFunction(op : Tree S, args : L E, prec : I) : Tree S ==
-      if debug then sayTeX$Lisp "formatFunction: " concat ["args=",_
-        argsToString(args)," prec=",string(prec)$S]
-      newNodes("",[op,tree("("),formatNary(",",args,minPrec),tree(")")])
+        leadingIndex(p:$):IS == index(leadingMonomial p)
 
-    formatNullary(op : S) : Tree S ==
-      if debug then sayTeX$Lisp "formatNullary: " concat ["op=",op]
-      op = "NOTHING" => empty()$Tree(S)
-      tree(op"()")
+        unitVector(i:IS):$ == monomial(1,[i, 0$E]$ModMonom)
 
-    -- implement operation with single argument
-    -- an example is minus '-'
-    -- prec is precidence of operator, used to force brackets where
-    -- more tightly bound operation is next to less tightly bound operation
-    formatUnary(op : S, arg : E, prec : I) : Tree S ==
-      if debug then sayTeX$Lisp "formatUnary: " concat ["op=",op," arg=",_
-        stringify arg," prec=",string(prec)$S]
-      p : I := position(op,unaryOps)
-      p < 1 => error "unknown unary op"
-      opPrec := unaryPrecs.p
-      s : Tree S := newNodes("",[tree(op),formatHtml(arg,opPrec)])
-      opPrec < prec => newNodes("",[tree("("),s,tree(")")])
-      s
+        build(c:R, i:IS, e:E):$  ==  monomial(c, construct(i, e))
 
-    -- output division with numerator above the denominator
-    -- implemented as a table
-    buildOver(top : Tree S,bottom : Tree S) : Tree S ==
-      if debug then sayTeX$Lisp "buildOver"
-      topCell:Tree S := newNode("td",top)
-      bottomCell:Tree S := newNode("td style='border-top-style:solid'",_
-        bottom)
-      rows:(List Tree S) := [newNode("tr id='col'",topCell),_
-        newNode("tr id='col'",bottomCell)]
-      newNodes("table border='0' id='col'",rows)
+     ----   WARNING: assumes c ^= 0
+        multMonom(c:R, e:E, mp:$):$  ==
+            zero? mp => mp
+            monomial(c * leadingCoefficient mp, [leadingIndex mp,
+                     e + leadingExponent mp]) + multMonom(c, e, reductum mp)
 
-    -- op may be: "|","^","/","OVER","+->"
-    -- note: "+" and "*" are n-ary ops
-    formatBinary(op : S, args : L E, prec : I) : Tree S ==
-      if debug then sayTeX$Lisp "formatBinary: " concat ["op=",op,_
-        " args=",argsToString(args)," prec=",string(prec)$S]
-      p : I := position(op,binaryOps)
-      p < 1 => error "unknown binary op"
-      opPrec := binaryPrecs.p
-      -- if base op is product or sum need to add parentheses
-      if ATOM(first args)$Lisp@Boolean then
-        opa:S := stringify first args
-      else
-        la : L E := (first args pretend L E)
-        opa : S := stringify first la
-      if (opa = "SIGMA" or opa = "SIGMA2" or opa = "PI" or opa = "PI2")_
-        and op = "^" then
-          s1 : Tree S := newNodes("",[tree("("),formatHtml(first args,_
-            opPrec),tree(")")])
-      else
-        s1 : Tree S := formatHtml(first args, opPrec)
-      s2 : Tree S := formatHtml(first rest args, opPrec)
-      op = "|" => newNodes("",[s1,tree(op),s2])
-      op = "^" => buildSuperscript(s1,s2)
-      op = "/" => newNodes("",[s1,tree(op),s2])
-      op = "OVER" => buildOver(s1,s2)
-      op = "+->" => newNodes("",[s1,tree("|&mdash;&rsaquo;"),s2])
-      newNodes("",[s1,tree(op),s2])
+        ((p:P) * (mp:$)):$  ==
+            zero? p => 0
+            multMonom(leadingCoefficient p, degree p, mp) +
+               reductum(p) * mp
 
-    -- build a zag from a table with a right part and a
-    -- upper and lower left part
-    buildZag(top:Tree S,lowerLeft:Tree S,lowerRight:Tree S) : Tree S ==
-      if debug then sayTeX$Lisp "buildZag"
-      cellTop:Tree S := _
-        newNode("td colspan='2' id='zag' style='border-bottom-style:solid'",_
-         top)
-      cellLowerLeft:Tree S := newNodes("td id='zag'",[lowerLeft,tree("+")])
-      cellLowerRight:Tree S := newNode("td id='zag'",lowerRight)
-      row1:Tree S := newNodes("tr id='zag'",[cellTop])
-      row2:Tree S := newNodes("tr id='zag'",[cellLowerLeft,cellLowerRight])
-      newNodes("table border='0' id='zag'",[row1,row2])
+*)
 
-    formatZag(args : L E,nestLevel:I)  : Tree S ==
-      -- args will be a list of things like this {{ZAG}{1}{7}}, the ZAG
-      -- must be there, the '1' and '7' could conceivably be more complex
-      -- expressions
-      --
-      -- ex 1. continuedFraction(314159/100000)
-      -- {{+}{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}}
-      -- {{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
-      -- this is the preconditioned output form
-      -- including "op", the args list would be the rest of this
-      -- i.e op = '+' and args = {{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}
-      -- {{ZAG}{1}{1}}{{ZAG}{1}{25}}{{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
-      --
-      -- ex 2. continuedFraction(14159/100000)
-      -- this one doesn't have the leading integer
-      -- {{+}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}}
-      -- {{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
-      --
-      -- ex 3. continuedFraction(3,repeating [1], repeating [3,6])
-      -- {{+}{3}{{ZAG}{1}{3}}{{ZAG}{1}{6}}{{ZAG}{1}{3}}{{ZAG}{1}{6}}
-      -- {{ZAG}{1}{3}}{{ZAG}{1}{6}}{{ZAG}{1}{3}}{{ZAG}{1}{6}}
-      -- {{ZAG}{1}{3}}{{ZAG}{1}{6}}{...}}
-      --
-      -- In each of these examples the args list consists of the terms
-      -- following the '+' op
-      -- so the first arg could be a "ZAG" or something
-      -- else, but the second arg looks like it has to be "ZAG", so maybe
-      -- test for #args > 1 and args.2 contains "ZAG".
-      -- Note that since the resulting tables are nested we need
-      -- to handle the whole continued fraction at once, i.e. we can't
-      -- just look for, e.g., {{ZAG}{1}{6}}
-      --
-      -- we will assume that the font starts at 16px and reduce it by 4
-      -- <span style='font-size:16px'>outer zag</span>
-      -- <span style='font-size:14px'>next zag</span>
-      -- <span style='font-size:12px'>next zag</span>
-      -- <span style='font-size:10px'>next zag</span>
-      -- <span style='font-size:9px'>lowest zag</span>
-      if debug then sayTeX$Lisp "formatZag: " concat ["args=",_
-        argsToString(args)]
-      tmpZag : L E := first args pretend L E
-      fontAttrib : S :=
-        nestLevel < 2 => "span style='font-size:16px'"
-        nestLevel = 2 => "span style='font-size:14px'"
-        nestLevel = 3 => "span style='font-size:12px'"
-        nestLevel = 4 => "span style='font-size:10px'"
-        "span style='font-size:9px'"
-      -- may want to test that tmpZag contains 'ZAG'
-      #args > 1 =>
-        newNode(fontAttrib,buildZag(formatHtml(first rest tmpZag,minPrec),_
-          formatHtml(first rest rest tmpZag,minPrec),_
-            formatZag(rest args,nestLevel+1)))
-      (first args = "...":: E)@Boolean => tree("&#x2026;")
-      op:S := stringify first args
-      position("ZAG",op,1) > 0 =>
-        newNode(fontAttrib,buildOver(formatHtml(first rest tmpZag,minPrec),_
-          formatHtml(first rest rest tmpZag,minPrec)))
-      tree("formatZag: Last argument in ZAG construct unknown operator: "op)
+\end{chunk}
 
-    -- returns true if this term starts with a minus '-' sign
-    -- this is used so that we can suppress any plus '+' in front
-    -- of the - so we dont get terms like +-
-    neg?(arg : E) : Boolean ==
-      if debug then sayTeX$Lisp "neg?: " concat ["arg=",argsToString([arg])]
-      ATOM(arg)$Lisp@Boolean => false
-      l : L E := (arg pretend L E)
-      op : S := stringify first l
-      op = "-" => true
-      false
+\begin{chunk}{GMODPOL.dotabb}
+"GMODPOL" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GMODPOL"]
+"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"]
+"DIRPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=DIRPCAT"]
+"GMODPOL" -> "PFECAT"
+"GMODPOL" -> "DIRPCAT"
 
-    formatNary(op : S, args : L E, prec : I) : Tree S ==
-      if debug then sayTeX$Lisp "formatNary: " concat ["op=",op," args=",_
-        argsToString(args)," prec=",string(prec)$S]
-      formatNaryNoGroup(op, args, prec)
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain GCNAALG GenericNonAssociativeAlgebra}
+
+\begin{chunk}{GenericNonAssociativeAlgebra.input}
+)set break resume
+)sys rm -f GenericNonAssociativeAlgebra.output
+)spool GenericNonAssociativeAlgebra.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show GenericNonAssociativeAlgebra
+--R 
+--R GenericNonAssociativeAlgebra(R: CommutativeRing,n: PositiveInteger,ls: List(Symbol),gamma: Vector(Matrix(R)))  is a domain constructor
+--R Abbreviation for GenericNonAssociativeAlgebra is GCNAALG 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for GCNAALG 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
+--R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
+--R ?**? : (%,PositiveInteger) -> %       ?+? : (%,%) -> %
+--R ?-? : (%,%) -> %                      -? : % -> %
+--R ?=? : (%,%) -> Boolean                0 : () -> %
+--R alternative? : () -> Boolean          antiAssociative? : () -> Boolean
+--R antiCommutative? : () -> Boolean      antiCommutator : (%,%) -> %
+--R associative? : () -> Boolean          associator : (%,%,%) -> %
+--R basis : () -> Vector(%)               coerce : % -> OutputForm
+--R commutative? : () -> Boolean          commutator : (%,%) -> %
+--R flexible? : () -> Boolean             generic : (Symbol,Vector(%)) -> %
+--R generic : Vector(%) -> %              generic : Vector(Symbol) -> %
+--R generic : Symbol -> %                 generic : () -> %
+--R hash : % -> SingleInteger             jacobiIdentity? : () -> Boolean
+--R jordanAdmissible? : () -> Boolean     jordanAlgebra? : () -> Boolean
+--R latex : % -> String                   leftAlternative? : () -> Boolean
+--R lieAdmissible? : () -> Boolean        lieAlgebra? : () -> Boolean
+--R powerAssociative? : () -> Boolean     rank : () -> PositiveInteger
+--R rightAlternative? : () -> Boolean     sample : () -> %
+--R someBasis : () -> Vector(%)           zero? : % -> Boolean
+--R ?~=? : (%,%) -> Boolean              
+--R ?*? : (SquareMatrix(n,Fraction(Polynomial(R))),%) -> %
+--R ?*? : (Fraction(Polynomial(R)),%) -> %
+--R ?*? : (%,Fraction(Polynomial(R))) -> %
+--R apply : (Matrix(Fraction(Polynomial(R))),%) -> %
+--R associatorDependence : () -> List(Vector(Fraction(Polynomial(R)))) if Fraction(Polynomial(R)) has INTDOM
+--R coerce : Vector(Fraction(Polynomial(R))) -> %
+--R conditionsForIdempotents : () -> List(Polynomial(R)) if R has INTDOM
+--R conditionsForIdempotents : Vector(%) -> List(Polynomial(R)) if R has INTDOM
+--R conditionsForIdempotents : () -> List(Polynomial(Fraction(Polynomial(R))))
+--R conditionsForIdempotents : Vector(%) -> List(Polynomial(Fraction(Polynomial(R))))
+--R convert : Vector(Fraction(Polynomial(R))) -> %
+--R convert : % -> Vector(Fraction(Polynomial(R)))
+--R coordinates : Vector(%) -> Matrix(Fraction(Polynomial(R)))
+--R coordinates : % -> Vector(Fraction(Polynomial(R)))
+--R coordinates : (Vector(%),Vector(%)) -> Matrix(Fraction(Polynomial(R)))
+--R coordinates : (%,Vector(%)) -> Vector(Fraction(Polynomial(R)))
+--R ?.? : (%,Integer) -> Fraction(Polynomial(R))
+--R generic : (Vector(Symbol),Vector(%)) -> %
+--R genericLeftDiscriminant : () -> Fraction(Polynomial(R)) if R has INTDOM
+--R genericLeftMinimalPolynomial : % -> SparseUnivariatePolynomial(Fraction(Polynomial(R))) if R has INTDOM
+--R genericLeftNorm : % -> Fraction(Polynomial(R)) if R has INTDOM
+--R genericLeftTrace : % -> Fraction(Polynomial(R)) if R has INTDOM
+--R genericLeftTraceForm : (%,%) -> Fraction(Polynomial(R)) if R has INTDOM
+--R genericRightDiscriminant : () -> Fraction(Polynomial(R)) if R has INTDOM
+--R genericRightMinimalPolynomial : % -> SparseUnivariatePolynomial(Fraction(Polynomial(R))) if R has INTDOM
+--R genericRightNorm : % -> Fraction(Polynomial(R)) if R has INTDOM
+--R genericRightTrace : % -> Fraction(Polynomial(R)) if R has INTDOM
+--R genericRightTraceForm : (%,%) -> Fraction(Polynomial(R)) if R has INTDOM
+--R leftCharacteristicPolynomial : % -> SparseUnivariatePolynomial(Fraction(Polynomial(R)))
+--R leftDiscriminant : () -> Fraction(Polynomial(R))
+--R leftDiscriminant : Vector(%) -> Fraction(Polynomial(R))
+--R leftMinimalPolynomial : % -> SparseUnivariatePolynomial(Fraction(Polynomial(R))) if Fraction(Polynomial(R)) has INTDOM
+--R leftNorm : % -> Fraction(Polynomial(R))
+--R leftPower : (%,PositiveInteger) -> %
+--R leftRankPolynomial : () -> SparseUnivariatePolynomial(Fraction(Polynomial(R))) if R has INTDOM
+--R leftRankPolynomial : () -> SparseUnivariatePolynomial(Polynomial(Fraction(Polynomial(R)))) if Fraction(Polynomial(R)) has FIELD
+--R leftRecip : % -> Union(%,"failed") if Fraction(Polynomial(R)) has INTDOM
+--R leftRegularRepresentation : % -> Matrix(Fraction(Polynomial(R)))
+--R leftRegularRepresentation : (%,Vector(%)) -> Matrix(Fraction(Polynomial(R)))
+--R leftTrace : % -> Fraction(Polynomial(R))
+--R leftTraceMatrix : () -> Matrix(Fraction(Polynomial(R)))
+--R leftTraceMatrix : Vector(%) -> Matrix(Fraction(Polynomial(R)))
+--R leftUnit : () -> Union(%,"failed") if Fraction(Polynomial(R)) has INTDOM
+--R leftUnits : () -> Union(Record(particular: %,basis: List(%)),"failed")
+--R noncommutativeJordanAlgebra? : () -> Boolean
+--R plenaryPower : (%,PositiveInteger) -> %
+--R recip : % -> Union(%,"failed") if Fraction(Polynomial(R)) has INTDOM
+--R represents : Vector(Fraction(Polynomial(R))) -> %
+--R represents : (Vector(Fraction(Polynomial(R))),Vector(%)) -> %
+--R rightCharacteristicPolynomial : % -> SparseUnivariatePolynomial(Fraction(Polynomial(R)))
+--R rightDiscriminant : () -> Fraction(Polynomial(R))
+--R rightDiscriminant : Vector(%) -> Fraction(Polynomial(R))
+--R rightMinimalPolynomial : % -> SparseUnivariatePolynomial(Fraction(Polynomial(R))) if Fraction(Polynomial(R)) has INTDOM
+--R rightNorm : % -> Fraction(Polynomial(R))
+--R rightPower : (%,PositiveInteger) -> %
+--R rightRankPolynomial : () -> SparseUnivariatePolynomial(Fraction(Polynomial(R))) if R has INTDOM
+--R rightRankPolynomial : () -> SparseUnivariatePolynomial(Polynomial(Fraction(Polynomial(R)))) if Fraction(Polynomial(R)) has FIELD
+--R rightRecip : % -> Union(%,"failed") if Fraction(Polynomial(R)) has INTDOM
+--R rightRegularRepresentation : % -> Matrix(Fraction(Polynomial(R)))
+--R rightRegularRepresentation : (%,Vector(%)) -> Matrix(Fraction(Polynomial(R)))
+--R rightTrace : % -> Fraction(Polynomial(R))
+--R rightTraceMatrix : () -> Matrix(Fraction(Polynomial(R)))
+--R rightTraceMatrix : Vector(%) -> Matrix(Fraction(Polynomial(R)))
+--R rightUnit : () -> Union(%,"failed") if Fraction(Polynomial(R)) has INTDOM
+--R rightUnits : () -> Union(Record(particular: %,basis: List(%)),"failed")
+--R structuralConstants : () -> Vector(Matrix(Fraction(Polynomial(R))))
+--R structuralConstants : Vector(%) -> Vector(Matrix(Fraction(Polynomial(R))))
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R unit : () -> Union(%,"failed") if Fraction(Polynomial(R)) has INTDOM
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{GenericNonAssociativeAlgebra.help}
+====================================================================
+GenericNonAssociativeAlgebra examples
+====================================================================
+
+AlgebraGenericElementPackage allows you to create generic elements of an 
+algebra, i.e. the scalars are extended to include symbolic coefficients.
+
+See Also:
+o )show GenericNonAssociativeAlgebra
+
+\end{chunk}
+
+\pagehead{GenericNonAssociativeAlgebra}{GCNAALG}
+\pagepic{ps/v103genericnonassociativealgebra.ps}{GCNAALG}{1.00}
+
+{\bf Exports:}\\
+\begin{tabular}{ll}
+\cross{GCNAALG}{0} &
+\cross{GCNAALG}{alternative?} \\
+\cross{GCNAALG}{antiAssociative?} &
+\cross{GCNAALG}{antiCommutative?} \\
+\cross{GCNAALG}{antiCommutator} &
+\cross{GCNAALG}{apply} \\
+\cross{GCNAALG}{associative?} &
+\cross{GCNAALG}{associator} \\
+\cross{GCNAALG}{associatorDependence} &
+\cross{GCNAALG}{basis} \\
+\cross{GCNAALG}{coerce} &
+\cross{GCNAALG}{commutative?} \\
+\cross{GCNAALG}{commutator} &
+\cross{GCNAALG}{conditionsForIdempotents} \\
+\cross{GCNAALG}{convert} &
+\cross{GCNAALG}{convert} \\
+\cross{GCNAALG}{coordinates} &
+\cross{GCNAALG}{coordinates} \\
+\cross{GCNAALG}{coordinates} &
+\cross{GCNAALG}{coordinates} \\
+\cross{GCNAALG}{flexible?} &
+\cross{GCNAALG}{generic} \\
+\cross{GCNAALG}{genericLeftDiscriminant} &
+\cross{GCNAALG}{genericLeftMinimalPolynomial} \\
+\cross{GCNAALG}{genericLeftNorm} &
+\cross{GCNAALG}{genericLeftTrace} \\
+\cross{GCNAALG}{genericLeftTraceForm} &
+\cross{GCNAALG}{genericRightDiscriminant} \\
+\cross{GCNAALG}{genericRightMinimalPolynomial} &
+\cross{GCNAALG}{genericRightNorm} \\
+\cross{GCNAALG}{genericRightTrace} &
+\cross{GCNAALG}{genericRightTraceForm} \\
+\cross{GCNAALG}{hash} &
+\cross{GCNAALG}{jacobiIdentity?} \\
+\cross{GCNAALG}{jordanAdmissible?} &
+\cross{GCNAALG}{jordanAlgebra?} \\
+\cross{GCNAALG}{latex} &
+\cross{GCNAALG}{leftAlternative?} \\
+\cross{GCNAALG}{leftCharacteristicPolynomial} &
+\cross{GCNAALG}{leftDiscriminant} \\
+\cross{GCNAALG}{leftDiscriminant} &
+\cross{GCNAALG}{leftMinimalPolynomial} \\
+\cross{GCNAALG}{leftNorm} &
+\cross{GCNAALG}{leftPower} \\
+\cross{GCNAALG}{leftRankPolynomial} &
+\cross{GCNAALG}{leftRankPolynomial} \\
+\cross{GCNAALG}{leftRecip} &
+\cross{GCNAALG}{leftRegularRepresentation} \\
+\cross{GCNAALG}{leftRegularRepresentation} &
+\cross{GCNAALG}{leftTrace} \\
+\cross{GCNAALG}{leftTraceMatrix} &
+\cross{GCNAALG}{leftTraceMatrix} \\
+\cross{GCNAALG}{leftUnit} &
+\cross{GCNAALG}{leftUnits} \\
+\cross{GCNAALG}{lieAdmissible?} &
+\cross{GCNAALG}{lieAlgebra?} \\
+\cross{GCNAALG}{noncommutativeJordanAlgebra?} &
+\cross{GCNAALG}{plenaryPower} \\
+\cross{GCNAALG}{powerAssociative?} &
+\cross{GCNAALG}{rank} \\
+\cross{GCNAALG}{recip} &
+\cross{GCNAALG}{represents} \\
+\cross{GCNAALG}{rightAlternative?} &
+\cross{GCNAALG}{rightCharacteristicPolynomial} \\
+\cross{GCNAALG}{rightDiscriminant} &
+\cross{GCNAALG}{rightDiscriminant} \\
+\cross{GCNAALG}{rightMinimalPolynomial} &
+\cross{GCNAALG}{rightNorm} \\
+\cross{GCNAALG}{rightPower} &
+\cross{GCNAALG}{rightRankPolynomial} \\
+\cross{GCNAALG}{rightRankPolynomial} &
+\cross{GCNAALG}{rightRecip} \\
+\cross{GCNAALG}{rightRegularRepresentation} &
+\cross{GCNAALG}{rightRegularRepresentation} \\
+\cross{GCNAALG}{rightTrace} &
+\cross{GCNAALG}{rightTraceMatrix} \\
+\cross{GCNAALG}{rightTraceMatrix} &
+\cross{GCNAALG}{rightUnit} \\
+\cross{GCNAALG}{rightUnits} &
+\cross{GCNAALG}{sample} \\
+\cross{GCNAALG}{someBasis} &
+\cross{GCNAALG}{structuralConstants} \\
+\cross{GCNAALG}{structuralConstants} &
+\cross{GCNAALG}{subtractIfCan} \\
+\cross{GCNAALG}{unit} &
+\cross{GCNAALG}{zero?} \\
+\cross{GCNAALG}{?*?} &
+\cross{GCNAALG}{?**?} \\
+\cross{GCNAALG}{?+?} &
+\cross{GCNAALG}{?-?} \\
+\cross{GCNAALG}{-?} &
+\cross{GCNAALG}{?=?} \\
+\cross{GCNAALG}{?.?} &
+\cross{GCNAALG}{?\~{}=?}
+\end{tabular}
+
+\begin{chunk}{domain GCNAALG GenericNonAssociativeAlgebra}
+)abbrev domain GCNAALG GenericNonAssociativeAlgebra
+++ Authors: J. Grabmeier, R. Wisbauer
+++ Date Created: 26 June 1991
+++ Date Last Updated: 26 June 1991
+++ Reference:
+++  A. Woerz-Busekros: Algebra in Genetics
+++  Lectures Notes in Biomathematics 36,
+++  Springer-Verlag,  Heidelberg, 1980
+++ Description:
+++ AlgebraGenericElementPackage allows you to create generic elements
+++ of an algebra, i.e. the scalars are extended to include symbolic
+++ coefficients
+
+GenericNonAssociativeAlgebra(R : CommutativeRing, n : PositiveInteger,_
+  ls : List Symbol, gamma: Vector Matrix R ): public == private where
+
+  NNI ==> NonNegativeInteger
+  V   ==> Vector
+  PR  ==> Polynomial R
+  FPR ==> Fraction Polynomial R
+  SUP ==> SparseUnivariatePolynomial
+  S   ==> Symbol
+
+  public ==> Join(FramedNonAssociativeAlgebra(FPR), _
+      LeftModule(SquareMatrix(n,FPR)) ) with
+
+    coerce : Vector FPR -> %
+      ++ coerce(v) assumes that it is called with a vector
+      ++ of length equal to the dimension of the algebra, then
+      ++ a linear combination with the basis element is formed
+    leftUnits:() -> Union(Record(particular: %, basis: List %), "failed")
+      ++ leftUnits() returns the affine space of all left units of the
+      ++ algebra, or \spad{"failed"} if there is none
+    rightUnits:() -> Union(Record(particular: %, basis: List %), "failed")
+      ++ rightUnits() returns the affine space of all right units of the
+      ++ algebra, or \spad{"failed"} if there is none
+    generic : () -> %
+      ++ generic() returns a generic element, i.e. the linear combination
+      ++ of the fixed basis with the symbolic coefficients
+      ++ \spad{%x1,%x2,..}
+    generic : Symbol -> %
+      ++ generic(s) returns a generic element, i.e. the linear combination
+      ++ of the fixed basis with the symbolic coefficients
+      ++ \spad{s1,s2,..}
+    generic : Vector Symbol -> %
+      ++ generic(vs) returns a generic element, i.e. the linear combination
+      ++ of the fixed basis with the symbolic coefficients
+      ++ \spad{vs};
+      ++ error, if the vector of symbols is too short
+    generic : Vector % -> %
+      ++ generic(ve) returns a generic element, i.e. the linear combination
+      ++ of \spad{ve} basis with the symbolic coefficients
+      ++ \spad{%x1,%x2,..}
+    generic : (Symbol, Vector %) -> %
+      ++ generic(s,v) returns a generic element, i.e. the linear combination
+      ++ of v with the symbolic coefficients
+      ++ \spad{s1,s2,..}
+    generic : (Vector Symbol, Vector %) -> %
+      ++ generic(vs,ve) returns a generic element, i.e. the linear combination
+      ++ of \spad{ve} with the symbolic coefficients \spad{vs}
+      ++ error, if the vector of symbols is shorter than the vector of
+      ++ elements
+    if R has IntegralDomain then
+      leftRankPolynomial : () -> SparseUnivariatePolynomial FPR
+        ++ leftRankPolynomial() returns the left minimimal polynomial
+        ++ of the generic element
+      genericLeftMinimalPolynomial : % -> SparseUnivariatePolynomial FPR
+        ++ genericLeftMinimalPolynomial(a) substitutes the coefficients
+        ++ of {em a} for the generic coefficients in
+        ++ \spad{leftRankPolynomial()}
+      genericLeftTrace : % -> FPR
+        ++ genericLeftTrace(a) substitutes the coefficients
+        ++ of \spad{a} for the generic coefficients into the
+        ++ coefficient of the second highest term in
+        ++ \spadfun{leftRankPolynomial} and changes the sign.
+        ++  This is a linear form
+      genericLeftNorm : % -> FPR
+        ++ genericLeftNorm(a) substitutes the coefficients
+        ++ of \spad{a} for the generic coefficients into the
+        ++ coefficient of the constant term in \spadfun{leftRankPolynomial}
+        ++ and changes the sign if the degree of this polynomial is odd.
+        ++ This is a form of degree k
+      rightRankPolynomial : () -> SparseUnivariatePolynomial FPR
+        ++ rightRankPolynomial() returns the right minimimal polynomial
+        ++ of the generic element
+      genericRightMinimalPolynomial : % -> SparseUnivariatePolynomial FPR
+        ++ genericRightMinimalPolynomial(a) substitutes the coefficients
+        ++ of \spad{a} for the generic coefficients in
+        ++ \spadfun{rightRankPolynomial}
+      genericRightTrace : % -> FPR
+        ++ genericRightTrace(a) substitutes the coefficients
+        ++ of \spad{a} for the generic coefficients into the
+        ++ coefficient of the second highest term in
+        ++ \spadfun{rightRankPolynomial} and changes the sign
+      genericRightNorm : % -> FPR
+        ++ genericRightNorm(a) substitutes the coefficients
+        ++ of \spad{a} for the generic coefficients into the
+        ++ coefficient of the constant term in \spadfun{rightRankPolynomial}
+        ++ and changes the sign if the degree of this polynomial is odd
+      genericLeftTraceForm : (%,%) -> FPR
+        ++ genericLeftTraceForm (a,b) is defined to be
+        ++ \spad{genericLeftTrace (a*b)}, this defines
+        ++ a symmetric bilinear form on the algebra
+      genericLeftDiscriminant: () -> FPR
+        ++ genericLeftDiscriminant() is the determinant of the
+        ++ generic left trace forms of all products of basis element,
+        ++ if the generic left trace form is associative, an algebra
+        ++ is separable if the generic left discriminant is invertible,
+        ++ if it is non-zero, there is some ring extension which
+        ++ makes the algebra separable
+      genericRightTraceForm : (%,%) -> FPR
+        ++ genericRightTraceForm (a,b) is defined to be
+        ++ \spadfun{genericRightTrace (a*b)}, this defines
+        ++ a symmetric bilinear form on the algebra
+      genericRightDiscriminant: () -> FPR
+        ++ genericRightDiscriminant() is the determinant of the
+        ++ generic left trace forms of all products of basis element,
+        ++ if the generic left trace form is associative, an algebra
+        ++ is separable if the generic left discriminant is invertible,
+        ++ if it is non-zero, there is some ring extension which
+        ++ makes the algebra separable
+      conditionsForIdempotents: Vector % -> List Polynomial R
+        ++ conditionsForIdempotents([v1,...,vn]) determines a complete list
+        ++ of polynomial equations for the coefficients of idempotents
+        ++ with respect to the \spad{R}-module basis \spad{v1},...,\spad{vn}
+      conditionsForIdempotents: () -> List Polynomial R
+        ++ conditionsForIdempotents() determines a complete list
+        ++ of polynomial equations for the coefficients of idempotents
+        ++ with respect to the fixed \spad{R}-module basis
+
+  private ==> AlgebraGivenByStructuralConstants(FPR,n,ls,_
+         coerce(gamma)$CoerceVectorMatrixPackage(R) ) add
+
+    listOfNumbers : List String :=  [PRINC_-TO_-STRING(q)$Lisp for q in 1..n]
+    symbolsForCoef : V Symbol :=
+        [concat("%", concat("x", i))::Symbol  for i in listOfNumbers]
+    genericElement : % :=
+      v : Vector PR :=
+        [monomial(1$PR, [symbolsForCoef.i],[1]) for i in 1..n]
+      convert map(coerce,v)$VectorFunctions2(PR,FPR)
+
+    eval : (FPR, %) -> FPR
+    eval(rf,a) ==
+      -- for the moment we only substitute the numerators
+      -- of the coefficients
+      coefOfa : List PR :=
+        map(numer, entries coordinates a)$ListFunctions2(FPR,PR)
+      ls : List PR :=[monomial(1$PR, [s],[1]) for s in entries symbolsForCoef]
+      lEq : List Equation PR := []
+      for i in 1..maxIndex ls repeat
+        lEq := cons(equation(ls.i,coefOfa.i)$Equation(PR) , lEq)
+      top : PR := eval(numer(rf),lEq)$PR
+      bot : PR := eval(numer(rf),lEq)$PR
+      top/bot
+
+    if R has IntegralDomain then
+
+      genericLeftTraceForm(a,b) == genericLeftTrace(a*b)
+      genericLeftDiscriminant() ==
+        listBasis : List % := entries basis()$%
+        m : Matrix FPR := matrix
+          [[genericLeftTraceForm(a,b) for a in listBasis] for b in listBasis]
+        determinant m
+
+      genericRightTraceForm(a,b) == genericRightTrace(a*b)
+      genericRightDiscriminant() ==
+        listBasis : List % := entries basis()$%
+        m : Matrix FPR := matrix
+          [[genericRightTraceForm(a,b) for a in listBasis] for b in listBasis]
+        determinant m
+
+      leftRankPoly : SparseUnivariatePolynomial FPR := 0
+      initLeft? : Boolean :=true
+
+      initializeLeft: () -> Void
+      initializeLeft() ==
+        -- reset initialize flag
+        initLeft?:=false
+        leftRankPoly := leftMinimalPolynomial genericElement
+        void()$Void
+
+      rightRankPoly : SparseUnivariatePolynomial FPR := 0
+      initRight? : Boolean :=true
+
+      initializeRight: () -> Void
+      initializeRight() ==
+        -- reset initialize flag
+        initRight?:=false
+        rightRankPoly := rightMinimalPolynomial genericElement
+        void()$Void
+
+      leftRankPolynomial() ==
+        if initLeft? then initializeLeft()
+        leftRankPoly
+
+      rightRankPolynomial() ==
+        if initRight? then initializeRight()
+        rightRankPoly
+
+      genericLeftMinimalPolynomial a ==
+        if initLeft? then initializeLeft()
+        map(x+->eval(x,a),leftRankPoly)$SUP(FPR)
+
+      genericRightMinimalPolynomial a ==
+        if initRight? then initializeRight()
+        map(x+->eval(x,a),rightRankPoly)$SUP(FPR)
+
+      genericLeftTrace a ==
+        if initLeft? then initializeLeft()
+        d1 : NNI := (degree leftRankPoly - 1) :: NNI
+        rf : FPR := coefficient(leftRankPoly, d1)
+        rf := eval(rf,a)
+        - rf
+
+      genericRightTrace a ==
+        if initRight? then initializeRight()
+        d1 : NNI := (degree rightRankPoly - 1) :: NNI
+        rf : FPR := coefficient(rightRankPoly, d1)
+        rf := eval(rf,a)
+        - rf
+
+      genericLeftNorm a ==
+        if initLeft? then initializeLeft()
+        rf : FPR := coefficient(leftRankPoly, 1)
+        if odd? degree leftRankPoly then rf := - rf
+        rf
+
+      genericRightNorm a ==
+        if initRight? then initializeRight()
+        rf : FPR := coefficient(rightRankPoly, 1)
+        if odd? degree rightRankPoly then rf := - rf
+        rf
+
+    conditionsForIdempotents(b: V %) : List Polynomial R ==
+      x : % := generic(b)
+      map(numer,entries coordinates(x*x-x,b))$ListFunctions2(FPR,PR)
+
+    conditionsForIdempotents(): List Polynomial R ==
+      x : % := genericElement
+      map(numer,entries coordinates(x*x-x))$ListFunctions2(FPR,PR)
+
+    generic() ==  genericElement
+
+    generic(vs:V S, ve: V %): % ==
+      maxIndex v > maxIndex ve =>
+        error "generic: too little symbols"
+      v : Vector PR :=
+        [monomial(1$PR, [vs.i],[1]) for i in 1..maxIndex ve]
+      represents(map(coerce,v)$VectorFunctions2(PR,FPR),ve)
+
+    generic(s: S, ve: V %): % ==
+      lON : List String :=  [PRINC_-TO_-STRING(q)$Lisp for q in 1..maxIndex ve]
+      sFC : Vector Symbol :=
+        [concat(s pretend String, i)::Symbol  for i in lON]
+      generic(sFC, ve)
+
+    generic(ve : V %) ==
+      lON : List String :=  [PRINC_-TO_-STRING(q)$Lisp for q in 1..maxIndex ve]
+      sFC : Vector Symbol :=
+        [concat("%", concat("x", i))::Symbol  for i in lON]
+      v : Vector PR :=
+        [monomial(1$PR, [sFC.i],[1]) for i in 1..maxIndex ve]
+      represents(map(coerce,v)$VectorFunctions2(PR,FPR),ve)
+
+    generic(vs:V S): % == generic(vs, basis()$%)
+
+    generic(s: S): % == generic(s, basis()$%)
+
+\end{chunk}
+
+\begin{chunk}{COQ GCNAALG}
+(* domain GCNAALG *)
+(*
+ AlgebraGivenByStructuralConstants(FPR,n,ls,_
+         coerce(gamma)$CoerceVectorMatrixPackage(R) ) add
+
+    listOfNumbers : List String :=  [PRINC_-TO_-STRING(q)$Lisp for q in 1..n]
+    symbolsForCoef : V Symbol :=
+        [concat("%", concat("x", i))::Symbol  for i in listOfNumbers]
+    genericElement : % :=
+      v : Vector PR :=
+        [monomial(1$PR, [symbolsForCoef.i],[1]) for i in 1..n]
+      convert map(coerce,v)$VectorFunctions2(PR,FPR)
+
+    eval : (FPR, %) -> FPR
+    eval(rf,a) ==
+      -- for the moment we only substitute the numerators
+      -- of the coefficients
+      coefOfa : List PR :=
+        map(numer, entries coordinates a)$ListFunctions2(FPR,PR)
+      ls : List PR :=[monomial(1$PR, [s],[1]) for s in entries symbolsForCoef]
+      lEq : List Equation PR := []
+      for i in 1..maxIndex ls repeat
+        lEq := cons(equation(ls.i,coefOfa.i)$Equation(PR) , lEq)
+      top : PR := eval(numer(rf),lEq)$PR
+      bot : PR := eval(numer(rf),lEq)$PR
+      top/bot
+
+    if R has IntegralDomain then
+
+      genericLeftTraceForm(a,b) == genericLeftTrace(a*b)
+      genericLeftDiscriminant() ==
+        listBasis : List % := entries basis()$%
+        m : Matrix FPR := matrix
+          [[genericLeftTraceForm(a,b) for a in listBasis] for b in listBasis]
+        determinant m
+
+      genericRightTraceForm(a,b) == genericRightTrace(a*b)
+      genericRightDiscriminant() ==
+        listBasis : List % := entries basis()$%
+        m : Matrix FPR := matrix
+          [[genericRightTraceForm(a,b) for a in listBasis] for b in listBasis]
+        determinant m
+
+      leftRankPoly : SparseUnivariatePolynomial FPR := 0
+      initLeft? : Boolean :=true
+
+      initializeLeft: () -> Void
+      initializeLeft() ==
+        -- reset initialize flag
+        initLeft?:=false
+        leftRankPoly := leftMinimalPolynomial genericElement
+        void()$Void
+
+      rightRankPoly : SparseUnivariatePolynomial FPR := 0
+      initRight? : Boolean :=true
+
+      initializeRight: () -> Void
+      initializeRight() ==
+        -- reset initialize flag
+        initRight?:=false
+        rightRankPoly := rightMinimalPolynomial genericElement
+        void()$Void
+
+      leftRankPolynomial() ==
+        if initLeft? then initializeLeft()
+        leftRankPoly
+
+      rightRankPolynomial() ==
+        if initRight? then initializeRight()
+        rightRankPoly
+
+      genericLeftMinimalPolynomial a ==
+        if initLeft? then initializeLeft()
+        map(x+->eval(x,a),leftRankPoly)$SUP(FPR)
+
+      genericRightMinimalPolynomial a ==
+        if initRight? then initializeRight()
+        map(x+->eval(x,a),rightRankPoly)$SUP(FPR)
+
+      genericLeftTrace a ==
+        if initLeft? then initializeLeft()
+        d1 : NNI := (degree leftRankPoly - 1) :: NNI
+        rf : FPR := coefficient(leftRankPoly, d1)
+        rf := eval(rf,a)
+        - rf
+
+      genericRightTrace a ==
+        if initRight? then initializeRight()
+        d1 : NNI := (degree rightRankPoly - 1) :: NNI
+        rf : FPR := coefficient(rightRankPoly, d1)
+        rf := eval(rf,a)
+        - rf
+
+      genericLeftNorm a ==
+        if initLeft? then initializeLeft()
+        rf : FPR := coefficient(leftRankPoly, 1)
+        if odd? degree leftRankPoly then rf := - rf
+        rf
+
+      genericRightNorm a ==
+        if initRight? then initializeRight()
+        rf : FPR := coefficient(rightRankPoly, 1)
+        if odd? degree rightRankPoly then rf := - rf
+        rf
+
+    conditionsForIdempotents(b: V %) : List Polynomial R ==
+      x : % := generic(b)
+      map(numer,entries coordinates(x*x-x,b))$ListFunctions2(FPR,PR)
+
+    conditionsForIdempotents(): List Polynomial R ==
+      x : % := genericElement
+      map(numer,entries coordinates(x*x-x))$ListFunctions2(FPR,PR)
+
+    generic() ==  genericElement
+
+    generic(vs:V S, ve: V %): % ==
+      maxIndex v > maxIndex ve =>
+        error "generic: too little symbols"
+      v : Vector PR :=
+        [monomial(1$PR, [vs.i],[1]) for i in 1..maxIndex ve]
+      represents(map(coerce,v)$VectorFunctions2(PR,FPR),ve)
+
+    generic(s: S, ve: V %): % ==
+      lON : List String :=  [PRINC_-TO_-STRING(q)$Lisp for q in 1..maxIndex ve]
+      sFC : Vector Symbol :=
+        [concat(s pretend String, i)::Symbol  for i in lON]
+      generic(sFC, ve)
+
+    generic(ve : V %) ==
+      lON : List String :=  [PRINC_-TO_-STRING(q)$Lisp for q in 1..maxIndex ve]
+      sFC : Vector Symbol :=
+        [concat("%", concat("x", i))::Symbol  for i in lON]
+      v : Vector PR :=
+        [monomial(1$PR, [sFC.i],[1]) for i in 1..maxIndex ve]
+      represents(map(coerce,v)$VectorFunctions2(PR,FPR),ve)
+
+    generic(vs:V S): % == generic(vs, basis()$%)
+
+    generic(s: S): % == generic(s, basis()$%)
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{GCNAALG.dotabb}
+"GCNAALG" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GCNAALG"]
+"FRNAALG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FRNAALG"]
+"GCNAALG" -> "FRNAALG"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain GPOLSET GeneralPolynomialSet}
+
+\begin{chunk}{GeneralPolynomialSet.input}
+)set break resume
+)sys rm -f GeneralPolynomialSet.output
+)spool GeneralPolynomialSet.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show GeneralPolynomialSet
+--R 
+--R GeneralPolynomialSet(R: Ring,E: OrderedAbelianMonoidSup,VarSet: OrderedSet,P: RecursivePolynomialCategory(R,E,VarSet))  is a domain constructor
+--R Abbreviation for GeneralPolynomialSet is GPOLSET 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for GPOLSET 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?=? : (%,%) -> Boolean                coerce : % -> List(P)
+--R coerce : % -> OutputForm              collect : (%,VarSet) -> %
+--R collectUnder : (%,VarSet) -> %        collectUpper : (%,VarSet) -> %
+--R construct : List(P) -> %              convert : List(P) -> %
+--R copy : % -> %                         empty : () -> %
+--R empty? : % -> Boolean                 eq? : (%,%) -> Boolean
+--R hash : % -> SingleInteger             latex : % -> String
+--R mainVariables : % -> List(VarSet)     map : ((P -> P),%) -> %
+--R mvar : % -> VarSet                    retract : List(P) -> %
+--R sample : () -> %                      trivialIdeal? : % -> Boolean
+--R variables : % -> List(VarSet)         ?~=? : (%,%) -> Boolean
+--R #? : % -> NonNegativeInteger if $ has finiteAggregate
+--R any? : ((P -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R convert : % -> InputForm if P has KONVERT(INFORM)
+--R count : ((P -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
+--R count : (P,%) -> NonNegativeInteger if $ has finiteAggregate and P has SETCAT
+--R eval : (%,List(Equation(P))) -> % if P has EVALAB(P) and P has SETCAT
+--R eval : (%,Equation(P)) -> % if P has EVALAB(P) and P has SETCAT
+--R eval : (%,P,P) -> % if P has EVALAB(P) and P has SETCAT
+--R eval : (%,List(P),List(P)) -> % if P has EVALAB(P) and P has SETCAT
+--R every? : ((P -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R find : ((P -> Boolean),%) -> Union(P,"failed")
+--R headRemainder : (P,%) -> Record(num: P,den: R) if R has INTDOM
+--R less? : (%,NonNegativeInteger) -> Boolean
+--R mainVariable? : (VarSet,%) -> Boolean
+--R map! : ((P -> P),%) -> % if $ has shallowlyMutable
+--R member? : (P,%) -> Boolean if $ has finiteAggregate and P has SETCAT
+--R members : % -> List(P) if $ has finiteAggregate
+--R more? : (%,NonNegativeInteger) -> Boolean
+--R parts : % -> List(P) if $ has finiteAggregate
+--R reduce : (((P,P) -> P),%) -> P if $ has finiteAggregate
+--R reduce : (((P,P) -> P),%,P) -> P if $ has finiteAggregate
+--R reduce : (((P,P) -> P),%,P,P) -> P if $ has finiteAggregate and P has SETCAT
+--R remainder : (P,%) -> Record(rnum: R,polnum: P,den: R) if R has INTDOM
+--R remove : ((P -> Boolean),%) -> % if $ has finiteAggregate
+--R remove : (P,%) -> % if $ has finiteAggregate and P has SETCAT
+--R removeDuplicates : % -> % if $ has finiteAggregate and P has SETCAT
+--R retractIfCan : List(P) -> Union(%,"failed")
+--R rewriteIdealWithHeadRemainder : (List(P),%) -> List(P) if R has INTDOM
+--R rewriteIdealWithRemainder : (List(P),%) -> List(P) if R has INTDOM
+--R roughBase? : % -> Boolean if R has INTDOM
+--R roughEqualIdeals? : (%,%) -> Boolean if R has INTDOM
+--R roughSubIdeal? : (%,%) -> Boolean if R has INTDOM
+--R roughUnitIdeal? : % -> Boolean if R has INTDOM
+--R select : ((P -> Boolean),%) -> % if $ has finiteAggregate
+--R size? : (%,NonNegativeInteger) -> Boolean
+--R sort : (%,VarSet) -> Record(under: %,floor: %,upper: %)
+--R triangular? : % -> Boolean if R has INTDOM
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{GeneralPolynomialSet.help}
+====================================================================
+GeneralPolynomialSet examples
+====================================================================
+
+A domain for polynomial sets.
+
+See Also:
+o )show GeneralPolynomialSet
+
+\end{chunk}
+
+\pagehead{GeneralPolynomialSet}{GPOLSET}
+\pagepic{ps/v103generalpolynomialset.ps}{GPOLSET}{1.00}
+
+{\bf Exports:}\\
+\begin{tabular}{ll}
+\cross{GPOLSET}{any?} &
+\cross{GPOLSET}{coerce} \\
+\cross{GPOLSET}{collect} &
+\cross{GPOLSET}{collectUnder} \\
+\cross{GPOLSET}{collectUpper} &
+\cross{GPOLSET}{construct} \\
+\cross{GPOLSET}{convert} &
+\cross{GPOLSET}{copy} \\
+\cross{GPOLSET}{count} &
+\cross{GPOLSET}{empty} \\
+\cross{GPOLSET}{empty?} &
+\cross{GPOLSET}{eq?} \\
+\cross{GPOLSET}{eval} &
+\cross{GPOLSET}{every?} \\
+\cross{GPOLSET}{find} &
+\cross{GPOLSET}{hash} \\
+\cross{GPOLSET}{headRemainder} &
+\cross{GPOLSET}{latex} \\
+\cross{GPOLSET}{less?} &
+\cross{GPOLSET}{mainVariables} \\
+\cross{GPOLSET}{mainVariable?} &
+\cross{GPOLSET}{map} \\
+\cross{GPOLSET}{map!} &
+\cross{GPOLSET}{member?} \\
+\cross{GPOLSET}{members} &
+\cross{GPOLSET}{more?} \\
+\cross{GPOLSET}{mvar} &
+\cross{GPOLSET}{parts} \\
+\cross{GPOLSET}{reduce} &
+\cross{GPOLSET}{remainder} \\
+\cross{GPOLSET}{remove} &
+\cross{GPOLSET}{removeDuplicates} \\
+\cross{GPOLSET}{retract} &
+\cross{GPOLSET}{retractIfCan} \\
+\cross{GPOLSET}{rewriteIdealWithHeadRemainder} &
+\cross{GPOLSET}{rewriteIdealWithRemainder} \\
+\cross{GPOLSET}{roughBase?} &
+\cross{GPOLSET}{roughEqualIdeals?} \\
+\cross{GPOLSET}{roughSubIdeal?} &
+\cross{GPOLSET}{roughUnitIdeal?} \\
+\cross{GPOLSET}{sample} &
+\cross{GPOLSET}{select} \\
+\cross{GPOLSET}{size?} &
+\cross{GPOLSET}{sort} \\
+\cross{GPOLSET}{triangular?} &
+\cross{GPOLSET}{trivialIdeal?} \\
+\cross{GPOLSET}{variables} &
+\cross{GPOLSET}{\#{}?} \\
+\cross{GPOLSET}{?=?} &
+\cross{GPOLSET}{?\~{}=?} 
+\end{tabular}
+
+\begin{chunk}{domain GPOLSET GeneralPolynomialSet}
+)abbrev domain GPOLSET GeneralPolynomialSet
+++ Author: Marc Moreno Maza
+++ Date Created: 04/26/1994
+++ Date Last Updated: 12/15/1998
+++ Description: 
+++ A domain for polynomial sets.
+
+GeneralPolynomialSet(R,E,VarSet,P) : Exports == Implementation where
+
+  R:Ring
+  VarSet:OrderedSet
+  E:OrderedAbelianMonoidSup
+  P:RecursivePolynomialCategory(R,E,VarSet)
+  LP ==> List P
+  PtoP ==> P -> P
+
+  Exports ==  PolynomialSetCategory(R,E,VarSet,P)  with
+
+     convert : LP -> $
+       ++ \axiom{convert(lp)} returns the polynomial set whose members 
+       ++ are the polynomials of \axiom{lp}.
+
+     finiteAggregate
+     shallowlyMutable
+
+  Implementation == add
+
+     Rep := List P
+
+     construct lp ==
+       (removeDuplicates(lp)$List(P))::$
+
+     copy ps ==
+       construct(copy(members(ps)$$)$LP)$$
+
+     empty() ==
+       []
+
+     parts ps ==
+       ps pretend LP
+
+     map (f : PtoP, ps : $) : $ ==
+       construct(map(f,members(ps))$LP)$$
+
+     map! (f : PtoP, ps : $) : $  ==
+       construct(map!(f,members(ps))$LP)$$
+
+     member? (p,ps) ==
+       member?(p,members(ps))$LP
+
+     ps1 = ps2 ==
+       {p for p in parts(ps1)} =$(Set P) {p for p in parts(ps2)}
+
+     coerce(ps:$) : OutputForm ==
+       lp : List(P) := sort(infRittWu?,members(ps))$(List P)
+       brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm
+
+     mvar ps ==
+       empty? ps => error"Error from GPOLSET in mvar : #1 is empty"
+       lv : List VarSet := variables(ps)
+       empty? lv => 
+        error "Error from GPOLSET in mvar : every polynomial in #1 is constant"
+       reduce(max,lv)$(List VarSet)
+
+     retractIfCan(lp) ==
+       (construct(lp))::Union($,"failed")
+
+     coerce(ps:$) : (List P) ==
+       ps pretend (List P)
+
+     convert(lp:LP) : $ ==
+       construct lp
+
+\end{chunk}
+
+\begin{chunk}{COQ GPOLSET}
+(* domain GPOLSET *)
+(*
+
+     Rep := List P
+
+     construct lp ==
+       (removeDuplicates(lp)$List(P))::$
+
+     copy ps ==
+       construct(copy(members(ps)$$)$LP)$$
+
+     empty() ==
+       []
+
+     parts ps ==
+       ps pretend LP
+
+     map (f : PtoP, ps : $) : $ ==
+       construct(map(f,members(ps))$LP)$$
+
+     map! (f : PtoP, ps : $) : $  ==
+       construct(map!(f,members(ps))$LP)$$
+
+     member? (p,ps) ==
+       member?(p,members(ps))$LP
+
+     ps1 = ps2 ==
+       {p for p in parts(ps1)} =$(Set P) {p for p in parts(ps2)}
+
+     coerce(ps:$) : OutputForm ==
+       lp : List(P) := sort(infRittWu?,members(ps))$(List P)
+       brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm
+
+     mvar ps ==
+       empty? ps => error"Error from GPOLSET in mvar : #1 is empty"
+       lv : List VarSet := variables(ps)
+       empty? lv => 
+        error "Error from GPOLSET in mvar : every polynomial in #1 is constant"
+       reduce(max,lv)$(List VarSet)
+
+     retractIfCan(lp) ==
+       (construct(lp))::Union($,"failed")
+
+     coerce(ps:$) : (List P) ==
+       ps pretend (List P)
+
+     convert(lp:LP) : $ ==
+       construct lp
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{GPOLSET.dotabb}
+"GPOLSET" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GPOLSET"]
+"RPOLCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=RPOLCAT"]
+"GPOLSET" -> "RPOLCAT"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain GSTBL GeneralSparseTable}
+
+\begin{chunk}{GeneralSparseTable.input}
+)set break resume
+)sys rm -f GeneralSparseTable.output
+)spool GeneralSparseTable.output
+)set message test on
+)set message auto off
+)set break resume
+)clear all
+
+--S 1 of 8
+patrons: GeneralSparseTable(String, Integer, KeyedAccessFile(Integer), 0) := table() ; 
+--E 1
+
+--S 2 of 8
+patrons."Smith" := 10500 
+--E 2
+
+--S 3 of 8
+patrons."Jones" := 22000
+--E 3
+
+--S 4 of 8
+patrons."Jones" 
+--E 4
+
+--S 5 of 8
+patrons."Stingy"
+--E 5
+
+--S 6 of 8
+reduce(+, entries patrons) 
+--E 6
+
+--S 7 of 8
+)system rm -r kaf*.sdata
+--E 7
+
+--S 8 of 8
+)show GeneralSparseTable
+--R 
+--R GeneralSparseTable(Key: SetCategory,Entry: SetCategory,Tbl: TableAggregate(Key,Entry),dent: Entry)  is a domain constructor
+--R Abbreviation for GeneralSparseTable is GSTBL 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for GSTBL 
+--R
+--R------------------------------- Operations --------------------------------
+--R copy : % -> %                         dictionary : () -> %
+--R elt : (%,Key,Entry) -> Entry          ?.? : (%,Key) -> Entry
+--R empty : () -> %                       empty? : % -> Boolean
+--R entries : % -> List(Entry)            eq? : (%,%) -> Boolean
+--R index? : (Key,%) -> Boolean           indices : % -> List(Key)
+--R key? : (Key,%) -> Boolean             keys : % -> List(Key)
+--R map : ((Entry -> Entry),%) -> %       qelt : (%,Key) -> Entry
+--R sample : () -> %                      setelt : (%,Key,Entry) -> Entry
+--R table : () -> %                      
+--R #? : % -> NonNegativeInteger if $ has finiteAggregate
+--R ?=? : (%,%) -> Boolean if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
+--R any? : ((Entry -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R any? : ((Record(key: Key,entry: Entry) -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R bag : List(Record(key: Key,entry: Entry)) -> %
+--R coerce : % -> OutputForm if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
+--R construct : List(Record(key: Key,entry: Entry)) -> %
+--R convert : % -> InputForm if Record(key: Key,entry: Entry) has KONVERT(INFORM)
+--R count : ((Entry -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
+--R count : (Entry,%) -> NonNegativeInteger if $ has finiteAggregate and Entry has SETCAT
+--R count : (Record(key: Key,entry: Entry),%) -> NonNegativeInteger if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
+--R count : ((Record(key: Key,entry: Entry) -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
+--R dictionary : List(Record(key: Key,entry: Entry)) -> %
+--R entry? : (Entry,%) -> Boolean if $ has finiteAggregate and Entry has SETCAT
+--R eval : (%,List(Equation(Entry))) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
+--R eval : (%,Equation(Entry)) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
+--R eval : (%,Entry,Entry) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
+--R eval : (%,List(Entry),List(Entry)) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
+--R eval : (%,List(Record(key: Key,entry: Entry)),List(Record(key: Key,entry: Entry))) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
+--R eval : (%,Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
+--R eval : (%,Equation(Record(key: Key,entry: Entry))) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
+--R eval : (%,List(Equation(Record(key: Key,entry: Entry)))) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
+--R every? : ((Entry -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R every? : ((Record(key: Key,entry: Entry) -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R extract! : % -> Record(key: Key,entry: Entry)
+--R fill! : (%,Entry) -> % if $ has shallowlyMutable
+--R find : ((Record(key: Key,entry: Entry) -> Boolean),%) -> Union(Record(key: Key,entry: Entry),"failed")
+--R first : % -> Entry if Key has ORDSET
+--R hash : % -> SingleInteger if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
+--R insert! : (Record(key: Key,entry: Entry),%) -> %
+--R inspect : % -> Record(key: Key,entry: Entry)
+--R latex : % -> String if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
+--R less? : (%,NonNegativeInteger) -> Boolean
+--R map : (((Entry,Entry) -> Entry),%,%) -> %
+--R map : ((Record(key: Key,entry: Entry) -> Record(key: Key,entry: Entry)),%) -> %
+--R map! : ((Entry -> Entry),%) -> % if $ has shallowlyMutable
+--R map! : ((Record(key: Key,entry: Entry) -> Record(key: Key,entry: Entry)),%) -> % if $ has shallowlyMutable
+--R maxIndex : % -> Key if Key has ORDSET
+--R member? : (Entry,%) -> Boolean if $ has finiteAggregate and Entry has SETCAT
+--R member? : (Record(key: Key,entry: Entry),%) -> Boolean if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
+--R members : % -> List(Entry) if $ has finiteAggregate
+--R members : % -> List(Record(key: Key,entry: Entry)) if $ has finiteAggregate
+--R minIndex : % -> Key if Key has ORDSET
+--R more? : (%,NonNegativeInteger) -> Boolean
+--R parts : % -> List(Entry) if $ has finiteAggregate
+--R parts : % -> List(Record(key: Key,entry: Entry)) if $ has finiteAggregate
+--R qsetelt! : (%,Key,Entry) -> Entry if $ has shallowlyMutable
+--R reduce : (((Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry)),%) -> Record(key: Key,entry: Entry) if $ has finiteAggregate
+--R reduce : (((Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry)),%,Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry) if $ has finiteAggregate
+--R reduce : (((Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry)),%,Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry) if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
+--R remove : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
+--R remove : (Record(key: Key,entry: Entry),%) -> % if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
+--R remove! : (Key,%) -> Union(Entry,"failed")
+--R remove! : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
+--R remove! : (Record(key: Key,entry: Entry),%) -> % if $ has finiteAggregate
+--R removeDuplicates : % -> % if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
+--R search : (Key,%) -> Union(Entry,"failed")
+--R select : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
+--R select! : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
+--R size? : (%,NonNegativeInteger) -> Boolean
+--R swap! : (%,Key,Key) -> Void if $ has shallowlyMutable
+--R table : List(Record(key: Key,entry: Entry)) -> %
+--R ?~=? : (%,%) -> Boolean if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
+--R
+--E 8
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{GeneralSparseTable.help}
+====================================================================
+GeneralSparseTable
+====================================================================
+
+Sometimes when working with tables there is a natural value to use as
+the entry in all but a few cases.  The GeneralSparseTable constructor
+can be used to provide any table type with a default value for
+entries.
+
+Suppose we launched a fund-raising campaign to raise fifty thousand
+dollars.  To record the contributions, we want a table with strings as
+keys (for the names) and integer entries (for the amount).  In a data
+base of cash contributions, unless someone has been explicitly
+entered, it is reasonable to assume they have made a zero dollar
+contribution.
+
+This creates a keyed access file with default entry 0.
+
+  patrons: GeneralSparseTable(String, Integer, KeyedAccessFile(Integer), 0) := table() ; 
+
+Now patrons can be used just as any other table.  Here we record two gifts.
+
+  patrons."Smith" := 10500 
+
+  patrons."Jones" := 22000
+
+Now let us look up the size of the contributions from Jones and Stingy.
+
+  patrons."Jones" 
+
+  patrons."Stingy"
+
+Have we met our seventy thousand dollar goal?
+
+  reduce(+, entries patrons) 
+
+So the project is cancelled and we can delete the data base:
+
+  )system rm -r kaf*.sdata
+
+See Also:
+o )show GeneralSparseTable
+
+\end{chunk}
+\pagehead{GeneralSparseTable}{GSTBL}
+\pagepic{ps/v103generalsparsetable.ps}{GSTBL}{1.00}
+{\bf See}\\
+\pageto{HashTable}{HASHTBL}
+\pageto{InnerTable}{INTABL}
+\pageto{Table}{TABLE}
+\pageto{EqTable}{EQTBL}
+\pageto{StringTable}{STRTBL}
+\pageto{SparseTable}{STBL}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{GSTBL}{any?} &
+\cross{GSTBL}{bag} &
+\cross{GSTBL}{coerce} &
+\cross{GSTBL}{construct} &
+\cross{GSTBL}{convert} \\
+\cross{GSTBL}{copy} &
+\cross{GSTBL}{count} &
+\cross{GSTBL}{dictionary} &
+\cross{GSTBL}{elt} &
+\cross{GSTBL}{empty} \\
+\cross{GSTBL}{empty?} &
+\cross{GSTBL}{entries} &
+\cross{GSTBL}{entry?} &
+\cross{GSTBL}{eq?} &
+\cross{GSTBL}{eval} \\
+\cross{GSTBL}{every?} &
+\cross{GSTBL}{extract!} &
+\cross{GSTBL}{fill!} &
+\cross{GSTBL}{find} &
+\cross{GSTBL}{first} \\
+\cross{GSTBL}{hash} &
+\cross{GSTBL}{index?} &
+\cross{GSTBL}{indices} &
+\cross{GSTBL}{insert!} &
+\cross{GSTBL}{inspect} \\
+\cross{GSTBL}{key?} &
+\cross{GSTBL}{keys} &
+\cross{GSTBL}{latex} &
+\cross{GSTBL}{less?} &
+\cross{GSTBL}{map} \\
+\cross{GSTBL}{map!} &
+\cross{GSTBL}{maxIndex} &
+\cross{GSTBL}{member?} &
+\cross{GSTBL}{members} &
+\cross{GSTBL}{minIndex} \\
+\cross{GSTBL}{more?} &
+\cross{GSTBL}{parts} &
+\cross{GSTBL}{qelt} &
+\cross{GSTBL}{qsetelt!} &
+\cross{GSTBL}{reduce} \\
+\cross{GSTBL}{remove} &
+\cross{GSTBL}{remove!} &
+\cross{GSTBL}{removeDuplicates} &
+\cross{GSTBL}{sample} &
+\cross{GSTBL}{search} \\
+\cross{GSTBL}{select} &
+\cross{GSTBL}{select!} &
+\cross{GSTBL}{setelt} &
+\cross{GSTBL}{size?} &
+\cross{GSTBL}{swap!} \\
+\cross{GSTBL}{table} &
+\cross{GSTBL}{\#{}?} &
+\cross{GSTBL}{?=?} &
+\cross{GSTBL}{?\~{}=?} &
+\cross{GSTBL}{?.?} 
+\end{tabular}
+
+\begin{chunk}{domain GSTBL GeneralSparseTable}
+)abbrev domain GSTBL GeneralSparseTable
+++ Author: Stephen M. Watt
+++ Date Created: 1986
+++ Date Last Updated: June 21, 1991
+++ Description:
+++ A sparse table has a default entry, which is returned if no other
+++ value has been explicitly stored for a key.
+
+GeneralSparseTable(Key, Entry, Tbl, dent): TableAggregate(Key, Entry) == Impl
+  where
+    Key, Entry: SetCategory
+    Tbl:  TableAggregate(Key, Entry)
+    dent: Entry
+
+    Impl ==> Tbl add
+
+        Rep := Tbl
+
+        elt(t:%, k:Key) ==
+            (u := search(k, t)$Rep) case "failed" => dent
+            u::Entry
+
+        setelt(t:%, k:Key, e:Entry) ==
+            e = dent => (remove_!(k, t); e)
+            setelt(t, k, e)$Rep
+
+        search(k:Key, t:%) ==
+            (u := search(k, t)$Rep) case "failed" => dent
+            u
+
+\end{chunk}
+
+\begin{chunk}{COQ GSTBL}
+(* domain GSTBL *)
+(*
+
+        Rep := Tbl
+
+        elt(t:%, k:Key) ==
+            (u := search(k, t)$Rep) case "failed" => dent
+            u::Entry
+
+        setelt(t:%, k:Key, e:Entry) ==
+            e = dent => (remove_!(k, t); e)
+            setelt(t, k, e)$Rep
+
+        search(k:Key, t:%) ==
+            (u := search(k, t)$Rep) case "failed" => dent
+            u
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{GSTBL.dotabb}
+"GSTBL" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GSTBL"]
+"TBAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=TBAGG"]
+"GSTBL" -> "TBAGG"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain GTSET GeneralTriangularSet}
+
+\begin{chunk}{GeneralTriangularSet.input}
+)set break resume
+)sys rm -f GeneralTriangularSet.output
+)spool GeneralTriangularSet.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show GeneralTriangularSet
+--R 
+--R GeneralTriangularSet(R: IntegralDomain,E: OrderedAbelianMonoidSup,V: OrderedSet,P: RecursivePolynomialCategory(R,E,V))  is a domain constructor
+--R Abbreviation for GeneralTriangularSet is GTSET 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for GTSET 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?=? : (%,%) -> Boolean                algebraic? : (V,%) -> Boolean
+--R algebraicVariables : % -> List(V)     coerce : % -> List(P)
+--R coerce : % -> OutputForm              collect : (%,V) -> %
+--R collectQuasiMonic : % -> %            collectUnder : (%,V) -> %
+--R collectUpper : (%,V) -> %             construct : List(P) -> %
+--R copy : % -> %                         degree : % -> NonNegativeInteger
+--R empty : () -> %                       empty? : % -> Boolean
+--R eq? : (%,%) -> Boolean                extend : (%,P) -> %
+--R first : % -> Union(P,"failed")        hash : % -> SingleInteger
+--R headReduce : (P,%) -> P               headReduced? : % -> Boolean
+--R headReduced? : (P,%) -> Boolean       infRittWu? : (%,%) -> Boolean
+--R initiallyReduce : (P,%) -> P          initiallyReduced? : % -> Boolean
+--R initials : % -> List(P)               last : % -> Union(P,"failed")
+--R latex : % -> String                   mainVariable? : (V,%) -> Boolean
+--R mainVariables : % -> List(V)          map : ((P -> P),%) -> %
+--R mvar : % -> V                         normalized? : % -> Boolean
+--R normalized? : (P,%) -> Boolean        reduceByQuasiMonic : (P,%) -> P
+--R removeZero : (P,%) -> P               rest : % -> Union(%,"failed")
+--R retract : List(P) -> %                sample : () -> %
+--R select : (%,V) -> Union(P,"failed")   stronglyReduce : (P,%) -> P
+--R stronglyReduced? : % -> Boolean       stronglyReduced? : (P,%) -> Boolean
+--R trivialIdeal? : % -> Boolean          variables : % -> List(V)
+--R zeroSetSplit : List(P) -> List(%)     ?~=? : (%,%) -> Boolean
+--R #? : % -> NonNegativeInteger if $ has finiteAggregate
+--R any? : ((P -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R autoReduced? : (%,((P,List(P)) -> Boolean)) -> Boolean
+--R basicSet : (List(P),(P -> Boolean),((P,P) -> Boolean)) -> Union(Record(bas: %,top: List(P)),"failed")
+--R basicSet : (List(P),((P,P) -> Boolean)) -> Union(Record(bas: %,top: List(P)),"failed")
+--R coHeight : % -> NonNegativeInteger if V has FINITE
+--R convert : % -> InputForm if P has KONVERT(INFORM)
+--R count : ((P -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
+--R count : (P,%) -> NonNegativeInteger if $ has finiteAggregate and P has SETCAT
+--R eval : (%,List(Equation(P))) -> % if P has EVALAB(P) and P has SETCAT
+--R eval : (%,Equation(P)) -> % if P has EVALAB(P) and P has SETCAT
+--R eval : (%,P,P) -> % if P has EVALAB(P) and P has SETCAT
+--R eval : (%,List(P),List(P)) -> % if P has EVALAB(P) and P has SETCAT
+--R every? : ((P -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R extendIfCan : (%,P) -> Union(%,"failed")
+--R find : ((P -> Boolean),%) -> Union(P,"failed")
+--R headRemainder : (P,%) -> Record(num: P,den: R) if R has INTDOM
+--R initiallyReduced? : (P,%) -> Boolean
+--R less? : (%,NonNegativeInteger) -> Boolean
+--R map! : ((P -> P),%) -> % if $ has shallowlyMutable
+--R member? : (P,%) -> Boolean if $ has finiteAggregate and P has SETCAT
+--R members : % -> List(P) if $ has finiteAggregate
+--R more? : (%,NonNegativeInteger) -> Boolean
+--R parts : % -> List(P) if $ has finiteAggregate
+--R quasiComponent : % -> Record(close: List(P),open: List(P))
+--R reduce : (P,%,((P,P) -> P),((P,P) -> Boolean)) -> P
+--R reduce : (((P,P) -> P),%) -> P if $ has finiteAggregate
+--R reduce : (((P,P) -> P),%,P) -> P if $ has finiteAggregate
+--R reduce : (((P,P) -> P),%,P,P) -> P if $ has finiteAggregate and P has SETCAT
+--R reduced? : (P,%,((P,P) -> Boolean)) -> Boolean
+--R remainder : (P,%) -> Record(rnum: R,polnum: P,den: R) if R has INTDOM
+--R remove : ((P -> Boolean),%) -> % if $ has finiteAggregate
+--R remove : (P,%) -> % if $ has finiteAggregate and P has SETCAT
+--R removeDuplicates : % -> % if $ has finiteAggregate and P has SETCAT
+--R retractIfCan : List(P) -> Union(%,"failed")
+--R rewriteIdealWithHeadRemainder : (List(P),%) -> List(P) if R has INTDOM
+--R rewriteIdealWithRemainder : (List(P),%) -> List(P) if R has INTDOM
+--R rewriteSetWithReduction : (List(P),%,((P,P) -> P),((P,P) -> Boolean)) -> List(P)
+--R roughBase? : % -> Boolean if R has INTDOM
+--R roughEqualIdeals? : (%,%) -> Boolean if R has INTDOM
+--R roughSubIdeal? : (%,%) -> Boolean if R has INTDOM
+--R roughUnitIdeal? : % -> Boolean if R has INTDOM
+--R select : ((P -> Boolean),%) -> % if $ has finiteAggregate
+--R size? : (%,NonNegativeInteger) -> Boolean
+--R sort : (%,V) -> Record(under: %,floor: %,upper: %)
+--R triangular? : % -> Boolean if R has INTDOM
+--R zeroSetSplitIntoTriangularSystems : List(P) -> List(Record(close: %,open: List(P)))
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{GeneralTriangularSet.help}
+====================================================================
+GeneralTriangularSet examples
+====================================================================
+
+A domain constructor of the category TriangularSetCategory.  The only
+requirement for a list of polynomials to be a member of such a domain
+is the following: no polynomial is constant and two distinct
+polynomials have distinct main variables. Such a triangular set may
+not be auto-reduced or consistent. Triangular sets are stored as
+sorted lists w.r.t. the main variables of their members but they are
+displayed in reverse order.
+
+See Also:
+o )show GeneralTriangularSet
+
+\end{chunk}
+
+\pagehead{GeneralTriangularSet}{GTSET}
+\pagepic{ps/v103generaltriangularset.ps}{GTSET}{1.00}
+{\bf See}\\
+\pageto{WuWenTsunTriangularSet}{WUTSET}
+
+{\bf Exports:}\\
+\begin{tabular}{ll}
+\cross{GTSET}{algebraic?} &
+\cross{GTSET}{algebraicVariables} \\
+\cross{GTSET}{any?} &
+\cross{GTSET}{autoReduced?} \\
+\cross{GTSET}{basicSet} &
+\cross{GTSET}{coerce} \\
+\cross{GTSET}{collect} &
+\cross{GTSET}{collectQuasiMonic} \\
+\cross{GTSET}{collectUnder} &
+\cross{GTSET}{collectUpper} \\
+\cross{GTSET}{coHeight} &
+\cross{GTSET}{construct} \\
+\cross{GTSET}{convert} &
+\cross{GTSET}{copy} \\
+\cross{GTSET}{count} &
+\cross{GTSET}{degree} \\
+\cross{GTSET}{empty} &
+\cross{GTSET}{empty?} \\
+\cross{GTSET}{eq?} &
+\cross{GTSET}{eval} \\
+\cross{GTSET}{every?} &
+\cross{GTSET}{extend} \\
+\cross{GTSET}{extendIfCan} &
+\cross{GTSET}{find} \\
+\cross{GTSET}{first} &
+\cross{GTSET}{hash} \\
+\cross{GTSET}{headReduce} &
+\cross{GTSET}{headReduced?} \\
+\cross{GTSET}{headReduced?} &
+\cross{GTSET}{headRemainder} \\
+\cross{GTSET}{infRittWu?} &
+\cross{GTSET}{initiallyReduce} \\
+\cross{GTSET}{initiallyReduced?} &
+\cross{GTSET}{initials} \\
+\cross{GTSET}{last} &
+\cross{GTSET}{latex} \\
+\cross{GTSET}{less?} &
+\cross{GTSET}{mainVariable?} \\
+\cross{GTSET}{mainVariables} &
+\cross{GTSET}{map} \\
+\cross{GTSET}{map!} &
+\cross{GTSET}{member?} \\
+\cross{GTSET}{members} &
+\cross{GTSET}{more?} \\
+\cross{GTSET}{mvar} &
+\cross{GTSET}{normalized?} \\
+\cross{GTSET}{normalized?} &
+\cross{GTSET}{parts} \\
+\cross{GTSET}{quasiComponent} &
+\cross{GTSET}{reduce} \\
+\cross{GTSET}{reduceByQuasiMonic} &
+\cross{GTSET}{reduced?} \\
+\cross{GTSET}{remainder} &
+\cross{GTSET}{remove} \\
+\cross{GTSET}{removeDuplicates} &
+\cross{GTSET}{removeZero} \\
+\cross{GTSET}{rest} &
+\cross{GTSET}{retract} \\
+\cross{GTSET}{retractIfCan} &
+\cross{GTSET}{rewriteIdealWithHeadRemainder} \\
+\cross{GTSET}{rewriteIdealWithRemainder} &
+\cross{GTSET}{rewriteSetWithReduction} \\
+\cross{GTSET}{roughBase?} &
+\cross{GTSET}{roughEqualIdeals?} \\
+\cross{GTSET}{roughSubIdeal?} &
+\cross{GTSET}{roughUnitIdeal?} \\
+\cross{GTSET}{sample} &
+\cross{GTSET}{select} \\
+\cross{GTSET}{size?} &
+\cross{GTSET}{sort} \\
+\cross{GTSET}{stronglyReduce} &
+\cross{GTSET}{stronglyReduced?} \\
+\cross{GTSET}{triangular?} &
+\cross{GTSET}{trivialIdeal?} \\
+\cross{GTSET}{variables} &
+\cross{GTSET}{zeroSetSplit} \\
+\cross{GTSET}{zeroSetSplitIntoTriangularSystems} &
+\cross{GTSET}{\#{}?} \\
+\cross{GTSET}{?=?} &
+\cross{GTSET}{?\~{}=?} 
+\end{tabular}
+
+\begin{chunk}{domain GTSET GeneralTriangularSet}
+)abbrev domain GTSET GeneralTriangularSet
+++ Author: Marc Moreno Maza (marc@nag.co.uk)
+++ Date Created: 10/06/1995
+++ Date Last Updated: 06/12/1996
+++ References :
+++  [1] P. AUBRY, D. LAZARD and M. MORENO MAZA "On the Theories
+++      of Triangular Sets" Journal of Symbol. Comp. (to appear)
+++ Description: 
+++ A domain constructor of the category \axiomType{TriangularSetCategory}.
+++ The only requirement for a list of polynomials to be a member of such
+++ a domain is the following: no polynomial is constant and two distinct
+++ polynomials have distinct main variables. Such a triangular set may
+++ not be auto-reduced or consistent. Triangular sets are stored
+++ as sorted lists w.r.t. the main variables of their members but they
+++ are displayed in reverse order.
+
+GeneralTriangularSet(R,E,V,P) : Exports == Implementation where
+
+  R : IntegralDomain
+  E : OrderedAbelianMonoidSup
+  V : OrderedSet
+  P : RecursivePolynomialCategory(R,E,V)
+  N ==> NonNegativeInteger
+  Z ==> Integer
+  B ==> Boolean
+  LP ==> List P
+  PtoP ==> P -> P
+
+  Exports ==  TriangularSetCategory(R,E,V,P)
+
+  Implementation == add
+
+     Rep ==> LP
+
+     rep(s:$):Rep == s pretend Rep
+
+     per(l:Rep):$ == l pretend $
+
+     copy ts ==
+       per(copy(rep(ts))$LP)
+
+     empty() ==
+       per([])
+
+     empty?(ts:$) ==
+       empty?(rep(ts))
+
+     parts ts ==
+       rep(ts)
+
+     members ts ==
+       rep(ts)
+
+     map (f : PtoP, ts : $) : $ ==
+       construct(map(f,rep(ts))$LP)$$
+
+     map! (f : PtoP, ts : $) : $  ==
+       construct(map!(f,rep(ts))$LP)$$
+
+     member? (p,ts) ==
+       member?(p,rep(ts))$LP
+
+     unitIdealIfCan() ==
+       "failed"::Union($,"failed")
+
+     roughUnitIdeal? ts ==
+       false
+
+     -- the following assume that rep(ts) is decreasingly sorted
+     -- w.r.t. the main variavles of the polynomials in rep(ts)
+     coerce(ts:$) : OutputForm ==
+       lp : List(P) := reverse(rep(ts))
+       brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm
+
+     mvar ts ==
+       empty? ts => error"failed in mvar : $ -> V from GTSET"
+       mvar(first(rep(ts)))$P
+
+     first ts ==
+       empty? ts => "failed"::Union(P,"failed")
+       first(rep(ts))::Union(P,"failed")
+
+     last ts ==
+       empty? ts => "failed"::Union(P,"failed")
+       last(rep(ts))::Union(P,"failed")
+
+     rest ts ==
+       empty? ts => "failed"::Union($,"failed")
+       per(rest(rep(ts)))::Union($,"failed")
+
+     coerce(ts:$) : (List P) ==
+       rep(ts)
+
+     collectUpper (ts,v) ==
+       empty? ts => ts
+       lp := rep(ts)
+       newlp : Rep := []
+       while (not empty? lp) and (mvar(first(lp)) > v) repeat
+         newlp := cons(first(lp),newlp)
+         lp := rest lp
+       per(reverse(newlp))
+
+     collectUnder (ts,v) ==
+       empty? ts => ts
+       lp := rep(ts)
+       while (not empty? lp) and (mvar(first(lp)) >= v) repeat
+         lp := rest lp
+       per(lp)
+
+     -- for another domain of TSETCAT build on this domain GTSET
+     -- the following operations must be redefined
+     extendIfCan(ts:$,p:P) ==
+       ground? p => "failed"::Union($,"failed")
+       empty? ts => (per([unitCanonical(p)]$LP))::Union($,"failed")
+       not (mvar(ts) < mvar(p)) => "failed"::Union($,"failed")
+       (per(cons(p,rep(ts))))::Union($,"failed")
+
+\end{chunk}
+
+\begin{chunk}{COQ GTSET}
+(* domain GTSET *)
+(*
+
+     Rep ==> LP
+
+     rep(s:$):Rep == s pretend Rep
+
+     per(l:Rep):$ == l pretend $
+
+     copy ts ==
+       per(copy(rep(ts))$LP)
+
+     empty() ==
+       per([])
+
+     empty?(ts:$) ==
+       empty?(rep(ts))
+
+     parts ts ==
+       rep(ts)
+
+     members ts ==
+       rep(ts)
+
+     map (f : PtoP, ts : $) : $ ==
+       construct(map(f,rep(ts))$LP)$$
+
+     map! (f : PtoP, ts : $) : $  ==
+       construct(map!(f,rep(ts))$LP)$$
+
+     member? (p,ts) ==
+       member?(p,rep(ts))$LP
+
+     unitIdealIfCan() ==
+       "failed"::Union($,"failed")
+
+     roughUnitIdeal? ts ==
+       false
+
+     -- the following assume that rep(ts) is decreasingly sorted
+     -- w.r.t. the main variavles of the polynomials in rep(ts)
+     coerce(ts:$) : OutputForm ==
+       lp : List(P) := reverse(rep(ts))
+       brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm
+
+     mvar ts ==
+       empty? ts => error"failed in mvar : $ -> V from GTSET"
+       mvar(first(rep(ts)))$P
+
+     first ts ==
+       empty? ts => "failed"::Union(P,"failed")
+       first(rep(ts))::Union(P,"failed")
+
+     last ts ==
+       empty? ts => "failed"::Union(P,"failed")
+       last(rep(ts))::Union(P,"failed")
+
+     rest ts ==
+       empty? ts => "failed"::Union($,"failed")
+       per(rest(rep(ts)))::Union($,"failed")
+
+     coerce(ts:$) : (List P) ==
+       rep(ts)
+
+     collectUpper (ts,v) ==
+       empty? ts => ts
+       lp := rep(ts)
+       newlp : Rep := []
+       while (not empty? lp) and (mvar(first(lp)) > v) repeat
+         newlp := cons(first(lp),newlp)
+         lp := rest lp
+       per(reverse(newlp))
+
+     collectUnder (ts,v) ==
+       empty? ts => ts
+       lp := rep(ts)
+       while (not empty? lp) and (mvar(first(lp)) >= v) repeat
+         lp := rest lp
+       per(lp)
+
+     -- for another domain of TSETCAT build on this domain GTSET
+     -- the following operations must be redefined
+     extendIfCan(ts:$,p:P) ==
+       ground? p => "failed"::Union($,"failed")
+       empty? ts => (per([unitCanonical(p)]$LP))::Union($,"failed")
+       not (mvar(ts) < mvar(p)) => "failed"::Union($,"failed")
+       (per(cons(p,rep(ts))))::Union($,"failed")
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{GTSET.dotabb}
+"GTSET" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GTSET"]
+"RPOLCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=RPOLCAT"]
+"GTSET" -> "RPOLCAT"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain GSERIES GeneralUnivariatePowerSeries}
+
+\begin{chunk}{GeneralUnivariatePowerSeries.input}
+)set break resume
+)sys rm -f GeneralUnivariatePowerSeries.output
+)spool GeneralUnivariatePowerSeries.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show GeneralUnivariatePowerSeries
+--R 
+--R GeneralUnivariatePowerSeries(Coef: Ring,var: Symbol,cen: Coef)  is a domain constructor
+--R Abbreviation for GeneralUnivariatePowerSeries is GSERIES 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for GSERIES 
+--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                    coerce : % -> % if Coef has INTDOM
+--R coerce : Variable(var) -> %           coerce : Integer -> %
+--R coerce : % -> OutputForm              complete : % -> %
+--R degree : % -> Fraction(Integer)       ?.? : (%,Fraction(Integer)) -> Coef
+--R hash : % -> SingleInteger             inv : % -> % if Coef has FIELD
+--R latex : % -> String                   leadingCoefficient : % -> Coef
+--R leadingMonomial : % -> %              map : ((Coef -> Coef),%) -> %
+--R monomial? : % -> Boolean              one? : % -> Boolean
+--R order : % -> Fraction(Integer)        pole? : % -> Boolean
+--R recip : % -> Union(%,"failed")        reductum : % -> %
+--R sample : () -> %                      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 ?**? : (%,Integer) -> % if Coef has FIELD
+--R ?/? : (%,%) -> % if Coef has FIELD
+--R ?/? : (%,Coef) -> % if Coef has FIELD
+--R D : % -> % if Coef has *: (Fraction(Integer),Coef) -> Coef
+--R D : (%,NonNegativeInteger) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef
+--R D : (%,Symbol) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R D : (%,List(Symbol)) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R D : (%,Symbol,NonNegativeInteger) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R ?^? : (%,Integer) -> % if Coef has FIELD
+--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 : (%,Fraction(Integer)) -> Coef if Coef has **: (Coef,Fraction(Integer)) -> 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 : (%,Fraction(Integer)) -> Coef
+--R coerce : Fraction(Integer) -> % if Coef has ALGEBRA(FRAC(INT))
+--R coerce : UnivariatePuiseuxSeries(Coef,var,cen) -> %
+--R coerce : Coef -> % if Coef has COMRING
+--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 : (%,Variable(var)) -> %
+--R differentiate : % -> % if Coef has *: (Fraction(Integer),Coef) -> Coef
+--R differentiate : (%,NonNegativeInteger) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef
+--R differentiate : (%,Symbol) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R differentiate : (%,List(Symbol)) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R differentiate : (%,Symbol,NonNegativeInteger) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has *: (Fraction(Integer),Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R divide : (%,%) -> Record(quotient: %,remainder: %) if Coef has FIELD
+--R ?.? : (%,%) -> % if Fraction(Integer) has SGROUP
+--R euclideanSize : % -> NonNegativeInteger if Coef has FIELD
+--R eval : (%,Coef) -> Stream(Coef) if Coef has **: (Coef,Fraction(Integer)) -> Coef
+--R exp : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R expressIdealMember : (List(%),%) -> Union(List(%),"failed") if Coef has FIELD
+--R exquo : (%,%) -> Union(%,"failed") if Coef has INTDOM
+--R extend : (%,Fraction(Integer)) -> %
+--R extendedEuclidean : (%,%) -> Record(coef1: %,coef2: %,generator: %) if Coef has FIELD
+--R extendedEuclidean : (%,%,%) -> Union(Record(coef1: %,coef2: %),"failed") if Coef has FIELD
+--R factor : % -> Factored(%) if Coef has FIELD
+--R gcd : (%,%) -> % if Coef has FIELD
+--R gcd : List(%) -> % if Coef has FIELD
+--R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%) if Coef has FIELD
+--R integrate : (%,Variable(var)) -> % if Coef has ALGEBRA(FRAC(INT))
+--R integrate : (%,Symbol) -> % if Coef has integrate: (Coef,Symbol) -> Coef and Coef has variables: Coef -> List(Symbol) and Coef has ALGEBRA(FRAC(INT)) or Coef has ACFS(INT) and Coef has ALGEBRA(FRAC(INT)) and Coef has PRIMCAT and Coef has TRANFUN
+--R integrate : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R lcm : (%,%) -> % if Coef has FIELD
+--R lcm : List(%) -> % if Coef has FIELD
+--R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) if Coef has FIELD
+--R log : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R monomial : (%,List(SingletonAsOrderedSet),List(Fraction(Integer))) -> %
+--R monomial : (%,SingletonAsOrderedSet,Fraction(Integer)) -> %
+--R monomial : (Coef,Fraction(Integer)) -> %
+--R multiEuclidean : (List(%),%) -> Union(List(%),"failed") if Coef has FIELD
+--R multiplyExponents : (%,Fraction(Integer)) -> %
+--R multiplyExponents : (%,PositiveInteger) -> %
+--R nthRoot : (%,Integer) -> % if Coef has ALGEBRA(FRAC(INT))
+--R order : (%,Fraction(Integer)) -> Fraction(Integer)
+--R pi : () -> % if Coef has ALGEBRA(FRAC(INT))
+--R prime? : % -> Boolean if Coef has FIELD
+--R principalIdeal : List(%) -> Record(coef: List(%),generator: %) if Coef has FIELD
+--R ?quo? : (%,%) -> % if Coef has FIELD
+--R ?rem? : (%,%) -> % if Coef has FIELD
+--R sec : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R sech : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R series : (NonNegativeInteger,Stream(Record(k: Fraction(Integer),c: Coef))) -> %
+--R sin : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R sinh : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R sizeLess? : (%,%) -> Boolean if Coef has FIELD
+--R sqrt : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R squareFree : % -> Factored(%) if Coef has FIELD
+--R squareFreePart : % -> % if Coef has FIELD
+--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: Fraction(Integer),c: Coef))
+--R truncate : (%,Fraction(Integer),Fraction(Integer)) -> %
+--R truncate : (%,Fraction(Integer)) -> %
+--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}{GeneralUnivariatePowerSeries.help}
+====================================================================
+GeneralUnivariatePowerSeries examples
+====================================================================
+
+This is a category of univariate Puiseux series constructed from 
+univariate Laurent series.  A Puiseux series is represented by a pair 
+[r,f(x)], where r is a positive rational number and f(x) is a Laurent 
+series.  This pair represents the Puiseux series f(x\^r).
+
+See Also:
+o )show GeneralUnivariatePowerSeries
+
+\end{chunk}
+
+\pagehead{GeneralUnivariatePowerSeries}{GSERIES}
+\pagepic{ps/v103generalunivariatepowerseries.ps}{GSERIES}{1.00}
+
+{\bf Exports:}\\
+\begin{tabular}{llll}
+\cross{GSERIES}{0} &
+\cross{GSERIES}{1} &
+\cross{GSERIES}{acos} &
+\cross{GSERIES}{acosh} \\
+\cross{GSERIES}{acot} &
+\cross{GSERIES}{acoth} &
+\cross{GSERIES}{acsc} &
+\cross{GSERIES}{acsch} \\
+\cross{GSERIES}{approximate} &
+\cross{GSERIES}{asec} &
+\cross{GSERIES}{asech} &
+\cross{GSERIES}{asin} \\
+\cross{GSERIES}{asinh} &
+\cross{GSERIES}{associates?} &
+\cross{GSERIES}{atan} &
+\cross{GSERIES}{atanh} \\
+\cross{GSERIES}{center} &
+\cross{GSERIES}{characteristic} &
+\cross{GSERIES}{charthRoot} &
+\cross{GSERIES}{coefficient} \\
+\cross{GSERIES}{coerce} &
+\cross{GSERIES}{complete} &
+\cross{GSERIES}{cos} &
+\cross{GSERIES}{cosh} \\
+\cross{GSERIES}{cot} &
+\cross{GSERIES}{coth} &
+\cross{GSERIES}{csc} &
+\cross{GSERIES}{csch} \\
+\cross{GSERIES}{D} &
+\cross{GSERIES}{degree} &
+\cross{GSERIES}{differentiate} &
+\cross{GSERIES}{divide} \\
+\cross{GSERIES}{euclideanSize} &
+\cross{GSERIES}{eval} &
+\cross{GSERIES}{exp} &
+\cross{GSERIES}{expressIdealMember} \\
+\cross{GSERIES}{exquo} &
+\cross{GSERIES}{extend} &
+\cross{GSERIES}{extendedEuclidean} &
+\cross{GSERIES}{factor} \\
+\cross{GSERIES}{gcd} &
+\cross{GSERIES}{gcdPolynomial} &
+\cross{GSERIES}{hash} &
+\cross{GSERIES}{integrate} \\
+\cross{GSERIES}{inv} &
+\cross{GSERIES}{latex} &
+\cross{GSERIES}{lcm} &
+\cross{GSERIES}{leadingCoefficient} \\
+\cross{GSERIES}{leadingMonomial} &
+\cross{GSERIES}{log} &
+\cross{GSERIES}{map} &
+\cross{GSERIES}{monomial} \\
+\cross{GSERIES}{monomial?} &
+\cross{GSERIES}{multiEuclidean} &
+\cross{GSERIES}{multiplyExponents} &
+\cross{GSERIES}{nthRoot} \\
+\cross{GSERIES}{one?} &
+\cross{GSERIES}{order} &
+\cross{GSERIES}{pi} &
+\cross{GSERIES}{pole?} \\
+\cross{GSERIES}{prime?} &
+\cross{GSERIES}{principalIdeal} &
+\cross{GSERIES}{recip} &
+\cross{GSERIES}{reductum} \\
+\cross{GSERIES}{sample} &
+\cross{GSERIES}{sec} &
+\cross{GSERIES}{sech} &
+\cross{GSERIES}{series} \\
+\cross{GSERIES}{sin} &
+\cross{GSERIES}{sinh} &
+\cross{GSERIES}{sizeLess?} &
+\cross{GSERIES}{sqrt} \\
+\cross{GSERIES}{squareFree} &
+\cross{GSERIES}{squareFreePart} &
+\cross{GSERIES}{subtractIfCan} &
+\cross{GSERIES}{tan} \\
+\cross{GSERIES}{tanh} &
+\cross{GSERIES}{terms} &
+\cross{GSERIES}{truncate} &
+\cross{GSERIES}{unit?} \\
+\cross{GSERIES}{unitCanonical} &
+\cross{GSERIES}{unitNormal} &
+\cross{GSERIES}{variable} &
+\cross{GSERIES}{variables} \\
+\cross{GSERIES}{zero?} &
+\cross{GSERIES}{?+?} &
+\cross{GSERIES}{?-?} &
+\cross{GSERIES}{-?} \\
+\cross{GSERIES}{?=?} &
+\cross{GSERIES}{?\^{}?} &
+\cross{GSERIES}{?\~{}=?} &
+\cross{GSERIES}{?*?} \\
+\cross{GSERIES}{?**?} &
+\cross{GSERIES}{?/?} &
+\cross{GSERIES}{?.?} \\
+\cross{GSERIES}{?quo?} &
+\cross{GSERIES}{?rem?} &&
+\end{tabular}
+
+\begin{chunk}{domain GSERIES GeneralUnivariatePowerSeries}
+)abbrev domain GSERIES GeneralUnivariatePowerSeries
+++ Author: Clifton J. Williamson
+++ Date Created: 22 September 1993
+++ Date Last Updated: 23 September 1993
+++ Description:
+++ This is a category of univariate Puiseux series constructed
+++ from univariate Laurent series.  A Puiseux series is represented
+++ by a pair \spad{[r,f(x)]}, where r is a positive rational number and
+++ \spad{f(x)} is a Laurent series.  This pair represents the Puiseux
+++ series \spad{f(x\^r)}.
+
+GeneralUnivariatePowerSeries(Coef,var,cen): Exports == Implementation where
+  Coef : Ring
+  var  : Symbol
+  cen  : Coef
+  I      ==> Integer
+  UTS    ==> UnivariateTaylorSeries
+  ULS    ==> UnivariateLaurentSeries
+  UPXS   ==> UnivariatePuiseuxSeries
+  EFULS  ==> ElementaryFunctionsUnivariateLaurentSeries
+  EFUPXS ==> ElementaryFunctionsUnivariatePuiseuxSeries
+  FS2UPS ==> FunctionSpaceToUnivariatePowerSeries
+
+  Exports ==> UnivariatePuiseuxSeriesCategory Coef with
+    coerce: Variable(var) -> %
+      ++ coerce(var) converts the series variable \spad{var} into a
+      ++ Puiseux series.
+    coerce: UPXS(Coef,var,cen) -> %
+      ++ coerce(f) converts a Puiseux series to a general power series.
+    differentiate: (%,Variable(var)) -> %
+      ++ \spad{differentiate(f(x),x)} returns the derivative of
+      ++ \spad{f(x)} with respect to \spad{x}.
+    if Coef has Algebra Fraction Integer then
+      integrate: (%,Variable(var)) -> %
+        ++ \spad{integrate(f(x))} returns an anti-derivative of the power
+        ++ series \spad{f(x)} with constant coefficient 0.
+        ++ We may integrate a series when we can divide coefficients
+        ++ by integers.
+
+  Implementation ==> UnivariatePuiseuxSeries(Coef,var,cen) add
+
+    coerce(upxs:UPXS(Coef,var,cen)) == upxs pretend %
+
+    puiseux: % -> UPXS(Coef,var,cen)
+    puiseux f == f pretend UPXS(Coef,var,cen)
+
+    if Coef has Algebra Fraction Integer then
+
+      differentiate f ==
+        str1 : String := "'differentiate' unavailable on this domain;  "
+        str2 : String := "use 'approximate' first"
+        error concat(str1,str2)
+
+      differentiate(f:%,v:Variable(var)) == differentiate f
+
+      if Coef has PartialDifferentialRing(Symbol) then
+        differentiate(f:%,s:Symbol) ==
+          (s = variable(f)) =>
+            str1 : String := "'differentiate' unavailable on this domain;  "
+            str2 : String := "use 'approximate' first"
+            error concat(str1,str2)
+          dcds := differentiate(center f,s)
+          deriv := differentiate(puiseux f) :: %
+          map(x+->differentiate(x,s),f) - dcds * deriv
+
+      integrate f ==
+        str1 : String := "'integrate' unavailable on this domain;  "
+        str2 : String := "use 'approximate' first"
+        error concat(str1,str2)
+
+      integrate(f:%,v:Variable(var)) == integrate f
+
+      if Coef has integrate: (Coef,Symbol) -> Coef and _
+         Coef has variables: Coef -> List Symbol then
+
+        integrate(f:%,s:Symbol) ==
+          (s = variable(f)) =>
+            str1 : String := "'integrate' unavailable on this domain;  "
+            str2 : String := "use 'approximate' first"
+            error concat(str1,str2)
+          not entry?(s,variables center f) => map(x+->integrate(x,s),f)
+          error "integrate: center is a function of variable of integration"
+
+      if Coef has TranscendentalFunctionCategory and _
+         Coef has PrimitiveFunctionCategory and _
+         Coef has AlgebraicallyClosedFunctionSpace Integer then
+
+        integrateWithOneAnswer: (Coef,Symbol) -> Coef
+        integrateWithOneAnswer(f,s) ==
+          res := integrate(f,s)$FunctionSpaceIntegration(Integer,Coef)
+          res case Coef => res :: Coef
+          first(res :: List Coef)
+
+        integrate(f:%,s:Symbol) ==
+          (s = variable(f)) =>
+            str1 : String := "'integrate' unavailable on this domain;  "
+            str2 : String := "use 'approximate' first"
+            error concat(str1,str2)
+          not entry?(s,variables center f) =>
+            map(x+->integrateWithOneAnswer(x,s),f)
+          error "integrate: center is a function of variable of integration"
+
+\end{chunk}
+
+\begin{chunk}{COQ GSERIES}
+(* domain GSERIES *)
+(*
+ UnivariatePuiseuxSeries(Coef,var,cen) add
+
+    coerce(upxs:UPXS(Coef,var,cen)) == upxs pretend %
+
+    puiseux: % -> UPXS(Coef,var,cen)
+    puiseux f == f pretend UPXS(Coef,var,cen)
+
+    if Coef has Algebra Fraction Integer then
+
+      differentiate f ==
+        str1 : String := "'differentiate' unavailable on this domain;  "
+        str2 : String := "use 'approximate' first"
+        error concat(str1,str2)
+
+      differentiate(f:%,v:Variable(var)) == differentiate f
+
+      if Coef has PartialDifferentialRing(Symbol) then
+        differentiate(f:%,s:Symbol) ==
+          (s = variable(f)) =>
+            str1 : String := "'differentiate' unavailable on this domain;  "
+            str2 : String := "use 'approximate' first"
+            error concat(str1,str2)
+          dcds := differentiate(center f,s)
+          deriv := differentiate(puiseux f) :: %
+          map(x+->differentiate(x,s),f) - dcds * deriv
+
+      integrate f ==
+        str1 : String := "'integrate' unavailable on this domain;  "
+        str2 : String := "use 'approximate' first"
+        error concat(str1,str2)
+
+      integrate(f:%,v:Variable(var)) == integrate f
+
+      if Coef has integrate: (Coef,Symbol) -> Coef and _
+         Coef has variables: Coef -> List Symbol then
+
+        integrate(f:%,s:Symbol) ==
+          (s = variable(f)) =>
+            str1 : String := "'integrate' unavailable on this domain;  "
+            str2 : String := "use 'approximate' first"
+            error concat(str1,str2)
+          not entry?(s,variables center f) => map(x+->integrate(x,s),f)
+          error "integrate: center is a function of variable of integration"
+
+      if Coef has TranscendentalFunctionCategory and _
+         Coef has PrimitiveFunctionCategory and _
+         Coef has AlgebraicallyClosedFunctionSpace Integer then
+
+        integrateWithOneAnswer: (Coef,Symbol) -> Coef
+        integrateWithOneAnswer(f,s) ==
+          res := integrate(f,s)$FunctionSpaceIntegration(Integer,Coef)
+          res case Coef => res :: Coef
+          first(res :: List Coef)
+
+        integrate(f:%,s:Symbol) ==
+          (s = variable(f)) =>
+            str1 : String := "'integrate' unavailable on this domain;  "
+            str2 : String := "use 'approximate' first"
+            error concat(str1,str2)
+          not entry?(s,variables center f) =>
+            map(x+->integrateWithOneAnswer(x,s),f)
+          error "integrate: center is a function of variable of integration"
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{GSERIES.dotabb}
+"GSERIES" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GSERIES"]
+"ACFS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACFS"]
+"GSERIES" -> "ACFS"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain GRIMAGE GraphImage}
+
+\begin{chunk}{GraphImage.input}
+)set break resume
+)sys rm -f GraphImage.output
+)spool GraphImage.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show GraphImage
+--R 
+--R GraphImage  is a domain constructor
+--R Abbreviation for GraphImage is GRIMAGE 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for GRIMAGE 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?=? : (%,%) -> Boolean                coerce : % -> OutputForm
+--R graphImage : () -> %                  hash : % -> SingleInteger
+--R key : % -> Integer                    latex : % -> String
+--R makeGraphImage : % -> %               ranges : % -> List(Segment(Float))
+--R units : % -> List(Float)              ?~=? : (%,%) -> Boolean
+--R appendPoint : (%,Point(DoubleFloat)) -> Void
+--R coerce : List(List(Point(DoubleFloat))) -> %
+--R component : (%,Point(DoubleFloat),Palette,Palette,PositiveInteger) -> Void
+--R component : (%,Point(DoubleFloat)) -> Void
+--R component : (%,List(Point(DoubleFloat)),Palette,Palette,PositiveInteger) -> Void
+--R figureUnits : List(List(Point(DoubleFloat))) -> List(DoubleFloat)
+--R makeGraphImage : (List(List(Point(DoubleFloat))),List(Palette),List(Palette),List(PositiveInteger),List(DrawOption)) -> %
+--R makeGraphImage : (List(List(Point(DoubleFloat))),List(Palette),List(Palette),List(PositiveInteger)) -> %
+--R makeGraphImage : List(List(Point(DoubleFloat))) -> %
+--R point : (%,Point(DoubleFloat),Palette) -> Void
+--R pointLists : % -> List(List(Point(DoubleFloat)))
+--R putColorInfo : (List(List(Point(DoubleFloat))),List(Palette)) -> List(List(Point(DoubleFloat)))
+--R ranges : (%,List(Segment(Float))) -> List(Segment(Float))
+--R units : (%,List(Float)) -> List(Float)
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{GraphImage.help}
+====================================================================
+GraphImage examples
+====================================================================
+
+TwoDimensionalGraph creates virtual two dimensional graphs 
+(to be displayed on TwoDimensionalViewports).
+
+See Also:
+o )show GraphImage
+
+\end{chunk}
+
+\pagehead{GraphImage}{GRIMAGE}
+\pagepic{ps/v103graphimage.ps}{GRIMAGE}{1.00}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{GRIMAGE}{appendPoint} &
+\cross{GRIMAGE}{coerce} &
+\cross{GRIMAGE}{component} &
+\cross{GRIMAGE}{figureUnits} &
+\cross{GRIMAGE}{graphImage} \\
+\cross{GRIMAGE}{hash} &
+\cross{GRIMAGE}{key} &
+\cross{GRIMAGE}{latex} &
+\cross{GRIMAGE}{makeGraphImage} &
+\cross{GRIMAGE}{point} \\
+\cross{GRIMAGE}{pointLists} &
+\cross{GRIMAGE}{putColorInfo} &
+\cross{GRIMAGE}{ranges} &
+\cross{GRIMAGE}{units} &
+\cross{GRIMAGE}{?\~{}=?} \\
+\cross{GRIMAGE}{?=?} &&&&
+\end{tabular}
+
+\begin{chunk}{domain GRIMAGE GraphImage}
+)abbrev domain GRIMAGE GraphImage
+++ Author: Jim Wen
+++ Date Created: 27 April 1989
+++ Date Last Updated: 1995 September 20, Mike Richardson (MGR)
+++ Description:
+++ TwoDimensionalGraph creates virtual two dimensional graphs 
+++ (to be displayed on TwoDimensionalViewports).
+
+GraphImage (): Exports == Implementation where
+
+  VIEW    ==> VIEWPORTSERVER$Lisp
+  sendI   ==> SOCK_-SEND_-INT
+  sendSF  ==> SOCK_-SEND_-FLOAT
+  sendSTR ==> SOCK_-SEND_-STRING
+  getI    ==> SOCK_-GET_-INT
+  getSF   ==> SOCK_-GET_-FLOAT
+
+  typeGRAPH  ==> 2
+  typeVIEW2D ==> 3
+
+  makeGRAPH  ==> (-1)$SingleInteger
+  makeVIEW2D ==> (-1)$SingleInteger
+ 
+  I   ==> Integer
+  PI  ==> PositiveInteger
+  NNI ==> NonNegativeInteger
+  SF  ==> DoubleFloat
+  F   ==> Float
+  L   ==> List
+  P   ==> Point(SF)
+  V   ==> Vector
+  SEG ==> Segment
+  RANGESF   ==> L SEG SF
+  RANGEF    ==> L SEG F
+  UNITSF   ==> L SF
+  UNITF    ==> L F
+  PAL ==> Palette
+  E   ==> OutputForm
+  DROP ==> DrawOption
+  PP ==> PointPackage(SF)
+  COORDSYS ==> CoordinateSystems(SF)
+
+  Exports ==> SetCategory with
+    graphImage      :  ()                                        -> $
+      ++ graphImage() returns an empty graph with 0 point lists 
+      ++ of the domain \spadtype{GraphImage}.  A graph image contains
+      ++ the graph data component of a two dimensional viewport.
+    makeGraphImage  :  $                                         -> $ 
+      ++ makeGraphImage(gi) takes the given graph, \spad{gi} of the
+      ++ domain \spadtype{GraphImage}, and sends it's data to the
+      ++ viewport manager where it waits to be included in a two-dimensional
+      ++ viewport window.  \spad{gi} cannot be an empty graph, and it's
+      ++ elements must have been created using the \spadfun{point} or
+      ++ \spadfun{component} functions, not by a previous
+      ++ \spadfun{makeGraphImage}.
+    makeGraphImage  :  (L L P)                                   -> $
+      ++ makeGraphImage(llp) returns a graph of the domain 
+      ++ \spadtype{GraphImage} which is composed of the points and 
+      ++ lines from the list of lists of points, \spad{llp}, with 
+      ++ default point size and default point and line colours. The graph
+      ++ data is then sent to the viewport manager where it waits to be
+      ++ included in a two-dimensional viewport window.
+    makeGraphImage  :  (L L P,L PAL,L PAL,L PI)                  -> $ 
+      ++ makeGraphImage(llp,lpal1,lpal2,lp) returns a graph of the
+      ++ domain \spadtype{GraphImage} which is composed of the points
+      ++ and lines from the list of lists of points, \spad{llp}, whose
+      ++ point colors are indicated by the list of palette colors,
+      ++ \spad{lpal1}, and whose lines are colored according to the list
+      ++ of palette colors, \spad{lpal2}.  The paramater lp is a list of
+      ++ integers which denote the size of the data points.  The graph
+      ++ data is then sent to the viewport manager where it waits to be
+      ++ included in a two-dimensional viewport window.
+    makeGraphImage  :  (L L P,L PAL,L PAL,L PI,L DROP)           -> $
+      ++ makeGraphImage(llp,lpal1,lpal2,lp,lopt) returns a graph of
+      ++ the domain \spadtype{GraphImage} which is composed of the 
+      ++ points and lines from the list of lists of points, \spad{llp},
+      ++ whose point colors are indicated by the list of palette colors,
+      ++ \spad{lpal1}, and whose lines are colored according to the list
+      ++ of palette colors, \spad{lpal2}.  The paramater lp is a list of
+      ++ integers which denote the size of the data points, and \spad{lopt}
+      ++ is the list of draw command options.  The graph data is then sent
+      ++ to the viewport manager where it waits to be included in a 
+      ++ two-dimensional viewport window.
+    pointLists      :  $                                         -> L L P
+      ++ pointLists(gi) returns the list of lists of points which compose
+      ++ the given graph, \spad{gi}, of the domain \spadtype{GraphImage}.
+    key             :  $                                         -> I
+      ++ key(gi) returns the process ID of the given graph, \spad{gi},
+      ++ of the domain \spadtype{GraphImage}.
+    ranges          :  $                                         -> RANGEF
+      ++ ranges(gi) returns the list of ranges of the point components from
+      ++ the indicated graph, \spad{gi}, of the domain \spadtype{GraphImage}.
+    ranges          :  ($,RANGEF)                                -> RANGEF
+      ++ ranges(gi,lr) modifies the list of ranges for the given graph,
+      ++ \spad{gi} of the domain \spadtype{GraphImage}, to be that of the
+      ++ list of range segments, \spad{lr}, and returns the new range list
+      ++ for \spad{gi}. 
+    units           :  $                                         -> UNITF
+      ++ units(gi) returns the list of unit increments for the x and y
+      ++ axes of the indicated graph, \spad{gi}, of the domain
+      ++ \spadtype{GraphImage}.
+    units           :  ($,UNITF)                                 -> UNITF
+      ++ units(gi,lu) modifies the list of unit increments for the x and y
+      ++ axes of the given graph, \spad{gi} of the domain
+      ++ \spadtype{GraphImage}, to be that of the list of unit increments,
+      ++ \spad{lu}, and returns the new list of units for \spad{gi}. 
+    component       :  ($,L P,PAL,PAL,PI)                        -> Void
+      ++ component(gi,lp,pal1,pal2,p) sets the components of the
+      ++ graph, \spad{gi} of the domain \spadtype{GraphImage}, to the
+      ++ values given.  The point list for \spad{gi} is set to the list
+      ++ \spad{lp}, the color of the points in \spad{lp} is set to
+      ++ the palette color \spad{pal1}, the color of the lines which
+      ++ connect the points \spad{lp} is set to the palette color
+      ++ \spad{pal2}, and the size of the points in \spad{lp} is given
+      ++ by the integer p.
+    component       :  ($,P)                                     -> Void
+      ++ component(gi,pt) modifies the graph \spad{gi} of the domain
+      ++ \spadtype{GraphImage} to contain one point component, \spad{pt}
+      ++ whose point color, line color and point size are determined by
+      ++ the default functions \spadfun{pointColorDefault},
+      ++ \spadfun{lineColorDefault}, and \spadfun{pointSizeDefault}.
+    component       :  ($,P,PAL,PAL,PI)                          -> Void
+      ++ component(gi,pt,pal1,pal2,ps) modifies the graph \spad{gi} of
+      ++ the domain \spadtype{GraphImage} to contain one point component,
+      ++ \spad{pt} whose point color is set to the palette color \spad{pal1},
+      ++ line color is set to the palette color \spad{pal2}, and point
+      ++ size is set to the positive integer \spad{ps}.
+    appendPoint     :  ($,P)                                     -> Void
+      ++ appendPoint(gi,pt) appends the point \spad{pt} to the end
+      ++ of the list of points component for the graph, \spad{gi}, which is
+      ++ of the domain \spadtype{GraphImage}.
+    point           :  ($,P,PAL)                                 -> Void
+      ++ point(gi,pt,pal) modifies the graph \spad{gi} of the domain
+      ++ \spadtype{GraphImage} to contain one point component, \spad{pt}
+      ++ whose point color is set to be the palette color \spad{pal}, and
+      ++ whose line color and point size are determined by the default
+      ++ functions \spadfun{lineColorDefault} and \spadfun{pointSizeDefault}.
+    coerce          :  L L P                                     -> $
+      ++ coerce(llp)
+      ++ component(gi,pt) creates and returns a graph of the domain
+      ++ \spadtype{GraphImage} which is composed of the list of list
+      ++ of points given by \spad{llp}, and whose point colors, line colors
+      ++ and point sizes are determined by the default functions 
+      ++ \spadfun{pointColorDefault}, \spadfun{lineColorDefault}, and
+      ++ \spadfun{pointSizeDefault}.  The graph data is then sent to the 
+      ++ viewport manager where it waits to be included in a two-dimensional
+      ++ viewport window.
+    coerce          :  $                                         -> E
+      ++ coerce(gi) returns the indicated graph, \spad{gi}, of domain
+      ++ \spadtype{GraphImage} as output of the domain \spadtype{OutputForm}.
+    putColorInfo    : (L L P,L PAL)                              -> L L P
+      ++ putColorInfo(llp,lpal) takes a list of list of points, \spad{llp},
+      ++ and returns the points with their hue and shade components
+      ++ set according to the list of palette colors, \spad{lpal}.
+    figureUnits : L L P                       -> UNITSF
+
+  Implementation ==> add
+
+    import Color()
+    import Palette()
+    import ViewDefaultsPackage()
+    import PlotTools()
+    import DrawOptionFunctions0
+    import P
+    import PP
+    import COORDSYS
+
+    Rep := Record(key: I, rangesField: RANGESF, unitsField: UNITSF, _
+       llPoints: L L P, pointColors: L PAL, _
+       lineColors: L PAL, pointSizes: L PI, _
+       optionsField: L DROP)
+
+--%Internal Functions
+
+    graph       : RANGEF                          -> $
+
+    scaleStep   : SF                          -> SF
+
+    makeGraph   :  $                          -> $
+
+    numberCheck(nums:Point SF):Void ==
+      for i in minIndex(nums)..maxIndex(nums) repeat
+        COMPLEXP(nums.(i::PositiveInteger))$Lisp =>
+          error _
+           "An unexpected complex number was encountered in the calculations."
+           
+
+    doOptions(g:Rep):Void ==    
+      lr : RANGEF := ranges(g.optionsField,ranges g)
+      if (#lr > 1$I) then
+        g.rangesField := [segment(convert(lo(lr.1))@SF,_
+                                  convert(hi(lr.1))@SF)$(Segment(SF)), 
+                           segment(convert(lo(lr.2))@SF,_
+                                   convert(hi(lr.2))@SF)$(Segment(SF))]
+      else
+        g.rangesField := []
+      lu : UNITF := units(g.optionsField,units g)
+      if (#lu > 1$I) then
+        g.unitsField := [convert(lu.1)@SF,convert(lu.2)@SF]
+      else
+        g.unitsField := []
+    -- etc - graphimage specific stuff...
+
+    putColorInfo(llp,listOfPalettes) ==
+      llp2 : L L P := []
+      for lp in llp for pal in listOfPalettes repeat
+        lp2 : L P := []
+        daHue   := (hue(hue pal))::SF
+        daShade := (shade pal)::SF
+        for p in lp repeat
+          if (d := dimension p) < 3 then
+            p := extend(p,[daHue,daShade])
+          else
+            p.3 := daHue
+            d < 4 => p := extend(p,[daShade])
+            p.4 := daShade
+          lp2 := cons(p,lp2)
+        llp2 := cons(reverse_! lp2,llp2)
+      reverse_! llp2
+
+    graph demRanges ==
+      null demRanges =>  [ 0, [], [], [], [], [], [], [] ]
+      demRangesSF : RANGESF := _
+        [ segment(convert(lo demRanges.1)@SF,_
+                  convert(hi demRanges.1)@SF)$(Segment(SF)), _
+          segment(convert(lo demRanges.1)@SF,_
+                  convert(hi demRanges.1)@SF)$(Segment(SF)) ]
+      [ 0, demRangesSF, [], [], [], [], [], [] ]
+
+    scaleStep(range) ==                        -- MGR
+      adjust:NNI
+      tryStep:SF
+      scaleDown:SF
+      numerals:String
+      adjust := 0
+      while range < 100.0::SF repeat
+        adjust := adjust + 1
+        range := range * 10.0::SF -- might as well take big steps
+      tryStep := range/10.0::SF
+      numerals := string(((retract(ceiling(tryStep)$SF)$SF)@I))$String
+      scaleDown := (10@I **$I (((#(numerals)@I) - 1$I) pretend PI))::SF
+      scaleDown*ceiling(tryStep/scaleDown - 0.5::SF)/((10 **$I adjust)::SF)
+
+    figureUnits(listOfListsOfPoints) ==
+        -- figure out the min/max and divide by 10 for unit markers
+      xMin := xMax := xCoord first first listOfListsOfPoints
+      yMin := yMax := yCoord first first listOfListsOfPoints
+      if xMin ~= xMin then xMin:=max()
+      if xMax ~= xMax then xMax:=min()
+      if yMin ~= yMin then yMin:=max()
+      if yMax ~= yMax then yMax:=min()
+      for pL in listOfListsOfPoints repeat
+        for p in pL repeat
+          if ((px := (xCoord p)) < xMin) then
+            xMin := px
+          if px > xMax then
+            xMax := px
+          if ((py := (yCoord p)) < yMin) then
+            yMin := py
+          if py > yMax then
+            yMax := py
+      if xMin = xMax then
+        xMin := xMin - convert(0.5)$Float
+        xMax := xMax + convert(0.5)$Float
+      if yMin = yMax then
+        yMin := yMin - convert(0.5)$Float
+        yMax := yMax + convert(0.5)$Float
+      [scaleStep(xMax-xMin),scaleStep(yMax-yMin)]
+
+    plotLists(graf:Rep,listOfListsOfPoints:L L P,listOfPointColors:L PAL,_
+              listOfLineColors:L PAL,listOfPointSizes:L PI):$ ==
+      givenLen := #listOfListsOfPoints
+        -- take out point lists that are actually empty
+      listOfListsOfPoints := [ l for l in listOfListsOfPoints | ^null l ]
+      if (null listOfListsOfPoints) then
+        error "GraphImage was given a list that contained no valid point lists"
+      if ((len := #listOfListsOfPoints) ^= givenLen) then
+        sayBrightly(_
+         ["   Warning: Ignoring pointless point list"::E]$List(E))$Lisp
+      graf.llPoints := listOfListsOfPoints
+        -- do point colors
+      if ((givenLen := #listOfPointColors) > len) then
+         -- pad or discard elements if given list has 
+         -- length different from the point list
+        graf.pointColors := concat(listOfPointColors,
+            new((len - givenLen)::NonNegativeInteger + 1, pointColorDefault()))
+      else graf.pointColors := first(listOfPointColors, len)
+        -- do line colors
+      if ((givenLen := #listOfLineColors) > len) then
+        graf.lineColors := concat(listOfLineColors,
+             new((len - givenLen)::NonNegativeInteger + 1, lineColorDefault()))
+      else graf.lineColors := first(listOfLineColors, len)
+        -- do point sizes
+      if ((givenLen := #listOfPointSizes) > len) then
+        graf.pointSizes := concat(listOfPointSizes,
+             new((len - givenLen)::NonNegativeInteger + 1, pointSizeDefault()))
+      else graf.pointSizes := first(listOfPointSizes, len)
+      graf
+
+    makeGraph graf ==
+      doOptions(graf)
+      (s := #(graf.llPoints)) = 0 =>
+        error "You are trying to make a graph with no points"
+      key graf ^= 0 => 
+        error "You are trying to draw over an existing graph"
+      transform := _
+        coord(graf.optionsField,cartesian$COORDSYS)$DrawOptionFunctions0 
+      graf.llPoints:= putColorInfo(graf.llPoints,graf.pointColors)
+      if null(ranges graf) then  -- figure out best ranges for points
+        graf.rangesField := calcRanges(graf.llPoints)  --::V SEG SF
+      if null(units graf) then  -- figure out best ranges for points
+        graf.unitsField := figureUnits(graf.llPoints)  --::V SEG SF
+      sayBrightly(["   Graph data being transmitted to the _
+ viewport manager..."::E]$List(E))$Lisp
+      sendI(VIEW,typeGRAPH)$Lisp
+      sendI(VIEW,makeGRAPH)$Lisp
+      tonto := (graf.rangesField)::RANGESF
+      sendSF(VIEW,lo(first tonto))$Lisp
+      sendSF(VIEW,hi(first tonto))$Lisp
+      sendSF(VIEW,lo(second tonto))$Lisp
+      sendSF(VIEW,hi(second tonto))$Lisp
+      sendSF(VIEW,first (graf.unitsField))$Lisp
+      sendSF(VIEW,second (graf.unitsField))$Lisp
+      sendI(VIEW,s)$Lisp     -- how many lists of points are being sent
+      for aList in graf.llPoints _
+       for pColor in graf.pointColors _
+        for lColor in graf.lineColors for s in graf.pointSizes repeat
+        sendI(VIEW,#aList)$Lisp  -- how many points in this list
+        for p in aList repeat
+          aPoint := transform p
+          sendSF(VIEW,xCoord aPoint)$Lisp
+          sendSF(VIEW,yCoord aPoint)$Lisp
+          sendSF(VIEW,hue(p)$PP)$Lisp  -- ?use aPoint as well...?
+          sendSF(VIEW,shade(p)$PP)$Lisp
+        hueShade := hue hue pColor + shade pColor * numberOfHues() 
+        sendI(VIEW,hueShade)$Lisp
+        hueShade := (hue hue lColor -1)*5 + shade lColor
+        sendI(VIEW,hueShade)$Lisp
+        sendI(VIEW,s)$Lisp
+      graf.key := getI(VIEW)$Lisp
+      graf        
+
+--%Exported Functions
+
+    makeGraphImage(graf:$)    == makeGraph graf
+
+    key graf                  == graf.key
+
+    pointLists graf           == graf.llPoints
+
+    ranges graf                == 
+      null graf.rangesField => []
+      [segment(convert(lo graf.rangesField.1)@F,_
+               convert(hi graf.rangesField.1)@F), _
+       segment(convert(lo graf.rangesField.2)@F,_
+               convert(hi graf.rangesField.2)@F)]
+
+    ranges(graf,rangesList)     == 
+      graf.rangesField := 
+        [segment(convert(lo rangesList.1)@SF,convert(hi rangesList.1)@SF), _
+         segment(convert(lo rangesList.2)@SF,convert(hi rangesList.2)@SF)]
+      rangesList
+
+    units graf                == 
+      null(graf.unitsField) => []
+      [convert(graf.unitsField.1)@F,convert(graf.unitsField.2)@F]
+
+    units (graf,unitsToBe)    == 
+      graf.unitsField := [convert(unitsToBe.1)@SF,convert(unitsToBe.2)@SF]
+      unitsToBe
+
+    graphImage                == graph []
+
+    makeGraphImage(llp) ==
+      makeGraphImage(llp,
+        [pointColorDefault() for i in 1..(l:=#llp)],
+         [lineColorDefault() for i in 1..l], 
+          [pointSizeDefault() for i in 1..l])
+
+    makeGraphImage(llp,lpc,llc,lps) ==
+      makeGraphImage(llp,lpc,llc,lps,[])
+
+    makeGraphImage(llp,lpc,llc,lps,opts) ==
+      graf := graph(ranges(opts,[]))
+      graf.optionsField := opts
+      graf := plotLists(graf,llp,lpc,llc,lps)
+      transform := _
+        coord(graf.optionsField,cartesian$COORDSYS)$DrawOptionFunctions0
+      for aList in graf.llPoints repeat
+        for p in aList repeat
+          aPoint := transform p
+          numberCheck aPoint
+      makeGraph graf
+
+    component (graf:$,ListOfPoints:L P,PointColor:PAL,_
+               LineColor:PAL,PointSize:PI) ==
+      graf.llPoints    := append(graf.llPoints,[ListOfPoints])
+      graf.pointColors := append(graf.pointColors,[PointColor])
+      graf.lineColors  := append(graf.lineColors,[LineColor])
+      graf.pointSizes  := append(graf.pointSizes,[PointSize])     
+
+    component (graf,aPoint) ==
+      component(graf,aPoint,pointColorDefault(),_
+                lineColorDefault(),pointSizeDefault())
+
+    component (graf:$,aPoint:P,PointColor:PAL,LineColor:PAL,PointSize:PI) ==
+      component (graf,[aPoint],PointColor,LineColor,PointSize)
+
+    appendPoint (graf,aPoint) ==
+      num : I  := #(graf.llPoints) - 1
+      num < 0 => error "No point lists to append to!"
+      (graf.llPoints.num) := append((graf.llPoints.num),[aPoint])
+
+    point (graf,aPoint,PointColor) ==
+      component(graf,aPoint,PointColor,lineColorDefault(),pointSizeDefault())
+
+    coerce (llp : L L P) : $ ==
+      makeGraphImage(llp,
+          [pointColorDefault() for i in 1..(l:=#llp)],
+           [lineColorDefault() for i in 1..l], 
+            [pointSizeDefault() for i in 1..l])
+
+    coerce (graf : $) : E ==
+      hconcat( ["Graph with " :: E,(p := # pointLists graf) :: E, 
+         (p=1 => " point list"; " point lists") :: E])
+
+\end{chunk}
+
+\begin{chunk}{COQ GRIMAGE}
+(* domain GRIMAGE *)
+(*
+
+    import Color()
+    import Palette()
+    import ViewDefaultsPackage()
+    import PlotTools()
+    import DrawOptionFunctions0
+    import P
+    import PP
+    import COORDSYS
+
+    Rep := Record(key: I, rangesField: RANGESF, unitsField: UNITSF, _
+       llPoints: L L P, pointColors: L PAL, _
+       lineColors: L PAL, pointSizes: L PI, _
+       optionsField: L DROP)
+
+--%Internal Functions
+
+    graph       : RANGEF                          -> $
+
+    scaleStep   : SF                          -> SF
+
+    makeGraph   :  $                          -> $
+
+    numberCheck(nums:Point SF):Void ==
+      for i in minIndex(nums)..maxIndex(nums) repeat
+        COMPLEXP(nums.(i::PositiveInteger))$Lisp =>
+          error _
+           "An unexpected complex number was encountered in the calculations."
+           
+
+    doOptions(g:Rep):Void ==    
+      lr : RANGEF := ranges(g.optionsField,ranges g)
+      if (#lr > 1$I) then
+        g.rangesField := [segment(convert(lo(lr.1))@SF,_
+                                  convert(hi(lr.1))@SF)$(Segment(SF)), 
+                           segment(convert(lo(lr.2))@SF,_
+                                   convert(hi(lr.2))@SF)$(Segment(SF))]
+      else
+        g.rangesField := []
+      lu : UNITF := units(g.optionsField,units g)
+      if (#lu > 1$I) then
+        g.unitsField := [convert(lu.1)@SF,convert(lu.2)@SF]
+      else
+        g.unitsField := []
+    -- etc - graphimage specific stuff...
+
+    putColorInfo(llp,listOfPalettes) ==
+      llp2 : L L P := []
+      for lp in llp for pal in listOfPalettes repeat
+        lp2 : L P := []
+        daHue   := (hue(hue pal))::SF
+        daShade := (shade pal)::SF
+        for p in lp repeat
+          if (d := dimension p) < 3 then
+            p := extend(p,[daHue,daShade])
+          else
+            p.3 := daHue
+            d < 4 => p := extend(p,[daShade])
+            p.4 := daShade
+          lp2 := cons(p,lp2)
+        llp2 := cons(reverse_! lp2,llp2)
+      reverse_! llp2
+
+    graph demRanges ==
+      null demRanges =>  [ 0, [], [], [], [], [], [], [] ]
+      demRangesSF : RANGESF := _
+        [ segment(convert(lo demRanges.1)@SF,_
+                  convert(hi demRanges.1)@SF)$(Segment(SF)), _
+          segment(convert(lo demRanges.1)@SF,_
+                  convert(hi demRanges.1)@SF)$(Segment(SF)) ]
+      [ 0, demRangesSF, [], [], [], [], [], [] ]
+
+    scaleStep(range) ==                        -- MGR
+      adjust:NNI
+      tryStep:SF
+      scaleDown:SF
+      numerals:String
+      adjust := 0
+      while range < 100.0::SF repeat
+        adjust := adjust + 1
+        range := range * 10.0::SF -- might as well take big steps
+      tryStep := range/10.0::SF
+      numerals := string(((retract(ceiling(tryStep)$SF)$SF)@I))$String
+      scaleDown := (10@I **$I (((#(numerals)@I) - 1$I) pretend PI))::SF
+      scaleDown*ceiling(tryStep/scaleDown - 0.5::SF)/((10 **$I adjust)::SF)
+
+    figureUnits(listOfListsOfPoints) ==
+        -- figure out the min/max and divide by 10 for unit markers
+      xMin := xMax := xCoord first first listOfListsOfPoints
+      yMin := yMax := yCoord first first listOfListsOfPoints
+      if xMin ~= xMin then xMin:=max()
+      if xMax ~= xMax then xMax:=min()
+      if yMin ~= yMin then yMin:=max()
+      if yMax ~= yMax then yMax:=min()
+      for pL in listOfListsOfPoints repeat
+        for p in pL repeat
+          if ((px := (xCoord p)) < xMin) then
+            xMin := px
+          if px > xMax then
+            xMax := px
+          if ((py := (yCoord p)) < yMin) then
+            yMin := py
+          if py > yMax then
+            yMax := py
+      if xMin = xMax then
+        xMin := xMin - convert(0.5)$Float
+        xMax := xMax + convert(0.5)$Float
+      if yMin = yMax then
+        yMin := yMin - convert(0.5)$Float
+        yMax := yMax + convert(0.5)$Float
+      [scaleStep(xMax-xMin),scaleStep(yMax-yMin)]
+
+    plotLists(graf:Rep,listOfListsOfPoints:L L P,listOfPointColors:L PAL,_
+              listOfLineColors:L PAL,listOfPointSizes:L PI):$ ==
+      givenLen := #listOfListsOfPoints
+        -- take out point lists that are actually empty
+      listOfListsOfPoints := [ l for l in listOfListsOfPoints | ^null l ]
+      if (null listOfListsOfPoints) then
+        error "GraphImage was given a list that contained no valid point lists"
+      if ((len := #listOfListsOfPoints) ^= givenLen) then
+        sayBrightly(_
+         ["   Warning: Ignoring pointless point list"::E]$List(E))$Lisp
+      graf.llPoints := listOfListsOfPoints
+        -- do point colors
+      if ((givenLen := #listOfPointColors) > len) then
+         -- pad or discard elements if given list has 
+         -- length different from the point list
+        graf.pointColors := concat(listOfPointColors,
+            new((len - givenLen)::NonNegativeInteger + 1, pointColorDefault()))
+      else graf.pointColors := first(listOfPointColors, len)
+        -- do line colors
+      if ((givenLen := #listOfLineColors) > len) then
+        graf.lineColors := concat(listOfLineColors,
+             new((len - givenLen)::NonNegativeInteger + 1, lineColorDefault()))
+      else graf.lineColors := first(listOfLineColors, len)
+        -- do point sizes
+      if ((givenLen := #listOfPointSizes) > len) then
+        graf.pointSizes := concat(listOfPointSizes,
+             new((len - givenLen)::NonNegativeInteger + 1, pointSizeDefault()))
+      else graf.pointSizes := first(listOfPointSizes, len)
+      graf
+
+    makeGraph graf ==
+      doOptions(graf)
+      (s := #(graf.llPoints)) = 0 =>
+        error "You are trying to make a graph with no points"
+      key graf ^= 0 => 
+        error "You are trying to draw over an existing graph"
+      transform := _
+        coord(graf.optionsField,cartesian$COORDSYS)$DrawOptionFunctions0 
+      graf.llPoints:= putColorInfo(graf.llPoints,graf.pointColors)
+      if null(ranges graf) then  -- figure out best ranges for points
+        graf.rangesField := calcRanges(graf.llPoints)  --::V SEG SF
+      if null(units graf) then  -- figure out best ranges for points
+        graf.unitsField := figureUnits(graf.llPoints)  --::V SEG SF
+      sayBrightly(["   Graph data being transmitted to the _
+ viewport manager..."::E]$List(E))$Lisp
+      sendI(VIEW,typeGRAPH)$Lisp
+      sendI(VIEW,makeGRAPH)$Lisp
+      tonto := (graf.rangesField)::RANGESF
+      sendSF(VIEW,lo(first tonto))$Lisp
+      sendSF(VIEW,hi(first tonto))$Lisp
+      sendSF(VIEW,lo(second tonto))$Lisp
+      sendSF(VIEW,hi(second tonto))$Lisp
+      sendSF(VIEW,first (graf.unitsField))$Lisp
+      sendSF(VIEW,second (graf.unitsField))$Lisp
+      sendI(VIEW,s)$Lisp     -- how many lists of points are being sent
+      for aList in graf.llPoints _
+       for pColor in graf.pointColors _
+        for lColor in graf.lineColors for s in graf.pointSizes repeat
+        sendI(VIEW,#aList)$Lisp  -- how many points in this list
+        for p in aList repeat
+          aPoint := transform p
+          sendSF(VIEW,xCoord aPoint)$Lisp
+          sendSF(VIEW,yCoord aPoint)$Lisp
+          sendSF(VIEW,hue(p)$PP)$Lisp  -- ?use aPoint as well...?
+          sendSF(VIEW,shade(p)$PP)$Lisp
+        hueShade := hue hue pColor + shade pColor * numberOfHues() 
+        sendI(VIEW,hueShade)$Lisp
+        hueShade := (hue hue lColor -1)*5 + shade lColor
+        sendI(VIEW,hueShade)$Lisp
+        sendI(VIEW,s)$Lisp
+      graf.key := getI(VIEW)$Lisp
+      graf        
+
+--%Exported Functions
+
+    makeGraphImage(graf:$)    == makeGraph graf
+
+    key graf                  == graf.key
+
+    pointLists graf           == graf.llPoints
+
+    ranges graf                == 
+      null graf.rangesField => []
+      [segment(convert(lo graf.rangesField.1)@F,_
+               convert(hi graf.rangesField.1)@F), _
+       segment(convert(lo graf.rangesField.2)@F,_
+               convert(hi graf.rangesField.2)@F)]
+
+    ranges(graf,rangesList)     == 
+      graf.rangesField := 
+        [segment(convert(lo rangesList.1)@SF,convert(hi rangesList.1)@SF), _
+         segment(convert(lo rangesList.2)@SF,convert(hi rangesList.2)@SF)]
+      rangesList
+
+    units graf                == 
+      null(graf.unitsField) => []
+      [convert(graf.unitsField.1)@F,convert(graf.unitsField.2)@F]
+
+    units (graf,unitsToBe)    == 
+      graf.unitsField := [convert(unitsToBe.1)@SF,convert(unitsToBe.2)@SF]
+      unitsToBe
+
+    graphImage                == graph []
+
+    makeGraphImage(llp) ==
+      makeGraphImage(llp,
+        [pointColorDefault() for i in 1..(l:=#llp)],
+         [lineColorDefault() for i in 1..l], 
+          [pointSizeDefault() for i in 1..l])
+
+    makeGraphImage(llp,lpc,llc,lps) ==
+      makeGraphImage(llp,lpc,llc,lps,[])
+
+    makeGraphImage(llp,lpc,llc,lps,opts) ==
+      graf := graph(ranges(opts,[]))
+      graf.optionsField := opts
+      graf := plotLists(graf,llp,lpc,llc,lps)
+      transform := _
+        coord(graf.optionsField,cartesian$COORDSYS)$DrawOptionFunctions0
+      for aList in graf.llPoints repeat
+        for p in aList repeat
+          aPoint := transform p
+          numberCheck aPoint
+      makeGraph graf
+
+    component (graf:$,ListOfPoints:L P,PointColor:PAL,_
+               LineColor:PAL,PointSize:PI) ==
+      graf.llPoints    := append(graf.llPoints,[ListOfPoints])
+      graf.pointColors := append(graf.pointColors,[PointColor])
+      graf.lineColors  := append(graf.lineColors,[LineColor])
+      graf.pointSizes  := append(graf.pointSizes,[PointSize])     
+
+    component (graf,aPoint) ==
+      component(graf,aPoint,pointColorDefault(),_
+                lineColorDefault(),pointSizeDefault())
+
+    component (graf:$,aPoint:P,PointColor:PAL,LineColor:PAL,PointSize:PI) ==
+      component (graf,[aPoint],PointColor,LineColor,PointSize)
+
+    appendPoint (graf,aPoint) ==
+      num : I  := #(graf.llPoints) - 1
+      num < 0 => error "No point lists to append to!"
+      (graf.llPoints.num) := append((graf.llPoints.num),[aPoint])
+
+    point (graf,aPoint,PointColor) ==
+      component(graf,aPoint,PointColor,lineColorDefault(),pointSizeDefault())
+
+    coerce (llp : L L P) : $ ==
+      makeGraphImage(llp,
+          [pointColorDefault() for i in 1..(l:=#llp)],
+           [lineColorDefault() for i in 1..l], 
+            [pointSizeDefault() for i in 1..l])
+
+    coerce (graf : $) : E ==
+      hconcat( ["Graph with " :: E,(p := # pointLists graf) :: E, 
+         (p=1 => " point list"; " point lists") :: E])
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{GRIMAGE.dotabb}
+"GRIMAGE" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GRIMAGE"]
+"STRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=STRING"]
+"GRIMAGE" -> "STRING"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain GOPT GuessOption}
+
+\begin{chunk}{GuessOption.input}
+)set break resume
+)sys rm -f GuessOption.output
+)spool GuessOption.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show GuessOption
+--R 
+--R GuessOption  is a domain constructor
+--R Abbreviation for GuessOption is GOPT 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for GOPT 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?=? : (%,%) -> Boolean                allDegrees : Boolean -> %
+--R checkExtraValues : Boolean -> %       coerce : % -> OutputForm
+--R debug : Boolean -> %                  displayKind : Symbol -> %
+--R functionName : Symbol -> %            functionNames : List(Symbol) -> %
+--R hash : % -> SingleInteger             indexName : Symbol -> %
+--R latex : % -> String                   one : Boolean -> %
+--R safety : NonNegativeInteger -> %      variableName : Symbol -> %
+--R ?~=? : (%,%) -> Boolean              
+--R Somos : Union(PositiveInteger,Boolean) -> %
+--R check : Union(skip,MonteCarlo,deterministic) -> %
+--R homogeneous : Union(PositiveInteger,Boolean) -> %
+--R maxDegree : Union(NonNegativeInteger,arbitrary) -> %
+--R maxDerivative : Union(NonNegativeInteger,arbitrary) -> %
+--R maxLevel : Union(NonNegativeInteger,arbitrary) -> %
+--R maxMixedDegree : NonNegativeInteger -> %
+--R maxPower : Union(PositiveInteger,arbitrary) -> %
+--R maxShift : Union(NonNegativeInteger,arbitrary) -> %
+--R maxSubst : Union(PositiveInteger,arbitrary) -> %
+--R option : (List(%),Symbol) -> Union(Any,"failed")
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{GuessOption.help}
+====================================================================
+GuessOption examples
+====================================================================
+
+GuessOption is a domain whose elements are various options used by Guess.
+
+See Also:
+o )show GuessOption
+
+\end{chunk}
+
+\pagehead{GuessOption}{GOPT}
+\pagepic{ps/v103guessoption.ps}{GOPT}{1.00}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{GOPT}{?=?} &
+\cross{GOPT}{?\~{}=?} &
+\cross{GOPT}{Somos} &
+\cross{GOPT}{allDegrees} &
+\cross{GOPT}{check} \\
+\cross{GOPT}{checkExtraValues} &
+\cross{GOPT}{coerce} &
+\cross{GOPT}{debug} &
+\cross{GOPT}{displayKind} &
+\cross{GOPT}{functionName} \\
+\cross{GOPT}{functionNames} &
+\cross{GOPT}{hash} &
+\cross{GOPT}{homogeneous} &
+\cross{GOPT}{indexName} &
+\cross{GOPT}{latex} \\
+\cross{GOPT}{maxDegree} &
+\cross{GOPT}{maxDerivative} &
+\cross{GOPT}{maxLevel} &
+\cross{GOPT}{maxMixedDegree} &
+\cross{GOPT}{maxPower} \\
+\cross{GOPT}{maxShift} &
+\cross{GOPT}{maxSubst} &
+\cross{GOPT}{one} &
+\cross{GOPT}{option} &
+\cross{GOPT}{safety} 
+\cross{GOPT}{variableName} 
+\end{tabular}
+
+\begin{chunk}{domain GOPT GuessOption}
+)abbrev domain GOPT GuessOption
+++ Author: Martin Rubey
+++ Description:
+++ GuessOption is a domain whose elements are various options used
+++ by Guess.
+GuessOption(): Exports == Implementation where
+
+  Exports == SetCategory with
+
+    maxDerivative: Union(NonNegativeInteger, "arbitrary") -> %
+      ++ maxDerivative(d) specifies the maximum derivative in an algebraic
+      ++ differential equation.  This option is expressed in the form
+      ++ \spad{maxDerivative == d}.
+
+    maxShift: Union(NonNegativeInteger, "arbitrary") -> %
+      ++ maxShift(d) specifies the maximum shift in a recurrence
+      ++ equation.  This option is expressed in the form \spad{maxShift == d}.
+
+    maxSubst: Union(PositiveInteger, "arbitrary") -> %
+      ++ maxSubst(d) specifies the maximum degree of the monomial substituted
+      ++ into the function we are looking for.  That is, if \spad{maxSubst ==
+      ++ d}, we look for polynomials such that $p(f(x), f(x^2), ...,
+      ++ f(x^d))=0$.  equation.  This option is expressed in the form
+      ++ \spad{maxSubst == d}.
+
+    maxPower: Union(PositiveInteger, "arbitrary") -> %
+      ++ maxPower(d) specifies the maximum degree in an algebraic differential
+      ++ equation. For example, the degree of (f'')^3 f' is 4. maxPower(-1)
+      ++ specifies that the maximum exponent can be arbitrary. This option is
+      ++ expressed in the form \spad{maxPower == d}.
+
+    homogeneous: Union(PositiveInteger, Boolean) -> %
+      ++ homogeneous(d) specifies whether we allow only homogeneous algebraic
+      ++ differential equations.  This option is expressed in the form
+      ++ \spad{homogeneous == d}.  If true, then maxPower must be
+      ++ set, too, and ADEs with constant total degree are allowed.
+      ++ If a PositiveInteger is given, only ADE's with this total degree are
+      ++ allowed.
+
+    Somos: Union(PositiveInteger, Boolean) -> %
+      ++ Somos(d) specifies whether we want that the total degree of the
+      ++ differential operators is constant, and equal to d, or maxDerivative
+      ++ if true. If true, maxDerivative must be set, too.
+
+    maxLevel: Union(NonNegativeInteger, "arbitrary") -> %
+      ++ maxLevel(d) specifies the maximum number of recursion levels operators
+      ++ guessProduct and guessSum will be applied. This option is expressed in
+      ++ the form spad{maxLevel == d}.
+
+    maxDegree: Union(NonNegativeInteger, "arbitrary") -> %
+      ++ maxDegree(d) specifies the maximum degree of the coefficient
+      ++ polynomials in an algebraic differential equation or a recursion with
+      ++ polynomial coefficients. For rational functions with an exponential
+      ++ term, \spad{maxDegree} bounds the degree of the denominator
+      ++ polynomial.
+      ++ This option is expressed in the form \spad{maxDegree == d}.
+
+    maxMixedDegree: NonNegativeInteger -> %
+      ++ maxMixedDegree(d) specifies the maximum q-degree of the coefficient
+      ++ polynomials in a recurrence with polynomial coefficients, in the case
+      ++ of mixed shifts.  Although slightly inconsistent, maxMixedDegree(0)
+      ++ specifies that no mixed shifts are allowed. This option is expressed
+      ++ in the form \spad{maxMixedDegree == d}.
+
+    allDegrees: Boolean -> %
+      ++ allDegrees(d) specifies whether all possibilities of the degree vector
+      ++ - taking into account maxDegree - should be tried. This is mainly
+      ++ interesting for rational interpolation. This option is expressed in
+      ++ the form \spad{allDegrees == d}.
+
+    safety: NonNegativeInteger -> %
+      ++ safety(d) specifies the number of values reserved for testing any
+      ++ solutions found. This option is expressed in the form \spad{safety ==
+      ++ d}.
+
+    check: Union("skip", "MonteCarlo", "deterministic") -> %
+      ++ check(d) specifies how we want to check the solution.  If
+      ++ the value is "skip", we return the solutions found by the
+      ++ interpolation routine without checking.  If the value is
+      ++ "MonteCarlo", we use a probabilistic check.  This option is
+      ++ expressed in the form \spad{check == d}
+
+    checkExtraValues: Boolean -> %
+      ++ checkExtraValues(d) specifies whether we want to check the
+      ++ solution beyond the order given by the degree bounds. This
+      ++ option is expressed in the form \spad{checkExtraValues == d}
+
+    one: Boolean -> %
+      ++ one(d) specifies whether we are happy with one solution. This option
+      ++ is expressed in the form \spad{one == d}.
+
+    debug: Boolean -> %
+      ++ debug(d) specifies whether we want additional output on the
+      ++ progress. This option is expressed in the form \spad{debug == d}.
+
+    functionName: Symbol -> %
+      ++ functionName(d) specifies the name of the function given by the
+      ++ algebraic differential equation or recurrence. This option is
+      ++ expressed in the form \spad{functionName == d}.
+
+    functionNames: List(Symbol) -> %
+      ++ functionNames(d) specifies the names for the function in
+      ++ algebraic dependence. This option is
+      ++ expressed in the form \spad{functionNames == d}.
+
+    variableName: Symbol -> %
+      ++ variableName(d) specifies the variable used in by the algebraic
+      ++ differential equation. This option is expressed in the form
+      ++ \spad{variableName == d}.
+
+    indexName: Symbol -> %
+      ++ indexName(d) specifies the index variable used for the formulas. This
+      ++ option is expressed in the form \spad{indexName == d}.
+
+    displayKind: Symbol -> %
+      ++ displayKind(d) specifies kind of the result: generating function,
+      ++ recurrence or equation. This option should not be set by the
+      ++ user, but rather by the HP-specification.
+
+    option : (List %, Symbol) -> Union(Any, "failed")
+      ++ option(l, option) returns which options are given.
+
+  Implementation ==> add
+    import AnyFunctions1(Boolean)
+    import AnyFunctions1(Symbol)
+    import AnyFunctions1(NonNegativeInteger)
+    import AnyFunctions1(Union(NonNegativeInteger, "arbitrary"))
+    import AnyFunctions1(Union(PositiveInteger, "arbitrary"))
+    import AnyFunctions1(Union(PositiveInteger, Boolean))
+    import AnyFunctions1(Union("skip", "MonteCarlo", "deterministic"))
+
+    Rep := Record(keyword: Symbol, value: Any)
+
+    maxLevel d       == ['maxLevel,       d::Any]
+
+    maxDerivative d  == ['maxDerivative,  d::Any]
+
+    maxShift d       == maxDerivative d
+
+    maxSubst d       ==
+        if d case PositiveInteger
+        then maxDerivative((d::Integer-1)::NonNegativeInteger)
+        else maxDerivative d
+
+    maxDegree d        == ['maxDegree,        d::Any]
+
+    maxMixedDegree d   == ['maxMixedDegree,   d::Any]
+
+    allDegrees d       == ['allDegrees,       d::Any]
+
+    maxPower d         == ['maxPower,         d::Any]
+
+    safety d           == ['safety,           d::Any]
+
+    homogeneous d      == ['homogeneous,      d::Any]
+
+    Somos d            == ['Somos,            d::Any]
+
+    debug d            == ['debug,            d::Any]
+
+    check d            == ['check,            d::Any]
+
+    checkExtraValues d == ['checkExtraValues, d::Any]
+
+    one d              == ['one,              d::Any]
+
+    functionName d     == ['functionName,     d::Any]
+
+    functionNames d ==
+        ['functionNames, coerce(d)$AnyFunctions1(List(Symbol))]
+
+    variableName d     == ['variableName,     d::Any]
+
+    indexName d        == ['indexName,        d::Any]
+
+    displayKind d      == ['displayKind,      d::Any]
+
+    coerce(x:%):OutputForm == x.keyword::OutputForm = x.value::OutputForm
+
+    x:% = y:%              == x.keyword = y.keyword and x.value = y.value
+
+    option(l, s) ==
+      for x in l repeat
+        x.keyword = s => return(x.value)
+      "failed"
+
+\end{chunk}
+
+\begin{chunk}{COQ GOPT}
+(* domain GOPT *)
+(*
+    import AnyFunctions1(Boolean)
+    import AnyFunctions1(Symbol)
+    import AnyFunctions1(NonNegativeInteger)
+    import AnyFunctions1(Union(NonNegativeInteger, "arbitrary"))
+    import AnyFunctions1(Union(PositiveInteger, "arbitrary"))
+    import AnyFunctions1(Union(PositiveInteger, Boolean))
+    import AnyFunctions1(Union("skip", "MonteCarlo", "deterministic"))
+
+    Rep := Record(keyword: Symbol, value: Any)
+
+    maxLevel d       == ['maxLevel,       d::Any]
+
+    maxDerivative d  == ['maxDerivative,  d::Any]
+
+    maxShift d       == maxDerivative d
+
+    maxSubst d       ==
+        if d case PositiveInteger
+        then maxDerivative((d::Integer-1)::NonNegativeInteger)
+        else maxDerivative d
+
+    maxDegree d        == ['maxDegree,        d::Any]
+
+    maxMixedDegree d   == ['maxMixedDegree,   d::Any]
+
+    allDegrees d       == ['allDegrees,       d::Any]
+
+    maxPower d         == ['maxPower,         d::Any]
+
+    safety d           == ['safety,           d::Any]
+
+    homogeneous d      == ['homogeneous,      d::Any]
+
+    Somos d            == ['Somos,            d::Any]
+
+    debug d            == ['debug,            d::Any]
+
+    check d            == ['check,            d::Any]
+
+    checkExtraValues d == ['checkExtraValues, d::Any]
+
+    one d              == ['one,              d::Any]
+
+    functionName d     == ['functionName,     d::Any]
+
+    functionNames d ==
+        ['functionNames, coerce(d)$AnyFunctions1(List(Symbol))]
+
+    variableName d     == ['variableName,     d::Any]
+
+    indexName d        == ['indexName,        d::Any]
+
+    displayKind d      == ['displayKind,      d::Any]
+
+    coerce(x:%):OutputForm == x.keyword::OutputForm = x.value::OutputForm
+
+    x:% = y:%              == x.keyword = y.keyword and x.value = y.value
+
+    option(l, s) ==
+      for x in l repeat
+        x.keyword = s => return(x.value)
+      "failed"
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{GOPT.dotabb}
+"GOPT" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GOPT"]
+"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
+"GOPT" -> "ALIST"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain GOPT0 GuessOptionFunctions0}
+
+\begin{chunk}{GuessOptionFunctions0.input}
+)set break resume
+)sys rm -f GuessOptionFunctions0.output
+)spool GuessOptionFunctions0.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show GuessOptionFunctions0
+--R 
+--R GuessOptionFunctions0  is a domain constructor
+--R Abbreviation for GuessOptionFunctions0 is GOPT0 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for GOPT0 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?=? : (%,%) -> Boolean                coerce : % -> OutputForm
+--R debug : List(GuessOption) -> Boolean  hash : % -> SingleInteger
+--R latex : % -> String                   one : List(GuessOption) -> Boolean
+--R ?~=? : (%,%) -> Boolean              
+--R Somos : List(GuessOption) -> Union(PositiveInteger,Boolean)
+--R allDegrees : List(GuessOption) -> Boolean
+--R check : List(GuessOption) -> Union(skip,MonteCarlo,deterministic)
+--R checkExtraValues : List(GuessOption) -> Boolean
+--R checkOptions : List(GuessOption) -> Void
+--R displayAsGF : List(GuessOption) -> Boolean
+--R functionName : List(GuessOption) -> Symbol
+--R homogeneous : List(GuessOption) -> Union(PositiveInteger,Boolean)
+--R indexName : List(GuessOption) -> Symbol
+--R maxDegree : List(GuessOption) -> Union(NonNegativeInteger,arbitrary)
+--R maxDerivative : List(GuessOption) -> Union(NonNegativeInteger,arbitrary)
+--R maxLevel : List(GuessOption) -> Union(NonNegativeInteger,arbitrary)
+--R maxMixedDegree : List(GuessOption) -> NonNegativeInteger
+--R maxPower : List(GuessOption) -> Union(PositiveInteger,arbitrary)
+--R maxShift : List(GuessOption) -> Union(NonNegativeInteger,arbitrary)
+--R maxSubst : List(GuessOption) -> Union(PositiveInteger,arbitrary)
+--R safety : List(GuessOption) -> NonNegativeInteger
+--R variableName : List(GuessOption) -> Symbol
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{GuessOptionFunctions0.help}
+====================================================================
+GuessOptionFunctions0 examples
+====================================================================
+
+GuessOptionFunctions0 provides operations that extract the
+values of options for Guess.
+
+See Also:
+o )show GuessOptionFunctions0
+
+\end{chunk}
+\pagehead{GuessOptionFunctions0}{GOPT0}
+\pagepic{ps/v103guessoptionfunctions0.eps}{GOPT0}{1.00}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{GOPT0}{?=?} &
+\cross{GOPT0}{?\~{}=?} &
+\cross{GOPT0}{MonteCarlo} &
+\cross{GOPT0}{Somos} &
+\cross{GOPT0}{allDegrees} \\
+\cross{GOPT0}{check} &
+\cross{GOPT0}{checkOptions} &
+\cross{GOPT0}{coerce} &
+\cross{GOPT0}{debug} &
+\cross{GOPT0}{displayAsGF} \\
+\cross{GOPT0}{functionName} &
+\cross{GOPT0}{hash} &
+\cross{GOPT0}{homogeneous} &
+\cross{GOPT0}{indexName} &
+\cross{GOPT0}{latex} \\
+\cross{GOPT0}{maxDegree} &
+\cross{GOPT0}{maxDerivative} &
+\cross{GOPT0}{maxLevel} &
+\cross{GOPT0}{maxMixedDegree} &
+\cross{GOPT0}{maxPower} \\
+\cross{GOPT0}{maxShift} &
+\cross{GOPT0}{maxSubst} &
+\cross{GOPT0}{one} &
+\cross{GOPT0}{safety} &
+\cross{GOPT0}{variableName} 
+\end{tabular}
+
+\begin{chunk}{domain GOPT0 GuessOptionFunctions0}
+)abbrev domain GOPT0 GuessOptionFunctions0
+++ Author: Martin Rubey
+++ Description: 
+++ GuessOptionFunctions0 provides operations that extract the
+++ values of options for Guess.
+GuessOptionFunctions0(): Exports == Implementation where
+
+  LGOPT ==> List GuessOption
+
+  Exports == SetCategory with
+
+    maxDerivative: LGOPT -> Union(NonNegativeInteger, "arbitrary")
+      ++ maxDerivative returns the specified maxDerivative.
+
+    maxShift: LGOPT -> Union(NonNegativeInteger, "arbitrary")
+      ++ maxShift returns the specified maxShift.
+
+    maxSubst: LGOPT -> Union(PositiveInteger, "arbitrary")
+      ++ maxSubst returns the specified maxSubst.
+
+    maxPower: LGOPT -> Union(PositiveInteger, "arbitrary")
+      ++ maxPower returns the specified maxPower.
+
+    homogeneous: LGOPT -> Union(PositiveInteger, Boolean)
+      ++ homogeneous returns whether we allow only homogeneous algebraic
+      ++ differential equations, default being false
+
+    Somos: LGOPT -> Union(PositiveInteger, Boolean)
+      ++ Somos returns whether we allow only Somos-like operators, default
+      ++ being false
+
+    maxLevel: LGOPT -> Union(NonNegativeInteger, "arbitrary")
+      ++ maxLevel returns the specified maxLevel.
+
+    maxDegree: LGOPT -> Union(NonNegativeInteger, "arbitrary")
+      ++ maxDegree returns the specified maxDegree.
+
+    maxMixedDegree: LGOPT -> NonNegativeInteger
+      ++ maxMixedDegree returns the specified maxMixedDegree.
+
+    allDegrees: LGOPT -> Boolean
+      ++ allDegrees returns whether all possibilities of the degree vector
+      ++ should be tried, the default being false.
+
+    safety: LGOPT -> NonNegativeInteger
+      ++ safety returns the specified safety or 1 as default.
+
+    check: LGOPT -> Union("skip", "MonteCarlo", "deterministic")
+      ++ check(d) specifies how we want to check the solution.  If
+      ++ the value is "skip", we return the solutions found by the
+      ++ interpolation routine without checking.  If the value is
+      ++ "MonteCarlo", we use a probabilistic check.  The default is
+      ++ "deterministic".
+
+    checkExtraValues: LGOPT -> Boolean
+      ++ checkExtraValues(d) specifies whether we want to check the
+      ++ solution beyond the order given by the degree bounds.  The
+      ++ default is true.
+
+    one: LGOPT -> Boolean
+      ++ one returns whether we need only one solution, default being true.
+
+    functionName: LGOPT -> Symbol
+      ++ functionName returns the name of the function given by the algebraic
+      ++ differential equation, default being f
+
+    variableName: LGOPT -> Symbol
+      ++ variableName returns the name of the variable used in by the
+      ++ algebraic differential equation, default being x
+
+    indexName: LGOPT -> Symbol
+      ++ indexName returns the name of the index variable used for the
+      ++ formulas, default being n
+
+    displayAsGF: LGOPT -> Boolean
+      ++ displayAsGF specifies whether the result is a generating function
+      ++ or a recurrence. This option should not be set by the user, but rather
+      ++ by the HP-specification, therefore, there is no default.
+
+    debug: LGOPT -> Boolean
+      ++ debug returns whether we want additional output on the progress,
+      ++ default being false
+
+    checkOptions: LGOPT -> Void
+      ++ checkOptions checks whether the given options are consistent, and
+      ++ yields an error otherwise
+
+  Implementation == add
+
+    maxLevel l ==
+      if (opt := option(l, 'maxLevel)) case "failed" then
+        "arbitrary"
+      else
+        retract(opt::Any)$AnyFunctions1(Union(NonNegativeInteger, "arbitrary"))
+
+    maxDerivative l ==
+      if (opt := option(l, 'maxDerivative)) case "failed" then
+        "arbitrary"
+      else
+        retract(opt::Any)$AnyFunctions1(Union(NonNegativeInteger, "arbitrary"))
+
+    maxShift l == maxDerivative l
+
+    maxSubst l ==
+        d := maxDerivative l
+        if d case NonNegativeInteger
+        then (d+1)::PositiveInteger
+        else d
+
+    maxDegree l ==
+      if (opt := option(l, 'maxDegree)) case "failed" then
+        "arbitrary"
+      else
+        retract(opt::Any)$AnyFunctions1(Union(NonNegativeInteger, "arbitrary"))
+
+    maxMixedDegree l ==
+      if (opt := option(l, 'maxMixedDegree)) case "failed" then
+        0
+      else
+        retract(opt :: Any)$AnyFunctions1(NonNegativeInteger)
+
+    allDegrees l ==
+      if (opt := option(l, 'allDegrees)) case "failed" then
+        false
+      else
+        retract(opt :: Any)$AnyFunctions1(Boolean)
+
+    maxPower l ==
+      if (opt := option(l, 'maxPower)) case "failed" then
+        "arbitrary"
+      else
+        retract(opt :: Any)$AnyFunctions1(Union(PositiveInteger, "arbitrary"))
+
+    safety l ==
+      if (opt := option(l, 'safety)) case "failed" then
+        1$NonNegativeInteger
+      else
+        retract(opt :: Any)$AnyFunctions1(NonNegativeInteger)
+
+    check l ==
+       if (opt := option(l, 'check)) case "failed" then
+           "deterministic"
+       else
+           retract(opt::Any)$AnyFunctions1(_
+                                 Union("skip", "MonteCarlo", "deterministic"))
+
+    checkExtraValues l ==
+       if (opt := option(l, 'checkExtraValues)) case "failed" then
+           true
+       else
+           retract(opt :: Any)$AnyFunctions1(Boolean)
+
+    one l ==
+      if (opt := option(l, 'one)) case "failed" then
+        true
+      else
+        retract(opt :: Any)$AnyFunctions1(Boolean)
+
+    debug l ==
+      if (opt := option(l, 'debug)) case "failed" then
+        false
+      else
+        retract(opt :: Any)$AnyFunctions1(Boolean)
+
+    homogeneous l ==
+      if (opt := option(l, 'homogeneous)) case "failed" then
+        false
+      else
+        retract(opt :: Any)$AnyFunctions1(Union(PositiveInteger, Boolean))
+
+    Somos l ==
+      if (opt := option(l, 'Somos)) case "failed" then
+        false
+      else
+        retract(opt :: Any)$AnyFunctions1(Union(PositiveInteger, Boolean))
+
+    variableName l ==
+      if (opt := option(l, 'variableName)) case "failed" then
+        'x
+      else
+        retract(opt :: Any)$AnyFunctions1(Symbol)
+
+    functionName l ==
+      if (opt := option(l, 'functionName)) case "failed" then
+        'f
+      else
+        retract(opt :: Any)$AnyFunctions1(Symbol)
+
+    indexName l ==
+      if (opt := option(l, 'indexName)) case "failed" then
+        'n
+      else
+        retract(opt :: Any)$AnyFunctions1(Symbol)
+
+    displayAsGF l ==
+      if (opt := option(l, 'displayAsGF)) case "failed" then
+        error "GuessOption: displayAsGF not set"
+      else
+        retract(opt :: Any)$AnyFunctions1(Boolean)
+
+    NNI ==> NonNegativeInteger
+
+    PI  ==> PositiveInteger
+
+    checkOptions l ==
+      maxD := maxDerivative l
+      maxP := maxPower l
+      homo := homogeneous l
+      Somo := Somos l
+
+      if Somo case PI then
+          if one? Somo then
+              error "Guess: Somos must be Boolean or at least two"
+
+          if maxP case PI and one? maxP then
+              error "Guess: Somos requires that maxPower is at least two"
+
+          if maxD case NNI and maxD > Somo then
+              err:String:=concat [_
+                "Guess: if Somos is an integer, it should be larger than ",_
+                "maxDerivative/maxShift or at least as big as maxSubst" ]
+              error err
+      else
+          if Somo then
+              if maxP case PI and one? maxP then
+                  error "Guess: Somos requires that maxPower is at least two"
+
+              if not (maxD case NNI) or zero? maxD or one? maxD then
+                  err:String:= concat [_
+                    "Guess: Somos==true requires that maxDerivative/maxShift",_
+                    " is an integer, at least two, or maxSubst is an ",_
+                    "integer, at least three" ]
+                  error err
+
+              if not (maxP case PI) and homo case Boolean and not homo then
+                  err:String:= concat [_
+                    "Guess: Somos requires that maxPower is set or ", _
+                    "homogeneous is not false" ]
+                  error err
+
+      if homo case PI then
+          if maxP case PI and maxP ~= homo then
+              err:String:= _
+                "Guess: only one of homogeneous and maxPower may be an integer"
+              error err
+
+          if maxD case NNI and zero? maxD then
+              err:String:= concat [_
+                "Guess: homogeneous requires that maxShift/maxDerivative ",_
+                "is at least one or maxSubst is at least two" ]
+              error err
+      else
+          if homo then
+              if not maxP case PI then
+                  err:String:= concat [_
+                    "Guess: homogeneous==true requires that maxPower is ", _
+                    "an integer" ]
+                  error err
+
+              if maxD case NNI and zero? maxD then
+                  err:String:= concat [_
+                    "Guess: homogeneous requires that maxShift/maxDerivative",_
+                    " is at least one or maxSubst is at least two" ]
+                  error err
+\end{chunk}
+
+\begin{chunk}{COQ GOPT0}
+(* domain GOPT0 *)
+(*
+
+    maxLevel l ==
+      if (opt := option(l, 'maxLevel)) case "failed" then
+        "arbitrary"
+      else
+        retract(opt::Any)$AnyFunctions1(Union(NonNegativeInteger, "arbitrary"))
+
+    maxDerivative l ==
+      if (opt := option(l, 'maxDerivative)) case "failed" then
+        "arbitrary"
+      else
+        retract(opt::Any)$AnyFunctions1(Union(NonNegativeInteger, "arbitrary"))
+
+    maxShift l == maxDerivative l
+
+    maxSubst l ==
+        d := maxDerivative l
+        if d case NonNegativeInteger
+        then (d+1)::PositiveInteger
+        else d
+
+    maxDegree l ==
+      if (opt := option(l, 'maxDegree)) case "failed" then
+        "arbitrary"
+      else
+        retract(opt::Any)$AnyFunctions1(Union(NonNegativeInteger, "arbitrary"))
+
+    maxMixedDegree l ==
+      if (opt := option(l, 'maxMixedDegree)) case "failed" then
+        0
+      else
+        retract(opt :: Any)$AnyFunctions1(NonNegativeInteger)
+
+    allDegrees l ==
+      if (opt := option(l, 'allDegrees)) case "failed" then
+        false
+      else
+        retract(opt :: Any)$AnyFunctions1(Boolean)
+
+    maxPower l ==
+      if (opt := option(l, 'maxPower)) case "failed" then
+        "arbitrary"
+      else
+        retract(opt :: Any)$AnyFunctions1(Union(PositiveInteger, "arbitrary"))
+
+    safety l ==
+      if (opt := option(l, 'safety)) case "failed" then
+        1$NonNegativeInteger
+      else
+        retract(opt :: Any)$AnyFunctions1(NonNegativeInteger)
+
+    check l ==
+       if (opt := option(l, 'check)) case "failed" then
+           "deterministic"
+       else
+           retract(opt::Any)$AnyFunctions1(_
+                                 Union("skip", "MonteCarlo", "deterministic"))
+
+    checkExtraValues l ==
+       if (opt := option(l, 'checkExtraValues)) case "failed" then
+           true
+       else
+           retract(opt :: Any)$AnyFunctions1(Boolean)
+
+    one l ==
+      if (opt := option(l, 'one)) case "failed" then
+        true
+      else
+        retract(opt :: Any)$AnyFunctions1(Boolean)
+
+    debug l ==
+      if (opt := option(l, 'debug)) case "failed" then
+        false
+      else
+        retract(opt :: Any)$AnyFunctions1(Boolean)
+
+    homogeneous l ==
+      if (opt := option(l, 'homogeneous)) case "failed" then
+        false
+      else
+        retract(opt :: Any)$AnyFunctions1(Union(PositiveInteger, Boolean))
+
+    Somos l ==
+      if (opt := option(l, 'Somos)) case "failed" then
+        false
+      else
+        retract(opt :: Any)$AnyFunctions1(Union(PositiveInteger, Boolean))
+
+    variableName l ==
+      if (opt := option(l, 'variableName)) case "failed" then
+        'x
+      else
+        retract(opt :: Any)$AnyFunctions1(Symbol)
+
+    functionName l ==
+      if (opt := option(l, 'functionName)) case "failed" then
+        'f
+      else
+        retract(opt :: Any)$AnyFunctions1(Symbol)
+
+    indexName l ==
+      if (opt := option(l, 'indexName)) case "failed" then
+        'n
+      else
+        retract(opt :: Any)$AnyFunctions1(Symbol)
+
+    displayAsGF l ==
+      if (opt := option(l, 'displayAsGF)) case "failed" then
+        error "GuessOption: displayAsGF not set"
+      else
+        retract(opt :: Any)$AnyFunctions1(Boolean)
+
+    NNI ==> NonNegativeInteger
+
+    PI  ==> PositiveInteger
+
+    checkOptions l ==
+      maxD := maxDerivative l
+      maxP := maxPower l
+      homo := homogeneous l
+      Somo := Somos l
+
+      if Somo case PI then
+          if one? Somo then
+              error "Guess: Somos must be Boolean or at least two"
+
+          if maxP case PI and one? maxP then
+              error "Guess: Somos requires that maxPower is at least two"
+
+          if maxD case NNI and maxD > Somo then
+              err:String:=concat [_
+                "Guess: if Somos is an integer, it should be larger than ",_
+                "maxDerivative/maxShift or at least as big as maxSubst" ]
+              error err
+      else
+          if Somo then
+              if maxP case PI and one? maxP then
+                  error "Guess: Somos requires that maxPower is at least two"
+
+              if not (maxD case NNI) or zero? maxD or one? maxD then
+                  err:String:= concat [_
+                    "Guess: Somos==true requires that maxDerivative/maxShift",_
+                    " is an integer, at least two, or maxSubst is an ",_
+                    "integer, at least three" ]
+                  error err
+
+              if not (maxP case PI) and homo case Boolean and not homo then
+                  err:String:= concat [_
+                    "Guess: Somos requires that maxPower is set or ", _
+                    "homogeneous is not false" ]
+                  error err
+
+      if homo case PI then
+          if maxP case PI and maxP ~= homo then
+              err:String:= _
+                "Guess: only one of homogeneous and maxPower may be an integer"
+              error err
+
+          if maxD case NNI and zero? maxD then
+              err:String:= concat [_
+                "Guess: homogeneous requires that maxShift/maxDerivative ",_
+                "is at least one or maxSubst is at least two" ]
+              error err
+      else
+          if homo then
+              if not maxP case PI then
+                  err:String:= concat [_
+                    "Guess: homogeneous==true requires that maxPower is ", _
+                    "an integer" ]
+                  error err
+
+              if maxD case NNI and zero? maxD then
+                  err:String:= concat [_
+                    "Guess: homogeneous requires that maxShift/maxDerivative",_
+                    " is at least one or maxSubst is at least two" ]
+                  error err
+*)
+
+\end{chunk}
+
+\begin{chunk}{GOPT0.dotabb}
+"GOPT0" [color="#88FF44",href="bookvol10.3.pdf#nameddest=GOPT0"]
+"STRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=STRING"]
+"GOPT0" -> "STRING"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\chapter{Chapter H}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain HASHTBL HashTable}
+
+\begin{chunk}{HashTable.input}
+)set break resume
+)sys rm -f HashTable.output
+)spool HashTable.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show HashTable
+--R 
+--R HashTable(Key: SetCategory,Entry: SetCategory,hashfn: String)  is a domain constructor
+--R Abbreviation for HashTable is HASHTBL 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for HASHTBL 
+--R
+--R------------------------------- Operations --------------------------------
+--R copy : % -> %                         dictionary : () -> %
+--R elt : (%,Key,Entry) -> Entry          ?.? : (%,Key) -> Entry
+--R empty : () -> %                       empty? : % -> Boolean
+--R entries : % -> List(Entry)            eq? : (%,%) -> Boolean
+--R index? : (Key,%) -> Boolean           indices : % -> List(Key)
+--R key? : (Key,%) -> Boolean             keys : % -> List(Key)
+--R map : ((Entry -> Entry),%) -> %       qelt : (%,Key) -> Entry
+--R sample : () -> %                      setelt : (%,Key,Entry) -> Entry
+--R table : () -> %                      
+--R #? : % -> NonNegativeInteger if $ has finiteAggregate
+--R ?=? : (%,%) -> Boolean if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
+--R any? : ((Entry -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R any? : ((Record(key: Key,entry: Entry) -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R bag : List(Record(key: Key,entry: Entry)) -> %
+--R coerce : % -> OutputForm if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
+--R construct : List(Record(key: Key,entry: Entry)) -> %
+--R convert : % -> InputForm if Record(key: Key,entry: Entry) has KONVERT(INFORM)
+--R count : ((Entry -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
+--R count : (Entry,%) -> NonNegativeInteger if $ has finiteAggregate and Entry has SETCAT
+--R count : (Record(key: Key,entry: Entry),%) -> NonNegativeInteger if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
+--R count : ((Record(key: Key,entry: Entry) -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
+--R dictionary : List(Record(key: Key,entry: Entry)) -> %
+--R entry? : (Entry,%) -> Boolean if $ has finiteAggregate and Entry has SETCAT
+--R eval : (%,List(Equation(Entry))) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
+--R eval : (%,Equation(Entry)) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
+--R eval : (%,Entry,Entry) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
+--R eval : (%,List(Entry),List(Entry)) -> % if Entry has EVALAB(Entry) and Entry has SETCAT
+--R eval : (%,List(Record(key: Key,entry: Entry)),List(Record(key: Key,entry: Entry))) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
+--R eval : (%,Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
+--R eval : (%,Equation(Record(key: Key,entry: Entry))) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
+--R eval : (%,List(Equation(Record(key: Key,entry: Entry)))) -> % if Record(key: Key,entry: Entry) has EVALAB(Record(key: Key,entry: Entry)) and Record(key: Key,entry: Entry) has SETCAT
+--R every? : ((Entry -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R every? : ((Record(key: Key,entry: Entry) -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R extract! : % -> Record(key: Key,entry: Entry)
+--R fill! : (%,Entry) -> % if $ has shallowlyMutable
+--R find : ((Record(key: Key,entry: Entry) -> Boolean),%) -> Union(Record(key: Key,entry: Entry),"failed")
+--R first : % -> Entry if Key has ORDSET
+--R hash : % -> SingleInteger if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
+--R insert! : (Record(key: Key,entry: Entry),%) -> %
+--R inspect : % -> Record(key: Key,entry: Entry)
+--R latex : % -> String if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
+--R less? : (%,NonNegativeInteger) -> Boolean
+--R map : (((Entry,Entry) -> Entry),%,%) -> %
+--R map : ((Record(key: Key,entry: Entry) -> Record(key: Key,entry: Entry)),%) -> %
+--R map! : ((Entry -> Entry),%) -> % if $ has shallowlyMutable
+--R map! : ((Record(key: Key,entry: Entry) -> Record(key: Key,entry: Entry)),%) -> % if $ has shallowlyMutable
+--R maxIndex : % -> Key if Key has ORDSET
+--R member? : (Entry,%) -> Boolean if $ has finiteAggregate and Entry has SETCAT
+--R member? : (Record(key: Key,entry: Entry),%) -> Boolean if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
+--R members : % -> List(Entry) if $ has finiteAggregate
+--R members : % -> List(Record(key: Key,entry: Entry)) if $ has finiteAggregate
+--R minIndex : % -> Key if Key has ORDSET
+--R more? : (%,NonNegativeInteger) -> Boolean
+--R parts : % -> List(Entry) if $ has finiteAggregate
+--R parts : % -> List(Record(key: Key,entry: Entry)) if $ has finiteAggregate
+--R qsetelt! : (%,Key,Entry) -> Entry if $ has shallowlyMutable
+--R reduce : (((Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry)),%) -> Record(key: Key,entry: Entry) if $ has finiteAggregate
+--R reduce : (((Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry)),%,Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry) if $ has finiteAggregate
+--R reduce : (((Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry)),%,Record(key: Key,entry: Entry),Record(key: Key,entry: Entry)) -> Record(key: Key,entry: Entry) if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
+--R remove : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
+--R remove : (Record(key: Key,entry: Entry),%) -> % if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
+--R remove! : (Key,%) -> Union(Entry,"failed")
+--R remove! : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
+--R remove! : (Record(key: Key,entry: Entry),%) -> % if $ has finiteAggregate
+--R removeDuplicates : % -> % if $ has finiteAggregate and Record(key: Key,entry: Entry) has SETCAT
+--R search : (Key,%) -> Union(Entry,"failed")
+--R select : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
+--R select! : ((Record(key: Key,entry: Entry) -> Boolean),%) -> % if $ has finiteAggregate
+--R size? : (%,NonNegativeInteger) -> Boolean
+--R swap! : (%,Key,Key) -> Void if $ has shallowlyMutable
+--R table : List(Record(key: Key,entry: Entry)) -> %
+--R ?~=? : (%,%) -> Boolean if Record(key: Key,entry: Entry) has SETCAT or Entry has SETCAT
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{HashTable.help}
+====================================================================
+HashTable examples
+====================================================================
+
+This domain provides access to the underlying Lisp hash tables.
+By varying the hashfn parameter, tables suited for different 
+purposes can be obtained.
+
+See Also:
+o )show HashTable
+
+\end{chunk}
+
+\pagehead{HashTable}{HASHTBL}
+\pagepic{ps/v103hashtable.ps}{HASHTBL}{1.00}
+{\bf See}\\
+\pageto{InnerTable}{INTABL}
+\pageto{Table}{TABLE}
+\pageto{EqTable}{EQTBL}
+\pageto{StringTable}{STRTBL}
+\pageto{GeneralSparseTable}{GSTBL}
+\pageto{SparseTable}{STBL}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{HASHTBL}{any?} &
+\cross{HASHTBL}{bag} &
+\cross{HASHTBL}{coerce} &
+\cross{HASHTBL}{construct} &
+\cross{HASHTBL}{convert} \\
+\cross{HASHTBL}{copy} &
+\cross{HASHTBL}{count} &
+\cross{HASHTBL}{dictionary} &
+\cross{HASHTBL}{entry?} &
+\cross{HASHTBL}{elt} \\
+\cross{HASHTBL}{empty} &
+\cross{HASHTBL}{empty?} &
+\cross{HASHTBL}{entries} &
+\cross{HASHTBL}{eq?} &
+\cross{HASHTBL}{eval} \\
+\cross{HASHTBL}{every?} &
+\cross{HASHTBL}{extract!} &
+\cross{HASHTBL}{fill!} &
+\cross{HASHTBL}{find} &
+\cross{HASHTBL}{first} \\
+\cross{HASHTBL}{hash} &
+\cross{HASHTBL}{index?} &
+\cross{HASHTBL}{indices} &
+\cross{HASHTBL}{insert!} &
+\cross{HASHTBL}{inspect} \\
+\cross{HASHTBL}{key?} &
+\cross{HASHTBL}{keys} &
+\cross{HASHTBL}{latex} &
+\cross{HASHTBL}{less?} &
+\cross{HASHTBL}{map} \\
+\cross{HASHTBL}{map!} &
+\cross{HASHTBL}{maxIndex} &
+\cross{HASHTBL}{member?} &
+\cross{HASHTBL}{members} &
+\cross{HASHTBL}{minIndex} \\
+\cross{HASHTBL}{more?} &
+\cross{HASHTBL}{parts} &
+\cross{HASHTBL}{qelt} &
+\cross{HASHTBL}{qsetelt!} &
+\cross{HASHTBL}{reduce} \\
+\cross{HASHTBL}{remove} &
+\cross{HASHTBL}{remove!} &
+\cross{HASHTBL}{removeDuplicates} &
+\cross{HASHTBL}{sample} &
+\cross{HASHTBL}{search} \\
+\cross{HASHTBL}{select} &
+\cross{HASHTBL}{select!} &
+\cross{HASHTBL}{setelt} &
+\cross{HASHTBL}{size?} &
+\cross{HASHTBL}{swap!} \\
+\cross{HASHTBL}{table} &
+\cross{HASHTBL}{\#{}?} &
+\cross{HASHTBL}{?=?} &
+\cross{HASHTBL}{?\~{}=?} &
+\cross{HASHTBL}{?.?} 
+\end{tabular}
+
+\begin{chunk}{domain HASHTBL HashTable}
+)abbrev domain HASHTBL HashTable
+++ Author: Stephen M. Watt
+++ Date Created: 1985
+++ Date Last Updated: June 21, 1991
+++ Description:
+++ This domain provides access to the underlying Lisp hash tables.
+++ By varying the hashfn parameter, tables suited for different 
+++ purposes can be obtained.
+
+HashTable(Key, Entry, hashfn): Exports == Implementation where
+    Key, Entry: SetCategory
+    hashfn: String --  Union("EQ", "UEQUAL", "CVEC", "ID")
+
+    Exports ==> TableAggregate(Key, Entry) with
+                     finiteAggregate
+
+    Implementation ==> add
+
+        Pair ==> Record(key: Key, entry: Entry)
+
+        Ex   ==> OutputForm
+
+        failMsg := GENSYM()$Lisp
+
+        t1 = t2              == EQ(t1, t2)$Lisp
+
+        keys t               == HKEYS(t)$Lisp
+
+        # t                  == HASH_-TABLE_-COUNT(t)$Lisp
+
+        setelt(t, k, e)      == HPUT(t,k,e)$Lisp
+
+        remove_!(k:Key, t:%) ==
+          r := HGET(t,k,failMsg)$Lisp
+          not EQ(r,failMsg)$Lisp =>
+            HREM(t, k)$Lisp
+            r pretend Entry
+          "failed"
+
+        empty() ==
+            MAKE_-HASHTABLE(INTERN(hashfn)$Lisp,
+                            INTERN("STRONG")$Lisp)$Lisp
+
+        search(k:Key, t:%)  ==
+            r := HGET(t, k, failMsg)$Lisp
+            not EQ(r, failMsg)$Lisp => r pretend Entry
+            "failed"
+
+\end{chunk}
+
+\begin{chunk}{COQ HASHTBL}
+(* domain HASHTBL *)
+(*
+
+        Pair ==> Record(key: Key, entry: Entry)
+
+        Ex   ==> OutputForm
+
+        failMsg := GENSYM()$Lisp
+
+        t1 = t2              == EQ(t1, t2)$Lisp
+
+        keys t               == HKEYS(t)$Lisp
+
+        # t                  == HASH_-TABLE_-COUNT(t)$Lisp
+
+        setelt(t, k, e)      == HPUT(t,k,e)$Lisp
+
+        remove_!(k:Key, t:%) ==
+          r := HGET(t,k,failMsg)$Lisp
+          not EQ(r,failMsg)$Lisp =>
+            HREM(t, k)$Lisp
+            r pretend Entry
+          "failed"
+
+        empty() ==
+            MAKE_-HASHTABLE(INTERN(hashfn)$Lisp,
+                            INTERN("STRONG")$Lisp)$Lisp
+
+        search(k:Key, t:%)  ==
+            r := HGET(t, k, failMsg)$Lisp
+            not EQ(r, failMsg)$Lisp => r pretend Entry
+            "failed"
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{HASHTBL.dotabb}
+"HASHTBL" [color="#88FF44",href="bookvol10.3.pdf#nameddest=HASHTBL"]
+"TBAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=TBAGG"]
+"HASHTBL" -> "TBAGG"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain HEAP Heap}
+
+\begin{chunk}{Heap.input}
+)set break resume
+)sys rm -f Heap.output
+)spool Heap.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 42
+a:Heap INT:= heap [1,2,3,4,5]
+--R 
+--R
+--R   (1)  [5,4,2,1,3]
+--R                                                          Type: Heap(Integer)
+--E 1
+
+--S 2 of 42
+bag([1,2,3,4,5])$Heap(INT)
+--R 
+--R
+--R   (2)  [5,4,3,1,2]
+--R                                                          Type: Heap(Integer)
+--E 2
+
+--S 3 of 42
+c:=copy a
+--R 
+--R
+--R   (3)  [5,4,2,1,3]
+--R                                                          Type: Heap(Integer)
+--E 3
+
+--S 4 of 42
+empty? a
+--R 
+--R
+--R   (4)  false
+--R                                                                Type: Boolean
+--E 4
+
+--S 5 of 42
+b:=empty()$(Heap INT)
+--R 
+--R
+--R   (5)  []
+--R                                                          Type: Heap(Integer)
+--E 5
+
+--S 6 of 42
+empty? b
+--R 
+--R
+--R   (6)  true
+--R                                                                Type: Boolean
+--E 6
+
+--S 7 of 42
+eq?(a,c)
+--R 
+--R
+--R   (7)  false
+--R                                                                Type: Boolean
+--E 7
+
+--S 8 of 42
+extract! a
+--R 
+--R
+--R   (8)  5
+--R                                                        Type: PositiveInteger
+--E 8
+
+--S 8 of 42
+h:=heap [17,-4,9,-11,2,7,-7]
+--R 
+--R
+--R   (9)  [17,2,9,- 11,- 4,7,- 7]
+--R                                                          Type: Heap(Integer)
+--E 8
+
+--S 9 of 42
+[extract!(h) while not empty?(h)]
+--R 
+--R
+--R   (10)  [17,9,7,2,- 4,- 7,- 11]
+--R                                                          Type: List(Integer)
+--E 9
+
+--S 10 of 42
+heapsort(x) == (empty? x => []; cons(extract!(x),heapsort x))
+--R 
+--R                                                                   Type: Void
+--E 10
+
+--S 11 of 42
+h1 := heapsort heap [17,-4,9,-11,2,7,-7]
+--R 
+--R   Compiling function heapsort with type Heap(Integer) -> List(Integer)
+--R      
+--R
+--R   (12)  [17,9,7,2,- 4,- 7,- 11]
+--R                                                          Type: List(Integer)
+--E 11
+
+--S 12 of 42
+(a=c)@Boolean
+--R 
+--R
+--R   (13)  false
+--R                                                                Type: Boolean
+--E 12
+
+--S 13 of 42
+(a~=c)
+--R 
+--R
+--R   (14)  true
+--R                                                                Type: Boolean
+--E 13
+
+--S 14 of 42
+a
+--R 
+--R
+--R   (15)  [4,3,2,1]
+--R                                                          Type: Heap(Integer)
+--E 14
+
+--S 15 of 42
+inspect a
+--R 
+--R
+--R   (16)  4
+--R                                                        Type: PositiveInteger
+--E 15
+
+--S 16 of 42
+insert!(9,a)
+--R 
+--R
+--R   (17)  [9,4,2,1,3]
+--R                                                          Type: Heap(Integer)
+--E 16
+
+--S 17 of 42
+map(x+->x+10,a)
+--R 
+--R
+--R   (18)  [19,14,12,11,13]
+--R                                                          Type: Heap(Integer)
+--E 17
+
+--S 18 of 42
+a
+--R 
+--R
+--R   (19)  [9,4,2,1,3]
+--R                                                          Type: Heap(Integer)
+--E 18
+
+--S 19 of 42
+map!(x+->x+10,a)
+--R 
+--R
+--R   (20)  [19,14,12,11,13]
+--R                                                          Type: Heap(Integer)
+--E 19
+
+--S 20 of 42
+a
+--R 
+--R
+--R   (21)  [19,14,12,11,13]
+--R                                                          Type: Heap(Integer)
+--E 20
+
+--S 21 of 42
+max a
+--R 
+--R
+--R   (22)  19
+--R                                                        Type: PositiveInteger
+--E 21
+
+--S 22 of 42
+merge(a,c)
+--R 
+--R
+--R   (23)  [19,14,12,11,13,5,4,2,1,3]
+--R                                                          Type: Heap(Integer)
+--E 22
+
+--S 23 of 42
+a
+--R 
+--R
+--R   (24)  [19,14,12,11,13]
+--R                                                          Type: Heap(Integer)
+--E 23
+
+--S 24 of 42
+merge!(a,c)
+--R 
+--R
+--R   (25)  [19,14,12,11,13,5,4,2,1,3]
+--R                                                          Type: Heap(Integer)
+--E 24
+
+--S 25 of 42
+a
+--R 
+--R
+--R   (26)  [19,14,12,11,13,5,4,2,1,3]
+--R                                                          Type: Heap(Integer)
+--E 25
+
+--S 26 of 42
+c
+--R 
+--R
+--R   (27)  [5,4,2,1,3]
+--R                                                          Type: Heap(Integer)
+--E 26
+
+--S 27 of 42
+sample()$Heap(INT)
+--R 
+--R
+--R   (28)  []
+--R                                                          Type: Heap(Integer)
+--E 27
+
+--S 28 of 42
+#a
+--R 
+--R
+--R   (29)  10
+--R                                                        Type: PositiveInteger
+--E 28
+
+--S 29 of 42
+any?(x+->(x=14),a)
+--R 
+--R
+--R   (30)  true
+--R                                                                Type: Boolean
+--E 29
+
+--S 30 of 42
+every?(x+->(x=11),a)
+--R 
+--R
+--R   (31)  false
+--R                                                                Type: Boolean
+--E 30
+
+--S 31 of 42
+parts a
+--R 
+--R
+--R   (32)  [19,14,12,11,13,5,4,2,1,3]
+--R                                                          Type: List(Integer)
+--E 31
+
+--S 32 of 42
+size?(a,9)
+--R 
+--R
+--R   (33)  false
+--R                                                                Type: Boolean
+--E 32
+
+--S 33 of 42
+more?(a,9)
+--R 
+--R
+--R   (34)  true
+--R                                                                Type: Boolean
+--E 33
+
+--S 34 of 42
+less?(a,9)
+--R 
+--R
+--R   (35)  false
+--R                                                                Type: Boolean
+--E 34
+
+--S 35 of 42
+members a
+--R 
+--R
+--R   (36)  [19,14,12,11,13,5,4,2,1,3]
+--R                                                          Type: List(Integer)
+--E 35
+
+--S 36 of 42
+member?(14,a)
+--R 
+--R
+--R   (37)  true
+--R                                                                Type: Boolean
+--E 36
+
+--S 37 of 42
+latex a
+--R 
+--R
+--R   (38)  "\mbox{\bf Unimplemented}"
+--R                                                                 Type: String
+--E 37
+
+--S 38 of 42
+hash a
+--R 
+--R
+--I   (39)  36647017
+--R                                                          Type: SingleInteger
+--E 38
+
+--S 39 of 42
+count(14,a)
+--R 
+--R
+--R   (40)  1
+--R                                                        Type: PositiveInteger
+--E 39
+
+--S 40 of 42
+count(x+->(x>13),a)
+--R 
+--R
+--R   (41)  2
+--R                                                        Type: PositiveInteger
+--E 40
+
+--S 41 of 42
+coerce a
+--R 
+--R
+--R   (42)  [19,14,12,11,13,5,4,2,1,3]
+--R                                                             Type: OutputForm
+--E 41
+
+--S 42 of 42
+)show Heap
+--R 
+--R Heap(S: OrderedSet)  is a domain constructor
+--R Abbreviation for Heap is HEAP 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for HEAP 
+--R
+--R------------------------------- Operations --------------------------------
+--R bag : List(S) -> %                    copy : % -> %
+--R empty : () -> %                       empty? : % -> Boolean
+--R eq? : (%,%) -> Boolean                extract! : % -> S
+--R heap : List(S) -> %                   insert! : (S,%) -> %
+--R inspect : % -> S                      latex : % -> String if S has SETCAT
+--R map : ((S -> S),%) -> %               max : % -> S
+--R merge : (%,%) -> %                    merge! : (%,%) -> %
+--R sample : () -> %                     
+--R #? : % -> NonNegativeInteger if $ has finiteAggregate
+--R ?=? : (%,%) -> Boolean if S has SETCAT
+--R any? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R coerce : % -> OutputForm if S has SETCAT
+--R count : (S,%) -> NonNegativeInteger if $ has finiteAggregate and S has SETCAT
+--R count : ((S -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
+--R eval : (%,List(S),List(S)) -> % if S has EVALAB(S) and S has SETCAT
+--R eval : (%,S,S) -> % if S has EVALAB(S) and S has SETCAT
+--R eval : (%,Equation(S)) -> % if S has EVALAB(S) and S has SETCAT
+--R eval : (%,List(Equation(S))) -> % if S has EVALAB(S) and S has SETCAT
+--R every? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R hash : % -> SingleInteger if S has SETCAT
+--R less? : (%,NonNegativeInteger) -> Boolean
+--R map! : ((S -> S),%) -> % if $ has shallowlyMutable
+--R member? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
+--R members : % -> List(S) if $ has finiteAggregate
+--R more? : (%,NonNegativeInteger) -> Boolean
+--R parts : % -> List(S) if $ has finiteAggregate
+--R size? : (%,NonNegativeInteger) -> Boolean
+--R ?~=? : (%,%) -> Boolean if S has SETCAT
+--R
+--E 42
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{Heap.help}
+====================================================================
+Heap examples
+====================================================================
+
+The domain Heap(S) implements a priority queue of objects of type S
+such that the operation extract! removes and returns the maximum
+element.  The implementation represents heaps as flexible arrays The
+representation and algorithms give complexity of O(log(n)) for
+insertion and extractions, and O(n) for construction.
+
+Create a heap of five elements:
+
+   a:Heap INT:= heap [1,2,3,4,5]
+        [5,4,2,1,3]
+
+Use bag to convert a Bag into a Heap:
+
+   bag([1,2,3,4,5])$Heap(INT)
+        [5,4,3,1,2]
+
+The operation copy can be used to copy a Heap:
+
+   c:=copy a
+        [5,4,2,1,3]
+
+Use empty? to check if the heap is empty:
+
+   empty? a
+        false
+
+Use empty to create a new, empty heap:
+ 
+   b:=empty()$(Heap INT)
+        []
+
+and we can see that the newly created heap is empty:
+
+   empty? b
+        true
+
+The eq? function compares the reference of one heap to another:
+
+   eq?(a,c)
+        false
+
+The extract! function removes largest element of the heap:
+
+   extract! a
+        5
+
+Now extract! elements repeatedly until none are left, collecting
+the elements in a list.
+
+  [extract!(h) while not empty?(h)]
+    [9,7,3,2,- 4,- 7]
+                      Type: List Integer
+
+Another way to produce the same result is by defining a heapsort function.
+
+  heapsort(x) == (empty? x => []; cons(extract!(x),heapsort x))
+                      Type: Void
+
+Create another sample heap.
+
+  h1 := heap [17,-4,9,-11,2,7,-7]
+    [17,2,9,- 11,- 4,7,- 7]
+                      Type: Heap Integer
+
+Apply heapsort to present elements in order.
+
+  heapsort h1
+    [17,9,7,2,- 4,- 7,- 11]
+                      Type: List Integer
+
+Heaps can be compared with =
+
+   (a=c)@Boolean
+        false
+
+and ~=
+
+   (a~=c)
+       true
+
+The inspect function shows the largest element in the heap:
+
+   inspect a
+       4
+
+The insert! function adds an element to the heap:
+
+   insert!(9,a)
+       [9,4,2,1,3]
+
+The map function applies a function to every element of the heap
+and returns a new heap:
+
+   map(x+->x+10,a)
+       [19,14,12,11,13]
+
+The original heap is unchanged:
+
+   a
+       [9,4,2,1,3]
+
+The map! function applies a function to every element of the heap
+and returns the original heap with modifications:
+
+   map!(x+->x+10,a)
+       [19,14,12,11,13]
+
+The original heap has been modified:
+
+   a
+       [19,14,12,11,13]
+
+The max function returns the largest element in the heap:
+
+   max a
+       19
+
+The merge function takes two heaps and creates a new heap with
+all of the elements:
+
+   merge(a,c)
+       [19,14,12,11,13,5,4,2,1,3]
+
+Notice that the original heap is unchanged:
+
+   a
+       [19,14,12,11,13]
+
+The merge! function takes two heaps and modifies the first heap
+argument to contain all of the elements:
+
+   merge!(a,c)
+       [19,14,12,11,13,5,4,2,1,3]
+
+Notice that the first argument was modified:
+
+   a
+       [19,14,12,11,13,5,4,2,1,3]
+
+but the second argument was not:
+
+   c
+       [5,4,2,1,3]
+
+A new, empty heap can be created with sample:
+
+   sample()$Heap(INT)
+       []
+
+The # function gives the size of the heap:
+
+   #a
+       10 
+
+The any? function tests each element against a predicate function
+and returns true if any pass:
+
+   any?(x+->(x=14),a)
+       true
+
+The every? function tests each element against a predicate function
+and returns true if they all pass:
+
+   every?(x+->(x=11),a)
+       false
+
+The parts function returns a list of the elements in the heap:
+
+   parts a
+       [19,14,12,11,13,5,4,2,1,3]
+
+The size? predicate compares the size of the heap to a value:
+
+   size?(a,9)
+       false
+
+The more? predicate asks if the heap size is larger than a value:
+
+   more?(a,9)
+       true
+
+The less? predicate asks if the heap size is smaller than a value:
+
+   less?(a,9)
+       false
+
+The members function returns a list of the elements of the heap:
+
+   members a
+       [19,14,12,11,13,5,4,2,1,3]
+
+The member? predicate asks if an element is in the heap:
+
+   member?(14,a)
+       true
+
+The count function has two forms, one of which counts the number
+of copies of an element in the heap:
+
+   count(14,a)
+       1
+
+The second form of the count function accepts a predicate to test
+against each member of the heap and counts the number of true results:
+
+   count(x+->(x>13),a)
+       2
+
+See Also:
+o )show Stack
+o )show ArrayStack
+o )show Queue
+o )show Dequeue
+o )show Heap
+o )show BagAggregate
+
+\end{chunk}
+\pagehead{Heap}{HEAP}
+\pagepic{ps/v103heap.ps}{HEAP}{1.00}
+{\bf See}\\
+\pageto{Stack}{STACK}
+\pageto{ArrayStack}{ASTACK}
+\pageto{Queue}{QUEUE}
+\pageto{Dequeue}{DEQUEUE}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{HEAP}{any?} &
+\cross{HEAP}{bag} &
+\cross{HEAP}{coerce} &
+\cross{HEAP}{copy} &
+\cross{HEAP}{count} \\
+\cross{HEAP}{empty} &
+\cross{HEAP}{empty?} &
+\cross{HEAP}{eq?} &
+\cross{HEAP}{eval} &
+\cross{HEAP}{every?} \\
+\cross{HEAP}{extract!} &
+\cross{HEAP}{hash} &
+\cross{HEAP}{heap} &
+\cross{HEAP}{insert!} &
+\cross{HEAP}{inspect} \\
+\cross{HEAP}{latex} &
+\cross{HEAP}{less?} &
+\cross{HEAP}{map} &
+\cross{HEAP}{map!} &
+\cross{HEAP}{max} \\
+\cross{HEAP}{member?} &
+\cross{HEAP}{members} &
+\cross{HEAP}{merge} &
+\cross{HEAP}{merge!} &
+\cross{HEAP}{more?} \\
+\cross{HEAP}{parts} &
+\cross{HEAP}{sample} &
+\cross{HEAP}{size?} &
+\cross{HEAP}{\#{}?} &
+\cross{HEAP}{?=?} \\
+\cross{HEAP}{?\~{}=?} &&&&
+\end{tabular}
+
+\begin{chunk}{domain HEAP Heap}
+)abbrev domain HEAP Heap
+++ Author: Michael Monagan and Stephen Watt
+++ Date Created:June 86 and July 87
+++ Date Last Updated:Feb 92
+++ Description:
+++ Heap implemented in a flexible array to allow for insertions
+++ Complexity: O(log n) insertion, extraction and O(n) construction
+--% Dequeue and Heap data types
+ 
+Heap(S:OrderedSet): Exports == Implementation where 
+  Exports == PriorityQueueAggregate S with
+    heap : List S -> %
+      ++ heap(ls) creates a heap of elements consisting of the 
+      ++ elements of ls.
+      ++
+      ++E i:Heap INT := heap [1,6,3,7,5,2,4]
+
+ -- Inherited Signatures repeated for examples documentation
+
+    bag : List S -> %
+      ++
+      ++X bag([1,2,3,4,5])$Heap(INT)
+    copy : % -> %
+      ++
+      ++X a:Heap INT:= heap [1,2,3,4,5]
+      ++X copy a
+    empty? : % -> Boolean
+      ++
+      ++X a:Heap INT:= heap [1,2,3,4,5]
+      ++X empty? a
+    empty : () -> %
+      ++
+      ++X b:=empty()$(Heap INT)
+    eq? : (%,%) -> Boolean
+      ++
+      ++X a:Heap INT:= heap [1,2,3,4,5]
+      ++X b:=copy a
+      ++X eq?(a,b)
+    extract_! : % -> S
+      ++
+      ++X a:Heap INT:= heap [1,2,3,4,5]
+      ++X extract! a
+      ++X a
+    insert_! : (S,%) -> %
+      ++
+      ++X a:Heap INT:= heap [1,2,3,4,5]
+      ++X insert!(8,a)
+      ++X a
+    inspect : % -> S
+      ++
+      ++X a:Heap INT:= heap [1,2,3,4,5]
+      ++X inspect a
+    map :  ((S -> S),%) -> %
+      ++
+      ++X a:Heap INT:= heap [1,2,3,4,5]
+      ++X map(x+->x+10,a)
+      ++X a
+    max : % -> S
+      ++
+      ++X a:Heap INT:= heap [1,2,3,4,5]
+      ++X max a
+    merge : (%,%) -> %
+      ++
+      ++X a:Heap INT:= heap [1,2,3,4,5]
+      ++X b:Heap INT:= heap [6,7,8,9,10]
+      ++X merge(a,b)
+    merge! : (%,%) -> %
+      ++
+      ++X a:Heap INT:= heap [1,2,3,4,5]
+      ++X b:Heap INT:= heap [6,7,8,9,10]
+      ++X merge!(a,b)
+      ++X a
+      ++X b
+    sample : () -> %
+      ++
+      ++X sample()$Heap(INT)
+    less? : (%,NonNegativeInteger) -> Boolean
+      ++
+      ++X a:Heap INT:= heap [1,2,3,4,5]
+      ++X less?(a,9)
+    more? : (%,NonNegativeInteger) -> Boolean
+      ++
+      ++X a:Heap INT:= heap [1,2,3,4,5]
+      ++X more?(a,9)
+    size? : (%,NonNegativeInteger) -> Boolean
+      ++
+      ++X a:Heap INT:= heap [1,2,3,4,5]
+      ++X size?(a,5)
+    if $ has shallowlyMutable then
+      map! :  ((S -> S),%) -> %
+        ++
+        ++X a:Heap INT:= heap [1,2,3,4,5]
+        ++X map!(x+->x+10,a)
+        ++X a
+    if S has SetCategory then
+      latex : % -> String
+        ++
+        ++X a:Heap INT:= heap [1,2,3,4,5]
+        ++X latex a
+      hash : % -> SingleInteger
+        ++
+        ++X a:Heap INT:= heap [1,2,3,4,5]
+        ++X hash a
+      coerce : % -> OutputForm
+        ++
+        ++X a:Heap INT:= heap [1,2,3,4,5]
+        ++X coerce a
+      "=": (%,%) -> Boolean
+        ++
+        ++X a:Heap INT:= heap [1,2,3,4,5]
+        ++X b:Heap INT:= heap [1,2,3,4,5]
+        ++X (a=b)@Boolean
+      "~=" : (%,%) -> Boolean
+        ++
+        ++X a:Heap INT:= heap [1,2,3,4,5]
+        ++X b:=copy a
+        ++X (a~=b)
+    if % has finiteAggregate then
+      every? : ((S -> Boolean),%) -> Boolean
+        ++
+        ++X a:Heap INT:= heap [1,2,3,4,5]
+        ++X every?(x+->(x=4),a)
+      any? : ((S -> Boolean),%) -> Boolean
+        ++
+        ++X a:Heap INT:= heap [1,2,3,4,5]
+        ++X any?(x+->(x=4),a)
+      count :  ((S -> Boolean),%) -> NonNegativeInteger
+        ++
+        ++X a:Heap INT:= heap [1,2,3,4,5]
+        ++X count(x+->(x>2),a)
+      _# : % -> NonNegativeInteger
+        ++
+        ++X a:Heap INT:= heap [1,2,3,4,5]
+        ++X #a
+      parts : % -> List S
+        ++
+        ++X a:Heap INT:= heap [1,2,3,4,5]
+        ++X parts a
+      members : % -> List S
+        ++
+        ++X a:Heap INT:= heap [1,2,3,4,5]
+        ++X members a
+    if % has finiteAggregate and S has SetCategory then
+      member? : (S,%) -> Boolean
+        ++
+        ++X a:Heap INT:= heap [1,2,3,4,5]
+        ++X member?(3,a)
+      count : (S,%) -> NonNegativeInteger
+        ++
+        ++X a:Heap INT:= heap [1,2,3,4,5]
+        ++X count(4,a)
+
+  Implementation == IndexedFlexibleArray(S,0) add
+
+    Rep := IndexedFlexibleArray( S,0)
+
+    empty() == empty()$Rep
+
+    heap l == 
+      n := #l
+      h := empty()
+      n = 0 => h
+      for x in l repeat insert_!(x,h)
+      h
+
+    siftUp: (%,Integer,Integer) -> Void
+    siftUp(r,i,n) ==
+       -- assertion 0 <= i < n
+       t := r.i
+       while (j := 2*i+1) < n repeat
+          if (k := j+1) < n and r.j < r.k then j := k
+          if t < r.j then (r.i := r.j; r.j := t; i := j) else leave
+ 
+    extract_! r ==
+       -- extract the maximum from the heap O(log n)
+       n := #r :: Integer
+       n = 0 => error "empty heap"
+       t := r(0)
+       r(0) := r(n-1)
+       delete_!(r,n-1)
+       n = 1 => t
+       siftUp(r,0,n-1)
+       t
+ 
+    insert_!(x,r) ==
+       -- Williams' insertion algorithm O(log n)
+       j := (#r) :: Integer
+       r:=concat_!(r,concat(x,empty()$Rep))
+       while j > 0 repeat
+          i := (j-1) quo 2
+          if r(i) >= x then leave
+          r(j) := r(i)
+          j := i
+       r(j):=x
+       r
+ 
+    max r == if #r = 0 then error "empty heap" else r.0
+
+    inspect r == max r
+ 
+    makeHeap(r:%):% ==
+       -- Floyd's heap construction algorithm O(n)
+       n := #r
+       for k in n quo 2 -1 .. 0 by -1 repeat siftUp(r,k,n)
+       r
+
+    bag l == makeHeap construct(l)$Rep
+
+    merge(a,b) == makeHeap concat(a,b)
+
+    merge_!(a,b) == makeHeap concat_!(a,b)
+
+\end{chunk}
+
+\begin{chunk}{COQ HEAP}
+(* domain HEAP *)
+(*
+ IndexedFlexibleArray(S,0) add
+
+    Rep := IndexedFlexibleArray( S,0)
+
+    empty() == empty()$Rep
+
+    heap l == 
+      n := #l
+      h := empty()
+      n = 0 => h
+      for x in l repeat insert_!(x,h)
+      h
+
+    siftUp: (%,Integer,Integer) -> Void
+    siftUp(r,i,n) ==
+       -- assertion 0 <= i < n
+       t := r.i
+       while (j := 2*i+1) < n repeat
+          if (k := j+1) < n and r.j < r.k then j := k
+          if t < r.j then (r.i := r.j; r.j := t; i := j) else leave
+ 
+    extract_! r ==
+       -- extract the maximum from the heap O(log n)
+       n := #r :: Integer
+       n = 0 => error "empty heap"
+       t := r(0)
+       r(0) := r(n-1)
+       delete_!(r,n-1)
+       n = 1 => t
+       siftUp(r,0,n-1)
+       t
+ 
+    insert_!(x,r) ==
+       -- Williams' insertion algorithm O(log n)
+       j := (#r) :: Integer
+       r:=concat_!(r,concat(x,empty()$Rep))
+       while j > 0 repeat
+          i := (j-1) quo 2
+          if r(i) >= x then leave
+          r(j) := r(i)
+          j := i
+       r(j):=x
+       r
+ 
+    max r == if #r = 0 then error "empty heap" else r.0
+
+    inspect r == max r
+ 
+    makeHeap(r:%):% ==
+       -- Floyd's heap construction algorithm O(n)
+       n := #r
+       for k in n quo 2 -1 .. 0 by -1 repeat siftUp(r,k,n)
+       r
+
+    bag l == makeHeap construct(l)$Rep
+
+    merge(a,b) == makeHeap concat(a,b)
+
+    merge_!(a,b) == makeHeap concat_!(a,b)
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{HEAP.dotabb}
+"HEAP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=HEAP"]
+"A1AGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=A1AGG"]
+"HEAP" -> "A1AGG"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain HEXADEC HexadecimalExpansion}
+
+\begin{chunk}{HexadecimalExpansion.input}
+)set break resume
+)sys rm -f HexadecimalExpansion.output
+)spool HexadecimalExpansion.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 8
+r := hex(22/7)
+--R 
+--R
+--R          ___
+--R   (1)  3.249
+--R                                                   Type: HexadecimalExpansion
+--E 1
+
+--S 2 of 8
+r + hex(6/7)
+--R 
+--R
+--R   (2)  4
+--R                                                   Type: HexadecimalExpansion
+--E 2
+
+--S 3 of 8
+[hex(1/i) for i in 350..354]
+--R 
+--R
+--R   (3)
+--R       _______________    _________      _____    ______________________
+--R   [0.00BB3EE721A54D88, 0.00BAB6561, 0.00BA2E8, 0.00B9A7862A0FF465879D5F,
+--R       _____________________________
+--R    0.00B92143FA36F5E02E4850FE8DBD78]
+--R                                             Type: List(HexadecimalExpansion)
+--E 3
+
+--S 4 of 8
+hex(1/1007)
+--R 
+--R
+--R   (4)
+--R   0.
+--R     OVERBAR
+--R        0041149783F0BF2C7D13933192AF6980619EE345E91EC2BB9D5CCA5C071E40926E54E8D
+--R          DAE24196C0B2F8A0AAD60DBA57F5D4C8536262210C74F1
+--R                                                   Type: HexadecimalExpansion
+--E 4
+
+--S 5 of 8
+p := hex(1/4)*x**2 + hex(2/3)*x + hex(4/9)
+--R 
+--R
+--R            2     _      ___
+--R   (5)  0.4x  + 0.Ax + 0.71C
+--R                                       Type: Polynomial(HexadecimalExpansion)
+--E 5
+
+--S 6 of 8
+q := D(p, x)
+--R 
+--R
+--R                 _
+--R   (6)  0.8x + 0.A
+--R                                       Type: Polynomial(HexadecimalExpansion)
+--E 6
+
+--S 7 of 8
+g := gcd(p, q)
+--R 
+--R
+--R              _
+--R   (7)  x + 1.5
+--R                                       Type: Polynomial(HexadecimalExpansion)
+--E 7
+
+--S 8 of 8
+)show HexadecimalExpansion
+--R 
+--R HexadecimalExpansion  is a domain constructor
+--R Abbreviation for HexadecimalExpansion is HEXADEC 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for HEXADEC 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (%,Integer) -> %                ?*? : (Integer,%) -> %
+--R ?*? : (Fraction(Integer),%) -> %      ?*? : (%,Fraction(Integer)) -> %
+--R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
+--R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
+--R ?**? : (%,Integer) -> %               ?**? : (%,NonNegativeInteger) -> %
+--R ?**? : (%,PositiveInteger) -> %       ?+? : (%,%) -> %
+--R ?-? : (%,%) -> %                      -? : % -> %
+--R ?/? : (Integer,Integer) -> %          ?/? : (%,%) -> %
+--R ?=? : (%,%) -> Boolean                D : (%,(Integer -> Integer)) -> %
+--R D : % -> % if Integer has DIFRING     1 : () -> %
+--R 0 : () -> %                           ?^? : (%,Integer) -> %
+--R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
+--R associates? : (%,%) -> Boolean        coerce : % -> RadixExpansion(16)
+--R coerce : % -> Fraction(Integer)       coerce : Integer -> %
+--R coerce : Fraction(Integer) -> %       coerce : % -> %
+--R coerce : Integer -> %                 coerce : % -> OutputForm
+--R denom : % -> Integer                  denominator : % -> %
+--R factor : % -> Factored(%)             gcd : List(%) -> %
+--R gcd : (%,%) -> %                      hash : % -> SingleInteger
+--R hex : Fraction(Integer) -> %          init : () -> % if Integer has STEP
+--R inv : % -> %                          latex : % -> String
+--R lcm : List(%) -> %                    lcm : (%,%) -> %
+--R numer : % -> Integer                  numerator : % -> %
+--R one? : % -> Boolean                   prime? : % -> Boolean
+--R ?quo? : (%,%) -> %                    random : () -> % if Integer has INS
+--R recip : % -> Union(%,"failed")        ?rem? : (%,%) -> %
+--R retract : % -> Integer                sample : () -> %
+--R sizeLess? : (%,%) -> Boolean          squareFree : % -> Factored(%)
+--R squareFreePart : % -> %               toint : String -> Integer
+--R unit? : % -> Boolean                  unitCanonical : % -> %
+--R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
+--R ?<? : (%,%) -> Boolean if Integer has ORDSET
+--R ?<=? : (%,%) -> Boolean if Integer has ORDSET
+--R ?>? : (%,%) -> Boolean if Integer has ORDSET
+--R ?>=? : (%,%) -> Boolean if Integer has ORDSET
+--R D : (%,(Integer -> Integer),NonNegativeInteger) -> %
+--R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if Integer has PDRING(SYMBOL)
+--R D : (%,Symbol,NonNegativeInteger) -> % if Integer has PDRING(SYMBOL)
+--R D : (%,List(Symbol)) -> % if Integer has PDRING(SYMBOL)
+--R D : (%,Symbol) -> % if Integer has PDRING(SYMBOL)
+--R D : (%,NonNegativeInteger) -> % if Integer has DIFRING
+--R abs : % -> % if Integer has OINTDOM
+--R ceiling : % -> Integer if Integer has INS
+--R characteristic : () -> NonNegativeInteger
+--R charthRoot : % -> Union(%,"failed") if $ has CHARNZ and Integer has PFECAT or Integer has CHARNZ
+--R coerce : Symbol -> % if Integer has RETRACT(SYMBOL)
+--R conditionP : Matrix(%) -> Union(Vector(%),"failed") if $ has CHARNZ and Integer has PFECAT
+--R convert : % -> DoubleFloat if Integer has REAL
+--R convert : % -> Float if Integer has REAL
+--R convert : % -> InputForm if Integer has KONVERT(INFORM)
+--R convert : % -> Pattern(Float) if Integer has KONVERT(PATTERN(FLOAT))
+--R convert : % -> Pattern(Integer) if Integer has KONVERT(PATTERN(INT))
+--R differentiate : (%,(Integer -> Integer)) -> %
+--R differentiate : (%,(Integer -> Integer),NonNegativeInteger) -> %
+--R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if Integer has PDRING(SYMBOL)
+--R differentiate : (%,Symbol,NonNegativeInteger) -> % if Integer has PDRING(SYMBOL)
+--R differentiate : (%,List(Symbol)) -> % if Integer has PDRING(SYMBOL)
+--R differentiate : (%,Symbol) -> % if Integer has PDRING(SYMBOL)
+--R differentiate : (%,NonNegativeInteger) -> % if Integer has DIFRING
+--R differentiate : % -> % if Integer has DIFRING
+--R divide : (%,%) -> Record(quotient: %,remainder: %)
+--R ?.? : (%,Integer) -> % if Integer has ELTAB(INT,INT)
+--R euclideanSize : % -> NonNegativeInteger
+--R eval : (%,Symbol,Integer) -> % if Integer has IEVALAB(SYMBOL,INT)
+--R eval : (%,List(Symbol),List(Integer)) -> % if Integer has IEVALAB(SYMBOL,INT)
+--R eval : (%,List(Equation(Integer))) -> % if Integer has EVALAB(INT)
+--R eval : (%,Equation(Integer)) -> % if Integer has EVALAB(INT)
+--R eval : (%,Integer,Integer) -> % if Integer has EVALAB(INT)
+--R eval : (%,List(Integer),List(Integer)) -> % if Integer has EVALAB(INT)
+--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 Integer has PFECAT
+--R factorSquareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if Integer has PFECAT
+--R floor : % -> Integer if Integer has INS
+--R fractionPart : % -> Fraction(Integer)
+--R fractionPart : % -> % if Integer has EUCDOM
+--R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%)
+--R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %)
+--R map : ((Integer -> Integer),%) -> %
+--R max : (%,%) -> % if Integer has ORDSET
+--R min : (%,%) -> % if Integer has ORDSET
+--R multiEuclidean : (List(%),%) -> Union(List(%),"failed")
+--R negative? : % -> Boolean if Integer has OINTDOM
+--R nextItem : % -> Union(%,"failed") if Integer has STEP
+--R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) if Integer has PATMAB(FLOAT)
+--R patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> PatternMatchResult(Integer,%) if Integer has PATMAB(INT)
+--R positive? : % -> Boolean if Integer has OINTDOM
+--R principalIdeal : List(%) -> Record(coef: List(%),generator: %)
+--R reducedSystem : Matrix(%) -> Matrix(Integer)
+--R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer))
+--R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer)) if Integer has LINEXP(INT)
+--R reducedSystem : Matrix(%) -> Matrix(Integer) if Integer has LINEXP(INT)
+--R retract : % -> Integer if Integer has RETRACT(INT)
+--R retract : % -> Fraction(Integer) if Integer has RETRACT(INT)
+--R retract : % -> Symbol if Integer has RETRACT(SYMBOL)
+--R retractIfCan : % -> Union(Integer,"failed") if Integer has RETRACT(INT)
+--R retractIfCan : % -> Union(Fraction(Integer),"failed") if Integer has RETRACT(INT)
+--R retractIfCan : % -> Union(Symbol,"failed") if Integer has RETRACT(SYMBOL)
+--R retractIfCan : % -> Union(Integer,"failed")
+--R sign : % -> Integer if Integer has OINTDOM
+--R solveLinearPolynomialEquation : (List(SparseUnivariatePolynomial(%)),SparseUnivariatePolynomial(%)) -> Union(List(SparseUnivariatePolynomial(%)),"failed") if Integer has PFECAT
+--R squareFreePolynomial : SparseUnivariatePolynomial(%) -> Factored(SparseUnivariatePolynomial(%)) if Integer has PFECAT
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R unitNormal : % -> Record(unit: %,canonical: %,associate: %)
+--R wholePart : % -> Integer if Integer has EUCDOM
+--R
+--E 8
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{HexadecimalExpansion.help}
+====================================================================
+HexadecimalExpansion
+====================================================================
+
+All rationals have repeating hexadecimal expansions.  The operation
+hex returns these expansions of type HexadecimalExpansion.  Operations
+to access the individual numerals of a hexadecimal expansion can be
+obtained by converting the value to RadixExpansion(16).  More examples
+of expansions are available in the DecimalExpansion, BinaryExpansion,
+and RadixExpansion.
+
+This is a hexadecimal expansion of a rational number.
+
+  r := hex(22/7)
+      ___
+    3.249
+                      Type: HexadecimalExpansion
+
+Arithmetic is exact.
+
+  r + hex(6/7)
+    4
+                      Type: HexadecimalExpansion
+
+The period of the expansion can be short or long ...
+
+  [hex(1/i) for i in 350..354]
+       _______________    _________      _____    ______________________
+   [0.00BB3EE721A54D88, 0.00BAB6561, 0.00BA2E8, 0.00B9A7862A0FF465879D5F,
+       _____________________________
+    0.00B92143FA36F5E02E4850FE8DBD78]
+                      Type: List HexadecimalExpansion
+
+or very long!
+
+  hex(1/1007)
+     _______________________________________________________________________
+   0.0041149783F0BF2C7D13933192AF6980619EE345E91EC2BB9D5CCA5C071E40926E54E8D
+     ______________________________________________
+     DAE24196C0B2F8A0AAD60DBA57F5D4C8536262210C74F1
+                      Type: HexadecimalExpansion
+
+These numbers are bona fide algebraic objects.
+
+  p := hex(1/4)*x**2 + hex(2/3)*x + hex(4/9)
+        2     _      ___
+    0.4x  + 0.Ax + 0.71C
+                      Type: Polynomial HexadecimalExpansion
+
+  q := D(p, x)
+             _
+    0.8x + 0.A
+                      Type: Polynomial HexadecimalExpansion
+
+  g := gcd(p, q)
+          _
+    x + 1.5
+                      Type: Polynomial HexadecimalExpansion
+
+See Also:
+o )help RadixExpansion
+o )help BinaryExpansion
+o )help DecimalExpansion
+o )show HexadecimalExpansion
+
+\end{chunk}
+\pagehead{HexadecimalExpansion}{HEXADEC}
+\pagepic{ps/v103hexadecimalexpansion.ps}{HEXADEC}{1.00}
+{\bf See}\\
+\pageto{RadixExpansion}{RADIX}
+\pageto{BinaryExpansion}{BINARY}
+\pageto{DecimalExpansion}{DECIMAL}
+
+{\bf Exports:}\\
+\begin{tabular}{ll}
+\cross{HEXADEC}{0} &
+\cross{HEXADEC}{1} \\
+\cross{HEXADEC}{abs} &
+\cross{HEXADEC}{associates?} \\
+\cross{HEXADEC}{ceiling} &
+\cross{HEXADEC}{characteristic} \\
+\cross{HEXADEC}{charthRoot} &
+\cross{HEXADEC}{coerce} \\
+\cross{HEXADEC}{conditionP} &
+\cross{HEXADEC}{convert} \\
+\cross{HEXADEC}{D} &
+\cross{HEXADEC}{denom} \\
+\cross{HEXADEC}{denominator} &
+\cross{HEXADEC}{differentiate} \\
+\cross{HEXADEC}{divide} &
+\cross{HEXADEC}{euclideanSize} \\
+\cross{HEXADEC}{eval} &
+\cross{HEXADEC}{expressIdealMember} \\
+\cross{HEXADEC}{exquo} &
+\cross{HEXADEC}{extendedEuclidean} \\
+\cross{HEXADEC}{factor} &
+\cross{HEXADEC}{factorPolynomial} \\
+\cross{HEXADEC}{factorSquareFreePolynomial} &
+\cross{HEXADEC}{floor} \\
+\cross{HEXADEC}{fractionPart} &
+\cross{HEXADEC}{gcd} \\
+\cross{HEXADEC}{gcdPolynomial} &
+\cross{HEXADEC}{hash} \\
+\cross{HEXADEC}{hex} &
+\cross{HEXADEC}{init} \\
+\cross{HEXADEC}{inv} &
+\cross{HEXADEC}{latex} \\
+\cross{HEXADEC}{lcm} &
+\cross{HEXADEC}{map} \\
+\cross{HEXADEC}{max} &
+\cross{HEXADEC}{min} \\
+\cross{HEXADEC}{multiEuclidean} &
+\cross{HEXADEC}{negative?} \\
+\cross{HEXADEC}{nextItem} &
+\cross{HEXADEC}{numer} \\
+\cross{HEXADEC}{numerator} &
+\cross{HEXADEC}{one?} \\
+\cross{HEXADEC}{patternMatch} &
+\cross{HEXADEC}{positive?} \\
+\cross{HEXADEC}{prime?} &
+\cross{HEXADEC}{principalIdeal} \\
+\cross{HEXADEC}{random} &
+\cross{HEXADEC}{recip} \\
+\cross{HEXADEC}{reducedSystem} &
+\cross{HEXADEC}{retract} \\
+\cross{HEXADEC}{retractIfCan} &
+\cross{HEXADEC}{sample} \\
+\cross{HEXADEC}{sign} &
+\cross{HEXADEC}{sizeLess?} \\
+\cross{HEXADEC}{solveLinearPolynomialEquation} &
+\cross{HEXADEC}{squareFree} \\
+\cross{HEXADEC}{squareFreePart} &
+\cross{HEXADEC}{squareFreePolynomial} \\
+\cross{HEXADEC}{subtractIfCan} &
+\cross{HEXADEC}{unit?} \\
+\cross{HEXADEC}{unitCanonical} &
+\cross{HEXADEC}{unitNormal} \\
+\cross{HEXADEC}{wholePart} &
+\cross{HEXADEC}{zero?} \\
+\cross{HEXADEC}{?*?} &
+\cross{HEXADEC}{?**?} \\
+\cross{HEXADEC}{?+?} &
+\cross{HEXADEC}{?-?} \\
+\cross{HEXADEC}{-?} &
+\cross{HEXADEC}{?/?} \\
+\cross{HEXADEC}{?=?} &
+\cross{HEXADEC}{?\^{}?} \\
+\cross{HEXADEC}{?\~{}=?} &
+\cross{HEXADEC}{?$<$?} \\
+\cross{HEXADEC}{?$<=$?} &
+\cross{HEXADEC}{?$>$?} \\
+\cross{HEXADEC}{?$>=$?} &
+\cross{HEXADEC}{?.?} \\
+\cross{HEXADEC}{?quo?} &
+\cross{HEXADEC}{?rem?} 
+\end{tabular}
+
+\begin{chunk}{domain HEXADEC HexadecimalExpansion}
+)abbrev domain HEXADEC HexadecimalExpansion
+++ Author: Clifton J. Williamson
+++ Date Created: April 26, 1990
+++ Date Last Updated: May 15, 1991
+++ Description:
+++ This domain allows rational numbers to be presented as repeating
+++ hexadecimal expansions.
+
+HexadecimalExpansion(): Exports == Implementation where
+  INT ==> Integer
+  CHAR ==> Character
+  Exports ==> QuotientFieldCategory(Integer) with
+
+    coerce: % -> Fraction Integer
+      ++ coerce(h) converts a hexadecimal expansion to a rational number.
+
+    coerce: % -> RadixExpansion(16)
+      ++ coerce(h) converts a hexadecimal expansion to a radix expansion
+      ++ with base 16.
+
+    fractionPart: % -> Fraction Integer
+      ++ fractionPart(h) returns the fractional part of a hexadecimal expansion
+
+    hex: Fraction Integer -> %
+      ++ hex(r) converts a rational number to a hexadecimal expansion.
+
+    toint: String -> Integer
+      ++ toint(s) converts a hex string to integer
+      ++
+      ++X toint("FE")
+      ++X toint("BFD25E8C")
+
+  Implementation ==> RadixExpansion(16) add
+  
+    hex r == 
+      r :: %
+
+    coerce(x:%):RadixExpansion(16) ==
+      x pretend RadixExpansion(16)
+
+    toint(s) ==
+      dec:Integer := 0
+      for i in 1..#s repeat 
+        if (s.i = char "0")$CHAR then dec := 16*dec
+        if (s.i = char "1")$CHAR then dec := 16*dec+1
+        if (s.i = char "2")$CHAR then dec := 16*dec+2
+        if (s.i = char "3")$CHAR then dec := 16*dec+3
+        if (s.i = char "4")$CHAR then dec := 16*dec+4
+        if (s.i = char "5")$CHAR then dec := 16*dec+5
+        if (s.i = char "6")$CHAR then dec := 16*dec+6
+        if (s.i = char "7")$CHAR then dec := 16*dec+7
+        if (s.i = char "8")$CHAR then dec := 16*dec+8
+        if (s.i = char "9")$CHAR then dec := 16*dec+9
+        if (s.i = char "A")$CHAR then dec := 16*dec+10
+        if (s.i = char "a")$CHAR then dec := 16*dec+10
+        if (s.i = char "B")$CHAR then dec := 16*dec+11
+        if (s.i = char "b")$CHAR then dec := 16*dec+11
+        if (s.i = char "C")$CHAR then dec := 16*dec+12
+        if (s.i = char "c")$CHAR then dec := 16*dec+12
+        if (s.i = char "D")$CHAR then dec := 16*dec+13
+        if (s.i = char "d")$CHAR then dec := 16*dec+13
+        if (s.i = char "E")$CHAR then dec := 16*dec+14
+        if (s.i = char "e")$CHAR then dec := 16*dec+14
+        if (s.i = char "F")$CHAR then dec := 16*dec+15
+        if (s.i = char "f")$CHAR then dec := 16*dec+15
+      dec
+
+\end{chunk}
+
+\begin{chunk}{COQ HEXADEC}
+(* domain HEXADEC *)
+(*
+ RadixExpansion(16) add
+  
+    hex r == 
+      r :: %
+
+    coerce(x:%):RadixExpansion(16) ==
+      x pretend RadixExpansion(16)
+
+    toint(s) ==
+      dec:Integer := 0
+      for i in 1..#s repeat 
+        if (s.i = char "0")$CHAR then dec := 16*dec
+        if (s.i = char "1")$CHAR then dec := 16*dec+1
+        if (s.i = char "2")$CHAR then dec := 16*dec+2
+        if (s.i = char "3")$CHAR then dec := 16*dec+3
+        if (s.i = char "4")$CHAR then dec := 16*dec+4
+        if (s.i = char "5")$CHAR then dec := 16*dec+5
+        if (s.i = char "6")$CHAR then dec := 16*dec+6
+        if (s.i = char "7")$CHAR then dec := 16*dec+7
+        if (s.i = char "8")$CHAR then dec := 16*dec+8
+        if (s.i = char "9")$CHAR then dec := 16*dec+9
+        if (s.i = char "A")$CHAR then dec := 16*dec+10
+        if (s.i = char "a")$CHAR then dec := 16*dec+10
+        if (s.i = char "B")$CHAR then dec := 16*dec+11
+        if (s.i = char "b")$CHAR then dec := 16*dec+11
+        if (s.i = char "C")$CHAR then dec := 16*dec+12
+        if (s.i = char "c")$CHAR then dec := 16*dec+12
+        if (s.i = char "D")$CHAR then dec := 16*dec+13
+        if (s.i = char "d")$CHAR then dec := 16*dec+13
+        if (s.i = char "E")$CHAR then dec := 16*dec+14
+        if (s.i = char "e")$CHAR then dec := 16*dec+14
+        if (s.i = char "F")$CHAR then dec := 16*dec+15
+        if (s.i = char "f")$CHAR then dec := 16*dec+15
+      dec
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{HEXADEC.dotabb}
+"HEXADEC" [color="#88FF44",href="bookvol10.3.pdf#nameddest=HEXADEC"]
+"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"]
+"HEXADEC" -> "PFECAT"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{package HTMLFORM HTMLFormat}
+Here I have put some information about 'how to use' and 'the benefits of'
+this HTML formatter. Also some information for programmers if they want
+to extend this package.
+
+If you want information about creating output formatters in general then,
+rather than duplicating content here I refer you to mathml.spad.pamphlet
+containing the MathMLFormat domain by Arthur C. Ralfs. This contains useful
+information for writers of output formatters.
+
+\subsection{Overview}
+
+This package allows users to cut and paste output from the Axiom
+command line to a HTML page. This output is enabled by typing:
+
+\begin{verbatim}
+)set output html on
+\end{verbatim}
+
+After this the command line will output html (in addition to other formats
+that are enabled) and this html code can then be copied and pasted into a
+HTML document.
+
+The HTML produced is well formed XML, that is, all tags have equivalent
+closing tags.
+
+\subsection{Why output to HTML?}
+
+In some ways HTMLFormat is a compromise between the standard text output and
+specialised formats like MathMLFormat. The potential quality is never
+going to be as good as output to a specialised maths renderer but on
+the other hand it is a lot better than the clunky fixed width font
+text output. The quality is not the only issue though, the direct output
+in any format is unlikely to be exactly what the user wants, so possibly
+more important than quality is the ability to edit the output.
+
+HTMLFormat has advantages that the other output formats don't, for instance,
+\begin{itemize}
+\item It works with any browser without the need for plugins (as far as I know
+most computers should have the required fonts)
+\item Users can easily annotate and add comments using colour, bold, underline
+and so on.
+\item Annotations can easily be done with whatever html editor or text editor
+you are familiar with.
+\item Edits to the output will cause the width of columns and so on to be
+automatically adjusted, no need to try to insert spaces to get the
+superscripts to line up again!
+\item It is very easy to customise output so, for instance, we can fit a lot of
+information in a compact space on the page.
+\end{itemize}
+
+\section{Using the formatter}
+We can cause the command line interpreter to output in html by typing
+the following:
+
+\begin{verbatim}
+)set output html on
+\end{verbatim}
+
+After this the command line will output html (in addition to other formats
+that are enabled) and this html code can then be copied and pasted into an
+existing HTML document.
+
+If you do not already have an html page to copy the output to then you can
+create one with a text editor and entering the following:
+
+\begin{verbatim}
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" 
+ "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" >
+ <head>
+  <title>Enter Your Title Here</title>
+ </head>
+ <body>
+  Copy and paste the output from command line here.
+ </body>
+</html>
+\end{verbatim}
+
+Or using any program that will export to html such as OpenOffice.org
+writer.
+
+\section{Form of the output}
+\begin{verbatim}
+HTMLFormat does not try to interpret syntax, for instance in an example like:
+(1) -> integral(x^x,x)
+it just takes what OutputForm provides and does not try to replace
+%A with the bound variable x.
+\end{verbatim}
+
+\section{Matrix Formatting}
+A big requirement for me is to fit big matrices on ordinary web pages.
+
+At the moment the default output for a matrix is a grid, however it easy to
+modify this for a single matrix, or a whole page or whole site by using css
+(cascading style sheets). For instance we can get a more conventional looking
+matrix by adding the following style to the top of the page after the <head>
+tag:
+
+\begin{verbatim}
+<style type="text/css">
+#matl {border-left-style:solid}
+#matr {border-right-style:solid}
+#matlt {border-left-style:solid;border-top-style:solid}
+#matrt {border-right-style:solid;border-top-style:solid}
+#matlb {border-left-style:solid;border-bottom-style:solid}
+#matrb {border-right-style:solid;border-bottom-style:solid}
+</style>
+\end{verbatim}
+
+There are many other possibilities, for instance we can generate a matrix
+with bars either side to indicate a determinant. All we have to do is
+change the css for the site, page or individual element.
+
+\section{Programmers Guide}
+This package converts from OutputForm, which is a hierarchical tree structure,
+to html which uses tags arranged in a hierarchical tree structure. So the
+package converts from one tree (graph) structure to another.
+
+This conversion is done in two stages using an intermediate Tree String
+structure. This Tree String structure represents HTML where:
+\begin{itemize}
+\item leafs represents unstructured text
+\item string in leafs contains the text
+\item non-leafs represents xml elements
+\item string in non-leafs represents xml attributes
+\end{itemize}
+
+This is created by traversing OutputForm while building up the Tree String
+structure.
+
+The second stage is to convert the Tree Structure to text. All text output
+is done using:
+\begin{verbatim}
+sayTeX$Lisp
+\end{verbatim}
+I have not produced and output to String as I don't know a way to append
+to a long string efficiently and I don't know how to insert carriage-
+returns into a String.
+
+\subsection{Future Developments}
+There would be some benefits in creating a XMLFormat category which would
+contain common elements for all xml formatted outputs such as HTMLFormat,
+MathMLFormat, SVGFormat and X3DFormat. However programming effort might
+be better spent creating a version of OutputForm which has better syntax
+information.
+
+\begin{chunk}{HTMLFormat.input}
+)set break resume
+)sys rm -f HTMLFormat.output
+)spool HTMLFormat.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 9
+)show HTMLFormat
+--R 
+--R HTMLFormat  is a domain constructor
+--R Abbreviation for HTMLFormat is HTMLFORM 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for HTMLFORM 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?=? : (%,%) -> Boolean                coerce : OutputForm -> String
+--R coerce : % -> OutputForm              coerceL : OutputForm -> String
+--R coerceS : OutputForm -> String        display : String -> Void
+--R exprex : OutputForm -> String         hash : % -> SingleInteger
+--R latex : % -> String                   ?~=? : (%,%) -> Boolean
+--R
+--E 1
+
+--S 2 of 9
+coerce("3+4"::OutputForm)$HTMLFORM
+--R 
+--R"3+4"
+--R
+--R   (1)  " "
+--R                                                                 Type: String
+--E 2
+
+--S 3 of 9
+coerce("sqrt(3+4)"::OutputForm)$HTMLFORM
+--R 
+--R"sqrt(3+4)"
+--R
+--R   (2)  " "
+--R                                                                 Type: String
+--E 3
+
+--S 4 of 9
+coerce(sqrt(3+4)::OutputForm)$HTMLFORM
+--R 
+--R&radic;7
+--R
+--R   (3)  " "
+--R                                                                 Type: String
+--E 4
+
+--S 5 of 9
+coerce(sqrt(3+x)::OutputForm)$HTMLFORM
+--R 
+--R<table border='0' id='root'>
+--R<tr id='root'>
+--R<td id='root'>
+--R&radic;
+--R</td>
+--R<td id='root' style='border-top-style:solid'>
+--Rx+3
+--R</td>
+--R</tr>
+--R</table>
+--R
+--R   (4)  " "
+--R                                                                 Type: String
+--E 5
+
+--S 6 of 9
+coerceS(sqrt(3+x)::OutputForm)$HTMLFORM
+--R 
+--R<table border='0' id='root'>
+--R<tr id='root'>
+--R<td id='root'>
+--R&radic;
+--R</td>
+--R<td id='root' style='border-top-style:solid'>
+--Rx+3
+--R</td>
+--R</tr>
+--R</table>
+--R
+--R   (5)  " "
+--R                                                                 Type: String
+--E 6
+
+--S 7 of 9
+coerceL(sqrt(3+x)::OutputForm)$HTMLFORM
+--R 
+--R<table border='0' id='root'>
+--R<tr id='root'>
+--R<td id='root'>
+--R&radic;
+--R</td>
+--R<td id='root' style='border-top-style:solid'>
+--Rx+3
+--R</td>
+--R</tr>
+--R</table>
+--R
+--R   (6)  " "
+--R                                                                 Type: String
+--E 7
+
+--S 8 of 9
+exprex(sqrt(3+x)::OutputForm)$HTMLFORM
+--R 
+--R
+--R   (7)  "{{ROOT}{{+}{x}{3}}}"
+--R                                                                 Type: String
+--E 8
+
+--S 9 of 9
+display(coerce(sqrt(3+x)::OutputForm)$HTMLFORM)$HTMLFORM
+--R 
+--R<table border='0' id='root'>
+--R<tr id='root'>
+--R<td id='root'>
+--R&radic;
+--R</td>
+--R<td id='root' style='border-top-style:solid'>
+--Rx+3
+--R</td>
+--R</tr>
+--R</table>
+--R 
+--R                                                                   Type: Void
+--E 9
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{HTMLFormat.help}
+====================================================================
+HTMLFormat examples
+====================================================================
+
+HtmlFormat provides a coercion from OutputForm to html.
+
+coerce("3+4"::OutputForm)$HTMLFORM
+  "3+4"
+
+coerce("sqrt(3+4)"::OutputForm)$HTMLFORM
+  "sqrt(3+4)"
+
+coerce(sqrt(3+4)::OutputForm)$HTMLFORM
+  &radic;7
+
+coerce(sqrt(3+x)::OutputForm)$HTMLFORM
+  <table border='0' id='root'>
+  <tr id='root'>
+  <td id='root'>
+  &radic;
+  </td>
+  <td id='root' style='border-top-style:solid'>
+  x+3
+  </td>
+  </tr>
+  </table>
+
+coerceS(sqrt(3+x)::OutputForm)$HTMLFORM
+  <table border='0' id='root'>
+  <tr id='root'>
+  <td id='root'>
+  &radic;
+  </td>
+  <td id='root' style='border-top-style:solid'>
+  x+3
+  </td>
+  </tr>
+  </table>
+
+coerceL(sqrt(3+x)::OutputForm)$HTMLFORM
+  <table border='0' id='root'>
+  <tr id='root'>
+  <td id='root'>
+  &radic;
+  </td>
+  <td id='root' style='border-top-style:solid'>
+  x+3
+  </td>
+  </tr>
+  </table>
+
+exprex(sqrt(3+x)::OutputForm)$HTMLFORM
+  "{{ROOT}{{+}{x}{3}}}"
+
+display(coerce(sqrt(3+x)::OutputForm)$HTMLFORM)$HTMLFORM
+  <table border='0' id='root'>
+  <tr id='root'>
+  <td id='root'>
+  &radic;
+  </td>
+  <td id='root' style='border-top-style:solid'>
+  x+3
+  </td>
+  </tr>
+  </table>
+
+See Also:
+o )show HTMLFormat
+
+\end{chunk}
+
+\pagehead{HTMLFormat}{HTMLFORM}
+\pagepic{ps/v103htmlformat.eps}{HTMLFORM}{1.00}
+{\bf See}\\
+\pagefrom{SetCategory}{SETCAT}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{HTMLFORM}{?=?} &
+\cross{HTMLFORM}{?~=?} &
+\cross{HTMLFORM}{coerce} &
+\cross{HTMLFORM}{coerceL} &
+\cross{HTMLFORM}{coerceS} \\
+\cross{HTMLFORM}{display} &
+\cross{HTMLFORM}{exprex} &
+\cross{HTMLFORM}{hash} &
+\cross{HTMLFORM}{latex} &
+\end{tabular}
+
+\begin{chunk}{domain HTMLFORM HTMLFormat}
+)abbrev domain HTMLFORM HTMLFormat
+++ Author: Martin J Baker, Arthur C. Ralfs, Robert S. Sutor
+++ Date: January 2010
+++ Description:
+++ HtmlFormat provides a coercion from OutputForm to html.
+HTMLFormat(): public == private where
+  E      ==> OutputForm
+  I      ==> Integer
+  L      ==> List
+  S      ==> String
+
+  public == SetCategory with
+    coerce:    E -> S
+      ++ coerce(o) changes o in the standard output format to html format.
+      ++
+      ++X coerce(sqrt(3+x)::OutputForm)$HTMLFORM
+    coerceS:   E -> S
+      ++ coerceS(o) changes o in the standard output format to html
+      ++ format and displays formatted result.
+      ++
+      ++X coerceS(sqrt(3+x)::OutputForm)$HTMLFORM
+    coerceL:   E -> S
+      ++ coerceL(o) changes o in the standard output format to html
+      ++ format and displays result as one long string.
+      ++
+      ++X coerceL(sqrt(3+x)::OutputForm)$HTMLFORM
+    exprex:    E -> S
+      ++ exprex(o) coverts \spadtype{OutputForm} to \spadtype{String}
+      ++
+      ++X exprex(sqrt(3+x)::OutputForm)$HTMLFORM
+    display:   S -> Void
+      ++ display(o) prints the string returned by coerce.
+      ++
+      ++X display(coerce(sqrt(3+x)::OutputForm)$HTMLFORM)$HTMLFORM
+
+  private == add
+    import OutputForm
+    import Character
+    import Integer
+    import List OutputForm
+    import List String
+
+    expr: E
+    prec,opPrec: I
+    str:  S
+    blank         : S := " \  "
+
+    maxPrec       : I   := 1000000
+    minPrec       : I   := 0
+
+    unaryOps      : L S := ["-"]$(L S)
+    unaryPrecs    : L I := [700]$(L I)
+
+    -- the precedence of / in the following is relatively low because
+    -- the bar obviates the need for parentheses.
+    binaryOps     : L S := ["+->","|","^","/","<",">","=","OVER"]$(L S)
+    binaryPrecs   : L I := [0,0,900,700,400,400,400,700]$(L I)
+    naryOps       : L S := ["-","+","*",blank,",",";"," ","ROW","",
+       " \cr ","&","/\","\/"]$(L S)
+    naryPrecs     : L I := [700,700,800,800,110,110,0,0,0,0,0,600,600]$(L I)
+    naryNGOps     : L S := ["ROW","&"]$(L S)
+    plexOps       : L S := ["SIGMA","SIGMA2","PI","PI2","INTSIGN",_
+                            "INDEFINTEGRAL"]$(L S)
+    plexPrecs     : L I := [700,800,700,800,700,700]$(L I)
+    specialOps    : L S := ["MATRIX","BRACKET","BRACE","CONCATB","VCONCAT",_
+                            "AGGLST","CONCAT","OVERBAR","ROOT","SUB","TAG",_
+                            "SUPERSUB","ZAG","AGGSET","SC","PAREN",_
+                            "SEGMENT","QUOTE","theMap", "SLASH"]
+
+    -- the next two lists provide translations for some strings for
+    -- which HTML has some special character codes.
+    specialStrings : L S :=
+      ["cos", "cot", "csc", "log", "sec", "sin", "tan", _
+       "cosh", "coth", "csch", "sech", "sinh", "tanh", _
+       "acos","asin","atan","erf","...","$","infinity","Gamma", _
+       "%pi","%e","%i"]
+    specialStringsInHTML : L S :=
+      ["cos","cot","csc","log","sec","sin","tan", _
+       "cosh","coth","csch","sech","sinh","tanh", _
+       "arccos","arcsin","arctan","erf","&#x2026;","$","&#x221E;",_
+       "&#x0413;","&#x003C0;","&#x02147;","&#x02148;"]
+
+    debug := false
+
+    atomize:E -> L E
+
+    formatBinary:(S,L E, I) -> Tree S
+
+    formatFunction:(Tree S,L E, I) -> Tree S
+
+    formatMatrix:L E -> Tree S
+
+    formatNary:(S,L E, I) -> Tree S
+
+    formatNaryNoGroup:(S,L E, I) -> Tree S
+
+    formatNullary:S -> Tree S
+
+    formatPlex:(S,L E, I) -> Tree S
+
+    formatSpecial:(S,L E, I) -> Tree S
+
+    formatUnary:(S,  E, I) -> Tree S
+
+    formatHtml:(E,I) -> Tree S
+
+    precondition:E -> E
+      -- this function is applied to the OutputForm expression before
+      -- doing anything else.
+
+    outputTree:Tree S -> Void
+      -- This function traverses the tree and linierises it into a string.
+      -- To get the formatting we use a nested set of tables. It also checks
+      -- for +- and removes the +. it may also need to remove the outer
+      -- set of brackets.
+
+    stringify:E -> S
+
+    coerce(expr : E): S ==
+      outputTree formatHtml(precondition expr, minPrec)
+      " "
+
+    coerceS(expr : E): S ==
+      outputTree formatHtml(precondition expr, minPrec)
+      " "
+
+    coerceL(expr : E): S ==
+      outputTree formatHtml(precondition expr, minPrec)
+      " "
+
+    display(html : S): Void ==
+      sayTeX$Lisp html
+      void()$Void
+
+    newNode(tag:S,node: Tree S): (Tree S) ==
+      t := tree(S,[node])
+      setvalue!(t,tag)
+      t
+
+    newNodes(tag:S,nodes: L Tree S): (Tree S) ==
+      t := tree(S,nodes)
+      setvalue!(t,tag)
+      t
+
+    -- returns true if this can be represented without a table
+    notTable?(node: Tree S): Boolean ==
+      empty?(node) => true
+      leaf?(node) => true
+      prefix?("table",value(node))$String => false
+      c := children(node)
+      for a in c repeat
+        if not notTable?(a) then return false
+      true
+
+    -- this retuns a string representation of OutputForm arguments
+    -- it is used when debug is true to trace the calling of functions
+    -- in this package
+    argsToString(args : L E): S ==
+      sop : S := exprex first args
+      args := rest args
+      s : S := concat ["{",sop]
+      for a in args repeat
+          s1 : S := exprex a
+          s := concat [s,s1]
+      s := concat [s,"}"]
+
+    exprex(expr : E): S ==
+      -- This breaks down an expression into atoms and returns it as
+      -- a string.  It's for developmental purposes to help understand
+      -- the expressions.
+      a : E
+      expr := precondition expr
+      (ATOM(expr)$Lisp@Boolean) or (stringify expr = "NOTHING") =>
+        concat ["{",stringify expr,"}"]
+      le : L E := (expr pretend L E)
+      op := first le
+      sop : S := exprex op
+      args : L E := rest le
+      nargs : I := #args
+      s : S := concat ["{",sop]
+      if nargs > 0  then
+        for a in args repeat
+          s1 : S := exprex a
+          s := concat [s,s1]
+      s := concat [s,"}"]
+
+    atomize(expr : E): L E ==
+      -- This breaks down an expression into a flat list of atomic
+      -- expressions.
+      -- expr should be preconditioned.
+      le : L E := nil()
+      a : E
+      letmp : L E
+      (ATOM(expr)$Lisp@Boolean) or (stringify expr = "NOTHING") =>
+        le := append(le,list(expr))
+      letmp := expr pretend L E
+      for a in letmp repeat
+        le := append(le,atomize a)
+      le
+
+    -- output html test using tables and
+    -- remove unnecessary '+' at end of first string
+    -- when second string starts with '-'
+    outputTree(t: Tree S): Void ==
+      endWithPlus:Boolean := false -- if the last string ends with '+'
+      -- and the next string starts with '-' then the '+' needs to be
+      -- removed
+      if empty?(t) then
+        --if debug then sayTeX$Lisp "outputTree empty"
+        return void()$Void
+      if leaf?(t) then
+        --if debug then sayTeX$Lisp concat("outputTree leaf:",value(t))
+        sayTeX$Lisp value(t)
+        return void()$Void
+      tagName := copy value(t)
+      tagPos := position(char(" "),tagName,1)$String
+      if tagPos > 1 then
+        tagName := split(tagName,char(" ")).1
+        --sayTeX$Lisp "outputTree: tagPos="string(tagPos)" "tagName
+      if value(t) ~= "" then sayTeX$Lisp concat ["<",value(t),">"]
+      c := children(t)
+      enableGrid:Boolean := (#c > 1) and not notTable?(t)
+      if enableGrid then
+        if tagName = "table" then enableGrid := false
+        if tagName = "tr" then enableGrid := false
+      b:List Boolean := [leaf?(c1) for c1 in c]
+      -- if all children are strings then no need to wrap in table
+      allString: Boolean := true
+      for c1 in c repeat if not leaf?(c1) then allString := false
+      if allString then
+        s:String := ""
+        for c1 in c repeat s := concat(s,value(c1))
+        sayTeX$Lisp s
+        if value(t) ~= "" then sayTeX$Lisp concat ["</",tagName,">"]
+        return void()$Void
+      if enableGrid then
+        sayTeX$Lisp "<table border='0'>"
+        sayTeX$Lisp "<tr>"
+      for c1 in c repeat
+        if enableGrid then sayTeX$Lisp "<td>"
+        outputTree(c1)
+        if enableGrid then sayTeX$Lisp "</td>"
+      if enableGrid then
+        sayTeX$Lisp "</tr>"
+        sayTeX$Lisp "</table>"
+      if value(t) ~= "" then sayTeX$Lisp concat ["</",tagName,">"]
+      void()$Void
+
+    stringify expr == (mathObject2String$Lisp expr)@S
+
+    precondition expr ==
+      outputTran$Lisp expr
+
+    -- I dont know what SC is so put it in a table for now
+    formatSC(args : L E, prec : I)  : Tree S ==
+      if debug then sayTeX$Lisp "formatSC: "concat [" args=",_
+        argsToString(args)," prec=",string(prec)$S]
+      null args => tree("")
+      cells:L Tree S := [_
+        newNode("td id='sc' style='border-bottom-style:solid'",_
+        formatHtml(a,prec)) for a in args]
+      row:Tree S := newNodes("tr id='sc'",cells)
+      newNode("table border='0' id='sc'",row)
+
+    -- to build an overbar we put it in a single column,
+    -- single row table and set the top border to solid
+    buildOverbar(content : Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildOverbar"
+      cell:Tree S := _
+        newNode("td id='overbar' style='border-top-style:solid'",content)
+      row:Tree S := newNode("tr id='overbar'",cell)
+      newNode("table border='0' id='overbar'",row)
+
+    -- to build an square root we put it in a double column,
+    -- single row table and set the top border of the second column to
+    -- solid
+    buildRoot(content : Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildRoot"
+      if leaf?(content) then
+        -- root of a single term so no need for overbar
+        return newNodes("",[tree("&radic;"),content])
+      cell1:Tree S := newNode("td id='root'",tree("&radic;"))
+      cell2:Tree S := _
+        newNode("td id='root' style='border-top-style:solid'",content)
+      row:Tree S := newNodes("tr id='root'",[cell1,cell2])
+      newNode("table border='0' id='root'",row)
+
+    -- to build an 'n'th root we put it in a double column,
+    -- single row table and set the top border of the second column to
+    -- solid
+    buildNRoot(content : Tree S,nth: Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildNRoot"
+      power:Tree S := newNode("sup",nth)
+      if leaf?(content) then
+        -- root of a single term so no need for overbar
+        return newNodes("",[power,tree("&radic;"),content])
+      cell1:Tree S := newNodes("td id='nroot'",[power,tree("&radic;")])
+      cell2:Tree S := _
+        newNode("td id='nroot' style='border-top-style:solid'",content)
+      row:Tree S := newNodes("tr id='nroot'",[cell1,cell2])
+      newNode("table border='0' id='nroot'",row)
+
+    -- formatSpecial handles "theMap","AGGLST","AGGSET","TAG","SLASH",
+    -- "VCONCAT", "CONCATB","CONCAT","QUOTE","BRACKET","BRACE","PAREN",
+    -- "OVERBAR","ROOT", "SEGMENT","SC","MATRIX","ZAG"
+    -- note "SUB" and "SUPERSUB" are handled directly by formatHtml
+    formatSpecial(op : S, args : L E, prec : I) : Tree S ==
+      if debug then sayTeX$Lisp _
+        "formatSpecial: " concat ["op=",op," args=",argsToString(args),_
+          " prec=",string(prec)$S]
+      arg : E
+      prescript : Boolean := false
+      op = "theMap" => tree("theMap(...)")
+      op = "AGGLST" =>
+        formatNary(",",args,prec)
+      op = "AGGSET" =>
+        formatNary(";",args,prec)
+      op = "TAG" =>
+        newNodes("",[formatHtml(first args,prec),tree("&#x02192;"),_
+          formatHtml(second args,prec)])
+        --RightArrow
+      op = "SLASH" =>
+        newNodes("",[formatHtml(first args, prec),tree("/"),_
+          formatHtml(second args,prec)])
+      op = "VCONCAT" =>
+        newNodes("table",[newNode("td",formatHtml(u, minPrec))_
+           for u in args]::L Tree S)
+      op = "CONCATB" =>
+        formatNary(" ",args,prec)
+      op = "CONCAT" =>
+        formatNary("",args,minPrec)
+      op = "QUOTE" =>
+        newNodes("",[tree("'"),formatHtml(first args, minPrec)])
+      op = "BRACKET" =>
+        newNodes("",[tree("["),formatHtml(first args, minPrec),tree("]")])
+      op = "BRACE" =>
+        newNodes("",[tree("{"),formatHtml(first args, minPrec),tree("}")])
+      op = "PAREN" =>
+        newNodes("",[tree("("),formatHtml(first args, minPrec),tree(")")])
+      op = "OVERBAR" =>
+        null args => tree("")
+        buildOverbar(formatHtml(first args,minPrec))
+      op = "ROOT" and #args < 1 => tree("")
+      op = "ROOT" and #args = 1 => _
+        buildRoot(formatHtml(first args, minPrec))
+      op = "ROOT" and #args > 1 => _
+        buildNRoot(formatHtml(first args, minPrec),_
+          formatHtml(second args, minPrec))
+      op = "SEGMENT" =>
+        -- '..' indicates a range in a list for example
+        tmp : Tree S := newNodes("",[formatHtml(first args, minPrec),_
+          tree("..")])
+        null rest args =>  tmp
+        newNodes("",[tmp,formatHtml(first rest args, minPrec)])
+      op = "SC" => formatSC(args,minPrec)
+      op = "MATRIX" => formatMatrix rest args
+      op = "ZAG" =>
+        -- {{+}{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}}_
+        --      {{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
+        -- to format continued fraction traditionally need to intercept
+        -- it at the formatNary of the "+"
+        newNodes("",[tree(" \zag{"),formatHtml(first args, minPrec),
+          tree("}{"),
+          formatHtml(first rest args,minPrec),tree("}")])
+      tree("formatSpecial not implemented:"op)
+
+    formatSuperSub(expr : E, args : L E, opPrec : I) : Tree S ==
+      -- This one produces ordinary derivatives with differential notation,
+      -- it needs a little more work yet.
+      -- first have to divine the semantics, add cases as needed
+      if debug then sayTeX$Lisp _
+        "formatSuperSub: " concat ["expr=",stringify expr," args=",_
+          argsToString(args)," prec=",string(opPrec)$S]
+      atomE : L E := atomize(expr)
+      op : S := stringify first atomE
+      op ~= "SUPERSUB" => tree("Mistake in formatSuperSub: no SUPERSUB")
+      #args ~= 1 => tree("Mistake in SuperSub: #args <> 1")
+      var : E := first args
+      -- should be looking at something like {{SUPERSUB}{var}{ }{,,...,}}
+      -- for example here's the second derivative of y w.r.t. x
+      -- {{{SUPERSUB}{y}{ }{,,}}{x}}, expr is the first {} and args is the
+      -- {x}
+      funcS : S := stringify first rest atomE
+      bvarS : S := stringify first args
+      -- count the number of commas
+      commaS : S := stringify first rest rest rest atomE
+      commaTest : S := ","
+      ndiffs : I := 0
+      while position(commaTest,commaS,1) > 0 repeat
+        ndiffs := ndiffs+1
+        commaTest := commaTest","
+      res:Tree S := newNodes("",_
+        [tree("&#x02146;"string(ndiffs)""funcS"&#x02146;"),_
+          formatHtml(first args,minPrec),tree(""string(ndiffs)"&#x02061;"),_
+            formatHtml(first args,minPrec),tree(")")])
+      res
+
+    -- build structure such as integral as a table
+    buildPlex3(main:Tree S,supsc:Tree S,op:Tree S,subsc:Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildPlex"
+      ssup:Tree S := newNode("td id='plex'",supsc)
+      sop:Tree S := newNode("td id='plex'",op)
+      ssub:Tree S := newNode("td id='plex'",subsc)
+      m:Tree S := newNode("td rowspan='3' id='plex'",main)
+      rows:(List Tree S) := [newNodes("tr id='plex'",[ssup,m]),_
+        newNode("tr id='plex'",sop),newNode("tr id='plex'",ssub)]
+      newNodes("table border='0' id='plex'",rows)
+
+    -- build structure such as integral as a table
+    buildPlex2(main : Tree S,supsc : Tree S,op : Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildPlex"
+      ssup:Tree S := newNode("td id='plex'",supsc)
+      sop:Tree S := newNode("td id='plex'",op)
+      m:Tree S := newNode("td rowspan='2' id='plex'",main)
+      rows:(List Tree S) := [newNodes("tr id='plex'",[sop,m]),_
+        newNode("tr id='plex'",ssup)]
+      newNodes("table border='0' id='plex'",rows)
+
+    -- format an integral
+    -- args.1 = "NOTHING"
+    -- args.2 = bound variable
+    -- args.3 = body, thing being integrated
+    --
+    -- axiom replaces the bound variable with somthing like
+    -- %A and puts the original variable used
+    -- in the input command as a superscript on the integral sign.
+    formatIntSign(args : L E, opPrec : I) : Tree S ==
+      -- the original OutputForm expression looks something like this:
+      -- {{INTSIGN}{NOTHING or lower limit?}
+      -- {bvar or upper limit?}{{*}{integrand}{{CONCAT}{d}{axiom var}}}}
+      -- the args list passed here consists of the rest of this list, i.e.
+      -- starting at the NOTHING or ...
+      if debug then sayTeX$Lisp "formatIntSign: " concat [" args=",_
+        argsToString(args)," prec=",string(opPrec)$S]
+      (stringify first args) = "NOTHING" =>
+        buildPlex2(formatHtml(args.3,opPrec),tree("&int;"),_
+          formatHtml(args.2,opPrec)) -- could use &#x0222B; or &int;
+      buildPlex3(formatHtml(first args,opPrec),formatHtml(args.3,opPrec),_
+        tree("&int;"),formatHtml(args.2,opPrec))
+
+    -- plex ops are "SIGMA","SIGMA2","PI","PI2","INTSIGN","INDEFINTEGRAL"
+    -- expects 2 or 3 args
+    formatPlex(op : S, args : L E, prec : I) : Tree S ==
+      if debug then sayTeX$Lisp "formatPlex: " concat ["op=",op," args=",_
+        argsToString(args)," prec=",string(prec)$S]
+      checkarg:Boolean := false
+      hold : S
+      p : I := position(op,plexOps)
+      p < 1 => error "unknown plex op"
+      op = "INTSIGN" => formatIntSign(args,minPrec)
+      opPrec := plexPrecs.p
+      n : I := #args
+      (n ~= 2) and (n ~= 3) => error "wrong number of arguments for plex"
+      s : Tree S :=
+        op = "SIGMA"   =>
+          checkarg := true
+          tree("&#x02211;")
+        -- Sum
+        op = "SIGMA2"   =>
+          checkarg := true
+          tree("&#x02211;")
+        -- Sum
+        op = "PI"      =>
+          checkarg := true
+          tree("&#x0220F;")
+        -- Product
+        op = "PI2"     =>
+          checkarg := true
+          tree("&#x0220F;")
+        -- Product
+        op = "INTSIGN" => tree("&#x0222B;")
+        -- Integral, int
+        op = "INDEFINTEGRAL" => tree("&#x0222B;")
+        -- Integral, int
+        tree("formatPlex: unexpected op:"op)
+      -- if opPrec < prec then perhaps we should parenthesize?
+      -- but we need to be careful we don't get loads of unnecessary
+      -- brackets
+      if n=2 then return buildPlex2(formatHtml(first args,minPrec),_
+        formatHtml(args.2,minPrec),s)
+      buildPlex3(formatHtml(first args,minPrec),formatHtml(args.2,minPrec),_
+        s,formatHtml(args.3,minPrec))
+
+    -- an example is: op=ROW arg={{ROW}{1}{2}}
+    formatMatrixRow(op : S, arg : E, prec : I,y:I,h:I)  : L Tree S ==
+      if debug then sayTeX$Lisp "formatMatrixRow: " concat ["op=",op,_
+        " args=",stringify arg," prec=",string(prec)$S]
+      ATOM(arg)$Lisp@Boolean => [_
+        tree("formatMatrixRow does not contain row")]
+      l : L E := (arg pretend L E)
+      op : S := stringify first l
+      args : L E := rest l
+      --sayTeX$Lisp "formatMatrixRow op="op" args="argsToString(args)
+      w:I := #args
+      cells:(List Tree S) := empty()
+      for x in 1..w repeat
+        --sayTeX$Lisp "formatMatrixRow: x="string(x)$S" width="string(w)$S
+        attrib:S := "td id='mat'"
+        if x=1 then attrib := "td id='matl'"
+        if x=w then attrib := "td id='matr'"
+        if y=1 then attrib := "td id='matt'"
+        if y=h then attrib := "td id='matb'"
+        if x=1 and y=1 then attrib := "td id='matlt'"
+        if x=1 and y=h then attrib := "td id='matlb'"
+        if x=w and y=1  then attrib := "td id='matrt'"
+        if x=w and y=h  then attrib := "td id='matrb'"
+        cells := append(cells,[newNode(attrib,formatHtml(args.(x),prec))])
+      cells
+
+    -- an example is: op=MATRIX args={{ROW}{1}{2}}{{ROW}{3}{4}}
+    formatMatrixContent(op : S, args : L E, prec : I)  : L Tree S ==
+      if debug then sayTeX$Lisp "formatMatrixContent: " concat ["op=",op,_
+        " args=",argsToString(args)," prec=",string(prec)$S]
+      y:I := 0
+      rows:(List Tree S) := [newNodes("tr id='mat'",_
+        formatMatrixRow("ROW",e,prec,y:=y+1,#args)) for e in args]
+      rows
+
+    formatMatrix(args : L E) : Tree S ==
+      -- format for args is [[ROW ...],[ROW ...],[ROW ...]]
+      -- generate string for formatting columns (centered)
+      if debug then sayTeX$Lisp "formatMatrix: " concat ["args=",_
+        argsToString(args)]
+      newNodes("table border='1' id='mat'",_
+        formatMatrixContent("MATRIX",args,minPrec))
+
+    -- output arguments in column table
+    buildColumnTable(elements : List Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildColumnTable"
+      cells:(List Tree S) := [newNode("td id='col'",j) for j in elements]
+      rows:(List Tree S) := [newNode("tr id='col'",i) for i in cells]
+      newNodes("table border='0' id='col'",rows)
+
+    -- build superscript structure as either sup tag or
+    -- if it contains anything that won't go into a
+    -- sup tag then build it as a table
+    buildSuperscript(main : Tree S,super : Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildSuperscript"
+      notTable?(super) => newNodes("",[main,newNode("sup",super)])
+      m:Tree S := newNode("td rowspan='2' id='sup'",main)
+      su:Tree S := newNode("td id='sup'",super)
+      e:Tree S := newNode("td id='sup'",tree("&nbsp;"))
+      rows:(List Tree S) := [newNodes("tr id='sup'",[m,su]),_
+        newNode("tr id='sup'",e)]
+      newNodes("table border='0' id='sup'",rows)
+
+    -- build subscript structure as either sub tag or
+    -- if it contains anything that won't go into a
+    -- sub tag then build it as a table
+    buildSubscript(main : Tree S,subsc : Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildSubscript"
+      notTable?(subsc) => newNodes("",[main,newNode("sub",subsc)])
+      m:Tree S := newNode("td rowspan='2' id='sub'",main)
+      su:Tree S := newNode("td id='sub'",subsc)
+      e:Tree S := newNode("td id='sub'",tree("&nbsp;"))
+      rows:(List Tree S) := [newNodes("tr id='sub'",[m,e]),_
+        newNode("tr id='sub'",su)]
+      newNodes("table border='0' id='sub'",rows)
+
+    formatSub(expr : E, args : L E, opPrec : I) : Tree S ==
+      -- format subscript
+      -- this function expects expr to start with SUB
+      -- it expects first args to be the operator or value that
+      -- the subscript is applied to
+      -- and the rest args to be the subscript
+      if debug then sayTeX$Lisp "formatSub: " concat ["expr=",_
+        stringify expr," args=",argsToString(args)," prec=",_
+          string(opPrec)$S]
+      atomE : L E := atomize(expr)
+      if empty?(atomE) then
+        if debug then sayTeX$Lisp "formatSub: expr=empty"
+        return tree("formatSub: expr=empty")
+      op : S := stringify first atomE
+      op ~= "SUB" =>
+        if debug then sayTeX$Lisp "formatSub: expr~=SUB"
+        tree("formatSub: expr~=SUB")
+      -- assume args.1 is the expression and args.2 is its subscript
+      if #args < 2 then
+        if debug then sayTeX$Lisp concat("formatSub: num args=",_
+          string(#args)$String)$String
+        return tree(concat("formatSub: num args=",_
+          string(#args)$String)$String)
+      if #args > 2 then
+        if debug then sayTeX$Lisp concat("formatSub: num args=",_
+          string(#args)$String)$String
+        return buildSubscript(formatHtml(first args,opPrec),_
+          newNodes("",[formatHtml(e,opPrec) for e in rest args]))
+      buildSubscript(formatHtml(first args,opPrec),_
+        formatHtml(args.2,opPrec))
+
+    formatFunction(op : Tree S, args : L E, prec : I) : Tree S ==
+      if debug then sayTeX$Lisp "formatFunction: " concat ["args=",_
+        argsToString(args)," prec=",string(prec)$S]
+      newNodes("",[op,tree("("),formatNary(",",args,minPrec),tree(")")])
+
+    formatNullary(op : S) : Tree S ==
+      if debug then sayTeX$Lisp "formatNullary: " concat ["op=",op]
+      op = "NOTHING" => empty()$Tree(S)
+      tree(op"()")
+
+    -- implement operation with single argument
+    -- an example is minus '-'
+    -- prec is precidence of operator, used to force brackets where
+    -- more tightly bound operation is next to less tightly bound operation
+    formatUnary(op : S, arg : E, prec : I) : Tree S ==
+      if debug then sayTeX$Lisp "formatUnary: " concat ["op=",op," arg=",_
+        stringify arg," prec=",string(prec)$S]
+      p : I := position(op,unaryOps)
+      p < 1 => error "unknown unary op"
+      opPrec := unaryPrecs.p
+      s : Tree S := newNodes("",[tree(op),formatHtml(arg,opPrec)])
+      opPrec < prec => newNodes("",[tree("("),s,tree(")")])
+      s
+
+    -- output division with numerator above the denominator
+    -- implemented as a table
+    buildOver(top : Tree S,bottom : Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildOver"
+      topCell:Tree S := newNode("td",top)
+      bottomCell:Tree S := newNode("td style='border-top-style:solid'",_
+        bottom)
+      rows:(List Tree S) := [newNode("tr id='col'",topCell),_
+        newNode("tr id='col'",bottomCell)]
+      newNodes("table border='0' id='col'",rows)
+
+    -- op may be: "|","^","/","OVER","+->"
+    -- note: "+" and "*" are n-ary ops
+    formatBinary(op : S, args : L E, prec : I) : Tree S ==
+      if debug then sayTeX$Lisp "formatBinary: " concat ["op=",op,_
+        " args=",argsToString(args)," prec=",string(prec)$S]
+      p : I := position(op,binaryOps)
+      p < 1 => error "unknown binary op"
+      opPrec := binaryPrecs.p
+      -- if base op is product or sum need to add parentheses
+      if ATOM(first args)$Lisp@Boolean then
+        opa:S := stringify first args
+      else
+        la : L E := (first args pretend L E)
+        opa : S := stringify first la
+      if (opa = "SIGMA" or opa = "SIGMA2" or opa = "PI" or opa = "PI2")_
+        and op = "^" then
+          s1 : Tree S := newNodes("",[tree("("),formatHtml(first args,_
+            opPrec),tree(")")])
+      else
+        s1 : Tree S := formatHtml(first args, opPrec)
+      s2 : Tree S := formatHtml(first rest args, opPrec)
+      op = "|" => newNodes("",[s1,tree(op),s2])
+      op = "^" => buildSuperscript(s1,s2)
+      op = "/" => newNodes("",[s1,tree(op),s2])
+      op = "OVER" => buildOver(s1,s2)
+      op = "+->" => newNodes("",[s1,tree("|&mdash;&rsaquo;"),s2])
+      newNodes("",[s1,tree(op),s2])
+
+    -- build a zag from a table with a right part and a
+    -- upper and lower left part
+    buildZag(top:Tree S,lowerLeft:Tree S,lowerRight:Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildZag"
+      cellTop:Tree S := _
+        newNode("td colspan='2' id='zag' style='border-bottom-style:solid'",_
+         top)
+      cellLowerLeft:Tree S := newNodes("td id='zag'",[lowerLeft,tree("+")])
+      cellLowerRight:Tree S := newNode("td id='zag'",lowerRight)
+      row1:Tree S := newNodes("tr id='zag'",[cellTop])
+      row2:Tree S := newNodes("tr id='zag'",[cellLowerLeft,cellLowerRight])
+      newNodes("table border='0' id='zag'",[row1,row2])
+
+    formatZag(args : L E,nestLevel:I)  : Tree S ==
+      -- args will be a list of things like this {{ZAG}{1}{7}}, the ZAG
+      -- must be there, the '1' and '7' could conceivably be more complex
+      -- expressions
+      --
+      -- ex 1. continuedFraction(314159/100000)
+      -- {{+}{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}}
+      -- {{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
+      -- this is the preconditioned output form
+      -- including "op", the args list would be the rest of this
+      -- i.e op = '+' and args = {{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}
+      -- {{ZAG}{1}{1}}{{ZAG}{1}{25}}{{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
+      --
+      -- ex 2. continuedFraction(14159/100000)
+      -- this one doesn't have the leading integer
+      -- {{+}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}}
+      -- {{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
+      --
+      -- ex 3. continuedFraction(3,repeating [1], repeating [3,6])
+      -- {{+}{3}{{ZAG}{1}{3}}{{ZAG}{1}{6}}{{ZAG}{1}{3}}{{ZAG}{1}{6}}
+      -- {{ZAG}{1}{3}}{{ZAG}{1}{6}}{{ZAG}{1}{3}}{{ZAG}{1}{6}}
+      -- {{ZAG}{1}{3}}{{ZAG}{1}{6}}{...}}
+      --
+      -- In each of these examples the args list consists of the terms
+      -- following the '+' op
+      -- so the first arg could be a "ZAG" or something
+      -- else, but the second arg looks like it has to be "ZAG", so maybe
+      -- test for #args > 1 and args.2 contains "ZAG".
+      -- Note that since the resulting tables are nested we need
+      -- to handle the whole continued fraction at once, i.e. we can't
+      -- just look for, e.g., {{ZAG}{1}{6}}
+      --
+      -- we will assume that the font starts at 16px and reduce it by 4
+      -- <span style='font-size:16px'>outer zag</span>
+      -- <span style='font-size:14px'>next zag</span>
+      -- <span style='font-size:12px'>next zag</span>
+      -- <span style='font-size:10px'>next zag</span>
+      -- <span style='font-size:9px'>lowest zag</span>
+      if debug then sayTeX$Lisp "formatZag: " concat ["args=",_
+        argsToString(args)]
+      tmpZag : L E := first args pretend L E
+      fontAttrib : S :=
+        nestLevel < 2 => "span style='font-size:16px'"
+        nestLevel = 2 => "span style='font-size:14px'"
+        nestLevel = 3 => "span style='font-size:12px'"
+        nestLevel = 4 => "span style='font-size:10px'"
+        "span style='font-size:9px'"
+      -- may want to test that tmpZag contains 'ZAG'
+      #args > 1 =>
+        newNode(fontAttrib,buildZag(formatHtml(first rest tmpZag,minPrec),_
+          formatHtml(first rest rest tmpZag,minPrec),_
+            formatZag(rest args,nestLevel+1)))
+      (first args = "...":: E)@Boolean => tree("&#x2026;")
+      op:S := stringify first args
+      position("ZAG",op,1) > 0 =>
+        newNode(fontAttrib,buildOver(formatHtml(first rest tmpZag,minPrec),_
+          formatHtml(first rest rest tmpZag,minPrec)))
+      tree("formatZag: Last argument in ZAG construct unknown operator: "op)
+
+    -- returns true if this term starts with a minus '-' sign
+    -- this is used so that we can suppress any plus '+' in front
+    -- of the - so we dont get terms like +-
+    neg?(arg : E) : Boolean ==
+      if debug then sayTeX$Lisp "neg?: " concat ["arg=",argsToString([arg])]
+      ATOM(arg)$Lisp@Boolean => false
+      l : L E := (arg pretend L E)
+      op : S := stringify first l
+      op = "-" => true
+      false
+
+    formatNary(op : S, args : L E, prec : I) : Tree S ==
+      if debug then sayTeX$Lisp "formatNary: " concat ["op=",op," args=",_
+        argsToString(args)," prec=",string(prec)$S]
+      formatNaryNoGroup(op, args, prec)
+
+    -- possible op values are:
+    -- ",",";","*"," ","ROW","+","-"
+    -- an example is content of matrix which gives:
+    -- {{ROW}{1}{2}}{{ROW}{3}{4}}
+    -- or AGGLST which gives op=, args={{1}{2}}
+    --
+    -- need to:
+    -- format ZAG
+    -- check for +-
+    -- add brackets for sigma or pi or root ("SIGMA","SIGMA2","PI","PI2")
+    formatNaryNoGroup(op : S, args : L E, prec : I)  : Tree S ==
+      if debug then sayTeX$Lisp "formatNaryNoGroup: " concat ["op=",op,_
+        " args=",argsToString(args)," prec=",string(prec)$S]
+      checkargs:Boolean := false
+      null args => empty()$Tree(S)
+      p : I := position(op,naryOps)
+      p < 1 => error "unknown nary op"
+      -- need to test for "ZAG" case and divert it here
+      (#args > 1) and (position("ZAG",stringify first rest args,1) > 0) =>
+           tmpS : S := stringify first args
+           position("ZAG",tmpS,1) > 0 => formatZag(args,1)
+           newNodes("",[formatHtml(first args,minPrec),tree("+"),_
+            formatZag(rest args,1)])
+      -- At least for the ops "*","+","-" we need to test to see if a
+      -- sigma or pi is one of their arguments because we might need
+      -- parentheses as indicated
+      -- by the problem with summation(operator(f)(i),i=1..n)+1 versus
+      -- summation(operator(f)(i)+1,i=1..n) having identical displays as of
+      -- 2007-12-21
+      l := empty()$Tree(S)
+      opPrec := naryPrecs.p
+      -- if checkargs is true check each arg except last one to see if it's
+      -- a sigma or pi and if so add parentheses. Other op's may have to be
+      -- checked for in future
+      count:I := 1
+      tags : (L Tree S)
+      if opPrec < prec then tags := [tree("("),formatHtml(args.1,opPrec)]
+      if opPrec >= prec then tags := [formatHtml(args.1,opPrec)]
+      for a in rest args repeat
+        if op ~= "+" or not neg?(a) then tags := append(tags,[tree(op)])
+        tags := append(tags,[formatHtml(a,opPrec)])
+      if opPrec < prec then tags := append(tags,[tree(")")])
+      newNodes("",tags)
+
+    -- expr is a tree structure
+    -- prec is the precision of integers
+    -- formatHtml returns a string for this node in the tree structure
+    -- and calls recursivly to evaluate sub expressions
+    formatHtml(arg : E,prec : I) : Tree S ==
+      if debug then sayTeX$Lisp "formatHtml: " concat ["arg=",_
+        argsToString([arg])," prec=",string(prec)$S]
+      i,len : Integer
+      intSplitLen : Integer := 20
+      ATOM(arg)$Lisp@Boolean =>
+        if debug then sayTeX$Lisp "formatHtml atom: " concat ["expr=",_
+          stringify arg," prec=",string(prec)$S]
+        str := stringify arg
+        (i := position(str,specialStrings)) > 0 =>
+          tree(specialStringsInHTML.i)
+        tree(str)
+      l : L E := (arg pretend L E)
+      null l => tree(blank)
+      op : S := stringify first l
+      args : L E := rest l
+      nargs : I := #args
+      -- need to test here in case first l is SUPERSUB case and then
+      -- pass first l and args to formatSuperSub.
+      position("SUPERSUB",op,1) > 0 =>
+        formatSuperSub(first l,args,minPrec)
+      -- now test for SUB
+      position("SUB",op,1) > 0 =>
+        formatSub(first l,args,minPrec)
+      -- special cases
+      -- specialOps are:
+      -- MATRIX, BRACKET, BRACE, CONCATB, VCONCAT
+      -- AGGLST, CONCAT, OVERBAR, ROOT, SUB, TAG
+      -- SUPERSUB, ZAG, AGGSET, SC, PAREN
+      -- SEGMENT, QUOTE, theMap, SLASH
+      member?(op, specialOps) => formatSpecial(op,args,prec)
+      -- specialOps are:
+      -- SIGMA, SIGMA2, PI, PI2, INTSIGN, INDEFINTEGRAL
+      member?(op, plexOps)    => formatPlex(op,args,prec)
+      -- nullary case: function with no aguments
+      0 = nargs => formatNullary op
+      -- unary case: function with one agument such as '-'
+      (1 = nargs) and member?(op, unaryOps) =>
+        formatUnary(op, first args, prec)
+      -- binary case
+      -- binary ops include special processing for | ^ / OVER and +->
+      (2 = nargs) and member?(op, binaryOps) =>
+        formatBinary(op, args, prec)
+      -- nary case: including '+' and '*'
+      member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec)
+      member?(op,naryOps) => formatNary(op,args, prec)
+
+      op1 := formatHtml(first l,minPrec)
+      formatFunction(op1,args,prec)
+
+\end{chunk}
+
+\begin{chunk}{COQ HTMLFORM}
+(* domain HTMLFORM *)
+(*
+    import OutputForm
+    import Character
+    import Integer
+    import List OutputForm
+    import List String
+
+    expr: E
+    prec,opPrec: I
+    str:  S
+    blank         : S := " \  "
+
+    maxPrec       : I   := 1000000
+    minPrec       : I   := 0
+
+    unaryOps      : L S := ["-"]$(L S)
+    unaryPrecs    : L I := [700]$(L I)
+
+    -- the precedence of / in the following is relatively low because
+    -- the bar obviates the need for parentheses.
+    binaryOps     : L S := ["+->","|","^","/","<",">","=","OVER"]$(L S)
+    binaryPrecs   : L I := [0,0,900,700,400,400,400,700]$(L I)
+    naryOps       : L S := ["-","+","*",blank,",",";"," ","ROW","",
+       " \cr ","&","/\","\/"]$(L S)
+    naryPrecs     : L I := [700,700,800,800,110,110,0,0,0,0,0,600,600]$(L I)
+    naryNGOps     : L S := ["ROW","&"]$(L S)
+    plexOps       : L S := ["SIGMA","SIGMA2","PI","PI2","INTSIGN",_
+                            "INDEFINTEGRAL"]$(L S)
+    plexPrecs     : L I := [700,800,700,800,700,700]$(L I)
+    specialOps    : L S := ["MATRIX","BRACKET","BRACE","CONCATB","VCONCAT",_
+                            "AGGLST","CONCAT","OVERBAR","ROOT","SUB","TAG",_
+                            "SUPERSUB","ZAG","AGGSET","SC","PAREN",_
+                            "SEGMENT","QUOTE","theMap", "SLASH"]
+
+    -- the next two lists provide translations for some strings for
+    -- which HTML has some special character codes.
+    specialStrings : L S :=
+      ["cos", "cot", "csc", "log", "sec", "sin", "tan", _
+       "cosh", "coth", "csch", "sech", "sinh", "tanh", _
+       "acos","asin","atan","erf","...","$","infinity","Gamma", _
+       "%pi","%e","%i"]
+    specialStringsInHTML : L S :=
+      ["cos","cot","csc","log","sec","sin","tan", _
+       "cosh","coth","csch","sech","sinh","tanh", _
+       "arccos","arcsin","arctan","erf","&#x2026;","$","&#x221E;",_
+       "&#x0413;","&#x003C0;","&#x02147;","&#x02148;"]
+
+    debug := false
+
+    atomize:E -> L E
+
+    formatBinary:(S,L E, I) -> Tree S
+
+    formatFunction:(Tree S,L E, I) -> Tree S
+
+    formatMatrix:L E -> Tree S
+
+    formatNary:(S,L E, I) -> Tree S
+
+    formatNaryNoGroup:(S,L E, I) -> Tree S
+
+    formatNullary:S -> Tree S
+
+    formatPlex:(S,L E, I) -> Tree S
+
+    formatSpecial:(S,L E, I) -> Tree S
+
+    formatUnary:(S,  E, I) -> Tree S
+
+    formatHtml:(E,I) -> Tree S
+
+    precondition:E -> E
+      -- this function is applied to the OutputForm expression before
+      -- doing anything else.
+
+    outputTree:Tree S -> Void
+      -- This function traverses the tree and linierises it into a string.
+      -- To get the formatting we use a nested set of tables. It also checks
+      -- for +- and removes the +. it may also need to remove the outer
+      -- set of brackets.
+
+    stringify:E -> S
+
+    coerce(expr : E): S ==
+      outputTree formatHtml(precondition expr, minPrec)
+      " "
+
+    coerceS(expr : E): S ==
+      outputTree formatHtml(precondition expr, minPrec)
+      " "
+
+    coerceL(expr : E): S ==
+      outputTree formatHtml(precondition expr, minPrec)
+      " "
+
+    display(html : S): Void ==
+      sayTeX$Lisp html
+      void()$Void
+
+    newNode(tag:S,node: Tree S): (Tree S) ==
+      t := tree(S,[node])
+      setvalue!(t,tag)
+      t
+
+    newNodes(tag:S,nodes: L Tree S): (Tree S) ==
+      t := tree(S,nodes)
+      setvalue!(t,tag)
+      t
+
+    -- returns true if this can be represented without a table
+    notTable?(node: Tree S): Boolean ==
+      empty?(node) => true
+      leaf?(node) => true
+      prefix?("table",value(node))$String => false
+      c := children(node)
+      for a in c repeat
+        if not notTable?(a) then return false
+      true
+
+    -- this retuns a string representation of OutputForm arguments
+    -- it is used when debug is true to trace the calling of functions
+    -- in this package
+    argsToString(args : L E): S ==
+      sop : S := exprex first args
+      args := rest args
+      s : S := concat ["{",sop]
+      for a in args repeat
+          s1 : S := exprex a
+          s := concat [s,s1]
+      s := concat [s,"}"]
+
+    exprex(expr : E): S ==
+      -- This breaks down an expression into atoms and returns it as
+      -- a string.  It's for developmental purposes to help understand
+      -- the expressions.
+      a : E
+      expr := precondition expr
+      (ATOM(expr)$Lisp@Boolean) or (stringify expr = "NOTHING") =>
+        concat ["{",stringify expr,"}"]
+      le : L E := (expr pretend L E)
+      op := first le
+      sop : S := exprex op
+      args : L E := rest le
+      nargs : I := #args
+      s : S := concat ["{",sop]
+      if nargs > 0  then
+        for a in args repeat
+          s1 : S := exprex a
+          s := concat [s,s1]
+      s := concat [s,"}"]
+
+    atomize(expr : E): L E ==
+      -- This breaks down an expression into a flat list of atomic
+      -- expressions.
+      -- expr should be preconditioned.
+      le : L E := nil()
+      a : E
+      letmp : L E
+      (ATOM(expr)$Lisp@Boolean) or (stringify expr = "NOTHING") =>
+        le := append(le,list(expr))
+      letmp := expr pretend L E
+      for a in letmp repeat
+        le := append(le,atomize a)
+      le
+
+    -- output html test using tables and
+    -- remove unnecessary '+' at end of first string
+    -- when second string starts with '-'
+    outputTree(t: Tree S): Void ==
+      endWithPlus:Boolean := false -- if the last string ends with '+'
+      -- and the next string starts with '-' then the '+' needs to be
+      -- removed
+      if empty?(t) then
+        --if debug then sayTeX$Lisp "outputTree empty"
+        return void()$Void
+      if leaf?(t) then
+        --if debug then sayTeX$Lisp concat("outputTree leaf:",value(t))
+        sayTeX$Lisp value(t)
+        return void()$Void
+      tagName := copy value(t)
+      tagPos := position(char(" "),tagName,1)$String
+      if tagPos > 1 then
+        tagName := split(tagName,char(" ")).1
+        --sayTeX$Lisp "outputTree: tagPos="string(tagPos)" "tagName
+      if value(t) ~= "" then sayTeX$Lisp concat ["<",value(t),">"]
+      c := children(t)
+      enableGrid:Boolean := (#c > 1) and not notTable?(t)
+      if enableGrid then
+        if tagName = "table" then enableGrid := false
+        if tagName = "tr" then enableGrid := false
+      b:List Boolean := [leaf?(c1) for c1 in c]
+      -- if all children are strings then no need to wrap in table
+      allString: Boolean := true
+      for c1 in c repeat if not leaf?(c1) then allString := false
+      if allString then
+        s:String := ""
+        for c1 in c repeat s := concat(s,value(c1))
+        sayTeX$Lisp s
+        if value(t) ~= "" then sayTeX$Lisp concat ["</",tagName,">"]
+        return void()$Void
+      if enableGrid then
+        sayTeX$Lisp "<table border='0'>"
+        sayTeX$Lisp "<tr>"
+      for c1 in c repeat
+        if enableGrid then sayTeX$Lisp "<td>"
+        outputTree(c1)
+        if enableGrid then sayTeX$Lisp "</td>"
+      if enableGrid then
+        sayTeX$Lisp "</tr>"
+        sayTeX$Lisp "</table>"
+      if value(t) ~= "" then sayTeX$Lisp concat ["</",tagName,">"]
+      void()$Void
+
+    stringify expr == (mathObject2String$Lisp expr)@S
+
+    precondition expr ==
+      outputTran$Lisp expr
+
+    -- I dont know what SC is so put it in a table for now
+    formatSC(args : L E, prec : I)  : Tree S ==
+      if debug then sayTeX$Lisp "formatSC: "concat [" args=",_
+        argsToString(args)," prec=",string(prec)$S]
+      null args => tree("")
+      cells:L Tree S := [_
+        newNode("td id='sc' style='border-bottom-style:solid'",_
+        formatHtml(a,prec)) for a in args]
+      row:Tree S := newNodes("tr id='sc'",cells)
+      newNode("table border='0' id='sc'",row)
+
+    -- to build an overbar we put it in a single column,
+    -- single row table and set the top border to solid
+    buildOverbar(content : Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildOverbar"
+      cell:Tree S := _
+        newNode("td id='overbar' style='border-top-style:solid'",content)
+      row:Tree S := newNode("tr id='overbar'",cell)
+      newNode("table border='0' id='overbar'",row)
+
+    -- to build an square root we put it in a double column,
+    -- single row table and set the top border of the second column to
+    -- solid
+    buildRoot(content : Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildRoot"
+      if leaf?(content) then
+        -- root of a single term so no need for overbar
+        return newNodes("",[tree("&radic;"),content])
+      cell1:Tree S := newNode("td id='root'",tree("&radic;"))
+      cell2:Tree S := _
+        newNode("td id='root' style='border-top-style:solid'",content)
+      row:Tree S := newNodes("tr id='root'",[cell1,cell2])
+      newNode("table border='0' id='root'",row)
+
+    -- to build an 'n'th root we put it in a double column,
+    -- single row table and set the top border of the second column to
+    -- solid
+    buildNRoot(content : Tree S,nth: Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildNRoot"
+      power:Tree S := newNode("sup",nth)
+      if leaf?(content) then
+        -- root of a single term so no need for overbar
+        return newNodes("",[power,tree("&radic;"),content])
+      cell1:Tree S := newNodes("td id='nroot'",[power,tree("&radic;")])
+      cell2:Tree S := _
+        newNode("td id='nroot' style='border-top-style:solid'",content)
+      row:Tree S := newNodes("tr id='nroot'",[cell1,cell2])
+      newNode("table border='0' id='nroot'",row)
+
+    -- formatSpecial handles "theMap","AGGLST","AGGSET","TAG","SLASH",
+    -- "VCONCAT", "CONCATB","CONCAT","QUOTE","BRACKET","BRACE","PAREN",
+    -- "OVERBAR","ROOT", "SEGMENT","SC","MATRIX","ZAG"
+    -- note "SUB" and "SUPERSUB" are handled directly by formatHtml
+    formatSpecial(op : S, args : L E, prec : I) : Tree S ==
+      if debug then sayTeX$Lisp _
+        "formatSpecial: " concat ["op=",op," args=",argsToString(args),_
+          " prec=",string(prec)$S]
+      arg : E
+      prescript : Boolean := false
+      op = "theMap" => tree("theMap(...)")
+      op = "AGGLST" =>
+        formatNary(",",args,prec)
+      op = "AGGSET" =>
+        formatNary(";",args,prec)
+      op = "TAG" =>
+        newNodes("",[formatHtml(first args,prec),tree("&#x02192;"),_
+          formatHtml(second args,prec)])
+        --RightArrow
+      op = "SLASH" =>
+        newNodes("",[formatHtml(first args, prec),tree("/"),_
+          formatHtml(second args,prec)])
+      op = "VCONCAT" =>
+        newNodes("table",[newNode("td",formatHtml(u, minPrec))_
+           for u in args]::L Tree S)
+      op = "CONCATB" =>
+        formatNary(" ",args,prec)
+      op = "CONCAT" =>
+        formatNary("",args,minPrec)
+      op = "QUOTE" =>
+        newNodes("",[tree("'"),formatHtml(first args, minPrec)])
+      op = "BRACKET" =>
+        newNodes("",[tree("["),formatHtml(first args, minPrec),tree("]")])
+      op = "BRACE" =>
+        newNodes("",[tree("{"),formatHtml(first args, minPrec),tree("}")])
+      op = "PAREN" =>
+        newNodes("",[tree("("),formatHtml(first args, minPrec),tree(")")])
+      op = "OVERBAR" =>
+        null args => tree("")
+        buildOverbar(formatHtml(first args,minPrec))
+      op = "ROOT" and #args < 1 => tree("")
+      op = "ROOT" and #args = 1 => _
+        buildRoot(formatHtml(first args, minPrec))
+      op = "ROOT" and #args > 1 => _
+        buildNRoot(formatHtml(first args, minPrec),_
+          formatHtml(second args, minPrec))
+      op = "SEGMENT" =>
+        -- '..' indicates a range in a list for example
+        tmp : Tree S := newNodes("",[formatHtml(first args, minPrec),_
+          tree("..")])
+        null rest args =>  tmp
+        newNodes("",[tmp,formatHtml(first rest args, minPrec)])
+      op = "SC" => formatSC(args,minPrec)
+      op = "MATRIX" => formatMatrix rest args
+      op = "ZAG" =>
+        -- {{+}{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}}_
+        --      {{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
+        -- to format continued fraction traditionally need to intercept
+        -- it at the formatNary of the "+"
+        newNodes("",[tree(" \zag{"),formatHtml(first args, minPrec),
+          tree("}{"),
+          formatHtml(first rest args,minPrec),tree("}")])
+      tree("formatSpecial not implemented:"op)
+
+    formatSuperSub(expr : E, args : L E, opPrec : I) : Tree S ==
+      -- This one produces ordinary derivatives with differential notation,
+      -- it needs a little more work yet.
+      -- first have to divine the semantics, add cases as needed
+      if debug then sayTeX$Lisp _
+        "formatSuperSub: " concat ["expr=",stringify expr," args=",_
+          argsToString(args)," prec=",string(opPrec)$S]
+      atomE : L E := atomize(expr)
+      op : S := stringify first atomE
+      op ~= "SUPERSUB" => tree("Mistake in formatSuperSub: no SUPERSUB")
+      #args ~= 1 => tree("Mistake in SuperSub: #args <> 1")
+      var : E := first args
+      -- should be looking at something like {{SUPERSUB}{var}{ }{,,...,}}
+      -- for example here's the second derivative of y w.r.t. x
+      -- {{{SUPERSUB}{y}{ }{,,}}{x}}, expr is the first {} and args is the
+      -- {x}
+      funcS : S := stringify first rest atomE
+      bvarS : S := stringify first args
+      -- count the number of commas
+      commaS : S := stringify first rest rest rest atomE
+      commaTest : S := ","
+      ndiffs : I := 0
+      while position(commaTest,commaS,1) > 0 repeat
+        ndiffs := ndiffs+1
+        commaTest := commaTest","
+      res:Tree S := newNodes("",_
+        [tree("&#x02146;"string(ndiffs)""funcS"&#x02146;"),_
+          formatHtml(first args,minPrec),tree(""string(ndiffs)"&#x02061;"),_
+            formatHtml(first args,minPrec),tree(")")])
+      res
+
+    -- build structure such as integral as a table
+    buildPlex3(main:Tree S,supsc:Tree S,op:Tree S,subsc:Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildPlex"
+      ssup:Tree S := newNode("td id='plex'",supsc)
+      sop:Tree S := newNode("td id='plex'",op)
+      ssub:Tree S := newNode("td id='plex'",subsc)
+      m:Tree S := newNode("td rowspan='3' id='plex'",main)
+      rows:(List Tree S) := [newNodes("tr id='plex'",[ssup,m]),_
+        newNode("tr id='plex'",sop),newNode("tr id='plex'",ssub)]
+      newNodes("table border='0' id='plex'",rows)
+
+    -- build structure such as integral as a table
+    buildPlex2(main : Tree S,supsc : Tree S,op : Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildPlex"
+      ssup:Tree S := newNode("td id='plex'",supsc)
+      sop:Tree S := newNode("td id='plex'",op)
+      m:Tree S := newNode("td rowspan='2' id='plex'",main)
+      rows:(List Tree S) := [newNodes("tr id='plex'",[sop,m]),_
+        newNode("tr id='plex'",ssup)]
+      newNodes("table border='0' id='plex'",rows)
+
+    -- format an integral
+    -- args.1 = "NOTHING"
+    -- args.2 = bound variable
+    -- args.3 = body, thing being integrated
+    --
+    -- axiom replaces the bound variable with somthing like
+    -- %A and puts the original variable used
+    -- in the input command as a superscript on the integral sign.
+    formatIntSign(args : L E, opPrec : I) : Tree S ==
+      -- the original OutputForm expression looks something like this:
+      -- {{INTSIGN}{NOTHING or lower limit?}
+      -- {bvar or upper limit?}{{*}{integrand}{{CONCAT}{d}{axiom var}}}}
+      -- the args list passed here consists of the rest of this list, i.e.
+      -- starting at the NOTHING or ...
+      if debug then sayTeX$Lisp "formatIntSign: " concat [" args=",_
+        argsToString(args)," prec=",string(opPrec)$S]
+      (stringify first args) = "NOTHING" =>
+        buildPlex2(formatHtml(args.3,opPrec),tree("&int;"),_
+          formatHtml(args.2,opPrec)) -- could use &#x0222B; or &int;
+      buildPlex3(formatHtml(first args,opPrec),formatHtml(args.3,opPrec),_
+        tree("&int;"),formatHtml(args.2,opPrec))
+
+    -- plex ops are "SIGMA","SIGMA2","PI","PI2","INTSIGN","INDEFINTEGRAL"
+    -- expects 2 or 3 args
+    formatPlex(op : S, args : L E, prec : I) : Tree S ==
+      if debug then sayTeX$Lisp "formatPlex: " concat ["op=",op," args=",_
+        argsToString(args)," prec=",string(prec)$S]
+      checkarg:Boolean := false
+      hold : S
+      p : I := position(op,plexOps)
+      p < 1 => error "unknown plex op"
+      op = "INTSIGN" => formatIntSign(args,minPrec)
+      opPrec := plexPrecs.p
+      n : I := #args
+      (n ~= 2) and (n ~= 3) => error "wrong number of arguments for plex"
+      s : Tree S :=
+        op = "SIGMA"   =>
+          checkarg := true
+          tree("&#x02211;")
+        -- Sum
+        op = "SIGMA2"   =>
+          checkarg := true
+          tree("&#x02211;")
+        -- Sum
+        op = "PI"      =>
+          checkarg := true
+          tree("&#x0220F;")
+        -- Product
+        op = "PI2"     =>
+          checkarg := true
+          tree("&#x0220F;")
+        -- Product
+        op = "INTSIGN" => tree("&#x0222B;")
+        -- Integral, int
+        op = "INDEFINTEGRAL" => tree("&#x0222B;")
+        -- Integral, int
+        tree("formatPlex: unexpected op:"op)
+      -- if opPrec < prec then perhaps we should parenthesize?
+      -- but we need to be careful we don't get loads of unnecessary
+      -- brackets
+      if n=2 then return buildPlex2(formatHtml(first args,minPrec),_
+        formatHtml(args.2,minPrec),s)
+      buildPlex3(formatHtml(first args,minPrec),formatHtml(args.2,minPrec),_
+        s,formatHtml(args.3,minPrec))
+
+    -- an example is: op=ROW arg={{ROW}{1}{2}}
+    formatMatrixRow(op : S, arg : E, prec : I,y:I,h:I)  : L Tree S ==
+      if debug then sayTeX$Lisp "formatMatrixRow: " concat ["op=",op,_
+        " args=",stringify arg," prec=",string(prec)$S]
+      ATOM(arg)$Lisp@Boolean => [_
+        tree("formatMatrixRow does not contain row")]
+      l : L E := (arg pretend L E)
+      op : S := stringify first l
+      args : L E := rest l
+      --sayTeX$Lisp "formatMatrixRow op="op" args="argsToString(args)
+      w:I := #args
+      cells:(List Tree S) := empty()
+      for x in 1..w repeat
+        --sayTeX$Lisp "formatMatrixRow: x="string(x)$S" width="string(w)$S
+        attrib:S := "td id='mat'"
+        if x=1 then attrib := "td id='matl'"
+        if x=w then attrib := "td id='matr'"
+        if y=1 then attrib := "td id='matt'"
+        if y=h then attrib := "td id='matb'"
+        if x=1 and y=1 then attrib := "td id='matlt'"
+        if x=1 and y=h then attrib := "td id='matlb'"
+        if x=w and y=1  then attrib := "td id='matrt'"
+        if x=w and y=h  then attrib := "td id='matrb'"
+        cells := append(cells,[newNode(attrib,formatHtml(args.(x),prec))])
+      cells
+
+    -- an example is: op=MATRIX args={{ROW}{1}{2}}{{ROW}{3}{4}}
+    formatMatrixContent(op : S, args : L E, prec : I)  : L Tree S ==
+      if debug then sayTeX$Lisp "formatMatrixContent: " concat ["op=",op,_
+        " args=",argsToString(args)," prec=",string(prec)$S]
+      y:I := 0
+      rows:(List Tree S) := [newNodes("tr id='mat'",_
+        formatMatrixRow("ROW",e,prec,y:=y+1,#args)) for e in args]
+      rows
+
+    formatMatrix(args : L E) : Tree S ==
+      -- format for args is [[ROW ...],[ROW ...],[ROW ...]]
+      -- generate string for formatting columns (centered)
+      if debug then sayTeX$Lisp "formatMatrix: " concat ["args=",_
+        argsToString(args)]
+      newNodes("table border='1' id='mat'",_
+        formatMatrixContent("MATRIX",args,minPrec))
+
+    -- output arguments in column table
+    buildColumnTable(elements : List Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildColumnTable"
+      cells:(List Tree S) := [newNode("td id='col'",j) for j in elements]
+      rows:(List Tree S) := [newNode("tr id='col'",i) for i in cells]
+      newNodes("table border='0' id='col'",rows)
+
+    -- build superscript structure as either sup tag or
+    -- if it contains anything that won't go into a
+    -- sup tag then build it as a table
+    buildSuperscript(main : Tree S,super : Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildSuperscript"
+      notTable?(super) => newNodes("",[main,newNode("sup",super)])
+      m:Tree S := newNode("td rowspan='2' id='sup'",main)
+      su:Tree S := newNode("td id='sup'",super)
+      e:Tree S := newNode("td id='sup'",tree("&nbsp;"))
+      rows:(List Tree S) := [newNodes("tr id='sup'",[m,su]),_
+        newNode("tr id='sup'",e)]
+      newNodes("table border='0' id='sup'",rows)
+
+    -- build subscript structure as either sub tag or
+    -- if it contains anything that won't go into a
+    -- sub tag then build it as a table
+    buildSubscript(main : Tree S,subsc : Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildSubscript"
+      notTable?(subsc) => newNodes("",[main,newNode("sub",subsc)])
+      m:Tree S := newNode("td rowspan='2' id='sub'",main)
+      su:Tree S := newNode("td id='sub'",subsc)
+      e:Tree S := newNode("td id='sub'",tree("&nbsp;"))
+      rows:(List Tree S) := [newNodes("tr id='sub'",[m,e]),_
+        newNode("tr id='sub'",su)]
+      newNodes("table border='0' id='sub'",rows)
+
+    formatSub(expr : E, args : L E, opPrec : I) : Tree S ==
+      -- format subscript
+      -- this function expects expr to start with SUB
+      -- it expects first args to be the operator or value that
+      -- the subscript is applied to
+      -- and the rest args to be the subscript
+      if debug then sayTeX$Lisp "formatSub: " concat ["expr=",_
+        stringify expr," args=",argsToString(args)," prec=",_
+          string(opPrec)$S]
+      atomE : L E := atomize(expr)
+      if empty?(atomE) then
+        if debug then sayTeX$Lisp "formatSub: expr=empty"
+        return tree("formatSub: expr=empty")
+      op : S := stringify first atomE
+      op ~= "SUB" =>
+        if debug then sayTeX$Lisp "formatSub: expr~=SUB"
+        tree("formatSub: expr~=SUB")
+      -- assume args.1 is the expression and args.2 is its subscript
+      if #args < 2 then
+        if debug then sayTeX$Lisp concat("formatSub: num args=",_
+          string(#args)$String)$String
+        return tree(concat("formatSub: num args=",_
+          string(#args)$String)$String)
+      if #args > 2 then
+        if debug then sayTeX$Lisp concat("formatSub: num args=",_
+          string(#args)$String)$String
+        return buildSubscript(formatHtml(first args,opPrec),_
+          newNodes("",[formatHtml(e,opPrec) for e in rest args]))
+      buildSubscript(formatHtml(first args,opPrec),_
+        formatHtml(args.2,opPrec))
+
+    formatFunction(op : Tree S, args : L E, prec : I) : Tree S ==
+      if debug then sayTeX$Lisp "formatFunction: " concat ["args=",_
+        argsToString(args)," prec=",string(prec)$S]
+      newNodes("",[op,tree("("),formatNary(",",args,minPrec),tree(")")])
+
+    formatNullary(op : S) : Tree S ==
+      if debug then sayTeX$Lisp "formatNullary: " concat ["op=",op]
+      op = "NOTHING" => empty()$Tree(S)
+      tree(op"()")
+
+    -- implement operation with single argument
+    -- an example is minus '-'
+    -- prec is precidence of operator, used to force brackets where
+    -- more tightly bound operation is next to less tightly bound operation
+    formatUnary(op : S, arg : E, prec : I) : Tree S ==
+      if debug then sayTeX$Lisp "formatUnary: " concat ["op=",op," arg=",_
+        stringify arg," prec=",string(prec)$S]
+      p : I := position(op,unaryOps)
+      p < 1 => error "unknown unary op"
+      opPrec := unaryPrecs.p
+      s : Tree S := newNodes("",[tree(op),formatHtml(arg,opPrec)])
+      opPrec < prec => newNodes("",[tree("("),s,tree(")")])
+      s
+
+    -- output division with numerator above the denominator
+    -- implemented as a table
+    buildOver(top : Tree S,bottom : Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildOver"
+      topCell:Tree S := newNode("td",top)
+      bottomCell:Tree S := newNode("td style='border-top-style:solid'",_
+        bottom)
+      rows:(List Tree S) := [newNode("tr id='col'",topCell),_
+        newNode("tr id='col'",bottomCell)]
+      newNodes("table border='0' id='col'",rows)
+
+    -- op may be: "|","^","/","OVER","+->"
+    -- note: "+" and "*" are n-ary ops
+    formatBinary(op : S, args : L E, prec : I) : Tree S ==
+      if debug then sayTeX$Lisp "formatBinary: " concat ["op=",op,_
+        " args=",argsToString(args)," prec=",string(prec)$S]
+      p : I := position(op,binaryOps)
+      p < 1 => error "unknown binary op"
+      opPrec := binaryPrecs.p
+      -- if base op is product or sum need to add parentheses
+      if ATOM(first args)$Lisp@Boolean then
+        opa:S := stringify first args
+      else
+        la : L E := (first args pretend L E)
+        opa : S := stringify first la
+      if (opa = "SIGMA" or opa = "SIGMA2" or opa = "PI" or opa = "PI2")_
+        and op = "^" then
+          s1 : Tree S := newNodes("",[tree("("),formatHtml(first args,_
+            opPrec),tree(")")])
+      else
+        s1 : Tree S := formatHtml(first args, opPrec)
+      s2 : Tree S := formatHtml(first rest args, opPrec)
+      op = "|" => newNodes("",[s1,tree(op),s2])
+      op = "^" => buildSuperscript(s1,s2)
+      op = "/" => newNodes("",[s1,tree(op),s2])
+      op = "OVER" => buildOver(s1,s2)
+      op = "+->" => newNodes("",[s1,tree("|&mdash;&rsaquo;"),s2])
+      newNodes("",[s1,tree(op),s2])
+
+    -- build a zag from a table with a right part and a
+    -- upper and lower left part
+    buildZag(top:Tree S,lowerLeft:Tree S,lowerRight:Tree S) : Tree S ==
+      if debug then sayTeX$Lisp "buildZag"
+      cellTop:Tree S := _
+        newNode("td colspan='2' id='zag' style='border-bottom-style:solid'",_
+         top)
+      cellLowerLeft:Tree S := newNodes("td id='zag'",[lowerLeft,tree("+")])
+      cellLowerRight:Tree S := newNode("td id='zag'",lowerRight)
+      row1:Tree S := newNodes("tr id='zag'",[cellTop])
+      row2:Tree S := newNodes("tr id='zag'",[cellLowerLeft,cellLowerRight])
+      newNodes("table border='0' id='zag'",[row1,row2])
+
+    formatZag(args : L E,nestLevel:I)  : Tree S ==
+      -- args will be a list of things like this {{ZAG}{1}{7}}, the ZAG
+      -- must be there, the '1' and '7' could conceivably be more complex
+      -- expressions
+      --
+      -- ex 1. continuedFraction(314159/100000)
+      -- {{+}{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}}
+      -- {{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
+      -- this is the preconditioned output form
+      -- including "op", the args list would be the rest of this
+      -- i.e op = '+' and args = {{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}
+      -- {{ZAG}{1}{1}}{{ZAG}{1}{25}}{{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
+      --
+      -- ex 2. continuedFraction(14159/100000)
+      -- this one doesn't have the leading integer
+      -- {{+}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}}
+      -- {{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
+      --
+      -- ex 3. continuedFraction(3,repeating [1], repeating [3,6])
+      -- {{+}{3}{{ZAG}{1}{3}}{{ZAG}{1}{6}}{{ZAG}{1}{3}}{{ZAG}{1}{6}}
+      -- {{ZAG}{1}{3}}{{ZAG}{1}{6}}{{ZAG}{1}{3}}{{ZAG}{1}{6}}
+      -- {{ZAG}{1}{3}}{{ZAG}{1}{6}}{...}}
+      --
+      -- In each of these examples the args list consists of the terms
+      -- following the '+' op
+      -- so the first arg could be a "ZAG" or something
+      -- else, but the second arg looks like it has to be "ZAG", so maybe
+      -- test for #args > 1 and args.2 contains "ZAG".
+      -- Note that since the resulting tables are nested we need
+      -- to handle the whole continued fraction at once, i.e. we can't
+      -- just look for, e.g., {{ZAG}{1}{6}}
+      --
+      -- we will assume that the font starts at 16px and reduce it by 4
+      -- <span style='font-size:16px'>outer zag</span>
+      -- <span style='font-size:14px'>next zag</span>
+      -- <span style='font-size:12px'>next zag</span>
+      -- <span style='font-size:10px'>next zag</span>
+      -- <span style='font-size:9px'>lowest zag</span>
+      if debug then sayTeX$Lisp "formatZag: " concat ["args=",_
+        argsToString(args)]
+      tmpZag : L E := first args pretend L E
+      fontAttrib : S :=
+        nestLevel < 2 => "span style='font-size:16px'"
+        nestLevel = 2 => "span style='font-size:14px'"
+        nestLevel = 3 => "span style='font-size:12px'"
+        nestLevel = 4 => "span style='font-size:10px'"
+        "span style='font-size:9px'"
+      -- may want to test that tmpZag contains 'ZAG'
+      #args > 1 =>
+        newNode(fontAttrib,buildZag(formatHtml(first rest tmpZag,minPrec),_
+          formatHtml(first rest rest tmpZag,minPrec),_
+            formatZag(rest args,nestLevel+1)))
+      (first args = "...":: E)@Boolean => tree("&#x2026;")
+      op:S := stringify first args
+      position("ZAG",op,1) > 0 =>
+        newNode(fontAttrib,buildOver(formatHtml(first rest tmpZag,minPrec),_
+          formatHtml(first rest rest tmpZag,minPrec)))
+      tree("formatZag: Last argument in ZAG construct unknown operator: "op)
+
+    -- returns true if this term starts with a minus '-' sign
+    -- this is used so that we can suppress any plus '+' in front
+    -- of the - so we dont get terms like +-
+    neg?(arg : E) : Boolean ==
+      if debug then sayTeX$Lisp "neg?: " concat ["arg=",argsToString([arg])]
+      ATOM(arg)$Lisp@Boolean => false
+      l : L E := (arg pretend L E)
+      op : S := stringify first l
+      op = "-" => true
+      false
+
+    formatNary(op : S, args : L E, prec : I) : Tree S ==
+      if debug then sayTeX$Lisp "formatNary: " concat ["op=",op," args=",_
+        argsToString(args)," prec=",string(prec)$S]
+      formatNaryNoGroup(op, args, prec)
 
     -- possible op values are:
     -- ",",";","*"," ","ROW","+","-"
@@ -72873,191 +86032,3952 @@ HTMLFormat(): public == private where
       if opPrec < prec then tags := append(tags,[tree(")")])
       newNodes("",tags)
 
-    -- expr is a tree structure
-    -- prec is the precision of integers
-    -- formatHtml returns a string for this node in the tree structure
-    -- and calls recursivly to evaluate sub expressions
-    formatHtml(arg : E,prec : I) : Tree S ==
-      if debug then sayTeX$Lisp "formatHtml: " concat ["arg=",_
-        argsToString([arg])," prec=",string(prec)$S]
-      i,len : Integer
-      intSplitLen : Integer := 20
-      ATOM(arg)$Lisp@Boolean =>
-        if debug then sayTeX$Lisp "formatHtml atom: " concat ["expr=",_
-          stringify arg," prec=",string(prec)$S]
-        str := stringify arg
-        (i := position(str,specialStrings)) > 0 =>
-          tree(specialStringsInHTML.i)
-        tree(str)
-      l : L E := (arg pretend L E)
-      null l => tree(blank)
-      op : S := stringify first l
-      args : L E := rest l
-      nargs : I := #args
-      -- need to test here in case first l is SUPERSUB case and then
-      -- pass first l and args to formatSuperSub.
-      position("SUPERSUB",op,1) > 0 =>
-        formatSuperSub(first l,args,minPrec)
-      -- now test for SUB
-      position("SUB",op,1) > 0 =>
-        formatSub(first l,args,minPrec)
-      -- special cases
-      -- specialOps are:
-      -- MATRIX, BRACKET, BRACE, CONCATB, VCONCAT
-      -- AGGLST, CONCAT, OVERBAR, ROOT, SUB, TAG
-      -- SUPERSUB, ZAG, AGGSET, SC, PAREN
-      -- SEGMENT, QUOTE, theMap, SLASH
-      member?(op, specialOps) => formatSpecial(op,args,prec)
-      -- specialOps are:
-      -- SIGMA, SIGMA2, PI, PI2, INTSIGN, INDEFINTEGRAL
-      member?(op, plexOps)    => formatPlex(op,args,prec)
-      -- nullary case: function with no aguments
-      0 = nargs => formatNullary op
-      -- unary case: function with one agument such as '-'
-      (1 = nargs) and member?(op, unaryOps) =>
-        formatUnary(op, first args, prec)
-      -- binary case
-      -- binary ops include special processing for | ^ / OVER and +->
-      (2 = nargs) and member?(op, binaryOps) =>
-        formatBinary(op, args, prec)
-      -- nary case: including '+' and '*'
-      member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec)
-      member?(op,naryOps) => formatNary(op,args, prec)
+    -- expr is a tree structure
+    -- prec is the precision of integers
+    -- formatHtml returns a string for this node in the tree structure
+    -- and calls recursivly to evaluate sub expressions
+    formatHtml(arg : E,prec : I) : Tree S ==
+      if debug then sayTeX$Lisp "formatHtml: " concat ["arg=",_
+        argsToString([arg])," prec=",string(prec)$S]
+      i,len : Integer
+      intSplitLen : Integer := 20
+      ATOM(arg)$Lisp@Boolean =>
+        if debug then sayTeX$Lisp "formatHtml atom: " concat ["expr=",_
+          stringify arg," prec=",string(prec)$S]
+        str := stringify arg
+        (i := position(str,specialStrings)) > 0 =>
+          tree(specialStringsInHTML.i)
+        tree(str)
+      l : L E := (arg pretend L E)
+      null l => tree(blank)
+      op : S := stringify first l
+      args : L E := rest l
+      nargs : I := #args
+      -- need to test here in case first l is SUPERSUB case and then
+      -- pass first l and args to formatSuperSub.
+      position("SUPERSUB",op,1) > 0 =>
+        formatSuperSub(first l,args,minPrec)
+      -- now test for SUB
+      position("SUB",op,1) > 0 =>
+        formatSub(first l,args,minPrec)
+      -- special cases
+      -- specialOps are:
+      -- MATRIX, BRACKET, BRACE, CONCATB, VCONCAT
+      -- AGGLST, CONCAT, OVERBAR, ROOT, SUB, TAG
+      -- SUPERSUB, ZAG, AGGSET, SC, PAREN
+      -- SEGMENT, QUOTE, theMap, SLASH
+      member?(op, specialOps) => formatSpecial(op,args,prec)
+      -- specialOps are:
+      -- SIGMA, SIGMA2, PI, PI2, INTSIGN, INDEFINTEGRAL
+      member?(op, plexOps)    => formatPlex(op,args,prec)
+      -- nullary case: function with no aguments
+      0 = nargs => formatNullary op
+      -- unary case: function with one agument such as '-'
+      (1 = nargs) and member?(op, unaryOps) =>
+        formatUnary(op, first args, prec)
+      -- binary case
+      -- binary ops include special processing for | ^ / OVER and +->
+      (2 = nargs) and member?(op, binaryOps) =>
+        formatBinary(op, args, prec)
+      -- nary case: including '+' and '*'
+      member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec)
+      member?(op,naryOps) => formatNary(op,args, prec)
+
+      op1 := formatHtml(first l,minPrec)
+      formatFunction(op1,args,prec)
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{HTMLFORM.dotabb}
+"HTMLFORM" [color="#88FF44",href="bookvol10.3.pdf#nameddest=HTMLFORM"]
+"STRING" [color="#4488FF",href="bookvol10.2.pdf#nameddest=STRING"]
+"HTMLFORM" -> "STRING"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain HDP HomogeneousDirectProduct}
+
+\begin{chunk}{HomogeneousDirectProduct.input}
+)set break resume
+)sys rm -f HomogeneousDirectProduct.output
+)spool HomogeneousDirectProduct.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show HomogeneousDirectProduct
+--R 
+--R HomogeneousDirectProduct(dim: NonNegativeInteger,S: OrderedAbelianMonoidSup)  is a domain constructor
+--R Abbreviation for HomogeneousDirectProduct is HDP 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for HDP 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (S,%) -> % if S has MONOID      ?*? : (%,S) -> % if S has MONOID
+--R ?*? : (%,%) -> % if S has MONOID      ?+? : (%,%) -> % if S has ABELSG
+--R -? : % -> % if S has RING             ?-? : (%,%) -> % if S has RING
+--R ?/? : (%,S) -> % if S has FIELD       1 : () -> % if S has MONOID
+--R 0 : () -> % if S has CABMON           abs : % -> % if S has ORDRING
+--R coerce : S -> % if S has SETCAT       coerce : % -> Vector(S)
+--R copy : % -> %                         directProduct : Vector(S) -> %
+--R dot : (%,%) -> S if S has RING        ?.? : (%,Integer) -> S
+--R elt : (%,Integer,S) -> S              empty : () -> %
+--R empty? : % -> Boolean                 entries : % -> List(S)
+--R eq? : (%,%) -> Boolean                index? : (Integer,%) -> Boolean
+--R indices : % -> List(Integer)          latex : % -> String if S has SETCAT
+--R map : ((S -> S),%) -> %               one? : % -> Boolean if S has MONOID
+--R qelt : (%,Integer) -> S               random : () -> % if S has FINITE
+--R retract : % -> S if S has SETCAT      sample : () -> %
+--R sup : (%,%) -> % if S has OAMONS     
+--R #? : % -> NonNegativeInteger if $ has finiteAggregate
+--R ?*? : (PositiveInteger,%) -> % if S has ABELSG
+--R ?*? : (NonNegativeInteger,%) -> % if S has CABMON
+--R ?*? : (Integer,%) -> % if S has RING
+--R ?**? : (%,PositiveInteger) -> % if S has MONOID
+--R ?**? : (%,NonNegativeInteger) -> % if S has MONOID
+--R ?<? : (%,%) -> Boolean if S has OAMONS or S has ORDRING
+--R ?<=? : (%,%) -> Boolean if S has OAMONS or S has ORDRING
+--R ?=? : (%,%) -> Boolean if S has SETCAT
+--R ?>? : (%,%) -> Boolean if S has OAMONS or S has ORDRING
+--R ?>=? : (%,%) -> Boolean if S has OAMONS or S has ORDRING
+--R D : (%,(S -> S)) -> % if S has RING
+--R D : (%,(S -> S),NonNegativeInteger) -> % if S has RING
+--R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if S has PDRING(SYMBOL) and S has RING
+--R D : (%,Symbol,NonNegativeInteger) -> % if S has PDRING(SYMBOL) and S has RING
+--R D : (%,List(Symbol)) -> % if S has PDRING(SYMBOL) and S has RING
+--R D : (%,Symbol) -> % if S has PDRING(SYMBOL) and S has RING
+--R D : (%,NonNegativeInteger) -> % if S has DIFRING and S has RING
+--R D : % -> % if S has DIFRING and S has RING
+--R ?^? : (%,PositiveInteger) -> % if S has MONOID
+--R ?^? : (%,NonNegativeInteger) -> % if S has MONOID
+--R any? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R characteristic : () -> NonNegativeInteger if S has RING
+--R coerce : Fraction(Integer) -> % if S has RETRACT(FRAC(INT)) and S has SETCAT
+--R coerce : Integer -> % if S has RETRACT(INT) and S has SETCAT or S has RING
+--R coerce : % -> OutputForm if S has SETCAT
+--R count : (S,%) -> NonNegativeInteger if $ has finiteAggregate and S has SETCAT
+--R count : ((S -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
+--R differentiate : (%,(S -> S)) -> % if S has RING
+--R differentiate : (%,(S -> S),NonNegativeInteger) -> % if S has RING
+--R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if S has PDRING(SYMBOL) and S has RING
+--R differentiate : (%,Symbol,NonNegativeInteger) -> % if S has PDRING(SYMBOL) and S has RING
+--R differentiate : (%,List(Symbol)) -> % if S has PDRING(SYMBOL) and S has RING
+--R differentiate : (%,Symbol) -> % if S has PDRING(SYMBOL) and S has RING
+--R differentiate : (%,NonNegativeInteger) -> % if S has DIFRING and S has RING
+--R differentiate : % -> % if S has DIFRING and S has RING
+--R dimension : () -> CardinalNumber if S has FIELD
+--R entry? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
+--R enumerate : () -> List(%) if S has FINITE
+--R eval : (%,List(S),List(S)) -> % if S has EVALAB(S) and S has SETCAT
+--R eval : (%,S,S) -> % if S has EVALAB(S) and S has SETCAT
+--R eval : (%,Equation(S)) -> % if S has EVALAB(S) and S has SETCAT
+--R eval : (%,List(Equation(S))) -> % if S has EVALAB(S) and S has SETCAT
+--R every? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R fill! : (%,S) -> % if $ has shallowlyMutable
+--R first : % -> S if Integer has ORDSET
+--R hash : % -> SingleInteger if S has SETCAT
+--R index : PositiveInteger -> % if S has FINITE
+--R less? : (%,NonNegativeInteger) -> Boolean
+--R lookup : % -> PositiveInteger if S has FINITE
+--R map! : ((S -> S),%) -> % if $ has shallowlyMutable
+--R max : (%,%) -> % if S has OAMONS or S has ORDRING
+--R maxIndex : % -> Integer if Integer has ORDSET
+--R member? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
+--R members : % -> List(S) if $ has finiteAggregate
+--R min : (%,%) -> % if S has OAMONS or S has ORDRING
+--R minIndex : % -> Integer if Integer has ORDSET
+--R more? : (%,NonNegativeInteger) -> Boolean
+--R negative? : % -> Boolean if S has ORDRING
+--R parts : % -> List(S) if $ has finiteAggregate
+--R positive? : % -> Boolean if S has ORDRING
+--R qsetelt! : (%,Integer,S) -> S if $ has shallowlyMutable
+--R recip : % -> Union(%,"failed") if S has MONOID
+--R reducedSystem : Matrix(%) -> Matrix(S) if S has RING
+--R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(S),vec: Vector(S)) if S has RING
+--R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer)) if S has LINEXP(INT) and S has RING
+--R reducedSystem : Matrix(%) -> Matrix(Integer) if S has LINEXP(INT) and S has RING
+--R retract : % -> Fraction(Integer) if S has RETRACT(FRAC(INT)) and S has SETCAT
+--R retract : % -> Integer if S has RETRACT(INT) and S has SETCAT
+--R retractIfCan : % -> Union(S,"failed") if S has SETCAT
+--R retractIfCan : % -> Union(Fraction(Integer),"failed") if S has RETRACT(FRAC(INT)) and S has SETCAT
+--R retractIfCan : % -> Union(Integer,"failed") if S has RETRACT(INT) and S has SETCAT
+--R setelt : (%,Integer,S) -> S if $ has shallowlyMutable
+--R sign : % -> Integer if S has ORDRING
+--R size : () -> NonNegativeInteger if S has FINITE
+--R size? : (%,NonNegativeInteger) -> Boolean
+--R subtractIfCan : (%,%) -> Union(%,"failed") if S has CABMON
+--R swap! : (%,Integer,Integer) -> Void if $ has shallowlyMutable
+--R unitVector : PositiveInteger -> % if S has RING
+--R zero? : % -> Boolean if S has CABMON
+--R ?~=? : (%,%) -> Boolean if S has SETCAT
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{HomogeneousDirectProduct.help}
+====================================================================
+HomogeneousDirectProduct examples
+====================================================================
+
+This type represents the finite direct or cartesian product of an
+underlying ordered component type. The vectors are ordered first
+by the sum of their components, and then refined using a reverse
+lexicographic ordering. This type is a suitable third argument for
+GeneralDistributedMultivariatePolynomial.
+
+See Also:
+o )show HomogeneousDirectProduct
+
+\end{chunk}
+
+\pagehead{HomogeneousDirectProduct}{HDP}
+\pagepic{ps/v103homogeneousdirectproduct.ps}{HDP}{1.00}
+{\bf See}\\
+\pageto{OrderedDirectProduct}{ODP}
+\pageto{SplitHomogeneousDirectProduct}{SHDP}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{HDP}{0} &
+\cross{HDP}{1} &
+\cross{HDP}{abs} &
+\cross{HDP}{any?} &
+\cross{HDP}{characteristic} \\
+\cross{HDP}{coerce} &
+\cross{HDP}{copy} &
+\cross{HDP}{count} &
+\cross{HDP}{D} &
+\cross{HDP}{differentiate} \\
+\cross{HDP}{dimension} &
+\cross{HDP}{directProduct} &
+\cross{HDP}{dot} &
+\cross{HDP}{elt} &
+\cross{HDP}{empty} \\
+\cross{HDP}{empty?} &
+\cross{HDP}{entries} &
+\cross{HDP}{entry?} &
+\cross{HDP}{eq?} &
+\cross{HDP}{eval} \\
+\cross{HDP}{every?} &
+\cross{HDP}{fill!} &
+\cross{HDP}{first} &
+\cross{HDP}{hash} &
+\cross{HDP}{index} \\
+\cross{HDP}{index?} &
+\cross{HDP}{indices} &
+\cross{HDP}{latex} &
+\cross{HDP}{less?} &
+\cross{HDP}{lookup} \\
+\cross{HDP}{map} &
+\cross{HDP}{map!} &
+\cross{HDP}{max} &
+\cross{HDP}{maxIndex} &
+\cross{HDP}{member?} \\
+\cross{HDP}{members} &
+\cross{HDP}{min} &
+\cross{HDP}{minIndex} &
+\cross{HDP}{more?} &
+\cross{HDP}{negative?} \\
+\cross{HDP}{one?} &
+\cross{HDP}{parts} &
+\cross{HDP}{positive?} &
+\cross{HDP}{qelt} &
+\cross{HDP}{qsetelt!} \\
+\cross{HDP}{random} &
+\cross{HDP}{recip} &
+\cross{HDP}{reducedSystem} &
+\cross{HDP}{retract} &
+\cross{HDP}{retractIfCan} \\
+\cross{HDP}{sample} &
+\cross{HDP}{setelt} &
+\cross{HDP}{sign} &
+\cross{HDP}{size} &
+\cross{HDP}{size?} \\
+\cross{HDP}{subtractIfCan} &
+\cross{HDP}{sup} &
+\cross{HDP}{swap!} &
+\cross{HDP}{unitVector} &
+\cross{HDP}{zero?} \\
+\cross{HDP}{\#{}?} &
+\cross{HDP}{?*?} &
+\cross{HDP}{?**?} &
+\cross{HDP}{?+?} &
+\cross{HDP}{?-?} \\
+\cross{HDP}{?/?} &
+\cross{HDP}{?$<$?} &
+\cross{HDP}{?$<=$?} &
+\cross{HDP}{?=?} &
+\cross{HDP}{?$>$?} \\
+\cross{HDP}{?$>=$?} &
+\cross{HDP}{?\^{}?} &
+\cross{HDP}{?\~{}=?} &
+\cross{HDP}{-?} &
+\cross{HDP}{?.?} 
+\end{tabular}
+
+\begin{chunk}{domain HDP HomogeneousDirectProduct}
+)abbrev domain HDP HomogeneousDirectProduct
+++ Author: Mark Botch
+++ Description:
+++ This type represents the finite direct or cartesian product of an
+++ underlying ordered component type. The vectors are ordered first
+++ by the sum of their components, and then refined using a reverse
+++ lexicographic ordering. This type is a suitable third argument for
+++ \spadtype{GeneralDistributedMultivariatePolynomial}.
+
+HomogeneousDirectProduct(dim,S) : T == C where
+   dim : NonNegativeInteger
+   S         : OrderedAbelianMonoidSup
+
+   T == DirectProductCategory(dim,S)
+
+   C == DirectProduct(dim,S) add
+
+        Rep:=Vector(S)
+
+        -- reverse lexicographical ordering
+        v1:% < v2:% ==
+          n1:S:=0
+          n2:S:=0
+          for i in 1..dim repeat
+            n1:= n1+qelt(v1,i)
+            n2:=n2+qelt(v2,i)
+          n1<n2 => true
+          n2<n1 => false
+          for i in reverse(1..dim) repeat
+            if qelt(v2,i) < qelt(v1,i) then return true
+            if qelt(v1,i) < qelt(v2,i) then return false
+          false
+
+\end{chunk}
+
+\begin{chunk}{COQ HDP}
+(* domain HDP *)
+(*
+ DirectProduct(dim,S) add
+
+        Rep:=Vector(S)
+
+        -- reverse lexicographical ordering
+        v1:% < v2:% ==
+          n1:S:=0
+          n2:S:=0
+          for i in 1..dim repeat
+            n1:= n1+qelt(v1,i)
+            n2:=n2+qelt(v2,i)
+          n1<n2 => true
+          n2<n1 => false
+          for i in reverse(1..dim) repeat
+            if qelt(v2,i) < qelt(v1,i) then return true
+            if qelt(v1,i) < qelt(v2,i) then return false
+          false
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{HDP.dotabb}
+"HDP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=HDP"]
+"DIRPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=DIRPCAT"]
+"HDP" -> "DIRPCAT"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain HDMP HomogeneousDistributedMultivariatePolynomial}
+
+\begin{chunk}{HomogeneousDistributedMultivariatePolynomial.input}
+)set break resume
+)sys rm -f HomogeneousDistributedMultivariatePolynomial.output
+)spool HomogeneousDistributedMultivariatePolynomial.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 11
+(d1,d2,d3) : DMP([z,y,x],FRAC INT) 
+--R 
+--R                                                                   Type: Void
+--E 1
+
+--S 2 of 11
+d1 := -4*z + 4*y**2*x + 16*x**2 + 1 
+--R 
+--R
+--R                 2       2
+--R   (2)  - 4z + 4y x + 16x  + 1
+--R           Type: DistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
+--E 2
+
+--S 3 of 11
+d2 := 2*z*y**2 + 4*x + 1 
+--R 
+--R
+--R            2
+--R   (3)  2z y  + 4x + 1
+--R           Type: DistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
+--E 3
+
+--S 4 of 11
+d3 := 2*z*x**2 - 2*y**2 - x 
+--R 
+--R
+--R            2     2
+--R   (4)  2z x  - 2y  - x
+--R           Type: DistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
+--E 4
+
+--S 5 of 11
+groebner [d1,d2,d3]
+--R 
+--R
+--R   (5)
+--R        1568  6   1264  5    6   4   182  3   2047  2    103      2857
+--R   [z - ---- x  - ---- x  + --- x  + --- x  - ---- x  - ---- x - -----,
+--R        2745       305      305      549       610      2745     10980
+--R     2    112  6    84  5   1264  4    13  3    84  2   1772       2
+--R    y  + ---- x  - --- x  - ---- x  - --- x  + --- x  + ---- x + ----,
+--R         2745      305       305      549      305      2745     2745
+--R     7   29  6   17  4   11  3    1  2   15     1
+--R    x  + -- x  - -- x  - -- x  + -- x  + -- x + -]
+--R          4      16       8      32      16     4
+--R     Type: List(DistributedMultivariatePolynomial([z,y,x],Fraction(Integer)))
+--E 5
+
+--S 6 of 11
+(n1,n2,n3) : HDMP([z,y,x],FRAC INT)
+--R 
+--R                                                                   Type: Void
+--E 6
+
+--S 7 of 11
+n1 := d1
+--R 
+--R
+--R          2       2
+--R   (7)  4y x + 16x  - 4z + 1
+--RType: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
+--E 7
+
+--S 8 of 11
+n2 := d2
+--R 
+--R
+--R            2
+--R   (8)  2z y  + 4x + 1
+--RType: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
+--E 8
+
+--S 9 of 11
+n3 := d3
+--R 
+--R
+--R            2     2
+--R   (9)  2z x  - 2y  - x
+--RType: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
+--E 9
+
+--S 10 of 11
+groebner [n1,n2,n3]
+--R 
+--R
+--R   (10)
+--R     4     3   3  2   1     1   4   29  3   1  2   7        9     1
+--R   [y  + 2x  - - x  + - z - -, x  + -- x  - - y  - - z x - -- x - -,
+--R               2      2     8        4      8      4       16     4
+--R       2        1   2      2       1     2    2   1
+--R    z y  + 2x + -, y x + 4x  - z + -, z x  - y  - - x,
+--R                2                  4              2
+--R     2     2     2   1     3
+--R    z  - 4y  + 2x  - - z - - x]
+--R                     4     2
+--RType: List(HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer)))
+--E 10
+
+--S 11 of 11
+)show HomogeneousDistributedMultivariatePolynomial
+--R 
+--R HomogeneousDistributedMultivariatePolynomial(vl: List(Symbol),R: Ring)  is a domain constructor
+--R Abbreviation for HomogeneousDistributedMultivariatePolynomial is HDMP 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for HDMP 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (%,R) -> %                      ?*? : (R,%) -> %
+--R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
+--R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
+--R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
+--R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
+--R -? : % -> %                           ?/? : (%,R) -> % if R has FIELD
+--R ?=? : (%,%) -> Boolean                1 : () -> %
+--R 0 : () -> %                           ?^? : (%,NonNegativeInteger) -> %
+--R ?^? : (%,PositiveInteger) -> %        coefficients : % -> List(R)
+--R coerce : % -> % if R has INTDOM       coerce : R -> %
+--R coerce : Integer -> %                 coerce : % -> OutputForm
+--R content : % -> R if R has GCDDOM      eval : (%,List(%),List(%)) -> %
+--R eval : (%,%,%) -> %                   eval : (%,Equation(%)) -> %
+--R eval : (%,List(Equation(%))) -> %     gcd : (%,%) -> % if R has GCDDOM
+--R gcd : List(%) -> % if R has GCDDOM    ground : % -> R
+--R ground? : % -> Boolean                hash : % -> SingleInteger
+--R latex : % -> String                   lcm : (%,%) -> % if R has GCDDOM
+--R lcm : List(%) -> % if R has GCDDOM    leadingCoefficient : % -> R
+--R leadingMonomial : % -> %              map : ((R -> R),%) -> %
+--R max : (%,%) -> % if R has ORDSET      min : (%,%) -> % if R has ORDSET
+--R monomial? : % -> Boolean              monomials : % -> List(%)
+--R one? : % -> Boolean                   primitiveMonomials : % -> List(%)
+--R recip : % -> Union(%,"failed")        reductum : % -> %
+--R reorder : (%,List(Integer)) -> %      retract : % -> R
+--R sample : () -> %                      zero? : % -> Boolean
+--R ?~=? : (%,%) -> 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(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
+--R D : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
+--R D : (%,List(OrderedVariableList(vl))) -> %
+--R D : (%,OrderedVariableList(vl)) -> %
+--R associates? : (%,%) -> Boolean if R has INTDOM
+--R binomThmExpt : (%,%,NonNegativeInteger) -> % if R has COMRING
+--R characteristic : () -> NonNegativeInteger
+--R charthRoot : % -> Union(%,"failed") if $ has CHARNZ and R has PFECAT or R has CHARNZ
+--R coefficient : (%,List(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
+--R coefficient : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
+--R coefficient : (%,HomogeneousDirectProduct(#(vl),NonNegativeInteger)) -> R
+--R coerce : Fraction(Integer) -> % if R has ALGEBRA(FRAC(INT)) or R has RETRACT(FRAC(INT))
+--R coerce : OrderedVariableList(vl) -> %
+--R conditionP : Matrix(%) -> Union(Vector(%),"failed") if $ has CHARNZ and R has PFECAT
+--R content : (%,OrderedVariableList(vl)) -> % if R has GCDDOM
+--R convert : % -> InputForm if OrderedVariableList(vl) has KONVERT(INFORM) and R has KONVERT(INFORM)
+--R convert : % -> Pattern(Integer) if OrderedVariableList(vl) has KONVERT(PATTERN(INT)) and R has KONVERT(PATTERN(INT))
+--R convert : % -> Pattern(Float) if OrderedVariableList(vl) has KONVERT(PATTERN(FLOAT)) and R has KONVERT(PATTERN(FLOAT))
+--R degree : (%,List(OrderedVariableList(vl))) -> List(NonNegativeInteger)
+--R degree : (%,OrderedVariableList(vl)) -> NonNegativeInteger
+--R degree : % -> HomogeneousDirectProduct(#(vl),NonNegativeInteger)
+--R differentiate : (%,List(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
+--R differentiate : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
+--R differentiate : (%,List(OrderedVariableList(vl))) -> %
+--R differentiate : (%,OrderedVariableList(vl)) -> %
+--R discriminant : (%,OrderedVariableList(vl)) -> % if R has COMRING
+--R eval : (%,List(OrderedVariableList(vl)),List(%)) -> %
+--R eval : (%,OrderedVariableList(vl),%) -> %
+--R eval : (%,List(OrderedVariableList(vl)),List(R)) -> %
+--R eval : (%,OrderedVariableList(vl),R) -> %
+--R exquo : (%,%) -> Union(%,"failed") if R has INTDOM
+--R exquo : (%,R) -> Union(%,"failed") 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 isExpt : % -> Union(Record(var: OrderedVariableList(vl),exponent: NonNegativeInteger),"failed")
+--R isPlus : % -> Union(List(%),"failed")
+--R isTimes : % -> Union(List(%),"failed")
+--R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) if R has GCDDOM
+--R mainVariable : % -> Union(OrderedVariableList(vl),"failed")
+--R mapExponents : ((HomogeneousDirectProduct(#(vl),NonNegativeInteger) -> HomogeneousDirectProduct(#(vl),NonNegativeInteger)),%) -> %
+--R minimumDegree : (%,List(OrderedVariableList(vl))) -> List(NonNegativeInteger)
+--R minimumDegree : (%,OrderedVariableList(vl)) -> NonNegativeInteger
+--R minimumDegree : % -> HomogeneousDirectProduct(#(vl),NonNegativeInteger)
+--R monicDivide : (%,%,OrderedVariableList(vl)) -> Record(quotient: %,remainder: %)
+--R monomial : (%,List(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
+--R monomial : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
+--R monomial : (R,HomogeneousDirectProduct(#(vl),NonNegativeInteger)) -> %
+--R multivariate : (SparseUnivariatePolynomial(%),OrderedVariableList(vl)) -> %
+--R multivariate : (SparseUnivariatePolynomial(R),OrderedVariableList(vl)) -> %
+--R numberOfMonomials : % -> NonNegativeInteger
+--R patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> PatternMatchResult(Integer,%) if OrderedVariableList(vl) has PATMAB(INT) and R has PATMAB(INT)
+--R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) if OrderedVariableList(vl) has PATMAB(FLOAT) and R has PATMAB(FLOAT)
+--R pomopo! : (%,R,HomogeneousDirectProduct(#(vl),NonNegativeInteger),%) -> %
+--R prime? : % -> Boolean if R has PFECAT
+--R primitivePart : (%,OrderedVariableList(vl)) -> % if R has GCDDOM
+--R primitivePart : % -> % if R has GCDDOM
+--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 : (%,%,OrderedVariableList(vl)) -> % if R has COMRING
+--R retract : % -> OrderedVariableList(vl)
+--R retract : % -> Integer if R has RETRACT(INT)
+--R retract : % -> Fraction(Integer) if R has RETRACT(FRAC(INT))
+--R retractIfCan : % -> Union(OrderedVariableList(vl),"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 subtractIfCan : (%,%) -> Union(%,"failed")
+--R totalDegree : (%,List(OrderedVariableList(vl))) -> 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 : (%,OrderedVariableList(vl)) -> SparseUnivariatePolynomial(%)
+--R variables : % -> List(OrderedVariableList(vl))
+--R
+--E 11
+
+)spool
+)lisp (bye)
+\end{chunk}
+
+\begin{chunk}{HomogeneousDistributedMultivariatePolynomial.help}
+====================================================================
+MultivariatePolynomial
+DistributedMultivariatePolynomial
+HomogeneousDistributedMultivariatePolynomial
+GeneralDistributedMultivariatePolynomial
+====================================================================
+
+DistributedMultivariatePolynomial which is abbreviated as DMP and 
+HomogeneousDistributedMultivariatePolynomial, which is abbreviated
+as HDMP, are very similar to MultivariatePolynomial except that 
+they are represented and displayed in a non-recursive manner.
+
+  (d1,d2,d3) : DMP([z,y,x],FRAC INT) 
+                      Type: Void
+
+The constructor DMP orders its monomials lexicographically while
+HDMP orders them by total order refined by reverse lexicographic
+order.
+
+  d1 := -4*z + 4*y**2*x + 16*x**2 + 1 
+            2       2
+   - 4z + 4y x + 16x  + 1
+            Type: DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+
+  d2 := 2*z*y**2 + 4*x + 1 
+       2
+   2z y  + 4x + 1
+            Type: DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+
+  d3 := 2*z*x**2 - 2*y**2 - x 
+       2     2
+   2z x  - 2y  - x
+            Type: DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+
+These constructors are mostly used in Groebner basis calculations.
+
+  groebner [d1,d2,d3]
+        1568  6   1264  5    6   4   182  3   2047  2    103      2857
+   [z - ---- x  - ---- x  + --- x  + --- x  - ---- x  - ---- x - -----,
+        2745       305      305      549       610      2745     10980
+     2    112  6    84  5   1264  4    13  3    84  2   1772       2
+    y  + ---- x  - --- x  - ---- x  - --- x  + --- x  + ---- x + ----,
+         2745      305       305      549      305      2745     2745
+     7   29  6   17  4   11  3    1  2   15     1
+    x  + -- x  - -- x  - -- x  + -- x  + -- x + -]
+          4      16       8      32      16     4
+       Type: List DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+
+  (n1,n2,n3) : HDMP([z,y,x],FRAC INT)
+                      Type: Void
+
+  n1 := d1
+     2       2
+   4y x + 16x  - 4z + 1
+ Type: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+
+  n2 := d2
+       2
+   2z y  + 4x + 1
+ Type: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+
+  n3 := d3
+       2     2
+   2z x  - 2y  - x
+ Type: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+
+Note that we get a different Groebner basis when we use the HDMP
+polynomials, as expected.
+
+  groebner [n1,n2,n3]
+     4     3   3  2   1     1   4   29  3   1  2   7        9     1
+   [y  + 2x  - - x  + - z - -, x  + -- x  - - y  - - z x - -- x - -,
+               2      2     8        4      8      4       16     4
+       2        1   2      2       1     2    2   1
+    z y  + 2x + -, y x + 4x  - z + -, z x  - y  - - x,
+                2                  4              2
+     2     2     2   1     3
+    z  - 4y  + 2x  - - z - - x]
+                     4     2
+      Type: List HomogeneousDistributedMultivariatePolynomial([z,y,x],
+                                                           Fraction Integer)
+
+GeneralDistributedMultivariatePolynomial is somewhat more flexible in
+the sense that as well as accepting a list of variables to specify the
+variable ordering, it also takes a predicate on exponent vectors to
+specify the term ordering.  With this polynomial type the user can
+experiment with the effect of using completely arbitrary term orderings.  
+This flexibility is mostly important for algorithms such as Groebner 
+basis calculations which can be very sensitive to term ordering.
+
+See Also:
+o )help Polynomial
+o )help UnivariatePolynomial
+o )help MultivariatePolynomial
+o )help DistributedMultivariatePolynomial
+o )help GeneralDistributedMultivariatePolynomial
+o )show HomogeneousDistributedMultivariatePolynomial
+
+\end{chunk}
+\pagehead{HomogeneousDistributedMultivariatePolynomial}{HDMP}
+\pagepic{ps/v103homogeneousdistributedmultivariatepolynomial.ps}{HDMP}{1.00}
+{\bf See}\\
+\pageto{GeneralDistributedMultivariatePolynomial}{GDMP}
+\pageto{DistributedMultivariatePolynomial}{DMP}
+
+{\bf Exports:}\\
+\begin{tabular}{lll}
+\cross{HDMP}{0} &
+\cross{HDMP}{1} &
+\cross{HDMP}{associates?} \\
+\cross{HDMP}{binomThmExpt} &
+\cross{HDMP}{characteristic} &
+\cross{HDMP}{charthRoot} \\
+\cross{HDMP}{coefficient} &
+\cross{HDMP}{coefficients} &
+\cross{HDMP}{coerce} \\
+\cross{HDMP}{conditionP} &
+\cross{HDMP}{content} &
+\cross{HDMP}{convert} \\
+\cross{HDMP}{D} &
+\cross{HDMP}{degree} &
+\cross{HDMP}{differentiate} \\
+\cross{HDMP}{discriminant} &
+\cross{HDMP}{eval} &
+\cross{HDMP}{exquo} \\
+\cross{HDMP}{factor} &
+\cross{HDMP}{factorPolynomial} &
+\cross{HDMP}{factorSquareFreePolynomial} \\
+\cross{HDMP}{gcd} &
+\cross{HDMP}{gcdPolynomial} &
+\cross{HDMP}{ground} \\
+\cross{HDMP}{ground?} &
+\cross{HDMP}{hash} &
+\cross{HDMP}{isExpt} \\
+\cross{HDMP}{isPlus} &
+\cross{HDMP}{isTimes} &
+\cross{HDMP}{latex} \\
+\cross{HDMP}{lcm} &
+\cross{HDMP}{leadingCoefficient} &
+\cross{HDMP}{leadingMonomial} \\
+\cross{HDMP}{mainVariable} &
+\cross{HDMP}{map} &
+\cross{HDMP}{mapExponents} \\
+\cross{HDMP}{max} &
+\cross{HDMP}{min} &
+\cross{HDMP}{minimumDegree} \\
+\cross{HDMP}{monicDivide} &
+\cross{HDMP}{monomial} &
+\cross{HDMP}{monomial?} \\
+\cross{HDMP}{monomials} &
+\cross{HDMP}{multivariate} &
+\cross{HDMP}{numberOfMonomials} \\
+\cross{HDMP}{one?} &
+\cross{HDMP}{patternMatch} &
+\cross{HDMP}{pomopo!} \\
+\cross{HDMP}{prime?} &
+\cross{HDMP}{primitiveMonomials} &
+\cross{HDMP}{primitivePart} \\
+\cross{HDMP}{recip} &
+\cross{HDMP}{reducedSystem} &
+\cross{HDMP}{reductum} \\
+\cross{HDMP}{reorder} &
+\cross{HDMP}{resultant} &
+\cross{HDMP}{retract} \\
+\cross{HDMP}{retractIfCan} &
+\cross{HDMP}{sample} &
+\cross{HDMP}{solveLinearPolynomialEquation} \\
+\cross{HDMP}{squareFree} &
+\cross{HDMP}{squareFreePart} &
+\cross{HDMP}{squareFreePolynomial} \\
+\cross{HDMP}{subtractIfCan} &
+\cross{HDMP}{totalDegree} &
+\cross{HDMP}{unit?} \\
+\cross{HDMP}{unitCanonical} &
+\cross{HDMP}{unitNormal} &
+\cross{HDMP}{univariate} \\
+\cross{HDMP}{variables} &
+\cross{HDMP}{zero?} &
+\cross{HDMP}{?*?} \\
+\cross{HDMP}{?**?} &
+\cross{HDMP}{?+?} &
+\cross{HDMP}{?-?} \\
+\cross{HDMP}{-?} &
+\cross{HDMP}{?=?} &
+\cross{HDMP}{?\^{}?} \\
+\cross{HDMP}{?\~{}=?} &
+\cross{HDMP}{?/?} &
+\cross{HDMP}{?$<$?} \\
+\cross{HDMP}{?$<=$?} &
+\cross{HDMP}{?$>$?} &
+\cross{HDMP}{?$>=$?} \\
+\cross{HDMP}{?\^{}?} &&
+\end{tabular}
+
+\begin{chunk}{domain HDMP HomogeneousDistributedMultivariatePolynomial}
+)abbrev domain HDMP HomogeneousDistributedMultivariatePolynomial
+++ Author: Barry Trager
+++ Description:
+++ This type supports distributed multivariate polynomials
+++ whose variables are from a user specified list of symbols.
+++ The coefficient ring may be non commutative,
+++ but the variables are assumed to commute.
+++ The term ordering is total degree ordering refined by reverse
+++ lexicographic ordering with respect to the position that the variables
+++ appear in the list of variables parameter.
+
+HomogeneousDistributedMultivariatePolynomial(vl,R): public == private where
+  vl : List Symbol
+  R  : Ring
+  E   ==> HomogeneousDirectProduct(#vl,NonNegativeInteger)
+  OV  ==> OrderedVariableList(vl)
+  public == PolynomialCategory(R,E,OV) with
+      reorder: (%,List Integer) -> %
+        ++ reorder(p, perm) applies the permutation perm to the variables
+        ++ in a polynomial and returns the new correctly ordered polynomial
+  private ==
+    GeneralDistributedMultivariatePolynomial(vl,R,E)
+
+\end{chunk}
+
+\begin{chunk}{COQ HDMP}
+(* domain HDMP *)
+(*
+*)
+
+\end{chunk}
+
+\begin{chunk}{HDMP.dotabb}
+"HDMP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=HDMP"]
+"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"]
+"DIRPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=DIRPCAT"]
+"HDMP" -> "PFECAT"
+"HDMP" -> "DIRPCAT"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain HELLFDIV HyperellipticFiniteDivisor}
+
+\begin{chunk}{HyperellipticFiniteDivisor.input}
+)set break resume
+)sys rm -f HyperellipticFiniteDivisor.output
+)spool HyperellipticFiniteDivisor.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show HyperellipticFiniteDivisor
+--R 
+--R HyperellipticFiniteDivisor(F: Field,UP: UnivariatePolynomialCategory(F),UPUP: UnivariatePolynomialCategory(Fraction(UP)),R: FunctionFieldCategory(F,UP,UPUP))  is a domain constructor
+--R Abbreviation for HyperellipticFiniteDivisor is HELLFDIV 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for HELLFDIV 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (Integer,%) -> %                ?*? : (NonNegativeInteger,%) -> %
+--R ?*? : (PositiveInteger,%) -> %        ?+? : (%,%) -> %
+--R ?-? : (%,%) -> %                      -? : % -> %
+--R ?=? : (%,%) -> Boolean                0 : () -> %
+--R coerce : % -> OutputForm              divisor : (R,UP,UP,UP,F) -> %
+--R divisor : (F,F,Integer) -> %          divisor : (F,F) -> %
+--R divisor : R -> %                      generator : % -> Union(R,"failed")
+--R hash : % -> SingleInteger             latex : % -> String
+--R principal? : % -> Boolean             reduce : % -> %
+--R sample : () -> %                      zero? : % -> Boolean
+--R ?~=? : (%,%) -> Boolean              
+--R decompose : % -> Record(id: FractionalIdeal(UP,Fraction(UP),UPUP,R),principalPart: R)
+--R divisor : FractionalIdeal(UP,Fraction(UP),UPUP,R) -> %
+--R ideal : % -> FractionalIdeal(UP,Fraction(UP),UPUP,R)
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{HyperellipticFiniteDivisor.help}
+====================================================================
+HyperellipticFiniteDivisor examples
+====================================================================
+
+This domains implements finite rational divisors on an hyperelliptic curve,
+that is finite formal sums SUM(n * P) where the n's are integers and the
+P's are finite rational points on the curve.
+
+The equation of the curve must be  y^2 = f(x) and f must have odd degree.
+
+See Also:
+o )show HyperellipticFiniteDivisor
+
+\end{chunk}
+
+\pagehead{HyperellipticFiniteDivisor}{HELLFDIV}
+\pagepic{ps/v103hyperellipticfinitedivisor.ps}{HELLFDIV}{1.00}
+{\bf See}\\
+\pageto{FractionalIdeal}{FRIDEAL}
+\pageto{FramedModule}{FRMOD}
+\pageto{FiniteDivisor}{FDIV}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{HELLFDIV}{0} &
+\cross{HELLFDIV}{coerce} &
+\cross{HELLFDIV}{decompose} &
+\cross{HELLFDIV}{divisor} &
+\cross{HELLFDIV}{hash} \\
+\cross{HELLFDIV}{ideal} &
+\cross{HELLFDIV}{generator} &
+\cross{HELLFDIV}{latex} &
+\cross{HELLFDIV}{principal?} &
+\cross{HELLFDIV}{reduce} \\
+\cross{HELLFDIV}{sample} &
+\cross{HELLFDIV}{subtractIfCan} &
+\cross{HELLFDIV}{zero?} &
+\cross{HELLFDIV}{?\~{}=?} &
+\cross{HELLFDIV}{?*?} \\
+\cross{HELLFDIV}{?+?} &
+\cross{HELLFDIV}{?-?} &
+\cross{HELLFDIV}{-?} &
+\cross{HELLFDIV}{?=?} &
+\end{tabular}
+
+\begin{chunk}{domain HELLFDIV HyperellipticFiniteDivisor}
+)abbrev domain HELLFDIV HyperellipticFiniteDivisor
+++ Author: Manuel Bronstein
+++ Date Created: 19 May 1993
+++ Date Last Updated: 20 July 1998
+++ Description:
+++ This domains implements finite rational divisors on an hyperelliptic curve,
+++ that is finite formal sums SUM(n * P) where the n's are integers and the
+++ P's are finite rational points on the curve.
+++ The equation of the curve must be  y^2 = f(x) and f must have odd degree.
+
+HyperellipticFiniteDivisor(F, UP, UPUP, R): Exports == Implementation where
+  F   : Field
+  UP  : UnivariatePolynomialCategory F
+  UPUP: UnivariatePolynomialCategory Fraction UP
+  R   : FunctionFieldCategory(F, UP, UPUP)
+
+  O   ==> OutputForm
+  Z   ==> Integer
+  RF  ==> Fraction UP
+  ID  ==> FractionalIdeal(UP, RF, UPUP, R)
+  ERR ==> error "divisor: incomplete implementation for hyperelliptic curves"
+
+  Exports ==> FiniteDivisorCategory(F, UP, UPUP, R)
+
+  Implementation ==> add
+    if (uhyper:Union(UP, "failed") := hyperelliptic()$R) case "failed" then
+              error "HyperellipticFiniteDivisor: curve must be hyperelliptic"
+
+-- we use the semi-reduced representation from D.Cantor, "Computing in the
+-- Jacobian of a HyperellipticCurve", Mathematics of Computation, vol 48,
+-- no.177, January 1987, 95-101.
+-- The representation [a,b,f] for D means D = [a,b] + div(f)
+-- and [a,b] is a semi-reduced representative on the Jacobian
+
+    Rep := Record(center:UP, polyPart:UP, principalPart:R, reduced?:Boolean)
+
+    hyper:UP := uhyper::UP
+    gen:Z    := ((degree(hyper)::Z - 1) exquo 2)::Z     -- genus of the curve
+    dvd:O    := "div"::Symbol::O
+    zer:O    := 0::Z::O
+
+    makeDivisor  : (UP, UP, R) -> %
+    intReduc     : (R, UP) -> R
+    princ?       : % -> Boolean
+    polyIfCan    : R -> Union(UP, "failed")
+    redpolyIfCan : (R, UP) -> Union(UP, "failed")
+    intReduce    : (R, UP) -> R
+    mkIdeal      : (UP, UP) -> ID
+    reducedTimes : (Z, UP, UP) -> %
+    reducedDouble: (UP, UP) -> %
+
+    0                    == divisor(1$R)
+
+    divisor(g:R)         == [1, 0, g, true]
+
+    makeDivisor(a, b, g) == [a, b, g, false]
+
+    princ? d             == (d.center = 1) and zero?(d.polyPart)
+
+    ideal d     == ideal([d.principalPart]) * mkIdeal(d.center, d.polyPart)
+
+    decompose d == [ideal makeDivisor(d.center, d.polyPart, 1),d.principalPart]
+
+    mkIdeal(a, b) == ideal [a::RF::R, reduce(monomial(1, 1)$UPUP-b::RF::UPUP)]
+
+    -- keep the sum reduced if d1 and d2 are both reduced at the start
+    d1 + d2 ==
+      a1  := d1.center;   a2 := d2.center
+      b1  := d1.polyPart; b2 := d2.polyPart
+      rec := principalIdeal [a1, a2, b1 + b2]
+      d   := rec.generator
+      h   := rec.coef              -- d = h1 a1 + h2 a2 + h3(b1 + b2)
+      a   := ((a1 * a2) exquo d**2)::UP
+      b:UP:= first(h) * a1 * b2
+      b   := b + second(h) * a2 * b1
+      b   := b + third(h) * (b1*b2 + hyper)
+      b   := (b exquo d)::UP rem a
+      dd  := makeDivisor(a, b, d::RF * d1.principalPart * d2.principalPart)
+      d1.reduced? and d2.reduced? => reduce dd
+      dd
+
+    -- if is cheaper to keep on reducing as we exponentiate 
+    -- if d is already reduced
+    n:Z * d:% ==
+      zero? n => 0
+      n < 0 => (-n) * (-d)
+      divisor(d.principalPart ** n) + divisor(mkIdeal(d.center,d.polyPart)**n)
+
+    divisor(i:ID) ==
+      (n := #(v := basis minimize i)) = 1 => divisor v minIndex v
+      n ^= 2 => ERR
+      a := v minIndex v
+      h := v maxIndex v
+      (u := polyIfCan a) case UP =>
+        (w := redpolyIfCan(h, u::UP)) case UP => makeDivisor(u::UP, w::UP, 1)
+        ERR
+      (u := polyIfCan h) case UP =>
+        (w := redpolyIfCan(a, u::UP)) case UP => makeDivisor(u::UP, w::UP, 1)
+        ERR
+      ERR
+
+    polyIfCan a ==
+      (u := retractIfCan(a)@Union(RF, "failed")) case "failed" => "failed"
+      (v := retractIfCan(u::RF)@Union(UP, "failed")) case "failed" => "failed"
+      v::UP
+
+    redpolyIfCan(h, a) ==
+      degree(p := lift h) ^= 1 => "failed"
+      q := - coefficient(p, 0) / coefficient(p, 1)
+      rec := extendedEuclidean(denom q, a)
+      not ground?(rec.generator) => "failed"
+      ((numer(q) * rec.coef1) exquo rec.generator)::UP rem a
+
+    coerce(d:%):O ==
+      r := bracket [d.center::O, d.polyPart::O]
+      g := prefix(dvd, [d.principalPart::O])
+      z := (d.principalPart = 1)
+      princ? d => (z => zer; g)
+      z => r
+      r + g
+
+    reduce d ==
+      d.reduced? => d
+      degree(a := d.center) <= gen => (d.reduced? := true; d)
+      b  := d.polyPart
+      a0 := ((hyper - b**2) exquo a)::UP
+      b0 := (-b) rem a0
+      g  := d.principalPart * reduce(b::RF::UPUP-monomial(1,1)$UPUP)/a0::RF::R
+      reduce makeDivisor(a0, b0, g)
+
+    generator d ==
+      d := reduce d
+      princ? d => d.principalPart
+      "failed"
+
+    - d ==
+      a := d.center
+      makeDivisor(a, - d.polyPart, inv(a::RF * d.principalPart))
+
+    d1 = d2 ==
+      d1 := reduce d1
+      d2 := reduce d2
+      d1.center = d2.center and d1.polyPart = d2.polyPart
+        and d1.principalPart = d2.principalPart
+
+    divisor(a, b) ==
+      x := monomial(1, 1)$UP
+      not ground? gcd(d := x - a::UP, retract(discriminant())@UP) =>
+                                  error "divisor: point is singular"
+      makeDivisor(d, b::UP, 1)
+
+    intReduce(h, b) ==
+      v := integralCoordinates(h).num
+      integralRepresents(
+                [qelt(v, i) rem b for i in minIndex v .. maxIndex v], 1)
+
+    -- with hyperelliptic curves, cheaper to keep divisors in reduced form
+    divisor(h, a, dp, g, r) ==
+      h  := h - (r * dp)::RF::R
+      a  := gcd(a, retract(norm h)@UP)
+      h  := intReduce(h, a)
+      if not ground? gcd(g, a) then h := intReduce(h ** rank(), a)
+      hh := lift h
+      b  := - coefficient(hh, 0) / coefficient(hh, 1)
+      rec := extendedEuclidean(denom b, a)
+      not ground?(rec.generator) => ERR
+      bb := ((numer(b) * rec.coef1) exquo rec.generator)::UP rem a
+      reduce makeDivisor(a, bb, 1)
+
+\end{chunk}
+
+\begin{chunk}{COQ HELLFDIV}
+(* domain HELLFDIV *)
+(*
+    if (uhyper:Union(UP, "failed") := hyperelliptic()$R) case "failed" then
+              error "HyperellipticFiniteDivisor: curve must be hyperelliptic"
+
+-- we use the semi-reduced representation from D.Cantor, "Computing in the
+-- Jacobian of a HyperellipticCurve", Mathematics of Computation, vol 48,
+-- no.177, January 1987, 95-101.
+-- The representation [a,b,f] for D means D = [a,b] + div(f)
+-- and [a,b] is a semi-reduced representative on the Jacobian
+
+    Rep := Record(center:UP, polyPart:UP, principalPart:R, reduced?:Boolean)
+
+    hyper:UP := uhyper::UP
+    gen:Z    := ((degree(hyper)::Z - 1) exquo 2)::Z     -- genus of the curve
+    dvd:O    := "div"::Symbol::O
+    zer:O    := 0::Z::O
+
+    makeDivisor  : (UP, UP, R) -> %
+    intReduc     : (R, UP) -> R
+    princ?       : % -> Boolean
+    polyIfCan    : R -> Union(UP, "failed")
+    redpolyIfCan : (R, UP) -> Union(UP, "failed")
+    intReduce    : (R, UP) -> R
+    mkIdeal      : (UP, UP) -> ID
+    reducedTimes : (Z, UP, UP) -> %
+    reducedDouble: (UP, UP) -> %
+
+    0                    == divisor(1$R)
+
+    divisor(g:R)         == [1, 0, g, true]
+
+    makeDivisor(a, b, g) == [a, b, g, false]
+
+    princ? d             == (d.center = 1) and zero?(d.polyPart)
+
+    ideal d     == ideal([d.principalPart]) * mkIdeal(d.center, d.polyPart)
+
+    decompose d == [ideal makeDivisor(d.center, d.polyPart, 1),d.principalPart]
+
+    mkIdeal(a, b) == ideal [a::RF::R, reduce(monomial(1, 1)$UPUP-b::RF::UPUP)]
+
+    -- keep the sum reduced if d1 and d2 are both reduced at the start
+    d1 + d2 ==
+      a1  := d1.center;   a2 := d2.center
+      b1  := d1.polyPart; b2 := d2.polyPart
+      rec := principalIdeal [a1, a2, b1 + b2]
+      d   := rec.generator
+      h   := rec.coef              -- d = h1 a1 + h2 a2 + h3(b1 + b2)
+      a   := ((a1 * a2) exquo d**2)::UP
+      b:UP:= first(h) * a1 * b2
+      b   := b + second(h) * a2 * b1
+      b   := b + third(h) * (b1*b2 + hyper)
+      b   := (b exquo d)::UP rem a
+      dd  := makeDivisor(a, b, d::RF * d1.principalPart * d2.principalPart)
+      d1.reduced? and d2.reduced? => reduce dd
+      dd
+
+    -- if is cheaper to keep on reducing as we exponentiate 
+    -- if d is already reduced
+    n:Z * d:% ==
+      zero? n => 0
+      n < 0 => (-n) * (-d)
+      divisor(d.principalPart ** n) + divisor(mkIdeal(d.center,d.polyPart)**n)
+
+    divisor(i:ID) ==
+      (n := #(v := basis minimize i)) = 1 => divisor v minIndex v
+      n ^= 2 => ERR
+      a := v minIndex v
+      h := v maxIndex v
+      (u := polyIfCan a) case UP =>
+        (w := redpolyIfCan(h, u::UP)) case UP => makeDivisor(u::UP, w::UP, 1)
+        ERR
+      (u := polyIfCan h) case UP =>
+        (w := redpolyIfCan(a, u::UP)) case UP => makeDivisor(u::UP, w::UP, 1)
+        ERR
+      ERR
+
+    polyIfCan a ==
+      (u := retractIfCan(a)@Union(RF, "failed")) case "failed" => "failed"
+      (v := retractIfCan(u::RF)@Union(UP, "failed")) case "failed" => "failed"
+      v::UP
+
+    redpolyIfCan(h, a) ==
+      degree(p := lift h) ^= 1 => "failed"
+      q := - coefficient(p, 0) / coefficient(p, 1)
+      rec := extendedEuclidean(denom q, a)
+      not ground?(rec.generator) => "failed"
+      ((numer(q) * rec.coef1) exquo rec.generator)::UP rem a
+
+    coerce(d:%):O ==
+      r := bracket [d.center::O, d.polyPart::O]
+      g := prefix(dvd, [d.principalPart::O])
+      z := (d.principalPart = 1)
+      princ? d => (z => zer; g)
+      z => r
+      r + g
+
+    reduce d ==
+      d.reduced? => d
+      degree(a := d.center) <= gen => (d.reduced? := true; d)
+      b  := d.polyPart
+      a0 := ((hyper - b**2) exquo a)::UP
+      b0 := (-b) rem a0
+      g  := d.principalPart * reduce(b::RF::UPUP-monomial(1,1)$UPUP)/a0::RF::R
+      reduce makeDivisor(a0, b0, g)
+
+    generator d ==
+      d := reduce d
+      princ? d => d.principalPart
+      "failed"
+
+    - d ==
+      a := d.center
+      makeDivisor(a, - d.polyPart, inv(a::RF * d.principalPart))
+
+    d1 = d2 ==
+      d1 := reduce d1
+      d2 := reduce d2
+      d1.center = d2.center and d1.polyPart = d2.polyPart
+        and d1.principalPart = d2.principalPart
+
+    divisor(a, b) ==
+      x := monomial(1, 1)$UP
+      not ground? gcd(d := x - a::UP, retract(discriminant())@UP) =>
+                                  error "divisor: point is singular"
+      makeDivisor(d, b::UP, 1)
+
+    intReduce(h, b) ==
+      v := integralCoordinates(h).num
+      integralRepresents(
+                [qelt(v, i) rem b for i in minIndex v .. maxIndex v], 1)
+
+    -- with hyperelliptic curves, cheaper to keep divisors in reduced form
+    divisor(h, a, dp, g, r) ==
+      h  := h - (r * dp)::RF::R
+      a  := gcd(a, retract(norm h)@UP)
+      h  := intReduce(h, a)
+      if not ground? gcd(g, a) then h := intReduce(h ** rank(), a)
+      hh := lift h
+      b  := - coefficient(hh, 0) / coefficient(hh, 1)
+      rec := extendedEuclidean(denom b, a)
+      not ground?(rec.generator) => ERR
+      bb := ((numer(b) * rec.coef1) exquo rec.generator)::UP rem a
+      reduce makeDivisor(a, bb, 1)
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{HELLFDIV.dotabb}
+"HELLFDIV" [color="#88FF44",href="bookvol10.3.pdf#nameddest=HELLFDIV"]
+"FDIVCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FDIVCAT"]
+"HELLFDIV" -> "FDIVCAT"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\chapter{Chapter I}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain ICP InfClsPt}
+
+\begin{chunk}{InfClsPt.input}
+)set break resume
+)sys rm -f InfClsPt.output
+)spool InfClsPt.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show InfClsPt
+--R 
+--R InfClsPt(K: Field,symb: List(Symbol),BLMET: BlowUpMethodCategory)  is a domain constructor
+--R Abbreviation for InfClsPt is ICP 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for ICP 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?=? : (%,%) -> Boolean                actualExtensionV : % -> K
+--R chartV : % -> BLMET                   coerce : % -> OutputForm
+--R degree : % -> PositiveInteger         excpDivV : % -> Divisor(Places(K))
+--R fullOut : % -> OutputForm             fullOutput : () -> Boolean
+--R fullOutput : Boolean -> Boolean       hash : % -> SingleInteger
+--R latex : % -> String                   localPointV : % -> AffinePlane(K)
+--R multV : % -> NonNegativeInteger       pointV : % -> ProjectivePlane(K)
+--R setchart! : (%,BLMET) -> BLMET        setsymbName! : (%,Symbol) -> Symbol
+--R subMultV : % -> NonNegativeInteger    symbNameV : % -> Symbol
+--R ?~=? : (%,%) -> Boolean              
+--R create : (ProjectivePlane(K),DistributedMultivariatePolynomial(symb,K)) -> %
+--R create : (ProjectivePlane(K),DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K),AffinePlane(K),NonNegativeInteger,BLMET,NonNegativeInteger,Divisor(Places(K)),K,Symbol) -> %
+--R curveV : % -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
+--R localParamV : % -> List(NeitherSparseOrDensePowerSeries(K))
+--R setcurve! : (%,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)) -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
+--R setexcpDiv! : (%,Divisor(Places(K))) -> Divisor(Places(K))
+--R setlocalParam! : (%,List(NeitherSparseOrDensePowerSeries(K))) -> List(NeitherSparseOrDensePowerSeries(K))
+--R setlocalPoint! : (%,AffinePlane(K)) -> AffinePlane(K)
+--R setmult! : (%,NonNegativeInteger) -> NonNegativeInteger
+--R setpoint! : (%,ProjectivePlane(K)) -> ProjectivePlane(K)
+--R setsubmult! : (%,NonNegativeInteger) -> NonNegativeInteger
+--R
+--E 1
+
+)spool
+)lisp (bye)
+
+\end{chunk}
+\begin{chunk}{InfClsPt.help}
+====================================================================
+InfClsPt examples
+====================================================================
+
+This domain is part of the PAFF package
+
+See Also:
+o )show InfClsPt
+
+\end{chunk}
+\pagehead{InfClsPt}{ICP}
+\pagepic{ps/v103infclspt.eps}{ICP}{1.00}
+
+{\bf Exports:}\\
+\begin{tabular}{lll}
+\cross{IC}{?=?} &
+\cross{IC}{?\~{}=?} &
+\cross{IC}{actualExtensionV} \\
+\cross{IC}{chartV} &
+\cross{IC}{coerce} &
+\cross{IC}{create} \\
+\cross{IC}{curveV} &
+\cross{IC}{degree} &
+\cross{IC}{excpDivV} \\
+\cross{IC}{fullOut} &
+\cross{IC}{fullOutput} &
+\cross{IC}{hash} \\
+\cross{IC}{latex} &
+\cross{IC}{localParamV} &
+\cross{IC}{localPointV} \\
+\cross{IC}{multV} &
+\cross{IC}{pointV} &
+\cross{IC}{setchart!} \\
+\cross{IC}{setcurve!} &
+\cross{IC}{setexcpDiv!} &
+\cross{IC}{setlocalParam!} \\
+\cross{IC}{setlocalPoint!} &
+\cross{IC}{setmult!} &
+\cross{IC}{setpoint!} \\
+\cross{IC}{setsubmult!} &
+\cross{IC}{setsymbName!} &
+\cross{IC}{subMultV} \\
+\cross{IC}{symbNameV} &&
+\end{tabular}
+
+\begin{chunk}{domain ICP InfClsPt}
+)abbrev domain ICP InfClsPt
+++ Authors: Gaetan Hache
+++ Date Created: june 1996 
+++ Date Last Updated: May 2010 by Tim Daly
+++ Description: 
+++ This domain is part of the PAFF package
+InfClsPt(K,symb,BLMET):Exports == Implementation where
+  K:Field
+  symb: List Symbol
+  BLMET : BlowUpMethodCategory
+
+  E         ==> DirectProduct(#symb,NonNegativeInteger)
+  PolyRing  ==> DistributedMultivariatePolynomial(symb,K) 
+  ProjPt    ==> ProjectivePlane(K)
+  PCS       ==> NeitherSparseOrDensePowerSeries(K)
+  Plc       ==> Places(K)
+  DIVISOR   ==> Divisor(Plc)
+
+  Exports == InfinitlyClosePointCategory(K,symb,PolyRing,E,ProjPt,_
+                                         PCS,Plc,DIVISOR,BLMET) with
+    fullOut: % -> OutputForm
+      ++ fullOut(tr) yields a full output of tr (see function fullOutput).
+
+    fullOutput: Boolean -> Boolean
+      ++ fullOutput(b) sets a flag such that when true, a coerce to 
+      ++ OutputForm yields the full output of tr, otherwise encode(tr) is 
+      ++ output (see encode function). The default is false.
+
+    fullOutput: () -> Boolean
+      ++ fullOutput returns the value of the flag set by fullOutput(b).   
+     
+  Implementation == InfinitlyClosePoint(K,symb,PolyRing,E,ProjPt,_
+                                        PCS,Plc,DIVISOR,BLMET) 
+
+
+\end{chunk}
+
+\begin{chunk}{COQ ICP}
+(* domain ICP *)
+(*
+*)
+
+\end{chunk}
+
+\begin{chunk}{ICP.dotabb}
+"ICP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ICP"]
+"INFCLSPT" [color="#88FF44",href="bookvol10.3.pdf#nameddest=INFCLSPT"]
+"PLACES" [color="#88FF44",href="bookvol10.3.pdf#nameddest=PLACES"]
+"ICP" -> "INFCLSPT"
+"ICP" -> "PLACES"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain ICARD IndexCard}
+
+\begin{chunk}{IndexCard.input}
+)set break resume
+)sys rm -f IndexCard.output
+)spool IndexCard.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show IndexCard
+--R 
+--R IndexCard  is a domain constructor
+--R Abbreviation for IndexCard is ICARD 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for ICARD 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?<? : (%,%) -> Boolean                ?<=? : (%,%) -> Boolean
+--R ?=? : (%,%) -> Boolean                ?>? : (%,%) -> Boolean
+--R ?>=? : (%,%) -> Boolean               coerce : String -> %
+--R coerce : % -> OutputForm              display : % -> Void
+--R ?.? : (%,Symbol) -> String            fullDisplay : % -> Void
+--R hash : % -> SingleInteger             latex : % -> String
+--R max : (%,%) -> %                      min : (%,%) -> %
+--R ?~=? : (%,%) -> Boolean              
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{IndexCard.help}
+====================================================================
+IndexCard examples
+====================================================================
+
+This domain implements a container of information about the AXIOM library
+
+See Also:
+o )show IndexCard
+
+\end{chunk}
+
+\pagehead{IndexCard}{ICARD}
+\pagepic{ps/v103indexcard.ps}{ICARD}{1.00}
+{\bf See}\\
+\pageto{DataList}{DLIST}
+\pageto{Database}{DBASE}
+\pageto{QueryEquation}{QEQUAT}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{ICARD}{coerce} &
+\cross{ICARD}{display} &
+\cross{ICARD}{fullDisplay} &
+\cross{ICARD}{hash} &
+\cross{ICARD}{latex} \\
+\cross{ICARD}{max} &
+\cross{ICARD}{min} &
+\cross{ICARD}{?\~{}=?} &
+\cross{ICARD}{?$<$?} &
+\cross{ICARD}{?$<=$?} \\
+\cross{ICARD}{?=?} &
+\cross{ICARD}{?$>$?} &
+\cross{ICARD}{?$>=$?} &
+\cross{ICARD}{?.?} &
+\end{tabular}
+
+\begin{chunk}{domain ICARD IndexCard}
+)abbrev domain ICARD IndexCard
+++ Author: Mark Botch
+++ Description:
+++ This domain implements a container of information about the AXIOM library
+
+IndexCard() : Exports == Implementation where
+  Exports == OrderedSet with
+    elt: (%,Symbol) -> String
+      ++ elt(ic,s) selects a particular field from \axiom{ic}.  Valid fields
+      ++ are \axiom{name, nargs, exposed, type, abbreviation, kind, origin,
+      ++ params, condition, doc}.
+    display: % -> Void
+      ++ display(ic) prints a summary of information contained in \axiom{ic}.
+    fullDisplay: % -> Void
+      ++ fullDisplay(ic) prints all of the information contained in \axiom{ic}.
+    coerce: String -> %
+      ++ coerce(s) converts \axiom{s} into an \axiom{IndexCard}.  Warning: if
+      ++ \axiom{s} is not of the right format then an error will occur 
+
+  Implementation == add
+
+    x<y==(x pretend String) < (y pretend String)
+
+    x=y==(x pretend String) = (y pretend String)
+
+    display(x) ==
+      name : OutputForm := dbName(x)$Lisp
+      type : OutputForm := dbPart(x,4,1$Lisp)$Lisp
+      output(hconcat(name,hconcat(" : ",type)))$OutputPackage
+
+    fullDisplay(x) ==
+      name : OutputForm := dbName(x)$Lisp
+      type : OutputForm := dbPart(x,4,1$Lisp)$Lisp
+      origin:OutputForm := 
+          hconcat(alqlGetOrigin(x$Lisp)$Lisp,alqlGetParams(x$Lisp)$Lisp)
+      fromPart : OutputForm := hconcat(" from ",origin)
+      condition : String := dbPart(x,6,1$Lisp)$Lisp
+      ifPart : OutputForm :=
+        condition = "" => empty()
+        hconcat(" if ",condition::OutputForm)
+      exposed? : String := SUBSTRING(dbPart(x,3,1)$Lisp,0,1)$Lisp 
+      exposedPart : OutputForm := 
+        exposed? = "n" => " (unexposed)"
+        empty()       
+      firstPart := hconcat(name,hconcat(" : ",type))
+      secondPart := hconcat(fromPart,hconcat(ifPart,exposedPart))
+      output(hconcat(firstPart,secondPart))$OutputPackage
+
+    coerce(s:String): % == (s pretend %)
+
+    coerce(x): OutputForm == (x pretend String)::OutputForm
+
+    elt(x,sel) ==
+      s := PNAME(sel)$Lisp pretend String
+      s = "name" => dbName(x)$Lisp
+      s = "nargs" => dbPart(x,2,1$Lisp)$Lisp
+      s = "exposed" => SUBSTRING(dbPart(x,3,1)$Lisp,0,1)$Lisp 
+      s = "type" => dbPart(x,4,1$Lisp)$Lisp
+      s = "abbreviation" => dbPart(x,5,1$Lisp)$Lisp
+      s = "kind" => alqlGetKindString(x)$Lisp
+      s = "origin" => alqlGetOrigin(x)$Lisp
+      s = "params" => alqlGetParams(x)$Lisp
+      s = "condition" => dbPart(x,6,1$Lisp)$Lisp
+      s = "doc" => dbComments(x)$Lisp
+      error "unknown selector"
+
+\end{chunk}
+
+\begin{chunk}{COQ ICARD}
+(* domain ICARD *)
+(*
+
+    x<y==(x pretend String) < (y pretend String)
+
+    x=y==(x pretend String) = (y pretend String)
+
+    display(x) ==
+      name : OutputForm := dbName(x)$Lisp
+      type : OutputForm := dbPart(x,4,1$Lisp)$Lisp
+      output(hconcat(name,hconcat(" : ",type)))$OutputPackage
+
+    fullDisplay(x) ==
+      name : OutputForm := dbName(x)$Lisp
+      type : OutputForm := dbPart(x,4,1$Lisp)$Lisp
+      origin:OutputForm := 
+          hconcat(alqlGetOrigin(x$Lisp)$Lisp,alqlGetParams(x$Lisp)$Lisp)
+      fromPart : OutputForm := hconcat(" from ",origin)
+      condition : String := dbPart(x,6,1$Lisp)$Lisp
+      ifPart : OutputForm :=
+        condition = "" => empty()
+        hconcat(" if ",condition::OutputForm)
+      exposed? : String := SUBSTRING(dbPart(x,3,1)$Lisp,0,1)$Lisp 
+      exposedPart : OutputForm := 
+        exposed? = "n" => " (unexposed)"
+        empty()       
+      firstPart := hconcat(name,hconcat(" : ",type))
+      secondPart := hconcat(fromPart,hconcat(ifPart,exposedPart))
+      output(hconcat(firstPart,secondPart))$OutputPackage
+
+    coerce(s:String): % == (s pretend %)
+
+    coerce(x): OutputForm == (x pretend String)::OutputForm
+
+    elt(x,sel) ==
+      s := PNAME(sel)$Lisp pretend String
+      s = "name" => dbName(x)$Lisp
+      s = "nargs" => dbPart(x,2,1$Lisp)$Lisp
+      s = "exposed" => SUBSTRING(dbPart(x,3,1)$Lisp,0,1)$Lisp 
+      s = "type" => dbPart(x,4,1$Lisp)$Lisp
+      s = "abbreviation" => dbPart(x,5,1$Lisp)$Lisp
+      s = "kind" => alqlGetKindString(x)$Lisp
+      s = "origin" => alqlGetOrigin(x)$Lisp
+      s = "params" => alqlGetParams(x)$Lisp
+      s = "condition" => dbPart(x,6,1$Lisp)$Lisp
+      s = "doc" => dbComments(x)$Lisp
+      error "unknown selector"
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{ICARD.dotabb}
+"ICARD" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ICARD"]
+"STRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=STRING"]
+"ICARD" -> "STRING"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain IBITS IndexedBits}
+
+\begin{chunk}{IndexedBits.input}
+)set break resume
+)sys rm -f IndexedBits.output
+)spool IndexedBits.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 14
+a:IBITS(32):=new(32,false)
+--R 
+--R
+--R   (1)  "00000000000000000000000000000000"
+--R                                                        Type: IndexedBits(32)
+--E 1
+
+--S 2 of 14
+b:IBITS(32):=new(32,true)
+--R 
+--R
+--R   (2)  "11111111111111111111111111111111"
+--R                                                        Type: IndexedBits(32)
+--E 2
+
+--S 3 of 14
+elt(a,3)
+--R 
+--R
+--R   (3)  false
+--R                                                                Type: Boolean
+--E 3
+
+--S 4 of 14
+setelt(a,3,true)
+--R 
+--R
+--R   (4)  true
+--R                                                                Type: Boolean
+--E 4
+
+--S 5 of 14
+a
+--R 
+--R
+--R   (5)  "00000000000000000000000000000100"
+--R                                                        Type: IndexedBits(32)
+--E 5
+
+--S 6 of 14
+#a
+--R 
+--R
+--R   (6)  32
+--R                                                        Type: PositiveInteger
+--E 6
+
+--S 7 of 14
+(a=a)$IBITS(32)
+--R 
+--R
+--R   (7)  true
+--R                                                                Type: Boolean
+--E 7
+
+--S 8 of 14
+(a=b)$IBITS(32)
+--R 
+--R
+--R   (8)  false
+--R                                                                Type: Boolean
+--E 8
+
+--S 9 of 14
+(a ~= b)
+--R 
+--R
+--R   (9)  true
+--R                                                                Type: Boolean
+--E 9
+
+--S 10 of 14
+Or(a,b)
+--R 
+--R
+--R   (10)  "11111111111111111111111111111111"
+--R                                                        Type: IndexedBits(32)
+--E 10
+
+--S 11 of 14
+And(a,b)
+--R 
+--R
+--R   (11)  "00000000000000000000000000000100"
+--R                                                        Type: IndexedBits(32)
+--E 11
+
+--S 12 of 14
+Not(a)
+--R 
+--R
+--R   (12)  "11111111111111111111111111111011"
+--R                                                        Type: IndexedBits(32)
+--E 12
+
+--S 13 of 14
+c:=copy a
+--R 
+--R
+--R   (13)  "00000000000000000000000000000100"
+--R                                                        Type: IndexedBits(32)
+--E 13
+
+--S 14 of 14
+)show IndexedBits
+--R 
+--R IndexedBits(mn: Integer)  is a domain constructor
+--R Abbreviation for IndexedBits is IBITS 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IBITS 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?/\? : (%,%) -> %                     ?<? : (%,%) -> Boolean
+--R ?<=? : (%,%) -> Boolean               ?=? : (%,%) -> Boolean
+--R ?>? : (%,%) -> Boolean                ?>=? : (%,%) -> Boolean
+--R And : (%,%) -> %                      Not : % -> %
+--R Or : (%,%) -> %                       ?\/? : (%,%) -> %
+--R ^? : % -> %                           ?and? : (%,%) -> %
+--R coerce : % -> OutputForm              concat : (%,Boolean) -> %
+--R concat : (Boolean,%) -> %             concat : (%,%) -> %
+--R concat : List(%) -> %                 construct : List(Boolean) -> %
+--R copy : % -> %                         delete : (%,Integer) -> %
+--R ?.? : (%,Integer) -> Boolean          empty : () -> %
+--R empty? : % -> Boolean                 entries : % -> List(Boolean)
+--R eq? : (%,%) -> Boolean                hash : % -> SingleInteger
+--R index? : (Integer,%) -> Boolean       indices : % -> List(Integer)
+--R insert : (Boolean,%,Integer) -> %     insert : (%,%,Integer) -> %
+--R latex : % -> String                   max : (%,%) -> %
+--R min : (%,%) -> %                      nand : (%,%) -> %
+--R nor : (%,%) -> %                      not? : % -> %
+--R ?or? : (%,%) -> %                     qelt : (%,Integer) -> Boolean
+--R reverse : % -> %                      sample : () -> %
+--R xor : (%,%) -> %                      ~? : % -> %
+--R ?~=? : (%,%) -> Boolean              
+--R #? : % -> NonNegativeInteger if $ has finiteAggregate
+--R any? : ((Boolean -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R convert : % -> InputForm if Boolean has KONVERT(INFORM)
+--R copyInto! : (%,%,Integer) -> % if $ has shallowlyMutable
+--R count : ((Boolean -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
+--R count : (Boolean,%) -> NonNegativeInteger if $ has finiteAggregate and Boolean has SETCAT
+--R delete : (%,UniversalSegment(Integer)) -> %
+--R elt : (%,Integer,Boolean) -> Boolean
+--R ?.? : (%,UniversalSegment(Integer)) -> %
+--R entry? : (Boolean,%) -> Boolean if $ has finiteAggregate and Boolean has SETCAT
+--R eval : (%,List(Equation(Boolean))) -> % if Boolean has EVALAB(BOOLEAN) and Boolean has SETCAT
+--R eval : (%,Equation(Boolean)) -> % if Boolean has EVALAB(BOOLEAN) and Boolean has SETCAT
+--R eval : (%,Boolean,Boolean) -> % if Boolean has EVALAB(BOOLEAN) and Boolean has SETCAT
+--R eval : (%,List(Boolean),List(Boolean)) -> % if Boolean has EVALAB(BOOLEAN) and Boolean has SETCAT
+--R every? : ((Boolean -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R fill! : (%,Boolean) -> % if $ has shallowlyMutable
+--R find : ((Boolean -> Boolean),%) -> Union(Boolean,"failed")
+--R first : % -> Boolean if Integer has ORDSET
+--R less? : (%,NonNegativeInteger) -> Boolean
+--R map : ((Boolean -> Boolean),%) -> %
+--R map : (((Boolean,Boolean) -> Boolean),%,%) -> %
+--R map! : ((Boolean -> Boolean),%) -> % if $ has shallowlyMutable
+--R maxIndex : % -> Integer if Integer has ORDSET
+--R member? : (Boolean,%) -> Boolean if $ has finiteAggregate and Boolean has SETCAT
+--R members : % -> List(Boolean) if $ has finiteAggregate
+--R merge : (((Boolean,Boolean) -> Boolean),%,%) -> %
+--R merge : (%,%) -> % if Boolean has ORDSET
+--R minIndex : % -> Integer if Integer has ORDSET
+--R more? : (%,NonNegativeInteger) -> Boolean
+--R new : (NonNegativeInteger,Boolean) -> %
+--R parts : % -> List(Boolean) if $ has finiteAggregate
+--R position : ((Boolean -> Boolean),%) -> Integer
+--R position : (Boolean,%) -> Integer if Boolean has SETCAT
+--R position : (Boolean,%,Integer) -> Integer if Boolean has SETCAT
+--R qsetelt! : (%,Integer,Boolean) -> Boolean if $ has shallowlyMutable
+--R reduce : (((Boolean,Boolean) -> Boolean),%,Boolean,Boolean) -> Boolean if $ has finiteAggregate and Boolean has SETCAT
+--R reduce : (((Boolean,Boolean) -> Boolean),%,Boolean) -> Boolean if $ has finiteAggregate
+--R reduce : (((Boolean,Boolean) -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R remove : (Boolean,%) -> % if $ has finiteAggregate and Boolean has SETCAT
+--R remove : ((Boolean -> Boolean),%) -> % if $ has finiteAggregate
+--R removeDuplicates : % -> % if $ has finiteAggregate and Boolean has SETCAT
+--R reverse! : % -> % if $ has shallowlyMutable
+--R select : ((Boolean -> Boolean),%) -> % if $ has finiteAggregate
+--R setelt : (%,Integer,Boolean) -> Boolean if $ has shallowlyMutable
+--R setelt : (%,UniversalSegment(Integer),Boolean) -> Boolean if $ has shallowlyMutable
+--R size? : (%,NonNegativeInteger) -> Boolean
+--R sort : (((Boolean,Boolean) -> Boolean),%) -> %
+--R sort : % -> % if Boolean has ORDSET
+--R sort! : (((Boolean,Boolean) -> Boolean),%) -> % if $ has shallowlyMutable
+--R sort! : % -> % if $ has shallowlyMutable and Boolean has ORDSET
+--R sorted? : (((Boolean,Boolean) -> Boolean),%) -> Boolean
+--R sorted? : % -> Boolean if Boolean has ORDSET
+--R swap! : (%,Integer,Integer) -> Void if $ has shallowlyMutable
+--R
+--E 14
+
+)spool
+)lisp (bye)
+\end{chunk}
+
+\begin{chunk}{IndexedBits.help}
+====================================================================
+IndexedBits
+====================================================================
+
+a:IBITS(32):=new(32,false)
+  "00000000000000000000000000000000"
+
+b:IBITS(32):=new(32,true)
+  "11111111111111111111111111111111"
+
+elt(a,3)
+  false
+
+setelt(a,3,true)
+  true
+
+a
+  "00000000000000000000000000000100"
+
+#a
+  32
+
+(a=a)$IBITS(32)
+  true
+
+(a=b)$IBITS(32)
+  false
+
+(a ~= b)
+  true
+
+Or(a,b)
+  "11111111111111111111111111111111"
+
+And(a,b)
+  "00000000000000000000000000000100"
+
+Not(a)
+  "11111111111111111111111111111011"
+
+c:=copy a
+  "00000000000000000000000000000100"
+
+See Also:
+o )show IndexedBits
+
+\end{chunk}
+\pagehead{IndexedBits}{IBITS}
+\pagepic{ps/v103indexedbits.ps}{IBITS}{1.00}
+{\bf See}\\
+\pageto{Reference}{REF}
+\pageto{Boolean}{BOOLEAN}
+\pageto{Bits}{BITS}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{IBITS}{And} &
+\cross{IBITS}{any?} &
+\cross{IBITS}{coerce} &
+\cross{IBITS}{concat} &
+\cross{IBITS}{construct} \\
+\cross{IBITS}{convert} &
+\cross{IBITS}{copy} &
+\cross{IBITS}{copyInto!} &
+\cross{IBITS}{count} &
+\cross{IBITS}{count} \\
+\cross{IBITS}{delete} &
+\cross{IBITS}{elt} &
+\cross{IBITS}{empty} &
+\cross{IBITS}{empty?} &
+\cross{IBITS}{entries} \\
+\cross{IBITS}{entry?} &
+\cross{IBITS}{eq?} &
+\cross{IBITS}{eval} &
+\cross{IBITS}{every?} &
+\cross{IBITS}{fill!} \\
+\cross{IBITS}{find} &
+\cross{IBITS}{first} &
+\cross{IBITS}{hash} &
+\cross{IBITS}{index?} &
+\cross{IBITS}{indices} \\
+\cross{IBITS}{insert} &
+\cross{IBITS}{latex} &
+\cross{IBITS}{less?} &
+\cross{IBITS}{map} &
+\cross{IBITS}{map!} \\
+\cross{IBITS}{max} &
+\cross{IBITS}{maxIndex} &
+\cross{IBITS}{member?} &
+\cross{IBITS}{members} &
+\cross{IBITS}{merge} \\
+\cross{IBITS}{min} &
+\cross{IBITS}{minIndex} &
+\cross{IBITS}{more?} &
+\cross{IBITS}{nand} &
+\cross{IBITS}{new} \\
+\cross{IBITS}{nor} &
+\cross{IBITS}{Not} &
+\cross{IBITS}{not?} &
+\cross{IBITS}{Or} &
+\cross{IBITS}{parts} \\
+\cross{IBITS}{position} &
+\cross{IBITS}{qelt} &
+\cross{IBITS}{qsetelt!} &
+\cross{IBITS}{reduce} &
+\cross{IBITS}{removeDuplicates} \\
+\cross{IBITS}{reverse} &
+\cross{IBITS}{reverse!} &
+\cross{IBITS}{sample} &
+\cross{IBITS}{select} &
+\cross{IBITS}{size?} \\
+\cross{IBITS}{sort} &
+\cross{IBITS}{sort!} &
+\cross{IBITS}{sorted?} &
+\cross{IBITS}{swap!} &
+\cross{IBITS}{xor} \\
+\cross{IBITS}{\#{}?} &
+\cross{IBITS}{?.?} &
+\cross{IBITS}{?/$\backslash{}$?} &
+\cross{IBITS}{?$<$?} &
+\cross{IBITS}{?$<=$?} \\
+\cross{IBITS}{?=?} &
+\cross{IBITS}{?$>$?} &
+\cross{IBITS}{?$>=$?} &
+\cross{IBITS}{?$\backslash{}$/?} &
+\cross{IBITS}{\^{}?} \\
+\cross{IBITS}{?.?} &
+\cross{IBITS}{\~{}?} &
+\cross{IBITS}{?\~{}=?} &
+\cross{IBITS}{?or?} &
+\cross{IBITS}{?and?} 
+\end{tabular}
+
+\begin{chunk}{domain IBITS IndexedBits}
+)abbrev domain IBITS IndexedBits
+++ Author: Stephen Watt and Michael Monagan
+++ Date Created: July 86
+++ Change History:  Oct 87
+++ Description: 
+++ \spadtype{IndexedBits} is a domain to compactly represent
+++ large quantities of Boolean data.
+
+IndexedBits(mn:Integer): BitAggregate() with
+        -- temporaries until parser gets better
+        Not: % -> %
+            ++ Not(n) returns the bit-by-bit logical Not of n.
+        Or : (%, %) -> %
+            ++ Or(n,m)  returns the bit-by-bit logical Or of
+            ++ n and m.
+        And: (%, %) -> %
+            ++ And(n,m)  returns the bit-by-bit logical And of
+            ++ n and m.
+    == add
+
+        range: (%, Integer) -> Integer
+          --++ range(j,i) returnes the range i of the boolean j.
+
+        minIndex u  == mn
+
+        range(v, i) ==
+          i >= 0 and i < #v => i
+          error "Index out of range"
+
+        coerce(v):OutputForm ==
+            t:Character := char "1"
+            f:Character := char "0"
+            s := new(#v, space()$Character)$String
+            for i in minIndex(s)..maxIndex(s) for j in mn.. repeat
+              s.i := if v.j then t else f
+            s::OutputForm
+
+        new(n, b)       == BVEC_-MAKE_-FULL(n,TRUTH_-TO_-BIT(b)$Lisp)$Lisp
+
+        empty()         == BVEC_-MAKE_-FULL(0,0)$Lisp
+
+        copy v          == BVEC_-COPY(v)$Lisp
+
+        #v              == BVEC_-SIZE(v)$Lisp
+
+        v = u           == BVEC_-EQUAL(v, u)$Lisp
+
+        v < u           == BVEC_-GREATER(u, v)$Lisp
+
+        _and(u, v)      == (#v=#u => BVEC_-AND(v,u)$Lisp; map("and",v,u))
+
+        _or(u, v)       == (#v=#u => BVEC_-OR(v, u)$Lisp; map("or", v,u))
+
+        xor(v,u)        == (#v=#u => BVEC_-XOR(v,u)$Lisp; map("xor",v,u))
+
+        setelt(v:%, i:Integer, f:Boolean) ==
+          BVEC_-SETELT(v, range(v, abs(i-mn)), TRUTH_-TO_-BIT(f)$Lisp)$Lisp
+
+        elt(v:%, i:Integer) ==
+          BIT_-TO_-TRUTH(BVEC_-ELT(v, range(v, abs(i-mn)))$Lisp)$Lisp
+
+        Not v           == BVEC_-NOT(v)$Lisp
+
+        And(u, v)       == (#v=#u => BVEC_-AND(v,u)$Lisp; map("and",v,u))
+
+        Or(u, v)        == (#v=#u => BVEC_-OR(v, u)$Lisp; map("or", v,u))
+
+\end{chunk}
+
+\begin{chunk}{COQ IBITS}
+(* domain IBITS *)
+(*
+
+        range: (%, Integer) -> Integer
+          --++ range(j,i) returnes the range i of the boolean j.
+
+        minIndex u  == mn
+
+        range(v, i) ==
+          i >= 0 and i < #v => i
+          error "Index out of range"
+
+        coerce(v):OutputForm ==
+            t:Character := char "1"
+            f:Character := char "0"
+            s := new(#v, space()$Character)$String
+            for i in minIndex(s)..maxIndex(s) for j in mn.. repeat
+              s.i := if v.j then t else f
+            s::OutputForm
+
+        new(n, b)       == BVEC_-MAKE_-FULL(n,TRUTH_-TO_-BIT(b)$Lisp)$Lisp
+
+        empty()         == BVEC_-MAKE_-FULL(0,0)$Lisp
+
+        copy v          == BVEC_-COPY(v)$Lisp
+
+        #v              == BVEC_-SIZE(v)$Lisp
+
+        v = u           == BVEC_-EQUAL(v, u)$Lisp
+
+        v < u           == BVEC_-GREATER(u, v)$Lisp
+
+        _and(u, v)      == (#v=#u => BVEC_-AND(v,u)$Lisp; map("and",v,u))
+
+        _or(u, v)       == (#v=#u => BVEC_-OR(v, u)$Lisp; map("or", v,u))
+
+        xor(v,u)        == (#v=#u => BVEC_-XOR(v,u)$Lisp; map("xor",v,u))
+
+        setelt(v:%, i:Integer, f:Boolean) ==
+          BVEC_-SETELT(v, range(v, abs(i-mn)), TRUTH_-TO_-BIT(f)$Lisp)$Lisp
+
+        elt(v:%, i:Integer) ==
+          BIT_-TO_-TRUTH(BVEC_-ELT(v, range(v, abs(i-mn)))$Lisp)$Lisp
+
+        Not v           == BVEC_-NOT(v)$Lisp
+
+        And(u, v)       == (#v=#u => BVEC_-AND(v,u)$Lisp; map("and",v,u))
+
+        Or(u, v)        == (#v=#u => BVEC_-OR(v, u)$Lisp; map("or", v,u))
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{IBITS.dotabb}
+"IBITS" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IBITS"]
+"STRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=STRING"]
+"IBITS" -> "STRING"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain IDPAG IndexedDirectProductAbelianGroup}
+
+\begin{chunk}{IndexedDirectProductAbelianGroup.input}
+)set break resume
+)sys rm -f IndexedDirectProductAbelianGroup.output
+)spool IndexedDirectProductAbelianGroup.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show IndexedDirectProductAbelianGroup
+--R 
+--R IndexedDirectProductAbelianGroup(A: AbelianGroup,S: OrderedSet)  is a domain constructor
+--R Abbreviation for IndexedDirectProductAbelianGroup is IDPAG 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IDPAG 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (Integer,%) -> %                ?*? : (NonNegativeInteger,%) -> %
+--R ?*? : (PositiveInteger,%) -> %        ?+? : (%,%) -> %
+--R ?-? : (%,%) -> %                      -? : % -> %
+--R ?=? : (%,%) -> Boolean                0 : () -> %
+--R coerce : % -> OutputForm              hash : % -> SingleInteger
+--R latex : % -> String                   leadingCoefficient : % -> A
+--R leadingSupport : % -> S               map : ((A -> A),%) -> %
+--R monomial : (A,S) -> %                 reductum : % -> %
+--R sample : () -> %                      zero? : % -> Boolean
+--R ?~=? : (%,%) -> Boolean              
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{IndexedDirectProductAbelianGroup.help}
+====================================================================
+IndexedDirectProductAbelianGroup examples
+====================================================================
+
+Indexed direct products of abelian groups over an abelian group A of
+generators indexed by the ordered set S.  All items have finite
+support: only non-zero terms are stored.
+
+See Also:
+o )show IndexedDirectProductAbelianGroup
+
+\end{chunk}
+
+\pagehead{IndexedDirectProductAbelianGroup}{IDPAG}
+\pagepic{ps/v103indexeddirectproductabeliangroup.ps}{IDPAG}{1.00}
+{\bf See}\\
+\pageto{IndexedDirectProductObject}{IDPO}
+\pageto{IndexedDirectProductAbelianMonoid}{IDPAM}
+\pageto{IndexedDirectProductOrderedAbelianMonoid}{IDPOAM}
+\pageto{IndexedDirectProductOrderedAbelianMonoidSup}{IDPOAMS}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{IDPAG}{0} &
+\cross{IDPAG}{coerce} &
+\cross{IDPAG}{hash} &
+\cross{IDPAG}{latex} &
+\cross{IDPAG}{leadingCoefficient} \\
+\cross{IDPAG}{leadingSupport} &
+\cross{IDPAG}{map} &
+\cross{IDPAG}{monomial} &
+\cross{IDPAG}{reductum} &
+\cross{IDPAG}{sample} \\
+\cross{IDPAG}{subtractIfCan} &
+\cross{IDPAG}{zero?} &
+\cross{IDPAG}{?\~{}=?} &
+\cross{IDPAG}{?*?} &
+\cross{IDPAG}{?+?} \\
+\cross{IDPAG}{?-?} &
+\cross{IDPAG}{-?} &
+\cross{IDPAG}{?=?} &&
+\end{tabular}
+
+\begin{chunk}{domain IDPAG IndexedDirectProductAbelianGroup}
+)abbrev domain IDPAG IndexedDirectProductAbelianGroup
+++ Author: Mark Botch
+++ Description:
+++ Indexed direct products of abelian groups over an abelian group \spad{A} of
+++ generators indexed by the ordered set S.
+++ All items have finite support: only non-zero terms are stored.
+
+IndexedDirectProductAbelianGroup(A:AbelianGroup,S:OrderedSet):
+    Join(AbelianGroup,IndexedDirectProductCategory(A,S))
+ ==  IndexedDirectProductAbelianMonoid(A,S) add
+    --representations
+       Term:=  Record(k:S,c:A)
+       Rep:=  List Term
+       x,y: %
+       r: A
+       n: Integer
+       f: A -> A
+       s: S
+
+       -x == [[u.k,-u.c] for u in x]
+
+       n * x  ==
+             n = 0 => 0
+             n = 1 => x
+             [[u.k,a] for u in x | (a:=n*u.c) ^= 0$A]
+
+       qsetrest!: (Rep, Rep) -> Rep
+       qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp
+
+       x - y ==
+          null x => -y
+          null y => x
+          endcell: Rep := empty()
+          res:  Rep := empty()
+          while not empty? x and not empty? y repeat
+                  newcell := empty()
+                  if x.first.k = y.first.k then
+                          r:= x.first.c - y.first.c
+                          if not zero? r then
+                                  newcell:= cons([x.first.k, r], empty())
+                          x := rest x
+                          y := rest y
+                  else if x.first.k > y.first.k then
+                          newcell := cons(x.first, empty())
+                          x := rest x
+                  else
+                          newcell:= cons([y.first.k,-y.first.c], empty())
+                          y := rest y
+                  if not empty? newcell then
+                          if not empty? endcell then
+                                  qsetrest!(endcell, newcell)
+                                  endcell := newcell
+                          else
+                                  res     := newcell;
+                                  endcell := res
+          if empty? x then end := - y
+          else end := x
+          if empty? res then res := end
+          else qsetrest!(endcell, end)
+          res
+
+\end{chunk}
+
+\begin{chunk}{COQ IDPAG}
+(* domain IDPAG *)
+(*
+  IndexedDirectProductAbelianMonoid(A,S) add
+    --representations
+       Term:=  Record(k:S,c:A)
+       Rep:=  List Term
+       x,y: %
+       r: A
+       n: Integer
+       f: A -> A
+       s: S
+
+       -x == [[u.k,-u.c] for u in x]
+
+       n * x  ==
+             n = 0 => 0
+             n = 1 => x
+             [[u.k,a] for u in x | (a:=n*u.c) ^= 0$A]
+
+       qsetrest!: (Rep, Rep) -> Rep
+       qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp
+
+       x - y ==
+          null x => -y
+          null y => x
+          endcell: Rep := empty()
+          res:  Rep := empty()
+          while not empty? x and not empty? y repeat
+                  newcell := empty()
+                  if x.first.k = y.first.k then
+                          r:= x.first.c - y.first.c
+                          if not zero? r then
+                                  newcell:= cons([x.first.k, r], empty())
+                          x := rest x
+                          y := rest y
+                  else if x.first.k > y.first.k then
+                          newcell := cons(x.first, empty())
+                          x := rest x
+                  else
+                          newcell:= cons([y.first.k,-y.first.c], empty())
+                          y := rest y
+                  if not empty? newcell then
+                          if not empty? endcell then
+                                  qsetrest!(endcell, newcell)
+                                  endcell := newcell
+                          else
+                                  res     := newcell;
+                                  endcell := res
+          if empty? x then end := - y
+          else end := x
+          if empty? res then res := end
+          else qsetrest!(endcell, end)
+          res
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{IDPAG.dotabb}
+"IDPAG" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IDPAG"]
+"ORDSET" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ORDSET"]
+"IDPC" [color="#4488FF",href="bookvol10.2.pdf#nameddest=IDPC"]
+"IDPAG" -> "IDPC"
+"IDPAG" -> "ORDSET"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain IDPAM IndexedDirectProductAbelianMonoid}
+
+\begin{chunk}{IndexedDirectProductAbelianMonoid.input}
+)set break resume
+)sys rm -f IndexedDirectProductAbelianMonoid.output
+)spool IndexedDirectProductAbelianMonoid.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show IndexedDirectProductAbelianMonoid
+--R 
+--R IndexedDirectProductAbelianMonoid(A: AbelianMonoid,S: OrderedSet)  is a domain constructor
+--R Abbreviation for IndexedDirectProductAbelianMonoid is IDPAM 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IDPAM 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
+--R ?+? : (%,%) -> %                      ?=? : (%,%) -> Boolean
+--R 0 : () -> %                           coerce : % -> OutputForm
+--R hash : % -> SingleInteger             latex : % -> String
+--R leadingCoefficient : % -> A           leadingSupport : % -> S
+--R map : ((A -> A),%) -> %               monomial : (A,S) -> %
+--R reductum : % -> %                     sample : () -> %
+--R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{IndexedDirectProductAbelianMonoid.help}
+====================================================================
+IndexedDirectProductAbelianMonoid examples
+====================================================================
+
+Indexed direct products of abelian monoids over an abelian monoid 
+A of generators indexed by the ordered set S. All items have 
+finite support. Only non-zero terms are stored.
+
+See Also:
+o )show IndexedDirectProductAbelianMonoid
+
+\end{chunk}
+
+\pagehead{IndexedDirectProductAbelianMonoid}{IDPAM}
+\pagepic{ps/v103indexeddirectproductabelianmonoid.ps}{IDPAM}{1.00}
+{\bf See}\\
+\pageto{IndexedDirectProductObject}{IDPO}
+\pageto{IndexedDirectProductOrderedAbelianMonoid}{IDPOAM}
+\pageto{IndexedDirectProductOrderedAbelianMonoidSup}{IDPOAMS}
+\pageto{IndexedDirectProductAbelianGroup}{IDPAG}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{IDPAM}{0} &
+\cross{IDPAM}{coerce} &
+\cross{IDPAM}{hash} &
+\cross{IDPAM}{latex} &
+\cross{IDPAM}{leadingCoefficient} \\
+\cross{IDPAM}{leadingSupport} &
+\cross{IDPAM}{map} &
+\cross{IDPAM}{monomial} &
+\cross{IDPAM}{reductum} &
+\cross{IDPAM}{sample} \\
+\cross{IDPAM}{zero?} &
+\cross{IDPAM}{?\~{}=?} &
+\cross{IDPAM}{?*?} &
+\cross{IDPAM}{?+?} &
+\cross{IDPAM}{?=?}
+\end{tabular}
+
+\begin{chunk}{domain IDPAM IndexedDirectProductAbelianMonoid}
+)abbrev domain IDPAM IndexedDirectProductAbelianMonoid
+++ Author: Mark Botch
+++ Description:
+++ Indexed direct products of abelian monoids over an abelian monoid 
+++ \spad{A} of generators indexed by the ordered set S. All items have 
+++ finite support. Only non-zero terms are stored.
+
+IndexedDirectProductAbelianMonoid(A:AbelianMonoid,S:OrderedSet):
+    Join(AbelianMonoid,IndexedDirectProductCategory(A,S))
+ ==  IndexedDirectProductObject(A,S) add
+
+    --representations
+       Term:=  Record(k:S,c:A)
+       Rep:=  List Term
+       x,y: %
+       r: A
+       n: NonNegativeInteger
+       f: A -> A
+       s: S
+
+       0  == []
+
+       zero? x ==  null x
+
+        -- PERFORMANCE CRITICAL; Should build list up
+        --  by merging 2 sorted lists.   Doing this will
+        -- avoid the recursive calls (very useful if there is a
+        -- large number of vars in a polynomial.
+       qsetrest!: (Rep, Rep) -> Rep
+       qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp
+
+       x + y == 
+        null x => y
+        null y => x
+        endcell: Rep := empty()
+        res:  Rep := empty()
+        while not empty? x and not empty? y repeat 
+            newcell := empty()
+            if x.first.k = y.first.k then
+                r:= x.first.c + y.first.c
+                if not zero? r then 
+                    newcell := cons([x.first.k, r], empty())
+                x := rest x
+                y := rest y
+            else if x.first.k > y.first.k then
+                newcell := cons(x.first, empty())
+                x := rest x
+            else
+                newcell := cons(y.first, empty())
+                y := rest y
+            if not empty? newcell then 
+                if not empty? endcell then
+                    qsetrest!(endcell, newcell)
+                    endcell := newcell
+                else
+                    res     := newcell;
+                    endcell := res
+        if empty? x then end := y
+        else end := x
+        if empty? res then res := end
+        else qsetrest!(endcell, end)
+        res
+
+       n * x  ==
+             n = 0 => 0
+             n = 1 => x
+             [[u.k,a] for u in x | (a:=n*u.c) ^= 0$A]
+
+       monomial(r,s) == (r = 0 => 0; [[s,r]])
+
+       map(f,x) == [[tm.k,a] for tm in x | (a:=f(tm.c)) ^= 0$A]
+
+       reductum x     == (null x => 0; rest x)
+
+       leadingCoefficient x  == (null x => 0; x.first.c)
+
+\end{chunk}
+
+\begin{chunk}{COQ IDPAM}
+(* domain IDPAM *)
+(*
+  IndexedDirectProductObject(A,S) add
+
+    --representations
+       Term:=  Record(k:S,c:A)
+       Rep:=  List Term
+       x,y: %
+       r: A
+       n: NonNegativeInteger
+       f: A -> A
+       s: S
+
+       0  == []
+
+       zero? x ==  null x
+
+        -- PERFORMANCE CRITICAL; Should build list up
+        --  by merging 2 sorted lists.   Doing this will
+        -- avoid the recursive calls (very useful if there is a
+        -- large number of vars in a polynomial.
+       qsetrest!: (Rep, Rep) -> Rep
+       qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp
+
+       x + y == 
+        null x => y
+        null y => x
+        endcell: Rep := empty()
+        res:  Rep := empty()
+        while not empty? x and not empty? y repeat 
+            newcell := empty()
+            if x.first.k = y.first.k then
+                r:= x.first.c + y.first.c
+                if not zero? r then 
+                    newcell := cons([x.first.k, r], empty())
+                x := rest x
+                y := rest y
+            else if x.first.k > y.first.k then
+                newcell := cons(x.first, empty())
+                x := rest x
+            else
+                newcell := cons(y.first, empty())
+                y := rest y
+            if not empty? newcell then 
+                if not empty? endcell then
+                    qsetrest!(endcell, newcell)
+                    endcell := newcell
+                else
+                    res     := newcell;
+                    endcell := res
+        if empty? x then end := y
+        else end := x
+        if empty? res then res := end
+        else qsetrest!(endcell, end)
+        res
+
+       n * x  ==
+             n = 0 => 0
+             n = 1 => x
+             [[u.k,a] for u in x | (a:=n*u.c) ^= 0$A]
+
+       monomial(r,s) == (r = 0 => 0; [[s,r]])
+
+       map(f,x) == [[tm.k,a] for tm in x | (a:=f(tm.c)) ^= 0$A]
+
+       reductum x     == (null x => 0; rest x)
+
+       leadingCoefficient x  == (null x => 0; x.first.c)
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{IDPAM.dotabb}
+"IDPAM" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IDPAM"]
+"ORDSET" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ORDSET"]
+"IDPC" [color="#4488FF",href="bookvol10.2.pdf#nameddest=IDPC"]
+"IDPAM" -> "IDPC"
+"IDPAM" -> "ORDSET"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain IDPO IndexedDirectProductObject}
+
+\begin{chunk}{IndexedDirectProductObject.input}
+)set break resume
+)sys rm -f IndexedDirectProductObject.output
+)spool IndexedDirectProductObject.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show IndexedDirectProductObject
+--R 
+--R IndexedDirectProductObject(A: SetCategory,S: OrderedSet)  is a domain constructor
+--R Abbreviation for IndexedDirectProductObject is IDPO 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IDPO 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?=? : (%,%) -> Boolean                coerce : % -> OutputForm
+--R hash : % -> SingleInteger             latex : % -> String
+--R leadingCoefficient : % -> A           leadingSupport : % -> S
+--R map : ((A -> A),%) -> %               monomial : (A,S) -> %
+--R reductum : % -> %                     ?~=? : (%,%) -> Boolean
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{IndexedDirectProductObject.help}
+====================================================================
+IndexedDirectProductObject examples
+====================================================================
+
+Indexed direct products of objects over a set A of generators indexed
+by an ordered set S. All items have finite support.
+
+See Also:
+o )show IndexedDirectProductObject
+
+\end{chunk}
+
+\pagehead{IndexedDirectProductObject}{IDPO}
+\pagepic{ps/v103indexeddirectproductobject.ps}{IDPO}{1.00}
+{\bf See}\\
+\pageto{IndexedDirectProductAbelianMonoid}{IDPAM}
+\pageto{IndexedDirectProductOrderedAbelianMonoid}{IDPOAM}
+\pageto{IndexedDirectProductOrderedAbelianMonoidSup}{IDPOAMS}
+\pageto{IndexedDirectProductAbelianGroup}{IDPAG}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{IDPO}{coerce} &
+\cross{IDPO}{hash} &
+\cross{IDPO}{latex} &
+\cross{IDPO}{leadingCoefficient} &
+\cross{IDPO}{leadingSupport} \\
+\cross{IDPO}{map} &
+\cross{IDPO}{monomial} &
+\cross{IDPO}{reductum} &
+\cross{IDPO}{?=?} &
+\cross{IDPO}{?\~{}=?} 
+\end{tabular}
+
+\begin{chunk}{domain IDPO IndexedDirectProductObject}
+)abbrev domain IDPO IndexedDirectProductObject
+++ Author: Mark Botch
+++ Description:
+++ Indexed direct products of objects over a set \spad{A}
+++ of generators indexed by an ordered set S. All items have finite support.
+
+IndexedDirectProductObject(A:SetCategory,S:OrderedSet): _
+  IndexedDirectProductCategory(A,S)
+ == add
+
+    --representations
+       Term:=  Record(k:S,c:A)
+       Rep:=  List Term
+
+    --declarations
+       x,y: %
+       f: A -> A
+       s: S
+
+    --define
+
+       x = y ==
+         while not null x and _^ null y repeat
+           x.first.k ^= y.first.k => return false
+           x.first.c ^= y.first.c => return false
+           x:=x.rest
+           y:=y.rest
+         null x and null y
+
+       coerce(x:%):OutputForm ==
+          bracket [rarrow(t.k :: OutputForm, t.c :: OutputForm) for t in x]
+
+       -- sample():% == [[sample()$S,sample()$A]$Term]$Rep
+
+       monomial(r,s) == [[s,r]]
+
+       map(f,x) == [[tm.k,f(tm.c)] for tm in x]
+
+       reductum x     ==
+          rest x
+
+       leadingCoefficient x  ==
+          null x => _
+            error "Can't take leadingCoefficient of empty product element"
+          x.first.c
+
+       leadingSupport x  ==
+          null x => _
+            error "Can't take leadingCoefficient of empty product element"
+          x.first.k
+
+\end{chunk}
+
+\begin{chunk}{COQ IDPO}
+(* domain IDPO *)
+(*
+
+    --representations
+       Term:=  Record(k:S,c:A)
+       Rep:=  List Term
+
+    --declarations
+       x,y: %
+       f: A -> A
+       s: S
+
+    --define
+
+       x = y ==
+         while not null x and _^ null y repeat
+           x.first.k ^= y.first.k => return false
+           x.first.c ^= y.first.c => return false
+           x:=x.rest
+           y:=y.rest
+         null x and null y
+
+       coerce(x:%):OutputForm ==
+          bracket [rarrow(t.k :: OutputForm, t.c :: OutputForm) for t in x]
+
+       -- sample():% == [[sample()$S,sample()$A]$Term]$Rep
+
+       monomial(r,s) == [[s,r]]
+
+       map(f,x) == [[tm.k,f(tm.c)] for tm in x]
+
+       reductum x     ==
+          rest x
+
+       leadingCoefficient x  ==
+          null x => _
+            error "Can't take leadingCoefficient of empty product element"
+          x.first.c
+
+       leadingSupport x  ==
+          null x => _
+            error "Can't take leadingCoefficient of empty product element"
+          x.first.k
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{IDPO.dotabb}
+"IDPO" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IDPO"]
+"ORDSET" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ORDSET"]
+"IDPC" [color="#4488FF",href="bookvol10.2.pdf#nameddest=IDPC"]
+"IDPO" -> "IDPC"
+"IDPO" -> "ORDSET"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain IDPOAM IndexedDirectProductOrderedAbelianMonoid}
+
+\begin{chunk}{IndexedDirectProductOrderedAbelianMonoid.input}
+)set break resume
+)sys rm -f IndexedDirectProductOrderedAbelianMonoid.output
+)spool IndexedDirectProductOrderedAbelianMonoid.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show IndexedDirectProductOrderedAbelianMonoid
+--R 
+--R IndexedDirectProductOrderedAbelianMonoid(A: OrderedAbelianMonoid,S: OrderedSet)  is a domain constructor
+--R Abbreviation for IndexedDirectProductOrderedAbelianMonoid is IDPOAM 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IDPOAM 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
+--R ?+? : (%,%) -> %                      ?<? : (%,%) -> Boolean
+--R ?<=? : (%,%) -> Boolean               ?=? : (%,%) -> Boolean
+--R ?>? : (%,%) -> Boolean                ?>=? : (%,%) -> Boolean
+--R 0 : () -> %                           coerce : % -> OutputForm
+--R hash : % -> SingleInteger             latex : % -> String
+--R leadingCoefficient : % -> A           leadingSupport : % -> S
+--R map : ((A -> A),%) -> %               max : (%,%) -> %
+--R min : (%,%) -> %                      monomial : (A,S) -> %
+--R reductum : % -> %                     sample : () -> %
+--R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{IndexedDirectProductOrderedAbelianMonoid.help}
+====================================================================
+IndexedDirectProductOrderedAbelianMonoid examples
+====================================================================
+
+Indexed direct products of ordered abelian monoids A of generators
+indexed by the ordered set S.  The inherited order is lexicographical.
+All items have finite support: only non-zero terms are stored.
+
+See Also:
+o )show IndexedDirectProductOrderedAbelianMonoid
+
+\end{chunk}
+
+\pagehead{IndexedDirectProductOrderedAbelianMonoid}{IDPOAM}
+\pagepic{ps/v103indexeddirectproductorderedabelianmonoid.ps}{IDPOAM}{1.00}
+{\bf See}\\
+\pageto{IndexedDirectProductObject}{IDPO}
+\pageto{IndexedDirectProductAbelianMonoid}{IDPAM}
+\pageto{IndexedDirectProductOrderedAbelianMonoidSup}{IDPOAMS}
+\pageto{IndexedDirectProductAbelianGroup}{IDPAG}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{IDPOAM}{0} &
+\cross{IDPOAM}{coerce} &
+\cross{IDPOAM}{hash} &
+\cross{IDPOAM}{latex} &
+\cross{IDPOAM}{leadingCoefficient} \\
+\cross{IDPOAM}{leadingSupport} &
+\cross{IDPOAM}{map} &
+\cross{IDPOAM}{max} &
+\cross{IDPOAM}{min} &
+\cross{IDPOAM}{monomial} \\
+\cross{IDPOAM}{reductum} &
+\cross{IDPOAM}{sample} &
+\cross{IDPOAM}{zero?} &
+\cross{IDPOAM}{?\~{}=?} &
+\cross{IDPOAM}{?*?} \\
+\cross{IDPOAM}{?+?} &
+\cross{IDPOAM}{?$<$?} &
+\cross{IDPOAM}{?$<=$?} &
+\cross{IDPOAM}{?=?} &
+\cross{IDPOAM}{?$>$?} \\
+\cross{IDPOAM}{?$>=$?} &&&&
+\end{tabular}
+
+\begin{chunk}{domain IDPOAM IndexedDirectProductOrderedAbelianMonoid}
+)abbrev domain IDPOAM IndexedDirectProductOrderedAbelianMonoid
+++ Author: Mark Botch
+++ Description:
+++ Indexed direct products of ordered abelian monoids \spad{A} of
+++ generators indexed by the ordered set S.
+++ The inherited order is lexicographical.
+++ All items have finite support: only non-zero terms are stored.
+
+IndexedDirectProductOrderedAbelianMonoid(A:OrderedAbelianMonoid,S:OrderedSet):
+    Join(OrderedAbelianMonoid,IndexedDirectProductCategory(A,S))
+ ==  IndexedDirectProductAbelianMonoid(A,S) add
+
+    --representations
+
+       Term:=  Record(k:S,c:A)
+       Rep:=  List Term
+       x,y: %
+
+       x<y ==
+         empty? y => false
+         empty? x => true   -- note careful order of these two lines
+         y.first.k > x.first.k => true
+         y.first.k < x.first.k => false
+         y.first.c > x.first.c => true
+         y.first.c < x.first.c => false
+         x.rest < y.rest
+
+\end{chunk}
+
+\begin{chunk}{COQ IDPOAM}
+(* domain IDPOAM *)
+(*
+  IndexedDirectProductAbelianMonoid(A,S) add
+
+    --representations
+
+       Term:=  Record(k:S,c:A)
+       Rep:=  List Term
+       x,y: %
+
+       x<y ==
+         empty? y => false
+         empty? x => true   -- note careful order of these two lines
+         y.first.k > x.first.k => true
+         y.first.k < x.first.k => false
+         y.first.c > x.first.c => true
+         y.first.c < x.first.c => false
+         x.rest < y.rest
+
+*)
+
+\end{chunk}
 
-      op1 := formatHtml(first l,minPrec)
-      formatFunction(op1,args,prec)
+\begin{chunk}{IDPOAM.dotabb}
+"IDPOAM" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IDPOAM"]
+"OAMON" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAMON"]
+"IDPOAM" -> "OAMON"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain IDPOAMS IndexedDirectProductOrderedAbelianMonoidSup}
+
+\begin{chunk}{IndexedDirectProductOrderedAbelianMonoidSup.input}
+)set break resume
+)sys rm -f IndexedDirectProductOrderedAbelianMonoidSup.output
+)spool IndexedDirectProductOrderedAbelianMonoidSup.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show IndexedDirectProductOrderedAbelianMonoidSup
+--R 
+--R IndexedDirectProductOrderedAbelianMonoidSup(A: OrderedAbelianMonoidSup,S: OrderedSet)  is a domain constructor
+--R Abbreviation for IndexedDirectProductOrderedAbelianMonoidSup is IDPOAMS 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IDPOAMS 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
+--R ?+? : (%,%) -> %                      ?<? : (%,%) -> Boolean
+--R ?<=? : (%,%) -> Boolean               ?=? : (%,%) -> Boolean
+--R ?>? : (%,%) -> Boolean                ?>=? : (%,%) -> Boolean
+--R 0 : () -> %                           coerce : % -> OutputForm
+--R hash : % -> SingleInteger             latex : % -> String
+--R leadingCoefficient : % -> A           leadingSupport : % -> S
+--R map : ((A -> A),%) -> %               max : (%,%) -> %
+--R min : (%,%) -> %                      monomial : (A,S) -> %
+--R reductum : % -> %                     sample : () -> %
+--R sup : (%,%) -> %                      zero? : % -> Boolean
+--R ?~=? : (%,%) -> Boolean              
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{IndexedDirectProductOrderedAbelianMonoidSup.help}
+====================================================================
+IndexedDirectProductOrderedAbelianMonoidSup examples
+====================================================================
+
+Indexed direct products of ordered abelian monoid sups A, generators
+indexed by the ordered set S.  All items have finite support: only
+non-zero terms are stored.
+
+See Also:
+o )show IndexedDirectProductOrderedAbelianMonoidSup
+
+\end{chunk}
+
+\pagehead{IndexedDirectProductOrderedAbelianMonoidSup}{IDPOAMS}
+\pagepic{ps/v103indexeddirectproductorderedabelianmonoidsup.ps}{IDPOAMS}{1.00}
+{\bf See}\\
+\pageto{IndexedDirectProductObject}{IDPO}
+\pageto{IndexedDirectProductAbelianMonoid}{IDPAM}
+\pageto{IndexedDirectProductOrderedAbelianMonoid}{IDPOAM}
+\pageto{IndexedDirectProductAbelianGroup}{IDPAG}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{IDPOAMS}{0} &
+\cross{IDPOAMS}{coerce} &
+\cross{IDPOAMS}{hash} &
+\cross{IDPOAMS}{latex} &
+\cross{IDPOAMS}{leadingCoefficient} \\
+\cross{IDPOAMS}{leadingSupport} &
+\cross{IDPOAMS}{map} &
+\cross{IDPOAMS}{max} &
+\cross{IDPOAMS}{min} &
+\cross{IDPOAMS}{monomial} \\
+\cross{IDPOAMS}{reductum} &
+\cross{IDPOAMS}{sample} &
+\cross{IDPOAMS}{subtractIfCan} &
+\cross{IDPOAMS}{sup} &
+\cross{IDPOAMS}{zero?} \\
+\cross{IDPOAMS}{?\~{}=?} &
+\cross{IDPOAMS}{?*?} &
+\cross{IDPOAMS}{?+?} &
+\cross{IDPOAMS}{?$<$?} &
+\cross{IDPOAMS}{?$<=$?} \\
+\cross{IDPOAMS}{?=?} &
+\cross{IDPOAMS}{?$>$?} &
+\cross{IDPOAMS}{?$>=$?} &&
+\end{tabular}
+
+\begin{chunk}{domain IDPOAMS IndexedDirectProductOrderedAbelianMonoidSup}
+)abbrev domain IDPOAMS IndexedDirectProductOrderedAbelianMonoidSup
+++ Author: Mark Botch
+++ Description:
+++ Indexed direct products of ordered abelian monoid sups \spad{A},
+++ generators indexed by the ordered set S.
+++ All items have finite support: only non-zero terms are stored.
+
+IndexedDirectProductOrderedAbelianMonoidSup(A:OrderedAbelianMonoidSup,S:OrderedSet):
+    Join(OrderedAbelianMonoidSup,IndexedDirectProductCategory(A,S))
+ ==  IndexedDirectProductOrderedAbelianMonoid(A,S) add
+    --representations
+       Term:=  Record(k:S,c:A)
+       Rep:=  List Term
+       x,y: %
+       r: A
+       s: S
+
+       subtractIfCan(x,y) ==
+         empty? y => x
+         empty? x => "failed"
+         x.first.k < y.first.k => "failed"
+         x.first.k > y.first.k =>
+             t:= subtractIfCan(x.rest, y)
+             t case "failed" => "failed"
+             cons( x.first, t)
+         u:=subtractIfCan(x.first.c, y.first.c)
+         u case "failed" => "failed"
+         zero? u => subtractIfCan(x.rest, y.rest)
+         t:= subtractIfCan(x.rest, y.rest)
+         t case "failed" => "failed"
+         cons([x.first.k,u],t)
+
+       sup(x,y) ==
+         empty? y => x
+         empty? x => y
+         x.first.k < y.first.k => cons(y.first,sup(x,y.rest))
+         x.first.k > y.first.k => cons(x.first,sup(x.rest,y))
+         u:=sup(x.first.c, y.first.c)
+         cons([x.first.k,u],sup(x.rest,y.rest))
+
+\end{chunk}
+
+\begin{chunk}{COQ IDPOAMS}
+(* domain IDPOAMS *)
+(*
+  IndexedDirectProductOrderedAbelianMonoid(A,S) add
+    --representations
+       Term:=  Record(k:S,c:A)
+       Rep:=  List Term
+       x,y: %
+       r: A
+       s: S
+
+       subtractIfCan(x,y) ==
+         empty? y => x
+         empty? x => "failed"
+         x.first.k < y.first.k => "failed"
+         x.first.k > y.first.k =>
+             t:= subtractIfCan(x.rest, y)
+             t case "failed" => "failed"
+             cons( x.first, t)
+         u:=subtractIfCan(x.first.c, y.first.c)
+         u case "failed" => "failed"
+         zero? u => subtractIfCan(x.rest, y.rest)
+         t:= subtractIfCan(x.rest, y.rest)
+         t case "failed" => "failed"
+         cons([x.first.k,u],t)
+
+       sup(x,y) ==
+         empty? y => x
+         empty? x => y
+         x.first.k < y.first.k => cons(y.first,sup(x,y.rest))
+         x.first.k > y.first.k => cons(x.first,sup(x.rest,y))
+         u:=sup(x.first.c, y.first.c)
+         cons([x.first.k,u],sup(x.rest,y.rest))
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{IDPOAMS.dotabb}
+"IDPOAMS" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IDPOAMS"]
+"OAMONS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAMONS"]
+"IDPOAMS" -> "OAMONS"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain INDE IndexedExponents}
+
+\begin{chunk}{IndexedExponents.input}
+)set break resume
+)sys rm -f IndexedExponents.output
+)spool IndexedExponents.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show IndexedExponents
+--R 
+--R IndexedExponents(Varset: OrderedSet)  is a domain constructor
+--R Abbreviation for IndexedExponents is INDE 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for INDE 
+--R
+--R------------------------------- Operations --------------------------------
+--R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
+--R ?+? : (%,%) -> %                      ?<? : (%,%) -> Boolean
+--R ?<=? : (%,%) -> Boolean               ?=? : (%,%) -> Boolean
+--R ?>? : (%,%) -> Boolean                ?>=? : (%,%) -> Boolean
+--R 0 : () -> %                           coerce : % -> OutputForm
+--R hash : % -> SingleInteger             latex : % -> String
+--R leadingSupport : % -> Varset          max : (%,%) -> %
+--R min : (%,%) -> %                      reductum : % -> %
+--R sample : () -> %                      sup : (%,%) -> %
+--R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
+--R leadingCoefficient : % -> NonNegativeInteger
+--R map : ((NonNegativeInteger -> NonNegativeInteger),%) -> %
+--R monomial : (NonNegativeInteger,Varset) -> %
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{IndexedExponents.help}
+====================================================================
+IndexedExponents examples
+====================================================================
+
+IndexedExponents of an ordered set of variables gives a representation
+for the degree of polynomials in commuting variables. It gives an ordered
+pairing of non negative integer exponents with variables
+
+See Also:
+o )show IndexedExponents
+
+\end{chunk}
+
+\pagehead{IndexedExponents}{INDE}
+\pagepic{ps/v103indexedexponents.ps}{INDE}{1.00}
+{\bf See}\\
+\pageto{Polynomial}{POLY}
+\pageto{MultivariatePolynomial}{MPOLY}
+\pageto{SparseMultivariatePolynomial}{SMP}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{INDE}{0} &
+\cross{INDE}{coerce} &
+\cross{INDE}{hash} &
+\cross{INDE}{latex} &
+\cross{INDE}{leadingCoefficient} \\
+\cross{INDE}{leadingSupport} &
+\cross{INDE}{map} &
+\cross{INDE}{max} &
+\cross{INDE}{min} &
+\cross{INDE}{monomial} \\
+\cross{INDE}{reductum} &
+\cross{INDE}{sample} &
+\cross{INDE}{subtractIfCan} &
+\cross{INDE}{sup} &
+\cross{INDE}{zero?} \\
+\cross{INDE}{?\~{}=?} &
+\cross{INDE}{?*?} &
+\cross{INDE}{?+?} &
+\cross{INDE}{?$<$?} &
+\cross{INDE}{?$<=$?} \\
+\cross{INDE}{?=?} &
+\cross{INDE}{?$>$?} &
+\cross{INDE}{?$>=$?} &&
+\end{tabular}
+
+\begin{chunk}{domain INDE IndexedExponents}
+)abbrev domain INDE IndexedExponents
+++ Author: James Davenport
+++ Description:
+++ IndexedExponents of an ordered set of variables gives a representation
+++ for the degree of polynomials in commuting variables. It gives an ordered
+++ pairing of non negative integer exponents with variables
+
+IndexedExponents(Varset:OrderedSet): C == T where
+  C == Join(OrderedAbelianMonoidSup,
+            IndexedDirectProductCategory(NonNegativeInteger,Varset))
+  T ==
+   IndexedDirectProductOrderedAbelianMonoidSup(NonNegativeInteger,Varset) add
+      Term:=  Record(k:Varset,c:NonNegativeInteger)
+      Rep:=  List Term
+      x:%
+      t:Term
+
+      coerceOF(t):OutputForm ==     --++ converts term to OutputForm
+         t.c = 1 => (t.k)::OutputForm
+         (t.k)::OutputForm ** (t.c)::OutputForm
+
+      coerce(x):OutputForm == ++ converts entire exponents to OutputForm
+         null x => 1::Integer::OutputForm
+         null rest x => coerceOF(first x)
+         reduce("*",[coerceOF t for t in x])
+
+\end{chunk}
+
+\begin{chunk}{COQ INDE}
+(* domain INDE *)
+(*
+   IndexedDirectProductOrderedAbelianMonoidSup(NonNegativeInteger,Varset) add
+      Term:=  Record(k:Varset,c:NonNegativeInteger)
+      Rep:=  List Term
+      x:%
+      t:Term
+
+      coerceOF(t):OutputForm ==     --++ converts term to OutputForm
+         t.c = 1 => (t.k)::OutputForm
+         (t.k)::OutputForm ** (t.c)::OutputForm
+
+      coerce(x):OutputForm == ++ converts entire exponents to OutputForm
+         null x => 1::Integer::OutputForm
+         null rest x => coerceOF(first x)
+         reduce("*",[coerceOF t for t in x])
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{INDE.dotabb}
+"INDE" [color="#88FF44",href="bookvol10.3.pdf#nameddest=INDE"]
+"FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"]
+"INDE" -> "FLAGG"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{domain IFARRAY IndexedFlexibleArray}
+
+\begin{chunk}{IndexedFlexibleArray.input}
+)set break resume
+)sys rm -f IndexedFlexibleArray.output
+)spool IndexedFlexibleArray.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show IndexedFlexibleArray
+--R 
+--R IndexedFlexibleArray(S: Type,mn: Integer)  is a domain constructor
+--R Abbreviation for IndexedFlexibleArray is IFARRAY 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IFARRAY 
+--R
+--R------------------------------- Operations --------------------------------
+--R concat : List(%) -> %                 concat : (%,%) -> %
+--R concat : (S,%) -> %                   concat : (%,S) -> %
+--R concat! : (%,S) -> %                  concat! : (%,%) -> %
+--R construct : List(S) -> %              copy : % -> %
+--R delete : (%,Integer) -> %             delete! : (%,Integer) -> %
+--R ?.? : (%,Integer) -> S                elt : (%,Integer,S) -> S
+--R empty : () -> %                       empty? : % -> Boolean
+--R entries : % -> List(S)                eq? : (%,%) -> Boolean
+--R flexibleArray : List(S) -> %          index? : (Integer,%) -> Boolean
+--R indices : % -> List(Integer)          insert : (%,%,Integer) -> %
+--R insert : (S,%,Integer) -> %           insert! : (S,%,Integer) -> %
+--R insert! : (%,%,Integer) -> %          latex : % -> String if S has SETCAT
+--R map : (((S,S) -> S),%,%) -> %         map : ((S -> S),%) -> %
+--R max : (%,%) -> % if S has ORDSET      min : (%,%) -> % if S has ORDSET
+--R new : (NonNegativeInteger,S) -> %     physicalLength! : (%,Integer) -> %
+--R qelt : (%,Integer) -> S               remove! : ((S -> Boolean),%) -> %
+--R reverse : % -> %                      sample : () -> %
+--R select! : ((S -> Boolean),%) -> %     shrinkable : Boolean -> Boolean
+--R sort : % -> % if S has ORDSET         sort : (((S,S) -> Boolean),%) -> %
+--R #? : % -> NonNegativeInteger if $ has finiteAggregate
+--R ?<? : (%,%) -> Boolean if S has ORDSET
+--R ?<=? : (%,%) -> Boolean if S has ORDSET
+--R ?=? : (%,%) -> Boolean if S has SETCAT
+--R ?>? : (%,%) -> Boolean if S has ORDSET
+--R ?>=? : (%,%) -> Boolean if S has ORDSET
+--R any? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R coerce : % -> OutputForm if S has SETCAT
+--R convert : % -> InputForm if S has KONVERT(INFORM)
+--R copyInto! : (%,%,Integer) -> % if $ has shallowlyMutable
+--R count : (S,%) -> NonNegativeInteger if $ has finiteAggregate and S has SETCAT
+--R count : ((S -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
+--R delete : (%,UniversalSegment(Integer)) -> %
+--R delete! : (%,UniversalSegment(Integer)) -> %
+--R ?.? : (%,UniversalSegment(Integer)) -> %
+--R entry? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
+--R eval : (%,List(S),List(S)) -> % if S has EVALAB(S) and S has SETCAT
+--R eval : (%,S,S) -> % if S has EVALAB(S) and S has SETCAT
+--R eval : (%,Equation(S)) -> % if S has EVALAB(S) and S has SETCAT
+--R eval : (%,List(Equation(S))) -> % if S has EVALAB(S) and S has SETCAT
+--R every? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R fill! : (%,S) -> % if $ has shallowlyMutable
+--R find : ((S -> Boolean),%) -> Union(S,"failed")
+--R first : % -> S if Integer has ORDSET
+--R hash : % -> SingleInteger if S has SETCAT
+--R less? : (%,NonNegativeInteger) -> Boolean
+--R map! : ((S -> S),%) -> % if $ has shallowlyMutable
+--R maxIndex : % -> Integer if Integer has ORDSET
+--R member? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
+--R members : % -> List(S) if $ has finiteAggregate
+--R merge : (%,%) -> % if S has ORDSET
+--R merge : (((S,S) -> Boolean),%,%) -> %
+--R merge! : (((S,S) -> Boolean),%,%) -> %
+--R merge! : (%,%) -> % if S has ORDSET
+--R minIndex : % -> Integer if Integer has ORDSET
+--R more? : (%,NonNegativeInteger) -> Boolean
+--R parts : % -> List(S) if $ has finiteAggregate
+--R physicalLength : % -> NonNegativeInteger
+--R position : (S,%,Integer) -> Integer if S has SETCAT
+--R position : (S,%) -> Integer if S has SETCAT
+--R position : ((S -> Boolean),%) -> Integer
+--R qsetelt! : (%,Integer,S) -> S if $ has shallowlyMutable
+--R reduce : (((S,S) -> S),%) -> S if $ has finiteAggregate
+--R reduce : (((S,S) -> S),%,S) -> S if $ has finiteAggregate
+--R reduce : (((S,S) -> S),%,S,S) -> S if $ has finiteAggregate and S has SETCAT
+--R remove : ((S -> Boolean),%) -> % if $ has finiteAggregate
+--R remove : (S,%) -> % if $ has finiteAggregate and S has SETCAT
+--R remove! : (S,%) -> % if S has SETCAT
+--R removeDuplicates : % -> % if $ has finiteAggregate and S has SETCAT
+--R removeDuplicates! : % -> % if S has SETCAT
+--R reverse! : % -> % if $ has shallowlyMutable
+--R select : ((S -> Boolean),%) -> % if $ has finiteAggregate
+--R setelt : (%,UniversalSegment(Integer),S) -> S if $ has shallowlyMutable
+--R setelt : (%,Integer,S) -> S if $ has shallowlyMutable
+--R size? : (%,NonNegativeInteger) -> Boolean
+--R sort! : % -> % if $ has shallowlyMutable and S has ORDSET
+--R sort! : (((S,S) -> Boolean),%) -> % if $ has shallowlyMutable
+--R sorted? : % -> Boolean if S has ORDSET
+--R sorted? : (((S,S) -> Boolean),%) -> Boolean
+--R swap! : (%,Integer,Integer) -> Void if $ has shallowlyMutable
+--R ?~=? : (%,%) -> Boolean if S has SETCAT
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{IndexedFlexibleArray.help}
+====================================================================
+IndexedFlexibleArray examples
+====================================================================
+
+A FlexibleArray is the notion of an array intended to allow for growth
+at the end only.  Hence the following efficient operations
+  append(x,a)  meaning append item x at the end of the array a
+  delete(a,n)} meaning delete the last item from the array a
+
+Flexible arrays support the other operations inherited from
+ExtensibleLinearAggregate. However, these are not efficient.
+
+Flexible arrays combine the O(1) access time property of arrays
+with growing and shrinking at the end in O(1) (average) time.
+This is done by using an ordinary array which may have zero or more
+empty slots at the end.  When the array becomes full it is copied
+into a new larger (50% larger) array.  Conversely, when the array
+becomes less than 1/2 full, it is copied into a smaller array.
+Flexible arrays provide for an efficient implementation of many
+data structures in particular heaps, stacks and sets.
+
+See Also:
+o )show IndexedFlexibleArray
+
+\end{chunk}
+
+\pagehead{IndexedFlexibleArray}{IFARRAY}
+\pagepic{ps/v103indexedflexiblearray.ps}{IFARRAY}{1.00}
+{\bf See}\\
+\pageto{PrimitiveArray}{PRIMARR}
+\pageto{Tuple}{TUPLE}
+\pageto{FlexibleArray}{FARRAY}
+\pageto{IndexedOneDimensionalArray}{IARRAY1}
+\pageto{OneDimensionalArray}{ARRAY1}
+
+{\bf Exports:}\\
+\begin{tabular}{llll}
+\cross{IFARRAY}{concat} &
+\cross{IFARRAY}{concat!} &
+\cross{IFARRAY}{construct} &
+\cross{IFARRAY}{copy} \\
+\cross{IFARRAY}{delete} &
+\cross{IFARRAY}{delete!} &
+\cross{IFARRAY}{elt} &
+\cross{IFARRAY}{empty} \\
+\cross{IFARRAY}{empty?} &
+\cross{IFARRAY}{entries} &
+\cross{IFARRAY}{eq?} &
+\cross{IFARRAY}{flexibleArray} \\
+\cross{IFARRAY}{index?} &
+\cross{IFARRAY}{indices} &
+\cross{IFARRAY}{insert} &
+\cross{IFARRAY}{insert!} \\
+\cross{IFARRAY}{map} &
+\cross{IFARRAY}{new} &
+\cross{IFARRAY}{qelt} &
+\cross{IFARRAY}{reverse} \\
+\cross{IFARRAY}{sample} &
+\cross{IFARRAY}{shrinkable} &
+\cross{IFARRAY}{ any?} &
+\cross{IFARRAY}{coerce} \\
+\cross{IFARRAY}{convert} &
+\cross{IFARRAY}{copyInto!} &
+\cross{IFARRAY}{count} &
+\cross{IFARRAY}{delete} \\
+\cross{IFARRAY}{delete!} &
+\cross{IFARRAY}{entry?} &
+\cross{IFARRAY}{eval} &
+\cross{IFARRAY}{every?} \\
+\cross{IFARRAY}{fill!} &
+\cross{IFARRAY}{find} &
+\cross{IFARRAY}{first} &
+\cross{IFARRAY}{hash} \\
+\cross{IFARRAY}{latex} &
+\cross{IFARRAY}{less?} &
+\cross{IFARRAY}{map!} &
+\cross{IFARRAY}{max} \\
+\cross{IFARRAY}{maxIndex} &
+\cross{IFARRAY}{member?} &
+\cross{IFARRAY}{members} &
+\cross{IFARRAY}{merge} \\
+\cross{IFARRAY}{merge!} &
+\cross{IFARRAY}{min} &
+\cross{IFARRAY}{minIndex} &
+\cross{IFARRAY}{more?} \\
+\cross{IFARRAY}{parts} &
+\cross{IFARRAY}{physicalLength} &
+\cross{IFARRAY}{physicalLength!} &
+\cross{IFARRAY}{position} \\
+\cross{IFARRAY}{qsetelt!} &
+\cross{IFARRAY}{reduce} &
+\cross{IFARRAY}{remove} &
+\cross{IFARRAY}{remove!} \\
+\cross{IFARRAY}{removeDuplicates} &
+\cross{IFARRAY}{removeDuplicates!} &
+\cross{IFARRAY}{reverse!} &
+\cross{IFARRAY}{select} \\
+\cross{IFARRAY}{select!} &
+\cross{IFARRAY}{setelt} &
+\cross{IFARRAY}{size?} &
+\cross{IFARRAY}{sort} \\
+\cross{IFARRAY}{sort!} &
+\cross{IFARRAY}{sorted?} &
+\cross{IFARRAY}{swap!} &
+\cross{IFARRAY}{\#{}?} \\
+\cross{IFARRAY}{?$<$?} &
+\cross{IFARRAY}{?$<=$?} &
+\cross{IFARRAY}{?=?} &
+\cross{IFARRAY}{?$>$?} \\
+\cross{IFARRAY}{?$>=$?} &
+\cross{IFARRAY}{?\~{}=?} &
+\cross{IFARRAY}{?.?} &
+\end{tabular}
+
+\begin{chunk}{domain IFARRAY IndexedFlexibleArray}
+)abbrev domain IFARRAY IndexedFlexibleArray
+++ Author: Michael Monagan July/87, modified SMW June/91
+++ Description:
+++ A FlexibleArray is the notion of an array intended to allow for growth
+++ at the end only.  Hence the following efficient operations\br
+++ \spad{append(x,a)} meaning append item x at the end of the array \spad{a}\br
+++ \spad{delete(a,n)} meaning delete the last item from the array \spad{a}\br
+++ Flexible arrays support the other operations inherited from
+++ \spadtype{ExtensibleLinearAggregate}. However, these are not efficient.
+++ Flexible arrays combine the \spad{O(1)} access time property of arrays
+++ with growing and shrinking at the end in \spad{O(1)} (average) time.
+++ This is done by using an ordinary array which may have zero or more
+++ empty slots at the end.  When the array becomes full it is copied
+++ into a new larger (50% larger) array.  Conversely, when the array
+++ becomes less than 1/2 full, it is copied into a smaller array.
+++ Flexible arrays provide for an efficient implementation of many
+++ data structures in particular heaps, stacks and sets.
+
+IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where
+  A ==> PrimitiveArray S
+  I ==> Integer
+  N ==> NonNegativeInteger
+  U ==> UniversalSegment Integer
+  Exports ==
+   Join(OneDimensionalArrayAggregate S,ExtensibleLinearAggregate S) with
+    flexibleArray : List S -> %
+     ++ flexibleArray(l) creates a flexible array from the list of elements l
+     ++
+     ++X T1:=IndexedFlexibleArray(Integer,20)
+     ++X flexibleArray([i for i in 1..10])$T1
+
+    physicalLength : % -> NonNegativeInteger
+     ++ physicalLength(x) returns the number of elements x can 
+     ++ accomodate before growing
+     ++
+     ++X T1:=IndexedFlexibleArray(Integer,20)
+     ++X t2:=flexibleArray([i for i in 1..10])$T1
+     ++X physicalLength t2
+
+    physicalLength_!: (%, I) -> %
+     ++ physicalLength!(x,n) changes the physical length of x to be n and
+     ++ returns the new array.
+     ++
+     ++X T1:=IndexedFlexibleArray(Integer,20)
+     ++X t2:=flexibleArray([i for i in 1..10])$T1
+     ++X physicalLength!(t2,15)
+
+    shrinkable: Boolean -> Boolean
+     ++ shrinkable(b) sets the shrinkable attribute of flexible arrays to b
+     ++ and returns the previous value
+     ++
+     ++X T1:=IndexedFlexibleArray(Integer,20)
+     ++X shrinkable(false)$T1
+
+  Implementation == add
+    Rep := Record(physLen:I, logLen:I, f:A)
+    shrinkable? : Boolean := true
+    growAndFill : (%, I, S) -> %
+    growWith    : (%, I, S) -> %
+    growAdding  : (%, I, %) -> %
+    shrink: (%, I)    -> %
+    newa  : (N, A) -> A
+
+    physicalLength(r) == (r.physLen) pretend NonNegativeInteger
+
+    physicalLength_!(r, n) ==
+       r.physLen = 0  => error "flexible array must be non-empty"
+       growWith(r, n, r.f.0)
+
+    empty()      == [0, 0, empty()]
+
+    #r           == (r.logLen)::N
+
+    fill_!(r, x) == (fill_!(r.f, x); r)
+
+    maxIndex r   == r.logLen - 1 + mn
+
+    minIndex r   == mn
+
+    new(n, a)    == [n, n, new(n, a)]
+
+    shrinkable(b) ==
+      oldval := shrinkable?
+      shrinkable? := b
+      oldval
+
+    flexibleArray l ==
+       n := #l
+       n = 0 => empty()
+       x := l.1
+       a := new(n,x)
+       for i in mn + 1..mn + n-1 for y in rest l repeat a.i := y
+       a
+
+    -- local utility operations
+    newa(n, a) ==
+       zero? n => empty()
+       new(n, a.0)
+
+    growAdding(r, b, s) ==
+       b = 0 => r
+       #r > 0 => growAndFill(r, b, (r.f).0)
+       #s > 0 => growAndFill(r, b, (s.f).0)
+       error "no default filler element"
+
+    growAndFill(r, b, x) ==
+       (r.logLen := r.logLen + b) <= r.physLen => r
+       -- enlarge by 50% + b
+       n := r.physLen + r.physLen quo 2 + 1
+       if r.logLen > n then n := r.logLen
+       growWith(r, n, x)
+
+    growWith(r, n, x) ==
+       y := new(n::N, x)$PrimitiveArray(S)
+       a := r.f
+       for k in 0 .. r.physLen-1 repeat y.k := a.k
+       r.physLen := n
+       r.f := y
+       r
+
+    shrink(r, i) ==
+       r.logLen := r.logLen - i
+       negative?(n := r.logLen) => error "internal bug in flexible array"
+       2*n+2 > r.physLen => r
+       not shrinkable? => r
+       if n < r.logLen 
+         then error "cannot shrink flexible array to indicated size"
+       n = 0 => empty()
+       r.physLen := n
+       y := newa(n::N, a := r.f)
+       for k in 0 .. n-1 repeat y.k := a.k
+       r.f := y
+       r
+
+    copy r ==
+       n := #r
+       a := r.f
+       v := newa(n, a := r.f)
+       for k in 0..n-1 repeat v.k := a.k
+       [n, n, v]
+
+
+    elt(r:%, i:I) ==
+       i < mn or i >= r.logLen + mn =>
+           error "index out of range"
+       r.f.(i-mn)
+
+    setelt(r:%, i:I, x:S) ==
+       i < mn or i >= r.logLen + mn =>
+           error "index out of range"
+       r.f.(i-mn) := x
+
+    -- operations inherited from extensible aggregate
+
+    merge(g, a, b)   == merge_!(g, copy a, b)
+
+    concat(x:S, r:%) == insert_!(x, r, mn)
+
+    concat_!(r:%, x:S) ==
+       growAndFill(r, 1, x)
+       r.f.(r.logLen-1) := x
+       r
+
+    concat_!(a:%, b:%) ==
+       if eq?(a, b) then b := copy b
+       n := #a
+       growAdding(a, #b, b)
+       copyInto_!(a, b, n + mn)
+
+    remove_!(g:(S->Boolean), a:%) ==
+       k:I := 0
+       for i in 0..maxIndex a - mn repeat
+          if not g(a.i) then (a.k := a.i; k := k+1)
+       shrink(a, #a - k)
+
+    delete_!(r:%, i1:I) ==
+       i := i1 - mn
+       i < 0 or i > r.logLen => error "index out of range"
+       for k in i..r.logLen-2 repeat r.f.k := r.f.(k+1)
+       shrink(r, 1)
+
+    delete_!(r:%, i:U) ==
+       l := lo i - mn; m := maxIndex r - mn
+       h := (hasHi i => hi i - mn; m)
+       l < 0 or h > m => error "index out of range"
+       for j in l.. for k in h+1..m repeat r.f.j := r.f.k
+       shrink(r, max(0,h-l+1))
+
+    insert_!(x:S, r:%, i1:I):% ==
+       i := i1 - mn
+       n := r.logLen
+       i < 0 or i > n => error "index out of range"
+       growAndFill(r, 1, x)
+       for k in n-1 .. i by -1 repeat r.f.(k+1) := r.f.k
+       r.f.i := x
+       r
+
+    insert_!(a:%, b:%, i1:I):% ==
+       i := i1 - mn
+       if eq?(a, b) then b := copy b
+       m := #a; n := #b
+       i < 0 or i > n => error "index out of range"
+       growAdding(b, m, a)
+       for k in n-1 .. i by -1 repeat b.f.(m+k) := b.f.k
+       for k in m-1 .. 0 by -1 repeat b.f.(i+k) := a.f.k
+       b
+
+    merge_!(g, a, b) ==
+       m := #a; n := #b; growAdding(a, n, b)
+       for i in m-1..0 by -1 for j in m+n-1.. by -1 repeat a.f.j := a.f.i
+       i := n; j := 0
+       for k in 0.. while i < n+m and j < n repeat
+          if g(a.f.i,b.f.j) then (a.f.k := a.f.i; i := i+1)
+          else (a.f.k := b.f.j; j := j+1)
+       for k in k.. for j in j..n-1 repeat a.f.k := b.f.j
+       a
+
+    select_!(g:(S->Boolean), a:%) ==
+       k:I := 0
+       for i in 0..maxIndex a - mn repeat_
+          if g(a.f.i) then (a.f.k := a.f.i;k := k+1)
+       shrink(a, #a - k)
+
+    if S has SetCategory then
+
+      removeDuplicates_! a ==
+         ct := #a
+         ct < 2 => a
+
+         i     := mn
+         nlim  := mn + ct
+         nlim0 := nlim
+         while i < nlim repeat
+            j := i+1
+            for k in j..nlim-1 | a.k ^= a.i repeat
+                a.j := a.k
+                j := j+1
+            nlim := j
+            i := i+1
+         nlim ^= nlim0 => delete_!(a, i..)
+         a
 
 \end{chunk}
 
-\begin{chunk}{COQ HTMLFORM}
-(* domain HTMLFORM *)
-(*
+\begin{chunk}{COQ IFARRAY}
+(* domain IFARRAY *)
+(*
+    Rep := Record(physLen:I, logLen:I, f:A)
+    shrinkable? : Boolean := true
+    growAndFill : (%, I, S) -> %
+    growWith    : (%, I, S) -> %
+    growAdding  : (%, I, %) -> %
+    shrink: (%, I)    -> %
+    newa  : (N, A) -> A
+
+    physicalLength(r) == (r.physLen) pretend NonNegativeInteger
+
+    physicalLength_!(r, n) ==
+       r.physLen = 0  => error "flexible array must be non-empty"
+       growWith(r, n, r.f.0)
+
+    empty()      == [0, 0, empty()]
+
+    #r           == (r.logLen)::N
+
+    fill_!(r, x) == (fill_!(r.f, x); r)
+
+    maxIndex r   == r.logLen - 1 + mn
+
+    minIndex r   == mn
+
+    new(n, a)    == [n, n, new(n, a)]
+
+    shrinkable(b) ==
+      oldval := shrinkable?
+      shrinkable? := b
+      oldval
+
+    flexibleArray l ==
+       n := #l
+       n = 0 => empty()
+       x := l.1
+       a := new(n,x)
+       for i in mn + 1..mn + n-1 for y in rest l repeat a.i := y
+       a
+
+    -- local utility operations
+    newa(n, a) ==
+       zero? n => empty()
+       new(n, a.0)
+
+    growAdding(r, b, s) ==
+       b = 0 => r
+       #r > 0 => growAndFill(r, b, (r.f).0)
+       #s > 0 => growAndFill(r, b, (s.f).0)
+       error "no default filler element"
+
+    growAndFill(r, b, x) ==
+       (r.logLen := r.logLen + b) <= r.physLen => r
+       -- enlarge by 50% + b
+       n := r.physLen + r.physLen quo 2 + 1
+       if r.logLen > n then n := r.logLen
+       growWith(r, n, x)
+
+    growWith(r, n, x) ==
+       y := new(n::N, x)$PrimitiveArray(S)
+       a := r.f
+       for k in 0 .. r.physLen-1 repeat y.k := a.k
+       r.physLen := n
+       r.f := y
+       r
+
+    shrink(r, i) ==
+       r.logLen := r.logLen - i
+       negative?(n := r.logLen) => error "internal bug in flexible array"
+       2*n+2 > r.physLen => r
+       not shrinkable? => r
+       if n < r.logLen 
+         then error "cannot shrink flexible array to indicated size"
+       n = 0 => empty()
+       r.physLen := n
+       y := newa(n::N, a := r.f)
+       for k in 0 .. n-1 repeat y.k := a.k
+       r.f := y
+       r
+
+    copy r ==
+       n := #r
+       a := r.f
+       v := newa(n, a := r.f)
+       for k in 0..n-1 repeat v.k := a.k
+       [n, n, v]
+
+
+    elt(r:%, i:I) ==
+       i < mn or i >= r.logLen + mn =>
+           error "index out of range"
+       r.f.(i-mn)
+
+    setelt(r:%, i:I, x:S) ==
+       i < mn or i >= r.logLen + mn =>
+           error "index out of range"
+       r.f.(i-mn) := x
+
+    -- operations inherited from extensible aggregate
+
+    merge(g, a, b)   == merge_!(g, copy a, b)
+
+    concat(x:S, r:%) == insert_!(x, r, mn)
+
+    concat_!(r:%, x:S) ==
+       growAndFill(r, 1, x)
+       r.f.(r.logLen-1) := x
+       r
+
+    concat_!(a:%, b:%) ==
+       if eq?(a, b) then b := copy b
+       n := #a
+       growAdding(a, #b, b)
+       copyInto_!(a, b, n + mn)
+
+    remove_!(g:(S->Boolean), a:%) ==
+       k:I := 0
+       for i in 0..maxIndex a - mn repeat
+          if not g(a.i) then (a.k := a.i; k := k+1)
+       shrink(a, #a - k)
+
+    delete_!(r:%, i1:I) ==
+       i := i1 - mn
+       i < 0 or i > r.logLen => error "index out of range"
+       for k in i..r.logLen-2 repeat r.f.k := r.f.(k+1)
+       shrink(r, 1)
+
+    delete_!(r:%, i:U) ==
+       l := lo i - mn; m := maxIndex r - mn
+       h := (hasHi i => hi i - mn; m)
+       l < 0 or h > m => error "index out of range"
+       for j in l.. for k in h+1..m repeat r.f.j := r.f.k
+       shrink(r, max(0,h-l+1))
+
+    insert_!(x:S, r:%, i1:I):% ==
+       i := i1 - mn
+       n := r.logLen
+       i < 0 or i > n => error "index out of range"
+       growAndFill(r, 1, x)
+       for k in n-1 .. i by -1 repeat r.f.(k+1) := r.f.k
+       r.f.i := x
+       r
+
+    insert_!(a:%, b:%, i1:I):% ==
+       i := i1 - mn
+       if eq?(a, b) then b := copy b
+       m := #a; n := #b
+       i < 0 or i > n => error "index out of range"
+       growAdding(b, m, a)
+       for k in n-1 .. i by -1 repeat b.f.(m+k) := b.f.k
+       for k in m-1 .. 0 by -1 repeat b.f.(i+k) := a.f.k
+       b
+
+    merge_!(g, a, b) ==
+       m := #a; n := #b; growAdding(a, n, b)
+       for i in m-1..0 by -1 for j in m+n-1.. by -1 repeat a.f.j := a.f.i
+       i := n; j := 0
+       for k in 0.. while i < n+m and j < n repeat
+          if g(a.f.i,b.f.j) then (a.f.k := a.f.i; i := i+1)
+          else (a.f.k := b.f.j; j := j+1)
+       for k in k.. for j in j..n-1 repeat a.f.k := b.f.j
+       a
+
+    select_!(g:(S->Boolean), a:%) ==
+       k:I := 0
+       for i in 0..maxIndex a - mn repeat_
+          if g(a.f.i) then (a.f.k := a.f.i;k := k+1)
+       shrink(a, #a - k)
+
+    if S has SetCategory then
+
+      removeDuplicates_! a ==
+         ct := #a
+         ct < 2 => a
+
+         i     := mn
+         nlim  := mn + ct
+         nlim0 := nlim
+         while i < nlim repeat
+            j := i+1
+            for k in j..nlim-1 | a.k ^= a.i repeat
+                a.j := a.k
+                j := j+1
+            nlim := j
+            i := i+1
+         nlim ^= nlim0 => delete_!(a, i..)
+         a
+
 *)
 
 \end{chunk}
 
-\begin{chunk}{HTMLFORM.dotabb}
-"HTMLFORM" [color="#88FF44",href="bookvol10.3.pdf#nameddest=HTMLFORM"]
-"STRING" [color="#4488FF",href="bookvol10.2.pdf#nameddest=STRING"]
-"HTMLFORM" -> "STRING"
+\begin{chunk}{IFARRAY.dotabb}
+"IFARRAY" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IFARRAY"]
+"A1AGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=A1AGG"]
+"IFARRAY" -> "A1AGG"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain HDP HomogeneousDirectProduct}
+\section{domain ILIST IndexedList}
 
-\begin{chunk}{HomogeneousDirectProduct.input}
+\begin{chunk}{IndexedList.input}
 )set break resume
-)sys rm -f HomogeneousDirectProduct.output
-)spool HomogeneousDirectProduct.output
+)sys rm -f IndexedList.output
+)spool IndexedList.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show HomogeneousDirectProduct
+)show IndexedList
 --R 
---R HomogeneousDirectProduct(dim: NonNegativeInteger,S: OrderedAbelianMonoidSup)  is a domain constructor
---R Abbreviation for HomogeneousDirectProduct is HDP 
+--R IndexedList(S: Type,mn: Integer)  is a domain constructor
+--R Abbreviation for IndexedList is ILIST 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for HDP 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for ILIST 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (S,%) -> % if S has MONOID      ?*? : (%,S) -> % if S has MONOID
---R ?*? : (%,%) -> % if S has MONOID      ?+? : (%,%) -> % if S has ABELSG
---R -? : % -> % if S has RING             ?-? : (%,%) -> % if S has RING
---R ?/? : (%,S) -> % if S has FIELD       1 : () -> % if S has MONOID
---R 0 : () -> % if S has CABMON           abs : % -> % if S has ORDRING
---R coerce : S -> % if S has SETCAT       coerce : % -> Vector(S)
---R copy : % -> %                         directProduct : Vector(S) -> %
---R dot : (%,%) -> S if S has RING        ?.? : (%,Integer) -> S
---R elt : (%,Integer,S) -> S              empty : () -> %
+--R children : % -> List(%)               concat : (%,S) -> %
+--R concat : List(%) -> %                 concat : (S,%) -> %
+--R concat : (%,%) -> %                   concat! : (%,S) -> %
+--R concat! : (%,%) -> %                  construct : List(S) -> %
+--R copy : % -> %                         cycleEntry : % -> %
+--R cycleTail : % -> %                    cyclic? : % -> Boolean
+--R delete : (%,Integer) -> %             delete! : (%,Integer) -> %
+--R distance : (%,%) -> Integer           elt : (%,Integer,S) -> S
+--R ?.? : (%,Integer) -> S                ?.last : (%,last) -> S
+--R ?.rest : (%,rest) -> %                ?.first : (%,first) -> S
+--R ?.value : (%,value) -> S              empty : () -> %
 --R empty? : % -> Boolean                 entries : % -> List(S)
---R eq? : (%,%) -> Boolean                index? : (Integer,%) -> Boolean
---R indices : % -> List(Integer)          latex : % -> String if S has SETCAT
---R map : ((S -> S),%) -> %               one? : % -> Boolean if S has MONOID
---R qelt : (%,Integer) -> S               random : () -> % if S has FINITE
---R retract : % -> S if S has SETCAT      sample : () -> %
---R sup : (%,%) -> % if S has OAMONS     
+--R eq? : (%,%) -> Boolean                explicitlyFinite? : % -> Boolean
+--R first : % -> S                        index? : (Integer,%) -> Boolean
+--R indices : % -> List(Integer)          insert : (S,%,Integer) -> %
+--R insert : (%,%,Integer) -> %           insert! : (S,%,Integer) -> %
+--R insert! : (%,%,Integer) -> %          last : (%,NonNegativeInteger) -> %
+--R last : % -> S                         latex : % -> String if S has SETCAT
+--R leaf? : % -> Boolean                  leaves : % -> List(S)
+--R list : S -> %                         map : (((S,S) -> S),%,%) -> %
+--R map : ((S -> S),%) -> %               max : (%,%) -> % if S has ORDSET
+--R min : (%,%) -> % if S has ORDSET      new : (NonNegativeInteger,S) -> %
+--R nodes : % -> List(%)                  possiblyInfinite? : % -> Boolean
+--R qelt : (%,Integer) -> S               remove! : ((S -> Boolean),%) -> %
+--R rest : (%,NonNegativeInteger) -> %    rest : % -> %
+--R reverse : % -> %                      sample : () -> %
+--R second : % -> S                       select! : ((S -> Boolean),%) -> %
+--R sort : (((S,S) -> Boolean),%) -> %    sort : % -> % if S has ORDSET
+--R tail : % -> %                         third : % -> S
+--R value : % -> S                       
 --R #? : % -> NonNegativeInteger if $ has finiteAggregate
---R ?*? : (PositiveInteger,%) -> % if S has ABELSG
---R ?*? : (NonNegativeInteger,%) -> % if S has CABMON
---R ?*? : (Integer,%) -> % if S has RING
---R ?**? : (%,PositiveInteger) -> % if S has MONOID
---R ?**? : (%,NonNegativeInteger) -> % if S has MONOID
---R ?<? : (%,%) -> Boolean if S has OAMONS or S has ORDRING
---R ?<=? : (%,%) -> Boolean if S has OAMONS or S has ORDRING
+--R ?<? : (%,%) -> Boolean if S has ORDSET
+--R ?<=? : (%,%) -> Boolean if S has ORDSET
 --R ?=? : (%,%) -> Boolean if S has SETCAT
---R ?>? : (%,%) -> Boolean if S has OAMONS or S has ORDRING
---R ?>=? : (%,%) -> Boolean if S has OAMONS or S has ORDRING
---R D : (%,(S -> S)) -> % if S has RING
---R D : (%,(S -> S),NonNegativeInteger) -> % if S has RING
---R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if S has PDRING(SYMBOL) and S has RING
---R D : (%,Symbol,NonNegativeInteger) -> % if S has PDRING(SYMBOL) and S has RING
---R D : (%,List(Symbol)) -> % if S has PDRING(SYMBOL) and S has RING
---R D : (%,Symbol) -> % if S has PDRING(SYMBOL) and S has RING
---R D : (%,NonNegativeInteger) -> % if S has DIFRING and S has RING
---R D : % -> % if S has DIFRING and S has RING
---R ?^? : (%,PositiveInteger) -> % if S has MONOID
---R ?^? : (%,NonNegativeInteger) -> % if S has MONOID
+--R ?>? : (%,%) -> Boolean if S has ORDSET
+--R ?>=? : (%,%) -> Boolean if S has ORDSET
 --R any? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
---R characteristic : () -> NonNegativeInteger if S has RING
---R coerce : Fraction(Integer) -> % if S has RETRACT(FRAC(INT)) and S has SETCAT
---R coerce : Integer -> % if S has RETRACT(INT) and S has SETCAT or S has RING
+--R child? : (%,%) -> Boolean if S has SETCAT
 --R coerce : % -> OutputForm if S has SETCAT
+--R convert : % -> InputForm if S has KONVERT(INFORM)
+--R copyInto! : (%,%,Integer) -> % if $ has shallowlyMutable
 --R count : (S,%) -> NonNegativeInteger if $ has finiteAggregate and S has SETCAT
 --R count : ((S -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R differentiate : (%,(S -> S)) -> % if S has RING
---R differentiate : (%,(S -> S),NonNegativeInteger) -> % if S has RING
---R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if S has PDRING(SYMBOL) and S has RING
---R differentiate : (%,Symbol,NonNegativeInteger) -> % if S has PDRING(SYMBOL) and S has RING
---R differentiate : (%,List(Symbol)) -> % if S has PDRING(SYMBOL) and S has RING
---R differentiate : (%,Symbol) -> % if S has PDRING(SYMBOL) and S has RING
---R differentiate : (%,NonNegativeInteger) -> % if S has DIFRING and S has RING
---R differentiate : % -> % if S has DIFRING and S has RING
---R dimension : () -> CardinalNumber if S has FIELD
+--R cycleLength : % -> NonNegativeInteger
+--R cycleSplit! : % -> % if $ has shallowlyMutable
+--R delete : (%,UniversalSegment(Integer)) -> %
+--R delete! : (%,UniversalSegment(Integer)) -> %
+--R ?.? : (%,UniversalSegment(Integer)) -> %
 --R entry? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
---R enumerate : () -> List(%) if S has FINITE
 --R eval : (%,List(S),List(S)) -> % if S has EVALAB(S) and S has SETCAT
 --R eval : (%,S,S) -> % if S has EVALAB(S) and S has SETCAT
 --R eval : (%,Equation(S)) -> % if S has EVALAB(S) and S has SETCAT
 --R eval : (%,List(Equation(S))) -> % if S has EVALAB(S) and S has SETCAT
 --R every? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
 --R fill! : (%,S) -> % if $ has shallowlyMutable
---R first : % -> S if Integer has ORDSET
+--R find : ((S -> Boolean),%) -> Union(S,"failed")
+--R first : (%,NonNegativeInteger) -> %
 --R hash : % -> SingleInteger if S has SETCAT
---R index : PositiveInteger -> % if S has FINITE
 --R less? : (%,NonNegativeInteger) -> Boolean
---R lookup : % -> PositiveInteger if S has FINITE
 --R map! : ((S -> S),%) -> % if $ has shallowlyMutable
---R max : (%,%) -> % if S has OAMONS or S has ORDRING
 --R maxIndex : % -> Integer if Integer has ORDSET
 --R member? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
 --R members : % -> List(S) if $ has finiteAggregate
---R min : (%,%) -> % if S has OAMONS or S has ORDRING
+--R merge : (((S,S) -> Boolean),%,%) -> %
+--R merge : (%,%) -> % if S has ORDSET
+--R merge! : (((S,S) -> Boolean),%,%) -> %
+--R merge! : (%,%) -> % if S has ORDSET
 --R minIndex : % -> Integer if Integer has ORDSET
 --R more? : (%,NonNegativeInteger) -> Boolean
---R negative? : % -> Boolean if S has ORDRING
+--R node? : (%,%) -> Boolean if S has SETCAT
 --R parts : % -> List(S) if $ has finiteAggregate
---R positive? : % -> Boolean if S has ORDRING
+--R position : ((S -> Boolean),%) -> Integer
+--R position : (S,%) -> Integer if S has SETCAT
+--R position : (S,%,Integer) -> Integer if S has SETCAT
 --R qsetelt! : (%,Integer,S) -> S if $ has shallowlyMutable
---R recip : % -> Union(%,"failed") if S has MONOID
---R reducedSystem : Matrix(%) -> Matrix(S) if S has RING
---R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(S),vec: Vector(S)) if S has RING
---R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer)) if S has LINEXP(INT) and S has RING
---R reducedSystem : Matrix(%) -> Matrix(Integer) if S has LINEXP(INT) and S has RING
---R retract : % -> Fraction(Integer) if S has RETRACT(FRAC(INT)) and S has SETCAT
---R retract : % -> Integer if S has RETRACT(INT) and S has SETCAT
---R retractIfCan : % -> Union(S,"failed") if S has SETCAT
---R retractIfCan : % -> Union(Fraction(Integer),"failed") if S has RETRACT(FRAC(INT)) and S has SETCAT
---R retractIfCan : % -> Union(Integer,"failed") if S has RETRACT(INT) and S has SETCAT
+--R reduce : (((S,S) -> S),%,S,S) -> S if $ has finiteAggregate and S has SETCAT
+--R reduce : (((S,S) -> S),%,S) -> S if $ has finiteAggregate
+--R reduce : (((S,S) -> S),%) -> S if $ has finiteAggregate
+--R remove : (S,%) -> % if $ has finiteAggregate and S has SETCAT
+--R remove : ((S -> Boolean),%) -> % if $ has finiteAggregate
+--R remove! : (S,%) -> % if S has SETCAT
+--R removeDuplicates : % -> % if $ has finiteAggregate and S has SETCAT
+--R removeDuplicates! : % -> % if S has SETCAT
+--R reverse! : % -> % if $ has shallowlyMutable
+--R select : ((S -> Boolean),%) -> % if $ has finiteAggregate
+--R setchildren! : (%,List(%)) -> % if $ has shallowlyMutable
 --R setelt : (%,Integer,S) -> S if $ has shallowlyMutable
---R sign : % -> Integer if S has ORDRING
---R size : () -> NonNegativeInteger if S has FINITE
+--R setelt : (%,UniversalSegment(Integer),S) -> S if $ has shallowlyMutable
+--R setelt : (%,last,S) -> S if $ has shallowlyMutable
+--R setelt : (%,rest,%) -> % if $ has shallowlyMutable
+--R setelt : (%,first,S) -> S if $ has shallowlyMutable
+--R setelt : (%,value,S) -> S if $ has shallowlyMutable
+--R setfirst! : (%,S) -> S if $ has shallowlyMutable
+--R setlast! : (%,S) -> S if $ has shallowlyMutable
+--R setrest! : (%,%) -> % if $ has shallowlyMutable
+--R setvalue! : (%,S) -> S if $ has shallowlyMutable
 --R size? : (%,NonNegativeInteger) -> Boolean
---R subtractIfCan : (%,%) -> Union(%,"failed") if S has CABMON
+--R sort! : (((S,S) -> Boolean),%) -> % if $ has shallowlyMutable
+--R sort! : % -> % if $ has shallowlyMutable and S has ORDSET
+--R sorted? : (((S,S) -> Boolean),%) -> Boolean
+--R sorted? : % -> Boolean if S has ORDSET
+--R split! : (%,Integer) -> % if $ has shallowlyMutable
 --R swap! : (%,Integer,Integer) -> Void if $ has shallowlyMutable
---R unitVector : PositiveInteger -> % if S has RING
---R zero? : % -> Boolean if S has CABMON
 --R ?~=? : (%,%) -> Boolean if S has SETCAT
 --R
 --E 1
@@ -73065,4852 +89985,3909 @@ HTMLFormat(): public == private where
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{HomogeneousDirectProduct.help}
+\begin{chunk}{IndexedList.help}
 ====================================================================
-HomogeneousDirectProduct examples
+IndexedList examples
 ====================================================================
 
-This type represents the finite direct or cartesian product of an
-underlying ordered component type. The vectors are ordered first
-by the sum of their components, and then refined using a reverse
-lexicographic ordering. This type is a suitable third argument for
-GeneralDistributedMultivariatePolynomial.
+IndexedList is a basic implementation of the functions in
+ListAggregate, often using functions in the underlying LISP
+system. The second parameter to the constructor (mn) is the beginning
+index of the list. That is, if l is a list, then elt(l,mn) is the
+first value. This constructor is probably best viewed as the
+implementation of singly-linked lists that are addressable by index
+rather than as a mere wrapper for LISP lists.
 
 See Also:
-o )show HomogeneousDirectProduct
+o )show IndexedList
 
 \end{chunk}
 
-\pagehead{HomogeneousDirectProduct}{HDP}
-\pagepic{ps/v103homogeneousdirectproduct.ps}{HDP}{1.00}
+\pagehead{IndexedList}{ILIST}
+\pagepic{ps/v103indexedlist.ps}{ILIST}{1.00}
 {\bf See}\\
-\pageto{OrderedDirectProduct}{ODP}
-\pageto{SplitHomogeneousDirectProduct}{SHDP}
+\pageto{List}{LIST}
+\pageto{AssociationList}{ALIST}
 
 {\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{HDP}{0} &
-\cross{HDP}{1} &
-\cross{HDP}{abs} &
-\cross{HDP}{any?} &
-\cross{HDP}{characteristic} \\
-\cross{HDP}{coerce} &
-\cross{HDP}{copy} &
-\cross{HDP}{count} &
-\cross{HDP}{D} &
-\cross{HDP}{differentiate} \\
-\cross{HDP}{dimension} &
-\cross{HDP}{directProduct} &
-\cross{HDP}{dot} &
-\cross{HDP}{elt} &
-\cross{HDP}{empty} \\
-\cross{HDP}{empty?} &
-\cross{HDP}{entries} &
-\cross{HDP}{entry?} &
-\cross{HDP}{eq?} &
-\cross{HDP}{eval} \\
-\cross{HDP}{every?} &
-\cross{HDP}{fill!} &
-\cross{HDP}{first} &
-\cross{HDP}{hash} &
-\cross{HDP}{index} \\
-\cross{HDP}{index?} &
-\cross{HDP}{indices} &
-\cross{HDP}{latex} &
-\cross{HDP}{less?} &
-\cross{HDP}{lookup} \\
-\cross{HDP}{map} &
-\cross{HDP}{map!} &
-\cross{HDP}{max} &
-\cross{HDP}{maxIndex} &
-\cross{HDP}{member?} \\
-\cross{HDP}{members} &
-\cross{HDP}{min} &
-\cross{HDP}{minIndex} &
-\cross{HDP}{more?} &
-\cross{HDP}{negative?} \\
-\cross{HDP}{one?} &
-\cross{HDP}{parts} &
-\cross{HDP}{positive?} &
-\cross{HDP}{qelt} &
-\cross{HDP}{qsetelt!} \\
-\cross{HDP}{random} &
-\cross{HDP}{recip} &
-\cross{HDP}{reducedSystem} &
-\cross{HDP}{retract} &
-\cross{HDP}{retractIfCan} \\
-\cross{HDP}{sample} &
-\cross{HDP}{setelt} &
-\cross{HDP}{sign} &
-\cross{HDP}{size} &
-\cross{HDP}{size?} \\
-\cross{HDP}{subtractIfCan} &
-\cross{HDP}{sup} &
-\cross{HDP}{swap!} &
-\cross{HDP}{unitVector} &
-\cross{HDP}{zero?} \\
-\cross{HDP}{\#{}?} &
-\cross{HDP}{?*?} &
-\cross{HDP}{?**?} &
-\cross{HDP}{?+?} &
-\cross{HDP}{?-?} \\
-\cross{HDP}{?/?} &
-\cross{HDP}{?$<$?} &
-\cross{HDP}{?$<=$?} &
-\cross{HDP}{?=?} &
-\cross{HDP}{?$>$?} \\
-\cross{HDP}{?$>=$?} &
-\cross{HDP}{?\^{}?} &
-\cross{HDP}{?\~{}=?} &
-\cross{HDP}{-?} &
-\cross{HDP}{?.?} 
+\begin{tabular}{llll}
+\cross{ILIST}{any?} &
+\cross{ILIST}{child?} &
+\cross{ILIST}{children} &
+\cross{ILIST}{coerce} \\
+\cross{ILIST}{concat} &
+\cross{ILIST}{convert} &
+\cross{ILIST}{concat!} &
+\cross{ILIST}{copyInto!} \\
+\cross{ILIST}{construct} &
+\cross{ILIST}{copy} &
+\cross{ILIST}{count} &
+\cross{ILIST}{cycleEntry} \\
+\cross{ILIST}{cycleLength} &
+\cross{ILIST}{cycleSplit!} &
+\cross{ILIST}{cycleTail} &
+\cross{ILIST}{cyclic?} \\
+\cross{ILIST}{delete} &
+\cross{ILIST}{delete!} &
+\cross{ILIST}{distance} &
+\cross{ILIST}{elt} \\
+\cross{ILIST}{empty} &
+\cross{ILIST}{empty?} &
+\cross{ILIST}{entries} &
+\cross{ILIST}{entry?} \\
+\cross{ILIST}{eq?} &
+\cross{ILIST}{eval} &
+\cross{ILIST}{every?} &
+\cross{ILIST}{explicitlyFinite?} \\
+\cross{ILIST}{fill!} &
+\cross{ILIST}{find} &
+\cross{ILIST}{first} &
+\cross{ILIST}{hash} \\
+\cross{ILIST}{index?} &
+\cross{ILIST}{indices} &
+\cross{ILIST}{insert} &
+\cross{ILIST}{insert!} \\
+\cross{ILIST}{last} &
+\cross{ILIST}{latex} &
+\cross{ILIST}{leaf?} &
+\cross{ILIST}{leaves} \\
+\cross{ILIST}{less?} &
+\cross{ILIST}{list} &
+\cross{ILIST}{map} &
+\cross{ILIST}{map!} \\
+\cross{ILIST}{max} &
+\cross{ILIST}{maxIndex} &
+\cross{ILIST}{member?} &
+\cross{ILIST}{members} \\
+\cross{ILIST}{merge} &
+\cross{ILIST}{merge!} &
+\cross{ILIST}{min} &
+\cross{ILIST}{minIndex} \\
+\cross{ILIST}{more?} &
+\cross{ILIST}{new} &
+\cross{ILIST}{node?} &
+\cross{ILIST}{nodes} \\
+\cross{ILIST}{parts} &
+\cross{ILIST}{position} &
+\cross{ILIST}{possiblyInfinite?} &
+\cross{ILIST}{qelt} \\
+\cross{ILIST}{qsetelt!} &
+\cross{ILIST}{reduce} &
+\cross{ILIST}{remove} &
+\cross{ILIST}{remove!} \\
+\cross{ILIST}{removeDuplicates} &
+\cross{ILIST}{removeDuplicates!} &
+\cross{ILIST}{rest} &
+\cross{ILIST}{reverse} \\
+\cross{ILIST}{reverse!} &
+\cross{ILIST}{sample} &
+\cross{ILIST}{second} &
+\cross{ILIST}{select} \\
+\cross{ILIST}{select!} &
+\cross{ILIST}{setchildren!} &
+\cross{ILIST}{setelt} &
+\cross{ILIST}{setfirst!} \\
+\cross{ILIST}{setlast!} &
+\cross{ILIST}{setrest!} &
+\cross{ILIST}{setvalue!} &
+\cross{ILIST}{size?} \\
+\cross{ILIST}{sort} &
+\cross{ILIST}{sort!} &
+\cross{ILIST}{sorted?} &
+\cross{ILIST}{split!} \\
+\cross{ILIST}{swap!} &
+\cross{ILIST}{tail} &
+\cross{ILIST}{third} &
+\cross{ILIST}{value} \\
+\cross{ILIST}{\#{}?} &
+\cross{ILIST}{?$<$?} &
+\cross{ILIST}{?$<=$?} &
+\cross{ILIST}{?=?} \\
+\cross{ILIST}{?$>$?} &
+\cross{ILIST}{?$>=$?} &
+\cross{ILIST}{?\~{}=?} &
+\cross{ILIST}{?.?} \\
+\cross{ILIST}{?.last} &
+\cross{ILIST}{?.rest} &
+\cross{ILIST}{?.first} &
+\cross{ILIST}{?.value} 
 \end{tabular}
 
-\begin{chunk}{domain HDP HomogeneousDirectProduct}
-)abbrev domain HDP HomogeneousDirectProduct
-++ Author: Mark Botch
+\begin{chunk}{domain ILIST IndexedList}
+)abbrev domain ILIST IndexedList
+++ Author: Michael Monagan
+++ Date Created: Sep 1987
 ++ Description:
-++ This type represents the finite direct or cartesian product of an
-++ underlying ordered component type. The vectors are ordered first
-++ by the sum of their components, and then refined using a reverse
-++ lexicographic ordering. This type is a suitable third argument for
-++ \spadtype{GeneralDistributedMultivariatePolynomial}.
-
-HomogeneousDirectProduct(dim,S) : T == C where
-   dim : NonNegativeInteger
-   S         : OrderedAbelianMonoidSup
-
-   T == DirectProductCategory(dim,S)
-   C == DirectProduct(dim,S) add
-        Rep:=Vector(S)
-        v1:% < v2:% ==
- -- reverse lexicographical ordering
-          n1:S:=0
-          n2:S:=0
-          for i in 1..dim repeat
-            n1:= n1+qelt(v1,i)
-            n2:=n2+qelt(v2,i)
-          n1<n2 => true
-          n2<n1 => false
-          for i in reverse(1..dim) repeat
-            if qelt(v2,i) < qelt(v1,i) then return true
-            if qelt(v1,i) < qelt(v2,i) then return false
-          false
-
-\end{chunk}
-
-\begin{chunk}{COQ HDP}
-(* domain HDP *)
-(*
-*)
-
-\end{chunk}
+++ \spadtype{IndexedList} is a basic implementation of the functions
+++ in \spadtype{ListAggregate}, often using functions in the underlying
+++ LISP system. The second parameter to the constructor (\spad{mn})
+++ is the beginning index of the list. That is, if \spad{l} is a
+++ list, then \spad{elt(l,mn)} is the first value. This constructor
+++ is probably best viewed as the implementation of singly-linked
+++ lists that are addressable by index rather than as a mere wrapper
+++ for LISP lists.
 
-\begin{chunk}{HDP.dotabb}
-"HDP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=HDP"]
-"DIRPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=DIRPCAT"]
-"HDP" -> "DIRPCAT"
+IndexedList(S:Type, mn:Integer): Exports == Implementation where
+ cycleMax ==> 1000        -- value used in checking for cycles
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain HDMP HomogeneousDistributedMultivariatePolynomial}
+-- The following seems to be a bit out of date, but is kept in case
+-- a knowledgeable person wants to update it:
+--   The following LISP dependencies are divided into two groups
+--   Those that are required
+--   CONS, EQ, NIL, NULL, QCAR, QCDR, RPLACA, RPLACD
+--   Those that are included for efficiency only
+--   NEQ, LIST, CAR, CDR, NCONC2, NREVERSE, LENGTH
+--   Also REVERSE, since it's called in Polynomial Ring
 
-\begin{chunk}{HomogeneousDistributedMultivariatePolynomial.input}
-)set break resume
-)sys rm -f HomogeneousDistributedMultivariatePolynomial.output
-)spool HomogeneousDistributedMultivariatePolynomial.output
-)set message test on
-)set message auto off
-)clear all
+ Qfirst  ==> QCAR$Lisp
+ Qrest   ==> QCDR$Lisp
+ Qnull   ==> NULL$Lisp
+ Qeq     ==> EQ$Lisp
+ Qneq    ==> NEQ$Lisp
+ Qcons   ==> CONS$Lisp
+ Qpush   ==> PUSH$Lisp
+ 
+ Exports ==> ListAggregate S 
+ Implementation ==>
+  add
 
---S 1 of 11
-(d1,d2,d3) : DMP([z,y,x],FRAC INT) 
---R 
---R                                                                   Type: Void
---E 1
+   #x                  == LENGTH(x)$Lisp
 
---S 2 of 11
-d1 := -4*z + 4*y**2*x + 16*x**2 + 1 
---R 
---R
---R                 2       2
---R   (2)  - 4z + 4y x + 16x  + 1
---R           Type: DistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
---E 2
+   concat(s:S,x:%)     == CONS(s,x)$Lisp
 
---S 3 of 11
-d2 := 2*z*y**2 + 4*x + 1 
---R 
---R
---R            2
---R   (3)  2z y  + 4x + 1
---R           Type: DistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
---E 3
+   eq?(x,y)            == EQ(x,y)$Lisp
 
---S 4 of 11
-d3 := 2*z*x**2 - 2*y**2 - x 
---R 
---R
---R            2     2
---R   (4)  2z x  - 2y  - x
---R           Type: DistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
---E 4
+   first x             == SPADfirst(x)$Lisp
 
---S 5 of 11
-groebner [d1,d2,d3]
---R 
---R
---R   (5)
---R        1568  6   1264  5    6   4   182  3   2047  2    103      2857
---R   [z - ---- x  - ---- x  + --- x  + --- x  - ---- x  - ---- x - -----,
---R        2745       305      305      549       610      2745     10980
---R     2    112  6    84  5   1264  4    13  3    84  2   1772       2
---R    y  + ---- x  - --- x  - ---- x  - --- x  + --- x  + ---- x + ----,
---R         2745      305       305      549      305      2745     2745
---R     7   29  6   17  4   11  3    1  2   15     1
---R    x  + -- x  - -- x  - -- x  + -- x  + -- x + -]
---R          4      16       8      32      16     4
---R     Type: List(DistributedMultivariatePolynomial([z,y,x],Fraction(Integer)))
---E 5
+   elt(x,"first")      == SPADfirst(x)$Lisp
 
---S 6 of 11
-(n1,n2,n3) : HDMP([z,y,x],FRAC INT)
---R 
---R                                                                   Type: Void
---E 6
+   empty()             == NIL$Lisp
 
---S 7 of 11
-n1 := d1
---R 
---R
---R          2       2
---R   (7)  4y x + 16x  - 4z + 1
---RType: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
---E 7
+   empty? x            == NULL(x)$Lisp
 
---S 8 of 11
-n2 := d2
---R 
---R
---R            2
---R   (8)  2z y  + 4x + 1
---RType: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
---E 8
+   rest x              == CDR(x)$Lisp
 
---S 9 of 11
-n3 := d3
---R 
---R
---R            2     2
---R   (9)  2z x  - 2y  - x
---RType: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer))
---E 9
+   elt(x,"rest")       == CDR(x)$Lisp
 
---S 10 of 11
-groebner [n1,n2,n3]
---R 
---R
---R   (10)
---R     4     3   3  2   1     1   4   29  3   1  2   7        9     1
---R   [y  + 2x  - - x  + - z - -, x  + -- x  - - y  - - z x - -- x - -,
---R               2      2     8        4      8      4       16     4
---R       2        1   2      2       1     2    2   1
---R    z y  + 2x + -, y x + 4x  - z + -, z x  - y  - - x,
---R                2                  4              2
---R     2     2     2   1     3
---R    z  - 4y  + 2x  - - z - - x]
---R                     4     2
---RType: List(HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction(Integer)))
---E 10
+   setfirst_!(x,s)     ==
+      empty? x => error "Cannot update an empty list"
+      Qfirst RPLACA(x,s)$Lisp
 
---S 11 of 11
-)show HomogeneousDistributedMultivariatePolynomial
---R 
---R HomogeneousDistributedMultivariatePolynomial(vl: List(Symbol),R: Ring)  is a domain constructor
---R Abbreviation for HomogeneousDistributedMultivariatePolynomial is HDMP 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for HDMP 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (%,R) -> %                      ?*? : (R,%) -> %
---R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
---R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
---R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
---R -? : % -> %                           ?/? : (%,R) -> % if R has FIELD
---R ?=? : (%,%) -> Boolean                1 : () -> %
---R 0 : () -> %                           ?^? : (%,NonNegativeInteger) -> %
---R ?^? : (%,PositiveInteger) -> %        coefficients : % -> List(R)
---R coerce : % -> % if R has INTDOM       coerce : R -> %
---R coerce : Integer -> %                 coerce : % -> OutputForm
---R content : % -> R if R has GCDDOM      eval : (%,List(%),List(%)) -> %
---R eval : (%,%,%) -> %                   eval : (%,Equation(%)) -> %
---R eval : (%,List(Equation(%))) -> %     gcd : (%,%) -> % if R has GCDDOM
---R gcd : List(%) -> % if R has GCDDOM    ground : % -> R
---R ground? : % -> Boolean                hash : % -> SingleInteger
---R latex : % -> String                   lcm : (%,%) -> % if R has GCDDOM
---R lcm : List(%) -> % if R has GCDDOM    leadingCoefficient : % -> R
---R leadingMonomial : % -> %              map : ((R -> R),%) -> %
---R max : (%,%) -> % if R has ORDSET      min : (%,%) -> % if R has ORDSET
---R monomial? : % -> Boolean              monomials : % -> List(%)
---R one? : % -> Boolean                   primitiveMonomials : % -> List(%)
---R recip : % -> Union(%,"failed")        reductum : % -> %
---R reorder : (%,List(Integer)) -> %      retract : % -> R
---R sample : () -> %                      zero? : % -> Boolean
---R ?~=? : (%,%) -> 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(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
---R D : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
---R D : (%,List(OrderedVariableList(vl))) -> %
---R D : (%,OrderedVariableList(vl)) -> %
---R associates? : (%,%) -> Boolean if R has INTDOM
---R binomThmExpt : (%,%,NonNegativeInteger) -> % if R has COMRING
---R characteristic : () -> NonNegativeInteger
---R charthRoot : % -> Union(%,"failed") if $ has CHARNZ and R has PFECAT or R has CHARNZ
---R coefficient : (%,List(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
---R coefficient : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
---R coefficient : (%,HomogeneousDirectProduct(#(vl),NonNegativeInteger)) -> R
---R coerce : Fraction(Integer) -> % if R has ALGEBRA(FRAC(INT)) or R has RETRACT(FRAC(INT))
---R coerce : OrderedVariableList(vl) -> %
---R conditionP : Matrix(%) -> Union(Vector(%),"failed") if $ has CHARNZ and R has PFECAT
---R content : (%,OrderedVariableList(vl)) -> % if R has GCDDOM
---R convert : % -> InputForm if OrderedVariableList(vl) has KONVERT(INFORM) and R has KONVERT(INFORM)
---R convert : % -> Pattern(Integer) if OrderedVariableList(vl) has KONVERT(PATTERN(INT)) and R has KONVERT(PATTERN(INT))
---R convert : % -> Pattern(Float) if OrderedVariableList(vl) has KONVERT(PATTERN(FLOAT)) and R has KONVERT(PATTERN(FLOAT))
---R degree : (%,List(OrderedVariableList(vl))) -> List(NonNegativeInteger)
---R degree : (%,OrderedVariableList(vl)) -> NonNegativeInteger
---R degree : % -> HomogeneousDirectProduct(#(vl),NonNegativeInteger)
---R differentiate : (%,List(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
---R differentiate : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
---R differentiate : (%,List(OrderedVariableList(vl))) -> %
---R differentiate : (%,OrderedVariableList(vl)) -> %
---R discriminant : (%,OrderedVariableList(vl)) -> % if R has COMRING
---R eval : (%,List(OrderedVariableList(vl)),List(%)) -> %
---R eval : (%,OrderedVariableList(vl),%) -> %
---R eval : (%,List(OrderedVariableList(vl)),List(R)) -> %
---R eval : (%,OrderedVariableList(vl),R) -> %
---R exquo : (%,%) -> Union(%,"failed") if R has INTDOM
---R exquo : (%,R) -> Union(%,"failed") 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 isExpt : % -> Union(Record(var: OrderedVariableList(vl),exponent: NonNegativeInteger),"failed")
---R isPlus : % -> Union(List(%),"failed")
---R isTimes : % -> Union(List(%),"failed")
---R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %) if R has GCDDOM
---R mainVariable : % -> Union(OrderedVariableList(vl),"failed")
---R mapExponents : ((HomogeneousDirectProduct(#(vl),NonNegativeInteger) -> HomogeneousDirectProduct(#(vl),NonNegativeInteger)),%) -> %
---R minimumDegree : (%,List(OrderedVariableList(vl))) -> List(NonNegativeInteger)
---R minimumDegree : (%,OrderedVariableList(vl)) -> NonNegativeInteger
---R minimumDegree : % -> HomogeneousDirectProduct(#(vl),NonNegativeInteger)
---R monicDivide : (%,%,OrderedVariableList(vl)) -> Record(quotient: %,remainder: %)
---R monomial : (%,List(OrderedVariableList(vl)),List(NonNegativeInteger)) -> %
---R monomial : (%,OrderedVariableList(vl),NonNegativeInteger) -> %
---R monomial : (R,HomogeneousDirectProduct(#(vl),NonNegativeInteger)) -> %
---R multivariate : (SparseUnivariatePolynomial(%),OrderedVariableList(vl)) -> %
---R multivariate : (SparseUnivariatePolynomial(R),OrderedVariableList(vl)) -> %
---R numberOfMonomials : % -> NonNegativeInteger
---R patternMatch : (%,Pattern(Integer),PatternMatchResult(Integer,%)) -> PatternMatchResult(Integer,%) if OrderedVariableList(vl) has PATMAB(INT) and R has PATMAB(INT)
---R patternMatch : (%,Pattern(Float),PatternMatchResult(Float,%)) -> PatternMatchResult(Float,%) if OrderedVariableList(vl) has PATMAB(FLOAT) and R has PATMAB(FLOAT)
---R pomopo! : (%,R,HomogeneousDirectProduct(#(vl),NonNegativeInteger),%) -> %
---R prime? : % -> Boolean if R has PFECAT
---R primitivePart : (%,OrderedVariableList(vl)) -> % if R has GCDDOM
---R primitivePart : % -> % if R has GCDDOM
---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 : (%,%,OrderedVariableList(vl)) -> % if R has COMRING
---R retract : % -> OrderedVariableList(vl)
---R retract : % -> Integer if R has RETRACT(INT)
---R retract : % -> Fraction(Integer) if R has RETRACT(FRAC(INT))
---R retractIfCan : % -> Union(OrderedVariableList(vl),"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 subtractIfCan : (%,%) -> Union(%,"failed")
---R totalDegree : (%,List(OrderedVariableList(vl))) -> 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 : (%,OrderedVariableList(vl)) -> SparseUnivariatePolynomial(%)
---R variables : % -> List(OrderedVariableList(vl))
---R
---E 11
+   setelt(x,"first",s) ==
+      empty? x => error "Cannot update an empty list"
+      Qfirst RPLACA(x,s)$Lisp
 
-)spool
-)lisp (bye)
-\end{chunk}
+   setrest_!(x,y)      ==
+      empty? x => error "Cannot update an empty list"
+      Qrest RPLACD(x,y)$Lisp
 
-\begin{chunk}{HomogeneousDistributedMultivariatePolynomial.help}
-====================================================================
-MultivariatePolynomial
-DistributedMultivariatePolynomial
-HomogeneousDistributedMultivariatePolynomial
-GeneralDistributedMultivariatePolynomial
-====================================================================
+   setelt(x,"rest",y)  ==
+      empty? x => error "Cannot update an empty list"
+      Qrest RPLACD(x,y)$Lisp
 
-DistributedMultivariatePolynomial which is abbreviated as DMP and 
-HomogeneousDistributedMultivariatePolynomial, which is abbreviated
-as HDMP, are very similar to MultivariatePolynomial except that 
-they are represented and displayed in a non-recursive manner.
+   construct l         == l pretend %
 
-  (d1,d2,d3) : DMP([z,y,x],FRAC INT) 
-                      Type: Void
+   parts s             == s pretend List S
 
-The constructor DMP orders its monomials lexicographically while
-HDMP orders them by total order refined by reverse lexicographic
-order.
+   reverse_! x         == NREVERSE(x)$Lisp
 
-  d1 := -4*z + 4*y**2*x + 16*x**2 + 1 
-            2       2
-   - 4z + 4y x + 16x  + 1
-            Type: DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+   reverse x           == REVERSE(x)$Lisp
 
-  d2 := 2*z*y**2 + 4*x + 1 
-       2
-   2z y  + 4x + 1
-            Type: DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+   minIndex x          == mn
 
-  d3 := 2*z*x**2 - 2*y**2 - x 
-       2     2
-   2z x  - 2y  - x
-            Type: DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+   rest(x, n) ==
+      for i in 1..n repeat
+         if Qnull x then error "index out of range"
+         x := Qrest x
+      x
 
-These constructors are mostly used in Groebner basis calculations.
+   copy x ==
+      y := empty()
+      for i in 0.. while not Qnull x repeat
+         if Qeq(i,cycleMax) and cyclic? x then error "cyclic list"
+         y := Qcons(Qfirst x,y)
+         x := Qrest x
+      (NREVERSE(y)$Lisp)@%
 
-  groebner [d1,d2,d3]
-        1568  6   1264  5    6   4   182  3   2047  2    103      2857
-   [z - ---- x  - ---- x  + --- x  + --- x  - ---- x  - ---- x - -----,
-        2745       305      305      549       610      2745     10980
-     2    112  6    84  5   1264  4    13  3    84  2   1772       2
-    y  + ---- x  - --- x  - ---- x  - --- x  + --- x  + ---- x + ----,
-         2745      305       305      549      305      2745     2745
-     7   29  6   17  4   11  3    1  2   15     1
-    x  + -- x  - -- x  - -- x  + -- x  + -- x + -]
-          4      16       8      32      16     4
-       Type: List DistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+   if S has SetCategory then
 
-  (n1,n2,n3) : HDMP([z,y,x],FRAC INT)
-                      Type: Void
+     coerce(x):OutputForm ==
+        -- displays cycle with overbar over the cycle
+        y := empty()$List(OutputForm)
+        s := cycleEntry x
+        while Qneq(x, s) repeat
+          y := concat((first x)::OutputForm, y)
+          x := rest x
+        y := reverse_! y
+        empty? s => bracket y
+        -- cyclic case: z is cylic part
+        z := list((first x)::OutputForm)
+        while Qneq(s, rest x) repeat
+           x := rest x
+           z := concat((first x)::OutputForm, z)
+        bracket concat_!(y, overbar commaSeparate reverse_! z)
 
-  n1 := d1
-     2       2
-   4y x + 16x  - 4z + 1
- Type: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+     x = y ==
+       Qeq(x,y) => true
+       while not Qnull x and not Qnull y repeat
+          Qfirst x ^=$S Qfirst y => return false
+          x := Qrest x
+          y := Qrest y
+       Qnull x and Qnull y
 
-  n2 := d2
-       2
-   2z y  + 4x + 1
- Type: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+     latex(x : %): String ==
+       s : String := "\left["
+       while not Qnull x repeat
+         s := concat(s, latex(Qfirst x)$S)$String
+         x := Qrest x
+         if not Qnull x then s := concat(s, ", ")$String
+       concat(s, " \right]")$String
 
-  n3 := d3
-       2     2
-   2z x  - 2y  - x
- Type: HomogeneousDistributedMultivariatePolynomial([z,y,x],Fraction Integer)
+     member?(s,x) ==
+        while not Qnull x repeat
+           if s = Qfirst x then return true else x := Qrest x
+        false
 
-Note that we get a different Groebner basis when we use the HDMP
-polynomials, as expected.
+   -- Lots of code from parts of AGGCAT, repeated here to
+   -- get faster compilation
+   concat_!(x:%,y:%) ==
+      Qnull x => 
+        Qnull y => x
+        Qpush(first y,x)
+        QRPLACD(x,rest y)$Lisp
+        x
+      z:=x
+      while not Qnull Qrest z repeat
+        z:=Qrest z
+      QRPLACD(z,y)$Lisp
+      x
 
-  groebner [n1,n2,n3]
-     4     3   3  2   1     1   4   29  3   1  2   7        9     1
-   [y  + 2x  - - x  + - z - -, x  + -- x  - - y  - - z x - -- x - -,
-               2      2     8        4      8      4       16     4
-       2        1   2      2       1     2    2   1
-    z y  + 2x + -, y x + 4x  - z + -, z x  - y  - - x,
-                2                  4              2
-     2     2     2   1     3
-    z  - 4y  + 2x  - - z - - x]
-                     4     2
-      Type: List HomogeneousDistributedMultivariatePolynomial([z,y,x],
-                                                           Fraction Integer)
+   -- Then a quicky:
+   if S has SetCategory then
 
-GeneralDistributedMultivariatePolynomial is somewhat more flexible in
-the sense that as well as accepting a list of variables to specify the
-variable ordering, it also takes a predicate on exponent vectors to
-specify the term ordering.  With this polynomial type the user can
-experiment with the effect of using completely arbitrary term orderings.  
-This flexibility is mostly important for algorithms such as Groebner 
-basis calculations which can be very sensitive to term ordering.
+     removeDuplicates_! l ==
+       p := l
+       while not Qnull p repeat
+         pp:=p
+         f:S:=Qfirst p
+         p:=Qrest p
+         while not Qnull (pr:=Qrest pp) repeat
+           if (Qfirst pr)@S = f then QRPLACD(pp,Qrest pr)$Lisp
+           else pp:=pr
+       l
 
-See Also:
-o )help Polynomial
-o )help UnivariatePolynomial
-o )help MultivariatePolynomial
-o )help DistributedMultivariatePolynomial
-o )help GeneralDistributedMultivariatePolynomial
-o )show HomogeneousDistributedMultivariatePolynomial
+   -- then sorting
+   mergeSort: ((S, S) -> Boolean, %, Integer) -> %
 
-\end{chunk}
-\pagehead{HomogeneousDistributedMultivariatePolynomial}{HDMP}
-\pagepic{ps/v103homogeneousdistributedmultivariatepolynomial.ps}{HDMP}{1.00}
-{\bf See}\\
-\pageto{GeneralDistributedMultivariatePolynomial}{GDMP}
-\pageto{DistributedMultivariatePolynomial}{DMP}
+   sort_!(f, l)       == mergeSort(f, l, #l)
 
-{\bf Exports:}\\
-\begin{tabular}{lll}
-\cross{HDMP}{0} &
-\cross{HDMP}{1} &
-\cross{HDMP}{associates?} \\
-\cross{HDMP}{binomThmExpt} &
-\cross{HDMP}{characteristic} &
-\cross{HDMP}{charthRoot} \\
-\cross{HDMP}{coefficient} &
-\cross{HDMP}{coefficients} &
-\cross{HDMP}{coerce} \\
-\cross{HDMP}{conditionP} &
-\cross{HDMP}{content} &
-\cross{HDMP}{convert} \\
-\cross{HDMP}{D} &
-\cross{HDMP}{degree} &
-\cross{HDMP}{differentiate} \\
-\cross{HDMP}{discriminant} &
-\cross{HDMP}{eval} &
-\cross{HDMP}{exquo} \\
-\cross{HDMP}{factor} &
-\cross{HDMP}{factorPolynomial} &
-\cross{HDMP}{factorSquareFreePolynomial} \\
-\cross{HDMP}{gcd} &
-\cross{HDMP}{gcdPolynomial} &
-\cross{HDMP}{ground} \\
-\cross{HDMP}{ground?} &
-\cross{HDMP}{hash} &
-\cross{HDMP}{isExpt} \\
-\cross{HDMP}{isPlus} &
-\cross{HDMP}{isTimes} &
-\cross{HDMP}{latex} \\
-\cross{HDMP}{lcm} &
-\cross{HDMP}{leadingCoefficient} &
-\cross{HDMP}{leadingMonomial} \\
-\cross{HDMP}{mainVariable} &
-\cross{HDMP}{map} &
-\cross{HDMP}{mapExponents} \\
-\cross{HDMP}{max} &
-\cross{HDMP}{min} &
-\cross{HDMP}{minimumDegree} \\
-\cross{HDMP}{monicDivide} &
-\cross{HDMP}{monomial} &
-\cross{HDMP}{monomial?} \\
-\cross{HDMP}{monomials} &
-\cross{HDMP}{multivariate} &
-\cross{HDMP}{numberOfMonomials} \\
-\cross{HDMP}{one?} &
-\cross{HDMP}{patternMatch} &
-\cross{HDMP}{pomopo!} \\
-\cross{HDMP}{prime?} &
-\cross{HDMP}{primitiveMonomials} &
-\cross{HDMP}{primitivePart} \\
-\cross{HDMP}{recip} &
-\cross{HDMP}{reducedSystem} &
-\cross{HDMP}{reductum} \\
-\cross{HDMP}{reorder} &
-\cross{HDMP}{resultant} &
-\cross{HDMP}{retract} \\
-\cross{HDMP}{retractIfCan} &
-\cross{HDMP}{sample} &
-\cross{HDMP}{solveLinearPolynomialEquation} \\
-\cross{HDMP}{squareFree} &
-\cross{HDMP}{squareFreePart} &
-\cross{HDMP}{squareFreePolynomial} \\
-\cross{HDMP}{subtractIfCan} &
-\cross{HDMP}{totalDegree} &
-\cross{HDMP}{unit?} \\
-\cross{HDMP}{unitCanonical} &
-\cross{HDMP}{unitNormal} &
-\cross{HDMP}{univariate} \\
-\cross{HDMP}{variables} &
-\cross{HDMP}{zero?} &
-\cross{HDMP}{?*?} \\
-\cross{HDMP}{?**?} &
-\cross{HDMP}{?+?} &
-\cross{HDMP}{?-?} \\
-\cross{HDMP}{-?} &
-\cross{HDMP}{?=?} &
-\cross{HDMP}{?\^{}?} \\
-\cross{HDMP}{?\~{}=?} &
-\cross{HDMP}{?/?} &
-\cross{HDMP}{?$<$?} \\
-\cross{HDMP}{?$<=$?} &
-\cross{HDMP}{?$>$?} &
-\cross{HDMP}{?$>=$?} \\
-\cross{HDMP}{?\^{}?} &&
-\end{tabular}
+   merge_!(f, p, q) ==
+     Qnull p => q
+     Qnull q => p
+     Qeq(p, q) => error "cannot merge a list into itself"
+     if f(Qfirst p, Qfirst q)
+       then (r := t := p; p := Qrest p)
+       else (r := t := q; q := Qrest q)
+     while not Qnull p and not Qnull q repeat
+       if f(Qfirst p, Qfirst q)
+         then (QRPLACD(t, p)$Lisp; t := p; p := Qrest p)
+         else (QRPLACD(t, q)$Lisp; t := q; q := Qrest q)
+     QRPLACD(t, if Qnull p then q else p)$Lisp
+     r
 
-\begin{chunk}{domain HDMP HomogeneousDistributedMultivariatePolynomial}
-)abbrev domain HDMP HomogeneousDistributedMultivariatePolynomial
-++ Author: Barry Trager
-++ Description:
-++ This type supports distributed multivariate polynomials
-++ whose variables are from a user specified list of symbols.
-++ The coefficient ring may be non commutative,
-++ but the variables are assumed to commute.
-++ The term ordering is total degree ordering refined by reverse
-++ lexicographic ordering with respect to the position that the variables
-++ appear in the list of variables parameter.
+   split_!(p, n) ==
+      n < 1 => error "index out of range"
+      p := rest(p, (n - 1)::NonNegativeInteger)
+      q := Qrest p
+      QRPLACD(p, NIL$Lisp)$Lisp
+      q
 
-HomogeneousDistributedMultivariatePolynomial(vl,R): public == private where
-  vl : List Symbol
-  R  : Ring
-  E   ==> HomogeneousDirectProduct(#vl,NonNegativeInteger)
-  OV  ==> OrderedVariableList(vl)
-  public == PolynomialCategory(R,E,OV) with
-      reorder: (%,List Integer) -> %
-        ++ reorder(p, perm) applies the permutation perm to the variables
-        ++ in a polynomial and returns the new correctly ordered polynomial
-  private ==
-    GeneralDistributedMultivariatePolynomial(vl,R,E)
+   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)
 
 \end{chunk}
 
-\begin{chunk}{COQ HDMP}
-(* domain HDMP *)
+\begin{chunk}{COQ ILIST}
+(* domain ILIST *)
 (*
-*)
-
-\end{chunk}
-
-\begin{chunk}{HDMP.dotabb}
-"HDMP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=HDMP"]
-"PFECAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PFECAT"]
-"DIRPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=DIRPCAT"]
-"HDMP" -> "PFECAT"
-"HDMP" -> "DIRPCAT"
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain HELLFDIV HyperellipticFiniteDivisor}
+   #? : % -> NonNegativeInteger if $ has finiteAggregate
+   #x == LENGTH(x)$Lisp
 
-\begin{chunk}{HyperellipticFiniteDivisor.input}
-)set break resume
-)sys rm -f HyperellipticFiniteDivisor.output
-)spool HyperellipticFiniteDivisor.output
-)set message test on
-)set message auto off
-)clear all
+   concat : (S,%) -> %
+   concat(s:S,x:%) == CONS(s,x)$Lisp
 
---S 1 of 1
-)show HyperellipticFiniteDivisor
---R 
---R HyperellipticFiniteDivisor(F: Field,UP: UnivariatePolynomialCategory(F),UPUP: UnivariatePolynomialCategory(Fraction(UP)),R: FunctionFieldCategory(F,UP,UPUP))  is a domain constructor
---R Abbreviation for HyperellipticFiniteDivisor is HELLFDIV 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for HELLFDIV 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (Integer,%) -> %                ?*? : (NonNegativeInteger,%) -> %
---R ?*? : (PositiveInteger,%) -> %        ?+? : (%,%) -> %
---R ?-? : (%,%) -> %                      -? : % -> %
---R ?=? : (%,%) -> Boolean                0 : () -> %
---R coerce : % -> OutputForm              divisor : (R,UP,UP,UP,F) -> %
---R divisor : (F,F,Integer) -> %          divisor : (F,F) -> %
---R divisor : R -> %                      generator : % -> Union(R,"failed")
---R hash : % -> SingleInteger             latex : % -> String
---R principal? : % -> Boolean             reduce : % -> %
---R sample : () -> %                      zero? : % -> Boolean
---R ?~=? : (%,%) -> Boolean              
---R decompose : % -> Record(id: FractionalIdeal(UP,Fraction(UP),UPUP,R),principalPart: R)
---R divisor : FractionalIdeal(UP,Fraction(UP),UPUP,R) -> %
---R ideal : % -> FractionalIdeal(UP,Fraction(UP),UPUP,R)
---R subtractIfCan : (%,%) -> Union(%,"failed")
---R
---E 1
+   eq? : (%,%) -> Boolean
+   eq?(x,y) == EQ(x,y)$Lisp
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{HyperellipticFiniteDivisor.help}
-====================================================================
-HyperellipticFiniteDivisor examples
-====================================================================
+   first : % -> S
+   first x == SPADfirst(x)$Lisp
 
-This domains implements finite rational divisors on an hyperelliptic curve,
-that is finite formal sums SUM(n * P) where the n's are integers and the
-P's are finite rational points on the curve.
+   ?.first : (%,first) -> S
+   elt(x,"first") == SPADfirst(x)$Lisp
 
-The equation of the curve must be  y^2 = f(x) and f must have odd degree.
+   empty : () -> %
+   empty() == NIL$Lisp
 
-See Also:
-o )show HyperellipticFiniteDivisor
+   empty? : % -> Boolean
+   empty? x == NULL(x)$Lisp
 
-\end{chunk}
+   rest : % -> %
+   rest x == CDR(x)$Lisp
 
-\pagehead{HyperellipticFiniteDivisor}{HELLFDIV}
-\pagepic{ps/v103hyperellipticfinitedivisor.ps}{HELLFDIV}{1.00}
-{\bf See}\\
-\pageto{FractionalIdeal}{FRIDEAL}
-\pageto{FramedModule}{FRMOD}
-\pageto{FiniteDivisor}{FDIV}
+   ?.rest : (%,rest) -> %
+   elt(x,"rest") == CDR(x)$Lisp
 
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{HELLFDIV}{0} &
-\cross{HELLFDIV}{coerce} &
-\cross{HELLFDIV}{decompose} &
-\cross{HELLFDIV}{divisor} &
-\cross{HELLFDIV}{hash} \\
-\cross{HELLFDIV}{ideal} &
-\cross{HELLFDIV}{generator} &
-\cross{HELLFDIV}{latex} &
-\cross{HELLFDIV}{principal?} &
-\cross{HELLFDIV}{reduce} \\
-\cross{HELLFDIV}{sample} &
-\cross{HELLFDIV}{subtractIfCan} &
-\cross{HELLFDIV}{zero?} &
-\cross{HELLFDIV}{?\~{}=?} &
-\cross{HELLFDIV}{?*?} \\
-\cross{HELLFDIV}{?+?} &
-\cross{HELLFDIV}{?-?} &
-\cross{HELLFDIV}{-?} &
-\cross{HELLFDIV}{?=?} &
-\end{tabular}
+   setfirst! : (%,S) -> S
+   setfirst_!(x,s) ==
+      empty? x => error "Cannot update an empty list"
+      Qfirst RPLACA(x,s)$Lisp
 
-\begin{chunk}{domain HELLFDIV HyperellipticFiniteDivisor}
-)abbrev domain HELLFDIV HyperellipticFiniteDivisor
-++ Author: Manuel Bronstein
-++ Date Created: 19 May 1993
-++ Date Last Updated: 20 July 1998
-++ Description:
-++ This domains implements finite rational divisors on an hyperelliptic curve,
-++ that is finite formal sums SUM(n * P) where the n's are integers and the
-++ P's are finite rational points on the curve.
-++ The equation of the curve must be  y^2 = f(x) and f must have odd degree.
+   setelt : (%,first,S) -> S
+   setelt(x,"first",s) ==
+      empty? x => error "Cannot update an empty list"
+      Qfirst RPLACA(x,s)$Lisp
 
-HyperellipticFiniteDivisor(F, UP, UPUP, R): Exports == Implementation where
-  F   : Field
-  UP  : UnivariatePolynomialCategory F
-  UPUP: UnivariatePolynomialCategory Fraction UP
-  R   : FunctionFieldCategory(F, UP, UPUP)
+   setrest! : (%,%) -> %
+   setrest_!(x,y) ==
+      empty? x => error "Cannot update an empty list"
+      Qrest RPLACD(x,y)$Lisp
 
-  O   ==> OutputForm
-  Z   ==> Integer
-  RF  ==> Fraction UP
-  ID  ==> FractionalIdeal(UP, RF, UPUP, R)
-  ERR ==> error "divisor: incomplete implementation for hyperelliptic curves"
+   setelt : (%,rest,%) -> %
+   setelt(x,"rest",y) ==
+      empty? x => error "Cannot update an empty list"
+      Qrest RPLACD(x,y)$Lisp
 
-  Exports ==> FiniteDivisorCategory(F, UP, UPUP, R)
+   construct : List(S) -> %
+   construct l == l pretend %
 
-  Implementation ==> add
-    if (uhyper:Union(UP, "failed") := hyperelliptic()$R) case "failed" then
-              error "HyperellipticFiniteDivisor: curve must be hyperelliptic"
+   parts : % -> List(S)
+   parts s == s pretend List S
 
--- we use the semi-reduced representation from D.Cantor, "Computing in the
--- Jacobian of a HyperellipticCurve", Mathematics of Computation, vol 48,
--- no.177, January 1987, 95-101.
--- The representation [a,b,f] for D means D = [a,b] + div(f)
--- and [a,b] is a semi-reduced representative on the Jacobian
-    Rep := Record(center:UP, polyPart:UP, principalPart:R, reduced?:Boolean)
+   reverse! : % -> %
+   reverse_! x == NREVERSE(x)$Lisp
 
-    hyper:UP := uhyper::UP
-    gen:Z    := ((degree(hyper)::Z - 1) exquo 2)::Z     -- genus of the curve
-    dvd:O    := "div"::Symbol::O
-    zer:O    := 0::Z::O
+   reverse : % -> %
+   reverse x == REVERSE(x)$Lisp
 
-    makeDivisor  : (UP, UP, R) -> %
-    intReduc     : (R, UP) -> R
-    princ?       : % -> Boolean
-    polyIfCan    : R -> Union(UP, "failed")
-    redpolyIfCan : (R, UP) -> Union(UP, "failed")
-    intReduce    : (R, UP) -> R
-    mkIdeal      : (UP, UP) -> ID
-    reducedTimes : (Z, UP, UP) -> %
-    reducedDouble: (UP, UP) -> %
+   minIndex : % -> Integer
+   minIndex x == mn
 
-    0                    == divisor(1$R)
-    divisor(g:R)         == [1, 0, g, true]
-    makeDivisor(a, b, g) == [a, b, g, false]
---    princ? d             == one?(d.center) and zero?(d.polyPart)
-    princ? d             == (d.center = 1) and zero?(d.polyPart)
-    ideal d     == ideal([d.principalPart]) * mkIdeal(d.center, d.polyPart)
-    decompose d == [ideal makeDivisor(d.center, d.polyPart, 1),d.principalPart]
-    mkIdeal(a, b) == ideal [a::RF::R, reduce(monomial(1, 1)$UPUP-b::RF::UPUP)]
+   rest : (%,NonNegativeInteger) -> %
+   rest(x, n) ==
+      for i in 1..n repeat
+         if Qnull x then error "index out of range"
+         x := Qrest x
+      x
 
--- keep the sum reduced if d1 and d2 are both reduced at the start
-    d1 + d2 ==
-      a1  := d1.center;   a2 := d2.center
-      b1  := d1.polyPart; b2 := d2.polyPart
-      rec := principalIdeal [a1, a2, b1 + b2]
-      d   := rec.generator
-      h   := rec.coef              -- d = h1 a1 + h2 a2 + h3(b1 + b2)
-      a   := ((a1 * a2) exquo d**2)::UP
-      b:UP:= first(h) * a1 * b2
-      b   := b + second(h) * a2 * b1
-      b   := b + third(h) * (b1*b2 + hyper)
-      b   := (b exquo d)::UP rem a
-      dd  := makeDivisor(a, b, d::RF * d1.principalPart * d2.principalPart)
-      d1.reduced? and d2.reduced? => reduce dd
-      dd
+   copy : % -> %
+   copy x ==
+      y := empty()
+      for i in 0.. while not Qnull x repeat
+         if Qeq(i,cycleMax) and cyclic? x then error "cyclic list"
+         y := Qcons(Qfirst x,y)
+         x := Qrest x
+      (NREVERSE(y)$Lisp)@%
 
--- if is cheaper to keep on reducing as we exponentiate if d is already reduced
-    n:Z * d:% ==
-      zero? n => 0
-      n < 0 => (-n) * (-d)
-      divisor(d.principalPart ** n) + divisor(mkIdeal(d.center,d.polyPart)**n)
+   if S has SetCategory then
 
-    divisor(i:ID) ==
---      one?(n := #(v := basis minimize i)) => divisor v minIndex v
-      (n := #(v := basis minimize i)) = 1 => divisor v minIndex v
-      n ^= 2 => ERR
-      a := v minIndex v
-      h := v maxIndex v
-      (u := polyIfCan a) case UP =>
-        (w := redpolyIfCan(h, u::UP)) case UP => makeDivisor(u::UP, w::UP, 1)
-        ERR
-      (u := polyIfCan h) case UP =>
-        (w := redpolyIfCan(a, u::UP)) case UP => makeDivisor(u::UP, w::UP, 1)
-        ERR
-      ERR
+     coerce : % -> OutputForm
+     coerce(x):OutputForm ==
+        -- displays cycle with overbar over the cycle
+        y := empty()$List(OutputForm)
+        s := cycleEntry x
+        while Qneq(x, s) repeat
+          y := concat((first x)::OutputForm, y)
+          x := rest x
+        y := reverse_! y
+        empty? s => bracket y
+        -- cyclic case: z is cylic part
+        z := list((first x)::OutputForm)
+        while Qneq(s, rest x) repeat
+           x := rest x
+           z := concat((first x)::OutputForm, z)
+        bracket concat_!(y, overbar commaSeparate reverse_! z)
 
-    polyIfCan a ==
-      (u := retractIfCan(a)@Union(RF, "failed")) case "failed" => "failed"
-      (v := retractIfCan(u::RF)@Union(UP, "failed")) case "failed" => "failed"
-      v::UP
+     ?=? : (%,%) -> Boolean
+     x = y ==
+       Qeq(x,y) => true
+       while not Qnull x and not Qnull y repeat
+          Qfirst x ^=$S Qfirst y => return false
+          x := Qrest x
+          y := Qrest y
+       Qnull x and Qnull y
 
-    redpolyIfCan(h, a) ==
-      degree(p := lift h) ^= 1 => "failed"
-      q := - coefficient(p, 0) / coefficient(p, 1)
-      rec := extendedEuclidean(denom q, a)
-      not ground?(rec.generator) => "failed"
-      ((numer(q) * rec.coef1) exquo rec.generator)::UP rem a
+     latex : % -> String
+     latex(x : %): String ==
+       s : String := "\left["
+       while not Qnull x repeat
+         s := concat(s, latex(Qfirst x)$S)$String
+         x := Qrest x
+         if not Qnull x then s := concat(s, ", ")$String
+       concat(s, " \right]")$String
 
-    coerce(d:%):O ==
-      r := bracket [d.center::O, d.polyPart::O]
-      g := prefix(dvd, [d.principalPart::O])
-      z := (d.principalPart = 1)
-      princ? d => (z => zer; g)
-      z => r
-      r + g
+     member? : (S,%) -> Boolean
+     member?(s,x) ==
+        while not Qnull x repeat
+           if s = Qfirst x then return true else x := Qrest x
+        false
 
-    reduce d ==
-      d.reduced? => d
-      degree(a := d.center) <= gen => (d.reduced? := true; d)
-      b  := d.polyPart
-      a0 := ((hyper - b**2) exquo a)::UP
-      b0 := (-b) rem a0
-      g  := d.principalPart * reduce(b::RF::UPUP-monomial(1,1)$UPUP)/a0::RF::R
-      reduce makeDivisor(a0, b0, g)
+   -- Lots of code from parts of AGGCAT, repeated here to
+   -- get faster compilation
+   concat! : (%,%) -> %
+   concat_!(x:%,y:%) ==
+      Qnull x => 
+        Qnull y => x
+        Qpush(first y,x)
+        QRPLACD(x,rest y)$Lisp
+        x
+      z:=x
+      while not Qnull Qrest z repeat
+        z:=Qrest z
+      QRPLACD(z,y)$Lisp
+      x
 
-    generator d ==
-      d := reduce d
-      princ? d => d.principalPart
-      "failed"
+   -- Then a quicky:
+   if S has SetCategory then
 
-    - d ==
-      a := d.center
-      makeDivisor(a, - d.polyPart, inv(a::RF * d.principalPart))
+     removeDuplicates! : % -> % if S has SETCAT
+     removeDuplicates_! l ==
+       p := l
+       while not Qnull p repeat
+         pp:=p
+         f:S:=Qfirst p
+         p:=Qrest p
+         while not Qnull (pr:=Qrest pp) repeat
+           if (Qfirst pr)@S = f then QRPLACD(pp,Qrest pr)$Lisp
+           else pp:=pr
+       l
 
-    d1 = d2 ==
-      d1 := reduce d1
-      d2 := reduce d2
-      d1.center = d2.center and d1.polyPart = d2.polyPart
-        and d1.principalPart = d2.principalPart
+   -- then sorting
 
-    divisor(a, b) ==
-      x := monomial(1, 1)$UP
-      not ground? gcd(d := x - a::UP, retract(discriminant())@UP) =>
-                                  error "divisor: point is singular"
-      makeDivisor(d, b::UP, 1)
+   sort! : (((S,S) -> Boolean),%) -> %
+   sort_!(f, l) == mergeSort(f, l, #l)
 
-    intReduce(h, b) ==
-      v := integralCoordinates(h).num
-      integralRepresents(
-                [qelt(v, i) rem b for i in minIndex v .. maxIndex v], 1)
+   merge! : (((S,S) -> Boolean),%,%) -> %
+   merge_!(f, p, q) ==
+     Qnull p => q
+     Qnull q => p
+     Qeq(p, q) => error "cannot merge a list into itself"
+     if f(Qfirst p, Qfirst q)
+       then (r := t := p; p := Qrest p)
+       else (r := t := q; q := Qrest q)
+     while not Qnull p and not Qnull q repeat
+       if f(Qfirst p, Qfirst q)
+         then (QRPLACD(t, p)$Lisp; t := p; p := Qrest p)
+         else (QRPLACD(t, q)$Lisp; t := q; q := Qrest q)
+     QRPLACD(t, if Qnull p then q else p)$Lisp
+     r
 
--- with hyperelliptic curves, it is cheaper to keep divisors in reduced form
-    divisor(h, a, dp, g, r) ==
-      h  := h - (r * dp)::RF::R
-      a  := gcd(a, retract(norm h)@UP)
-      h  := intReduce(h, a)
-      if not ground? gcd(g, a) then h := intReduce(h ** rank(), a)
-      hh := lift h
-      b  := - coefficient(hh, 0) / coefficient(hh, 1)
-      rec := extendedEuclidean(denom b, a)
-      not ground?(rec.generator) => ERR
-      bb := ((numer(b) * rec.coef1) exquo rec.generator)::UP rem a
-      reduce makeDivisor(a, bb, 1)
+   split! : (%,Integer) -> %
+   split_!(p, n) ==
+      n < 1 => error "index out of range"
+      p := rest(p, (n - 1)::NonNegativeInteger)
+      q := Qrest p
+      QRPLACD(p, NIL$Lisp)$Lisp
+      q
 
-\end{chunk}
+   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)
 
-\begin{chunk}{COQ HELLFDIV}
-(* domain HELLFDIV *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{HELLFDIV.dotabb}
-"HELLFDIV" [color="#88FF44",href="bookvol10.3.pdf#nameddest=HELLFDIV"]
-"FDIVCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FDIVCAT"]
-"HELLFDIV" -> "FDIVCAT"
+\begin{chunk}{ILIST.dotabb}
+"ILIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ILIST",
+          shape=ellipse]
+"STRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=STRING"]
+"ILIST" -> "STRING"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\chapter{Chapter I}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain ICP InfClsPt}
+\section{domain IMATRIX IndexedMatrix}
 
-\begin{chunk}{InfClsPt.input}
+\begin{chunk}{IndexedMatrix.input}
 )set break resume
-)sys rm -f InfClsPt.output
-)spool InfClsPt.output
+)sys rm -f IndexedMatrix.output
+)spool IndexedMatrix.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show InfClsPt
+)show IndexedMatrix
 --R 
---R InfClsPt(K: Field,symb: List(Symbol),BLMET: BlowUpMethodCategory)  is a domain constructor
---R Abbreviation for InfClsPt is ICP 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for ICP 
+--R IndexedMatrix(R: Ring,mnRow: Integer,mnCol: Integer)  is a domain constructor
+--R Abbreviation for IndexedMatrix is IMATRIX 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IMATRIX 
 --R
 --R------------------------------- Operations --------------------------------
---R ?=? : (%,%) -> Boolean                actualExtensionV : % -> K
---R chartV : % -> BLMET                   coerce : % -> OutputForm
---R degree : % -> PositiveInteger         excpDivV : % -> Divisor(Places(K))
---R fullOut : % -> OutputForm             fullOutput : () -> Boolean
---R fullOutput : Boolean -> Boolean       hash : % -> SingleInteger
---R latex : % -> String                   localPointV : % -> AffinePlane(K)
---R multV : % -> NonNegativeInteger       pointV : % -> ProjectivePlane(K)
---R setchart! : (%,BLMET) -> BLMET        setsymbName! : (%,Symbol) -> Symbol
---R subMultV : % -> NonNegativeInteger    symbNameV : % -> Symbol
---R ?~=? : (%,%) -> Boolean              
---R create : (ProjectivePlane(K),DistributedMultivariatePolynomial(symb,K)) -> %
---R create : (ProjectivePlane(K),DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K),AffinePlane(K),NonNegativeInteger,BLMET,NonNegativeInteger,Divisor(Places(K)),K,Symbol) -> %
---R curveV : % -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
---R localParamV : % -> List(NeitherSparseOrDensePowerSeries(K))
---R setcurve! : (%,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)) -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
---R setexcpDiv! : (%,Divisor(Places(K))) -> Divisor(Places(K))
---R setlocalParam! : (%,List(NeitherSparseOrDensePowerSeries(K))) -> List(NeitherSparseOrDensePowerSeries(K))
---R setlocalPoint! : (%,AffinePlane(K)) -> AffinePlane(K)
---R setmult! : (%,NonNegativeInteger) -> NonNegativeInteger
---R setpoint! : (%,ProjectivePlane(K)) -> ProjectivePlane(K)
---R setsubmult! : (%,NonNegativeInteger) -> NonNegativeInteger
+--R ?*? : (Integer,%) -> %                ?*? : (%,R) -> %
+--R ?*? : (R,%) -> %                      ?*? : (%,%) -> %
+--R ?**? : (%,NonNegativeInteger) -> %    ?+? : (%,%) -> %
+--R -? : % -> %                           ?-? : (%,%) -> %
+--R ?/? : (%,R) -> % if R has FIELD       antisymmetric? : % -> Boolean
+--R copy : % -> %                         diagonal? : % -> Boolean
+--R diagonalMatrix : List(%) -> %         diagonalMatrix : List(R) -> %
+--R elt : (%,Integer,Integer,R) -> R      elt : (%,Integer,Integer) -> R
+--R empty : () -> %                       empty? : % -> Boolean
+--R eq? : (%,%) -> Boolean                fill! : (%,R) -> %
+--R horizConcat : (%,%) -> %              latex : % -> String if R has SETCAT
+--R listOfLists : % -> List(List(R))      map : (((R,R) -> R),%,%,R) -> %
+--R map : (((R,R) -> R),%,%) -> %         map : ((R -> R),%) -> %
+--R map! : ((R -> R),%) -> %              matrix : List(List(R)) -> %
+--R maxColIndex : % -> Integer            maxRowIndex : % -> Integer
+--R minColIndex : % -> Integer            minRowIndex : % -> Integer
+--R ncols : % -> NonNegativeInteger       nrows : % -> NonNegativeInteger
+--R parts : % -> List(R)                  pfaffian : % -> R if R has COMRING
+--R qelt : (%,Integer,Integer) -> R       sample : () -> %
+--R setelt : (%,Integer,Integer,R) -> R   square? : % -> Boolean
+--R squareTop : % -> %                    symmetric? : % -> Boolean
+--R transpose : % -> %                    vertConcat : (%,%) -> %
+--R #? : % -> NonNegativeInteger if $ has finiteAggregate
+--R ?*? : (IndexedVector(R,mnCol),%) -> IndexedVector(R,mnCol)
+--R ?*? : (%,IndexedVector(R,mnRow)) -> IndexedVector(R,mnRow)
+--R ?**? : (%,Integer) -> % if R has FIELD
+--R ?=? : (%,%) -> Boolean if R has SETCAT
+--R any? : ((R -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R coerce : IndexedVector(R,mnRow) -> %
+--R coerce : % -> OutputForm if R has SETCAT
+--R column : (%,Integer) -> IndexedVector(R,mnRow)
+--R columnSpace : % -> List(IndexedVector(R,mnRow)) if R has EUCDOM
+--R count : (R,%) -> NonNegativeInteger if $ has finiteAggregate and R has SETCAT
+--R count : ((R -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
+--R determinant : % -> R if R has commutative(*)
+--R elt : (%,List(Integer),List(Integer)) -> %
+--R eval : (%,List(R),List(R)) -> % if R has EVALAB(R) and R has SETCAT
+--R eval : (%,R,R) -> % if R has EVALAB(R) and R has SETCAT
+--R eval : (%,Equation(R)) -> % if R has EVALAB(R) and R has SETCAT
+--R eval : (%,List(Equation(R))) -> % if R has EVALAB(R) and R has SETCAT
+--R every? : ((R -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R exquo : (%,R) -> Union(%,"failed") if R has INTDOM
+--R hash : % -> SingleInteger if R has SETCAT
+--R inverse : % -> Union(%,"failed") if R has FIELD
+--R less? : (%,NonNegativeInteger) -> Boolean
+--R matrix : (NonNegativeInteger,NonNegativeInteger,((Integer,Integer) -> R)) -> %
+--R member? : (R,%) -> Boolean if $ has finiteAggregate and R has SETCAT
+--R members : % -> List(R) if $ has finiteAggregate
+--R minordet : % -> R if R has commutative(*)
+--R more? : (%,NonNegativeInteger) -> Boolean
+--R new : (NonNegativeInteger,NonNegativeInteger,R) -> %
+--R nullSpace : % -> List(IndexedVector(R,mnRow)) if R has INTDOM
+--R nullity : % -> NonNegativeInteger if R has INTDOM
+--R qsetelt! : (%,Integer,Integer,R) -> R
+--R rank : % -> NonNegativeInteger if R has INTDOM
+--R row : (%,Integer) -> IndexedVector(R,mnCol)
+--R rowEchelon : % -> % if R has EUCDOM
+--R scalarMatrix : (NonNegativeInteger,R) -> %
+--R setColumn! : (%,Integer,IndexedVector(R,mnRow)) -> %
+--R setRow! : (%,Integer,IndexedVector(R,mnCol)) -> %
+--R setelt : (%,List(Integer),List(Integer),%) -> %
+--R setsubMatrix! : (%,Integer,Integer,%) -> %
+--R size? : (%,NonNegativeInteger) -> Boolean
+--R subMatrix : (%,Integer,Integer,Integer,Integer) -> %
+--R swapColumns! : (%,Integer,Integer) -> %
+--R swapRows! : (%,Integer,Integer) -> %
+--R transpose : IndexedVector(R,mnCol) -> %
+--R zero : (NonNegativeInteger,NonNegativeInteger) -> %
+--R ?~=? : (%,%) -> Boolean if R has SETCAT
 --R
 --E 1
 
 )spool
 )lisp (bye)
-
 \end{chunk}
-\begin{chunk}{InfClsPt.help}
+\begin{chunk}{IndexedMatrix.help}
 ====================================================================
-InfClsPt examples
+IndexedMatrix examples
 ====================================================================
 
-This domain is part of the PAFF package
+An IndexedMatrix is a matrix where the minimal row and column
+indices are parameters of the type.  The domains Row and Col
+are both IndexedVectors.
+
+The index of the 'first' row may be obtained by calling the function
+minRowIndex. The index of the 'first' column may be obtained by calling 
+the function minColIndex.  The index of the first element of a 'Row' is 
+the same as the index of the first column in a matrix and vice versa.
 
 See Also:
-o )show InfClsPt
+o )show IndexedMatrix
 
 \end{chunk}
-\pagehead{InfClsPt}{ICP}
-\pagepic{ps/v103infclspt.eps}{ICP}{1.00}
+
+\pagehead{IndexedMatrix}{IMATRIX}
+\pagepic{ps/v103indexedmatrix.ps}{IMATRIX}{1.00}
+{\bf See}\\
+\pageto{Matrix}{MATRIX}
+\pageto{RectangularMatrix}{RMATRIX}
+\pageto{SquareMatrix}{SQMATRIX}
 
 {\bf Exports:}\\
-\begin{tabular}{lll}
-\cross{IC}{?=?} &
-\cross{IC}{?\~{}=?} &
-\cross{IC}{actualExtensionV} \\
-\cross{IC}{chartV} &
-\cross{IC}{coerce} &
-\cross{IC}{create} \\
-\cross{IC}{curveV} &
-\cross{IC}{degree} &
-\cross{IC}{excpDivV} \\
-\cross{IC}{fullOut} &
-\cross{IC}{fullOutput} &
-\cross{IC}{hash} \\
-\cross{IC}{latex} &
-\cross{IC}{localParamV} &
-\cross{IC}{localPointV} \\
-\cross{IC}{multV} &
-\cross{IC}{pointV} &
-\cross{IC}{setchart!} \\
-\cross{IC}{setcurve!} &
-\cross{IC}{setexcpDiv!} &
-\cross{IC}{setlocalParam!} \\
-\cross{IC}{setlocalPoint!} &
-\cross{IC}{setmult!} &
-\cross{IC}{setpoint!} \\
-\cross{IC}{setsubmult!} &
-\cross{IC}{setsymbName!} &
-\cross{IC}{subMultV} \\
-\cross{IC}{symbNameV} &&
+\begin{tabular}{lllll}
+\cross{IMATRIX}{any?} &
+\cross{IMATRIX}{antisymmetric?} &
+\cross{IMATRIX}{coerce} &
+\cross{IMATRIX}{column} &
+\cross{IMATRIX}{copy} \\
+\cross{IMATRIX}{count} &
+\cross{IMATRIX}{determinant} &
+\cross{IMATRIX}{diagonal?} &
+\cross{IMATRIX}{diagonalMatrix} &
+\cross{IMATRIX}{elt} \\
+\cross{IMATRIX}{empty} &
+\cross{IMATRIX}{empty?} &
+\cross{IMATRIX}{eq?} &
+\cross{IMATRIX}{eval} &
+\cross{IMATRIX}{every?} \\
+\cross{IMATRIX}{exquo} &
+\cross{IMATRIX}{fill!} &
+\cross{IMATRIX}{hash} &
+\cross{IMATRIX}{horizConcat} &
+\cross{IMATRIX}{inverse} \\
+\cross{IMATRIX}{latex} &
+\cross{IMATRIX}{less?} &
+\cross{IMATRIX}{listOfLists} &
+\cross{IMATRIX}{map} &
+\cross{IMATRIX}{map!} \\
+\cross{IMATRIX}{matrix} &
+\cross{IMATRIX}{maxColIndex} &
+\cross{IMATRIX}{maxRowIndex} &
+\cross{IMATRIX}{member?} &
+\cross{IMATRIX}{members} \\
+\cross{IMATRIX}{minColIndex} &
+\cross{IMATRIX}{minordet} &
+\cross{IMATRIX}{minRowIndex} &
+\cross{IMATRIX}{more?} &
+\cross{IMATRIX}{ncols} \\
+\cross{IMATRIX}{new} &
+\cross{IMATRIX}{nrows} &
+\cross{IMATRIX}{nullSpace} &
+\cross{IMATRIX}{nullity} &
+\cross{IMATRIX}{parts} \\
+\cross{IMATRIX}{qelt} &
+\cross{IMATRIX}{qsetelt!} &
+\cross{IMATRIX}{rank} &
+\cross{IMATRIX}{row} &
+\cross{IMATRIX}{rowEchelon} \\
+\cross{IMATRIX}{sample} &
+\cross{IMATRIX}{scalarMatrix} &
+\cross{IMATRIX}{setColumn!} &
+\cross{IMATRIX}{setRow!} &
+\cross{IMATRIX}{setelt} \\
+\cross{IMATRIX}{setsubMatrix!} &
+\cross{IMATRIX}{size?} &
+\cross{IMATRIX}{square?} &
+\cross{IMATRIX}{squareTop} &
+\cross{IMATRIX}{subMatrix} \\
+\cross{IMATRIX}{swapColumns!} &
+\cross{IMATRIX}{swapRows!} &
+\cross{IMATRIX}{symmetric?} &
+\cross{IMATRIX}{transpose} &
+\cross{IMATRIX}{vertConcat} \\
+\cross{IMATRIX}{zero} &
+\cross{IMATRIX}{\#{}?} &
+\cross{IMATRIX}{?*?} &
+\cross{IMATRIX}{?**?} &
+\cross{IMATRIX}{?/?} \\
+\cross{IMATRIX}{?=?} &
+\cross{IMATRIX}{?\~{}=?} &
+\cross{IMATRIX}{?+?} &
+\cross{IMATRIX}{-?} &
+\cross{IMATRIX}{?-?} 
 \end{tabular}
 
-\begin{chunk}{domain ICP InfClsPt}
-)abbrev domain ICP InfClsPt
-++ Authors: Gaetan Hache
-++ Date Created: june 1996 
-++ Date Last Updated: May 2010 by Tim Daly
-++ Description: 
-++ This domain is part of the PAFF package
-InfClsPt(K,symb,BLMET):Exports == Implementation where
-  K:Field
-  symb: List Symbol
-  BLMET : BlowUpMethodCategory
-
-  E         ==> DirectProduct(#symb,NonNegativeInteger)
-  PolyRing  ==> DistributedMultivariatePolynomial(symb,K) 
-  ProjPt    ==> ProjectivePlane(K)
-  PCS       ==> NeitherSparseOrDensePowerSeries(K)
-  Plc       ==> Places(K)
-  DIVISOR   ==> Divisor(Plc)
+\begin{chunk}{domain IMATRIX IndexedMatrix}
+)abbrev domain IMATRIX IndexedMatrix
+++ Author: Grabmeier, Gschnitzer, Williamson
+++ Date Created: 1987
+++ Date Last Updated: July 1990
+++ Description:
+++ An \spad{IndexedMatrix} is a matrix where the minimal row and column
+++ indices are parameters of the type.  The domains Row and Col
+++ are both IndexedVectors.
+++ The index of the 'first' row may be obtained by calling the
+++ function \spadfun{minRowIndex}.  The index of the 'first' column may
+++ be obtained by calling the function \spadfun{minColIndex}.  The index of
+++ the first element of a 'Row' is the same as the index of the
+++ first column in a matrix and vice versa.
 
-  Exports == InfinitlyClosePointCategory(K,symb,PolyRing,E,ProjPt,_
-                                         PCS,Plc,DIVISOR,BLMET) with
-    fullOut: % -> OutputForm
-      ++ fullOut(tr) yields a full output of tr (see function fullOutput).
+IndexedMatrix(R,mnRow,mnCol): Exports == Implementation where
+  R : Ring
+  mnRow, mnCol : Integer
+  Row ==> IndexedVector(R,mnCol)
+  Col ==> IndexedVector(R,mnRow)
+  MATLIN ==> MatrixLinearAlgebraFunctions(R,Row,Col,$)
+ 
+  Exports ==> MatrixCategory(R,Row,Col)
+ 
+  Implementation ==>
+    InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col) add
+ 
+      swapRows_!(x,i1,i2) ==
+        (i1 < minRowIndex(x)) or (i1 > maxRowIndex(x)) or _
+           (i2 < minRowIndex(x)) or (i2 > maxRowIndex(x)) =>
+             error "swapRows!: index out of range"
+        i1 = i2 => x
+        minRow := minRowIndex x
+        xx := x pretend PrimitiveArray(PrimitiveArray(R))
+        n1 := i1 - minRow; n2 := i2 - minRow
+        row1 := qelt(xx,n1)
+        qsetelt_!(xx,n1,qelt(xx,n2))
+        qsetelt_!(xx,n2,row1)
+        xx pretend $
+ 
+      if R has commutative("*") then
+ 
+        determinant x == determinant(x)$MATLIN
 
-    fullOutput: Boolean -> Boolean
-      ++ fullOutput(b) sets a flag such that when true, a coerce to 
-      ++ OutputForm yields the full output of tr, otherwise encode(tr) is 
-      ++ output (see encode function). The default is false.
+        minordet    x == minordet(x)$MATLIN
+ 
+      if R has EuclideanDomain then
+ 
+        rowEchelon  x == rowEchelon(x)$MATLIN
+ 
+      if R has IntegralDomain then
+ 
+        rank        x == rank(x)$MATLIN
 
-    fullOutput: () -> Boolean
-      ++ fullOutput returns the value of the flag set by fullOutput(b).   
-     
-  Implementation == InfinitlyClosePoint(K,symb,PolyRing,E,ProjPt,_
-                                        PCS,Plc,DIVISOR,BLMET) 
+        nullity     x == nullity(x)$MATLIN
 
+        nullSpace   x == nullSpace(x)$MATLIN
+ 
+      if R has Field then
+ 
+        inverse     x == inverse(x)$MATLIN
 
 \end{chunk}
 
-\begin{chunk}{COQ ICP}
-(* domain ICP *)
+\begin{chunk}{COQ IMATRIX}
+(* domain IMATRIX *)
 (*
+    InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col) add
+ 
+      swapRows_!(x,i1,i2) ==
+        (i1 < minRowIndex(x)) or (i1 > maxRowIndex(x)) or _
+           (i2 < minRowIndex(x)) or (i2 > maxRowIndex(x)) =>
+             error "swapRows!: index out of range"
+        i1 = i2 => x
+        minRow := minRowIndex x
+        xx := x pretend PrimitiveArray(PrimitiveArray(R))
+        n1 := i1 - minRow; n2 := i2 - minRow
+        row1 := qelt(xx,n1)
+        qsetelt_!(xx,n1,qelt(xx,n2))
+        qsetelt_!(xx,n2,row1)
+        xx pretend $
+ 
+      if R has commutative("*") then
+ 
+        determinant x == determinant(x)$MATLIN
+
+        minordet    x == minordet(x)$MATLIN
+ 
+      if R has EuclideanDomain then
+ 
+        rowEchelon  x == rowEchelon(x)$MATLIN
+ 
+      if R has IntegralDomain then
+ 
+        rank        x == rank(x)$MATLIN
+
+        nullity     x == nullity(x)$MATLIN
+
+        nullSpace   x == nullSpace(x)$MATLIN
+ 
+      if R has Field then
+ 
+        inverse     x == inverse(x)$MATLIN
+
 *)
 
 \end{chunk}
 
-\begin{chunk}{ICP.dotabb}
-"ICP" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ICP"]
-"INFCLSPT" [color="#88FF44",href="bookvol10.3.pdf#nameddest=INFCLSPT"]
-"PLACES" [color="#88FF44",href="bookvol10.3.pdf#nameddest=PLACES"]
-"ICP" -> "INFCLSPT"
-"ICP" -> "PLACES"
+\begin{chunk}{IMATRIX.dotabb}
+"IMATRIX" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IMATRIX"]
+"MATCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=MATCAT"]
+"VECTCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=VECTCAT"]
+"IMATRIX" -> "MATCAT"
+"IMATRIX" -> "VECTCAT"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain ICARD IndexCard}
+\section{domain IARRAY1 IndexedOneDimensionalArray}
 
-\begin{chunk}{IndexCard.input}
+\begin{chunk}{IndexedOneDimensionalArray.input}
 )set break resume
-)sys rm -f IndexCard.output
-)spool IndexCard.output
+)sys rm -f IndexedOneDimensionalArray.output
+)spool IndexedOneDimensionalArray.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show IndexCard
+)show IndexedOneDimensionalArray
 --R 
---R IndexCard  is a domain constructor
---R Abbreviation for IndexCard is ICARD 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for ICARD 
+--R IndexedOneDimensionalArray(S: Type,mn: Integer)  is a domain constructor
+--R Abbreviation for IndexedOneDimensionalArray is IARRAY1 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IARRAY1 
 --R
 --R------------------------------- Operations --------------------------------
---R ?<? : (%,%) -> Boolean                ?<=? : (%,%) -> Boolean
---R ?=? : (%,%) -> Boolean                ?>? : (%,%) -> Boolean
---R ?>=? : (%,%) -> Boolean               coerce : String -> %
---R coerce : % -> OutputForm              display : % -> Void
---R ?.? : (%,Symbol) -> String            fullDisplay : % -> Void
---R hash : % -> SingleInteger             latex : % -> String
---R max : (%,%) -> %                      min : (%,%) -> %
---R ?~=? : (%,%) -> Boolean              
+--R concat : List(%) -> %                 concat : (%,%) -> %
+--R concat : (S,%) -> %                   concat : (%,S) -> %
+--R construct : List(S) -> %              copy : % -> %
+--R delete : (%,Integer) -> %             ?.? : (%,Integer) -> S
+--R elt : (%,Integer,S) -> S              empty : () -> %
+--R empty? : % -> Boolean                 entries : % -> List(S)
+--R eq? : (%,%) -> Boolean                index? : (Integer,%) -> Boolean
+--R indices : % -> List(Integer)          insert : (%,%,Integer) -> %
+--R insert : (S,%,Integer) -> %           latex : % -> String if S has SETCAT
+--R map : (((S,S) -> S),%,%) -> %         map : ((S -> S),%) -> %
+--R max : (%,%) -> % if S has ORDSET      min : (%,%) -> % if S has ORDSET
+--R new : (NonNegativeInteger,S) -> %     qelt : (%,Integer) -> S
+--R reverse : % -> %                      sample : () -> %
+--R sort : % -> % if S has ORDSET         sort : (((S,S) -> Boolean),%) -> %
+--R #? : % -> NonNegativeInteger if $ has finiteAggregate
+--R ?<? : (%,%) -> Boolean if S has ORDSET
+--R ?<=? : (%,%) -> Boolean if S has ORDSET
+--R ?=? : (%,%) -> Boolean if S has SETCAT
+--R ?>? : (%,%) -> Boolean if S has ORDSET
+--R ?>=? : (%,%) -> Boolean if S has ORDSET
+--R any? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R coerce : % -> OutputForm if S has SETCAT
+--R convert : % -> InputForm if S has KONVERT(INFORM)
+--R copyInto! : (%,%,Integer) -> % if $ has shallowlyMutable
+--R count : (S,%) -> NonNegativeInteger if $ has finiteAggregate and S has SETCAT
+--R count : ((S -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
+--R delete : (%,UniversalSegment(Integer)) -> %
+--R ?.? : (%,UniversalSegment(Integer)) -> %
+--R entry? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
+--R eval : (%,List(S),List(S)) -> % if S has EVALAB(S) and S has SETCAT
+--R eval : (%,S,S) -> % if S has EVALAB(S) and S has SETCAT
+--R eval : (%,Equation(S)) -> % if S has EVALAB(S) and S has SETCAT
+--R eval : (%,List(Equation(S))) -> % if S has EVALAB(S) and S has SETCAT
+--R every? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R fill! : (%,S) -> % if $ has shallowlyMutable
+--R find : ((S -> Boolean),%) -> Union(S,"failed")
+--R first : % -> S if Integer has ORDSET
+--R hash : % -> SingleInteger if S has SETCAT
+--R less? : (%,NonNegativeInteger) -> Boolean
+--R map! : ((S -> S),%) -> % if $ has shallowlyMutable
+--R maxIndex : % -> Integer if Integer has ORDSET
+--R member? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
+--R members : % -> List(S) if $ has finiteAggregate
+--R merge : (%,%) -> % if S has ORDSET
+--R merge : (((S,S) -> Boolean),%,%) -> %
+--R minIndex : % -> Integer if Integer has ORDSET
+--R more? : (%,NonNegativeInteger) -> Boolean
+--R parts : % -> List(S) if $ has finiteAggregate
+--R position : (S,%,Integer) -> Integer if S has SETCAT
+--R position : (S,%) -> Integer if S has SETCAT
+--R position : ((S -> Boolean),%) -> Integer
+--R qsetelt! : (%,Integer,S) -> S if $ has shallowlyMutable
+--R reduce : (((S,S) -> S),%) -> S if $ has finiteAggregate
+--R reduce : (((S,S) -> S),%,S) -> S if $ has finiteAggregate
+--R reduce : (((S,S) -> S),%,S,S) -> S if $ has finiteAggregate and S has SETCAT
+--R remove : ((S -> Boolean),%) -> % if $ has finiteAggregate
+--R remove : (S,%) -> % if $ has finiteAggregate and S has SETCAT
+--R removeDuplicates : % -> % if $ has finiteAggregate and S has SETCAT
+--R reverse! : % -> % if $ has shallowlyMutable
+--R select : ((S -> Boolean),%) -> % if $ has finiteAggregate
+--R setelt : (%,UniversalSegment(Integer),S) -> S if $ has shallowlyMutable
+--R setelt : (%,Integer,S) -> S if $ has shallowlyMutable
+--R size? : (%,NonNegativeInteger) -> Boolean
+--R sort! : % -> % if $ has shallowlyMutable and S has ORDSET
+--R sort! : (((S,S) -> Boolean),%) -> % if $ has shallowlyMutable
+--R sorted? : % -> Boolean if S has ORDSET
+--R sorted? : (((S,S) -> Boolean),%) -> Boolean
+--R swap! : (%,Integer,Integer) -> Void if $ has shallowlyMutable
+--R ?~=? : (%,%) -> Boolean if S has SETCAT
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{IndexCard.help}
+\begin{chunk}{IndexedOneDimensionalArray.help}
 ====================================================================
-IndexCard examples
+IndexedOneDimensionalArray examples
 ====================================================================
 
-This domain implements a container of information about the AXIOM library
+This is the basic one dimensional array data type.
 
 See Also:
-o )show IndexCard
+o )show IndexedOneDimensionalArray
 
 \end{chunk}
 
-\pagehead{IndexCard}{ICARD}
-\pagepic{ps/v103indexcard.ps}{ICARD}{1.00}
+\pagehead{IndexedOneDimensionalArray}{IARRAY1}
+\pagepic{ps/v103indexedonedimensionalarray.ps}{IARRAY1}{1.00}
 {\bf See}\\
-\pageto{DataList}{DLIST}
-\pageto{Database}{DBASE}
-\pageto{QueryEquation}{QEQUAT}
+\pageto{PrimitiveArray}{PRIMARR}
+\pageto{Tuple}{TUPLE}
+\pageto{IndexedFlexibleArray}{IFARRAY}
+\pageto{FlexibleArray}{FARRAY}
+\pageto{OneDimensionalArray}{ARRAY1}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{ICARD}{coerce} &
-\cross{ICARD}{display} &
-\cross{ICARD}{fullDisplay} &
-\cross{ICARD}{hash} &
-\cross{ICARD}{latex} \\
-\cross{ICARD}{max} &
-\cross{ICARD}{min} &
-\cross{ICARD}{?\~{}=?} &
-\cross{ICARD}{?$<$?} &
-\cross{ICARD}{?$<=$?} \\
-\cross{ICARD}{?=?} &
-\cross{ICARD}{?$>$?} &
-\cross{ICARD}{?$>=$?} &
-\cross{ICARD}{?.?} &
+\cross{IARRAY1}{concat} &
+\cross{IARRAY1}{construct} &
+\cross{IARRAY1}{copy} &
+\cross{IARRAY1}{delete} &
+\cross{IARRAY1}{elt} \\
+\cross{IARRAY1}{empty} &
+\cross{IARRAY1}{empty?} &
+\cross{IARRAY1}{entries} &
+\cross{IARRAY1}{eq?} &
+\cross{IARRAY1}{index?} \\
+\cross{IARRAY1}{indices} &
+\cross{IARRAY1}{insert} &
+\cross{IARRAY1}{insert} &
+\cross{IARRAY1}{map} &
+\cross{IARRAY1}{map} \\
+\cross{IARRAY1}{new} &
+\cross{IARRAY1}{qelt} &
+\cross{IARRAY1}{reverse} &
+\cross{IARRAY1}{sample} &
+\cross{IARRAY1}{any?} \\
+\cross{IARRAY1}{coerce} &
+\cross{IARRAY1}{convert} &
+\cross{IARRAY1}{copyInto!} &
+\cross{IARRAY1}{count} &
+\cross{IARRAY1}{count} \\
+\cross{IARRAY1}{delete} &
+\cross{IARRAY1}{entry?} &
+\cross{IARRAY1}{eval} &
+\cross{IARRAY1}{eval} &
+\cross{IARRAY1}{eval} \\
+\cross{IARRAY1}{eval} &
+\cross{IARRAY1}{every?} &
+\cross{IARRAY1}{fill!} &
+\cross{IARRAY1}{find} &
+\cross{IARRAY1}{first} \\
+\cross{IARRAY1}{hash} &
+\cross{IARRAY1}{latex} &
+\cross{IARRAY1}{less?} &
+\cross{IARRAY1}{map!} &
+\cross{IARRAY1}{max} \\
+\cross{IARRAY1}{maxIndex} &
+\cross{IARRAY1}{member?} &
+\cross{IARRAY1}{members} &
+\cross{IARRAY1}{merge} &
+\cross{IARRAY1}{merge} \\
+\cross{IARRAY1}{min} &
+\cross{IARRAY1}{minIndex} &
+\cross{IARRAY1}{more?} &
+\cross{IARRAY1}{parts} &
+\cross{IARRAY1}{position} \\
+\cross{IARRAY1}{position} &
+\cross{IARRAY1}{position} &
+\cross{IARRAY1}{qsetelt!} &
+\cross{IARRAY1}{reduce} &
+\cross{IARRAY1}{reduce} \\
+\cross{IARRAY1}{reduce} &
+\cross{IARRAY1}{remove} &
+\cross{IARRAY1}{remove} &
+\cross{IARRAY1}{removeDuplicates} &
+\cross{IARRAY1}{reverse!} \\
+\cross{IARRAY1}{select} &
+\cross{IARRAY1}{setelt} &
+\cross{IARRAY1}{setelt} &
+\cross{IARRAY1}{size?} &
+\cross{IARRAY1}{sort} \\
+\cross{IARRAY1}{sort} &
+\cross{IARRAY1}{sort!} &
+\cross{IARRAY1}{sort!} &
+\cross{IARRAY1}{sorted?} &
+\cross{IARRAY1}{sorted?} \\
+\cross{IARRAY1}{swap!} &
+\cross{IARRAY1}{\#{}?} &
+\cross{IARRAY1}{?$<$?} &
+\cross{IARRAY1}{?$<=$?} &
+\cross{IARRAY1}{?=?} \\
+\cross{IARRAY1}{?$>$?} &
+\cross{IARRAY1}{?$>=$?} &
+\cross{IARRAY1}{?\~{}=?} &
+\cross{IARRAY1}{?.?} &
 \end{tabular}
 
-\begin{chunk}{domain ICARD IndexCard}
-)abbrev domain ICARD IndexCard
-++ Author: Mark Botch
-++ Description:
-++ This domain implements a container of information about the AXIOM library
-
-IndexCard() : Exports == Implementation where
-  Exports == OrderedSet with
-    elt: (%,Symbol) -> String
-      ++ elt(ic,s) selects a particular field from \axiom{ic}.  Valid fields
-      ++ are \axiom{name, nargs, exposed, type, abbreviation, kind, origin,
-      ++ params, condition, doc}.
-    display: % -> Void
-      ++ display(ic) prints a summary of information contained in \axiom{ic}.
-    fullDisplay: % -> Void
-      ++ fullDisplay(ic) prints all of the information contained in \axiom{ic}.
-    coerce: String -> %
-      ++ coerce(s) converts \axiom{s} into an \axiom{IndexCard}.  Warning: if
-      ++ \axiom{s} is not of the right format then an error will occur 
-  Implementation == add
-    x<y==(x pretend String) < (y pretend String)
-    x=y==(x pretend String) = (y pretend String)
-    display(x) ==
-      name : OutputForm := dbName(x)$Lisp
-      type : OutputForm := dbPart(x,4,1$Lisp)$Lisp
-      output(hconcat(name,hconcat(" : ",type)))$OutputPackage
-    fullDisplay(x) ==
-      name : OutputForm := dbName(x)$Lisp
-      type : OutputForm := dbPart(x,4,1$Lisp)$Lisp
-      origin:OutputForm := 
-          hconcat(alqlGetOrigin(x$Lisp)$Lisp,alqlGetParams(x$Lisp)$Lisp)
-      fromPart : OutputForm := hconcat(" from ",origin)
-      condition : String := dbPart(x,6,1$Lisp)$Lisp
-      ifPart : OutputForm :=
-        condition = "" => empty()
-        hconcat(" if ",condition::OutputForm)
-      exposed? : String := SUBSTRING(dbPart(x,3,1)$Lisp,0,1)$Lisp 
-      exposedPart : OutputForm := 
-        exposed? = "n" => " (unexposed)"
-        empty()       
-      firstPart := hconcat(name,hconcat(" : ",type))
-      secondPart := hconcat(fromPart,hconcat(ifPart,exposedPart))
-      output(hconcat(firstPart,secondPart))$OutputPackage
-    coerce(s:String): % == (s pretend %)
-    coerce(x): OutputForm == (x pretend String)::OutputForm
-    elt(x,sel) ==
-      s := PNAME(sel)$Lisp pretend String
-      s = "name" => dbName(x)$Lisp
-      s = "nargs" => dbPart(x,2,1$Lisp)$Lisp
-      s = "exposed" => SUBSTRING(dbPart(x,3,1)$Lisp,0,1)$Lisp 
-      s = "type" => dbPart(x,4,1$Lisp)$Lisp
-      s = "abbreviation" => dbPart(x,5,1$Lisp)$Lisp
-      s = "kind" => alqlGetKindString(x)$Lisp
-      s = "origin" => alqlGetOrigin(x)$Lisp
-      s = "params" => alqlGetParams(x)$Lisp
-      s = "condition" => dbPart(x,6,1$Lisp)$Lisp
-      s = "doc" => dbComments(x)$Lisp
-      error "unknown selector"
-
-\end{chunk}
+\begin{chunk}{domain IARRAY1 IndexedOneDimensionalArray}
+)abbrev domain IARRAY1 IndexedOneDimensionalArray
+++ Author Micheal Monagan Aug/87
+++ Description:
+++ This is the basic one dimensional array data type.
 
-\begin{chunk}{COQ ICARD}
-(* domain ICARD *)
-(*
-*)
+IndexedOneDimensionalArray(S:Type, mn:Integer):
+ OneDimensionalArrayAggregate S == add
+   Qmax ==> QVMAXINDEX$Lisp
+   Qsize ==> QVSIZE$Lisp
+   Qelt ==> ELT$Lisp
+   Qsetelt ==> SETELT$Lisp
+   Qnew ==> MAKE_-ARRAY$Lisp
+   I ==> Integer
 
-\end{chunk}
+   #x               == Qsize x
 
-\begin{chunk}{ICARD.dotabb}
-"ICARD" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ICARD"]
-"STRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=STRING"]
-"ICARD" -> "STRING"
+   fill_!(x, s)     == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x)
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IBITS IndexedBits}
+   minIndex x       == mn
 
-\begin{chunk}{IndexedBits.input}
-)set break resume
-)sys rm -f IndexedBits.output
-)spool IndexedBits.output
-)set message test on
-)set message auto off
-)clear all
+   empty()          == Qnew(0$Lisp)
 
---S 1 of 14
-a:IBITS(32):=new(32,false)
---R 
---R
---R   (1)  "00000000000000000000000000000000"
---R                                                        Type: IndexedBits(32)
---E 1
+   new(n, s)        == fill_!(Qnew n,s)
 
---S 2 of 14
-b:IBITS(32):=new(32,true)
---R 
---R
---R   (2)  "11111111111111111111111111111111"
---R                                                        Type: IndexedBits(32)
---E 2
+   map_!(f, s1)  ==
+      n:Integer := Qmax(s1)
+      n < 0 => s1
+      for i in 0..n repeat Qsetelt(s1, i, f(Qelt(s1,i)))
+      s1
 
---S 3 of 14
-elt(a,3)
---R 
---R
---R   (3)  false
---R                                                                Type: Boolean
---E 3
+   map(f, s1)       ==
+      n:Integer := Qmax(s1)
+      n < 0 => s1
+      ss2:% := Qnew(n+1)
+      for i in 0..n repeat Qsetelt(ss2, i, f(Qelt(s1,i)))
+      ss2
 
---S 4 of 14
-setelt(a,3,true)
---R 
---R
---R   (4)  true
---R                                                                Type: Boolean
---E 4
+   map(f, a, b)   ==
+      maxind:Integer := min(Qmax a, Qmax b)
+      maxind < 0 => empty()
+      c:% := Qnew(maxind+1)
+      for i in 0..maxind repeat
+        Qsetelt(c, i, f(Qelt(a,i),Qelt(b,i)))
+      c
 
---S 5 of 14
-a
---R 
---R
---R   (5)  "00000000000000000000000000000100"
---R                                                        Type: IndexedBits(32)
---E 5
+   if zero? mn then
 
---S 6 of 14
-#a
---R 
---R
---R   (6)  32
---R                                                        Type: PositiveInteger
---E 6
+     qelt(x, i)       == Qelt(x, i)
 
---S 7 of 14
-(a=a)$IBITS(32)
---R 
---R
---R   (7)  true
---R                                                                Type: Boolean
---E 7
+     qsetelt_!(x, i, s) == Qsetelt(x, i, s)
 
---S 8 of 14
-(a=b)$IBITS(32)
---R 
---R
---R   (8)  false
---R                                                                Type: Boolean
---E 8
+     elt(x:%, i:I) ==
+       negative? i or i > maxIndex(x) => error "index out of range"
+       qelt(x, i)
 
---S 9 of 14
-(a ~= b)
---R 
---R
---R   (9)  true
---R                                                                Type: Boolean
---E 9
+     setelt(x:%, i:I, s:S) ==
+       negative? i or i > maxIndex(x) => error "index out of range"
+       qsetelt_!(x, i, s)
 
---S 10 of 14
-Or(a,b)
---R 
---R
---R   (10)  "11111111111111111111111111111111"
---R                                                        Type: IndexedBits(32)
---E 10
+   else if (mn = 1) then
 
---S 11 of 14
-And(a,b)
---R 
---R
---R   (11)  "00000000000000000000000000000100"
---R                                                        Type: IndexedBits(32)
---E 11
+     maxIndex x       == Qsize x
 
---S 12 of 14
-Not(a)
---R 
---R
---R   (12)  "11111111111111111111111111111011"
---R                                                        Type: IndexedBits(32)
---E 12
+     qelt(x, i)       == Qelt(x, i-1)
 
---S 13 of 14
-c:=copy a
---R 
---R
---R   (13)  "00000000000000000000000000000100"
---R                                                        Type: IndexedBits(32)
---E 13
+     qsetelt_!(x, i, s) == Qsetelt(x, i-1, s)
 
---S 14 of 14
-)show IndexedBits
---R 
---R IndexedBits(mn: Integer)  is a domain constructor
---R Abbreviation for IndexedBits is IBITS 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IBITS 
---R
---R------------------------------- Operations --------------------------------
---R ?/\? : (%,%) -> %                     ?<? : (%,%) -> Boolean
---R ?<=? : (%,%) -> Boolean               ?=? : (%,%) -> Boolean
---R ?>? : (%,%) -> Boolean                ?>=? : (%,%) -> Boolean
---R And : (%,%) -> %                      Not : % -> %
---R Or : (%,%) -> %                       ?\/? : (%,%) -> %
---R ^? : % -> %                           ?and? : (%,%) -> %
---R coerce : % -> OutputForm              concat : (%,Boolean) -> %
---R concat : (Boolean,%) -> %             concat : (%,%) -> %
---R concat : List(%) -> %                 construct : List(Boolean) -> %
---R copy : % -> %                         delete : (%,Integer) -> %
---R ?.? : (%,Integer) -> Boolean          empty : () -> %
---R empty? : % -> Boolean                 entries : % -> List(Boolean)
---R eq? : (%,%) -> Boolean                hash : % -> SingleInteger
---R index? : (Integer,%) -> Boolean       indices : % -> List(Integer)
---R insert : (Boolean,%,Integer) -> %     insert : (%,%,Integer) -> %
---R latex : % -> String                   max : (%,%) -> %
---R min : (%,%) -> %                      nand : (%,%) -> %
---R nor : (%,%) -> %                      not? : % -> %
---R ?or? : (%,%) -> %                     qelt : (%,Integer) -> Boolean
---R reverse : % -> %                      sample : () -> %
---R xor : (%,%) -> %                      ~? : % -> %
---R ?~=? : (%,%) -> Boolean              
---R #? : % -> NonNegativeInteger if $ has finiteAggregate
---R any? : ((Boolean -> Boolean),%) -> Boolean if $ has finiteAggregate
---R convert : % -> InputForm if Boolean has KONVERT(INFORM)
---R copyInto! : (%,%,Integer) -> % if $ has shallowlyMutable
---R count : ((Boolean -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R count : (Boolean,%) -> NonNegativeInteger if $ has finiteAggregate and Boolean has SETCAT
---R delete : (%,UniversalSegment(Integer)) -> %
---R elt : (%,Integer,Boolean) -> Boolean
---R ?.? : (%,UniversalSegment(Integer)) -> %
---R entry? : (Boolean,%) -> Boolean if $ has finiteAggregate and Boolean has SETCAT
---R eval : (%,List(Equation(Boolean))) -> % if Boolean has EVALAB(BOOLEAN) and Boolean has SETCAT
---R eval : (%,Equation(Boolean)) -> % if Boolean has EVALAB(BOOLEAN) and Boolean has SETCAT
---R eval : (%,Boolean,Boolean) -> % if Boolean has EVALAB(BOOLEAN) and Boolean has SETCAT
---R eval : (%,List(Boolean),List(Boolean)) -> % if Boolean has EVALAB(BOOLEAN) and Boolean has SETCAT
---R every? : ((Boolean -> Boolean),%) -> Boolean if $ has finiteAggregate
---R fill! : (%,Boolean) -> % if $ has shallowlyMutable
---R find : ((Boolean -> Boolean),%) -> Union(Boolean,"failed")
---R first : % -> Boolean if Integer has ORDSET
---R less? : (%,NonNegativeInteger) -> Boolean
---R map : ((Boolean -> Boolean),%) -> %
---R map : (((Boolean,Boolean) -> Boolean),%,%) -> %
---R map! : ((Boolean -> Boolean),%) -> % if $ has shallowlyMutable
---R maxIndex : % -> Integer if Integer has ORDSET
---R member? : (Boolean,%) -> Boolean if $ has finiteAggregate and Boolean has SETCAT
---R members : % -> List(Boolean) if $ has finiteAggregate
---R merge : (((Boolean,Boolean) -> Boolean),%,%) -> %
---R merge : (%,%) -> % if Boolean has ORDSET
---R minIndex : % -> Integer if Integer has ORDSET
---R more? : (%,NonNegativeInteger) -> Boolean
---R new : (NonNegativeInteger,Boolean) -> %
---R parts : % -> List(Boolean) if $ has finiteAggregate
---R position : ((Boolean -> Boolean),%) -> Integer
---R position : (Boolean,%) -> Integer if Boolean has SETCAT
---R position : (Boolean,%,Integer) -> Integer if Boolean has SETCAT
---R qsetelt! : (%,Integer,Boolean) -> Boolean if $ has shallowlyMutable
---R reduce : (((Boolean,Boolean) -> Boolean),%,Boolean,Boolean) -> Boolean if $ has finiteAggregate and Boolean has SETCAT
---R reduce : (((Boolean,Boolean) -> Boolean),%,Boolean) -> Boolean if $ has finiteAggregate
---R reduce : (((Boolean,Boolean) -> Boolean),%) -> Boolean if $ has finiteAggregate
---R remove : (Boolean,%) -> % if $ has finiteAggregate and Boolean has SETCAT
---R remove : ((Boolean -> Boolean),%) -> % if $ has finiteAggregate
---R removeDuplicates : % -> % if $ has finiteAggregate and Boolean has SETCAT
---R reverse! : % -> % if $ has shallowlyMutable
---R select : ((Boolean -> Boolean),%) -> % if $ has finiteAggregate
---R setelt : (%,Integer,Boolean) -> Boolean if $ has shallowlyMutable
---R setelt : (%,UniversalSegment(Integer),Boolean) -> Boolean if $ has shallowlyMutable
---R size? : (%,NonNegativeInteger) -> Boolean
---R sort : (((Boolean,Boolean) -> Boolean),%) -> %
---R sort : % -> % if Boolean has ORDSET
---R sort! : (((Boolean,Boolean) -> Boolean),%) -> % if $ has shallowlyMutable
---R sort! : % -> % if $ has shallowlyMutable and Boolean has ORDSET
---R sorted? : (((Boolean,Boolean) -> Boolean),%) -> Boolean
---R sorted? : % -> Boolean if Boolean has ORDSET
---R swap! : (%,Integer,Integer) -> Void if $ has shallowlyMutable
---R
---E 14
+     elt(x:%, i:I) ==
+       QSLESSP(i,1$Lisp)$Lisp or QSLESSP(Qsize x,i)$Lisp =>
+         error "index out of range"
+       Qelt(x, i-1)
 
-)spool
-)lisp (bye)
-\end{chunk}
+     setelt(x:%, i:I, s:S) ==
+       QSLESSP(i,1$Lisp)$Lisp or QSLESSP(Qsize x,i)$Lisp =>
+         error "index out of range"
+       Qsetelt(x, i-1, s)
 
-\begin{chunk}{IndexedBits.help}
-====================================================================
-IndexedBits
-====================================================================
+    else
 
-a:IBITS(32):=new(32,false)
-  "00000000000000000000000000000000"
+       qelt(x, i)       == Qelt(x, i - mn)
 
-b:IBITS(32):=new(32,true)
-  "11111111111111111111111111111111"
+       qsetelt_!(x, i, s) == Qsetelt(x, i - mn, s)
 
-elt(a,3)
-  false
+       elt(x:%, i:I) ==
+         i < mn or i > maxIndex(x) => error "index out of range"
+         qelt(x, i)
 
-setelt(a,3,true)
-  true
+       setelt(x:%, i:I, s:S) ==
+         i < mn or i > maxIndex(x) => error "index out of range"
+         qsetelt_!(x, i, s)
 
-a
-  "00000000000000000000000000000100"
+\end{chunk}
 
-#a
-  32
+\begin{chunk}{COQ IARRAY1}
+(* domain IARRAY1 *)
+(*
+   Qmax ==> QVMAXINDEX$Lisp
+   Qsize ==> QVSIZE$Lisp
+   Qelt ==> ELT$Lisp
+   Qsetelt ==> SETELT$Lisp
+   Qnew ==> MAKE_-ARRAY$Lisp
+   I ==> Integer
 
-(a=a)$IBITS(32)
-  true
+   #x               == Qsize x
 
-(a=b)$IBITS(32)
-  false
+   fill_!(x, s)     == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x)
 
-(a ~= b)
-  true
+   minIndex x       == mn
 
-Or(a,b)
-  "11111111111111111111111111111111"
+   empty()          == Qnew(0$Lisp)
 
-And(a,b)
-  "00000000000000000000000000000100"
+   new(n, s)        == fill_!(Qnew n,s)
 
-Not(a)
-  "11111111111111111111111111111011"
+   map_!(f, s1)  ==
+      n:Integer := Qmax(s1)
+      n < 0 => s1
+      for i in 0..n repeat Qsetelt(s1, i, f(Qelt(s1,i)))
+      s1
 
-c:=copy a
-  "00000000000000000000000000000100"
+   map(f, s1)       ==
+      n:Integer := Qmax(s1)
+      n < 0 => s1
+      ss2:% := Qnew(n+1)
+      for i in 0..n repeat Qsetelt(ss2, i, f(Qelt(s1,i)))
+      ss2
 
-See Also:
-o )show IndexedBits
+   map(f, a, b)   ==
+      maxind:Integer := min(Qmax a, Qmax b)
+      maxind < 0 => empty()
+      c:% := Qnew(maxind+1)
+      for i in 0..maxind repeat
+        Qsetelt(c, i, f(Qelt(a,i),Qelt(b,i)))
+      c
 
-\end{chunk}
-\pagehead{IndexedBits}{IBITS}
-\pagepic{ps/v103indexedbits.ps}{IBITS}{1.00}
-{\bf See}\\
-\pageto{Reference}{REF}
-\pageto{Boolean}{BOOLEAN}
-\pageto{Bits}{BITS}
+   if zero? mn then
 
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{IBITS}{And} &
-\cross{IBITS}{any?} &
-\cross{IBITS}{coerce} &
-\cross{IBITS}{concat} &
-\cross{IBITS}{construct} \\
-\cross{IBITS}{convert} &
-\cross{IBITS}{copy} &
-\cross{IBITS}{copyInto!} &
-\cross{IBITS}{count} &
-\cross{IBITS}{count} \\
-\cross{IBITS}{delete} &
-\cross{IBITS}{elt} &
-\cross{IBITS}{empty} &
-\cross{IBITS}{empty?} &
-\cross{IBITS}{entries} \\
-\cross{IBITS}{entry?} &
-\cross{IBITS}{eq?} &
-\cross{IBITS}{eval} &
-\cross{IBITS}{every?} &
-\cross{IBITS}{fill!} \\
-\cross{IBITS}{find} &
-\cross{IBITS}{first} &
-\cross{IBITS}{hash} &
-\cross{IBITS}{index?} &
-\cross{IBITS}{indices} \\
-\cross{IBITS}{insert} &
-\cross{IBITS}{latex} &
-\cross{IBITS}{less?} &
-\cross{IBITS}{map} &
-\cross{IBITS}{map!} \\
-\cross{IBITS}{max} &
-\cross{IBITS}{maxIndex} &
-\cross{IBITS}{member?} &
-\cross{IBITS}{members} &
-\cross{IBITS}{merge} \\
-\cross{IBITS}{min} &
-\cross{IBITS}{minIndex} &
-\cross{IBITS}{more?} &
-\cross{IBITS}{nand} &
-\cross{IBITS}{new} \\
-\cross{IBITS}{nor} &
-\cross{IBITS}{Not} &
-\cross{IBITS}{not?} &
-\cross{IBITS}{Or} &
-\cross{IBITS}{parts} \\
-\cross{IBITS}{position} &
-\cross{IBITS}{qelt} &
-\cross{IBITS}{qsetelt!} &
-\cross{IBITS}{reduce} &
-\cross{IBITS}{removeDuplicates} \\
-\cross{IBITS}{reverse} &
-\cross{IBITS}{reverse!} &
-\cross{IBITS}{sample} &
-\cross{IBITS}{select} &
-\cross{IBITS}{size?} \\
-\cross{IBITS}{sort} &
-\cross{IBITS}{sort!} &
-\cross{IBITS}{sorted?} &
-\cross{IBITS}{swap!} &
-\cross{IBITS}{xor} \\
-\cross{IBITS}{\#{}?} &
-\cross{IBITS}{?.?} &
-\cross{IBITS}{?/$\backslash{}$?} &
-\cross{IBITS}{?$<$?} &
-\cross{IBITS}{?$<=$?} \\
-\cross{IBITS}{?=?} &
-\cross{IBITS}{?$>$?} &
-\cross{IBITS}{?$>=$?} &
-\cross{IBITS}{?$\backslash{}$/?} &
-\cross{IBITS}{\^{}?} \\
-\cross{IBITS}{?.?} &
-\cross{IBITS}{\~{}?} &
-\cross{IBITS}{?\~{}=?} &
-\cross{IBITS}{?or?} &
-\cross{IBITS}{?and?} 
-\end{tabular}
+     qelt(x, i)       == Qelt(x, i)
 
-\begin{chunk}{domain IBITS IndexedBits}
-)abbrev domain IBITS IndexedBits
-++ Author: Stephen Watt and Michael Monagan
-++ Date Created: July 86
-++ Change History:  Oct 87
-++ Description: 
-++ \spadtype{IndexedBits} is a domain to compactly represent
-++ large quantities of Boolean data.
+     qsetelt_!(x, i, s) == Qsetelt(x, i, s)
 
-IndexedBits(mn:Integer): BitAggregate() with
-        -- temporaries until parser gets better
-        Not: % -> %
-            ++ Not(n) returns the bit-by-bit logical Not of n.
-        Or : (%, %) -> %
-            ++ Or(n,m)  returns the bit-by-bit logical Or of
-            ++ n and m.
-        And: (%, %) -> %
-            ++ And(n,m)  returns the bit-by-bit logical And of
-            ++ n and m.
-    == add
+     elt(x:%, i:I) ==
+       negative? i or i > maxIndex(x) => error "index out of range"
+       qelt(x, i)
 
-        range: (%, Integer) -> Integer
-          --++ range(j,i) returnes the range i of the boolean j.
+     setelt(x:%, i:I, s:S) ==
+       negative? i or i > maxIndex(x) => error "index out of range"
+       qsetelt_!(x, i, s)
 
-        minIndex u  == mn
+   else if (mn = 1) then
 
-        range(v, i) ==
-          i >= 0 and i < #v => i
-          error "Index out of range"
+     maxIndex x       == Qsize x
 
-        coerce(v):OutputForm ==
-            t:Character := char "1"
-            f:Character := char "0"
-            s := new(#v, space()$Character)$String
-            for i in minIndex(s)..maxIndex(s) for j in mn.. repeat
-              s.i := if v.j then t else f
-            s::OutputForm
+     qelt(x, i)       == Qelt(x, i-1)
 
-        new(n, b)       == BVEC_-MAKE_-FULL(n,TRUTH_-TO_-BIT(b)$Lisp)$Lisp
-        empty()         == BVEC_-MAKE_-FULL(0,0)$Lisp
-        copy v          == BVEC_-COPY(v)$Lisp
-        #v              == BVEC_-SIZE(v)$Lisp
-        v = u           == BVEC_-EQUAL(v, u)$Lisp
-        v < u           == BVEC_-GREATER(u, v)$Lisp
-        _and(u, v)      == (#v=#u => BVEC_-AND(v,u)$Lisp; map("and",v,u))
-        _or(u, v)       == (#v=#u => BVEC_-OR(v, u)$Lisp; map("or", v,u))
-        xor(v,u)        == (#v=#u => BVEC_-XOR(v,u)$Lisp; map("xor",v,u))
-        setelt(v:%, i:Integer, f:Boolean) ==
-          BVEC_-SETELT(v, range(v, abs(i-mn)), TRUTH_-TO_-BIT(f)$Lisp)$Lisp
-        elt(v:%, i:Integer) ==
-          BIT_-TO_-TRUTH(BVEC_-ELT(v, range(v, abs(i-mn)))$Lisp)$Lisp
+     qsetelt_!(x, i, s) == Qsetelt(x, i-1, s)
 
-        Not v           == BVEC_-NOT(v)$Lisp
-        And(u, v)       == (#v=#u => BVEC_-AND(v,u)$Lisp; map("and",v,u))
-        Or(u, v)        == (#v=#u => BVEC_-OR(v, u)$Lisp; map("or", v,u))
+     elt(x:%, i:I) ==
+       QSLESSP(i,1$Lisp)$Lisp or QSLESSP(Qsize x,i)$Lisp =>
+         error "index out of range"
+       Qelt(x, i-1)
 
-\end{chunk}
+     setelt(x:%, i:I, s:S) ==
+       QSLESSP(i,1$Lisp)$Lisp or QSLESSP(Qsize x,i)$Lisp =>
+         error "index out of range"
+       Qsetelt(x, i-1, s)
+
+    else
+
+       qelt(x, i)       == Qelt(x, i - mn)
+
+       qsetelt_!(x, i, s) == Qsetelt(x, i - mn, s)
+
+       elt(x:%, i:I) ==
+         i < mn or i > maxIndex(x) => error "index out of range"
+         qelt(x, i)
+
+       setelt(x:%, i:I, s:S) ==
+         i < mn or i > maxIndex(x) => error "index out of range"
+         qsetelt_!(x, i, s)
 
-\begin{chunk}{COQ IBITS}
-(* domain IBITS *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{IBITS.dotabb}
-"IBITS" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IBITS"]
-"STRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=STRING"]
-"IBITS" -> "STRING"
+\begin{chunk}{IARRAY1.dotabb}
+"IARRAY1" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IARRAY1"]
+"A1AGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=A1AGG"]
+"IARRAY1" -> "A1AGG"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IDPAG IndexedDirectProductAbelianGroup}
+\section{domain ISTRING IndexedString}
 
-\begin{chunk}{IndexedDirectProductAbelianGroup.input}
+\begin{chunk}{IndexedString.input}
 )set break resume
-)sys rm -f IndexedDirectProductAbelianGroup.output
-)spool IndexedDirectProductAbelianGroup.output
+)sys rm -f IndexedString.output
+)spool IndexedString.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show IndexedDirectProductAbelianGroup
+)show IndexedString
 --R 
---R IndexedDirectProductAbelianGroup(A: AbelianGroup,S: OrderedSet)  is a domain constructor
---R Abbreviation for IndexedDirectProductAbelianGroup is IDPAG 
+--R IndexedString(mn: Integer)  is a domain constructor
+--R Abbreviation for IndexedString is ISTRING 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IDPAG 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for ISTRING 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (Integer,%) -> %                ?*? : (NonNegativeInteger,%) -> %
---R ?*? : (PositiveInteger,%) -> %        ?+? : (%,%) -> %
---R ?-? : (%,%) -> %                      -? : % -> %
---R ?=? : (%,%) -> Boolean                0 : () -> %
---R coerce : % -> OutputForm              hash : % -> SingleInteger
---R latex : % -> String                   leadingCoefficient : % -> A
---R leadingSupport : % -> S               map : ((A -> A),%) -> %
---R monomial : (A,S) -> %                 reductum : % -> %
---R sample : () -> %                      zero? : % -> Boolean
---R ?~=? : (%,%) -> Boolean              
---R subtractIfCan : (%,%) -> Union(%,"failed")
+--R coerce : Character -> %               concat : List(%) -> %
+--R concat : (%,%) -> %                   concat : (Character,%) -> %
+--R concat : (%,Character) -> %           construct : List(Character) -> %
+--R copy : % -> %                         delete : (%,Integer) -> %
+--R ?.? : (%,%) -> %                      ?.? : (%,Integer) -> Character
+--R empty : () -> %                       empty? : % -> Boolean
+--R entries : % -> List(Character)        eq? : (%,%) -> Boolean
+--R hash : % -> Integer                   index? : (Integer,%) -> Boolean
+--R indices : % -> List(Integer)          insert : (%,%,Integer) -> %
+--R leftTrim : (%,CharacterClass) -> %    leftTrim : (%,Character) -> %
+--R lowerCase : % -> %                    lowerCase! : % -> %
+--R prefix? : (%,%) -> Boolean            qelt : (%,Integer) -> Character
+--R reverse : % -> %                      rightTrim : (%,Character) -> %
+--R sample : () -> %                      split : (%,Character) -> List(%)
+--R suffix? : (%,%) -> Boolean            trim : (%,CharacterClass) -> %
+--R trim : (%,Character) -> %             upperCase : % -> %
+--R upperCase! : % -> %                  
+--R #? : % -> NonNegativeInteger if $ has finiteAggregate
+--R ?<? : (%,%) -> Boolean if Character has ORDSET
+--R ?<=? : (%,%) -> Boolean if Character has ORDSET
+--R ?=? : (%,%) -> Boolean if Character has SETCAT
+--R ?>? : (%,%) -> Boolean if Character has ORDSET
+--R ?>=? : (%,%) -> Boolean if Character has ORDSET
+--R any? : ((Character -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R coerce : % -> OutputForm if Character has SETCAT
+--R convert : % -> InputForm if Character has KONVERT(INFORM)
+--R copyInto! : (%,%,Integer) -> % if $ has shallowlyMutable
+--R count : (Character,%) -> NonNegativeInteger if $ has finiteAggregate and Character has SETCAT
+--R count : ((Character -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
+--R delete : (%,UniversalSegment(Integer)) -> %
+--R ?.? : (%,UniversalSegment(Integer)) -> %
+--R elt : (%,Integer,Character) -> Character
+--R entry? : (Character,%) -> Boolean if $ has finiteAggregate and Character has SETCAT
+--R eval : (%,List(Character),List(Character)) -> % if Character has EVALAB(CHAR) and Character has SETCAT
+--R eval : (%,Character,Character) -> % if Character has EVALAB(CHAR) and Character has SETCAT
+--R eval : (%,Equation(Character)) -> % if Character has EVALAB(CHAR) and Character has SETCAT
+--R eval : (%,List(Equation(Character))) -> % if Character has EVALAB(CHAR) and Character has SETCAT
+--R every? : ((Character -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R fill! : (%,Character) -> % if $ has shallowlyMutable
+--R find : ((Character -> Boolean),%) -> Union(Character,"failed")
+--R first : % -> Character if Integer has ORDSET
+--R hash : % -> SingleInteger if Character has SETCAT
+--R insert : (Character,%,Integer) -> %
+--R latex : % -> String if Character has SETCAT
+--R less? : (%,NonNegativeInteger) -> Boolean
+--R map : (((Character,Character) -> Character),%,%) -> %
+--R map : ((Character -> Character),%) -> %
+--R map! : ((Character -> Character),%) -> % if $ has shallowlyMutable
+--R match : (%,%,Character) -> NonNegativeInteger
+--R match? : (%,%,Character) -> Boolean
+--R max : (%,%) -> % if Character has ORDSET
+--R maxIndex : % -> Integer if Integer has ORDSET
+--R member? : (Character,%) -> Boolean if $ has finiteAggregate and Character has SETCAT
+--R members : % -> List(Character) if $ has finiteAggregate
+--R merge : (%,%) -> % if Character has ORDSET
+--R merge : (((Character,Character) -> Boolean),%,%) -> %
+--R min : (%,%) -> % if Character has ORDSET
+--R minIndex : % -> Integer if Integer has ORDSET
+--R more? : (%,NonNegativeInteger) -> Boolean
+--R new : (NonNegativeInteger,Character) -> %
+--R parts : % -> List(Character) if $ has finiteAggregate
+--R position : (CharacterClass,%,Integer) -> Integer
+--R position : (%,%,Integer) -> Integer
+--R position : (Character,%,Integer) -> Integer if Character has SETCAT
+--R position : (Character,%) -> Integer if Character has SETCAT
+--R position : ((Character -> Boolean),%) -> Integer
+--R qsetelt! : (%,Integer,Character) -> Character if $ has shallowlyMutable
+--R reduce : (((Character,Character) -> Character),%) -> Character if $ has finiteAggregate
+--R reduce : (((Character,Character) -> Character),%,Character) -> Character if $ has finiteAggregate
+--R reduce : (((Character,Character) -> Character),%,Character,Character) -> Character if $ has finiteAggregate and Character has SETCAT
+--R remove : ((Character -> Boolean),%) -> % if $ has finiteAggregate
+--R remove : (Character,%) -> % if $ has finiteAggregate and Character has SETCAT
+--R removeDuplicates : % -> % if $ has finiteAggregate and Character has SETCAT
+--R replace : (%,UniversalSegment(Integer),%) -> %
+--R reverse! : % -> % if $ has shallowlyMutable
+--R rightTrim : (%,CharacterClass) -> %
+--R select : ((Character -> Boolean),%) -> % if $ has finiteAggregate
+--R setelt : (%,UniversalSegment(Integer),Character) -> Character if $ has shallowlyMutable
+--R setelt : (%,Integer,Character) -> Character if $ has shallowlyMutable
+--R size? : (%,NonNegativeInteger) -> Boolean
+--R sort : % -> % if Character has ORDSET
+--R sort : (((Character,Character) -> Boolean),%) -> %
+--R sort! : % -> % if $ has shallowlyMutable and Character has ORDSET
+--R sort! : (((Character,Character) -> Boolean),%) -> % if $ has shallowlyMutable
+--R sorted? : % -> Boolean if Character has ORDSET
+--R sorted? : (((Character,Character) -> Boolean),%) -> Boolean
+--R split : (%,CharacterClass) -> List(%)
+--R substring? : (%,%,Integer) -> Boolean
+--R swap! : (%,Integer,Integer) -> Void if $ has shallowlyMutable
+--R ?~=? : (%,%) -> Boolean if Character has SETCAT
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{IndexedDirectProductAbelianGroup.help}
+\begin{chunk}{IndexedString.help}
 ====================================================================
-IndexedDirectProductAbelianGroup examples
+IndexedString examples
 ====================================================================
 
-Indexed direct products of abelian groups over an abelian group A of
-generators indexed by the ordered set S.  All items have finite
-support: only non-zero terms are stored.
+This domain implements low-level strings
 
 See Also:
-o )show IndexedDirectProductAbelianGroup
+o )show IndexedString
 
 \end{chunk}
 
-\pagehead{IndexedDirectProductAbelianGroup}{IDPAG}
-\pagepic{ps/v103indexeddirectproductabeliangroup.ps}{IDPAG}{1.00}
+\pagehead{IndexedString}{ISTRING}
+\pagepic{ps/v103indexedstring.ps}{ISTRING}{1.00}
 {\bf See}\\
-\pageto{IndexedDirectProductObject}{IDPO}
-\pageto{IndexedDirectProductAbelianMonoid}{IDPAM}
-\pageto{IndexedDirectProductOrderedAbelianMonoid}{IDPOAM}
-\pageto{IndexedDirectProductOrderedAbelianMonoidSup}{IDPOAMS}
+\pageto{Character}{CHAR}
+\pageto{CharacterClass}{CCLASS}
+\pageto{String}{STRING}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{IDPAG}{0} &
-\cross{IDPAG}{coerce} &
-\cross{IDPAG}{hash} &
-\cross{IDPAG}{latex} &
-\cross{IDPAG}{leadingCoefficient} \\
-\cross{IDPAG}{leadingSupport} &
-\cross{IDPAG}{map} &
-\cross{IDPAG}{monomial} &
-\cross{IDPAG}{reductum} &
-\cross{IDPAG}{sample} \\
-\cross{IDPAG}{subtractIfCan} &
-\cross{IDPAG}{zero?} &
-\cross{IDPAG}{?\~{}=?} &
-\cross{IDPAG}{?*?} &
-\cross{IDPAG}{?+?} \\
-\cross{IDPAG}{?-?} &
-\cross{IDPAG}{-?} &
-\cross{IDPAG}{?=?} &&
+\cross{ISTRING}{any?} &
+\cross{ISTRING}{coerce} &
+\cross{ISTRING}{concat} &
+\cross{ISTRING}{construct} &
+\cross{ISTRING}{convert} \\
+\cross{ISTRING}{copy} &
+\cross{ISTRING}{copyInto!} &
+\cross{ISTRING}{count} &
+\cross{ISTRING}{delete} &
+\cross{ISTRING}{elt} \\
+\cross{ISTRING}{empty} &
+\cross{ISTRING}{empty?} &
+\cross{ISTRING}{entries} &
+\cross{ISTRING}{entry?} &
+\cross{ISTRING}{eq?} \\
+\cross{ISTRING}{eval} &
+\cross{ISTRING}{every?} &
+\cross{ISTRING}{fill!} &
+\cross{ISTRING}{find} &
+\cross{ISTRING}{first} \\
+\cross{ISTRING}{hash} &
+\cross{ISTRING}{index?} &
+\cross{ISTRING}{indices} &
+\cross{ISTRING}{insert} &
+\cross{ISTRING}{latex} \\
+\cross{ISTRING}{leftTrim} &
+\cross{ISTRING}{less?} &
+\cross{ISTRING}{lowerCase} &
+\cross{ISTRING}{lowerCase!} &
+\cross{ISTRING}{map} \\
+\cross{ISTRING}{map!} &
+\cross{ISTRING}{match} &
+\cross{ISTRING}{match?} &
+\cross{ISTRING}{max} &
+\cross{ISTRING}{maxIndex} \\
+\cross{ISTRING}{member?} &
+\cross{ISTRING}{members} &
+\cross{ISTRING}{merge} &
+\cross{ISTRING}{min} &
+\cross{ISTRING}{minIndex} \\
+\cross{ISTRING}{more?} &
+\cross{ISTRING}{new} &
+\cross{ISTRING}{parts} &
+\cross{ISTRING}{prefix?} &
+\cross{ISTRING}{position} \\
+\cross{ISTRING}{qelt} &
+\cross{ISTRING}{qsetelt!} &
+\cross{ISTRING}{reduce} &
+\cross{ISTRING}{remove} &
+\cross{ISTRING}{removeDuplicates} \\
+\cross{ISTRING}{replace} &
+\cross{ISTRING}{reverse} &
+\cross{ISTRING}{reverse!} &
+\cross{ISTRING}{rightTrim} &
+\cross{ISTRING}{sample} \\
+\cross{ISTRING}{select} &
+\cross{ISTRING}{setelt} &
+\cross{ISTRING}{size?} &
+\cross{ISTRING}{sort} &
+\cross{ISTRING}{sort!} \\
+\cross{ISTRING}{sorted?} &
+\cross{ISTRING}{split} &
+\cross{ISTRING}{suffix?} &
+\cross{ISTRING}{substring?} &
+\cross{ISTRING}{swap!} \\
+\cross{ISTRING}{trim} &
+\cross{ISTRING}{upperCase} &
+\cross{ISTRING}{upperCase!} &
+\cross{ISTRING}{\#{}?} &
+\cross{ISTRING}{?$<$?} \\
+\cross{ISTRING}{?$<=$?} &
+\cross{ISTRING}{?=?} &
+\cross{ISTRING}{?$>$?} &
+\cross{ISTRING}{?$>=$?} &
+\cross{ISTRING}{?\~{}=?} \\
+\cross{ISTRING}{?.?} &&&&
 \end{tabular}
 
-\begin{chunk}{domain IDPAG IndexedDirectProductAbelianGroup}
-)abbrev domain IDPAG IndexedDirectProductAbelianGroup
-++ Author: Mark Botch
+\begin{chunk}{domain ISTRING IndexedString}
+)abbrev domain ISTRING IndexedString
+++ Authors: Stephen Watt, Michael Monagan, Manuel Bronstein 1986 .. 1991
 ++ Description:
-++ Indexed direct products of abelian groups over an abelian group \spad{A} of
-++ generators indexed by the ordered set S.
-++ All items have finite support: only non-zero terms are stored.
+++ This domain implements low-level strings
 
-IndexedDirectProductAbelianGroup(A:AbelianGroup,S:OrderedSet):
-    Join(AbelianGroup,IndexedDirectProductCategory(A,S))
- ==  IndexedDirectProductAbelianMonoid(A,S) add
-    --representations
-       Term:=  Record(k:S,c:A)
-       Rep:=  List Term
-       x,y: %
-       r: A
-       n: Integer
-       f: A -> A
-       s: S
-       -x == [[u.k,-u.c] for u in x]
-       n * x  ==
-             n = 0 => 0
-             n = 1 => x
-             [[u.k,a] for u in x | (a:=n*u.c) ^= 0$A]
+IndexedString(mn:Integer): Export == Implementation where
+  B ==> Boolean
+  C ==> Character
+  I ==> Integer
+  N ==> NonNegativeInteger
+  U ==> UniversalSegment Integer
 
-       qsetrest!: (Rep, Rep) -> Rep
-       qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp
+  Export ==> StringAggregate() with
+      hash: % -> I
+        ++ hash(x) provides a hashing function for strings
 
-       x - y ==
-                null x => -y
-                null y => x
-                endcell: Rep := empty()
-                res:  Rep := empty()
-                while not empty? x and not empty? y repeat
-                        newcell := empty()
-                        if x.first.k = y.first.k then
-                                r:= x.first.c - y.first.c
-                                if not zero? r then
-                                        newcell := cons([x.first.k, r], empty())
-                                x := rest x
-                                y := rest y
-                        else if x.first.k > y.first.k then
-                                newcell := cons(x.first, empty())
-                                x := rest x
-                        else
-                                newcell := cons([y.first.k,-y.first.c], empty())
-                                y := rest y
-                        if not empty? newcell then
-                                if not empty? endcell then
-                                        qsetrest!(endcell, newcell)
-                                        endcell := newcell
-                                else
-                                        res     := newcell;
-                                        endcell := res
-                if empty? x then end := - y
-                else end := x
-                if empty? res then res := end
-                else qsetrest!(endcell, end)
-                res
+  Implementation ==> add
+    -- These assume Character's Rep is Small I
+    Qelt    ==> QENUM$Lisp
+    Qequal  ==> EQUAL$Lisp
+    Qsetelt ==> QESET$Lisp
+    Qsize   ==> QCSIZE$Lisp
+    Cheq    ==> EQL$Lisp
+    Chlt    ==> QSLESSP$Lisp
+    Chgt    ==> QSGREATERP$Lisp
 
---       x - y  ==
---          empty? x => - y
---          empty? y => x
---          y.first.k > x.first.k => cons([y.first.k,-y.first.c],(x - y.rest))
---          x.first.k > y.first.k => cons(x.first,(x.rest - y))
---          r:= x.first.c - y.first.c
---          r = 0 => x.rest - y.rest
---          cons([x.first.k,r],(x.rest - y.rest))
+    c: Character
+    cc: CharacterClass
 
-\end{chunk}
+    new(n, c)              == MAKE_-FULL_-CVEC(n, c)$Lisp
 
-\begin{chunk}{COQ IDPAG}
-(* domain IDPAG *)
-(*
-*)
+    empty()                == MAKE_-FULL_-CVEC(0$Lisp)$Lisp
 
-\end{chunk}
+    empty?(s)              == Qsize(s) = 0
 
-\begin{chunk}{IDPAG.dotabb}
-"IDPAG" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IDPAG"]
-"ORDSET" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ORDSET"]
-"IDPC" [color="#4488FF",href="bookvol10.2.pdf#nameddest=IDPC"]
-"IDPAG" -> "IDPC"
-"IDPAG" -> "ORDSET"
+    #s                     == Qsize(s)
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IDPAM IndexedDirectProductAbelianMonoid}
+    s = t                  == Qequal(s, t)
 
-\begin{chunk}{IndexedDirectProductAbelianMonoid.input}
-)set break resume
-)sys rm -f IndexedDirectProductAbelianMonoid.output
-)spool IndexedDirectProductAbelianMonoid.output
-)set message test on
-)set message auto off
-)clear all
+    s < t                  == CGREATERP(t,s)$Lisp
 
---S 1 of 1
-)show IndexedDirectProductAbelianMonoid
---R 
---R IndexedDirectProductAbelianMonoid(A: AbelianMonoid,S: OrderedSet)  is a domain constructor
---R Abbreviation for IndexedDirectProductAbelianMonoid is IDPAM 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IDPAM 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?+? : (%,%) -> %                      ?=? : (%,%) -> Boolean
---R 0 : () -> %                           coerce : % -> OutputForm
---R hash : % -> SingleInteger             latex : % -> String
---R leadingCoefficient : % -> A           leadingSupport : % -> S
---R map : ((A -> A),%) -> %               monomial : (A,S) -> %
---R reductum : % -> %                     sample : () -> %
---R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
---R
---E 1
+    concat(s:%,t:%)        == STRCONC(s,t)$Lisp
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{IndexedDirectProductAbelianMonoid.help}
-====================================================================
-IndexedDirectProductAbelianMonoid examples
-====================================================================
+    copy s                 == COPY_-SEQ(s)$Lisp
 
-Indexed direct products of abelian monoids over an abelian monoid 
-A of generators indexed by the ordered set S. All items have 
-finite support. Only non-zero terms are stored.
+    insert(s:%, t:%, i:I)  == concat(concat(s(mn..i-1), t), s(i..))
 
-See Also:
-o )show IndexedDirectProductAbelianMonoid
+    coerce(s:%):OutputForm == outputForm(s pretend String)
 
-\end{chunk}
+    minIndex s             == mn
 
-\pagehead{IndexedDirectProductAbelianMonoid}{IDPAM}
-\pagepic{ps/v103indexeddirectproductabelianmonoid.ps}{IDPAM}{1.00}
-{\bf See}\\
-\pageto{IndexedDirectProductObject}{IDPO}
-\pageto{IndexedDirectProductOrderedAbelianMonoid}{IDPOAM}
-\pageto{IndexedDirectProductOrderedAbelianMonoidSup}{IDPOAMS}
-\pageto{IndexedDirectProductAbelianGroup}{IDPAG}
+    upperCase_! s          == map_!(upperCase, s)
 
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{IDPAM}{0} &
-\cross{IDPAM}{coerce} &
-\cross{IDPAM}{hash} &
-\cross{IDPAM}{latex} &
-\cross{IDPAM}{leadingCoefficient} \\
-\cross{IDPAM}{leadingSupport} &
-\cross{IDPAM}{map} &
-\cross{IDPAM}{monomial} &
-\cross{IDPAM}{reductum} &
-\cross{IDPAM}{sample} \\
-\cross{IDPAM}{zero?} &
-\cross{IDPAM}{?\~{}=?} &
-\cross{IDPAM}{?*?} &
-\cross{IDPAM}{?+?} &
-\cross{IDPAM}{?=?}
-\end{tabular}
+    lowerCase_! s          == map_!(lowerCase, s)
 
-\begin{chunk}{domain IDPAM IndexedDirectProductAbelianMonoid}
-)abbrev domain IDPAM IndexedDirectProductAbelianMonoid
-++ Author: Mark Botch
-++ Description:
-++ Indexed direct products of abelian monoids over an abelian monoid 
-++ \spad{A} of generators indexed by the ordered set S. All items have 
-++ finite support. Only non-zero terms are stored.
+    latex s             == concat("\mbox{``", concat(s pretend String, "''}"))
 
-IndexedDirectProductAbelianMonoid(A:AbelianMonoid,S:OrderedSet):
-    Join(AbelianMonoid,IndexedDirectProductCategory(A,S))
- ==  IndexedDirectProductObject(A,S) add
-    --representations
-       Term:=  Record(k:S,c:A)
-       Rep:=  List Term
-       x,y: %
-       r: A
-       n: NonNegativeInteger
-       f: A -> A
-       s: S
-       0  == []
-       zero? x ==  null x
+    replace(s, sg, t) ==
+      l := lo(sg) - mn
+      m := #s
+      n := #t
+      h:I := if hasHi sg then hi(sg) - mn else maxIndex s - mn
+      l < 0 or h >= m or h < l-1 => error "index out of range"
+      r := new((m-(h-l+1)+n)::N, space$C)
+      for k in 0.. for i in 0..l-1 repeat Qsetelt(r, k, Qelt(s, i))
+      for k in k.. for i in 0..n-1 repeat Qsetelt(r, k, Qelt(t, i))
+      for k in k.. for i in h+1..m-1 repeat Qsetelt(r, k, Qelt(s, i))
+      r
 
-        -- PERFORMANCE CRITICAL; Should build list up
-        --  by merging 2 sorted lists.   Doing this will
-        -- avoid the recursive calls (very useful if there is a
-        -- large number of vars in a polynomial.
---       x + y  ==
---          null x => y
---          null y => x
---          y.first.k > x.first.k => cons(y.first,(x + y.rest))
---          x.first.k > y.first.k => cons(x.first,(x.rest + y))
---          r:= x.first.c + y.first.c
---          r = 0 => x.rest + y.rest
---          cons([x.first.k,r],(x.rest + y.rest))
-       qsetrest!: (Rep, Rep) -> Rep
-       qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp
+    setelt(s:%, i:I, c:C) ==
+      i < mn or i > maxIndex(s) => error "index out of range"
+      Qsetelt(s, i - mn, c)
+      c
 
-       x + y == 
-        null x => y
-        null y => x
-        endcell: Rep := empty()
-        res:  Rep := empty()
-        while not empty? x and not empty? y repeat 
-            newcell := empty()
-            if x.first.k = y.first.k then
-                r:= x.first.c + y.first.c
-                if not zero? r then 
-                    newcell := cons([x.first.k, r], empty())
-                x := rest x
-                y := rest y
-            else if x.first.k > y.first.k then
-                newcell := cons(x.first, empty())
-                x := rest x
-            else
-                newcell := cons(y.first, empty())
-                y := rest y
-            if not empty? newcell then 
-                if not empty? endcell then
-                    qsetrest!(endcell, newcell)
-                    endcell := newcell
-                else
-                    res     := newcell;
-                    endcell := res
-        if empty? x then end := y
-        else end := x
-        if empty? res then res := end
-        else qsetrest!(endcell, end)
-        res
+    substring?(part, whole, startpos) ==
+      np:I := Qsize part
+      nw:I := Qsize whole
+      (startpos := startpos - mn) < 0 => error "index out of bounds"
+      np > nw - startpos => false
+      for ip in 0..np-1 for iw in startpos.. repeat
+          not Cheq(Qelt(part, ip), Qelt(whole, iw)) => return false
+      true
+
+    position(s:%, t:%, startpos:I) ==
+      (startpos := startpos - mn) < 0 => error "index out of bounds"
+      startpos >= Qsize t => mn - 1
+      r:I := STRPOS(s, t, startpos, NIL$Lisp)$Lisp
+      EQ(r, NIL$Lisp)$Lisp => mn - 1
+      r + mn
+
+    position(c: Character, t: %, startpos: I) ==
+      (startpos := startpos - mn) < 0 => error "index out of bounds"
+      startpos >= Qsize t => mn - 1
+      for r in startpos..Qsize t - 1 repeat
+          if Cheq(Qelt(t, r), c) then return r + mn
+      mn - 1
+
+    position(cc: CharacterClass, t: %, startpos: I) ==
+      (startpos := startpos - mn) < 0 => error "index out of bounds"
+      startpos >= Qsize t => mn - 1
+      for r in startpos..Qsize t - 1 repeat
+          if member?(Qelt(t,r), cc) then return r + mn
+      mn - 1
+
+    suffix?(s, t) ==
+      (m := maxIndex s) > (n := maxIndex t) => false
+      substring?(s, t, mn + n - m)
+
+    split(s, c) ==
+      n := maxIndex s
+      for i in mn..n while s.i = c repeat 0
+      l := empty()$List(%)
+      j:Integer -- j is conditionally intialized
+      while i <= n and (j := position(c, s, i)) >= mn repeat
+          l := concat(s(i..j-1), l)
+          for i in j..n while s.i = c repeat 0
+      if i <= n then l := concat(s(i..n), l)
+      reverse_! l
+
+    split(s, cc) ==
+      n := maxIndex s
+      for i in mn..n while member?(s.i,cc) repeat 0
+      l := empty()$List(%)
+      j:Integer -- j is conditionally intialized
+      while i <= n and (j := position(cc, s, i)) >= mn repeat
+          l := concat(s(i..j-1), l)
+          for i in j..n while member?(s.i,cc) repeat 0
+      if i <= n then l := concat(s(i..n), l)
+      reverse_! l
+
+    leftTrim(s, c) ==
+      n := maxIndex s
+      for i in mn .. n while s.i = c repeat 0
+      s(i..n)
+
+    leftTrim(s, cc) ==
+      n := maxIndex s
+      for i in mn .. n while member?(s.i,cc) repeat 0
+      s(i..n)
 
-       n * x  ==
-             n = 0 => 0
-             n = 1 => x
-             [[u.k,a] for u in x | (a:=n*u.c) ^= 0$A]
+    rightTrim(s, c) ==
+      for j in maxIndex s .. mn by -1 while s.j = c repeat 0
+      s(minIndex(s)..j)
 
-       monomial(r,s) == (r = 0 => 0; [[s,r]])
-       map(f,x) == [[tm.k,a] for tm in x | (a:=f(tm.c)) ^= 0$A]
+    rightTrim(s, cc) ==
+      for j in maxIndex s .. mn by -1 while member?(s.j, cc) repeat 0
+      s(minIndex(s)..j)
 
-       reductum x     == (null x => 0; rest x)
-       leadingCoefficient x  == (null x => 0; x.first.c)
+    concat l ==
+      t := new(+/[#s for s in l], space$C)
+      i := mn
+      for s in l repeat
+          copyInto_!(t, s, i)
+          i := i + #s
+      t
+
+    copyInto_!(y, x, s) ==
+      m := #x
+      n := #y
+      s := s - mn
+      s < 0 or s+m > n => error "index out of range"
+      RPLACSTR(y, s, m, x, 0, m)$Lisp
+      y
+
+    elt(s:%, i:I) ==
+      i < mn or i > maxIndex(s) => error "index out of range"
+      Qelt(s, i - mn)
+
+    elt(s:%, sg:U) ==
+      l := lo(sg) - mn
+      h := if hasHi sg then hi(sg) - mn else maxIndex s - mn
+      l < 0 or h >= #s => error "index out of bound"
+      SUBSTRING(s, l, max(0, h-l+1))$Lisp
+
+    hash(s:$):Integer ==
+      n:I := Qsize s
+      zero? n => 0
+      (n = 1) => ord(s.mn)
+      ord(s.mn) * ord s(mn+n-1) * ord s(mn + n quo 2)
+
+    match(pattern,target,wildcard) ==
+      stringMatch(pattern,target,CHARACTER(wildcard)$Lisp)$Lisp
+ 
+    match?(pattern, target, dontcare) ==
+      n := maxIndex pattern
+      p := position(dontcare, pattern, m := minIndex pattern)::N
+      p = m-1 => pattern = target
+      (p ^= m) and not prefix?(pattern(m..p-1), target) => false
+      i := p      -- index into target
+      q := position(dontcare, pattern, p + 1)::N
+      while q ^= m-1 repeat
+         s := pattern(p+1..q-1)
+         i := position(s, target, i)::N
+         i = m-1 => return false
+         i := i + #s
+         p := q
+         q := position(dontcare, pattern, q + 1)::N
+      (p ^= n) and not suffix?(pattern(p+1..n), target) => false
+      true
 
 \end{chunk}
 
-\begin{chunk}{COQ IDPAM}
-(* domain IDPAM *)
+\begin{chunk}{COQ ISTRING}
+(* domain ISTRING *)
 (*
-*)
+    -- These assume Character's Rep is Small I
+    Qelt    ==> QENUM$Lisp
+    Qequal  ==> EQUAL$Lisp
+    Qsetelt ==> QESET$Lisp
+    Qsize   ==> QCSIZE$Lisp
+    Cheq    ==> EQL$Lisp
+    Chlt    ==> QSLESSP$Lisp
+    Chgt    ==> QSGREATERP$Lisp
 
-\end{chunk}
+    c: Character
+    cc: CharacterClass
 
-\begin{chunk}{IDPAM.dotabb}
-"IDPAM" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IDPAM"]
-"ORDSET" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ORDSET"]
-"IDPC" [color="#4488FF",href="bookvol10.2.pdf#nameddest=IDPC"]
-"IDPAM" -> "IDPC"
-"IDPAM" -> "ORDSET"
+    new(n, c)              == MAKE_-FULL_-CVEC(n, c)$Lisp
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IDPO IndexedDirectProductObject}
+    empty()                == MAKE_-FULL_-CVEC(0$Lisp)$Lisp
 
-\begin{chunk}{IndexedDirectProductObject.input}
-)set break resume
-)sys rm -f IndexedDirectProductObject.output
-)spool IndexedDirectProductObject.output
-)set message test on
-)set message auto off
-)clear all
+    empty?(s)              == Qsize(s) = 0
 
---S 1 of 1
-)show IndexedDirectProductObject
---R 
---R IndexedDirectProductObject(A: SetCategory,S: OrderedSet)  is a domain constructor
---R Abbreviation for IndexedDirectProductObject is IDPO 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IDPO 
---R
---R------------------------------- Operations --------------------------------
---R ?=? : (%,%) -> Boolean                coerce : % -> OutputForm
---R hash : % -> SingleInteger             latex : % -> String
---R leadingCoefficient : % -> A           leadingSupport : % -> S
---R map : ((A -> A),%) -> %               monomial : (A,S) -> %
---R reductum : % -> %                     ?~=? : (%,%) -> Boolean
---R
---E 1
+    #s                     == Qsize(s)
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{IndexedDirectProductObject.help}
-====================================================================
-IndexedDirectProductObject examples
-====================================================================
+    s = t                  == Qequal(s, t)
 
-Indexed direct products of objects over a set A of generators indexed
-by an ordered set S. All items have finite support.
+    s < t                  == CGREATERP(t,s)$Lisp
 
-See Also:
-o )show IndexedDirectProductObject
+    concat(s:%,t:%)        == STRCONC(s,t)$Lisp
 
-\end{chunk}
+    copy s                 == COPY_-SEQ(s)$Lisp
 
-\pagehead{IndexedDirectProductObject}{IDPO}
-\pagepic{ps/v103indexeddirectproductobject.ps}{IDPO}{1.00}
-{\bf See}\\
-\pageto{IndexedDirectProductAbelianMonoid}{IDPAM}
-\pageto{IndexedDirectProductOrderedAbelianMonoid}{IDPOAM}
-\pageto{IndexedDirectProductOrderedAbelianMonoidSup}{IDPOAMS}
-\pageto{IndexedDirectProductAbelianGroup}{IDPAG}
+    insert(s:%, t:%, i:I)  == concat(concat(s(mn..i-1), t), s(i..))
 
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{IDPO}{coerce} &
-\cross{IDPO}{hash} &
-\cross{IDPO}{latex} &
-\cross{IDPO}{leadingCoefficient} &
-\cross{IDPO}{leadingSupport} \\
-\cross{IDPO}{map} &
-\cross{IDPO}{monomial} &
-\cross{IDPO}{reductum} &
-\cross{IDPO}{?=?} &
-\cross{IDPO}{?\~{}=?} 
-\end{tabular}
+    coerce(s:%):OutputForm == outputForm(s pretend String)
 
-\begin{chunk}{domain IDPO IndexedDirectProductObject}
-)abbrev domain IDPO IndexedDirectProductObject
-++ Author: Mark Botch
-++ Description:
-++ Indexed direct products of objects over a set \spad{A}
-++ of generators indexed by an ordered set S. All items have finite support.
+    minIndex s             == mn
 
-IndexedDirectProductObject(A:SetCategory,S:OrderedSet): _
-  IndexedDirectProductCategory(A,S)
- == add
-    --representations
-       Term:=  Record(k:S,c:A)
-       Rep:=  List Term
-    --declarations
-       x,y: %
-       f: A -> A
-       s: S
-    --define
-       x = y ==
-         while not null x and _^ null y repeat
-           x.first.k ^= y.first.k => return false
-           x.first.c ^= y.first.c => return false
-           x:=x.rest
-           y:=y.rest
-         null x and null y
+    upperCase_! s          == map_!(upperCase, s)
 
-       coerce(x:%):OutputForm ==
-          bracket [rarrow(t.k :: OutputForm, t.c :: OutputForm) for t in x]
+    lowerCase_! s          == map_!(lowerCase, s)
 
-       -- sample():% == [[sample()$S,sample()$A]$Term]$Rep
+    latex s             == concat("\mbox{``", concat(s pretend String, "''}"))
 
-       monomial(r,s) == [[s,r]]
-       map(f,x) == [[tm.k,f(tm.c)] for tm in x]
+    replace(s, sg, t) ==
+      l := lo(sg) - mn
+      m := #s
+      n := #t
+      h:I := if hasHi sg then hi(sg) - mn else maxIndex s - mn
+      l < 0 or h >= m or h < l-1 => error "index out of range"
+      r := new((m-(h-l+1)+n)::N, space$C)
+      for k in 0.. for i in 0..l-1 repeat Qsetelt(r, k, Qelt(s, i))
+      for k in k.. for i in 0..n-1 repeat Qsetelt(r, k, Qelt(t, i))
+      for k in k.. for i in h+1..m-1 repeat Qsetelt(r, k, Qelt(s, i))
+      r
 
-       reductum x     ==
-          rest x
-       leadingCoefficient x  ==
-          null x => error "Can't take leadingCoefficient of empty product element"
-          x.first.c
-       leadingSupport x  ==
-          null x => error "Can't take leadingCoefficient of empty product element"
-          x.first.k
+    setelt(s:%, i:I, c:C) ==
+      i < mn or i > maxIndex(s) => error "index out of range"
+      Qsetelt(s, i - mn, c)
+      c
 
-\end{chunk}
+    substring?(part, whole, startpos) ==
+      np:I := Qsize part
+      nw:I := Qsize whole
+      (startpos := startpos - mn) < 0 => error "index out of bounds"
+      np > nw - startpos => false
+      for ip in 0..np-1 for iw in startpos.. repeat
+          not Cheq(Qelt(part, ip), Qelt(whole, iw)) => return false
+      true
 
-\begin{chunk}{COQ IDPO}
-(* domain IDPO *)
-(*
-*)
+    position(s:%, t:%, startpos:I) ==
+      (startpos := startpos - mn) < 0 => error "index out of bounds"
+      startpos >= Qsize t => mn - 1
+      r:I := STRPOS(s, t, startpos, NIL$Lisp)$Lisp
+      EQ(r, NIL$Lisp)$Lisp => mn - 1
+      r + mn
 
-\end{chunk}
+    position(c: Character, t: %, startpos: I) ==
+      (startpos := startpos - mn) < 0 => error "index out of bounds"
+      startpos >= Qsize t => mn - 1
+      for r in startpos..Qsize t - 1 repeat
+          if Cheq(Qelt(t, r), c) then return r + mn
+      mn - 1
 
-\begin{chunk}{IDPO.dotabb}
-"IDPO" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IDPO"]
-"ORDSET" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ORDSET"]
-"IDPC" [color="#4488FF",href="bookvol10.2.pdf#nameddest=IDPC"]
-"IDPO" -> "IDPC"
-"IDPO" -> "ORDSET"
+    position(cc: CharacterClass, t: %, startpos: I) ==
+      (startpos := startpos - mn) < 0 => error "index out of bounds"
+      startpos >= Qsize t => mn - 1
+      for r in startpos..Qsize t - 1 repeat
+          if member?(Qelt(t,r), cc) then return r + mn
+      mn - 1
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IDPOAM IndexedDirectProductOrderedAbelianMonoid}
+    suffix?(s, t) ==
+      (m := maxIndex s) > (n := maxIndex t) => false
+      substring?(s, t, mn + n - m)
 
-\begin{chunk}{IndexedDirectProductOrderedAbelianMonoid.input}
-)set break resume
-)sys rm -f IndexedDirectProductOrderedAbelianMonoid.output
-)spool IndexedDirectProductOrderedAbelianMonoid.output
-)set message test on
-)set message auto off
-)clear all
+    split(s, c) ==
+      n := maxIndex s
+      for i in mn..n while s.i = c repeat 0
+      l := empty()$List(%)
+      j:Integer -- j is conditionally intialized
+      while i <= n and (j := position(c, s, i)) >= mn repeat
+          l := concat(s(i..j-1), l)
+          for i in j..n while s.i = c repeat 0
+      if i <= n then l := concat(s(i..n), l)
+      reverse_! l
 
---S 1 of 1
-)show IndexedDirectProductOrderedAbelianMonoid
---R 
---R IndexedDirectProductOrderedAbelianMonoid(A: OrderedAbelianMonoid,S: OrderedSet)  is a domain constructor
---R Abbreviation for IndexedDirectProductOrderedAbelianMonoid is IDPOAM 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IDPOAM 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?+? : (%,%) -> %                      ?<? : (%,%) -> Boolean
---R ?<=? : (%,%) -> Boolean               ?=? : (%,%) -> Boolean
---R ?>? : (%,%) -> Boolean                ?>=? : (%,%) -> Boolean
---R 0 : () -> %                           coerce : % -> OutputForm
---R hash : % -> SingleInteger             latex : % -> String
---R leadingCoefficient : % -> A           leadingSupport : % -> S
---R map : ((A -> A),%) -> %               max : (%,%) -> %
---R min : (%,%) -> %                      monomial : (A,S) -> %
---R reductum : % -> %                     sample : () -> %
---R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
---R
---E 1
+    split(s, cc) ==
+      n := maxIndex s
+      for i in mn..n while member?(s.i,cc) repeat 0
+      l := empty()$List(%)
+      j:Integer -- j is conditionally intialized
+      while i <= n and (j := position(cc, s, i)) >= mn repeat
+          l := concat(s(i..j-1), l)
+          for i in j..n while member?(s.i,cc) repeat 0
+      if i <= n then l := concat(s(i..n), l)
+      reverse_! l
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{IndexedDirectProductOrderedAbelianMonoid.help}
-====================================================================
-IndexedDirectProductOrderedAbelianMonoid examples
-====================================================================
+    leftTrim(s, c) ==
+      n := maxIndex s
+      for i in mn .. n while s.i = c repeat 0
+      s(i..n)
 
-Indexed direct products of ordered abelian monoids A of generators
-indexed by the ordered set S.  The inherited order is lexicographical.
-All items have finite support: only non-zero terms are stored.
+    leftTrim(s, cc) ==
+      n := maxIndex s
+      for i in mn .. n while member?(s.i,cc) repeat 0
+      s(i..n)
 
-See Also:
-o )show IndexedDirectProductOrderedAbelianMonoid
+    rightTrim(s, c) ==
+      for j in maxIndex s .. mn by -1 while s.j = c repeat 0
+      s(minIndex(s)..j)
 
-\end{chunk}
+    rightTrim(s, cc) ==
+      for j in maxIndex s .. mn by -1 while member?(s.j, cc) repeat 0
+      s(minIndex(s)..j)
 
-\pagehead{IndexedDirectProductOrderedAbelianMonoid}{IDPOAM}
-\pagepic{ps/v103indexeddirectproductorderedabelianmonoid.ps}{IDPOAM}{1.00}
-{\bf See}\\
-\pageto{IndexedDirectProductObject}{IDPO}
-\pageto{IndexedDirectProductAbelianMonoid}{IDPAM}
-\pageto{IndexedDirectProductOrderedAbelianMonoidSup}{IDPOAMS}
-\pageto{IndexedDirectProductAbelianGroup}{IDPAG}
+    concat l ==
+      t := new(+/[#s for s in l], space$C)
+      i := mn
+      for s in l repeat
+          copyInto_!(t, s, i)
+          i := i + #s
+      t
 
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{IDPOAM}{0} &
-\cross{IDPOAM}{coerce} &
-\cross{IDPOAM}{hash} &
-\cross{IDPOAM}{latex} &
-\cross{IDPOAM}{leadingCoefficient} \\
-\cross{IDPOAM}{leadingSupport} &
-\cross{IDPOAM}{map} &
-\cross{IDPOAM}{max} &
-\cross{IDPOAM}{min} &
-\cross{IDPOAM}{monomial} \\
-\cross{IDPOAM}{reductum} &
-\cross{IDPOAM}{sample} &
-\cross{IDPOAM}{zero?} &
-\cross{IDPOAM}{?\~{}=?} &
-\cross{IDPOAM}{?*?} \\
-\cross{IDPOAM}{?+?} &
-\cross{IDPOAM}{?$<$?} &
-\cross{IDPOAM}{?$<=$?} &
-\cross{IDPOAM}{?=?} &
-\cross{IDPOAM}{?$>$?} \\
-\cross{IDPOAM}{?$>=$?} &&&&
-\end{tabular}
+    copyInto_!(y, x, s) ==
+      m := #x
+      n := #y
+      s := s - mn
+      s < 0 or s+m > n => error "index out of range"
+      RPLACSTR(y, s, m, x, 0, m)$Lisp
+      y
 
-\begin{chunk}{domain IDPOAM IndexedDirectProductOrderedAbelianMonoid}
-)abbrev domain IDPOAM IndexedDirectProductOrderedAbelianMonoid
-++ Author: Mark Botch
-++ Description:
-++ Indexed direct products of ordered abelian monoids \spad{A} of
-++ generators indexed by the ordered set S.
-++ The inherited order is lexicographical.
-++ All items have finite support: only non-zero terms are stored.
+    elt(s:%, i:I) ==
+      i < mn or i > maxIndex(s) => error "index out of range"
+      Qelt(s, i - mn)
 
-IndexedDirectProductOrderedAbelianMonoid(A:OrderedAbelianMonoid,S:OrderedSet):
-    Join(OrderedAbelianMonoid,IndexedDirectProductCategory(A,S))
- ==  IndexedDirectProductAbelianMonoid(A,S) add
-    --representations
-       Term:=  Record(k:S,c:A)
-       Rep:=  List Term
-       x,y: %
-       x<y ==
-         empty? y => false
-         empty? x => true   -- note careful order of these two lines
-         y.first.k > x.first.k => true
-         y.first.k < x.first.k => false
-         y.first.c > x.first.c => true
-         y.first.c < x.first.c => false
-         x.rest < y.rest
+    elt(s:%, sg:U) ==
+      l := lo(sg) - mn
+      h := if hasHi sg then hi(sg) - mn else maxIndex s - mn
+      l < 0 or h >= #s => error "index out of bound"
+      SUBSTRING(s, l, max(0, h-l+1))$Lisp
 
-\end{chunk}
+    hash(s:$):Integer ==
+      n:I := Qsize s
+      zero? n => 0
+      (n = 1) => ord(s.mn)
+      ord(s.mn) * ord s(mn+n-1) * ord s(mn + n quo 2)
+
+    match(pattern,target,wildcard) ==
+      stringMatch(pattern,target,CHARACTER(wildcard)$Lisp)$Lisp
+ 
+    match?(pattern, target, dontcare) ==
+      n := maxIndex pattern
+      p := position(dontcare, pattern, m := minIndex pattern)::N
+      p = m-1 => pattern = target
+      (p ^= m) and not prefix?(pattern(m..p-1), target) => false
+      i := p      -- index into target
+      q := position(dontcare, pattern, p + 1)::N
+      while q ^= m-1 repeat
+         s := pattern(p+1..q-1)
+         i := position(s, target, i)::N
+         i = m-1 => return false
+         i := i + #s
+         p := q
+         q := position(dontcare, pattern, q + 1)::N
+      (p ^= n) and not suffix?(pattern(p+1..n), target) => false
+      true
 
-\begin{chunk}{COQ IDPOAM}
-(* domain IDPOAM *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{IDPOAM.dotabb}
-"IDPOAM" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IDPOAM"]
-"OAMON" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAMON"]
-"IDPOAM" -> "OAMON"
+\begin{chunk}{ISTRING.dotabb}
+"ISTRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ISTRING",
+          shape=ellipse]
+"FSAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FSAGG"]
+"ISTRING" -> "FSAGG"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IDPOAMS IndexedDirectProductOrderedAbelianMonoidSup}
+\section{domain IARRAY2 IndexedTwoDimensionalArray}
 
-\begin{chunk}{IndexedDirectProductOrderedAbelianMonoidSup.input}
+An IndexedTwoDimensionalArray is a 2-dimensional array where
+the minimal row and column indices are parameters of the type.
+Rows and columns are returned as IndexedOneDimensionalArray's with
+minimal indices matching those of the IndexedTwoDimensionalArray.
+The index of the 'first' row may be obtained by calling the
+function 'minRowIndex'.  The index of the 'first' column may
+be obtained by calling the function 'minColIndex'.  The index of
+the first element of a 'Row' is the same as the index of the
+first column in an array and vice versa.
+
+\begin{chunk}{IndexedTwoDimensionalArray.input}
 )set break resume
-)sys rm -f IndexedDirectProductOrderedAbelianMonoidSup.output
-)spool IndexedDirectProductOrderedAbelianMonoidSup.output
+)sys rm -f IndexedTwoDimensionalArray.output
+)spool IndexedTwoDimensionalArray.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show IndexedDirectProductOrderedAbelianMonoidSup
+)show IndexedTwoDimensionalArray
 --R 
---R IndexedDirectProductOrderedAbelianMonoidSup(A: OrderedAbelianMonoidSup,S: OrderedSet)  is a domain constructor
---R Abbreviation for IndexedDirectProductOrderedAbelianMonoidSup is IDPOAMS 
+--R IndexedTwoDimensionalArray(R: Type,mnRow: Integer,mnCol: Integer)  is a domain constructor
+--R Abbreviation for IndexedTwoDimensionalArray is IARRAY2 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IDPOAMS 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IARRAY2 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?+? : (%,%) -> %                      ?<? : (%,%) -> Boolean
---R ?<=? : (%,%) -> Boolean               ?=? : (%,%) -> Boolean
---R ?>? : (%,%) -> Boolean                ?>=? : (%,%) -> Boolean
---R 0 : () -> %                           coerce : % -> OutputForm
---R hash : % -> SingleInteger             latex : % -> String
---R leadingCoefficient : % -> A           leadingSupport : % -> S
---R map : ((A -> A),%) -> %               max : (%,%) -> %
---R min : (%,%) -> %                      monomial : (A,S) -> %
---R reductum : % -> %                     sample : () -> %
---R sup : (%,%) -> %                      zero? : % -> Boolean
---R ?~=? : (%,%) -> Boolean              
---R subtractIfCan : (%,%) -> Union(%,"failed")
+--R copy : % -> %                         elt : (%,Integer,Integer,R) -> R
+--R elt : (%,Integer,Integer) -> R        empty : () -> %
+--R empty? : % -> Boolean                 eq? : (%,%) -> Boolean
+--R fill! : (%,R) -> %                    latex : % -> String if R has SETCAT
+--R map : (((R,R) -> R),%,%,R) -> %       map : (((R,R) -> R),%,%) -> %
+--R map : ((R -> R),%) -> %               map! : ((R -> R),%) -> %
+--R maxColIndex : % -> Integer            maxRowIndex : % -> Integer
+--R minColIndex : % -> Integer            minRowIndex : % -> Integer
+--R ncols : % -> NonNegativeInteger       nrows : % -> NonNegativeInteger
+--R parts : % -> List(R)                  qelt : (%,Integer,Integer) -> R
+--R sample : () -> %                      setelt : (%,Integer,Integer,R) -> R
+--R #? : % -> NonNegativeInteger if $ has finiteAggregate
+--R ?=? : (%,%) -> Boolean if R has SETCAT
+--R any? : ((R -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R coerce : % -> OutputForm if R has SETCAT
+--R column : (%,Integer) -> IndexedOneDimensionalArray(R,mnRow)
+--R count : (R,%) -> NonNegativeInteger if $ has finiteAggregate and R has SETCAT
+--R count : ((R -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
+--R eval : (%,List(R),List(R)) -> % if R has EVALAB(R) and R has SETCAT
+--R eval : (%,R,R) -> % if R has EVALAB(R) and R has SETCAT
+--R eval : (%,Equation(R)) -> % if R has EVALAB(R) and R has SETCAT
+--R eval : (%,List(Equation(R))) -> % if R has EVALAB(R) and R has SETCAT
+--R every? : ((R -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R hash : % -> SingleInteger if R has SETCAT
+--R less? : (%,NonNegativeInteger) -> Boolean
+--R member? : (R,%) -> Boolean if $ has finiteAggregate and R has SETCAT
+--R members : % -> List(R) if $ has finiteAggregate
+--R more? : (%,NonNegativeInteger) -> Boolean
+--R new : (NonNegativeInteger,NonNegativeInteger,R) -> %
+--R qsetelt! : (%,Integer,Integer,R) -> R
+--R row : (%,Integer) -> IndexedOneDimensionalArray(R,mnCol)
+--R setColumn! : (%,Integer,IndexedOneDimensionalArray(R,mnRow)) -> %
+--R setRow! : (%,Integer,IndexedOneDimensionalArray(R,mnCol)) -> %
+--R size? : (%,NonNegativeInteger) -> Boolean
+--R ?~=? : (%,%) -> Boolean if R has SETCAT
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{IndexedDirectProductOrderedAbelianMonoidSup.help}
+\begin{chunk}{IndexedTwoDimensionalArray.help}
 ====================================================================
-IndexedDirectProductOrderedAbelianMonoidSup examples
+IndexedTwoDimensionalArray examples
 ====================================================================
 
-Indexed direct products of ordered abelian monoid sups A, generators
-indexed by the ordered set S.  All items have finite support: only
-non-zero terms are stored.
+This domain implements two dimensional arrays
 
 See Also:
-o )show IndexedDirectProductOrderedAbelianMonoidSup
+o )show IndexedTwoDimensionalArray
 
 \end{chunk}
 
-\pagehead{IndexedDirectProductOrderedAbelianMonoidSup}{IDPOAMS}
-\pagepic{ps/v103indexeddirectproductorderedabelianmonoidsup.ps}{IDPOAMS}{1.00}
+\pagehead{IndexedTwoDimensionalArray}{IARRAY2}
+\pagepic{ps/v103indexedtwodimensionalarray.ps}{IARRAY2}{1.00}
 {\bf See}\\
-\pageto{IndexedDirectProductObject}{IDPO}
-\pageto{IndexedDirectProductAbelianMonoid}{IDPAM}
-\pageto{IndexedDirectProductOrderedAbelianMonoid}{IDPOAM}
-\pageto{IndexedDirectProductAbelianGroup}{IDPAG}
+\pageto{InnerIndexedTwoDimensionalArray}{IIARRAY2}
+\pageto{TwoDimensionalArray}{ARRAY2}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{IDPOAMS}{0} &
-\cross{IDPOAMS}{coerce} &
-\cross{IDPOAMS}{hash} &
-\cross{IDPOAMS}{latex} &
-\cross{IDPOAMS}{leadingCoefficient} \\
-\cross{IDPOAMS}{leadingSupport} &
-\cross{IDPOAMS}{map} &
-\cross{IDPOAMS}{max} &
-\cross{IDPOAMS}{min} &
-\cross{IDPOAMS}{monomial} \\
-\cross{IDPOAMS}{reductum} &
-\cross{IDPOAMS}{sample} &
-\cross{IDPOAMS}{subtractIfCan} &
-\cross{IDPOAMS}{sup} &
-\cross{IDPOAMS}{zero?} \\
-\cross{IDPOAMS}{?\~{}=?} &
-\cross{IDPOAMS}{?*?} &
-\cross{IDPOAMS}{?+?} &
-\cross{IDPOAMS}{?$<$?} &
-\cross{IDPOAMS}{?$<=$?} \\
-\cross{IDPOAMS}{?=?} &
-\cross{IDPOAMS}{?$>$?} &
-\cross{IDPOAMS}{?$>=$?} &&
+\cross{IARRAY2}{any?} &
+\cross{IARRAY2}{coerce} &
+\cross{IARRAY2}{column} &
+\cross{IARRAY2}{copy} &
+\cross{IARRAY2}{count} \\
+\cross{IARRAY2}{count} &
+\cross{IARRAY2}{elt} &
+\cross{IARRAY2}{empty} &
+\cross{IARRAY2}{empty?} &
+\cross{IARRAY2}{eq?} \\
+\cross{IARRAY2}{eval} &
+\cross{IARRAY2}{every?} &
+\cross{IARRAY2}{fill!} &
+\cross{IARRAY2}{hash} &
+\cross{IARRAY2}{latex} \\
+\cross{IARRAY2}{less?} &
+\cross{IARRAY2}{maxColIndex} &
+\cross{IARRAY2}{maxRowIndex} &
+\cross{IARRAY2}{map} &
+\cross{IARRAY2}{map!} \\
+\cross{IARRAY2}{member?} &
+\cross{IARRAY2}{members} &
+\cross{IARRAY2}{minColIndex} &
+\cross{IARRAY2}{minRowIndex} &
+\cross{IARRAY2}{more?} \\
+\cross{IARRAY2}{ncols} &
+\cross{IARRAY2}{new} &
+\cross{IARRAY2}{nrows} &
+\cross{IARRAY2}{parts} &
+\cross{IARRAY2}{qelt} \\
+\cross{IARRAY2}{qsetelt!} &
+\cross{IARRAY2}{row} &
+\cross{IARRAY2}{sample} &
+\cross{IARRAY2}{setColumn!} &
+\cross{IARRAY2}{setRow!} \\
+\cross{IARRAY2}{setelt} &
+\cross{IARRAY2}{size?} &
+\cross{IARRAY2}{\#{}?} &
+\cross{IARRAY2}{?=?} &
+\cross{IARRAY2}{?\~{}=?}
 \end{tabular}
 
-\begin{chunk}{domain IDPOAMS IndexedDirectProductOrderedAbelianMonoidSup}
-)abbrev domain IDPOAMS IndexedDirectProductOrderedAbelianMonoidSup
+\begin{chunk}{domain IARRAY2 IndexedTwoDimensionalArray}
+)abbrev domain IARRAY2 IndexedTwoDimensionalArray
 ++ Author: Mark Botch
 ++ Description:
-++ Indexed direct products of ordered abelian monoid sups \spad{A},
-++ generators indexed by the ordered set S.
-++ All items have finite support: only non-zero terms are stored.
+++ This domain implements two dimensional arrays
 
-IndexedDirectProductOrderedAbelianMonoidSup(A:OrderedAbelianMonoidSup,S:OrderedSet):
-    Join(OrderedAbelianMonoidSup,IndexedDirectProductCategory(A,S))
- ==  IndexedDirectProductOrderedAbelianMonoid(A,S) add
-    --representations
-       Term:=  Record(k:S,c:A)
-       Rep:=  List Term
-       x,y: %
-       r: A
-       s: S
+IndexedTwoDimensionalArray(R,mnRow,mnCol):Exports == Implementation where
+  R : Type
+  mnRow, mnCol : Integer
+  Row ==> IndexedOneDimensionalArray(R,mnCol)
+  Col ==> IndexedOneDimensionalArray(R,mnRow)
 
-       subtractIfCan(x,y) ==
-         empty? y => x
-         empty? x => "failed"
-         x.first.k < y.first.k => "failed"
-         x.first.k > y.first.k =>
-             t:= subtractIfCan(x.rest, y)
-             t case "failed" => "failed"
-             cons( x.first, t)
-         u:=subtractIfCan(x.first.c, y.first.c)
-         u case "failed" => "failed"
-         zero? u => subtractIfCan(x.rest, y.rest)
-         t:= subtractIfCan(x.rest, y.rest)
-         t case "failed" => "failed"
-         cons([x.first.k,u],t)
+  Exports ==> TwoDimensionalArrayCategory(R,Row,Col)
 
-       sup(x,y) ==
-         empty? y => x
-         empty? x => y
-         x.first.k < y.first.k => cons(y.first,sup(x,y.rest))
-         x.first.k > y.first.k => cons(x.first,sup(x.rest,y))
-         u:=sup(x.first.c, y.first.c)
-         cons([x.first.k,u],sup(x.rest,y.rest))
+  Implementation ==>
+    InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col)
 
 \end{chunk}
 
-\begin{chunk}{COQ IDPOAMS}
-(* domain IDPOAMS *)
+\begin{chunk}{COQ IARRAY2}
+(* domain IARRAY2 *)
 (*
 *)
 
 \end{chunk}
 
-\begin{chunk}{IDPOAMS.dotabb}
-"IDPOAMS" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IDPOAMS"]
-"OAMONS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAMONS"]
-"IDPOAMS" -> "OAMONS"
+\begin{chunk}{IARRAY2.dotabb}
+"IARRAY2" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IARRAY2"]
+"A1AGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=A1AGG"]
+"ARR2CAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ARR2CAT"]
+"IARRAY2" -> "ARR2CAT"
+"IARRAY2" -> "A1AGG"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain INDE IndexedExponents}
+\section{domain IVECTOR IndexedVector}
 
-\begin{chunk}{IndexedExponents.input}
+\begin{chunk}{IndexedVector.input}
 )set break resume
-)sys rm -f IndexedExponents.output
-)spool IndexedExponents.output
+)sys rm -f IndexedVector.output
+)spool IndexedVector.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show IndexedExponents
+)show IndexedVector
 --R 
---R IndexedExponents(Varset: OrderedSet)  is a domain constructor
---R Abbreviation for IndexedExponents is INDE 
+--R IndexedVector(R: Type,mn: Integer)  is a domain constructor
+--R Abbreviation for IndexedVector is IVECTOR 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for INDE 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IVECTOR 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?+? : (%,%) -> %                      ?<? : (%,%) -> Boolean
---R ?<=? : (%,%) -> Boolean               ?=? : (%,%) -> Boolean
---R ?>? : (%,%) -> Boolean                ?>=? : (%,%) -> Boolean
---R 0 : () -> %                           coerce : % -> OutputForm
---R hash : % -> SingleInteger             latex : % -> String
---R leadingSupport : % -> Varset          max : (%,%) -> %
---R min : (%,%) -> %                      reductum : % -> %
---R sample : () -> %                      sup : (%,%) -> %
---R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
---R leadingCoefficient : % -> NonNegativeInteger
---R map : ((NonNegativeInteger -> NonNegativeInteger),%) -> %
---R monomial : (NonNegativeInteger,Varset) -> %
---R subtractIfCan : (%,%) -> Union(%,"failed")
+--R ?*? : (%,R) -> % if R has MONOID      ?*? : (R,%) -> % if R has MONOID
+--R ?+? : (%,%) -> % if R has ABELSG      ?-? : (%,%) -> % if R has ABELGRP
+--R -? : % -> % if R has ABELGRP          concat : List(%) -> %
+--R concat : (%,%) -> %                   concat : (R,%) -> %
+--R concat : (%,R) -> %                   construct : List(R) -> %
+--R copy : % -> %                         cross : (%,%) -> % if R has RING
+--R delete : (%,Integer) -> %             dot : (%,%) -> R if R has RING
+--R ?.? : (%,Integer) -> R                elt : (%,Integer,R) -> R
+--R empty : () -> %                       empty? : % -> Boolean
+--R entries : % -> List(R)                eq? : (%,%) -> Boolean
+--R index? : (Integer,%) -> Boolean       indices : % -> List(Integer)
+--R insert : (%,%,Integer) -> %           insert : (R,%,Integer) -> %
+--R latex : % -> String if R has SETCAT   map : (((R,R) -> R),%,%) -> %
+--R map : ((R -> R),%) -> %               max : (%,%) -> % if R has ORDSET
+--R min : (%,%) -> % if R has ORDSET      new : (NonNegativeInteger,R) -> %
+--R qelt : (%,Integer) -> R               reverse : % -> %
+--R sample : () -> %                      sort : % -> % if R has ORDSET
+--R sort : (((R,R) -> Boolean),%) -> %   
+--R #? : % -> NonNegativeInteger if $ has finiteAggregate
+--R ?*? : (Integer,%) -> % if R has ABELGRP
+--R ?<? : (%,%) -> Boolean if R has ORDSET
+--R ?<=? : (%,%) -> Boolean if R has ORDSET
+--R ?=? : (%,%) -> Boolean if R has SETCAT
+--R ?>? : (%,%) -> Boolean if R has ORDSET
+--R ?>=? : (%,%) -> Boolean if R has ORDSET
+--R any? : ((R -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R coerce : % -> OutputForm if R has SETCAT
+--R convert : % -> InputForm if R has KONVERT(INFORM)
+--R copyInto! : (%,%,Integer) -> % if $ has shallowlyMutable
+--R count : (R,%) -> NonNegativeInteger if $ has finiteAggregate and R has SETCAT
+--R count : ((R -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
+--R delete : (%,UniversalSegment(Integer)) -> %
+--R ?.? : (%,UniversalSegment(Integer)) -> %
+--R entry? : (R,%) -> Boolean if $ has finiteAggregate and R has SETCAT
+--R eval : (%,List(R),List(R)) -> % if R has EVALAB(R) and R has SETCAT
+--R eval : (%,R,R) -> % if R has EVALAB(R) and R has SETCAT
+--R eval : (%,Equation(R)) -> % if R has EVALAB(R) and R has SETCAT
+--R eval : (%,List(Equation(R))) -> % if R has EVALAB(R) and R has SETCAT
+--R every? : ((R -> Boolean),%) -> Boolean if $ has finiteAggregate
+--R fill! : (%,R) -> % if $ has shallowlyMutable
+--R find : ((R -> Boolean),%) -> Union(R,"failed")
+--R first : % -> R if Integer has ORDSET
+--R hash : % -> SingleInteger if R has SETCAT
+--R length : % -> R if R has RADCAT and R has RING
+--R less? : (%,NonNegativeInteger) -> Boolean
+--R magnitude : % -> R if R has RADCAT and R has RING
+--R map! : ((R -> R),%) -> % if $ has shallowlyMutable
+--R maxIndex : % -> Integer if Integer has ORDSET
+--R member? : (R,%) -> Boolean if $ has finiteAggregate and R has SETCAT
+--R members : % -> List(R) if $ has finiteAggregate
+--R merge : (%,%) -> % if R has ORDSET
+--R merge : (((R,R) -> Boolean),%,%) -> %
+--R minIndex : % -> Integer if Integer has ORDSET
+--R more? : (%,NonNegativeInteger) -> Boolean
+--R outerProduct : (%,%) -> Matrix(R) if R has RING
+--R parts : % -> List(R) if $ has finiteAggregate
+--R position : (R,%,Integer) -> Integer if R has SETCAT
+--R position : (R,%) -> Integer if R has SETCAT
+--R position : ((R -> Boolean),%) -> Integer
+--R qsetelt! : (%,Integer,R) -> R if $ has shallowlyMutable
+--R reduce : (((R,R) -> R),%) -> R if $ has finiteAggregate
+--R reduce : (((R,R) -> R),%,R) -> R if $ has finiteAggregate
+--R reduce : (((R,R) -> R),%,R,R) -> R if $ has finiteAggregate and R has SETCAT
+--R remove : ((R -> Boolean),%) -> % if $ has finiteAggregate
+--R remove : (R,%) -> % if $ has finiteAggregate and R has SETCAT
+--R removeDuplicates : % -> % if $ has finiteAggregate and R has SETCAT
+--R reverse! : % -> % if $ has shallowlyMutable
+--R select : ((R -> Boolean),%) -> % if $ has finiteAggregate
+--R setelt : (%,UniversalSegment(Integer),R) -> R if $ has shallowlyMutable
+--R setelt : (%,Integer,R) -> R if $ has shallowlyMutable
+--R size? : (%,NonNegativeInteger) -> Boolean
+--R sort! : % -> % if $ has shallowlyMutable and R has ORDSET
+--R sort! : (((R,R) -> Boolean),%) -> % if $ has shallowlyMutable
+--R sorted? : % -> Boolean if R has ORDSET
+--R sorted? : (((R,R) -> Boolean),%) -> Boolean
+--R swap! : (%,Integer,Integer) -> Void if $ has shallowlyMutable
+--R zero : NonNegativeInteger -> % if R has ABELMON
+--R ?~=? : (%,%) -> Boolean if R has SETCAT
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{IndexedExponents.help}
+\begin{chunk}{IndexedVector.help}
 ====================================================================
-IndexedExponents examples
+IndexedVector examples
 ====================================================================
 
-IndexedExponents of an ordered set of variables gives a representation
-for the degree of polynomials in commuting variables. It gives an ordered
-pairing of non negative integer exponents with variables
+This type represents vector like objects with varying lengths
+and a user-specified initial index.
 
 See Also:
-o )show IndexedExponents
+o )show IndexedVector
 
 \end{chunk}
 
-\pagehead{IndexedExponents}{INDE}
-\pagepic{ps/v103indexedexponents.ps}{INDE}{1.00}
-{\bf See}\\
-\pageto{Polynomial}{POLY}
-\pageto{MultivariatePolynomial}{MPOLY}
-\pageto{SparseMultivariatePolynomial}{SMP}
+\pagehead{IndexedVector}{IVECTOR}
+\pagepic{ps/v103indexedvector.ps}{IVECTOR}{1.00}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{INDE}{0} &
-\cross{INDE}{coerce} &
-\cross{INDE}{hash} &
-\cross{INDE}{latex} &
-\cross{INDE}{leadingCoefficient} \\
-\cross{INDE}{leadingSupport} &
-\cross{INDE}{map} &
-\cross{INDE}{max} &
-\cross{INDE}{min} &
-\cross{INDE}{monomial} \\
-\cross{INDE}{reductum} &
-\cross{INDE}{sample} &
-\cross{INDE}{subtractIfCan} &
-\cross{INDE}{sup} &
-\cross{INDE}{zero?} \\
-\cross{INDE}{?\~{}=?} &
-\cross{INDE}{?*?} &
-\cross{INDE}{?+?} &
-\cross{INDE}{?$<$?} &
-\cross{INDE}{?$<=$?} \\
-\cross{INDE}{?=?} &
-\cross{INDE}{?$>$?} &
-\cross{INDE}{?$>=$?} &&
+\cross{IVECTOR}{any?} &
+\cross{IVECTOR}{coerce} &
+\cross{IVECTOR}{concat} &
+\cross{IVECTOR}{construct} &
+\cross{IVECTOR}{convert} \\
+\cross{IVECTOR}{copy} &
+\cross{IVECTOR}{copyInto!} &
+\cross{IVECTOR}{count} &
+\cross{IVECTOR}{cross} &
+\cross{IVECTOR}{delete} \\
+\cross{IVECTOR}{dot} &
+\cross{IVECTOR}{elt} &
+\cross{IVECTOR}{empty} &
+\cross{IVECTOR}{empty?} &
+\cross{IVECTOR}{entries} \\
+\cross{IVECTOR}{entry?} &
+\cross{IVECTOR}{eq?} &
+\cross{IVECTOR}{eval} &
+\cross{IVECTOR}{every?} &
+\cross{IVECTOR}{fill!} \\
+\cross{IVECTOR}{find} &
+\cross{IVECTOR}{first} &
+\cross{IVECTOR}{hash} &
+\cross{IVECTOR}{index?} &
+\cross{IVECTOR}{indices} \\
+\cross{IVECTOR}{insert} &
+\cross{IVECTOR}{latex} &
+\cross{IVECTOR}{length} &
+\cross{IVECTOR}{less?} &
+\cross{IVECTOR}{magnitude} \\
+\cross{IVECTOR}{map!} &
+\cross{IVECTOR}{max} &
+\cross{IVECTOR}{maxIndex} &
+\cross{IVECTOR}{member?} &
+\cross{IVECTOR}{members} \\
+\cross{IVECTOR}{merge} &
+\cross{IVECTOR}{min} &
+\cross{IVECTOR}{minIndex} &
+\cross{IVECTOR}{more?} &
+\cross{IVECTOR}{new} \\
+\cross{IVECTOR}{outerProduct} &
+\cross{IVECTOR}{parts} &
+\cross{IVECTOR}{position} &
+\cross{IVECTOR}{qelt} &
+\cross{IVECTOR}{qsetelt!} \\
+\cross{IVECTOR}{reduce} &
+\cross{IVECTOR}{remove} &
+\cross{IVECTOR}{removeDuplicates} &
+\cross{IVECTOR}{reverse} &
+\cross{IVECTOR}{reverse!} \\
+\cross{IVECTOR}{sample} &
+\cross{IVECTOR}{select} &
+\cross{IVECTOR}{setelt} &
+\cross{IVECTOR}{size?} &
+\cross{IVECTOR}{sort} \\
+\cross{IVECTOR}{sort!} &
+\cross{IVECTOR}{sorted?} &
+\cross{IVECTOR}{swap!} &
+\cross{IVECTOR}{zero} &
+\cross{IVECTOR}{\#{}?} \\
+\cross{IVECTOR}{?*?} &
+\cross{IVECTOR}{?+?} &
+\cross{IVECTOR}{?-?} &
+\cross{IVECTOR}{?$<$?} &
+\cross{IVECTOR}{?$<=$?} \\
+\cross{IVECTOR}{?=?} &
+\cross{IVECTOR}{?$>$?} &
+\cross{IVECTOR}{?$>=$?} &
+\cross{IVECTOR}{?\~{}=?} &
+\cross{IVECTOR}{-?} \\
+\cross{IVECTOR}{?.?} &&&&
 \end{tabular}
 
-\begin{chunk}{domain INDE IndexedExponents}
-)abbrev domain INDE IndexedExponents
-++ Author: James Davenport
+\begin{chunk}{domain IVECTOR IndexedVector}
+)abbrev domain IVECTOR IndexedVector
+++ Author: Mark Botch
 ++ Description:
-++ IndexedExponents of an ordered set of variables gives a representation
-++ for the degree of polynomials in commuting variables. It gives an ordered
-++ pairing of non negative integer exponents with variables
-
-IndexedExponents(Varset:OrderedSet): C == T where
-  C == Join(OrderedAbelianMonoidSup,
-            IndexedDirectProductCategory(NonNegativeInteger,Varset))
-  T == IndexedDirectProductOrderedAbelianMonoidSup(NonNegativeInteger,Varset) add
-      Term:=  Record(k:Varset,c:NonNegativeInteger)
-      Rep:=  List Term
-      x:%
-      t:Term
-      coerceOF(t):OutputForm ==     --++ converts term to OutputForm
-         t.c = 1 => (t.k)::OutputForm
-         (t.k)::OutputForm ** (t.c)::OutputForm
-      coerce(x):OutputForm == ++ converts entire exponents to OutputForm
-         null x => 1::Integer::OutputForm
-         null rest x => coerceOF(first x)
-         reduce("*",[coerceOF t for t in x])
-
+++ This type represents vector like objects with varying lengths
+++ and a user-specified initial index.
+ 
+IndexedVector(R:Type, mn:Integer):
+  VectorCategory R == IndexedOneDimensionalArray(R, mn)
+ 
 \end{chunk}
 
-\begin{chunk}{COQ INDE}
-(* domain INDE *)
+\begin{chunk}{COQ IVECTOR}
+(* domain IVECTOR *)
 (*
 *)
 
 \end{chunk}
 
-\begin{chunk}{INDE.dotabb}
-"INDE" [color="#88FF44",href="bookvol10.3.pdf#nameddest=INDE"]
-"FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"]
-"INDE" -> "FLAGG"
+\begin{chunk}{IVECTOR.dotabb}
+"IVECTOR" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IVECTOR"]
+"VECTCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=VECTCAT"]
+"IVECTOR" -> "VECTCAT"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IFARRAY IndexedFlexibleArray}
+\section{domain ITUPLE InfiniteTuple}
 
-\begin{chunk}{IndexedFlexibleArray.input}
+\begin{chunk}{InfiniteTuple.input}
 )set break resume
-)sys rm -f IndexedFlexibleArray.output
-)spool IndexedFlexibleArray.output
+)sys rm -f InfiniteTuple.output
+)spool InfiniteTuple.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show IndexedFlexibleArray
---R 
---R IndexedFlexibleArray(S: Type,mn: Integer)  is a domain constructor
---R Abbreviation for IndexedFlexibleArray is IFARRAY 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IFARRAY 
---R
---R------------------------------- Operations --------------------------------
---R concat : List(%) -> %                 concat : (%,%) -> %
---R concat : (S,%) -> %                   concat : (%,S) -> %
---R concat! : (%,S) -> %                  concat! : (%,%) -> %
---R construct : List(S) -> %              copy : % -> %
---R delete : (%,Integer) -> %             delete! : (%,Integer) -> %
---R ?.? : (%,Integer) -> S                elt : (%,Integer,S) -> S
---R empty : () -> %                       empty? : % -> Boolean
---R entries : % -> List(S)                eq? : (%,%) -> Boolean
---R flexibleArray : List(S) -> %          index? : (Integer,%) -> Boolean
---R indices : % -> List(Integer)          insert : (%,%,Integer) -> %
---R insert : (S,%,Integer) -> %           insert! : (S,%,Integer) -> %
---R insert! : (%,%,Integer) -> %          latex : % -> String if S has SETCAT
---R map : (((S,S) -> S),%,%) -> %         map : ((S -> S),%) -> %
---R max : (%,%) -> % if S has ORDSET      min : (%,%) -> % if S has ORDSET
---R new : (NonNegativeInteger,S) -> %     physicalLength! : (%,Integer) -> %
---R qelt : (%,Integer) -> S               remove! : ((S -> Boolean),%) -> %
---R reverse : % -> %                      sample : () -> %
---R select! : ((S -> Boolean),%) -> %     shrinkable : Boolean -> Boolean
---R sort : % -> % if S has ORDSET         sort : (((S,S) -> Boolean),%) -> %
---R #? : % -> NonNegativeInteger if $ has finiteAggregate
---R ?<? : (%,%) -> Boolean if S has ORDSET
---R ?<=? : (%,%) -> Boolean if S has ORDSET
---R ?=? : (%,%) -> Boolean if S has SETCAT
---R ?>? : (%,%) -> Boolean if S has ORDSET
---R ?>=? : (%,%) -> Boolean if S has ORDSET
---R any? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
---R coerce : % -> OutputForm if S has SETCAT
---R convert : % -> InputForm if S has KONVERT(INFORM)
---R copyInto! : (%,%,Integer) -> % if $ has shallowlyMutable
---R count : (S,%) -> NonNegativeInteger if $ has finiteAggregate and S has SETCAT
---R count : ((S -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R delete : (%,UniversalSegment(Integer)) -> %
---R delete! : (%,UniversalSegment(Integer)) -> %
---R ?.? : (%,UniversalSegment(Integer)) -> %
---R entry? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
---R eval : (%,List(S),List(S)) -> % if S has EVALAB(S) and S has SETCAT
---R eval : (%,S,S) -> % if S has EVALAB(S) and S has SETCAT
---R eval : (%,Equation(S)) -> % if S has EVALAB(S) and S has SETCAT
---R eval : (%,List(Equation(S))) -> % if S has EVALAB(S) and S has SETCAT
---R every? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
---R fill! : (%,S) -> % if $ has shallowlyMutable
---R find : ((S -> Boolean),%) -> Union(S,"failed")
---R first : % -> S if Integer has ORDSET
---R hash : % -> SingleInteger if S has SETCAT
---R less? : (%,NonNegativeInteger) -> Boolean
---R map! : ((S -> S),%) -> % if $ has shallowlyMutable
---R maxIndex : % -> Integer if Integer has ORDSET
---R member? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
---R members : % -> List(S) if $ has finiteAggregate
---R merge : (%,%) -> % if S has ORDSET
---R merge : (((S,S) -> Boolean),%,%) -> %
---R merge! : (((S,S) -> Boolean),%,%) -> %
---R merge! : (%,%) -> % if S has ORDSET
---R minIndex : % -> Integer if Integer has ORDSET
---R more? : (%,NonNegativeInteger) -> Boolean
---R parts : % -> List(S) if $ has finiteAggregate
---R physicalLength : % -> NonNegativeInteger
---R position : (S,%,Integer) -> Integer if S has SETCAT
---R position : (S,%) -> Integer if S has SETCAT
---R position : ((S -> Boolean),%) -> Integer
---R qsetelt! : (%,Integer,S) -> S if $ has shallowlyMutable
---R reduce : (((S,S) -> S),%) -> S if $ has finiteAggregate
---R reduce : (((S,S) -> S),%,S) -> S if $ has finiteAggregate
---R reduce : (((S,S) -> S),%,S,S) -> S if $ has finiteAggregate and S has SETCAT
---R remove : ((S -> Boolean),%) -> % if $ has finiteAggregate
---R remove : (S,%) -> % if $ has finiteAggregate and S has SETCAT
---R remove! : (S,%) -> % if S has SETCAT
---R removeDuplicates : % -> % if $ has finiteAggregate and S has SETCAT
---R removeDuplicates! : % -> % if S has SETCAT
---R reverse! : % -> % if $ has shallowlyMutable
---R select : ((S -> Boolean),%) -> % if $ has finiteAggregate
---R setelt : (%,UniversalSegment(Integer),S) -> S if $ has shallowlyMutable
---R setelt : (%,Integer,S) -> S if $ has shallowlyMutable
---R size? : (%,NonNegativeInteger) -> Boolean
---R sort! : % -> % if $ has shallowlyMutable and S has ORDSET
---R sort! : (((S,S) -> Boolean),%) -> % if $ has shallowlyMutable
---R sorted? : % -> Boolean if S has ORDSET
---R sorted? : (((S,S) -> Boolean),%) -> Boolean
---R swap! : (%,Integer,Integer) -> Void if $ has shallowlyMutable
---R ?~=? : (%,%) -> Boolean if S has SETCAT
+)show InfiniteTuple
+--R 
+--R InfiniteTuple(S: Type)  is a domain constructor
+--R Abbreviation for InfiniteTuple is ITUPLE 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for ITUPLE 
+--R
+--R------------------------------- Operations --------------------------------
+--R coerce : % -> OutputForm              construct : % -> Stream(S)
+--R generate : ((S -> S),S) -> %          map : ((S -> S),%) -> %
+--R select : ((S -> Boolean),%) -> %     
+--R filterUntil : ((S -> Boolean),%) -> %
+--R filterWhile : ((S -> Boolean),%) -> %
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{IndexedFlexibleArray.help}
+\begin{chunk}{InfiniteTuple.help}
 ====================================================================
-IndexedFlexibleArray examples
+InfiniteTuple examples
 ====================================================================
 
-A FlexibleArray is the notion of an array intended to allow for growth
-at the end only.  Hence the following efficient operations
-  append(x,a)  meaning append item x at the end of the array a
-  delete(a,n)} meaning delete the last item from the array a
-
-Flexible arrays support the other operations inherited from
-ExtensibleLinearAggregate. However, these are not efficient.
-
-Flexible arrays combine the O(1) access time property of arrays
-with growing and shrinking at the end in O(1) (average) time.
-This is done by using an ordinary array which may have zero or more
-empty slots at the end.  When the array becomes full it is copied
-into a new larger (50% larger) array.  Conversely, when the array
-becomes less than 1/2 full, it is copied into a smaller array.
-Flexible arrays provide for an efficient implementation of many
-data structures in particular heaps, stacks and sets.
+This package implements 'infinite tuples' for the interpreter.
+The representation is a stream.
 
 See Also:
-o )show IndexedFlexibleArray
+o )show InfiniteTuple
 
 \end{chunk}
 
-\pagehead{IndexedFlexibleArray}{IFARRAY}
-\pagepic{ps/v103indexedflexiblearray.ps}{IFARRAY}{1.00}
-{\bf See}\\
-\pageto{PrimitiveArray}{PRIMARR}
-\pageto{Tuple}{TUPLE}
-\pageto{FlexibleArray}{FARRAY}
-\pageto{IndexedOneDimensionalArray}{IARRAY1}
-\pageto{OneDimensionalArray}{ARRAY1}
+\pagehead{InfiniteTuple}{ITUPLE}
+\pagepic{ps/v103infinitetuple.ps}{ITUPLE}{1.00}
 
 {\bf Exports:}\\
-\begin{tabular}{llll}
-\cross{IFARRAY}{concat} &
-\cross{IFARRAY}{concat!} &
-\cross{IFARRAY}{construct} &
-\cross{IFARRAY}{copy} \\
-\cross{IFARRAY}{delete} &
-\cross{IFARRAY}{delete!} &
-\cross{IFARRAY}{elt} &
-\cross{IFARRAY}{empty} \\
-\cross{IFARRAY}{empty?} &
-\cross{IFARRAY}{entries} &
-\cross{IFARRAY}{eq?} &
-\cross{IFARRAY}{flexibleArray} \\
-\cross{IFARRAY}{index?} &
-\cross{IFARRAY}{indices} &
-\cross{IFARRAY}{insert} &
-\cross{IFARRAY}{insert!} \\
-\cross{IFARRAY}{map} &
-\cross{IFARRAY}{new} &
-\cross{IFARRAY}{qelt} &
-\cross{IFARRAY}{reverse} \\
-\cross{IFARRAY}{sample} &
-\cross{IFARRAY}{shrinkable} &
-\cross{IFARRAY}{ any?} &
-\cross{IFARRAY}{coerce} \\
-\cross{IFARRAY}{convert} &
-\cross{IFARRAY}{copyInto!} &
-\cross{IFARRAY}{count} &
-\cross{IFARRAY}{delete} \\
-\cross{IFARRAY}{delete!} &
-\cross{IFARRAY}{entry?} &
-\cross{IFARRAY}{eval} &
-\cross{IFARRAY}{every?} \\
-\cross{IFARRAY}{fill!} &
-\cross{IFARRAY}{find} &
-\cross{IFARRAY}{first} &
-\cross{IFARRAY}{hash} \\
-\cross{IFARRAY}{latex} &
-\cross{IFARRAY}{less?} &
-\cross{IFARRAY}{map!} &
-\cross{IFARRAY}{max} \\
-\cross{IFARRAY}{maxIndex} &
-\cross{IFARRAY}{member?} &
-\cross{IFARRAY}{members} &
-\cross{IFARRAY}{merge} \\
-\cross{IFARRAY}{merge!} &
-\cross{IFARRAY}{min} &
-\cross{IFARRAY}{minIndex} &
-\cross{IFARRAY}{more?} \\
-\cross{IFARRAY}{parts} &
-\cross{IFARRAY}{physicalLength} &
-\cross{IFARRAY}{physicalLength!} &
-\cross{IFARRAY}{position} \\
-\cross{IFARRAY}{qsetelt!} &
-\cross{IFARRAY}{reduce} &
-\cross{IFARRAY}{remove} &
-\cross{IFARRAY}{remove!} \\
-\cross{IFARRAY}{removeDuplicates} &
-\cross{IFARRAY}{removeDuplicates!} &
-\cross{IFARRAY}{reverse!} &
-\cross{IFARRAY}{select} \\
-\cross{IFARRAY}{select!} &
-\cross{IFARRAY}{setelt} &
-\cross{IFARRAY}{size?} &
-\cross{IFARRAY}{sort} \\
-\cross{IFARRAY}{sort!} &
-\cross{IFARRAY}{sorted?} &
-\cross{IFARRAY}{swap!} &
-\cross{IFARRAY}{\#{}?} \\
-\cross{IFARRAY}{?$<$?} &
-\cross{IFARRAY}{?$<=$?} &
-\cross{IFARRAY}{?=?} &
-\cross{IFARRAY}{?$>$?} \\
-\cross{IFARRAY}{?$>=$?} &
-\cross{IFARRAY}{?\~{}=?} &
-\cross{IFARRAY}{?.?} &
+\begin{tabular}{lllllll}
+\cross{ITUPLE}{coerce} &
+\cross{ITUPLE}{construct} &
+\cross{ITUPLE}{filterUntil} &
+\cross{ITUPLE}{filterWhile} &
+\cross{ITUPLE}{generate} &
+\cross{ITUPLE}{map} &
+\cross{ITUPLE}{select} 
 \end{tabular}
 
-\begin{chunk}{domain IFARRAY IndexedFlexibleArray}
-)abbrev domain IFARRAY IndexedFlexibleArray
-++ Author: Michael Monagan July/87, modified SMW June/91
+\begin{chunk}{domain ITUPLE InfiniteTuple}
+)abbrev domain ITUPLE InfiniteTuple
+++ Author: Clifton J. Williamson
+++ Date Created: 16 February 1990
+++ Date Last Updated: 16 February 1990
 ++ Description:
-++ A FlexibleArray is the notion of an array intended to allow for growth
-++ at the end only.  Hence the following efficient operations\br
-++ \spad{append(x,a)} meaning append item x at the end of the array \spad{a}\br
-++ \spad{delete(a,n)} meaning delete the last item from the array \spad{a}\br
-++ Flexible arrays support the other operations inherited from
-++ \spadtype{ExtensibleLinearAggregate}. However, these are not efficient.
-++ Flexible arrays combine the \spad{O(1)} access time property of arrays
-++ with growing and shrinking at the end in \spad{O(1)} (average) time.
-++ This is done by using an ordinary array which may have zero or more
-++ empty slots at the end.  When the array becomes full it is copied
-++ into a new larger (50% larger) array.  Conversely, when the array
-++ becomes less than 1/2 full, it is copied into a smaller array.
-++ Flexible arrays provide for an efficient implementation of many
-++ data structures in particular heaps, stacks and sets.
-
-IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where
-  A ==> PrimitiveArray S
-  I ==> Integer
-  N ==> NonNegativeInteger
-  U ==> UniversalSegment Integer
-  Exports ==
-   Join(OneDimensionalArrayAggregate S,ExtensibleLinearAggregate S) with
-    flexibleArray : List S -> %
-     ++ flexibleArray(l) creates a flexible array from the list of elements l
-     ++
-     ++X T1:=IndexedFlexibleArray(Integer,20)
-     ++X flexibleArray([i for i in 1..10])$T1
-
-    physicalLength : % -> NonNegativeInteger
-     ++ physicalLength(x) returns the number of elements x can 
-     ++ accomodate before growing
-     ++
-     ++X T1:=IndexedFlexibleArray(Integer,20)
-     ++X t2:=flexibleArray([i for i in 1..10])$T1
-     ++X physicalLength t2
-
-    physicalLength_!: (%, I) -> %
-     ++ physicalLength!(x,n) changes the physical length of x to be n and
-     ++ returns the new array.
-     ++
-     ++X T1:=IndexedFlexibleArray(Integer,20)
-     ++X t2:=flexibleArray([i for i in 1..10])$T1
-     ++X physicalLength!(t2,15)
-
-    shrinkable: Boolean -> Boolean
-     ++ shrinkable(b) sets the shrinkable attribute of flexible arrays to b
-     ++ and returns the previous value
-     ++
-     ++X T1:=IndexedFlexibleArray(Integer,20)
-     ++X shrinkable(false)$T1
-
-  Implementation == add
-    Rep := Record(physLen:I, logLen:I, f:A)
-    shrinkable? : Boolean := true
-    growAndFill : (%, I, S) -> %
-    growWith    : (%, I, S) -> %
-    growAdding  : (%, I, %) -> %
-    shrink: (%, I)    -> %
-    newa  : (N, A) -> A
-
-    physicalLength(r) == (r.physLen) pretend NonNegativeInteger
-    physicalLength_!(r, n) ==
-       r.physLen = 0  => error "flexible array must be non-empty"
-       growWith(r, n, r.f.0)
-
-    empty()      == [0, 0, empty()]
-    #r           == (r.logLen)::N
-    fill_!(r, x) == (fill_!(r.f, x); r)
-    maxIndex r   == r.logLen - 1 + mn
-    minIndex r   == mn
-    new(n, a)    == [n, n, new(n, a)]
-
-    shrinkable(b) ==
-      oldval := shrinkable?
-      shrinkable? := b
-      oldval
-
-    flexibleArray l ==
-       n := #l
-       n = 0 => empty()
-       x := l.1
-       a := new(n,x)
-       for i in mn + 1..mn + n-1 for y in rest l repeat a.i := y
-       a
-
-    -- local utility operations
-    newa(n, a) ==
-       zero? n => empty()
-       new(n, a.0)
-
-    growAdding(r, b, s) ==
-       b = 0 => r
-       #r > 0 => growAndFill(r, b, (r.f).0)
-       #s > 0 => growAndFill(r, b, (s.f).0)
-       error "no default filler element"
-
-    growAndFill(r, b, x) ==
-       (r.logLen := r.logLen + b) <= r.physLen => r
-       -- enlarge by 50% + b
-       n := r.physLen + r.physLen quo 2 + 1
-       if r.logLen > n then n := r.logLen
-       growWith(r, n, x)
-
-    growWith(r, n, x) ==
-       y := new(n::N, x)$PrimitiveArray(S)
-       a := r.f
-       for k in 0 .. r.physLen-1 repeat y.k := a.k
-       r.physLen := n
-       r.f := y
-       r
-
-    shrink(r, i) ==
-       r.logLen := r.logLen - i
-       negative?(n := r.logLen) => error "internal bug in flexible array"
-       2*n+2 > r.physLen => r
-       not shrinkable? => r
-       if n < r.logLen 
-         then error "cannot shrink flexible array to indicated size"
-       n = 0 => empty()
-       r.physLen := n
-       y := newa(n::N, a := r.f)
-       for k in 0 .. n-1 repeat y.k := a.k
-       r.f := y
-       r
-
-    copy r ==
-       n := #r
-       a := r.f
-       v := newa(n, a := r.f)
-       for k in 0..n-1 repeat v.k := a.k
-       [n, n, v]
-
+++ This package implements 'infinite tuples' for the interpreter.
+++ The representation is a stream.
 
-    elt(r:%, i:I) ==
-       i < mn or i >= r.logLen + mn =>
-           error "index out of range"
-       r.f.(i-mn)
+InfiniteTuple(S:Type): Exports == Implementation where
 
-    setelt(r:%, i:I, x:S) ==
-       i < mn or i >= r.logLen + mn =>
-           error "index out of range"
-       r.f.(i-mn) := x
+  Exports ==> CoercibleTo OutputForm with
+    map: (S -> S, %) -> %
+      ++ map(f,t) replaces the tuple t
+      ++ by \spad{[f(x) for x in t]}.
+    filterWhile: (S -> Boolean, %) -> %
+      ++ filterWhile(p,t) returns \spad{[x for x in t while p(x)]}.
+    filterUntil: (S -> Boolean, %) -> %
+      ++ filterUntil(p,t) returns \spad{[x for x in t while not p(x)]}.
+    select: (S -> Boolean, %) -> %
+      ++ select(p,t) returns \spad{[x for x in t | p(x)]}.
+    generate: (S -> S,S) -> %
+      ++ generate(f,s) returns \spad{[s,f(s),f(f(s)),...]}.
+    construct: % -> Stream S
+      ++ construct(t) converts an infinite tuple to a stream.
 
-    -- operations inherited from extensible aggregate
-    merge(g, a, b)   == merge_!(g, copy a, b)
-    concat(x:S, r:%) == insert_!(x, r, mn)
+  Implementation ==> Stream S add
 
-    concat_!(r:%, x:S) ==
-       growAndFill(r, 1, x)
-       r.f.(r.logLen-1) := x
-       r
+    generate(f,x) == generate(f,x)$Stream(S) pretend %
 
-    concat_!(a:%, b:%) ==
-       if eq?(a, b) then b := copy b
-       n := #a
-       growAdding(a, #b, b)
-       copyInto_!(a, b, n + mn)
+    filterWhile(f, x) == filterWhile(f,x pretend Stream(S))$Stream(S) pretend %
 
-    remove_!(g:(S->Boolean), a:%) ==
-       k:I := 0
-       for i in 0..maxIndex a - mn repeat
-          if not g(a.i) then (a.k := a.i; k := k+1)
-       shrink(a, #a - k)
+    filterUntil(f, x) == filterUntil(f,x pretend Stream(S))$Stream(S) pretend %
 
-    delete_!(r:%, i1:I) ==
-       i := i1 - mn
-       i < 0 or i > r.logLen => error "index out of range"
-       for k in i..r.logLen-2 repeat r.f.k := r.f.(k+1)
-       shrink(r, 1)
+    select(f, x) == select(f,x pretend Stream(S))$Stream(S) pretend %
 
-    delete_!(r:%, i:U) ==
-       l := lo i - mn; m := maxIndex r - mn
-       h := (hasHi i => hi i - mn; m)
-       l < 0 or h > m => error "index out of range"
-       for j in l.. for k in h+1..m repeat r.f.j := r.f.k
-       shrink(r, max(0,h-l+1))
+    construct x == x pretend Stream(S)
 
-    insert_!(x:S, r:%, i1:I):% ==
-       i := i1 - mn
-       n := r.logLen
-       i < 0 or i > n => error "index out of range"
-       growAndFill(r, 1, x)
-       for k in n-1 .. i by -1 repeat r.f.(k+1) := r.f.k
-       r.f.i := x
-       r
+\end{chunk}
 
-    insert_!(a:%, b:%, i1:I):% ==
-       i := i1 - mn
-       if eq?(a, b) then b := copy b
-       m := #a; n := #b
-       i < 0 or i > n => error "index out of range"
-       growAdding(b, m, a)
-       for k in n-1 .. i by -1 repeat b.f.(m+k) := b.f.k
-       for k in m-1 .. 0 by -1 repeat b.f.(i+k) := a.f.k
-       b
+\begin{chunk}{COQ ITUPLE}
+(* domain ITUPLE *)
+(*
+ Stream S add
 
-    merge_!(g, a, b) ==
-       m := #a; n := #b; growAdding(a, n, b)
-       for i in m-1..0 by -1 for j in m+n-1.. by -1 repeat a.f.j := a.f.i
-       i := n; j := 0
-       for k in 0.. while i < n+m and j < n repeat
-          if g(a.f.i,b.f.j) then (a.f.k := a.f.i; i := i+1)
-          else (a.f.k := b.f.j; j := j+1)
-       for k in k.. for j in j..n-1 repeat a.f.k := b.f.j
-       a
+    generate(f,x) == generate(f,x)$Stream(S) pretend %
 
-    select_!(g:(S->Boolean), a:%) ==
-       k:I := 0
-       for i in 0..maxIndex a - mn repeat_
-          if g(a.f.i) then (a.f.k := a.f.i;k := k+1)
-       shrink(a, #a - k)
+    filterWhile(f, x) == filterWhile(f,x pretend Stream(S))$Stream(S) pretend %
 
-    if S has SetCategory then
-      removeDuplicates_! a ==
-         ct := #a
-         ct < 2 => a
+    filterUntil(f, x) == filterUntil(f,x pretend Stream(S))$Stream(S) pretend %
 
-         i     := mn
-         nlim  := mn + ct
-         nlim0 := nlim
-         while i < nlim repeat
-            j := i+1
-            for k in j..nlim-1 | a.k ^= a.i repeat
-                a.j := a.k
-                j := j+1
-            nlim := j
-            i := i+1
-         nlim ^= nlim0 => delete_!(a, i..)
-         a
+    select(f, x) == select(f,x pretend Stream(S))$Stream(S) pretend %
 
-\end{chunk}
+    construct x == x pretend Stream(S)
 
-\begin{chunk}{COQ IFARRAY}
-(* domain IFARRAY *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{IFARRAY.dotabb}
-"IFARRAY" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IFARRAY"]
-"A1AGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=A1AGG"]
-"IFARRAY" -> "A1AGG"
+\begin{chunk}{ITUPLE.dotabb}
+"ITUPLE" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ITUPLE"]
+"TYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=TYPE"]
+"ITUPLE" -> "TYPE"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain ILIST IndexedList}
+\section{domain INFCLSPT InfinitlyClosePoint} 
 
-\begin{chunk}{IndexedList.input}
+\begin{chunk}{InfinitlyClosePoint.input}
 )set break resume
-)sys rm -f IndexedList.output
-)spool IndexedList.output
+)sys rm -f InfinitlyClosePoint.output
+)spool InfinitlyClosePoint.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show IndexedList
+)show InfinitlyClosePoint
 --R 
---R IndexedList(S: Type,mn: Integer)  is a domain constructor
---R Abbreviation for IndexedList is ILIST 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for ILIST 
+--R InfinitlyClosePoint(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)  is a domain constructor
+--R Abbreviation for InfinitlyClosePoint is INFCLSPT 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for INFCLSPT 
 --R
 --R------------------------------- Operations --------------------------------
---R children : % -> List(%)               concat : (%,S) -> %
---R concat : List(%) -> %                 concat : (S,%) -> %
---R concat : (%,%) -> %                   concat! : (%,S) -> %
---R concat! : (%,%) -> %                  construct : List(S) -> %
---R copy : % -> %                         cycleEntry : % -> %
---R cycleTail : % -> %                    cyclic? : % -> Boolean
---R delete : (%,Integer) -> %             delete! : (%,Integer) -> %
---R distance : (%,%) -> Integer           elt : (%,Integer,S) -> S
---R ?.? : (%,Integer) -> S                ?.last : (%,last) -> S
---R ?.rest : (%,rest) -> %                ?.first : (%,first) -> S
---R ?.value : (%,value) -> S              empty : () -> %
---R empty? : % -> Boolean                 entries : % -> List(S)
---R eq? : (%,%) -> Boolean                explicitlyFinite? : % -> Boolean
---R first : % -> S                        index? : (Integer,%) -> Boolean
---R indices : % -> List(Integer)          insert : (S,%,Integer) -> %
---R insert : (%,%,Integer) -> %           insert! : (S,%,Integer) -> %
---R insert! : (%,%,Integer) -> %          last : (%,NonNegativeInteger) -> %
---R last : % -> S                         latex : % -> String if S has SETCAT
---R leaf? : % -> Boolean                  leaves : % -> List(S)
---R list : S -> %                         map : (((S,S) -> S),%,%) -> %
---R map : ((S -> S),%) -> %               max : (%,%) -> % if S has ORDSET
---R min : (%,%) -> % if S has ORDSET      new : (NonNegativeInteger,S) -> %
---R nodes : % -> List(%)                  possiblyInfinite? : % -> Boolean
---R qelt : (%,Integer) -> S               remove! : ((S -> Boolean),%) -> %
---R rest : (%,NonNegativeInteger) -> %    rest : % -> %
---R reverse : % -> %                      sample : () -> %
---R second : % -> S                       select! : ((S -> Boolean),%) -> %
---R sort : (((S,S) -> Boolean),%) -> %    sort : % -> % if S has ORDSET
---R tail : % -> %                         third : % -> S
---R value : % -> S                       
---R #? : % -> NonNegativeInteger if $ has finiteAggregate
---R ?<? : (%,%) -> Boolean if S has ORDSET
---R ?<=? : (%,%) -> Boolean if S has ORDSET
---R ?=? : (%,%) -> Boolean if S has SETCAT
---R ?>? : (%,%) -> Boolean if S has ORDSET
---R ?>=? : (%,%) -> Boolean if S has ORDSET
---R any? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
---R child? : (%,%) -> Boolean if S has SETCAT
---R coerce : % -> OutputForm if S has SETCAT
---R convert : % -> InputForm if S has KONVERT(INFORM)
---R copyInto! : (%,%,Integer) -> % if $ has shallowlyMutable
---R count : (S,%) -> NonNegativeInteger if $ has finiteAggregate and S has SETCAT
---R count : ((S -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R cycleLength : % -> NonNegativeInteger
---R cycleSplit! : % -> % if $ has shallowlyMutable
---R delete : (%,UniversalSegment(Integer)) -> %
---R delete! : (%,UniversalSegment(Integer)) -> %
---R ?.? : (%,UniversalSegment(Integer)) -> %
---R entry? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
---R eval : (%,List(S),List(S)) -> % if S has EVALAB(S) and S has SETCAT
---R eval : (%,S,S) -> % if S has EVALAB(S) and S has SETCAT
---R eval : (%,Equation(S)) -> % if S has EVALAB(S) and S has SETCAT
---R eval : (%,List(Equation(S))) -> % if S has EVALAB(S) and S has SETCAT
---R every? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
---R fill! : (%,S) -> % if $ has shallowlyMutable
---R find : ((S -> Boolean),%) -> Union(S,"failed")
---R first : (%,NonNegativeInteger) -> %
---R hash : % -> SingleInteger if S has SETCAT
---R less? : (%,NonNegativeInteger) -> Boolean
---R map! : ((S -> S),%) -> % if $ has shallowlyMutable
---R maxIndex : % -> Integer if Integer has ORDSET
---R member? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
---R members : % -> List(S) if $ has finiteAggregate
---R merge : (((S,S) -> Boolean),%,%) -> %
---R merge : (%,%) -> % if S has ORDSET
---R merge! : (((S,S) -> Boolean),%,%) -> %
---R merge! : (%,%) -> % if S has ORDSET
---R minIndex : % -> Integer if Integer has ORDSET
---R more? : (%,NonNegativeInteger) -> Boolean
---R node? : (%,%) -> Boolean if S has SETCAT
---R parts : % -> List(S) if $ has finiteAggregate
---R position : ((S -> Boolean),%) -> Integer
---R position : (S,%) -> Integer if S has SETCAT
---R position : (S,%,Integer) -> Integer if S has SETCAT
---R qsetelt! : (%,Integer,S) -> S if $ has shallowlyMutable
---R reduce : (((S,S) -> S),%,S,S) -> S if $ has finiteAggregate and S has SETCAT
---R reduce : (((S,S) -> S),%,S) -> S if $ has finiteAggregate
---R reduce : (((S,S) -> S),%) -> S if $ has finiteAggregate
---R remove : (S,%) -> % if $ has finiteAggregate and S has SETCAT
---R remove : ((S -> Boolean),%) -> % if $ has finiteAggregate
---R remove! : (S,%) -> % if S has SETCAT
---R removeDuplicates : % -> % if $ has finiteAggregate and S has SETCAT
---R removeDuplicates! : % -> % if S has SETCAT
---R reverse! : % -> % if $ has shallowlyMutable
---R select : ((S -> Boolean),%) -> % if $ has finiteAggregate
---R setchildren! : (%,List(%)) -> % if $ has shallowlyMutable
---R setelt : (%,Integer,S) -> S if $ has shallowlyMutable
---R setelt : (%,UniversalSegment(Integer),S) -> S if $ has shallowlyMutable
---R setelt : (%,last,S) -> S if $ has shallowlyMutable
---R setelt : (%,rest,%) -> % if $ has shallowlyMutable
---R setelt : (%,first,S) -> S if $ has shallowlyMutable
---R setelt : (%,value,S) -> S if $ has shallowlyMutable
---R setfirst! : (%,S) -> S if $ has shallowlyMutable
---R setlast! : (%,S) -> S if $ has shallowlyMutable
---R setrest! : (%,%) -> % if $ has shallowlyMutable
---R setvalue! : (%,S) -> S if $ has shallowlyMutable
---R size? : (%,NonNegativeInteger) -> Boolean
---R sort! : (((S,S) -> Boolean),%) -> % if $ has shallowlyMutable
---R sort! : % -> % if $ has shallowlyMutable and S has ORDSET
---R sorted? : (((S,S) -> Boolean),%) -> Boolean
---R sorted? : % -> Boolean if S has ORDSET
---R split! : (%,Integer) -> % if $ has shallowlyMutable
---R swap! : (%,Integer,Integer) -> Void if $ has shallowlyMutable
---R ?~=? : (%,%) -> Boolean if S has SETCAT
+--R ?=? : (%,%) -> Boolean                actualExtensionV : % -> K
+--R chartV : % -> BLMET                   coerce : % -> OutputForm
+--R create : (ProjPt,PolyRing) -> %       degree : % -> PositiveInteger
+--R excpDivV : % -> DIVISOR               fullOut : % -> OutputForm
+--R fullOutput : () -> Boolean            fullOutput : Boolean -> Boolean
+--R hash : % -> SingleInteger             latex : % -> String
+--R localParamV : % -> List(PCS)          localPointV : % -> AffinePlane(K)
+--R multV : % -> NonNegativeInteger       pointV : % -> ProjPt
+--R setchart! : (%,BLMET) -> BLMET        setpoint! : (%,ProjPt) -> ProjPt
+--R setsymbName! : (%,Symbol) -> Symbol   subMultV : % -> NonNegativeInteger
+--R symbNameV : % -> Symbol               ?~=? : (%,%) -> Boolean
+--R create : (ProjPt,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K),AffinePlane(K),NonNegativeInteger,BLMET,NonNegativeInteger,DIVISOR,K,Symbol) -> %
+--R curveV : % -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
+--R setcurve! : (%,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)) -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
+--R setexcpDiv! : (%,DIVISOR) -> DIVISOR
+--R setlocalParam! : (%,List(PCS)) -> List(PCS)
+--R setlocalPoint! : (%,AffinePlane(K)) -> AffinePlane(K)
+--R setmult! : (%,NonNegativeInteger) -> NonNegativeInteger
+--R setsubmult! : (%,NonNegativeInteger) -> NonNegativeInteger
 --R
 --E 1
 
 )spool
 )lisp (bye)
+
 \end{chunk}
-\begin{chunk}{IndexedList.help}
+\begin{chunk}{InfinitlyClosePoint.help}
 ====================================================================
-IndexedList examples
+InfinitlyClosePoint examples
 ====================================================================
 
-IndexedList is a basic implementation of the functions in
-ListAggregate, often using functions in the underlying LISP
-system. The second parameter to the constructor (mn) is the beginning
-index of the list. That is, if l is a list, then elt(l,mn) is the
-first value. This constructor is probably best viewed as the
-implementation of singly-linked lists that are addressable by index
-rather than as a mere wrapper for LISP lists.
+This domain is part of the PAFF package
 
 See Also:
-o )show IndexedList
+o )show InfinitlyClosePoint
 
 \end{chunk}
-
-\pagehead{IndexedList}{ILIST}
-\pagepic{ps/v103indexedlist.ps}{ILIST}{1.00}
-{\bf See}\\
-\pageto{List}{LIST}
-\pageto{AssociationList}{ALIST}
+\pagehead{InfinitlyClosePoint}{INFCLSPT}
+\pagepic{ps/v103infinitlyclosepoint.eps}{INFCLSPT}{1.00}
 
 {\bf Exports:}\\
-\begin{tabular}{llll}
-\cross{ILIST}{any?} &
-\cross{ILIST}{child?} &
-\cross{ILIST}{children} &
-\cross{ILIST}{coerce} \\
-\cross{ILIST}{concat} &
-\cross{ILIST}{convert} &
-\cross{ILIST}{concat!} &
-\cross{ILIST}{copyInto!} \\
-\cross{ILIST}{construct} &
-\cross{ILIST}{copy} &
-\cross{ILIST}{count} &
-\cross{ILIST}{cycleEntry} \\
-\cross{ILIST}{cycleLength} &
-\cross{ILIST}{cycleSplit!} &
-\cross{ILIST}{cycleTail} &
-\cross{ILIST}{cyclic?} \\
-\cross{ILIST}{delete} &
-\cross{ILIST}{delete!} &
-\cross{ILIST}{distance} &
-\cross{ILIST}{elt} \\
-\cross{ILIST}{empty} &
-\cross{ILIST}{empty?} &
-\cross{ILIST}{entries} &
-\cross{ILIST}{entry?} \\
-\cross{ILIST}{eq?} &
-\cross{ILIST}{eval} &
-\cross{ILIST}{every?} &
-\cross{ILIST}{explicitlyFinite?} \\
-\cross{ILIST}{fill!} &
-\cross{ILIST}{find} &
-\cross{ILIST}{first} &
-\cross{ILIST}{hash} \\
-\cross{ILIST}{index?} &
-\cross{ILIST}{indices} &
-\cross{ILIST}{insert} &
-\cross{ILIST}{insert!} \\
-\cross{ILIST}{last} &
-\cross{ILIST}{latex} &
-\cross{ILIST}{leaf?} &
-\cross{ILIST}{leaves} \\
-\cross{ILIST}{less?} &
-\cross{ILIST}{list} &
-\cross{ILIST}{map} &
-\cross{ILIST}{map!} \\
-\cross{ILIST}{max} &
-\cross{ILIST}{maxIndex} &
-\cross{ILIST}{member?} &
-\cross{ILIST}{members} \\
-\cross{ILIST}{merge} &
-\cross{ILIST}{merge!} &
-\cross{ILIST}{min} &
-\cross{ILIST}{minIndex} \\
-\cross{ILIST}{more?} &
-\cross{ILIST}{new} &
-\cross{ILIST}{node?} &
-\cross{ILIST}{nodes} \\
-\cross{ILIST}{parts} &
-\cross{ILIST}{position} &
-\cross{ILIST}{possiblyInfinite?} &
-\cross{ILIST}{qelt} \\
-\cross{ILIST}{qsetelt!} &
-\cross{ILIST}{reduce} &
-\cross{ILIST}{remove} &
-\cross{ILIST}{remove!} \\
-\cross{ILIST}{removeDuplicates} &
-\cross{ILIST}{removeDuplicates!} &
-\cross{ILIST}{rest} &
-\cross{ILIST}{reverse} \\
-\cross{ILIST}{reverse!} &
-\cross{ILIST}{sample} &
-\cross{ILIST}{second} &
-\cross{ILIST}{select} \\
-\cross{ILIST}{select!} &
-\cross{ILIST}{setchildren!} &
-\cross{ILIST}{setelt} &
-\cross{ILIST}{setfirst!} \\
-\cross{ILIST}{setlast!} &
-\cross{ILIST}{setrest!} &
-\cross{ILIST}{setvalue!} &
-\cross{ILIST}{size?} \\
-\cross{ILIST}{sort} &
-\cross{ILIST}{sort!} &
-\cross{ILIST}{sorted?} &
-\cross{ILIST}{split!} \\
-\cross{ILIST}{swap!} &
-\cross{ILIST}{tail} &
-\cross{ILIST}{third} &
-\cross{ILIST}{value} \\
-\cross{ILIST}{\#{}?} &
-\cross{ILIST}{?$<$?} &
-\cross{ILIST}{?$<=$?} &
-\cross{ILIST}{?=?} \\
-\cross{ILIST}{?$>$?} &
-\cross{ILIST}{?$>=$?} &
-\cross{ILIST}{?\~{}=?} &
-\cross{ILIST}{?.?} \\
-\cross{ILIST}{?.last} &
-\cross{ILIST}{?.rest} &
-\cross{ILIST}{?.first} &
-\cross{ILIST}{?.value} 
+\begin{tabular}{lll}
+\cross{INFCLSPT}{?=?} &
+\cross{INFCLSPT}{?\~{}=?} &
+\cross{INFCLSPT}{actualExtensionV} \\
+\cross{INFCLSPT}{chartV} &
+\cross{INFCLSPT}{coerce} &
+\cross{INFCLSPT}{create} \\
+\cross{INFCLSPT}{curveV} &
+\cross{INFCLSPT}{degree} &
+\cross{INFCLSPT}{excpDivV} \\
+\cross{INFCLSPT}{fullOut} &
+\cross{INFCLSPT}{fullOutput} &
+\cross{INFCLSPT}{fullOutput} \\
+\cross{INFCLSPT}{hash} &
+\cross{INFCLSPT}{latex} &
+\cross{INFCLSPT}{localParamV} \\
+\cross{INFCLSPT}{localPointV} &
+\cross{INFCLSPT}{multV} &
+\cross{INFCLSPT}{pointV} \\
+\cross{INFCLSPT}{setchart!} &
+\cross{INFCLSPT}{setcurve!} &
+\cross{INFCLSPT}{setexcpDiv!} \\
+\cross{INFCLSPT}{setlocalParam!} &
+\cross{INFCLSPT}{setlocalPoint!} &
+\cross{INFCLSPT}{setmult!} \\
+\cross{INFCLSPT}{setpoint!} &
+\cross{INFCLSPT}{setsubmult!} &
+\cross{INFCLSPT}{setsymbName!} \\
+\cross{INFCLSPT}{subMultV} &
+\cross{INFCLSPT}{symbNameV} &
 \end{tabular}
 
-\begin{chunk}{domain ILIST IndexedList}
-)abbrev domain ILIST IndexedList
-++ Author: Michael Monagan
-++ Date Created: Sep 1987
-++ Description:
-++ \spadtype{IndexedList} is a basic implementation of the functions
-++ in \spadtype{ListAggregate}, often using functions in the underlying
-++ LISP system. The second parameter to the constructor (\spad{mn})
-++ is the beginning index of the list. That is, if \spad{l} is a
-++ list, then \spad{elt(l,mn)} is the first value. This constructor
-++ is probably best viewed as the implementation of singly-linked
-++ lists that are addressable by index rather than as a mere wrapper
-++ for LISP lists.
+\begin{chunk}{domain INFCLSPT InfinitlyClosePoint}
+)abbrev domain INFCLSPT InfinitlyClosePoint
+++ Authors: Gaetan Hache
+++ Date Created: june 1996 
+++ Date Last Updated: May 2010 by Tim Daly
+++ Description: 
+++ This domain is part of the PAFF package
+InfinitlyClosePoint(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR,BLMET):Exports == Implementation where
+  K:Field
+  symb: List Symbol
+  E:DirectProductCategory(#symb,NonNegativeInteger)
+  OV ==> OrderedVariableList(symb)
+  PolyRing:  PolynomialCategory(K,E,OV)
 
-IndexedList(S:Type, mn:Integer): Exports == Implementation where
- cycleMax ==> 1000        -- value used in checking for cycles
+  bls      ==> ['X,'Y]
+  BlUpRing ==> DistributedMultivariatePolynomial(bls , K)
+  E2       ==> DirectProduct( #bls , NonNegativeInteger )
+  outRec   ==> Record(name:Symbol,mult:NonNegativeInteger)
+  AFP      ==> AffinePlane(K)
+  OV2      ==> OrderedVariableList( bls )
 
--- The following seems to be a bit out of date, but is kept in case
--- a knowledgeable person wants to update it:
---   The following LISP dependencies are divided into two groups
---   Those that are required
---   CONS, EQ, NIL, NULL, QCAR, QCDR, RPLACA, RPLACD
---   Those that are included for efficiency only
---   NEQ, LIST, CAR, CDR, NCONC2, NREVERSE, LENGTH
---   Also REVERSE, since it's called in Polynomial Ring
+  PCS: LocalPowerSeriesCategory(K)
+  ProjPt:ProjectiveSpaceCategory(K)
+  Plc: PlacesCategory(K,PCS)
+  DIVISOR: DivisorCategory(Plc)
+  BLMET : BlowUpMethodCategory
+  
+  bigoutRecBLQT ==> Record(dominate:ProjPt,_
+                       name:Symbol,_
+                       mult:NonNegativeInteger,_
+                       defCurve:BlUpRing,_
+                       localPoint:AFP,_
+                       chart:BLMET,_ 
+                       expD:DIVISOR) 
 
- Qfirst  ==> QCAR$Lisp
- Qrest   ==> QCDR$Lisp
- Qnull   ==> NULL$Lisp
- Qeq     ==> EQ$Lisp
- Qneq    ==> NEQ$Lisp
- Qcons   ==> CONS$Lisp
- Qpush   ==> PUSH$Lisp
- 
- Exports ==> ListAggregate S 
- Implementation ==>
-  add
+  bigoutRecHN  ==> Record(dominate:ProjPt,_
+                       name:Symbol,_
+                       mult:NonNegativeInteger,_
+                       defCurve:BlUpRing,_
+                       localPoint:AFP,_
+                       chart:BLMET,_ 
+                       subMultip: NonNegativeInteger,_
+                       expD:DIVISOR) 
 
-   #x                  == LENGTH(x)$Lisp
 
-   concat(s:S,x:%)     == CONS(s,x)$Lisp
+  representation   ==>  Record(point:ProjPt,_
+                               curve:BlUpRing,_
+                               localPoint:AFP,_
+                               mult:NonNegativeInteger,_
+                               chrt:BLMET,_
+                               subMultiplicity:NonNegativeInteger,_
+                               excpDiv:DIVISOR,_
+                               localParam:List(PCS),_
+                               actualExtension:K,_
+                               symbName:Symbol)
 
-   eq?(x,y)            == EQ(x,y)$Lisp
 
-   first x             == SPADfirst(x)$Lisp
+  Exports == InfinitlyClosePointCategory(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR,BLMET) with 
 
-   elt(x,"first")      == SPADfirst(x)$Lisp
+    fullOut: % -> OutputForm
+      ++ fullOut(tr) yields a full output of tr (see function fullOutput).
 
-   empty()             == NIL$Lisp
+    fullOutput: Boolean -> Boolean
+      ++ fullOutput(b) sets a flag such that when true, a coerce to 
+      ++ OutputForm yields the full output of tr, otherwise encode(tr) is 
+      ++ output (see encode function). The default is false.
 
-   empty? x            == NULL(x)$Lisp
+    fullOutput: () -> Boolean
+      ++ fullOutput returns the value of the flag set by fullOutput(b).   
+     
+  Implementation == representation add
+    Rep := representation
 
-   rest x              == CDR(x)$Lisp
+    polyRing2BiRing: (PolyRing, Integer) -> BlUpRing
+    polyRing2BiRing(pol,nV)==
+      zero? pol => 0$BlUpRing
+      d:= degree pol
+      lc:= leadingCoefficient pol
+      dd: List NonNegativeInteger := entries d
+      ddr:=vector([dd.i for i in 1..#dd | ^(i=nV)])$Vector(NonNegativeInteger)
+      ddre:E2 := directProduct( ddr )$E2
+      monomial(lc,ddre)$BlUpRing  + polyRing2BiRing( reductum pol , nV )
 
-   elt(x,"rest")       == CDR(x)$Lisp
+    projPt2affPt: (ProjPt, Integer) -> AFP
+    projPt2affPt(pt,nV)==
+      ll:= pt :: List(K)
+      l:= [ ll.i for i in 1..#ll | ^(i = nV )]
+      affinePoint( l)
 
-   setfirst_!(x,s)     ==
-      empty? x => error "Cannot update an empty list"
-      Qfirst RPLACA(x,s)$Lisp
+    fullOut(a)==
+      oo: bigoutRecBLQT
+      oo2: bigoutRecHN
+      BLMET has BlowUpWithQuadTrans =>
+        oo:=  [ pointV(a), symbNameV(a), multV(a), curveV(a), _
+              localPointV(a), chartV(a),  excpDivV(a) ]$bigoutRecBLQT
+        oo :: OutputForm
+      BLMET has BlowUpWithHamburgerNoether => 
+        oo2:=  [ pointV(a), symbNameV(a), multV(a), curveV(a), _
+              localPointV(a), chartV(a), subMultV(a), excpDivV(a) ]$bigoutRecHN
+        oo2 :: OutputForm
 
-   setelt(x,"first",s) ==
-      empty? x => error "Cannot update an empty list"
-      Qfirst RPLACA(x,s)$Lisp
+    fullOutputFlag:Boolean:=false()
 
-   setrest_!(x,y)      ==
-      empty? x => error "Cannot update an empty list"
-      Qrest RPLACD(x,y)$Lisp
+    fullOutput(f)== fullOutputFlag:=f
 
-   setelt(x,"rest",y)  ==
-      empty? x => error "Cannot update an empty list"
-      Qrest RPLACD(x,y)$Lisp
+    fullOutput == fullOutputFlag
 
-   construct l         == l pretend %
+    coerce(a:%):OutputForm== 
+      fullOutput() => fullOut(a)
+      oo:outRec:= [ symbNameV(a) , multV(a) ]$outRec
+      oo :: OutputForm
 
-   parts s             == s pretend List S
+    degree(a)==
+      K has PseudoAlgebraicClosureOfPerfectFieldCategory  => _
+        extDegree actualExtensionV a
+      1
+      
+    create(pointA,curveA,localPointA,multA,chartA,subM,excpDivA,atcL,aName)==
+      ([pointA,curveA,localPointA,multA,chartA,subM,_
+        excpDivA,empty()$List(PCS),atcL,aName]$Rep)::%
 
-   reverse_! x         == NREVERSE(x)$Lisp
+    create(pointA,curveA)==
+      nV := lastNonNul pointA
+      localPointA := projPt2affPt(pointA,nV)
+      multA:NonNegativeInteger:=0$NonNegativeInteger
+      chartA:BLMET 
+      if BLMET has QuadraticTransform then 
+        chartA:=( [0,0, nV] :: List Integer ) :: BLMET   -- CHH
+      if BLMET has HamburgerNoether then
+        chartA := createHN( 0,0,nV,0,0,true,"right")   -- A changer le "right" 
+      excpDivA:DIVISOR:= 0$DIVISOR
+      actL:K:=definingField pointA
+      aName:Symbol:=new(P)$Symbol
+      affCurvA : BlUpRing := polyRing2BiRing(curveA,nV)
+      create(pointA,affCurvA,localPointA,multA,chartA,_
+             0$NonNegativeInteger,excpDivA,actL,aName)
+      
+    subMultV(a:%)== (a:Rep)(subMultiplicity)
 
-   reverse x           == REVERSE(x)$Lisp
+    setsubmult_!(a:%,sm:NonNegativeInteger)== (a:Rep)(subMultiplicity) := sm
 
-   minIndex x          == mn
+    pointV(a:%)     ==(a:Rep)(point)
 
-   rest(x, n) ==
-      for i in 1..n repeat
-         if Qnull x then error "index out of range"
-         x := Qrest x
-      x
+    symbNameV(a:%)     ==(a:Rep)(symbName)
 
-   copy x ==
-      y := empty()
-      for i in 0.. while not Qnull x repeat
-         if Qeq(i,cycleMax) and cyclic? x then error "cyclic list"
-         y := Qcons(Qfirst x,y)
-         x := Qrest x
-      (NREVERSE(y)$Lisp)@%
+    curveV(a:%)  ==(a:Rep)(curve)
 
-   if S has SetCategory then
+    localPointV(a:%)   ==(a:Rep)(localPoint)
 
-     coerce(x):OutputForm ==
-        -- displays cycle with overbar over the cycle
-        y := empty()$List(OutputForm)
-        s := cycleEntry x
-        while Qneq(x, s) repeat
-          y := concat((first x)::OutputForm, y)
-          x := rest x
-        y := reverse_! y
-        empty? s => bracket y
-        -- cyclic case: z is cylic part
-        z := list((first x)::OutputForm)
-        while Qneq(s, rest x) repeat
-           x := rest x
-           z := concat((first x)::OutputForm, z)
-        bracket concat_!(y, overbar commaSeparate reverse_! z)
+    multV(a:%)    ==(a:Rep)(mult)
 
-     x = y ==
-       Qeq(x,y) => true
-       while not Qnull x and not Qnull y repeat
-          Qfirst x ^=$S Qfirst y => return false
-          x := Qrest x
-          y := Qrest y
-       Qnull x and Qnull y
+    chartV(a:%)   ==(a:Rep)(chrt)  -- CHH
 
-     latex(x : %): String ==
-       s : String := "\left["
-       while not Qnull x repeat
-         s := concat(s, latex(Qfirst x)$S)$String
-         x := Qrest x
-         if not Qnull x then s := concat(s, ", ")$String
-       concat(s, " \right]")$String
+    excpDivV(a:%) ==(a:Rep)(excpDiv)
 
-     member?(s,x) ==
-        while not Qnull x repeat
-           if s = Qfirst x then return true else x := Qrest x
-        false
+    localParamV(a:%) ==(a:Rep)(localParam)
+    
+    actualExtensionV(a:%) == (a:Rep)(actualExtension)
 
-   -- Lots of code from parts of AGGCAT, repeated here to
-   -- get faster compilation
-   concat_!(x:%,y:%) ==
-      Qnull x => 
-        Qnull y => x
-        Qpush(first y,x)
-        QRPLACD(x,rest y)$Lisp
-        x
-      z:=x
-      while not Qnull Qrest z repeat
-        z:=Qrest z
-      QRPLACD(z,y)$Lisp
-      x
+    setpoint_!(a:%,n:ProjPt)       ==(a:Rep)(point):=n
 
-   -- Then a quicky:
-   if S has SetCategory then
+    setcurve_!(a:%,n:BlUpRing)   ==(a:Rep)(curve):=n
 
-     removeDuplicates_! l ==
-       p := l
-       while not Qnull p repeat
-         pp:=p
-         f:S:=Qfirst p
-         p:=Qrest p
-         while not Qnull (pr:=Qrest pp) repeat
-           if (Qfirst pr)@S = f then QRPLACD(pp,Qrest pr)$Lisp
-           else pp:=pr
-       l
+    setlocalPoint_!(a:%,n:AFP)  ==(a:Rep)(localPoint):=n
 
-   -- then sorting
-   mergeSort: ((S, S) -> Boolean, %, Integer) -> %
+    setmult_!(a:%,n:NonNegativeInteger)         ==(a:Rep)(mult):=n
 
-   sort_!(f, l)       == mergeSort(f, l, #l)
+    setchart_!(a:%,n:BLMET)  ==(a:Rep)(chrt):=n  -- CHH
 
-   merge_!(f, p, q) ==
-     Qnull p => q
-     Qnull q => p
-     Qeq(p, q) => error "cannot merge a list into itself"
-     if f(Qfirst p, Qfirst q)
-       then (r := t := p; p := Qrest p)
-       else (r := t := q; q := Qrest q)
-     while not Qnull p and not Qnull q repeat
-       if f(Qfirst p, Qfirst q)
-         then (QRPLACD(t, p)$Lisp; t := p; p := Qrest p)
-         else (QRPLACD(t, q)$Lisp; t := q; q := Qrest q)
-     QRPLACD(t, if Qnull p then q else p)$Lisp
-     r
+    setlocalParam_!(a:%,n:List(PCS)) ==(a:Rep)(localParam):=n
 
-   split_!(p, n) ==
-      n < 1 => error "index out of range"
-      p := rest(p, (n - 1)::NonNegativeInteger)
-      q := Qrest p
-      QRPLACD(p, NIL$Lisp)$Lisp
-      q
+    setexcpDiv_!(a:%,n:DIVISOR) ==(a:Rep)(excpDiv):=n
 
-   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)
+    setsymbName_!(a:%,n:Symbol) ==(a:Rep)(symbName):=n
 
 \end{chunk}
 
-\begin{chunk}{COQ ILIST}
-(* domain ILIST *)
+\begin{chunk}{COQ INFCLSPT}
+(* domain INFCLSPT *)
 (*
+    Rep := representation
 
-   #? : % -> NonNegativeInteger if $ has finiteAggregate
-   #x == LENGTH(x)$Lisp
-
-   concat : (S,%) -> %
-   concat(s:S,x:%) == CONS(s,x)$Lisp
-
-   eq? : (%,%) -> Boolean
-   eq?(x,y) == EQ(x,y)$Lisp
-
-   first : % -> S
-   first x == SPADfirst(x)$Lisp
-
-   ?.first : (%,first) -> S
-   elt(x,"first") == SPADfirst(x)$Lisp
-
-   empty : () -> %
-   empty() == NIL$Lisp
-
-   empty? : % -> Boolean
-   empty? x == NULL(x)$Lisp
-
-   rest : % -> %
-   rest x == CDR(x)$Lisp
+    polyRing2BiRing: (PolyRing, Integer) -> BlUpRing
+    polyRing2BiRing(pol,nV)==
+      zero? pol => 0$BlUpRing
+      d:= degree pol
+      lc:= leadingCoefficient pol
+      dd: List NonNegativeInteger := entries d
+      ddr:=vector([dd.i for i in 1..#dd | ^(i=nV)])$Vector(NonNegativeInteger)
+      ddre:E2 := directProduct( ddr )$E2
+      monomial(lc,ddre)$BlUpRing  + polyRing2BiRing( reductum pol , nV )
 
-   ?.rest : (%,rest) -> %
-   elt(x,"rest") == CDR(x)$Lisp
+    projPt2affPt: (ProjPt, Integer) -> AFP
+    projPt2affPt(pt,nV)==
+      ll:= pt :: List(K)
+      l:= [ ll.i for i in 1..#ll | ^(i = nV )]
+      affinePoint( l)
 
-   setfirst! : (%,S) -> S
-   setfirst_!(x,s) ==
-      empty? x => error "Cannot update an empty list"
-      Qfirst RPLACA(x,s)$Lisp
+    fullOut(a)==
+      oo: bigoutRecBLQT
+      oo2: bigoutRecHN
+      BLMET has BlowUpWithQuadTrans =>
+        oo:=  [ pointV(a), symbNameV(a), multV(a), curveV(a), _
+              localPointV(a), chartV(a),  excpDivV(a) ]$bigoutRecBLQT
+        oo :: OutputForm
+      BLMET has BlowUpWithHamburgerNoether => 
+        oo2:=  [ pointV(a), symbNameV(a), multV(a), curveV(a), _
+              localPointV(a), chartV(a), subMultV(a), excpDivV(a) ]$bigoutRecHN
+        oo2 :: OutputForm
 
-   setelt : (%,first,S) -> S
-   setelt(x,"first",s) ==
-      empty? x => error "Cannot update an empty list"
-      Qfirst RPLACA(x,s)$Lisp
+    fullOutputFlag:Boolean:=false()
 
-   setrest! : (%,%) -> %
-   setrest_!(x,y) ==
-      empty? x => error "Cannot update an empty list"
-      Qrest RPLACD(x,y)$Lisp
+    fullOutput(f)== fullOutputFlag:=f
 
-   setelt : (%,rest,%) -> %
-   setelt(x,"rest",y) ==
-      empty? x => error "Cannot update an empty list"
-      Qrest RPLACD(x,y)$Lisp
+    fullOutput == fullOutputFlag
 
-   construct : List(S) -> %
-   construct l == l pretend %
+    coerce(a:%):OutputForm== 
+      fullOutput() => fullOut(a)
+      oo:outRec:= [ symbNameV(a) , multV(a) ]$outRec
+      oo :: OutputForm
 
-   parts : % -> List(S)
-   parts s == s pretend List S
+    degree(a)==
+      K has PseudoAlgebraicClosureOfPerfectFieldCategory  => _
+        extDegree actualExtensionV a
+      1
+      
+    create(pointA,curveA,localPointA,multA,chartA,subM,excpDivA,atcL,aName)==
+      ([pointA,curveA,localPointA,multA,chartA,subM,_
+        excpDivA,empty()$List(PCS),atcL,aName]$Rep)::%
 
-   reverse! : % -> %
-   reverse_! x == NREVERSE(x)$Lisp
+    create(pointA,curveA)==
+      nV := lastNonNul pointA
+      localPointA := projPt2affPt(pointA,nV)
+      multA:NonNegativeInteger:=0$NonNegativeInteger
+      chartA:BLMET 
+      if BLMET has QuadraticTransform then 
+        chartA:=( [0,0, nV] :: List Integer ) :: BLMET   -- CHH
+      if BLMET has HamburgerNoether then
+        chartA := createHN( 0,0,nV,0,0,true,"right")   -- A changer le "right" 
+      excpDivA:DIVISOR:= 0$DIVISOR
+      actL:K:=definingField pointA
+      aName:Symbol:=new(P)$Symbol
+      affCurvA : BlUpRing := polyRing2BiRing(curveA,nV)
+      create(pointA,affCurvA,localPointA,multA,chartA,_
+             0$NonNegativeInteger,excpDivA,actL,aName)
+      
+    subMultV(a:%)== (a:Rep)(subMultiplicity)
 
-   reverse : % -> %
-   reverse x == REVERSE(x)$Lisp
+    setsubmult_!(a:%,sm:NonNegativeInteger)== (a:Rep)(subMultiplicity) := sm
 
-   minIndex : % -> Integer
-   minIndex x == mn
+    pointV(a:%)     ==(a:Rep)(point)
 
-   rest : (%,NonNegativeInteger) -> %
-   rest(x, n) ==
-      for i in 1..n repeat
-         if Qnull x then error "index out of range"
-         x := Qrest x
-      x
+    symbNameV(a:%)     ==(a:Rep)(symbName)
 
-   copy : % -> %
-   copy x ==
-      y := empty()
-      for i in 0.. while not Qnull x repeat
-         if Qeq(i,cycleMax) and cyclic? x then error "cyclic list"
-         y := Qcons(Qfirst x,y)
-         x := Qrest x
-      (NREVERSE(y)$Lisp)@%
+    curveV(a:%)  ==(a:Rep)(curve)
 
-   if S has SetCategory then
+    localPointV(a:%)   ==(a:Rep)(localPoint)
 
-     coerce : % -> OutputForm
-     coerce(x):OutputForm ==
-        -- displays cycle with overbar over the cycle
-        y := empty()$List(OutputForm)
-        s := cycleEntry x
-        while Qneq(x, s) repeat
-          y := concat((first x)::OutputForm, y)
-          x := rest x
-        y := reverse_! y
-        empty? s => bracket y
-        -- cyclic case: z is cylic part
-        z := list((first x)::OutputForm)
-        while Qneq(s, rest x) repeat
-           x := rest x
-           z := concat((first x)::OutputForm, z)
-        bracket concat_!(y, overbar commaSeparate reverse_! z)
+    multV(a:%)    ==(a:Rep)(mult)
 
-     ?=? : (%,%) -> Boolean
-     x = y ==
-       Qeq(x,y) => true
-       while not Qnull x and not Qnull y repeat
-          Qfirst x ^=$S Qfirst y => return false
-          x := Qrest x
-          y := Qrest y
-       Qnull x and Qnull y
+    chartV(a:%)   ==(a:Rep)(chrt)  -- CHH
 
-     latex : % -> String
-     latex(x : %): String ==
-       s : String := "\left["
-       while not Qnull x repeat
-         s := concat(s, latex(Qfirst x)$S)$String
-         x := Qrest x
-         if not Qnull x then s := concat(s, ", ")$String
-       concat(s, " \right]")$String
+    excpDivV(a:%) ==(a:Rep)(excpDiv)
 
-     member? : (S,%) -> Boolean
-     member?(s,x) ==
-        while not Qnull x repeat
-           if s = Qfirst x then return true else x := Qrest x
-        false
+    localParamV(a:%) ==(a:Rep)(localParam)
+    
+    actualExtensionV(a:%) == (a:Rep)(actualExtension)
 
-   -- Lots of code from parts of AGGCAT, repeated here to
-   -- get faster compilation
-   concat! : (%,%) -> %
-   concat_!(x:%,y:%) ==
-      Qnull x => 
-        Qnull y => x
-        Qpush(first y,x)
-        QRPLACD(x,rest y)$Lisp
-        x
-      z:=x
-      while not Qnull Qrest z repeat
-        z:=Qrest z
-      QRPLACD(z,y)$Lisp
-      x
+    setpoint_!(a:%,n:ProjPt)       ==(a:Rep)(point):=n
 
-   -- Then a quicky:
-   if S has SetCategory then
+    setcurve_!(a:%,n:BlUpRing)   ==(a:Rep)(curve):=n
 
-     removeDuplicates! : % -> % if S has SETCAT
-     removeDuplicates_! l ==
-       p := l
-       while not Qnull p repeat
-         pp:=p
-         f:S:=Qfirst p
-         p:=Qrest p
-         while not Qnull (pr:=Qrest pp) repeat
-           if (Qfirst pr)@S = f then QRPLACD(pp,Qrest pr)$Lisp
-           else pp:=pr
-       l
+    setlocalPoint_!(a:%,n:AFP)  ==(a:Rep)(localPoint):=n
 
-   -- then sorting
+    setmult_!(a:%,n:NonNegativeInteger)         ==(a:Rep)(mult):=n
 
-   sort! : (((S,S) -> Boolean),%) -> %
-   sort_!(f, l) == mergeSort(f, l, #l)
+    setchart_!(a:%,n:BLMET)  ==(a:Rep)(chrt):=n  -- CHH
 
-   merge! : (((S,S) -> Boolean),%,%) -> %
-   merge_!(f, p, q) ==
-     Qnull p => q
-     Qnull q => p
-     Qeq(p, q) => error "cannot merge a list into itself"
-     if f(Qfirst p, Qfirst q)
-       then (r := t := p; p := Qrest p)
-       else (r := t := q; q := Qrest q)
-     while not Qnull p and not Qnull q repeat
-       if f(Qfirst p, Qfirst q)
-         then (QRPLACD(t, p)$Lisp; t := p; p := Qrest p)
-         else (QRPLACD(t, q)$Lisp; t := q; q := Qrest q)
-     QRPLACD(t, if Qnull p then q else p)$Lisp
-     r
+    setlocalParam_!(a:%,n:List(PCS)) ==(a:Rep)(localParam):=n
 
-   split! : (%,Integer) -> %
-   split_!(p, n) ==
-      n < 1 => error "index out of range"
-      p := rest(p, (n - 1)::NonNegativeInteger)
-      q := Qrest p
-      QRPLACD(p, NIL$Lisp)$Lisp
-      q
+    setexcpDiv_!(a:%,n:DIVISOR) ==(a:Rep)(excpDiv):=n
 
-   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)
+    setsymbName_!(a:%,n:Symbol) ==(a:Rep)(symbName):=n
 
 *)
 
 \end{chunk}
 
-\begin{chunk}{ILIST.dotabb}
-"ILIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ILIST",
-          shape=ellipse]
-"STRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=STRING"]
-"ILIST" -> "STRING"
+\begin{chunk}{INFCLSPT.dotabb}
+"INFCLSPT" [color="#88FF44",href="bookvol10.3.pdf#nameddest=INFCLSPT"]
+"INFCLCT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=INFCLCT"]
+"INFCLSPT" -> "INFCLCT"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IMATRIX IndexedMatrix}
+\section{domain INFCLSPS InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField}
 
-\begin{chunk}{IndexedMatrix.input}
+\begin{chunk}{InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField.input}
 )set break resume
-)sys rm -f IndexedMatrix.output
-)spool IndexedMatrix.output
+)sys rm -f InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField.output
+)spool InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show IndexedMatrix
+)show InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField
 --R 
---R IndexedMatrix(R: Ring,mnRow: Integer,mnCol: Integer)  is a domain constructor
---R Abbreviation for IndexedMatrix is IMATRIX 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IMATRIX 
+--R InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField(K: FiniteFieldCategory,symb: List(Symbol),BLMET: BlowUpMethodCategory)  is a domain constructor
+--R Abbreviation for InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField is INFCLSPS 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for INFCLSPS 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (Integer,%) -> %                ?*? : (%,R) -> %
---R ?*? : (R,%) -> %                      ?*? : (%,%) -> %
---R ?**? : (%,NonNegativeInteger) -> %    ?+? : (%,%) -> %
---R -? : % -> %                           ?-? : (%,%) -> %
---R ?/? : (%,R) -> % if R has FIELD       antisymmetric? : % -> Boolean
---R copy : % -> %                         diagonal? : % -> Boolean
---R diagonalMatrix : List(%) -> %         diagonalMatrix : List(R) -> %
---R elt : (%,Integer,Integer,R) -> R      elt : (%,Integer,Integer) -> R
---R empty : () -> %                       empty? : % -> Boolean
---R eq? : (%,%) -> Boolean                fill! : (%,R) -> %
---R horizConcat : (%,%) -> %              latex : % -> String if R has SETCAT
---R listOfLists : % -> List(List(R))      map : (((R,R) -> R),%,%,R) -> %
---R map : (((R,R) -> R),%,%) -> %         map : ((R -> R),%) -> %
---R map! : ((R -> R),%) -> %              matrix : List(List(R)) -> %
---R maxColIndex : % -> Integer            maxRowIndex : % -> Integer
---R minColIndex : % -> Integer            minRowIndex : % -> Integer
---R ncols : % -> NonNegativeInteger       nrows : % -> NonNegativeInteger
---R parts : % -> List(R)                  pfaffian : % -> R if R has COMRING
---R qelt : (%,Integer,Integer) -> R       sample : () -> %
---R setelt : (%,Integer,Integer,R) -> R   square? : % -> Boolean
---R squareTop : % -> %                    symmetric? : % -> Boolean
---R transpose : % -> %                    vertConcat : (%,%) -> %
---R #? : % -> NonNegativeInteger if $ has finiteAggregate
---R ?*? : (IndexedVector(R,mnCol),%) -> IndexedVector(R,mnCol)
---R ?*? : (%,IndexedVector(R,mnRow)) -> IndexedVector(R,mnRow)
---R ?**? : (%,Integer) -> % if R has FIELD
---R ?=? : (%,%) -> Boolean if R has SETCAT
---R any? : ((R -> Boolean),%) -> Boolean if $ has finiteAggregate
---R coerce : IndexedVector(R,mnRow) -> %
---R coerce : % -> OutputForm if R has SETCAT
---R column : (%,Integer) -> IndexedVector(R,mnRow)
---R columnSpace : % -> List(IndexedVector(R,mnRow)) if R has EUCDOM
---R count : (R,%) -> NonNegativeInteger if $ has finiteAggregate and R has SETCAT
---R count : ((R -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R determinant : % -> R if R has commutative(*)
---R elt : (%,List(Integer),List(Integer)) -> %
---R eval : (%,List(R),List(R)) -> % if R has EVALAB(R) and R has SETCAT
---R eval : (%,R,R) -> % if R has EVALAB(R) and R has SETCAT
---R eval : (%,Equation(R)) -> % if R has EVALAB(R) and R has SETCAT
---R eval : (%,List(Equation(R))) -> % if R has EVALAB(R) and R has SETCAT
---R every? : ((R -> Boolean),%) -> Boolean if $ has finiteAggregate
---R exquo : (%,R) -> Union(%,"failed") if R has INTDOM
---R hash : % -> SingleInteger if R has SETCAT
---R inverse : % -> Union(%,"failed") if R has FIELD
---R less? : (%,NonNegativeInteger) -> Boolean
---R matrix : (NonNegativeInteger,NonNegativeInteger,((Integer,Integer) -> R)) -> %
---R member? : (R,%) -> Boolean if $ has finiteAggregate and R has SETCAT
---R members : % -> List(R) if $ has finiteAggregate
---R minordet : % -> R if R has commutative(*)
---R more? : (%,NonNegativeInteger) -> Boolean
---R new : (NonNegativeInteger,NonNegativeInteger,R) -> %
---R nullSpace : % -> List(IndexedVector(R,mnRow)) if R has INTDOM
---R nullity : % -> NonNegativeInteger if R has INTDOM
---R qsetelt! : (%,Integer,Integer,R) -> R
---R rank : % -> NonNegativeInteger if R has INTDOM
---R row : (%,Integer) -> IndexedVector(R,mnCol)
---R rowEchelon : % -> % if R has EUCDOM
---R scalarMatrix : (NonNegativeInteger,R) -> %
---R setColumn! : (%,Integer,IndexedVector(R,mnRow)) -> %
---R setRow! : (%,Integer,IndexedVector(R,mnCol)) -> %
---R setelt : (%,List(Integer),List(Integer),%) -> %
---R setsubMatrix! : (%,Integer,Integer,%) -> %
---R size? : (%,NonNegativeInteger) -> Boolean
---R subMatrix : (%,Integer,Integer,Integer,Integer) -> %
---R swapColumns! : (%,Integer,Integer) -> %
---R swapRows! : (%,Integer,Integer) -> %
---R transpose : IndexedVector(R,mnCol) -> %
---R zero : (NonNegativeInteger,NonNegativeInteger) -> %
---R ?~=? : (%,%) -> Boolean if R has SETCAT
+--R ?=? : (%,%) -> Boolean                chartV : % -> BLMET
+--R coerce : % -> OutputForm              degree : % -> PositiveInteger
+--R fullOut : % -> OutputForm             fullOutput : () -> Boolean
+--R fullOutput : Boolean -> Boolean       hash : % -> SingleInteger
+--R latex : % -> String                   multV : % -> NonNegativeInteger
+--R setchart! : (%,BLMET) -> BLMET        setsymbName! : (%,Symbol) -> Symbol
+--R subMultV : % -> NonNegativeInteger    symbNameV : % -> Symbol
+--R ?~=? : (%,%) -> Boolean              
+--R actualExtensionV : % -> PseudoAlgebraicClosureOfFiniteField(K)
+--R create : (ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K),DistributedMultivariatePolynomial(symb,PseudoAlgebraicClosureOfFiniteField(K))) -> %
+--R create : (ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K),DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],PseudoAlgebraicClosureOfFiniteField(K)),AffinePlane(PseudoAlgebraicClosureOfFiniteField(K)),NonNegativeInteger,BLMET,NonNegativeInteger,Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K)),PseudoAlgebraicClosureOfFiniteField(K),Symbol) -> %
+--R curveV : % -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],PseudoAlgebraicClosureOfFiniteField(K))
+--R excpDivV : % -> Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K))
+--R localParamV : % -> List(NeitherSparseOrDensePowerSeries(PseudoAlgebraicClosureOfFiniteField(K)))
+--R localPointV : % -> AffinePlane(PseudoAlgebraicClosureOfFiniteField(K))
+--R pointV : % -> ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K)
+--R setcurve! : (%,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],PseudoAlgebraicClosureOfFiniteField(K))) -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],PseudoAlgebraicClosureOfFiniteField(K))
+--R setexcpDiv! : (%,Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K))) -> Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K))
+--R setlocalParam! : (%,List(NeitherSparseOrDensePowerSeries(PseudoAlgebraicClosureOfFiniteField(K)))) -> List(NeitherSparseOrDensePowerSeries(PseudoAlgebraicClosureOfFiniteField(K)))
+--R setlocalPoint! : (%,AffinePlane(PseudoAlgebraicClosureOfFiniteField(K))) -> AffinePlane(PseudoAlgebraicClosureOfFiniteField(K))
+--R setmult! : (%,NonNegativeInteger) -> NonNegativeInteger
+--R setpoint! : (%,ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K)) -> ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K)
+--R setsubmult! : (%,NonNegativeInteger) -> NonNegativeInteger
 --R
 --E 1
 
 )spool
 )lisp (bye)
+
 \end{chunk}
-\begin{chunk}{IndexedMatrix.help}
+\begin{chunk}{InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField.help}
 ====================================================================
-IndexedMatrix examples
+InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField examples
 ====================================================================
 
-An IndexedMatrix is a matrix where the minimal row and column
-indices are parameters of the type.  The domains Row and Col
-are both IndexedVectors.
-
-The index of the 'first' row may be obtained by calling the function
-minRowIndex. The index of the 'first' column may be obtained by calling 
-the function minColIndex.  The index of the first element of a 'Row' is 
-the same as the index of the first column in a matrix and vice versa.
+This domain is part of the PAFF package
 
 See Also:
-o )show IndexedMatrix
+o )show InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField
 
 \end{chunk}
-
-\pagehead{IndexedMatrix}{IMATRIX}
-\pagepic{ps/v103indexedmatrix.ps}{IMATRIX}{1.00}
-{\bf See}\\
-\pageto{Matrix}{MATRIX}
-\pageto{RectangularMatrix}{RMATRIX}
-\pageto{SquareMatrix}{SQMATRIX}
+\pagehead{InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField}{INFCLSPS}
+\pagepic{ps/v103infinitlyclosepointoverpseudoalgebraicclosureoffinitefield.eps}{INFCLSPS}{1.00}
 
 {\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{IMATRIX}{any?} &
-\cross{IMATRIX}{antisymmetric?} &
-\cross{IMATRIX}{coerce} &
-\cross{IMATRIX}{column} &
-\cross{IMATRIX}{copy} \\
-\cross{IMATRIX}{count} &
-\cross{IMATRIX}{determinant} &
-\cross{IMATRIX}{diagonal?} &
-\cross{IMATRIX}{diagonalMatrix} &
-\cross{IMATRIX}{elt} \\
-\cross{IMATRIX}{empty} &
-\cross{IMATRIX}{empty?} &
-\cross{IMATRIX}{eq?} &
-\cross{IMATRIX}{eval} &
-\cross{IMATRIX}{every?} \\
-\cross{IMATRIX}{exquo} &
-\cross{IMATRIX}{fill!} &
-\cross{IMATRIX}{hash} &
-\cross{IMATRIX}{horizConcat} &
-\cross{IMATRIX}{inverse} \\
-\cross{IMATRIX}{latex} &
-\cross{IMATRIX}{less?} &
-\cross{IMATRIX}{listOfLists} &
-\cross{IMATRIX}{map} &
-\cross{IMATRIX}{map!} \\
-\cross{IMATRIX}{matrix} &
-\cross{IMATRIX}{maxColIndex} &
-\cross{IMATRIX}{maxRowIndex} &
-\cross{IMATRIX}{member?} &
-\cross{IMATRIX}{members} \\
-\cross{IMATRIX}{minColIndex} &
-\cross{IMATRIX}{minordet} &
-\cross{IMATRIX}{minRowIndex} &
-\cross{IMATRIX}{more?} &
-\cross{IMATRIX}{ncols} \\
-\cross{IMATRIX}{new} &
-\cross{IMATRIX}{nrows} &
-\cross{IMATRIX}{nullSpace} &
-\cross{IMATRIX}{nullity} &
-\cross{IMATRIX}{parts} \\
-\cross{IMATRIX}{qelt} &
-\cross{IMATRIX}{qsetelt!} &
-\cross{IMATRIX}{rank} &
-\cross{IMATRIX}{row} &
-\cross{IMATRIX}{rowEchelon} \\
-\cross{IMATRIX}{sample} &
-\cross{IMATRIX}{scalarMatrix} &
-\cross{IMATRIX}{setColumn!} &
-\cross{IMATRIX}{setRow!} &
-\cross{IMATRIX}{setelt} \\
-\cross{IMATRIX}{setsubMatrix!} &
-\cross{IMATRIX}{size?} &
-\cross{IMATRIX}{square?} &
-\cross{IMATRIX}{squareTop} &
-\cross{IMATRIX}{subMatrix} \\
-\cross{IMATRIX}{swapColumns!} &
-\cross{IMATRIX}{swapRows!} &
-\cross{IMATRIX}{symmetric?} &
-\cross{IMATRIX}{transpose} &
-\cross{IMATRIX}{vertConcat} \\
-\cross{IMATRIX}{zero} &
-\cross{IMATRIX}{\#{}?} &
-\cross{IMATRIX}{?*?} &
-\cross{IMATRIX}{?**?} &
-\cross{IMATRIX}{?/?} \\
-\cross{IMATRIX}{?=?} &
-\cross{IMATRIX}{?\~{}=?} &
-\cross{IMATRIX}{?+?} &
-\cross{IMATRIX}{-?} &
-\cross{IMATRIX}{?-?} 
+\begin{tabular}{lll}
+\cross{INFCLSPS}{?=?} &
+\cross{INFCLSPS}{?\~{}=?} &
+\cross{INFCLSPS}{actualExtensionV} \\
+\cross{INFCLSPS}{chartV} &
+\cross{INFCLSPS}{coerce} &
+\cross{INFCLSPS}{create} \\
+\cross{INFCLSPS}{curveV} &
+\cross{INFCLSPS}{degree} &
+\cross{INFCLSPS}{excpDivV} \\
+\cross{INFCLSPS}{fullOut} &
+\cross{INFCLSPS}{fullOutput} &
+\cross{INFCLSPS}{hash} \\
+\cross{INFCLSPS}{latex} &
+\cross{INFCLSPS}{localParamV} &
+\cross{INFCLSPS}{localPointV} \\
+\cross{INFCLSPS}{multV} &
+\cross{INFCLSPS}{pointV} &
+\cross{INFCLSPS}{setchart!} \\
+\cross{INFCLSPS}{setcurve!} &
+\cross{INFCLSPS}{setexcpDiv!} &
+\cross{INFCLSPS}{setlocalParam!} \\
+\cross{INFCLSPS}{setlocalPoint!} &
+\cross{INFCLSPS}{setmult!} &
+\cross{INFCLSPS}{setpoint!} \\
+\cross{INFCLSPS}{setsubmult!} &
+\cross{INFCLSPS}{setsymbName!} &
+\cross{INFCLSPS}{subMultV} \\
+\cross{INFCLSPS}{symbNameV} &&
 \end{tabular}
 
-\begin{chunk}{domain IMATRIX IndexedMatrix}
-)abbrev domain IMATRIX IndexedMatrix
-++ Author: Grabmeier, Gschnitzer, Williamson
-++ Date Created: 1987
-++ Date Last Updated: July 1990
-++ Description:
-++ An \spad{IndexedMatrix} is a matrix where the minimal row and column
-++ indices are parameters of the type.  The domains Row and Col
-++ are both IndexedVectors.
-++ The index of the 'first' row may be obtained by calling the
-++ function \spadfun{minRowIndex}.  The index of the 'first' column may
-++ be obtained by calling the function \spadfun{minColIndex}.  The index of
-++ the first element of a 'Row' is the same as the index of the
-++ first column in a matrix and vice versa.
+\begin{chunk}{domain INFCLSPS InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField}
+)abbrev domain INFCLSPS InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField
+++ Authors: Gaetan Hache
+++ Date Created: june 1996 
+++ Date Last Updated: May 2010 by Tim Daly
+++ Description: 
+++ This domain is part of the PAFF package
+InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField(K,symb,BLMET):_
+ Exports == Implementation where
 
-IndexedMatrix(R,mnRow,mnCol): Exports == Implementation where
-  R : Ring
-  mnRow, mnCol : Integer
-  Row ==> IndexedVector(R,mnCol)
-  Col ==> IndexedVector(R,mnRow)
-  MATLIN ==> MatrixLinearAlgebraFunctions(R,Row,Col,$)
- 
-  Exports ==> MatrixCategory(R,Row,Col)
- 
-  Implementation ==>
-    InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col) add
- 
-      swapRows_!(x,i1,i2) ==
-        (i1 < minRowIndex(x)) or (i1 > maxRowIndex(x)) or _
-           (i2 < minRowIndex(x)) or (i2 > maxRowIndex(x)) =>
-             error "swapRows!: index out of range"
-        i1 = i2 => x
-        minRow := minRowIndex x
-        xx := x pretend PrimitiveArray(PrimitiveArray(R))
-        n1 := i1 - minRow; n2 := i2 - minRow
-        row1 := qelt(xx,n1)
-        qsetelt_!(xx,n1,qelt(xx,n2))
-        qsetelt_!(xx,n2,row1)
-        xx pretend $
- 
-      if R has commutative("*") then
- 
-        determinant x == determinant(x)$MATLIN
-        minordet    x == minordet(x)$MATLIN
- 
-      if R has EuclideanDomain then
- 
-        rowEchelon  x == rowEchelon(x)$MATLIN
- 
-      if R has IntegralDomain then
- 
-        rank        x == rank(x)$MATLIN
-        nullity     x == nullity(x)$MATLIN
-        nullSpace   x == nullSpace(x)$MATLIN
- 
-      if R has Field then
- 
-        inverse     x == inverse(x)$MATLIN
+  K:FiniteFieldCategory
+  symb: List Symbol
+  BLMET : BlowUpMethodCategory
+
+  E           ==> DirectProduct(#symb,NonNegativeInteger)
+  KK          ==> PseudoAlgebraicClosureOfFiniteField(K)
+  PolyRing    ==> DistributedMultivariatePolynomial(symb,KK) 
+  ProjPt      ==> ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K)
+  PCS         ==> NeitherSparseOrDensePowerSeries(KK)
+  Plc         ==> PlacesOverPseudoAlgebraicClosureOfFiniteField(K)
+  DIVISOR     ==> Divisor(Plc)
+
+  Exports == InfinitlyClosePointCategory(KK,symb,PolyRing,E,ProjPt,_
+                                         PCS,Plc,DIVISOR,BLMET) with
+  
+    fullOut: % -> OutputForm
+      ++ fullOut(tr) yields a full output of tr (see function fullOutput).
+
+    fullOutput: Boolean -> Boolean
+
+      ++ fullOutput(b) sets a flag such that when true, a coerce to OutputForm
+      ++  yields the full output of tr, otherwise encode(tr) is output 
+      ++ (see encode function). The default is false.
 
+    fullOutput: () -> Boolean
+      ++ fullOutput returns the value of the flag set by fullOutput(b).   
+     
+  Implementation == InfinitlyClosePoint(KK,symb,PolyRing,E,ProjPt,_
+                                        PCS,Plc,DIVISOR,BLMET) 
 \end{chunk}
 
-\begin{chunk}{COQ IMATRIX}
-(* domain IMATRIX *)
+\begin{chunk}{COQ INFCLSPS}
+(* domain INFCLSPS *)
 (*
 *)
 
 \end{chunk}
 
-\begin{chunk}{IMATRIX.dotabb}
-"IMATRIX" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IMATRIX"]
-"MATCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=MATCAT"]
-"VECTCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=VECTCAT"]
-"IMATRIX" -> "MATCAT"
-"IMATRIX" -> "VECTCAT"
+\begin{chunk}{INFCLSPS.dotabb}
+"INFCLSPS" [color="#88FF44",href="bookvol10.3.pdf#nameddest=INFCLSPS"]
+"PROJPLPS" [color="#88FF44",href="bookvol10.3.pdf#nameddest=PROJPLPS"]
+"INFCLSPS" -> "PROJPLPS"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IARRAY1 IndexedOneDimensionalArray}
+\section{domain IAN InnerAlgebraicNumber}
 
-\begin{chunk}{IndexedOneDimensionalArray.input}
+\begin{chunk}{InnerAlgebraicNumber.input}
 )set break resume
-)sys rm -f IndexedOneDimensionalArray.output
-)spool IndexedOneDimensionalArray.output
+)sys rm -f InnerAlgebraicNumber.output
+)spool InnerAlgebraicNumber.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show IndexedOneDimensionalArray
+)show InnerAlgebraicNumber
 --R 
---R IndexedOneDimensionalArray(S: Type,mn: Integer)  is a domain constructor
---R Abbreviation for IndexedOneDimensionalArray is IARRAY1 
+--R InnerAlgebraicNumber  is a domain constructor
+--R Abbreviation for InnerAlgebraicNumber is IAN 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IARRAY1 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IAN 
 --R
 --R------------------------------- Operations --------------------------------
---R concat : List(%) -> %                 concat : (%,%) -> %
---R concat : (S,%) -> %                   concat : (%,S) -> %
---R construct : List(S) -> %              copy : % -> %
---R delete : (%,Integer) -> %             ?.? : (%,Integer) -> S
---R elt : (%,Integer,S) -> S              empty : () -> %
---R empty? : % -> Boolean                 entries : % -> List(S)
---R eq? : (%,%) -> Boolean                index? : (Integer,%) -> Boolean
---R indices : % -> List(Integer)          insert : (%,%,Integer) -> %
---R insert : (S,%,Integer) -> %           latex : % -> String if S has SETCAT
---R map : (((S,S) -> S),%,%) -> %         map : ((S -> S),%) -> %
---R max : (%,%) -> % if S has ORDSET      min : (%,%) -> % if S has ORDSET
---R new : (NonNegativeInteger,S) -> %     qelt : (%,Integer) -> S
---R reverse : % -> %                      sample : () -> %
---R sort : % -> % if S has ORDSET         sort : (((S,S) -> Boolean),%) -> %
---R #? : % -> NonNegativeInteger if $ has finiteAggregate
---R ?<? : (%,%) -> Boolean if S has ORDSET
---R ?<=? : (%,%) -> Boolean if S has ORDSET
---R ?=? : (%,%) -> Boolean if S has SETCAT
---R ?>? : (%,%) -> Boolean if S has ORDSET
---R ?>=? : (%,%) -> Boolean if S has ORDSET
---R any? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
---R coerce : % -> OutputForm if S has SETCAT
---R convert : % -> InputForm if S has KONVERT(INFORM)
---R copyInto! : (%,%,Integer) -> % if $ has shallowlyMutable
---R count : (S,%) -> NonNegativeInteger if $ has finiteAggregate and S has SETCAT
---R count : ((S -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R delete : (%,UniversalSegment(Integer)) -> %
---R ?.? : (%,UniversalSegment(Integer)) -> %
---R entry? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
---R eval : (%,List(S),List(S)) -> % if S has EVALAB(S) and S has SETCAT
---R eval : (%,S,S) -> % if S has EVALAB(S) and S has SETCAT
---R eval : (%,Equation(S)) -> % if S has EVALAB(S) and S has SETCAT
---R eval : (%,List(Equation(S))) -> % if S has EVALAB(S) and S has SETCAT
---R every? : ((S -> Boolean),%) -> Boolean if $ has finiteAggregate
---R fill! : (%,S) -> % if $ has shallowlyMutable
---R find : ((S -> Boolean),%) -> Union(S,"failed")
---R first : % -> S if Integer has ORDSET
---R hash : % -> SingleInteger if S has SETCAT
---R less? : (%,NonNegativeInteger) -> Boolean
---R map! : ((S -> S),%) -> % if $ has shallowlyMutable
---R maxIndex : % -> Integer if Integer has ORDSET
---R member? : (S,%) -> Boolean if $ has finiteAggregate and S has SETCAT
---R members : % -> List(S) if $ has finiteAggregate
---R merge : (%,%) -> % if S has ORDSET
---R merge : (((S,S) -> Boolean),%,%) -> %
---R minIndex : % -> Integer if Integer has ORDSET
---R more? : (%,NonNegativeInteger) -> Boolean
---R parts : % -> List(S) if $ has finiteAggregate
---R position : (S,%,Integer) -> Integer if S has SETCAT
---R position : (S,%) -> Integer if S has SETCAT
---R position : ((S -> Boolean),%) -> Integer
---R qsetelt! : (%,Integer,S) -> S if $ has shallowlyMutable
---R reduce : (((S,S) -> S),%) -> S if $ has finiteAggregate
---R reduce : (((S,S) -> S),%,S) -> S if $ has finiteAggregate
---R reduce : (((S,S) -> S),%,S,S) -> S if $ has finiteAggregate and S has SETCAT
---R remove : ((S -> Boolean),%) -> % if $ has finiteAggregate
---R remove : (S,%) -> % if $ has finiteAggregate and S has SETCAT
---R removeDuplicates : % -> % if $ has finiteAggregate and S has SETCAT
---R reverse! : % -> % if $ has shallowlyMutable
---R select : ((S -> Boolean),%) -> % if $ has finiteAggregate
---R setelt : (%,UniversalSegment(Integer),S) -> S if $ has shallowlyMutable
---R setelt : (%,Integer,S) -> S if $ has shallowlyMutable
---R size? : (%,NonNegativeInteger) -> Boolean
---R sort! : % -> % if $ has shallowlyMutable and S has ORDSET
---R sort! : (((S,S) -> Boolean),%) -> % if $ has shallowlyMutable
---R sorted? : % -> Boolean if S has ORDSET
---R sorted? : (((S,S) -> Boolean),%) -> Boolean
---R swap! : (%,Integer,Integer) -> Void if $ has shallowlyMutable
---R ?~=? : (%,%) -> Boolean if S has SETCAT
+--R ?*? : (PositiveInteger,%) -> %        ?*? : (NonNegativeInteger,%) -> %
+--R ?*? : (Integer,%) -> %                ?*? : (%,%) -> %
+--R ?*? : (%,Fraction(Integer)) -> %      ?*? : (Fraction(Integer),%) -> %
+--R ?**? : (%,PositiveInteger) -> %       ?**? : (%,NonNegativeInteger) -> %
+--R ?**? : (%,Integer) -> %               ?**? : (%,Fraction(Integer)) -> %
+--R ?+? : (%,%) -> %                      -? : % -> %
+--R ?-? : (%,%) -> %                      ?/? : (%,%) -> %
+--R ?<? : (%,%) -> Boolean                ?<=? : (%,%) -> Boolean
+--R ?=? : (%,%) -> Boolean                ?>? : (%,%) -> Boolean
+--R ?>=? : (%,%) -> Boolean               D : % -> %
+--R D : (%,NonNegativeInteger) -> %       1 : () -> %
+--R 0 : () -> %                           ?^? : (%,PositiveInteger) -> %
+--R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,Integer) -> %
+--R associates? : (%,%) -> Boolean        belong? : BasicOperator -> Boolean
+--R box : List(%) -> %                    box : % -> %
+--R coerce : Integer -> %                 coerce : % -> %
+--R coerce : Fraction(Integer) -> %       coerce : Kernel(%) -> %
+--R coerce : % -> OutputForm              convert : % -> Complex(Float)
+--R convert : % -> DoubleFloat            convert : % -> Float
+--R differentiate : % -> %                distribute : (%,%) -> %
+--R distribute : % -> %                   elt : (BasicOperator,List(%)) -> %
+--R elt : (BasicOperator,%,%,%) -> %      elt : (BasicOperator,%,%) -> %
+--R elt : (BasicOperator,%) -> %          eval : (%,Symbol,(% -> %)) -> %
+--R eval : (%,List(%),List(%)) -> %       eval : (%,%,%) -> %
+--R eval : (%,Equation(%)) -> %           eval : (%,List(Equation(%))) -> %
+--R eval : (%,Kernel(%),%) -> %           factor : % -> Factored(%)
+--R freeOf? : (%,Symbol) -> Boolean       freeOf? : (%,%) -> Boolean
+--R gcd : (%,%) -> %                      gcd : List(%) -> %
+--R hash : % -> SingleInteger             height : % -> NonNegativeInteger
+--R inv : % -> %                          is? : (%,Symbol) -> Boolean
+--R is? : (%,BasicOperator) -> Boolean    kernel : (BasicOperator,%) -> %
+--R kernels : % -> List(Kernel(%))        latex : % -> String
+--R lcm : (%,%) -> %                      lcm : List(%) -> %
+--R map : ((% -> %),Kernel(%)) -> %       max : (%,%) -> %
+--R min : (%,%) -> %                      norm : (%,List(Kernel(%))) -> %
+--R norm : (%,Kernel(%)) -> %             nthRoot : (%,Integer) -> %
+--R one? : % -> Boolean                   paren : List(%) -> %
+--R paren : % -> %                        prime? : % -> Boolean
+--R ?quo? : (%,%) -> %                    recip : % -> Union(%,"failed")
+--R reduce : % -> %                       ?rem? : (%,%) -> %
+--R retract : % -> Fraction(Integer)      retract : % -> Integer
+--R retract : % -> Kernel(%)              rootOf : Polynomial(%) -> %
+--R rootsOf : Polynomial(%) -> List(%)    sample : () -> %
+--R sizeLess? : (%,%) -> Boolean          sqrt : % -> %
+--R squareFree : % -> Factored(%)         squareFreePart : % -> %
+--R subst : (%,Equation(%)) -> %          tower : % -> List(Kernel(%))
+--R trueEqual : (%,%) -> Boolean          unit? : % -> Boolean
+--R unitCanonical : % -> %                zero? : % -> Boolean
+--R zeroOf : Polynomial(%) -> %           zerosOf : Polynomial(%) -> List(%)
+--R ?~=? : (%,%) -> Boolean              
+--R characteristic : () -> NonNegativeInteger
+--R coerce : SparseMultivariatePolynomial(Integer,Kernel(%)) -> %
+--R definingPolynomial : % -> % if $ has RING
+--R denom : % -> SparseMultivariatePolynomial(Integer,Kernel(%))
+--R differentiate : (%,NonNegativeInteger) -> %
+--R divide : (%,%) -> Record(quotient: %,remainder: %)
+--R elt : (BasicOperator,%,%,%,%) -> %
+--R euclideanSize : % -> NonNegativeInteger
+--R eval : (%,BasicOperator,(% -> %)) -> %
+--R eval : (%,BasicOperator,(List(%) -> %)) -> %
+--R eval : (%,List(BasicOperator),List((List(%) -> %))) -> %
+--R eval : (%,List(BasicOperator),List((% -> %))) -> %
+--R eval : (%,Symbol,(List(%) -> %)) -> %
+--R eval : (%,List(Symbol),List((List(%) -> %))) -> %
+--R eval : (%,List(Symbol),List((% -> %))) -> %
+--R eval : (%,List(Kernel(%)),List(%)) -> %
+--R even? : % -> Boolean if $ has RETRACT(INT)
+--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 kernel : (BasicOperator,List(%)) -> %
+--R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %)
+--R mainKernel : % -> Union(Kernel(%),"failed")
+--R minPoly : Kernel(%) -> SparseUnivariatePolynomial(%) if $ has RING
+--R multiEuclidean : (List(%),%) -> Union(List(%),"failed")
+--R norm : (SparseUnivariatePolynomial(%),List(Kernel(%))) -> SparseUnivariatePolynomial(%)
+--R norm : (SparseUnivariatePolynomial(%),Kernel(%)) -> SparseUnivariatePolynomial(%)
+--R numer : % -> SparseMultivariatePolynomial(Integer,Kernel(%))
+--R odd? : % -> Boolean if $ has RETRACT(INT)
+--R operator : BasicOperator -> BasicOperator
+--R operators : % -> List(BasicOperator)
+--R principalIdeal : List(%) -> Record(coef: List(%),generator: %)
+--R reducedSystem : Matrix(%) -> Matrix(Fraction(Integer))
+--R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Fraction(Integer)),vec: Vector(Fraction(Integer)))
+--R reducedSystem : Matrix(%) -> Matrix(Integer)
+--R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer))
+--R retractIfCan : % -> Union(Fraction(Integer),"failed")
+--R retractIfCan : % -> Union(Integer,"failed")
+--R retractIfCan : % -> Union(Kernel(%),"failed")
+--R rootOf : SparseUnivariatePolynomial(%) -> %
+--R rootOf : (SparseUnivariatePolynomial(%),Symbol) -> %
+--R rootsOf : SparseUnivariatePolynomial(%) -> List(%)
+--R rootsOf : (SparseUnivariatePolynomial(%),Symbol) -> List(%)
+--R subst : (%,List(Kernel(%)),List(%)) -> %
+--R subst : (%,List(Equation(%))) -> %
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R unitNormal : % -> Record(unit: %,canonical: %,associate: %)
+--R zeroOf : SparseUnivariatePolynomial(%) -> %
+--R zeroOf : (SparseUnivariatePolynomial(%),Symbol) -> %
+--R zerosOf : SparseUnivariatePolynomial(%) -> List(%)
+--R zerosOf : (SparseUnivariatePolynomial(%),Symbol) -> List(%)
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{IndexedOneDimensionalArray.help}
+\begin{chunk}{InnerAlgebraicNumber.help}
 ====================================================================
-IndexedOneDimensionalArray examples
+InnerAlgebraicNumber examples
 ====================================================================
 
-This is the basic one dimensional array data type.
+Algebraic closure of the rational numbers.
 
 See Also:
-o )show IndexedOneDimensionalArray
+o )show InnerAlgebraicNumber
 
 \end{chunk}
 
-\pagehead{IndexedOneDimensionalArray}{IARRAY1}
-\pagepic{ps/v103indexedonedimensionalarray.ps}{IARRAY1}{1.00}
+\pagehead{InnerAlgebraicNumber}{IAN}
+\pagepic{ps/v103inneralgebraicnumber.ps}{IAN}{1.00}
 {\bf See}\\
-\pageto{PrimitiveArray}{PRIMARR}
-\pageto{Tuple}{TUPLE}
-\pageto{IndexedFlexibleArray}{IFARRAY}
-\pageto{FlexibleArray}{FARRAY}
-\pageto{OneDimensionalArray}{ARRAY1}
+\pageto{AlgebraicNumber}{AN}
 
 {\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{IARRAY1}{concat} &
-\cross{IARRAY1}{construct} &
-\cross{IARRAY1}{copy} &
-\cross{IARRAY1}{delete} &
-\cross{IARRAY1}{elt} \\
-\cross{IARRAY1}{empty} &
-\cross{IARRAY1}{empty?} &
-\cross{IARRAY1}{entries} &
-\cross{IARRAY1}{eq?} &
-\cross{IARRAY1}{index?} \\
-\cross{IARRAY1}{indices} &
-\cross{IARRAY1}{insert} &
-\cross{IARRAY1}{insert} &
-\cross{IARRAY1}{map} &
-\cross{IARRAY1}{map} \\
-\cross{IARRAY1}{new} &
-\cross{IARRAY1}{qelt} &
-\cross{IARRAY1}{reverse} &
-\cross{IARRAY1}{sample} &
-\cross{IARRAY1}{any?} \\
-\cross{IARRAY1}{coerce} &
-\cross{IARRAY1}{convert} &
-\cross{IARRAY1}{copyInto!} &
-\cross{IARRAY1}{count} &
-\cross{IARRAY1}{count} \\
-\cross{IARRAY1}{delete} &
-\cross{IARRAY1}{entry?} &
-\cross{IARRAY1}{eval} &
-\cross{IARRAY1}{eval} &
-\cross{IARRAY1}{eval} \\
-\cross{IARRAY1}{eval} &
-\cross{IARRAY1}{every?} &
-\cross{IARRAY1}{fill!} &
-\cross{IARRAY1}{find} &
-\cross{IARRAY1}{first} \\
-\cross{IARRAY1}{hash} &
-\cross{IARRAY1}{latex} &
-\cross{IARRAY1}{less?} &
-\cross{IARRAY1}{map!} &
-\cross{IARRAY1}{max} \\
-\cross{IARRAY1}{maxIndex} &
-\cross{IARRAY1}{member?} &
-\cross{IARRAY1}{members} &
-\cross{IARRAY1}{merge} &
-\cross{IARRAY1}{merge} \\
-\cross{IARRAY1}{min} &
-\cross{IARRAY1}{minIndex} &
-\cross{IARRAY1}{more?} &
-\cross{IARRAY1}{parts} &
-\cross{IARRAY1}{position} \\
-\cross{IARRAY1}{position} &
-\cross{IARRAY1}{position} &
-\cross{IARRAY1}{qsetelt!} &
-\cross{IARRAY1}{reduce} &
-\cross{IARRAY1}{reduce} \\
-\cross{IARRAY1}{reduce} &
-\cross{IARRAY1}{remove} &
-\cross{IARRAY1}{remove} &
-\cross{IARRAY1}{removeDuplicates} &
-\cross{IARRAY1}{reverse!} \\
-\cross{IARRAY1}{select} &
-\cross{IARRAY1}{setelt} &
-\cross{IARRAY1}{setelt} &
-\cross{IARRAY1}{size?} &
-\cross{IARRAY1}{sort} \\
-\cross{IARRAY1}{sort} &
-\cross{IARRAY1}{sort!} &
-\cross{IARRAY1}{sort!} &
-\cross{IARRAY1}{sorted?} &
-\cross{IARRAY1}{sorted?} \\
-\cross{IARRAY1}{swap!} &
-\cross{IARRAY1}{\#{}?} &
-\cross{IARRAY1}{?$<$?} &
-\cross{IARRAY1}{?$<=$?} &
-\cross{IARRAY1}{?=?} \\
-\cross{IARRAY1}{?$>$?} &
-\cross{IARRAY1}{?$>=$?} &
-\cross{IARRAY1}{?\~{}=?} &
-\cross{IARRAY1}{?.?} &
+\begin{tabular}{llll}
+\cross{IAN}{0} &
+\cross{IAN}{1} &
+\cross{IAN}{associates?} &
+\cross{IAN}{belong?} \\
+\cross{IAN}{box} &
+\cross{IAN}{characteristic} &
+\cross{IAN}{coerce} &
+\cross{IAN}{convert} \\
+\cross{IAN}{D} &
+\cross{IAN}{definingPolynomial} &
+\cross{IAN}{denom} &
+\cross{IAN}{differentiate} \\
+\cross{IAN}{distribute} &
+\cross{IAN}{divide} &
+\cross{IAN}{elt} &
+\cross{IAN}{euclideanSize} \\
+\cross{IAN}{eval} &
+\cross{IAN}{even?} &
+\cross{IAN}{expressIdealMember} &
+\cross{IAN}{exquo} \\
+\cross{IAN}{extendedEuclidean} &
+\cross{IAN}{factor} &
+\cross{IAN}{freeOf?} &
+\cross{IAN}{gcd} \\
+\cross{IAN}{gcdPolynomial} &
+\cross{IAN}{hash} &
+\cross{IAN}{height} &
+\cross{IAN}{inv} \\
+\cross{IAN}{is?} &
+\cross{IAN}{kernel} &
+\cross{IAN}{kernels} &
+\cross{IAN}{latex} \\
+\cross{IAN}{lcm} &
+\cross{IAN}{mainKernel} &
+\cross{IAN}{map} &
+\cross{IAN}{max} \\
+\cross{IAN}{min} &
+\cross{IAN}{minPoly} &
+\cross{IAN}{multiEuclidean} &
+\cross{IAN}{norm} \\
+\cross{IAN}{nthRoot} &
+\cross{IAN}{numer} &
+\cross{IAN}{odd?} &
+\cross{IAN}{one?} \\
+\cross{IAN}{operator} &
+\cross{IAN}{operators} &
+\cross{IAN}{paren} &
+\cross{IAN}{prime?} \\
+\cross{IAN}{principalIdeal} &
+\cross{IAN}{recip} &
+\cross{IAN}{reduce} &
+\cross{IAN}{reducedSystem} \\
+\cross{IAN}{retract} &
+\cross{IAN}{retractIfCan} &
+\cross{IAN}{rootOf} &
+\cross{IAN}{rootsOf} \\
+\cross{IAN}{sample} &
+\cross{IAN}{sizeLess?} &
+\cross{IAN}{sqrt} &
+\cross{IAN}{squareFree} \\
+\cross{IAN}{squareFreePart} &
+\cross{IAN}{subst} &
+\cross{IAN}{subtractIfCan} &
+\cross{IAN}{tower} \\
+\cross{IAN}{trueEqual} &
+\cross{IAN}{unit?} &
+\cross{IAN}{unitCanonical} &
+\cross{IAN}{unitNormal} \\
+\cross{IAN}{zero?} &
+\cross{IAN}{zeroOf} &
+\cross{IAN}{zerosOf} &
+\cross{IAN}{?*?} \\
+\cross{IAN}{?**?} &
+\cross{IAN}{?+?} &
+\cross{IAN}{-?} &
+\cross{IAN}{?-?} \\
+\cross{IAN}{?/?} &
+\cross{IAN}{?$<$?} &
+\cross{IAN}{?$<=$?} &
+\cross{IAN}{?=?} \\
+\cross{IAN}{?$>$?} &
+\cross{IAN}{?$>=$?} &
+\cross{IAN}{?\^{}?} &
+\cross{IAN}{?\~{}=?} \\
+\cross{IAN}{?*?} &
+\cross{IAN}{?**?} &
+\cross{IAN}{?quo?} &
+\cross{IAN}{?rem?} 
 \end{tabular}
 
-\begin{chunk}{domain IARRAY1 IndexedOneDimensionalArray}
-)abbrev domain IARRAY1 IndexedOneDimensionalArray
-++ Author Micheal Monagan Aug/87
-++ Description:
-++ This is the basic one dimensional array data type.
+\begin{chunk}{domain IAN InnerAlgebraicNumber}
+)abbrev domain IAN InnerAlgebraicNumber
+++ Author: Manuel Bronstein
+++ Date Created: 22 March 1988
+++ Date Last Updated: 4 October 1995 (JHD)
+++ Description: 
+++ Algebraic closure of the rational numbers.
+
+InnerAlgebraicNumber(): Exports == Implementation where
+  Z   ==> Integer
+  FE  ==> Expression Z
+  K   ==> Kernel %
+  P   ==> SparseMultivariatePolynomial(Z, K)
+  ALGOP ==> "%alg"
+  SUP ==>  SparseUnivariatePolynomial
+
+  Exports ==> Join(ExpressionSpace, AlgebraicallyClosedField,
+                   RetractableTo Z, RetractableTo Fraction Z,
+                   LinearlyExplicitRingOver Z, RealConstant,
+                   LinearlyExplicitRingOver Fraction Z,
+                   CharacteristicZero,
+                   ConvertibleTo Complex Float, DifferentialRing) with
+    coerce : P -> %
+      ++ coerce(p) returns p viewed as an algebraic number.
+    numer  : % -> P
+      ++ numer(f) returns the numerator of f viewed as a
+      ++ polynomial in the kernels over Z.
+    denom  : % -> P
+      ++ denom(f) returns the denominator of f viewed as a
+      ++ polynomial in the kernels over Z.
+    reduce : % -> %
+      ++ reduce(f) simplifies all the unreduced algebraic numbers
+      ++ present in f by applying their defining relations.
+    trueEqual : (%,%) -> Boolean
+      ++ trueEqual(x,y) tries to determine if the two numbers are equal
+    norm : (SUP(%),Kernel %) -> SUP(%)
+      ++ norm(p,k) computes the norm of the polynomial p
+      ++ with respect to the extension generated by kernel k
+    norm : (SUP(%),List Kernel %) -> SUP(%)
+      ++ norm(p,l) computes the norm of the polynomial p
+      ++ with respect to the extension generated by kernels l
+    norm : (%,Kernel %) -> %
+      ++ norm(f,k) computes the norm of the algebraic number f
+      ++ with respect to the extension generated by kernel k
+    norm : (%,List Kernel %) -> %
+      ++ norm(f,l) computes the norm of the algebraic number f
+      ++ with respect to the extension generated by kernels l
+  Implementation ==> FE add
+
+    Rep := FE
+
+    -- private
+    mainRatDenom(f:%):% ==
+       ratDenom(f::Rep::FE)$AlgebraicManipulations(Integer, FE)::Rep::%
+
+    findDenominator(z:SUP %):Record(num:SUP %,den:%) ==
+       zz:=z
+       while not(zz=0) repeat
+          dd:=(denom leadingCoefficient zz)::%
+          not(dd=1) =>
+             rec:=findDenominator(dd*z)
+             return [rec.num,rec.den*dd]
+          zz:=reductum zz
+       [z,1]
+
+    makeUnivariate(p:P,k:Kernel %):SUP % ==
+      map(x+->x::%,univariate(p,k))$SparseUnivariatePolynomialFunctions2(P,%)
+
+    -- public
+    a,b:%
+
+    differentiate(x:%):% == 0
+
+    zero? a == zero? numer a
+
+    one? a == (numer a = 1) and (denom a = 1)
+
+    x:% / y:%        == mainRatDenom(x /$Rep y)
+
+    x:% ** n:Integer ==
+      n < 0 => mainRatDenom (x **$Rep n)
+      x **$Rep n
+
+    trueEqual(a,b) ==
+       -- if two algebraic numbers have the same norm (after deleting repeated
+       -- roots, then they are certainly conjugates. Note that we start with a
+       -- monic polynomial, so don't have to check for constant factors.
+       -- this will be fooled by sqrt(2) and -sqrt(2), but the = in
+       -- AlgebraicNumber knows what to do about this.
+       ka:=reverse tower a
+       kb:=reverse tower b
+       empty? ka and empty? kb => retract(a)@Fraction Z = retract(b)@Fraction Z
+       pa,pb:SparseUnivariatePolynomial %
+       pa:=monomial(1,1)-monomial(a,0)
+       pb:=monomial(1,1)-monomial(b,0)
+       na:=map(retract,norm(pa,ka))_
+         $SparseUnivariatePolynomialFunctions2(%,Fraction Z)
+       nb:=map(retract,norm(pb,kb))_
+         $SparseUnivariatePolynomialFunctions2(%,Fraction Z)
+       (sa:=squareFreePart(na)) = (sb:=squareFreePart(nb)) => true
+       g:=gcd(sa,sb)
+       (dg:=degree g) = 0 => false
+       -- of course, if these have a factor in common, then the
+       -- answer is really ambiguous, so we ought to be using Duval-type
+       -- technology
+       dg = degree sa or dg = degree sb => true
+       false
+
+    norm(z:%,k:Kernel %): % ==
+       p:=minPoly k
+       n:=makeUnivariate(numer z,k)
+       d:=makeUnivariate(denom z,k)
+       resultant(n,p)/resultant(d,p)
 
-IndexedOneDimensionalArray(S:Type, mn:Integer):
- OneDimensionalArrayAggregate S == add
-   Qmax ==> QVMAXINDEX$Lisp
-   Qsize ==> QVSIZE$Lisp
---   Qelt ==> QVELT$Lisp
---   Qsetelt ==> QSETVELT$Lisp
-   Qelt ==> ELT$Lisp
-   Qsetelt ==> SETELT$Lisp
---   Qelt1 ==> QVELT_-1$Lisp
---   Qsetelt1 ==> QSETVELT_-1$Lisp
-   Qnew ==> MAKE_-ARRAY$Lisp
-   I ==> Integer
+    norm(z:%,l:List Kernel %): % ==
+       for k in l repeat
+           z:=norm(z,k)
+       z
 
-   #x               == Qsize x
-   fill_!(x, s)     == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x)
-   minIndex x       == mn
+    norm(z:SUP %,k:Kernel %):SUP % ==
+       p:=map(x +-> x::SUP %,minPoly k)_
+         $SparseUnivariatePolynomialFunctions2(%,SUP %)
+       f:=findDenominator z
+       zz:=map(x +-> makeUnivariate(numer x,k),f.num)_
+         $SparseUnivariatePolynomialFunctions2( %,SUP %)
+       zz:=swap(zz)$CommuteUnivariatePolynomialCategory(%,SUP %,SUP SUP %)
+       resultant(p,zz)/norm(f.den,k)
 
-   empty()          == Qnew(0$Lisp)
-   new(n, s)        == fill_!(Qnew n,s)
+    norm(z:SUP %,l:List Kernel %): SUP % ==
+       for k in l repeat
+           z:=norm(z,k)
+       z
+    belong? op           == belong?(op)$ExpressionSpace_&(%) or has?(op, ALGOP)
 
-   map_!(f, s1)  ==
-      n:Integer := Qmax(s1)
-      n < 0 => s1
-      for i in 0..n repeat Qsetelt(s1, i, f(Qelt(s1,i)))
-      s1
+    convert(x:%):Float ==
+      retract map(y +-> y::Float, x pretend FE)$ExpressionFunctions2(Z,Float)
 
-   map(f, s1)       ==
-      n:Integer := Qmax(s1)
-      n < 0 => s1
-      ss2:% := Qnew(n+1)
-      for i in 0..n repeat Qsetelt(ss2, i, f(Qelt(s1,i)))
-      ss2
+    convert(x:%):DoubleFloat ==
+      retract map(y +-> y::DoubleFloat,x pretend FE)_
+        $ExpressionFunctions2(Z, DoubleFloat)
 
-   map(f, a, b)   ==
-      maxind:Integer := min(Qmax a, Qmax b)
-      maxind < 0 => empty()
-      c:% := Qnew(maxind+1)
-      for i in 0..maxind repeat
-        Qsetelt(c, i, f(Qelt(a,i),Qelt(b,i)))
-      c
+    convert(x:%):Complex(Float) ==
+      retract map(y +-> y::Complex(Float),x pretend FE)_
+        $ExpressionFunctions2(Z, Complex Float)
 
-   if zero? mn then
-     qelt(x, i)       == Qelt(x, i)
-     qsetelt_!(x, i, s) == Qsetelt(x, i, s)
+\end{chunk}
 
-     elt(x:%, i:I) ==
-       negative? i or i > maxIndex(x) => error "index out of range"
-       qelt(x, i)
+\begin{chunk}{COQ IAN}
+(* domain IAN *)
+(*
+ FE add
 
-     setelt(x:%, i:I, s:S) ==
-       negative? i or i > maxIndex(x) => error "index out of range"
-       qsetelt_!(x, i, s)
+    Rep := FE
 
---   else if one? mn then
-   else if (mn = 1) then
-     maxIndex x       == Qsize x
-     qelt(x, i)       == Qelt(x, i-1)
-     qsetelt_!(x, i, s) == Qsetelt(x, i-1, s)
+    -- private
+    mainRatDenom(f:%):% ==
+       ratDenom(f::Rep::FE)$AlgebraicManipulations(Integer, FE)::Rep::%
 
-     elt(x:%, i:I) ==
-       QSLESSP(i,1$Lisp)$Lisp or QSLESSP(Qsize x,i)$Lisp =>
-         error "index out of range"
-       Qelt(x, i-1)
+    findDenominator(z:SUP %):Record(num:SUP %,den:%) ==
+       zz:=z
+       while not(zz=0) repeat
+          dd:=(denom leadingCoefficient zz)::%
+          not(dd=1) =>
+             rec:=findDenominator(dd*z)
+             return [rec.num,rec.den*dd]
+          zz:=reductum zz
+       [z,1]
 
-     setelt(x:%, i:I, s:S) ==
-       QSLESSP(i,1$Lisp)$Lisp or QSLESSP(Qsize x,i)$Lisp =>
-         error "index out of range"
-       Qsetelt(x, i-1, s)
+    makeUnivariate(p:P,k:Kernel %):SUP % ==
+      map(x+->x::%,univariate(p,k))$SparseUnivariatePolynomialFunctions2(P,%)
 
-    else
-       qelt(x, i)       == Qelt(x, i - mn)
-       qsetelt_!(x, i, s) == Qsetelt(x, i - mn, s)
+    -- public
+    a,b:%
 
-       elt(x:%, i:I) ==
-         i < mn or i > maxIndex(x) => error "index out of range"
-         qelt(x, i)
+    differentiate(x:%):% == 0
 
-       setelt(x:%, i:I, s:S) ==
-         i < mn or i > maxIndex(x) => error "index out of range"
-         qsetelt_!(x, i, s)
+    zero? a == zero? numer a
 
-\end{chunk}
+    one? a == (numer a = 1) and (denom a = 1)
+
+    x:% / y:%        == mainRatDenom(x /$Rep y)
+
+    x:% ** n:Integer ==
+      n < 0 => mainRatDenom (x **$Rep n)
+      x **$Rep n
+
+    trueEqual(a,b) ==
+       -- if two algebraic numbers have the same norm (after deleting repeated
+       -- roots, then they are certainly conjugates. Note that we start with a
+       -- monic polynomial, so don't have to check for constant factors.
+       -- this will be fooled by sqrt(2) and -sqrt(2), but the = in
+       -- AlgebraicNumber knows what to do about this.
+       ka:=reverse tower a
+       kb:=reverse tower b
+       empty? ka and empty? kb => retract(a)@Fraction Z = retract(b)@Fraction Z
+       pa,pb:SparseUnivariatePolynomial %
+       pa:=monomial(1,1)-monomial(a,0)
+       pb:=monomial(1,1)-monomial(b,0)
+       na:=map(retract,norm(pa,ka))_
+         $SparseUnivariatePolynomialFunctions2(%,Fraction Z)
+       nb:=map(retract,norm(pb,kb))_
+         $SparseUnivariatePolynomialFunctions2(%,Fraction Z)
+       (sa:=squareFreePart(na)) = (sb:=squareFreePart(nb)) => true
+       g:=gcd(sa,sb)
+       (dg:=degree g) = 0 => false
+       -- of course, if these have a factor in common, then the
+       -- answer is really ambiguous, so we ought to be using Duval-type
+       -- technology
+       dg = degree sa or dg = degree sb => true
+       false
+
+    norm(z:%,k:Kernel %): % ==
+       p:=minPoly k
+       n:=makeUnivariate(numer z,k)
+       d:=makeUnivariate(denom z,k)
+       resultant(n,p)/resultant(d,p)
+
+    norm(z:%,l:List Kernel %): % ==
+       for k in l repeat
+           z:=norm(z,k)
+       z
+
+    norm(z:SUP %,k:Kernel %):SUP % ==
+       p:=map(x +-> x::SUP %,minPoly k)_
+         $SparseUnivariatePolynomialFunctions2(%,SUP %)
+       f:=findDenominator z
+       zz:=map(x +-> makeUnivariate(numer x,k),f.num)_
+         $SparseUnivariatePolynomialFunctions2( %,SUP %)
+       zz:=swap(zz)$CommuteUnivariatePolynomialCategory(%,SUP %,SUP SUP %)
+       resultant(p,zz)/norm(f.den,k)
+
+    norm(z:SUP %,l:List Kernel %): SUP % ==
+       for k in l repeat
+           z:=norm(z,k)
+       z
+    belong? op           == belong?(op)$ExpressionSpace_&(%) or has?(op, ALGOP)
+
+    convert(x:%):Float ==
+      retract map(y +-> y::Float, x pretend FE)$ExpressionFunctions2(Z,Float)
+
+    convert(x:%):DoubleFloat ==
+      retract map(y +-> y::DoubleFloat,x pretend FE)_
+        $ExpressionFunctions2(Z, DoubleFloat)
+
+    convert(x:%):Complex(Float) ==
+      retract map(y +-> y::Complex(Float),x pretend FE)_
+        $ExpressionFunctions2(Z, Complex Float)
 
-\begin{chunk}{COQ IARRAY1}
-(* domain IARRAY1 *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{IARRAY1.dotabb}
-"IARRAY1" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IARRAY1"]
-"A1AGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=A1AGG"]
-"IARRAY1" -> "A1AGG"
+\begin{chunk}{IAN.dotabb}
+"IAN" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IAN"]
+"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
+"COMPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=COMPCAT"]
+"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"]
+"IAN" -> "ACF"
+"IAN" -> "FS"
+"IAN" -> "COMPCAT"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain ISTRING IndexedString}
+\section{domain IFF InnerFiniteField}
 
-\begin{chunk}{IndexedString.input}
+\begin{chunk}{InnerFiniteField.input}
 )set break resume
-)sys rm -f IndexedString.output
-)spool IndexedString.output
+)sys rm -f InnerFiniteField.output
+)spool InnerFiniteField.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show IndexedString
+)show InnerFiniteField
 --R 
---R IndexedString(mn: Integer)  is a domain constructor
---R Abbreviation for IndexedString is ISTRING 
+--R InnerFiniteField(p: PositiveInteger,n: PositiveInteger)  is a domain constructor
+--R Abbreviation for InnerFiniteField is IFF 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for ISTRING 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IFF 
 --R
 --R------------------------------- Operations --------------------------------
---R coerce : Character -> %               concat : List(%) -> %
---R concat : (%,%) -> %                   concat : (Character,%) -> %
---R concat : (%,Character) -> %           construct : List(Character) -> %
---R copy : % -> %                         delete : (%,Integer) -> %
---R ?.? : (%,%) -> %                      ?.? : (%,Integer) -> Character
---R empty : () -> %                       empty? : % -> Boolean
---R entries : % -> List(Character)        eq? : (%,%) -> Boolean
---R hash : % -> Integer                   index? : (Integer,%) -> Boolean
---R indices : % -> List(Integer)          insert : (%,%,Integer) -> %
---R leftTrim : (%,CharacterClass) -> %    leftTrim : (%,Character) -> %
---R lowerCase : % -> %                    lowerCase! : % -> %
---R prefix? : (%,%) -> Boolean            qelt : (%,Integer) -> Character
---R reverse : % -> %                      rightTrim : (%,Character) -> %
---R sample : () -> %                      split : (%,Character) -> List(%)
---R suffix? : (%,%) -> Boolean            trim : (%,CharacterClass) -> %
---R trim : (%,Character) -> %             upperCase : % -> %
---R upperCase! : % -> %                  
---R #? : % -> NonNegativeInteger if $ has finiteAggregate
---R ?<? : (%,%) -> Boolean if Character has ORDSET
---R ?<=? : (%,%) -> Boolean if Character has ORDSET
---R ?=? : (%,%) -> Boolean if Character has SETCAT
---R ?>? : (%,%) -> Boolean if Character has ORDSET
---R ?>=? : (%,%) -> Boolean if Character has ORDSET
---R any? : ((Character -> Boolean),%) -> Boolean if $ has finiteAggregate
---R coerce : % -> OutputForm if Character has SETCAT
---R convert : % -> InputForm if Character has KONVERT(INFORM)
---R copyInto! : (%,%,Integer) -> % if $ has shallowlyMutable
---R count : (Character,%) -> NonNegativeInteger if $ has finiteAggregate and Character has SETCAT
---R count : ((Character -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R delete : (%,UniversalSegment(Integer)) -> %
---R ?.? : (%,UniversalSegment(Integer)) -> %
---R elt : (%,Integer,Character) -> Character
---R entry? : (Character,%) -> Boolean if $ has finiteAggregate and Character has SETCAT
---R eval : (%,List(Character),List(Character)) -> % if Character has EVALAB(CHAR) and Character has SETCAT
---R eval : (%,Character,Character) -> % if Character has EVALAB(CHAR) and Character has SETCAT
---R eval : (%,Equation(Character)) -> % if Character has EVALAB(CHAR) and Character has SETCAT
---R eval : (%,List(Equation(Character))) -> % if Character has EVALAB(CHAR) and Character has SETCAT
---R every? : ((Character -> Boolean),%) -> Boolean if $ has finiteAggregate
---R fill! : (%,Character) -> % if $ has shallowlyMutable
---R find : ((Character -> Boolean),%) -> Union(Character,"failed")
---R first : % -> Character if Integer has ORDSET
---R hash : % -> SingleInteger if Character has SETCAT
---R insert : (Character,%,Integer) -> %
---R latex : % -> String if Character has SETCAT
---R less? : (%,NonNegativeInteger) -> Boolean
---R map : (((Character,Character) -> Character),%,%) -> %
---R map : ((Character -> Character),%) -> %
---R map! : ((Character -> Character),%) -> % if $ has shallowlyMutable
---R match : (%,%,Character) -> NonNegativeInteger
---R match? : (%,%,Character) -> Boolean
---R max : (%,%) -> % if Character has ORDSET
---R maxIndex : % -> Integer if Integer has ORDSET
---R member? : (Character,%) -> Boolean if $ has finiteAggregate and Character has SETCAT
---R members : % -> List(Character) if $ has finiteAggregate
---R merge : (%,%) -> % if Character has ORDSET
---R merge : (((Character,Character) -> Boolean),%,%) -> %
---R min : (%,%) -> % if Character has ORDSET
---R minIndex : % -> Integer if Integer has ORDSET
---R more? : (%,NonNegativeInteger) -> Boolean
---R new : (NonNegativeInteger,Character) -> %
---R parts : % -> List(Character) if $ has finiteAggregate
---R position : (CharacterClass,%,Integer) -> Integer
---R position : (%,%,Integer) -> Integer
---R position : (Character,%,Integer) -> Integer if Character has SETCAT
---R position : (Character,%) -> Integer if Character has SETCAT
---R position : ((Character -> Boolean),%) -> Integer
---R qsetelt! : (%,Integer,Character) -> Character if $ has shallowlyMutable
---R reduce : (((Character,Character) -> Character),%) -> Character if $ has finiteAggregate
---R reduce : (((Character,Character) -> Character),%,Character) -> Character if $ has finiteAggregate
---R reduce : (((Character,Character) -> Character),%,Character,Character) -> Character if $ has finiteAggregate and Character has SETCAT
---R remove : ((Character -> Boolean),%) -> % if $ has finiteAggregate
---R remove : (Character,%) -> % if $ has finiteAggregate and Character has SETCAT
---R removeDuplicates : % -> % if $ has finiteAggregate and Character has SETCAT
---R replace : (%,UniversalSegment(Integer),%) -> %
---R reverse! : % -> % if $ has shallowlyMutable
---R rightTrim : (%,CharacterClass) -> %
---R select : ((Character -> Boolean),%) -> % if $ has finiteAggregate
---R setelt : (%,UniversalSegment(Integer),Character) -> Character if $ has shallowlyMutable
---R setelt : (%,Integer,Character) -> Character if $ has shallowlyMutable
---R size? : (%,NonNegativeInteger) -> Boolean
---R sort : % -> % if Character has ORDSET
---R sort : (((Character,Character) -> Boolean),%) -> %
---R sort! : % -> % if $ has shallowlyMutable and Character has ORDSET
---R sort! : (((Character,Character) -> Boolean),%) -> % if $ has shallowlyMutable
---R sorted? : % -> Boolean if Character has ORDSET
---R sorted? : (((Character,Character) -> Boolean),%) -> Boolean
---R split : (%,CharacterClass) -> List(%)
---R substring? : (%,%,Integer) -> Boolean
---R swap! : (%,Integer,Integer) -> Void if $ has shallowlyMutable
---R ?~=? : (%,%) -> Boolean if Character has SETCAT
+--R ?*? : (InnerPrimeField(p),%) -> %     ?*? : (%,InnerPrimeField(p)) -> %
+--R ?*? : (Fraction(Integer),%) -> %      ?*? : (%,Fraction(Integer)) -> %
+--R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
+--R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
+--R ?**? : (%,Integer) -> %               ?**? : (%,NonNegativeInteger) -> %
+--R ?**? : (%,PositiveInteger) -> %       ?+? : (%,%) -> %
+--R ?-? : (%,%) -> %                      -? : % -> %
+--R ?/? : (%,InnerPrimeField(p)) -> %     ?/? : (%,%) -> %
+--R ?=? : (%,%) -> Boolean                1 : () -> %
+--R 0 : () -> %                           ?^? : (%,Integer) -> %
+--R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
+--R algebraic? : % -> Boolean             associates? : (%,%) -> Boolean
+--R basis : () -> Vector(%)               coerce : InnerPrimeField(p) -> %
+--R coerce : Fraction(Integer) -> %       coerce : % -> %
+--R coerce : Integer -> %                 coerce : % -> OutputForm
+--R degree : % -> PositiveInteger         dimension : () -> CardinalNumber
+--R factor : % -> Factored(%)             gcd : List(%) -> %
+--R gcd : (%,%) -> %                      hash : % -> SingleInteger
+--R inGroundField? : % -> Boolean         inv : % -> %
+--R latex : % -> String                   lcm : List(%) -> %
+--R lcm : (%,%) -> %                      norm : % -> InnerPrimeField(p)
+--R one? : % -> Boolean                   prime? : % -> Boolean
+--R ?quo? : (%,%) -> %                    recip : % -> Union(%,"failed")
+--R ?rem? : (%,%) -> %                    retract : % -> InnerPrimeField(p)
+--R sample : () -> %                      sizeLess? : (%,%) -> Boolean
+--R squareFree : % -> Factored(%)         squareFreePart : % -> %
+--R trace : % -> InnerPrimeField(p)       transcendent? : % -> Boolean
+--R unit? : % -> Boolean                  unitCanonical : % -> %
+--R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
+--R D : (%,NonNegativeInteger) -> % if InnerPrimeField(p) has FINITE
+--R D : % -> % if InnerPrimeField(p) has FINITE
+--R Frobenius : (%,NonNegativeInteger) -> % if InnerPrimeField(p) has FINITE
+--R Frobenius : % -> % if InnerPrimeField(p) has FINITE
+--R basis : PositiveInteger -> Vector(%)
+--R characteristic : () -> NonNegativeInteger
+--R charthRoot : % -> Union(%,"failed") if InnerPrimeField(p) has CHARNZ or InnerPrimeField(p) has FINITE
+--R charthRoot : % -> % if InnerPrimeField(p) has FINITE
+--R conditionP : Matrix(%) -> Union(Vector(%),"failed") if InnerPrimeField(p) has FINITE
+--R coordinates : Vector(%) -> Matrix(InnerPrimeField(p))
+--R coordinates : % -> Vector(InnerPrimeField(p))
+--R createNormalElement : () -> % if InnerPrimeField(p) has FINITE
+--R createPrimitiveElement : () -> % if InnerPrimeField(p) has FINITE
+--R definingPolynomial : () -> SparseUnivariatePolynomial(InnerPrimeField(p))
+--R degree : % -> OnePointCompletion(PositiveInteger)
+--R differentiate : (%,NonNegativeInteger) -> % if InnerPrimeField(p) has FINITE
+--R differentiate : % -> % if InnerPrimeField(p) has FINITE
+--R discreteLog : (%,%) -> Union(NonNegativeInteger,"failed") if InnerPrimeField(p) has CHARNZ or InnerPrimeField(p) has FINITE
+--R discreteLog : % -> NonNegativeInteger if InnerPrimeField(p) has FINITE
+--R divide : (%,%) -> Record(quotient: %,remainder: %)
+--R enumerate : () -> List(%) if InnerPrimeField(p) has FINITE
+--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 extensionDegree : () -> PositiveInteger
+--R extensionDegree : () -> OnePointCompletion(PositiveInteger)
+--R factorsOfCyclicGroupSize : () -> List(Record(factor: Integer,exponent: Integer)) if InnerPrimeField(p) has FINITE
+--R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%)
+--R generator : () -> % if InnerPrimeField(p) has FINITE
+--R index : PositiveInteger -> % if InnerPrimeField(p) has FINITE
+--R init : () -> % if InnerPrimeField(p) has FINITE
+--R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %)
+--R linearAssociatedExp : (%,SparseUnivariatePolynomial(InnerPrimeField(p))) -> % if InnerPrimeField(p) has FINITE
+--R linearAssociatedLog : (%,%) -> Union(SparseUnivariatePolynomial(InnerPrimeField(p)),"failed") if InnerPrimeField(p) has FINITE
+--R linearAssociatedLog : % -> SparseUnivariatePolynomial(InnerPrimeField(p)) if InnerPrimeField(p) has FINITE
+--R linearAssociatedOrder : % -> SparseUnivariatePolynomial(InnerPrimeField(p)) if InnerPrimeField(p) has FINITE
+--R lookup : % -> PositiveInteger if InnerPrimeField(p) has FINITE
+--R minimalPolynomial : (%,PositiveInteger) -> SparseUnivariatePolynomial(%) if InnerPrimeField(p) has FINITE
+--R minimalPolynomial : % -> SparseUnivariatePolynomial(InnerPrimeField(p))
+--R multiEuclidean : (List(%),%) -> Union(List(%),"failed")
+--R nextItem : % -> Union(%,"failed") if InnerPrimeField(p) has FINITE
+--R norm : (%,PositiveInteger) -> % if InnerPrimeField(p) has FINITE
+--R normal? : % -> Boolean if InnerPrimeField(p) has FINITE
+--R normalElement : () -> % if InnerPrimeField(p) has FINITE
+--R order : % -> OnePointCompletion(PositiveInteger) if InnerPrimeField(p) has CHARNZ or InnerPrimeField(p) has FINITE
+--R order : % -> PositiveInteger if InnerPrimeField(p) has FINITE
+--R primeFrobenius : % -> % if InnerPrimeField(p) has CHARNZ or InnerPrimeField(p) has FINITE
+--R primeFrobenius : (%,NonNegativeInteger) -> % if InnerPrimeField(p) has CHARNZ or InnerPrimeField(p) has FINITE
+--R primitive? : % -> Boolean if InnerPrimeField(p) has FINITE
+--R primitiveElement : () -> % if InnerPrimeField(p) has FINITE
+--R principalIdeal : List(%) -> Record(coef: List(%),generator: %)
+--R random : () -> % if InnerPrimeField(p) has FINITE
+--R representationType : () -> Union("prime",polynomial,normal,cyclic) if InnerPrimeField(p) has FINITE
+--R represents : Vector(InnerPrimeField(p)) -> %
+--R retractIfCan : % -> Union(InnerPrimeField(p),"failed")
+--R size : () -> NonNegativeInteger if InnerPrimeField(p) has FINITE
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R tableForDiscreteLogarithm : Integer -> Table(PositiveInteger,NonNegativeInteger) if InnerPrimeField(p) has FINITE
+--R trace : (%,PositiveInteger) -> % if InnerPrimeField(p) has FINITE
+--R transcendenceDegree : () -> NonNegativeInteger
+--R unitNormal : % -> Record(unit: %,canonical: %,associate: %)
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{IndexedString.help}
+\begin{chunk}{InnerFiniteField.help}
 ====================================================================
-IndexedString examples
+InnerFiniteField examples
 ====================================================================
 
-This domain implements low-level strings
+InnerFiniteField(p,n) implements finite fields with p**n elements
+where p is assumed prime but does not check.
+For a version which checks that p is prime, see FiniteField.
 
 See Also:
-o )show IndexedString
+o )show InnerFiniteField
+o )show FiniteField
 
 \end{chunk}
 
-\pagehead{IndexedString}{ISTRING}
-\pagepic{ps/v103indexedstring.ps}{ISTRING}{1.00}
+\pagehead{InnerFiniteField}{IFF}
+\pagepic{ps/v103innerfinitefield.ps}{IFF}{1.00}
 {\bf See}\\
-\pageto{Character}{CHAR}
-\pageto{CharacterClass}{CCLASS}
-\pageto{String}{STRING}
+\pageto{FiniteFieldExtensionByPolynomial}{FFP}
+\pageto{FiniteFieldExtension}{FFX}
+\pageto{FiniteField}{FF}
 
 {\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{ISTRING}{any?} &
-\cross{ISTRING}{coerce} &
-\cross{ISTRING}{concat} &
-\cross{ISTRING}{construct} &
-\cross{ISTRING}{convert} \\
-\cross{ISTRING}{copy} &
-\cross{ISTRING}{copyInto!} &
-\cross{ISTRING}{count} &
-\cross{ISTRING}{delete} &
-\cross{ISTRING}{elt} \\
-\cross{ISTRING}{empty} &
-\cross{ISTRING}{empty?} &
-\cross{ISTRING}{entries} &
-\cross{ISTRING}{entry?} &
-\cross{ISTRING}{eq?} \\
-\cross{ISTRING}{eval} &
-\cross{ISTRING}{every?} &
-\cross{ISTRING}{fill!} &
-\cross{ISTRING}{find} &
-\cross{ISTRING}{first} \\
-\cross{ISTRING}{hash} &
-\cross{ISTRING}{index?} &
-\cross{ISTRING}{indices} &
-\cross{ISTRING}{insert} &
-\cross{ISTRING}{latex} \\
-\cross{ISTRING}{leftTrim} &
-\cross{ISTRING}{less?} &
-\cross{ISTRING}{lowerCase} &
-\cross{ISTRING}{lowerCase!} &
-\cross{ISTRING}{map} \\
-\cross{ISTRING}{map!} &
-\cross{ISTRING}{match} &
-\cross{ISTRING}{match?} &
-\cross{ISTRING}{max} &
-\cross{ISTRING}{maxIndex} \\
-\cross{ISTRING}{member?} &
-\cross{ISTRING}{members} &
-\cross{ISTRING}{merge} &
-\cross{ISTRING}{min} &
-\cross{ISTRING}{minIndex} \\
-\cross{ISTRING}{more?} &
-\cross{ISTRING}{new} &
-\cross{ISTRING}{parts} &
-\cross{ISTRING}{prefix?} &
-\cross{ISTRING}{position} \\
-\cross{ISTRING}{qelt} &
-\cross{ISTRING}{qsetelt!} &
-\cross{ISTRING}{reduce} &
-\cross{ISTRING}{remove} &
-\cross{ISTRING}{removeDuplicates} \\
-\cross{ISTRING}{replace} &
-\cross{ISTRING}{reverse} &
-\cross{ISTRING}{reverse!} &
-\cross{ISTRING}{rightTrim} &
-\cross{ISTRING}{sample} \\
-\cross{ISTRING}{select} &
-\cross{ISTRING}{setelt} &
-\cross{ISTRING}{size?} &
-\cross{ISTRING}{sort} &
-\cross{ISTRING}{sort!} \\
-\cross{ISTRING}{sorted?} &
-\cross{ISTRING}{split} &
-\cross{ISTRING}{suffix?} &
-\cross{ISTRING}{substring?} &
-\cross{ISTRING}{swap!} \\
-\cross{ISTRING}{trim} &
-\cross{ISTRING}{upperCase} &
-\cross{ISTRING}{upperCase!} &
-\cross{ISTRING}{\#{}?} &
-\cross{ISTRING}{?$<$?} \\
-\cross{ISTRING}{?$<=$?} &
-\cross{ISTRING}{?=?} &
-\cross{ISTRING}{?$>$?} &
-\cross{ISTRING}{?$>=$?} &
-\cross{ISTRING}{?\~{}=?} \\
-\cross{ISTRING}{?.?} &&&&
+\begin{tabular}{lll}
+\cross{IFF}{0} &
+\cross{IFF}{1} &
+\cross{IFF}{algebraic?} \\
+\cross{IFF}{associates?} &
+\cross{IFF}{basis} &
+\cross{IFF}{characteristic} \\
+\cross{IFF}{charthRoot} &
+\cross{IFF}{coerce} &
+\cross{IFF}{conditionP} \\
+\cross{IFF}{coordinates} &
+\cross{IFF}{createNormalElement} &
+\cross{IFF}{createPrimitiveElement} \\
+\cross{IFF}{D} &
+\cross{IFF}{definingPolynomial} &
+\cross{IFF}{degree} \\
+\cross{IFF}{dimension} &
+\cross{IFF}{differentiate} &
+\cross{IFF}{discreteLog} \\
+\cross{IFF}{divide} &
+\cross{IFF}{euclideanSize} &
+\cross{IFF}{expressIdealMember} \\
+\cross{IFF}{exquo} &
+\cross{IFF}{extendedEuclidean} &
+\cross{IFF}{extensionDegree} \\
+\cross{IFF}{factor} &
+\cross{IFF}{factorsOfCyclicGroupSize} &
+\cross{IFF}{Frobenius} \\
+\cross{IFF}{gcd} &
+\cross{IFF}{gcdPolynomial} &
+\cross{IFF}{generator} \\
+\cross{IFF}{hash} &
+\cross{IFF}{index} &
+\cross{IFF}{inGroundField?} \\
+\cross{IFF}{init} &
+\cross{IFF}{inv} &
+\cross{IFF}{latex} \\
+\cross{IFF}{lcm} &
+\cross{IFF}{linearAssociatedExp} &
+\cross{IFF}{linearAssociatedLog} \\
+\cross{IFF}{linearAssociatedOrder} &
+\cross{IFF}{lookup} &
+\cross{IFF}{minimalPolynomial} \\
+\cross{IFF}{multiEuclidean} &
+\cross{IFF}{nextItem} &
+\cross{IFF}{norm} \\
+\cross{IFF}{normal?} &
+\cross{IFF}{normalElement} &
+\cross{IFF}{one?} \\
+\cross{IFF}{order} &
+\cross{IFF}{prime?} &
+\cross{IFF}{primeFrobenius} \\
+\cross{IFF}{primitive?} &
+\cross{IFF}{primitiveElement} &
+\cross{IFF}{principalIdeal} \\
+\cross{IFF}{random} &
+\cross{IFF}{recip} &
+\cross{IFF}{representationType} \\
+\cross{IFF}{represents} &
+\cross{IFF}{retract} &
+\cross{IFF}{retractIfCan} \\
+\cross{IFF}{sample} &
+\cross{IFF}{size} &
+\cross{IFF}{sizeLess?} \\
+\cross{IFF}{squareFree} &
+\cross{IFF}{squareFreePart} &
+\cross{IFF}{subtractIfCan} \\
+\cross{IFF}{tableForDiscreteLogarithm} &
+\cross{IFF}{trace} &
+\cross{IFF}{transcendenceDegree} \\
+\cross{IFF}{transcendent?} &
+\cross{IFF}{unit?} &
+\cross{IFF}{unitCanonical} \\
+\cross{IFF}{unitNormal} &
+\cross{IFF}{zero?} &
+\cross{IFF}{?*?} \\
+\cross{IFF}{?**?} &
+\cross{IFF}{?+?} &
+\cross{IFF}{?-?} \\
+\cross{IFF}{-?} &
+\cross{IFF}{?/?} &
+\cross{IFF}{?=?} \\
+\cross{IFF}{?\^{}?} &
+\cross{IFF}{?\~{}=?} &
+\cross{IFF}{?quo?} \\
+\cross{IFF}{?rem?} &&
 \end{tabular}
 
-\begin{chunk}{domain ISTRING IndexedString}
-)abbrev domain ISTRING IndexedString
-++ Authors: Stephen Watt, Michael Monagan, Manuel Bronstein 1986 .. 1991
+\begin{chunk}{domain IFF InnerFiniteField}
+)abbrev domain IFF InnerFiniteField
+++ Author: Mark Botch
+++ Date Last Updated: 29 May 1990
+++ Reference:
+++  R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics an
+++   Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4
+++  J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM.
+++   AXIOM Technical Report Series, ATR/5 NP2522.
 ++ Description:
-++ This domain implements low-level strings
-
-IndexedString(mn:Integer): Export == Implementation where
-  B ==> Boolean
-  C ==> Character
-  I ==> Integer
-  N ==> NonNegativeInteger
-  U ==> UniversalSegment Integer
-
-  Export ==> StringAggregate() with
-      hash: % -> I
-        ++ hash(x) provides a hashing function for strings
-
-  Implementation ==> add
-    -- These assume Character's Rep is Small I
-    Qelt    ==> QENUM$Lisp
-    Qequal  ==> EQUAL$Lisp
-    Qsetelt ==> QESET$Lisp
-    Qsize   ==> QCSIZE$Lisp
-    Cheq    ==> EQL$Lisp
-    Chlt    ==> QSLESSP$Lisp
-    Chgt    ==> QSGREATERP$Lisp
-
-    c: Character
-    cc: CharacterClass
-
---  new n                  == MAKE_-FULL_-CVEC(n, space$C)$Lisp
-    new(n, c)              == MAKE_-FULL_-CVEC(n, c)$Lisp
-    empty()                == MAKE_-FULL_-CVEC(0$Lisp)$Lisp
-    empty?(s)              == Qsize(s) = 0
-    #s                     == Qsize(s)
-    s = t                  == Qequal(s, t)
-    s < t                  == CGREATERP(t,s)$Lisp
-    concat(s:%,t:%)        == STRCONC(s,t)$Lisp
-    copy s                 == COPY_-SEQ(s)$Lisp
-    insert(s:%, t:%, i:I)  == concat(concat(s(mn..i-1), t), s(i..))
-    coerce(s:%):OutputForm == outputForm(s pretend String)
-    minIndex s             == mn
-    upperCase_! s          == map_!(upperCase, s)
-    lowerCase_! s          == map_!(lowerCase, s)
-
-    latex s             == concat("\mbox{``", concat(s pretend String, "''}"))
-
-    replace(s, sg, t) ==
-      l := lo(sg) - mn
-      m := #s
-      n := #t
-      h:I := if hasHi sg then hi(sg) - mn else maxIndex s - mn
-      l < 0 or h >= m or h < l-1 => error "index out of range"
-      r := new((m-(h-l+1)+n)::N, space$C)
-      for k in 0.. for i in 0..l-1 repeat Qsetelt(r, k, Qelt(s, i))
-      for k in k.. for i in 0..n-1 repeat Qsetelt(r, k, Qelt(t, i))
-      for k in k.. for i in h+1..m-1 repeat Qsetelt(r, k, Qelt(s, i))
-      r
-
-    setelt(s:%, i:I, c:C) ==
-      i < mn or i > maxIndex(s) => error "index out of range"
-      Qsetelt(s, i - mn, c)
-      c
-
-    substring?(part, whole, startpos) ==
-      np:I := Qsize part
-      nw:I := Qsize whole
-      (startpos := startpos - mn) < 0 => error "index out of bounds"
-      np > nw - startpos => false
-      for ip in 0..np-1 for iw in startpos.. repeat
-          not Cheq(Qelt(part, ip), Qelt(whole, iw)) => return false
-      true
-
-    position(s:%, t:%, startpos:I) ==
-      (startpos := startpos - mn) < 0 => error "index out of bounds"
-      startpos >= Qsize t => mn - 1
-      r:I := STRPOS(s, t, startpos, NIL$Lisp)$Lisp
-      EQ(r, NIL$Lisp)$Lisp => mn - 1
-      r + mn
-
-    position(c: Character, t: %, startpos: I) ==
-      (startpos := startpos - mn) < 0 => error "index out of bounds"
-      startpos >= Qsize t => mn - 1
-      for r in startpos..Qsize t - 1 repeat
-          if Cheq(Qelt(t, r), c) then return r + mn
-      mn - 1
-
-    position(cc: CharacterClass, t: %, startpos: I) ==
-      (startpos := startpos - mn) < 0 => error "index out of bounds"
-      startpos >= Qsize t => mn - 1
-      for r in startpos..Qsize t - 1 repeat
-          if member?(Qelt(t,r), cc) then return r + mn
-      mn - 1
-
-    suffix?(s, t) ==
-      (m := maxIndex s) > (n := maxIndex t) => false
-      substring?(s, t, mn + n - m)
-
-    split(s, c) ==
-      n := maxIndex s
-      for i in mn..n while s.i = c repeat 0
-      l := empty()$List(%)
-      j:Integer -- j is conditionally intialized
-      while i <= n and (j := position(c, s, i)) >= mn repeat
-          l := concat(s(i..j-1), l)
-          for i in j..n while s.i = c repeat 0
-      if i <= n then l := concat(s(i..n), l)
-      reverse_! l
-
-    split(s, cc) ==
-      n := maxIndex s
-      for i in mn..n while member?(s.i,cc) repeat 0
-      l := empty()$List(%)
-      j:Integer -- j is conditionally intialized
-      while i <= n and (j := position(cc, s, i)) >= mn repeat
-          l := concat(s(i..j-1), l)
-          for i in j..n while member?(s.i,cc) repeat 0
-      if i <= n then l := concat(s(i..n), l)
-      reverse_! l
-
-    leftTrim(s, c) ==
-      n := maxIndex s
-      for i in mn .. n while s.i = c repeat 0
-      s(i..n)
-
-    leftTrim(s, cc) ==
-      n := maxIndex s
-      for i in mn .. n while member?(s.i,cc) repeat 0
-      s(i..n)
-
-    rightTrim(s, c) ==
-      for j in maxIndex s .. mn by -1 while s.j = c repeat 0
-      s(minIndex(s)..j)
-
-    rightTrim(s, cc) ==
-      for j in maxIndex s .. mn by -1 while member?(s.j, cc) repeat 0
-      s(minIndex(s)..j)
-
-    concat l ==
-      t := new(+/[#s for s in l], space$C)
-      i := mn
-      for s in l repeat
-          copyInto_!(t, s, i)
-          i := i + #s
-      t
-
-    copyInto_!(y, x, s) ==
-      m := #x
-      n := #y
-      s := s - mn
-      s < 0 or s+m > n => error "index out of range"
-      RPLACSTR(y, s, m, x, 0, m)$Lisp
-      y
-
-    elt(s:%, i:I) ==
-      i < mn or i > maxIndex(s) => error "index out of range"
-      Qelt(s, i - mn)
-
-    elt(s:%, sg:U) ==
-      l := lo(sg) - mn
-      h := if hasHi sg then hi(sg) - mn else maxIndex s - mn
-      l < 0 or h >= #s => error "index out of bound"
-      SUBSTRING(s, l, max(0, h-l+1))$Lisp
-
-    hash(s:$):Integer ==
-      n:I := Qsize s
-      zero? n => 0
---      one? n => ord(s.mn)
-      (n = 1) => ord(s.mn)
-      ord(s.mn) * ord s(mn+n-1) * ord s(mn + n quo 2)
+++ InnerFiniteField(p,n) implements finite fields with \spad{p**n} elements
+++ where p is assumed prime but does not check.
+++ For a version which checks that p is prime, see \spadtype{FiniteField}.
 
-    match(pattern,target,wildcard) ==
-      stringMatch(pattern,target,CHARACTER(wildcard)$Lisp)$Lisp
- 
-    match?(pattern, target, dontcare) ==
-      n := maxIndex pattern
-      p := position(dontcare, pattern, m := minIndex pattern)::N
-      p = m-1 => pattern = target
-      (p ^= m) and not prefix?(pattern(m..p-1), target) => false
-      i := p      -- index into target
-      q := position(dontcare, pattern, p + 1)::N
-      while q ^= m-1 repeat
-         s := pattern(p+1..q-1)
-         i := position(s, target, i)::N
-         i = m-1 => return false
-         i := i + #s
-         p := q
-         q := position(dontcare, pattern, q + 1)::N
-      (p ^= n) and not suffix?(pattern(p+1..n), target) => false
-      true
+InnerFiniteField(p:PositiveInteger, n:PositiveInteger) ==
+     FiniteFieldExtension(InnerPrimeField p, n)
 
 \end{chunk}
 
-\begin{chunk}{COQ ISTRING}
-(* domain ISTRING *)
+\begin{chunk}{COQ IFF}
+(* domain IFF *)
 (*
 *)
 
 \end{chunk}
 
-\begin{chunk}{ISTRING.dotabb}
-"ISTRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ISTRING",
-          shape=ellipse]
-"FSAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FSAGG"]
-"ISTRING" -> "FSAGG"
+\begin{chunk}{IFF.dotabb}
+"IFF" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IFF"]
+"FAXF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FAXF"]
+"IFF" -> "FAXF"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IARRAY2 IndexedTwoDimensionalArray}
-
-An IndexedTwoDimensionalArray is a 2-dimensional array where
-the minimal row and column indices are parameters of the type.
-Rows and columns are returned as IndexedOneDimensionalArray's with
-minimal indices matching those of the IndexedTwoDimensionalArray.
-The index of the 'first' row may be obtained by calling the
-function 'minRowIndex'.  The index of the 'first' column may
-be obtained by calling the function 'minColIndex'.  The index of
-the first element of a 'Row' is the same as the index of the
-first column in an array and vice versa.
+\section{domain IFAMON InnerFreeAbelianMonoid}
 
-\begin{chunk}{IndexedTwoDimensionalArray.input}
+\begin{chunk}{InnerFreeAbelianMonoid.input}
 )set break resume
-)sys rm -f IndexedTwoDimensionalArray.output
-)spool IndexedTwoDimensionalArray.output
+)sys rm -f InnerFreeAbelianMonoid.output
+)spool InnerFreeAbelianMonoid.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show IndexedTwoDimensionalArray
+)show InnerFreeAbelianMonoid
 --R 
---R IndexedTwoDimensionalArray(R: Type,mnRow: Integer,mnCol: Integer)  is a domain constructor
---R Abbreviation for IndexedTwoDimensionalArray is IARRAY2 
+--R InnerFreeAbelianMonoid(S: SetCategory,E: CancellationAbelianMonoid,un: E)  is a domain constructor
+--R Abbreviation for InnerFreeAbelianMonoid is IFAMON 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IARRAY2 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IFAMON 
 --R
 --R------------------------------- Operations --------------------------------
---R copy : % -> %                         elt : (%,Integer,Integer,R) -> R
---R elt : (%,Integer,Integer) -> R        empty : () -> %
---R empty? : % -> Boolean                 eq? : (%,%) -> Boolean
---R fill! : (%,R) -> %                    latex : % -> String if R has SETCAT
---R map : (((R,R) -> R),%,%,R) -> %       map : (((R,R) -> R),%,%) -> %
---R map : ((R -> R),%) -> %               map! : ((R -> R),%) -> %
---R maxColIndex : % -> Integer            maxRowIndex : % -> Integer
---R minColIndex : % -> Integer            minRowIndex : % -> Integer
---R ncols : % -> NonNegativeInteger       nrows : % -> NonNegativeInteger
---R parts : % -> List(R)                  qelt : (%,Integer,Integer) -> R
---R sample : () -> %                      setelt : (%,Integer,Integer,R) -> R
---R #? : % -> NonNegativeInteger if $ has finiteAggregate
---R ?=? : (%,%) -> Boolean if R has SETCAT
---R any? : ((R -> Boolean),%) -> Boolean if $ has finiteAggregate
---R coerce : % -> OutputForm if R has SETCAT
---R column : (%,Integer) -> IndexedOneDimensionalArray(R,mnRow)
---R count : (R,%) -> NonNegativeInteger if $ has finiteAggregate and R has SETCAT
---R count : ((R -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R eval : (%,List(R),List(R)) -> % if R has EVALAB(R) and R has SETCAT
---R eval : (%,R,R) -> % if R has EVALAB(R) and R has SETCAT
---R eval : (%,Equation(R)) -> % if R has EVALAB(R) and R has SETCAT
---R eval : (%,List(Equation(R))) -> % if R has EVALAB(R) and R has SETCAT
---R every? : ((R -> Boolean),%) -> Boolean if $ has finiteAggregate
---R hash : % -> SingleInteger if R has SETCAT
---R less? : (%,NonNegativeInteger) -> Boolean
---R member? : (R,%) -> Boolean if $ has finiteAggregate and R has SETCAT
---R members : % -> List(R) if $ has finiteAggregate
---R more? : (%,NonNegativeInteger) -> Boolean
---R new : (NonNegativeInteger,NonNegativeInteger,R) -> %
---R qsetelt! : (%,Integer,Integer,R) -> R
---R row : (%,Integer) -> IndexedOneDimensionalArray(R,mnCol)
---R setColumn! : (%,Integer,IndexedOneDimensionalArray(R,mnRow)) -> %
---R setRow! : (%,Integer,IndexedOneDimensionalArray(R,mnCol)) -> %
---R size? : (%,NonNegativeInteger) -> Boolean
---R ?~=? : (%,%) -> Boolean if R has SETCAT
+--R ?*? : (E,S) -> %                      ?*? : (NonNegativeInteger,%) -> %
+--R ?*? : (PositiveInteger,%) -> %        ?+? : (S,%) -> %
+--R ?+? : (%,%) -> %                      ?=? : (%,%) -> Boolean
+--R 0 : () -> %                           coefficient : (S,%) -> E
+--R coerce : S -> %                       coerce : % -> OutputForm
+--R hash : % -> SingleInteger             latex : % -> String
+--R mapCoef : ((E -> E),%) -> %           mapGen : ((S -> S),%) -> %
+--R nthCoef : (%,Integer) -> E            nthFactor : (%,Integer) -> S
+--R retract : % -> S                      sample : () -> %
+--R size : % -> NonNegativeInteger        zero? : % -> Boolean
+--R ?~=? : (%,%) -> Boolean              
+--R highCommonTerms : (%,%) -> % if E has OAMON
+--R retractIfCan : % -> Union(S,"failed")
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R terms : % -> List(Record(gen: S,exp: E))
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{IndexedTwoDimensionalArray.help}
+\begin{chunk}{InnerFreeAbelianMonoid.help}
 ====================================================================
-IndexedTwoDimensionalArray examples
+InnerFreeAbelianMonoid examples
 ====================================================================
 
-This domain implements two dimensional arrays
+Internal implementation of a free abelian monoid on any set of generators
 
 See Also:
-o )show IndexedTwoDimensionalArray
+o )show InnerFreeAbelianMonoid
 
 \end{chunk}
 
-\pagehead{IndexedTwoDimensionalArray}{IARRAY2}
-\pagepic{ps/v103indexedtwodimensionalarray.ps}{IARRAY2}{1.00}
+\pagehead{InnerFreeAbelianMonoid}{IFAMON}
+\pagepic{ps/v103innerfreeabelianmonoid.ps}{IFAMON}{1.00}
 {\bf See}\\
-\pageto{InnerIndexedTwoDimensionalArray}{IIARRAY2}
-\pageto{TwoDimensionalArray}{ARRAY2}
+\pageto{ListMonoidOps}{LMOPS}
+\pageto{FreeMonoid}{FMONOID}
+\pageto{FreeGroup}{FGROUP}
+\pageto{FreeAbelianMonoid}{FAMONOID}
+\pageto{FreeAbelianGroup}{FAGROUP}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{IARRAY2}{any?} &
-\cross{IARRAY2}{coerce} &
-\cross{IARRAY2}{column} &
-\cross{IARRAY2}{copy} &
-\cross{IARRAY2}{count} \\
-\cross{IARRAY2}{count} &
-\cross{IARRAY2}{elt} &
-\cross{IARRAY2}{empty} &
-\cross{IARRAY2}{empty?} &
-\cross{IARRAY2}{eq?} \\
-\cross{IARRAY2}{eval} &
-\cross{IARRAY2}{every?} &
-\cross{IARRAY2}{fill!} &
-\cross{IARRAY2}{hash} &
-\cross{IARRAY2}{latex} \\
-\cross{IARRAY2}{less?} &
-\cross{IARRAY2}{maxColIndex} &
-\cross{IARRAY2}{maxRowIndex} &
-\cross{IARRAY2}{map} &
-\cross{IARRAY2}{map!} \\
-\cross{IARRAY2}{member?} &
-\cross{IARRAY2}{members} &
-\cross{IARRAY2}{minColIndex} &
-\cross{IARRAY2}{minRowIndex} &
-\cross{IARRAY2}{more?} \\
-\cross{IARRAY2}{ncols} &
-\cross{IARRAY2}{new} &
-\cross{IARRAY2}{nrows} &
-\cross{IARRAY2}{parts} &
-\cross{IARRAY2}{qelt} \\
-\cross{IARRAY2}{qsetelt!} &
-\cross{IARRAY2}{row} &
-\cross{IARRAY2}{sample} &
-\cross{IARRAY2}{setColumn!} &
-\cross{IARRAY2}{setRow!} \\
-\cross{IARRAY2}{setelt} &
-\cross{IARRAY2}{size?} &
-\cross{IARRAY2}{\#{}?} &
-\cross{IARRAY2}{?=?} &
-\cross{IARRAY2}{?\~{}=?}
+\cross{IFAMON}{0} &
+\cross{IFAMON}{coefficient} &
+\cross{IFAMON}{coerce} &
+\cross{IFAMON}{hash} &
+\cross{IFAMON}{highCommonTerms} \\
+\cross{IFAMON}{latex} &
+\cross{IFAMON}{mapCoef} &
+\cross{IFAMON}{mapGen} &
+\cross{IFAMON}{nthCoef} &
+\cross{IFAMON}{nthFactor} \\
+\cross{IFAMON}{retract} &
+\cross{IFAMON}{retractIfCan} &
+\cross{IFAMON}{sample} &
+\cross{IFAMON}{size} &
+\cross{IFAMON}{subtractIfCan} \\
+\cross{IFAMON}{terms} &
+\cross{IFAMON}{zero?} &
+\cross{IFAMON}{?\~{}=?} &
+\cross{IFAMON}{?*?} &
+\cross{IFAMON}{?+?} \\
+\cross{IFAMON}{?=?} &&&&
 \end{tabular}
 
-\begin{chunk}{domain IARRAY2 IndexedTwoDimensionalArray}
-)abbrev domain IARRAY2 IndexedTwoDimensionalArray
-++ Author: Mark Botch
-++ Description:
-++ This domain implements two dimensional arrays
+\begin{chunk}{domain IFAMON InnerFreeAbelianMonoid}
+)abbrev domain IFAMON InnerFreeAbelianMonoid
+++ Author: Manuel Bronstein
+++ Date Created: November 1989
+++ Date Last Updated: 6 June 1991
+++ Description:
+++ Internal implementation of a free abelian monoid on any set of generators
+
+InnerFreeAbelianMonoid(S: SetCategory, E:CancellationAbelianMonoid, un:E):
+  FreeAbelianMonoidCategory(S, E) == ListMonoidOps(S, E, un) add
+
+        Rep := ListMonoidOps(S, E, un)
+
+        0                          == makeUnit()
+
+        zero? f                    == empty? listOfMonoms f
+
+        terms f                    == copy listOfMonoms f
+
+        nthCoef(f, i)              == nthExpon(f, i)
+
+        nthFactor(f, i)            == nthFactor(f, i)$Rep
+
+        s:S + f:$                  == plus(s, un, f)
+
+        f:$ + g:$                  == plus(f, g)
+
+        (f:$ = g:$):Boolean        == commutativeEquality(f,g)
+
+        n:E * s:S                  == makeTerm(s, n)
+
+        n:NonNegativeInteger * f:$ == mapExpon(x +-> n*x, f)
+
+        coerce(f:$):OutputForm     == outputForm(f, "+", (x,y) +-> y*x, 0)
+
+        mapCoef(f, x)              == mapExpon(f, x)
+
+        mapGen(f, x)               == mapGen(f, x)$Rep
+
+        coefficient(s, f) ==
+          for x in terms f repeat
+            x.gen = s => return(x.exp)
+          0
+
+        if E has OrderedAbelianMonoid then
+
+          highCommonTerms(f, g) ==
+            makeMulti [[x.gen, min(x.exp, n)] for x in listOfMonoms f |
+                                       (n := coefficient(x.gen, g)) > 0]
+
+\end{chunk}
+
+\begin{chunk}{COQ IFAMON}
+(* domain IFAMON *)
+(*
+
+        Rep := ListMonoidOps(S, E, un)
+
+        0                          == makeUnit()
+
+        zero? f                    == empty? listOfMonoms f
+
+        terms f                    == copy listOfMonoms f
+
+        nthCoef(f, i)              == nthExpon(f, i)
 
-IndexedTwoDimensionalArray(R,mnRow,mnCol):Exports == Implementation where
-  R : Type
-  mnRow, mnCol : Integer
-  Row ==> IndexedOneDimensionalArray(R,mnCol)
-  Col ==> IndexedOneDimensionalArray(R,mnRow)
+        nthFactor(f, i)            == nthFactor(f, i)$Rep
 
-  Exports ==> TwoDimensionalArrayCategory(R,Row,Col)
+        s:S + f:$                  == plus(s, un, f)
 
-  Implementation ==>
-    InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col)
+        f:$ + g:$                  == plus(f, g)
 
-\end{chunk}
+        (f:$ = g:$):Boolean        == commutativeEquality(f,g)
+
+        n:E * s:S                  == makeTerm(s, n)
+
+        n:NonNegativeInteger * f:$ == mapExpon(x +-> n*x, f)
+
+        coerce(f:$):OutputForm     == outputForm(f, "+", (x,y) +-> y*x, 0)
+
+        mapCoef(f, x)              == mapExpon(f, x)
+
+        mapGen(f, x)               == mapGen(f, x)$Rep
+
+        coefficient(s, f) ==
+          for x in terms f repeat
+            x.gen = s => return(x.exp)
+          0
+
+        if E has OrderedAbelianMonoid then
+
+          highCommonTerms(f, g) ==
+            makeMulti [[x.gen, min(x.exp, n)] for x in listOfMonoms f |
+                                       (n := coefficient(x.gen, g)) > 0]
 
-\begin{chunk}{COQ IARRAY2}
-(* domain IARRAY2 *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{IARRAY2.dotabb}
-"IARRAY2" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IARRAY2"]
-"A1AGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=A1AGG"]
-"ARR2CAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ARR2CAT"]
-"IARRAY2" -> "ARR2CAT"
-"IARRAY2" -> "A1AGG"
+\begin{chunk}{IFAMON.dotabb}
+"IFAMON" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IFAMON"]
+"OAMON" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAMON"]
+"IFAMON" -> "OAMON"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IVECTOR IndexedVector}
+\section{domain IIARRAY2 InnerIndexedTwoDimensionalArray}
 
-\begin{chunk}{IndexedVector.input}
+This is an internal type which provides an implementation of
+2-dimensional arrays as PrimitiveArray's of PrimitiveArray's.
+
+\begin{chunk}{InnerIndexedTwoDimensionalArray.input}
 )set break resume
-)sys rm -f IndexedVector.output
-)spool IndexedVector.output
+)sys rm -f InnerIndexedTwoDimensionalArray.output
+)spool InnerIndexedTwoDimensionalArray.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show IndexedVector
+)show InnerIndexedTwoDimensionalArray
 --R 
---R IndexedVector(R: Type,mn: Integer)  is a domain constructor
---R Abbreviation for IndexedVector is IVECTOR 
+--R InnerIndexedTwoDimensionalArray(R: Type,mnRow: Integer,mnCol: Integer,Row: FiniteLinearAggregate(R),Col: FiniteLinearAggregate(R))  is a domain constructor
+--R Abbreviation for InnerIndexedTwoDimensionalArray is IIARRAY2 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IVECTOR 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IIARRAY2 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (%,R) -> % if R has MONOID      ?*? : (R,%) -> % if R has MONOID
---R ?+? : (%,%) -> % if R has ABELSG      ?-? : (%,%) -> % if R has ABELGRP
---R -? : % -> % if R has ABELGRP          concat : List(%) -> %
---R concat : (%,%) -> %                   concat : (R,%) -> %
---R concat : (%,R) -> %                   construct : List(R) -> %
---R copy : % -> %                         cross : (%,%) -> % if R has RING
---R delete : (%,Integer) -> %             dot : (%,%) -> R if R has RING
---R ?.? : (%,Integer) -> R                elt : (%,Integer,R) -> R
+--R column : (%,Integer) -> Col           copy : % -> %
+--R elt : (%,Integer,Integer,R) -> R      elt : (%,Integer,Integer) -> R
 --R empty : () -> %                       empty? : % -> Boolean
---R entries : % -> List(R)                eq? : (%,%) -> Boolean
---R index? : (Integer,%) -> Boolean       indices : % -> List(Integer)
---R insert : (%,%,Integer) -> %           insert : (R,%,Integer) -> %
---R latex : % -> String if R has SETCAT   map : (((R,R) -> R),%,%) -> %
---R map : ((R -> R),%) -> %               max : (%,%) -> % if R has ORDSET
---R min : (%,%) -> % if R has ORDSET      new : (NonNegativeInteger,R) -> %
---R qelt : (%,Integer) -> R               reverse : % -> %
---R sample : () -> %                      sort : % -> % if R has ORDSET
---R sort : (((R,R) -> Boolean),%) -> %   
+--R eq? : (%,%) -> Boolean                fill! : (%,R) -> %
+--R latex : % -> String if R has SETCAT   map : (((R,R) -> R),%,%,R) -> %
+--R map : (((R,R) -> R),%,%) -> %         map : ((R -> R),%) -> %
+--R map! : ((R -> R),%) -> %              maxColIndex : % -> Integer
+--R maxRowIndex : % -> Integer            minColIndex : % -> Integer
+--R minRowIndex : % -> Integer            ncols : % -> NonNegativeInteger
+--R nrows : % -> NonNegativeInteger       parts : % -> List(R)
+--R qelt : (%,Integer,Integer) -> R       row : (%,Integer) -> Row
+--R sample : () -> %                      setColumn! : (%,Integer,Col) -> %
+--R setRow! : (%,Integer,Row) -> %        setelt : (%,Integer,Integer,R) -> R
 --R #? : % -> NonNegativeInteger if $ has finiteAggregate
---R ?*? : (Integer,%) -> % if R has ABELGRP
---R ?<? : (%,%) -> Boolean if R has ORDSET
---R ?<=? : (%,%) -> Boolean if R has ORDSET
 --R ?=? : (%,%) -> Boolean if R has SETCAT
---R ?>? : (%,%) -> Boolean if R has ORDSET
---R ?>=? : (%,%) -> Boolean if R has ORDSET
 --R any? : ((R -> Boolean),%) -> Boolean if $ has finiteAggregate
 --R coerce : % -> OutputForm if R has SETCAT
---R convert : % -> InputForm if R has KONVERT(INFORM)
---R copyInto! : (%,%,Integer) -> % if $ has shallowlyMutable
 --R count : (R,%) -> NonNegativeInteger if $ has finiteAggregate and R has SETCAT
 --R count : ((R -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R delete : (%,UniversalSegment(Integer)) -> %
---R ?.? : (%,UniversalSegment(Integer)) -> %
---R entry? : (R,%) -> Boolean if $ has finiteAggregate and R has SETCAT
 --R eval : (%,List(R),List(R)) -> % if R has EVALAB(R) and R has SETCAT
 --R eval : (%,R,R) -> % if R has EVALAB(R) and R has SETCAT
 --R eval : (%,Equation(R)) -> % if R has EVALAB(R) and R has SETCAT
 --R eval : (%,List(Equation(R))) -> % if R has EVALAB(R) and R has SETCAT
 --R every? : ((R -> Boolean),%) -> Boolean if $ has finiteAggregate
---R fill! : (%,R) -> % if $ has shallowlyMutable
---R find : ((R -> Boolean),%) -> Union(R,"failed")
---R first : % -> R if Integer has ORDSET
 --R hash : % -> SingleInteger if R has SETCAT
---R length : % -> R if R has RADCAT and R has RING
 --R less? : (%,NonNegativeInteger) -> Boolean
---R magnitude : % -> R if R has RADCAT and R has RING
---R map! : ((R -> R),%) -> % if $ has shallowlyMutable
---R maxIndex : % -> Integer if Integer has ORDSET
 --R member? : (R,%) -> Boolean if $ has finiteAggregate and R has SETCAT
 --R members : % -> List(R) if $ has finiteAggregate
---R merge : (%,%) -> % if R has ORDSET
---R merge : (((R,R) -> Boolean),%,%) -> %
---R minIndex : % -> Integer if Integer has ORDSET
 --R more? : (%,NonNegativeInteger) -> Boolean
---R outerProduct : (%,%) -> Matrix(R) if R has RING
---R parts : % -> List(R) if $ has finiteAggregate
---R position : (R,%,Integer) -> Integer if R has SETCAT
---R position : (R,%) -> Integer if R has SETCAT
---R position : ((R -> Boolean),%) -> Integer
---R qsetelt! : (%,Integer,R) -> R if $ has shallowlyMutable
---R reduce : (((R,R) -> R),%) -> R if $ has finiteAggregate
---R reduce : (((R,R) -> R),%,R) -> R if $ has finiteAggregate
---R reduce : (((R,R) -> R),%,R,R) -> R if $ has finiteAggregate and R has SETCAT
---R remove : ((R -> Boolean),%) -> % if $ has finiteAggregate
---R remove : (R,%) -> % if $ has finiteAggregate and R has SETCAT
---R removeDuplicates : % -> % if $ has finiteAggregate and R has SETCAT
---R reverse! : % -> % if $ has shallowlyMutable
---R select : ((R -> Boolean),%) -> % if $ has finiteAggregate
---R setelt : (%,UniversalSegment(Integer),R) -> R if $ has shallowlyMutable
---R setelt : (%,Integer,R) -> R if $ has shallowlyMutable
+--R new : (NonNegativeInteger,NonNegativeInteger,R) -> %
+--R qsetelt! : (%,Integer,Integer,R) -> R
 --R size? : (%,NonNegativeInteger) -> Boolean
---R sort! : % -> % if $ has shallowlyMutable and R has ORDSET
---R sort! : (((R,R) -> Boolean),%) -> % if $ has shallowlyMutable
---R sorted? : % -> Boolean if R has ORDSET
---R sorted? : (((R,R) -> Boolean),%) -> Boolean
---R swap! : (%,Integer,Integer) -> Void if $ has shallowlyMutable
---R zero : NonNegativeInteger -> % if R has ABELMON
 --R ?~=? : (%,%) -> Boolean if R has SETCAT
 --R
 --E 1
@@ -77918,1700 +93895,1432 @@ IndexedTwoDimensionalArray(R,mnRow,mnCol):Exports == Implementation where
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{IndexedVector.help}
+\begin{chunk}{InnerIndexedTwoDimensionalArray.help}
 ====================================================================
-IndexedVector examples
+InnerIndexedTwoDimensionalArray examples
 ====================================================================
 
-This type represents vector like objects with varying lengths
-and a user-specified initial index.
+There is no description for this domain
 
 See Also:
-o )show IndexedVector
+o )show InnerIndexedTwoDimensionalArray
 
 \end{chunk}
 
-\pagehead{IndexedVector}{IVECTOR}
-\pagepic{ps/v103indexedvector.ps}{IVECTOR}{1.00}
+\pagehead{InnerIndexedTwoDimensionalArray}{IIARRAY2}
+\pagepic{ps/v103innerindexedtwodimensionalarray.ps}{IIARRAY2}{1.00}
+{\bf See}\\
+\pageto{IndexedTwoDimensionalArray}{IARRAY2}
+\pageto{TwoDimensionalArray}{ARRAY2}
 
 {\bf Exports:}\\
 \begin{tabular}{lllll}
-\cross{IVECTOR}{any?} &
-\cross{IVECTOR}{coerce} &
-\cross{IVECTOR}{concat} &
-\cross{IVECTOR}{construct} &
-\cross{IVECTOR}{convert} \\
-\cross{IVECTOR}{copy} &
-\cross{IVECTOR}{copyInto!} &
-\cross{IVECTOR}{count} &
-\cross{IVECTOR}{cross} &
-\cross{IVECTOR}{delete} \\
-\cross{IVECTOR}{dot} &
-\cross{IVECTOR}{elt} &
-\cross{IVECTOR}{empty} &
-\cross{IVECTOR}{empty?} &
-\cross{IVECTOR}{entries} \\
-\cross{IVECTOR}{entry?} &
-\cross{IVECTOR}{eq?} &
-\cross{IVECTOR}{eval} &
-\cross{IVECTOR}{every?} &
-\cross{IVECTOR}{fill!} \\
-\cross{IVECTOR}{find} &
-\cross{IVECTOR}{first} &
-\cross{IVECTOR}{hash} &
-\cross{IVECTOR}{index?} &
-\cross{IVECTOR}{indices} \\
-\cross{IVECTOR}{insert} &
-\cross{IVECTOR}{latex} &
-\cross{IVECTOR}{length} &
-\cross{IVECTOR}{less?} &
-\cross{IVECTOR}{magnitude} \\
-\cross{IVECTOR}{map!} &
-\cross{IVECTOR}{max} &
-\cross{IVECTOR}{maxIndex} &
-\cross{IVECTOR}{member?} &
-\cross{IVECTOR}{members} \\
-\cross{IVECTOR}{merge} &
-\cross{IVECTOR}{min} &
-\cross{IVECTOR}{minIndex} &
-\cross{IVECTOR}{more?} &
-\cross{IVECTOR}{new} \\
-\cross{IVECTOR}{outerProduct} &
-\cross{IVECTOR}{parts} &
-\cross{IVECTOR}{position} &
-\cross{IVECTOR}{qelt} &
-\cross{IVECTOR}{qsetelt!} \\
-\cross{IVECTOR}{reduce} &
-\cross{IVECTOR}{remove} &
-\cross{IVECTOR}{removeDuplicates} &
-\cross{IVECTOR}{reverse} &
-\cross{IVECTOR}{reverse!} \\
-\cross{IVECTOR}{sample} &
-\cross{IVECTOR}{select} &
-\cross{IVECTOR}{setelt} &
-\cross{IVECTOR}{size?} &
-\cross{IVECTOR}{sort} \\
-\cross{IVECTOR}{sort!} &
-\cross{IVECTOR}{sorted?} &
-\cross{IVECTOR}{swap!} &
-\cross{IVECTOR}{zero} &
-\cross{IVECTOR}{\#{}?} \\
-\cross{IVECTOR}{?*?} &
-\cross{IVECTOR}{?+?} &
-\cross{IVECTOR}{?-?} &
-\cross{IVECTOR}{?$<$?} &
-\cross{IVECTOR}{?$<=$?} \\
-\cross{IVECTOR}{?=?} &
-\cross{IVECTOR}{?$>$?} &
-\cross{IVECTOR}{?$>=$?} &
-\cross{IVECTOR}{?\~{}=?} &
-\cross{IVECTOR}{-?} \\
-\cross{IVECTOR}{?.?} &&&&
+\cross{IIARRAY2}{any?} &
+\cross{IIARRAY2}{coerce} &
+\cross{IIARRAY2}{column} &
+\cross{IIARRAY2}{copy} &
+\cross{IIARRAY2}{count} \\
+\cross{IIARRAY2}{elt} &
+\cross{IIARRAY2}{empty} &
+\cross{IIARRAY2}{empty?} &
+\cross{IIARRAY2}{eq?} &
+\cross{IIARRAY2}{eval} \\
+\cross{IIARRAY2}{every?} &
+\cross{IIARRAY2}{fill!} &
+\cross{IIARRAY2}{hash} &
+\cross{IIARRAY2}{latex} &
+\cross{IIARRAY2}{less?} \\
+\cross{IIARRAY2}{map} &
+\cross{IIARRAY2}{map!} &
+\cross{IIARRAY2}{maxColIndex} &
+\cross{IIARRAY2}{maxRowIndex} &
+\cross{IIARRAY2}{member?} \\
+\cross{IIARRAY2}{members} &
+\cross{IIARRAY2}{minColIndex} &
+\cross{IIARRAY2}{minRowIndex} &
+\cross{IIARRAY2}{more?} &
+\cross{IIARRAY2}{ncols} \\
+\cross{IIARRAY2}{new} &
+\cross{IIARRAY2}{nrows} &
+\cross{IIARRAY2}{parts} &
+\cross{IIARRAY2}{qelt} &
+\cross{IIARRAY2}{qsetelt!} \\
+\cross{IIARRAY2}{row} &
+\cross{IIARRAY2}{sample} &
+\cross{IIARRAY2}{setColumn!} &
+\cross{IIARRAY2}{setelt} &
+\cross{IIARRAY2}{setRow!} \\
+\cross{IIARRAY2}{size?} &
+\cross{IIARRAY2}{\#{}?} &
+\cross{IIARRAY2}{?=?} &
+\cross{IIARRAY2}{?\~{}=?} &
 \end{tabular}
 
-\begin{chunk}{domain IVECTOR IndexedVector}
-)abbrev domain IVECTOR IndexedVector
+\begin{chunk}{domain IIARRAY2 InnerIndexedTwoDimensionalArray}
+)abbrev domain IIARRAY2 InnerIndexedTwoDimensionalArray
 ++ Author: Mark Botch
 ++ Description:
-++ This type represents vector like objects with varying lengths
-++ and a user-specified initial index.
- 
-IndexedVector(R:Type, mn:Integer):
-  VectorCategory R == IndexedOneDimensionalArray(R, mn)
- 
+++ There is no description for this domain
+
+InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col):_
+       Exports == Implementation where
+  R : Type
+  mnRow, mnCol : Integer
+  Row : FiniteLinearAggregate R
+  Col : FiniteLinearAggregate R
+
+  Exports ==> TwoDimensionalArrayCategory(R,Row,Col)
+
+  Implementation ==> add
+
+    Rep := PrimitiveArray PrimitiveArray R
+
+--% Predicates
+
+    empty? m == empty?(m)$Rep
+
+--% Primitive array creation
+
+    empty() == empty()$Rep
+
+    new(rows,cols,a) ==
+      rows = 0 =>
+        error "new: arrays with zero rows are not supported"
+      arr : PrimitiveArray PrimitiveArray R := new(rows,empty())
+      for i in minIndex(arr)..maxIndex(arr) repeat
+        qsetelt_!(arr,i,new(cols,a))
+      arr
+
+--% Size inquiries
+
+    minRowIndex m == mnRow
+
+    minColIndex m == mnCol
+
+    maxRowIndex m == nrows m + mnRow - 1
+
+    maxColIndex m == ncols m + mnCol - 1
+
+    nrows m == (# m)$Rep
+
+    ncols m ==
+      empty? m => 0
+      # m(minIndex(m)$Rep)
+
+--% Part selection/assignment
+
+    qelt(m,i,j) ==
+      qelt(qelt(m,i - minRowIndex m)$Rep,j - minColIndex m)
+
+    elt(m:%,i:Integer,j:Integer) ==
+      i < minRowIndex(m) or i > maxRowIndex(m) =>
+        error "elt: index out of range"
+      j < minColIndex(m) or j > maxColIndex(m) =>
+        error "elt: index out of range"
+      qelt(m,i,j)
+
+    qsetelt_!(m,i,j,r) ==
+      setelt(qelt(m,i - minRowIndex m)$Rep,j - minColIndex m,r)
+
+    setelt(m:%,i:Integer,j:Integer,r:R) ==
+      i < minRowIndex(m) or i > maxRowIndex(m) =>
+        error "setelt: index out of range"
+      j < minColIndex(m) or j > maxColIndex(m) =>
+        error "setelt: index out of range"
+      qsetelt_!(m,i,j,r)
+
+    if R has SetCategory then
+        latex(m : %) : String ==
+          s : String := "\left[ \begin{array}{"
+          j : Integer
+          for j in minColIndex(m)..maxColIndex(m) repeat
+            s := concat(s,"c")$String
+          s := concat(s,"} ")$String
+          i : Integer
+          for i in minRowIndex(m)..maxRowIndex(m) repeat
+            for j in minColIndex(m)..maxColIndex(m) repeat
+              s := concat(s, latex(qelt(m,i,j))$R)$String
+              if j < maxColIndex(m) then s := concat(s, " & ")$String
+            if i < maxRowIndex(m) then s := concat(s, " \\ ")$String
+          concat(s, "\end{array} \right]")$String
+
 \end{chunk}
 
-\begin{chunk}{COQ IVECTOR}
-(* domain IVECTOR *)
+\begin{chunk}{COQ IIARRAY2}
+(* domain IIARRAY2 *)
 (*
+
+    Rep := PrimitiveArray PrimitiveArray R
+
+--% Predicates
+
+    empty? m == empty?(m)$Rep
+
+--% Primitive array creation
+
+    empty() == empty()$Rep
+
+    new(rows,cols,a) ==
+      rows = 0 =>
+        error "new: arrays with zero rows are not supported"
+      arr : PrimitiveArray PrimitiveArray R := new(rows,empty())
+      for i in minIndex(arr)..maxIndex(arr) repeat
+        qsetelt_!(arr,i,new(cols,a))
+      arr
+
+--% Size inquiries
+
+    minRowIndex m == mnRow
+
+    minColIndex m == mnCol
+
+    maxRowIndex m == nrows m + mnRow - 1
+
+    maxColIndex m == ncols m + mnCol - 1
+
+    nrows m == (# m)$Rep
+
+    ncols m ==
+      empty? m => 0
+      # m(minIndex(m)$Rep)
+
+--% Part selection/assignment
+
+    qelt(m,i,j) ==
+      qelt(qelt(m,i - minRowIndex m)$Rep,j - minColIndex m)
+
+    elt(m:%,i:Integer,j:Integer) ==
+      i < minRowIndex(m) or i > maxRowIndex(m) =>
+        error "elt: index out of range"
+      j < minColIndex(m) or j > maxColIndex(m) =>
+        error "elt: index out of range"
+      qelt(m,i,j)
+
+    qsetelt_!(m,i,j,r) ==
+      setelt(qelt(m,i - minRowIndex m)$Rep,j - minColIndex m,r)
+
+    setelt(m:%,i:Integer,j:Integer,r:R) ==
+      i < minRowIndex(m) or i > maxRowIndex(m) =>
+        error "setelt: index out of range"
+      j < minColIndex(m) or j > maxColIndex(m) =>
+        error "setelt: index out of range"
+      qsetelt_!(m,i,j,r)
+
+    if R has SetCategory then
+        latex(m : %) : String ==
+          s : String := "\left[ \begin{array}{"
+          j : Integer
+          for j in minColIndex(m)..maxColIndex(m) repeat
+            s := concat(s,"c")$String
+          s := concat(s,"} ")$String
+          i : Integer
+          for i in minRowIndex(m)..maxRowIndex(m) repeat
+            for j in minColIndex(m)..maxColIndex(m) repeat
+              s := concat(s, latex(qelt(m,i,j))$R)$String
+              if j < maxColIndex(m) then s := concat(s, " & ")$String
+            if i < maxRowIndex(m) then s := concat(s, " \\ ")$String
+          concat(s, "\end{array} \right]")$String
+
 *)
 
 \end{chunk}
 
-\begin{chunk}{IVECTOR.dotabb}
-"IVECTOR" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IVECTOR"]
-"VECTCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=VECTCAT"]
-"IVECTOR" -> "VECTCAT"
+\begin{chunk}{IIARRAY2.dotabb}
+"IIARRAY2" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IIARRAY2"]
+"STRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=STRING"]
+"IIARRAY2" -> "STRING"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain ITUPLE InfiniteTuple}
+\section{domain IPADIC InnerPAdicInteger}
 
-\begin{chunk}{InfiniteTuple.input}
+\begin{chunk}{InnerPAdicInteger.input}
 )set break resume
-)sys rm -f InfiniteTuple.output
-)spool InfiniteTuple.output
+)sys rm -f InnerPAdicInteger.output
+)spool InnerPAdicInteger.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show InfiniteTuple
+)show InnerPAdicInteger
 --R 
---R InfiniteTuple(S: Type)  is a domain constructor
---R Abbreviation for InfiniteTuple is ITUPLE 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for ITUPLE 
+--R InnerPAdicInteger(p: Integer,unBalanced?: Boolean)  is a domain constructor
+--R Abbreviation for InnerPAdicInteger is IPADIC 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IPADIC 
 --R
 --R------------------------------- Operations --------------------------------
---R coerce : % -> OutputForm              construct : % -> Stream(S)
---R generate : ((S -> S),S) -> %          map : ((S -> S),%) -> %
---R select : ((S -> Boolean),%) -> %     
---R filterUntil : ((S -> Boolean),%) -> %
---R filterWhile : ((S -> Boolean),%) -> %
+--R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
+--R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
+--R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
+--R ?+? : (%,%) -> %                      ?-? : (%,%) -> %
+--R -? : % -> %                           ?=? : (%,%) -> Boolean
+--R 1 : () -> %                           0 : () -> %
+--R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
+--R associates? : (%,%) -> Boolean        coerce : % -> %
+--R coerce : Integer -> %                 coerce : % -> OutputForm
+--R complete : % -> %                     digits : % -> Stream(Integer)
+--R extend : (%,Integer) -> %             gcd : List(%) -> %
+--R gcd : (%,%) -> %                      hash : % -> SingleInteger
+--R latex : % -> String                   lcm : List(%) -> %
+--R lcm : (%,%) -> %                      moduloP : % -> Integer
+--R modulus : () -> Integer               one? : % -> Boolean
+--R order : % -> NonNegativeInteger       ?quo? : (%,%) -> %
+--R quotientByP : % -> %                  recip : % -> Union(%,"failed")
+--R ?rem? : (%,%) -> %                    sample : () -> %
+--R sizeLess? : (%,%) -> Boolean          sqrt : (%,Integer) -> %
+--R unit? : % -> Boolean                  unitCanonical : % -> %
+--R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
+--R approximate : (%,Integer) -> Integer
+--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 principalIdeal : List(%) -> Record(coef: List(%),generator: %)
+--R root : (SparseUnivariatePolynomial(Integer),Integer) -> %
+--R subtractIfCan : (%,%) -> Union(%,"failed")
+--R unitNormal : % -> Record(unit: %,canonical: %,associate: %)
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{InfiniteTuple.help}
+\begin{chunk}{InnerPAdicInteger.help}
 ====================================================================
-InfiniteTuple examples
+InnerPAdicInteger examples
 ====================================================================
 
-This package implements 'infinite tuples' for the interpreter.
-The representation is a stream.
+This domain implements Zp, the p-adic completion of the integers.
+This is an internal domain.
 
 See Also:
-o )show InfiniteTuple
+o )show InnerPAdicInteger
 
 \end{chunk}
 
-\pagehead{InfiniteTuple}{ITUPLE}
-\pagepic{ps/v103infinitetuple.ps}{ITUPLE}{1.00}
+\pagehead{InnerPAdicInteger}{IPADIC}
+\pagepic{ps/v103innerpadicinteger.ps}{IPADIC}{1.00}
+{\bf See}\\
+\pageto{PAdicInteger}{PADIC}
+\pageto{BalancedPAdicInteger}{BPADIC}
+\pageto{PAdicRationalConstructor}{PADICRC}
+\pageto{PAdicRational}{PADICRAT}
+\pageto{BalancedPAdicRational}{BPADICRT}
 
 {\bf Exports:}\\
-\begin{tabular}{lllllll}
-\cross{ITUPLE}{coerce} &
-\cross{ITUPLE}{construct} &
-\cross{ITUPLE}{filterUntil} &
-\cross{ITUPLE}{filterWhile} &
-\cross{ITUPLE}{generate} &
-\cross{ITUPLE}{map} &
-\cross{ITUPLE}{select} 
+\begin{tabular}{llll}
+\cross{IPADIC}{0} &
+\cross{IPADIC}{1} &
+\cross{IPADIC}{approximate} &
+\cross{IPADIC}{associates?} \\
+\cross{IPADIC}{characteristic} &
+\cross{IPADIC}{coerce} &
+\cross{IPADIC}{complete} &
+\cross{IPADIC}{digits} \\
+\cross{IPADIC}{divide} &
+\cross{IPADIC}{euclideanSize} &
+\cross{IPADIC}{expressIdealMember} &
+\cross{IPADIC}{exquo} \\
+\cross{IPADIC}{extend} &
+\cross{IPADIC}{extendedEuclidean} &
+\cross{IPADIC}{gcd} &
+\cross{IPADIC}{gcdPolynomial} \\
+\cross{IPADIC}{hash} &
+\cross{IPADIC}{latex} &
+\cross{IPADIC}{lcm} &
+\cross{IPADIC}{multiEuclidean} \\
+\cross{IPADIC}{moduloP} &
+\cross{IPADIC}{modulus} &
+\cross{IPADIC}{one?} &
+\cross{IPADIC}{order} \\
+\cross{IPADIC}{principalIdeal} &
+\cross{IPADIC}{quotientByP} &
+\cross{IPADIC}{recip} &
+\cross{IPADIC}{root} \\
+\cross{IPADIC}{sample} &
+\cross{IPADIC}{sizeLess?} &
+\cross{IPADIC}{sqrt} &
+\cross{IPADIC}{subtractIfCan} \\
+\cross{IPADIC}{unit?} &
+\cross{IPADIC}{unitCanonical} &
+\cross{IPADIC}{unitNormal} &
+\cross{IPADIC}{zero?} \\
+\cross{IPADIC}{?\~{}=?} &
+\cross{IPADIC}{?*?} &
+\cross{IPADIC}{?**?} &
+\cross{IPADIC}{?\^{}?} \\
+\cross{IPADIC}{?+?} &
+\cross{IPADIC}{?-?} &
+\cross{IPADIC}{-?} &
+\cross{IPADIC}{?=?} \\
+\cross{IPADIC}{?quo?} &
+\cross{IPADIC}{?rem?} &&
 \end{tabular}
 
-\begin{chunk}{domain ITUPLE InfiniteTuple}
-)abbrev domain ITUPLE InfiniteTuple
+\begin{chunk}{domain IPADIC InnerPAdicInteger}
+)abbrev domain IPADIC InnerPAdicInteger
 ++ Author: Clifton J. Williamson
-++ Date Created: 16 February 1990
-++ Date Last Updated: 16 February 1990
+++ Date Created: 20 August 1989
+++ Date Last Updated: 15 May 1990
 ++ Description:
-++ This package implements 'infinite tuples' for the interpreter.
-++ The representation is a stream.
+++ This domain implements Zp, the p-adic completion of the integers.
+++ This is an internal domain.
 
-InfiniteTuple(S:Type): Exports == Implementation where
+InnerPAdicInteger(p,unBalanced?): Exports == Implementation where
+  p           : Integer
+  unBalanced? : Boolean
+  I   ==> Integer
+  NNI ==> NonNegativeInteger
+  OUT ==> OutputForm
+  L   ==> List
+  ST  ==> Stream
+  SUP ==> SparseUnivariatePolynomial
 
-  Exports ==> CoercibleTo OutputForm with
-    map: (S -> S, %) -> %
-      ++ map(f,t) replaces the tuple t
-      ++ by \spad{[f(x) for x in t]}.
-    filterWhile: (S -> Boolean, %) -> %
-      ++ filterWhile(p,t) returns \spad{[x for x in t while p(x)]}.
-    filterUntil: (S -> Boolean, %) -> %
-      ++ filterUntil(p,t) returns \spad{[x for x in t while not p(x)]}.
-    select: (S -> Boolean, %) -> %
-      ++ select(p,t) returns \spad{[x for x in t | p(x)]}.
-    generate: (S -> S,S) -> %
-      ++ generate(f,s) returns \spad{[s,f(s),f(f(s)),...]}.
-    construct: % -> Stream S
-      ++ construct(t) converts an infinite tuple to a stream.
+  Exports ==> PAdicIntegerCategory p
 
-  Implementation ==> Stream S add
-    generate(f,x) == generate(f,x)$Stream(S) pretend %
-    filterWhile(f, x) == filterWhile(f,x pretend Stream(S))$Stream(S) pretend %
-    filterUntil(f, x) == filterUntil(f,x pretend Stream(S))$Stream(S) pretend %
-    select(f, x) == select(f,x pretend Stream(S))$Stream(S) pretend %
-    construct x == x pretend Stream(S)
---    coerce x ==
---      coerce(x)$Stream(S)
+  Implementation ==> add
 
-\end{chunk}
+    PEXPR := p :: OUT
 
-\begin{chunk}{COQ ITUPLE}
-(* domain ITUPLE *)
-(*
-*)
+    Rep := ST I
 
-\end{chunk}
+    characteristic() == 0
+    euclideanSize(x) == order(x)
 
-\begin{chunk}{ITUPLE.dotabb}
-"ITUPLE" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ITUPLE"]
-"TYPE" [color="#4488FF",href="bookvol10.2.pdf#nameddest=TYPE"]
-"ITUPLE" -> "TYPE"
+    stream(x:%):ST I == x pretend ST(I)
+    padic(x:ST I):% == x pretend %
+    digits x == stream x
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain INFCLSPT InfinitlyClosePoint} 
+    extend(x,n) == extend(x,n + 1)$Rep
+    complete x == complete(x)$Rep
 
-\begin{chunk}{InfinitlyClosePoint.input}
-)set break resume
-)sys rm -f InfinitlyClosePoint.output
-)spool InfinitlyClosePoint.output
-)set message test on
-)set message auto off
-)clear all
+    modP:I -> I
+    modP n ==
+      unBalanced? or (p = 2) => positiveRemainder(n,p)
+      symmetricRemainder(n,p)
 
---S 1 of 1
-)show InfinitlyClosePoint
---R 
---R InfinitlyClosePoint(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)  is a domain constructor
---R Abbreviation for InfinitlyClosePoint is INFCLSPT 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for INFCLSPT 
---R
---R------------------------------- Operations --------------------------------
---R ?=? : (%,%) -> Boolean                actualExtensionV : % -> K
---R chartV : % -> BLMET                   coerce : % -> OutputForm
---R create : (ProjPt,PolyRing) -> %       degree : % -> PositiveInteger
---R excpDivV : % -> DIVISOR               fullOut : % -> OutputForm
---R fullOutput : () -> Boolean            fullOutput : Boolean -> Boolean
---R hash : % -> SingleInteger             latex : % -> String
---R localParamV : % -> List(PCS)          localPointV : % -> AffinePlane(K)
---R multV : % -> NonNegativeInteger       pointV : % -> ProjPt
---R setchart! : (%,BLMET) -> BLMET        setpoint! : (%,ProjPt) -> ProjPt
---R setsymbName! : (%,Symbol) -> Symbol   subMultV : % -> NonNegativeInteger
---R symbNameV : % -> Symbol               ?~=? : (%,%) -> Boolean
---R create : (ProjPt,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K),AffinePlane(K),NonNegativeInteger,BLMET,NonNegativeInteger,DIVISOR,K,Symbol) -> %
---R curveV : % -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
---R setcurve! : (%,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)) -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],K)
---R setexcpDiv! : (%,DIVISOR) -> DIVISOR
---R setlocalParam! : (%,List(PCS)) -> List(PCS)
---R setlocalPoint! : (%,AffinePlane(K)) -> AffinePlane(K)
---R setmult! : (%,NonNegativeInteger) -> NonNegativeInteger
---R setsubmult! : (%,NonNegativeInteger) -> NonNegativeInteger
---R
---E 1
+    modPInfo:I -> Record(digit:I,carry:I)
+    modPInfo n ==
+      dv := divide(n,p)
+      r0 := dv.remainder; q := dv.quotient
+      if (r := modP r0) ^= r0 then q := q + ((r0 - r) quo p)
+      [r,q]
 
-)spool
-)lisp (bye)
+    invModP: I -> I
+    invModP n == invmod(n,p)
 
-\end{chunk}
-\begin{chunk}{InfinitlyClosePoint.help}
-====================================================================
-InfinitlyClosePoint examples
-====================================================================
+    modulus()     == p
 
-This domain is part of the PAFF package
+    moduloP x     == (empty? x => 0; frst x)
 
-See Also:
-o )show InfinitlyClosePoint
+    quotientByP x == (empty? x => x; rst x)
 
-\end{chunk}
-\pagehead{InfinitlyClosePoint}{INFCLSPT}
-\pagepic{ps/v103infinitlyclosepoint.eps}{INFCLSPT}{1.00}
+    approximate(x,n) ==
+      n <= 0 or empty? x => 0
+      frst x + p * approximate(rst x,n - 1)
 
-{\bf Exports:}\\
-\begin{tabular}{lll}
-\cross{INFCLSPT}{?=?} &
-\cross{INFCLSPT}{?\~{}=?} &
-\cross{INFCLSPT}{actualExtensionV} \\
-\cross{INFCLSPT}{chartV} &
-\cross{INFCLSPT}{coerce} &
-\cross{INFCLSPT}{create} \\
-\cross{INFCLSPT}{curveV} &
-\cross{INFCLSPT}{degree} &
-\cross{INFCLSPT}{excpDivV} \\
-\cross{INFCLSPT}{fullOut} &
-\cross{INFCLSPT}{fullOutput} &
-\cross{INFCLSPT}{fullOutput} \\
-\cross{INFCLSPT}{hash} &
-\cross{INFCLSPT}{latex} &
-\cross{INFCLSPT}{localParamV} \\
-\cross{INFCLSPT}{localPointV} &
-\cross{INFCLSPT}{multV} &
-\cross{INFCLSPT}{pointV} \\
-\cross{INFCLSPT}{setchart!} &
-\cross{INFCLSPT}{setcurve!} &
-\cross{INFCLSPT}{setexcpDiv!} \\
-\cross{INFCLSPT}{setlocalParam!} &
-\cross{INFCLSPT}{setlocalPoint!} &
-\cross{INFCLSPT}{setmult!} \\
-\cross{INFCLSPT}{setpoint!} &
-\cross{INFCLSPT}{setsubmult!} &
-\cross{INFCLSPT}{setsymbName!} \\
-\cross{INFCLSPT}{subMultV} &
-\cross{INFCLSPT}{symbNameV} &
-\end{tabular}
+    x = y ==
+      st : ST I := stream(x - y)
+      n : I := _$streamCount$Lisp
+      for i in 0..n repeat
+        empty? st => return true
+        frst st ^= 0 => return false
+        st := rst st
+      empty? st
 
-\begin{chunk}{domain INFCLSPT InfinitlyClosePoint}
-)abbrev domain INFCLSPT InfinitlyClosePoint
-++ Authors: Gaetan Hache
-++ Date Created: june 1996 
-++ Date Last Updated: May 2010 by Tim Daly
-++ Description: 
-++ This domain is part of the PAFF package
-InfinitlyClosePoint(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR,BLMET):Exports == Implementation where
-  K:Field
-  symb: List Symbol
-  E:DirectProductCategory(#symb,NonNegativeInteger)
-  OV ==> OrderedVariableList(symb)
-  PolyRing:  PolynomialCategory(K,E,OV)
+    order x ==
+      st := stream x
+      for i in 0..1000 repeat
+        empty? st => return 0
+        frst st ^= 0 => return i
+        st := rst st
+      error "order: series has more than 1000 leading zero coefs"
 
-  bls      ==> ['X,'Y]
-  BlUpRing ==> DistributedMultivariatePolynomial(bls , K)
-  E2       ==> DirectProduct( #bls , NonNegativeInteger )
-  outRec   ==> Record(name:Symbol,mult:NonNegativeInteger)
-  AFP      ==> AffinePlane(K)
-  OV2      ==> OrderedVariableList( bls )
+    0 == padic concat(0$I,empty())
 
-  PCS: LocalPowerSeriesCategory(K)
-  ProjPt:ProjectiveSpaceCategory(K)
-  Plc: PlacesCategory(K,PCS)
-  DIVISOR: DivisorCategory(Plc)
-  BLMET : BlowUpMethodCategory
-  
-  bigoutRecBLQT ==> Record(dominate:ProjPt,_
-                       name:Symbol,_
-                       mult:NonNegativeInteger,_
-                       defCurve:BlUpRing,_
-                       localPoint:AFP,_
-                       chart:BLMET,_ 
-                       expD:DIVISOR) 
+    1 == padic concat(1$I,empty())
 
-  bigoutRecHN  ==> Record(dominate:ProjPt,_
-                       name:Symbol,_
-                       mult:NonNegativeInteger,_
-                       defCurve:BlUpRing,_
-                       localPoint:AFP,_
-                       chart:BLMET,_ 
-                       subMultip: NonNegativeInteger,_
-                       expD:DIVISOR) 
+    intToPAdic: I -> ST I
+    intToPAdic n == delay
+      n = 0 => empty()
+      modp := modPInfo n
+      concat(modp.digit,intToPAdic modp.carry)
 
+    intPlusPAdic: (I,ST I) -> ST I
+    intPlusPAdic(n,x) == delay
+      empty? x => intToPAdic n
+      modp := modPInfo(n + frst x)
+      concat(modp.digit,intPlusPAdic(modp.carry,rst x))
 
-  representation   ==>  Record(point:ProjPt,_
-                               curve:BlUpRing,_
-                               localPoint:AFP,_
-                               mult:NonNegativeInteger,_
-                               chrt:BLMET,_
-                               subMultiplicity:NonNegativeInteger,_
-                               excpDiv:DIVISOR,_
-                               localParam:List(PCS),_
-                               actualExtension:K,_
-                               symbName:Symbol)
+    intMinusPAdic: (I,ST I) -> ST I
+    intMinusPAdic(n,x) == delay
+      empty? x => intToPAdic n
+      modp := modPInfo(n - frst x)
+      concat(modp.digit,intMinusPAdic(modp.carry,rst x))
 
+    plusAux: (I,ST I,ST I) -> ST I
+    plusAux(n,x,y) == delay
+      empty? x and empty? y => intToPAdic n
+      empty? x => intPlusPAdic(n,y)
+      empty? y => intPlusPAdic(n,x)
+      modp := modPInfo(n + frst x + frst y)
+      concat(modp.digit,plusAux(modp.carry,rst x,rst y))
 
-  Exports == InfinitlyClosePointCategory(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR,BLMET) with 
+    minusAux: (I,ST I,ST I) -> ST I
+    minusAux(n,x,y) == delay
+      empty? x and empty? y => intToPAdic n
+      empty? x => intMinusPAdic(n,y)
+      empty? y => intPlusPAdic(n,x)
+      modp := modPInfo(n + frst x - frst y)
+      concat(modp.digit,minusAux(modp.carry,rst x,rst y))
 
-    fullOut: % -> OutputForm
-      ++ fullOut(tr) yields a full output of tr (see function fullOutput).
+    x + y == padic plusAux(0,stream x,stream y)
+    x - y == padic minusAux(0,stream x,stream y)
+    - y   == padic intMinusPAdic(0,stream y)
+    coerce(n:I) == padic intToPAdic n
 
-    fullOutput: Boolean -> Boolean
-      ++ fullOutput(b) sets a flag such that when true, a coerce to 
-      ++ OutputForm yields the full output of tr, otherwise encode(tr) is 
-      ++ output (see encode function). The default is false.
+    intMult:(I,ST I) -> ST I
+    intMult(n,x) == delay
+      empty? x => empty()
+      modp := modPInfo(n * frst x)
+      concat(modp.digit,intPlusPAdic(modp.carry,intMult(n,rst x)))
 
-    fullOutput: () -> Boolean
-      ++ fullOutput returns the value of the flag set by fullOutput(b).   
-     
-  Implementation == representation add
-    Rep := representation
+    (n:I) * (x:%) ==
+      padic intMult(n,stream x)
 
-    polyRing2BiRing: (PolyRing, Integer) -> BlUpRing
-    polyRing2BiRing(pol,nV)==
-      zero? pol => 0$BlUpRing
-      d:= degree pol
-      lc:= leadingCoefficient pol
-      dd: List NonNegativeInteger := entries d
-      ddr:=vector([dd.i for i in 1..#dd | ^(i=nV)])$Vector(NonNegativeInteger)
-      ddre:E2 := directProduct( ddr )$E2
-      monomial(lc,ddre)$BlUpRing  + polyRing2BiRing( reductum pol , nV )
+    timesAux:(ST I,ST I) -> ST I
+    timesAux(x,y) == delay
+      empty? x or empty? y => empty()
+      modp := modPInfo(frst x * frst y)
+      car := modp.digit
+      cdr : ST I --!!
+      cdr := plusAux(modp.carry,intMult(frst x,rst y),timesAux(rst x,y))
+      concat(car,cdr)
 
-    projPt2affPt: (ProjPt, Integer) -> AFP
-    projPt2affPt(pt,nV)==
-      ll:= pt :: List(K)
-      l:= [ ll.i for i in 1..#ll | ^(i = nV )]
-      affinePoint( l)
+    (x:%) * (y:%) == padic timesAux(stream x,stream y)
 
-    fullOut(a)==
-      oo: bigoutRecBLQT
-      oo2: bigoutRecHN
-      BLMET has BlowUpWithQuadTrans =>
-        oo:=  [ pointV(a), symbNameV(a), multV(a), curveV(a), _
-              localPointV(a), chartV(a),  excpDivV(a) ]$bigoutRecBLQT
-        oo :: OutputForm
-      BLMET has BlowUpWithHamburgerNoether => 
-        oo2:=  [ pointV(a), symbNameV(a), multV(a), curveV(a), _
-              localPointV(a), chartV(a), subMultV(a), excpDivV(a) ]$bigoutRecHN
-        oo2 :: OutputForm
+    quotientAux:(ST I,ST I) -> ST I
+    quotientAux(x,y) == delay
+      empty? x => error "quotientAux: first argument"
+      empty? y => empty()
+      modP frst x = 0 =>
+        modP frst y = 0 => quotientAux(rst x,rst y)
+        error "quotient: quotient not integral"
+      z0 := modP(invModP frst x * frst y)
+      yy : ST I --!!
+      yy := rest minusAux(0,y,intMult(z0,x))
+      concat(z0,quotientAux(x,yy))
 
-    fullOutputFlag:Boolean:=false()
+    recip x ==
+      empty? x or modP frst x = 0 => "failed"
+      padic quotientAux(stream x,concat(1,empty()))
 
-    fullOutput(f)== fullOutputFlag:=f
+    iExquo: (%,%,I) -> Union(%,"failed")
+    iExquo(xx,yy,n) ==
+      n > 1000 =>
+        error "exquo: quotient by series with many leading zero coefs"
+      empty? yy => "failed"
+      empty? xx => 0
+      zero? frst yy =>
+        zero? frst xx => iExquo(rst xx,rst yy,n + 1)
+        "failed"
+      (rec := recip yy) case "failed" => "failed"
+      xx * (rec :: %)
 
-    fullOutput == fullOutputFlag
+    x exquo y == iExquo(stream x,stream y,0)
 
-    coerce(a:%):OutputForm== 
-      fullOutput() => fullOut(a)
-      oo:outRec:= [ symbNameV(a) , multV(a) ]$outRec
-      oo :: OutputForm
+    divide(x,y) ==
+      (z:=x exquo y) case "failed" => [0,x]
+      [z, 0]
 
-    degree(a)==
-      K has PseudoAlgebraicClosureOfPerfectFieldCategory  => extDegree actualExtensionV a
-      1
-      
-    create(pointA,curveA,localPointA,multA,chartA,subM,excpDivA,atcL,aName)==  -- CHH
-      ([pointA,curveA,localPointA,multA,chartA,subM,excpDivA,empty()$List(PCS),atcL,aName]$Rep)::%
+    iSqrt: (I,I,I,%) -> %
+    iSqrt(pn,an,bn,bSt) == delay
+      bn1 := (empty? bSt => bn; bn + pn * frst(bSt))
+      c := (bn1 - an*an) quo pn
+      aa := modP(c * invmod(2*an,p))
+      nSt := (empty? bSt => bSt; rst bSt)
+      concat(aa,iSqrt(pn*p,an + pn*aa,bn1,nSt))
 
-    create(pointA,curveA)==
-      nV := lastNonNul pointA
-      localPointA := projPt2affPt(pointA,nV)
-      multA:NonNegativeInteger:=0$NonNegativeInteger
-      chartA:BLMET 
-      if BLMET has QuadraticTransform then chartA:=( [0,0, nV] :: List Integer ) :: BLMET   -- CHH
-      if BLMET has HamburgerNoether then
-        chartA := createHN( 0,0,nV,0,0,true,"right")   -- A changer le "right" 
-      excpDivA:DIVISOR:= 0$DIVISOR
-      actL:K:=definingField pointA
-      aName:Symbol:=new(P)$Symbol
-      affCurvA : BlUpRing := polyRing2BiRing(curveA,nV)
-      create(pointA,affCurvA,localPointA,multA,chartA,0$NonNegativeInteger,excpDivA,actL,aName)
-      
-    subMultV(a:%)== (a:Rep)(subMultiplicity)
+    sqrt(b,a) ==
+      p = 2 =>
+        error "sqrt: no square roots in Z2 yet"
+      not zero? modP(a*a - (bb := moduloP b)) =>
+        error "sqrt: not a square root (mod p)"
+      b := (empty? b => b; rst b)
+      a := modP a
+      concat(a,iSqrt(p,a,bb,b))
+
+    iRoot: (SUP I,I,I,I) -> ST I
+    iRoot(f,alpha,invFpx0,pPow) == delay
+      num := -((f(alpha) exquo pPow) :: I)
+      digit := modP(num * invFpx0)
+      concat(digit,iRoot(f,alpha + digit * pPow,invFpx0,p * pPow))
+
+    root(f,x0) ==
+      x0 := modP x0
+      not zero? modP f(x0) =>
+        error "root: not a root (mod p)"
+      fpx0 := modP (differentiate f)(x0)
+      zero? fpx0 =>
+        error "root: approximate root must be a simple root (mod p)"
+      invFpx0 := modP invModP fpx0
+      padic concat(x0,iRoot(f,x0,invFpx0,p))
+
+    termOutput:(I,I) -> OUT
+    termOutput(k,c) ==
+      k = 0 => c :: OUT
+      mon := (k = 1 => PEXPR; PEXPR ** (k :: OUT))
+      c = 1 => mon
+      c = -1 => -mon
+      (c :: OUT) * mon
+
+    showAll?:() -> Boolean
+    -- check a global Lisp variable
+    showAll?() == true
+
+    coerce(x:%):OUT ==
+      empty?(st := stream x) => 0 :: OUT
+      n : NNI ; count : NNI := _$streamCount$Lisp
+      l : L OUT := empty()
+      for n in 0..count while not empty? st repeat
+        if frst(st) ^= 0 then
+          l := concat(termOutput(n :: I,frst st),l)
+        st := rst st
+      if showAll?() then
+        for n in (count + 1).. while explicitEntries? st and _
+               not eq?(st,rst st) repeat
+          if frst(st) ^= 0 then
+            l := concat(termOutput(n pretend I,frst st),l)
+          st := rst st
+      l :=
+        explicitlyEmpty? st => l
+        eq?(st,rst st) and frst st = 0 => l
+        concat(prefix("O" :: OUT,[PEXPR ** (n :: OUT)]),l)
+      empty? l => 0 :: OUT
+      reduce("+",reverse_! l)
+
+\end{chunk}
+
+\begin{chunk}{COQ IPADIC}
+(* domain IPADIC *)
+(*
 
-    setsubmult_!(a:%,sm:NonNegativeInteger)== (a:Rep)(subMultiplicity) := sm
+    PEXPR := p :: OUT
 
-    pointV(a:%)     ==(a:Rep)(point)
+    Rep := ST I
 
-    symbNameV(a:%)     ==(a:Rep)(symbName)
+    characteristic() == 0
+    euclideanSize(x) == order(x)
 
-    curveV(a:%)  ==(a:Rep)(curve)
+    stream(x:%):ST I == x pretend ST(I)
+    padic(x:ST I):% == x pretend %
+    digits x == stream x
 
-    localPointV(a:%)   ==(a:Rep)(localPoint)
+    extend(x,n) == extend(x,n + 1)$Rep
+    complete x == complete(x)$Rep
 
-    multV(a:%)    ==(a:Rep)(mult)
+    modP:I -> I
+    modP n ==
+      unBalanced? or (p = 2) => positiveRemainder(n,p)
+      symmetricRemainder(n,p)
 
-    chartV(a:%)   ==(a:Rep)(chrt)  -- CHH
+    modPInfo:I -> Record(digit:I,carry:I)
+    modPInfo n ==
+      dv := divide(n,p)
+      r0 := dv.remainder; q := dv.quotient
+      if (r := modP r0) ^= r0 then q := q + ((r0 - r) quo p)
+      [r,q]
 
-    excpDivV(a:%) ==(a:Rep)(excpDiv)
+    invModP: I -> I
+    invModP n == invmod(n,p)
 
-    localParamV(a:%) ==(a:Rep)(localParam)
-    
-    actualExtensionV(a:%) == (a:Rep)(actualExtension)
+    modulus()     == p
 
-    setpoint_!(a:%,n:ProjPt)       ==(a:Rep)(point):=n
+    moduloP x     == (empty? x => 0; frst x)
 
-    setcurve_!(a:%,n:BlUpRing)   ==(a:Rep)(curve):=n
+    quotientByP x == (empty? x => x; rst x)
 
-    setlocalPoint_!(a:%,n:AFP)  ==(a:Rep)(localPoint):=n
+    approximate(x,n) ==
+      n <= 0 or empty? x => 0
+      frst x + p * approximate(rst x,n - 1)
 
-    setmult_!(a:%,n:NonNegativeInteger)         ==(a:Rep)(mult):=n
+    x = y ==
+      st : ST I := stream(x - y)
+      n : I := _$streamCount$Lisp
+      for i in 0..n repeat
+        empty? st => return true
+        frst st ^= 0 => return false
+        st := rst st
+      empty? st
 
-    setchart_!(a:%,n:BLMET)  ==(a:Rep)(chrt):=n  -- CHH
+    order x ==
+      st := stream x
+      for i in 0..1000 repeat
+        empty? st => return 0
+        frst st ^= 0 => return i
+        st := rst st
+      error "order: series has more than 1000 leading zero coefs"
 
-    setlocalParam_!(a:%,n:List(PCS)) ==(a:Rep)(localParam):=n
+    0 == padic concat(0$I,empty())
 
-    setexcpDiv_!(a:%,n:DIVISOR) ==(a:Rep)(excpDiv):=n
+    1 == padic concat(1$I,empty())
 
-    setsymbName_!(a:%,n:Symbol) ==(a:Rep)(symbName):=n
+    intToPAdic: I -> ST I
+    intToPAdic n == delay
+      n = 0 => empty()
+      modp := modPInfo n
+      concat(modp.digit,intToPAdic modp.carry)
 
-\end{chunk}
+    intPlusPAdic: (I,ST I) -> ST I
+    intPlusPAdic(n,x) == delay
+      empty? x => intToPAdic n
+      modp := modPInfo(n + frst x)
+      concat(modp.digit,intPlusPAdic(modp.carry,rst x))
 
-\begin{chunk}{COQ INFCLSPT}
-(* domain INFCLSPT *)
-(*
-*)
+    intMinusPAdic: (I,ST I) -> ST I
+    intMinusPAdic(n,x) == delay
+      empty? x => intToPAdic n
+      modp := modPInfo(n - frst x)
+      concat(modp.digit,intMinusPAdic(modp.carry,rst x))
 
-\end{chunk}
+    plusAux: (I,ST I,ST I) -> ST I
+    plusAux(n,x,y) == delay
+      empty? x and empty? y => intToPAdic n
+      empty? x => intPlusPAdic(n,y)
+      empty? y => intPlusPAdic(n,x)
+      modp := modPInfo(n + frst x + frst y)
+      concat(modp.digit,plusAux(modp.carry,rst x,rst y))
 
-\begin{chunk}{INFCLSPT.dotabb}
-"INFCLSPT" [color="#88FF44",href="bookvol10.3.pdf#nameddest=INFCLSPT"]
-"INFCLCT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=INFCLCT"]
-"INFCLSPT" -> "INFCLCT"
+    minusAux: (I,ST I,ST I) -> ST I
+    minusAux(n,x,y) == delay
+      empty? x and empty? y => intToPAdic n
+      empty? x => intMinusPAdic(n,y)
+      empty? y => intPlusPAdic(n,x)
+      modp := modPInfo(n + frst x - frst y)
+      concat(modp.digit,minusAux(modp.carry,rst x,rst y))
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain INFCLSPS InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField}
+    x + y == padic plusAux(0,stream x,stream y)
+    x - y == padic minusAux(0,stream x,stream y)
+    - y   == padic intMinusPAdic(0,stream y)
+    coerce(n:I) == padic intToPAdic n
 
-\begin{chunk}{InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField.input}
-)set break resume
-)sys rm -f InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField.output
-)spool InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField.output
-)set message test on
-)set message auto off
-)clear all
+    intMult:(I,ST I) -> ST I
+    intMult(n,x) == delay
+      empty? x => empty()
+      modp := modPInfo(n * frst x)
+      concat(modp.digit,intPlusPAdic(modp.carry,intMult(n,rst x)))
 
---S 1 of 1
-)show InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField
---R 
---R InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField(K: FiniteFieldCategory,symb: List(Symbol),BLMET: BlowUpMethodCategory)  is a domain constructor
---R Abbreviation for InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField is INFCLSPS 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for INFCLSPS 
---R
---R------------------------------- Operations --------------------------------
---R ?=? : (%,%) -> Boolean                chartV : % -> BLMET
---R coerce : % -> OutputForm              degree : % -> PositiveInteger
---R fullOut : % -> OutputForm             fullOutput : () -> Boolean
---R fullOutput : Boolean -> Boolean       hash : % -> SingleInteger
---R latex : % -> String                   multV : % -> NonNegativeInteger
---R setchart! : (%,BLMET) -> BLMET        setsymbName! : (%,Symbol) -> Symbol
---R subMultV : % -> NonNegativeInteger    symbNameV : % -> Symbol
---R ?~=? : (%,%) -> Boolean              
---R actualExtensionV : % -> PseudoAlgebraicClosureOfFiniteField(K)
---R create : (ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K),DistributedMultivariatePolynomial(symb,PseudoAlgebraicClosureOfFiniteField(K))) -> %
---R create : (ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K),DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],PseudoAlgebraicClosureOfFiniteField(K)),AffinePlane(PseudoAlgebraicClosureOfFiniteField(K)),NonNegativeInteger,BLMET,NonNegativeInteger,Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K)),PseudoAlgebraicClosureOfFiniteField(K),Symbol) -> %
---R curveV : % -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],PseudoAlgebraicClosureOfFiniteField(K))
---R excpDivV : % -> Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K))
---R localParamV : % -> List(NeitherSparseOrDensePowerSeries(PseudoAlgebraicClosureOfFiniteField(K)))
---R localPointV : % -> AffinePlane(PseudoAlgebraicClosureOfFiniteField(K))
---R pointV : % -> ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K)
---R setcurve! : (%,DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],PseudoAlgebraicClosureOfFiniteField(K))) -> DistributedMultivariatePolynomial([construct,QUOTEX,QUOTEY],PseudoAlgebraicClosureOfFiniteField(K))
---R setexcpDiv! : (%,Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K))) -> Divisor(PlacesOverPseudoAlgebraicClosureOfFiniteField(K))
---R setlocalParam! : (%,List(NeitherSparseOrDensePowerSeries(PseudoAlgebraicClosureOfFiniteField(K)))) -> List(NeitherSparseOrDensePowerSeries(PseudoAlgebraicClosureOfFiniteField(K)))
---R setlocalPoint! : (%,AffinePlane(PseudoAlgebraicClosureOfFiniteField(K))) -> AffinePlane(PseudoAlgebraicClosureOfFiniteField(K))
---R setmult! : (%,NonNegativeInteger) -> NonNegativeInteger
---R setpoint! : (%,ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K)) -> ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K)
---R setsubmult! : (%,NonNegativeInteger) -> NonNegativeInteger
---R
---E 1
+    (n:I) * (x:%) ==
+      padic intMult(n,stream x)
 
-)spool
-)lisp (bye)
+    timesAux:(ST I,ST I) -> ST I
+    timesAux(x,y) == delay
+      empty? x or empty? y => empty()
+      modp := modPInfo(frst x * frst y)
+      car := modp.digit
+      cdr : ST I --!!
+      cdr := plusAux(modp.carry,intMult(frst x,rst y),timesAux(rst x,y))
+      concat(car,cdr)
 
-\end{chunk}
-\begin{chunk}{InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField.help}
-====================================================================
-InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField examples
-====================================================================
+    (x:%) * (y:%) == padic timesAux(stream x,stream y)
 
-This domain is part of the PAFF package
+    quotientAux:(ST I,ST I) -> ST I
+    quotientAux(x,y) == delay
+      empty? x => error "quotientAux: first argument"
+      empty? y => empty()
+      modP frst x = 0 =>
+        modP frst y = 0 => quotientAux(rst x,rst y)
+        error "quotient: quotient not integral"
+      z0 := modP(invModP frst x * frst y)
+      yy : ST I --!!
+      yy := rest minusAux(0,y,intMult(z0,x))
+      concat(z0,quotientAux(x,yy))
 
-See Also:
-o )show InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField
+    recip x ==
+      empty? x or modP frst x = 0 => "failed"
+      padic quotientAux(stream x,concat(1,empty()))
 
-\end{chunk}
-\pagehead{InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField}{INFCLSPS}
-\pagepic{ps/v103infinitlyclosepointoverpseudoalgebraicclosureoffinitefield.eps}{INFCLSPS}{1.00}
+    iExquo: (%,%,I) -> Union(%,"failed")
+    iExquo(xx,yy,n) ==
+      n > 1000 =>
+        error "exquo: quotient by series with many leading zero coefs"
+      empty? yy => "failed"
+      empty? xx => 0
+      zero? frst yy =>
+        zero? frst xx => iExquo(rst xx,rst yy,n + 1)
+        "failed"
+      (rec := recip yy) case "failed" => "failed"
+      xx * (rec :: %)
 
-{\bf Exports:}\\
-\begin{tabular}{lll}
-\cross{INFCLSPS}{?=?} &
-\cross{INFCLSPS}{?\~{}=?} &
-\cross{INFCLSPS}{actualExtensionV} \\
-\cross{INFCLSPS}{chartV} &
-\cross{INFCLSPS}{coerce} &
-\cross{INFCLSPS}{create} \\
-\cross{INFCLSPS}{curveV} &
-\cross{INFCLSPS}{degree} &
-\cross{INFCLSPS}{excpDivV} \\
-\cross{INFCLSPS}{fullOut} &
-\cross{INFCLSPS}{fullOutput} &
-\cross{INFCLSPS}{hash} \\
-\cross{INFCLSPS}{latex} &
-\cross{INFCLSPS}{localParamV} &
-\cross{INFCLSPS}{localPointV} \\
-\cross{INFCLSPS}{multV} &
-\cross{INFCLSPS}{pointV} &
-\cross{INFCLSPS}{setchart!} \\
-\cross{INFCLSPS}{setcurve!} &
-\cross{INFCLSPS}{setexcpDiv!} &
-\cross{INFCLSPS}{setlocalParam!} \\
-\cross{INFCLSPS}{setlocalPoint!} &
-\cross{INFCLSPS}{setmult!} &
-\cross{INFCLSPS}{setpoint!} \\
-\cross{INFCLSPS}{setsubmult!} &
-\cross{INFCLSPS}{setsymbName!} &
-\cross{INFCLSPS}{subMultV} \\
-\cross{INFCLSPS}{symbNameV} &&
-\end{tabular}
+    x exquo y == iExquo(stream x,stream y,0)
 
-\begin{chunk}{domain INFCLSPS InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField}
-)abbrev domain INFCLSPS InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField
-++ Authors: Gaetan Hache
-++ Date Created: june 1996 
-++ Date Last Updated: May 2010 by Tim Daly
-++ Description: 
-++ This domain is part of the PAFF package
-InfinitlyClosePointOverPseudoAlgebraicClosureOfFiniteField(K,symb,BLMET):_
- Exports == Implementation where
+    divide(x,y) ==
+      (z:=x exquo y) case "failed" => [0,x]
+      [z, 0]
 
-  K:FiniteFieldCategory
-  symb: List Symbol
-  BLMET : BlowUpMethodCategory
+    iSqrt: (I,I,I,%) -> %
+    iSqrt(pn,an,bn,bSt) == delay
+      bn1 := (empty? bSt => bn; bn + pn * frst(bSt))
+      c := (bn1 - an*an) quo pn
+      aa := modP(c * invmod(2*an,p))
+      nSt := (empty? bSt => bSt; rst bSt)
+      concat(aa,iSqrt(pn*p,an + pn*aa,bn1,nSt))
 
-  E           ==> DirectProduct(#symb,NonNegativeInteger)
-  KK          ==> PseudoAlgebraicClosureOfFiniteField(K)
-  PolyRing    ==> DistributedMultivariatePolynomial(symb,KK) 
-  ProjPt      ==> ProjectivePlaneOverPseudoAlgebraicClosureOfFiniteField(K)
-  PCS         ==> NeitherSparseOrDensePowerSeries(KK)
-  Plc         ==> PlacesOverPseudoAlgebraicClosureOfFiniteField(K)
-  DIVISOR     ==> Divisor(Plc)
+    sqrt(b,a) ==
+      p = 2 =>
+        error "sqrt: no square roots in Z2 yet"
+      not zero? modP(a*a - (bb := moduloP b)) =>
+        error "sqrt: not a square root (mod p)"
+      b := (empty? b => b; rst b)
+      a := modP a
+      concat(a,iSqrt(p,a,bb,b))
 
-  Exports == InfinitlyClosePointCategory(KK,symb,PolyRing,E,ProjPt,_
-                                         PCS,Plc,DIVISOR,BLMET) with
-  
-    fullOut: % -> OutputForm
-      ++ fullOut(tr) yields a full output of tr (see function fullOutput).
+    iRoot: (SUP I,I,I,I) -> ST I
+    iRoot(f,alpha,invFpx0,pPow) == delay
+      num := -((f(alpha) exquo pPow) :: I)
+      digit := modP(num * invFpx0)
+      concat(digit,iRoot(f,alpha + digit * pPow,invFpx0,p * pPow))
 
-    fullOutput: Boolean -> Boolean
+    root(f,x0) ==
+      x0 := modP x0
+      not zero? modP f(x0) =>
+        error "root: not a root (mod p)"
+      fpx0 := modP (differentiate f)(x0)
+      zero? fpx0 =>
+        error "root: approximate root must be a simple root (mod p)"
+      invFpx0 := modP invModP fpx0
+      padic concat(x0,iRoot(f,x0,invFpx0,p))
 
-      ++ fullOutput(b) sets a flag such that when true, a coerce to OutputForm
-      ++  yields the full output of tr, otherwise encode(tr) is output 
-      ++ (see encode function). The default is false.
+    termOutput:(I,I) -> OUT
+    termOutput(k,c) ==
+      k = 0 => c :: OUT
+      mon := (k = 1 => PEXPR; PEXPR ** (k :: OUT))
+      c = 1 => mon
+      c = -1 => -mon
+      (c :: OUT) * mon
 
-    fullOutput: () -> Boolean
-      ++ fullOutput returns the value of the flag set by fullOutput(b).   
-     
-  Implementation == InfinitlyClosePoint(KK,symb,PolyRing,E,ProjPt,_
-                                        PCS,Plc,DIVISOR,BLMET) 
-\end{chunk}
+    showAll?:() -> Boolean
+    -- check a global Lisp variable
+    showAll?() == true
+
+    coerce(x:%):OUT ==
+      empty?(st := stream x) => 0 :: OUT
+      n : NNI ; count : NNI := _$streamCount$Lisp
+      l : L OUT := empty()
+      for n in 0..count while not empty? st repeat
+        if frst(st) ^= 0 then
+          l := concat(termOutput(n :: I,frst st),l)
+        st := rst st
+      if showAll?() then
+        for n in (count + 1).. while explicitEntries? st and _
+               not eq?(st,rst st) repeat
+          if frst(st) ^= 0 then
+            l := concat(termOutput(n pretend I,frst st),l)
+          st := rst st
+      l :=
+        explicitlyEmpty? st => l
+        eq?(st,rst st) and frst st = 0 => l
+        concat(prefix("O" :: OUT,[PEXPR ** (n :: OUT)]),l)
+      empty? l => 0 :: OUT
+      reduce("+",reverse_! l)
 
-\begin{chunk}{COQ INFCLSPS}
-(* domain INFCLSPS *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{INFCLSPS.dotabb}
-"INFCLSPS" [color="#88FF44",href="bookvol10.3.pdf#nameddest=INFCLSPS"]
-"PROJPLPS" [color="#88FF44",href="bookvol10.3.pdf#nameddest=PROJPLPS"]
-"INFCLSPS" -> "PROJPLPS"
+\begin{chunk}{IPADIC.dotabb}
+"IPADIC" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IPADIC"]
+"FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"]
+"PADICCT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PADICCT"]
+"IPADIC" -> "PADICCT"
+"IPADIC" -> "FLAGG"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IAN InnerAlgebraicNumber}
+\section{domain IPF InnerPrimeField}
 
-\begin{chunk}{InnerAlgebraicNumber.input}
+\begin{chunk}{InnerPrimeField.input}
 )set break resume
-)sys rm -f InnerAlgebraicNumber.output
-)spool InnerAlgebraicNumber.output
+)sys rm -f InnerPrimeField.output
+)spool InnerPrimeField.output
 )set message test on
 )set message auto off
 )clear all
 
 --S 1 of 1
-)show InnerAlgebraicNumber
+)show InnerPrimeField
 --R 
---R InnerAlgebraicNumber  is a domain constructor
---R Abbreviation for InnerAlgebraicNumber is IAN 
+--R InnerPrimeField(p: PositiveInteger)  is a domain constructor
+--R Abbreviation for InnerPrimeField is IPF 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IAN 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for IPF 
 --R
 --R------------------------------- Operations --------------------------------
---R ?*? : (PositiveInteger,%) -> %        ?*? : (NonNegativeInteger,%) -> %
---R ?*? : (Integer,%) -> %                ?*? : (%,%) -> %
---R ?*? : (%,Fraction(Integer)) -> %      ?*? : (Fraction(Integer),%) -> %
---R ?**? : (%,PositiveInteger) -> %       ?**? : (%,NonNegativeInteger) -> %
---R ?**? : (%,Integer) -> %               ?**? : (%,Fraction(Integer)) -> %
---R ?+? : (%,%) -> %                      -? : % -> %
---R ?-? : (%,%) -> %                      ?/? : (%,%) -> %
---R ?<? : (%,%) -> Boolean                ?<=? : (%,%) -> Boolean
---R ?=? : (%,%) -> Boolean                ?>? : (%,%) -> Boolean
---R ?>=? : (%,%) -> Boolean               D : % -> %
---R D : (%,NonNegativeInteger) -> %       1 : () -> %
---R 0 : () -> %                           ?^? : (%,PositiveInteger) -> %
---R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,Integer) -> %
---R associates? : (%,%) -> Boolean        belong? : BasicOperator -> Boolean
---R box : List(%) -> %                    box : % -> %
---R coerce : Integer -> %                 coerce : % -> %
---R coerce : Fraction(Integer) -> %       coerce : Kernel(%) -> %
---R coerce : % -> OutputForm              convert : % -> Complex(Float)
---R convert : % -> DoubleFloat            convert : % -> Float
---R differentiate : % -> %                distribute : (%,%) -> %
---R distribute : % -> %                   elt : (BasicOperator,List(%)) -> %
---R elt : (BasicOperator,%,%,%) -> %      elt : (BasicOperator,%,%) -> %
---R elt : (BasicOperator,%) -> %          eval : (%,Symbol,(% -> %)) -> %
---R eval : (%,List(%),List(%)) -> %       eval : (%,%,%) -> %
---R eval : (%,Equation(%)) -> %           eval : (%,List(Equation(%))) -> %
---R eval : (%,Kernel(%),%) -> %           factor : % -> Factored(%)
---R freeOf? : (%,Symbol) -> Boolean       freeOf? : (%,%) -> Boolean
---R gcd : (%,%) -> %                      gcd : List(%) -> %
---R hash : % -> SingleInteger             height : % -> NonNegativeInteger
---R inv : % -> %                          is? : (%,Symbol) -> Boolean
---R is? : (%,BasicOperator) -> Boolean    kernel : (BasicOperator,%) -> %
---R kernels : % -> List(Kernel(%))        latex : % -> String
---R lcm : (%,%) -> %                      lcm : List(%) -> %
---R map : ((% -> %),Kernel(%)) -> %       max : (%,%) -> %
---R min : (%,%) -> %                      norm : (%,List(Kernel(%))) -> %
---R norm : (%,Kernel(%)) -> %             nthRoot : (%,Integer) -> %
---R one? : % -> Boolean                   paren : List(%) -> %
---R paren : % -> %                        prime? : % -> Boolean
---R ?quo? : (%,%) -> %                    recip : % -> Union(%,"failed")
---R reduce : % -> %                       ?rem? : (%,%) -> %
---R retract : % -> Fraction(Integer)      retract : % -> Integer
---R retract : % -> Kernel(%)              rootOf : Polynomial(%) -> %
---R rootsOf : Polynomial(%) -> List(%)    sample : () -> %
---R sizeLess? : (%,%) -> Boolean          sqrt : % -> %
---R squareFree : % -> Factored(%)         squareFreePart : % -> %
---R subst : (%,Equation(%)) -> %          tower : % -> List(Kernel(%))
---R trueEqual : (%,%) -> Boolean          unit? : % -> Boolean
+--R ?*? : (Fraction(Integer),%) -> %      ?*? : (%,Fraction(Integer)) -> %
+--R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
+--R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
+--R ?**? : (%,Integer) -> %               ?**? : (%,NonNegativeInteger) -> %
+--R ?**? : (%,PositiveInteger) -> %       ?+? : (%,%) -> %
+--R ?-? : (%,%) -> %                      -? : % -> %
+--R ?/? : (%,%) -> %                      ?=? : (%,%) -> Boolean
+--R D : % -> %                            D : (%,NonNegativeInteger) -> %
+--R Frobenius : % -> % if $ has FINITE    1 : () -> %
+--R 0 : () -> %                           ?^? : (%,Integer) -> %
+--R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
+--R algebraic? : % -> Boolean             associates? : (%,%) -> Boolean
+--R basis : () -> Vector(%)               charthRoot : % -> %
+--R coerce : Fraction(Integer) -> %       coerce : % -> %
+--R coerce : Integer -> %                 coerce : % -> OutputForm
+--R convert : % -> Integer                coordinates : % -> Vector(%)
+--R createPrimitiveElement : () -> %      degree : % -> PositiveInteger
+--R differentiate : % -> %                dimension : () -> CardinalNumber
+--R enumerate : () -> List(%)             factor : % -> Factored(%)
+--R gcd : List(%) -> %                    gcd : (%,%) -> %
+--R generator : () -> % if $ has FINITE   hash : % -> SingleInteger
+--R inGroundField? : % -> Boolean         index : PositiveInteger -> %
+--R init : () -> %                        inv : % -> %
+--R latex : % -> String                   lcm : List(%) -> %
+--R lcm : (%,%) -> %                      lookup : % -> PositiveInteger
+--R nextItem : % -> Union(%,"failed")     norm : % -> %
+--R one? : % -> Boolean                   order : % -> PositiveInteger
+--R prime? : % -> Boolean                 primeFrobenius : % -> %
+--R primitive? : % -> Boolean             primitiveElement : () -> %
+--R ?quo? : (%,%) -> %                    random : () -> %
+--R recip : % -> Union(%,"failed")        ?rem? : (%,%) -> %
+--R represents : Vector(%) -> %           retract : % -> %
+--R sample : () -> %                      size : () -> NonNegativeInteger
+--R sizeLess? : (%,%) -> Boolean          squareFree : % -> Factored(%)
+--R squareFreePart : % -> %               trace : % -> %
+--R transcendent? : % -> Boolean          unit? : % -> Boolean
 --R unitCanonical : % -> %                zero? : % -> Boolean
---R zeroOf : Polynomial(%) -> %           zerosOf : Polynomial(%) -> List(%)
 --R ?~=? : (%,%) -> Boolean              
+--R Frobenius : (%,NonNegativeInteger) -> % if $ has FINITE
+--R basis : PositiveInteger -> Vector(%)
 --R characteristic : () -> NonNegativeInteger
---R coerce : SparseMultivariatePolynomial(Integer,Kernel(%)) -> %
---R definingPolynomial : % -> % if $ has RING
---R denom : % -> SparseMultivariatePolynomial(Integer,Kernel(%))
+--R charthRoot : % -> Union(%,"failed")
+--R conditionP : Matrix(%) -> Union(Vector(%),"failed")
+--R coordinates : Vector(%) -> Matrix(%)
+--R createNormalElement : () -> % if $ has FINITE
+--R definingPolynomial : () -> SparseUnivariatePolynomial(%)
+--R degree : % -> OnePointCompletion(PositiveInteger)
 --R differentiate : (%,NonNegativeInteger) -> %
+--R discreteLog : % -> NonNegativeInteger
+--R discreteLog : (%,%) -> Union(NonNegativeInteger,"failed")
 --R divide : (%,%) -> Record(quotient: %,remainder: %)
---R elt : (BasicOperator,%,%,%,%) -> %
 --R euclideanSize : % -> NonNegativeInteger
---R eval : (%,BasicOperator,(% -> %)) -> %
---R eval : (%,BasicOperator,(List(%) -> %)) -> %
---R eval : (%,List(BasicOperator),List((List(%) -> %))) -> %
---R eval : (%,List(BasicOperator),List((% -> %))) -> %
---R eval : (%,Symbol,(List(%) -> %)) -> %
---R eval : (%,List(Symbol),List((List(%) -> %))) -> %
---R eval : (%,List(Symbol),List((% -> %))) -> %
---R eval : (%,List(Kernel(%)),List(%)) -> %
---R even? : % -> Boolean if $ has RETRACT(INT)
 --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 extensionDegree : () -> OnePointCompletion(PositiveInteger)
+--R extensionDegree : () -> PositiveInteger
+--R factorsOfCyclicGroupSize : () -> List(Record(factor: Integer,exponent: Integer))
 --R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%)
---R kernel : (BasicOperator,List(%)) -> %
 --R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %)
---R mainKernel : % -> Union(Kernel(%),"failed")
---R minPoly : Kernel(%) -> SparseUnivariatePolynomial(%) if $ has RING
+--R linearAssociatedExp : (%,SparseUnivariatePolynomial(%)) -> % if $ has FINITE
+--R linearAssociatedLog : % -> SparseUnivariatePolynomial(%) if $ has FINITE
+--R linearAssociatedLog : (%,%) -> Union(SparseUnivariatePolynomial(%),"failed") if $ has FINITE
+--R linearAssociatedOrder : % -> SparseUnivariatePolynomial(%) if $ has FINITE
+--R minimalPolynomial : % -> SparseUnivariatePolynomial(%)
+--R minimalPolynomial : (%,PositiveInteger) -> SparseUnivariatePolynomial(%) if $ has FINITE
 --R multiEuclidean : (List(%),%) -> Union(List(%),"failed")
---R norm : (SparseUnivariatePolynomial(%),List(Kernel(%))) -> SparseUnivariatePolynomial(%)
---R norm : (SparseUnivariatePolynomial(%),Kernel(%)) -> SparseUnivariatePolynomial(%)
---R numer : % -> SparseMultivariatePolynomial(Integer,Kernel(%))
---R odd? : % -> Boolean if $ has RETRACT(INT)
---R operator : BasicOperator -> BasicOperator
---R operators : % -> List(BasicOperator)
+--R norm : (%,PositiveInteger) -> % if $ has FINITE
+--R normal? : % -> Boolean if $ has FINITE
+--R normalElement : () -> % if $ has FINITE
+--R order : % -> OnePointCompletion(PositiveInteger)
+--R primeFrobenius : (%,NonNegativeInteger) -> %
 --R principalIdeal : List(%) -> Record(coef: List(%),generator: %)
---R reducedSystem : Matrix(%) -> Matrix(Fraction(Integer))
---R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Fraction(Integer)),vec: Vector(Fraction(Integer)))
---R reducedSystem : Matrix(%) -> Matrix(Integer)
---R reducedSystem : (Matrix(%),Vector(%)) -> Record(mat: Matrix(Integer),vec: Vector(Integer))
---R retractIfCan : % -> Union(Fraction(Integer),"failed")
---R retractIfCan : % -> Union(Integer,"failed")
---R retractIfCan : % -> Union(Kernel(%),"failed")
---R rootOf : SparseUnivariatePolynomial(%) -> %
---R rootOf : (SparseUnivariatePolynomial(%),Symbol) -> %
---R rootsOf : SparseUnivariatePolynomial(%) -> List(%)
---R rootsOf : (SparseUnivariatePolynomial(%),Symbol) -> List(%)
---R subst : (%,List(Kernel(%)),List(%)) -> %
---R subst : (%,List(Equation(%))) -> %
+--R representationType : () -> Union("prime",polynomial,normal,cyclic)
+--R retractIfCan : % -> Union(%,"failed")
 --R subtractIfCan : (%,%) -> Union(%,"failed")
+--R tableForDiscreteLogarithm : Integer -> Table(PositiveInteger,NonNegativeInteger)
+--R trace : (%,PositiveInteger) -> % if $ has FINITE
+--R transcendenceDegree : () -> NonNegativeInteger
 --R unitNormal : % -> Record(unit: %,canonical: %,associate: %)
---R zeroOf : SparseUnivariatePolynomial(%) -> %
---R zeroOf : (SparseUnivariatePolynomial(%),Symbol) -> %
---R zerosOf : SparseUnivariatePolynomial(%) -> List(%)
---R zerosOf : (SparseUnivariatePolynomial(%),Symbol) -> List(%)
 --R
 --E 1
 
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{InnerAlgebraicNumber.help}
+\begin{chunk}{InnerPrimeField.help}
 ====================================================================
-InnerAlgebraicNumber examples
+InnerPrimeField examples
 ====================================================================
 
-Algebraic closure of the rational numbers.
+InnerPrimeField(p) implements the field with p elements.
+Note: argument p MUST be a prime (this domain does not check).
+See PrimeField for a domain that does check.
 
 See Also:
-o )show InnerAlgebraicNumber
+o )show InnerPrimeField
+o )show PrimeField
 
 \end{chunk}
 
-\pagehead{InnerAlgebraicNumber}{IAN}
-\pagepic{ps/v103inneralgebraicnumber.ps}{IAN}{1.00}
+\pagehead{InnerPrimeField}{IPF}
+\pagepic{ps/v103innerprimefield.ps}{IPF}{1.00}
 {\bf See}\\
-\pageto{AlgebraicNumber}{AN}
+\pageto{PrimeField}{PF}
 
 {\bf Exports:}\\
-\begin{tabular}{llll}
-\cross{IAN}{0} &
-\cross{IAN}{1} &
-\cross{IAN}{associates?} &
-\cross{IAN}{belong?} \\
-\cross{IAN}{box} &
-\cross{IAN}{characteristic} &
-\cross{IAN}{coerce} &
-\cross{IAN}{convert} \\
-\cross{IAN}{D} &
-\cross{IAN}{definingPolynomial} &
-\cross{IAN}{denom} &
-\cross{IAN}{differentiate} \\
-\cross{IAN}{distribute} &
-\cross{IAN}{divide} &
-\cross{IAN}{elt} &
-\cross{IAN}{euclideanSize} \\
-\cross{IAN}{eval} &
-\cross{IAN}{even?} &
-\cross{IAN}{expressIdealMember} &
-\cross{IAN}{exquo} \\
-\cross{IAN}{extendedEuclidean} &
-\cross{IAN}{factor} &
-\cross{IAN}{freeOf?} &
-\cross{IAN}{gcd} \\
-\cross{IAN}{gcdPolynomial} &
-\cross{IAN}{hash} &
-\cross{IAN}{height} &
-\cross{IAN}{inv} \\
-\cross{IAN}{is?} &
-\cross{IAN}{kernel} &
-\cross{IAN}{kernels} &
-\cross{IAN}{latex} \\
-\cross{IAN}{lcm} &
-\cross{IAN}{mainKernel} &
-\cross{IAN}{map} &
-\cross{IAN}{max} \\
-\cross{IAN}{min} &
-\cross{IAN}{minPoly} &
-\cross{IAN}{multiEuclidean} &
-\cross{IAN}{norm} \\
-\cross{IAN}{nthRoot} &
-\cross{IAN}{numer} &
-\cross{IAN}{odd?} &
-\cross{IAN}{one?} \\
-\cross{IAN}{operator} &
-\cross{IAN}{operators} &
-\cross{IAN}{paren} &
-\cross{IAN}{prime?} \\
-\cross{IAN}{principalIdeal} &
-\cross{IAN}{recip} &
-\cross{IAN}{reduce} &
-\cross{IAN}{reducedSystem} \\
-\cross{IAN}{retract} &
-\cross{IAN}{retractIfCan} &
-\cross{IAN}{rootOf} &
-\cross{IAN}{rootsOf} \\
-\cross{IAN}{sample} &
-\cross{IAN}{sizeLess?} &
-\cross{IAN}{sqrt} &
-\cross{IAN}{squareFree} \\
-\cross{IAN}{squareFreePart} &
-\cross{IAN}{subst} &
-\cross{IAN}{subtractIfCan} &
-\cross{IAN}{tower} \\
-\cross{IAN}{trueEqual} &
-\cross{IAN}{unit?} &
-\cross{IAN}{unitCanonical} &
-\cross{IAN}{unitNormal} \\
-\cross{IAN}{zero?} &
-\cross{IAN}{zeroOf} &
-\cross{IAN}{zerosOf} &
-\cross{IAN}{?*?} \\
-\cross{IAN}{?**?} &
-\cross{IAN}{?+?} &
-\cross{IAN}{-?} &
-\cross{IAN}{?-?} \\
-\cross{IAN}{?/?} &
-\cross{IAN}{?$<$?} &
-\cross{IAN}{?$<=$?} &
-\cross{IAN}{?=?} \\
-\cross{IAN}{?$>$?} &
-\cross{IAN}{?$>=$?} &
-\cross{IAN}{?\^{}?} &
-\cross{IAN}{?\~{}=?} \\
-\cross{IAN}{?*?} &
-\cross{IAN}{?**?} &
-\cross{IAN}{?quo?} &
-\cross{IAN}{?rem?} 
+\begin{tabular}{lll}
+\cross{IPF}{0} &
+\cross{IPF}{1} &
+\cross{IPF}{algebraic?} \\
+\cross{IPF}{associates?} &
+\cross{IPF}{basis} &
+\cross{IPF}{characteristic} \\
+\cross{IPF}{charthRoot} &
+\cross{IPF}{coerce} &
+\cross{IPF}{conditionP} \\
+\cross{IPF}{convert} &
+\cross{IPF}{coordinates} &
+\cross{IPF}{createPrimitiveElement} \\
+\cross{IPF}{createNormalElement} &
+\cross{IPF}{D} &
+\cross{IPF}{definingPolynomial} \\
+\cross{IPF}{degree} &
+\cross{IPF}{differentiate} &
+\cross{IPF}{dimension} \\
+\cross{IPF}{discreteLog} &
+\cross{IPF}{divide} &
+\cross{IPF}{euclideanSize} \\
+\cross{IPF}{expressIdealMember} &
+\cross{IPF}{exquo} &
+\cross{IPF}{extendedEuclidean} \\
+\cross{IPF}{extensionDegree} &
+\cross{IPF}{factor} &
+\cross{IPF}{factorsOfCyclicGroupSize} \\
+\cross{IPF}{Frobenius} &
+\cross{IPF}{gcd} &
+\cross{IPF}{gcdPolynomial} \\
+\cross{IPF}{generator} &
+\cross{IPF}{hash} &
+\cross{IPF}{inGroundField?} \\
+\cross{IPF}{index} &
+\cross{IPF}{init} &
+\cross{IPF}{inv} \\
+\cross{IPF}{latex} &
+\cross{IPF}{lcm} &
+\cross{IPF}{linearAssociatedExp} \\
+\cross{IPF}{linearAssociatedLog} &
+\cross{IPF}{linearAssociatedOrder} &
+\cross{IPF}{lookup} \\
+\cross{IPF}{minimalPolynomial} &
+\cross{IPF}{multiEuclidean} &
+\cross{IPF}{nextItem} \\
+\cross{IPF}{norm} &
+\cross{IPF}{normal?} &
+\cross{IPF}{normalElement} \\
+\cross{IPF}{one?} &
+\cross{IPF}{order} &
+\cross{IPF}{prime?} \\
+\cross{IPF}{primeFrobenius} &
+\cross{IPF}{primitive?} &
+\cross{IPF}{primitiveElement} \\
+\cross{IPF}{principalIdeal} &
+\cross{IPF}{random} &
+\cross{IPF}{recip} \\
+\cross{IPF}{representationType} &
+\cross{IPF}{represents} &
+\cross{IPF}{retract} \\
+\cross{IPF}{retractIfCan} &
+\cross{IPF}{sample} &
+\cross{IPF}{size} \\
+\cross{IPF}{sizeLess?} &
+\cross{IPF}{squareFree} &
+\cross{IPF}{squareFreePart} \\
+\cross{IPF}{subtractIfCan} &
+\cross{IPF}{tableForDiscreteLogarithm} &
+\cross{IPF}{trace} \\
+\cross{IPF}{transcendenceDegree} &
+\cross{IPF}{transcendent?} &
+\cross{IPF}{unit?} \\
+\cross{IPF}{unitCanonical} &
+\cross{IPF}{unitNormal} &
+\cross{IPF}{zero?} \\
+\cross{IPF}{?*?} &
+\cross{IPF}{?**?} &
+\cross{IPF}{?+?} \\
+\cross{IPF}{?-?} &
+\cross{IPF}{-?} &
+\cross{IPF}{?/?} \\
+\cross{IPF}{?=?} &
+\cross{IPF}{?\^{}?} &
+\cross{IPF}{?\~{}=?} \\
+\cross{IPF}{?quo?} &
+\cross{IPF}{?rem?} &
 \end{tabular}
 
-\begin{chunk}{domain IAN InnerAlgebraicNumber}
-)abbrev domain IAN InnerAlgebraicNumber
-++ Author: Manuel Bronstein
-++ Date Created: 22 March 1988
-++ Date Last Updated: 4 October 1995 (JHD)
-++ Description: 
-++ Algebraic closure of the rational numbers.
+\begin{chunk}{domain IPF InnerPrimeField}
+)abbrev domain IPF InnerPrimeField
+++ Authors: N.N., J.Grabmeier, A.Scheerhorn
+++ Date Created: ?, November 1990, 26.03.1991
+++ Date Last Updated: 12 April 1991
+++ References:
+++  R.Lidl, H.Niederreiter: Finite Field, Encycoldia of Mathematics and
+++  Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4
+++  AXIOM Technical Report Series, to appear.
+++ Description:
+++ InnerPrimeField(p) implements the field with p elements.
+++ Note: argument p MUST be a prime (this domain does not check).
+++ See \spadtype{PrimeField} for a domain that does check.
 
-InnerAlgebraicNumber(): Exports == Implementation where
-  Z   ==> Integer
-  FE  ==> Expression Z
-  K   ==> Kernel %
-  P   ==> SparseMultivariatePolynomial(Z, K)
-  ALGOP ==> "%alg"
-  SUP ==>  SparseUnivariatePolynomial
+InnerPrimeField(p:PositiveInteger): Exports == Implementation where
 
-  Exports ==> Join(ExpressionSpace, AlgebraicallyClosedField,
-                   RetractableTo Z, RetractableTo Fraction Z,
-                   LinearlyExplicitRingOver Z, RealConstant,
-                   LinearlyExplicitRingOver Fraction Z,
-                   CharacteristicZero,
-                   ConvertibleTo Complex Float, DifferentialRing) with
-    coerce : P -> %
-      ++ coerce(p) returns p viewed as an algebraic number.
-    numer  : % -> P
-      ++ numer(f) returns the numerator of f viewed as a
-      ++ polynomial in the kernels over Z.
-    denom  : % -> P
-      ++ denom(f) returns the denominator of f viewed as a
-      ++ polynomial in the kernels over Z.
-    reduce : % -> %
-      ++ reduce(f) simplifies all the unreduced algebraic numbers
-      ++ present in f by applying their defining relations.
-    trueEqual : (%,%) -> Boolean
-      ++ trueEqual(x,y) tries to determine if the two numbers are equal
-    norm : (SUP(%),Kernel %) -> SUP(%)
-      ++ norm(p,k) computes the norm of the polynomial p
-      ++ with respect to the extension generated by kernel k
-    norm : (SUP(%),List Kernel %) -> SUP(%)
-      ++ norm(p,l) computes the norm of the polynomial p
-      ++ with respect to the extension generated by kernels l
-    norm : (%,Kernel %) -> %
-      ++ norm(f,k) computes the norm of the algebraic number f
-      ++ with respect to the extension generated by kernel k
-    norm : (%,List Kernel %) -> %
-      ++ norm(f,l) computes the norm of the algebraic number f
-      ++ with respect to the extension generated by kernels l
-  Implementation ==> FE add
+  I   ==> Integer
+  NNI ==> NonNegativeInteger
+  PI  ==> PositiveInteger
+  TBL ==> Table(PI,NNI)
+  R   ==> Record(key:PI,entry:NNI)
+  SUP ==> SparseUnivariatePolynomial
+  OUT ==> OutputForm
 
-    Rep := FE
+  Exports ==> Join(FiniteFieldCategory,FiniteAlgebraicExtensionField($),_
+                ConvertibleTo(Integer))
 
-    -- private
-    mainRatDenom(f:%):% ==
-       ratDenom(f::Rep::FE)$AlgebraicManipulations(Integer, FE)::Rep::%
---        mv:= mainVariable denom f
---        mv case "failed" => f
---        algv:=mv::K
---       q:=univariate(f, algv, minPoly(algv))_
---       $PolynomialCategoryQuotientFunctions(IndexedExponents K,K,Integer,P,%)
---       q(algv::%)
+  Implementation ==> IntegerMod p add
 
-    findDenominator(z:SUP %):Record(num:SUP %,den:%) ==
-       zz:=z
-       while not(zz=0) repeat
-          dd:=(denom leadingCoefficient zz)::%
-          not(dd=1) =>
-             rec:=findDenominator(dd*z)
-             return [rec.num,rec.den*dd]
-          zz:=reductum zz
-       [z,1]
-    makeUnivariate(p:P,k:Kernel %):SUP % ==
-      map(x+->x::%,univariate(p,k))$SparseUnivariatePolynomialFunctions2(P,%)
-    -- public
-    a,b:%
-    differentiate(x:%):% == 0
-    zero? a == zero? numer a
---    one? a == one? numer a and one? denom a
-    one? a == (numer a = 1) and (denom a = 1)
-    x:% / y:%        == mainRatDenom(x /$Rep y)
-    x:% ** n:Integer ==
-      n < 0 => mainRatDenom (x **$Rep n)
-      x **$Rep n
-    trueEqual(a,b) ==
-       -- if two algebraic numbers have the same norm (after deleting repeated
-       -- roots, then they are certainly conjugates. Note that we start with a
-       -- monic polynomial, so don't have to check for constant factors.
-       -- this will be fooled by sqrt(2) and -sqrt(2), but the = in
-       -- AlgebraicNumber knows what to do about this.
-       ka:=reverse tower a
-       kb:=reverse tower b
-       empty? ka and empty? kb => retract(a)@Fraction Z = retract(b)@Fraction Z
-       pa,pb:SparseUnivariatePolynomial %
-       pa:=monomial(1,1)-monomial(a,0)
-       pb:=monomial(1,1)-monomial(b,0)
-       na:=map(retract,norm(pa,ka))_
-         $SparseUnivariatePolynomialFunctions2(%,Fraction Z)
-       nb:=map(retract,norm(pb,kb))_
-         $SparseUnivariatePolynomialFunctions2(%,Fraction Z)
-       (sa:=squareFreePart(na)) = (sb:=squareFreePart(nb)) => true
-       g:=gcd(sa,sb)
-       (dg:=degree g) = 0 => false
-       -- of course, if these have a factor in common, then the
-       -- answer is really ambiguous, so we ought to be using Duval-type
-       -- technology
-       dg = degree sa or dg = degree sb => true
-       false
-    norm(z:%,k:Kernel %): % ==
-       p:=minPoly k
-       n:=makeUnivariate(numer z,k)
-       d:=makeUnivariate(denom z,k)
-       resultant(n,p)/resultant(d,p)
-    norm(z:%,l:List Kernel %): % ==
-       for k in l repeat
-           z:=norm(z,k)
-       z
-    norm(z:SUP %,k:Kernel %):SUP % ==
-       p:=map(x +-> x::SUP %,minPoly k)_
-         $SparseUnivariatePolynomialFunctions2(%,SUP %)
-       f:=findDenominator z
-       zz:=map(x +-> makeUnivariate(numer x,k),f.num)_
-         $SparseUnivariatePolynomialFunctions2( %,SUP %)
-       zz:=swap(zz)$CommuteUnivariatePolynomialCategory(%,SUP %,SUP SUP %)
-       resultant(p,zz)/norm(f.den,k)
-    norm(z:SUP %,l:List Kernel %): SUP % ==
-       for k in l repeat
-           z:=norm(z,k)
-       z
-    belong? op           == belong?(op)$ExpressionSpace_&(%) or has?(op, ALGOP)
+    initializeElt:() -> Void
+    initializeLog:() -> Void
 
-    convert(x:%):Float ==
-      retract map(y +-> y::Float, x pretend FE)$ExpressionFunctions2(Z,Float)
+-- global variables ====================================================
 
-    convert(x:%):DoubleFloat ==
-      retract map(y +-> y::DoubleFloat,x pretend FE)_
-        $ExpressionFunctions2(Z, DoubleFloat)
+    primitiveElt:PI:=1
+    -- for the lookup the primitive Element 
+    -- computed by createPrimitiveElement()
 
-    convert(x:%):Complex(Float) ==
-      retract map(y +-> y::Complex(Float),x pretend FE)_
-        $ExpressionFunctions2(Z, Complex Float)
+    sizeCG  :=(p-1) pretend NonNegativeInteger
+    -- the size of the cyclic group
 
-\end{chunk}
+    facOfGroupSize := nil()$(List Record(factor:Integer,exponent:Integer))
+    -- the factorization of the cyclic group size
 
-\begin{chunk}{COQ IAN}
-(* domain IAN *)
-(*
-*)
+    initlog?:Boolean:=true
+    -- gets false after initialization of the logarithm table
 
-\end{chunk}
+    initelt?:Boolean:=true
+    -- gets false after initialization of the primitive Element
 
-\begin{chunk}{IAN.dotabb}
-"IAN" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IAN"]
-"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
-"COMPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=COMPCAT"]
-"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"]
-"IAN" -> "ACF"
-"IAN" -> "FS"
-"IAN" -> "COMPCAT"
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IFF InnerFiniteField}
+    discLogTable:Table(PI,TBL):=table()$Table(PI,TBL)
+    -- tables indexed by the factors of the size q of the cyclic group
+    -- discLogTable.factor is a table of with keys
+    -- primitiveElement() ** (i * (q quo factor)) and entries i for
+    -- i in 0..n-1, n computed in initialize() in order to use
+    -- the minimal size limit 'limit' optimal.
 
-\begin{chunk}{InnerFiniteField.input}
-)set break resume
-)sys rm -f InnerFiniteField.output
-)spool InnerFiniteField.output
-)set message test on
-)set message auto off
-)clear all
+-- functions ===========================================================
 
---S 1 of 1
-)show InnerFiniteField
---R 
---R InnerFiniteField(p: PositiveInteger,n: PositiveInteger)  is a domain constructor
---R Abbreviation for InnerFiniteField is IFF 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IFF 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (InnerPrimeField(p),%) -> %     ?*? : (%,InnerPrimeField(p)) -> %
---R ?*? : (Fraction(Integer),%) -> %      ?*? : (%,Fraction(Integer)) -> %
---R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
---R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?**? : (%,Integer) -> %               ?**? : (%,NonNegativeInteger) -> %
---R ?**? : (%,PositiveInteger) -> %       ?+? : (%,%) -> %
---R ?-? : (%,%) -> %                      -? : % -> %
---R ?/? : (%,InnerPrimeField(p)) -> %     ?/? : (%,%) -> %
---R ?=? : (%,%) -> Boolean                1 : () -> %
---R 0 : () -> %                           ?^? : (%,Integer) -> %
---R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
---R algebraic? : % -> Boolean             associates? : (%,%) -> Boolean
---R basis : () -> Vector(%)               coerce : InnerPrimeField(p) -> %
---R coerce : Fraction(Integer) -> %       coerce : % -> %
---R coerce : Integer -> %                 coerce : % -> OutputForm
---R degree : % -> PositiveInteger         dimension : () -> CardinalNumber
---R factor : % -> Factored(%)             gcd : List(%) -> %
---R gcd : (%,%) -> %                      hash : % -> SingleInteger
---R inGroundField? : % -> Boolean         inv : % -> %
---R latex : % -> String                   lcm : List(%) -> %
---R lcm : (%,%) -> %                      norm : % -> InnerPrimeField(p)
---R one? : % -> Boolean                   prime? : % -> Boolean
---R ?quo? : (%,%) -> %                    recip : % -> Union(%,"failed")
---R ?rem? : (%,%) -> %                    retract : % -> InnerPrimeField(p)
---R sample : () -> %                      sizeLess? : (%,%) -> Boolean
---R squareFree : % -> Factored(%)         squareFreePart : % -> %
---R trace : % -> InnerPrimeField(p)       transcendent? : % -> Boolean
---R unit? : % -> Boolean                  unitCanonical : % -> %
---R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
---R D : (%,NonNegativeInteger) -> % if InnerPrimeField(p) has FINITE
---R D : % -> % if InnerPrimeField(p) has FINITE
---R Frobenius : (%,NonNegativeInteger) -> % if InnerPrimeField(p) has FINITE
---R Frobenius : % -> % if InnerPrimeField(p) has FINITE
---R basis : PositiveInteger -> Vector(%)
---R characteristic : () -> NonNegativeInteger
---R charthRoot : % -> Union(%,"failed") if InnerPrimeField(p) has CHARNZ or InnerPrimeField(p) has FINITE
---R charthRoot : % -> % if InnerPrimeField(p) has FINITE
---R conditionP : Matrix(%) -> Union(Vector(%),"failed") if InnerPrimeField(p) has FINITE
---R coordinates : Vector(%) -> Matrix(InnerPrimeField(p))
---R coordinates : % -> Vector(InnerPrimeField(p))
---R createNormalElement : () -> % if InnerPrimeField(p) has FINITE
---R createPrimitiveElement : () -> % if InnerPrimeField(p) has FINITE
---R definingPolynomial : () -> SparseUnivariatePolynomial(InnerPrimeField(p))
---R degree : % -> OnePointCompletion(PositiveInteger)
---R differentiate : (%,NonNegativeInteger) -> % if InnerPrimeField(p) has FINITE
---R differentiate : % -> % if InnerPrimeField(p) has FINITE
---R discreteLog : (%,%) -> Union(NonNegativeInteger,"failed") if InnerPrimeField(p) has CHARNZ or InnerPrimeField(p) has FINITE
---R discreteLog : % -> NonNegativeInteger if InnerPrimeField(p) has FINITE
---R divide : (%,%) -> Record(quotient: %,remainder: %)
---R enumerate : () -> List(%) if InnerPrimeField(p) has FINITE
---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 extensionDegree : () -> PositiveInteger
---R extensionDegree : () -> OnePointCompletion(PositiveInteger)
---R factorsOfCyclicGroupSize : () -> List(Record(factor: Integer,exponent: Integer)) if InnerPrimeField(p) has FINITE
---R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%)
---R generator : () -> % if InnerPrimeField(p) has FINITE
---R index : PositiveInteger -> % if InnerPrimeField(p) has FINITE
---R init : () -> % if InnerPrimeField(p) has FINITE
---R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %)
---R linearAssociatedExp : (%,SparseUnivariatePolynomial(InnerPrimeField(p))) -> % if InnerPrimeField(p) has FINITE
---R linearAssociatedLog : (%,%) -> Union(SparseUnivariatePolynomial(InnerPrimeField(p)),"failed") if InnerPrimeField(p) has FINITE
---R linearAssociatedLog : % -> SparseUnivariatePolynomial(InnerPrimeField(p)) if InnerPrimeField(p) has FINITE
---R linearAssociatedOrder : % -> SparseUnivariatePolynomial(InnerPrimeField(p)) if InnerPrimeField(p) has FINITE
---R lookup : % -> PositiveInteger if InnerPrimeField(p) has FINITE
---R minimalPolynomial : (%,PositiveInteger) -> SparseUnivariatePolynomial(%) if InnerPrimeField(p) has FINITE
---R minimalPolynomial : % -> SparseUnivariatePolynomial(InnerPrimeField(p))
---R multiEuclidean : (List(%),%) -> Union(List(%),"failed")
---R nextItem : % -> Union(%,"failed") if InnerPrimeField(p) has FINITE
---R norm : (%,PositiveInteger) -> % if InnerPrimeField(p) has FINITE
---R normal? : % -> Boolean if InnerPrimeField(p) has FINITE
---R normalElement : () -> % if InnerPrimeField(p) has FINITE
---R order : % -> OnePointCompletion(PositiveInteger) if InnerPrimeField(p) has CHARNZ or InnerPrimeField(p) has FINITE
---R order : % -> PositiveInteger if InnerPrimeField(p) has FINITE
---R primeFrobenius : % -> % if InnerPrimeField(p) has CHARNZ or InnerPrimeField(p) has FINITE
---R primeFrobenius : (%,NonNegativeInteger) -> % if InnerPrimeField(p) has CHARNZ or InnerPrimeField(p) has FINITE
---R primitive? : % -> Boolean if InnerPrimeField(p) has FINITE
---R primitiveElement : () -> % if InnerPrimeField(p) has FINITE
---R principalIdeal : List(%) -> Record(coef: List(%),generator: %)
---R random : () -> % if InnerPrimeField(p) has FINITE
---R representationType : () -> Union("prime",polynomial,normal,cyclic) if InnerPrimeField(p) has FINITE
---R represents : Vector(InnerPrimeField(p)) -> %
---R retractIfCan : % -> Union(InnerPrimeField(p),"failed")
---R size : () -> NonNegativeInteger if InnerPrimeField(p) has FINITE
---R subtractIfCan : (%,%) -> Union(%,"failed")
---R tableForDiscreteLogarithm : Integer -> Table(PositiveInteger,NonNegativeInteger) if InnerPrimeField(p) has FINITE
---R trace : (%,PositiveInteger) -> % if InnerPrimeField(p) has FINITE
---R transcendenceDegree : () -> NonNegativeInteger
---R unitNormal : % -> Record(unit: %,canonical: %,associate: %)
---R
---E 1
+    generator() == 1
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{InnerFiniteField.help}
-====================================================================
-InnerFiniteField examples
-====================================================================
+    -- This uses x**(p-1)=1 (mod p), so x**(q(p-1)+r) = x**r (mod p)
+    x:$ ** n:Integer ==
+      zero?(n) => 1
+      zero?(x) => 0
+      r := positiveRemainder(n,p-1)::NNI
+      ((x pretend IntegerMod p) **$IntegerMod(p) r) pretend $
+
+    if p <= convert(max()$SingleInteger)@Integer then
+      q := p::SingleInteger
+
+      recip x ==
+        zero?(y := convert(x)@Integer :: SingleInteger) => "failed"
+        invmod(y, q)::Integer::$
 
-InnerFiniteField(p,n) implements finite fields with p**n elements
-where p is assumed prime but does not check.
-For a version which checks that p is prime, see FiniteField.
+    else
 
-See Also:
-o )show InnerFiniteField
-o )show FiniteField
+      recip x ==
+        zero?(y := convert(x)@Integer) => "failed"
+        invmod(y, p)::$
 
-\end{chunk}
+    convert(x:$) == x pretend I
 
-\pagehead{InnerFiniteField}{IFF}
-\pagepic{ps/v103innerfinitefield.ps}{IFF}{1.00}
-{\bf See}\\
-\pageto{FiniteFieldExtensionByPolynomial}{FFP}
-\pageto{FiniteFieldExtension}{FFX}
-\pageto{FiniteField}{FF}
+    normalElement() == 1
 
-{\bf Exports:}\\
-\begin{tabular}{lll}
-\cross{IFF}{0} &
-\cross{IFF}{1} &
-\cross{IFF}{algebraic?} \\
-\cross{IFF}{associates?} &
-\cross{IFF}{basis} &
-\cross{IFF}{characteristic} \\
-\cross{IFF}{charthRoot} &
-\cross{IFF}{coerce} &
-\cross{IFF}{conditionP} \\
-\cross{IFF}{coordinates} &
-\cross{IFF}{createNormalElement} &
-\cross{IFF}{createPrimitiveElement} \\
-\cross{IFF}{D} &
-\cross{IFF}{definingPolynomial} &
-\cross{IFF}{degree} \\
-\cross{IFF}{dimension} &
-\cross{IFF}{differentiate} &
-\cross{IFF}{discreteLog} \\
-\cross{IFF}{divide} &
-\cross{IFF}{euclideanSize} &
-\cross{IFF}{expressIdealMember} \\
-\cross{IFF}{exquo} &
-\cross{IFF}{extendedEuclidean} &
-\cross{IFF}{extensionDegree} \\
-\cross{IFF}{factor} &
-\cross{IFF}{factorsOfCyclicGroupSize} &
-\cross{IFF}{Frobenius} \\
-\cross{IFF}{gcd} &
-\cross{IFF}{gcdPolynomial} &
-\cross{IFF}{generator} \\
-\cross{IFF}{hash} &
-\cross{IFF}{index} &
-\cross{IFF}{inGroundField?} \\
-\cross{IFF}{init} &
-\cross{IFF}{inv} &
-\cross{IFF}{latex} \\
-\cross{IFF}{lcm} &
-\cross{IFF}{linearAssociatedExp} &
-\cross{IFF}{linearAssociatedLog} \\
-\cross{IFF}{linearAssociatedOrder} &
-\cross{IFF}{lookup} &
-\cross{IFF}{minimalPolynomial} \\
-\cross{IFF}{multiEuclidean} &
-\cross{IFF}{nextItem} &
-\cross{IFF}{norm} \\
-\cross{IFF}{normal?} &
-\cross{IFF}{normalElement} &
-\cross{IFF}{one?} \\
-\cross{IFF}{order} &
-\cross{IFF}{prime?} &
-\cross{IFF}{primeFrobenius} \\
-\cross{IFF}{primitive?} &
-\cross{IFF}{primitiveElement} &
-\cross{IFF}{principalIdeal} \\
-\cross{IFF}{random} &
-\cross{IFF}{recip} &
-\cross{IFF}{representationType} \\
-\cross{IFF}{represents} &
-\cross{IFF}{retract} &
-\cross{IFF}{retractIfCan} \\
-\cross{IFF}{sample} &
-\cross{IFF}{size} &
-\cross{IFF}{sizeLess?} \\
-\cross{IFF}{squareFree} &
-\cross{IFF}{squareFreePart} &
-\cross{IFF}{subtractIfCan} \\
-\cross{IFF}{tableForDiscreteLogarithm} &
-\cross{IFF}{trace} &
-\cross{IFF}{transcendenceDegree} \\
-\cross{IFF}{transcendent?} &
-\cross{IFF}{unit?} &
-\cross{IFF}{unitCanonical} \\
-\cross{IFF}{unitNormal} &
-\cross{IFF}{zero?} &
-\cross{IFF}{?*?} \\
-\cross{IFF}{?**?} &
-\cross{IFF}{?+?} &
-\cross{IFF}{?-?} \\
-\cross{IFF}{-?} &
-\cross{IFF}{?/?} &
-\cross{IFF}{?=?} \\
-\cross{IFF}{?\^{}?} &
-\cross{IFF}{?\~{}=?} &
-\cross{IFF}{?quo?} \\
-\cross{IFF}{?rem?} &&
-\end{tabular}
+    createNormalElement() == 1
 
-\begin{chunk}{domain IFF InnerFiniteField}
-)abbrev domain IFF InnerFiniteField
-++ Author: Mark Botch
-++ Date Last Updated: 29 May 1990
-++ Reference:
-++  R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics an
-++   Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4
-++  J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM.
-++   AXIOM Technical Report Series, ATR/5 NP2522.
-++ Description:
-++ InnerFiniteField(p,n) implements finite fields with \spad{p**n} elements
-++ where p is assumed prime but does not check.
-++ For a version which checks that p is prime, see \spadtype{FiniteField}.
+    characteristic() == p
 
-InnerFiniteField(p:PositiveInteger, n:PositiveInteger) ==
-     FiniteFieldExtension(InnerPrimeField p, n)
+    factorsOfCyclicGroupSize() ==
+      p=2 => facOfGroupSize -- this fixes an infinite loop of functions
+                            -- calls, problem was that factors factor(1)
+                            -- is the empty list
+      if empty? facOfGroupSize then initializeElt()
+      facOfGroupSize
 
-\end{chunk}
+    representationType() == "prime"
 
-\begin{chunk}{COQ IFF}
-(* domain IFF *)
-(*
-*)
+    tableForDiscreteLogarithm(fac) ==
+      if initlog? then initializeLog()
+      tbl:=search(fac::PI,discLogTable)$Table(PI,TBL)
+      tbl case "failed" =>
+        error "tableForDiscreteLogarithm: argument must be prime divisor_
+ of the order of the multiplicative group"
+      tbl pretend TBL
 
-\end{chunk}
+    primitiveElement() ==
+      if initelt? then initializeElt()
+      index(primitiveElt)
 
-\begin{chunk}{IFF.dotabb}
-"IFF" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IFF"]
-"FAXF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FAXF"]
-"IFF" -> "FAXF"
+    initializeElt() ==
+      facOfGroupSize:=factors(factor(sizeCG)$I)$(Factored I)
+      -- get a primitive element
+      primitiveElt:=lookup(createPrimitiveElement())
+      -- set initialization flag
+      initelt? := false
+      void$Void
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IFAMON InnerFreeAbelianMonoid}
+    initializeLog() ==
+      if initelt? then initializeElt()
+      -- set up tables for discrete logarithm
+      limit:Integer:=30
+      -- the minimum size for the discrete logarithm table
+      for f in facOfGroupSize repeat
+        fac:=f.factor
+        base:$:=primitiveElement() ** (sizeCG quo fac)
+        l:Integer:=length(fac)$Integer
+        n:Integer:=0
+        if odd?(l)$Integer then n:=shift(fac,-(l quo 2))
+                           else n:=shift(1,(l quo 2))
+        if n < limit then
+          d:=(fac-1) quo limit + 1
+          n:=(fac-1) quo d + 1
+        tbl:TBL:=table()$TBL
+        a:$:=1
+        for i in (0::NNI)..(n-1)::NNI repeat
+          insert_!([lookup(a),i::NNI]$R,tbl)$TBL
+          a:=a*base
+        insert_!([fac::PI,copy(tbl)$TBL]_
+               $Record(key:PI,entry:TBL),discLogTable)$Table(PI,TBL)
+      -- tell user about initialization
+      --    print("discrete logarithm table initialized"::OUT)
+      -- set initialization flag
+      initlog? := false
+      void$Void
 
-\begin{chunk}{InnerFreeAbelianMonoid.input}
-)set break resume
-)sys rm -f InnerFreeAbelianMonoid.output
-)spool InnerFreeAbelianMonoid.output
-)set message test on
-)set message auto off
-)clear all
+    degree(x):PI == 1::PositiveInteger
 
---S 1 of 1
-)show InnerFreeAbelianMonoid
---R 
---R InnerFreeAbelianMonoid(S: SetCategory,E: CancellationAbelianMonoid,un: E)  is a domain constructor
---R Abbreviation for InnerFreeAbelianMonoid is IFAMON 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IFAMON 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (E,S) -> %                      ?*? : (NonNegativeInteger,%) -> %
---R ?*? : (PositiveInteger,%) -> %        ?+? : (S,%) -> %
---R ?+? : (%,%) -> %                      ?=? : (%,%) -> Boolean
---R 0 : () -> %                           coefficient : (S,%) -> E
---R coerce : S -> %                       coerce : % -> OutputForm
---R hash : % -> SingleInteger             latex : % -> String
---R mapCoef : ((E -> E),%) -> %           mapGen : ((S -> S),%) -> %
---R nthCoef : (%,Integer) -> E            nthFactor : (%,Integer) -> S
---R retract : % -> S                      sample : () -> %
---R size : % -> NonNegativeInteger        zero? : % -> Boolean
---R ?~=? : (%,%) -> Boolean              
---R highCommonTerms : (%,%) -> % if E has OAMON
---R retractIfCan : % -> Union(S,"failed")
---R subtractIfCan : (%,%) -> Union(%,"failed")
---R terms : % -> List(Record(gen: S,exp: E))
---R
---E 1
+    extensionDegree():PI == 1::PositiveInteger
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{InnerFreeAbelianMonoid.help}
-====================================================================
-InnerFreeAbelianMonoid examples
-====================================================================
+    inGroundField?(x)  == true
 
-Internal implementation of a free abelian monoid on any set of generators
+    coordinates(x) == new(1,x)$(Vector $)
 
-See Also:
-o )show InnerFreeAbelianMonoid
+    represents(v)  == v.1
 
-\end{chunk}
+    retract(x) == x
 
-\pagehead{InnerFreeAbelianMonoid}{IFAMON}
-\pagepic{ps/v103innerfreeabelianmonoid.ps}{IFAMON}{1.00}
-{\bf See}\\
-\pageto{ListMonoidOps}{LMOPS}
-\pageto{FreeMonoid}{FMONOID}
-\pageto{FreeGroup}{FGROUP}
-\pageto{FreeAbelianMonoid}{FAMONOID}
-\pageto{FreeAbelianGroup}{FAGROUP}
+    retractIfCan(x) == x
 
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{IFAMON}{0} &
-\cross{IFAMON}{coefficient} &
-\cross{IFAMON}{coerce} &
-\cross{IFAMON}{hash} &
-\cross{IFAMON}{highCommonTerms} \\
-\cross{IFAMON}{latex} &
-\cross{IFAMON}{mapCoef} &
-\cross{IFAMON}{mapGen} &
-\cross{IFAMON}{nthCoef} &
-\cross{IFAMON}{nthFactor} \\
-\cross{IFAMON}{retract} &
-\cross{IFAMON}{retractIfCan} &
-\cross{IFAMON}{sample} &
-\cross{IFAMON}{size} &
-\cross{IFAMON}{subtractIfCan} \\
-\cross{IFAMON}{terms} &
-\cross{IFAMON}{zero?} &
-\cross{IFAMON}{?\~{}=?} &
-\cross{IFAMON}{?*?} &
-\cross{IFAMON}{?+?} \\
-\cross{IFAMON}{?=?} &&&&
-\end{tabular}
+    basis() == new(1,1::$)$(Vector $)
 
-\begin{chunk}{domain IFAMON InnerFreeAbelianMonoid}
-)abbrev domain IFAMON InnerFreeAbelianMonoid
-++ Author: Manuel Bronstein
-++ Date Created: November 1989
-++ Date Last Updated: 6 June 1991
-++ Description:
-++ Internal implementation of a free abelian monoid on any set of generators
+    basis(n:PI) ==
+      n = 1 => basis()
+      error("basis: argument must divide extension degree")
 
-InnerFreeAbelianMonoid(S: SetCategory, E:CancellationAbelianMonoid, un:E):
-  FreeAbelianMonoidCategory(S, E) == ListMonoidOps(S, E, un) add
-        Rep := ListMonoidOps(S, E, un)
+    definingPolynomial() ==
+      monomial(1,1)$(SUP $) - monomial(1,0)$(SUP $)
 
-        0                          == makeUnit()
-        zero? f                    == empty? listOfMonoms f
-        terms f                    == copy listOfMonoms f
-        nthCoef(f, i)              == nthExpon(f, i)
-        nthFactor(f, i)            == nthFactor(f, i)$Rep
-        s:S + f:$                  == plus(s, un, f)
-        f:$ + g:$                  == plus(f, g)
-        (f:$ = g:$):Boolean        == commutativeEquality(f,g)
-        n:E * s:S                  == makeTerm(s, n)
-        n:NonNegativeInteger * f:$ == mapExpon(x +-> n*x, f)
-        coerce(f:$):OutputForm     == outputForm(f, "+", (x,y) +-> y*x, 0)
-        mapCoef(f, x)              == mapExpon(f, x)
-        mapGen(f, x)               == mapGen(f, x)$Rep
 
-        coefficient(s, f) ==
-          for x in terms f repeat
-            x.gen = s => return(x.exp)
-          0
+    minimalPolynomial(x) ==
+      monomial(1,1)$(SUP $) - monomial(x,0)$(SUP $)
 
-        if E has OrderedAbelianMonoid then
-          highCommonTerms(f, g) ==
-            makeMulti [[x.gen, min(x.exp, n)] for x in listOfMonoms f |
-                                       (n := coefficient(x.gen, g)) > 0]
+    charthRoot x == x
 
 \end{chunk}
 
-\begin{chunk}{COQ IFAMON}
-(* domain IFAMON *)
+\begin{chunk}{COQ IPF}
+(* domain IPF *)
 (*
-*)
 
-\end{chunk}
+    initializeElt:() -> Void
+    initializeLog:() -> Void
 
-\begin{chunk}{IFAMON.dotabb}
-"IFAMON" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IFAMON"]
-"OAMON" [color="#4488FF",href="bookvol10.2.pdf#nameddest=OAMON"]
-"IFAMON" -> "OAMON"
+-- global variables ====================================================
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IIARRAY2 InnerIndexedTwoDimensionalArray}
+    primitiveElt:PI:=1
+    -- for the lookup the primitive Element 
+    -- computed by createPrimitiveElement()
 
-This is an internal type which provides an implementation of
-2-dimensional arrays as PrimitiveArray's of PrimitiveArray's.
+    sizeCG  :=(p-1) pretend NonNegativeInteger
+    -- the size of the cyclic group
 
-\begin{chunk}{InnerIndexedTwoDimensionalArray.input}
-)set break resume
-)sys rm -f InnerIndexedTwoDimensionalArray.output
-)spool InnerIndexedTwoDimensionalArray.output
-)set message test on
-)set message auto off
-)clear all
+    facOfGroupSize := nil()$(List Record(factor:Integer,exponent:Integer))
+    -- the factorization of the cyclic group size
 
---S 1 of 1
-)show InnerIndexedTwoDimensionalArray
---R 
---R InnerIndexedTwoDimensionalArray(R: Type,mnRow: Integer,mnCol: Integer,Row: FiniteLinearAggregate(R),Col: FiniteLinearAggregate(R))  is a domain constructor
---R Abbreviation for InnerIndexedTwoDimensionalArray is IIARRAY2 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IIARRAY2 
---R
---R------------------------------- Operations --------------------------------
---R column : (%,Integer) -> Col           copy : % -> %
---R elt : (%,Integer,Integer,R) -> R      elt : (%,Integer,Integer) -> R
---R empty : () -> %                       empty? : % -> Boolean
---R eq? : (%,%) -> Boolean                fill! : (%,R) -> %
---R latex : % -> String if R has SETCAT   map : (((R,R) -> R),%,%,R) -> %
---R map : (((R,R) -> R),%,%) -> %         map : ((R -> R),%) -> %
---R map! : ((R -> R),%) -> %              maxColIndex : % -> Integer
---R maxRowIndex : % -> Integer            minColIndex : % -> Integer
---R minRowIndex : % -> Integer            ncols : % -> NonNegativeInteger
---R nrows : % -> NonNegativeInteger       parts : % -> List(R)
---R qelt : (%,Integer,Integer) -> R       row : (%,Integer) -> Row
---R sample : () -> %                      setColumn! : (%,Integer,Col) -> %
---R setRow! : (%,Integer,Row) -> %        setelt : (%,Integer,Integer,R) -> R
---R #? : % -> NonNegativeInteger if $ has finiteAggregate
---R ?=? : (%,%) -> Boolean if R has SETCAT
---R any? : ((R -> Boolean),%) -> Boolean if $ has finiteAggregate
---R coerce : % -> OutputForm if R has SETCAT
---R count : (R,%) -> NonNegativeInteger if $ has finiteAggregate and R has SETCAT
---R count : ((R -> Boolean),%) -> NonNegativeInteger if $ has finiteAggregate
---R eval : (%,List(R),List(R)) -> % if R has EVALAB(R) and R has SETCAT
---R eval : (%,R,R) -> % if R has EVALAB(R) and R has SETCAT
---R eval : (%,Equation(R)) -> % if R has EVALAB(R) and R has SETCAT
---R eval : (%,List(Equation(R))) -> % if R has EVALAB(R) and R has SETCAT
---R every? : ((R -> Boolean),%) -> Boolean if $ has finiteAggregate
---R hash : % -> SingleInteger if R has SETCAT
---R less? : (%,NonNegativeInteger) -> Boolean
---R member? : (R,%) -> Boolean if $ has finiteAggregate and R has SETCAT
---R members : % -> List(R) if $ has finiteAggregate
---R more? : (%,NonNegativeInteger) -> Boolean
---R new : (NonNegativeInteger,NonNegativeInteger,R) -> %
---R qsetelt! : (%,Integer,Integer,R) -> R
---R size? : (%,NonNegativeInteger) -> Boolean
---R ?~=? : (%,%) -> Boolean if R has SETCAT
---R
---E 1
+    initlog?:Boolean:=true
+    -- gets false after initialization of the logarithm table
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{InnerIndexedTwoDimensionalArray.help}
-====================================================================
-InnerIndexedTwoDimensionalArray examples
-====================================================================
+    initelt?:Boolean:=true
+    -- gets false after initialization of the primitive Element
 
-There is no description for this domain
 
-See Also:
-o )show InnerIndexedTwoDimensionalArray
+    discLogTable:Table(PI,TBL):=table()$Table(PI,TBL)
+    -- tables indexed by the factors of the size q of the cyclic group
+    -- discLogTable.factor is a table of with keys
+    -- primitiveElement() ** (i * (q quo factor)) and entries i for
+    -- i in 0..n-1, n computed in initialize() in order to use
+    -- the minimal size limit 'limit' optimal.
 
-\end{chunk}
+-- functions ===========================================================
 
-\pagehead{InnerIndexedTwoDimensionalArray}{IIARRAY2}
-\pagepic{ps/v103innerindexedtwodimensionalarray.ps}{IIARRAY2}{1.00}
-{\bf See}\\
-\pageto{IndexedTwoDimensionalArray}{IARRAY2}
-\pageto{TwoDimensionalArray}{ARRAY2}
+    generator() == 1
 
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{IIARRAY2}{any?} &
-\cross{IIARRAY2}{coerce} &
-\cross{IIARRAY2}{column} &
-\cross{IIARRAY2}{copy} &
-\cross{IIARRAY2}{count} \\
-\cross{IIARRAY2}{elt} &
-\cross{IIARRAY2}{empty} &
-\cross{IIARRAY2}{empty?} &
-\cross{IIARRAY2}{eq?} &
-\cross{IIARRAY2}{eval} \\
-\cross{IIARRAY2}{every?} &
-\cross{IIARRAY2}{fill!} &
-\cross{IIARRAY2}{hash} &
-\cross{IIARRAY2}{latex} &
-\cross{IIARRAY2}{less?} \\
-\cross{IIARRAY2}{map} &
-\cross{IIARRAY2}{map!} &
-\cross{IIARRAY2}{maxColIndex} &
-\cross{IIARRAY2}{maxRowIndex} &
-\cross{IIARRAY2}{member?} \\
-\cross{IIARRAY2}{members} &
-\cross{IIARRAY2}{minColIndex} &
-\cross{IIARRAY2}{minRowIndex} &
-\cross{IIARRAY2}{more?} &
-\cross{IIARRAY2}{ncols} \\
-\cross{IIARRAY2}{new} &
-\cross{IIARRAY2}{nrows} &
-\cross{IIARRAY2}{parts} &
-\cross{IIARRAY2}{qelt} &
-\cross{IIARRAY2}{qsetelt!} \\
-\cross{IIARRAY2}{row} &
-\cross{IIARRAY2}{sample} &
-\cross{IIARRAY2}{setColumn!} &
-\cross{IIARRAY2}{setelt} &
-\cross{IIARRAY2}{setRow!} \\
-\cross{IIARRAY2}{size?} &
-\cross{IIARRAY2}{\#{}?} &
-\cross{IIARRAY2}{?=?} &
-\cross{IIARRAY2}{?\~{}=?} &
-\end{tabular}
+    -- This uses x**(p-1)=1 (mod p), so x**(q(p-1)+r) = x**r (mod p)
+    x:$ ** n:Integer ==
+      zero?(n) => 1
+      zero?(x) => 0
+      r := positiveRemainder(n,p-1)::NNI
+      ((x pretend IntegerMod p) **$IntegerMod(p) r) pretend $
 
-\begin{chunk}{domain IIARRAY2 InnerIndexedTwoDimensionalArray}
-)abbrev domain IIARRAY2 InnerIndexedTwoDimensionalArray
-++ Author: Mark Botch
-++ Description:
-++ There is no description for this domain
+    if p <= convert(max()$SingleInteger)@Integer then
+      q := p::SingleInteger
 
-InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col):_
-       Exports == Implementation where
-  R : Type
-  mnRow, mnCol : Integer
-  Row : FiniteLinearAggregate R
-  Col : FiniteLinearAggregate R
+      recip x ==
+        zero?(y := convert(x)@Integer :: SingleInteger) => "failed"
+        invmod(y, q)::Integer::$
 
-  Exports ==> TwoDimensionalArrayCategory(R,Row,Col)
+    else
 
-  Implementation ==> add
+      recip x ==
+        zero?(y := convert(x)@Integer) => "failed"
+        invmod(y, p)::$
 
-    Rep := PrimitiveArray PrimitiveArray R
+    convert(x:$) == x pretend I
 
---% Predicates
+    normalElement() == 1
 
-    empty? m == empty?(m)$Rep
+    createNormalElement() == 1
 
---% Primitive array creation
+    characteristic() == p
 
-    empty() == empty()$Rep
+    factorsOfCyclicGroupSize() ==
+      p=2 => facOfGroupSize -- this fixes an infinite loop of functions
+                            -- calls, problem was that factors factor(1)
+                            -- is the empty list
+      if empty? facOfGroupSize then initializeElt()
+      facOfGroupSize
 
-    new(rows,cols,a) ==
-      rows = 0 =>
-        error "new: arrays with zero rows are not supported"
---      cols = 0 =>
---        error "new: arrays with zero columns are not supported"
-      arr : PrimitiveArray PrimitiveArray R := new(rows,empty())
-      for i in minIndex(arr)..maxIndex(arr) repeat
-        qsetelt_!(arr,i,new(cols,a))
-      arr
+    representationType() == "prime"
 
---% Size inquiries
+    tableForDiscreteLogarithm(fac) ==
+      if initlog? then initializeLog()
+      tbl:=search(fac::PI,discLogTable)$Table(PI,TBL)
+      tbl case "failed" =>
+        error "tableForDiscreteLogarithm: argument must be prime divisor_
+ of the order of the multiplicative group"
+      tbl pretend TBL
 
-    minRowIndex m == mnRow
-    minColIndex m == mnCol
-    maxRowIndex m == nrows m + mnRow - 1
-    maxColIndex m == ncols m + mnCol - 1
+    primitiveElement() ==
+      if initelt? then initializeElt()
+      index(primitiveElt)
 
-    nrows m == (# m)$Rep
+    initializeElt() ==
+      facOfGroupSize:=factors(factor(sizeCG)$I)$(Factored I)
+      -- get a primitive element
+      primitiveElt:=lookup(createPrimitiveElement())
+      -- set initialization flag
+      initelt? := false
+      void$Void
 
-    ncols m ==
-      empty? m => 0
-      # m(minIndex(m)$Rep)
+    initializeLog() ==
+      if initelt? then initializeElt()
+      -- set up tables for discrete logarithm
+      limit:Integer:=30
+      -- the minimum size for the discrete logarithm table
+      for f in facOfGroupSize repeat
+        fac:=f.factor
+        base:$:=primitiveElement() ** (sizeCG quo fac)
+        l:Integer:=length(fac)$Integer
+        n:Integer:=0
+        if odd?(l)$Integer then n:=shift(fac,-(l quo 2))
+                           else n:=shift(1,(l quo 2))
+        if n < limit then
+          d:=(fac-1) quo limit + 1
+          n:=(fac-1) quo d + 1
+        tbl:TBL:=table()$TBL
+        a:$:=1
+        for i in (0::NNI)..(n-1)::NNI repeat
+          insert_!([lookup(a),i::NNI]$R,tbl)$TBL
+          a:=a*base
+        insert_!([fac::PI,copy(tbl)$TBL]_
+               $Record(key:PI,entry:TBL),discLogTable)$Table(PI,TBL)
+      -- tell user about initialization
+      --    print("discrete logarithm table initialized"::OUT)
+      -- set initialization flag
+      initlog? := false
+      void$Void
 
---% Part selection/assignment
+    degree(x):PI == 1::PositiveInteger
 
-    qelt(m,i,j) ==
-      qelt(qelt(m,i - minRowIndex m)$Rep,j - minColIndex m)
+    extensionDegree():PI == 1::PositiveInteger
 
-    elt(m:%,i:Integer,j:Integer) ==
-      i < minRowIndex(m) or i > maxRowIndex(m) =>
-        error "elt: index out of range"
-      j < minColIndex(m) or j > maxColIndex(m) =>
-        error "elt: index out of range"
-      qelt(m,i,j)
+    inGroundField?(x)  == true
 
-    qsetelt_!(m,i,j,r) ==
-      setelt(qelt(m,i - minRowIndex m)$Rep,j - minColIndex m,r)
+    coordinates(x) == new(1,x)$(Vector $)
 
-    setelt(m:%,i:Integer,j:Integer,r:R) ==
-      i < minRowIndex(m) or i > maxRowIndex(m) =>
-        error "setelt: index out of range"
-      j < minColIndex(m) or j > maxColIndex(m) =>
-        error "setelt: index out of range"
-      qsetelt_!(m,i,j,r)
+    represents(v)  == v.1
 
-    if R has SetCategory then
-        latex(m : %) : String ==
-          s : String := "\left[ \begin{array}{"
-          j : Integer
-          for j in minColIndex(m)..maxColIndex(m) repeat
-            s := concat(s,"c")$String
-          s := concat(s,"} ")$String
-          i : Integer
-          for i in minRowIndex(m)..maxRowIndex(m) repeat
-            for j in minColIndex(m)..maxColIndex(m) repeat
-              s := concat(s, latex(qelt(m,i,j))$R)$String
-              if j < maxColIndex(m) then s := concat(s, " & ")$String
-            if i < maxRowIndex(m) then s := concat(s, " \\ ")$String
-          concat(s, "\end{array} \right]")$String
+    retract(x) == x
 
-\end{chunk}
+    retractIfCan(x) == x
+
+    basis() == new(1,1::$)$(Vector $)
+
+    basis(n:PI) ==
+      n = 1 => basis()
+      error("basis: argument must divide extension degree")
+
+    definingPolynomial() ==
+      monomial(1,1)$(SUP $) - monomial(1,0)$(SUP $)
+
+
+    minimalPolynomial(x) ==
+      monomial(1,1)$(SUP $) - monomial(x,0)$(SUP $)
+
+    charthRoot x == x
 
-\begin{chunk}{COQ IIARRAY2}
-(* domain IIARRAY2 *)
-(*
 *)
 
 \end{chunk}
 
-\begin{chunk}{IIARRAY2.dotabb}
-"IIARRAY2" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IIARRAY2"]
-"STRING" [color="#88FF44",href="bookvol10.3.pdf#nameddest=STRING"]
-"IIARRAY2" -> "STRING"
+\begin{chunk}{IPF.dotabb}
+"IPF" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IPF"]
+"TBAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=TBAGG"]
+"IPF" -> "TBAGG"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IPADIC InnerPAdicInteger}
+\section{domain ISUPS InnerSparseUnivariatePowerSeries}
 
-\begin{chunk}{InnerPAdicInteger.input}
+\begin{chunk}{InnerSparseUnivariatePowerSeries.input}
 )set break resume
-)sys rm -f InnerPAdicInteger.output
-)spool InnerPAdicInteger.output
+)sys rm -f InnerSparseUnivariatePowerSeries.output
+)spool InnerSparseUnivariatePowerSeries.output
 )set message test on
 )set message auto off
 )clear all
 
---S 1 of 1
-)show InnerPAdicInteger
+--S 1 of 3
+)show InnerSparseUnivariatePowerSeries
 --R 
---R InnerPAdicInteger(p: Integer,unBalanced?: Boolean)  is a domain constructor
---R Abbreviation for InnerPAdicInteger is IPADIC 
+--R InnerSparseUnivariatePowerSeries(Coef: Ring)  is a domain constructor
+--R Abbreviation for InnerSparseUnivariatePowerSeries is ISUPS 
 --R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IPADIC 
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for ISUPS 
 --R
 --R------------------------------- Operations --------------------------------
+--R ?*? : (Coef,%) -> %                   ?*? : (%,Coef) -> %
 --R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
 --R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
 --R ?**? : (%,NonNegativeInteger) -> %    ?**? : (%,PositiveInteger) -> %
@@ -79619,1172 +95328,1298 @@ InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col):_
 --R -? : % -> %                           ?=? : (%,%) -> Boolean
 --R 1 : () -> %                           0 : () -> %
 --R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
---R associates? : (%,%) -> Boolean        coerce : % -> %
---R coerce : Integer -> %                 coerce : % -> OutputForm
---R complete : % -> %                     digits : % -> Stream(Integer)
---R extend : (%,Integer) -> %             gcd : List(%) -> %
---R gcd : (%,%) -> %                      hash : % -> SingleInteger
---R latex : % -> String                   lcm : List(%) -> %
---R lcm : (%,%) -> %                      moduloP : % -> Integer
---R modulus : () -> Integer               one? : % -> Boolean
---R order : % -> NonNegativeInteger       ?quo? : (%,%) -> %
---R quotientByP : % -> %                  recip : % -> Union(%,"failed")
---R ?rem? : (%,%) -> %                    sample : () -> %
---R sizeLess? : (%,%) -> Boolean          sqrt : (%,Integer) -> %
---R unit? : % -> Boolean                  unitCanonical : % -> %
---R zero? : % -> Boolean                  ?~=? : (%,%) -> Boolean
---R approximate : (%,Integer) -> Integer
+--R center : % -> Coef                    coefficient : (%,Integer) -> Coef
+--R coerce : % -> % if Coef has INTDOM    coerce : Integer -> %
+--R coerce : % -> OutputForm              complete : % -> %
+--R degree : % -> Integer                 ?.? : (%,Integer) -> Coef
+--R extend : (%,Integer) -> %             hash : % -> SingleInteger
+--R iCompose : (%,%) -> %                 latex : % -> String
+--R leadingCoefficient : % -> Coef        leadingMonomial : % -> %
+--R map : ((Coef -> Coef),%) -> %         monomial : (Coef,Integer) -> %
+--R monomial? : % -> Boolean              one? : % -> Boolean
+--R order : (%,Integer) -> Integer        order : % -> Integer
+--R pole? : % -> Boolean                  recip : % -> Union(%,"failed")
+--R reductum : % -> %                     sample : () -> %
+--R taylorQuoByVar : % -> %               truncate : (%,Integer) -> %
+--R variable : % -> Symbol                zero? : % -> Boolean
+--R ?~=? : (%,%) -> Boolean              
+--R ?*? : (%,Fraction(Integer)) -> % if Coef has ALGEBRA(FRAC(INT))
+--R ?*? : (Fraction(Integer),%) -> % if Coef has ALGEBRA(FRAC(INT))
+--R ?/? : (%,Coef) -> % if Coef has FIELD
+--R D : % -> % if Coef has *: (Integer,Coef) -> Coef
+--R D : (%,NonNegativeInteger) -> % if Coef has *: (Integer,Coef) -> Coef
+--R D : (%,Symbol) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R D : (%,List(Symbol)) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R D : (%,Symbol,NonNegativeInteger) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R approximate : (%,Integer) -> Coef if Coef has **: (Coef,Integer) -> Coef and Coef has coerce: Symbol -> Coef
+--R associates? : (%,%) -> Boolean if Coef has INTDOM
+--R cAcos : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cAcosh : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cAcot : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cAcoth : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cAcsc : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cAcsch : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cAsec : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cAsech : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cAsin : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cAsinh : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cAtan : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cAtanh : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cCos : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cCosh : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cCot : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cCoth : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cCsc : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cCsch : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cExp : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cLog : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cPower : (%,Coef) -> % if Coef has ALGEBRA(FRAC(INT))
+--R cRationalPower : (%,Fraction(Integer)) -> % if Coef has ALGEBRA(FRAC(INT))
+--R cSec : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cSech : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cSin : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cSinh : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cTan : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R cTanh : % -> % if Coef has ALGEBRA(FRAC(INT))
 --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 principalIdeal : List(%) -> Record(coef: List(%),generator: %)
---R root : (SparseUnivariatePolynomial(Integer),Integer) -> %
+--R charthRoot : % -> Union(%,"failed") if Coef has CHARNZ
+--R coerce : Coef -> % if Coef has COMRING
+--R coerce : Fraction(Integer) -> % if Coef has ALGEBRA(FRAC(INT))
+--R differentiate : % -> % if Coef has *: (Integer,Coef) -> Coef
+--R differentiate : (%,NonNegativeInteger) -> % if Coef has *: (Integer,Coef) -> Coef
+--R differentiate : (%,Symbol) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R differentiate : (%,List(Symbol)) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R differentiate : (%,Symbol,NonNegativeInteger) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
+--R ?.? : (%,%) -> % if Integer has SGROUP
+--R eval : (%,Coef) -> Stream(Coef) if Coef has **: (Coef,Integer) -> Coef
+--R exquo : (%,%) -> Union(%,"failed") if Coef has INTDOM
+--R getRef : % -> Reference(OrderedCompletion(Integer))
+--R getStream : % -> Stream(Record(k: Integer,c: Coef))
+--R iExquo : (%,%,Boolean) -> Union(%,"failed")
+--R integrate : % -> % if Coef has ALGEBRA(FRAC(INT))
+--R makeSeries : (Reference(OrderedCompletion(Integer)),Stream(Record(k: Integer,c: Coef))) -> %
+--R monomial : (%,List(SingletonAsOrderedSet),List(Integer)) -> %
+--R monomial : (%,SingletonAsOrderedSet,Integer) -> %
+--R multiplyCoefficients : ((Integer -> Coef),%) -> %
+--R multiplyExponents : (%,PositiveInteger) -> %
+--R series : Stream(Record(k: Integer,c: Coef)) -> %
+--R seriesToOutputForm : (Stream(Record(k: Integer,c: Coef)),Reference(OrderedCompletion(Integer)),Symbol,Coef,Fraction(Integer)) -> OutputForm
 --R subtractIfCan : (%,%) -> Union(%,"failed")
---R unitNormal : % -> Record(unit: %,canonical: %,associate: %)
+--R terms : % -> Stream(Record(k: Integer,c: Coef))
+--R truncate : (%,Integer,Integer) -> %
+--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
 
+-- test fix to iOrder internal function for finite case
+
+--S 2 of 5
+L := SparseUnivariateLaurentSeries(Fraction(Integer),'z,0)
+--E 2
+
+--S 3 of 5
+w:L := 0
+--E 3
+
+--S 4 of 5
+order(w,0)
+--E 4
+
+--S 5 of 5
+rationalFunction(w,0)
+--E 5
+
 )spool
 )lisp (bye)
 \end{chunk}
-\begin{chunk}{InnerPAdicInteger.help}
+\begin{chunk}{InnerSparseUnivariatePowerSeries.help}
 ====================================================================
-InnerPAdicInteger examples
+InnerSparseUnivariatePowerSeries examples
 ====================================================================
 
-This domain implements Zp, the p-adic completion of the integers.
-This is an internal domain.
+InnerSparseUnivariatePowerSeries is an internal domain used for
+creating sparse Taylor and Laurent series.
 
 See Also:
-o )show InnerPAdicInteger
+o )show InnerSparseUnivariatePowerSeries
 
 \end{chunk}
 
-\pagehead{InnerPAdicInteger}{IPADIC}
-\pagepic{ps/v103innerpadicinteger.ps}{IPADIC}{1.00}
-{\bf See}\\
-\pageto{PAdicInteger}{PADIC}
-\pageto{BalancedPAdicInteger}{BPADIC}
-\pageto{PAdicRationalConstructor}{PADICRC}
-\pageto{PAdicRational}{PADICRAT}
-\pageto{BalancedPAdicRational}{BPADICRT}
+\pagehead{InnerSparseUnivariatePowerSeries}{ISUPS}
+\pagepic{ps/v103innersparseunivariatepowerseries.ps}{ISUPS}{1.00}
+
+{\bf Exports:}\\
+\begin{tabular}{llll}
+\cross{ISUPS}{0} &
+\cross{ISUPS}{1} &
+\cross{ISUPS}{approximate} &
+\cross{ISUPS}{associates?} \\
+\cross{ISUPS}{cAcos} &
+\cross{ISUPS}{cAcosh} &
+\cross{ISUPS}{cAcot} &
+\cross{ISUPS}{cAcoth} \\
+\cross{ISUPS}{cAcsc} &
+\cross{ISUPS}{cAcsch} &
+\cross{ISUPS}{cAsec} &
+\cross{ISUPS}{cAsech} \\
+\cross{ISUPS}{cAsin} &
+\cross{ISUPS}{cAsinh} &
+\cross{ISUPS}{cAtan} &
+\cross{ISUPS}{cAtanh} \\
+\cross{ISUPS}{cCos} &
+\cross{ISUPS}{cCosh} &
+\cross{ISUPS}{cCot} &
+\cross{ISUPS}{cCoth} \\
+\cross{ISUPS}{cCsc} &
+\cross{ISUPS}{cCsch} &
+\cross{ISUPS}{center} &
+\cross{ISUPS}{cExp} \\
+\cross{ISUPS}{cLog} &
+\cross{ISUPS}{coefficient} &
+\cross{ISUPS}{cPower} &
+\cross{ISUPS}{cRationalPower} \\
+\cross{ISUPS}{cSec} &
+\cross{ISUPS}{cSech} &
+\cross{ISUPS}{cSin} &
+\cross{ISUPS}{cSinh} \\
+\cross{ISUPS}{cTan} &
+\cross{ISUPS}{cTanh} &
+\cross{ISUPS}{characteristic} &
+\cross{ISUPS}{charthRoot} \\
+\cross{ISUPS}{coerce} &
+\cross{ISUPS}{complete} &
+\cross{ISUPS}{D} &
+\cross{ISUPS}{differentiate} \\
+\cross{ISUPS}{degree} &
+\cross{ISUPS}{eval} &
+\cross{ISUPS}{exquo} &
+\cross{ISUPS}{extend} \\
+\cross{ISUPS}{getRef} &
+\cross{ISUPS}{getStream} &
+\cross{ISUPS}{hash} &
+\cross{ISUPS}{iCompose} \\
+\cross{ISUPS}{iExquo} &
+\cross{ISUPS}{integrate} &
+\cross{ISUPS}{latex} &
+\cross{ISUPS}{leadingCoefficient} \\
+\cross{ISUPS}{leadingMonomial} &
+\cross{ISUPS}{makeSeries} &
+\cross{ISUPS}{map} &
+\cross{ISUPS}{monomial} \\
+\cross{ISUPS}{monomial?} &
+\cross{ISUPS}{multiplyCoefficients} &
+\cross{ISUPS}{multiplyExponents} &
+\cross{ISUPS}{one?} \\
+\cross{ISUPS}{order} &
+\cross{ISUPS}{pole?} &
+\cross{ISUPS}{recip} &
+\cross{ISUPS}{reductum} \\
+\cross{ISUPS}{sample} &
+\cross{ISUPS}{series} &
+\cross{ISUPS}{seriesToOutputForm} &
+\cross{ISUPS}{subtractIfCan} \\
+\cross{ISUPS}{taylorQuoByVar} &
+\cross{ISUPS}{terms} &
+\cross{ISUPS}{truncate} &
+\cross{ISUPS}{unit?} \\
+\cross{ISUPS}{unitCanonical} &
+\cross{ISUPS}{unitNormal} &
+\cross{ISUPS}{variable} &
+\cross{ISUPS}{variables} \\
+\cross{ISUPS}{zero?} &
+\cross{ISUPS}{?*?} &
+\cross{ISUPS}{?**?} &
+\cross{ISUPS}{?+?} \\
+\cross{ISUPS}{?-?} &
+\cross{ISUPS}{-?} &
+\cross{ISUPS}{?=?} &
+\cross{ISUPS}{?\^{}?} \\
+\cross{ISUPS}{?.?} &
+\cross{ISUPS}{?\~{}=?} &
+\cross{ISUPS}{?/?} &
+\cross{ISUPS}{?\^{}?} \\
+\cross{ISUPS}{?.?} &&&
+\end{tabular}
+
+\begin{chunk}{domain ISUPS InnerSparseUnivariatePowerSeries}
+)abbrev domain ISUPS InnerSparseUnivariatePowerSeries
+++ Author: Clifton J. Williamson
+++ Date Created: 28 October 1994
+++ Date Last Updated: 9 March 1995
+++ Description: 
+++ InnerSparseUnivariatePowerSeries is an internal domain
+++ used for creating sparse Taylor and Laurent series.
+
+InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
+  Coef  : Ring
+  B    ==> Boolean
+  COM  ==> OrderedCompletion Integer
+  I    ==> Integer
+  L    ==> List
+  NNI  ==> NonNegativeInteger
+  OUT  ==> OutputForm
+  PI   ==> PositiveInteger
+  REF  ==> Reference OrderedCompletion Integer
+  RN   ==> Fraction Integer
+  Term ==> Record(k:Integer,c:Coef)
+  SG   ==> String
+  ST   ==> Stream Term
+
+  Exports ==> UnivariatePowerSeriesCategory(Coef,Integer) with
+    makeSeries: (REF,ST) -> %
+      ++ makeSeries(refer,str) creates a power series from the reference
+      ++ \spad{refer} and the stream \spad{str}.
+    getRef: % -> REF
+      ++ getRef(f) returns a reference containing the order to which the
+      ++ terms of f have been computed.
+    getStream: % -> ST
+      ++ getStream(f) returns the stream of terms representing the series f.
+    series: ST -> %
+      ++ series(st) creates a series from a stream of non-zero terms,
+      ++ where a term is an exponent-coefficient pair.  The terms in the
+      ++ stream should be ordered by increasing order of exponents.
+    monomial?: % -> B
+      ++ monomial?(f) tests if f is a single monomial.
+    multiplyCoefficients: (I -> Coef,%) -> %
+      ++ multiplyCoefficients(fn,f) returns the series
+      ++ \spad{sum(fn(n) * an * x^n,n = n0..)},
+      ++ where f is the series \spad{sum(an * x^n,n = n0..)}.
+    iExquo: (%,%,B) -> Union(%,"failed")
+      ++ iExquo(f,g,taylor?) is the quotient of the power series f and g.
+      ++ If \spad{taylor?} is \spad{true}, then we must have
+      ++ \spad{order(f) >= order(g)}.
+    taylorQuoByVar: % -> %
+      ++ taylorQuoByVar(a0 + a1 x + a2 x**2 + ...)
+      ++ returns \spad{a1 + a2 x + a3 x**2 + ...}
+    iCompose: (%,%) -> %
+      ++ iCompose(f,g) returns \spad{f(g(x))}.  This is an internal function
+      ++ which should only be called for Taylor series \spad{f(x)} and
+      ++ \spad{g(x)} such that the constant coefficient of \spad{g(x)} is zero.
+    seriesToOutputForm: (ST,REF,Symbol,Coef,RN) -> OutputForm
+      ++ seriesToOutputForm(st,refer,var,cen,r) prints the series
+      ++ \spad{f((var - cen)^r)}.
+    if Coef has Algebra Fraction Integer then
+      integrate: % -> %
+        ++ integrate(f(x)) returns an anti-derivative of the power series
+        ++ \spad{f(x)} with constant coefficient 0.
+        ++ Warning: function does not check for a term of degree -1.
+      cPower: (%,Coef) -> %
+        ++ cPower(f,r) computes \spad{f^r}, where f has constant coefficient 1.
+        ++ For use when the coefficient ring is commutative.
+      cRationalPower: (%,RN) -> %
+        ++ cRationalPower(f,r) computes \spad{f^r}.
+        ++ For use when the coefficient ring is commutative.
+      cExp: % -> %
+        ++ cExp(f) computes the exponential of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cLog: % -> %
+        ++ cLog(f) computes the logarithm of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cSin: % -> %
+        ++ cSin(f) computes the sine of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cCos: % -> %
+        ++ cCos(f) computes the cosine of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cTan: % -> %
+        ++ cTan(f) computes the tangent of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cCot: % -> %
+        ++ cCot(f) computes the cotangent of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cSec: % -> %
+        ++ cSec(f) computes the secant of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cCsc: % -> %
+        ++ cCsc(f) computes the cosecant of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cAsin: % -> %
+        ++ cAsin(f) computes the arcsine of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cAcos: % -> %
+        ++ cAcos(f) computes the arccosine of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cAtan: % -> %
+        ++ cAtan(f) computes the arctangent of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cAcot: % -> %
+        ++ cAcot(f) computes the arccotangent of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cAsec: % -> %
+        ++ cAsec(f) computes the arcsecant of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cAcsc: % -> %
+        ++ cAcsc(f) computes the arccosecant of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cSinh: % -> %
+        ++ cSinh(f) computes the hyperbolic sine of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cCosh: % -> %
+        ++ cCosh(f) computes the hyperbolic cosine of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cTanh: % -> %
+        ++ cTanh(f) computes the hyperbolic tangent of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cCoth: % -> %
+        ++ cCoth(f) computes the hyperbolic cotangent of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cSech: % -> %
+        ++ cSech(f) computes the hyperbolic secant of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cCsch: % -> %
+        ++ cCsch(f) computes the hyperbolic cosecant of the power series f.
+        ++ For use when the coefficient ring is commutative.
+      cAsinh: % -> %
+        ++ cAsinh(f) computes the inverse hyperbolic sine of the power
+        ++ series f.  For use when the coefficient ring is commutative.
+      cAcosh: % -> %
+        ++ cAcosh(f) computes the inverse hyperbolic cosine of the power
+        ++ series f.  For use when the coefficient ring is commutative.
+      cAtanh: % -> %
+        ++ cAtanh(f) computes the inverse hyperbolic tangent of the power
+        ++ series f.  For use when the coefficient ring is commutative.
+      cAcoth: % -> %
+        ++ cAcoth(f) computes the inverse hyperbolic cotangent of the power
+        ++ series f.  For use when the coefficient ring is commutative.
+      cAsech: % -> %
+        ++ cAsech(f) computes the inverse hyperbolic secant of the power
+        ++ series f.  For use when the coefficient ring is commutative.
+      cAcsch: % -> %
+        ++ cAcsch(f) computes the inverse hyperbolic cosecant of the power
+        ++ series f.  For use when the coefficient ring is commutative.
 
-{\bf Exports:}\\
-\begin{tabular}{llll}
-\cross{IPADIC}{0} &
-\cross{IPADIC}{1} &
-\cross{IPADIC}{approximate} &
-\cross{IPADIC}{associates?} \\
-\cross{IPADIC}{characteristic} &
-\cross{IPADIC}{coerce} &
-\cross{IPADIC}{complete} &
-\cross{IPADIC}{digits} \\
-\cross{IPADIC}{divide} &
-\cross{IPADIC}{euclideanSize} &
-\cross{IPADIC}{expressIdealMember} &
-\cross{IPADIC}{exquo} \\
-\cross{IPADIC}{extend} &
-\cross{IPADIC}{extendedEuclidean} &
-\cross{IPADIC}{gcd} &
-\cross{IPADIC}{gcdPolynomial} \\
-\cross{IPADIC}{hash} &
-\cross{IPADIC}{latex} &
-\cross{IPADIC}{lcm} &
-\cross{IPADIC}{multiEuclidean} \\
-\cross{IPADIC}{moduloP} &
-\cross{IPADIC}{modulus} &
-\cross{IPADIC}{one?} &
-\cross{IPADIC}{order} \\
-\cross{IPADIC}{principalIdeal} &
-\cross{IPADIC}{quotientByP} &
-\cross{IPADIC}{recip} &
-\cross{IPADIC}{root} \\
-\cross{IPADIC}{sample} &
-\cross{IPADIC}{sizeLess?} &
-\cross{IPADIC}{sqrt} &
-\cross{IPADIC}{subtractIfCan} \\
-\cross{IPADIC}{unit?} &
-\cross{IPADIC}{unitCanonical} &
-\cross{IPADIC}{unitNormal} &
-\cross{IPADIC}{zero?} \\
-\cross{IPADIC}{?\~{}=?} &
-\cross{IPADIC}{?*?} &
-\cross{IPADIC}{?**?} &
-\cross{IPADIC}{?\^{}?} \\
-\cross{IPADIC}{?+?} &
-\cross{IPADIC}{?-?} &
-\cross{IPADIC}{-?} &
-\cross{IPADIC}{?=?} \\
-\cross{IPADIC}{?quo?} &
-\cross{IPADIC}{?rem?} &&
-\end{tabular}
+  Implementation ==> add
+    import REF
 
-\begin{chunk}{domain IPADIC InnerPAdicInteger}
-)abbrev domain IPADIC InnerPAdicInteger
-++ Author: Clifton J. Williamson
-++ Date Created: 20 August 1989
-++ Date Last Updated: 15 May 1990
-++ Description:
-++ This domain implements Zp, the p-adic completion of the integers.
-++ This is an internal domain.
+    Rep := Record(%ord: REF,%str: Stream Term)
+    -- when the value of 'ord' is n, this indicates that all non-zero
+    -- terms of order up to and including n have been computed;
+    -- when 'ord' is plusInfinity, all terms have been computed;
+    -- lazy evaluation of 'str' has the side-effect of modifying the value
+    -- of 'ord'
 
-InnerPAdicInteger(p,unBalanced?): Exports == Implementation where
-  p           : Integer
-  unBalanced? : Boolean
-  I   ==> Integer
-  NNI ==> NonNegativeInteger
-  OUT ==> OutputForm
-  L   ==> List
-  ST  ==> Stream
-  SUP ==> SparseUnivariatePolynomial
+--% Local functions
 
-  Exports ==> PAdicIntegerCategory p
+    makeTerm:        (Integer,Coef) -> Term
+    getCoef:         Term -> Coef
+    getExpon:        Term -> Integer
+    iSeries:         (ST,REF) -> ST
+    iExtend:         (ST,COM,REF) -> ST
+    iTruncate0:      (ST,REF,REF,COM,I,I) -> ST
+    iTruncate:       (%,COM,I) -> %
+    iCoefficient:    (ST,Integer) -> Coef
+    iOrder:          (ST,COM,REF) -> I
+    iMap1:           ((Coef,I) -> Coef,I -> I,B,ST,REF,REF,Integer) -> ST
+    iMap2:           ((Coef,I) -> Coef,I -> I,B,%) -> %
+    iPlus1:          ((Coef,Coef) -> Coef,ST,REF,ST,REF,REF,I) -> ST
+    iPlus2:          ((Coef,Coef) -> Coef,%,%) -> %
+    productByTerm:   (Coef,I,ST,REF,REF,I) -> ST
+    productLazyEval: (ST,REF,ST,REF,COM) -> Void
+    iTimes:          (ST,REF,ST,REF,REF,I) -> ST
+    iDivide:         (ST,REF,ST,REF,Coef,I,REF,I) -> ST
+    divide:          (%,I,%,I,Coef) -> %
+    compose0:        (ST,REF,ST,REF,I,%,%,I,REF,I) -> ST
+    factorials?:     () -> Boolean
+    termOutput:      (RN,Coef,OUT) -> OUT
+    showAll?:        () -> Boolean
 
-  Implementation ==> add
+--% macros
 
-    PEXPR := p :: OUT
+    makeTerm(exp,coef) == [exp,coef]
 
-    Rep := ST I
+    getCoef term == term.c
 
-    characteristic() == 0
-    euclideanSize(x) == order(x)
+    getExpon term == term.k
 
-    stream(x:%):ST I == x pretend ST(I)
-    padic(x:ST I):% == x pretend %
-    digits x == stream x
+    makeSeries(refer,x) == [refer,x]
 
-    extend(x,n) == extend(x,n + 1)$Rep
-    complete x == complete(x)$Rep
+    getRef ups == ups.%ord
 
---     notBalanced?:() -> Boolean
---     notBalanced?() == unBalanced?
+    getStream ups == ups.%str
 
-    modP:I -> I
-    modP n ==
-      unBalanced? or (p = 2) => positiveRemainder(n,p)
-      symmetricRemainder(n,p)
+--% creation and destruction of series
 
-    modPInfo:I -> Record(digit:I,carry:I)
-    modPInfo n ==
-      dv := divide(n,p)
-      r0 := dv.remainder; q := dv.quotient
-      if (r := modP r0) ^= r0 then q := q + ((r0 - r) quo p)
-      [r,q]
+    monomial(coef,expon) ==
+      nix : ST := empty()
+      st :=
+        zero? coef => nix
+        concat(makeTerm(expon,coef),nix)
+      makeSeries(ref plusInfinity(),st)
 
-    invModP: I -> I
-    invModP n == invmod(n,p)
+    monomial? ups == (not empty? getStream ups) and (empty? rst getStream ups)
 
-    modulus()     == p
-    moduloP x     == (empty? x => 0; frst x)
-    quotientByP x == (empty? x => x; rst x)
+    coerce(n:I)    == n :: Coef :: %
 
-    approximate(x,n) ==
-      n <= 0 or empty? x => 0
-      frst x + p * approximate(rst x,n - 1)
+    coerce(r:Coef) == monomial(r,0)
 
-    x = y ==
-      st : ST I := stream(x - y)
-      n : I := _$streamCount$Lisp
-      for i in 0..n repeat
-        empty? st => return true
-        frst st ^= 0 => return false
-        st := rst st
-      empty? st
+    iSeries(x,refer) ==
+      empty? x => (setelt(refer,plusInfinity()); empty())
+      setelt(refer,(getExpon frst x) :: COM)
+      concat(frst x,iSeries(rst x,refer))
 
-    order x ==
-      st := stream x
-      for i in 0..1000 repeat
-        empty? st => return 0
-        frst st ^= 0 => return i
-        st := rst st
-      error "order: series has more than 1000 leading zero coefs"
+    series(x:ST) ==
+      empty? x => 0
+      n := getExpon frst x; refer := ref(n :: COM)
+      makeSeries(refer,iSeries(x,refer))
 
-    0 == padic concat(0$I,empty())
-    1 == padic concat(1$I,empty())
+--% values
 
-    intToPAdic: I -> ST I
-    intToPAdic n == delay
-      n = 0 => empty()
-      modp := modPInfo n
-      concat(modp.digit,intToPAdic modp.carry)
+    characteristic() == characteristic()$Coef
 
-    intPlusPAdic: (I,ST I) -> ST I
-    intPlusPAdic(n,x) == delay
-      empty? x => intToPAdic n
-      modp := modPInfo(n + frst x)
-      concat(modp.digit,intPlusPAdic(modp.carry,rst x))
+    0 == monomial(0,0)
 
-    intMinusPAdic: (I,ST I) -> ST I
-    intMinusPAdic(n,x) == delay
-      empty? x => intToPAdic n
-      modp := modPInfo(n - frst x)
-      concat(modp.digit,intMinusPAdic(modp.carry,rst x))
+    1 == monomial(1,0)
 
-    plusAux: (I,ST I,ST I) -> ST I
-    plusAux(n,x,y) == delay
-      empty? x and empty? y => intToPAdic n
-      empty? x => intPlusPAdic(n,y)
-      empty? y => intPlusPAdic(n,x)
-      modp := modPInfo(n + frst x + frst y)
-      concat(modp.digit,plusAux(modp.carry,rst x,rst y))
+    iExtend(st,n,refer) ==
+      (elt refer) < n =>
+        explicitlyEmpty? st => (setelt(refer,plusInfinity()); st)
+        explicitEntries? st => iExtend(rst st,n,refer)
+        iExtend(lazyEvaluate st,n,refer)
+      st
 
-    minusAux: (I,ST I,ST I) -> ST I
-    minusAux(n,x,y) == delay
-      empty? x and empty? y => intToPAdic n
-      empty? x => intMinusPAdic(n,y)
-      empty? y => intPlusPAdic(n,x)
-      modp := modPInfo(n + frst x - frst y)
-      concat(modp.digit,minusAux(modp.carry,rst x,rst y))
+    extend(x,n) == (iExtend(getStream x,n :: COM,getRef x); x)
 
-    x + y == padic plusAux(0,stream x,stream y)
-    x - y == padic minusAux(0,stream x,stream y)
-    - y   == padic intMinusPAdic(0,stream y)
-    coerce(n:I) == padic intToPAdic n
+    complete x  == (iExtend(getStream x,plusInfinity(),getRef x); x)
 
-    intMult:(I,ST I) -> ST I
-    intMult(n,x) == delay
-      empty? x => empty()
-      modp := modPInfo(n * frst x)
-      concat(modp.digit,intPlusPAdic(modp.carry,intMult(n,rst x)))
+    iTruncate0(x,xRefer,refer,minExp,maxExp,n) == delay
+      explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty())
+      nn := n :: COM
+      while (elt xRefer) < nn repeat lazyEvaluate x
+      explicitEntries? x =>
+        (nx := getExpon(xTerm := frst x)) > maxExp =>
+          (setelt(refer,plusInfinity()); empty())
+        setelt(refer,nx :: COM)
+        (nx :: COM) >= minExp =>
+          concat(makeTerm(nx,getCoef xTerm),_
+                 iTruncate0(rst x,xRefer,refer,minExp,maxExp,nx + 1))
+        iTruncate0(rst x,xRefer,refer,minExp,maxExp,nx + 1)
+      -- can't have elt(xRefer) = infty unless all terms have been computed
+      degr := retract(elt xRefer)@I
+      setelt(refer,degr :: COM)
+      iTruncate0(x,xRefer,refer,minExp,maxExp,degr + 1)
 
-    (n:I) * (x:%) ==
-      padic intMult(n,stream x)
+    iTruncate(ups,minExp,maxExp) ==
+      x := getStream ups; xRefer := getRef ups
+      explicitlyEmpty? x => 0
+      explicitEntries? x =>
+        deg := getExpon frst x
+        refer := ref((deg - 1) :: COM)
+        makeSeries(refer,iTruncate0(x,xRefer,refer,minExp,maxExp,deg))
+      -- can't have elt(xRefer) = infty unless all terms have been computed
+      degr := retract(elt xRefer)@I
+      refer := ref(degr :: COM)
+      makeSeries(refer,iTruncate0(x,xRefer,refer,minExp,maxExp,degr + 1))
 
-    timesAux:(ST I,ST I) -> ST I
-    timesAux(x,y) == delay
-      empty? x or empty? y => empty()
-      modp := modPInfo(frst x * frst y)
-      car := modp.digit
-      cdr : ST I --!!
-      cdr := plusAux(modp.carry,intMult(frst x,rst y),timesAux(rst x,y))
-      concat(car,cdr)
+    truncate(ups,n) == iTruncate(ups,minusInfinity(),n)
 
-    (x:%) * (y:%) == padic timesAux(stream x,stream y)
+    truncate(ups,n1,n2) ==
+      if n1 > n2 then (n1,n2) := (n2,n1)
+      iTruncate(ups,n1 :: COM,n2)
 
-    quotientAux:(ST I,ST I) -> ST I
-    quotientAux(x,y) == delay
-      empty? x => error "quotientAux: first argument"
-      empty? y => empty()
-      modP frst x = 0 =>
-        modP frst y = 0 => quotientAux(rst x,rst y)
-        error "quotient: quotient not integral"
-      z0 := modP(invModP frst x * frst y)
-      yy : ST I --!!
-      yy := rest minusAux(0,y,intMult(z0,x))
-      concat(z0,quotientAux(x,yy))
+    iCoefficient(st,n) ==
+      explicitEntries? st =>
+        term := frst st
+        (expon := getExpon term) > n => 0
+        expon = n => getCoef term
+        iCoefficient(rst st,n)
+      0
 
-    recip x ==
-      empty? x or modP frst x = 0 => "failed"
-      padic quotientAux(stream x,concat(1,empty()))
+    coefficient(x,n)   == (extend(x,n); iCoefficient(getStream x,n))
 
-    iExquo: (%,%,I) -> Union(%,"failed")
-    iExquo(xx,yy,n) ==
-      n > 1000 =>
-        error "exquo: quotient by series with many leading zero coefs"
-      empty? yy => "failed"
-      empty? xx => 0
-      zero? frst yy =>
-        zero? frst xx => iExquo(rst xx,rst yy,n + 1)
-        "failed"
-      (rec := recip yy) case "failed" => "failed"
-      xx * (rec :: %)
+    elt(x:%,n:Integer) == coefficient(x,n)
 
-    x exquo y == iExquo(stream x,stream y,0)
+    iOrder(st,n,refer) ==
+      explicitlyEmpty? st =>
+        finite?(n) => retract(n)@Integer
+        error "order: series has infinite order"
+      explicitEntries? st =>
+        ((r := getExpon frst st) :: COM) >= n => retract(n)@Integer
+        r
+      -- can't have elt(xRefer) = infty unless all terms have been computed
+      degr := retract(elt refer)@I
+      (degr :: COM) >= n => retract(n)@Integer
+      iOrder(lazyEvaluate st,n,refer)
 
-    divide(x,y) ==
-      (z:=x exquo y) case "failed" => [0,x]
-      [z, 0]
+    order x    == iOrder(getStream x,plusInfinity(),getRef x)
 
-    iSqrt: (I,I,I,%) -> %
-    iSqrt(pn,an,bn,bSt) == delay
-      bn1 := (empty? bSt => bn; bn + pn * frst(bSt))
-      c := (bn1 - an*an) quo pn
-      aa := modP(c * invmod(2*an,p))
-      nSt := (empty? bSt => bSt; rst bSt)
-      concat(aa,iSqrt(pn*p,an + pn*aa,bn1,nSt))
+    order(x,n) == iOrder(getStream x,n :: COM,getRef x)
 
-    sqrt(b,a) ==
-      p = 2 =>
-        error "sqrt: no square roots in Z2 yet"
-      not zero? modP(a*a - (bb := moduloP b)) =>
-        error "sqrt: not a square root (mod p)"
-      b := (empty? b => b; rst b)
-      a := modP a
-      concat(a,iSqrt(p,a,bb,b))
+    terms x    == getStream x
 
-    iRoot: (SUP I,I,I,I) -> ST I
-    iRoot(f,alpha,invFpx0,pPow) == delay
-      num := -((f(alpha) exquo pPow) :: I)
-      digit := modP(num * invFpx0)
-      concat(digit,iRoot(f,alpha + digit * pPow,invFpx0,p * pPow))
+--% predicates
 
-    root(f,x0) ==
-      x0 := modP x0
-      not zero? modP f(x0) =>
-        error "root: not a root (mod p)"
-      fpx0 := modP (differentiate f)(x0)
-      zero? fpx0 =>
-        error "root: approximate root must be a simple root (mod p)"
-      invFpx0 := modP invModP fpx0
-      padic concat(x0,iRoot(f,x0,invFpx0,p))
+    zero? ups ==
+      x := getStream ups; ref := getRef ups
+      whatInfinity(n := elt ref) = 1 => explicitlyEmpty? x
+      count : NNI := _$streamCount$Lisp
+      for i in 1..count repeat
+        explicitlyEmpty? x => return true
+        explicitEntries? x => return false
+        lazyEvaluate x
+      false
 
-    termOutput:(I,I) -> OUT
-    termOutput(k,c) ==
-      k = 0 => c :: OUT
-      mon := (k = 1 => PEXPR; PEXPR ** (k :: OUT))
-      c = 1 => mon
-      c = -1 => -mon
-      (c :: OUT) * mon
+    ups1 = ups2 == zero?(ups1 - ups2)
 
-    showAll?:() -> Boolean
-    -- check a global Lisp variable
-    showAll?() == true
+--% arithmetic
 
-    coerce(x:%):OUT ==
-      empty?(st := stream x) => 0 :: OUT
-      n : NNI ; count : NNI := _$streamCount$Lisp
-      l : L OUT := empty()
-      for n in 0..count while not empty? st repeat
-        if frst(st) ^= 0 then
-          l := concat(termOutput(n :: I,frst st),l)
-        st := rst st
-      if showAll?() then
-        for n in (count + 1).. while explicitEntries? st and _
-               not eq?(st,rst st) repeat
-          if frst(st) ^= 0 then
-            l := concat(termOutput(n pretend I,frst st),l)
-          st := rst st
-      l :=
-        explicitlyEmpty? st => l
-        eq?(st,rst st) and frst st = 0 => l
-        concat(prefix("O" :: OUT,[PEXPR ** (n :: OUT)]),l)
-      empty? l => 0 :: OUT
-      reduce("+",reverse_! l)
+    iMap1(cFcn,eFcn,check?,x,xRefer,refer,n) == delay
+      -- when this function is called, all terms in 'x' of order < n have been
+      -- computed and we compute the eFcn(n)th order coefficient of the result
+      explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty())
+      -- if terms in 'x' up to order n have not been computed,
+      -- apply lazy evaluation
+      nn := n :: COM
+      while (elt xRefer) < nn repeat lazyEvaluate x
+      -- 'x' may now be empty: retest
+      explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty())
+      -- must have nx >= n
+      explicitEntries? x =>
+        xCoef := getCoef(xTerm := frst x); nx := getExpon xTerm
+        newCoef := cFcn(xCoef,nx); m := eFcn nx
+        setelt(refer,m :: COM)
+        not check? =>
+          concat(makeTerm(m,newCoef),_
+                 iMap1(cFcn,eFcn,check?,rst x,xRefer,refer,nx + 1))
+        zero? newCoef => iMap1(cFcn,eFcn,check?,rst x,xRefer,refer,nx + 1)
+        concat(makeTerm(m,newCoef),_
+               iMap1(cFcn,eFcn,check?,rst x,xRefer,refer,nx + 1))
+      -- can't have elt(xRefer) = infty unless all terms have been computed
+      degr := retract(elt xRefer)@I
+      setelt(refer,eFcn(degr) :: COM)
+      iMap1(cFcn,eFcn,check?,x,xRefer,refer,degr + 1)
 
-\end{chunk}
+    iMap2(cFcn,eFcn,check?,ups) ==
+      -- 'eFcn' must be a strictly increasing function,
+      -- i.e. i < j => eFcn(i) < eFcn(j)
+      xRefer := getRef ups; x := getStream ups
+      explicitlyEmpty? x => 0
+      explicitEntries? x =>
+        deg := getExpon frst x
+        refer := ref(eFcn(deg - 1) :: COM)
+        makeSeries(refer,iMap1(cFcn,eFcn,check?,x,xRefer,refer,deg))
+      -- can't have elt(xRefer) = infty unless all terms have been computed
+      degr := retract(elt xRefer)@I
+      refer := ref(eFcn(degr) :: COM)
+      makeSeries(refer,iMap1(cFcn,eFcn,check?,x,xRefer,refer,degr + 1))
 
-\begin{chunk}{COQ IPADIC}
-(* domain IPADIC *)
-(*
-*)
+    map(fcn,x)                == iMap2((y,n) +-> fcn(y), z +->z,      true, x)
 
-\end{chunk}
+    differentiate x           == iMap2((y,n) +-> n*y,    z +-> z - 1, true, x)
 
-\begin{chunk}{IPADIC.dotabb}
-"IPADIC" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IPADIC"]
-"FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"]
-"PADICCT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=PADICCT"]
-"IPADIC" -> "PADICCT"
-"IPADIC" -> "FLAGG"
+    multiplyCoefficients(f,x) == iMap2((y,n) +-> f(n)*y, z +-> z,     true, x)
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain IPF InnerPrimeField}
+    multiplyExponents(x,n)    == iMap2((y,m) +-> y,      z +-> n*z,   false, x)
 
-\begin{chunk}{InnerPrimeField.input}
-)set break resume
-)sys rm -f InnerPrimeField.output
-)spool InnerPrimeField.output
-)set message test on
-)set message auto off
-)clear all
+    iPlus1(op,x,xRefer,y,yRefer,refer,n) == delay
+      -- when this function is called, all terms in 'x' and 'y' of order < n
+      -- have been computed and we are computing the nth order coefficient of
+      -- the result; note the 'op' is either '+' or '-'
+      explicitlyEmpty? x => 
+        iMap1((x1,m) +-> op(0,x1), z +-> z, false, y, yRefer, refer, n)
+      explicitlyEmpty? y => 
+        iMap1((x1,m) +-> op(x1,0), z +-> z, false, x, xRefer, refer, n)
+      -- if terms up to order n have not been computed,
+      -- apply lazy evaluation
+      nn := n :: COM
+      while (elt xRefer) < nn repeat lazyEvaluate x
+      while (elt yRefer) < nn repeat lazyEvaluate y
+      -- 'x' or 'y' may now be empty: retest
+      explicitlyEmpty? x => 
+        iMap1((x1,m) +-> op(0,x1), z +-> z, false, y, yRefer, refer, n)
+      explicitlyEmpty? y => 
+        iMap1((x1,m) +-> op(x1,0), z +-> z, false, x, xRefer, refer, n)
+      -- must have nx >= n, ny >= n
+      -- both x and y have explicit terms
+      explicitEntries?(x) and explicitEntries?(y) =>
+        xCoef := getCoef(xTerm := frst x); nx := getExpon xTerm
+        yCoef := getCoef(yTerm := frst y); ny := getExpon yTerm
+        nx = ny =>
+          setelt(refer,nx :: COM)
+          zero? (coef := op(xCoef,yCoef)) =>
+            iPlus1(op,rst x,xRefer,rst y,yRefer,refer,nx + 1)
+          concat(makeTerm(nx,coef),_
+                 iPlus1(op,rst x,xRefer,rst y,yRefer,refer,nx + 1))
+        nx < ny =>
+          setelt(refer,nx :: COM)
+          concat(makeTerm(nx,op(xCoef,0)),_
+                 iPlus1(op,rst x,xRefer,y,yRefer,refer,nx + 1))
+        setelt(refer,ny :: COM)
+        concat(makeTerm(ny,op(0,yCoef)),_
+               iPlus1(op,x,xRefer,rst y,yRefer,refer,ny + 1))
+      -- y has no term of degree n
+      explicitEntries? x =>
+        xCoef := getCoef(xTerm := frst x); nx := getExpon xTerm
+        -- can't have elt(yRefer) = infty unless all terms have been computed
+        (degr := retract(elt yRefer)@I) < nx =>
+          setelt(refer,elt yRefer)
+          iPlus1(op,x,xRefer,y,yRefer,refer,degr + 1)
+        setelt(refer,nx :: COM)
+        concat(makeTerm(nx,op(xCoef,0)),_
+               iPlus1(op,rst x,xRefer,y,yRefer,refer,nx + 1))
+      -- x has no term of degree n
+      explicitEntries? y =>
+        yCoef := getCoef(yTerm := frst y); ny := getExpon yTerm
+        -- can't have elt(xRefer) = infty unless all terms have been computed
+        (degr := retract(elt xRefer)@I) < ny =>
+          setelt(refer,elt xRefer)
+          iPlus1(op,x,xRefer,y,yRefer,refer,degr + 1)
+        setelt(refer,ny :: COM)
+        concat(makeTerm(ny,op(0,yCoef)),_
+               iPlus1(op,x,xRefer,rst y,yRefer,refer,ny + 1))
+      -- neither x nor y has a term of degree n
+      setelt(refer,xyRef := min(elt xRefer,elt yRefer))
+      -- can't have xyRef = infty unless all terms have been computed
+      iPlus1(op,x,xRefer,y,yRefer,refer,retract(xyRef)@I + 1)
 
---S 1 of 1
-)show InnerPrimeField
---R 
---R InnerPrimeField(p: PositiveInteger)  is a domain constructor
---R Abbreviation for InnerPrimeField is IPF 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for IPF 
---R
---R------------------------------- Operations --------------------------------
---R ?*? : (Fraction(Integer),%) -> %      ?*? : (%,Fraction(Integer)) -> %
---R ?*? : (%,%) -> %                      ?*? : (Integer,%) -> %
---R ?*? : (NonNegativeInteger,%) -> %     ?*? : (PositiveInteger,%) -> %
---R ?**? : (%,Integer) -> %               ?**? : (%,NonNegativeInteger) -> %
---R ?**? : (%,PositiveInteger) -> %       ?+? : (%,%) -> %
---R ?-? : (%,%) -> %                      -? : % -> %
---R ?/? : (%,%) -> %                      ?=? : (%,%) -> Boolean
---R D : % -> %                            D : (%,NonNegativeInteger) -> %
---R Frobenius : % -> % if $ has FINITE    1 : () -> %
---R 0 : () -> %                           ?^? : (%,Integer) -> %
---R ?^? : (%,NonNegativeInteger) -> %     ?^? : (%,PositiveInteger) -> %
---R algebraic? : % -> Boolean             associates? : (%,%) -> Boolean
---R basis : () -> Vector(%)               charthRoot : % -> %
---R coerce : Fraction(Integer) -> %       coerce : % -> %
---R coerce : Integer -> %                 coerce : % -> OutputForm
---R convert : % -> Integer                coordinates : % -> Vector(%)
---R createPrimitiveElement : () -> %      degree : % -> PositiveInteger
---R differentiate : % -> %                dimension : () -> CardinalNumber
---R enumerate : () -> List(%)             factor : % -> Factored(%)
---R gcd : List(%) -> %                    gcd : (%,%) -> %
---R generator : () -> % if $ has FINITE   hash : % -> SingleInteger
---R inGroundField? : % -> Boolean         index : PositiveInteger -> %
---R init : () -> %                        inv : % -> %
---R latex : % -> String                   lcm : List(%) -> %
---R lcm : (%,%) -> %                      lookup : % -> PositiveInteger
---R nextItem : % -> Union(%,"failed")     norm : % -> %
---R one? : % -> Boolean                   order : % -> PositiveInteger
---R prime? : % -> Boolean                 primeFrobenius : % -> %
---R primitive? : % -> Boolean             primitiveElement : () -> %
---R ?quo? : (%,%) -> %                    random : () -> %
---R recip : % -> Union(%,"failed")        ?rem? : (%,%) -> %
---R represents : Vector(%) -> %           retract : % -> %
---R sample : () -> %                      size : () -> NonNegativeInteger
---R sizeLess? : (%,%) -> Boolean          squareFree : % -> Factored(%)
---R squareFreePart : % -> %               trace : % -> %
---R transcendent? : % -> Boolean          unit? : % -> Boolean
---R unitCanonical : % -> %                zero? : % -> Boolean
---R ?~=? : (%,%) -> Boolean              
---R Frobenius : (%,NonNegativeInteger) -> % if $ has FINITE
---R basis : PositiveInteger -> Vector(%)
---R characteristic : () -> NonNegativeInteger
---R charthRoot : % -> Union(%,"failed")
---R conditionP : Matrix(%) -> Union(Vector(%),"failed")
---R coordinates : Vector(%) -> Matrix(%)
---R createNormalElement : () -> % if $ has FINITE
---R definingPolynomial : () -> SparseUnivariatePolynomial(%)
---R degree : % -> OnePointCompletion(PositiveInteger)
---R differentiate : (%,NonNegativeInteger) -> %
---R discreteLog : % -> NonNegativeInteger
---R discreteLog : (%,%) -> Union(NonNegativeInteger,"failed")
---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 extensionDegree : () -> OnePointCompletion(PositiveInteger)
---R extensionDegree : () -> PositiveInteger
---R factorsOfCyclicGroupSize : () -> List(Record(factor: Integer,exponent: Integer))
---R gcdPolynomial : (SparseUnivariatePolynomial(%),SparseUnivariatePolynomial(%)) -> SparseUnivariatePolynomial(%)
---R lcmCoef : (%,%) -> Record(llcmres: %,coeff1: %,coeff2: %)
---R linearAssociatedExp : (%,SparseUnivariatePolynomial(%)) -> % if $ has FINITE
---R linearAssociatedLog : % -> SparseUnivariatePolynomial(%) if $ has FINITE
---R linearAssociatedLog : (%,%) -> Union(SparseUnivariatePolynomial(%),"failed") if $ has FINITE
---R linearAssociatedOrder : % -> SparseUnivariatePolynomial(%) if $ has FINITE
---R minimalPolynomial : % -> SparseUnivariatePolynomial(%)
---R minimalPolynomial : (%,PositiveInteger) -> SparseUnivariatePolynomial(%) if $ has FINITE
---R multiEuclidean : (List(%),%) -> Union(List(%),"failed")
---R norm : (%,PositiveInteger) -> % if $ has FINITE
---R normal? : % -> Boolean if $ has FINITE
---R normalElement : () -> % if $ has FINITE
---R order : % -> OnePointCompletion(PositiveInteger)
---R primeFrobenius : (%,NonNegativeInteger) -> %
---R principalIdeal : List(%) -> Record(coef: List(%),generator: %)
---R representationType : () -> Union("prime",polynomial,normal,cyclic)
---R retractIfCan : % -> Union(%,"failed")
---R subtractIfCan : (%,%) -> Union(%,"failed")
---R tableForDiscreteLogarithm : Integer -> Table(PositiveInteger,NonNegativeInteger)
---R trace : (%,PositiveInteger) -> % if $ has FINITE
---R transcendenceDegree : () -> NonNegativeInteger
---R unitNormal : % -> Record(unit: %,canonical: %,associate: %)
---R
---E 1
+    iPlus2(op,ups1,ups2) ==
+      xRefer := getRef ups1; x := getStream ups1
+      xDeg :=
+        explicitlyEmpty? x => return map(z +-> op(0$Coef,z),ups2)
+        explicitEntries? x => (getExpon frst x) - 1
+        -- can't have elt(xRefer) = infty unless all terms have been computed
+        retract(elt xRefer)@I
+      yRefer := getRef ups2; y := getStream ups2
+      yDeg :=
+        explicitlyEmpty? y => return map(z +-> op(z,0$Coef),ups1)
+        explicitEntries? y => (getExpon frst y) - 1
+        -- can't have elt(yRefer) = infty unless all terms have been computed
+        retract(elt yRefer)@I
+      deg := min(xDeg,yDeg); refer := ref(deg :: COM)
+      makeSeries(refer,iPlus1(op,x,xRefer,y,yRefer,refer,deg + 1))
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{InnerPrimeField.help}
-====================================================================
-InnerPrimeField examples
-====================================================================
+    x + y == iPlus2((xi,yi) +-> xi + yi, x, y)
 
-InnerPrimeField(p) implements the field with p elements.
-Note: argument p MUST be a prime (this domain does not check).
-See PrimeField for a domain that does check.
+    x - y == iPlus2((xi,yi) +-> xi - yi, x, y)
 
-See Also:
-o )show InnerPrimeField
-o )show PrimeField
+    - y   == iMap2((x,n) +-> -x, z +-> z, false, y)
 
-\end{chunk}
+    -- gives correct defaults for I, NNI and PI
+    n:I   * x:% == (zero? n => 0; map(z +-> n*z, x))
 
-\pagehead{InnerPrimeField}{IPF}
-\pagepic{ps/v103innerprimefield.ps}{IPF}{1.00}
-{\bf See}\\
-\pageto{PrimeField}{PF}
+    n:NNI * x:% == (zero? n => 0; map(z +-> n*z, x))
 
-{\bf Exports:}\\
-\begin{tabular}{lll}
-\cross{IPF}{0} &
-\cross{IPF}{1} &
-\cross{IPF}{algebraic?} \\
-\cross{IPF}{associates?} &
-\cross{IPF}{basis} &
-\cross{IPF}{characteristic} \\
-\cross{IPF}{charthRoot} &
-\cross{IPF}{coerce} &
-\cross{IPF}{conditionP} \\
-\cross{IPF}{convert} &
-\cross{IPF}{coordinates} &
-\cross{IPF}{createPrimitiveElement} \\
-\cross{IPF}{createNormalElement} &
-\cross{IPF}{D} &
-\cross{IPF}{definingPolynomial} \\
-\cross{IPF}{degree} &
-\cross{IPF}{differentiate} &
-\cross{IPF}{dimension} \\
-\cross{IPF}{discreteLog} &
-\cross{IPF}{divide} &
-\cross{IPF}{euclideanSize} \\
-\cross{IPF}{expressIdealMember} &
-\cross{IPF}{exquo} &
-\cross{IPF}{extendedEuclidean} \\
-\cross{IPF}{extensionDegree} &
-\cross{IPF}{factor} &
-\cross{IPF}{factorsOfCyclicGroupSize} \\
-\cross{IPF}{Frobenius} &
-\cross{IPF}{gcd} &
-\cross{IPF}{gcdPolynomial} \\
-\cross{IPF}{generator} &
-\cross{IPF}{hash} &
-\cross{IPF}{inGroundField?} \\
-\cross{IPF}{index} &
-\cross{IPF}{init} &
-\cross{IPF}{inv} \\
-\cross{IPF}{latex} &
-\cross{IPF}{lcm} &
-\cross{IPF}{linearAssociatedExp} \\
-\cross{IPF}{linearAssociatedLog} &
-\cross{IPF}{linearAssociatedOrder} &
-\cross{IPF}{lookup} \\
-\cross{IPF}{minimalPolynomial} &
-\cross{IPF}{multiEuclidean} &
-\cross{IPF}{nextItem} \\
-\cross{IPF}{norm} &
-\cross{IPF}{normal?} &
-\cross{IPF}{normalElement} \\
-\cross{IPF}{one?} &
-\cross{IPF}{order} &
-\cross{IPF}{prime?} \\
-\cross{IPF}{primeFrobenius} &
-\cross{IPF}{primitive?} &
-\cross{IPF}{primitiveElement} \\
-\cross{IPF}{principalIdeal} &
-\cross{IPF}{random} &
-\cross{IPF}{recip} \\
-\cross{IPF}{representationType} &
-\cross{IPF}{represents} &
-\cross{IPF}{retract} \\
-\cross{IPF}{retractIfCan} &
-\cross{IPF}{sample} &
-\cross{IPF}{size} \\
-\cross{IPF}{sizeLess?} &
-\cross{IPF}{squareFree} &
-\cross{IPF}{squareFreePart} \\
-\cross{IPF}{subtractIfCan} &
-\cross{IPF}{tableForDiscreteLogarithm} &
-\cross{IPF}{trace} \\
-\cross{IPF}{transcendenceDegree} &
-\cross{IPF}{transcendent?} &
-\cross{IPF}{unit?} \\
-\cross{IPF}{unitCanonical} &
-\cross{IPF}{unitNormal} &
-\cross{IPF}{zero?} \\
-\cross{IPF}{?*?} &
-\cross{IPF}{?**?} &
-\cross{IPF}{?+?} \\
-\cross{IPF}{?-?} &
-\cross{IPF}{-?} &
-\cross{IPF}{?/?} \\
-\cross{IPF}{?=?} &
-\cross{IPF}{?\^{}?} &
-\cross{IPF}{?\~{}=?} \\
-\cross{IPF}{?quo?} &
-\cross{IPF}{?rem?} &
-\end{tabular}
+    n:PI  * x:% == (zero? n => 0; map(z +-> n*z, x))
 
-\begin{chunk}{domain IPF InnerPrimeField}
-)abbrev domain IPF InnerPrimeField
-++ Authors: N.N., J.Grabmeier, A.Scheerhorn
-++ Date Created: ?, November 1990, 26.03.1991
-++ Date Last Updated: 12 April 1991
-++ References:
-++  R.Lidl, H.Niederreiter: Finite Field, Encycoldia of Mathematics and
-++  Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4
-++  AXIOM Technical Report Series, to appear.
-++ Description:
-++ InnerPrimeField(p) implements the field with p elements.
-++ Note: argument p MUST be a prime (this domain does not check).
-++ See \spadtype{PrimeField} for a domain that does check.
+    productByTerm(coef,expon,x,xRefer,refer,n) ==
+      iMap1((y,m) +-> coef*y, z +-> z+expon, true, x, xRefer, refer, n)
 
-InnerPrimeField(p:PositiveInteger): Exports == Implementation where
+    productLazyEval(x,xRefer,y,yRefer,nn) ==
+      explicitlyEmpty?(x) or explicitlyEmpty?(y) => void()
+      explicitEntries? x =>
+        explicitEntries? y => void()
+        xDeg := (getExpon frst x) :: COM
+        while (xDeg + elt(yRefer)) < nn repeat lazyEvaluate y
+        void()
+      explicitEntries? y =>
+        yDeg := (getExpon frst y) :: COM
+        while (yDeg + elt(xRefer)) < nn repeat lazyEvaluate x
+        void()
+      lazyEvaluate x
+      -- if x = y, then y may now have explicit entries
+      if lazy? y then lazyEvaluate y
+      productLazyEval(x,xRefer,y,yRefer,nn)
 
-  I   ==> Integer
-  NNI ==> NonNegativeInteger
-  PI  ==> PositiveInteger
-  TBL ==> Table(PI,NNI)
-  R   ==> Record(key:PI,entry:NNI)
-  SUP ==> SparseUnivariatePolynomial
-  OUT ==> OutputForm
+    iTimes(x,xRefer,y,yRefer,refer,n) == delay
+      -- when this function is called, we are computing the nth order
+      -- coefficient of the product
+      productLazyEval(x,xRefer,y,yRefer,n :: COM)
+      explicitlyEmpty?(x) or explicitlyEmpty?(y) =>
+        (setelt(refer,plusInfinity()); empty())
+      -- must have nx + ny >= n
+      explicitEntries?(x) and explicitEntries?(y) =>
+        xCoef := getCoef(xTerm := frst x); xExpon := getExpon xTerm
+        yCoef := getCoef(yTerm := frst y); yExpon := getExpon yTerm
+        expon := xExpon + yExpon
+        setelt(refer,expon :: COM)
+        scRefer := ref(expon :: COM)
+        scMult := productByTerm(xCoef,xExpon,rst y,yRefer,scRefer,yExpon + 1)
+        prRefer := ref(expon :: COM)
+        pr := iTimes(rst x,xRefer,y,yRefer,prRefer,expon + 1)
+        sm := iPlus1((a,b) +-> a+b,scMult,scRefer,pr,prRefer,refer,expon + 1)
+        zero?(coef := xCoef * yCoef) => sm
+        concat(makeTerm(expon,coef),sm)
+      explicitEntries? x =>
+        xExpon := getExpon frst x
+        -- can't have elt(yRefer) = infty unless all terms have been computed
+        degr := retract(elt yRefer)@I
+        setelt(refer,(xExpon + degr) :: COM)
+        iTimes(x,xRefer,y,yRefer,refer,xExpon + degr + 1)
+      explicitEntries? y =>
+        yExpon := getExpon frst y
+        -- can't have elt(xRefer) = infty unless all terms have been computed
+        degr := retract(elt xRefer)@I
+        setelt(refer,(yExpon + degr) :: COM)
+        iTimes(x,xRefer,y,yRefer,refer,yExpon + degr + 1)
+      -- can't have elt(xRefer) = infty unless all terms have been computed
+      xDegr := retract(elt xRefer)@I
+      yDegr := retract(elt yRefer)@I
+      setelt(refer,(xDegr + yDegr) :: COM)
+      iTimes(x,xRefer,y,yRefer,refer,xDegr + yDegr + 1)
 
-  Exports ==> Join(FiniteFieldCategory,FiniteAlgebraicExtensionField($),_
-                ConvertibleTo(Integer))
+    ups1:% * ups2:% ==
+      xRefer := getRef ups1; x := getStream ups1
+      xDeg :=
+        explicitlyEmpty? x => return 0
+        explicitEntries? x => (getExpon frst x) - 1
+        -- can't have elt(xRefer) = infty unless all terms have been computed
+        retract(elt xRefer)@I
+      yRefer := getRef ups2; y := getStream ups2
+      yDeg :=
+        explicitlyEmpty? y => return 0
+        explicitEntries? y => (getExpon frst y) - 1
+        -- can't have elt(yRefer) = infty unless all terms have been computed
+        retract(elt yRefer)@I
+      deg := xDeg + yDeg + 1; refer := ref(deg :: COM)
+      makeSeries(refer,iTimes(x,xRefer,y,yRefer,refer,deg + 1))
 
-  Implementation ==> IntegerMod p add
+    iDivide(x,xRefer,y,yRefer,rym,m,refer,n) == delay
+      -- when this function is called, we are computing the nth order
+      -- coefficient of the result
+      explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty())
+      -- if terms up to order n - m have not been computed,
+      -- apply lazy evaluation
+      nm := (n + m) :: COM
+      while (elt xRefer) < nm repeat lazyEvaluate x
+      -- 'x' may now be empty: retest
+      explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty())
+      -- must have nx >= n + m
+      explicitEntries? x =>
+        newCoef := getCoef(xTerm := frst x) * rym; nx := getExpon xTerm
+        prodRefer := ref(nx :: COM)
+        prod := productByTerm(-newCoef,nx - m,rst y,yRefer,prodRefer,1)
+        sumRefer := ref(nx :: COM)
+        sum := iPlus1((a,b)+->a+b,rst x,xRefer,prod,prodRefer,sumRefer,nx + 1)
+        setelt(refer,(nx - m) :: COM); term := makeTerm(nx - m,newCoef)
+        concat(term,iDivide(sum,sumRefer,y,yRefer,rym,m,refer,nx - m + 1))
+      -- can't have elt(xRefer) = infty unless all terms have been computed
+      degr := retract(elt xRefer)@I
+      setelt(refer,(degr - m) :: COM)
+      iDivide(x,xRefer,y,yRefer,rym,m,refer,degr - m + 1)
 
-    initializeElt:() -> Void
-    initializeLog:() -> Void
+    divide(ups1,deg1,ups2,deg2,r) ==
+      xRefer := getRef ups1; x := getStream ups1
+      yRefer := getRef ups2; y := getStream ups2
+      refer := ref((deg1 - deg2) :: COM)
+      makeSeries(refer,iDivide(x,xRefer,y,yRefer,r,deg2,refer,deg1 - deg2 + 1))
 
--- global variables ====================================================
+    iExquo(ups1,ups2,taylor?) ==
+      xRefer := getRef ups1; x := getStream ups1
+      yRefer := getRef ups2; y := getStream ups2
+      n : I := 0
+      -- try to find first non-zero term in y
+      -- give up after 1000 lazy evaluations
+      while not explicitEntries? y repeat
+        explicitlyEmpty? y => return "failed"
+        lazyEvaluate y
+        (n := n + 1) > 1000 => return "failed"
+      yCoef := getCoef(yTerm := frst y); ny := getExpon yTerm
+      (ry := recip yCoef) case "failed" => "failed"
+      nn := ny :: COM
+      if taylor? then
+        while (elt(xRefer) < nn) repeat
+          explicitlyEmpty? x => return 0
+          explicitEntries? x => return "failed"
+          lazyEvaluate x
+      -- check if ups2 is a monomial
+      empty? rst y => iMap2((y1,m) +-> y1*(ry::Coef),z +->z-ny, false, ups1)
+      explicitlyEmpty? x => 0
+      nx :=
+        explicitEntries? x =>
+          ((deg := getExpon frst x) < ny) and taylor? => return "failed"
+          deg - 1
+        -- can't have elt(xRefer) = infty unless all terms have been computed
+        retract(elt xRefer)@I
+      divide(ups1,nx,ups2,ny,ry :: Coef)
 
-    primitiveElt:PI:=1
-    -- for the lookup the primitive Element computed by createPrimitiveElement()
+    taylorQuoByVar ups ==
+      iMap2((y,n) +-> y, z +-> z-1,false,ups - monomial(coefficient(ups,0),0))
 
-    sizeCG  :=(p-1) pretend NonNegativeInteger
-    -- the size of the cyclic group
+    compose0(x,xRefer,y,yRefer,yOrd,y1,yn0,n0,refer,n) == delay
+      -- when this function is called, we are computing the nth order
+      -- coefficient of the composite
+      explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty())
+      -- if terms in 'x' up to order n have not been computed,
+      -- apply lazy evaluation
+      nn := n :: COM; yyOrd := yOrd :: COM
+      while (yyOrd * elt(xRefer)) < nn repeat lazyEvaluate x
+      explicitEntries? x =>
+        xCoef := getCoef(xTerm := frst x); n1 := getExpon xTerm
+        zero? n1 =>
+          setelt(refer,n1 :: COM)
+          concat(makeTerm(n1,xCoef),_
+                 compose0(rst x,xRefer,y,yRefer,yOrd,y1,yn0,n0,refer,n1 + 1))
+        yn1 := yn0 * y1 ** ((n1 - n0) :: NNI)
+        z := getStream yn1; zRefer := getRef yn1
+        degr := yOrd * n1; prodRefer := ref((degr - 1) :: COM)
+        prod := iMap1((s,k)+->xCoef*s,m+->m,true,z,zRefer,prodRefer,degr)
+        coRefer := ref((degr + yOrd - 1) :: COM)
+        co := compose0(rst x,xRefer,y,yRefer,yOrd,y1,yn1,n1,coRefer,degr+yOrd)
+        setelt(refer,(degr - 1) :: COM)
+        iPlus1((a,b)+->a+b,prod,prodRefer,co,coRefer,refer,degr)
+      -- can't have elt(xRefer) = infty unless all terms have been computed
+      degr := yOrd * (retract(elt xRefer)@I + 1)
+      setelt(refer,(degr - 1) :: COM)
+      compose0(x,xRefer,y,yRefer,yOrd,y1,yn0,n0,refer,degr)
 
-    facOfGroupSize := nil()$(List Record(factor:Integer,exponent:Integer))
-    -- the factorization of the cyclic group size
+    iCompose(ups1,ups2) ==
+      x := getStream ups1; xRefer := getRef ups1
+      y := getStream ups2; yRefer := getRef ups2
+      -- try to compute the order of 'ups2'
+      n : I := _$streamCount$Lisp
+      for i in 1..n while not explicitEntries? y repeat
+        explicitlyEmpty? y => coefficient(ups1,0) :: %
+        lazyEvaluate y
+      explicitlyEmpty? y => coefficient(ups1,0) :: %
+      yOrd : I :=
+        explicitEntries? y => getExpon frst y
+        retract(elt yRefer)@I
+      compRefer := ref((-1) :: COM)
+      makeSeries(compRefer,_
+                 compose0(x,xRefer,y,yRefer,yOrd,ups2,1,0,compRefer,0))
 
-    initlog?:Boolean:=true
-    -- gets false after initialization of the logarithm table
+    if Coef has Algebra Fraction Integer then
 
-    initelt?:Boolean:=true
-    -- gets false after initialization of the primitive Element
+      integrate x == iMap2((y,n) +-> 1/(n+1)*y, z +-> z+1, true, x)
 
+--% Fixed point computations
 
-    discLogTable:Table(PI,TBL):=table()$Table(PI,TBL)
-    -- tables indexed by the factors of the size q of the cyclic group
-    -- discLogTable.factor is a table of with keys
-    -- primitiveElement() ** (i * (q quo factor)) and entries i for
-    -- i in 0..n-1, n computed in initialize() in order to use
-    -- the minimal size limit 'limit' optimal.
+      Ys ==> Y$ParadoxicalCombinatorsForStreams(Term)
 
--- functions ===========================================================
+      integ0: (ST,REF,REF,I) -> ST
+      integ0(x,intRef,ansRef,n) == delay
+        nLess1 := (n - 1) :: COM
+        while (elt intRef) < nLess1 repeat lazyEvaluate x
+        explicitlyEmpty? x => (setelt(ansRef,plusInfinity()); empty())
+        explicitEntries? x =>
+          xCoef := getCoef(xTerm := frst x); nx := getExpon xTerm
+          setelt(ansRef,(n1 := (nx + 1)) :: COM)
+          concat(makeTerm(n1,inv(n1 :: RN) * xCoef),_
+                 integ0(rst x,intRef,ansRef,n1))
+        -- can't have elt(intRef) = infty unless all terms have been computed
+        degr := retract(elt intRef)@I; setelt(ansRef,(degr + 1) :: COM)
+        integ0(x,intRef,ansRef,degr + 2)
 
-    generator() == 1
+      integ1: (ST,REF,REF) -> ST
+      integ1(x,intRef,ansRef) == integ0(x,intRef,ansRef,1)
 
-    -- This uses x**(p-1)=1 (mod p), so x**(q(p-1)+r) = x**r (mod p)
-    x:$ ** n:Integer ==
-      zero?(n) => 1
-      zero?(x) => 0
-      r := positiveRemainder(n,p-1)::NNI
-      ((x pretend IntegerMod p) **$IntegerMod(p) r) pretend $
+      lazyInteg: (Coef,() -> ST,REF,REF) -> ST
+      lazyInteg(a,xf,intRef,ansRef) ==
+        ansStr : ST := integ1(delay xf,intRef,ansRef)
+        concat(makeTerm(0,a),ansStr)
 
-    if p <= convert(max()$SingleInteger)@Integer then
-      q := p::SingleInteger
+      cPower(f,r) ==
+        -- computes f^r.  f should have constant coefficient 1.
+        fp := differentiate f
+        fInv := iExquo(1,f,false) :: %; y := r * fp * fInv
+        yRef := getRef y; yStr := getStream y
+        intRef := ref((-1) :: COM); ansRef := ref(0 :: COM)
+        ansStr := 
+         Ys(s+->lazyInteg(1,iTimes(s,ansRef,yStr,yRef,intRef,0),intRef,ansRef))
+        makeSeries(ansRef,ansStr)
 
-      recip x ==
-        zero?(y := convert(x)@Integer :: SingleInteger) => "failed"
-        invmod(y, q)::Integer::$
-    else
-      recip x ==
-        zero?(y := convert(x)@Integer) => "failed"
-        invmod(y, p)::$
+      iExp: (%,Coef) -> %
+      iExp(f,cc) ==
+        -- computes exp(f).  cc = exp coefficient(f,0)
+        fp := differentiate f
+        fpRef := getRef fp; fpStr := getStream fp
+        intRef := ref((-1) :: COM); ansRef := ref(0 :: COM)
+        ansStr := 
+         Ys(s+->lazyInteg(cc,
+                  iTimes(s,ansRef,fpStr,fpRef,intRef,0),intRef,ansRef))
+        makeSeries(ansRef,ansStr)
 
-    convert(x:$) == x pretend I
+      sincos0: (Coef,Coef,L ST,REF,REF,ST,REF,ST,REF) -> L ST
+      sincos0(sinc,cosc,list,sinRef,cosRef,fpStr,fpRef,fpStr2,fpRef2) ==
+        sinStr := first list; cosStr := second list
+        prodRef1 := ref((-1) :: COM); prodRef2 := ref((-1) :: COM)
+        prodStr1 := iTimes(cosStr,cosRef,fpStr,fpRef,prodRef1,0)
+        prodStr2 := iTimes(sinStr,sinRef,fpStr2,fpRef2,prodRef2,0)
+        [lazyInteg(sinc,prodStr1,prodRef1,sinRef),_
+         lazyInteg(cosc,prodStr2,prodRef2,cosRef)]
 
-    normalElement() == 1
+      iSincos: (%,Coef,Coef,I) -> Record(%sin: %, %cos: %)
+      iSincos(f,sinc,cosc,sign) ==
+        fp := differentiate f
+        fpRef := getRef fp; fpStr := getStream fp
+        fp2 := ((sign = 1) => fp; -fp)
+        fpRef2 := getRef fp2; fpStr2 := getStream fp2
+        sinRef := ref(0 :: COM); cosRef := ref(0 :: COM)
+        sincos :=
+         Ys(s+->sincos0(sinc,cosc,s,sinRef,cosRef,fpStr,fpRef,fpStr2,fpRef2),2)
+        sinStr := (zero? sinc => rst first sincos; first sincos)
+        cosStr := (zero? cosc => rst second sincos; second sincos)
+        [makeSeries(sinRef,sinStr),makeSeries(cosRef,cosStr)]
 
-    createNormalElement() == 1
+      tan0: (Coef,ST,REF,ST,REF,I) -> ST
+      tan0(cc,ansStr,ansRef,fpStr,fpRef,sign) ==
+        sqRef := ref((-1) :: COM)
+        sqStr := iTimes(ansStr,ansRef,ansStr,ansRef,sqRef,0)
+        one : % := 1; oneStr := getStream one; oneRef := getRef one
+        yRef := ref((-1) :: COM)
+        yStr : ST :=
+          (sign = 1) => iPlus1((a,b)+->a+b,oneStr,oneRef,sqStr,sqRef,yRef,0)
+          iPlus1((a,b)+->a-b,oneStr,oneRef,sqStr,sqRef,yRef,0)
+        intRef := ref((-1) :: COM)
+        lazyInteg(cc,iTimes(yStr,yRef,fpStr,fpRef,intRef,0),intRef,ansRef)
 
-    characteristic() == p
+      iTan: (%,%,Coef,I) -> %
+      iTan(f,fp,cc,sign) ==
+        -- computes the tangent (and related functions) of f.
+        fpRef := getRef fp; fpStr := getStream fp
+        ansRef := ref(0 :: COM)
+        ansStr := Ys(s+->tan0(cc,s,ansRef,fpStr,fpRef,sign))
+        zero? cc => makeSeries(ansRef,rst ansStr)
+        makeSeries(ansRef,ansStr)
 
-    factorsOfCyclicGroupSize() ==
-      p=2 => facOfGroupSize -- this fixes an infinite loop of functions
-                            -- calls, problem was that factors factor(1)
-                            -- is the empty list
-      if empty? facOfGroupSize then initializeElt()
-      facOfGroupSize
+--% Error Reporting
 
-    representationType() == "prime"
+      TRCONST : SG := "series expansion involves transcendental constants"
+      NPOWERS : SG := "series expansion has terms of negative degree"
+      FPOWERS : SG := "series expansion has terms of fractional degree"
+      MAYFPOW : SG := "series expansion may have terms of fractional degree"
+      LOGS : SG := "series expansion has logarithmic term"
+      NPOWLOG : SG :=
+         "series expansion has terms of negative degree or logarithmic term"
+      NOTINV : SG := "leading coefficient not invertible"
 
-    tableForDiscreteLogarithm(fac) ==
-      if initlog? then initializeLog()
-      tbl:=search(fac::PI,discLogTable)$Table(PI,TBL)
-      tbl case "failed" =>
-        error "tableForDiscreteLogarithm: argument must be prime divisor_
- of the order of the multiplicative group"
-      tbl pretend TBL
+--% Rational powers and transcendental functions
 
-    primitiveElement() ==
-      if initelt? then initializeElt()
-      index(primitiveElt)
+      orderOrFailed : % -> Union(I,"failed")
+      orderOrFailed uts ==
+      -- returns the order of x or "failed"
+      -- if -1 is returned, the series is identically zero
+        x := getStream uts
+        for n in 0..1000 repeat
+          explicitlyEmpty? x => return -1
+          explicitEntries? x => return getExpon frst x
+          lazyEvaluate x
+        "failed"
 
-    initializeElt() ==
-      facOfGroupSize:=factors(factor(sizeCG)$I)$(Factored I)
-      -- get a primitive element
-      primitiveElt:=lookup(createPrimitiveElement())
-      -- set initialization flag
-      initelt? := false
-      void$Void
+      RATPOWERS : Boolean := Coef has "**": (Coef,RN) -> Coef
+      TRANSFCN  : Boolean := Coef has TranscendentalFunctionCategory
 
-    initializeLog() ==
-      if initelt? then initializeElt()
-      -- set up tables for discrete logarithm
-      limit:Integer:=30
-      -- the minimum size for the discrete logarithm table
-      for f in facOfGroupSize repeat
-        fac:=f.factor
-        base:$:=primitiveElement() ** (sizeCG quo fac)
-        l:Integer:=length(fac)$Integer
-        n:Integer:=0
-        if odd?(l)$Integer then n:=shift(fac,-(l quo 2))
-                           else n:=shift(1,(l quo 2))
-        if n < limit then
-          d:=(fac-1) quo limit + 1
-          n:=(fac-1) quo d + 1
-        tbl:TBL:=table()$TBL
-        a:$:=1
-        for i in (0::NNI)..(n-1)::NNI repeat
-          insert_!([lookup(a),i::NNI]$R,tbl)$TBL
-          a:=a*base
-        insert_!([fac::PI,copy(tbl)$TBL]_
-               $Record(key:PI,entry:TBL),discLogTable)$Table(PI,TBL)
-      -- tell user about initialization
-      --    print("discrete logarithm table initialized"::OUT)
-      -- set initialization flag
-      initlog? := false
-      void$Void
+      cRationalPower(uts,r) ==
+        (ord0 := orderOrFailed uts) case "failed" =>
+          error "**: series with many leading zero coefficients"
+        order := ord0 :: I
+        (n := order exquo denom(r)) case "failed" =>
+          error "**: rational power does not exist"
+        cc := coefficient(uts,order)
+        (ccInv := recip cc) case "failed" => error concat("**: ",NOTINV)
+        ccPow :=
+          (cc = 1) => cc
+          (denom r) = 1 =>
+            not negative?(num := numer r) => cc ** (num :: NNI)
+            (ccInv :: Coef) ** ((-num) :: NNI)
+          RATPOWERS => cc ** r
+          error "** rational power of coefficient undefined"
+        uts1 := (ccInv :: Coef) * uts
+        uts2 := uts1 * monomial(1,-order)
+        monomial(ccPow,(n :: I) * numer(r)) * cPower(uts2,r :: Coef)
 
-    degree(x):PI == 1::PositiveInteger
-    extensionDegree():PI == 1::PositiveInteger
+      cExp uts ==
+        zero?(cc := coefficient(uts,0)) => iExp(uts,1)
+        TRANSFCN => iExp(uts,exp cc)
+        error concat("exp: ",TRCONST)
 
---    sizeOfGroundField() == p::NonNegativeInteger
+      cLog uts ==
+        zero?(cc := coefficient(uts,0)) =>
+          error "log: constant coefficient should not be 0"
+        (cc = 1) => integrate(differentiate(uts) * (iExquo(1,uts,true) :: %))
+        TRANSFCN =>
+          y := iExquo(1,uts,true) :: %
+          (log(cc) :: %) + integrate(y * differentiate(uts))
+        error concat("log: ",TRCONST)
 
-    inGroundField?(x)  == true
+      sincos: % -> Record(%sin: %, %cos: %)
+      sincos uts ==
+        zero?(cc := coefficient(uts,0)) => iSincos(uts,0,1,-1)
+        TRANSFCN => iSincos(uts,sin cc,cos cc,-1)
+        error concat("sincos: ",TRCONST)
 
-    coordinates(x) == new(1,x)$(Vector $)
+      cSin uts == sincos(uts).%sin
 
-    represents(v)  == v.1
+      cCos uts == sincos(uts).%cos
 
-    retract(x) == x
+      cTan uts ==
+        zero?(cc := coefficient(uts,0)) => iTan(uts,differentiate uts,0,1)
+        TRANSFCN => iTan(uts,differentiate uts,tan cc,1)
+        error concat("tan: ",TRCONST)
 
-    retractIfCan(x) == x
+      cCot uts ==
+        zero? uts => error "cot: cot(0) is undefined"
+        zero?(cc := coefficient(uts,0)) => error error concat("cot: ",NPOWERS)
+        TRANSFCN => iTan(uts,-differentiate uts,cot cc,1)
+        error concat("cot: ",TRCONST)
 
-    basis() == new(1,1::$)$(Vector $)
-    basis(n:PI) ==
-      n = 1 => basis()
-      error("basis: argument must divide extension degree")
+      cSec uts ==
+        zero?(cc := coefficient(uts,0)) => iExquo(1,cCos uts,true) :: %
+        TRANSFCN =>
+          cosUts := cCos uts
+          zero? coefficient(cosUts,0) => error concat("sec: ",NPOWERS)
+          iExquo(1,cosUts,true) :: %
+        error concat("sec: ",TRCONST)
 
-    definingPolynomial() ==
-      monomial(1,1)$(SUP $) - monomial(1,0)$(SUP $)
+      cCsc uts ==
+        zero? uts => error "csc: csc(0) is undefined"
+        TRANSFCN =>
+          sinUts := cSin uts
+          zero? coefficient(sinUts,0) => error concat("csc: ",NPOWERS)
+          iExquo(1,sinUts,true) :: %
+        error concat("csc: ",TRCONST)
 
+      cAsin uts ==
+        zero?(cc := coefficient(uts,0)) =>
+          integrate(cRationalPower(1 - uts*uts,-1/2) * differentiate(uts))
+        TRANSFCN =>
+          x := 1 - uts * uts
+          cc = 1 or cc = -1 =>
+            -- compute order of 'x'
+            (ord := orderOrFailed x) case "failed" =>
+              error concat("asin: ",MAYFPOW)
+            (order := ord :: I) = -1 => return asin(cc) :: %
+            odd? order => error concat("asin: ",FPOWERS)
+            c0 := asin(cc) :: %
+            c0 + integrate(cRationalPower(x,-1/2) * differentiate(uts))
+          c0 := asin(cc) :: %
+          c0 + integrate(cRationalPower(x,-1/2) * differentiate(uts))
+        error concat("asin: ",TRCONST)
 
-    minimalPolynomial(x) ==
-      monomial(1,1)$(SUP $) - monomial(x,0)$(SUP $)
+      cAcos uts ==
+        zero? uts =>
+          TRANSFCN => acos(0)$Coef :: %
+          error concat("acos: ",TRCONST)
+        TRANSFCN =>
+          x := 1 - uts * uts
+          cc := coefficient(uts,0)
+          cc = 1 or cc = -1 =>
+            -- compute order of 'x'
+            (ord := orderOrFailed x) case "failed" =>
+              error concat("acos: ",MAYFPOW)
+            (order := ord :: I) = -1 => return acos(cc) :: %
+            odd? order => error concat("acos: ",FPOWERS)
+            c0 := acos(cc) :: %
+            c0 + integrate(-cRationalPower(x,-1/2) * differentiate(uts))
+          c0 := acos(cc) :: %
+          c0 + integrate(-cRationalPower(x,-1/2) * differentiate(uts))
+        error concat("acos: ",TRCONST)
 
-    charthRoot x == x
+      cAtan uts ==
+        zero?(cc := coefficient(uts,0)) =>
+          y := iExquo(1,(1 :: %) + uts*uts,true) :: %
+          integrate(y * (differentiate uts))
+        TRANSFCN =>
+          (y := iExquo(1,(1 :: %) + uts*uts,true)) case "failed" =>
+            error concat("atan: ",LOGS)
+          (atan(cc) :: %) + integrate((y :: %) * (differentiate uts))
+        error concat("atan: ",TRCONST)
 
-\end{chunk}
+      cAcot uts ==
+        TRANSFCN =>
+          (y := iExquo(1,(1 :: %) + uts*uts,true)) case "failed" =>
+            error concat("acot: ",LOGS)
+          cc := coefficient(uts,0)
+          (acot(cc) :: %) + integrate(-(y :: %) * (differentiate uts))
+        error concat("acot: ",TRCONST)
 
-\begin{chunk}{COQ IPF}
-(* domain IPF *)
-(*
-*)
+      cAsec uts ==
+        zero?(cc := coefficient(uts,0)) =>
+          error "asec: constant coefficient should not be 0"
+        TRANSFCN =>
+          x := uts * uts - 1
+          y :=
+            cc = 1 or cc = -1 =>
+              -- compute order of 'x'
+              (ord := orderOrFailed x) case "failed" =>
+                error concat("asec: ",MAYFPOW)
+              (order := ord :: I) = -1 => return asec(cc) :: %
+              odd? order => error concat("asec: ",FPOWERS)
+              cRationalPower(x,-1/2) * differentiate(uts)
+            cRationalPower(x,-1/2) * differentiate(uts)
+          (z := iExquo(y,uts,true)) case "failed" =>
+            error concat("asec: ",NOTINV)
+          (asec(cc) :: %) + integrate(z :: %)
+        error concat("asec: ",TRCONST)
 
-\end{chunk}
+      cAcsc uts ==
+        zero?(cc := coefficient(uts,0)) =>
+          error "acsc: constant coefficient should not be 0"
+        TRANSFCN =>
+          x := uts * uts - 1
+          y :=
+            cc = 1 or cc = -1 =>
+              -- compute order of 'x'
+              (ord := orderOrFailed x) case "failed" =>
+                error concat("acsc: ",MAYFPOW)
+              (order := ord :: I) = -1 => return acsc(cc) :: %
+              odd? order => error concat("acsc: ",FPOWERS)
+              -cRationalPower(x,-1/2) * differentiate(uts)
+            -cRationalPower(x,-1/2) * differentiate(uts)
+          (z := iExquo(y,uts,true)) case "failed" =>
+            error concat("asec: ",NOTINV)
+          (acsc(cc) :: %) + integrate(z :: %)
+        error concat("acsc: ",TRCONST)
 
-\begin{chunk}{IPF.dotabb}
-"IPF" [color="#88FF44",href="bookvol10.3.pdf#nameddest=IPF"]
-"TBAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=TBAGG"]
-"IPF" -> "TBAGG"
+      sinhcosh: % -> Record(%sinh: %, %cosh: %)
+      sinhcosh uts ==
+        zero?(cc := coefficient(uts,0)) =>
+          tmp := iSincos(uts,0,1,1)
+          [tmp.%sin,tmp.%cos]
+        TRANSFCN =>
+          tmp := iSincos(uts,sinh cc,cosh cc,1)
+          [tmp.%sin,tmp.%cos]
+        error concat("sinhcosh: ",TRCONST)
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{domain ISUPS InnerSparseUnivariatePowerSeries}
+      cSinh uts == sinhcosh(uts).%sinh
+      cCosh uts == sinhcosh(uts).%cosh
 
-\begin{chunk}{InnerSparseUnivariatePowerSeries.input}
-)set break resume
-)sys rm -f InnerSparseUnivariatePowerSeries.output
-)spool InnerSparseUnivariatePowerSeries.output
-)set message test on
-)set message auto off
-)clear all
+      cTanh uts ==
+        zero?(cc := coefficient(uts,0)) => iTan(uts,differentiate uts,0,-1)
+        TRANSFCN => iTan(uts,differentiate uts,tanh cc,-1)
+        error concat("tanh: ",TRCONST)
 
---S 1 of 3
-)show InnerSparseUnivariatePowerSeries
---R 
---R InnerSparseUnivariatePowerSeries(Coef: Ring)  is a domain constructor
---R Abbreviation for InnerSparseUnivariatePowerSeries is ISUPS 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for ISUPS 
---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                    coefficient : (%,Integer) -> Coef
---R coerce : % -> % if Coef has INTDOM    coerce : Integer -> %
---R coerce : % -> OutputForm              complete : % -> %
---R degree : % -> Integer                 ?.? : (%,Integer) -> Coef
---R extend : (%,Integer) -> %             hash : % -> SingleInteger
---R iCompose : (%,%) -> %                 latex : % -> String
---R leadingCoefficient : % -> Coef        leadingMonomial : % -> %
---R map : ((Coef -> Coef),%) -> %         monomial : (Coef,Integer) -> %
---R monomial? : % -> Boolean              one? : % -> Boolean
---R order : (%,Integer) -> Integer        order : % -> Integer
---R pole? : % -> Boolean                  recip : % -> Union(%,"failed")
---R reductum : % -> %                     sample : () -> %
---R taylorQuoByVar : % -> %               truncate : (%,Integer) -> %
---R variable : % -> Symbol                zero? : % -> Boolean
---R ?~=? : (%,%) -> Boolean              
---R ?*? : (%,Fraction(Integer)) -> % if Coef has ALGEBRA(FRAC(INT))
---R ?*? : (Fraction(Integer),%) -> % if Coef has ALGEBRA(FRAC(INT))
---R ?/? : (%,Coef) -> % if Coef has FIELD
---R D : % -> % if Coef has *: (Integer,Coef) -> Coef
---R D : (%,NonNegativeInteger) -> % if Coef has *: (Integer,Coef) -> Coef
---R D : (%,Symbol) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
---R D : (%,List(Symbol)) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
---R D : (%,Symbol,NonNegativeInteger) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
---R D : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
---R approximate : (%,Integer) -> Coef if Coef has **: (Coef,Integer) -> Coef and Coef has coerce: Symbol -> Coef
---R associates? : (%,%) -> Boolean if Coef has INTDOM
---R cAcos : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cAcosh : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cAcot : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cAcoth : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cAcsc : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cAcsch : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cAsec : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cAsech : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cAsin : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cAsinh : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cAtan : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cAtanh : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cCos : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cCosh : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cCot : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cCoth : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cCsc : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cCsch : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cExp : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cLog : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cPower : (%,Coef) -> % if Coef has ALGEBRA(FRAC(INT))
---R cRationalPower : (%,Fraction(Integer)) -> % if Coef has ALGEBRA(FRAC(INT))
---R cSec : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cSech : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cSin : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cSinh : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cTan : % -> % if Coef has ALGEBRA(FRAC(INT))
---R cTanh : % -> % if Coef has ALGEBRA(FRAC(INT))
---R characteristic : () -> NonNegativeInteger
---R charthRoot : % -> Union(%,"failed") if Coef has CHARNZ
---R coerce : Coef -> % if Coef has COMRING
---R coerce : Fraction(Integer) -> % if Coef has ALGEBRA(FRAC(INT))
---R differentiate : % -> % if Coef has *: (Integer,Coef) -> Coef
---R differentiate : (%,NonNegativeInteger) -> % if Coef has *: (Integer,Coef) -> Coef
---R differentiate : (%,Symbol) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
---R differentiate : (%,List(Symbol)) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
---R differentiate : (%,Symbol,NonNegativeInteger) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
---R differentiate : (%,List(Symbol),List(NonNegativeInteger)) -> % if Coef has *: (Integer,Coef) -> Coef and Coef has PDRING(SYMBOL)
---R ?.? : (%,%) -> % if Integer has SGROUP
---R eval : (%,Coef) -> Stream(Coef) if Coef has **: (Coef,Integer) -> Coef
---R exquo : (%,%) -> Union(%,"failed") if Coef has INTDOM
---R getRef : % -> Reference(OrderedCompletion(Integer))
---R getStream : % -> Stream(Record(k: Integer,c: Coef))
---R iExquo : (%,%,Boolean) -> Union(%,"failed")
---R integrate : % -> % if Coef has ALGEBRA(FRAC(INT))
---R makeSeries : (Reference(OrderedCompletion(Integer)),Stream(Record(k: Integer,c: Coef))) -> %
---R monomial : (%,List(SingletonAsOrderedSet),List(Integer)) -> %
---R monomial : (%,SingletonAsOrderedSet,Integer) -> %
---R multiplyCoefficients : ((Integer -> Coef),%) -> %
---R multiplyExponents : (%,PositiveInteger) -> %
---R series : Stream(Record(k: Integer,c: Coef)) -> %
---R seriesToOutputForm : (Stream(Record(k: Integer,c: Coef)),Reference(OrderedCompletion(Integer)),Symbol,Coef,Fraction(Integer)) -> OutputForm
---R subtractIfCan : (%,%) -> Union(%,"failed")
---R terms : % -> Stream(Record(k: Integer,c: Coef))
---R truncate : (%,Integer,Integer) -> %
---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
+      cCoth uts ==
+        tanhUts := cTanh uts
+        zero? tanhUts => error "coth: coth(0) is undefined"
+        zero? coefficient(tanhUts,0) => error concat("coth: ",NPOWERS)
+        iExquo(1,tanhUts,true) :: %
 
--- test fix to iOrder internal function for finite case
+      cSech uts ==
+        coshUts := cCosh uts
+        zero? coefficient(coshUts,0) => error concat("sech: ",NPOWERS)
+        iExquo(1,coshUts,true) :: %
 
---S 2 of 5
-L := SparseUnivariateLaurentSeries(Fraction(Integer),'z,0)
---E 2
+      cCsch uts ==
+        sinhUts := cSinh uts
+        zero? coefficient(sinhUts,0) => error concat("csch: ",NPOWERS)
+        iExquo(1,sinhUts,true) :: %
 
---S 3 of 5
-w:L := 0
---E 3
+      cAsinh uts ==
+        x := 1 + uts * uts
+        zero?(cc := coefficient(uts,0)) => cLog(uts + cRationalPower(x,1/2))
+        TRANSFCN =>
+          (ord := orderOrFailed x) case "failed" =>
+            error concat("asinh: ",MAYFPOW)
+          (order := ord :: I) = -1 => return asinh(cc) :: %
+          odd? order => error concat("asinh: ",FPOWERS)
+          -- the argument to 'log' must have a non-zero constant term
+          cLog(uts + cRationalPower(x,1/2))
+        error concat("asinh: ",TRCONST)
 
---S 4 of 5
-order(w,0)
---E 4
+      cAcosh uts ==
+        zero? uts =>
+          TRANSFCN => acosh(0)$Coef :: %
+          error concat("acosh: ",TRCONST)
+        TRANSFCN =>
+          cc := coefficient(uts,0); x := uts*uts - 1
+          cc = 1 or cc = -1 =>
+            -- compute order of 'x'
+            (ord := orderOrFailed x) case "failed" =>
+              error concat("acosh: ",MAYFPOW)
+            (order := ord :: I) = -1 => return acosh(cc) :: %
+            odd? order => error concat("acosh: ",FPOWERS)
+            -- the argument to 'log' must have a non-zero constant term
+            cLog(uts + cRationalPower(x,1/2))
+          cLog(uts + cRationalPower(x,1/2))
+        error concat("acosh: ",TRCONST)
 
---S 5 of 5
-rationalFunction(w,0)
---E 5
+      cAtanh uts ==
+        half := inv(2 :: RN) :: Coef
+        zero?(cc := coefficient(uts,0)) =>
+          half * (cLog(1 + uts) - cLog(1 - uts))
+        TRANSFCN =>
+          cc = 1 or cc = -1 => error concat("atanh: ",LOGS)
+          half * (cLog(1 + uts) - cLog(1 - uts))
+        error concat("atanh: ",TRCONST)
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{InnerSparseUnivariatePowerSeries.help}
-====================================================================
-InnerSparseUnivariatePowerSeries examples
-====================================================================
+      cAcoth uts ==
+        zero? uts =>
+          TRANSFCN => acoth(0)$Coef :: %
+          error concat("acoth: ",TRCONST)
+        TRANSFCN =>
+          cc := coefficient(uts,0); half := inv(2 :: RN) :: Coef
+          cc = 1 or cc = -1 => error concat("acoth: ",LOGS)
+          half * (cLog(uts + 1) - cLog(uts - 1))
+        error concat("acoth: ",TRCONST)
 
-InnerSparseUnivariatePowerSeries is an internal domain used for
-creating sparse Taylor and Laurent series.
+      cAsech uts ==
+        zero? uts => error "asech: asech(0) is undefined"
+        TRANSFCN =>
+          zero?(cc := coefficient(uts,0)) =>
+            error concat("asech: ",NPOWLOG)
+          x := 1 - uts * uts
+          cc = 1 or cc = -1 =>
+            -- compute order of 'x'
+            (ord := orderOrFailed x) case "failed" =>
+              error concat("asech: ",MAYFPOW)
+            (order := ord :: I) = -1 => return asech(cc) :: %
+            odd? order => error concat("asech: ",FPOWERS)
+            (utsInv := iExquo(1,uts,true)) case "failed" =>
+              error concat("asech: ",NOTINV)
+            cLog((1 + cRationalPower(x,1/2)) * (utsInv :: %))
+          (utsInv := iExquo(1,uts,true)) case "failed" =>
+            error concat("asech: ",NOTINV)
+          cLog((1 + cRationalPower(x,1/2)) * (utsInv :: %))
+        error concat("asech: ",TRCONST)
 
-See Also:
-o )show InnerSparseUnivariatePowerSeries
+      cAcsch uts ==
+        zero? uts => error "acsch: acsch(0) is undefined"
+        TRANSFCN =>
+          zero?(cc := coefficient(uts,0)) => error concat("acsch: ",NPOWLOG)
+          x := uts * uts + 1
+          -- compute order of 'x'
+          (ord := orderOrFailed x) case "failed" =>
+            error concat("acsc: ",MAYFPOW)
+          (order := ord :: I) = -1 => return acsch(cc) :: %
+          odd? order => error concat("acsch: ",FPOWERS)
+          (utsInv := iExquo(1,uts,true)) case "failed" =>
+            error concat("acsch: ",NOTINV)
+          cLog((1 + cRationalPower(x,1/2)) * (utsInv :: %))
+        error concat("acsch: ",TRCONST)
 
-\end{chunk}
+--% Output forms
 
-\pagehead{InnerSparseUnivariatePowerSeries}{ISUPS}
-\pagepic{ps/v103innersparseunivariatepowerseries.ps}{ISUPS}{1.00}
+    -- check a global Lisp variable
+    factorials?() == false
 
-{\bf Exports:}\\
-\begin{tabular}{llll}
-\cross{ISUPS}{0} &
-\cross{ISUPS}{1} &
-\cross{ISUPS}{approximate} &
-\cross{ISUPS}{associates?} \\
-\cross{ISUPS}{cAcos} &
-\cross{ISUPS}{cAcosh} &
-\cross{ISUPS}{cAcot} &
-\cross{ISUPS}{cAcoth} \\
-\cross{ISUPS}{cAcsc} &
-\cross{ISUPS}{cAcsch} &
-\cross{ISUPS}{cAsec} &
-\cross{ISUPS}{cAsech} \\
-\cross{ISUPS}{cAsin} &
-\cross{ISUPS}{cAsinh} &
-\cross{ISUPS}{cAtan} &
-\cross{ISUPS}{cAtanh} \\
-\cross{ISUPS}{cCos} &
-\cross{ISUPS}{cCosh} &
-\cross{ISUPS}{cCot} &
-\cross{ISUPS}{cCoth} \\
-\cross{ISUPS}{cCsc} &
-\cross{ISUPS}{cCsch} &
-\cross{ISUPS}{center} &
-\cross{ISUPS}{cExp} \\
-\cross{ISUPS}{cLog} &
-\cross{ISUPS}{coefficient} &
-\cross{ISUPS}{cPower} &
-\cross{ISUPS}{cRationalPower} \\
-\cross{ISUPS}{cSec} &
-\cross{ISUPS}{cSech} &
-\cross{ISUPS}{cSin} &
-\cross{ISUPS}{cSinh} \\
-\cross{ISUPS}{cTan} &
-\cross{ISUPS}{cTanh} &
-\cross{ISUPS}{characteristic} &
-\cross{ISUPS}{charthRoot} \\
-\cross{ISUPS}{coerce} &
-\cross{ISUPS}{complete} &
-\cross{ISUPS}{D} &
-\cross{ISUPS}{differentiate} \\
-\cross{ISUPS}{degree} &
-\cross{ISUPS}{eval} &
-\cross{ISUPS}{exquo} &
-\cross{ISUPS}{extend} \\
-\cross{ISUPS}{getRef} &
-\cross{ISUPS}{getStream} &
-\cross{ISUPS}{hash} &
-\cross{ISUPS}{iCompose} \\
-\cross{ISUPS}{iExquo} &
-\cross{ISUPS}{integrate} &
-\cross{ISUPS}{latex} &
-\cross{ISUPS}{leadingCoefficient} \\
-\cross{ISUPS}{leadingMonomial} &
-\cross{ISUPS}{makeSeries} &
-\cross{ISUPS}{map} &
-\cross{ISUPS}{monomial} \\
-\cross{ISUPS}{monomial?} &
-\cross{ISUPS}{multiplyCoefficients} &
-\cross{ISUPS}{multiplyExponents} &
-\cross{ISUPS}{one?} \\
-\cross{ISUPS}{order} &
-\cross{ISUPS}{pole?} &
-\cross{ISUPS}{recip} &
-\cross{ISUPS}{reductum} \\
-\cross{ISUPS}{sample} &
-\cross{ISUPS}{series} &
-\cross{ISUPS}{seriesToOutputForm} &
-\cross{ISUPS}{subtractIfCan} \\
-\cross{ISUPS}{taylorQuoByVar} &
-\cross{ISUPS}{terms} &
-\cross{ISUPS}{truncate} &
-\cross{ISUPS}{unit?} \\
-\cross{ISUPS}{unitCanonical} &
-\cross{ISUPS}{unitNormal} &
-\cross{ISUPS}{variable} &
-\cross{ISUPS}{variables} \\
-\cross{ISUPS}{zero?} &
-\cross{ISUPS}{?*?} &
-\cross{ISUPS}{?**?} &
-\cross{ISUPS}{?+?} \\
-\cross{ISUPS}{?-?} &
-\cross{ISUPS}{-?} &
-\cross{ISUPS}{?=?} &
-\cross{ISUPS}{?\^{}?} \\
-\cross{ISUPS}{?.?} &
-\cross{ISUPS}{?\~{}=?} &
-\cross{ISUPS}{?/?} &
-\cross{ISUPS}{?\^{}?} \\
-\cross{ISUPS}{?.?} &&&
-\end{tabular}
+    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
 
-\begin{chunk}{domain ISUPS InnerSparseUnivariatePowerSeries}
-)abbrev domain ISUPS InnerSparseUnivariatePowerSeries
-++ Author: Clifton J. Williamson
-++ Date Created: 28 October 1994
-++ Date Last Updated: 9 March 1995
-++ Description: 
-++ InnerSparseUnivariatePowerSeries is an internal domain
-++ used for creating sparse Taylor and Laurent series.
+    -- check a global Lisp variable
+    showAll?() == true
 
-InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
-  Coef  : Ring
-  B    ==> Boolean
-  COM  ==> OrderedCompletion Integer
-  I    ==> Integer
-  L    ==> List
-  NNI  ==> NonNegativeInteger
-  OUT  ==> OutputForm
-  PI   ==> PositiveInteger
-  REF  ==> Reference OrderedCompletion Integer
-  RN   ==> Fraction Integer
-  Term ==> Record(k:Integer,c:Coef)
-  SG   ==> String
-  ST   ==> Stream Term
+    seriesToOutputForm(st,refer,var,cen,r) ==
+      vv :=
+        zero? cen => var :: OUT
+        paren(var :: OUT - cen :: OUT)
+      l : L OUT := empty()
+      while explicitEntries? st repeat
+        term := frst st
+        l := concat(termOutput(getExpon(term) * r,getCoef term,vv),l)
+        st := rst st
+      l :=
+        explicitlyEmpty? st => l
+        (deg := retractIfCan(elt refer)@Union(I,"failed")) case I =>
+          concat(prefix("O" :: OUT,[vv ** ((((deg :: I) + 1) * r) :: OUT)]),l)
+        l
+      empty? l => (0$Coef) :: OUT
+      reduce("+",reverse_! l)
 
-  Exports ==> UnivariatePowerSeriesCategory(Coef,Integer) with
-    makeSeries: (REF,ST) -> %
-      ++ makeSeries(refer,str) creates a power series from the reference
-      ++ \spad{refer} and the stream \spad{str}.
-    getRef: % -> REF
-      ++ getRef(f) returns a reference containing the order to which the
-      ++ terms of f have been computed.
-    getStream: % -> ST
-      ++ getStream(f) returns the stream of terms representing the series f.
-    series: ST -> %
-      ++ series(st) creates a series from a stream of non-zero terms,
-      ++ where a term is an exponent-coefficient pair.  The terms in the
-      ++ stream should be ordered by increasing order of exponents.
-    monomial?: % -> B
-      ++ monomial?(f) tests if f is a single monomial.
-    multiplyCoefficients: (I -> Coef,%) -> %
-      ++ multiplyCoefficients(fn,f) returns the series
-      ++ \spad{sum(fn(n) * an * x^n,n = n0..)},
-      ++ where f is the series \spad{sum(an * x^n,n = n0..)}.
-    iExquo: (%,%,B) -> Union(%,"failed")
-      ++ iExquo(f,g,taylor?) is the quotient of the power series f and g.
-      ++ If \spad{taylor?} is \spad{true}, then we must have
-      ++ \spad{order(f) >= order(g)}.
-    taylorQuoByVar: % -> %
-      ++ taylorQuoByVar(a0 + a1 x + a2 x**2 + ...)
-      ++ returns \spad{a1 + a2 x + a3 x**2 + ...}
-    iCompose: (%,%) -> %
-      ++ iCompose(f,g) returns \spad{f(g(x))}.  This is an internal function
-      ++ which should only be called for Taylor series \spad{f(x)} and
-      ++ \spad{g(x)} such that the constant coefficient of \spad{g(x)} is zero.
-    seriesToOutputForm: (ST,REF,Symbol,Coef,RN) -> OutputForm
-      ++ seriesToOutputForm(st,refer,var,cen,r) prints the series
-      ++ \spad{f((var - cen)^r)}.
-    if Coef has Algebra Fraction Integer then
-      integrate: % -> %
-        ++ integrate(f(x)) returns an anti-derivative of the power series
-        ++ \spad{f(x)} with constant coefficient 0.
-        ++ Warning: function does not check for a term of degree -1.
-      cPower: (%,Coef) -> %
-        ++ cPower(f,r) computes \spad{f^r}, where f has constant coefficient 1.
-        ++ For use when the coefficient ring is commutative.
-      cRationalPower: (%,RN) -> %
-        ++ cRationalPower(f,r) computes \spad{f^r}.
-        ++ For use when the coefficient ring is commutative.
-      cExp: % -> %
-        ++ cExp(f) computes the exponential of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cLog: % -> %
-        ++ cLog(f) computes the logarithm of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cSin: % -> %
-        ++ cSin(f) computes the sine of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cCos: % -> %
-        ++ cCos(f) computes the cosine of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cTan: % -> %
-        ++ cTan(f) computes the tangent of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cCot: % -> %
-        ++ cCot(f) computes the cotangent of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cSec: % -> %
-        ++ cSec(f) computes the secant of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cCsc: % -> %
-        ++ cCsc(f) computes the cosecant of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cAsin: % -> %
-        ++ cAsin(f) computes the arcsine of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cAcos: % -> %
-        ++ cAcos(f) computes the arccosine of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cAtan: % -> %
-        ++ cAtan(f) computes the arctangent of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cAcot: % -> %
-        ++ cAcot(f) computes the arccotangent of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cAsec: % -> %
-        ++ cAsec(f) computes the arcsecant of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cAcsc: % -> %
-        ++ cAcsc(f) computes the arccosecant of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cSinh: % -> %
-        ++ cSinh(f) computes the hyperbolic sine of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cCosh: % -> %
-        ++ cCosh(f) computes the hyperbolic cosine of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cTanh: % -> %
-        ++ cTanh(f) computes the hyperbolic tangent of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cCoth: % -> %
-        ++ cCoth(f) computes the hyperbolic cotangent of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cSech: % -> %
-        ++ cSech(f) computes the hyperbolic secant of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cCsch: % -> %
-        ++ cCsch(f) computes the hyperbolic cosecant of the power series f.
-        ++ For use when the coefficient ring is commutative.
-      cAsinh: % -> %
-        ++ cAsinh(f) computes the inverse hyperbolic sine of the power
-        ++ series f.  For use when the coefficient ring is commutative.
-      cAcosh: % -> %
-        ++ cAcosh(f) computes the inverse hyperbolic cosine of the power
-        ++ series f.  For use when the coefficient ring is commutative.
-      cAtanh: % -> %
-        ++ cAtanh(f) computes the inverse hyperbolic tangent of the power
-        ++ series f.  For use when the coefficient ring is commutative.
-      cAcoth: % -> %
-        ++ cAcoth(f) computes the inverse hyperbolic cotangent of the power
-        ++ series f.  For use when the coefficient ring is commutative.
-      cAsech: % -> %
-        ++ cAsech(f) computes the inverse hyperbolic secant of the power
-        ++ series f.  For use when the coefficient ring is commutative.
-      cAcsch: % -> %
-        ++ cAcsch(f) computes the inverse hyperbolic cosecant of the power
-        ++ series f.  For use when the coefficient ring is commutative.
+\end{chunk}
 
-  Implementation ==> add
-    import REF
+\begin{chunk}{COQ ISUPS}
+(* domain ISUPS *)
+(*
 
     Rep := Record(%ord: REF,%str: Stream Term)
     -- when the value of 'ord' is n, this indicates that all non-zero
@@ -80821,11 +96656,15 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
 --% macros
 
     makeTerm(exp,coef) == [exp,coef]
+
     getCoef term == term.c
+
     getExpon term == term.k
 
     makeSeries(refer,x) == [refer,x]
+
     getRef ups == ups.%ord
+
     getStream ups == ups.%str
 
 --% creation and destruction of series
@@ -80840,6 +96679,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
     monomial? ups == (not empty? getStream ups) and (empty? rst getStream ups)
 
     coerce(n:I)    == n :: Coef :: %
+
     coerce(r:Coef) == monomial(r,0)
 
     iSeries(x,refer) ==
@@ -80857,6 +96697,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
     characteristic() == characteristic()$Coef
 
     0 == monomial(0,0)
+
     1 == monomial(1,0)
 
     iExtend(st,n,refer) ==
@@ -80867,6 +96708,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
       st
 
     extend(x,n) == (iExtend(getStream x,n :: COM,getRef x); x)
+
     complete x  == (iExtend(getStream x,plusInfinity(),getRef x); x)
 
     iTruncate0(x,xRefer,refer,minExp,maxExp,n) == delay
@@ -80899,6 +96741,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
       makeSeries(refer,iTruncate0(x,xRefer,refer,minExp,maxExp,degr + 1))
 
     truncate(ups,n) == iTruncate(ups,minusInfinity(),n)
+
     truncate(ups,n1,n2) ==
       if n1 > n2 then (n1,n2) := (n2,n1)
       iTruncate(ups,n1 :: COM,n2)
@@ -80912,6 +96755,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
       0
 
     coefficient(x,n)   == (extend(x,n); iCoefficient(getStream x,n))
+
     elt(x:%,n:Integer) == coefficient(x,n)
 
     iOrder(st,n,refer) ==
@@ -80927,6 +96771,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
       iOrder(lazyEvaluate st,n,refer)
 
     order x    == iOrder(getStream x,plusInfinity(),getRef x)
+
     order(x,n) == iOrder(getStream x,n :: COM,getRef x)
 
     terms x    == getStream x
@@ -80988,8 +96833,11 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
       makeSeries(refer,iMap1(cFcn,eFcn,check?,x,xRefer,refer,degr + 1))
 
     map(fcn,x)                == iMap2((y,n) +-> fcn(y), z +->z,      true, x)
+
     differentiate x           == iMap2((y,n) +-> n*y,    z +-> z - 1, true, x)
+
     multiplyCoefficients(f,x) == iMap2((y,n) +-> f(n)*y, z +-> z,     true, x)
+
     multiplyExponents(x,n)    == iMap2((y,m) +-> y,      z +-> n*z,   false, x)
 
     iPlus1(op,x,xRefer,y,yRefer,refer,n) == delay
@@ -81070,12 +96918,16 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
       makeSeries(refer,iPlus1(op,x,xRefer,y,yRefer,refer,deg + 1))
 
     x + y == iPlus2((xi,yi) +-> xi + yi, x, y)
+
     x - y == iPlus2((xi,yi) +-> xi - yi, x, y)
+
     - y   == iMap2((x,n) +-> -x, z +-> z, false, y)
 
     -- gives correct defaults for I, NNI and PI
     n:I   * x:% == (zero? n => 0; map(z +-> n*z, x))
+
     n:NNI * x:% == (zero? n => 0; map(z +-> n*z, x))
+
     n:PI  * x:% == (zero? n => 0; map(z +-> n*z, x))
 
     productByTerm(coef,expon,x,xRefer,refer,n) ==
@@ -81319,7 +97171,6 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
       iSincos(f,sinc,cosc,sign) ==
         fp := differentiate f
         fpRef := getRef fp; fpStr := getStream fp
---        fp2 := (one? sign => fp; -fp)
         fp2 := ((sign = 1) => fp; -fp)
         fpRef2 := getRef fp2; fpStr2 := getStream fp2
         sinRef := ref(0 :: COM); cosRef := ref(0 :: COM)
@@ -81336,7 +97187,6 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
         one : % := 1; oneStr := getStream one; oneRef := getRef one
         yRef := ref((-1) :: COM)
         yStr : ST :=
---          one? sign => iPlus1(#1 + #2,oneStr,oneRef,sqStr,sqRef,yRef,0)
           (sign = 1) => iPlus1((a,b)+->a+b,oneStr,oneRef,sqStr,sqRef,yRef,0)
           iPlus1((a,b)+->a-b,oneStr,oneRef,sqStr,sqRef,yRef,0)
         intRef := ref((-1) :: COM)
@@ -81387,9 +97237,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
         cc := coefficient(uts,order)
         (ccInv := recip cc) case "failed" => error concat("**: ",NOTINV)
         ccPow :=
---          one? cc => cc
           (cc = 1) => cc
---          one? denom r =>
           (denom r) = 1 =>
             not negative?(num := numer r) => cc ** (num :: NNI)
             (ccInv :: Coef) ** ((-num) :: NNI)
@@ -81407,7 +97255,6 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
       cLog uts ==
         zero?(cc := coefficient(uts,0)) =>
           error "log: constant coefficient should not be 0"
---        one? cc => integrate(differentiate(uts) * (iExquo(1,uts,true) :: %))
         (cc = 1) => integrate(differentiate(uts) * (iExquo(1,uts,true) :: %))
         TRANSFCN =>
           y := iExquo(1,uts,true) :: %
@@ -81421,6 +97268,7 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
         error concat("sincos: ",TRCONST)
 
       cSin uts == sincos(uts).%sin
+
       cCos uts == sincos(uts).%cos
 
       cTan uts ==
@@ -81668,9 +97516,6 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation 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
@@ -81695,11 +97540,6 @@ InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where
       empty? l => (0$Coef) :: OUT
       reduce("+",reverse_! l)
 
-\end{chunk}
-
-\begin{chunk}{COQ ISUPS}
-(* domain ISUPS *)
-(*
 *)
 
 \end{chunk}
@@ -82095,10 +97935,13 @@ InnerTaylorSeries(Coef): Exports == Implementation where
     -- This will be done using the functions 'stream' and 'series'.
 
     stream : % -> Stream Coef
+
     stream x  == x pretend Stream(Coef)
+
     series st == st @ %
 
     0 == coerce(0)$STT
+
     1 == coerce(1)$STT
 
     x = y ==
@@ -82116,12 +97959,19 @@ InnerTaylorSeries(Coef): Exports == Implementation where
     coefficients x == stream x
 
     x + y            == stream(x) +$STT stream(y)
+
     x - y            == stream(x) -$STT stream(y)
+
     (x:%) * (y:%)    == stream(x) *$STT stream(y)
+
     - x              == -$STT (stream x)
+
     (i:I) * (x:%)    == (i::Coef) *$STT stream x
+
     (x:%) * (i:I)    == stream(x) *$STT (i::Coef)
+
     (c:Coef) * (x:%) == c *$STT stream x
+
     (x:%) * (c:Coef) == stream(x) *$STT c
 
     recip x ==
@@ -82139,6 +97989,7 @@ InnerTaylorSeries(Coef): Exports == Implementation where
       expt(x,n :: PositiveInteger)$RepeatedSquaring(%)
 
     characteristic() == characteristic()$Coef
+
     pole? x == false
 
     iOrder: (ST,NNI,NNI) -> NNI
@@ -82162,6 +98013,93 @@ InnerTaylorSeries(Coef): Exports == Implementation where
 \begin{chunk}{COQ ITAYLOR}
 (* domain ITAYLOR *)
 (*
+
+    Rep := Stream Coef
+
+--% declarations
+    x,y: %
+
+--% definitions
+
+    -- In what follows, we will be calling operations on Streams
+    -- which are NOT defined in the package Stream.  Thus, it is
+    -- necessary to explicitly pass back and forth between Rep and %.
+    -- This will be done using the functions 'stream' and 'series'.
+
+    stream : % -> Stream Coef
+
+    stream x  == x pretend Stream(Coef)
+
+    series st == st @ %
+
+    0 == coerce(0)$STT
+
+    1 == coerce(1)$STT
+
+    x = y ==
+      -- tests if two power series are equal
+      -- difference must be a finite stream of zeroes of length <= n + 1,
+      -- where n = $streamCount$Lisp
+      st : ST := stream(x - y)
+      n : I := _$streamCount$Lisp
+      for i in 0..n repeat
+        empty? st => return true
+        frst st ^= 0 => return false
+        st := rst st
+      empty? st
+
+    coefficients x == stream x
+
+    x + y            == stream(x) +$STT stream(y)
+
+    x - y            == stream(x) -$STT stream(y)
+
+    (x:%) * (y:%)    == stream(x) *$STT stream(y)
+
+    - x              == -$STT (stream x)
+
+    (i:I) * (x:%)    == (i::Coef) *$STT stream x
+
+    (x:%) * (i:I)    == stream(x) *$STT (i::Coef)
+
+    (c:Coef) * (x:%) == c *$STT stream x
+
+    (x:%) * (c:Coef) == stream(x) *$STT c
+
+    recip x ==
+      (rec := recip$STT stream x) case "failed" => "failed"
+      series(rec :: ST)
+
+    if Coef has IntegralDomain then
+
+      x exquo y ==
+        (quot := stream(x) exquo$STT stream(y)) case "failed" => "failed"
+        series(quot :: ST)
+
+    x:% ** n:NNI ==
+      n = 0 => 1
+      expt(x,n :: PositiveInteger)$RepeatedSquaring(%)
+
+    characteristic() == characteristic()$Coef
+
+    pole? x == false
+
+    iOrder: (ST,NNI,NNI) -> NNI
+    iOrder(st,n,n0) ==
+      (n = n0) or (empty? st) => n0
+      zero? frst st => iOrder(rst st,n + 1,n0)
+      n
+
+    order(x,n) == iOrder(stream x,0,n)
+
+    iOrder2: (ST,NNI) -> NNI
+    iOrder2(st,n) ==
+      empty? st => error "order: series has infinite order"
+      zero? frst st => iOrder2(rst st,n + 1)
+      n
+
+    order x == iOrder2(stream x,0)
+
 *)
 
 \end{chunk}
@@ -82357,6 +98295,7 @@ InputForm():
       ++ Error: if f was not defined beforehand in the interpreter,
       ++ or if the ti's are not valid types, or if the compiler fails.
  == SExpression add
+
     Rep := SExpression
 
     mkProperOp: Symbol -> %
@@ -82366,8 +98305,11 @@ InputForm():
                                              Record(lst: List %, symb:%)
 
     0                        == convert(0::Integer)
+
     1                        == convert(1::Integer)
+
     convert(x:%):SExpression == x pretend SExpression
+
     convert(x:SExpression):% == x
 
     conv(ll : List %): % ==
@@ -82381,7 +98323,6 @@ InputForm():
 
     convert(x:DoubleFloat):% ==
       zero? x => 0
---      one? x => 1
       (x = 1) => 1
       convert(x)$Rep
 
@@ -82461,7 +98402,6 @@ InputForm():
     s1:% ** n:Integer ==
       s1 = 0 and n > 0 => 0
       s1 = 1 or zero? n => 1
---      one? n => s1
       (n = 1) => s1
       conv [convert("**"::Symbol), s1, convert n]$List(%)
 
@@ -82476,6 +98416,122 @@ InputForm():
 \begin{chunk}{COQ INFORM}
 (* domain INFORM *)
 (*
+
+    Rep := SExpression
+
+    mkProperOp: Symbol -> %
+    strsym    : % -> String
+    tuplify   : List Symbol -> %
+    flatten0  : (%, Symbol, NonNegativeInteger) ->
+                                             Record(lst: List %, symb:%)
+
+    0                        == convert(0::Integer)
+
+    1                        == convert(1::Integer)
+
+    convert(x:%):SExpression == x pretend SExpression
+
+    convert(x:SExpression):% == x
+
+    conv(ll : List %): % ==
+      convert(ll pretend List SExpression)$SExpression pretend %
+
+    lambda(f,l) == conv([convert("+->"::Symbol),tuplify l,f]$List(%))
+
+    interpret x ==
+      v := interpret(x)$Lisp
+      mkObjFn(unwrap(objValFn(v)$Lisp)$Lisp, objModeFn(v)$Lisp)$Lisp
+
+    convert(x:DoubleFloat):% ==
+      zero? x => 0
+      (x = 1) => 1
+      convert(x)$Rep
+
+    flatten s ==
+      -- will not compile if I use 'or'
+      atom? s => s
+      every?(atom?,destruct s)$List(%) => s
+      sy := new()$Symbol
+      n:NonNegativeInteger := 0
+      l2 := [flatten0(x, sy, n := n + 1) for x in rest(l := destruct s)]
+      conv(concat(convert("SEQ"::Symbol)@%,
+        concat(concat [u.lst for u in l2], conv(
+           [convert("exit"::Symbol)@%, 1$%, conv(concat(first l,
+               [u.symb for u in l2]))@%]$List(%))@%)))@%
+
+    flatten0(s, sy, n) ==
+      atom? s => [nil(), s]
+      a := convert(concat(string sy, convert(n)@String)::Symbol)@%
+      l2 := [flatten0(x, sy, n := n+1) for x in rest(l := destruct s)]
+      [concat(concat [u.lst for u in l2], conv([convert(
+        "LET"::Symbol)@%, a, conv(concat(first l,
+             [u.symb for u in l2]))@%]$List(%))@%), a]
+
+    strsym s ==
+      string? s => string s
+      symbol? s => string symbol s
+      error "strsym: form is neither a string or symbol"
+
+    -- given a function this will attempt to recreate the input string
+    unparse x ==
+      atom?(s:% := unparseInputForm(x)$Lisp) => strsym s
+      concat [strsym a for a in destruct s]
+
+    parse(s:String):% ==
+      ncParseFromString(s)$Lisp
+
+    declare signature ==
+      declare(name := new()$Symbol, signature)$Lisp
+      name
+
+    compile(name, types) ==
+      symbol car cdr car
+        selectLocalMms(mkProperOp name, convert(name)@%,
+          types, nil$List(%))$Lisp
+
+    mkProperOp name ==
+      op := mkAtree(nme := convert(name)@%)$Lisp
+      transferPropsToNode(nme, op)$Lisp
+      convert op
+
+    binary(op, args) ==
+      (n := #args) < 2 => error "Need at least 2 arguments"
+      n = 2 => convert([op, first args, last args]$List(%))
+      convert([op, first args, binary(op, rest args)]$List(%))
+
+    tuplify l ==
+      empty? rest l => convert first l
+      conv
+        concat(convert("Tuple"::Symbol), [convert x for x in l]$List(%))
+
+    function(f, l, name) ==
+      nn := convert(new(1 + #l, convert(nil()$List(%)))$List(%))@%
+      conv([convert("DEF"::Symbol), conv(cons(convert(name)@%,
+                        [convert(x)@% for x in l])), nn, nn, f]$List(%))
+
+    s1 + s2 ==
+      s1 = 0 => s2
+      s2 = 0 => s1
+      conv [convert("+"::Symbol), s1, s2]$List(%)
+
+    s1 * s2 ==
+      s1 = 0 or s2 = 0 => 0
+      s1 = 1 => s2
+      s2 = 1 => s1
+      conv [convert("*"::Symbol), s1, s2]$List(%)
+
+    s1:% ** n:Integer ==
+      s1 = 0 and n > 0 => 0
+      s1 = 1 or zero? n => 1
+      (n = 1) => s1
+      conv [convert("**"::Symbol), s1, convert n]$List(%)
+
+    s1:% ** n:NonNegativeInteger == s1 ** (n::Integer)
+
+    s1 / s2 ==
+      s2 = 1 => s1
+      conv [convert("/"::Symbol), s1, s2]$List(%)
+
 *)
 
 \end{chunk}
@@ -83601,6 +99657,246 @@ Integer: Join(IntegerNumberSystem, ConvertibleTo String, OpenMath) with
 \begin{chunk}{COQ INT}
 (* domain INT *)
 (*
+
+      ZP ==> SparseUnivariatePolynomial %
+
+      ZZP ==> SparseUnivariatePolynomial Integer
+
+      x,y: %
+
+      n: NonNegativeInteger
+
+      writeOMInt(dev: OpenMathDevice, x: %): Void ==
+        if x < 0 then
+          OMputApp(dev)
+          OMputSymbol(dev, "arith1", "unary__minus")
+          OMputInteger(dev, (-x) pretend Integer)
+          OMputEndApp(dev)
+        else
+          OMputInteger(dev, x pretend Integer)
+
+      OMwrite(x: %): String ==
+        s: String := ""
+        sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+        dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
+        OMputObject(dev)
+        writeOMInt(dev, x)
+        OMputEndObject(dev)
+        OMclose(dev)
+        s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+        s
+
+      OMwrite(x: %, wholeObj: Boolean): String ==
+        s: String := ""
+        sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+        dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
+        if wholeObj then
+          OMputObject(dev)
+        writeOMInt(dev, x)
+        if wholeObj then
+          OMputEndObject(dev)
+        OMclose(dev)
+        s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+        s
+
+      OMwrite(dev: OpenMathDevice, x: %): Void ==
+        OMputObject(dev)
+        writeOMInt(dev, x)
+        OMputEndObject(dev)
+
+      OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void ==
+        if wholeObj then
+          OMputObject(dev)
+        writeOMInt(dev, x)
+        if wholeObj then
+          OMputEndObject(dev)
+
+      zero? x == 
+        ZEROP(x)$Lisp
+
+      one? x == 
+        x = 1
+
+      0 == 
+        0$Lisp
+
+      1 == 
+        1$Lisp
+
+      base() == 
+        2$Lisp
+
+      copy x == 
+        x
+
+      inc x  == 
+        x + 1
+
+      dec x == 
+        x - 1
+
+      hash x == 
+        SXHASH(x)$Lisp
+
+      negative? x == 
+        MINUSP(x)$Lisp
+
+      coerce(x):OutputForm == 
+        outputForm(x pretend Integer)
+
+      coerce(m:Integer):% == 
+        m pretend %
+
+      convert(x:%):Integer == 
+        x pretend Integer
+
+      length a == 
+        INTEGER_-LENGTH(a)$Lisp
+
+      addmod(a, b, p) ==
+        (c:=a + b) >= p => c - p
+        c
+
+      submod(a, b, p) ==
+        (c:=a - b) < 0 => c + p
+        c
+
+      mulmod(a, b, p) == 
+        (a * b) rem p
+
+      convert(x:%):Float == 
+        coerce(x pretend Integer)$Float
+
+      convert(x:%):DoubleFloat == 
+        coerce(x pretend Integer)$DoubleFloat
+
+      convert(x:%):InputForm == 
+        convert(x pretend Integer)$InputForm
+
+      convert(x:%):String == 
+        string(x pretend Integer)$String
+
+      latex(x:%):String ==
+        s : String := string(x pretend Integer)$String
+        (-1 < (x pretend Integer)) and ((x  pretend Integer) < 10) => s
+        concat("{", concat(s, "}")$String)$String
+
+      positiveRemainder(a, b) ==
+        negative?(r := a rem b) =>
+           negative? b => r - b
+           r + b
+        r
+
+      reducedSystem(m:Matrix %):Matrix(Integer) ==
+        m pretend Matrix(Integer)
+
+      reducedSystem(m:Matrix %, v:Vector %):
+       Record(mat:Matrix(Integer), vec:Vector(Integer)) ==
+        [m pretend Matrix(Integer), vec pretend Vector(Integer)]
+
+      abs(x) == 
+        ABS(x)$Lisp
+
+      random() == 
+        random()$Lisp
+
+      random(x) == 
+        RANDOM(x)$Lisp
+
+      x = y == 
+        EQL(x,y)$Lisp
+
+      x < y == 
+        (x<y)$Lisp
+
+      - x == 
+        (-x)$Lisp
+
+      x + y == 
+        (x+y)$Lisp
+
+      x - y == 
+        (x-y)$Lisp
+
+      x * y == 
+        (x*y)$Lisp
+
+      (m:Integer) * (y:%) == 
+        (m*y)$Lisp -- for subsumption problem
+
+      x ** n == 
+        EXPT(x,n)$Lisp
+
+      odd? x == 
+        ODDP(x)$Lisp
+
+      max(x,y) == 
+        MAX(x,y)$Lisp
+
+      min(x,y) == 
+        MIN(x,y)$Lisp
+
+      divide(x,y) == 
+        DIVIDE2(x,y)$Lisp
+
+      x quo y == 
+        QUOTIENT2(x,y)$Lisp
+
+      x rem y == 
+        REMAINDER2(x,y)$Lisp
+
+      shift(x, y) == 
+        ASH(x,y)$Lisp
+
+      x exquo y ==
+         zero? y => "failed"
+         zero?(x rem y) => x quo y
+         "failed"
+
+      recip(x) == 
+        if (x = 1) or x=-1 then x else "failed"
+
+      gcd(x,y) == 
+        GCD(x,y)$Lisp
+
+      UCA ==> Record(unit:%,canonical:%,associate:%)
+
+      unitNormal x ==
+         x < 0 => [-1,-x,-1]$UCA
+         [1,x,1]$UCA
+
+      unitCanonical x == 
+        abs x
+
+      solveLinearPolynomialEquation(lp:List ZP,p:ZP):Union(List ZP,"failed") ==
+        solveLinearPolynomialEquation(lp pretend List ZZP,
+               p pretend ZZP)$IntegerSolveLinearPolynomialEquation pretend
+                     Union(List ZP,"failed")
+
+      squareFreePolynomial(p:ZP):Factored ZP ==
+        squareFree(p)$UnivariatePolynomialSquareFree(%,ZP)
+
+      factorPolynomial(p:ZP):Factored ZP ==
+         -- GaloisGroupFactorizer doesn't factor the content
+         -- so we have to do this by hand
+         pp:=primitivePart p
+         leadingCoefficient pp = leadingCoefficient p =>
+             factor(p)$GaloisGroupFactorizer(ZP)
+         mergeFactors(factor(pp)$GaloisGroupFactorizer(ZP),
+                        map((x1:%):ZP+->x1::ZP,
+                            factor((leadingCoefficient p exquo
+                                    leadingCoefficient pp)
+                                   ::%))$FactoredFunctions2(%,ZP)
+                                     )$FactoredFunctionUtilities(ZP)
+
+      factorSquareFreePolynomial(p:ZP):Factored ZP ==
+        factorSquareFree(p)$GaloisGroupFactorizer(ZP)
+
+      gcdPolynomial(p:ZP, q:ZP):ZP ==
+        zero? p => unitCanonical q
+        zero? q => unitCanonical p
+        gcd([p,q])$HeuGcd(ZP)
+
 *)
 
 \end{chunk}
@@ -83711,35 +100007,55 @@ o )show IntegerMod
 
 IntegerMod(p:PositiveInteger):
  Join(CommutativeRing, Finite, ConvertibleTo Integer, StepThrough) == add
+
   size()           == p
+
   characteristic() == p
+
   lookup x == (zero? x => p; (convert(x)@Integer) :: PositiveInteger)
 
 -- Code is duplicated for the optimizer to kick in.
+
   if p <= convert(max()$SingleInteger)@Integer then
+
     Rep:= SingleInteger
     q := p::SingleInteger
 
     bloodyCompiler: Integer -> %
+
     bloodyCompiler n == positiveRemainder(n, p)$Integer :: Rep
 
     convert(x:%):Integer == convert(x)$Rep
+
     coerce(x):OutputForm == coerce(x)$Rep
+
     coerce(n:Integer):%  == bloodyCompiler n
+
     0                    == 0$Rep
+
     1                    == 1$Rep
+
     init                 == 0$Rep
+
     nextItem(n)          ==
                               m:=n+1
                               m=0 => "failed"
                               m
+
     x = y                == x =$Rep y
+
     x:% * y:%            == mulmod(x, y, q)
+
     n:Integer * x:%      == mulmod(bloodyCompiler n, x, q)
+
     x + y                == addmod(x, y, q)
+
     x - y                == submod(x, y, q)
+
     random()             == random(q)$Rep
+
     index a              == positiveRemainder(a::%, q)
+
     - x                  == (zero? x => 0; q -$Rep x)
 
     x:% ** n:NonNegativeInteger ==
@@ -83748,36 +100064,50 @@ IntegerMod(p:PositiveInteger):
 
     recip x ==
        (c1, c2, g) := extendedEuclidean(x, q)$Rep
---       not one? g => "failed"
        not (g = 1) => "failed"
        positiveRemainder(c1, q)
 
   else
+
     Rep:= Integer
 
     convert(x:%):Integer == convert(x)$Rep
+
     coerce(n:Integer):%  == positiveRemainder(n::Rep, p)
+
     coerce(x):OutputForm == coerce(x)$Rep
+
     0                    == 0$Rep
+
     1                    == 1$Rep
+
     init                 == 0$Rep
+
     nextItem(n)          ==
                               m:=n+1
                               m=0 => "failed"
                               m
+
     x = y                == x =$Rep y
+
     x:% * y:%            == mulmod(x, y, p)
+
     n:Integer * x:%      == mulmod(positiveRemainder(n::Rep, p), x, p)
+
     x + y                == addmod(x, y, p)
+
     x - y                == submod(x, y, p)
+
     random()             == random(p)$Rep
+
     index a              == positiveRemainder(a::Rep, p)
+
     - x                  == (zero? x => 0; p -$Rep x)
+
     x:% ** n:NonNegativeInteger == powmod(x, n::Rep, p)
 
     recip x ==
        (c1, c2, g) := extendedEuclidean(x, p)$Rep
---       not one? g => "failed"
        not (g = 1) => "failed"
        positiveRemainder(c1, p)
 
@@ -83786,6 +100116,111 @@ IntegerMod(p:PositiveInteger):
 \begin{chunk}{COQ ZMOD}
 (* domain ZMOD *)
 (*
+ Join(CommutativeRing, Finite, ConvertibleTo Integer, StepThrough) == add
+
+  size()           == p
+
+  characteristic() == p
+
+  lookup x == (zero? x => p; (convert(x)@Integer) :: PositiveInteger)
+
+-- Code is duplicated for the optimizer to kick in.
+
+  if p <= convert(max()$SingleInteger)@Integer then
+
+    Rep:= SingleInteger
+    q := p::SingleInteger
+
+    bloodyCompiler: Integer -> %
+
+    bloodyCompiler n == positiveRemainder(n, p)$Integer :: Rep
+
+    convert(x:%):Integer == convert(x)$Rep
+
+    coerce(x):OutputForm == coerce(x)$Rep
+
+    coerce(n:Integer):%  == bloodyCompiler n
+
+    0                    == 0$Rep
+
+    1                    == 1$Rep
+
+    init                 == 0$Rep
+
+    nextItem(n)          ==
+                              m:=n+1
+                              m=0 => "failed"
+                              m
+
+    x = y                == x =$Rep y
+
+    x:% * y:%            == mulmod(x, y, q)
+
+    n:Integer * x:%      == mulmod(bloodyCompiler n, x, q)
+
+    x + y                == addmod(x, y, q)
+
+    x - y                == submod(x, y, q)
+
+    random()             == random(q)$Rep
+
+    index a              == positiveRemainder(a::%, q)
+
+    - x                  == (zero? x => 0; q -$Rep x)
+
+    x:% ** n:NonNegativeInteger ==
+      n < p => powmod(x, n::Rep, q)
+      powmod(convert(x)@Integer, n, p)$Integer :: Rep
+
+    recip x ==
+       (c1, c2, g) := extendedEuclidean(x, q)$Rep
+       not (g = 1) => "failed"
+       positiveRemainder(c1, q)
+
+  else
+
+    Rep:= Integer
+
+    convert(x:%):Integer == convert(x)$Rep
+
+    coerce(n:Integer):%  == positiveRemainder(n::Rep, p)
+
+    coerce(x):OutputForm == coerce(x)$Rep
+
+    0                    == 0$Rep
+
+    1                    == 1$Rep
+
+    init                 == 0$Rep
+
+    nextItem(n)          ==
+                              m:=n+1
+                              m=0 => "failed"
+                              m
+
+    x = y                == x =$Rep y
+
+    x:% * y:%            == mulmod(x, y, p)
+
+    n:Integer * x:%      == mulmod(positiveRemainder(n::Rep, p), x, p)
+
+    x + y                == addmod(x, y, p)
+
+    x - y                == submod(x, y, p)
+
+    random()             == random(p)$Rep
+
+    index a              == positiveRemainder(a::Rep, p)
+
+    - x                  == (zero? x => 0; p -$Rep x)
+
+    x:% ** n:NonNegativeInteger == powmod(x, n::Rep, p)
+
+    recip x ==
+       (c1, c2, g) := extendedEuclidean(x, p)$Rep
+       not (g = 1) => "failed"
+       positiveRemainder(c1, p)
+
 *)
 
 \end{chunk}
@@ -83959,6 +100394,37 @@ IntegrationFunctionsTable(): E == I where
 \begin{chunk}{COQ INTFTBL}
 (* domain INTFTBL *)
 (*
+
+    Rep := Table(NIA,ATT)
+    import Rep
+
+    theFTable:$ := empty()$Rep
+
+    showTheFTable():$ ==
+      theFTable
+
+    clearTheFTable():Void ==
+      theFTable := empty()$Rep
+      void()$Void
+
+    fTable(l:List Record(key:NIA,entry:ATT)):$ ==
+      theFTable := table(l)$Rep
+
+    insert!(r:Record(key:NIA,entry:ATT)):$ ==
+      insert!(r,theFTable)$Rep
+
+    keys(t:$):List NIA ==
+      keys(t)$Rep
+
+    showAttributes(k:NIA):Union(ATT,"failed") ==
+      search(k,theFTable)$Rep
+
+    entries(t:$):List Record(key:NIA,entry:ATT) ==
+      members(t)$Rep
+
+    entry(k:NIA):ATT ==
+      qelt(theFTable,k)$Rep
+
 *)
 
 \end{chunk}
@@ -84104,7 +100570,7 @@ IntegrationResult(F:Field): Exports == Implementation where
     integral: (F, F) -> %
       ++ integral(f,x) returns the formal integral of f with respect to x
     differentiate: (%, F -> F) -> F
-      ++ differentiate(ir,D) differentiates ir with respect to the derivation D.
+      ++ differentiate(ir,D) differentiates ir with respect to the derivation D
     if F has PartialDifferentialRing(SE) then
       differentiate: (%, Symbol) -> F
         ++ differentiate(ir,x) differentiates ir with respect to x
@@ -84113,6 +100579,7 @@ IntegrationResult(F:Field): Exports == Implementation where
         ++ integral(f,x) returns the formal integral of f with respect to x
 
   Implementation ==> add
+
     Rep := Record(ratp: F, logp: List LOG, nelem: List NE)
 
     timelog : (Q, LOG) -> LOG
@@ -84125,29 +100592,40 @@ IntegrationResult(F:Field): Exports == Implementation where
     pLogDeriv: (LOG, F -> F) -> F
     pNeDeriv : (NE,  F -> F) -> F
 
-
     alpha:O := new()$Symbol :: O
 
     - u               == (-1$Z) * u
+
     0                 == mkAnswer(0, empty(), empty())
+
     coerce(x:F):%     == mkAnswer(x, empty(), empty())
+
     ratpart u         == u.ratp
+
     logpart u         == u.logp
+
     notelem u         == u.nelem
+
     elem? u           == empty? notelem u
+
     mkAnswer(x, l, n) == [x, l, nesimp n]
+
     timelog(r, lg)    == [r * lg.scalar, lg.coeff, lg.logand]
+
     integral(f:F,x:F) == (zero? f => 0; mkAnswer(0, empty(), [[f, x]]))
+
     timene(r, ne)     == [Q2F(r) * ne.integrand, ne.intvar]
+
     n:Z * u:%         == (n::Q) * u
+
     Q2F r             == numer(r)::F / denom(r)::F
+
     neselect(l, x)    == _+/[ne.integrand for ne in l | ne.intvar = x]
 
     if F has RetractableTo Symbol then
       integral(f:F, x:Symbol):% == integral(f, x::F)
 
     LOG2O rec ==
---      one? degree rec.coeff =>
       (degree rec.coeff) = 1 =>
         -- deg 1 minimal poly doesn't get sigma
         lastc := - coefficient(rec.coeff, 0) / coefficient(rec.coeff, 1)
@@ -84167,7 +100645,9 @@ IntegrationResult(F:Field): Exports == Implementation where
       [[u,x] for x in removeDuplicates_!([ne.intvar for ne in l]$List(F))
                                            | (u := neselect(l, x)) ^= 0]
 
-    if (F has LiouvillianFunctionCategory) and (F has RetractableTo Symbol) then
+    if (F has LiouvillianFunctionCategory) _
+     and (F has RetractableTo Symbol) then
+
       retractIfCan u ==
         empty? logpart u =>
           ratpart u +
@@ -84176,6 +100656,7 @@ IntegrationResult(F:Field): Exports == Implementation where
         "failed"
 
     else
+
       retractIfCan u ==
         elem? u and empty? logpart u => ratpart u
         "failed"
@@ -84200,7 +100681,6 @@ IntegrationResult(F:Field): Exports == Implementation where
                + _+/[pNeDeriv(ne, derivation) for ne in notelem u]
 
     pNeDeriv(ne, derivation) ==
---      one? derivation(ne.intvar) => ne.integrand
       (derivation(ne.intvar) = 1) => ne.integrand
       zero? derivation(ne.integrand) => 0
       error "pNeDeriv: cannot differentiate not elementary part into F"
@@ -84208,7 +100688,6 @@ IntegrationResult(F:Field): Exports == Implementation where
     pLogDeriv(log, derivation) ==
       map(derivation, log.coeff) ^= 0 =>
         error "pLogDeriv: can only handle logs with constant coefficients"
---      one?(n := degree(log.coeff)) =>
       ((n := degree(log.coeff)) = 1) =>
         c   := - (leadingCoefficient reductum log.coeff)
                                         / (leadingCoefficient log.coeff)
@@ -84240,6 +100719,141 @@ IntegrationResult(F:Field): Exports == Implementation where
 \begin{chunk}{COQ IR}
 (* domain IR *)
 (*
+
+    Rep := Record(ratp: F, logp: List LOG, nelem: List NE)
+
+    timelog : (Q, LOG) -> LOG
+    timene  : (Q, NE)  -> NE
+    LOG2O   : LOG      -> O
+    NE2O    : NE       -> O
+    Q2F     : Q        -> F
+    nesimp  : List NE  -> List NE
+    neselect: (List NE, F) -> F
+    pLogDeriv: (LOG, F -> F) -> F
+    pNeDeriv : (NE,  F -> F) -> F
+
+    alpha:O := new()$Symbol :: O
+
+    - u               == (-1$Z) * u
+
+    0                 == mkAnswer(0, empty(), empty())
+
+    coerce(x:F):%     == mkAnswer(x, empty(), empty())
+
+    ratpart u         == u.ratp
+
+    logpart u         == u.logp
+
+    notelem u         == u.nelem
+
+    elem? u           == empty? notelem u
+
+    mkAnswer(x, l, n) == [x, l, nesimp n]
+
+    timelog(r, lg)    == [r * lg.scalar, lg.coeff, lg.logand]
+
+    integral(f:F,x:F) == (zero? f => 0; mkAnswer(0, empty(), [[f, x]]))
+
+    timene(r, ne)     == [Q2F(r) * ne.integrand, ne.intvar]
+
+    n:Z * u:%         == (n::Q) * u
+
+    Q2F r             == numer(r)::F / denom(r)::F
+
+    neselect(l, x)    == _+/[ne.integrand for ne in l | ne.intvar = x]
+
+    if F has RetractableTo Symbol then
+      integral(f:F, x:Symbol):% == integral(f, x::F)
+
+    LOG2O rec ==
+      (degree rec.coeff) = 1 =>
+        -- deg 1 minimal poly doesn't get sigma
+        lastc := - coefficient(rec.coeff, 0) / coefficient(rec.coeff, 1)
+        lg    := (rec.logand) lastc
+        logandp := prefix("log"::Symbol::O, [lg::O])
+        (cc := Q2F(rec.scalar) * lastc) = 1 => logandp
+        cc = -1 => - logandp
+        cc::O * logandp
+      coeffp:O := (outputForm(rec.coeff, alpha) = 0::Z::O)@O
+      logandp :=
+           alpha * prefix("log"::Symbol::O, [outputForm(rec.logand, alpha)])
+      if (cc := Q2F(rec.scalar)) ^= 1 then
+        logandp := cc::O * logandp
+      sum(logandp, coeffp)
+
+    nesimp l ==
+      [[u,x] for x in removeDuplicates_!([ne.intvar for ne in l]$List(F))
+                                           | (u := neselect(l, x)) ^= 0]
+
+    if (F has LiouvillianFunctionCategory) _
+     and (F has RetractableTo Symbol) then
+
+      retractIfCan u ==
+        empty? logpart u =>
+          ratpart u +
+             _+/[integral(ne.integrand, retract(ne.intvar)@Symbol)$F
+                for ne in notelem u]
+        "failed"
+
+    else
+
+      retractIfCan u ==
+        elem? u and empty? logpart u => ratpart u
+        "failed"
+
+    r:Q * u:% ==
+      r = 0 => 0
+      mkAnswer(Q2F(r) * ratpart u, map(x1+->timelog(r, x1), logpart u),
+                                       map(x2+->timene(r, x2), notelem u))
+
+    -- Initial attempt, quick and dirty, no simplification
+    u + v ==
+      mkAnswer(ratpart u + ratpart v, concat(logpart u, logpart v),
+                                    nesimp concat(notelem u, notelem v))
+
+    if F has PartialDifferentialRing(Symbol) then
+      differentiate(u:%, x:Symbol):F == 
+        differentiate(u, x1+->differentiate(x1, x))
+
+    differentiate(u:%, derivation:F -> F):F ==
+      derivation ratpart u +
+          _+/[pLogDeriv(log, derivation) for log in logpart u]
+               + _+/[pNeDeriv(ne, derivation) for ne in notelem u]
+
+    pNeDeriv(ne, derivation) ==
+      (derivation(ne.intvar) = 1) => ne.integrand
+      zero? derivation(ne.integrand) => 0
+      error "pNeDeriv: cannot differentiate not elementary part into F"
+
+    pLogDeriv(log, derivation) ==
+      map(derivation, log.coeff) ^= 0 =>
+        error "pLogDeriv: can only handle logs with constant coefficients"
+      ((n := degree(log.coeff)) = 1) =>
+        c   := - (leadingCoefficient reductum log.coeff)
+                                        / (leadingCoefficient log.coeff)
+        ans := (log.logand) c
+        Q2F(log.scalar) * c * derivation(ans) / ans
+      numlog := map(derivation, log.logand)
+      diflog := extendedEuclidean(log.logand, log.coeff,
+                                    numlog)::Record(coef1:UP, coef2:UP)
+      algans := diflog.coef1
+      ans:F := 0
+      for i in 0..(n-1) repeat
+        algans := algans * monomial(1, 1) rem log.coeff
+        ans := ans + coefficient(algans, i)
+      Q2F(log.scalar) * ans
+
+    coerce(u:%):O ==
+      (r := retractIfCan u) case F => r::F::O
+      l := reverse_! [LOG2O f for f in logpart u]$List(O)
+      if ratpart u ^= 0 then l := concat(ratpart(u)::O, l)
+      if not elem? u then l := concat([NE2O f for f in notelem u], l)
+      null l => 0::O
+      reduce("+", l)
+
+    NE2O ne ==
+      int((ne.integrand)::O * hconcat ["d"::Symbol::O, (ne.intvar)::O])
+
 *)
 
 \end{chunk}
@@ -84560,10 +101174,420 @@ contains?(t3,0.3)
 ++ This domain is an implementation of interval arithmetic and transcendental
 ++ functions over intervals.
 
-Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCategory(R) == add 
+Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)):_
+ IntervalCategory(R) == add 
+
+  import Integer
+
+  Rep := Record(Inf:R, Sup:R)
+
+  roundDown(u:R):R == 
+    if zero?(u) then float(-1,-(bits()@Integer))
+                else float(mantissa(u) - 1,exponent(u))
+
+  roundUp(u:R):R   == 
+    if zero?(u) then float(1, -(bits())@Integer)
+                else float(mantissa(u) + 1,exponent(u))
+
+  -- Sometimes the float representation does not use all the bits (e.g. when
+  -- representing an integer in software using arbitrary-length Integers as
+  -- your mantissa it is convenient to keep them exact).  This function 
+  -- normalises things so that rounding etc. works as expected.  It is only
+  -- called when creating new intervals.
+  normaliseFloat(u:R):R == 
+    zero? u => u
+    m : Integer := mantissa u
+    b : Integer := bits()@Integer
+    l : Integer := length(m)
+    if l < b then 
+      BASE : Integer := base()$R@Integer
+      float(m*BASE**((b-l) pretend PositiveInteger),exponent(u)-b+l)
+    else
+      u
+
+  interval(i:R,s:R):% == 
+    i > s =>  [roundDown normaliseFloat s,roundUp normaliseFloat i]
+    [roundDown normaliseFloat i,roundUp normaliseFloat s]
+
+  interval(f:R):% ==  
+    zero?(f) => 0
+    one?(f)  => 1
+    -- This next part is necessary to allow e.g. mapping between Expressions:
+    -- AXIOM assumes that Integers stay as Integers!
+    -- import from Union(value1:Integer,failed:"failed")
+    fnew : R := normaliseFloat f
+    retractIfCan(f)@Union(Integer,"failed") case "failed" =>
+      [roundDown fnew, roundUp fnew]
+    [fnew,fnew]
+
+  qinterval(i:R,s:R):% ==
+    [roundDown normaliseFloat i,roundUp normaliseFloat s]
+
+  exactInterval(i:R,s:R):% == [i,s]
+
+  exactSupInterval(i:R,s:R):% == [roundDown i,s]
+
+  exactInfInterval(i:R,s:R):% == [i,roundUp s]
+
+  inf(u:%):R == u.Inf
+
+  sup(u:%):R == u.Sup
+
+  width(u:%):R == u.Sup - u.Inf
+
+  contains?(u:%,f:R):Boolean == (f > inf(u)) and (f < sup(u))
+
+  positive?(u:%):Boolean == inf(u) > 0
+
+  negative?(u:%):Boolean == sup(u) < 0
+
+  _< (a:%,b:%):Boolean ==
+    if inf(a) < inf(b) then
+      true
+    else if inf(a) > inf(b) then
+      false
+    else
+      sup(a) < sup(b)
+
+  _+ (a:%,b:%):% == 
+    -- A couple of blatent hacks to preserve the Ring Axioms!
+    if zero?(a) then return(b) else if zero?(b) then return(a)
+    if a = b then return qinterval(2*inf(a),2*sup(a))
+    qinterval(inf(a) + inf(b), sup(a) + sup(b))
+
+
+  _- (a:%,b:%):% ==  
+    if zero?(a) then return(-b) else if zero?(b) then return(a)
+    if a = b then 0 else qinterval(inf(a) - sup(b), sup(a) - inf(b))
+
+
+  _* (a:%,b:%):% == 
+    -- A couple of blatent hacks to preserve the Ring Axioms!
+    if one?(a) then return(b) else if one?(b) then return(a)
+    if zero?(a) then return(0) else if zero?(b) then return(0)
+    prods : List R :=  sort [inf(a)*inf(b),sup(a)*sup(b),
+                             inf(a)*sup(b),sup(a)*inf(b)]
+    qinterval(first prods, last prods)
+
+  _* (a:Integer,b:%):% == 
+    if (a > 0) then 
+      qinterval(a*inf(b),a*sup(b))
+    else if (a < 0) then
+      qinterval(a*sup(b),a*inf(b))
+    else
+      0
+
+  _* (a:PositiveInteger,b:%):% == qinterval(a*inf(b),a*sup(b))
+
+  _*_* (a:%,n:PositiveInteger):% == 
+    contains?(a,0) and zero?((n@Integer) rem 2) =>
+      interval(0,max(inf(a)**n,sup(a)**n)) 
+    interval(inf(a)**n,sup(a)**n)
+
+  _^ (a:%,n:PositiveInteger):% ==  
+    contains?(a,0) and zero?((n@Integer) rem 2) => 
+      interval(0,max(inf(a)**n,sup(a)**n))
+    interval(inf(a)**n,sup(a)**n)
+
+  _- (a:%):% == exactInterval(-sup(a),-inf(a))
+
+  _= (a:%,b:%):Boolean == (inf(a)=inf(b)) and (sup(a)=sup(b))
+
+  _~_= (a:%,b:%):Boolean == (inf(a)~=inf(b)) or (sup(a)~=sup(b))
+
+  1 == 
+    one : R := normaliseFloat 1
+    [one,one]
+
+  0 == [0,0]
+
+  recip(u:%):Union(%,"failed") == 
+   contains?(u,0) => "failed"
+   vals:List R := sort [1/inf(u),1/sup(u)]$List(R)
+   qinterval(first vals, last vals)
+
+  unit?(u:%):Boolean == contains?(u,0)
+
+  _exquo(u:%,v:%):Union(%,"failed") ==
+   contains?(v,0) => "failed"
+   one?(v) => u
+   u=v => 1
+   u=-v => -1
+   vals:List R := _
+     sort [inf(u)/inf(v),inf(u)/sup(v),sup(u)/inf(v),sup(u)/sup(v)]$List(R)
+   qinterval(first vals, last vals)
+
+  gcd(u:%,v:%):% == 1
+
+  coerce(u:Integer):% ==
+    ur := normaliseFloat(u::R)
+    exactInterval(ur,ur)
+
+
+  interval(u:Fraction Integer):% == 
+    flt := u::R
+
+    -- Test if the representation in R is exact
+    --den := denom(u)::Float
+    bin : Union(Integer,"failed") := retractIfCan(log2(denom(u)::Float))
+    bin case Integer and length(numer u)$Integer < (bits()@Integer) => 
+      flt := normaliseFloat flt
+      exactInterval(flt,flt)
+
+    qinterval(flt,flt)
+
+  retractIfCan(u:%):Union(Integer,"failed") == 
+    not zero? width(u) => "failed"
+    retractIfCan inf u
+  
+  retract(u:%):Integer == 
+    not zero? width(u) =>
+      error "attempt to retract a non-Integer interval to an Integer"
+    retract inf u
+  
+  coerce(u:%):OutputForm ==
+    bracket([coerce inf(u), coerce sup(u)]$List(OutputForm))
+
+  characteristic():NonNegativeInteger == 0
+
+  -- Explicit export from TranscendentalFunctionCategory
+  pi():% == qinterval(pi(),pi())
+
+  -- From ElementaryFunctionCategory
+  log(u:%):% == 
+    positive?(u) => qinterval(log inf u, log sup u)
+    error "negative logs in interval"
+
+  exp(u:%):% == qinterval(exp inf u, exp sup u)
+
+  _*_* (u:%,v:%):% == 
+    zero?(v) => if zero?(u) then error "0**0 is undefined" else 1
+    one?(u)  => 1
+    expts : List R :=  sort [inf(u)**inf(v),sup(u)**sup(v),
+                             inf(u)**sup(v),sup(u)**inf(v)]
+    qinterval(first expts, last expts)
+
+  -- From TrigonometricFunctionCategory
+
+  -- This function checks whether an interval contains a value of the form
+  -- `offset + 2 n pi'.
+  hasTwoPiMultiple(offset:R,ipi:R,i:%):Boolean == 
+    next : Integer := retract ceiling( (inf(i) - offset)/(2*ipi) )
+    contains?(i,offset+2*next*ipi)
+
+  -- This function checks whether an interval contains a value of the form
+  -- `offset + n pi'.
+  hasPiMultiple(offset:R,ipi:R,i:%):Boolean == 
+    next : Integer := retract ceiling( (inf(i) - offset)/ipi )
+    contains?(i,offset+next*ipi)
+
+  sin(u:%):% == 
+    ipi : R := pi()$R
+    hasOne? : Boolean := hasTwoPiMultiple(ipi/(2::R),ipi,u)
+    hasMinusOne? : Boolean := hasTwoPiMultiple(3*ipi/(2::R),ipi,u)
+
+    if hasOne? and hasMinusOne? then 
+      exactInterval(-1,1)
+    else 
+      vals : List R := sort [sin inf u, sin sup u]
+      if hasOne? then
+        exactSupInterval(first vals, 1)
+      else if hasMinusOne? then
+        exactInfInterval(-1,last vals)
+      else
+        qinterval(first vals, last vals)
+    
+  cos(u:%):% == 
+    ipi : R := pi()
+    hasOne? : Boolean := hasTwoPiMultiple(0,ipi,u)
+    hasMinusOne? : Boolean := hasTwoPiMultiple(ipi,ipi,u)
+
+    if hasOne? and hasMinusOne? then 
+      exactInterval(-1,1)
+    else 
+      vals : List R := sort [cos inf u, cos sup u]
+      if hasOne? then
+        exactSupInterval(first vals, 1)
+      else if hasMinusOne? then
+        exactInfInterval(-1,last vals)
+      else
+        qinterval(first vals, last vals)
+    
+  tan(u:%):% == 
+    ipi : R := pi()
+    if width(u) > ipi then
+      error "Interval contains a singularity"
+    else 
+      -- Since we know the interval is less than pi wide, monotonicity implies
+      -- that there is no singularity.  If there is a singularity on a endpoint
+      -- of the interval the user will see the error generated by R.
+      lo : R := tan inf u 
+      hi : R := tan sup u
+
+      lo > hi => error "Interval contains a singularity"
+      qinterval(lo,hi)
+    
+  csc(u:%):% == 
+    ipi : R := pi()
+    if width(u) > ipi then
+      error "Interval contains a singularity"
+    else 
+      -- import from Integer
+      -- singularities are at multiples of Pi
+      if hasPiMultiple(0,ipi,u) then error "Interval contains a singularity"
+      vals : List R := sort [csc inf u, csc sup u]
+      if hasTwoPiMultiple(ipi/(2::R),ipi,u) then 
+        exactInfInterval(1,last vals)
+      else if hasTwoPiMultiple(3*ipi/(2::R),ipi,u) then
+        exactSupInterval(first vals,-1)
+      else
+        qinterval(first vals, last vals)
+    
+  sec(u:%):% == 
+    ipi : R := pi()
+    if width(u) > ipi then
+      error "Interval contains a singularity"
+    else 
+      -- import from Integer
+      -- singularities are at Pi/2 + n Pi
+      if hasPiMultiple(ipi/(2::R),ipi,u) then
+        error "Interval contains a singularity"
+      vals : List R := sort [sec inf u, sec sup u]
+      if hasTwoPiMultiple(0,ipi,u) then 
+        exactInfInterval(1,last vals)
+      else if hasTwoPiMultiple(ipi,ipi,u) then
+        exactSupInterval(first vals,-1)
+      else
+        qinterval(first vals, last vals)
+    
+  cot(u:%):% == 
+    ipi : R := pi()
+    if width(u) > ipi then
+      error "Interval contains a singularity"
+    else 
+      -- Since we know the interval is less than pi wide, monotonicity implies
+      -- that there is no singularity.  If there is a singularity on a endpoint
+      -- of the interval the user will see the error generated by R.
+      hi : R := cot inf u 
+      lo : R := cot sup u
+
+      lo > hi => error "Interval contains a singularity"
+      qinterval(lo,hi)
+    
+  -- From ArcTrigonometricFunctionCategory
+
+  asin(u:%):% == 
+    lo : R := inf(u)
+    hi : R := sup(u)
+    if (lo < -1) or (hi > 1) then error "asin only defined on the region -1..1"
+    qinterval(asin lo,asin hi)
+  
+
+  acos(u:%):% == 
+    lo : R := inf(u)
+    hi : R := sup(u)
+    if (lo < -1) or (hi > 1) then error "acos only defined on the region -1..1"
+    qinterval(acos hi,acos lo)
+  
+
+  atan(u:%):% == qinterval(atan inf u, atan sup u)
+
+  acot(u:%):% == qinterval(acot sup u, acot inf u)
+
+  acsc(u:%):% == 
+    lo : R := inf(u)
+    hi : R := sup(u)
+    if ((lo <= -1) and (hi >= -1)) or ((lo <= 1) and (hi >= 1)) then
+      error "acsc not defined on the region -1..1"
+    qinterval(acsc hi, acsc lo)
+  
+
+  asec(u:%):% == 
+    lo : R := inf(u)
+    hi : R := sup(u)
+    if ((lo < -1) and (hi > -1)) or ((lo < 1) and (hi > 1)) then
+      error "asec not defined on the region -1..1"
+    qinterval(asec lo, asec hi)
+  
+
+  -- From HyperbolicFunctionCategory
+
+  tanh(u:%):% == qinterval(tanh inf u, tanh sup u)
+
+  sinh(u:%):% == qinterval(sinh inf u, sinh sup u)
+
+  sech(u:%):% == 
+    negative? u => qinterval(sech inf u, sech sup u)
+    positive? u => qinterval(sech sup u, sech inf u)
+    vals : List R := sort [sech inf u, sech sup u]
+    exactSupInterval(first vals,1)
+  
+
+  cosh(u:%):% == 
+    negative? u => qinterval(cosh sup u, cosh inf u)
+    positive? u => qinterval(cosh inf u, cosh sup u)
+    vals : List R := sort [cosh inf u, cosh sup u]
+    exactInfInterval(1,last vals)
+  
+
+  csch(u:%):% == 
+    contains?(u,0) => error "csch: singularity at zero"
+    qinterval(csch sup u, csch inf u)
+  
+
+  coth(u:%):% == 
+    contains?(u,0) => error "coth: singularity at zero"
+    qinterval(coth sup u, coth inf u)
+  
+
+  -- From ArcHyperbolicFunctionCategory
+
+  acosh(u:%):% == 
+    inf(u)<1 => error "invalid argument: acosh only defined on the region 1.."
+    qinterval(acosh inf u, acosh sup u)
+  
+
+  acoth(u:%):% == 
+    lo : R := inf(u)
+    hi : R := sup(u)
+    if ((lo <= -1) and (hi >= -1)) or ((lo <= 1) and (hi >= 1)) then
+      error "acoth not defined on the region -1..1"
+    qinterval(acoth hi, acoth lo)
+  
+
+  acsch(u:%):% == 
+    contains?(u,0) => error "acsch: singularity at zero"
+    qinterval(acsch sup u, acsch inf u)
+  
+
+  asech(u:%):% == 
+    lo : R := inf(u)
+    hi : R := sup(u)
+    if  (lo <= 0) or (hi > 1) then 
+      error "asech only defined on the region 0 < x <= 1"
+    qinterval(asech hi, asech lo)
+  
+
+  asinh(u:%):% == qinterval(asinh inf u, asinh sup u)
+
+  atanh(u:%):% == 
+    lo : R := inf(u)
+    hi : R := sup(u)
+    if  (lo <= -1) or (hi >= 1) then 
+      error "atanh only defined on the region -1 < x < 1"
+    qinterval(atanh lo, atanh hi)
+  
+
+  -- From RadicalCategory
+  _*_* (u:%,n:Fraction Integer):% == interval(inf(u)**n,sup(u)**n)
+  
+\end{chunk}
+
+\begin{chunk}{COQ INTRVL}
+(* domain INTRVL *)
+(*
 
   import Integer
---  import from R
 
   Rep := Record(Inf:R, Sup:R)
 
@@ -84600,7 +101624,7 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
     one?(f)  => 1
     -- This next part is necessary to allow e.g. mapping between Expressions:
     -- AXIOM assumes that Integers stay as Integers!
---    import from Union(value1:Integer,failed:"failed")
+    -- import from Union(value1:Integer,failed:"failed")
     fnew : R := normaliseFloat f
     retractIfCan(f)@Union(Integer,"failed") case "failed" =>
       [roundDown fnew, roundUp fnew]
@@ -84610,16 +101634,21 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
     [roundDown normaliseFloat i,roundUp normaliseFloat s]
 
   exactInterval(i:R,s:R):% == [i,s]
+
   exactSupInterval(i:R,s:R):% == [roundDown i,s]
+
   exactInfInterval(i:R,s:R):% == [i,roundUp s]
 
   inf(u:%):R == u.Inf
+
   sup(u:%):R == u.Sup
+
   width(u:%):R == u.Sup - u.Inf
 
   contains?(u:%,f:R):Boolean == (f > inf(u)) and (f < sup(u))
 
   positive?(u:%):Boolean == inf(u) > 0
+
   negative?(u:%):Boolean == sup(u) < 0
 
   _< (a:%,b:%):Boolean ==
@@ -84650,7 +101679,6 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
                              inf(a)*sup(b),sup(a)*inf(b)]
     qinterval(first prods, last prods)
 
-
   _* (a:Integer,b:%):% == 
     if (a > 0) then 
       qinterval(a*inf(b),a*sup(b))
@@ -84666,7 +101694,6 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
       interval(0,max(inf(a)**n,sup(a)**n)) 
     interval(inf(a)**n,sup(a)**n)
 
-
   _^ (a:%,n:PositiveInteger):% ==  
     contains?(a,0) and zero?((n@Integer) rem 2) => 
       interval(0,max(inf(a)**n,sup(a)**n))
@@ -84675,6 +101702,7 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
   _- (a:%):% == exactInterval(-sup(a),-inf(a))
 
   _= (a:%,b:%):Boolean == (inf(a)=inf(b)) and (sup(a)=sup(b))
+
   _~_= (a:%,b:%):Boolean == (inf(a)~=inf(b)) or (sup(a)~=sup(b))
 
   1 == 
@@ -84688,7 +101716,6 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
    vals:List R := sort [1/inf(u),1/sup(u)]$List(R)
    qinterval(first vals, last vals)
 
-
   unit?(u:%):Boolean == contains?(u,0)
 
   _exquo(u:%,v:%):Union(%,"failed") ==
@@ -84696,10 +101723,10 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
    one?(v) => u
    u=v => 1
    u=-v => -1
-   vals:List R := sort [inf(u)/inf(v),inf(u)/sup(v),sup(u)/inf(v),sup(u)/sup(v)]$List(R)
+   vals:List R := _
+     sort [inf(u)/inf(v),inf(u)/sup(v),sup(u)/inf(v),sup(u)/sup(v)]$List(R)
    qinterval(first vals, last vals)
 
-
   gcd(u:%,v:%):% == 1
 
   coerce(u:Integer):% ==
@@ -84708,10 +101735,6 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
 
 
   interval(u:Fraction Integer):% == 
---    import   log2 : % -> %
---             coerce : Integer -> %
---             retractIfCan : % -> Union(value1:Integer,failed:"failed")
---    from Float
     flt := u::R
 
     -- Test if the representation in R is exact
@@ -84723,24 +101746,20 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
 
     qinterval(flt,flt)
 
-
   retractIfCan(u:%):Union(Integer,"failed") == 
     not zero? width(u) => "failed"
     retractIfCan inf u
   
-
   retract(u:%):Integer == 
     not zero? width(u) =>
       error "attempt to retract a non-Integer interval to an Integer"
     retract inf u
   
-
   coerce(u:%):OutputForm ==
     bracket([coerce inf(u), coerce sup(u)]$List(OutputForm))
 
   characteristic():NonNegativeInteger == 0
 
-
   -- Explicit export from TranscendentalFunctionCategory
   pi():% == qinterval(pi(),pi())
 
@@ -84748,7 +101767,6 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
   log(u:%):% == 
     positive?(u) => qinterval(log inf u, log sup u)
     error "negative logs in interval"
-  
 
   exp(u:%):% == qinterval(exp inf u, exp sup u)
 
@@ -84766,14 +101784,12 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
   hasTwoPiMultiple(offset:R,ipi:R,i:%):Boolean == 
     next : Integer := retract ceiling( (inf(i) - offset)/(2*ipi) )
     contains?(i,offset+2*next*ipi)
-  
 
   -- This function checks whether an interval contains a value of the form
   -- `offset + n pi'.
   hasPiMultiple(offset:R,ipi:R,i:%):Boolean == 
     next : Integer := retract ceiling( (inf(i) - offset)/ipi )
     contains?(i,offset+next*ipi)
-  
 
   sin(u:%):% == 
     ipi : R := pi()$R
@@ -84791,8 +101807,6 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
       else
         qinterval(first vals, last vals)
     
-  
-
   cos(u:%):% == 
     ipi : R := pi()
     hasOne? : Boolean := hasTwoPiMultiple(0,ipi,u)
@@ -84809,8 +101823,6 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
       else
         qinterval(first vals, last vals)
     
-  
-
   tan(u:%):% == 
     ipi : R := pi()
     if width(u) > ipi then
@@ -84825,14 +101837,12 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
       lo > hi => error "Interval contains a singularity"
       qinterval(lo,hi)
     
-  
-
   csc(u:%):% == 
     ipi : R := pi()
     if width(u) > ipi then
       error "Interval contains a singularity"
     else 
---      import from Integer
+      -- import from Integer
       -- singularities are at multiples of Pi
       if hasPiMultiple(0,ipi,u) then error "Interval contains a singularity"
       vals : List R := sort [csc inf u, csc sup u]
@@ -84843,14 +101853,12 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
       else
         qinterval(first vals, last vals)
     
-  
-
   sec(u:%):% == 
     ipi : R := pi()
     if width(u) > ipi then
       error "Interval contains a singularity"
     else 
---      import from Integer
+      -- import from Integer
       -- singularities are at Pi/2 + n Pi
       if hasPiMultiple(ipi/(2::R),ipi,u) then
         error "Interval contains a singularity"
@@ -84862,9 +101870,6 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
       else
         qinterval(first vals, last vals)
     
-  
-
-
   cot(u:%):% == 
     ipi : R := pi()
     if width(u) > ipi then
@@ -84879,8 +101884,6 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
       lo > hi => error "Interval contains a singularity"
       qinterval(lo,hi)
     
-  
-
   -- From ArcTrigonometricFunctionCategory
 
   asin(u:%):% == 
@@ -84988,11 +101991,6 @@ Interval(R:Join(FloatingPointSystem,TranscendentalFunctionCategory)): IntervalCa
   -- From RadicalCategory
   _*_* (u:%,n:Fraction Integer):% == interval(inf(u)**n,sup(u)**n)
   
-\end{chunk}
-
-\begin{chunk}{COQ INTRVL}
-(* domain INTRVL *)
-(*
 *)
 
 \end{chunk}
@@ -85437,14 +102435,23 @@ Kernel(S:OrderedSet): Exports == Implementation where
     preds : OP      -> List Any
 
     is?(k:%, s:Symbol) == is?(operator k, s)
+
     is?(k:%, o:OP)     == (operator k) = o
+
     name k             == name operator k
+
     height k           == k.nest
+
     operator k         == k.op
+
     argument k         == k.arg
+
     position k         == k.posit
+
     setPosition(k, n)  == k.posit := n
+
     B2Z flag           == (flag => -1; 1)
+
     kernel s           == kernel(assert(operator(s,0),SYMBOL), nil(), 1)
 
     preds o ==
@@ -85526,6 +102533,110 @@ Kernel(S:OrderedSet): Exports == Implementation where
 \begin{chunk}{COQ KERNEL}
 (* domain KERNEL *)
 (*
+    import SortedCache(%)
+
+    Rep := Record(op:OP, arg:List S, nest:N, posit:N)
+
+    clearCache()
+
+    B2Z   : Boolean -> Integer
+    triage: (%, %)  -> Integer
+    preds : OP      -> List Any
+
+    is?(k:%, s:Symbol) == is?(operator k, s)
+
+    is?(k:%, o:OP)     == (operator k) = o
+
+    name k             == name operator k
+
+    height k           == k.nest
+
+    operator k         == k.op
+
+    argument k         == k.arg
+
+    position k         == k.posit
+
+    setPosition(k, n)  == k.posit := n
+
+    B2Z flag           == (flag => -1; 1)
+
+    kernel s           == kernel(assert(operator(s,0),SYMBOL), nil(), 1)
+
+    preds o ==
+      (u := property(o, PMPRED)) case "failed" => nil()
+      (u::None) pretend List(Any)
+
+    symbolIfCan k ==
+      has?(operator k, SYMBOL) => name operator k
+      "failed"
+
+    k1 = k2 ==
+      if k1.posit = 0 then enterInCache(k1, triage)
+      if k2.posit = 0 then enterInCache(k2, triage)
+      k1.posit = k2.posit
+
+    k1 < k2 ==
+      if k1.posit = 0 then enterInCache(k1, triage)
+      if k2.posit = 0 then enterInCache(k2, triage)
+      k1.posit < k2.posit
+
+    kernel(fn, x, n) ==
+      ((u := arity fn) case N) and (#x ^= u::N)
+                                    => error "Wrong number of arguments"
+      enterInCache([fn, x, n, 0]$Rep, triage)
+
+    -- SPECIALDISP contains a map List S -> OutputForm
+    -- it is used when the converting the arguments first is not good,
+    -- for instance with formal derivatives.
+    coerce(k:%):OutputForm ==
+      (v := symbolIfCan k) case Symbol => v::Symbol::OutputForm
+      (f := property(o := operator k, SPECIALDISP)) case None =>
+        ((f::None) pretend (List S -> OutputForm)) (argument k)
+      l := [x::OutputForm for x in argument k]$List(OutputForm)
+      (u := display o) case "failed" => prefix(name(o)::OutputForm, l)
+      (u::(List OutputForm -> OutputForm)) l
+
+    triage(k1, k2) ==
+      k1.nest   ^= k2.nest   => B2Z(k1.nest   < k2.nest)
+      k1.op ^= k2.op => B2Z(k1.op < k2.op)
+      (n1 := #(argument k1)) ^= (n2 := #(argument k2)) => B2Z(n1 < n2)
+      ((func := property(operator k1, SPECIALEQUAL)) case None) and
+        (((func::None) pretend ((%, %) -> Boolean)) (k1, k2)) => 0
+      for x1 in argument(k1) for x2 in argument(k2) repeat
+        x1 ^= x2 => return B2Z(x1 < x2)
+      0
+
+    if S has ConvertibleTo InputForm then
+      convert(k:%):InputForm ==
+        (v := symbolIfCan k) case Symbol => convert(v::Symbol)@InputForm
+        (f := property(o := operator k, SPECIALINPUT)) case None =>
+          ((f::None) pretend (List S -> InputForm)) (argument k)
+        l := [convert x for x in argument k]$List(InputForm)
+        (u := input operator k) case "failed" =>
+          convert concat(convert name operator k, l)
+        (u::(List InputForm -> InputForm)) l
+
+    if S has ConvertibleTo Pattern Integer then
+      convert(k:%):Pattern(Integer) ==
+        o := operator k
+        (v := symbolIfCan k) case Symbol =>
+          s  := patternVariable(v::Symbol,
+                      has?(o, PMCONST), has?(o, PMOPT), has?(o, PMMULT))
+          empty?(l := preds o) => s
+          setPredicates(s, l)
+        o [convert x for x in k.arg]$List(Pattern Integer)
+
+    if S has ConvertibleTo Pattern Float then
+      convert(k:%):Pattern(Float) ==
+        o := operator k
+        (v := symbolIfCan k) case Symbol =>
+          s  := patternVariable(v::Symbol,
+                      has?(o, PMCONST), has?(o, PMOPT), has?(o, PMMULT))
+          empty?(l := preds o) => s
+          setPredicates(s, l)
+        o [convert x for x in k.arg]$List(Pattern Float)
+
 *)
 
 \end{chunk}
@@ -86026,14 +103137,140 @@ KeyedAccessFile(Entry): KAFcategory == KAFcapsule where
             error ["IO mode must be input or output", mode]
  
         ---- From Set ----
+
+        f1 = f2 ==
+            f1.fileName = f2.fileName
+
+        coerce(f: %): OutputForm ==
+            f.fileName::OutputForm
+ 
+        ---- From FileCategory ----
+
+        open fname ==
+            open(fname, "either")
+
+        open(fname, mode) ==
+            mode = "either" =>
+                exists? fname =>
+                    open(fname, "input")
+                writable? fname =>
+                    reopen_!(open(fname, "output"), "input")
+                error "File does not exist and cannot be created"
+            [fname, defstream(fname, mode), mode]
+
+        reopen_!(f, mode) ==
+            close_! f
+            if mode ^= "closed" then
+                f.fileState := defstream(f.fileName, mode)
+                f.fileIOmode  := mode
+            f
+
+        close_! f  ==
+            if f.fileIOmode ^= "closed" then
+                RSHUT(f.fileState)$Lisp
+                f.fileIOmode  := "closed"
+            f
+
+        read_! f ==
+            f.fileIOmode ^= "input" => error ["File not in read state",f]
+            ks: List Symbol := RKEYIDS(f.fileName)$Lisp
+            null ks => error ["Attempt to read empty file", f]
+            ix := random()$Integer rem #ks
+            k: String := PNAME(ks.ix)$Lisp
+            [k, SPADRREAD(k, f.fileState)$Lisp]
+
+        write_!(f, pr) ==
+            f.fileIOmode ^= "output" => error ["File not in write state",f]
+            SPADRWRITE(pr.key, pr.entry, f.fileState)$Lisp
+            pr
+
+        name f ==
+            f.fileName
+
+        iomode f ==
+            f.fileIOmode
+ 
+        ---- From TableAggregate ----
+
+        empty() ==
+            fn := new("", "kaf", "sdata")$Name
+            open fn
+
+        keys f ==
+            close_! f
+            l: List SExpression := RKEYIDS(f.fileName)$Lisp
+            [PNAME(n)$Lisp for n in l]
+
+        # f ==
+            # keys f
+
+        elt(f,k) ==
+            reopen_!(f, "input")
+            SPADRREAD(k, f.fileState)$Lisp
+
+        setelt(f,k,e) ==
+            -- Leaves f in a safe, closed state.  For speed use "write".
+            reopen_!(f, "output")
+            UNWIND_-PROTECT(write_!(f, [k,e]), close_! f)$Lisp
+            close_! f
+            e
+
+        search(k,f) ==
+            not member?(k, keys f) => "failed"   -- can't trap RREAD error
+            reopen_!(f, "input")
+            (SPADRREAD(k, f.fileState)$Lisp)@Entry
+
+        remove_!(k:String,f:%)  ==
+            result := search(k,f)
+            result case "failed" => result
+            close_! f
+            RDROPITEMS(NAMESTRING(f.fileName)$Lisp, LIST(k)$Lisp)$Lisp
+            result
+
+        pack_! f ==
+            close_! f
+            RPACKFILE(f.fileName)$Lisp
+            f
+
+\end{chunk}
+
+\begin{chunk}{COQ KAFILE}
+(* domain KAFILE *)
+(*
+ 
+        CLASS     ==> 131   -- an arbitrary no. greater than 127
+        FileState ==> SExpression
+        IOMode    ==> String
+ 
+ 
+        Cons:= Record(car: SExpression, cdr: SExpression)
+        Rep := Record(fileName:    Name,     _
+                      fileState:   FileState,   _
+                      fileIOmode:  IOMode)
+ 
+        defstream(fn: Name, mode: IOMode): FileState ==
+            kafstring:=concat(fn::String,"/index.kaf")::FileName
+            mode = "input"  =>
+              not readable? kafstring => error ["File is not readable", fn]
+              RDEFINSTREAM(fn)$Lisp
+            mode = "output" =>
+              not writable? fn => error ["File is not writable", fn]
+              RDEFOUTSTREAM(fn)$Lisp
+            error ["IO mode must be input or output", mode]
+ 
+        ---- From Set ----
+
         f1 = f2 ==
             f1.fileName = f2.fileName
+
         coerce(f: %): OutputForm ==
             f.fileName::OutputForm
  
         ---- From FileCategory ----
+
         open fname ==
             open(fname, "either")
+
         open(fname, mode) ==
             mode = "either" =>
                 exists? fname =>
@@ -86042,17 +103279,20 @@ KeyedAccessFile(Entry): KAFcategory == KAFcapsule where
                     reopen_!(open(fname, "output"), "input")
                 error "File does not exist and cannot be created"
             [fname, defstream(fname, mode), mode]
+
         reopen_!(f, mode) ==
             close_! f
             if mode ^= "closed" then
                 f.fileState := defstream(f.fileName, mode)
                 f.fileIOmode  := mode
             f
+
         close_! f  ==
             if f.fileIOmode ^= "closed" then
                 RSHUT(f.fileState)$Lisp
                 f.fileIOmode  := "closed"
             f
+
         read_! f ==
             f.fileIOmode ^= "input" => error ["File not in read state",f]
             ks: List Symbol := RKEYIDS(f.fileName)$Lisp
@@ -86060,54 +103300,60 @@ KeyedAccessFile(Entry): KAFcategory == KAFcapsule where
             ix := random()$Integer rem #ks
             k: String := PNAME(ks.ix)$Lisp
             [k, SPADRREAD(k, f.fileState)$Lisp]
+
         write_!(f, pr) ==
             f.fileIOmode ^= "output" => error ["File not in write state",f]
             SPADRWRITE(pr.key, pr.entry, f.fileState)$Lisp
             pr
+
         name f ==
             f.fileName
+
         iomode f ==
             f.fileIOmode
  
         ---- From TableAggregate ----
+
         empty() ==
             fn := new("", "kaf", "sdata")$Name
             open fn
+
         keys f ==
             close_! f
             l: List SExpression := RKEYIDS(f.fileName)$Lisp
             [PNAME(n)$Lisp for n in l]
+
         # f ==
             # keys f
+
         elt(f,k) ==
             reopen_!(f, "input")
             SPADRREAD(k, f.fileState)$Lisp
+
         setelt(f,k,e) ==
             -- Leaves f in a safe, closed state.  For speed use "write".
             reopen_!(f, "output")
             UNWIND_-PROTECT(write_!(f, [k,e]), close_! f)$Lisp
             close_! f
             e
+
         search(k,f) ==
             not member?(k, keys f) => "failed"   -- can't trap RREAD error
             reopen_!(f, "input")
             (SPADRREAD(k, f.fileState)$Lisp)@Entry
+
         remove_!(k:String,f:%)  ==
             result := search(k,f)
             result case "failed" => result
             close_! f
             RDROPITEMS(NAMESTRING(f.fileName)$Lisp, LIST(k)$Lisp)$Lisp
             result
+
         pack_! f ==
             close_! f
             RPACKFILE(f.fileName)$Lisp
             f
 
-\end{chunk}
-
-\begin{chunk}{COQ KAFILE}
-(* domain KAFILE *)
-(*
 *)
 
 \end{chunk}
@@ -86337,6 +103583,7 @@ LaurentPolynomial(R, UP): Exports == Implementation where
         ++ separate(x) is not documented
  
   Implementation ==> add
+
     Rep := Record(polypart: UP, order0: Z)
  
     poly   : %  -> UP
@@ -86347,25 +103594,45 @@ LaurentPolynomial(R, UP): Exports == Implementation where
     monTerm: (R, Z, O) -> O
  
     0                == [0, 0]
+
     1                == [1, 0]
+
     p = q            == p.order0 = q.order0 and p.polypart = q.polypart
+
     poly p           == p.polypart
+
     order p          == p.order0
+
     gpol(p, n)       == [p, n]
+
     monomial(r, n)   == check0(n, r::UP)
+
     coerce(p:UP):%   == mkgpol(0, p)
+
     reductum p       == check0(order p, reductum poly p)
+
     n:Z * p:%        == check0(order p, n * poly p)
+
     characteristic() == characteristic()$R
+
     coerce(n:Z):%    == n::R::%
+
     degree p         == degree(poly p)::Z + order p
+
     monomial? p      == monomial? poly p
+
     coerce(r:R):%    == gpol(r::UP, 0)
+
     convert(p:%):RF  == poly(p) * (monomial(1, 1)$UP)::RF ** order p
+
     p:% * q:%        == check0(order p + order q, poly p * poly q)
+
     - p              == gpol(- poly p, order p)
+
     check0(n, p)     == (zero? p => 0; gpol(p, n))
+
     trailingCoefficient p   == coefficient(poly p, 0)
+
     leadingCoefficient p    == leadingCoefficient poly p
  
     coerce(p:%):O ==
@@ -86388,13 +103655,11 @@ LaurentPolynomial(R, UP): Exports == Implementation where
  
     monTerm(r, n, v) ==
       zero? n => r::O
---      one? n => v
       (n = 1) => v
       v ** (n::O)
  
     toutput(r, n, v) ==
       mon := monTerm(r, n, v)
---      zero? n or one? r => mon
       zero? n or (r = 1) => mon
       r = -1 => - mon
       r::O * mon
@@ -86429,6 +103694,7 @@ LaurentPolynomial(R, UP): Exports == Implementation where
       retractIfCan poly p
  
     if R has Field then
+
       gcd(p, q) == gcd(poly p, poly q)::%
  
       separate f ==
@@ -86438,8 +103704,8 @@ LaurentPolynomial(R, UP): Exports == Implementation where
         qr := divide(bc.coef1, q)
         [mkgpol(-n, bc.coef2 + tn * qr.quotient), qr.remainder / q]
  
--- returns (z, r) s.t. p = q z + r,
--- and degree(r) < degree(q), order(r) >= min(order(p), order(q))
+      -- returns (z, r) s.t. p = q z + r,
+      -- and degree(r) < degree(q), order(r) >= min(order(p), order(q))
       divide(p, q) ==
         c  := min(order p, order q)
         qr := divide(poly(p) * monomial(1, (order p - c)::N)$UP, poly q)
@@ -86458,6 +103724,142 @@ LaurentPolynomial(R, UP): Exports == Implementation where
 \begin{chunk}{COQ LAUPOL}
 (* domain LAUPOL *)
 (*
+
+    Rep := Record(polypart: UP, order0: Z)
+ 
+    poly   : %  -> UP
+    check0 : (Z, UP) -> %
+    mkgpol : (Z, UP) -> %
+    gpol   : (UP, Z) -> %
+    toutput: (R, Z, O) -> O
+    monTerm: (R, Z, O) -> O
+ 
+    0                == [0, 0]
+
+    1                == [1, 0]
+
+    p = q            == p.order0 = q.order0 and p.polypart = q.polypart
+
+    poly p           == p.polypart
+
+    order p          == p.order0
+
+    gpol(p, n)       == [p, n]
+
+    monomial(r, n)   == check0(n, r::UP)
+
+    coerce(p:UP):%   == mkgpol(0, p)
+
+    reductum p       == check0(order p, reductum poly p)
+
+    n:Z * p:%        == check0(order p, n * poly p)
+
+    characteristic() == characteristic()$R
+
+    coerce(n:Z):%    == n::R::%
+
+    degree p         == degree(poly p)::Z + order p
+
+    monomial? p      == monomial? poly p
+
+    coerce(r:R):%    == gpol(r::UP, 0)
+
+    convert(p:%):RF  == poly(p) * (monomial(1, 1)$UP)::RF ** order p
+
+    p:% * q:%        == check0(order p + order q, poly p * poly q)
+
+    - p              == gpol(- poly p, order p)
+
+    check0(n, p)     == (zero? p => 0; gpol(p, n))
+
+    trailingCoefficient p   == coefficient(poly p, 0)
+
+    leadingCoefficient p    == leadingCoefficient poly p
+ 
+    coerce(p:%):O ==
+      zero? p => 0::Z::O
+      l := nil()$List(O)
+      v := monomial(1, 1)$UP :: O
+      while p ^= 0 repeat
+        l := concat(l, toutput(leadingCoefficient p, degree p, v))
+        p := reductum p
+      reduce("+", l)
+ 
+    coefficient(p, n) ==
+      (m := n - order p) < 0 => 0
+      coefficient(poly p, m::N)
+ 
+    differentiate(p:%, derivation:UP -> UP) ==
+      t := monomial(1, 1)$UP
+      mkgpol(order(p) - 1,
+              derivation(poly p) * t + order(p) * poly(p) * derivation t)
+ 
+    monTerm(r, n, v) ==
+      zero? n => r::O
+      (n = 1) => v
+      v ** (n::O)
+ 
+    toutput(r, n, v) ==
+      mon := monTerm(r, n, v)
+      zero? n or (r = 1) => mon
+      r = -1 => - mon
+      r::O * mon
+ 
+    recip p ==
+      (q := recip poly p) case "failed" => "failed"
+      gpol(q::UP, - order p)
+ 
+    p + q ==
+      zero? q => p
+      zero? p => q
+      (d := order p - order q) > 0 =>
+                      gpol(poly(p) * monomial(1, d::N) + poly q, order q)
+      d < 0 => gpol(poly(p) + poly(q) * monomial(1, (-d)::N), order p)
+      mkgpol(order p, poly(p) + poly q)
+ 
+    mkgpol(n, p) ==
+      zero? p => 0
+      d := order(p, monomial(1, 1)$UP)
+      gpol((p exquo monomial(1, d))::UP, n + d::Z)
+ 
+    p exquo q ==
+      (r := poly(p) exquo poly q) case "failed" => "failed"
+      check0(order p - order q, r::UP)
+ 
+    retractIfCan(p:%):Union(UP, "failed") ==
+      order(p) < 0 => error "Not retractable"
+      poly(p) * monomial(1, order(p)::N)$UP
+ 
+    retractIfCan(p:%):Union(R, "failed") ==
+      order(p) ^= 0 => "failed"
+      retractIfCan poly p
+ 
+    if R has Field then
+
+      gcd(p, q) == gcd(poly p, poly q)::%
+ 
+      separate f ==
+        n  := order(q := denom f, monomial(1, 1))
+        q  := (q exquo (tn := monomial(1, n)$UP))::UP
+        bc := extendedEuclidean(tn,q,numer f)::Record(coef1:UP,coef2:UP)
+        qr := divide(bc.coef1, q)
+        [mkgpol(-n, bc.coef2 + tn * qr.quotient), qr.remainder / q]
+ 
+      -- returns (z, r) s.t. p = q z + r,
+      -- and degree(r) < degree(q), order(r) >= min(order(p), order(q))
+      divide(p, q) ==
+        c  := min(order p, order q)
+        qr := divide(poly(p) * monomial(1, (order p - c)::N)$UP, poly q)
+        [mkgpol(c - order q, qr.quotient), mkgpol(c, qr.remainder)]
+ 
+      euclideanSize p == degree poly p
+
+      extendedEuclidean(a, b, c) ==
+        (bc := extendedEuclidean(poly a, poly b, poly c)) case "failed"
+          => "failed"
+        [mkgpol(order c - order a, bc.coef1),
+                                     mkgpol(order c - order b, bc.coef2)]
+
 *)
 
 \end{chunk}
@@ -86773,9 +104175,13 @@ Library(): TableAggregate(String, Any) with
           ++ close!(f) returns the library f closed to input and output.
 
     == KeyedAccessFile(Any) add
+
          Rep := KeyedAccessFile(Any)
+
          library f == open f
+
          elt(f:%,v:Symbol) == elt(f, string v)
+
          setelt(f:%, v:Symbol, val:Any) == setelt(f, string v, val)
 
 \end{chunk}
@@ -86783,6 +104189,16 @@ Library(): TableAggregate(String, Any) with
 \begin{chunk}{COQ LIB}
 (* domain LIB *)
 (*
+ KeyedAccessFile(Any) add
+
+         Rep := KeyedAccessFile(Any)
+
+         library f == open f
+
+         elt(f:%,v:Symbol) == elt(f, string v)
+
+         setelt(f:%, v:Symbol, val:Any) == setelt(f, string v, val)
+
 *)
 
 \end{chunk}
@@ -87177,6 +104593,7 @@ LieExponentials(VarSet, R, Order): XDPcat == XDPdef where
          char("e")$Character :: EX ** (t.c::EX * t.k::EX)
  
     -- definitions
+
        identification(x,y) ==
           l1: List TERM1 := LyndonCoordinates x
           l2: List TERM1 := LyndonCoordinates y
@@ -87215,6 +104632,73 @@ LieExponentials(VarSet, R, Order): XDPcat == XDPdef where
 \begin{chunk}{COQ LEXP}
 (* domain LEXP *)
 (*
+ PBWPOLY add
+
+    -- Representation
+       Rep := PBWPOLY 
+
+    -- local functions
+       compareTerm1s: (TERM1, TERM1) -> Boolean
+       out: TERM1 -> EX
+       ident: (List TERM1, List TERM1) -> List EQ
+
+    -- functions locales
+       ident(l1, l2) ==
+         import(TERM1)
+         null l1 => [equation(0$R,t.c)$EQ for t in l2]
+         null l2 => [equation(t.c, 0$R)$EQ for t in l1]        
+         u1 : LWORD := l1.first.k; c1 :R := l1.first.c
+         u2 : LWORD := l2.first.k; c2 :R := l2.first.c
+         u1 = u2 =>
+            r: R := c1 - c2
+            r = 0 => ident(rest l1, rest l2) 
+            cons(equation(c1,c2)$EQ , ident(rest l1, rest l2))
+         lexico(u1, u2)$LWORD =>
+            cons(equation(0$R,c2)$EQ , ident(l1, rest l2))
+         cons(equation(c1,0$R)$EQ , ident(rest l1, l2))
+
+       -- ordre lexico decroissant
+       compareTerm1s(u:TERM1, v:TERM1):Boolean == lexico(v.k, u.k)$LWORD
+
+       out(t:TERM1):EX ==
+         t.c =$R 1 => char("e")$Character :: EX ** t.k ::EX
+         char("e")$Character :: EX ** (t.c::EX * t.k::EX)
+ 
+    -- definitions
+
+       identification(x,y) ==
+          l1: List TERM1 := LyndonCoordinates x
+          l2: List TERM1 := LyndonCoordinates y
+          ident(l1, l2)
+ 
+       LyndonCoordinates x ==
+         lt: List TERM1 := [[l::LWORD, t.c]$TERM1 for t in listOfTerms x | _
+                             (l := retractIfCan(t.k)$BASIS) case LWORD ] 
+         lt := sort(compareTerm1s,lt)
+
+       x:$ * y:$ == product(x::Rep, y::Rep, Order::I::NNI)$Rep
+
+       exp p == exp(p::Rep , Order::I::NNI)$Rep
+
+       log p == LiePolyIfCan(log(p,Order::I::NNI))$Rep :: LPOLY
+
+       coerce(p:$):EX ==
+          p = 1$$ => 1$R :: EX
+          lt : List TERM1 := LyndonCoordinates p 
+          reduce(_*, [out t for t in lt])$List(EX)
+
+
+       LyndonBasis(lv) == 
+         [LiePoly(l)$LPOLY for l in LyndonWordsList(lv,Order)$LWORD]
+
+       coerce(p:$):PBWPOLY == p::Rep
+
+       inv x ==
+         x = 1 => 1
+         lt:LTERMS := listOfTerms mirror x
+         lt:= [[t.k, (odd? length(t.k)$BASIS => - t.c; t.c)]$TERM for t in lt ]
+         lt pretend $
+
 *)
 
 \end{chunk}
@@ -87762,6 +105246,7 @@ LiePolynomial(VarSet:OrderedSet, R:CommutativeRing) : Public == Private where
         ++ \axiom{construct(x,y)} returns the Lie bracket \axiom{[x,y]}.
 
    Private ==  FreeModule1(R, LWORD) add       
+
         import(TERM)
 
       --representation
@@ -87837,6 +105322,7 @@ LiePolynomial(VarSet:OrderedSet, R:CommutativeRing) : Public == Private where
            r
  
       --definitions locales
+
         makeLyndon(u,v) == (u::MAGMA * v::MAGMA) pretend LWORD
  
         crw(u,v) ==               -- u et v sont des mots de Lyndon
@@ -87877,7 +105363,9 @@ LiePolynomial(VarSet:OrderedSet, R:CommutativeRing) : Public == Private where
             +/[t.c * cr1(t.k, y) for t in x]
 
         construct(l:LWORD , p:$):$ == cr1(l,p) 
+
         construct(p:$ , l:LWORD):$ == cr2(p,l)
+
         construct(u:LWORD , v:LWORD):$ == crw(u,v)
 
         coerce(p:$):XDPOLY ==
@@ -87903,22 +105391,157 @@ LiePolynomial(VarSet:OrderedSet, R:CommutativeRing) : Public == Private where
           null p => 0
           length( p.first.k)$LWORD
 
-      --  listOfTerms p == p pretend List TERM
-        
---        coerce(x) : EX ==
---           null x => (0$R) :: EX
---           le : List EX := nil
---           for rec in x repeat
---             rec.c = 1$R => le := cons(rec.k :: EX, le)
---             le := cons(mkBinary("*"::EX,  rec.c :: EX, rec.k :: EX), le)
---           1 = #le => first le
---           mkNary("+" :: EX,le)
-
 \end{chunk}
 
 \begin{chunk}{COQ LPOLY}
 (* domain LPOLY *)
 (*
+  FreeModule1(R, LWORD) add       
+
+        import(TERM)
+
+      --representation
+        Rep :=  List TERM
+
+      -- fonctions locales
+        cr1 : (LWORD, $    ) -> $
+        cr2 : ($, LWORD    ) -> $
+        crw : (LWORD, LWORD) -> $     -- crochet de 2 mots de Lyndon
+        DPoly: LWORD -> XDPOLY
+        lquo1: (XRPOLY , LWORD) -> XRPOLY
+        lyndon: (LWORD, LWORD) -> $
+        makeLyndon: (LWORD, LWORD) -> LWORD
+        rquo1: (XRPOLY , LWORD) -> XRPOLY
+        RPoly: LWORD -> XRPOLY
+        eval1: (LWORD, VarSet, $) -> $                     -- 08/03/98
+        eval2: (LWORD, List VarSet, List $) -> $           -- 08/03/98
+
+
+      -- Evaluation
+        eval1(lw,v,nv) ==                                  -- 08/03/98
+          not member?(v, varList(lw)$LWORD) => LiePoly lw
+          (s := retractIfCan(lw)$LWORD) case VarSet => 
+             if (s::VarSet) = v then nv else LiePoly lw 
+          l: LWORD := left lw
+          r: LWORD := right lw
+          construct(eval1(l,v,nv), eval1(r,v,nv))
+
+        eval2(lw,lv,lnv) ==                                -- 08/03/98
+          p: Integer
+          (s := retractIfCan(lw)$LWORD) case VarSet =>
+             p := position(s::VarSet, lv)$List(VarSet) 
+             if p=0 then lw::$ else elt(lnv,p)$List($)
+          l: LWORD := left lw
+          r: LWORD := right lw
+          construct(eval2(l,lv,lnv), eval2(r,lv,lnv))
+
+        eval(p:$, v: VarSet, nv: $): $ ==                  -- 08/03/98
+          +/ [t.c * eval1(t.k, v, nv) for t in p]
+
+        eval(p:$, lv: List(VarSet), lnv: List($)): $ ==    -- 08/03/98
+          +/ [t.c * eval2(t.k, lv, lnv) for t in p]
+
+        lquo1(p,lw) ==
+          constant? p => 0$XRPOLY
+          retractable? lw => lquo(p, retract lw)$XRPOLY
+          lquo1(lquo1(p, left lw),right lw) - lquo1(lquo1(p, right lw),left lw)  
+        rquo1(p,lw) ==
+          constant? p => 0$XRPOLY
+          retractable? lw => rquo(p, retract lw)$XRPOLY
+          rquo1(rquo1(p, left lw),right lw) - rquo1(rquo1(p, right lw),left lw)
+
+        coef(p, lp) == coef(p, lp::XRPOLY)$XRPOLY
+
+        lquo(p, lp) ==
+          lp = 0 => 0$XRPOLY
+          +/ [t.c * lquo1(p,t.k) for t in lp]
+ 
+        rquo(p, lp) ==
+          lp = 0 => 0$XRPOLY
+          +/ [t.c * rquo1(p,t.k) for t in lp] 
+
+        LiePolyIfCan p ==         -- inefficace a cause de la rep. de XDPOLY
+           not quasiRegular? p => "failed"
+           p1: XDPOLY := p ; r:$ := 0
+           while p1 ^= 0 repeat
+             t: Record(k:WORD, c:R) := mindegTerm p1
+             w: WORD := t.k; coef:R := t.c
+             (l := lyndonIfCan(w)$LWORD) case "failed" => return "failed"
+             lp:$ := coef * LiePoly(l::LWORD)
+             r := r + lp 
+             p1 := p1 - lp::XDPOLY 
+           r
+ 
+      --definitions locales
+
+        makeLyndon(u,v) == (u::MAGMA * v::MAGMA) pretend LWORD
+ 
+        crw(u,v) ==               -- u et v sont des mots de Lyndon
+          u = v => 0
+          lexico(u,v) => lyndon(u,v)
+          - lyndon (v,u)
+
+        lyndon(u,v) ==            -- u et v sont des mots de Lyndon tq u < v
+          retractable? u => monom(makeLyndon(u,v),1)
+          u1: LWORD := left u
+          u2: LWORD := right u
+          lexico(u2,v) => cr1(u1, lyndon(u2,v)) + cr2(lyndon(u1,v), u2)
+          monom(makeLyndon(u,v),1)
+           
+        cr1 (l, p) ==
+            +/[t.c * crw(l, t.k) for t in p]
+
+        cr2 (p, l) ==
+            +/[t.c * crw(t.k, l) for t in p]
+
+        DPoly w ==
+           retractable? w => retract(w) :: XDPOLY 
+           l:XDPOLY := DPoly left w
+           r:XDPOLY := DPoly right w
+           l*r - r*l
+
+        RPoly w ==
+           retractable? w => retract(w) :: XRPOLY 
+           l:XRPOLY := RPoly left w
+           r:XRPOLY := RPoly right w
+           l*r - r*l 
+    
+      -- definitions
+
+        coerce(v:VarSet) == monom(v::LWORD , 1)
+
+        construct(x:$ , y:$):$ ==
+            +/[t.c * cr1(t.k, y) for t in x]
+
+        construct(l:LWORD , p:$):$ == cr1(l,p) 
+
+        construct(p:$ , l:LWORD):$ == cr2(p,l)
+
+        construct(u:LWORD , v:LWORD):$ == crw(u,v)
+
+        coerce(p:$):XDPOLY ==
+            +/ [t.c * DPoly(t.k) for t in p]
+
+        coerce(p:$):XRPOLY ==
+            +/ [t.c * RPoly(t.k) for t in p]
+
+        LiePoly(l) == monom(l,1)
+
+        varList p ==
+          le : List VarSet := "setUnion"/[varList(t.k)$LWORD for t in p]
+          sort(le)$List(VarSet)
+
+        mirror p ==
+          [[t.k, (odd? length t.k => t.c; -t.c)]$TERM for t in p]
+
+        trunc(p, n) ==
+          degree(p) > n => trunc( reductum p , n)
+          p
+
+        degree p == 
+          null p => 0
+          length( p.first.k)$LWORD
+
 *)
 
 \end{chunk}
@@ -88272,8 +105895,9 @@ LieSquareMatrix(n,R): Exports == Implementation where
     n2 : PositiveInteger := n*n
 
     convDM : DirectProduct(n2,R) -> %
-    conv : DirectProduct(n2,R) ->  SquareMatrix(n,R)
+
       --++ converts n2-vector to (n,n)-matrix row by row
+    conv : DirectProduct(n2,R) ->  SquareMatrix(n,R)
     conv v  ==
       cond : Matrix(R) := new(n,n,0$R)$Matrix(R)
       z : Integer := 0
@@ -88283,7 +105907,6 @@ LieSquareMatrix(n,R): Exports == Implementation where
           setelt(cond,i,j,v.z)
       squareMatrix(cond)$SquareMatrix(n, R)
 
-
     coordinates(a:%,b:Vector(%)):Vector(R) ==
       -- only valid for b canonicalBasis
       res : Vector R := new(n2,0$R)
@@ -88294,7 +105917,6 @@ LieSquareMatrix(n,R): Exports == Implementation where
           res.z := elt(a,i,j)$%
       res
 
-
     convDM v ==
       sq := conv v
       coerce(sq)$Rep :: %
@@ -88307,26 +105929,60 @@ LieSquareMatrix(n,R): Exports == Implementation where
         ldp)$ListFunctions2(DirectProduct(n2,R), %)
 
     someBasis() == basis()
-    rank() == n*n
 
+    rank() == n*n
 
---    transpose: % -> %
---      ++ computes the transpose of a matrix
---    squareMatrix: Matrix R -> %
---      ++ converts a Matrix to a LieSquareMatrix
---    coerce: % -> Matrix R
---      ++ converts a LieSquareMatrix to a Matrix
---    symdecomp : % -> Record(sym:%,antisym:%)
---    if R has commutative("*") then
---      minorsVect: -> Vector(Union(R,"uncomputed")) --range: 1..2**n-1
---    if R has commutative("*") then central
---    if R has commutative("*") and R has unitsKnown then unitsKnown
 
 \end{chunk}
 
 \begin{chunk}{COQ LSQM}
 (* domain LSQM *)
 (*
+ AssociatedLieAlgebra (R,SquareMatrix(n, R)) add
+
+    Rep :=  AssociatedLieAlgebra (R,SquareMatrix(n, R))
+      -- local functions
+    n2 : PositiveInteger := n*n
+
+    convDM : DirectProduct(n2,R) -> %
+
+      --++ converts n2-vector to (n,n)-matrix row by row
+    conv : DirectProduct(n2,R) ->  SquareMatrix(n,R)
+    conv v  ==
+      cond : Matrix(R) := new(n,n,0$R)$Matrix(R)
+      z : Integer := 0
+      for i in 1..n repeat
+        for j in 1..n  repeat
+          z := z+1
+          setelt(cond,i,j,v.z)
+      squareMatrix(cond)$SquareMatrix(n, R)
+
+    coordinates(a:%,b:Vector(%)):Vector(R) ==
+      -- only valid for b canonicalBasis
+      res : Vector R := new(n2,0$R)
+      z : Integer := 0
+      for i in 1..n repeat
+        for j in 1..n repeat
+          z := z+1
+          res.z := elt(a,i,j)$%
+      res
+
+    convDM v ==
+      sq := conv v
+      coerce(sq)$Rep :: %
+
+    basis() ==
+      n2 : PositiveInteger := n*n
+      ldp : List DirectProduct(n2,R) :=
+        [unitVector(i::PositiveInteger)$DirectProduct(n2,R) for i in 1..n2]
+      res:Vector % := vector map(convDM,_
+        ldp)$ListFunctions2(DirectProduct(n2,R), %)
+
+    someBasis() == basis()
+
+    rank() == n*n
+
+
 *)
 
 \end{chunk}
@@ -88973,18 +106629,23 @@ o )show LinearOrdinaryDifferentialOperator
 LinearOrdinaryDifferentialOperator(A:Ring, diff: A -> A):
     LinearOrdinaryDifferentialOperatorCategory A
       == SparseUnivariateSkewPolynomial(A, 1, diff) add
+
         Rep := SparseUnivariateSkewPolynomial(A, 1, diff)
 
         outputD := "D"@String :: Symbol :: OutputForm
 
         coerce(l:%):OutputForm == outputForm(l, outputD)
+
         elt(p:%, a:A):A        == apply(p, 0, a)
 
         if A has Field then
+
             import LinearOrdinaryDifferentialOperatorsOps(A, %)
 
             symmetricProduct(a, b) == symmetricProduct(a, b, diff)
+
             symmetricPower(a, n)   == symmetricPower(a, n, diff)
+
             directSum(a, b)        == directSum(a, b, diff)
 
 \end{chunk}
@@ -88992,6 +106653,25 @@ LinearOrdinaryDifferentialOperator(A:Ring, diff: A -> A):
 \begin{chunk}{COQ LODO}
 (* domain LODO *)
 (*
+
+        Rep := SparseUnivariateSkewPolynomial(A, 1, diff)
+
+        outputD := "D"@String :: Symbol :: OutputForm
+
+        coerce(l:%):OutputForm == outputForm(l, outputD)
+
+        elt(p:%, a:A):A        == apply(p, 0, a)
+
+        if A has Field then
+
+            import LinearOrdinaryDifferentialOperatorsOps(A, %)
+
+            symmetricProduct(a, b) == symmetricProduct(a, b, diff)
+
+            symmetricPower(a, n)   == symmetricPower(a, n, diff)
+
+            directSum(a, b)        == directSum(a, b, diff)
+
 *)
 
 \end{chunk}
@@ -90234,6 +107914,7 @@ LinearOrdinaryDifferentialOperator2(A, M): Exports == Implementation where
   Exports ==> Join(LinearOrdinaryDifferentialOperatorCategory A, Eltable(M, M))
 
   Implementation ==> LinearOrdinaryDifferentialOperator(A, differentiate$A) add
+
       elt(p:%, m:M):M ==
         apply(p, differentiate, m)$ApplyUnivariateSkewPolynomial(A, M, %)
 
@@ -90242,6 +107923,10 @@ LinearOrdinaryDifferentialOperator2(A, M): Exports == Implementation where
 \begin{chunk}{COQ LODO2}
 (* domain LODO2 *)
 (*
+
+      elt(p:%, m:M):M ==
+        apply(p, differentiate, m)$ApplyUnivariateSkewPolynomial(A, M, %)
+
 *)
 
 \end{chunk}
@@ -91474,22 +109159,35 @@ ListMonoidOps(S, E, un): Exports == Implementation where
       ++ mapGen(f, a1\^e1 ... an\^en) returns \spad{f(a1)\^e1 ... f(an)\^en}.
 
   Implementation ==> add
+
     Rep := List REC
 
     localplus: ($, $) -> $
 
     makeUnit()       == empty()$Rep
+
     size l           == # listOfMonoms l
+
     coerce(s:S):$    == [[s, un]]
+
     coerce(l:$):O    == coerce(l)$Rep
+
     makeTerm(s, e)   == (zero? e => makeUnit(); [[s, e]])
+
     makeMulti l      == l
+
     f = g            == f =$Rep g
+
     listOfMonoms l   == l pretend List(REC)
+
     nthExpon(f, i)   == f.(i-1+minIndex f).exp
+
     nthFactor(f, i)  == f.(i-1+minIndex f).gen
+
     reverse l        == reverse(l)$Rep
+
     reverse_! l      == reverse_!(l)$Rep
+
     mapGen(f, l)     == [[f(x.gen), x.exp] for x in l]
 
     mapExpon(f, l) ==
@@ -91555,6 +109253,95 @@ ListMonoidOps(S, E, un): Exports == Implementation where
 \begin{chunk}{COQ LMOPS}
 (* domain LMOPS *)
 (*
+
+    Rep := List REC
+
+    localplus: ($, $) -> $
+
+    makeUnit()       == empty()$Rep
+
+    size l           == # listOfMonoms l
+
+    coerce(s:S):$    == [[s, un]]
+
+    coerce(l:$):O    == coerce(l)$Rep
+
+    makeTerm(s, e)   == (zero? e => makeUnit(); [[s, e]])
+
+    makeMulti l      == l
+
+    f = g            == f =$Rep g
+
+    listOfMonoms l   == l pretend List(REC)
+
+    nthExpon(f, i)   == f.(i-1+minIndex f).exp
+
+    nthFactor(f, i)  == f.(i-1+minIndex f).gen
+
+    reverse l        == reverse(l)$Rep
+
+    reverse_! l      == reverse_!(l)$Rep
+
+    mapGen(f, l)     == [[f(x.gen), x.exp] for x in l]
+
+    mapExpon(f, l) ==
+      ans:List(REC) := empty()
+      for x in l repeat
+        if (a := f(x.exp)) ^= 0 then ans := concat([x.gen, a], ans)
+      reverse_! ans
+
+    outputForm(l, op, opexp, id) ==
+      empty? l => id::OutputForm
+      l:List(O) :=
+         [(p.exp = un => p.gen::O; opexp(p.gen::O, p.exp::O)) for p in l]
+      reduce(op, l)
+
+    retractIfCan(l:$):Union(S, "failed") ==
+      not empty? l and empty? rest l and l.first.exp = un => l.first.gen
+      "failed"
+
+    rightMult(f, s) ==
+      empty? f => s::$
+      s = f.last.gen => (setlast_!(h := copy f, [s, f.last.exp + un]); h)
+      concat(f, [s, un])
+
+    leftMult(s, f) ==
+      empty? f => s::$
+      s = f.first.gen => concat([s, f.first.exp + un], rest f)
+      concat([s, un], f)
+
+    commutativeEquality(s1:$, s2:$):Boolean ==
+      #s1 ^= #s2 => false
+      for t1 in s1 repeat
+          if not member?(t1,s2) then return false
+      true
+
+    plus_!(s:S, n:E, f:$):$ ==
+      h := g := concat([s, n], f)
+      h1 := rest h
+      while not empty? h1 repeat
+        s = h1.first.gen =>
+          l :=
+            zero?(m := n + h1.first.exp) => rest h1
+            concat([s, m], rest h1)
+          setrest_!(h, l)
+          return rest g
+        h := h1
+        h1 := rest h1
+      g
+
+    plus(s, n, f) == plus_!(s,n,copy f)
+
+    plus(f, g) ==
+      #f < #g => localplus(f, g)
+      localplus(g, f)
+
+    localplus(f, g) ==
+      g := copy g
+      for x in f repeat
+        g := plus(x.gen, x.exp, g)
+      g
+
 *)
 
 \end{chunk}
@@ -91727,6 +109514,7 @@ ListMultiDictionary(S:SetCategory): EE == II where
    substitute : (S, S, %) -> %
      ++ substitute(x,y,d) replace x's with y's in dictionary d.
  II ==> add
+
    Rep := Reference List S
 
    sub: (S, S, S) -> S
@@ -91735,9 +109523,13 @@ ListMultiDictionary(S:SetCategory): EE == II where
      prefix("dictionary"::OutputForm, [x::OutputForm for x in parts s])
 
    #s                 == # parts s
+
    copy s             == dictionary copy parts s
+
    empty? s           == empty? parts s
+
    bag l              == dictionary l
+
    dictionary()       == dictionary empty()
 
    empty():% == ref empty()
@@ -91754,11 +109546,17 @@ ListMultiDictionary(S:SetCategory): EE == II where
         convert(parts lmd)@InputForm]
 
    map(f, s)          == dictionary map(f, parts s)
+
    map_!(f, s)        == dictionary map_!(f, parts s)
+
    parts s            == deref s
+
    sub(x, y, z)       == (z = x => y; z)
+
    insert_!(x, s, n)  == (for i in 1..n repeat insert_!(x, s); s)
+
    substitute(x, y, s) == dictionary map(z1 +-> sub(x, y, z1), parts s)
+
    removeDuplicates_! s == dictionary removeDuplicates_! parts s
 
    inspect s ==
@@ -91794,6 +109592,7 @@ ListMultiDictionary(S:SetCategory): EE == II where
      ld
 
    if S has OrderedSet then
+
       s = t == parts s = parts t
 
       remove_!(x:S, s:%) ==
@@ -91818,6 +109617,7 @@ ListMultiDictionary(S:SetCategory): EE == II where
          s
 
    else
+
       remove_!(x:S, s:%) == (setref(s, remove_!(x, parts s)); s)
 
       s = t ==
@@ -91843,6 +109643,130 @@ ListMultiDictionary(S:SetCategory): EE == II where
 \begin{chunk}{COQ LMDICT}
 (* domain LMDICT *)
 (*
+
+   Rep := Reference List S
+
+   sub: (S, S, S) -> S
+
+   coerce(s:%):OutputForm ==
+     prefix("dictionary"::OutputForm, [x::OutputForm for x in parts s])
+
+   #s                 == # parts s
+
+   copy s             == dictionary copy parts s
+
+   empty? s           == empty? parts s
+
+   bag l              == dictionary l
+
+   dictionary()       == dictionary empty()
+
+   empty():% == ref empty()
+
+   dictionary(ls:List S):% ==
+     empty? ls => empty()
+     lmd := empty()
+     for x in ls repeat insert_!(x,lmd)
+     lmd
+
+   if S has ConvertibleTo InputForm then
+     convert(lmd:%):InputForm ==
+       convert [convert("dictionary"::Symbol)@InputForm,
+        convert(parts lmd)@InputForm]
+
+   map(f, s)          == dictionary map(f, parts s)
+
+   map_!(f, s)        == dictionary map_!(f, parts s)
+
+   parts s            == deref s
+
+   sub(x, y, z)       == (z = x => y; z)
+
+   insert_!(x, s, n)  == (for i in 1..n repeat insert_!(x, s); s)
+
+   substitute(x, y, s) == dictionary map(z1 +-> sub(x, y, z1), parts s)
+
+   removeDuplicates_! s == dictionary removeDuplicates_! parts s
+
+   inspect s ==
+     empty? s => error "empty dictionary"
+     first parts s
+
+   extract_! s ==
+     empty? s => error "empty dictionary"
+     x := first(p := parts s)
+     setref(s, rest p)
+     x
+
+   duplicates? s ==
+     empty?(p := parts s) => false
+     q := rest p
+     while not empty? q repeat
+       first p = first q => return true
+       p := q
+       q := rest q
+     false
+
+   remove_!(p: S->Boolean, lmd:%):% ==
+     for x in removeDuplicates parts lmd | p(x) repeat remove_!(x,lmd)
+     lmd
+
+   select_!(p: S->Boolean, lmd:%):% == remove_!((z:S):Boolean+->not p(z), lmd)
+
+   duplicates(lmd:%):List D ==
+     ld: List D := empty()
+     for x in removeDuplicates parts lmd | (n := count(x, lmd)) >
+      1$NonNegativeInteger repeat
+       ld := cons([x, n], ld)
+     ld
+
+   if S has OrderedSet then
+
+      s = t == parts s = parts t
+
+      remove_!(x:S, s:%) ==
+         p := deref s
+         while not empty? p and x = first p repeat p := rest p
+         setref(s, p)
+         empty? p => s
+         q := rest p
+         while not empty? q and x > first q repeat (p := q; q := rest q)
+         while not empty? q and x = first q repeat q := rest q
+         p.rest := q
+         s
+
+      insert_!(x, s) ==
+         p := deref s
+         empty? p or x < first p =>
+            setref(s, concat(x, p))
+            s
+         q := rest p
+         while not empty? q and x > first q repeat (p := q; q := rest q)
+         p.rest := concat(x, q)
+         s
+
+   else
+
+      remove_!(x:S, s:%) == (setref(s, remove_!(x, parts s)); s)
+
+      s = t ==
+         a := copy s
+         while not empty? a repeat
+            x := inspect a
+            count(x, s) ^= count(x, t) => return false
+            remove_!(x, a)
+         true
+
+      insert_!(x, s) ==
+         p := deref s
+         while not empty? p repeat
+            x = first p =>
+               p.rest := concat(x, rest p)
+               s
+            p := rest p
+         setref(s, concat(x, deref s))
+         s
+
 *)
 
 \end{chunk}
@@ -91980,8 +109904,11 @@ LocalAlgebra(A: Algebra R,
           denom: % -> S
             ++ denom x returns the denominator of x.
  == Localize(A, R, S) add
+
         1 == 1$A / 1$S
+
         x:% * y:% == (numer(x) * numer(y)) / (denom(x) * denom(y))
+
         characteristic() == characteristic()$A
 
 \end{chunk}
@@ -91989,6 +109916,14 @@ LocalAlgebra(A: Algebra R,
 \begin{chunk}{COQ LA}
 (* domain LA *)
 (*
+ Localize(A, R, S) add
+
+        1 == 1$A / 1$S
+
+        x:% * y:% == (numer(x) * numer(y)) / (denom(x) * denom(y))
+
+        characteristic() == characteristic()$A
+
 *)
 
 \end{chunk}
@@ -92107,49 +110042,119 @@ Localize(M:Module R,
          ++ denom x returns the denominator of x.
  ==
   add
+
     --representation
+
       Rep:= Record(num:M,den:S)
+
     --declarations
       x,y: %
       n: Integer
       m: M
       r: R
       d: S
+
     --definitions
+
       0 == [0,1]
+
       zero? x == zero? (x.num)
+
       -x== [-x.num,x.den]
+
       x=y == y.den*x.num = x.den*y.num
+
       numer x == x.num
+
       denom x == x.den
+
       if M has OrderedAbelianGroup then
+
         x < y == 
---             if y.den::R < 0 then (x,y):=(y,x)
---             if x.den::R < 0 then (x,y):=(y,x)
              y.den*x.num < x.den*y.num
+
       x+y == [y.den*x.num+x.den*y.num, x.den*y.den]
+
       n*x == [n*x.num,x.den]
+
       r*x == if r=x.den then [x.num,1] else [r*x.num,x.den]
+
       x/d ==
         zero?(u:S:=d*x.den) => error "division by zero"
         [x.num,u]
+
       m/d == if zero? d then error "division by zero" else [m,d]
+
       coerce(x:%):OutputForm ==
---        one?(xd:=x.den) => (x.num)::OutputForm
         ((xd:=x.den) = 1) => (x.num)::OutputForm
         (x.num)::OutputForm / (xd::OutputForm)
+
       latex(x:%): String ==
---        one?(xd:=x.den) => latex(x.num)
         ((xd:=x.den) = 1) => latex(x.num)
         nl : String := concat("{", concat(latex(x.num), "}")$String)$String
         dl : String := concat("{", concat(latex(x.den), "}")$String)$String
-        concat("{ ", concat(nl, concat(" \over ", concat(dl, " }")$String)$String)$String)$String
+        concat("{ ", concat(nl, _
+         concat(" \over ", concat(dl, " }")$String)$String)$String)$String
 
 \end{chunk}
 
 \begin{chunk}{COQ LO}
 (* domain LO *)
 (*
+
+    --representation
+
+      Rep:= Record(num:M,den:S)
+
+    --declarations
+      x,y: %
+      n: Integer
+      m: M
+      r: R
+      d: S
+
+    --definitions
+
+      0 == [0,1]
+
+      zero? x == zero? (x.num)
+
+      -x== [-x.num,x.den]
+
+      x=y == y.den*x.num = x.den*y.num
+
+      numer x == x.num
+
+      denom x == x.den
+
+      if M has OrderedAbelianGroup then
+
+        x < y == 
+             y.den*x.num < x.den*y.num
+
+      x+y == [y.den*x.num+x.den*y.num, x.den*y.den]
+
+      n*x == [n*x.num,x.den]
+
+      r*x == if r=x.den then [x.num,1] else [r*x.num,x.den]
+
+      x/d ==
+        zero?(u:S:=d*x.den) => error "division by zero"
+        [x.num,u]
+
+      m/d == if zero? d then error "division by zero" else [m,d]
+
+      coerce(x:%):OutputForm ==
+        ((xd:=x.den) = 1) => (x.num)::OutputForm
+        (x.num)::OutputForm / (xd::OutputForm)
+
+      latex(x:%): String ==
+        ((xd:=x.den) = 1) => latex(x.num)
+        nl : String := concat("{", concat(latex(x.num), "}")$String)$String
+        dl : String := concat("{", concat(latex(x.den), "}")$String)$String
+        concat("{ ", concat(nl, _
+         concat(" \over ", concat(dl, " }")$String)$String)$String)$String
+
 *)
 
 \end{chunk}
@@ -92637,14 +110642,18 @@ LyndonWord(VarSet:OrderedSet):Public == Private where
         ++ words over the alphabet \axiom{vl}, up to order \axiom{n}.
 
    Private == Magma(VarSet) add
+
      -- Representation
+
        Rep:= Magma(VarSet)
 
      -- Fonctions locales
+
        LetterList : OFMON -> List VarSet
        factor1    : (List $, $, List $) -> List $
 
      -- Definitions
+
        lyndon? w ==
          w = 1$OFMON => false
          f: OFMON := rest w
@@ -92693,6 +110702,7 @@ LyndonWord(VarSet:OrderedSet):Public == Private where
          lx < ly
  
        coerce(x:$):OF == bracket(x::OFMON::OF)
+
        coerce(x:$):Magma VarSet == x::Rep
 
        LyndonWordsList1 (vl,n) ==    -- a ameliorer !!!!!!!!!!!
@@ -92728,6 +110738,98 @@ LyndonWord(VarSet:OrderedSet):Public == Private where
 \begin{chunk}{COQ LWORD}
 (* domain LWORD *)
 (*
+ Magma(VarSet) add
+
+     -- Representation
+
+       Rep:= Magma(VarSet)
+
+     -- Fonctions locales
+
+       LetterList : OFMON -> List VarSet
+       factor1    : (List $, $, List $) -> List $
+
+     -- Definitions
+
+       lyndon? w ==
+         w = 1$OFMON => false
+         f: OFMON := rest w
+         while f ^= 1$OFMON repeat
+           not lexico(w,f) => return false
+           f := rest f
+         true
+
+       lyndonIfCan w ==
+         l: List $ := factor w
+         # l = 1 => first l
+         "failed"
+
+       lyndon w ==
+         l: List $ := factor w
+         # l = 1 => first l
+         error "This word is not a Lyndon word"
+
+       LetterList w ==
+         w = 1 => []
+         cons(first w , LetterList rest w)
+
+       factor1 (gauche, x, droite) == 
+         g: List $ := gauche; d: List $ := droite
+         while not null g repeat             ++ (l in g or l=x) et u in d 
+           lexico(  g.first , x ) =>         ++  => right(l) >= u 
+              x  := g.first *$Rep x          -- crochetage
+              null(d) => g := rest g
+              g := cons( x, rest g)          -- mouvement a droite
+              x  := first d
+              d := rest d
+           d := cons( x , d)                 -- mouvement a gauche
+           x  := first g
+           g := rest g
+         return cons(x, d)
+
+       factor w ==
+         w = 1 => []
+         l : List $ := reverse [ u::$ for u in LetterList w]
+         factor1( rest l, first l , [] )
+      
+       x < y ==                     -- lexicographique par longueur
+         lx,ly: PI
+         lx:= length x ; ly:= length y
+         lx = ly => lexico(x,y)
+         lx < ly
+ 
+       coerce(x:$):OF == bracket(x::OFMON::OF)
+
+       coerce(x:$):Magma VarSet == x::Rep
+
+       LyndonWordsList1 (vl,n) ==    -- a ameliorer !!!!!!!!!!!
+            null vl => error "empty list"
+            base: ARRAY1 List $ := new(n::I::NNI ,[])
+           
+           -- mots de longueur 1
+            lbase1:List $ := [w::$ for w in sort(vl)]
+            base.1 := lbase1
+
+           -- calcul des mots de longueur ll
+            for ll in 2..n:I  repeat 
+               lbase1 := []   
+               for a in base(1) repeat              -- lettre + mot
+                  for b in base(ll-1) repeat
+                     if lexico(a,b) then lbase1:=cons(a*b,lbase1)
+
+               for i in 2..ll-1 repeat              -- mot + mot
+                 for a in base(i) repeat             
+                   for b in base(ll-i) repeat
+                     if lexico(a,b) and (lexico(b,right a) or b = right a ) 
+                     then lbase1:=cons(a*b,lbase1)
+ 
+               base(ll):= sort_!(lexico, lbase1)
+            return base
+           
+       LyndonWordsList (vl,n) ==
+           v:ARRAY1 List $ := LyndonWordsList1(vl,n)
+           "append"/ [v.i for i in 1..n] 
+
 *)
 
 \end{chunk}
@@ -93153,6 +111255,23 @@ MachineComplex():Exports == Implementation where
 \begin{chunk}{COQ MCMPLX}
 (* domain MCMPLX *)
 (*
+ Complex MachineFloat add
+
+    coerce(u:Complex Float):$ == 
+      complex(real(u)::MachineFloat,imag(u)::MachineFloat)
+
+    coerce(u:Complex Integer):$ ==
+      complex(real(u)::MachineFloat,imag(u)::MachineFloat)
+
+    coerce(u:Complex MachineInteger):$ ==
+      complex(real(u)::MachineFloat,imag(u)::MachineFloat)
+
+    coerce(u:Complex MachineFloat):$ == 
+      complex(real(u),imag(u))
+
+    coerce(u:$):Complex Float ==
+      complex(real(u)::Float,imag(u)::Float)
+
 *)
 
 \end{chunk}
@@ -93426,7 +111545,6 @@ MachineFloat(): Exports == Implementation where
     POWER : PI := 53  -- The maximum power of B which will yield P
                       -- decimal digits.
     MMAX  : PI := B**POWER 
-    
 
     -- locals
     locRound:(FI)->I
@@ -93444,6 +111562,7 @@ MachineFloat(): Exports == Implementation where
            positive? exp => man*B**(exp pretend PI)
            zero? exp => man
            wholePart(man/B**((-exp) pretend PI))
+
     normalise(u:$):$ ==
       -- We want the largest possible mantissa, to ensure a canonical
       -- representation.
@@ -93467,6 +111586,7 @@ MachineFloat(): Exports == Implementation where
       checkExponent [-man,exp]$Rep
 
     mantissa(u:$):I == elt(u,mantissa)$Rep
+
     exponent(u:$):I == elt(u,exponent)$Rep
 
     newPower(base:PI,prec:PI):Void ==
@@ -93575,16 +111695,14 @@ MachineFloat(): Exports == Implementation where
     minimumExponent():I == EMIN
 
     0 == [0,0]$Rep
+
     1 == changeBase(0,1,10)
 
     zero?(u:$):Boolean == u=[0,0]$Rep
 
-
-
     f1:$
     f2:$
 
-
     locRound(x:FI):I ==
       abs(fractionPart(x)) >= 1/2 => wholePart(x)+sign(x)
       wholePart(x)
@@ -93600,6 +111718,7 @@ MachineFloat(): Exports == Implementation where
       ((f1::F)**p)::%
 
 --inline
+
     f1 / f2 == 
       zero? f2 => error "division by zero"
       zero? f1 => 0
@@ -93614,7 +111733,9 @@ MachineFloat(): Exports == Implementation where
     divide(f1,f2) == [ f1/f2,0]
 
     f1 quo f2 == f1/f2
+
     f1 rem f2 == 0
+
     u:I * f1 == 
       normalise [u*mantissa(f1),exponent(f1)]$Rep
 
@@ -93660,6 +111781,253 @@ MachineFloat(): Exports == Implementation where
 \begin{chunk}{COQ MFLOAT}
 (* domain MFLOAT *)
 (*
+
+    import F
+    import FI
+
+    Rep := Record(mantissa:I,exponent:I)
+
+    -- Parameters of the Floating Point Representation
+    P : PI := 16      -- Precision
+    B : PI := 2       -- Base
+    EMIN : I := -1021 -- Minimum Exponent
+    EMAX : I :=  1024 -- Maximum Exponent
+
+    -- Useful constants
+    POWER : PI := 53  -- The maximum power of B which will yield P
+                      -- decimal digits.
+    MMAX  : PI := B**POWER 
+
+    -- locals
+    locRound:(FI)->I
+    checkExponent:($)->$
+    normalise:($)->$
+    newPower:(PI,PI)->Void
+ 
+    retractIfCan(u:$):Union(FI,"failed") == 
+      mantissa(u)*(B/1)**(exponent(u))
+
+    wholePart(u:$):Integer ==
+       man:I:=mantissa u
+       exp:I:=exponent u
+       f:=
+           positive? exp => man*B**(exp pretend PI)
+           zero? exp => man
+           wholePart(man/B**((-exp) pretend PI))
+
+    normalise(u:$):$ ==
+      -- We want the largest possible mantissa, to ensure a canonical
+      -- representation.
+      exp : I  := exponent u
+      man : I  := mantissa u
+      BB  : I  := B @ I
+      sgn : I := sign man ; man := abs man
+      zero? man => [0,0]$Rep
+      if man < MMAX then 
+        while man < MMAX repeat
+          exp := exp - 1
+          man := man * BB
+      if man > MMAX then
+        q1:FI:= man/1
+        BBF:FI:=BB/1
+        while wholePart(q1) > MMAX repeat
+          q1:= q1 / BBF
+          exp:=exp + 1
+        man := locRound(q1)  
+      positive?(sgn) => checkExponent [man,exp]$Rep
+      checkExponent [-man,exp]$Rep
+
+    mantissa(u:$):I == elt(u,mantissa)$Rep
+
+    exponent(u:$):I == elt(u,exponent)$Rep
+
+    newPower(base:PI,prec:PI):Void ==
+      power   : PI := 1
+      target  : PI := 10**prec
+      current : PI := base
+      while (current := current*base) < target repeat power := power+1
+      POWER := power
+      MMAX  := B**POWER
+      void()
+
+    changeBase(exp:I,man:I,base:PI):$ ==
+      newExp : I  := 0
+      f      : FI := man*(base @ I)::FI**exp
+      sign   : I  := sign f
+      f      : FI := abs f
+      newMan : I  := wholePart f
+      zero? f => [0,0]$Rep
+      BB     : FI := (B @ I)::FI
+      if newMan < MMAX then
+        while newMan < MMAX repeat
+          newExp := newExp - 1
+          f := f*BB
+          newMan := wholePart f
+      if newMan > MMAX then
+        while newMan > MMAX repeat
+          newExp := newExp + 1
+          f := f/BB
+          newMan := wholePart f
+      [sign*newMan,newExp]$Rep
+
+    checkExponent(u:$):$ ==
+      exponent(u) < EMIN or exponent(u) > EMAX =>
+        message :S := concat(["Exponent out of range: ",
+                              convert(EMIN)@S, "..", convert(EMAX)@S])$S
+        error message
+      u
+    
+    coerce(u:$):OutputForm == 
+      coerce(u::F)
+
+    coerce(u:MachineInteger):$ ==
+      checkExponent changeBase(0,retract(u)@Integer,10)
+
+    coerce(u:$):F ==
+      oldDigits : PI := digits(P)$F
+      r : F := float(mantissa u,exponent u,B)$Float
+      digits(oldDigits)$F
+      r
+    
+    coerce(u:F):$ ==
+      checkExponent changeBase(exponent(u)$F,mantissa(u)$F,base()$F)
+
+    coerce(u:I):$ ==
+       checkExponent changeBase(0,u,10)
+
+    coerce(u:FI):$ == (numer u)::$/(denom u)::$
+
+    retract(u:$):FI == 
+      value : Union(FI,"failed") := retractIfCan(u)
+      value case "failed" => error "Cannot retract to a Fraction Integer"
+      value::FI
+
+    retract(u:$):F == u::F
+
+    retractIfCan(u:$):Union(F,"failed") == u::F::Union(F,"failed")
+
+    retractIfCan(u:$):Union(I,"failed") ==
+      value:FI := mantissa(u)*(B @ I)::FI**exponent(u)
+      zero? fractionPart(value) => wholePart(value)::Union(I,"failed")
+      "failed"::Union(I,"failed")
+
+    retract(u:$):I ==
+      result : Union(I,"failed") := retractIfCan u
+      result = "failed" => error "Not an Integer"
+      result::I
+
+    precision(p: PI):PI ==
+      old : PI := P
+      newPower(B,p)
+      P := p
+      old
+
+    precision():PI == P
+
+    base(b:PI):PI ==
+      old : PI := b
+      newPower(b,P)
+      B := b
+      old
+
+    base():PI == B
+
+    maximumExponent(u:I):I ==
+      old : I := EMAX
+      EMAX := u
+      old
+
+    maximumExponent():I == EMAX
+
+    minimumExponent(u:I):I ==
+      old : I := EMIN
+      EMIN := u
+      old
+
+    minimumExponent():I == EMIN
+
+    0 == [0,0]$Rep
+
+    1 == changeBase(0,1,10)
+
+    zero?(u:$):Boolean == u=[0,0]$Rep
+
+    f1:$
+    f2:$
+
+    locRound(x:FI):I ==
+      abs(fractionPart(x)) >= 1/2 => wholePart(x)+sign(x)
+      wholePart(x)
+
+    recip f1 ==
+      zero? f1 => "failed"
+      normalise [ locRound(B**(2*POWER)/mantissa f1),-(exponent f1 + 2*POWER)]
+    
+    f1 * f2 == 
+      normalise [mantissa(f1)*mantissa(f2),exponent(f1)+exponent(f2)]$Rep
+    
+    f1 **(p:FI) ==
+      ((f1::F)**p)::%
+
+--inline
+
+    f1 / f2 == 
+      zero? f2 => error "division by zero"
+      zero? f1 => 0
+      f1=f2 => 1
+      normalise [locRound(mantissa(f1)*B**(2*POWER)/mantissa(f2)),
+         exponent(f1)-(exponent f2 + 2*POWER)]
+    
+    inv(f1) == 1/f1
+
+    f1 exquo f2 == f1/f2
+
+    divide(f1,f2) == [ f1/f2,0]
+
+    f1 quo f2 == f1/f2
+
+    f1 rem f2 == 0
+
+    u:I * f1 == 
+      normalise [u*mantissa(f1),exponent(f1)]$Rep
+
+    f1 = f2 == mantissa(f1)=mantissa(f2) and exponent(f1)=exponent(f2)
+
+    f1 + f2 == 
+      m1 : I := mantissa f1
+      m2 : I := mantissa f2
+      e1 : I := exponent f1
+      e2 : I := exponent f2
+      e1 > e2 => 
+--insignificance
+         e1 > e2 + POWER + 2 => 
+               zero? f1 => f2
+               f1 
+         normalise [m1*(B @ I)**((e1-e2) pretend NNI)+m2,e2]$Rep
+      e2 > e1 + POWER +2 => 
+               zero? f2 => f1
+               f2
+      normalise [m2*(B @ I)**((e2-e1) pretend NNI)+m1,e1]$Rep
+
+    - f1 == [- mantissa f1,exponent f1]$Rep
+
+    f1 - f2 == f1 + (-f2)
+
+    f1 < f2 == 
+      m1 : I := mantissa f1
+      m2 : I := mantissa f2
+      e1 : I := exponent f1
+      e2 : I := exponent f2
+      sign(m1) = sign(m2) =>
+        e1 < e2 => true
+        e1 = e2 and m1 < m2 => true
+        false
+      sign(m1) = 1 => false
+      sign(m1) = 0 and sign(m2) = -1 => false
+      true
+
+    characteristic():NNI == 0
+
 *)
 
 \end{chunk}
@@ -93917,6 +112285,30 @@ MachineInteger(): Exports == Implementation where
 \begin{chunk}{COQ MINT}
 (* domain MINT *)
 (*
+
+    MAXINT : PositiveInteger := 2**32
+
+    maxint():PositiveInteger == MAXINT
+
+    maxint(new:PositiveInteger):PositiveInteger ==
+      old := MAXINT
+      MAXINT := new
+      old
+
+    coerce(u:Expression Integer):Expression($) ==
+      map(coerce,u)$ExpressionFunctions2(Integer,$)
+
+    coerce(u:Integer):$ ==
+      import S
+      abs(u) > MAXINT => 
+        message: S := concat [convert(u)@S,"  > MAXINT(",convert(MAXINT)@S,")"]
+        error message
+      u pretend $
+
+    retract(u:$):Integer == u pretend Integer
+
+    retractIfCan(u:$):Union(Integer,"failed") == u pretend Integer
+
 *)
 
 \end{chunk}
@@ -94335,10 +112727,12 @@ Magma(VarSet:OrderedSet):Public == Private where
         ++ \axiom{right(x)} returns right subtree of \axiom{x} or 
         ++ error if retractable?(x) is true.
       varList       : $ -> List VarSet
-        ++ \axiom{varList(x)} returns the list of distinct entries of \axiom{x}.
+        ++ \axiom{varList(x)} returns the list of distinct entries of \axiom{x}
 
    Private == add
+
     -- representation
+
       VWORD := Record(left:$ ,right:$)
       Rep:= Union(VarSet,VWORD)  
 
@@ -94371,6 +112765,7 @@ Magma(VarSet:OrderedSet):Public == Private where
          error "Not retractable"
 
       retractIfCan x == (retractable? x => x::VarSet ; "failed")
+
       coerce(l:VarSet):$  == l
 
       mirror x ==
@@ -94429,6 +112824,95 @@ Magma(VarSet:OrderedSet):Public == Private where
 \begin{chunk}{COQ MAGMA}
 (* domain MAGMA *)
 (*
+
+    -- representation
+
+      VWORD := Record(left:$ ,right:$)
+      Rep:= Union(VarSet,VWORD)  
+
+      recursif: ($,$) -> Boolean
+
+    -- define
+      x:$ = y:$ ==
+        x case VarSet => 
+           y case VarSet => x::VarSet = y::VarSet
+           false
+        y case VWORD => x::VWORD = y::VWORD
+        false
+ 
+      varList x == 
+        x case VarSet => [x::VarSet]
+        lv: List VarSet := setUnion(varList x.left, varList x.right)
+        sort_!(lv)
+
+      left x == 
+        x case VarSet => error "x has only one entry"
+        x.left
+
+      right x == 
+        x case VarSet => error "x has only one entry"
+        x.right
+      retractable? x == (x case VarSet)
+
+      retract x ==
+         x case VarSet => x::VarSet
+         error "Not retractable"
+
+      retractIfCan x == (retractable? x => x::VarSet ; "failed")
+
+      coerce(l:VarSet):$  == l
+
+      mirror x ==
+        x case VarSet => x
+        [mirror x.right, mirror x.left]$VWORD
+
+      coerce(x:$): WORD ==
+        x case VarSet => x::VarSet::WORD
+        x.left::WORD * x.right::WORD
+
+      coerce(x:$):EX ==
+         x case VarSet => x::VarSet::EX
+         bracket [x.left::EX, x.right::EX]
+
+      x * y == [x,y]$VWORD
+
+      first x ==
+         x case VarSet => x::VarSet
+         first x.left
+
+      rest x ==
+         x case VarSet => error "rest$Magma: inexistant rest"
+         lx:$ := x.left
+         lx case VarSet => x.right
+         [rest lx , x.right]$VWORD
+
+      length x ==
+         x case VarSet => 1
+         length(x.left) + length(x.right)
+
+      recursif(x,y) ==    
+         x case VarSet => 
+            y case VarSet => x::VarSet < y::VarSet
+            true
+         y case VarSet => false
+         x.left =  y.left =>  x.right <  y.right
+         x.left < y.left
+
+      lexico(x,y) ==      -- peut etre amelioree !!!!!!!!!!!
+         x case VarSet => 
+            y case VarSet => x::VarSet < y::VarSet
+            x::VarSet <= first y
+         y case VarSet => first x < retract y
+         fx:VarSet := first x ; fy:VarSet := first y 
+         fx = fy => lexico(rest x , rest y)
+         fx < fy 
+
+      x < y ==           -- recursif par longueur
+         lx,ly: PositiveInteger
+         lx:= length x ; ly:= length y
+         lx = ly => recursif(x,y)
+         lx < ly 
+
 *)
 
 \end{chunk}
@@ -94523,6 +113007,7 @@ MakeCachableSet(S:SetCategory): Exports == Implementation where
       ++ coerce(s) returns s viewed as an element of %.
 
   Implementation ==> add
+
     import SortedCache(%)
 
     Rep := Record(setpart: S, pos: NonNegativeInteger)
@@ -94530,9 +113015,13 @@ MakeCachableSet(S:SetCategory): Exports == Implementation where
     clearCache()
 
     position x             == x.pos
+
     setPosition(x, n)      == (x.pos := n; void)
+
     coerce(x:%):S          == x.setpart
+
     coerce(x:%):OutputForm == x::S::OutputForm
+
     coerce(s:S):%          == enterInCache([s, 0]$Rep, x+->(s = x::S))
 
     x < y ==
@@ -94550,6 +113039,33 @@ MakeCachableSet(S:SetCategory): Exports == Implementation where
 \begin{chunk}{COQ MKCHSET}
 (* domain MKCHSET *)
 (*
+
+    import SortedCache(%)
+
+    Rep := Record(setpart: S, pos: NonNegativeInteger)
+
+    clearCache()
+
+    position x             == x.pos
+
+    setPosition(x, n)      == (x.pos := n; void)
+
+    coerce(x:%):S          == x.setpart
+
+    coerce(x:%):OutputForm == x::S::OutputForm
+
+    coerce(s:S):%          == enterInCache([s, 0]$Rep, x+->(s = x::S))
+
+    x < y ==
+      if position(x) = 0 then enterInCache(x, x1+->(x::S = x1::S))
+      if position(y) = 0 then enterInCache(y, x1+->(y::S = x1::S))
+      position(x) < position(y)
+
+    x = y ==
+      if position(x) = 0 then enterInCache(x, x1+->(x::S = x1::S))
+      if position(y) = 0 then enterInCache(y, x1+->(y::S = x1::S))
+      position(x) = position(y)
+
 *)
 
 \end{chunk}
@@ -95192,6 +113708,7 @@ returning Void.  I really only need the one coerce function.
 \subsection{Private Function Definitions}
 
 \subsubsection{Display Functions}
+\begin{chunk}{display functions}
 
     displayElt(mathml:S):Void
 
@@ -95201,8 +113718,6 @@ returning Void.  I really only need the one coerce function.
 
     tagEnd(name:S,pos:I,mathml:S):I
 
-\begin{chunk}{display functions}
-
     displayElt(mathML:S): Void ==
       -- Takes a string of syntactically complete mathML
       -- and formats it for display.
@@ -95355,7 +113870,6 @@ have to be switched by swapping names.
       str
 
     postcondition(str: S): S ==
---      str := ungroup str
       len : I := #str
       plusminus : S := "<mo>+</mo><mo>-</mo>"
       pos : I := position(plusminus,str,1)
@@ -95402,7 +113916,7 @@ have to be switched by swapping names.
           "<mo>/</mo>",formatMml(second args,prec)]
       op = "VCONCAT" =>
         group concat("<mtable><mtr>",
-                     concat(concat([concat("<mtd>",concat(formatMml(u, minPrec),"</mtd>"))
+          concat(concat([concat("<mtd>",concat(formatMml(u, minPrec),"</mtd>"))
                                     for u in args]::L S),
                             "</mtr></mtable>"))
       op = "CONCATB" =>
@@ -96221,6 +114735,805 @@ o )show MathMLFormat
 \begin{chunk}{COQ MMLFORM}
 (* domain MMLFORM *)
 (*
+
+    displayElt(mathml:S):Void
+
+    eltName(pos:I,mathml:S):S
+
+    eltLimit(name:S,pos:I,mathml:S):I
+
+    tagEnd(name:S,pos:I,mathml:S):I
+
+    displayElt(mathML:S): Void ==
+      -- Takes a string of syntactically complete mathML
+      -- and formats it for display.
+--      sayTeX$Lisp "****displayElt1****"
+--      sayTeX$Lisp mathML
+      enT:I -- marks end of tag, e.g. "<name>"
+      enE:I -- marks end of element, e.g. "<name> ... </name>"
+      end:I -- marks end of mathML string
+      u:US
+      end := #mathML
+      length:I := 60
+--      sayTeX$Lisp "****displayElt1.1****"
+      name:S := eltName(1,mathML)
+--      sayTeX$Lisp name
+--      sayTeX$Lisp concat("****displayElt1.2****",name)
+      enE := eltLimit(name,2+#name,mathML)
+--      sayTeX$Lisp "****displayElt2****"
+      if enE < length then
+--        sayTeX$Lisp "****displayElt3****"
+        u := segment(1,enE)$US
+        sayTeX$Lisp mathML.u
+      else
+--        sayTeX$Lisp "****displayElt4****"
+        enT := tagEnd(name,1,mathML)
+        u := segment(1,enT)$US
+        sayTeX$Lisp mathML.u
+        u := segment(enT+1,enE-#name-3)$US
+        displayElt(mathML.u)
+        u := segment(enE-#name-2,enE)$US
+        sayTeX$Lisp mathML.u
+      if end > enE then
+--        sayTeX$Lisp "****displayElt5****"
+        u := segment(enE+1,end)$US
+        displayElt(mathML.u)
+
+      void()$Void
+
+    eltName(pos:I,mathML:S): S ==
+      -- Assuming pos is the position of "<" for a start tag of a mathML
+      -- element finds and returns the element's name.
+      i:I := pos+1
+      --sayTeX$Lisp "eltName:mathmML string: "mathML
+      while member?(mathML.i,lowerCase()$CharacterClass)$CharacterClass repeat
+         i := i+1
+      u:US := segment(pos+1,i-1)
+      name:S := mathML.u
+
+    eltLimit(name:S,pos:I,mathML:S): I ==
+      -- Finds the end of a mathML element like "<name ...> ... </name>"
+      -- where pos is the position of the space after name in the start tag
+      -- although it could point to the closing ">".  Returns the position
+      -- of the ">" in the end tag.
+      pI:I := pos
+      startI:I
+      endI:I
+      startS:S := concat ["<",name]
+      endS:S := concat ["</",name,">"]
+      level:I := 1
+      --sayTeX$Lisp "eltLimit: element name: "name
+      while (level > 0) repeat
+        startI := position(startS,mathML,pI)$String
+
+        endI := position(endS,mathML,pI)$String
+
+        if (startI = 0) then
+          level := level-1
+          --sayTeX$Lisp "****eltLimit 1******"
+          pI := tagEnd(name,endI,mathML)
+        else
+          if (startI < endI) then
+            level := level+1
+            pI := tagEnd(name,startI,mathML)
+          else
+            level := level-1
+            pI := tagEnd(name,endI,mathML)
+      pI
+
+
+    tagEnd(name:S,pos:I,mathML:S):I ==
+      -- Finds the closing ">" for either a start or end tag of a mathML
+      -- element, so the return value is the position of ">" in mathML.
+      pI:I := pos
+      while  (mathML.pI ^= char ">") repeat
+        pI := pI+1
+      u:US := segment(pos,pI)$US
+      --sayTeX$Lisp "tagEnd: "mathML.u
+      pI
+
+    atomize(expr : E): L E ==
+      -- This breaks down an expression into a flat list of atomic expressions.
+      -- expr should be preconditioned.
+      le : L E := nil()
+      a : E
+      letmp : L E
+      (ATOM(expr)$Lisp@Boolean) or (stringify expr = "NOTHING") => 
+        le := append(le,list(expr))
+      letmp := expr pretend L E
+      for a in letmp repeat
+        le := append(le,atomize a)
+      le
+
+    ungroup(str: S): S ==
+      len : I := #str
+      len < 14 => str
+      lrow : S :=  "<mrow>"
+      rrow : S :=  "</mrow>"
+      -- drop leading and trailing mrows
+      u1 : US := segment(1,6)$US
+      u2 : US := segment(len-6,len)$US
+      if (str.u1 =$S lrow) and (str.u2 =$S rrow) then
+        u : US := segment(7,len-7)$US
+        str := str.u
+      str
+
+    postcondition(str: S): S ==
+      len : I := #str
+      plusminus : S := "<mo>+</mo><mo>-</mo>"
+      pos : I := position(plusminus,str,1)
+      if pos > 0 then
+        ustart:US := segment(1,pos-1)$US
+        uend:US := segment(pos+20,len)$US
+        str := concat [str.ustart,"<mo>-</mo>",str.uend]
+        if pos < len-18 then
+          str := postcondition(str)
+      str
+
+    stringify expr == (mathObject2String$Lisp expr)@S
+
+    group str ==
+      concat ["<mrow>",str,"</mrow>"]
+
+    addBraces str ==
+      concat ["<mo>{</mo>",str,"<mo>}</mo>"]
+
+    addBrackets str ==
+      concat ["<mo>[</mo>",str,"<mo>]</mo>"]
+
+    parenthesize str ==
+      concat ["<mo>(</mo>",str,"<mo>)</mo>"]
+
+    precondition expr ==
+      outputTran$Lisp expr
+
+    formatSpecial(op : S, args : L E, prec : I) : S ==
+      arg : E
+      prescript : Boolean := false
+      op = "theMap" => "<mtext>theMap(...)</mtext>"
+      op = "AGGLST" =>
+        formatNary(",",args,prec)
+      op = "AGGSET" =>
+        formatNary(";",args,prec)
+      op = "TAG" =>
+        group concat [formatMml(first args,prec),
+                      "<mo>&#x02192;</mo>",
+                        formatMml(second args,prec)]
+                     --RightArrow
+      op = "SLASH" =>
+        group concat [formatMml(first args,prec),
+          "<mo>/</mo>",formatMml(second args,prec)]
+      op = "VCONCAT" =>
+        group concat("<mtable><mtr>",
+          concat(concat([concat("<mtd>",concat(formatMml(u, minPrec),"</mtd>"))
+                                    for u in args]::L S),
+                            "</mtr></mtable>"))
+      op = "CONCATB" =>
+        formatNary(" ",args,prec)
+      op = "CONCAT" =>
+        formatNary("",args,minPrec)
+      op = "QUOTE" =>
+        group concat("<mo>'</mo>",formatMml(first args, minPrec))
+      op = "BRACKET" =>
+        group addBrackets ungroup formatMml(first args, minPrec)
+      op = "BRACE" =>
+        group addBraces ungroup formatMml(first args, minPrec)
+      op = "PAREN" =>
+        group parenthesize ungroup formatMml(first args, minPrec)
+      op = "OVERBAR" =>
+        null args => ""
+        group concat ["<mover accent='true'><mrow>",_
+                      formatMml(first args,minPrec),_
+                      "</mrow><mo stretchy='true'>&#x000AF;</mo></mover>"]
+        --OverBar
+      op = "ROOT" =>
+        null args => ""
+        tmp : S := group formatMml(first args, minPrec)
+        null rest args => concat ["<msqrt>",tmp,"</msqrt>"]
+        group concat
+          ["<mroot><mrow>",tmp,"</mrow>",_
+            formatMml(first rest args, minPrec),"</mroot>"]
+      op = "SEGMENT" =>
+        tmp : S := concat [formatMml(first args, minPrec),"<mo>..</mo>"]
+        group
+          null rest args =>  tmp
+          concat [tmp,formatMml(first rest args, minPrec)]
+      -- SUB should now be diverted in formatMml although I'll leave
+      -- the code here for now.
+      op = "SUB" =>
+        group concat ["<msub>",formatMml(first args, minPrec),
+          formatSpecial("AGGLST",rest args,minPrec),"</msub>"]
+      -- SUPERSUB should now be diverted in formatMml although I'll leave
+      -- the code here for now.
+      op = "SUPERSUB" =>
+        base:S := formatMml(first args, minPrec)
+        args := rest args
+        if #args = 1 then
+           "<msub><mrow>"base"</mrow><mrow>"_
+            formatMml(first args, minPrec)"</mrow></msub>"
+        else if #args = 2 then
+        -- it would be nice to substitue &#x2032; for , in the case of
+        -- an ordinary derivative, it looks a lot better.
+          "<msubsup><mrow>"base"</mrow><mrow>"_
+           formatMml(first args,minPrec)_
+            "</mrow><mrow>"_
+             formatMml(first rest args, minPrec)_
+              "</mrow></msubsup>"
+        else if #args = 3 then
+          "<mmultiscripts><mrow>"base"</mrow><mrow>"_
+           formatMml(first args,minPrec)"</mrow><mrow>"_
+            formatMml(first rest args,minPrec)"</mrow><mprescripts/><mrow>"_
+             formatMml(first rest rest args,minPrec)_
+              "</mrow><none/></mmultiscripts>"
+        else if #args = 4 then
+         "<mmultiscripts><mrow>"base"</mrow><mrow>"_
+           formatMml(first args,minPrec)"</mrow><mrow>"_
+            formatMml(first rest args,minPrec)"</mrow><mprescripts/><mrow>"_
+             formatMml(first rest rest args,minPrec)_
+              "</mrow><mrow>"formatMml(first rest rest rest args,minPrec)_
+               "</mrow></mmultiscripts>"
+        else
+          "<mtext>Problem with multiscript object</mtext>"
+      op = "SC" =>
+        -- need to handle indentation someday
+        null args => ""
+        tmp := formatNaryNoGroup("</mtd></mtr><mtr><mtd>", args, minPrec)
+        group concat ["<mtable><mtr><mtd>",tmp,"</mtd></mtr></mtable>"]
+      op = "MATRIX" => formatMatrix rest args
+      op = "ZAG" =>
+-- {{+}{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}
+-- {{ZAG}{1}{25}}{{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
+-- to format continued fraction traditionally need to intercept it at the
+-- formatNary of the "+"
+        concat [" \zag{",formatMml(first args, minPrec),"}{",
+          formatMml(first rest args,minPrec),"}"]
+      concat ["<mtext>not done yet for: ",op,"</mtext>"]
+
+    formatSub(expr : E, args : L E, opPrec : I) : S ==
+      -- This one produces differential notation partial derivatives.
+      -- It doesn't work in all cases and may not be workable, use
+      -- formatSub1 below for now.
+      -- At this time this is only to handle partial derivatives.
+      -- If the SUB case handles anything else I'm not aware of it.
+      -- This an example of the 4th partial of y(x,z) w.r.t. x,x,z,x
+      -- {{{SUB}{y}{{CONCAT}{{CONCAT}{{CONCAT}{{CONCAT}{,}{1}}
+      -- {{CONCAT}{,}{1}}}{{CONCAT}{,}{2}}}{{CONCAT}{,}{1}}}}{x}{z}}
+      atomE : L E := atomize(expr)      
+      op : S := stringify first atomE
+      op ^= "SUB" => "<mtext>Mistake in formatSub: no SUB</mtext>"
+      stringify first rest rest atomE ^= "CONCAT" => _
+         "<mtext>Mistake in formatSub: no CONCAT</mtext>"
+      -- expecting form for atomE like
+      --[{SUB}{func}{CONCAT}...{CONCAT}{,}{n}{CONCAT}{,}{n}...{CONCAT}{,}{n}],
+      --counting the first CONCATs before the comma gives the number of
+      --derivatives
+      ndiffs : I := 0
+      tmpLE : L E := rest rest atomE
+      while stringify first tmpLE = "CONCAT" repeat
+        ndiffs := ndiffs+1
+        tmpLE := rest tmpLE
+      numLS : L S := nil
+      i : I := 1
+      while i < ndiffs repeat
+        numLS := append(numLS,list(stringify first rest tmpLE))
+        tmpLE := rest rest rest tmpLE
+        i := i+1
+      numLS := append(numLS,list(stringify first rest tmpLE))
+      -- numLS contains the numbers of the bound variables as strings
+      -- for the differentiations, thus for the differentiation [x,x,z,x]
+      -- for y(x,z) numLS = ["1","1","2","1"]
+      posLS : L S := nil
+      i := 0
+ --     sayTeX$Lisp "formatSub: nargs = "string(#args)
+      while i < #args repeat
+        posLS := append(posLS,list(string(i+1)))
+        i := i+1
+      -- posLS contains the positions of the bound variables in args
+      -- as a list of strings, e.g. for the above example ["1","2"]
+      tmpS: S := stringify atomE.2
+      if ndiffs = 1 then
+        s : S := "<mfrac><mo>&#x02202;</mo><mi>"tmpS"</mi><mrow>"
+      else        
+        s : S := "<mfrac><mrow><msup><mo>&#x02202;</mo><mn>"string(ndiffs)"</mn></msup><mi>"tmpS"</mi></mrow><mrow>"
+      -- need to find the order of the differentiation w.r.t. the i-th
+      -- variable
+      i := 1
+      j : I
+      k : I
+      tmpS: S
+      while i < #posLS+1 repeat
+        j := 0
+        k := 1
+        while k < #numLS + 1 repeat
+          if numLS.k = string i then j := j + 1
+          k := k+1
+        if j > 0 then
+          tmpS := stringify args.i
+          if j = 1 then
+            s := s"<mo>&#x02202;</mo><mi>"tmpS"</mi>"
+          else
+            s := s"<mo>&#x02202;</mo><msup><mi>"tmpS_
+                  "</mi><mn>"string(j)"</mn></msup>"
+        i := i + 1
+      s := s"</mrow></mfrac><mo>(</mo>"
+      i := 1
+      while i < #posLS+1 repeat
+        tmpS := stringify args.i
+        s := s"<mi>"tmpS"</mi>"
+        if i < #posLS then s := s"<mo>,</mo>"
+        i := i+1
+      s := s"<mo>)</mo>"
+
+    formatSub1(expr : E, args : L E, opPrec : I) : S ==
+      -- This one produces partial derivatives notated by ",n" as
+      -- subscripts.
+      -- At this time this is only to handle partial derivatives.
+      -- If the SUB case handles anything else I'm not aware of it.
+      -- This an example of the 4th partial of y(x,z) w.r.t. x,x,z,x
+      -- {{{SUB}{y}{{CONCAT}{{CONCAT}{{CONCAT}{{CONCAT}{,}{1}}
+      -- {{CONCAT}{,}{1}}}{{CONCAT}{,}{2}}}{{CONCAT}{,}{1}}}}{x}{z}},
+      -- here expr is everything in the first set of braces and 
+      -- args is {{x}{z}}
+      atomE : L E := atomize(expr)      
+      op : S := stringify first atomE
+      op ^= "SUB" => "<mtext>Mistake in formatSub: no SUB</mtext>"
+      stringify first rest rest atomE ^= "CONCAT" => "<mtext>Mistake in formatSub: no CONCAT</mtext>"
+      -- expecting form for atomE like
+      --[{SUB}{func}{CONCAT}...{CONCAT}{,}{n}{CONCAT}{,}{n}...{CONCAT}{,}{n}],
+      --counting the first CONCATs before the comma gives the number of
+      --derivatives
+      ndiffs : I := 0
+      tmpLE : L E := rest rest atomE
+      while stringify first tmpLE = "CONCAT" repeat
+        ndiffs := ndiffs+1
+        tmpLE := rest tmpLE
+      numLS : L S := nil
+      i : I := 1
+      while i < ndiffs repeat
+        numLS := append(numLS,list(stringify first rest tmpLE))
+        tmpLE := rest rest rest tmpLE
+        i := i+1
+      numLS := append(numLS,list(stringify first rest tmpLE))
+      -- numLS contains the numbers of the bound variables as strings
+      -- for the differentiations, thus for the differentiation [x,x,z,x]
+      -- for y(x,z) numLS = ["1","1","2","1"]
+      posLS : L S := nil
+      i := 0
+ --     sayTeX$Lisp "formatSub: nargs = "string(#args)
+      while i < #args repeat
+        posLS := append(posLS,list(string(i+1)))
+        i := i+1
+      -- posLS contains the positions of the bound variables in args
+      -- as a list of strings, e.g. for the above example ["1","2"]
+      funcS: S := stringify atomE.2
+      s : S := "<msub><mi>"funcS"</mi><mrow>"
+      i := 1
+      while i < #numLS+1 repeat
+        s := s"<mo>,</mo><mn>"numLS.i"</mn>"
+        i := i + 1
+      s := s"</mrow></msub><mo>(</mo>"
+      i := 1
+      while i < #posLS+1 repeat
+--        tmpS := stringify args.i
+        tmpS := formatMml(first args,minPrec)
+        args := rest args
+        s := s"<mi>"tmpS"</mi>"
+        if i < #posLS then s := s"<mo>,</mo>"
+        i := i+1
+      s := s"<mo>)</mo>"
+
+    formatSuperSub(expr : E, args : L E, opPrec : I) : S ==
+      -- this produces prime notation ordinary derivatives.
+      -- first have to divine the semantics, add cases as needed
+--      WriteLine$Lisp "SuperSub1 begin"
+      atomE : L E := atomize(expr)      
+      op : S := stringify first atomE
+--      WriteLine$Lisp "op: "op
+      op ^= "SUPERSUB" => _
+          "<mtext>Mistake in formatSuperSub: no SUPERSUB1</mtext>"
+      #args ^= 1 => "<mtext>Mistake in SuperSub1: #args <> 1</mtext>"
+      var : E := first args
+      -- should be looking at something like {{SUPERSUB}{var}{ }{,,...,}} for
+      -- example here's the second derivative of y w.r.t. x
+      -- {{{SUPERSUB}{y}{ }{,,}}{x}}, expr is the first {} and args is the
+      -- {x}
+      funcS : S := stringify first rest atomE
+--      WriteLine$Lisp "funcS: "funcS
+      bvarS : S := stringify first args
+--      WriteLine$Lisp "bvarS: "bvarS
+      -- count the number of commas
+      commaS : S := stringify first rest rest rest atomE
+      commaTest : S := ","
+      i : I := 0
+      while position(commaTest,commaS,1) > 0 repeat
+        i := i+1
+        commaTest := commaTest","
+      s : S := "<msup><mi>"funcS"</mi><mrow>"
+--      WriteLine$Lisp "s: "s
+      j : I := 0
+      while j < i repeat
+        s := s"<mo>&#x02032;</mo>"
+        j := j + 1
+      s := s"</mrow></msup><mo>&#x02061;</mo><mo>(</mo>"_
+            formatMml(first args,minPrec)"<mo>)</mo>"
+
+    formatSuperSub1(expr : E, args : L E, opPrec : I) : S ==
+      -- This one produces ordinary derivatives with differential notation,
+      -- it needs a little more work yet.
+      -- first have to divine the semantics, add cases as needed
+--      WriteLine$Lisp "SuperSub begin"
+      atomE : L E := atomize(expr)      
+      op : S := stringify first atomE
+      op ^= "SUPERSUB" => _
+         "<mtext>Mistake in formatSuperSub: no SUPERSUB</mtext>"
+      #args ^= 1 => "<mtext>Mistake in SuperSub: #args <> 1</mtext>"
+      var : E := first args
+      -- should be looking at something like {{SUPERSUB}{var}{ }{,,...,}} for
+      -- example here's the second derivative of y w.r.t. x
+      -- {{{SUPERSUB}{y}{ }{,,}}{x}}, expr is the first {} and args is the
+      -- {x}
+      funcS : S := stringify first rest atomE
+      bvarS : S := stringify first args
+      -- count the number of commas
+      commaS : S := stringify first rest rest rest atomE
+      commaTest : S := ","
+      ndiffs : I := 0
+      while position(commaTest,commaS,1) > 0 repeat
+        ndiffs := ndiffs+1
+        commaTest := commaTest","
+      s : S := "<mfrac><mrow><msup><mo>&#x02146;</mo><mn>"string(ndiffs)_
+       "</mn></msup><mi>"funcS"</mi></mrow><mrow><mo>&#x02146;</mo><msup><mi>"_
+        formatMml(first args,minPrec)"</mi><mn>"string(ndiffs)_
+         "</mn></msup></mrow></mfrac><mo>&#x02061;</mo><mo>(</mo><mi>"_
+          formatMml(first args,minPrec)"</mi><mo>)</mo>"
+
+    formatPlex(op : S, args : L E, prec : I) : S ==
+      checkarg:Boolean := false
+      hold : S
+      p : I := position(op,plexOps)
+      p < 1 => error "unknown plex op"
+      op = "INTSIGN" => formatIntSign(args,minPrec)
+      opPrec := plexPrecs.p
+      n : I := #args
+      (n ^= 2) and (n ^= 3) => error "wrong number of arguments for plex"
+      s : S :=
+        op = "SIGMA"   => 
+         checkarg := true
+         "<mo>&#x02211;</mo>"
+        -- Sum
+        op = "SIGMA2"   => 
+         checkarg := true
+         "<mo>&#x02211;</mo>"
+        -- Sum
+        op = "PI"      => 
+         checkarg := true
+         "<mo>&#x0220F;</mo>"
+        -- Product
+        op = "PI2"     => 
+         checkarg := true
+         "<mo>&#x0220F;</mo>"
+        -- Product
+--        op = "INTSIGN" => "<mo>&#x0222B;</mo>"
+        -- Integral, int
+        op = "INDEFINTEGRAL" => "<mo>&#x0222B;</mo>"
+        -- Integral, int
+        "????"
+      hold := formatMml(first args,minPrec)
+      args := rest args
+      if op ^= "INDEFINTEGRAL" then
+        if hold ^= "" then
+          s := concat ["<munderover>",s,group hold]
+        else
+          s := concat ["<munderover>",s,group " "]
+        if not null rest args then
+          hold := formatMml(first args,minPrec)
+          if hold ^= "" then
+            s := concat [s,group hold,"</munderover>"]
+          else
+            s := concat [s,group " ","</munderover>"]
+          args := rest args
+        -- if checkarg true need to test op arg for "+" at least
+        -- and wrap parentheses if so
+        if checkarg then
+          la : L E := (first args pretend L E)
+          opa : S := stringify first la
+          if opa = "+" then
+            s := 
+             concat [s,"<mo>(</mo>",formatMml(first args,minPrec),"<mo>)</mo>"]
+          else s := concat [s,formatMml(first args,minPrec)]
+        else s := concat [s,formatMml(first args,minPrec)]
+      else
+        hold := group concat [hold,formatMml(first args,minPrec)]
+        s := concat [s,hold]
+--      if opPrec < prec then s := parenthesize s
+-- getting ugly parentheses on fractions
+      group s
+
+    formatIntSign(args : L E, opPrec : I) : S ==
+      -- the original OutputForm expression looks something like this:
+      -- {{INTSIGN}{NOTHING or lower limit?}
+      -- {bvar or upper limit?}{{*}{integrand}{{CONCAT}{d}{axiom var}}}}
+      -- the args list passed here consists of the rest of this list, i.e.
+      -- starting at the NOTHING or ...
+      (stringify first args) = "NOTHING" =>
+        -- the bound variable is the second one in the argument list
+        bvar : E := first rest args
+        bvarS : S := stringify bvar
+        tmpS : S
+        i : I := 0
+        u1 : US
+        u2 : US
+        -- this next one atomizes the integrand plus differential
+        atomE : L E := atomize(first rest rest args)
+        -- pick out the bound variable used by axiom
+        varRS : S := stringify last(atomE)
+        tmpLE : L E := ((first rest rest args) pretend L E)
+        integrand : S := formatMml(first rest tmpLE,minPrec)
+        -- replace the bound variable, i.e. axiom uses someting of the form
+        -- %A for the bound variable and puts the original variable used
+        -- in the input command as a superscript on the integral sign.
+        -- I'm assuming that the axiom variable is 2 characters.
+        while (i := position(varRS,integrand,i+1)) > 0 repeat
+          u1 := segment(1,i-1)$US
+          u2 := segment(i+2,#integrand)$US
+          integrand := concat [integrand.u1,bvarS,integrand.u2]
+        concat ["<mrow><mo>&#x0222B;</mo>" integrand _
+                "<mo>&#x02146;</mo><mi>" bvarS "</mi></mrow>"]
+
+      lowlim : S := stringify first args
+      highlim : S := stringify first rest args
+      bvar : E := last atomize(first rest rest args)
+      bvarS : S := stringify bvar
+      tmpLE : L E := ((first rest rest args) pretend L E)
+      integrand : S := formatMml(first rest tmpLE,minPrec)
+      concat ["<mrow><munderover><mo>&#x0222B;</mo><mi>" lowlim "</mi><mi>" highlim "</mi></munderover>" integrand "<mo>&#x02146;</mo><mi>" bvarS "</mi></mrow>"] 
+
+
+    formatMatrix(args : L E) : S ==
+      -- format for args is [[ROW ...],[ROW ...],[ROW ...]]
+      -- generate string for formatting columns (centered)
+      group addBrackets concat
+        ["<mtable><mtr><mtd>",formatNaryNoGroup("</mtd></mtr><mtr><mtd>",args,minPrec),
+          "</mtd></mtr></mtable>"]
+
+    formatFunction(op : S, args : L E, prec : I) : S ==
+      group concat ["<mo>",op,"</mo>",parenthesize formatNary(",",args,minPrec)]
+
+    formatNullary(op : S) ==
+      op = "NOTHING" => ""
+      group concat ["<mo>",op,"</mo><mo>(</mo><mo>)</mo>"]
+
+    formatUnary(op : S, arg : E, prec : I) ==
+      p : I := position(op,unaryOps)
+      p < 1 => error "unknown unary op"
+      opPrec := unaryPrecs.p
+      s : S := concat ["<mo>",op,"</mo>",formatMml(arg,opPrec)]
+      opPrec < prec => group parenthesize s
+      op = "-" => s
+      group s
+
+    formatBinary(op : S, args : L E, prec : I) : S ==
+      p : I := position(op,binaryOps)
+      p < 1 => error "unknown binary op"
+      opPrec := binaryPrecs.p
+      -- if base op is product or sum need to add parentheses
+      if ATOM(first args)$Lisp@Boolean then
+        opa:S := stringify first args
+      else
+        la : L E := (first args pretend L E)
+        opa : S := stringify first la
+      if (opa = "SIGMA" or opa = "SIGMA2" or opa = "PI" or opa = "PI2") _
+         and op = "**" then
+        s1:S:=concat ["<mo>(</mo>",formatMml(first args, opPrec),"<mo>)</mo>"]
+      else
+       s1 : S := formatMml(first args, opPrec)
+      s2 : S := formatMml(first rest args, opPrec)
+      op :=
+        op = "|"     =>  s := concat ["<mrow>",s1,"</mrow><mo>",op,"</mo><mrow>",s2,"</mrow>"]
+        op = "**"    =>  s := concat ["<msup><mrow>",s1,"</mrow><mrow>",s2,"</mrow></msup>"]
+        op = "/"     =>  s := concat ["<mfrac><mrow>",s1,"</mrow><mrow>",s2,"</mrow></mfrac>"]
+        op = "OVER"  =>  s := concat ["<mfrac><mrow>",s1,"</mrow><mrow>",s2,"</mrow></mfrac>"]
+        op = "+->"   =>  s := concat ["<mrow>",s1,"</mrow><mo>",op,"</mo><mrow>",s2,"</mrow>"]
+        s := concat ["<mrow>",s1,"</mrow><mo>",op,"</mo><mrow>",s2,"</mrow>"]
+      group
+        op = "OVER" => s
+--        opPrec < prec => parenthesize s
+-- ugly parentheses?
+        s
+
+    formatNary(op : S, args : L E, prec : I) : S ==
+      group formatNaryNoGroup(op, args, prec)
+
+    formatNaryNoGroup(op : S, args : L E, prec : I) : S ==
+      checkargs:Boolean := false
+      null args => ""
+      p : I := position(op,naryOps)
+      p < 1 => error "unknown nary op"
+      -- need to test for "ZAG" case and divert it here
+      -- ex 1. continuedFraction(314159/100000)
+      -- {{+}{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}}
+      -- {{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
+      -- this is the preconditioned output form
+      -- including "op", the args list would be the rest of this
+      -- i.e op = '+' and args = {{3}{{ZAG}{1}{7}}{{ZAG}{1}{15}}
+      -- {{ZAG}{1}{1}}{{ZAG}{1}{25}}{{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
+      -- ex 2. continuedFraction(14159/100000)
+      -- this one doesn't have the leading integer
+      -- {{+}{{ZAG}{1}{7}}{{ZAG}{1}{15}}{{ZAG}{1}{1}}{{ZAG}{1}{25}}
+      -- {{ZAG}{1}{1}}{{ZAG}{1}{7}}{{ZAG}{1}{4}}}
+      --
+      -- ex 3. continuedFraction(3,repeating [1], repeating [3,6])
+      -- {{+}{3}{{ZAG}{1}{3}}{{ZAG}{1}{6}}{{ZAG}{1}{3}}{{ZAG}{1}{6}}
+      -- {{ZAG}{1}{3}}{{ZAG}{1}{6}}{{ZAG}{1}{3}}{{ZAG}{1}{6}}
+      -- {{ZAG}{1}{3}}{{ZAG}{1}{6}}{...}}
+      -- In each of these examples the args list consists of the terms
+      -- following the '+' op
+      -- so the first arg could be a "ZAG" or something
+      -- else, but the second arg looks like it has to be "ZAG", so maybe
+      -- test for #args > 1 and args.2 contains "ZAG".
+      -- Note that since the resulting MathML <mfrac>s are nested we need
+      -- to handle the whole continued fraction at once, i.e. we can't
+      -- just look for, e.g., {{ZAG}{1}{6}}
+      (#args > 1) and (position("ZAG",stringify first rest args,1) > 0) =>
+           tmpS : S := stringify first args
+           position("ZAG",tmpS,1) > 0 => formatZag(args)
+--         position("ZAG",tmpS,1) > 0 => formatZag1(args)
+           concat [formatMml(first args,minPrec) "<mo>+</mo>" _
+                   formatZag(rest args)]
+      -- At least for the ops "*","+","-" we need to test to see if a sigma
+      -- or pi is one of their arguments because we might need parentheses
+      -- as indicated by the problem with 
+      -- summation(operator(f)(i),i=1..n)+1 versus
+      -- summation(operator(f)(i)+1,i=1..n) having identical displays as 
+      -- of 2007-21-21
+      op :=
+        op = ","     => "<mo>,</mo>" --originally , \:
+        op = ";"     => "<mo>;</mo>" --originally ; \: should figure these out
+        op = "*"     => "<mspace width='0.3em'/>"
+        -- InvisibleTimes
+        op = " "     => "<mspace width='0.5em'/>"
+        op = "ROW"   => "</mtd><mtd>"
+        op = "+"     => 
+            checkargs := true
+            "<mo>+</mo>"
+        op = "-"     => 
+            checkargs := true
+            "<mo>-</mo>"
+        op
+      l : L S := nil
+      opPrec := naryPrecs.p
+      -- if checkargs is true check each arg except last one to see if it's
+      -- a sigma or pi and if so add parentheses. Other op's may have to be
+      -- checked for in future
+      count:I := 1
+      for a in args repeat
+--        WriteLine$Lisp "checking args"
+        if checkargs then
+          if count < #args then
+            -- check here for sum or product
+            if ATOM(a)$Lisp@Boolean then
+              opa:S := stringify a
+            else
+              la : L E := (a pretend L E)
+              opa : S := stringify first la
+            if opa = "SIGMA" or opa = "SIGMA2" or _
+               opa = "PI" or opa = "PI2" then
+              l := concat(op,concat(_
+                    concat ["<mo>(</mo>",formatMml(a,opPrec),_
+                            "<mo>)</mo>"],l)$L(S))$L(S)
+            else l := concat(op,concat(formatMml(a,opPrec),l)$L(S))$L(S)
+          else l := concat(op,concat(formatMml(a,opPrec),l)$L(S))$L(S)
+        else l := concat(op,concat(formatMml(a,opPrec),l)$L(S))$L(S)
+        count := count + 1
+      s : S := concat reverse rest l
+      opPrec < prec => parenthesize s
+      s
+
+    formatZag(args : L E) : S ==
+    -- args will be a list of things like this {{ZAG}{1}{7}}, the ZAG
+    -- must be there, the '1' and '7' could conceivably be more complex
+    -- expressions
+      tmpZag : L E := first args pretend L E
+      -- may want to test that tmpZag contains 'ZAG'
+      #args > 1 => "<mfrac>"formatMml(first rest tmpZag,minPrec)"<mrow><mn>"formatMml(first rest rest tmpZag,minPrec)"</mn><mo>+</mo>"formatZag(rest args)"</mrow></mfrac>"
+      -- EQUAL(tmpZag, "...")$Lisp => "<mo>&#x2026;</mo>"
+      (first args = "..."::E)@Boolean => "<mo>&#x2026;</mo>"
+      position("ZAG",stringify first args,1) > 0 =>
+          "<mfrac>"formatMml(first rest tmpZag,minPrec)formatMml(first rest rest tmpZag,minPrec)"</mfrac>"      
+      "<mtext>formatZag: Unexpected kind of ZAG</mtext>"
+
+      
+    formatZag1(args : L E) : S ==
+    -- make alternative ZAG format without diminishing fonts, maybe
+    -- use a table
+    -- {{ZAG}{1}{7}}
+      tmpZag : L E := first args pretend L E
+      #args > 1 => "<mfrac>"formatMml(first rest tmpZag,minPrec)"<mrow><mn>"formatMml(first rest rest tmpZag,minPrec)"</mn><mo>+</mo>"formatZag(rest args)"</mrow></mfrac>"
+      (first args = "...":: E)@Boolean => "<mo>&#x2026;</mo>"
+      error "formatZag1: Unexpected kind of ZAG"
+
+
+    formatMml(expr : E,prec : I) ==
+      i,len : Integer
+      intSplitLen : Integer := 20
+      ATOM(expr)$Lisp@Boolean =>
+        str := stringify expr
+        len := #str
+        -- this bit seems to deal with integers
+        INTEGERP$Lisp expr =>
+          i := expr pretend Integer
+          if (i < 0) or (i > 9)
+            then
+              group
+                 nstr : String := ""
+                 -- insert some blanks into the string, if too long
+                 while ((len := #str) > intSplitLen) repeat
+                   nstr := concat [nstr," ",
+                     elt(str,segment(1,intSplitLen)$US)]
+                   str := elt(str,segment(intSplitLen+1)$US)
+                 empty? nstr => concat ["<mn>",str,"</mn>"]
+                 nstr :=
+                   empty? str => nstr
+                   concat [nstr," ",str]
+                 concat ["<mn>",elt(nstr,segment(2)$US),"</mn>"]
+            else str := concat ["<mn>",str,"</mn>"]
+        str = "%pi" => "<mi>&#x003C0;</mi>"
+        -- pi
+        str = "%e"  => "<mi>&#x02147;</mi>"
+        -- ExponentialE
+        str = "%i"  => "<mi>&#x02148;</mi>"
+        -- ImaginaryI
+        len > 0 and str.1 = char "%" => concat(concat("<mi>",str),"</mi>")
+         -- should handle floats
+        len > 1 and digit? str.1 => concat ["<mn>",str,"</mn>"]
+        -- presumably this is a literal string
+        len > 0 and str.1 = char "_"" =>
+          concat(concat("<mtext>",str),"</mtext>")
+        len = 1 and str.1 = char " " => " "
+        (i := position(str,specialStrings)) > 0 =>
+          specialStringsInMML.i
+        (i := position(char " ",str)) > 0 =>
+          -- We want to preserve spacing, so use a roman font.
+          -- What's this for?  Leave the \rm in for now so I can see
+          -- where it arises.  Removed 2007-02-14
+          concat(concat("<mtext>",str),"</mtext>")
+        -- if we get to here does that mean it's a variable?
+        concat ["<mi>",str,"</mi>"]
+      l : L E := (expr pretend L E)
+      null l => blank
+      op : S := stringify first l
+      args : L E := rest l
+      nargs : I := #args
+      -- need to test here in case first l is SUPERSUB case and then
+      -- pass first l and args to formatSuperSub.
+      position("SUPERSUB",op,1) > 0 =>
+        formatSuperSub(first l,args,minPrec)
+      -- now test for SUB
+      position("SUB",op,1) > 0 =>
+        formatSub1(first l,args,minPrec)
+
+      -- special cases
+      member?(op, specialOps) => formatSpecial(op,args,prec)
+      member?(op, plexOps)    => formatPlex(op,args,prec)
+
+      -- nullary case
+      0 = nargs => formatNullary op
+
+      -- unary case
+      (1 = nargs) and member?(op, unaryOps) =>
+        formatUnary(op, first args, prec)
+
+      -- binary case
+      (2 = nargs) and member?(op, binaryOps) =>
+        formatBinary(op, args, prec)
+
+      -- nary case
+      member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec)
+      member?(op,naryOps) => formatNary(op,args, prec)
+
+      op := formatMml(first l,minPrec)
+      formatFunction(op,args,prec)
+
 *)
 
 \end{chunk}
@@ -97341,17 +116654,6 @@ Matrix(R): Exports == Implementation where
         ++ \spad{inverse(m)} returns the inverse of the matrix m. 
         ++ If the matrix is not invertible, "failed" is returned.
         ++ Error: if the matrix is not square.
---     matrix: Vector Vector R -> $
---       ++ \spad{matrix(v)} converts the vector of vectors v to a matrix, where
---       ++ the vector of vectors is viewed as a vector of the rows of the
---       ++ matrix
---     diagonalMatrix: Vector $ -> $
---       ++ \spad{diagonalMatrix([m1,...,mk])} creates a block diagonal matrix
---       ++ M with block matrices m1,...,mk down the diagonal,
---       ++ with 0 block matrices elsewhere.
---     vectorOfVectors: $ -> Vector Vector R
---       ++ \spad{vectorOfVectors(m)} returns the rows of the matrix m as a
---       ++ vector of vectors
  
   Implementation ==>
    InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col) add
@@ -97380,7 +116682,6 @@ Matrix(R): Exports == Implementation where
  
     positivePower:($,Integer,NonNegativeInteger) -> $
     positivePower(x,n,nn) ==
---      one? n => x
       (n = 1) => x
       -- no need to allocate space for 3 additional matrices
       n = 2 => x * x
@@ -97401,6 +116702,7 @@ Matrix(R): Exports == Implementation where
     if R has commutative("*") then
  
         determinant x == determinant(x)$MATLIN
+
         minordet    x == minordet(x)$MATLIN
  
     if R has EuclideanDomain then
@@ -97410,7 +116712,9 @@ Matrix(R): Exports == Implementation where
     if R has IntegralDomain then
  
         rank        x == rank(x)$MATLIN
+
         nullity     x == nullity(x)$MATLIN
+
         nullSpace   x == nullSpace(x)$MATLIN
  
     if R has Field then
@@ -97427,54 +116731,14 @@ Matrix(R): Exports == Implementation where
             error "**: matrix must be invertible"
           positivePower(xInv :: $,-n,nn)
  
---     matrix(v: Vector Vector R) ==
---       (rows := # v) = 0 => new(0,0,0)
---       -- error check: this is a top level function
---       cols := # v.mini(v)
---       for k in (mini(v) + 1)..maxi(v) repeat
---         cols ^= # v.k => error "matrix: rows of different lengths"
---       ans := new(rows,cols,0)
---       for i in minr(ans)..maxr(ans) for k in mini(v)..maxi(v) repeat
---         vv := v.k
---         for j in minc(ans)..maxc(ans) for l in mini(vv)..maxi(vv) repeat
---           ans(i,j) := vv.l
---       ans
- 
     diagonalMatrix(v: Vector R) ==
       n := #v; ans := zero(n,n)
       for i in minr(ans)..maxr(ans) for j in minc(ans)..maxc(ans) _
           for k in mini(v)..maxi(v) repeat qsetelt_!(ans,i,j,qelt(v,k))
       ans
  
---     diagonalMatrix(vec: Vector $) ==
---       rows : NonNegativeInteger := 0
---       cols : NonNegativeInteger := 0
---       for r in mini(vec)..maxi(vec) repeat
---         mat := vec.r
---         rows := rows + nrows mat; cols := cols + ncols mat
---       ans := zero(rows,cols)
---       loR := minr ans; loC := minc ans
---       for r in mini(vec)..maxi(vec) repeat
---         mat := vec.r
---         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
---             ans(i,j) := mat(k,l)
---         loR := hiR + 1; loC := hiC + 1
---       ans
- 
---     vectorOfVectors x ==
---       vv : Vector Vector R := new(nrows x,0)
---       cols := ncols x
---       for k in mini(vv)..maxi(vv) repeat
---         vv.k := new(cols,0)
---       for i in minr(x)..maxr(x) for k in mini(vv)..maxi(vv) repeat
---         v := vv.k
---         for j in minc(x)..maxc(x) for l in mini(v)..maxi(v) repeat
---           v.l := x(i,j)
---       vv
- 
     if R has ConvertibleTo InputForm then
+
       convert(x:$):InputForm ==
          convert [convert("matrix"::Symbol)@InputForm,
                   convert listOfLists x]$List(InputForm)
@@ -97484,6 +116748,93 @@ Matrix(R): Exports == Implementation where
 \begin{chunk}{COQ MATRIX}
 (* domain MATRIX *)
 (*
+   InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col) add
+    minr ==> minRowIndex
+    maxr ==> maxRowIndex
+    minc ==> minColIndex
+    maxc ==> maxColIndex
+    mini ==> minIndex
+    maxi ==> maxIndex
+ 
+    minRowIndex x == mnRow
+    minColIndex x == mnCol
+ 
+    swapRows_!(x,i1,i2) ==
+        (i1 < minRowIndex(x)) or (i1 > maxRowIndex(x)) or _
+           (i2 < minRowIndex(x)) or (i2 > maxRowIndex(x)) =>
+             error "swapRows!: index out of range"
+        i1 = i2 => x
+        minRow := minRowIndex x
+        xx := x pretend PrimitiveArray(PrimitiveArray(R))
+        n1 := i1 - minRow; n2 := i2 - minRow
+        row1 := qelt(xx,n1)
+        qsetelt_!(xx,n1,qelt(xx,n2))
+        qsetelt_!(xx,n2,row1)
+        xx pretend $
+ 
+    positivePower:($,Integer,NonNegativeInteger) -> $
+    positivePower(x,n,nn) ==
+      (n = 1) => x
+      -- no need to allocate space for 3 additional matrices
+      n = 2 => x * x
+      n = 3 => x * x * x
+      n = 4 => (y := x * x; y * y)
+      a := new(nn,nn,0) pretend Matrix(R)
+      b := new(nn,nn,0) pretend Matrix(R)
+      c := new(nn,nn,0) pretend Matrix(R)
+      xx := x pretend Matrix(R)
+      power_!(a,b,c,xx,n :: NonNegativeInteger)$MATSTOR pretend $
+ 
+    x:$ ** n:NonNegativeInteger ==
+      not((nn := nrows x) = ncols x) =>
+        error "**: matrix must be square"
+      zero? n => scalarMatrix(nn,1)
+      positivePower(x,n,nn)
+ 
+    if R has commutative("*") then
+ 
+        determinant x == determinant(x)$MATLIN
+
+        minordet    x == minordet(x)$MATLIN
+ 
+    if R has EuclideanDomain then
+ 
+        rowEchelon  x == rowEchelon(x)$MATLIN
+ 
+    if R has IntegralDomain then
+ 
+        rank        x == rank(x)$MATLIN
+
+        nullity     x == nullity(x)$MATLIN
+
+        nullSpace   x == nullSpace(x)$MATLIN
+ 
+    if R has Field then
+ 
+        inverse     x == inverse(x)$MATLIN
+ 
+        x:$ ** n:Integer ==
+          nn := nrows x
+          not(nn = ncols x) =>
+            error "**: matrix must be square"
+          zero? n => scalarMatrix(nn,1)
+          positive? n => positivePower(x,n,nn)
+          (xInv := inverse x) case "failed" =>
+            error "**: matrix must be invertible"
+          positivePower(xInv :: $,-n,nn)
+ 
+    diagonalMatrix(v: Vector R) ==
+      n := #v; ans := zero(n,n)
+      for i in minr(ans)..maxr(ans) for j in minc(ans)..maxc(ans) _
+          for k in mini(v)..maxi(v) repeat qsetelt_!(ans,i,j,qelt(v,k))
+      ans
+ 
+    if R has ConvertibleTo InputForm then
+
+      convert(x:$):InputForm ==
+         convert [convert("matrix"::Symbol)@InputForm,
+                  convert listOfLists x]$List(InputForm)
+
 *)
 
 \end{chunk}
@@ -97896,11 +117247,13 @@ ModMonic(R,Rep): C == T
       power:PrimitiveArray(%)
       frobeniusPower:PrimitiveArray(%)
       computeFrobeniusPowers : () -> PrimitiveArray(%)
+
     --representations
-    --mutable m    --take this out??
-    --define
+
       power := new(0,0)
+
       frobeniusPower := new(0,0)
+
       setPoly (mon : Rep) ==
         mon =$Rep m => mon
         oldm := m
@@ -97908,8 +117261,8 @@ ModMonic(R,Rep): C == T
         -- following copy code needed since FFPOLY can modify mon
         copymon:Rep:= 0
         while not zero? mon repeat
-           copymon := monomial(leadingCoefficient mon, degree mon)$Rep + copymon
-           mon := reductum mon
+          copymon := monomial(leadingCoefficient mon, degree mon)$Rep + copymon
+          mon := reductum mon
         m := copymon
         d := degree(m)$Rep
         d1 := (d-1)::NonNegativeInteger
@@ -97921,26 +117274,47 @@ ModMonic(R,Rep): C == T
                 frobeniusPower(i) := reduce lift frobeniusPower(i)
           frobeniusPower := computeFrobeniusPowers()
         m
+
       modulus == m
+
       if R has Finite then
+
          size == d * size$R
+
          random == UnVectorise([random()$R for i in 0..d1])
+
       0 == 0$Rep
+
       1 == 1$Rep
+
       c * x == c *$Rep x
+
       n * x == (n::R) *$Rep x
+
       coerce(c:R):% == monomial(c,0)$Rep
+
       coerce(x:%):OutputForm == coerce(x)$Rep
+
       coefficient(x,e):R == coefficient(x,e)$Rep
+
       reductum(x) == reductum(x)$Rep
+
       leadingCoefficient x == (leadingCoefficient x)$Rep
+
       degree x == (degree x)$Rep
+
       lift(x) == x pretend Rep
+
       reduce(p) == (monicDivide(p,m)$Rep).remainder
+
       coerce(p) == reduce(p)
+
       x = y == x =$Rep y
+
       x + y == x +$Rep y
+
       - x == -$Rep x
+
       x * y ==
         p := x *$Rep y
         ans:=0$Rep
@@ -97948,9 +117322,12 @@ ModMonic(R,Rep): C == T
            ans:=ans + leadingCoefficient(p)*power.(n-d)
            p := reductum p
         ans+p
+
       Vectorise(x) == [coefficient(lift(x),i) for i in 0..d1]
+
       UnVectorise(vect) ==
         reduce(+/[monomial(vect.(i+1),i) for i in 0..d1])
+
       computePowers ==
            mat : PrimitiveArray(%):= new(d,0)
            mat.0:= reductum(-m)$Rep
@@ -97960,7 +117337,9 @@ ModMonic(R,Rep): C == T
               if degree mat.i=d then
                 mat.i:= reductum mat.i + leadingCoefficient mat.i * mat.0
            mat
+
       if frobenius? then
+
           computeFrobeniusPowers() ==
             mat : PrimitiveArray(%):= new(d,1)
             mat.1:= mult := monomial(1, size$R)$%
@@ -97976,6 +117355,7 @@ ModMonic(R,Rep): C == T
             aq
          
       pow == power
+
       monomial(c,e)==
          if e<d then monomial(c,e)$Rep
          else
@@ -97985,6 +117365,7 @@ ModMonic(R,Rep): C == T
                k1:=e quo twod
                k2 := (e-k1*twod)::NonNegativeInteger
                reduce((power.d1 **k1)*monomial(c,k2))
+
       if R has Field then
 
          (x:% exquo y:%):Union(%, "failed") ==
@@ -97993,25 +117374,165 @@ ModMonic(R,Rep): C == T
             return reduce(uv.coef1)
 
          recip(y:%):Union(%, "failed") ==  1 exquo y
+
          divide(x:%, y:%) ==
             (q := (x exquo y)) case "failed" => error "not divisible"
             [q, 0]
 
---     An(MM) == Vectorise(-(reduce(reductum(m))::MM))
---     LinearTransf(vect,MM) ==
---       ans:= 0::SquareMatrix<d>(R)
---       for i in 1..d do setelt(ans,i,1,vect.i)
---       for j in 2..d do
---          setelt(ans,1,j, elt(ans,d,j-1) * An(MM).1)
---          for i in 2..d do
---            setelt(ans,i,j, elt(ans,i-1,j-1) + elt(ans,d,j-1) * An(MM).i)
---       ans
-
 \end{chunk}
 
 \begin{chunk}{COQ MODMON}
 (* domain MODMON *)
 (*
+    --constants
+      m:Rep := monomial(1,1)$Rep --| degree(m) > 0 and LeadingCoef(m) = R$1
+      d := degree(m)$Rep
+      d1 := (d-1):NonNegativeInteger
+      twod := 2*d1+1
+      frobenius?:Boolean := R has FiniteFieldCategory
+      --VectorRep:= DirectProduct(d:NonNegativeInteger,R)
+    --declarations
+      x,y: %
+      p: Rep
+      d,n: Integer
+      e,k1,k2: NonNegativeInteger
+      c: R
+      --vect: Vector(R)
+      power:PrimitiveArray(%)
+      frobeniusPower:PrimitiveArray(%)
+      computeFrobeniusPowers : () -> PrimitiveArray(%)
+
+    --representations
+
+      power := new(0,0)
+
+      frobeniusPower := new(0,0)
+
+      setPoly (mon : Rep) ==
+        mon =$Rep m => mon
+        oldm := m
+        leadingCoefficient mon ^= 1 => error "polynomial must be monic"
+        -- following copy code needed since FFPOLY can modify mon
+        copymon:Rep:= 0
+        while not zero? mon repeat
+          copymon := monomial(leadingCoefficient mon, degree mon)$Rep + copymon
+          mon := reductum mon
+        m := copymon
+        d := degree(m)$Rep
+        d1 := (d-1)::NonNegativeInteger
+        twod := 2*d1+1
+        power := computePowers()
+        if frobenius? then
+          degree(oldm)>1 and not((oldm exquo$Rep m) case "failed") =>
+              for i in 1..d1 repeat
+                frobeniusPower(i) := reduce lift frobeniusPower(i)
+          frobeniusPower := computeFrobeniusPowers()
+        m
+
+      modulus == m
+
+      if R has Finite then
+
+         size == d * size$R
+
+         random == UnVectorise([random()$R for i in 0..d1])
+
+      0 == 0$Rep
+
+      1 == 1$Rep
+
+      c * x == c *$Rep x
+
+      n * x == (n::R) *$Rep x
+
+      coerce(c:R):% == monomial(c,0)$Rep
+
+      coerce(x:%):OutputForm == coerce(x)$Rep
+
+      coefficient(x,e):R == coefficient(x,e)$Rep
+
+      reductum(x) == reductum(x)$Rep
+
+      leadingCoefficient x == (leadingCoefficient x)$Rep
+
+      degree x == (degree x)$Rep
+
+      lift(x) == x pretend Rep
+
+      reduce(p) == (monicDivide(p,m)$Rep).remainder
+
+      coerce(p) == reduce(p)
+
+      x = y == x =$Rep y
+
+      x + y == x +$Rep y
+
+      - x == -$Rep x
+
+      x * y ==
+        p := x *$Rep y
+        ans:=0$Rep
+        while (n:=degree p)>d1 repeat
+           ans:=ans + leadingCoefficient(p)*power.(n-d)
+           p := reductum p
+        ans+p
+
+      Vectorise(x) == [coefficient(lift(x),i) for i in 0..d1]
+
+      UnVectorise(vect) ==
+        reduce(+/[monomial(vect.(i+1),i) for i in 0..d1])
+
+      computePowers ==
+           mat : PrimitiveArray(%):= new(d,0)
+           mat.0:= reductum(-m)$Rep
+           w: % := monomial$Rep (1,1)
+           for i in 1..d1 repeat
+              mat.i := w *$Rep mat.(i-1)
+              if degree mat.i=d then
+                mat.i:= reductum mat.i + leadingCoefficient mat.i * mat.0
+           mat
+
+      if frobenius? then
+
+          computeFrobeniusPowers() ==
+            mat : PrimitiveArray(%):= new(d,1)
+            mat.1:= mult := monomial(1, size$R)$%
+            for i in 2..d1 repeat
+               mat.i := mult * mat.(i-1)
+            mat
+
+          frobenius(a:%):% ==
+            aq:% := 0
+            while a^=0 repeat
+              aq:= aq + leadingCoefficient(a)*frobeniusPower(degree a)
+              a := reductum a
+            aq
+         
+      pow == power
+
+      monomial(c,e)==
+         if e<d then monomial(c,e)$Rep
+         else
+            if e<=twod then
+               c * power.(e-d)
+            else
+               k1:=e quo twod
+               k2 := (e-k1*twod)::NonNegativeInteger
+               reduce((power.d1 **k1)*monomial(c,k2))
+
+      if R has Field then
+
+         (x:% exquo y:%):Union(%, "failed") ==
+            uv := extendedEuclidean(y, modulus(), x)$Rep
+            uv case "failed" => "failed"
+            return reduce(uv.coef1)
+
+         recip(y:%):Union(%, "failed") ==  1 exquo y
+
+         divide(x:%, y:%) ==
+            (q := (x exquo y)) case "failed" => error "not divisible"
+            [q, 0]
+
 *)
 
 \end{chunk}
@@ -98324,23 +117845,35 @@ ModularRing(R,Mod,reduction:(R,Mod) -> R,
 
   T == add
     --representation
+
       Rep:= Record(val:R,modulo:Mod)
+
     --declarations
+
       x,y: %
 
     --define
+
       modulus(x)   == x.modulo
+
       coerce(x)    == x.val
+
       coerce(i:Integer):% == [i::R,0]$Rep
+
       i:Integer * x:% == (i::%)*x
+
       coerce(x):OutputForm == (x.val)::OutputForm
+
       reduce (a:R,m:Mod) == [reduction(a,m),m]$Rep
 
       characteristic():NonNegativeInteger == characteristic()$R
+
       0 == [0$R,0$Mod]$Rep
+
       1 == [1$R,0$Mod]$Rep
+
       zero? x == zero? x.val
---      one? x == one? x.val
+
       one? x == (x.val = 1)
 
       newmodulo(m1:Mod,m2:Mod) : Mod ==
@@ -98352,9 +117885,13 @@ ModularRing(R,Mod,reduction:(R,Mod) -> R,
         x.val = y.val => true
         x.modulo = y.modulo => false
         (x-y).val = 0
+
       x+y == reduce((x.val +$R y.val),newmodulo(x.modulo,y.modulo))
+
       x-y == reduce((x.val -$R y.val),newmodulo(x.modulo,y.modulo))
+
       -x  == reduce ((-$R x.val),x.modulo)
+
       x*y == reduce((x.val *$R y.val),newmodulo(x.modulo,y.modulo))
 
       exQuo(x,y) ==
@@ -98379,6 +117916,73 @@ ModularRing(R,Mod,reduction:(R,Mod) -> R,
 \begin{chunk}{COQ MODRING}
 (* domain MODRING *)
 (*
+    --representation
+
+      Rep:= Record(val:R,modulo:Mod)
+
+    --declarations
+
+      x,y: %
+
+    --define
+
+      modulus(x)   == x.modulo
+
+      coerce(x)    == x.val
+
+      coerce(i:Integer):% == [i::R,0]$Rep
+
+      i:Integer * x:% == (i::%)*x
+
+      coerce(x):OutputForm == (x.val)::OutputForm
+
+      reduce (a:R,m:Mod) == [reduction(a,m),m]$Rep
+
+      characteristic():NonNegativeInteger == characteristic()$R
+
+      0 == [0$R,0$Mod]$Rep
+
+      1 == [1$R,0$Mod]$Rep
+
+      zero? x == zero? x.val
+
+      one? x == (x.val = 1)
+
+      newmodulo(m1:Mod,m2:Mod) : Mod ==
+        r:=merge(m1,m2)
+        r case "failed" => error "incompatible moduli"
+        r::Mod
+
+      x=y ==
+        x.val = y.val => true
+        x.modulo = y.modulo => false
+        (x-y).val = 0
+
+      x+y == reduce((x.val +$R y.val),newmodulo(x.modulo,y.modulo))
+
+      x-y == reduce((x.val -$R y.val),newmodulo(x.modulo,y.modulo))
+
+      -x  == reduce ((-$R x.val),x.modulo)
+
+      x*y == reduce((x.val *$R y.val),newmodulo(x.modulo,y.modulo))
+
+      exQuo(x,y) ==
+        xm:=x.modulo
+        if xm ^=$Mod y.modulo then xm:=newmodulo(xm,y.modulo)
+        r:=exactQuo(x.val,y.val,xm)
+        r case "failed"=> "failed"
+        [r::R,xm]$Rep
+
+      --if R has EuclideanDomain then
+      recip x ==
+        r:=exactQuo(1$R,x.val,x.modulo)
+        r case "failed" => "failed"
+        [r,x.modulo]$Rep
+
+      inv x ==
+        if (u:=recip x) case "failed" then error("not invertible")
+        else u::%
+
 *)
 
 \end{chunk}
@@ -98483,12 +118087,19 @@ ModuleMonomial(IS: OrderedSet,
     construct: (IS, E) -> $
       ++ construct(i,e) is not documented
    C == MM  add
+
         Rep:= MM
+
         x:$ < y:$ == ff(x::Rep, y::Rep)
+
         exponent(x:$):E == x.exponent
+
         index(x:$): IS == x.index
+
         coerce(x:$):MM == x::Rep::MM
+
         coerce(x:MM):$ == x::Rep::$
+
         construct(i:IS, e:E):$ == [i, e]$MM::Rep::$
 
 \end{chunk}
@@ -98496,6 +118107,21 @@ ModuleMonomial(IS: OrderedSet,
 \begin{chunk}{COQ MODMONOM}
 (* domain MODMONOM *)
 (*
+
+        Rep:= MM
+
+        x:$ < y:$ == ff(x::Rep, y::Rep)
+
+        exponent(x:$):E == x.exponent
+
+        index(x:$): IS == x.index
+
+        coerce(x:$):MM == x::Rep::MM
+
+        coerce(x:MM):$ == x::Rep::$
+
+        construct(i:IS, e:E):$ == [i, e]$MM::Rep::$
+
 *)
 
 \end{chunk}
@@ -98679,20 +118305,34 @@ ModuleOperator(R: Ring, M:LeftModule(R)): Exports == Implementation where
     nocopy   : OP -> $
 
     1                   == makeop(1, 1)
+
     coerce(n:Integer):$ == n::R::$
+
     coerce(r:R):$       == (zero? r => 0; makeop(r, 1))
+
     coerce(op:OP):$     == nocopy copy op
+
     nocopy(op:OP):$     == makeop(1, op::FG)
+
     elt(x:$, r:M)       == +/[t.exp * termeval(t.gen, r) for t in terms x]
+
     rmeval(t, r)        == t.coef * monomeval(t.monom, r)
+
     termcopy t          == [[rm.coef, rm.monom] for rm in t]
+
     characteristic()    == characteristic()$R
+
     mkop(r, fg)         == [[r, fg]$RM]$TERM :: $
+
     evaluate(f, g)   == nocopy setProperty(retract(f)@OP,OPEVAL,g pretend None)
 
     if R has OrderedSet then
+
       makeop(r, fg) == (r >= 0 => mkop(r, fg); - mkop(-r, fg))
-    else makeop(r, fg) == mkop(r, fg)
+
+    else
+
+      makeop(r, fg) == mkop(r, fg)
 
     inv(t:TERM):$ ==
       empty? t => 1
@@ -98713,7 +118353,6 @@ ModuleOperator(R: Ring, M:LeftModule(R)): Exports == Implementation where
       reduce(_+, [trm2O(t.exp, t.gen) for t in terms x])$List(O)
 
     trm2O(c, t) ==
---      one? c => term2O t
       (c = 1) => term2O t
       c = -1 => - term2O t
       c::O * term2O t
@@ -98722,9 +118361,7 @@ ModuleOperator(R: Ring, M:LeftModule(R)): Exports == Implementation where
       reduce(_*, [rm2O(rm.coef, rm.monom) for rm in t])$List(O)
 
     rm2O(c, m) ==
---      one? c => m::O
       (c = 1) => m::O
---      one? m => c::O
       (m = 1) => c::O
       c::O * m::O
 
@@ -98740,11 +118377,9 @@ ModuleOperator(R: Ring, M:LeftModule(R)): Exports == Implementation where
       lc := first(xx := termcopy x)
       lc.coef := n * lc.coef
       rm := last xx
---      one?(first(y).coef) =>
       ((first(y).coef) = 1) =>
         rm.monom := rm.monom * first(y).monom
         concat_!(xx, termcopy rest y)
---      one?(rm.monom) =>
       ((rm.monom) = 1) =>
         rm.coef := rm.coef * first(y).coef
         rm.monom := first(y).monom
@@ -98752,11 +118387,13 @@ ModuleOperator(R: Ring, M:LeftModule(R)): Exports == Implementation where
       concat_!(xx, termcopy y)
 
     if M has ExpressionSpace then
+
       opeval(op, r) ==
         (func := property(op, OPEVAL)) case "failed" => kernel(op, r)
         ((func::None) pretend (M -> M)) r
 
     else
+
       opeval(op, r) ==
         (func := property(op, OPEVAL)) case "failed" =>
           error "eval: operator has no evaluation function"
@@ -98791,7 +118428,6 @@ ModuleOperator(R: Ring, M:LeftModule(R)): Exports == Implementation where
       empty?(t := r::TERM) => 0$R
       empty? rest t =>
         rm := first t
---        one?(rm.monom) => rm.coef
         (rm.monom = 1) => rm.coef
         "failed"
       "failed"
@@ -98801,7 +118437,6 @@ ModuleOperator(R: Ring, M:LeftModule(R)): Exports == Implementation where
       empty?(t := r::TERM) => "failed"
       empty? rest t =>
         rm := first t
---        one?(rm.coef) => retractIfCan(rm.monom)
         (rm.coef = 1) => retractIfCan(rm.monom)
         "failed"
       "failed"
@@ -98813,9 +118448,13 @@ ModuleOperator(R: Ring, M:LeftModule(R)): Exports == Implementation where
       opadj    : OP -> $
 
       r:R * x:$        == r::$ * x
+
       x:$ * r:R        == x * (r::$)
+
       adjoint x        == +/[t.exp * termadj(t.gen) for t in terms x]
+
       rmadj t          == conjug(t.coef) * monomadj(t.monom)
+
       adjoint(op, adj) == nocopy setProperty(retract(op)@OP, OPADJ, adj::None)
 
       termadj t ==
@@ -98833,13 +118472,206 @@ ModuleOperator(R: Ring, M:LeftModule(R)): Exports == Implementation where
            error "adjoint: operator does not have a defined adjoint"
         (adj::None) pretend $
 
-      if R has conjugate:R -> R then conjug r == conjugate r else conjug r == r
+      if R has conjugate:R -> R then
+
+        conjug r == conjugate r else conjug r == r
 
 \end{chunk}
 
 \begin{chunk}{COQ MODOP}
 (* domain MODOP *)
 (*
+    import NoneFunctions1($)
+    import BasicOperatorFunctions1(M)
+
+    Rep := FAB
+
+    inv      : TERM -> $
+    termeval : (TERM, M) -> M
+    rmeval   : (RM, M) -> M
+    monomeval: (FG, M) -> M
+    opInvEval: (OP, M) -> M
+    mkop     : (R, FG) -> $
+    termprod0: (Integer, TERM, TERM) -> $
+    termprod : (Integer, TERM, TERM) -> TERM
+    termcopy : TERM -> TERM
+    trm2O    : (Integer, TERM) -> O
+    term2O   : TERM -> O
+    rm2O     : (R, FG) -> O
+    nocopy   : OP -> $
+
+    1                   == makeop(1, 1)
+
+    coerce(n:Integer):$ == n::R::$
+
+    coerce(r:R):$       == (zero? r => 0; makeop(r, 1))
+
+    coerce(op:OP):$     == nocopy copy op
+
+    nocopy(op:OP):$     == makeop(1, op::FG)
+
+    elt(x:$, r:M)       == +/[t.exp * termeval(t.gen, r) for t in terms x]
+
+    rmeval(t, r)        == t.coef * monomeval(t.monom, r)
+
+    termcopy t          == [[rm.coef, rm.monom] for rm in t]
+
+    characteristic()    == characteristic()$R
+
+    mkop(r, fg)         == [[r, fg]$RM]$TERM :: $
+
+    evaluate(f, g)   == nocopy setProperty(retract(f)@OP,OPEVAL,g pretend None)
+
+    if R has OrderedSet then
+
+      makeop(r, fg) == (r >= 0 => mkop(r, fg); - mkop(-r, fg))
+
+    else
+
+      makeop(r, fg) == mkop(r, fg)
+
+    inv(t:TERM):$ ==
+      empty? t => 1
+      c := first(t).coef
+      m := first(t).monom
+      inv(rest t) * makeop(1, inv m) * (recip(c)::R::$)
+
+    x:$ ** i:Integer ==
+      i = 0 => 1
+      i > 0 => expt(x,i pretend PositiveInteger)$RepeatedSquaring($)
+      (inv(retract(x)@TERM)) ** (-i)
+
+    evaluateInverse(f, g) ==
+      nocopy setProperty(retract(f)@OP, INVEVAL, g pretend None)
+
+    coerce(x:$):O ==
+      zero? x => (0$R)::O
+      reduce(_+, [trm2O(t.exp, t.gen) for t in terms x])$List(O)
+
+    trm2O(c, t) ==
+      (c = 1) => term2O t
+      c = -1 => - term2O t
+      c::O * term2O t
+
+    term2O t ==
+      reduce(_*, [rm2O(rm.coef, rm.monom) for rm in t])$List(O)
+
+    rm2O(c, m) ==
+      (c = 1) => m::O
+      (m = 1) => c::O
+      c::O * m::O
+
+    x:$ * y:$ ==
+      +/[ +/[termprod0(t.exp * s.exp, t.gen, s.gen) for s in terms y]
+          for t in terms x]
+
+    termprod0(n, x, y) ==
+      n >= 0 => termprod(n, x, y)::$
+      - (termprod(-n, x, y)::$)
+
+    termprod(n, x, y) ==
+      lc := first(xx := termcopy x)
+      lc.coef := n * lc.coef
+      rm := last xx
+      ((first(y).coef) = 1) =>
+        rm.monom := rm.monom * first(y).monom
+        concat_!(xx, termcopy rest y)
+      ((rm.monom) = 1) =>
+        rm.coef := rm.coef * first(y).coef
+        rm.monom := first(y).monom
+        concat_!(xx, termcopy rest y)
+      concat_!(xx, termcopy y)
+
+    if M has ExpressionSpace then
+
+      opeval(op, r) ==
+        (func := property(op, OPEVAL)) case "failed" => kernel(op, r)
+        ((func::None) pretend (M -> M)) r
+
+    else
+
+      opeval(op, r) ==
+        (func := property(op, OPEVAL)) case "failed" =>
+          error "eval: operator has no evaluation function"
+        ((func::None) pretend (M -> M)) r
+
+    opInvEval(op, r) ==
+      (func := property(op, INVEVAL)) case "failed" =>
+         error "eval: operator has no inverse evaluation function"
+      ((func::None) pretend (M -> M)) r
+
+    termeval(t, r)  ==
+      for rm in reverse t repeat r := rmeval(rm, r)
+      r
+
+    monomeval(m, r) ==
+      for rec in reverse_! factors m repeat
+        e := rec.exp
+        g := rec.gen
+        e > 0 =>
+          for i in 1..e repeat r := opeval(g, r)
+        e < 0 =>
+          for i in 1..(-e) repeat r := opInvEval(g, r)
+      r
+
+    recip x ==
+      (r := retractIfCan(x)@Union(R, "failed")) case "failed" => "failed"
+      (r1 := recip(r::R)) case "failed" => "failed"
+      r1::R::$
+
+    retractIfCan(x:$):Union(R, "failed") ==
+      (r:= retractIfCan(x)@Union(TERM,"failed")) case "failed" => "failed"
+      empty?(t := r::TERM) => 0$R
+      empty? rest t =>
+        rm := first t
+        (rm.monom = 1) => rm.coef
+        "failed"
+      "failed"
+
+    retractIfCan(x:$):Union(OP, "failed") ==
+      (r:= retractIfCan(x)@Union(TERM,"failed")) case "failed" => "failed"
+      empty?(t := r::TERM) => "failed"
+      empty? rest t =>
+        rm := first t
+        (rm.coef = 1) => retractIfCan(rm.monom)
+        "failed"
+      "failed"
+
+    if R has CommutativeRing then
+      termadj  : TERM -> $
+      rmadj    : RM -> $
+      monomadj : FG -> $
+      opadj    : OP -> $
+
+      r:R * x:$        == r::$ * x
+
+      x:$ * r:R        == x * (r::$)
+
+      adjoint x        == +/[t.exp * termadj(t.gen) for t in terms x]
+
+      rmadj t          == conjug(t.coef) * monomadj(t.monom)
+
+      adjoint(op, adj) == nocopy setProperty(retract(op)@OP, OPADJ, adj::None)
+
+      termadj t ==
+        ans:$ := 1
+        for rm in t repeat ans := rmadj(rm) * ans
+        ans
+
+      monomadj m ==
+        ans:$ := 1
+        for rec in factors m repeat ans := (opadj(rec.gen) ** rec.exp) * ans
+        ans
+
+      opadj op ==
+        (adj := property(op, OPADJ)) case "failed" =>
+           error "adjoint: operator does not have a defined adjoint"
+        (adj::None) pretend $
+
+      if R has conjugate:R -> R then
+
+        conjug r == conjugate r else conjug r == r
+
 *)
 
 \end{chunk}
@@ -98985,22 +118817,31 @@ MoebiusTransform(F): Exports == Implementation where
     moebius(aa,bb,cc,dd) == [aa,bb,cc,dd]
  
     a(t:%):F == t.a
+
     b(t:%):F == t.b
+
     c(t:%):F == t.c
+
     d(t:%):F == t.d
  
     1 == moebius(1,0,0,1)
+
     t * s ==
       moebius(b(t)*c(s) + a(t)*a(s), b(t)*d(s) + a(t)*b(s), _
               d(t)*c(s) + c(t)*a(s), d(t)*d(s) + c(t)*b(s))
+
     inv t == moebius(d(t),-b(t),-c(t),a(t))
  
     shift f == moebius(1,f,0,1)
+
     scale f == moebius(f,0,0,1)
+
     recip() == moebius(0,1,1,0)
  
     shift(t,f) == moebius(a(t) + f*c(t), b(t) + f*d(t), c(t), d(t))
+
     scale(t,f) == moebius(f*a(t),f*b(t),c(t),d(t))
+
     recip t    == moebius(c(t),d(t),a(t),b(t))
  
     eval(t:%,f:F) == (a(t)*f + b(t))/(c(t)*f + d(t))
@@ -99035,6 +118876,66 @@ MoebiusTransform(F): Exports == Implementation where
 \begin{chunk}{COQ MOEBIUS}
 (* domain MOEBIUS *)
 (*
+ 
+    Rep := Record(a: F,b: F,c: F,d: F)
+ 
+    moebius(aa,bb,cc,dd) == [aa,bb,cc,dd]
+ 
+    a(t:%):F == t.a
+
+    b(t:%):F == t.b
+
+    c(t:%):F == t.c
+
+    d(t:%):F == t.d
+ 
+    1 == moebius(1,0,0,1)
+
+    t * s ==
+      moebius(b(t)*c(s) + a(t)*a(s), b(t)*d(s) + a(t)*b(s), _
+              d(t)*c(s) + c(t)*a(s), d(t)*d(s) + c(t)*b(s))
+
+    inv t == moebius(d(t),-b(t),-c(t),a(t))
+ 
+    shift f == moebius(1,f,0,1)
+
+    scale f == moebius(f,0,0,1)
+
+    recip() == moebius(0,1,1,0)
+ 
+    shift(t,f) == moebius(a(t) + f*c(t), b(t) + f*d(t), c(t), d(t))
+
+    scale(t,f) == moebius(f*a(t),f*b(t),c(t),d(t))
+
+    recip t    == moebius(c(t),d(t),a(t),b(t))
+ 
+    eval(t:%,f:F) == (a(t)*f + b(t))/(c(t)*f + d(t))
+    eval(t:%,f:P1F) ==
+      (ff := retractIfCan(f)@Union(F,"failed")) case "failed" =>
+        (a(t)/c(t)) :: P1F
+      zero?(den := c(t) * (fff := ff :: F) + d(t)) => infinity()
+      ((a(t) * fff + b(t))/den) :: P1F
+ 
+    coerce t ==
+      var := "%x" :: OUT
+      num := (a(t) :: OUT) * var + (b(t) :: OUT)
+      den := (c(t) :: OUT) * var + (d(t) :: OUT)
+      rarrow(var,num/den)
+ 
+    proportional?: (List F,List F) -> Boolean
+    proportional?(list1,list2) ==
+      empty? list1 => empty? list2
+      empty? list2 => false
+      zero? (x1 := first list1) =>
+        (zero? first list2) and proportional?(rest list1,rest list2)
+      zero? (x2 := first list2) => false
+      map((f1:F):F +-> f1/x1, list1) = map((g1:F):F +-> g1/x2, list2)
+ 
+    t = s ==
+      list1 : List F := [a(t),b(t),c(t),d(t)]
+      list2 : List F := [a(s),b(s),c(s),d(s)]
+      proportional?(list1,list2)
+
 *)
 
 \end{chunk}
@@ -99255,6 +119156,278 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where
           [[r, m]]
 
         if (R has Finite and M has Finite) then
+
+          size() == size()$R ** size()$M
+
+          index k ==
+            -- use p-adic decomposition of k
+            -- coefficient of p**j determines coefficient of index(i+p)$M
+            i:Integer := k rem size()
+            p:Integer := size()$R
+            n:Integer := size()$M
+            ans:% := 0
+            for j in 0.. while i > 0 repeat
+              h := i rem p
+              -- we use index(p) = 0$R
+              if h ^= 0 then
+                c : R := index(h :: PositiveInteger)$R
+                m : M := index((j+n) :: PositiveInteger)$M
+                --ans := ans + c *$% m
+                ans := ans + monomial(c, m)$%
+              i := i quo p
+            ans
+
+          lookup(z : %) : PositiveInteger ==
+            -- could be improved, if M has OrderedSet
+            -- z = index lookup z, n = lookup index n
+            -- use p-adic decomposition of k
+            -- coefficient of p**j determines coefficient of index(i+p)$M
+            zero?(z) => size()$% pretend PositiveInteger
+            liTe : List Term := terms z  -- all non-zero coefficients
+            p  : Integer := size()$R
+            n  : Integer := size()$M
+            res : Integer := 0
+            for te in liTe repeat
+              -- assume that lookup(p)$R = 0
+              l:NonNegativeInteger:=lookup(te.Mn)$M
+              ex : NonNegativeInteger := (n=l => 0;l)
+              co : Integer := lookup(te.Cf)$R
+              res := res + co * p ** ex
+            res pretend PositiveInteger
+
+          random() == index( (1+(random()$Integer rem size()$%) )_
+            pretend PositiveInteger)$%
+
+        0                   == empty()
+
+        1                   == [[1, 1]]
+
+        terms a             == (copy a) pretend List(Term)
+
+        monomials a         == [[t] for t in a]
+
+        coefficients a      == [t.Cf for t in a]
+
+        coerce(m:M):%       == [[1, m]]
+
+        coerce(r:R): % ==
+        -- coerce of ring
+          r = 0 => 0
+          [[r,    1]]
+
+        coerce(n:Integer): % ==
+        -- coerce of integers
+          n = 0 => 0
+          [[n::R, 1]]
+
+        - a                 == [[ -t.Cf, t.Mn] for t in a]
+
+        if R has noZeroDivisors
+           then
+
+            (r:R) * (a:%) ==
+              r = 0 => 0
+              [[r*t.Cf, t.Mn] for t in a]
+
+           else
+
+            (r:R) * (a:%) ==
+              r = 0 => 0
+              [[rt, t.Mn] for t in a | (rt:=r*t.Cf) ^= 0]
+
+        if R has noZeroDivisors
+           then
+
+            (n:Integer) * (a:%) ==
+              n = 0 => 0
+              [[n*t.Cf, t.Mn] for t in a]
+
+           else
+
+            (n:Integer) * (a:%) ==
+              n = 0 => 0
+              [[nt, t.Mn] for t in a | (nt:=n*t.Cf) ^= 0]
+
+        map(f, a)           == [[ft, t.Mn] for t in a | (ft:=f(t.Cf)) ^= 0]
+
+        numberOfMonomials a == #a
+
+        retractIfCan(a:%):Union(M, "failed") ==
+          ((#a) = 1) and ((a.first.Cf) = 1) => a.first.Mn
+          "failed"
+
+        retractIfCan(a:%):Union(R, "failed") ==
+          ((#a) = 1) and ((a.first.Mn) = 1) => a.first.Cf
+          "failed"
+
+        if R has noZeroDivisors then
+          if M has Group then
+
+            recip a ==
+              lt := terms a
+              #lt ^= 1 => "failed"
+              (u := recip lt.first.Cf) case "failed" => "failed"
+              --(u::R) * inv lt.first.Mn
+              monomial((u::R), inv lt.first.Mn)$%
+
+          else
+
+            recip a ==
+              #a ^= 1 or a.first.Mn ^= 1 => "failed"
+              (u := recip a.first.Cf) case "failed" => "failed"
+              u::R::%
+
+        mkTerm(r:R, m:M):Ex ==
+            r=1 => m::Ex
+            r=0 or m=1 => r::Ex
+            r::Ex * m::Ex
+
+        coerce(a:%):Ex ==
+            empty? a => (0$Integer)::Ex
+            empty? rest a => mkTerm(a.first.Cf, a.first.Mn)
+            reduce(_+, [mkTerm(t.Cf, t.Mn) for t in a])$List(Ex)
+
+        if M has OrderedSet then -- we mean totally ordered
+            -- Terms are stored in decending order.
+            leadingCoefficient a == (empty? a => 0; a.first.Cf)
+            leadingMonomial a    == (empty? a => 1; a.first.Mn)
+            reductum a           == (empty? a => a; rest a)
+
+            a = b ==
+                #a ^= #b => false
+                for ta in a for tb in b repeat
+                    ta.Cf ^= tb.Cf or ta.Mn ^= tb.Mn => return false
+                true
+
+            a + b ==
+                c:% := empty()
+                while not empty? a and not empty? b repeat
+                  ta := first a; tb := first b
+                  ra := rest a;  rb := rest b
+                  c :=
+                    ta.Mn > tb.Mn => (a := ra; concat_!(c, ta))
+                    ta.Mn < tb.Mn => (b := rb; concat_!(c, tb))
+                    a := ra; b := rb
+                    not zero?(r := ta.Cf+tb.Cf) =>
+                                        concat_!(c, [r, ta.Mn])
+                    c
+                concat_!(c, concat(a, b))
+
+            coefficient(a, m) ==
+                for t in a repeat
+                    if t.Mn = m then return t.Cf
+                    if t.Mn < m then return 0
+                0
+
+
+            if M has OrderedMonoid then
+
+            -- we use that multiplying an ordered list of monoid elements
+            -- by a single element respects the ordering
+
+              if R has noZeroDivisors then
+                a:% * b:% ==
+                  +/[[[ta.Cf*tb.Cf, ta.Mn*tb.Mn]$Term
+                    for tb in b ] for ta in reverse a]
+              else
+                a:% * b:% ==
+                  +/[[[r, ta.Mn*tb.Mn]$Term
+                    for tb in b | not zero?(r := ta.Cf*tb.Cf)]
+                      for ta in reverse a]
+            else -- M hasn't OrderedMonoid
+
+            -- we cannot assume that mutiplying an ordered list of
+            -- monoid elements by a single element respects the ordering:
+            -- we have to order and to collect equal terms
+              ge : (Term,Term) -> Boolean
+              ge(s,t) == t.Mn <= s.Mn
+
+              sortAndAdd : List Term -> List Term
+              sortAndAdd(liTe) ==  -- assume liTe not empty
+                liTe := sort(ge,liTe)
+                m : M :=  (first liTe).Mn
+                cf : R := (first liTe).Cf
+                res : List Term := []
+                for te in rest liTe repeat
+                  if m = te.Mn then
+                    cf := cf + te.Cf
+                  else
+                    if not zero? cf then res := cons([cf,m]$Term, res)
+                    m := te.Mn
+                    cf := te.Cf
+                if not zero? cf then res := cons([cf,m]$Term, res)
+                reverse res
+
+
+              if R has noZeroDivisors then
+
+                a:% * b:% ==
+                  zero? a => a
+                  zero? b => b  -- avoid calling sortAndAdd with []
+                  +/[sortAndAdd [[ta.Cf*tb.Cf, ta.Mn*tb.Mn]$Term
+                    for tb in b ] for ta in reverse a]
+
+              else
+
+                a:% * b:% ==
+                  zero? a => a
+                  zero? b => b  -- avoid calling sortAndAdd with []
+                  +/[sortAndAdd [[r, ta.Mn*tb.Mn]$Term
+                    for tb in b | not zero?(r := ta.Cf*tb.Cf)]
+                      for ta in reverse a]
+
+
+        else -- M hasn't OrderedSet
+            -- Terms are stored in random order.
+
+          a = b ==
+            #a ^= #b => false
+            brace(a pretend List(Term)) =$Set(Term) brace(b pretend List(Term))
+
+          coefficient(a, m) ==
+            for t in a repeat
+              t.Mn = m => return t.Cf
+            0
+
+          addterm(Tabl: AssociationList(M,R), r:R, m:M):R ==
+              (u := search(m, Tabl)) case "failed" => Tabl.m := r
+              zero?(r := r + u::R) => (remove_!(m, Tabl); 0)
+              Tabl.m := r
+
+          a + b ==
+              Tabl := table()$AssociationList(M,R)
+              for t in a repeat
+                  Tabl t.Mn := t.Cf
+              for t in b repeat
+                  addterm(Tabl, t.Cf, t.Mn)
+              [[Tabl m, m]$Term for m in keys Tabl]
+
+          a:% * b:% ==
+              Tabl := table()$AssociationList(M,R)
+              for ta in a repeat
+                  for tb in (b pretend List(Term)) repeat
+                      addterm(Tabl, ta.Cf*tb.Cf, ta.Mn*tb.Mn)
+              [[Tabl.m, m]$Term for m in keys Tabl]
+
+\end{chunk}
+
+\begin{chunk}{COQ MRING}
+(* domain MRING *)
+(*
+        Ex ==> OutputForm
+        Cf ==> coef
+        Mn ==> monom
+
+        Rep  := List Term
+
+        coerce(x: List Term): % == x :: %
+
+        monomial(r:R, m:M)  ==
+          r = 0 => empty()
+          [[r, m]]
+
+        if (R has Finite and M has Finite) then
+
           size() == size()$R ** size()$M
 
           index k ==
@@ -99297,60 +119470,79 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where
             pretend PositiveInteger)$%
 
         0                   == empty()
+
         1                   == [[1, 1]]
+
         terms a             == (copy a) pretend List(Term)
+
         monomials a         == [[t] for t in a]
+
         coefficients a      == [t.Cf for t in a]
+
         coerce(m:M):%       == [[1, m]]
+
         coerce(r:R): % ==
         -- coerce of ring
           r = 0 => 0
           [[r,    1]]
+
         coerce(n:Integer): % ==
         -- coerce of integers
           n = 0 => 0
           [[n::R, 1]]
+
         - a                 == [[ -t.Cf, t.Mn] for t in a]
+
         if R has noZeroDivisors
            then
+
             (r:R) * (a:%) ==
               r = 0 => 0
               [[r*t.Cf, t.Mn] for t in a]
+
            else
+
             (r:R) * (a:%) ==
               r = 0 => 0
               [[rt, t.Mn] for t in a | (rt:=r*t.Cf) ^= 0]
+
         if R has noZeroDivisors
            then
+
             (n:Integer) * (a:%) ==
               n = 0 => 0
               [[n*t.Cf, t.Mn] for t in a]
+
            else
+
             (n:Integer) * (a:%) ==
               n = 0 => 0
               [[nt, t.Mn] for t in a | (nt:=n*t.Cf) ^= 0]
+
         map(f, a)           == [[ft, t.Mn] for t in a | (ft:=f(t.Cf)) ^= 0]
+
         numberOfMonomials a == #a
 
         retractIfCan(a:%):Union(M, "failed") ==
---          one?(#a) and one?(a.first.Cf) => a.first.Mn
           ((#a) = 1) and ((a.first.Cf) = 1) => a.first.Mn
           "failed"
 
         retractIfCan(a:%):Union(R, "failed") ==
---          one?(#a) and one?(a.first.Mn) => a.first.Cf
           ((#a) = 1) and ((a.first.Mn) = 1) => a.first.Cf
           "failed"
 
         if R has noZeroDivisors then
           if M has Group then
+
             recip a ==
               lt := terms a
               #lt ^= 1 => "failed"
               (u := recip lt.first.Cf) case "failed" => "failed"
               --(u::R) * inv lt.first.Mn
               monomial((u::R), inv lt.first.Mn)$%
+
           else
+
             recip a ==
               #a ^= 1 or a.first.Mn ^= 1 => "failed"
               (u := recip a.first.Cf) case "failed" => "failed"
@@ -99439,12 +119631,15 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where
 
 
               if R has noZeroDivisors then
+
                 a:% * b:% ==
                   zero? a => a
                   zero? b => b  -- avoid calling sortAndAdd with []
                   +/[sortAndAdd [[ta.Cf*tb.Cf, ta.Mn*tb.Mn]$Term
                     for tb in b ] for ta in reverse a]
+
               else
+
                 a:% * b:% ==
                   zero? a => a
                   zero? b => b  -- avoid calling sortAndAdd with []
@@ -99455,6 +119650,7 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where
 
         else -- M hasn't OrderedSet
             -- Terms are stored in random order.
+
           a = b ==
             #a ^= #b => false
             brace(a pretend List(Term)) =$Set(Term) brace(b pretend List(Term))
@@ -99484,11 +119680,6 @@ MonoidRing(R: Ring, M: Monoid): MRcategory == MRdefinition where
                       addterm(Tabl, ta.Cf*tb.Cf, ta.Mn*tb.Mn)
               [[Tabl.m, m]$Term for m in keys Tabl]
 
-\end{chunk}
-
-\begin{chunk}{COQ MRING}
-(* domain MRING *)
-(*
 *)
 
 \end{chunk}
@@ -99898,9 +120089,13 @@ Multiset(S: SetCategory): MultisetAggregate S with
           a::Integer
 
         empty():% == [0,tbl()]
+
         multiset():% == empty()
+
         dictionary():% == empty() -- DictionaryOperations
+
         set():% == empty()
+
         brace():% == empty()
 
         construct(l:List S):% ==
@@ -99910,10 +120105,15 @@ Multiset(S: SetCategory): MultisetAggregate S with
               t.e := inc t.e
               n := inc n
             [n, t]
+
         multiset(l:List S):% == construct l
+
         bag(l:List S):% == construct l         -- BagAggregate
+
         dictionary(l:List S):% == construct l -- DictionaryOperations
+
         set(l:List S):% == construct l
+
         brace(l:List S):% == construct l
 
         multiset(s:S):% == construct [s]
@@ -100060,7 +120260,6 @@ Multiset(S: SetCategory): MultisetAggregate S with
             [m1.count + m2.count, t]
 
         intersect(m1:%, m2:%):% ==
---          if #m1 > #m2 then intersect(m2, m1)
             t := tbl()
             t1:= m1.table
             t2:= m2.table
@@ -100120,6 +120319,248 @@ Multiset(S: SetCategory): MultisetAggregate S with
 \begin{chunk}{COQ MSET}
 (* domain MSET *)
 (*
+
+        Tbl ==> Table(S, Integer)
+        tbl ==> table$Tbl
+        Rep := Record(count: Integer, table: Tbl)
+
+        n: Integer
+        ms, m1, m2: %
+        t,  t1, t2: Tbl
+        D ==> Record(entry: S, count: NonNegativeInteger)
+        K ==> Record(key: S, entry: Integer)
+
+        elt(t:Tbl, s:S):Integer ==
+          a := search(s,t)$Tbl
+          a case "failed" => 0
+          a::Integer
+
+        empty():% == [0,tbl()]
+
+        multiset():% == empty()
+
+        dictionary():% == empty() -- DictionaryOperations
+
+        set():% == empty()
+
+        brace():% == empty()
+
+        construct(l:List S):% ==
+            t := tbl()
+            n := 0
+            for e in l repeat
+              t.e := inc t.e
+              n := inc n
+            [n, t]
+
+        multiset(l:List S):% == construct l
+
+        bag(l:List S):% == construct l         -- BagAggregate
+
+        dictionary(l:List S):% == construct l -- DictionaryOperations
+
+        set(l:List S):% == construct l
+
+        brace(l:List S):% == construct l
+
+        multiset(s:S):% == construct [s]
+
+        if S has ConvertibleTo InputForm then
+          convert(ms:%):InputForm ==
+            convert [convert("multiset"::Symbol)@InputForm,
+             convert(parts ms)@InputForm]
+
+        members(ms:%):List S == keys ms.table
+
+        coerce(ms:%):OutputForm ==
+            l: List OutputForm := empty()
+            t := ms.table
+            colon := ": " :: OutputForm
+            for e in keys t repeat
+                ex := e::OutputForm
+                n := t.e
+                item :=
+                  n > 1 => hconcat [n :: OutputForm,colon, ex]
+                  ex
+                l := cons(item,l)
+            brace l
+
+        duplicates(ms:%):List D == -- MultiDictionary
+          ld : List D := empty()
+          t := ms.table
+          for e in keys t | (n := t.e) > 1 repeat
+            ld := cons([e,n::NonNegativeInteger],ld)
+          ld
+
+        extract_!(ms:%):S ==         -- BagAggregate
+          empty? ms => error "extract: Empty multiset"
+          ms.count := dec ms.count
+          t := ms.table
+          e := inspect(t).key
+          if (n := t.e) > 1 then t.e := dec n
+           else remove_!(e,t)
+          e
+
+        inspect(ms:%):S == inspect(ms.table).key  -- BagAggregate
+
+        insert_!(e:S,ms:%):% ==                  -- BagAggregate
+            ms.count   := inc ms.count
+            ms.table.e := inc ms.table.e
+            ms
+
+        member?(e:S,ms:%):Boolean == member?(e,keys ms.table)
+
+        empty?(ms:%):Boolean == ms.count = 0
+
+        #(ms:%):NonNegativeInteger == ms.count::NonNegativeInteger
+
+        count(e:S, ms:%):NonNegativeInteger == ms.table.e::NonNegativeInteger
+
+        remove_!(e:S, ms:%, max:Integer):% ==
+          zero? max => remove_!(e,ms)
+          t := ms.table
+          if member?(e, keys t) then
+            ((n := t.e) <= max) =>
+              remove_!(e,t)
+              ms.count := ms.count-n
+            max > 0 =>
+              t.e := n-max
+              ms.count := ms.count-max
+            (n := n+max) > 0 =>
+              t.e := -max
+              ms.count := ms.count-n
+          ms
+
+        remove_!(p: S -> Boolean, ms:%, max:Integer):% ==
+          zero? max => remove_!(p,ms)
+          t := ms.table
+          for e in keys t | p(e) repeat
+            ((n := t.e) <= max) =>
+              remove_!(e,t)
+              ms.count := ms.count-n
+            max > 0 =>
+              t.e := n-max
+              ms.count := ms.count-max
+            (n := n+max) > 0 =>
+              t.e := -max
+              ms.count := ms.count-n
+          ms
+
+        remove(e:S, ms:%, max:Integer):% == remove_!(e, copy ms, max)
+
+        remove(p: S -> Boolean,ms:%,max:Integer):% == remove_!(p, copy ms, max)
+
+        remove_!(e:S, ms:%):% == -- DictionaryOperations
+          t := ms.table
+          if member?(e, keys t) then
+            ms.count := ms.count-t.e
+            remove_!(e, t)
+          ms
+
+        remove_!(p:S ->Boolean, ms:%):% == -- DictionaryOperations
+          t := ms.table
+          for e in keys t | p(e) repeat
+            ms.count := ms.count-t.e
+            remove_!(e, t)
+          ms
+
+        select_!(p: S -> Boolean, ms:%):% == -- DictionaryOperations
+          remove_!((s1:S):Boolean+->not p(s1), ms)
+
+        removeDuplicates_!(ms:%):% == -- MultiDictionary
+          t := ms.table
+          l := keys t
+          for e in l repeat t.e := 1
+          ms.count := #l
+          ms
+
+        insert_!(e:S,ms:%,more:NonNegativeInteger):% == -- MultiDictionary
+            ms.count   := ms.count+more
+            ms.table.e := ms.table.e+more
+            ms
+
+        map_!(f: S->S, ms:%):% == -- HomogeneousAggregate
+          t := ms.table
+          t1 := tbl()
+          for e in keys t repeat
+            t1.f(e) := t.e
+            remove_!(e, t)
+          ms.table := t1
+          ms
+
+        map(f: S -> S, ms:%):% == map_!(f, copy ms) -- HomogeneousAggregate
+
+        parts(m:%):List S ==
+          l := empty()$List(S)
+          t := m.table
+          for e in keys t repeat
+            for i in 1..t.e repeat
+              l := cons(e,l)
+          l
+
+        union(m1:%, m2:%):% ==
+            t := tbl()
+            t1:= m1.table
+            t2:= m2.table
+            for e in keys t1 repeat t.e := t1.e
+            for e in keys t2 repeat t.e := t2.e + t.e
+            [m1.count + m2.count, t]
+
+        intersect(m1:%, m2:%):% ==
+            t := tbl()
+            t1:= m1.table
+            t2:= m2.table
+            n := 0
+            for e in keys t1 repeat
+              m := min(t1.e,t2.e)
+              m > 0 =>
+                m := t1.e + t2.e
+                t.e := m
+                n := n + m
+            [n, t]
+
+        difference(m1:%, m2:%):% ==
+            t := tbl()
+            t1:= m1.table
+            t2:= m2.table
+            n := 0
+            for e in keys t1 repeat
+              k1 := t1.e
+              k2 := t2.e
+              k1 > 0 and k2 = 0 =>
+                t.e := k1
+                n := n + k1
+            n = 0 => empty()
+            [n, t]
+
+        symmetricDifference(m1:%, m2:%):% ==
+            union(difference(m1,m2), difference(m2,m1))
+
+        m1 = m2 ==
+            m1.count ^= m2.count => false
+            t1 := m1.table
+            t2 := m2.table
+            for e in keys t1 repeat
+                t1.e ^= t2.e => return false
+            for e in keys t2 repeat
+                t1.e ^= t2.e => return false
+            true
+
+        m1 < m2 ==
+            m1.count >= m2.count => false
+            t1 := m1.table
+            t2 := m2.table
+            for e in keys t1 repeat
+                t1.e > t2.e => return false
+            m1.count < m2.count
+
+        subset?(m1:%, m2:%):Boolean ==
+            m1.count > m2.count => false
+            t1 := m1.table
+            t2 := m2.table
+            for e in keys t1 repeat t1.e > t2.e => return false
+            true
+
 *)
 
 \end{chunk}
@@ -100909,6 +121350,7 @@ MyExpression(q: Symbol, R): Exports == Implementation where
               retract: % -> Fraction UP
 
   Implementation == Expression R add
+
     Rep := Expression R
 
     iunivariate(p: Polynomial R): UP ==
@@ -100943,6 +121385,36 @@ MyExpression(q: Symbol, R): Exports == Implementation where
 \begin{chunk}{COQ MYEXPR}
 (* domain MYEXPR *)
 (*
+
+    Rep := Expression R
+
+    iunivariate(p: Polynomial R): UP ==
+        poly: SparseUnivariatePolynomial(Polynomial R) 
+             := univariate(p, q)$(Polynomial R)
+        map((z1:Polynomial R):R +-> retract(z1), poly)_
+          $UnivariatePolynomialCategoryFunctions2(Polynomial R,
+                    SparseUnivariatePolynomial Polynomial R, 
+                    R, UP)
+
+    retract(p: %): Fraction UP == 
+        poly: Fraction Polynomial R := retract p
+        upoly: UP := iunivariate numer poly
+        vpoly: UP := iunivariate denom poly
+
+        upoly / vpoly
+
+    retract(p: %): UP == iunivariate retract p
+
+    coerce(r: Fraction UP): % == 
+       num: SparseUnivariatePolynomial R := makeSUP numer r
+       den: SparseUnivariatePolynomial R := makeSUP denom r
+       u: Polynomial R := multivariate(num, q)
+       v: Polynomial R := multivariate(den, q)
+
+       quot: Fraction Polynomial R := u/v
+
+       quot::(Expression R)
+
 *)
 
 \end{chunk}
@@ -101297,15 +121769,22 @@ MyUnivariatePolynomial(x:Symbol, R:Ring):
     then coerce: R -> %
     coerce: Polynomial R -> %
    == SparseUnivariatePolynomial(R) add
+
     Rep := SparseUnivariatePolynomial(R)
+
     coerce(p: %):OutputForm  == outputForm(p, outputForm x)
+
     coerce(x: Symbol): % == monomial(1, 1)
+
     coerce(v: Variable(x)):% == monomial(1, 1)
+
     retract(p: %): Symbol == 
         retract(p)@SingletonAsOrderedSet
         x
-    if R has univariate: (R, Symbol) -> SparseUnivariatePolynomial R
-    then coerce(p: R): % == univariate(p, x)$R
+
+    if R has univariate: (R, Symbol) -> SparseUnivariatePolynomial R then
+
+      coerce(p: R): % == univariate(p, x)$R
 
     coerce(p: Polynomial R): % == 
         poly: SparseUnivariatePolynomial(Polynomial R) 
@@ -101319,6 +121798,30 @@ MyUnivariatePolynomial(x:Symbol, R:Ring):
 \begin{chunk}{COQ MYUP}
 (* domain MYUP *)
 (*
+
+    Rep := SparseUnivariatePolynomial(R)
+
+    coerce(p: %):OutputForm  == outputForm(p, outputForm x)
+
+    coerce(x: Symbol): % == monomial(1, 1)
+
+    coerce(v: Variable(x)):% == monomial(1, 1)
+
+    retract(p: %): Symbol == 
+        retract(p)@SingletonAsOrderedSet
+        x
+
+    if R has univariate: (R, Symbol) -> SparseUnivariatePolynomial R then
+
+      coerce(p: R): % == univariate(p, x)$R
+
+    coerce(p: Polynomial R): % == 
+        poly: SparseUnivariatePolynomial(Polynomial R) 
+             := univariate(p, x)$(Polynomial R)
+        map((z1:Polynomial R):R +-> retract(z1), poly)_
+             $UnivariatePolynomialCategoryFunctions2(Polynomial R,
+                    SparseUnivariatePolynomial Polynomial R, R, %)
+
 *)
 
 \end{chunk}
@@ -101937,6 +122440,216 @@ NeitherSparseOrDensePowerSeries(K):Exports == Implementation where
 \begin{chunk}{COQ NSDPS}
 (* domain NSDPS *)
 (*
+
+    Rep:=SER
+    
+    var : Symbol := 't
+    
+    multC: (K,INT,%) -> %
+
+    orderIfNegative(s:%)==
+      zero?(s) => "failed"
+      f:=frst(s)
+      f.k >= 0 => "failed"
+      zero?(f.c) => orderIfNegative(rest(s))
+      f.k
+
+    posExpnPart(s)==
+      zero?(s) => 0
+      o:=order s
+      (o >= 0) => s
+      posExpnPart(rst s)
+            
+    findTerm(s,n)==
+      empty?(s) =>  [n,0]$TERM
+      f:=frst(s)
+      f.k > n => [n,0]$TERM
+      f.k = n => f
+      findTerm(rst(s),n)
+    
+    findCoef(s,i)==findTerm(s,i).c
+    
+    coerce(s:%):SER == s::Rep
+
+    coerce(s:SER):%==s
+
+    localVarForPrintInfo:Boolean:=false()
+
+    printInfo==localVarForPrintInfo
+
+    printInfo(flag)==localVarForPrintInfo:=flag
+
+    outTerm: TERM -> OutputForm
+
+    removeZeroes(s)== delay
+      zero?(s) => 0
+      f:=frst(s)
+      zero?(f.c) => removeZeroes(rst(s))
+      concat(f,removeZeroes(rst(s)))
+    
+    inv(ra)==
+      a:=removeFirstZeroes ra
+      o:=-order(a)
+      aa:=shift(a,o)
+      aai:=recip aa
+      aai case "failed" => _
+        error "Big problem in inv function from CreateSeries"
+      shift(aai,o)
+
+    iDiv: (%,%,K) -> %
+    iDiv(x,y,ry0) == delay
+     empty? x => 0$%
+     sx:TERM:=frst x
+     c0:K:=ry0 * sx.c
+     nT:TERM:=[sx.k, c0]
+     tc0:%:=series(sx.k,c0,0$%)
+     concat(nT,iDiv(rst x - tc0 * rst y,y,ry0))
+     
+    recip x ==
+      empty? x => "failed"
+      rh1:TERM:=frst x
+      ^zero?(rh1.k) => "failed"
+      ic:K:= inv(rh1.c)
+      delay
+        concat([0,ic]$TERM,iDiv(- ic * rst x,x,ic))
+
+    removeFirstZeroes(s)==
+      zero?(s) => 0
+      f:=frst(s)
+      zero?(f.c) => removeFirstZeroes(rst(s))
+      s
+      
+    sbt(sa,sbb)== delay
+      sb:=removeFirstZeroes(sbb)
+      o:=order sb
+      ^(o > 0) => _
+         error "Cannot substitute by a series of order less than 1  !!!!!"
+      empty?(sa) or empty?(sb) => 0 
+      fa:TERM:=frst(sa)
+      fb:TERM:=frst(sb)
+      firstElem:TERM:=[fa.k*fb.k, fa.c*(fb.c**fa.k)]
+      zero?(fa.c) => sbt(rst(sa),sb) 
+      concat(firstElem,  rest((fa.c) * sb ** (fa.k)) + sbt(rst(sa),sb)  )
+
+    coerce(s:%):OutputForm==
+      zero?(s) => "0" :: OutputForm
+      count:SI:= _$streamCount$Lisp
+      lstTerm:List TERM:=empty()
+      rs:%:= s
+      for i in 1..count while  ^empty?(rs) repeat
+        fs:=frst rs
+        rs:=rst rs
+        lstTerm:=concat(lstTerm,fs)
+      listOfOutTerm:List OutputForm:=_
+        [outTerm(t) for t in lstTerm | ^zero?(t.c) ]
+      out:OutputForm:=
+        if empty?(listOfOutTerm) then
+          "0" :: OutputForm
+        else
+          reduce("+", listOfOutTerm)
+      empty?(rs) => out
+      out +  ("..." :: OutputForm)
+
+    outTerm(t)==
+      ee:=t.k
+      cc:=t.c
+      oe:OutputForm:=ee::OutputForm
+      oc:OutputForm:=cc::OutputForm
+      symb:OutputForm:= var :: OutputForm
+      one?(cc) and one?(ee) => symb
+      zero?(ee) => oc
+      one?(cc) => symb ** oe
+      one?(ee) => oc * symb
+      oc * symb ** oe
+
+    removeZeroes(n,s)== delay
+      n < 0 => s
+      zero?(s) => 0
+      f:=frst(s)
+      zero?(f.c) => removeZeroes(n-1, rst(s))
+      concat(f,removeZeroes(n-1, rst(s)))
+
+    order(s:%)==
+      zero?(s) => error _
+       "From order (PlaneCurveLocalPowerSeries): cannot compute the order of 0"
+      f:=frst(s)
+      zero?(f.c) => order(rest(s))
+      f.k
+
+    monomial2series(lpar,lexp,sh)==
+      shift(reduce("*",[s**e for s in lpar for e in lexp]),sh)
+
+    coefOfFirstNonZeroTerm(s:%)==
+      zero?(s) => error _
+       "From order (PlaneCurveLocalPowerSeries): cannot find the coefOfFirstNonZeroTerm"
+      f:=frst(s)
+      zero?(f.c) => coefOfFirstNonZeroTerm(rest(s))
+      f.c
+
+    degreeOfTermLower?: (TERM,INT) -> Boolean
+    degreeOfTermLower?(t,n)== t.k < n
+
+    filterUpTo(s,n)==filterWhile(degreeOfTermLower?(#1,n),s)
+
+    series(exp,coef,s)==cons([exp,coef]$TERM,s)
+
+    a:% ** n:NNI == -- delay
+      zero?(n) => 1
+      expt(a,n :: PositiveInteger)$RepeatedSquaring(%)
+
+    0 == empty()
+
+    1 == construct([[0,1]$TERM])
+
+    zero?(a)==empty?(a::Rep)
+
+    shift(s,n)== delay
+      zero?(s) => 0
+      fs:=frst(s)
+      es:=fs.k
+      concat([es+n,fs.c]$TERM,shift(rest(s),n))
+
+    a:% + b:% == delay
+        zero?(a) => b
+        zero?(b) => a
+        fa:=frst(a)
+        fb:=frst(b)
+        ea:=fa.k
+        eb:=fb.k
+        nc:K
+        ea = eb => concat([ea,fa.c+fb.c]$TERM,rest(a) + rest(b))
+        ea > eb => concat([eb,fb.c]$TERM,a + rest(b))
+        eb > ea => concat([ea,fa.c]$TERM,rest(a) + b)
+
+    - a:% == --delay
+      multC( (-1) :: K , 0 , a)
+    
+    a:% - b:% == --delay
+      a+(-b)
+
+    multC(coef,n,s)== delay
+        zero?(coef) => 0
+        zero?(s) => 0
+        f:=frst(s)
+        concat([f.k+n,coef*f.c]$TERM,multC(coef,n,rest(s)))
+
+    coef:K * s:% == delay
+        zero?(coef) => 0
+        zero?(s) => 0
+        f:=frst(s)
+        concat([f.k,coef*f.c]$TERM, coef *$% rest(s))
+
+    s:% * coef:K == coef * s
+    
+    s1:% * s2:%== delay
+        zero?(s1) or zero?(s2) => 0
+        f1:TERM:=frst(s1)
+        f2:TERM:=frst(s2)
+        e1:INT:=f1.k; e2:INT:=f2.k
+        c1:K:=f1.c;   c2:K:=f2.c
+        concat([e1+e2,c1*c2]$TERM,_
+               multC(c1,e1,rest(s2))+multC(c2,e2,rest(s1))+rest(s1)*rest(s2))
+
 *)
 
 \end{chunk}
@@ -102437,7 +123150,6 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where
        not ground?(ib)$$ => 
          error"Error in monicModulo from NSMP : #2 is not monic"
        mM : $
---       if not one?(ib)$$
        if not ((ib) = 1)$$
          then
            r : R := ground(ib)$$
@@ -102517,14 +123229,16 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where
          test := degree(a,b.v)::Z - db
        q
 
-     lazyPseudoDivide(a:$, b:$): Record(coef:$, gap: N,quotient:$, remainder:$) == 
+     lazyPseudoDivide(a:$, b:$): _
+         Record(coef:$, gap: N,quotient:$, remainder:$) == 
        -- with lazyPseudoDivide$NSUP
        b case R =>
          error " in lazyPseudoDivide$NSMP: #2 is conctant"
        (a case R) or (a.v < b.v) => [1$$,0$N,0$$,a]
        a.v = b.v =>
          cgqr := lazyPseudoDivide(a.ts,b.ts)
-         [cgqr.coef, cgqr.gap, PSimp(cgqr.quotient,a.v), PSimp(cgqr.remainder,a.v)]
+         [cgqr.coef, cgqr.gap, PSimp(cgqr.quotient,a.v), _
+          PSimp(cgqr.remainder,a.v)]
        db: N := degree(b.ts)$D
        lcb: $ := leadingCoefficient(b.ts)$D
        test: Z := degree(a,b.v)::Z - db
@@ -102569,14 +123283,12 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where
 
        LazardQuotient(x:$, y:$, n: N):$ == 
          zero?(n) => error("LazardQuotient$NSMP : n = 0")
---         one?(n) => x
          (n = 1) => x
          a: N := 1
          while n >= (b := 2*a) repeat a := b
          c: $ := x
          n := (n - a)::N
          repeat       
---           one?(a) => return c
            (a = 1) => return c
            a := a quo 2
            c := exactQuo(c*c,y)
@@ -102584,7 +123296,6 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where
 
        LazardQuotient2(p:$, a:$, b:$, n: N) ==
          zero?(n) => error " in LazardQuotient2$NSMP: bad #4"
---         one?(n) => p
          (n = 1) => p
          c: $  := LazardQuotient(a,b,(n-1)::N)
          exactQuo(c*p,b)
@@ -102648,13 +123359,11 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where
        then
 
          exactQuotient (a:$,b:R) ==
---           one? b => a
            (b = 1) => a
            a case R => (a::R quo$R b)::$
            ([a.v, map((a1:%):% +-> exactQuotient(a1,b),a.ts)$SUP2]$VPoly)::Rep
 
          exactQuotient! (a:$,b:R) ==
---           one? b => a
            (b = 1) => a
            a case R => (a::R quo$R b)::$
            a.ts := map((a1:%):% +-> exactQuotient!(a1,b),a.ts)$SUP2
@@ -102663,13 +123372,11 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where
        else
 
          exactQuotient (a:$,b:R) ==
---           one? b => a
            (b = 1) => a
            a case R => ((a::R exquo$R b)::R)::$
            ([a.v, map((a1:%):% +-> exactQuotient(a1,b),a.ts)$SUP2]$VPoly)::Rep
 
          exactQuotient! (a:$,b:R) == 
---           one? b => a
            (b = 1) => a
            a case R => ((a::R exquo$R b)::R)::$
            a.ts := map((a1:%):% +-> exactQuotient!(a1,b),a.ts)$SUP2
@@ -102683,7 +123390,6 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where
          gcd(r,content(p))$R         
 
        gcd(r:R,p:$):R ==
---         one? r => r
          (r = 1) => r
          zero? p => r
          localGcd(r,p)
@@ -102692,7 +123398,6 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where
          p case R => p
          up : D := p.ts
          r := 0$R
---         while (not zero? up) and (not one? r) repeat
          while (not zero? up) and (not (r = 1)) repeat
            r := localGcd(r,leadingCoefficient(up))
            up := reductum up
@@ -102711,6 +123416,370 @@ NewSparseMultivariatePolynomial(R,VarSet) : Exports == Implementation where
 \begin{chunk}{COQ NSMP}
 (* domain NSMP *)
 (*
+
+     D := NewSparseUnivariatePolynomial($)
+     VPoly:=  Record(v:VarSet,ts:D)
+     Rep:= Union(R,VPoly)
+
+    --local function
+     PSimp: (D,VarSet) -> %
+
+     PSimp(up,mv) ==
+       if degree(up) = 0 then leadingCoefficient(up) else [mv,up]$VPoly
+
+     coerce (p:$):SMPR == 
+       p pretend SMPR
+
+     coerce (p:SMPR):$ == 
+       p pretend $
+
+     retractIfCan (p:$) : Union(SMPR,"failed") == 
+       (p pretend SMPR)::Union(SMPR,"failed")
+
+     mvar p == 
+       p case R => error" Error in mvar from NSMP : #1 has no variables."
+       p.v
+
+     mdeg p == 
+       p case R => 0$N
+       degree(p.ts)$D
+
+     init p == 
+       p case R => error" Error in init from NSMP : #1 has no variables."
+       leadingCoefficient(p.ts)$D
+
+     head p == 
+       p case R => p
+       ([p.v,leadingMonomial(p.ts)$D]$VPoly)::Rep
+
+     tail p == 
+       p case R => 0$$
+       red := reductum(p.ts)$D
+       ground?(red)$D => (ground(red)$D)::Rep
+       ([p.v,red]$VPoly)::Rep
+
+     iteratedInitials p == 
+       p case R => [] 
+       p := leadingCoefficient(p.ts)$D
+       cons(p,iteratedInitials(p)) 
+
+     localDeepestInitial (p : $) : $ == 
+       p case R => p 
+       localDeepestInitial leadingCoefficient(p.ts)$D 
+
+     deepestInitial p == 
+       p case R => 
+         error"Error in deepestInitial from NSMP : #1 has no variables."
+       localDeepestInitial leadingCoefficient(p.ts)$D  
+
+     mainMonomial p == 
+       zero? p => 
+         error"Error in mainMonomial from NSMP : the argument is zero"
+       p case R => 1$$ 
+       monomial(1$$,p.v,degree(p.ts)$D)
+
+     leastMonomial p == 
+       zero? p => 
+         error"Error in leastMonomial from NSMP : the argument is zero"
+       p case R => 1$$
+       monomial(1$$,p.v,minimumDegree(p.ts)$D)
+
+     mainCoefficients p == 
+       zero? p => 
+         error"Error in mainCoefficients from NSMP : the argument is zero"
+       p case R => [p]
+       coefficients(p.ts)$D
+
+     leadingCoefficient(p:$,x:VarSet):$ == 
+       (p case R) => p
+       p.v = x => leadingCoefficient(p.ts)$D
+       zero? (d := degree(p,x)) => p
+       coefficient(p,x,d)
+
+     localMonicModulo(a:$,b:$):$ ==
+       -- b is assumed to have initial 1
+       a case R => a
+       a.v < b.v => a 
+       mM: $
+       if a.v > b.v
+         then 
+           m : D := map((a1:%):% +-> localMonicModulo(a1,b),a.ts)$SUP2
+         else
+           m : D := monicModulo(a.ts,b.ts)$D
+       if ground?(m)$D 
+          then 
+            mM := (ground(m)$D)::Rep 
+          else 
+            mM := ([a.v,m]$VPoly)::Rep
+       mM
+
+     monicModulo (a,b) == 
+       b case R => error"Error in monicModulo from NSMP : #2 is constant"
+       ib : $ := init(b)@$
+       not ground?(ib)$$ => 
+         error"Error in monicModulo from NSMP : #2 is not monic"
+       mM : $
+       if not ((ib) = 1)$$
+         then
+           r : R := ground(ib)$$
+           rec : Union(R,"failed"):= recip(r)$R
+           (rec case "failed") =>
+             error"Error in monicModulo from NSMP : #2 is not monic"
+           a case R => a
+           a := (rec::R) * a
+           b := (rec::R) * b
+           mM := ib * localMonicModulo (a,b)
+         else
+           mM := localMonicModulo (a,b)
+       mM
+
+     prem(a:$, b:$): $ == 
+       -- with pseudoRemainder$NSUP
+       b case R =>
+         error "in prem$NSMP: ground? #2"
+       db: N := degree(b.ts)$D
+       lcb: $ := leadingCoefficient(b.ts)$D
+       test: Z := degree(a,b.v)::Z - db
+       delta: Z := max(test + 1$Z, 0$Z)
+       (a case R) or (a.v < b.v) => lcb ** (delta::N) * a
+       a.v = b.v =>
+         r: D := pseudoRemainder(a.ts,b.ts)$D
+         ground?(r) => return (ground(r)$D)::Rep 
+         ([a.v,r]$VPoly)::Rep
+       while not zero?(a) and not negative?(test) repeat 
+         term := monomial(leadingCoefficient(a,b.v),b.v,test::N)
+         a := lcb * a - term * b
+         delta := delta - 1$Z 
+         test := degree(a,b.v)::Z - db
+       lcb ** (delta::N) * a
+
+     pquo (a:$, b:$)  : $ == 
+       cPS := lazyPseudoDivide (a,b)
+       c := (cPS.coef) ** (cPS.gap)
+       c * cPS.quotient
+
+     pseudoDivide(a:$, b:$): Record (quotient : $, remainder : $) ==
+       -- from RPOLCAT
+       cPS := lazyPseudoDivide(a,b)
+       c := (cPS.coef) ** (cPS.gap)
+       [c * cPS.quotient, c * cPS.remainder]
+
+     lazyPrem(a:$, b:$): $ == 
+       -- with lazyPseudoRemainder$NSUP
+       -- Uses leadingCoefficient: ($, V) -> $
+       b case R =>
+         error "in lazyPrem$NSMP: ground? #2"
+       (a case R) or (a.v < b.v) =>  a
+       a.v = b.v => PSimp(lazyPseudoRemainder(a.ts,b.ts)$D,a.v)
+       db: N := degree(b.ts)$D
+       lcb: $ := leadingCoefficient(b.ts)$D
+       test: Z := degree(a,b.v)::Z - db
+       while not zero?(a) and not negative?(test) repeat 
+         term := monomial(leadingCoefficient(a,b.v),b.v,test::N)
+         a := lcb * a - term * b
+         test := degree(a,b.v)::Z - db
+       a
+
+     lazyPquo (a:$, b:$) : $ ==
+       -- with lazyPseudoQuotient$NSUP
+       b case R =>
+         error " in lazyPquo$NSMP: #2 is conctant"
+       (a case R) or (a.v < b.v) => 0
+       a.v = b.v => PSimp(lazyPseudoQuotient(a.ts,b.ts)$D,a.v)
+       db: N := degree(b.ts)$D
+       lcb: $ := leadingCoefficient(b.ts)$D
+       test: Z := degree(a,b.v)::Z - db
+       q := 0$$
+       test: Z := degree(a,b.v)::Z - db
+       while not zero?(a) and not negative?(test) repeat 
+         term := monomial(leadingCoefficient(a,b.v),b.v,test::N)
+         a := lcb * a - term * b
+         q := lcb * q + term
+         test := degree(a,b.v)::Z - db
+       q
+
+     lazyPseudoDivide(a:$, b:$): _
+         Record(coef:$, gap: N,quotient:$, remainder:$) == 
+       -- with lazyPseudoDivide$NSUP
+       b case R =>
+         error " in lazyPseudoDivide$NSMP: #2 is conctant"
+       (a case R) or (a.v < b.v) => [1$$,0$N,0$$,a]
+       a.v = b.v =>
+         cgqr := lazyPseudoDivide(a.ts,b.ts)
+         [cgqr.coef, cgqr.gap, PSimp(cgqr.quotient,a.v), _
+          PSimp(cgqr.remainder,a.v)]
+       db: N := degree(b.ts)$D
+       lcb: $ := leadingCoefficient(b.ts)$D
+       test: Z := degree(a,b.v)::Z - db
+       q := 0$$
+       delta: Z := max(test + 1$Z, 0$Z) 
+       while not zero?(a) and not negative?(test) repeat 
+         term := monomial(leadingCoefficient(a,b.v),b.v,test::N)
+         a := lcb * a - term * b
+         q := lcb * q + term
+         delta := delta - 1$Z 
+         test := degree(a,b.v)::Z - db
+       [lcb, (delta::N), q, a]
+
+     lazyResidueClass(a:$, b:$): Record(polnum:$, polden:$, power:N) == 
+       -- with lazyResidueClass$NSUP
+       b case R =>
+         error " in lazyResidueClass$NSMP: #2 is conctant"
+       lcb: $ := leadingCoefficient(b.ts)$D
+       (a case R) or (a.v < b.v) => [a,lcb,0]
+       a.v = b.v =>
+         lrc := lazyResidueClass(a.ts,b.ts)$D
+         [PSimp(lrc.polnum,a.v), lrc.polden, lrc.power]
+       db: N := degree(b.ts)$D
+       test: Z := degree(a,b.v)::Z - db
+       pow: N := 0
+       while not zero?(a) and not negative?(test) repeat 
+         term := monomial(leadingCoefficient(a,b.v),b.v,test::N)
+         a := lcb * a - term * b
+         pow := pow + 1
+         test := degree(a,b.v)::Z - db
+       [a, lcb, pow]
+
+     if R has IntegralDomain
+     then
+
+       packD := PseudoRemainderSequence($,D)
+
+       exactQuo(x:$, y:$):$ == 
+         ex: Union($,"failed") := x exquo$$ y
+         (ex case $) => ex::$
+         error "in exactQuotient$NSMP: bad args"
+
+       LazardQuotient(x:$, y:$, n: N):$ == 
+         zero?(n) => error("LazardQuotient$NSMP : n = 0")
+         (n = 1) => x
+         a: N := 1
+         while n >= (b := 2*a) repeat a := b
+         c: $ := x
+         n := (n - a)::N
+         repeat       
+           (a = 1) => return c
+           a := a quo 2
+           c := exactQuo(c*c,y)
+           if n >= a then ( c := exactQuo(c*x,y) ; n := (n - a)::N )
+
+       LazardQuotient2(p:$, a:$, b:$, n: N) ==
+         zero?(n) => error " in LazardQuotient2$NSMP: bad #4"
+         (n = 1) => p
+         c: $  := LazardQuotient(a,b,(n-1)::N)
+         exactQuo(c*p,b)
+
+       next_subResultant2(p:$, q:$, z:$, s:$) ==
+         PSimp(next_sousResultant2(p.ts,q.ts,z.ts,s)$packD,p.v)
+
+       subResultantGcd(a:$, b:$): $ ==
+         (a case R) or (b case R) => 
+           error "subResultantGcd$NSMP: one arg is constant"
+         a.v ~= b.v => 
+           error "subResultantGcd$NSMP: mvar(#1) ~= mvar(#2)"
+         PSimp(subResultantGcd(a.ts,b.ts),a.v)
+
+       halfExtendedSubResultantGcd1(a:$,b:$): Record (gcd: $, coef1: $) ==
+         (a case R) or (b case R) => 
+           error "halfExtendedSubResultantGcd1$NSMP: one arg is constant"
+         a.v ~= b.v => 
+           error "halfExtendedSubResultantGcd1$NSMP: mvar(#1) ~= mvar(#2)"
+         hesrg := halfExtendedSubResultantGcd1(a.ts,b.ts)$D
+         [PSimp(hesrg.gcd,a.v), PSimp(hesrg.coef1,a.v)]
+
+       halfExtendedSubResultantGcd2(a:$,b:$): Record (gcd: $, coef2: $) ==
+         (a case R) or (b case R) => 
+           error "halfExtendedSubResultantGcd2$NSMP: one arg is constant"
+         a.v ~= b.v => 
+           error "halfExtendedSubResultantGcd2$NSMP: mvar(#1) ~= mvar(#2)"
+         hesrg := halfExtendedSubResultantGcd2(a.ts,b.ts)$D
+         [PSimp(hesrg.gcd,a.v), PSimp(hesrg.coef2,a.v)]
+
+       extendedSubResultantGcd(a:$,b:$): Record (gcd: $, coef1: $, coef2: $) ==
+         (a case R) or (b case R) => 
+           error "extendedSubResultantGcd$NSMP: one arg is constant"
+         a.v ~= b.v => 
+           error "extendedSubResultantGcd$NSMP: mvar(#1) ~= mvar(#2)"
+         esrg := extendedSubResultantGcd(a.ts,b.ts)$D
+         [PSimp(esrg.gcd,a.v),PSimp(esrg.coef1,a.v),PSimp(esrg.coef2,a.v)]  
+
+       resultant(a:$, b:$): $ ==
+         (a case R) or (b case R) => 
+           error "resultant$NSMP: one arg is constant"
+         a.v ~= b.v => 
+           error "resultant$NSMP: mvar(#1) ~= mvar(#2)"
+         resultant(a.ts,b.ts)$D
+
+       subResultantChain(a:$, b:$): List $ ==
+         (a case R) or (b case R) => 
+           error "subResultantChain$NSMP: one arg is constant"
+         a.v ~= b.v => 
+           error "subResultantChain$NSMP: mvar(#1) ~= mvar(#2)"
+         [PSimp(up,a.v) for up in subResultantsChain(a.ts,b.ts)]
+
+       lastSubResultant(a:$, b:$): $ ==
+         (a case R) or (b case R) => 
+           error "lastSubResultant$NSMP: one arg is constant"
+         a.v ~= b.v => 
+           error "lastSubResultant$NSMP: mvar(#1) ~= mvar(#2)"
+         PSimp(lastSubResultant(a.ts,b.ts),a.v)
+
+       if R has EuclideanDomain
+       then
+
+         exactQuotient (a:$,b:R) ==
+           (b = 1) => a
+           a case R => (a::R quo$R b)::$
+           ([a.v, map((a1:%):% +-> exactQuotient(a1,b),a.ts)$SUP2]$VPoly)::Rep
+
+         exactQuotient! (a:$,b:R) ==
+           (b = 1) => a
+           a case R => (a::R quo$R b)::$
+           a.ts := map((a1:%):% +-> exactQuotient!(a1,b),a.ts)$SUP2
+           a
+
+       else
+
+         exactQuotient (a:$,b:R) ==
+           (b = 1) => a
+           a case R => ((a::R exquo$R b)::R)::$
+           ([a.v, map((a1:%):% +-> exactQuotient(a1,b),a.ts)$SUP2]$VPoly)::Rep
+
+         exactQuotient! (a:$,b:R) == 
+           (b = 1) => a
+           a case R => ((a::R exquo$R b)::R)::$
+           a.ts := map((a1:%):% +-> exactQuotient!(a1,b),a.ts)$SUP2
+           a
+
+     if R has GcdDomain
+     then
+
+       localGcd(r:R,p:$):R ==
+         p case R => gcd(r,p::R)$R
+         gcd(r,content(p))$R         
+
+       gcd(r:R,p:$):R ==
+         (r = 1) => r
+         zero? p => r
+         localGcd(r,p)
+
+       content p ==
+         p case R => p
+         up : D := p.ts
+         r := 0$R
+         while (not zero? up) and (not (r = 1)) repeat
+           r := localGcd(r,leadingCoefficient(up))
+           up := reductum up
+         r
+
+       primitivePart! p ==
+         zero? p => p
+         p case R => 1$$
+         cp := content(p)
+         p.ts := 
+           unitCanonical(map((a1:%):% +-> exactQuotient!(a1,cp),p.ts)$SUP2)$D
+         p
+
 *)
 
 \end{chunk}
@@ -103159,9 +124228,11 @@ NewSparseUnivariatePolynomial(R): Exports == Implementation where
   Implementation == SparseUnivariatePolynomial(R) add
    
      Term == Record(k:NonNegativeInteger,c:R)
+
      Rep ==> List Term
 
      rep(s:$):Rep == s pretend Rep
+
      per(l:Rep):$ == l pretend $
 
      coerce (p:$):SUPR == 
@@ -103179,12 +124250,10 @@ NewSparseUnivariatePolynomial(R): Exports == Implementation where
                 ground? y =>
                    error "in monicModulo$NSUP: ground? #2"
                 yy := rep y
---                not one? (yy.first.c) => 
                 not ((yy.first.c) = 1) => 
                    error "in monicModulo$NSUP: not monic #2"
                 xx := rep x; empty? xx => x
                 e := yy.first.k; y := per(yy.rest)                
-                -- while (not empty? xx) repeat
                 repeat
                   if (u:=subtractIfCan(xx.first.k,e)) case "failed" then break
                   xx:= rep fmecg(per rest(xx), u, xx.first.c, y)
@@ -103213,7 +124282,6 @@ NewSparseUnivariatePolynomial(R): Exports == Implementation where
                    error "in lazyPseudoRemainder$NSUP: ground? #2"
                 ground? x => x
                 yy := rep y; co := yy.first.c
---                one? co => monicModulo(x,y)
                 (co = 1) => monicModulo(x,y)
                 (co = -1) => - monicModulo(-x,-y)
                 xx:= rep x; e := yy.first.k; y := per(yy.rest)
@@ -103258,6 +124326,7 @@ NewSparseUnivariatePolynomial(R): Exports == Implementation where
 
      if R has IntegralDomain
      then 
+
        pack ==> PseudoRemainderSequence(R, %)
 
        subResultantGcd(p1,p2) == subResultantGcd(p1,p2)$pack
@@ -103269,27 +124338,33 @@ NewSparseUnivariatePolynomial(R): Exports == Implementation where
        resultant(p1,p2) == resultant(p1,p2)$pack
 
        extendedResultant(p1,p2) == 
-          re: Record(coef1: $, coef2: $, resultant: R) := resultantEuclidean(p1,p2)$pack
+          re: Record(coef1: $, coef2: $, resultant: R) := _
+            resultantEuclidean(p1,p2)$pack
           [re.resultant, re.coef1, re.coef2]
 
        halfExtendedResultant1(p1:$, p2: $): Record(resultant: R, coef1: $) ==
-          re: Record(coef1: $, resultant: R) := semiResultantEuclidean1(p1, p2)$pack
+          re: Record(coef1: $, resultant: R) := _
+            semiResultantEuclidean1(p1, p2)$pack
           [re.resultant, re.coef1]
 
        halfExtendedResultant2(p1:$, p2: $): Record(resultant: R, coef2: $) ==
-          re: Record(coef2: $, resultant: R) := semiResultantEuclidean2(p1, p2)$pack
+          re: Record(coef2: $, resultant: R) := _
+           semiResultantEuclidean2(p1, p2)$pack
           [re.resultant, re.coef2]
 
        extendedSubResultantGcd(p1,p2) == 
-          re: Record(coef1: $, coef2: $, gcd: $) := subResultantGcdEuclidean(p1,p2)$pack
+          re: Record(coef1: $, coef2: $, gcd: $) := _
+            subResultantGcdEuclidean(p1,p2)$pack
           [re.gcd, re.coef1, re.coef2]
 
        halfExtendedSubResultantGcd1(p1:$, p2: $): Record(gcd: $, coef1: $) ==
-          re: Record(coef1: $, gcd: $) := semiSubResultantGcdEuclidean1(p1, p2)$pack
+          re: Record(coef1: $, gcd: $) := _
+            semiSubResultantGcdEuclidean1(p1, p2)$pack
           [re.gcd, re.coef1]
 
        halfExtendedSubResultantGcd2(p1:$, p2: $): Record(gcd: $, coef2: $) ==
-          re: Record(coef2: $, gcd: $) := semiSubResultantGcdEuclidean2(p1, p2)$pack
+          re: Record(coef2: $, gcd: $) := _
+            semiSubResultantGcdEuclidean2(p1, p2)$pack
           [re.gcd, re.coef2]
 
        pseudoDivide(x,y) ==
@@ -103337,6 +124412,187 @@ NewSparseUnivariatePolynomial(R): Exports == Implementation where
 \begin{chunk}{COQ NSUP}
 (* domain NSUP *)
 (*
+   
+     Term == Record(k:NonNegativeInteger,c:R)
+
+     Rep ==> List Term
+
+     rep(s:$):Rep == s pretend Rep
+
+     per(l:Rep):$ == l pretend $
+
+     coerce (p:$):SUPR == 
+       p pretend SUPR
+
+     coerce (p:SUPR):$ == 
+       p pretend $
+
+     retractIfCan (p:$) : Union(SUPR,"failed") == 
+       (p pretend SUPR)::Union(SUPR,"failed")
+
+     monicModulo(x,y) ==
+                zero? y => 
+                   error "in monicModulo$NSUP: division by 0"
+                ground? y =>
+                   error "in monicModulo$NSUP: ground? #2"
+                yy := rep y
+                not ((yy.first.c) = 1) => 
+                   error "in monicModulo$NSUP: not monic #2"
+                xx := rep x; empty? xx => x
+                e := yy.first.k; y := per(yy.rest)                
+                repeat
+                  if (u:=subtractIfCan(xx.first.k,e)) case "failed" then break
+                  xx:= rep fmecg(per rest(xx), u, xx.first.c, y)
+                  if empty? xx then break
+                per xx
+
+     lazyResidueClass(x,y) ==
+                zero? y => 
+                   error "in lazyResidueClass$NSUP: division by 0"
+                ground? y =>
+                   error "in lazyResidueClass$NSUP: ground? #2"
+                yy := rep y; co := yy.first.c; xx: Rep := rep x
+                empty? xx => [x, co, 0]
+                pow: NNI := 0; e := yy.first.k; y := per(yy.rest); 
+                repeat
+                  if (u:=subtractIfCan(xx.first.k,e)) case "failed" then break
+                  xx:= rep fmecg(co * per rest(xx), u, xx.first.c, y)
+                  pow := pow + 1
+                  if empty? xx then break
+                [per xx, co, pow]
+
+     lazyPseudoRemainder(x,y) ==
+                zero? y => 
+                   error "in lazyPseudoRemainder$NSUP: division by 0"
+                ground? y =>
+                   error "in lazyPseudoRemainder$NSUP: ground? #2"
+                ground? x => x
+                yy := rep y; co := yy.first.c
+                (co = 1) => monicModulo(x,y)
+                (co = -1) => - monicModulo(-x,-y)
+                xx:= rep x; e := yy.first.k; y := per(yy.rest)
+                repeat
+                  if (u:=subtractIfCan(xx.first.k,e)) case "failed" then break
+                  xx:= rep fmecg(co * per rest(xx), u, xx.first.c, y)
+                  if empty? xx then break
+                per xx
+
+     lazyPseudoDivide(x,y) ==
+                zero? y => 
+                   error "in lazyPseudoDivide$NSUP: division by 0"
+                ground? y =>
+                   error "in lazyPseudoDivide$NSUP: ground? #2"
+                yy := rep y; e := yy.first.k; 
+                xx: Rep := rep x; co := yy.first.c
+                (empty? xx) or (xx.first.k < e) => [co,0,0,x]
+                pow: NNI := subtractIfCan(xx.first.k,e)::NNI + 1
+                qq: Rep := []; y := per(yy.rest)
+                repeat
+                  if (u:=subtractIfCan(xx.first.k,e)) case "failed" then break
+                  qq := cons([u::NNI, xx.first.c]$Term, rep (co * per qq))
+                  xx := rep fmecg(co * per rest(xx), u, xx.first.c, y)
+                  pow := subtractIfCan(pow,1)::NNI
+                  if empty? xx then break
+                [co, pow, per reverse qq, per xx]
+
+     lazyPseudoQuotient(x,y) ==
+                zero? y => 
+                   error "in lazyPseudoQuotient$NSUP: division by 0"
+                ground? y =>
+                   error "in lazyPseudoQuotient$NSUP: ground? #2"
+                yy := rep y; e := yy.first.k; xx: Rep := rep x
+                (empty? xx) or (xx.first.k < e) => 0
+                qq: Rep := []; co := yy.first.c; y := per(yy.rest)
+                repeat
+                  if (u:=subtractIfCan(xx.first.k,e)) case "failed" then break
+                  qq := cons([u::NNI, xx.first.c]$Term, rep (co * per qq))
+                  xx := rep fmecg(co * per rest(xx), u, xx.first.c, y)
+                  if empty? xx then break
+                per reverse qq
+
+     if R has IntegralDomain
+     then 
+
+       pack ==> PseudoRemainderSequence(R, %)
+
+       subResultantGcd(p1,p2) == subResultantGcd(p1,p2)$pack
+
+       subResultantsChain(p1,p2) == chainSubResultants(p1,p2)$pack
+
+       lastSubResultant(p1,p2) == lastSubResultant(p1,p2)$pack
+
+       resultant(p1,p2) == resultant(p1,p2)$pack
+
+       extendedResultant(p1,p2) == 
+          re: Record(coef1: $, coef2: $, resultant: R) := _
+            resultantEuclidean(p1,p2)$pack
+          [re.resultant, re.coef1, re.coef2]
+
+       halfExtendedResultant1(p1:$, p2: $): Record(resultant: R, coef1: $) ==
+          re: Record(coef1: $, resultant: R) := _
+            semiResultantEuclidean1(p1, p2)$pack
+          [re.resultant, re.coef1]
+
+       halfExtendedResultant2(p1:$, p2: $): Record(resultant: R, coef2: $) ==
+          re: Record(coef2: $, resultant: R) := _
+           semiResultantEuclidean2(p1, p2)$pack
+          [re.resultant, re.coef2]
+
+       extendedSubResultantGcd(p1,p2) == 
+          re: Record(coef1: $, coef2: $, gcd: $) := _
+            subResultantGcdEuclidean(p1,p2)$pack
+          [re.gcd, re.coef1, re.coef2]
+
+       halfExtendedSubResultantGcd1(p1:$, p2: $): Record(gcd: $, coef1: $) ==
+          re: Record(coef1: $, gcd: $) := _
+            semiSubResultantGcdEuclidean1(p1, p2)$pack
+          [re.gcd, re.coef1]
+
+       halfExtendedSubResultantGcd2(p1:$, p2: $): Record(gcd: $, coef2: $) ==
+          re: Record(coef2: $, gcd: $) := _
+            semiSubResultantGcdEuclidean2(p1, p2)$pack
+          [re.gcd, re.coef2]
+
+       pseudoDivide(x,y) ==
+                zero? y => 
+                   error "in pseudoDivide$NSUP: division by 0"
+                ground? y =>
+                   error "in pseudoDivide$NSUP: ground? #2"
+                yy := rep y; e := yy.first.k
+                xx: Rep := rep x; co := yy.first.c
+                (empty? xx) or (xx.first.k < e) => [co,0,x]
+                pow: NNI := subtractIfCan(xx.first.k,e)::NNI + 1
+                qq: Rep := []; y := per(yy.rest)
+                repeat
+                  if (u:=subtractIfCan(xx.first.k,e)) case "failed" then break
+                  qq := cons([u::NNI, xx.first.c]$Term, rep (co * per qq))
+                  xx := rep fmecg(co * per rest(xx), u, xx.first.c, y)
+                  pow := subtractIfCan(pow,1)::NNI
+                  if empty? xx then break
+                zero? pow => [co, per reverse qq, per xx]
+                default: R := co ** pow
+                q := default * (per reverse qq)
+                x := default * (per xx)
+                [co, q, x]
+
+       pseudoQuotient(x,y) ==
+                zero? y => 
+                   error "in pseudoDivide$NSUP: division by 0"
+                ground? y =>
+                   error "in pseudoDivide$NSUP: ground? #2"
+                yy := rep y; e := yy.first.k; xx: Rep := rep x
+                (empty? xx) or (xx.first.k < e) => 0
+                pow: NNI := subtractIfCan(xx.first.k,e)::NNI + 1
+                qq: Rep := []; co := yy.first.c; y := per(yy.rest)
+                repeat
+                  if (u:=subtractIfCan(xx.first.k,e)) case "failed" then break
+                  qq := cons([u::NNI, xx.first.c]$Term, rep (co * per qq))
+                  xx := rep fmecg(co * per rest(xx), u, xx.first.c, y)
+                  pow := subtractIfCan(pow,1)::NNI
+                  if empty? xx then break
+                zero? pow => per reverse qq
+                (co ** pow) * (per reverse qq)
+
 *)
 
 \end{chunk}
@@ -103455,7 +124711,9 @@ o )show None
 ++ the interpreter and some of the internal \spadtype{Expression} code).
 
 None():SetCategory == add
+
     coerce(none:%):OutputForm == "NONE" :: OutputForm
+
     x:% = y:% == EQ(x,y)$Lisp
 
 \end{chunk}
@@ -103463,6 +124721,11 @@ None():SetCategory == add
 \begin{chunk}{COQ NONE}
 (* domain NONE *)
 (*
+
+    coerce(none:%):OutputForm == "NONE" :: OutputForm
+
+    x:% = y:% == EQ(x,y)$Lisp
+
 *)
 
 \end{chunk}
@@ -103603,9 +124866,13 @@ NonNegativeInteger: Join(OrderedAbelianMonoidSup,Monoid) with
               ++ that is, \spad{x*y = y*x}.
 
   == SubDomain(Integer,#1 >= 0) add
+
       x,y:%
+
       sup(x,y) == MAX(x,y)$Lisp
+
       shift(x:%, n:Integer):% == ASH(x,n)$Lisp
+
       subtractIfCan(x, y) ==
         c:Integer := (x pretend Integer) - (y pretend Integer)
         c < 0 => "failed"
@@ -103616,6 +124883,20 @@ NonNegativeInteger: Join(OrderedAbelianMonoidSup,Monoid) with
 \begin{chunk}{COQ NNI}
 (* domain NNI *)
 (*
+
+SubDomain(Integer,#1 >= 0) add
+
+      x,y:%
+
+      sup(x,y) == MAX(x,y)$Lisp
+
+      shift(x:%, n:Integer):% == ASH(x,n)$Lisp
+
+      subtractIfCan(x, y) ==
+        c:Integer := (x pretend Integer) - (y pretend Integer)
+        c < 0 => "failed"
+        c pretend %
+
 *)
 
 \end{chunk}
@@ -103821,6 +125102,21 @@ NottinghamGroup(F:FiniteFieldCategory): Group with
 \begin{chunk}{COQ NOTTING}
 (* domain NOTTING *)
 (*
+  Rep:=UnivariateFormalPowerSeries F
+
+  coerce f == coerce(f::Rep)$UnivariateFormalPowerSeries(F)
+
+  retract f ==
+    if zero? coefficient(f,0) and one? coefficient(f,1)
+    then f::Rep
+    else error"The leading term must be x"
+
+  1 == monomial(1,1)
+
+  f*g == f.g
+
+  inv f == revert f
+
 *)
 
 \end{chunk}
@@ -103955,14 +125251,19 @@ NumericalIntegrationProblem(): EE == II where
       ++ retract(x) is not documented
 
  II ==> add
+
       Rep := Union(nia:NIAA,mdnia:MDNIAA)
  
       coerce(s:NIAA) == [s]
+
       coerce(s:MDNIAA) == [s]
+
       coerce(s:Union(nia:NIAA,mdnia:MDNIAA)) == s
+
       coerce(x:%):OutputForm ==
         (x) case nia => (x.nia)::OutputForm
         (x.mdnia)::OutputForm
+
       retract(x:%):Union(nia:NIAA,mdnia:MDNIAA) ==
         (x) case nia => [x.nia]
         [x.mdnia]
@@ -103972,6 +125273,23 @@ NumericalIntegrationProblem(): EE == II where
 \begin{chunk}{COQ NIPROB}
 (* domain NIPROB *)
 (*
+
+      Rep := Union(nia:NIAA,mdnia:MDNIAA)
+ 
+      coerce(s:NIAA) == [s]
+
+      coerce(s:MDNIAA) == [s]
+
+      coerce(s:Union(nia:NIAA,mdnia:MDNIAA)) == s
+
+      coerce(x:%):OutputForm ==
+        (x) case nia => (x.nia)::OutputForm
+        (x.mdnia)::OutputForm
+
+      retract(x:%):Union(nia:NIAA,mdnia:MDNIAA) ==
+        (x) case nia => [x.nia]
+        [x.mdnia]
+
 *)
 
 \end{chunk}
@@ -104090,11 +125408,14 @@ NumericalODEProblem(): EE == II where
       ++ retract(x) is not documented
 
  II ==> add
+
       Rep := ODEAB
  
       coerce(s:ODEAB) == s
+
       coerce(x:%):OutputForm ==
         (retract(x))::OutputForm
+
       retract(x:%):ODEAB == x :: Rep
 
 \end{chunk}
@@ -104102,6 +125423,16 @@ NumericalODEProblem(): EE == II where
 \begin{chunk}{COQ ODEPROB}
 (* domain ODEPROB *)
 (*
+
+      Rep := ODEAB
+ 
+      coerce(s:ODEAB) == s
+
+      coerce(x:%):OutputForm ==
+        (retract(x))::OutputForm
+
+      retract(x:%):ODEAB == x :: Rep
+
 *)
 
 \end{chunk}
@@ -104237,14 +125568,19 @@ NumericalOptimizationProblem(): EE == II where
       ++ retract(x) is not documented
 
  II ==> add
+
       Rep := UNOALSAD
  
       coerce(s:NOAD) == [s]
+
       coerce(s:LSAD) == [s]
+
       coerce(x:UNOALSAD) == x
+
       coerce(x:%):OutputForm ==
         (x) case noa => (x.noa)::OutputForm
         (x.lsa)::OutputForm
+
       retract(x:%):UNOALSAD ==
         (x) case noa => [x.noa]
         [x.lsa]
@@ -104254,6 +125590,23 @@ NumericalOptimizationProblem(): EE == II where
 \begin{chunk}{COQ OPTPROB}
 (* domain OPTPROB *)
 (*
+
+      Rep := UNOALSAD
+ 
+      coerce(s:NOAD) == [s]
+
+      coerce(s:LSAD) == [s]
+
+      coerce(x:UNOALSAD) == x
+
+      coerce(x:%):OutputForm ==
+        (x) case noa => (x.noa)::OutputForm
+        (x.lsa)::OutputForm
+
+      retract(x:%):UNOALSAD ==
+        (x) case noa => [x.noa]
+        [x.lsa]
+
 *)
 
 \end{chunk}
@@ -104388,11 +125741,14 @@ NumericalPDEProblem(): EE == II where
       ++ retract(x) is not documented
 
  II ==> add
+
       Rep := PDEBC
  
       coerce(s:PDEBC) == s
+
       coerce(x:%):OutputForm ==
         (retract(x))::OutputForm
+
       retract(x:%):PDEBC == x :: Rep
 
 \end{chunk}
@@ -104400,6 +125756,16 @@ NumericalPDEProblem(): EE == II where
 \begin{chunk}{COQ PDEPROB}
 (* domain PDEPROB *)
 (*
+
+      Rep := PDEBC
+ 
+      coerce(s:PDEBC) == s
+
+      coerce(x:%):OutputForm ==
+        (retract(x))::OutputForm
+
+      retract(x:%):PDEBC == x :: Rep
+
 *)
 
 \end{chunk}
@@ -104849,34 +126215,51 @@ Octonion(R:CommutativeRing): export == impl where
       ++ octon(qe,qE) constructs an octonion from two quaternions
       ++ using the relation O = Q + QE.
   impl ==> add
+
     Rep := Record(e: QR,E: QR)
  
     0 == [0,0]
+
     1 == [1,0]
  
     a,b,c,d,f,g,h,i : R
+
     p,q : QR
+
     x,y : %
  
     real  x == real (x.e)
+
     imagi x == imagI (x.e)
+
     imagj x == imagJ (x.e)
+
     imagk x == imagK (x.e)
+
     imagE x == real (x.E)
+
     imagI x == imagI (x.E)
+
     imagJ x == imagJ (x.E)
+
     imagK x == imagK (x.E)
+
     octon(a,b,c,d,f,g,h,i) == [quatern(a,b,c,d)$QR,quatern(f,g,h,i)$QR]
+
     octon(p,q) == [p,q]
+
     coerce(q) == [q,0$QR] 
+
     retract(x):QR ==
-      not(zero? imagE x and zero? imagI x and zero? imagJ x and zero? imagK x)=>
+     not(zero? imagE x and zero? imagI x and zero? imagJ x and zero? imagK x)=>
         error "Cannot retract octonion to quaternion."
-      quatern(real x, imagi x,imagj x, imagk x)$QR
+     quatern(real x, imagi x,imagj x, imagk x)$QR
+
     retractIfCan(x):Union(QR,"failed") ==
-      not(zero? imagE x and zero? imagI x and zero? imagJ x and zero? imagK x)=>
+     not(zero? imagE x and zero? imagI x and zero? imagJ x and zero? imagK x)=>
         "failed"
-      quatern(real x, imagi x,imagj x, imagk x)$QR
+     quatern(real x, imagi x,imagj x, imagk x)$QR
+
     x * y == [x.e*y.e-(conjugate y.E)*x.E, y.E*x.e + x.E*(conjugate y.e)]
 
 \end{chunk}
@@ -104884,6 +126267,53 @@ Octonion(R:CommutativeRing): export == impl where
 \begin{chunk}{COQ OCT}
 (* domain OCT *)
 (*
+
+    Rep := Record(e: QR,E: QR)
+ 
+    0 == [0,0]
+
+    1 == [1,0]
+ 
+    a,b,c,d,f,g,h,i : R
+
+    p,q : QR
+
+    x,y : %
+ 
+    real  x == real (x.e)
+
+    imagi x == imagI (x.e)
+
+    imagj x == imagJ (x.e)
+
+    imagk x == imagK (x.e)
+
+    imagE x == real (x.E)
+
+    imagI x == imagI (x.E)
+
+    imagJ x == imagJ (x.E)
+
+    imagK x == imagK (x.E)
+
+    octon(a,b,c,d,f,g,h,i) == [quatern(a,b,c,d)$QR,quatern(f,g,h,i)$QR]
+
+    octon(p,q) == [p,q]
+
+    coerce(q) == [q,0$QR] 
+
+    retract(x):QR ==
+     not(zero? imagE x and zero? imagI x and zero? imagJ x and zero? imagK x)=>
+        error "Cannot retract octonion to quaternion."
+     quatern(real x, imagi x,imagj x, imagk x)$QR
+
+    retractIfCan(x):Union(QR,"failed") ==
+     not(zero? imagE x and zero? imagI x and zero? imagJ x and zero? imagK x)=>
+        "failed"
+     quatern(real x, imagi x,imagj x, imagk x)$QR
+
+    x * y == [x.e*y.e-(conjugate y.E)*x.E, y.E*x.e + x.E*(conjugate y.e)]
+
 *)
 
 \end{chunk}
@@ -105005,6 +126435,7 @@ ODEIntensityFunctionsTable(): E == I where
       ++ table of intensity functions k.
 
   I ==> add
+
     Rep := Table(ODEA,ATT)
     import Rep
 
@@ -105034,6 +126465,31 @@ ODEIntensityFunctionsTable(): E == I where
 \begin{chunk}{COQ ODEIFTBL}
 (* domain ODEIFTBL *)
 (*
+
+    Rep := Table(ODEA,ATT)
+    import Rep
+
+    theIFTable:$ := empty()$Rep
+
+    showTheIFTable():$ ==
+      theIFTable
+
+    clearTheIFTable():Void ==
+      theIFTable := empty()$Rep
+      void()$Void
+
+    iFTable(l:List Record(key:ODEA,entry:ATT)):$ ==
+      theIFTable := table(l)$Rep
+
+    insert!(r:Record(key:ODEA,entry:ATT)):$ ==
+      insert!(r,theIFTable)$Rep
+
+    keys(t:$):List ODEA ==
+      keys(t)$Rep
+
+    showIntensityFunctions(k:ODEA):Union(ATT,"failed") ==
+      search(k,theIFTable)$Rep
+
 *)
 
 \end{chunk}
@@ -105384,12 +126840,14 @@ OneDimensionalArray(S:Type): Exports == Implementation where
     ++X oneDimensionalArray(10,0.0)
 
   Implementation == IndexedOneDimensionalArray(S, ARRAYMININDEX) add
+
     oneDimensionalArray(u) ==
       n := #u
       n = 0 => empty()
       a := new(n, first u)
       for i in 2..n for x in rest u repeat a.i := x
       a
+
     oneDimensionalArray(n,s) == new(n,s)
 
 \end{chunk}
@@ -105397,6 +126855,17 @@ OneDimensionalArray(S:Type): Exports == Implementation where
 \begin{chunk}{COQ ARRAY1}
 (* domain ARRAY1 *)
 (*
+ IndexedOneDimensionalArray(S, ARRAYMININDEX) add
+
+    oneDimensionalArray(u) ==
+      n := #u
+      n = 0 => empty()
+      a := new(n, first u)
+      for i in 2..n for x in rest u repeat a.i := x
+      a
+
+    oneDimensionalArray(n,s) == new(n,s)
+
 *)
 
 \end{chunk}
@@ -105563,13 +127032,19 @@ OnePointCompletion(R:SetCategory): Exports == Implementation where
         ++ it is one, "failed" otherwise.
 
   Implementation ==> add
+
     Rep := Union(R, "infinity")
 
     coerce(r:R):%          == r
+
     retract(x:%):R         == (x case R => x::R; error "Not finite")
+
     finite? x              == x case R
+
     infinite? x            == x case "infinity"
+
     infinity()             == "infinity"
+
     retractIfCan(x:%):Union(R, "failed") == (x case R => x::R; "failed")
 
     coerce(x:%):OutputForm ==
@@ -105582,6 +127057,7 @@ OnePointCompletion(R:SetCategory): Exports == Implementation where
       x::R = y::R
 
     if R has AbelianGroup then
+
       0 == 0$R
 
       n:Integer * x:% ==
@@ -105600,9 +127076,11 @@ OnePointCompletion(R:SetCategory): Exports == Implementation where
         x::R + y::R
 
     if R has OrderedRing then
+
       fininf: R -> %
 
       1                == 1$R
+
       characteristic() == characteristic()$R
 
       fininf r ==
@@ -105628,7 +127106,9 @@ OnePointCompletion(R:SetCategory): Exports == Implementation where
         x::R < y::R
 
     if R has IntegerNumberSystem then
+
       rational? x == finite? x
+
       rational  x == rational(retract(x)@R)
 
       rationalIfCan x ==
@@ -105640,6 +127120,89 @@ OnePointCompletion(R:SetCategory): Exports == Implementation where
 \begin{chunk}{COQ ONECOMP}
 (* domain ONECOMP *)
 (*
+
+    Rep := Union(R, "infinity")
+
+    coerce(r:R):%          == r
+
+    retract(x:%):R         == (x case R => x::R; error "Not finite")
+
+    finite? x              == x case R
+
+    infinite? x            == x case "infinity"
+
+    infinity()             == "infinity"
+
+    retractIfCan(x:%):Union(R, "failed") == (x case R => x::R; "failed")
+
+    coerce(x:%):OutputForm ==
+      x case "infinity" => "infinity"::OutputForm
+      x::R::OutputForm
+
+    x = y ==
+      x case "infinity" => y case "infinity"
+      y case "infinity" => false
+      x::R = y::R
+
+    if R has AbelianGroup then
+
+      0 == 0$R
+
+      n:Integer * x:% ==
+        x case "infinity" =>
+          zero? n => error "Undefined product"
+          infinity()
+        n * x::R
+
+      - x ==
+        x case "infinity" => error "Undefined inverse"
+        - (x::R)
+
+      x + y ==
+        x case "infinity" => x
+        y case "infinity" => y
+        x::R + y::R
+
+    if R has OrderedRing then
+
+      fininf: R -> %
+
+      1                == 1$R
+
+      characteristic() == characteristic()$R
+
+      fininf r ==
+        zero? r => error "Undefined product"
+        infinity()
+
+      x:% * y:% ==
+        x case "infinity" =>
+          y case "infinity" => y
+          fininf(y::R)
+        y case "infinity" => fininf(x::R)
+        x::R * y::R
+
+      recip x ==
+        x case "infinity" => 0
+        zero?(x::R) => infinity()
+        (u := recip(x::R)) case "failed" => "failed"
+        u::R::%
+
+      x < y ==
+        x case "infinity" => false     -- do not change the order
+        y case "infinity" => true      -- of those two tests
+        x::R < y::R
+
+    if R has IntegerNumberSystem then
+
+      rational? x == finite? x
+
+      rational  x == rational(retract(x)@R)
+
+      rationalIfCan x ==
+        (r:= retractIfCan(x)@Union(R,"failed")) case "failed" =>"failed"
+        rational(r::R)
+
 *)
 
 \end{chunk}
@@ -105726,16 +127289,20 @@ OpenMathConnection(): with
   OMconnectTCP  : (%, String, SingleInteger) -> Boolean ++ \spad{OMconnectTCP}
   OMbindTCP     : (%, SingleInteger) -> Boolean ++ \spad{OMbindTCP}
  == add
+
   OMmakeConn(timeout: SingleInteger): % == OM_-MAKECONN(timeout)$Lisp
+
   OMcloseConn(conn: %): Void == OM_-CLOSECONN(conn)$Lisp
 
   OMconnInDevice(conn: %): OpenMathDevice ==
     OM_-GETCONNINDEV(conn)$Lisp
+
   OMconnOutDevice(conn: %): OpenMathDevice ==
     OM_-GETCONNOUTDEV(conn)$Lisp
 
   OMconnectTCP(conn: %, host: String, port: SingleInteger): Boolean ==
     OM_-CONNECTTCP(conn, host, port)$Lisp
+
   OMbindTCP(conn: %, port: SingleInteger): Boolean ==
     OM_-BINDTCP(conn, port)$Lisp
 
@@ -105744,6 +127311,23 @@ OpenMathConnection(): with
 \begin{chunk}{COQ OMCONN}
 (* domain OMCONN *)
 (*
+
+  OMmakeConn(timeout: SingleInteger): % == OM_-MAKECONN(timeout)$Lisp
+
+  OMcloseConn(conn: %): Void == OM_-CLOSECONN(conn)$Lisp
+
+  OMconnInDevice(conn: %): OpenMathDevice ==
+    OM_-GETCONNINDEV(conn)$Lisp
+
+  OMconnOutDevice(conn: %): OpenMathDevice ==
+    OM_-GETCONNOUTDEV(conn)$Lisp
+
+  OMconnectTCP(conn: %, host: String, port: SingleInteger): Boolean ==
+    OM_-CONNECTTCP(conn, host, port)$Lisp
+
+  OMbindTCP(conn: %, port: SingleInteger): Boolean ==
+    OM_-BINDTCP(conn, port)$Lisp
+
 *)
 
 \end{chunk}
@@ -105977,56 +127561,96 @@ OpenMathDevice(): with
   OMgetType     : % -> Symbol
   ++ OMgetType(dev) returns the type of the next object on \axiom{dev}.
  == add
+
   OMopenFile(fname: String, fmode: String, enc: OpenMathEncoding): % ==
     OM_-OPENFILEDEV(fname, fmode, enc)$Lisp
+
   OMopenString(str: String, enc: OpenMathEncoding): % ==
     OM_-OPENSTRINGDEV(str, enc)$Lisp
+
   OMclose(dev: %): Void ==
     OM_-CLOSEDEV(dev)$Lisp
+
   OMsetEncoding(dev: %, enc: OpenMathEncoding): Void ==
     OM_-SETDEVENCODING(dev, enc)$Lisp
 
   OMputApp(dev: %): Void == OM_-PUTAPP(dev)$Lisp
+
   OMputAtp(dev: %): Void == OM_-PUTATP(dev)$Lisp
+
   OMputAttr(dev: %): Void == OM_-PUTATTR(dev)$Lisp
+
   OMputBind(dev: %): Void == OM_-PUTBIND(dev)$Lisp
+
   OMputBVar(dev: %): Void == OM_-PUTBVAR(dev)$Lisp
+
   OMputError(dev: %): Void == OM_-PUTERROR(dev)$Lisp
+
   OMputObject(dev: %): Void == OM_-PUTOBJECT(dev)$Lisp
+
   OMputEndApp(dev: %): Void == OM_-PUTENDAPP(dev)$Lisp
+
   OMputEndAtp(dev: %): Void == OM_-PUTENDATP(dev)$Lisp
+
   OMputEndAttr(dev: %): Void == OM_-PUTENDATTR(dev)$Lisp
+
   OMputEndBind(dev: %): Void == OM_-PUTENDBIND(dev)$Lisp
+
   OMputEndBVar(dev: %): Void == OM_-PUTENDBVAR(dev)$Lisp
+
   OMputEndError(dev: %): Void == OM_-PUTENDERROR(dev)$Lisp
+
   OMputEndObject(dev: %): Void == OM_-PUTENDOBJECT(dev)$Lisp
+
   OMputInteger(dev: %, i: Integer): Void == OM_-PUTINT(dev, i)$Lisp
+
   OMputFloat(dev: %, f: DoubleFloat): Void == OM_-PUTFLOAT(dev, f)$Lisp
-  --OMputByteArray(dev: %, b: Array Byte): Void == OM_-PUTBYTEARRAY(dev, b)$Lisp
+
   OMputVariable(dev: %, v: Symbol): Void == OM_-PUTVAR(dev, v)$Lisp
+
   OMputString(dev: %, s: String): Void == OM_-PUTSTRING(dev, s)$Lisp
-  OMputSymbol(dev: %, cd: String, nm: String): Void == OM_-PUTSYMBOL(dev, cd, nm)$Lisp
+
+  OMputSymbol(dev: %, cd: String, nm: String): Void ==
+    OM_-PUTSYMBOL(dev, cd, nm)$Lisp
 
   OMgetApp(dev: %): Void == OM_-GETAPP(dev)$Lisp
+
   OMgetAtp(dev: %): Void == OM_-GETATP(dev)$Lisp
+
   OMgetAttr(dev: %): Void == OM_-GETATTR(dev)$Lisp
+
   OMgetBind(dev: %): Void == OM_-GETBIND(dev)$Lisp
+
   OMgetBVar(dev: %): Void == OM_-GETBVAR(dev)$Lisp
+
   OMgetError(dev: %): Void == OM_-GETERROR(dev)$Lisp
+
   OMgetObject(dev: %): Void == OM_-GETOBJECT(dev)$Lisp
+
   OMgetEndApp(dev: %): Void == OM_-GETENDAPP(dev)$Lisp
+
   OMgetEndAtp(dev: %): Void == OM_-GETENDATP(dev)$Lisp
+
   OMgetEndAttr(dev: %): Void == OM_-GETENDATTR(dev)$Lisp
+
   OMgetEndBind(dev: %): Void == OM_-GETENDBIND(dev)$Lisp
+
   OMgetEndBVar(dev: %): Void == OM_-GETENDBVAR(dev)$Lisp
+
   OMgetEndError(dev: %): Void == OM_-GETENDERROR(dev)$Lisp
+
   OMgetEndObject(dev: %): Void == OM_-GETENDOBJECT(dev)$Lisp
+
   OMgetInteger(dev: %): Integer == OM_-GETINT(dev)$Lisp
+
   OMgetFloat(dev: %): DoubleFloat == OM_-GETFLOAT(dev)$Lisp
-  --OMgetByteArray(dev: %): Array Byte == OM_-GETBYTEARRAY(dev)$Lisp
+
   OMgetVariable(dev: %): Symbol == OM_-GETVAR(dev)$Lisp
+
   OMgetString(dev: %): String == OM_-GETSTRING(dev)$Lisp
-  OMgetSymbol(dev: %): Record(cd:String, name:String) == OM_-GETSYMBOL(dev)$Lisp
+
+  OMgetSymbol(dev: %): Record(cd:String, name:String) ==
+    OM_-GETSYMBOL(dev)$Lisp
 
   OMgetType(dev: %): Symbol == OM_-GETTYPE(dev)$Lisp
 
@@ -106035,6 +127659,99 @@ OpenMathDevice(): with
 \begin{chunk}{COQ OMDEV}
 (* domain OMDEV *)
 (*
+
+  OMopenFile(fname: String, fmode: String, enc: OpenMathEncoding): % ==
+    OM_-OPENFILEDEV(fname, fmode, enc)$Lisp
+
+  OMopenString(str: String, enc: OpenMathEncoding): % ==
+    OM_-OPENSTRINGDEV(str, enc)$Lisp
+
+  OMclose(dev: %): Void ==
+    OM_-CLOSEDEV(dev)$Lisp
+
+  OMsetEncoding(dev: %, enc: OpenMathEncoding): Void ==
+    OM_-SETDEVENCODING(dev, enc)$Lisp
+
+  OMputApp(dev: %): Void == OM_-PUTAPP(dev)$Lisp
+
+  OMputAtp(dev: %): Void == OM_-PUTATP(dev)$Lisp
+
+  OMputAttr(dev: %): Void == OM_-PUTATTR(dev)$Lisp
+
+  OMputBind(dev: %): Void == OM_-PUTBIND(dev)$Lisp
+
+  OMputBVar(dev: %): Void == OM_-PUTBVAR(dev)$Lisp
+
+  OMputError(dev: %): Void == OM_-PUTERROR(dev)$Lisp
+
+  OMputObject(dev: %): Void == OM_-PUTOBJECT(dev)$Lisp
+
+  OMputEndApp(dev: %): Void == OM_-PUTENDAPP(dev)$Lisp
+
+  OMputEndAtp(dev: %): Void == OM_-PUTENDATP(dev)$Lisp
+
+  OMputEndAttr(dev: %): Void == OM_-PUTENDATTR(dev)$Lisp
+
+  OMputEndBind(dev: %): Void == OM_-PUTENDBIND(dev)$Lisp
+
+  OMputEndBVar(dev: %): Void == OM_-PUTENDBVAR(dev)$Lisp
+
+  OMputEndError(dev: %): Void == OM_-PUTENDERROR(dev)$Lisp
+
+  OMputEndObject(dev: %): Void == OM_-PUTENDOBJECT(dev)$Lisp
+
+  OMputInteger(dev: %, i: Integer): Void == OM_-PUTINT(dev, i)$Lisp
+
+  OMputFloat(dev: %, f: DoubleFloat): Void == OM_-PUTFLOAT(dev, f)$Lisp
+
+  OMputVariable(dev: %, v: Symbol): Void == OM_-PUTVAR(dev, v)$Lisp
+
+  OMputString(dev: %, s: String): Void == OM_-PUTSTRING(dev, s)$Lisp
+
+  OMputSymbol(dev: %, cd: String, nm: String): Void ==
+    OM_-PUTSYMBOL(dev, cd, nm)$Lisp
+
+  OMgetApp(dev: %): Void == OM_-GETAPP(dev)$Lisp
+
+  OMgetAtp(dev: %): Void == OM_-GETATP(dev)$Lisp
+
+  OMgetAttr(dev: %): Void == OM_-GETATTR(dev)$Lisp
+
+  OMgetBind(dev: %): Void == OM_-GETBIND(dev)$Lisp
+
+  OMgetBVar(dev: %): Void == OM_-GETBVAR(dev)$Lisp
+
+  OMgetError(dev: %): Void == OM_-GETERROR(dev)$Lisp
+
+  OMgetObject(dev: %): Void == OM_-GETOBJECT(dev)$Lisp
+
+  OMgetEndApp(dev: %): Void == OM_-GETENDAPP(dev)$Lisp
+
+  OMgetEndAtp(dev: %): Void == OM_-GETENDATP(dev)$Lisp
+
+  OMgetEndAttr(dev: %): Void == OM_-GETENDATTR(dev)$Lisp
+
+  OMgetEndBind(dev: %): Void == OM_-GETENDBIND(dev)$Lisp
+
+  OMgetEndBVar(dev: %): Void == OM_-GETENDBVAR(dev)$Lisp
+
+  OMgetEndError(dev: %): Void == OM_-GETENDERROR(dev)$Lisp
+
+  OMgetEndObject(dev: %): Void == OM_-GETENDOBJECT(dev)$Lisp
+
+  OMgetInteger(dev: %): Integer == OM_-GETINT(dev)$Lisp
+
+  OMgetFloat(dev: %): DoubleFloat == OM_-GETFLOAT(dev)$Lisp
+
+  OMgetVariable(dev: %): Symbol == OM_-GETVAR(dev)$Lisp
+
+  OMgetString(dev: %): String == OM_-GETSTRING(dev)$Lisp
+
+  OMgetSymbol(dev: %): Record(cd:String, name:String) ==
+    OM_-GETSYMBOL(dev)$Lisp
+
+  OMgetType(dev: %): Symbol == OM_-GETTYPE(dev)$Lisp
+
 *)
 
 \end{chunk}
@@ -106125,6 +127842,7 @@ OpenMathEncoding(): SetCategory with
   OMencodingBinary  : () -> %
   ++ OMencodingBinary() is the constant for the OpenMath binary encoding.
  == add
+
   Rep := SingleInteger
 
   =(u,v) == (u=v)$Rep
@@ -106139,8 +127857,11 @@ OpenMathEncoding(): SetCategory with
     error "Bogus OpenMath Encoding Type"
 
   OMencodingUnknown(): % == 0::Rep
+
   OMencodingBinary(): % == 1::Rep
+
   OMencodingXML(): % == 2::Rep
+
   OMencodingSGML(): % == 3::Rep
 
 \end{chunk}
@@ -106148,6 +127869,28 @@ OpenMathEncoding(): SetCategory with
 \begin{chunk}{COQ OMENC}
 (* domain OMENC *)
 (*
+
+  Rep := SingleInteger
+
+  =(u,v) == (u=v)$Rep
+
+  import Rep
+
+  coerce(u) ==
+    u::Rep = 0$Rep => "Unknown"::OutputForm
+    u::Rep = 1$Rep => "Binary"::OutputForm
+    u::Rep = 2::Rep => "XML"::OutputForm
+    u::Rep = 3::Rep => "SGML"::OutputForm
+    error "Bogus OpenMath Encoding Type"
+
+  OMencodingUnknown(): % == 0::Rep
+
+  OMencodingBinary(): % == 1::Rep
+
+  OMencodingXML(): % == 2::Rep
+
+  OMencodingSGML(): % == 3::Rep
+
 *)
 
 \end{chunk}
@@ -106234,6 +127977,7 @@ OpenMathError() : SetCategory with
   omError   : (OpenMathErrorKind, List Symbol) -> % 
   ++ omError(k,l) creates an instance of OpenMathError.
  == add
+
   Rep := Record(err:OpenMathErrorKind, info:List Symbol)
 
   import List String
@@ -106242,7 +127986,6 @@ OpenMathError() : SetCategory with
     OMParseError? e.err => message "Error parsing OpenMath object"
     infoSize := #(e.info)
     OMUnknownCD? e.err => 
---      not one? infoSize => error "Malformed info list in OMUnknownCD"
       not (infoSize = 1) => error "Malformed info list in OMUnknownCD"
       message concat("Cannot handle CD ",string first e.info)
     OMUnknownSymbol? e.err =>
@@ -106256,6 +127999,7 @@ OpenMathError() : SetCategory with
   omError(e:OpenMathErrorKind,i:List Symbol):% == [e,i]$Rep
 
   errorKind(e:%):OpenMathErrorKind == e.err
+
   errorInfo(e:%):List Symbol == e.info
 
 \end{chunk}
@@ -106263,6 +128007,31 @@ OpenMathError() : SetCategory with
 \begin{chunk}{COQ OMERR}
 (* domain OMERR *)
 (*
+
+  Rep := Record(err:OpenMathErrorKind, info:List Symbol)
+
+  import List String
+
+  coerce(e:%):OutputForm ==
+    OMParseError? e.err => message "Error parsing OpenMath object"
+    infoSize := #(e.info)
+    OMUnknownCD? e.err => 
+      not (infoSize = 1) => error "Malformed info list in OMUnknownCD"
+      message concat("Cannot handle CD ",string first e.info)
+    OMUnknownSymbol? e.err =>
+      not 2=infoSize => error "Malformed info list in OMUnknownSymbol"
+      message concat ["Cannot handle Symbol ",
+                      string e.info.2, " from CD ", string e.info.1]
+    OMReadError? e.err =>
+      message "OpenMath read error"
+    error "Malformed OpenMath Error"
+
+  omError(e:OpenMathErrorKind,i:List Symbol):% == [e,i]$Rep
+
+  errorKind(e:%):OpenMathErrorKind == e.err
+
+  errorInfo(e:%):List Symbol == e.info
+
 *)
 
 \end{chunk}
@@ -106358,12 +128127,16 @@ OpenMathErrorKind() : SetCategory with
   OMReadError?     : % -> Boolean
   ++ OMReadError?(u) tests whether u is an OpenMath read error.
  == add
+
   Rep := Union(parseError:"OMParseError", unknownCD:"OMUnknownCD", 
                unknownSymbol:"OMUnknownSymbol",readError:"OMReadError")
 
   OMParseError?(u) == (u case parseError)$Rep
+
   OMUnknownCD?(u) == (u case unknownCD)$Rep
+
   OMUnknownSymbol?(u) == (u case unknownSymbol)$Rep
+
   OMReadError?(u) == (u case readError)$Rep
 
   coerce(s:Symbol):% == 
@@ -106382,6 +128155,29 @@ OpenMathErrorKind() : SetCategory with
 \begin{chunk}{COQ OMERRK}
 (* domain OMERRK *)
 (*
+
+  Rep := Union(parseError:"OMParseError", unknownCD:"OMUnknownCD", 
+               unknownSymbol:"OMUnknownSymbol",readError:"OMReadError")
+
+  OMParseError?(u) == (u case parseError)$Rep
+
+  OMUnknownCD?(u) == (u case unknownCD)$Rep
+
+  OMUnknownSymbol?(u) == (u case unknownSymbol)$Rep
+
+  OMReadError?(u) == (u case readError)$Rep
+
+  coerce(s:Symbol):% == 
+    s = OMParseError    => ["OMParseError"]$Rep
+    s = OMUnknownCD     => ["OMUnknownCD"]$Rep
+    s = OMUnknownSymbol => ["OMUnknownSymbol"]$Rep
+    s = OMReadError     => ["OMReadError"]$Rep
+    error concat(string s, " is not a valid OpenMathErrorKind.")
+
+  a = b == (a=b)$Rep
+
+  coerce(e:%):OutputForm == coerce(e)$Rep
+
 *)
 
 \end{chunk}
@@ -107009,12 +128805,19 @@ OppositeMonogenicLinearOperator(P, R): OPRcat == OPRdef where
         po: $ -> P  ++ po(q) creates a value in P equal to q in $.
 
    OPRdef  == P add
+
         Rep := P
+
         x, y: $
+
         a: P
+
         op a == a: $
+
         po x == x: P
+
         x*y == (y:P) *$P (x:P)
+
         coerce(x): OutputForm == prefix(op::OutputForm, [coerce(x:P)$P])
 
 \end{chunk}
@@ -107022,6 +128825,21 @@ OppositeMonogenicLinearOperator(P, R): OPRcat == OPRdef where
 \begin{chunk}{COQ OMLO}
 (* domain OMLO *)
 (*
+
+        Rep := P
+
+        x, y: $
+
+        a: P
+
+        op a == a: $
+
+        po x == x: P
+
+        x*y == (y:P) *$P (x:P)
+
+        coerce(x): OutputForm == prefix(op::OutputForm, [coerce(x:P)$P])
+
 *)
 
 \end{chunk}
@@ -107194,13 +129012,19 @@ OrderedCompletion(R:SetCategory): Exports == Implementation where
         ++ it is one and "failed" otherwise.
 
   Implementation ==> add
+
     Rep := Union(fin:R, inf:B)  -- true = +infinity, false = -infinity
 
     coerce(r:R):%          == [r]
+
     retract(x:%):R         == (x case fin => x.fin; error "Not finite")
+
     finite? x              == x case fin
+
     infinite? x            == x case inf
+
     plusInfinity()         == [true]
+
     minusInfinity()        == [false]
 
     retractIfCan(x:%):Union(R, "failed") ==
@@ -107226,6 +129050,7 @@ OrderedCompletion(R:SetCategory): Exports == Implementation where
       x.fin = y.fin
 
     if R has AbelianGroup then
+
       0 == [0$R]
 
       n:Integer * x:% ==
@@ -107248,9 +129073,11 @@ OrderedCompletion(R:SetCategory): Exports == Implementation where
         [x.fin + y.fin]
 
     if R has OrderedRing then
+
       fininf: (B, R) -> %
 
       1                == [1$R]
+
       characteristic() == characteristic()$R
 
       fininf(b, r) ==
@@ -107282,7 +129109,9 @@ OrderedCompletion(R:SetCategory): Exports == Implementation where
         x.fin < y.fin
 
     if R has IntegerNumberSystem then
+
       rational? x == finite? x
+
       rational  x == rational(retract(x)@R)
 
       rationalIfCan x ==
@@ -107294,6 +129123,112 @@ OrderedCompletion(R:SetCategory): Exports == Implementation where
 \begin{chunk}{COQ ORDCOMP}
 (* domain ORDCOMP *)
 (*
+
+    Rep := Union(fin:R, inf:B)  -- true = +infinity, false = -infinity
+
+    coerce(r:R):%          == [r]
+
+    retract(x:%):R         == (x case fin => x.fin; error "Not finite")
+
+    finite? x              == x case fin
+
+    infinite? x            == x case inf
+
+    plusInfinity()         == [true]
+
+    minusInfinity()        == [false]
+
+    retractIfCan(x:%):Union(R, "failed") ==
+      x case fin => x.fin
+      "failed"
+
+    coerce(x:%):OutputForm ==
+      x case fin => (x.fin)::OutputForm
+      e := "infinity"::OutputForm
+      x.inf => empty() + e
+      - e
+
+    whatInfinity x ==
+      x case fin => 0
+      x.inf => 1
+      -1
+
+    x = y ==
+      x case inf =>
+        y case inf => not xor(x.inf, y.inf)
+        false
+      y case inf => false
+      x.fin = y.fin
+
+    if R has AbelianGroup then
+
+      0 == [0$R]
+
+      n:Integer * x:% ==
+        x case inf =>
+          n > 0 => x
+          n < 0 => [not(x.inf)]
+          error "Undefined product"
+        [n * x.fin]
+
+      - x ==
+        x case inf => [not(x.inf)]
+        [- (x.fin)]
+
+      x + y ==
+        x case inf =>
+          y case fin => x
+          xor(x.inf, y.inf) => error "Undefined sum"
+          x
+        y case inf => y
+        [x.fin + y.fin]
+
+    if R has OrderedRing then
+
+      fininf: (B, R) -> %
+
+      1                == [1$R]
+
+      characteristic() == characteristic()$R
+
+      fininf(b, r) ==
+        r > 0 => [b]
+        r < 0 => [not b]
+        error "Undefined product"
+
+      x:% * y:% ==
+        x case inf =>
+          y case inf =>
+            xor(x.inf, y.inf) => minusInfinity()
+            plusInfinity()
+          fininf(x.inf, y.fin)
+        y case inf => fininf(y.inf, x.fin)
+        [x.fin * y.fin]
+
+      recip x ==
+        x case inf => 0
+        (u := recip(x.fin)) case "failed" => "failed"
+        [u::R]
+
+      x < y ==
+        x case inf =>
+          y case inf =>
+            xor(x.inf, y.inf) => y.inf
+            false
+          not(x.inf)
+        y case inf => y.inf
+        x.fin < y.fin
+
+    if R has IntegerNumberSystem then
+
+      rational? x == finite? x
+
+      rational  x == rational(retract(x)@R)
+
+      rationalIfCan x ==
+        (r:= retractIfCan(x)@Union(R,"failed")) case "failed" =>"failed"
+        rational(r::R)
+
 *)
 
 \end{chunk}
@@ -107556,7 +129491,9 @@ OrderedDirectProduct(dim:NonNegativeInteger,
                              == C where
    T == DirectProductCategory(dim,S)
    C == DirectProduct(dim,S) add
+
         Rep:=Vector(S)
+
         x:% < y:% == f(x::Rep,y::Rep)
 
 \end{chunk}
@@ -107564,6 +129501,12 @@ OrderedDirectProduct(dim:NonNegativeInteger,
 \begin{chunk}{COQ ODP}
 (* domain ODP *)
 (*
+ DirectProduct(dim,S) add
+
+        Rep:=Vector(S)
+
+        x:% < y:% == f(x::Rep,y::Rep)
+
 *)
 
 \end{chunk}
@@ -108334,6 +130277,7 @@ OrderedFreeMonoid(S: OrderedSet): OFMcategory == OFMdefinition where
       ++X varList m1
 
   OFMdefinition == FreeMonoid(S) add
+
     Rep := ListMonoidOps(S, NNI, 1)
         
     -- definitions
@@ -108392,7 +130336,6 @@ OrderedFreeMonoid(S: OrderedSet): OFMcategory == OFMdefinition where
           la:=rest la
       empty? la and not empty? lb
 
-
     a < b ==               --  ordre lexicographique par longueur
       la:NNI := length a; lb:NNI := length b
       la = lb =>  lexico(a,b)
@@ -108405,6 +130348,73 @@ OrderedFreeMonoid(S: OrderedSet): OFMcategory == OFMdefinition where
 \begin{chunk}{COQ OFMONOID}
 (* domain OFMONOID *)
 (*
+ FreeMonoid(S) add
+
+    Rep := ListMonoidOps(S, NNI, 1)
+        
+    -- definitions
+    lquo(w:%, l:S) == 
+      x: List REC := listOfMonoms(w)$Rep
+      null x        => "failed"
+      fx: REC := first x
+      fx.gen ^= l  => "failed"
+      fx.exp = 1   => makeMulti rest(x)
+      makeMulti [[fx.gen, (fx.exp - 1)::NNI ]$REC, :rest x]
+       
+    rquo(w:%, l:S) ==
+      u:% := reverse w
+      (r := lquo (u,l)) case "failed" => "failed"
+      reverse_! (r::%)
+
+    divide(left:%,right:%) == 
+      a:=lquo(left,right) 
+      b:=rquo(left,right)
+      [a,b]
+
+    length x == reduce("+" ,[f.exp for f in listOfMonoms x], 0)
+
+    varList x ==
+      le: List S := [t.gen for t in listOfMonoms x]
+      sort_! removeDuplicates(le)
+ 
+    first w ==
+      x: List REC := listOfMonoms w
+      null x => error "empty word !!!"
+      x.first.gen
+
+    rest w ==
+      x: List REC := listOfMonoms w
+      null x => error "empty word !!!"
+      fx: REC := first x
+      fx.exp = 1 => makeMulti rest x
+      makeMulti [[fx.gen , (fx.exp - 1)::NNI ]$REC , :rest x]
+
+    lexico(a,b) ==         --  ordre lexicographique
+      la := listOfMonoms a
+      lb := listOfMonoms b
+      while (not null la) and (not null lb) repeat
+        la.first.gen > lb.first.gen => return false
+        la.first.gen < lb.first.gen => return true
+        if la.first.exp = lb.first.exp then
+          la:=rest la
+          lb:=rest lb
+        else if la.first.exp > lb.first.exp then
+          la:=concat([la.first.gen,
+                 (la.first.exp - lb.first.exp)::NNI], rest lb)
+          lb:=rest lb
+        else
+          lb:=concat([lb.first.gen,
+                   (lb.first.exp-la.first.exp)::NNI], rest la)
+          la:=rest la
+      empty? la and not empty? lb
+
+    a < b ==               --  ordre lexicographique par longueur
+      la:NNI := length a; lb:NNI := length b
+      la = lb =>  lexico(a,b)
+      la < lb 
+
+    mirror x == reverse(x)$Rep
+
 *)
 
 \end{chunk}
@@ -108576,23 +130586,38 @@ OrderedVariableList(VariableList:List Symbol):
          variable: Symbol -> Union(%,"failed")
                 ++ variable(s) returns a member of the variable set or failed
     == add
+
        VariableList := removeDuplicates VariableList
+
        Rep := PositiveInteger
+
        s1,s2:%
+
        convert(s1):Symbol == VariableList.((s1::Rep)::PositiveInteger)
+
        coerce(s1):OutputForm == (convert(s1)@Symbol)::OutputForm
+
        convert(s1):InputForm == convert(convert(s1)@Symbol)
+
        convert(s1):Pattern(Integer) == convert(convert(s1)@Symbol)
+
        convert(s1):Pattern(Float) == convert(convert(s1)@Symbol)
+
        index i   == i::%
+
        lookup j  == j :: Rep
+
        size ()   == #VariableList
+
        variable(exp:Symbol) ==
             for i in 1.. for exp2 in VariableList repeat
                 if exp=exp2 then return i::PositiveInteger::%
             "failed"
+
        s1 < s2 == s2 <$Rep s1
+
        s1 = s2 == s1 =$Rep s2
+
        latex(x:%):String      == latex(convert(x)@Symbol)
 
 \end{chunk}
@@ -108600,6 +130625,40 @@ OrderedVariableList(VariableList:List Symbol):
 \begin{chunk}{COQ OVAR}
 (* domain OVAR *)
 (*
+
+       VariableList := removeDuplicates VariableList
+
+       Rep := PositiveInteger
+
+       s1,s2:%
+
+       convert(s1):Symbol == VariableList.((s1::Rep)::PositiveInteger)
+
+       coerce(s1):OutputForm == (convert(s1)@Symbol)::OutputForm
+
+       convert(s1):InputForm == convert(convert(s1)@Symbol)
+
+       convert(s1):Pattern(Integer) == convert(convert(s1)@Symbol)
+
+       convert(s1):Pattern(Float) == convert(convert(s1)@Symbol)
+
+       index i   == i::%
+
+       lookup j  == j :: Rep
+
+       size ()   == #VariableList
+
+       variable(exp:Symbol) ==
+            for i in 1.. for exp2 in VariableList repeat
+                if exp=exp2 then return i::PositiveInteger::%
+            "failed"
+
+       s1 < s2 == s2 <$Rep s1
+
+       s1 = s2 == s1 =$Rep s2
+
+       latex(x:%):String      == latex(convert(x)@Symbol)
+
 *)
 
 \end{chunk}
@@ -109685,9 +131744,13 @@ o )show OrderlyDifferentialVariable
 
 OrderlyDifferentialVariable(S:OrderedSet):DifferentialVariableCategory(S)
   == add
+
     Rep := Record(var:S, ord:NonNegativeInteger)
+
     makeVariable(s,n) == [s, n]
+
     variable v     == v.var
+
     order v        == v.ord
 
 \end{chunk}
@@ -109695,6 +131758,15 @@ OrderlyDifferentialVariable(S:OrderedSet):DifferentialVariableCategory(S)
 \begin{chunk}{COQ ODVAR}
 (* domain ODVAR *)
 (*
+
+    Rep := Record(var:S, ord:NonNegativeInteger)
+
+    makeVariable(s,n) == [s, n]
+
+    variable v     == v.var
+
+    order v        == v.ord
+
 *)
 
 \end{chunk}
@@ -109867,15 +131939,23 @@ OrdinaryDifferentialRing(Kernels,R,var): DRcategory == DRcapsule where
         coerce: $ -> R
             ++ coerce(p) views p as a valie in the partial differential ring.
     DRcapsule == R add
+
         n: Integer
+
         Rep := R
+
         coerce(u:R):$ == u::Rep::$
+
         coerce(p:$):R == p::Rep::R
+
         differentiate p       == differentiate(p, var)
 
         if R has Field then
+
             p / q     == ((p::R) /$R (q::R))::$
+
             p ** n    == ((p::R) **$R n)::$
+
             inv(p)    == (inv(p::R)$R)::$
 
 \end{chunk}
@@ -109883,6 +131963,25 @@ OrdinaryDifferentialRing(Kernels,R,var): DRcategory == DRcapsule where
 \begin{chunk}{COQ ODR}
 (* domain ODR *)
 (*
+
+        n: Integer
+
+        Rep := R
+
+        coerce(u:R):$ == u::Rep::$
+
+        coerce(p:$):R == p::Rep::R
+
+        differentiate p       == differentiate(p, var)
+
+        if R has Field then
+
+            p / q     == ((p::R) /$R (q::R))::$
+
+            p ** n    == ((p::R) **$R n)::$
+
+            inv(p)    == (inv(p::R)$R)::$
+
 *)
 
 \end{chunk}
@@ -110119,10 +132218,13 @@ OrdSetInts: Export == Implement where
         ++ value(x) returns the integer associated with x
 
    Implement == add
+
      Rep := Integer
+
      x,y: %
 
      x = y == x =$Rep y
+
      x < y == x <$Rep y
 
      coerce(i:Integer):% == i
@@ -110137,6 +132239,22 @@ OrdSetInts: Export == Implement where
 \begin{chunk}{COQ OSI}
 (* domain OSI *)
 (*
+
+     Rep := Integer
+
+     x,y: %
+
+     x = y == x =$Rep y
+
+     x < y == x <$Rep y
+
+     coerce(i:Integer):% == i
+
+     value(x) == x:Rep
+
+     coerce(x):O ==
+       sub(e::Symbol::O, coerce(x)$Rep)$O
+
 *)
 
 \end{chunk}
@@ -110586,6 +132704,7 @@ OutputForm(): SetCategory with
           ++ SEGMENT(x) creates the prefix form: \spad{x..}.
 
     == add
+
         import NumberFormats
 
         -- Todo:
@@ -110597,50 +132716,80 @@ OutputForm(): SetCategory with
         --   uniformize integrals, products, etc as plexes.
 
         cons ==> CONS$Lisp
+
         car  ==> CAR$Lisp
+
         cdr  ==> CDR$Lisp
 
         Rep := List $
 
         a, b: $
+
         l: List $
+
         s: String
+
         e: Symbol
+
         n: Integer
+
         nn:NonNegativeInteger
 
         sform:    String  -> $
+
         eform:    Symbol  -> $
+
         iform:    Integer -> $
 
         print x              == mathprint(x)$Lisp
+
         message s            == (empty? s => empty(); s pretend $)
+
         messagePrint s       == print message s
+
         (a:$ = b:$):Boolean  == EQUAL(a, b)$Lisp
+
         (a:$ = b:$):$        == [sform "=",     a, b]
+
         coerce(a):OutputForm  == a pretend OutputForm
+
         outputForm n          == n pretend $
+
         outputForm e          == e pretend $
+
         outputForm(f:DoubleFloat) == f pretend $
+
         sform s               == s pretend $
+
         eform e               == e pretend $
+
         iform n               == n pretend $
 
         outputForm s ==
           sform concat(quote()$Character, concat(s, quote()$Character))
 
         width(a) == outformWidth(a)$Lisp
+
         height(a) == height(a)$Lisp
+
         subHeight(a) == subspan(a)$Lisp
+
         superHeight(a) == superspan(a)$Lisp
+
         height() == 20
+
         width() == 66
 
         center(a,w)   == hconcat(hspace((w - width(a)) quo 2),a)
+
         left(a,w)     == hconcat(a,hspace((w - width(a))))
+
         right(a,w)    == hconcat(hspace(w - width(a)),a)
+
         center(a)     == center(a,width())
+
         left(a)       == left(a,width())
+
         right(a)      == right(a,width())
 
         vspace(n) ==
@@ -110660,8 +132809,11 @@ OutputForm(): SetCategory with
             CONS(eform MATRIX, LIST2VEC$Lisp lv)$Lisp
 
         pile l              == cons(eform SC, l)
+
         commaSeparate l     == cons(eform AGGLST,  l)
+
         semicolonSeparate l == cons(eform AGGSET,  l)
+
         blankSeparate l     ==
            c:=eform CONCATB
            l1:$:=[]
@@ -110672,50 +132824,82 @@ OutputForm(): SetCategory with
            cons(c, l1)
 
         brace a        == [eform BRACE,   a]
+
         brace l        == brace commaSeparate l
+
         bracket a      == [eform BRACKET, a]
+
         bracket l      == bracket commaSeparate l
+
         paren a        == [eform PAREN,   a]
+
         paren l        == paren commaSeparate l
 
         sub     (a,b)  == [eform SUB, a, b]
+
         super   (a, b) == [eform SUPERSUB,a,sform " ",b]
+
         presub(a,b) == [eform SUPERSUB,a,sform " ",sform " ",sform " ",b]
+
         presuper(a, b) == [eform SUPERSUB,a,sform " ",sform " ",b]
+
         scripts (a, l) ==
             null l => a
             null rest l => sub(a, first l)
             cons(eform SUPERSUB, cons(a, l))
+
         supersub(a, l) ==
             if odd?(#l) then l := append(l, [empty()])
             cons(eform ALTSUPERSUB, cons(a, l))
 
         hconcat(a,b)  == [eform CONCAT, a, b]
+
         hconcat l     == cons(eform CONCAT, l)
+
         vconcat(a,b)  == [eform VCONCAT, a, b]
+
         vconcat l     == cons(eform VCONCAT, l)
 
         a ^= b      == [sform "^=",    a, b]
+
         a < b       == [sform "<",     a, b]
+
         a > b       == [sform ">",     a, b]
+
         a <= b      == [sform "<=",    a, b]
+
         a >= b      == [sform ">=",    a, b]
 
         a + b       == [sform "+",     a, b]
+
         a - b       == [sform "-",     a, b]
+
         - a         == [sform "-",     a]
+
         a * b       == [sform "*",     a, b]
+
         a / b       == [sform "/",     a, b]
+
         a ** b      == [sform "**",    a, b]
+
         a div b     == [sform "div",   a, b]
+
         a rem b     == [sform "rem",   a, b]
+
         a quo b     == [sform "quo",   a, b]
+
         a exquo b   == [sform "exquo", a, b]
+
         a and b     == [sform "and",   a, b]
+
         a or b      == [sform "or",    a, b]
+
         not a       == [sform "not",   a]
+
         SEGMENT(a,b)== [eform SEGMENT, a, b]
+
         SEGMENT(a)  == [eform SEGMENT, a]
+
         binomial(a,b)==[eform BINOMIAL, a, b]
 
         empty() == [eform NOTHING]
@@ -110729,39 +132913,58 @@ OutputForm(): SetCategory with
 
         elt(a, l) ==
             cons(a, l)
+
         prefix(a,l)   ==
             not infix? a => cons(a, l)
             hconcat(a, paren commaSeparate l)
+
         infix(a, l) ==
             null l => empty()
             null rest l => first l
             infix? a => cons(a, l)
             hconcat [first l, a, infix(a, rest l)]
+
         infix(a,b,c)  ==
             infix? a => [a, b, c]
             hconcat [b, a, c]
+
         postfix(a, b) ==
             hconcat(b, a)
 
         string a   == [eform STRING,  a]
+
         quote  a   == [eform QUOTE,   a]
+
         overbar a  == [eform OVERBAR, a]
+
         dot a      == super(a, sform ".")
+
         prime a    == super(a, sform ",")
+
         dot(a,nn)   == (s := new(nn, char "."); super(a, sform s))
+
         prime(a,nn) == (s := new(nn, char ","); super(a, sform s))
 
         overlabel(a,b) == [eform OVERLABEL, a, b]
+
         box a      == [eform BOX,     a]
+
         zag(a,b)   == [eform ZAG,     a, b]
+
         root a     == [eform ROOT,    a]
+
         root(a,b)  == [eform ROOT,    a, b]
+
         over(a,b)  == [eform OVER,    a, b]
+
         slash(a,b) == [eform SLASH,   a, b]
+
         assign(a,b)== [eform LET,     a, b]
 
         label(a,b) == [eform EQUATNUM, a, b]
+
         rarrow(a,b)== [eform TAG, a, b]
+
         differentiate(a, nn)==
             zero? nn => a
             nn < 4 => prime(a, nn)
@@ -110770,13 +132973,21 @@ OutputForm(): SetCategory with
             super(a, paren sform s)
 
         sum(a)     == [eform SIGMA,  empty(), a]
+
         sum(a,b)   == [eform SIGMA,  b, a]
+
         sum(a,b,c) == [eform SIGMA2, b, c, a]
+
         prod(a)    == [eform PI,     empty(), a]
+
         prod(a,b)  == [eform PI,     b, a]
+
         prod(a,b,c)== [eform PI2,    b, c, a]
+
         int(a)     == [eform INTSIGN,empty(), empty(), a]
+
         int(a,b)   == [eform INTSIGN,b, empty(), a]
+
         int(a,b,c) == [eform INTSIGN,b, c, a]
 
 \end{chunk}
@@ -110784,6 +132995,292 @@ OutputForm(): SetCategory with
 \begin{chunk}{COQ OUTFORM}
 (* domain OUTFORM *)
 (*
+
+        import NumberFormats
+
+        -- Todo:
+        --   program forms, greek letters
+        --   infix, prefix, postfix, matchfix support in OUT BOOT
+        --   labove rabove, corresponding overs.
+        --   better super script, overmark, undermark
+        --   bug in product, paren blankSeparate []
+        --   uniformize integrals, products, etc as plexes.
+
+        cons ==> CONS$Lisp
+
+        car  ==> CAR$Lisp
+
+        cdr  ==> CDR$Lisp
+
+        Rep := List $
+
+        a, b: $
+
+        l: List $
+
+        s: String
+
+        e: Symbol
+
+        n: Integer
+
+        nn:NonNegativeInteger
+
+        sform:    String  -> $
+
+        eform:    Symbol  -> $
+
+        iform:    Integer -> $
+
+        print x              == mathprint(x)$Lisp
+
+        message s            == (empty? s => empty(); s pretend $)
+
+        messagePrint s       == print message s
+
+        (a:$ = b:$):Boolean  == EQUAL(a, b)$Lisp
+
+        (a:$ = b:$):$        == [sform "=",     a, b]
+
+        coerce(a):OutputForm  == a pretend OutputForm
+
+        outputForm n          == n pretend $
+
+        outputForm e          == e pretend $
+
+        outputForm(f:DoubleFloat) == f pretend $
+
+        sform s               == s pretend $
+
+        eform e               == e pretend $
+
+        iform n               == n pretend $
+
+        outputForm s ==
+          sform concat(quote()$Character, concat(s, quote()$Character))
+
+        width(a) == outformWidth(a)$Lisp
+
+        height(a) == height(a)$Lisp
+
+        subHeight(a) == subspan(a)$Lisp
+
+        superHeight(a) == superspan(a)$Lisp
+
+        height() == 20
+
+        width() == 66
+
+        center(a,w)   == hconcat(hspace((w - width(a)) quo 2),a)
+
+        left(a,w)     == hconcat(a,hspace((w - width(a))))
+
+        right(a,w)    == hconcat(hspace(w - width(a)),a)
+
+        center(a)     == center(a,width())
+
+        left(a)       == left(a,width())
+
+        right(a)      == right(a,width())
+
+        vspace(n) ==
+          n = 0 => empty()
+          vconcat(sform " ",vspace(n - 1))
+
+        hspace(n) ==
+          n = 0 => empty()
+          sform(fillerSpaces(n)$Lisp)
+
+        rspace(n, m) ==
+          n = 0 or m = 0 => empty()
+          vconcat(hspace n, rspace(n, m - 1))
+
+        matrix ll ==
+            lv:$ := [LIST2VEC$Lisp l for l in ll]
+            CONS(eform MATRIX, LIST2VEC$Lisp lv)$Lisp
+
+        pile l              == cons(eform SC, l)
+
+        commaSeparate l     == cons(eform AGGLST,  l)
+
+        semicolonSeparate l == cons(eform AGGSET,  l)
+
+        blankSeparate l     ==
+           c:=eform CONCATB
+           l1:$:=[]
+           for u in reverse l repeat
+               if EQCAR(u,c)$Lisp
+                  then l1:=[:cdr u,:l1]
+                  else l1:=[u,:l1]
+           cons(c, l1)
+
+        brace a        == [eform BRACE,   a]
+
+        brace l        == brace commaSeparate l
+
+        bracket a      == [eform BRACKET, a]
+
+        bracket l      == bracket commaSeparate l
+
+        paren a        == [eform PAREN,   a]
+
+        paren l        == paren commaSeparate l
+
+        sub     (a,b)  == [eform SUB, a, b]
+
+        super   (a, b) == [eform SUPERSUB,a,sform " ",b]
+
+        presub(a,b) == [eform SUPERSUB,a,sform " ",sform " ",sform " ",b]
+
+        presuper(a, b) == [eform SUPERSUB,a,sform " ",sform " ",b]
+
+        scripts (a, l) ==
+            null l => a
+            null rest l => sub(a, first l)
+            cons(eform SUPERSUB, cons(a, l))
+
+        supersub(a, l) ==
+            if odd?(#l) then l := append(l, [empty()])
+            cons(eform ALTSUPERSUB, cons(a, l))
+
+        hconcat(a,b)  == [eform CONCAT, a, b]
+
+        hconcat l     == cons(eform CONCAT, l)
+
+        vconcat(a,b)  == [eform VCONCAT, a, b]
+
+        vconcat l     == cons(eform VCONCAT, l)
+
+        a ^= b      == [sform "^=",    a, b]
+
+        a < b       == [sform "<",     a, b]
+
+        a > b       == [sform ">",     a, b]
+
+        a <= b      == [sform "<=",    a, b]
+
+        a >= b      == [sform ">=",    a, b]
+
+        a + b       == [sform "+",     a, b]
+
+        a - b       == [sform "-",     a, b]
+
+        - a         == [sform "-",     a]
+
+        a * b       == [sform "*",     a, b]
+
+        a / b       == [sform "/",     a, b]
+
+        a ** b      == [sform "**",    a, b]
+
+        a div b     == [sform "div",   a, b]
+
+        a rem b     == [sform "rem",   a, b]
+
+        a quo b     == [sform "quo",   a, b]
+
+        a exquo b   == [sform "exquo", a, b]
+
+        a and b     == [sform "and",   a, b]
+
+        a or b      == [sform "or",    a, b]
+
+        not a       == [sform "not",   a]
+
+        SEGMENT(a,b)== [eform SEGMENT, a, b]
+
+        SEGMENT(a)  == [eform SEGMENT, a]
+
+        binomial(a,b)==[eform BINOMIAL, a, b]
+
+        empty() == [eform NOTHING]
+
+        infix? a ==
+            e:$ :=
+                IDENTP$Lisp a => a
+                STRINGP$Lisp a => INTERN$Lisp a
+                return false
+            if GET(e,QUOTE(INFIXOP$Lisp)$Lisp)$Lisp then true else false
+
+        elt(a, l) ==
+            cons(a, l)
+
+        prefix(a,l)   ==
+            not infix? a => cons(a, l)
+            hconcat(a, paren commaSeparate l)
+
+        infix(a, l) ==
+            null l => empty()
+            null rest l => first l
+            infix? a => cons(a, l)
+            hconcat [first l, a, infix(a, rest l)]
+
+        infix(a,b,c)  ==
+            infix? a => [a, b, c]
+            hconcat [b, a, c]
+
+        postfix(a, b) ==
+            hconcat(b, a)
+
+        string a   == [eform STRING,  a]
+
+        quote  a   == [eform QUOTE,   a]
+
+        overbar a  == [eform OVERBAR, a]
+
+        dot a      == super(a, sform ".")
+
+        prime a    == super(a, sform ",")
+
+        dot(a,nn)   == (s := new(nn, char "."); super(a, sform s))
+
+        prime(a,nn) == (s := new(nn, char ","); super(a, sform s))
+
+        overlabel(a,b) == [eform OVERLABEL, a, b]
+
+        box a      == [eform BOX,     a]
+
+        zag(a,b)   == [eform ZAG,     a, b]
+
+        root a     == [eform ROOT,    a]
+
+        root(a,b)  == [eform ROOT,    a, b]
+
+        over(a,b)  == [eform OVER,    a, b]
+
+        slash(a,b) == [eform SLASH,   a, b]
+
+        assign(a,b)== [eform LET,     a, b]
+
+        label(a,b) == [eform EQUATNUM, a, b]
+
+        rarrow(a,b)== [eform TAG, a, b]
+
+        differentiate(a, nn)==
+            zero? nn => a
+            nn < 4 => prime(a, nn)
+            r := FormatRoman(nn::PositiveInteger)
+            s := lowerCase(r::String)
+            super(a, paren sform s)
+
+        sum(a)     == [eform SIGMA,  empty(), a]
+
+        sum(a,b)   == [eform SIGMA,  b, a]
+
+        sum(a,b,c) == [eform SIGMA2, b, c, a]
+
+        prod(a)    == [eform PI,     empty(), a]
+
+        prod(a,b)  == [eform PI,     b, a]
+
+        prod(a,b,c)== [eform PI2,    b, c, a]
+
+        int(a)     == [eform INTSIGN,empty(), empty(), a]
+
+        int(a,b)   == [eform INTSIGN,b, empty(), a]
+
+        int(a,b,c) == [eform INTSIGN,b, c, a]
+
 *)
 
 \end{chunk}
@@ -111520,20 +134017,27 @@ PAdicRationalConstructor(p,PADIC): Exports == Implementation where
     Rep := Record(expon:I,pint:PADIC)
 
     getExpon: % -> I
+
     getZp   : % -> PADIC
+
     makeQp  : (I,PADIC) -> %
 
     getExpon x    == x.expon
+
     getZp x       == x.pint
+
     makeQp(r,int) == [r,int]
 
 --% creation
 
     0 == makeQp(0,0)
+
     1 == makeQp(0,1)
 
     coerce(x:I)     == x :: PADIC :: %
+
     coerce(r:RN)    == (numer(r) :: %)/(denom(r) :: %)
+
     coerce(x:PADIC) == makeQp(0,x)
 
 --% normalizations
@@ -111575,6 +134079,7 @@ PAdicRationalConstructor(p,PADIC): Exports == Implementation where
       makeQp(getExpon x,getZp(x) - p**((-n) :: NNI) * getZp(y))
 
     n:I * x:% == makeQp(getExpon x,n * getZp x)
+
     x:% * y:% == makeQp(getExpon x + getExpon y,getZp x * getZp y)
 
     x:% ** n:I ==
@@ -111593,7 +134098,9 @@ PAdicRationalConstructor(p,PADIC): Exports == Implementation where
       inv :: %
 
     x:% / y:% == x * inv y
+
     x:PADIC / y:PADIC == (x :: %) / (y :: %)
+
     x:PADIC * y:% == makeQp(getExpon y,x * getZp y)
 
     approximate(x,n) ==
@@ -111602,7 +134109,6 @@ PAdicRationalConstructor(p,PADIC): Exports == Implementation where
 
     cfStream: % -> Stream RN
     cfStream x == delay
---    zero? x => empty()
       invx := inv x; x0 := approximate(invx,1)
       concat(x0,cfStream(invx - (x0 :: %)))
 
@@ -111619,6 +134125,7 @@ PAdicRationalConstructor(p,PADIC): Exports == Implementation where
       (c :: OUT) * mon
 
     showAll?:() -> Boolean
+
     -- check a global Lisp variable
     showAll?() == true
 
@@ -111651,6 +134158,150 @@ PAdicRationalConstructor(p,PADIC): Exports == Implementation where
 \begin{chunk}{COQ PADICRC}
 (* domain PADICRC *)
 (*
+
+    PEXPR := p :: OUT
+
+--% representation
+
+    Rep := Record(expon:I,pint:PADIC)
+
+    getExpon: % -> I
+
+    getZp   : % -> PADIC
+
+    makeQp  : (I,PADIC) -> %
+
+    getExpon x    == x.expon
+
+    getZp x       == x.pint
+
+    makeQp(r,int) == [r,int]
+
+--% creation
+
+    0 == makeQp(0,0)
+
+    1 == makeQp(0,1)
+
+    coerce(x:I)     == x :: PADIC :: %
+
+    coerce(r:RN)    == (numer(r) :: %)/(denom(r) :: %)
+
+    coerce(x:PADIC) == makeQp(0,x)
+
+--% normalizations
+
+    removeZeroes x ==
+      empty? digits(xx := getZp x) => 0
+      zero? moduloP xx =>
+        removeZeroes makeQp(getExpon x + 1,quotientByP xx)
+      x
+
+    removeZeroes(n,x) ==
+      n <= 0 => x
+      empty? digits(xx := getZp x) => 0
+      zero? moduloP xx =>
+        removeZeroes(n - 1,makeQp(getExpon x + 1,quotientByP xx))
+      x
+
+--% arithmetic
+
+    x = y ==
+      EQ(x,y)$Lisp => true
+      n := getExpon(x) - getExpon(y)
+      n >= 0 =>
+        (p**(n :: NNI) * getZp(x)) = getZp(y)
+      (p**((- n) :: NNI) * getZp(y)) = getZp(x)
+
+    x + y ==
+      n := getExpon(x) - getExpon(y)
+      n >= 0 =>
+        makeQp(getExpon y,getZp(y) + p**(n :: NNI) * getZp(x))
+      makeQp(getExpon x,getZp(x) + p**((-n) :: NNI) * getZp(y))
+
+    -x == makeQp(getExpon x,-getZp(x))
+
+    x - y ==
+      n := getExpon(x) - getExpon(y)
+      n >= 0 =>
+        makeQp(getExpon y,p**(n :: NNI) * getZp(x) - getZp(y))
+      makeQp(getExpon x,getZp(x) - p**((-n) :: NNI) * getZp(y))
+
+    n:I * x:% == makeQp(getExpon x,n * getZp x)
+
+    x:% * y:% == makeQp(getExpon x + getExpon y,getZp x * getZp y)
+
+    x:% ** n:I ==
+      zero? n => 1
+      positive? n => expt(x,n :: PositiveInteger)$RepeatedSquaring(%)
+      inv expt(x,(-n) :: PositiveInteger)$RepeatedSquaring(%)
+
+    recip x ==
+      x := removeZeroes(1000,x)
+      zero? moduloP(xx := getZp x) => "failed"
+      (inv := recip xx) case "failed" => "failed"
+      makeQp(- getExpon x,inv :: PADIC)
+
+    inv x ==
+      (inv := recip x) case "failed" => error "inv: no inverse"
+      inv :: %
+
+    x:% / y:% == x * inv y
+
+    x:PADIC / y:PADIC == (x :: %) / (y :: %)
+
+    x:PADIC * y:% == makeQp(getExpon y,x * getZp y)
+
+    approximate(x,n) ==
+      k := getExpon x
+      (p :: RN) ** k * approximate(getZp x,n - k)
+
+    cfStream: % -> Stream RN
+    cfStream x == delay
+      invx := inv x; x0 := approximate(invx,1)
+      concat(x0,cfStream(invx - (x0 :: %)))
+
+    continuedFraction x ==
+      x0 := approximate(x,1)
+      reducedContinuedFraction(x0,cfStream(x - (x0 :: %)))
+
+    termOutput:(I,I) -> OUT
+    termOutput(k,c) ==
+      k = 0 => c :: OUT
+      mon := (k = 1 => PEXPR; PEXPR ** (k :: OUT))
+      c = 1 => mon
+      c = -1 => -mon
+      (c :: OUT) * mon
+
+    showAll?:() -> Boolean
+
+    -- check a global Lisp variable
+    showAll?() == true
+
+    coerce(x:%):OUT ==
+      x := removeZeroes(_$streamCount$Lisp,x)
+      m := getExpon x; zp := getZp x
+      uu := digits zp
+      l : L OUT := empty()
+      empty? uu => 0 :: OUT
+      n : NNI ; count : NNI := _$streamCount$Lisp
+      for n in 0..count while not empty? uu repeat
+        if frst(uu) ^= 0 then
+          l := concat(termOutput((n :: I) + m,frst(uu)),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) + m,frst(uu)),l)
+          uu := rst uu
+      l :=
+        explicitlyEmpty? uu => l
+        eq?(uu,rst uu) and frst uu = 0 => l
+        concat(prefix("O" :: OUT,[PEXPR ** ((n :: I) + m) :: OUT]),l)
+      empty? l => 0 :: OUT
+      reduce("+",reverse_! l)
+
 *)
 
 \end{chunk}
@@ -111760,17 +134411,27 @@ Palette(): Exports == Implementation where
       ++ indicated color c.
  
   Implementation ==> add
+
     Rep := Record(shadeField:I, hueField:C)
 
     dark   c == [1,c]
+
     dim    c == [2,c]  
+
     bright c == [3,c]  
+
     pastel c == [4,c]  
+
     light  c == [5,c]  
+
     hue    p == p.hueField
+
     shade  p == p.shadeField
+
     sample() == bright(sample())
+
     coerce(c:Color):% == bright c
+
     coerce(p:%):OutputForm ==
       hconcat ["[",coerce(p.hueField),"] from the ",_
                SHADE.(p.shadeField)," palette"]
@@ -111780,6 +134441,31 @@ Palette(): Exports == Implementation where
 \begin{chunk}{COQ PALETTE}
 (* domain PALETTE *)
 (*
+
+    Rep := Record(shadeField:I, hueField:C)
+
+    dark   c == [1,c]
+
+    dim    c == [2,c]  
+
+    bright c == [3,c]  
+
+    pastel c == [4,c]  
+
+    light  c == [5,c]  
+
+    hue    p == p.hueField
+
+    shade  p == p.shadeField
+
+    sample() == bright(sample())
+
+    coerce(c:Color):% == bright c
+
+    coerce(p:%):OutputForm ==
+      hconcat ["[",coerce(p.hueField),"] from the ",_
+               SHADE.(p.shadeField)," palette"]
+
 *)
 
 \end{chunk}
@@ -111872,6 +134558,7 @@ ParametricPlaneCurve(ComponentFunction): Exports == Implementation where
     Rep := Record(xCoord:ComponentFunction,yCoord:ComponentFunction)
  
     curve(x,y) == [x,y]
+
     coordinate(c,n) ==
       n = 1 => c.xCoord
       n = 2 => c.yCoord
@@ -111882,6 +134569,16 @@ ParametricPlaneCurve(ComponentFunction): Exports == Implementation where
 \begin{chunk}{COQ PARPCURV}
 (* domain PARPCURV *)
 (*
+ 
+    Rep := Record(xCoord:ComponentFunction,yCoord:ComponentFunction)
+ 
+    curve(x,y) == [x,y]
+
+    coordinate(c,n) ==
+      n = 1 => c.xCoord
+      n = 2 => c.yCoord
+      error "coordinate: index out of bounds"
+
 *)
 
 \end{chunk}
@@ -111974,6 +134671,7 @@ ParametricSpaceCurve(ComponentFunction): Exports == Implementation where
                   zCoord:ComponentFunction)
  
     curve(x,y,z) == [x,y,z]
+
     coordinate(c,n) ==
       n = 1 => c.xCoord
       n = 2 => c.yCoord
@@ -111985,6 +134683,19 @@ ParametricSpaceCurve(ComponentFunction): Exports == Implementation where
 \begin{chunk}{COQ PARSCURV}
 (* domain PARSCURV *)
 (*
+ 
+    Rep := Record(xCoord:ComponentFunction,_
+                  yCoord:ComponentFunction,_
+                  zCoord:ComponentFunction)
+ 
+    curve(x,y,z) == [x,y,z]
+
+    coordinate(c,n) ==
+      n = 1 => c.xCoord
+      n = 2 => c.yCoord
+      n = 3 => c.zCoord
+      error "coordinate: index out of bounds"
+
 *)
 
 \end{chunk}
@@ -112077,6 +134788,7 @@ ParametricSurface(ComponentFunction): Exports == Implementation where
                   zCoord:ComponentFunction)
  
     surface(x,y,z) == [x,y,z]
+
     coordinate(c,n) ==
       n = 1 => c.xCoord
       n = 2 => c.yCoord
@@ -112088,6 +134800,19 @@ ParametricSurface(ComponentFunction): Exports == Implementation where
 \begin{chunk}{COQ PARSURF}
 (* domain PARSURF *)
 (*
+ 
+    Rep := Record(xCoord:ComponentFunction,_
+                  yCoord:ComponentFunction,_
+                  zCoord:ComponentFunction)
+ 
+    surface(x,y,z) == [x,y,z]
+
+    coordinate(c,n) ==
+      n = 1 => c.xCoord
+      n = 2 => c.yCoord
+      n = 3 => c.zCoord
+      error "coordinate: index out of bounds"
+
 *)
 
 \end{chunk}
@@ -112721,10 +135446,12 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where
     -- some constructor assignments and macros
 
     Ex     ==> OutputForm
+
     fTerm  ==> Record(num: R, den: FRR)           -- den should have
                                                   -- unit = 1 and only
                                                   -- 1 factor
     LfTerm ==> List Record(num: R, den: FRR)
+
     QR     ==> Record(quotient: R, remainder: R)
 
     Rep    := Record(whole:R, fract: LfTerm)
@@ -112732,15 +135459,21 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where
     -- private function signatures
 
     copypf: % -> %
+
     LessThan: (fTerm, fTerm) -> Boolean
+
     multiplyFracTerms: (fTerm, fTerm) -> %
+
     normalizeFracTerm: fTerm -> %
+
     partialFractionNormalized: (R, FRR) -> %
 
     -- declarations
 
     a,b: %
+
     n: Integer
+
     r: R
 
     -- private function definitions
@@ -112797,7 +135530,8 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where
       d : %
       for i in 2..numberOfFactors(dn) repeat
         d :=
-          [0$R,[[1$R,nilFactor(nthFactor(dn,i), nthExponent(dn,i))]$fTerm]$LfTerm]
+          [0$R,[[1$R,nilFactor(nthFactor(dn,i),_
+            nthExponent(dn,i))]$fTerm]$LfTerm]
         c := c * d
       (qr.quotient :: %) + c
 
@@ -112845,17 +135579,22 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where
       [bw + b.whole,append(b.fract,bf)]$%
 
     0 == [0$R, nil()$LfTerm]
+
     1 == [1$R, nil()$LfTerm]
+
     characteristic() == characteristic()$R
 
     coerce(r): % == [r, nil()$LfTerm]
+
     coerce(n): % == [(n :: R), nil()$LfTerm]
+
     coerce(a): Fraction R ==
       q : Fraction R := (a.whole :: Fraction R)
       s : fTerm
       for s in a.fract repeat
         q := q + (s.num / (expand s.den))
       q
+
     coerce(q: Fraction FRR): % ==
       u : R := (recip unit denom q):: R
       r1 : R := u * expand numer q
@@ -112866,19 +135605,24 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where
       b = 1$% => a
       br : Fraction R := inv (b :: Fraction R)
       a * partialFraction(numer br,(denom br) :: FRR)
+
     recip a == (1$% exquo a)
 
     firstDenom a ==         -- denominator of 1st fractional term
       null a.fract => 1$FRR
       (first a.fract).den
+
     firstNumer a ==         -- numerator of 1st fractional term
       null a.fract => 0$R
       (first a.fract).num
+
     numberOfFractionalTerms a == # a.fract
+
     nthFractionalTerm(a,n) ==
       l : LfTerm := a.fract
       (n < 1) or (n > # l) => 0$%
       [0$R,[l.n]$LfTerm]$%
+
     wholePart a == a.whole
 
     partialFraction(nm: R, dn : FRR) ==
@@ -112957,6 +135701,260 @@ PartialFraction(R: EuclideanDomain): Cat == Capsule where
 \begin{chunk}{COQ PFR}
 (* domain PFR *)
 (*
+
+    -- some constructor assignments and macros
+
+    Ex     ==> OutputForm
+
+    fTerm  ==> Record(num: R, den: FRR)           -- den should have
+                                                  -- unit = 1 and only
+                                                  -- 1 factor
+    LfTerm ==> List Record(num: R, den: FRR)
+
+    QR     ==> Record(quotient: R, remainder: R)
+
+    Rep    := Record(whole:R, fract: LfTerm)
+
+    -- private function signatures
+
+    copypf: % -> %
+
+    LessThan: (fTerm, fTerm) -> Boolean
+
+    multiplyFracTerms: (fTerm, fTerm) -> %
+
+    normalizeFracTerm: fTerm -> %
+
+    partialFractionNormalized: (R, FRR) -> %
+
+    -- declarations
+
+    a,b: %
+
+    n: Integer
+
+    r: R
+
+    -- private function definitions
+
+    copypf(a: %): % == [a.whole,copy a.fract]$%
+
+    LessThan(s: fTerm, t: fTerm) ==
+      -- have to wait until FR has < operation
+      if (GGREATERP(s.den,t.den)$Lisp : Boolean) then false
+      else true
+
+    multiplyFracTerms(s : fTerm, t : fTerm) ==
+      nthFactor(s.den,1) = nthFactor(t.den,1) =>
+        normalizeFracTerm([s.num * t.num, s.den * t.den]$fTerm) : Rep
+      i : Union(Record(coef1: R, coef2: R),"failed")
+      coefs : Record(coef1: R, coef2: R)
+      i := extendedEuclidean(expand t.den, expand s.den,s.num * t.num)
+      i case "failed" => error "PartialFraction: not in ideal"
+      coefs := (i :: Record(coef1: R, coef2: R))
+      c : % := copypf 0$%
+      d : %
+      if coefs.coef2 ^= 0$R then
+        c := normalizeFracTerm ([coefs.coef2, t.den]$fTerm)
+      if coefs.coef1 ^= 0$R then
+        d := normalizeFracTerm ([coefs.coef1, s.den]$fTerm)
+        c.whole := c.whole + d.whole
+        not (null d.fract) => c.fract := append(d.fract,c.fract)
+      c
+
+    normalizeFracTerm(s : fTerm) ==
+      -- makes sure num is "less than" den, whole may be non-zero
+      qr : QR := divide(s.num, (expand s.den))
+      qr.remainder = 0$R => [qr.quotient, nil()$LfTerm]
+      -- now verify num and den are coprime
+      f : R := nthFactor(s.den,1)
+      nexpon : Integer := nthExponent(s.den,1)
+      expon  : Integer := 0
+      q : QR := divide(qr.remainder, f)
+      while (q.remainder = 0$R) and (expon < nexpon) repeat
+        expon := expon + 1
+        qr.remainder := q.quotient
+        q := divide(qr.remainder,f)
+      expon = 0 => [qr.quotient,[[qr.remainder, s.den]$fTerm]$LfTerm]
+      expon = nexpon => (qr.quotient + qr.remainder) :: %
+      [qr.quotient,[[qr.remainder, nilFactor(f,nexpon-expon)]$fTerm]$LfTerm]
+
+    partialFractionNormalized(nm: R, dn : FRR) ==
+      -- assume unit dn = 1
+      nm = 0$R   => 0$%
+      dn = 1$FRR => nm :: %
+      qr : QR := divide(nm, expand dn)
+      c : % := [0$R,[[qr.remainder,
+        nilFactor(nthFactor(dn,1), nthExponent(dn,1))]$fTerm]$LfTerm]
+      d : %
+      for i in 2..numberOfFactors(dn) repeat
+        d :=
+          [0$R,[[1$R,nilFactor(nthFactor(dn,i),_
+            nthExponent(dn,i))]$fTerm]$LfTerm]
+        c := c * d
+      (qr.quotient :: %) + c
+
+    -- public function definitions
+
+    padicFraction(a : %) ==
+      b: % := compactFraction a
+      null b.fract => b
+      l : LfTerm := nil
+      s : fTerm
+      f : R
+      e,d: Integer
+      for s in b.fract repeat
+        e := nthExponent(s.den,1)
+        e = 1 => l := cons(s,l)
+        f := nthFactor(s.den,1)
+        d := degree(sp := padicallyExpand(f,s.num))
+        while (sp ^= 0$SUPR) repeat
+          l := cons([leadingCoefficient sp,nilFactor(f,e-d)]$fTerm, l)
+          d := degree(sp := reductum sp)
+      [b.whole, sort(LessThan,l)]$%
+
+    compactFraction(a : %) ==
+      -- only one power for each distinct denom will remain
+      2 > # a.fract => a
+      af : LfTerm := reverse a.fract
+      bf : LfTerm := nil
+      bw : R := a.whole
+      b : %
+      s : fTerm := [(first af).num,(first af).den]$fTerm
+      f : R := nthFactor(s.den,1)
+      e : Integer := nthExponent(s.den,1)
+      t : fTerm
+      for t in rest af repeat
+        f = nthFactor(t.den,1) =>
+          s.num := s.num + (t.num *
+            (f **$R ((e - nthExponent(t.den,1)) : NonNegativeInteger)))
+        b := normalizeFracTerm s
+        bw := bw + b.whole
+        if not (null b.fract) then bf := cons(first b.fract,bf)
+        s := [t.num, t.den]$fTerm
+        f := nthFactor(s.den,1)
+        e := nthExponent(s.den,1)
+      b := normalizeFracTerm s
+      [bw + b.whole,append(b.fract,bf)]$%
+
+    0 == [0$R, nil()$LfTerm]
+
+    1 == [1$R, nil()$LfTerm]
+
+    characteristic() == characteristic()$R
+
+    coerce(r): % == [r, nil()$LfTerm]
+
+    coerce(n): % == [(n :: R), nil()$LfTerm]
+
+    coerce(a): Fraction R ==
+      q : Fraction R := (a.whole :: Fraction R)
+      s : fTerm
+      for s in a.fract repeat
+        q := q + (s.num / (expand s.den))
+      q
+
+    coerce(q: Fraction FRR): % ==
+      u : R := (recip unit denom q):: R
+      r1 : R := u * expand numer q
+      partialFractionNormalized(r1, u * denom q)
+
+    a exquo b ==
+      b = 0$% => "failed"
+      b = 1$% => a
+      br : Fraction R := inv (b :: Fraction R)
+      a * partialFraction(numer br,(denom br) :: FRR)
+
+    recip a == (1$% exquo a)
+
+    firstDenom a ==         -- denominator of 1st fractional term
+      null a.fract => 1$FRR
+      (first a.fract).den
+
+    firstNumer a ==         -- numerator of 1st fractional term
+      null a.fract => 0$R
+      (first a.fract).num
+
+    numberOfFractionalTerms a == # a.fract
+
+    nthFractionalTerm(a,n) ==
+      l : LfTerm := a.fract
+      (n < 1) or (n > # l) => 0$%
+      [0$R,[l.n]$LfTerm]$%
+
+    wholePart a == a.whole
+
+    partialFraction(nm: R, dn : FRR) ==
+      nm = 0$R => 0$%
+      -- move inv unit of den to numerator
+      u : R := unit dn
+      u := (recip u) :: R
+      partialFractionNormalized(u * nm,u * dn)
+
+    padicallyExpand(p : R, r : R) ==
+      -- expands r as a sum of powers of p, with coefficients
+      -- r = HornerEval(padicallyExpand(p,r),p)
+      qr : QR := divide(r, p)
+      qr.quotient = 0$R => qr.remainder :: SUPR
+      (qr.remainder :: SUPR) + monomial(1$R,1$NonNegativeInteger)$SUPR *
+        padicallyExpand(p,qr.quotient)
+
+    a = b ==
+      a.whole ^= b.whole => false  -- must verify this
+      (null a.fract) =>
+        null b.fract => a.whole = b.whole
+        false
+      null b.fract => false
+      -- oh, no! following is temporary
+      (a :: Fraction R) = (b :: Fraction R)
+
+    - a ==
+      s: fTerm
+      l: LfTerm := nil
+      for s in reverse a.fract repeat l := cons([- s.num,s.den]$fTerm,l)
+      [- a.whole,l]
+
+    r * a ==
+      r = 0$R => 0$%
+      r = 1$R => a
+      b : % := (r * a.whole) :: %
+      c : %
+      s : fTerm
+      for s in reverse a.fract repeat
+        c := normalizeFracTerm [r * s.num, s.den]$fTerm
+        b.whole := b.whole + c.whole
+        not (null c.fract) => b.fract := append(c.fract, b.fract)
+      b
+
+    n * a == (n :: R) * a
+
+    a + b ==
+      compactFraction
+        [a.whole + b.whole,
+          sort(LessThan,append(a.fract,copy b.fract))]$%
+
+    a * b ==
+      null a.fract => a.whole * b
+      null b.fract => b.whole * a
+      af : % := [0$R, a.fract]$%   --     a - a.whole
+      c: % := (a.whole * b) + (b.whole * af)
+      s,t : fTerm
+      for s in a.fract repeat
+        for t in b.fract repeat
+          c := c + multiplyFracTerms(s,t)
+      c
+
+    coerce(a): Ex ==
+      null a.fract => a.whole :: Ex
+      s : fTerm
+      l : List Ex
+      if a.whole = 0 then l := nil else l := [a.whole :: Ex]
+      for s in a.fract repeat
+        s.den = 1$FRR => l := cons(s.num :: Ex, l)
+        l := cons(s.num :: Ex /  s.den :: Ex, l)
+      # l = 1 => first l
+      reduce("+", reverse l)
+
 *)
 
 \end{chunk}
@@ -113099,9 +136097,11 @@ Partition: Exports == Implementation where
     import PartitionsAndPermutations
  
     Rep := List Integer
+
     0 == nil()
  
     coerce (s:%) == s pretend List Integer
+
     convert x == copy(x pretend L I)
  
     partition list == sort((i1:Integer,i2:Integer):Boolean +-> i2 < i1,list)
@@ -113114,10 +136114,6 @@ Partition: Exports == Implementation where
  
     x = y ==
         EQUAL(x,y)$Lisp
---      empty? x => empty? y
---      empty? y => false
---      first x = first y => rest x = rest y
---      false
  
     x + y ==
       empty? x => y
@@ -113186,6 +136182,90 @@ Partition: Exports == Implementation where
 \begin{chunk}{COQ PRTITION}
 (* domain PRTITION *)
 (*
+ 
+    import PartitionsAndPermutations
+ 
+    Rep := List Integer
+
+    0 == nil()
+ 
+    coerce (s:%) == s pretend List Integer
+
+    convert x == copy(x pretend L I)
+ 
+    partition list == sort((i1:Integer,i2:Integer):Boolean +-> i2 < i1,list)
+ 
+    x < y ==
+      empty? x => not empty? y
+      empty? y => false
+      first x = first y => rest x < rest y
+      first x < first y
+ 
+    x = y ==
+        EQUAL(x,y)$Lisp
+ 
+    x + y ==
+      empty? x => y
+      empty? y => x
+      first x > first y => concat(first x,rest(x) + y)
+      concat(first y,x + rest(y))
+    n:NNI * x:% == (zero? n => 0; x + (subtractIfCan(n,1) :: NNI) * x)
+ 
+    dp: (I,%) -> %
+    dp(i,x) ==
+      empty? x => 0
+      first x = i => rest x
+      concat(first x,dp(i,rest x))
+ 
+    remv: (I,%) -> UN
+    remv(i,x) == (member?(i,x) => dp(i,x); "failed")
+ 
+    subtractIfCan(x, y) ==
+      empty? x =>
+        empty? y => 0
+        "failed"
+      empty? y => x
+      (aa := remv(first y,x)) case "failed" => "failed"
+      subtractIfCan((aa :: %), rest y)
+ 
+    li1 : L I  --!! 'bite' won't compile without this
+    bite: (I,L I) -> L I
+    bite(i,li) ==
+      empty? li => concat(0,nil())
+      first li = i =>
+        li1 := bite(i,rest li)
+        concat(first(li1) + 1,rest li1)
+      concat(0,li)
+ 
+    li : L I  --!!  'powers' won't compile without this
+    powers l ==
+      empty? l => nil()
+      li := bite(first l,rest l)
+      concat([first l,first(li) + 1],powers(rest li))
+ 
+    conjugate x == conjugate(x pretend Rep)$PartitionsAndPermutations
+ 
+    mkterm: (I,I) -> OUT
+    mkterm(i1,i2) ==
+      i2 = 1 => (i1 :: OUT) ** (" " :: OUT)
+      (i1 :: OUT) ** (i2 :: OUT)
+ 
+    mkexp1: L L I -> L OUT
+    mkexp1 lli ==
+      empty? lli => nil()
+      li := first lli
+      empty?(rest lli) and second(li) = 1 =>
+        concat(first(li) :: OUT,nil())
+      concat(mkterm(first li,second li),mkexp1(rest lli))
+ 
+    coerce(x:%):OUT == 
+        empty? (x pretend Rep) => coerce(x pretend Rep)$Rep
+        paren(reduce("*",mkexp1(powers(x pretend Rep))))
+ 
+    pdct x ==
+      */[factorial(second a) * (first(a) ** (second(a) pretend NNI))
+                 for a in powers(x pretend Rep)]
+
 *)
 
 \end{chunk}
@@ -113469,52 +136549,92 @@ Pattern(R:SetCategory): Exports == Implementation where
       ++ "failed" otherwise;
  
   Implementation ==> add
+
     Rep := Record(cons?: B, pat:PAT, lev: NonNegativeInteger,
                   topvar: List SY, toppred: Any)
  
     dummy:BOP := operator(new()$Symbol)
+
     nopred    := coerce(0$Integer)$AnyFunctions1(Integer)
  
     mkPat     : (B, PAT, NonNegativeInteger) -> %
+
     mkrsy     : (SY, B, B, B)  -> RSY
+
     SYM2O     : RSY -> O
+
     PAT2O     : PAT -> O
+
     patcopy   : PAT -> PAT
+
     bitSet?   : (SI ,  SI) -> B
+
     pateq?    : (PAT, PAT) -> B
+
     LPAT2O    : ((O, O) -> O, List %) -> O
+
     taggedElt : (SI, List %) -> %
+
     isTaggedOp: (%, SI) -> Union(List %, "failed")
+
     incmax    : List % -> NonNegativeInteger
  
     coerce(r:R):%   == mkPat(true, [r], 0)
+
     mkPat(c, p, l)  == [c, p, l, empty(), nopred]
+
     hasTopPredicate? x == not empty?(x.topvar)
+
     topPredicate x  == [x.topvar, x.toppred]
+
     setTopPredicate(x, l, f) == (x.topvar := l; x.toppred := f; x)
+
     constant? p     == p.cons?
+
     depth p         == p.lev
+
     inR? p          == p.pat case ret
+
     symbol? p       == p.pat case sym
+
     isPlus p        == isTaggedOp(p, PAT_PLUS)
+
     isTimes p       == isTaggedOp(p, PAT_TIMES)
+
     isList p        == isTaggedOp(p, PAT_LIST)
+
     isExpt p        == (p.pat case exp => p.pat.exp; "failed")
+
     isQuotient p    == (p.pat case qot => p.pat.qot; "failed")
+
     hasPredicate? p == not empty? predicates p
+
     quoted? p       == symbol? p and zero?(p.pat.sym.tag)
+
     generic? p      == symbol? p and bitSet?(p.pat.sym.tag, SYM_GENERIC)
+
     multiple? p     == symbol? p and bitSet?(p.pat.sym.tag,SYM_MULTIPLE)
+
     optional? p     == symbol? p and bitSet?(p.pat.sym.tag,SYM_OPTIONAL)
+
     bitSet?(a, b)   == And(a, b) ^= 0
+
     coerce(p:%):O   == PAT2O(p.pat)
+
     p1:% ** p2:%    == taggedElt(PAT_EXPT, [p1, p2])
+
     LPAT2O(f, l)    == reduce(f, [x::O for x in l])$List(O)
+
     retract(p:%):R  == (inR? p => p.pat.ret; error "Not retractable")
+
     convert(l:List %):%                 == taggedElt(PAT_LIST, l)
+
     retractIfCan(p:%):Union(R,"failed") ==(inR? p => p.pat.ret;"failed")
+
     withPredicates(p, l)                == setPredicates(copy p, l)
+
     coerce(sy:SY):%          == patternVariable(sy, false, false, false)
+
     copy p  == [constant? p, patcopy(p.pat), p.lev, p.topvar, p.toppred]
  
     -- returns [a, b] if #l = 2 and optional? a, "failed" otherwise
@@ -113556,19 +136676,24 @@ Pattern(R:SetCategory): Exports == Implementation where
       "failed"
  
     if R has Monoid then
+
       1 == 1::R::%
+
     else
+
       1 == taggedElt(PAT_ONE,  empty())
  
     if R has AbelianMonoid then
+
       0 == 0::R::%
+
     else
+
       0 == taggedElt(PAT_ZERO, empty())
  
     p:% ** n:NonNegativeInteger ==
       p = 0 and n > 0 => 0
       p = 1 or zero? n => 1
---      one? n => p
       (n = 1) => p
       mkPat(constant? p, [[p, n]$REC], 1 + (p.lev))
  
@@ -113700,6 +136825,277 @@ Pattern(R:SetCategory): Exports == Implementation where
 \begin{chunk}{COQ PATTERN}
 (* domain PATTERN *)
 (*
+
+    Rep := Record(cons?: B, pat:PAT, lev: NonNegativeInteger,
+                  topvar: List SY, toppred: Any)
+ 
+    dummy:BOP := operator(new()$Symbol)
+
+    nopred    := coerce(0$Integer)$AnyFunctions1(Integer)
+ 
+    mkPat     : (B, PAT, NonNegativeInteger) -> %
+
+    mkrsy     : (SY, B, B, B)  -> RSY
+
+    SYM2O     : RSY -> O
+
+    PAT2O     : PAT -> O
+
+    patcopy   : PAT -> PAT
+
+    bitSet?   : (SI ,  SI) -> B
+
+    pateq?    : (PAT, PAT) -> B
+
+    LPAT2O    : ((O, O) -> O, List %) -> O
+
+    taggedElt : (SI, List %) -> %
+
+    isTaggedOp: (%, SI) -> Union(List %, "failed")
+
+    incmax    : List % -> NonNegativeInteger
+ 
+    coerce(r:R):%   == mkPat(true, [r], 0)
+
+    mkPat(c, p, l)  == [c, p, l, empty(), nopred]
+
+    hasTopPredicate? x == not empty?(x.topvar)
+
+    topPredicate x  == [x.topvar, x.toppred]
+
+    setTopPredicate(x, l, f) == (x.topvar := l; x.toppred := f; x)
+
+    constant? p     == p.cons?
+
+    depth p         == p.lev
+
+    inR? p          == p.pat case ret
+
+    symbol? p       == p.pat case sym
+
+    isPlus p        == isTaggedOp(p, PAT_PLUS)
+
+    isTimes p       == isTaggedOp(p, PAT_TIMES)
+
+    isList p        == isTaggedOp(p, PAT_LIST)
+
+    isExpt p        == (p.pat case exp => p.pat.exp; "failed")
+
+    isQuotient p    == (p.pat case qot => p.pat.qot; "failed")
+
+    hasPredicate? p == not empty? predicates p
+
+    quoted? p       == symbol? p and zero?(p.pat.sym.tag)
+
+    generic? p      == symbol? p and bitSet?(p.pat.sym.tag, SYM_GENERIC)
+
+    multiple? p     == symbol? p and bitSet?(p.pat.sym.tag,SYM_MULTIPLE)
+
+    optional? p     == symbol? p and bitSet?(p.pat.sym.tag,SYM_OPTIONAL)
+
+    bitSet?(a, b)   == And(a, b) ^= 0
+
+    coerce(p:%):O   == PAT2O(p.pat)
+
+    p1:% ** p2:%    == taggedElt(PAT_EXPT, [p1, p2])
+
+    LPAT2O(f, l)    == reduce(f, [x::O for x in l])$List(O)
+
+    retract(p:%):R  == (inR? p => p.pat.ret; error "Not retractable")
+
+    convert(l:List %):%                 == taggedElt(PAT_LIST, l)
+
+    retractIfCan(p:%):Union(R,"failed") ==(inR? p => p.pat.ret;"failed")
+
+    withPredicates(p, l)                == setPredicates(copy p, l)
+
+    coerce(sy:SY):%          == patternVariable(sy, false, false, false)
+
+    copy p  == [constant? p, patcopy(p.pat), p.lev, p.topvar, p.toppred]
+ 
+    -- returns [a, b] if #l = 2 and optional? a, "failed" otherwise
+    optpair l ==
+      empty? rest rest l =>
+        b := first rest l
+        optional?(a := first l) => l
+        optional? b => reverse l
+        "failed"
+      "failed"
+ 
+    incmax l ==
+      1 + reduce("max", [p.lev for p in l], 0)$List(NonNegativeInteger)
+ 
+    p1 = p2 ==
+      (p1.cons? = p2.cons?) and (p1.lev = p2.lev) and
+        (p1.topvar = p2.topvar) and
+          ((EQ(p1.toppred, p2.toppred)$Lisp) pretend B) and
+            pateq?(p1.pat, p2.pat)
+ 
+    isPower p ==
+      (u := isTaggedOp(p, PAT_EXPT)) case "failed" => "failed"
+      [first(u::List(%)), second(u::List(%))]
+ 
+    taggedElt(n, l) ==
+      mkPat(every?(constant?, l), [[n, dummy, l]$KER], incmax l)
+ 
+    elt(o, l) ==
+      is?(o, POWER) and #l = 2 => first(l) ** last(l)
+      mkPat(every?(constant?, l), [[0, o, l]$KER], incmax l)
+ 
+    isOp p ==
+      (p.pat case ker) and zero?(p.pat.ker.tag) =>
+        [p.pat.ker.op, p.pat.ker.arg]
+      "failed"
+ 
+    isTaggedOp(p,t) ==
+      (p.pat case ker) and (p.pat.ker.tag = t) => p.pat.ker.arg
+      "failed"
+ 
+    if R has Monoid then
+
+      1 == 1::R::%
+
+    else
+
+      1 == taggedElt(PAT_ONE,  empty())
+ 
+    if R has AbelianMonoid then
+
+      0 == 0::R::%
+
+    else
+
+      0 == taggedElt(PAT_ZERO, empty())
+ 
+    p:% ** n:NonNegativeInteger ==
+      p = 0 and n > 0 => 0
+      p = 1 or zero? n => 1
+      (n = 1) => p
+      mkPat(constant? p, [[p, n]$REC], 1 + (p.lev))
+ 
+    p1 / p2 ==
+      p2 = 1 => p1
+      mkPat(constant? p1 and constant? p2, [[p1, p2]$QOT],
+                                      1 + max(p1.lev, p2.lev))
+ 
+    p1 + p2 ==
+      p1 = 0 => p2
+      p2 = 0 => p1
+      (u1 := isPlus p1) case List(%) =>
+        (u2 := isPlus p2) case List(%) =>
+          taggedElt(PAT_PLUS, concat(u1::List %, u2::List %))
+        taggedElt(PAT_PLUS, concat(u1::List %, p2))
+      (u2 := isPlus p2) case List(%) =>
+        taggedElt(PAT_PLUS, concat(p1, u2::List %))
+      taggedElt(PAT_PLUS, [p1, p2])
+ 
+    p1 * p2 ==
+      p1 = 0 or p2 = 0 => 0
+      p1 = 1 => p2
+      p2 = 1 => p1
+      (u1 := isTimes p1) case List(%) =>
+        (u2 := isTimes p2) case List(%) =>
+          taggedElt(PAT_TIMES, concat(u1::List %, u2::List %))
+        taggedElt(PAT_TIMES, concat(u1::List %, p2))
+      (u2 := isTimes p2) case List(%) =>
+        taggedElt(PAT_TIMES, concat(p1, u2::List %))
+      taggedElt(PAT_TIMES, [p1, p2])
+ 
+    isOp(p, o) ==
+      (p.pat case ker) and zero?(p.pat.ker.tag) and (p.pat.ker.op =o) =>
+        p.pat.ker.arg
+      "failed"
+ 
+    predicates p ==
+      symbol? p => p.pat.sym.pred
+      empty()
+ 
+    setPredicates(p, l) ==
+      generic? p => (p.pat.sym.pred := l; p)
+      error "Can only attach predicates to generic symbol"
+ 
+    resetBadValues p ==
+      generic? p => (p.pat.sym.bad := empty()$List(Any); p)
+      error "Can only attach bad values to generic symbol"
+ 
+    addBadValue(p, a) ==
+      generic? p =>
+        if not member?(a, p.pat.sym.bad) then
+          p.pat.sym.bad := concat(a, p.pat.sym.bad)
+        p
+      error "Can only attach bad values to generic symbol"
+ 
+    getBadValues p ==
+      generic? p => p.pat.sym.bad
+      error "Not a generic symbol"
+ 
+    SYM2O p ==
+      sy := (p.val)::O
+      empty?(p.pred) => sy
+      paren infix(" | "::O, sy,
+        reduce("and",[sub("f"::O, i::O) for i in 1..#(p.pred)])$List(O))
+ 
+    variables p ==
+      constant? p => empty()
+      generic? p => [p]
+      q := p.pat
+      q case ret => empty()
+      q case exp => variables(q.exp.val)
+      q case qot => concat_!(variables(q.qot.num), variables(q.qot.den))
+      q case ker => concat [variables r for r in q.ker.arg]
+      empty()
+ 
+    PAT2O p ==
+      p case ret => (p.ret)::O
+      p case sym => SYM2O(p.sym)
+      p case exp => (p.exp.val)::O ** (p.exp.exponent)::O
+      p case qot => (p.qot.num)::O / (p.qot.den)::O
+      p.ker.tag = PAT_PLUS  => LPAT2O("+", p.ker.arg)
+      p.ker.tag = PAT_TIMES => LPAT2O("*", p.ker.arg)
+      p.ker.tag = PAT_LIST => (p.ker.arg)::O
+      p.ker.tag = PAT_ZERO => 0::Integer::O
+      p.ker.tag = PAT_ONE  => 1::Integer::O
+      l := [x::O for x in p.ker.arg]$List(O)
+      (u:=display(p.ker.op)) case "failed" =>prefix(name(p.ker.op)::O,l)
+      (u::(List O -> O)) l
+ 
+    patcopy p ==
+      p case ret => [p.ret]
+      p case sym =>
+        [[p.sym.tag, p.sym.val, copy(p.sym.pred), copy(p.sym.bad)]$RSY]
+      p case ker=>[[p.ker.tag,p.ker.op,[copy x for x in p.ker.arg]]$KER]
+      p case qot => [[copy(p.qot.num), copy(p.qot.den)]$QOT]
+      [[copy(p.exp.val), p.exp.exponent]$REC]
+ 
+    pateq?(p1, p2) ==
+      p1 case ret => (p2 case ret) and (p1.ret = p2.ret)
+      p1 case qot =>
+        (p2 case qot) and (p1.qot.num = p2.qot.num)
+                      and (p1.qot.den = p2.qot.den)
+      p1 case sym =>
+        (p2 case sym) and (p1.sym.val = p2.sym.val)
+                      and {p1.sym.pred} =$Set(Any) {p2.sym.pred}
+                        and {p1.sym.bad} =$Set(Any) {p2.sym.bad}
+      p1 case ker =>
+        (p2 case ker) and (p1.ker.tag = p2.ker.tag)
+               and (p1.ker.op = p2.ker.op) and (p1.ker.arg = p2.ker.arg)
+      (p2 case exp) and (p1.exp.exponent = p2.exp.exponent)
+                    and (p1.exp.val = p2.exp.val)
+ 
+    retractIfCan(p:%):Union(SY, "failed") ==
+      symbol? p => p.pat.sym.val
+      "failed"
+ 
+    mkrsy(t, c?, o?, m?) ==
+      c? => [0, t, empty(), empty()]
+      mlt := (m? => SYM_MULTIPLE; 0)
+      opt := (o? => SYM_OPTIONAL; 0)
+      [Or(Or(SYM_GENERIC, mlt), opt), t, empty(), empty()]
+ 
+    patternVariable(sy, c?, o?, m?) ==
+      rsy := mkrsy(sy, c?, o?, m?)
+      mkPat(zero?(rsy.tag), [rsy], 0)
+
 *)
 
 \end{chunk}
@@ -113806,13 +137202,19 @@ PatternMatchListResult(R:SetCategory, S:SetCategory, L:ListAggregate S):
     lists     : %  -> PatternMatchResult(R, L)
       ++ lists(r) returns the list of matches that match lists.
  == add
+
   Rep := Record(a:PatternMatchResult(R, S), l:PatternMatchResult(R, L))
 
   new()              == [new(), new()]
+
   atoms r            == r.a
+
   lists r            == r.l
+
   failed()           == [failed(), failed()]
+
   failed? r          == failed?(atoms r)
+
   x = y              == (atoms x = atoms y) and (lists x = lists y)
 
   makeResult(r1, r2) ==
@@ -113828,6 +137230,29 @@ PatternMatchListResult(R:SetCategory, S:SetCategory, L:ListAggregate S):
 \begin{chunk}{COQ PATLRES}
 (* domain PATLRES *)
 (*
+
+  Rep := Record(a:PatternMatchResult(R, S), l:PatternMatchResult(R, L))
+
+  new()              == [new(), new()]
+
+  atoms r            == r.a
+
+  lists r            == r.l
+
+  failed()           == [failed(), failed()]
+
+  failed? r          == failed?(atoms r)
+
+  x = y              == (atoms x = atoms y) and (lists x = lists y)
+
+  makeResult(r1, r2) ==
+    failed? r1 or failed? r2 => failed()
+    [r1, r2]
+
+  coerce(r:%):OutputForm ==
+    failed? r => atoms(r)::OutputForm
+    RecordPrint(r, Rep)$Lisp
+
 *)
 
 \end{chunk}
@@ -113965,6 +137390,7 @@ PatternMatchResult(R:SetCategory, S:SetCategory): SetCategory with
     ++ if not enough variables of p are matched in r to decide.
 
  == add
+
   LR ==> AssociationList(Symbol, S)
 
   import PatternFunctions1(R, S)
@@ -113972,10 +137398,15 @@ PatternMatchResult(R:SetCategory, S:SetCategory): SetCategory with
   Rep := Union(LR, "failed")
 
   new()                == empty()
+
   failed()             == "failed"
+
   failed? x            == x case "failed"
+
   insertMatch(p, x, l) == concat([retract p, x], l::LR)
+
   construct l          == construct(l)$LR
+
   destruct l           == entries(l::LR)$LR
 
 -- returns "failed" if not all the variables of the pred. are matched
@@ -114020,6 +137451,62 @@ PatternMatchResult(R:SetCategory, S:SetCategory): SetCategory with
 \begin{chunk}{COQ PATRES}
 (* domain PATRES *)
 (*
+
+  LR ==> AssociationList(Symbol, S)
+
+  import PatternFunctions1(R, S)
+
+  Rep := Union(LR, "failed")
+
+  new()                == empty()
+
+  failed()             == "failed"
+
+  failed? x            == x case "failed"
+
+  insertMatch(p, x, l) == concat([retract p, x], l::LR)
+
+  construct l          == construct(l)$LR
+
+  destruct l           == entries(l::LR)$LR
+
+-- returns "failed" if not all the variables of the pred. are matched
+  satisfy?(r, p) ==
+    failed? r => false
+    lr := r::LR
+    lv := [if (u := search(v, lr)) case "failed" then return "failed"
+                        else  u::S for v in topPredicate(p).var]$List(S)
+    satisfy?(lv, p)
+
+  union(x, y) ==
+    failed? x or failed? y => failed()
+    removeDuplicates concat(x::LR, y::LR)
+
+  x = y ==
+    failed? x => failed? y
+    failed? y => false
+    x::LR =$LR y::LR
+
+  coerce(x:%):OutputForm ==
+    failed? x => "Does not match"::OutputForm
+    destruct(x)::OutputForm
+
+  addMatchRestricted(p, x, l, ident) ==
+    (not optional? p) and (x = ident) => failed()
+    addMatch(p, x, l)
+
+  addMatch(p, x, l) ==
+    failed?(l) or not(satisfy?(x, p)) => failed()
+    al := l::LR
+    sy := retract(p)@Symbol
+    (r := search(sy, al)) case "failed" => insertMatch(p, x, l)
+    r::S = x => l
+    failed()
+
+  getMatch(p, l) ==
+    failed? l => "failed"
+    search(retract(p)@Symbol, l::LR)
+
 *)
 
 \end{chunk}
@@ -114568,22 +138055,31 @@ Permutation(S:SetCategory): public == private where
     -- import of domains and packages
 
     import OutputForm
+
     import Vector List S
 
     -- variables
 
     p,q      : %
+
     exp      : I
 
     -- local functions first, signatures:
 
     smaller? : (S,S) -> B
+
     rotateCycle: L S -> L S
+
     coerceCycle: L L S -> %
+
     smallerCycle?: (L S, L S)  -> B
+
     shorterCycle?:(L S, L S)  -> B
+
     permord:(RECCYPE,RECCYPE)  -> B
+
     coerceToCycle:(%,B) -> L L S
+
     duplicates?: L S -> B
 
     smaller?(a:S, b:S): B ==
@@ -114601,7 +138097,6 @@ Permutation(S:SetCategory): public == private where
         if smaller?(cyc.i,min) then
           min  := cyc.i
           minpos := i
---      one? minpos => cyc
       (minpos = 1) => cyc
       concat(last(cyc,((#cyc-minpos+1)::NNI)),first(cyc,(minpos-1)::NNI))
 
@@ -114818,7 +138313,6 @@ Permutation(S:SetCategory): public == private where
 
     numberOfCycles p == #coerceToCycle(p, false)
 
-
     if S has IntegerNumberSystem then
 
       coerceImages (image) ==
@@ -114842,6 +138336,290 @@ Permutation(S:SetCategory): public == private where
 \begin{chunk}{COQ PERM}
 (* domain PERM *)
 (*
+
+    -- representation of the object:
+
+    Rep  := V L S
+
+    -- import of domains and packages
+
+    import OutputForm
+
+    import Vector List S
+
+    -- variables
+
+    p,q      : %
+
+    exp      : I
+
+    -- local functions first, signatures:
+
+    smaller? : (S,S) -> B
+
+    rotateCycle: L S -> L S
+
+    coerceCycle: L L S -> %
+
+    smallerCycle?: (L S, L S)  -> B
+
+    shorterCycle?:(L S, L S)  -> B
+
+    permord:(RECCYPE,RECCYPE)  -> B
+
+    coerceToCycle:(%,B) -> L L S
+
+    duplicates?: L S -> B
+
+    smaller?(a:S, b:S): B ==
+      S has OrderedSet => a <$S b
+      S has Finite     => lookup a < lookup b
+      false
+
+    rotateCycle(cyc: L S): L S ==
+      -- smallest element is put in first place
+      -- doesn't change cycle if underlying set
+      -- is not ordered or not finite.
+      min:S := first cyc
+      minpos:I := 1           -- 1 = minIndex cyc
+      for i in 2..maxIndex cyc repeat
+        if smaller?(cyc.i,min) then
+          min  := cyc.i
+          minpos := i
+      (minpos = 1) => cyc
+      concat(last(cyc,((#cyc-minpos+1)::NNI)),first(cyc,(minpos-1)::NNI))
+
+    coerceCycle(lls : L L S): % ==
+      perm : % := 1
+      for lists in reverse lls repeat
+        perm := cycle lists * perm
+      perm
+
+    smallerCycle?(cyca: L S, cycb: L S): B ==
+      #cyca ^= #cycb =>
+        #cyca < #cycb
+      for i in cyca for j in cycb repeat
+        i ^= j => return smaller?(i, j)
+      false
+
+    shorterCycle?(cyca: L S, cycb: L S): B ==
+      #cyca < #cycb
+
+    permord(pa: RECCYPE, pb : RECCYPE): B ==
+      for i in pa.cycl for j in pb.cycl repeat
+        i ^= j => return smallerCycle?(i, j)
+      #pa.cycl < #pb.cycl
+
+    coerceToCycle(p: %, doSorting?: B): L L S ==
+      preim := p.1
+      im := p.2
+      cycles := nil()$(L L S)
+      while not null preim repeat
+        -- start next cycle
+        firstEltInCycle: S := first preim
+        nextCycle : L S := list firstEltInCycle
+        preim := rest preim
+        nextEltInCycle := first im
+        im      := rest im
+        while nextEltInCycle ^= firstEltInCycle repeat
+          nextCycle := cons(nextEltInCycle, nextCycle)
+          i := position(nextEltInCycle, preim)
+          preim := delete(preim,i)
+          nextEltInCycle := im.i
+          im := delete(im,i)
+        nextCycle := reverse nextCycle
+        -- check on 1-cycles, we don't list these
+        if not null rest nextCycle then
+          if doSorting? and (S has OrderedSet or S has Finite) then
+              -- put smallest element in cycle first:
+              nextCycle := rotateCycle nextCycle
+          cycles := cons(nextCycle, cycles)
+      not doSorting? => cycles
+      -- sort cycles
+      S has OrderedSet or S has Finite =>
+        sort(smallerCycle?,cycles)$(L L S)
+      sort(shorterCycle?,cycles)$(L L S)
+
+    duplicates? (ls : L S ): B ==
+      x := copy ls
+      while not null x repeat
+        member? (first x ,rest x) => return true
+        x := rest x
+      false
+
+    -- now the exported functions
+
+    listRepresentation p ==
+      s : RECPRIM := [p.1,p.2]
+
+    coercePreimagesImages preImageAndImage ==
+      preImage: List S := []
+      image: List S := []
+      for i in preImageAndImage.1 
+        for pi in preImageAndImage.2 repeat
+          if i ~= pi then
+            preImage := cons(i, preImage)
+            image := cons(pi, image)
+
+      [preImage, image]
+
+    movedPoints p == construct p.1
+
+    degree p ==  #movedPoints p
+
+    p = q ==
+      #(preimp := p.1) ^= #(preimq := q.1) => false
+      for i in 1..maxIndex preimp repeat
+        pos := position(preimp.i, preimq)
+        pos = 0 => return false
+        (p.2).i ^= (q.2).pos => return false
+      true
+
+    orbit(p ,el) ==
+      -- start with a 1-element list:
+      out : Set S := brace list el
+      el2 := eval(p, el)
+      while el2 ^= el repeat
+        -- be carefull: insert adds one element
+        -- as side effect to out
+        insert_!(el2, out)
+        el2 := eval(p, el2)
+      out
+
+    cyclePartition p ==
+      partition([#c for c in coerceToCycle(p, false)])$Partition
+
+    order p ==
+      ord: I := lcm removeDuplicates convert cyclePartition p
+      ord::NNI
+
+    sign(p) ==
+      even? p => 1
+      - 1
+
+    even?(p) ==  even?(#(p.1) - numberOfCycles p)
+      -- see the book of James and Kerber on symmetric groups
+      -- for this formula.
+
+    odd?(p) ==  odd?(#(p.1) - numberOfCycles p)
+
+    pa < pb ==
+      pacyc:= coerceToCycle(pa,true)
+      pbcyc:= coerceToCycle(pb,true)
+      for i in pacyc for j in pbcyc repeat
+        i ^= j => return smallerCycle? ( i, j )
+      maxIndex pacyc < maxIndex pbcyc
+
+    coerce(lls : L L S): % == coerceCycle lls
+
+    coerce(ls : L S): % == cycle ls
+
+    sort(inList : L %): L % ==
+      not (S has OrderedSet or S has Finite) => inList
+      ownList: L RECCYPE := nil()$(L RECCYPE)
+      for sigma in inList repeat
+        ownList :=
+          cons([coerceToCycle(sigma,true),sigma]::RECCYPE, ownList)
+      ownList := sort(permord, ownList)$(L RECCYPE)
+      outList := nil()$(L %)
+      for rec in ownList repeat
+        outList := cons(rec.permut, outList)
+      reverse outList
+
+    coerce (p: %): OUTFORM ==
+      cycles: L L S := coerceToCycle(p,true)
+      outfmL : L OUTFORM := nil()
+      for cycle in cycles repeat
+        outcycL: L OUTFORM := nil()
+        for elt in cycle repeat
+          outcycL := cons(elt :: OUTFORM, outcycL)
+        outfmL := cons(paren blankSeparate reverse outcycL, outfmL)
+      -- The identity element will be output as 1:
+      null outfmL => outputForm(1@Integer)
+      -- represent a single cycle in the form (a b c d)
+      -- and not in the form ((a b c d)):
+      null rest outfmL => first outfmL
+      hconcat reverse outfmL
+
+    cycles(vs ) == coerceCycle vs
+
+    cycle(ls) ==
+      #ls < 2 => 1
+      duplicates? ls => error "cycle: the input contains duplicates"
+      [ls, append(rest ls, list first ls)]
+
+    coerceListOfPairs(loP) ==
+      preim := nil()$(L S)
+      im := nil()$(L S)
+      for pair in loP repeat
+        if first pair ^=  second pair then
+          preim := cons(first pair, preim)
+          im := cons(second pair, im)
+      duplicates?(preim) or duplicates?(im) or brace(preim)$(Set S) _
+        ^= brace(im)$(Set S) =>
+        error "coerceListOfPairs: the input cannot be interpreted as a permutation"
+      [preim, im]
+
+    q * p ==
+      -- use vectors for efficiency??
+      preimOfp : V S := construct p.1
+      imOfp : V S := construct p.2
+      preimOfq := q.1
+      imOfq := q.2
+      preimOfqp   := nil()$(L S)
+      imOfqp   := nil()$(L S)
+      -- 1 = minIndex preimOfp
+      for i in 1..(maxIndex preimOfp) repeat
+        -- find index of image of p.i in q if it exists
+        j := position(imOfp.i, preimOfq)
+        if j = 0 then
+          -- it does not exist
+          preimOfqp := cons(preimOfp.i, preimOfqp)
+          imOfqp := cons(imOfp.i, imOfqp)
+        else
+          -- it exists
+          el := imOfq.j
+          -- if the composition fixes the element, we don't
+          -- have to do anything
+          if el ^= preimOfp.i then
+            preimOfqp := cons(preimOfp.i, preimOfqp)
+            imOfqp := cons(el, imOfqp)
+          -- we drop the parts of q which have to do with p
+          preimOfq := delete(preimOfq, j)
+          imOfq := delete(imOfq, j)
+      [append(preimOfqp, preimOfq), append(imOfqp, imOfq)]
+
+    1 == new(2,empty())$Rep
+
+    inv p  == [p.2, p.1]
+
+    eval(p, el) ==
+      pos := position(el, p.1)
+      pos = 0 => el
+      (p.2).pos
+
+    elt(p, el) == eval(p, el)
+
+    numberOfCycles p == #coerceToCycle(p, false)
+
+    if S has IntegerNumberSystem then
+
+      coerceImages (image) ==
+        preImage : L S := [i::S for i in 1..maxIndex image]
+        coercePreimagesImages [preImage,image]
+
+    if S has Finite then
+
+      coerceImages (image) ==
+        preImage : L S := [index(i::PI)::S for i in 1..maxIndex image]
+        coercePreimagesImages [preImage,image]
+
+      fixedPoints ( p ) == complement movedPoints p
+
+      cyclePartition p ==
+        pt := partition([#c for c in coerceToCycle(p, false)])$Partition
+        pt +$PT conjugate(partition([#fixedPoints(p)])$PT)$PT
+
 *)
 
 \end{chunk}
@@ -116341,7 +140119,7 @@ PermutationGroup(S:SetCategory): public == private where
         entryLessZero  := (entry < 0)
         if  ^entryLessZero then
           actelt := times(group.entry, actelt)
-          if wordProblem then outlist := append ( words.(entry::NNI) , outlist )
+          if wordProblem then outlist := append( words.(entry::NNI) , outlist )
       [ actelt , reverse outlist ]
 
     orbitInternal ( gp : % , startList : L S ) : L L S ==
@@ -116380,7 +140158,7 @@ PermutationGroup(S:SetCategory): public == private where
       while numberOfLoops > 0 repeat
         randomInteger : I := 1 + (random()$Integer rem numberOfGenerators)
         randomElement := times ( group.randomInteger , randomElement )
-        if wordProblem then words := append ( word.(randomInteger::NNI) , words)
+        if wordProblem then words := append( word.(randomInteger::NNI) , words)
         numberOfLoops := numberOfLoops - 1
       [ randomElement , words ]
 
@@ -116614,7 +140392,7 @@ PermutationGroup(S:SetCategory): public == private where
                   else
                     ee := sgs.entry
                     z  := times ( ee , z )
-                    if wordProblem then word := append ( wordlist.entry , word )
+                    if wordProblem then word := append( wordlist.entry , word )
               if noresult then
                 basePoint    := 1
                 newBasePoint := true
@@ -116640,7 +140418,8 @@ PermutationGroup(S:SetCategory): public == private where
             if wordProblem then outword := cons (list word , outword )
           else
             out.basePoint := cons ( z , out.basePoint )
-            if wordProblem then outword.basePoint := cons(word ,outword.basePoint )
+            if wordProblem then _
+              outword.basePoint := cons(word ,outword.basePoint )
           kkk := basePoint
       sizeOfGroup  := 1
       for j in 1..#baseOfGroup repeat
@@ -116721,6 +140500,636 @@ PermutationGroup(S:SetCategory): public == private where
   --now the exported functions
 
     coerce ( gp : % ) : L PERM S == gp.gens
+
+    generators ( gp : % ) : L PERM S == gp.gens
+
+    strongGenerators ( group ) ==
+      knownGroup? group
+      degree := # supp
+      strongGens := nil()$(L PERM S)
+      for i in sgs repeat
+        pairs := nil()$(L L S)
+        for j in 1..degree repeat
+          pairs := cons ( [ supp.j , supp.(i.j) ] , pairs )
+        strongGens := cons ( coerceListOfPairs pairs , strongGens )
+      reverse strongGens
+
+    elt ( gp , i ) == (gp.gens).i
+
+    movedPoints ( gp ) == brace pointList gp
+
+    random ( group , maximalNumberOfFactors ) ==
+      maximalNumberOfFactors < 1 => 1$(PERM S)
+      gp : L PERM S := group.gens
+      numberOfGenerators := # gp
+      randomInteger : I  := 1 + (random()$Integer rem numberOfGenerators)
+      randomElement      := gp.randomInteger
+      numberOfLoops : I  := 1 + (random()$Integer rem maximalNumberOfFactors)
+      while numberOfLoops > 0 repeat
+        randomInteger : I  := 1 + (random()$Integer rem numberOfGenerators)
+        randomElement := gp.randomInteger * randomElement
+        numberOfLoops := numberOfLoops - 1
+      randomElement
+
+    random ( group ) == random ( group , 20 )
+
+    order ( group ) ==
+      knownGroup? group
+      ord
+
+    degree ( group ) == # pointList group
+
+    base ( group ) ==
+      knownGroup? group
+      groupBase := nil()$(L S)
+      for i in baseOfGroup repeat
+        groupBase := cons ( supp.i , groupBase )
+      reverse groupBase
+
+    wordsForStrongGenerators ( group ) ==
+      knownGroup? group
+      wordlist
+
+    coerce ( gp : L PERM S ) : % ==
+      result : REC2 := [ 0 , [] , [] , [] , [] , [] ]
+      group         := [ gp , result ]
+
+    permutationGroup ( gp : L PERM S ) : % ==
+      result : REC2 := [ 0 , [] , [] , [] , [] , [] ]
+      group         := [ gp , result ]
+
+    coerce(group: %) : OUT ==
+      outList := nil()$(L OUT)
+      gp : L PERM S := group.gens
+      for i in (maxIndex gp)..1 by -1 repeat
+        outList := cons(coerce gp.i, outList)
+      postfix(outputForm(">":SYM),_
+        postfix(commaSeparate outList,outputForm("<":SYM)))
+
+    orbit ( gp : % , el : S ) : FSET S ==
+      elList : L S := [ el ]
+      outList      := orbitInternal ( gp , elList )
+      outSet       := brace()$(FSET S)
+      for i in 1..#outList repeat
+        insert_! ( outList.i.1 , outSet )
+      outSet
+
+    orbits ( gp ) ==
+      spp    := movedPoints gp
+      orbits := nil()$(L FSET S)
+      while cardinality spp > 0 repeat
+        el       := extract_! spp
+        orbitSet := orbit ( gp , el )
+        orbits   := cons ( orbitSet , orbits )
+        spp      := difference ( spp , orbitSet )
+      brace orbits
+
+    member? (p,  gp) ==
+      wordProblem := false
+      mi := memberInternal ( p , gp , true )
+      mi.bool
+
+    wordInStrongGenerators (p, gp ) ==
+      mi := memberInternal ( inv p , gp , false )
+      not mi.bool => error "p is not an element of gp"
+      mi.lst
+
+    wordInGenerators (p,  gp) ==
+      lll : L NNI := wordInStrongGenerators (p, gp)
+      outlist := nil()$(L NNI)
+      for wd in lll repeat
+        outlist := append ( outlist , wordlist.wd )
+      shortenWord ( outlist , gp )
+
+    gp1 < gp2 ==
+      not empty? difference ( movedPoints gp1 , movedPoints gp2 ) => false
+      not subgroup ( gp1 , gp2 ) => false
+      order gp1 = order gp2 => false
+      true
+
+    gp1 <= gp2 ==
+      not empty?  difference ( movedPoints gp1 , movedPoints gp2 ) => false
+      subgroup ( gp1 , gp2 )
+
+    gp1 = gp2 ==
+      movedPoints gp1 ^= movedPoints gp2 => false
+      if #(gp1.gens) <= #(gp2.gens) then
+        not subgroup ( gp1 , gp2 ) => return false
+      else
+        not subgroup ( gp2 , gp1 ) => return false
+      order gp1 = order gp2 => true
+      false
+
+    orbit ( gp : % , startSet : FSET S ) : FSET FSET S ==
+      startList : L S := parts startSet
+      outList         := orbitInternal ( gp , startList )
+      outSet          := brace()$(FSET FSET S)
+      for i in 1..#outList repeat
+        newSet : FSET S := brace outList.i
+        insert_! ( newSet , outSet )
+      outSet
+
+    orbit ( gp : % , startList : L S ) : FSET L S ==
+      brace orbitInternal(gp, startList)
+
+    initializeGroupForWordProblem ( gp , maxLoops , diff ) ==
+      wordProblem    := true
+      ord            := bsgs ( gp , maxLoops , diff )
+      gp.information := [ ord , sgs , baseOfGroup , gporb , supp , wordlist ]
+      void
+
+    initializeGroupForWordProblem ( gp ) ==
+       initializeGroupForWordProblem ( gp , 0 , 1 )
+
+\end{chunk}
+
+\begin{chunk}{COQ PERMGRP}
+(* domain PERMGRP *)
+(*
+
+    -- representation of the object:
+
+    Rep  := Record ( gens : L PERM S , information : REC2 )
+
+    -- import of domains and packages
+
+    import Permutation S
+    import OutputForm
+    import Symbol
+    import Void
+
+  --first the local variables
+
+    sgs               : L V NNI       := []
+    baseOfGroup       : L NNI         := []
+    sizeOfGroup       : NNI           := 1
+    degree            : NNI           := 0
+    gporb             : L REC         := []
+    out               : L L V NNI     := []
+    outword           : L L L NNI     := []
+    wordlist          : L L NNI       := []
+    basePoint         : NNI           := 0
+    newBasePoint      : B             := true
+    supp              : L S           := []
+    ord               : NNI           := 1
+    wordProblem       : B             := true
+
+  --local functions first, signatures:
+
+    shortenWord:(L NNI, %)->L NNI
+    times:(V NNI, V NNI)->V NNI
+    strip:(V NNI,REC,L V NNI,L L NNI)->REC3
+    orbitInternal:(%,L S )->L L S
+    inv: V NNI->V NNI
+    ranelt:(L V NNI,L L NNI, I)->REC3
+    testIdentity:V NNI->B
+    pointList: %->L S
+    orbitWithSvc:(L V NNI ,NNI )->REC
+    cosetRep:(NNI ,REC ,L V NNI )->REC3
+    bsgs1:(L V NNI,NNI,L L NNI,I,%,I)->NNI
+    computeOrbits: I->L NNI
+    reduceGenerators: I->Void
+    bsgs:(%, I, I)->NNI
+    initialize: %->FSET PERM S
+    knownGroup?: %->Void
+    subgroup:(%, %)->B
+    memberInternal:(PERM S, %, B)->REC4
+
+  --local functions first, implementations:
+
+    shortenWord ( lw : L NNI , gp : % ) : L NNI ==
+      -- tries to shorten a word in the generators by removing identities
+      gpgens : L PERM S := coerce gp
+      orderList : L NNI := [ order gen for gen in gpgens ]
+      newlw : L NNI := copy lw
+      for i in 1.. maxIndex orderList repeat
+        if orderList.i = 1 then
+          while member?(i,newlw) repeat
+          -- removing the trivial element
+            pos := position(i,newlw)
+            newlw := delete(newlw,pos)
+      flag : B := true
+      while flag repeat
+        actualLength : NNI := (maxIndex newlw) pretend NNI
+        pointer := actualLength
+        test := newlw.pointer
+        anzahl : NNI := 1
+        flag := false
+        while pointer > 1 repeat
+          pointer := ( pointer - 1 )::NNI
+          if newlw.pointer ^= test then
+            -- don't get a trivial element, try next
+            test := newlw.pointer
+            anzahl := 1
+          else
+            anzahl := anzahl + 1
+            if anzahl = orderList.test then
+              -- we have an identity, so remove it
+              for i in (pointer+anzahl)..actualLength repeat
+                newlw.(i-anzahl) := newlw.i
+              newlw := first(newlw, (actualLength - anzahl) :: NNI)
+              flag := true
+              pointer := 1
+      newlw
+
+    times ( p : V NNI , q : V NNI ) : V NNI ==
+      -- internal multiplication of permutations
+      [ qelt(p,qelt(q,i)) for i in 1..degree ]
+
+    strip(element:V NNI,orbit:REC,group:L V NNI,words:L L NNI) : REC3 ==
+      -- strip an element into the stabilizer
+      actelt         := element
+      schreierVector := orbit.svc
+      point          := orbit.orb.1
+      outlist        := nil()$(L NNI)
+      entryLessZero  : B := false
+      while ^entryLessZero repeat
+        entry := schreierVector.(actelt.point)
+        entryLessZero  := (entry < 0)
+        if  ^entryLessZero then
+          actelt := times(group.entry, actelt)
+          if wordProblem then outlist := append( words.(entry::NNI) , outlist )
+      [ actelt , reverse outlist ]
+
+    orbitInternal ( gp : % , startList : L S ) : L L S ==
+      orbitList : L L S := [ startList ]
+      pos  : I := 1
+      while not zero? pos  repeat
+        gpset : L PERM S := gp.gens
+        for gen in gpset repeat
+          newList  := nil()$(L S)
+          workList := orbitList.pos
+          for j in #workList..1 by -1 repeat
+            newList := cons ( eval ( gen , workList.j ) , newList )
+          if ^member?( newList , orbitList ) then
+            orbitList := cons ( newList , orbitList )
+            pos  := pos + 1
+        pos := pos - 1
+      reverse orbitList
+
+    inv ( p : V NNI ) : V NNI ==
+      -- internal inverse of a permutation
+      q : V NNI := new(degree,0)$(V NNI)
+      for i in 1..degree repeat q.(qelt(p,i)) := i
+      q
+
+    ranelt ( group : L V NNI , word : L L NNI , maxLoops : I ) : REC3 ==
+      -- generate a "random" element
+      numberOfGenerators    := # group
+      randomInteger : I     := 1 + (random()$Integer rem numberOfGenerators)
+      randomElement : V NNI := group.randomInteger
+      words                 := nil()$(L NNI)
+      if wordProblem then words := word.(randomInteger::NNI)
+      if maxLoops > 0 then
+        numberOfLoops : I  := 1 + (random()$Integer rem maxLoops)
+      else
+        numberOfLoops : I := maxLoops
+      while numberOfLoops > 0 repeat
+        randomInteger : I := 1 + (random()$Integer rem numberOfGenerators)
+        randomElement := times ( group.randomInteger , randomElement )
+        if wordProblem then words := append( word.(randomInteger::NNI) , words)
+        numberOfLoops := numberOfLoops - 1
+      [ randomElement , words ]
+
+    testIdentity ( p : V NNI ) : B ==
+      -- internal test for identity
+      for i in 1..degree repeat qelt(p,i) ^= i => return false
+      true
+
+    pointList(group : %) : L S ==
+      support : FSET S :=  brace()   -- empty set !!
+      for perm in group.gens repeat
+        support := union(support, movedPoints perm)
+      parts support
+
+    orbitWithSvc ( group : L V NNI , point : NNI ) : REC ==
+      -- compute orbit with Schreier vector, "-2" means not in the orbit,
+      -- "-1" means starting point, the PI correspond to generators
+      newGroup := nil()$(L V NNI)
+      for el in group repeat
+        newGroup := cons ( inv el , newGroup )
+      newGroup               := reverse newGroup
+      orbit          : L NNI := [ point ]
+      schreierVector : V I   := new ( degree , -2 )
+      schreierVector.point   := -1
+      position : I := 1
+      while not zero? position repeat
+        for i in 1..#newGroup repeat
+          newPoint := orbit.position
+          newPoint := newGroup.i.newPoint
+          if ^ member? ( newPoint , orbit ) then
+            orbit                   := cons ( newPoint , orbit )
+            position                := position + 1
+            schreierVector.newPoint := i
+        position := position - 1
+      [ reverse orbit , schreierVector ]
+
+    cosetRep ( point : NNI , o : REC , group : L V NNI ) : REC3 ==
+      ppt          := point
+      xelt : V NNI := [ n for n in 1..degree ]
+      word         := nil()$(L NNI)
+      oorb         := o.orb
+      osvc         := o.svc
+      while degree > 0 repeat
+        p := osvc.ppt
+        p < 0 => return [ xelt , word ]
+        x    := group.p
+        xelt := times ( x , xelt )
+        if wordProblem then word := append ( wordlist.p , word )
+        ppt  := x.ppt
+
+    bsgs1 (group:L V NNI,number1:NNI,words:L L NNI,maxLoops:I,gp:%,diff:I)_
+        : NNI ==
+      -- try to get a good approximation for the strong generators and base
+      for i in number1..degree repeat
+        ort := orbitWithSvc ( group , i )
+        k   := ort.orb
+        k1  := # k
+        if k1 ^= 1 then leave
+      gpsgs := nil()$(L V NNI)
+      words2 := nil()$(L L NNI)
+      gplength : NNI := #group
+      for jj in 1..gplength repeat if (group.jj).i ^= i then leave
+      for k in 1..gplength repeat
+        el2 := group.k
+        if el2.i ^= i then
+          gpsgs := cons ( el2 , gpsgs )
+          if wordProblem then words2 := cons ( words.k , words2 )
+        else
+          gpsgs := cons ( times ( group.jj , el2 ) , gpsgs )
+          if wordProblem _
+            then words2 := cons ( append ( words.jj , words.k ) , words2 )
+      group2 := nil()$(L V NNI)
+      words3 := nil()$(L L NNI)
+      j : I  := 15
+      while j > 0 repeat
+        -- find generators for the stabilizer
+        ran := ranelt ( group , words , maxLoops )
+        str := strip ( ran.elt , ort , group , words )
+        el2 := str.elt
+        if ^ testIdentity el2 then
+          if ^ member?(el2,group2) then
+            group2 := cons ( el2 , group2 )
+            if wordProblem then
+              help : L NNI := append ( reverse str.lst , ran.lst )
+              help         := shortenWord ( help , gp )
+              words3       := cons ( help , words3 )
+            j := j - 2
+        j := j - 1
+      -- this is for word length control
+      if wordProblem then maxLoops    := maxLoops - diff
+      if ( null group2 ) or ( maxLoops < 0 ) then
+        sizeOfGroup := k1
+        baseOfGroup := [ i ]
+        out         := [ gpsgs ]
+        outword     := [ words2 ]
+        return sizeOfGroup
+      k2          := bsgs1 ( group2 , i + 1 , words3 , maxLoops , gp , diff )
+      sizeOfGroup := k1 * k2
+      out         := append ( out , [ gpsgs ] )
+      outword     := append ( outword , [ words2 ] )
+      baseOfGroup := cons ( i , baseOfGroup )
+      sizeOfGroup
+
+    computeOrbits ( kkk : I ) : L NNI ==
+      -- compute the orbits for the stabilizers
+      sgs         := nil()
+      orbitLength := nil()$(L NNI)
+      gporb       := nil()
+      for i in 1..#baseOfGroup repeat
+        sgs         := append ( sgs , out.i )
+        pt          := #baseOfGroup - i + 1
+        obs         := orbitWithSvc ( sgs , baseOfGroup.pt )
+        orbitLength := cons ( #obs.orb , orbitLength )
+        gporb       := cons ( obs , gporb )
+      gporb := reverse gporb
+      reverse orbitLength
+
+    reduceGenerators ( kkk : I ) : Void ==
+      -- try to reduce number of strong generators
+      orbitLength := computeOrbits ( kkk )
+      sgs         := nil()
+      wordlist    := nil()
+      for i in 1..(kkk-1) repeat
+        sgs := append ( sgs , out.i )
+        if wordProblem then wordlist := append ( wordlist , outword.i )
+      removedGenerator := false
+      baseLength : NNI := #baseOfGroup
+      for nnn in kkk..(baseLength-1) repeat
+        sgs := append ( sgs , out.nnn )
+        if wordProblem then wordlist := append ( wordlist , outword.nnn )
+        pt  := baseLength - nnn + 1
+        obs := orbitWithSvc ( sgs , baseOfGroup.pt )
+        i   := 1
+        while not ( i > # out.nnn ) repeat
+          pos  := position ( out.nnn.i , sgs )
+          sgs2 := delete(sgs, pos)
+          obs2 := orbitWithSvc ( sgs2 , baseOfGroup.pt )
+          if # obs2.orb = orbitLength.nnn then
+            test := true
+            for j in (nnn+1)..(baseLength-1) repeat
+              pt2  := baseLength - j + 1
+              sgs2 := append ( sgs2 , out.j )
+              obs2 := orbitWithSvc ( sgs2 , baseOfGroup.pt2 )
+              if # obs2.orb ^= orbitLength.j then
+                test := false
+                leave
+            if test then
+              removedGenerator := true
+              sgs              := delete (sgs, pos)
+              if wordProblem then wordlist    := delete(wordlist, pos)
+              out.nnn          := delete (out.nnn, i)
+              if wordProblem then _
+                outword.nnn := delete(outword.nnn, i )
+            else
+              i := i + 1
+          else
+            i := i + 1
+      if removedGenerator then orbitLength := computeOrbits ( kkk )
+      void()
+
+
+    bsgs ( group : % ,maxLoops : I , diff : I ) : NNI ==
+      -- the MOST IMPORTANT part of the package
+      supp   := pointList group
+      degree := # supp
+      if degree = 0 then
+        sizeOfGroup := 1
+        sgs         := [ [ 0 ] ]
+        baseOfGroup := nil()
+        gporb       := nil()
+        return sizeOfGroup
+      newGroup := nil()$(L V NNI)
+      gp       : L PERM S := group.gens
+      words := nil()$(L L NNI)
+      for ggg in 1..#gp repeat
+        q := new(degree,0)$(V NNI)
+        for i in 1..degree repeat
+          newEl := eval ( gp.ggg , supp.i )
+          pos2  := position ( newEl , supp )
+          q.i   := pos2 pretend NNI
+        newGroup := cons ( q , newGroup )
+        if wordProblem then words    := cons(list ggg, words)
+      if maxLoops < 1 then
+        -- try to get the (approximate) base length
+        if zero? (# ((group.information).gpbase)) then
+          wordProblem := false
+          k           := bsgs1 ( newGroup , 1 , words , 20 , group , 0 )
+          wordProblem := true
+          maxLoops    := (# baseOfGroup) - 1
+        else
+          maxLoops    := (# ((group.information).gpbase)) - 1
+      k       := bsgs1 ( newGroup , 1 , words , maxLoops , group , diff )
+      kkk : I := 1
+      newGroup := reverse newGroup
+      noAnswer : B := true
+      while noAnswer repeat
+        reduceGenerators kkk
+-- *** Here is former "bsgs2" *** --
+        -- test whether we have a base and a strong generating set
+        sgs := nil()
+        wordlist := nil()
+        for i in 1..(kkk-1) repeat
+          sgs := append ( sgs , out.i )
+          if wordProblem then wordlist := append ( wordlist , outword.i )
+        noresult : B := true
+        for i in kkk..#baseOfGroup while noresult repeat
+          sgs    := append ( sgs , out.i )
+          if wordProblem then wordlist := append ( wordlist , outword.i )
+          gporbi := gporb.i
+          for pt in gporbi.orb while noresult repeat
+            ppp   := cosetRep ( pt , gporbi , sgs )
+            y1    := inv ppp.elt
+            word3 := ppp.lst
+            for jjj in 1..#sgs while noresult repeat
+              word         := nil()$(L NNI)
+              z            := times ( sgs.jjj , y1 )
+              if wordProblem then word := append ( wordlist.jjj , word )
+              ppp          := cosetRep ( (sgs.jjj).pt , gporbi , sgs )
+              z            := times ( ppp.elt , z )
+              if wordProblem then word := append ( ppp.lst , word )
+              newBasePoint := false
+              for j in (i-1)..1 by -1 while noresult repeat
+                s := gporb.j.svc
+                p := gporb.j.orb.1
+                while ( degree > 0 ) and noresult repeat
+                  entry := s.(z.p)
+                  if entry < 0 then
+                    if entry = -1 then leave
+                    basePoint := j::NNI
+                    noresult := false
+                  else
+                    ee := sgs.entry
+                    z  := times ( ee , z )
+                    if wordProblem then word := append( wordlist.entry , word )
+              if noresult then
+                basePoint    := 1
+                newBasePoint := true
+                noresult := testIdentity z
+        noAnswer := not (testIdentity z)
+        if noAnswer then
+          -- we have missed something
+          word2 := nil()$(L NNI)
+          if wordProblem then
+            for wd in word3 repeat
+              ttt := newGroup.wd
+              while not (testIdentity ttt) repeat
+                word2 := cons ( wd , word2 )
+                ttt   := times ( ttt , newGroup.wd )
+            word := append ( word , word2 )
+            word := shortenWord ( word , group )
+          if newBasePoint then
+            for i in 1..degree repeat
+              if z.i ^= i then
+                baseOfGroup := append ( baseOfGroup , [ i ] )
+                leave
+            out := cons (list  z, out )
+            if wordProblem then outword := cons (list word , outword )
+          else
+            out.basePoint := cons ( z , out.basePoint )
+            if wordProblem then _
+              outword.basePoint := cons(word ,outword.basePoint )
+          kkk := basePoint
+      sizeOfGroup  := 1
+      for j in 1..#baseOfGroup repeat
+        sizeOfGroup := sizeOfGroup * # gporb.j.orb
+      sizeOfGroup
+
+
+    initialize ( group : % ) : FSET PERM S ==
+      group2 := brace()$(FSET PERM S)
+      gp : L PERM S := group.gens
+      for gen in gp repeat
+        if degree gen > 0 then insert_!(gen, group2)
+      group2
+
+    knownGroup? (gp : %) : Void ==
+      -- do we know the group already?
+      result := gp.information
+      if result.order = 0 then
+        wordProblem       := false
+        ord               := bsgs ( gp , 20 , 0 )
+        result            := [ ord , sgs , baseOfGroup , gporb , supp , [] ]
+        gp.information    := result
+      else
+        ord         := result.order
+        sgs         := result.sgset
+        baseOfGroup := result.gpbase
+        gporb       := result.orbs
+        supp        := result.mp
+        wordlist    := result.wd
+      void
+
+    subgroup ( gp1 : % , gp2 : % ) : B ==
+      gpset1 := initialize gp1
+      gpset2 := initialize gp2
+      empty? difference (gpset1, gpset2) => true
+      for el in parts gpset1 repeat
+        not member? (el,  gp2) => return false
+      true
+
+    memberInternal ( p : PERM S , gp : % , flag : B ) : REC4 ==
+      -- internal membership testing
+      supp     := pointList gp
+      outlist := nil()$(L NNI)
+      mP : L S := parts movedPoints p
+      for x in mP repeat
+        not member? (x, supp) => return [ false , nil()$(L NNI) ]
+      if flag then
+        member? ( p , gp.gens ) => return [ true , nil()$(L NNI) ]
+        knownGroup? gp
+      else
+        result := gp.information
+        if #(result.wd) = 0 then
+          initializeGroupForWordProblem gp
+        else
+          ord         := result.order
+          sgs         := result.sgset
+          baseOfGroup := result.gpbase
+          gporb       := result.orbs
+          supp        := result.mp
+          wordlist    := result.wd
+      degree := # supp
+      pp := new(degree,0)$(V NNI)
+      for i in 1..degree repeat
+        el   := eval ( p , supp.i )
+        pos  := position ( el , supp )
+        pp.i := pos::NNI
+      words := nil()$(L L NNI)
+      if wordProblem then
+        for i in 1..#sgs repeat
+          lw : L NNI := [ (#sgs - i + 1)::NNI ]
+          words := cons ( lw , words )
+      for i in #baseOfGroup..1 by -1 repeat
+        str := strip ( pp , gporb.i , sgs , words )
+        pp := str.elt
+        if wordProblem then outlist := append ( outlist , str.lst )
+      [ testIdentity pp , reverse outlist ]
+
+  --now the exported functions
+
+    coerce ( gp : % ) : L PERM S == gp.gens
+
     generators ( gp : % ) : L PERM S == gp.gens
 
     strongGenerators ( group ) ==
@@ -116783,7 +141192,8 @@ PermutationGroup(S:SetCategory): public == private where
       gp : L PERM S := group.gens
       for i in (maxIndex gp)..1 by -1 repeat
         outList := cons(coerce gp.i, outList)
-      postfix(outputForm(">":SYM),postfix(commaSeparate outList,outputForm("<":SYM)))
+      postfix(outputForm(">":SYM),_
+        postfix(commaSeparate outList,outputForm("<":SYM)))
 
     orbit ( gp : % , el : S ) : FSET S ==
       elList : L S := [ el ]
@@ -116857,13 +141267,9 @@ PermutationGroup(S:SetCategory): public == private where
       gp.information := [ ord , sgs , baseOfGroup , gporb , supp , wordlist ]
       void
 
-    initializeGroupForWordProblem ( gp ) == initializeGroupForWordProblem ( gp , 0 , 1 )
+    initializeGroupForWordProblem ( gp ) ==
+       initializeGroupForWordProblem ( gp , 0 , 1 )
 
-\end{chunk}
-
-\begin{chunk}{COQ PERMGRP}
-(* domain PERMGRP *)
-(*
 *)
 
 \end{chunk}
@@ -117053,6 +141459,7 @@ Pi(): Exports == Implementation where
                    ConvertibleTo RF, ConvertibleTo InputForm) with
     pi: () -> % ++ pi() returns the symbolic %pi.
   Implementation ==> RF add
+
     Rep := RF
 
     sympi := "%pi"::Symbol
@@ -117064,12 +141471,19 @@ Pi(): Exports == Implementation where
     p2p:  UP -> PZ
 
     pi()                    == (monomial(1, 1)$UP :: RF) pretend %
+
     convert(x:%):RF         == x pretend RF
+
     convert(x:%):Float      == x::Float
+
     convert(x:%):DoubleFloat == x::DoubleFloat
+
     coerce(x:%):DoubleFloat  == p2sf(numer x) / p2sf(denom x)
+
     coerce(x:%):Float       == p2f(numer x) / p2f(denom x)
+
     p2o p                   == outputForm(p, sympi::OutputForm)
+
     p2i p                   == convert p2p p
 
     p2p p ==
@@ -117102,6 +141516,58 @@ Pi(): Exports == Implementation where
 \begin{chunk}{COQ HACKPI}
 (* domain HACKPI *)
 (*
+
+    Rep := RF
+
+    sympi := "%pi"::Symbol
+
+    p2sf: UP -> DoubleFloat
+    p2f : UP -> Float
+    p2o : UP -> OutputForm
+    p2i : UP -> InputForm
+    p2p:  UP -> PZ
+
+    pi()                    == (monomial(1, 1)$UP :: RF) pretend %
+
+    convert(x:%):RF         == x pretend RF
+
+    convert(x:%):Float      == x::Float
+
+    convert(x:%):DoubleFloat == x::DoubleFloat
+
+    coerce(x:%):DoubleFloat  == p2sf(numer x) / p2sf(denom x)
+
+    coerce(x:%):Float       == p2f(numer x) / p2f(denom x)
+
+    p2o p                   == outputForm(p, sympi::OutputForm)
+
+    p2i p                   == convert p2p p
+
+    p2p p ==
+      ans:PZ := 0
+      while p ^= 0 repeat
+        ans := ans + monomial(leadingCoefficient(p)::PZ, sympi, degree p)
+        p   := reductum p
+      ans
+
+    coerce(x:%):OutputForm ==
+      (r := retractIfCan(x)@Union(UP, "failed")) case UP => p2o(r::UP)
+      p2o(numer x) / p2o(denom x)
+
+    convert(x:%):InputForm ==
+      (r := retractIfCan(x)@Union(UP, "failed")) case UP => p2i(r::UP)
+      p2i(numer x) / p2i(denom x)
+
+    p2sf p ==
+      map((x:Integer):DoubleFloat+->x::DoubleFloat, p)_
+       $SparseUnivariatePolynomialFunctions2(Integer, DoubleFloat)
+        (pi()$DoubleFloat)
+
+    p2f p ==
+      map((x:Integer):Float+->x::Float,p)_
+       $SparseUnivariatePolynomialFunctions2(Integer, Float)
+         (pi()$Float)
+
 *)
 
 \end{chunk}
@@ -117661,129 +142127,1311 @@ listBranches(refined)
 --R                                         Type: List(List(Point(DoubleFloat)))
 --E 4
 
---S 5 of 5
-)show PlaneAlgebraicCurvePlot
---R 
---R PlaneAlgebraicCurvePlot  is a domain constructor
---R Abbreviation for PlaneAlgebraicCurvePlot is ACPLOT 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.3.pamphlet to see algebra source code for ACPLOT 
---R
---R------------------------------- Operations --------------------------------
---R coerce : % -> OutputForm              refine : (%,DoubleFloat) -> %
---R xRange : % -> Segment(DoubleFloat)    yRange : % -> Segment(DoubleFloat)
---R listBranches : % -> List(List(Point(DoubleFloat)))
---R makeSketch : (Polynomial(Integer),Symbol,Symbol,Segment(Fraction(Integer)),Segment(Fraction(Integer))) -> %
---R
---E 5
+--S 5 of 5
+)show PlaneAlgebraicCurvePlot
+--R 
+--R PlaneAlgebraicCurvePlot  is a domain constructor
+--R Abbreviation for PlaneAlgebraicCurvePlot is ACPLOT 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.3.pamphlet to see algebra source code for ACPLOT 
+--R
+--R------------------------------- Operations --------------------------------
+--R coerce : % -> OutputForm              refine : (%,DoubleFloat) -> %
+--R xRange : % -> Segment(DoubleFloat)    yRange : % -> Segment(DoubleFloat)
+--R listBranches : % -> List(List(Point(DoubleFloat)))
+--R makeSketch : (Polynomial(Integer),Symbol,Symbol,Segment(Fraction(Integer)),Segment(Fraction(Integer))) -> %
+--R
+--E 5
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{PlaneAlgebraicCurvePlot.help}
+====================================================================
+PlaneAlgebraicCurvePlot examples
+====================================================================
+
+Plot a NON-SINGULAR plane algebraic curve p(x,y) = 0.
+
+sketch:=makeSketch(x+y,x,y,-1/2..1/2,-1/2..1/2)$ACPLOT
+
+                          ACPLOT
+                       1         1      1         1
+        y + x = 0,   - - <= x <= -,   - - <= y <= -
+                       2         2      2         2
+                        [0.5,- 0.5]
+                        [- 0.5,0.5]
+
+
+
+refined:=refine(sketch,0.1)
+
+                            ACPLOT
+                         1         1      1         1
+          y + x = 0,   - - <= x <= -,   - - <= y <= -
+                         2         2      2         2
+                          [0.5,- 0.5]
+          [0.49600000000000083,- 0.49600000000000083]
+          [0.49200000000000083,- 0.49200000000000083]
+          [0.48800000000000082,- 0.48800000000000082]
+          [0.48400000000000082,- 0.48400000000000082]
+          ...
+          [- 0.48399999999999999,0.48399999999999999]
+          [- 0.48799999999999999,0.48799999999999999]
+          [- 0.49199999999999999,0.49199999999999999]
+                        [- 0.496,0.496]
+                          [- 0.5,0.5]
+
+listBranches(sketch)
+
+   [[[0.5,- 0.5],[- 0.5,0.5]]]
+
+
+listBranches(refined)
+
+   [
+     [[0.5,- 0.5], [0.49600000000000083,- 0.49600000000000083],
+      [0.49200000000000083,- 0.49200000000000083],
+      [0.48800000000000082,- 0.48800000000000082],
+      ...
+      [- 0.48399999999999999,0.48399999999999999],
+      [- 0.48799999999999999,0.48799999999999999],
+      [- 0.49199999999999999,0.49199999999999999], [- 0.496,0.496],
+
+\end{chunk}
+\pagehead{PlaneAlgebraicCurvePlot}{ACPLOT}
+\pagepic{ps/v103planealgebraiccurveplot.ps}{ACPLOT}{1.00}
+
+{\bf Exports:}\\
+\begin{tabular}{llllll}
+\cross{ACPLOT}{coerce} &
+\cross{ACPLOT}{listBranches} &
+\cross{ACPLOT}{makeSketch} &
+\cross{ACPLOT}{refine} &
+\cross{ACPLOT}{xRange} &
+\cross{ACPLOT}{yRange} 
+\end{tabular}
+
+\begin{chunk}{domain ACPLOT PlaneAlgebraicCurvePlot}
+)abbrev domain ACPLOT PlaneAlgebraicCurvePlot
+++ Author: Clifton J. Williamson and Timothy Daly
+++ Date Created: Fall 1988
+++ Date Last Updated: 27 April 1990
+++ Description:
+++ Plot a NON-SINGULAR plane algebraic curve p(x,y) = 0.
+
+PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _
+ with
+
+  makeSketch:(Polynomial Integer,Symbol,Symbol,Segment Fraction Integer,_
+               Segment Fraction Integer) -> %
+     ++ makeSketch(p,x,y,a..b,c..d) creates an ACPLOT of the
+     ++ curve \spad{p = 0} in the region a <= x <= b, c <= y <= d.
+     ++ More specifically, 'makeSketch' plots a non-singular algebraic curve
+     ++ \spad{p = 0} in an rectangular region xMin <= x <= xMax,
+     ++ yMin <= y <= yMax. The user inputs
+     ++ \spad{makeSketch(p,x,y,xMin..xMax,yMin..yMax)}.
+     ++ Here p is a polynomial in the variables x and y with
+     ++ integer coefficients (p belongs to the domain
+     ++ \spad{Polynomial Integer}). The case
+     ++ where p is a polynomial in only one of the variables is
+     ++ allowed.  The variables x and y are input to specify the
+     ++ the coordinate axes.  The horizontal axis is the x-axis and
+     ++ the vertical axis is the y-axis.  The rational numbers
+     ++ xMin,...,yMax specify the boundaries of the region in
+     ++ which the curve is to be plotted.
+     ++
+     ++X makeSketch(x+y,x,y,-1/2..1/2,-1/2..1/2)$ACPLOT
+
+  refine:(%,DoubleFloat) -> %
+     ++ refine(p,x) is not documented
+     ++
+     ++X sketch:=makeSketch(x+y,x,y,-1/2..1/2,-1/2..1/2)$ACPLOT
+     ++X refined:=refine(sketch,0.1)
+
+ == add
+
+  import PointPackage DoubleFloat
+  import Plot
+  import RealSolvePackage
+
+  BoundaryPts ==> Record(left:   List Point DoubleFloat,_
+                         right:  List Point DoubleFloat,_
+                         bottom: List Point DoubleFloat,_
+                         top:    List Point DoubleFloat)
+
+  NewPtInfo   ==> Record(newPt: Point DoubleFloat,_
+                         type:  String)
+
+  Corners     ==> Record(minXVal: DoubleFloat,_
+                         maxXVal: DoubleFloat,_
+                         minYVal: DoubleFloat,_
+                         maxYVal: DoubleFloat)
+
+  kinte       ==> solve$RealSolvePackage()
+
+  rsolve      ==> realSolve$RealSolvePackage()
+
+  singValBetween?:(DoubleFloat,DoubleFloat,List DoubleFloat) -> Boolean
+
+  segmentInfo:(DoubleFloat -> DoubleFloat,DoubleFloat,DoubleFloat,_
+               List DoubleFloat,List DoubleFloat,List DoubleFloat,_
+               DoubleFloat,DoubleFloat) -> _
+    Record(seg:Segment DoubleFloat,_
+           left: DoubleFloat,_
+           lowerVals: List DoubleFloat,_
+           upperVals:List DoubleFloat)
+
+  swapCoords:Point DoubleFloat -> Point DoubleFloat
+
+  samePlottedPt?:(Point DoubleFloat,Point DoubleFloat) -> Boolean
+
+  findPtOnList:(Point DoubleFloat,List Point DoubleFloat) -> _
+    Union(Point DoubleFloat,"failed")
+
+  makeCorners:(DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat) -> Corners
+
+  getXMin: Corners -> DoubleFloat
+
+  getXMax: Corners -> DoubleFloat
+
+  getYMin: Corners -> DoubleFloat
+
+  getYMax: Corners -> DoubleFloat
+
+  SFPolyToUPoly:Polynomial DoubleFloat -> _
+    SparseUnivariatePolynomial DoubleFloat
+
+  RNPolyToUPoly:Polynomial Fraction Integer -> _
+    SparseUnivariatePolynomial Fraction Integer
+
+  coerceCoefsToSFs:Polynomial Integer -> Polynomial DoubleFloat
+
+  coerceCoefsToRNs:Polynomial Integer -> Polynomial Fraction Integer
+
+  RNtoSF:Fraction Integer -> DoubleFloat
+
+  RNtoNF:Fraction Integer -> Float
+
+  SFtoNF:DoubleFloat -> Float
+
+  listPtsOnHorizBdry:(Polynomial Fraction Integer,Symbol,Fraction Integer,_
+                      Float,Float) -> _
+    List Point DoubleFloat
+
+  listPtsOnVertBdry:(Polynomial Fraction Integer,Symbol,Fraction Integer,_
+                     Float,Float) -> _
+    List Point DoubleFloat
+
+  listPtsInRect:(List List Float,Float,Float,Float,Float) -> _
+    List Point DoubleFloat
+
+  ptsSuchThat?:(List List Float,List Float -> Boolean) -> Boolean
+
+  inRect?:(List Float,Float,Float,Float,Float) -> Boolean
+
+  onHorzSeg?:(List Float,Float,Float,Float) -> Boolean
+
+  onVertSeg?:(List Float,Float,Float,Float) -> Boolean
+
+  newX:(List List Float,List List Float,Float,Float,Float,Fraction Integer,_
+        Fraction Integer) -> Fraction Integer
+
+  newY:(List List Float,List List Float,Float,Float,Float,_
+        Fraction Integer,Fraction Integer) -> Fraction Integer
+
+  makeOneVarSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_
+                    Fraction Integer,Fraction Integer,Fraction Integer,_
+                    Symbol) -> %
+
+  makeLineSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_
+                  Fraction Integer,Fraction Integer,Fraction Integer) -> %
+
+  makeRatFcnSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_
+                    Fraction Integer,Fraction Integer,Fraction Integer,_
+                    Symbol) -> %
+
+  makeGeneralSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_
+                     Fraction Integer,Fraction Integer,Fraction Integer) -> %
+
+  traceBranches:(Polynomial DoubleFloat,Polynomial DoubleFloat,_
+                 Polynomial DoubleFloat,Symbol,Symbol,Corners,DoubleFloat,_
+                 DoubleFloat,PositiveInteger, List Point DoubleFloat,_
+                 BoundaryPts) -> List List Point DoubleFloat
+
+  dummyFirstPt:(Point DoubleFloat,Polynomial DoubleFloat,_
+                Polynomial DoubleFloat,Symbol,Symbol,List Point DoubleFloat,_
+                List Point DoubleFloat,List Point DoubleFloat,_
+                List Point DoubleFloat) -> Point DoubleFloat
+
+  listPtsOnSegment:(Polynomial DoubleFloat,Polynomial DoubleFloat,_
+                    Polynomial DoubleFloat,Symbol,Symbol,Point DoubleFloat,_
+                    Point DoubleFloat,Corners, DoubleFloat,DoubleFloat,_
+                    PositiveInteger,List Point DoubleFloat,_
+                    List Point DoubleFloat) -> List List Point DoubleFloat
+
+  listPtsOnLoop:(Polynomial DoubleFloat,Polynomial DoubleFloat,_
+                 Polynomial DoubleFloat,Symbol,Symbol,Point DoubleFloat,_
+                 Corners, DoubleFloat,DoubleFloat,PositiveInteger,_
+                 List Point DoubleFloat,List Point DoubleFloat) -> _
+                 List List Point DoubleFloat
+
+  computeNextPt:(Polynomial DoubleFloat,Polynomial DoubleFloat,_
+                 Polynomial DoubleFloat,Symbol,Symbol,Point DoubleFloat,_
+                 Point DoubleFloat,Corners, DoubleFloat,DoubleFloat,_
+                 PositiveInteger,List Point DoubleFloat,_
+                 List Point DoubleFloat) -> NewPtInfo
+
+  newtonApprox:(SparseUnivariatePolynomial DoubleFloat, DoubleFloat, _
+                DoubleFloat, PositiveInteger) -> Union(DoubleFloat, "failed")
+
+--% representation
+
+  Rep := Record(poly    : Polynomial Integer,_
+                xVar    : Symbol,_
+                yVar    : Symbol,_
+                minXVal : Fraction Integer,_
+                maxXVal : Fraction Integer,_
+                minYVal : Fraction Integer,_
+                maxYVal : Fraction Integer,_
+                bdryPts : BoundaryPts,_
+                hTanPts : List Point DoubleFloat,_
+                vTanPts : List Point DoubleFloat,_
+                branches: List List Point DoubleFloat)
+
+--% global constants
+
+  EPSILON : Float := .000001 -- precision to which realSolve finds roots
+  PLOTERR : DoubleFloat := float(1,-3,10)
+    -- maximum allowable difference in each coordinate when
+    -- determining if 2 plotted points are equal
+
+--% global flags
+
+  NADA   : String := "nothing in particular"
+  BDRY   : String := "boundary point"
+  CRIT   : String := "critical point"
+  BOTTOM : String := "bottom"
+  TOP    : String := "top"
+
+--% hacks
+
+  NFtoSF: Float -> DoubleFloat
+  NFtoSF x == 0 + convert(x)$Float
+
+--% points
+  makePt: (DoubleFloat,DoubleFloat) -> Point DoubleFloat
+  makePt(xx,yy) == point(l : List DoubleFloat := [xx,yy])
+
+  swapCoords(pt) == makePt(yCoord pt,xCoord pt)
+
+  samePlottedPt?(p0,p1) ==
+    -- determines if p1 lies in a square with side 2 PLOTERR
+    -- centered at p0
+    x0 := xCoord p0; y0 := yCoord p0
+    x1 := xCoord p1; y1 := yCoord p1
+    (abs(x1-x0) < PLOTERR) and (abs(y1-y0) < PLOTERR)
+
+  findPtOnList(pt,pointList) ==
+    for point in pointList repeat
+      samePlottedPt?(pt,point) => return point
+    "failed"
+
+--% corners
+
+  makeCorners(xMinSF,xMaxSF,yMinSF,yMaxSF) ==
+    [xMinSF,xMaxSF,yMinSF,yMaxSF]
+
+  getXMin(corners) == corners.minXVal
+  getXMax(corners) == corners.maxXVal
+  getYMin(corners) == corners.minYVal
+  getYMax(corners) == corners.maxYVal
+
+--% coercions
+
+  SFPolyToUPoly(p) ==
+  -- 'p' is of type Polynomial, but has only one variable
+    zero? p => 0
+    monomial(leadingCoefficient p,totalDegree p) +
+       SFPolyToUPoly(reductum p)
+
+  RNPolyToUPoly(p) ==
+  -- 'p' is of type Polynomial, but has only one variable
+    zero? p => 0
+    monomial(leadingCoefficient p,totalDegree p) +
+        RNPolyToUPoly(reductum p)
+
+  coerceCoefsToSFs(p) ==
+  -- coefficients of 'p' are coerced to be DoubleFloat's
+    map(coerce,p)$PolynomialFunctions2(Integer,DoubleFloat)
+
+  coerceCoefsToRNs(p) ==
+  -- coefficients of 'p' are coerced to be DoubleFloat's
+    map(coerce,p)$PolynomialFunctions2(Integer,Fraction Integer)
+
+  RNtoSF(r) == coerce(r)@DoubleFloat
+  RNtoNF(r) == coerce(r)@Float
+  SFtoNF(x) == convert(x)@Float
+
+--% computation of special points
+
+  listPtsOnHorizBdry(pRN,y,y0,xMinNF,xMaxNF) ==
+  -- strict inequality here: corners on vertical boundary
+    pointList : List Point DoubleFloat := nil()
+    ySF := RNtoSF(y0)
+    f := eval(pRN,y,y0)
+    roots : List Float := kinte(f,EPSILON)
+    for root in roots repeat
+      if (xMinNF < root) and (root < xMaxNF) then
+        pointList := cons(makePt(NFtoSF root, ySF), pointList)
+    pointList
+
+  listPtsOnVertBdry(pRN,x,x0,yMinNF,yMaxNF) ==
+    pointList : List Point DoubleFloat := nil()
+    xSF := RNtoSF(x0)
+    f := eval(pRN,x,x0)
+    roots : List Float := kinte(f,EPSILON)
+    for root in roots repeat
+      if (yMinNF <= root) and (root <= yMaxNF) then
+        pointList := cons(makePt(xSF, NFtoSF root), pointList)
+    pointList
+
+  listPtsInRect(points,xMin,xMax,yMin,yMax) ==
+    pointList : List Point DoubleFloat := nil()
+    for point in points repeat
+      xx := first point; yy := second point
+      if (xMin<=xx) and (xx<=xMax) and (yMin<=yy) and (yy<=yMax) then
+        pointList := cons(makePt(NFtoSF xx,NFtoSF yy),pointList)
+    pointList
+
+  ptsSuchThat?(points,pred) ==
+    for point in points repeat
+      if pred point then return true
+    false
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{PlaneAlgebraicCurvePlot.help}
-====================================================================
-PlaneAlgebraicCurvePlot examples
-====================================================================
+  inRect?(point,xMinNF,xMaxNF,yMinNF,yMaxNF) ==
+    xx := first point; yy := second point
+    xMinNF <= xx and xx <= xMaxNF and yMinNF <= yy and yy <= yMaxNF
 
-Plot a NON-SINGULAR plane algebraic curve p(x,y) = 0.
+  onHorzSeg?(point,xMinNF,xMaxNF,yNF) ==
+    xx := first point; yy := second point
+    yy = yNF and xMinNF <= xx and xx <= xMaxNF
 
-sketch:=makeSketch(x+y,x,y,-1/2..1/2,-1/2..1/2)$ACPLOT
+  onVertSeg?(point,yMinNF,yMaxNF,xNF) ==
+    xx := first point; yy := second point
+    xx = xNF and yMinNF <= yy and yy <= yMaxNF
 
-                          ACPLOT
-                       1         1      1         1
-        y + x = 0,   - - <= x <= -,   - - <= y <= -
-                       2         2      2         2
-                        [0.5,- 0.5]
-                        [- 0.5,0.5]
+  newX(vtanPts,singPts,yMinNF,yMaxNF,xNF,xRN,horizInc) ==
+    xNewNF := xNF + RNtoNF horizInc
+    xRtNF := max(xNF,xNewNF); xLftNF := min(xNF,xNewNF)
+--  ptsSuchThat?(singPts,inRect?(#1,xLftNF,xRtNF,yMinNF,yMaxNF)) =>
+    foo : List Float -> Boolean := x +-> inRect?(x,xLftNF,xRtNF,yMinNF,yMaxNF)
+    ptsSuchThat?(singPts,foo) =>
+      newX(vtanPts,singPts,yMinNF,yMaxNF,xNF,xRN,_
+        horizInc/2::(Fraction Integer))
+--  ptsSuchThat?(vtanPts,onVertSeg?(#1,yMinNF,yMaxNF,xNewNF)) =>
+    goo : List Float -> Boolean := x +-> onVertSeg?(x,yMinNF,yMaxNF,xNewNF)
+    ptsSuchThat?(vtanPts,goo) =>
+      newX(vtanPts,singPts,yMinNF,yMaxNF,xNF,xRN,_
+        horizInc/2::(Fraction Integer))
+    xRN + horizInc
 
+  newY(htanPts,singPts,xMinNF,xMaxNF,yNF,yRN,vertInc) ==
+    yNewNF := yNF + RNtoNF vertInc
+    yTopNF := max(yNF,yNewNF); yBotNF := min(yNF,yNewNF)
+--  ptsSuchThat?(singPts,inRect?(#1,xMinNF,xMaxNF,yBotNF,yTopNF)) =>
+    foo : List Float -> Boolean := x +-> inRect?(x,xMinNF,xMaxNF,yBotNF,yTopNF)
+    ptsSuchThat?(singPts,foo) =>
+      newY(htanPts,singPts,xMinNF,xMaxNF,yNF,yRN,_
+        vertInc/2::(Fraction Integer))
+--  ptsSuchThat?(htanPts,onHorzSeg?(#1,xMinNF,xMaxNF,yNewNF)) =>
+    goo : List Float -> Boolean := x +-> onHorzSeg?(x,xMinNF,xMaxNF,yNewNF)
+    ptsSuchThat?(htanPts,goo) =>
+      newY(htanPts,singPts,xMinNF,xMaxNF,yNF,yRN,_
+        vertInc/2::(Fraction Integer))
+    yRN + vertInc
 
+--% creation of sketches
 
-refined:=refine(sketch,0.1)
+  makeSketch(p,x,y,xRange,yRange) ==
+    xMin := lo xRange; xMax := hi xRange
+    yMin := lo yRange; yMax := hi yRange
+    -- test input for consistency
+    xMax <= xMin =>
+      error "makeSketch: bad range for first variable"
+    yMax <= yMin =>
+      error "makeSketch: bad range for second variable"
+    varList := variables p
+    # varList > 2 =>
+      error "makeSketch: polynomial in more than 2 variables"
+    # varList = 0 =>
+      error "makeSketch: constant polynomial"
+    -- polynomial in 1 variable
+    # varList = 1 =>
+      (not member?(x,varList)) and (not member?(y,varList)) =>
+        error "makeSketch: bad variables"
+      makeOneVarSketch(p,x,y,xMin,xMax,yMin,yMax,first varList)
+    -- polynomial in 2 variables
+    (not member?(x,varList)) or (not member?(y,varList)) =>
+      error "makeSketch: bad variables"
+    totalDegree p = 1 =>
+      makeLineSketch(p,x,y,xMin,xMax,yMin,yMax)
+    -- polynomial is linear in one variable
+    -- y is a rational function of x
+    degree(p,y) = 1 =>
+      makeRatFcnSketch(p,x,y,xMin,xMax,yMin,yMax,y)
+    -- x is a rational function of y
+    degree(p,x) = 1 =>
+      makeRatFcnSketch(p,x,y,xMin,xMax,yMin,yMax,x)
+    -- the general case
+    makeGeneralSketch(p,x,y,xMin,xMax,yMin,yMax)
 
-                            ACPLOT
-                         1         1      1         1
-          y + x = 0,   - - <= x <= -,   - - <= y <= -
-                         2         2      2         2
-                          [0.5,- 0.5]
-          [0.49600000000000083,- 0.49600000000000083]
-          [0.49200000000000083,- 0.49200000000000083]
-          [0.48800000000000082,- 0.48800000000000082]
-          [0.48400000000000082,- 0.48400000000000082]
-          ...
-          [- 0.48399999999999999,0.48399999999999999]
-          [- 0.48799999999999999,0.48799999999999999]
-          [- 0.49199999999999999,0.49199999999999999]
-                        [- 0.496,0.496]
-                          [- 0.5,0.5]
+--% special cases
 
-listBranches(sketch)
+  makeOneVarSketch(p,x,y,xMin,xMax,yMin,yMax,var) ==
+  -- the case where 'p' is a polynomial in only one variable
+  -- the graph consists of horizontal or vertical lines
+    if var = x then
+      minVal := RNtoNF xMin
+      maxVal := RNtoNF xMax
+    else
+      minVal := RNtoNF yMin
+      maxVal := RNtoNF yMax
+    lf : List Point DoubleFloat := nil()
+    rt : List Point DoubleFloat := nil()
+    bt : List Point DoubleFloat := nil() 
+    tp : List Point DoubleFloat := nil()
+    htans : List Point DoubleFloat := nil() 
+    vtans : List Point DoubleFloat := nil()
+    bran : List List Point DoubleFloat := nil()
+    roots := kinte(p,EPSILON)
+    sketchRoots : List DoubleFloat := nil()
+    for root in roots repeat
+      if (minVal <= root) and (root <= maxVal) then
+          sketchRoots := cons(NFtoSF root,sketchRoots)
+    null sketchRoots =>
+      [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],htans,vtans,bran]
+    if var = x then
+      yMinSF := RNtoSF yMin; yMaxSF := RNtoSF yMax
+      for rootSF in sketchRoots repeat
+          tp := cons(pt1 := makePt(rootSF,yMaxSF),tp)
+          bt := cons(pt2 := makePt(rootSF,yMinSF),bt)
+          branch : List Point DoubleFloat := [pt1,pt2]
+          bran := cons(branch,bran)
+    else
+      xMinSF := RNtoSF xMin; xMaxSF := RNtoSF xMax
+      for rootSF in sketchRoots repeat
+          rt := cons(pt1 := makePt(xMaxSF,rootSF),rt)
+          lf := cons(pt2 := makePt(xMinSF,rootSF),lf)
+          branch : List Point DoubleFloat := [pt1,pt2]
+          bran := cons(branch,bran)
+    [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],htans,vtans,bran]
 
-   [[[0.5,- 0.5],[- 0.5,0.5]]]
+  makeLineSketch(p,x,y,xMin,xMax,yMin,yMax) ==
+  -- the case where p(x,y) = a x + b y + c with a ^= 0, b ^= 0
+  -- this is a line which is neither vertical nor horizontal
+    xMinSF := RNtoSF xMin; xMaxSF := RNtoSF xMax
+    yMinSF := RNtoSF yMin; yMaxSF := RNtoSF yMax
+    -- determine the coefficients a, b, and c
+    a := ground(coefficient(p,x,1)) :: DoubleFloat
+    b := ground(coefficient(p,y,1)) :: DoubleFloat
+    c := ground(coefficient(coefficient(p,x,0),y,0)) :: DoubleFloat
+    lf : List Point DoubleFloat := nil()
+    rt : List Point DoubleFloat := nil()
+    bt : List Point DoubleFloat := nil()
+    tp : List Point DoubleFloat := nil()
+    htans : List Point DoubleFloat := nil()
+    vtans : List Point DoubleFloat := nil()
+    branch : List Point DoubleFloat := nil()
+    bran : List List Point DoubleFloat := nil()
+    -- compute x coordinate of point on line with y = yMin
+    xBottom := (- b*yMinSF - c)/a
+    -- compute x coordinate of point on line with y = yMax
+    xTop    := (- b*yMaxSF - c)/a
+    -- compute y coordinate of point on line with x = xMin
+    yLeft   := (- a*xMinSF - c)/b
+    -- compute y coordinate of point on line with x = xMax
+    yRight  := (- a*xMaxSF - c)/b
+    -- determine which of the above 4 points are in the region
+    -- to be plotted and list them as a branch
+    if (xMinSF < xBottom) and (xBottom < xMaxSF) then
+        bt := cons(pt := makePt(xBottom,yMinSF),bt)
+        branch := cons(pt,branch)
+    if (xMinSF < xTop) and (xTop < xMaxSF) then
+        tp := cons(pt := makePt(xTop,yMaxSF),tp)
+        branch := cons(pt,branch)
+    if (yMinSF <= yLeft) and (yLeft <= yMaxSF) then
+        lf := cons(pt := makePt(xMinSF,yLeft),lf)
+        branch := cons(pt,branch)
+    if (yMinSF <= yRight) and (yRight <= yMaxSF) then
+        rt := cons(pt := makePt(xMaxSF,yRight),rt)
+        branch := cons(pt,branch)
+    bran := cons(branch,bran)
+    [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],htans,vtans,bran]
 
+  singValBetween?(xCurrent,xNext,xSingList) ==
+    for xVal in xSingList repeat
+      (xCurrent < xVal) and (xVal < xNext) => return true
+    false
 
-listBranches(refined)
+  segmentInfo(f,lo,hi,botList,topList,singList,minSF,maxSF) ==
+    repeat
+      -- 'current' is the smallest element of 'topList' and 'botList'
+      -- 'currentFrom' records the list from which it was taken
+      if null topList then
+        if null botList then
+          return [segment(lo,hi),hi,nil(),nil()]
+        else
+          current := first botList
+          botList := rest  botList
+          currentFrom := BOTTOM
+      else
+        if null botList then
+          current := first topList
+          topList := rest  topList
+          currentFrom := TOP
+        else
+          bot := first botList
+          top := first topList
+          if bot < top then
+            current := bot
+            botList := rest botList
+            currentFrom := BOTTOM
+          else
+            current := top
+            topList := rest topList
+            currentFrom := TOP
+      -- 'nxt' is the next smallest element of 'topList'
+      --  and 'botList'
+      -- 'nextFrom' records the list from which it was taken
+      if null topList then
+        if null botList then
+          return [segment(lo,hi),hi,nil(),nil()]
+        else
+          nxt := first botList
+          botList := rest botList
+          nextFrom := BOTTOM
+      else
+        if null botList then
+          nxt := first topList
+          topList := rest topList
+          nextFrom := TOP
+        else
+          bot := first botList
+          top := first topList
+          if bot < top then
+            nxt := bot
+            botList := rest botList
+            nextFrom := BOTTOM
+          else
+            nxt := top
+            topList := rest topList
+            nextFrom := TOP
+      if currentFrom = nextFrom then
+        if singValBetween?(current,nxt,singList) then
+          return [segment(lo,current),nxt,botList,topList]
+        else
+          val := f((nxt - current)/2::DoubleFloat)
+          if (val <= minSF) or (val >= maxSF) then
+            return [segment(lo,current),nxt,botList,topList]
+      else
+        if singValBetween?(current,nxt,singList) then
+          return [segment(lo,current),nxt,botList,topList]
 
-   [
-     [[0.5,- 0.5], [0.49600000000000083,- 0.49600000000000083],
-      [0.49200000000000083,- 0.49200000000000083],
-      [0.48800000000000082,- 0.48800000000000082],
-      ...
-      [- 0.48399999999999999,0.48399999999999999],
-      [- 0.48799999999999999,0.48799999999999999],
-      [- 0.49199999999999999,0.49199999999999999], [- 0.496,0.496],
+  makeRatFcnSketch(p,x,y,xMin,xMax,yMin,yMax,depVar) ==
+  -- the case where p(x,y) is linear in x or y
+  -- Thus, one variable is a rational function of the other.
+  -- Therefore, we may use the 2-dimensional function plotting
+  -- package.  The only problem is determining the intervals on
+  -- on which the function is to be plotted.
+  --!! corners: e.g. upper left corner is on graph with y' > 0
+    factoredP := p ::(Factored Polynomial Integer)
+    numberOfFactors(factoredP) > 1 =>
+        error "reducible polynomial"  --!! sketch each factor
+    dpdx := differentiate(p,x)
+    dpdy := differentiate(p,y)
+    pRN := coerceCoefsToRNs p
+    xMinSF := RNtoSF xMin; xMaxSF := RNtoSF xMax
+    yMinSF := RNtoSF yMin; yMaxSF := RNtoSF yMax
+    xMinNF := RNtoNF xMin; xMaxNF := RNtoNF xMax
+    yMinNF := RNtoNF yMin; yMaxNF := RNtoNF yMax
+    -- 'p' is of degree 1 in the variable 'depVar'.
+    -- Thus, 'depVar' is a rational function of the other variable.
+    num := -coefficient(p,depVar,0)
+    den :=  coefficient(p,depVar,1)
+    numUPolySF := SFPolyToUPoly(coerceCoefsToSFs(num))
+    denUPolySF := SFPolyToUPoly(coerceCoefsToSFs(den))
+    -- this is the rational function
+    f : DoubleFloat -> DoubleFloat := s +-> elt(numUPolySF,s)/elt(denUPolySF,s)
+    -- values of the dependent and independent variables
+    if depVar = x then
+      indVarMin   := yMin;   indVarMax   := yMax
+      indVarMinNF := yMinNF; indVarMaxNF := yMaxNF
+      indVarMinSF := yMinSF; indVarMaxSF := yMaxSF
+      depVarMin   := xMin;   depVarMax   := xMax
+      depVarMinSF := xMinSF; depVarMaxSF := xMaxSF
+    else
+      indVarMin   := xMin;   indVarMax   := xMax
+      indVarMinNF := xMinNF; indVarMaxNF := xMaxNF
+      indVarMinSF := xMinSF; indVarMaxSF := xMaxSF
+      depVarMin   := yMin;   depVarMax   := yMax
+      depVarMinSF := yMinSF; depVarMaxSF := yMaxSF
+    -- Create lists of critical points.
+    htanPts := rsolve([p,dpdx],[x,y],EPSILON)
+    vtanPts := rsolve([p,dpdy],[x,y],EPSILON)
+    htans := listPtsInRect(htanPts,xMinNF,xMaxNF,yMinNF,yMaxNF)
+    vtans := listPtsInRect(vtanPts,xMinNF,xMaxNF,yMinNF,yMaxNF)
+    -- Create lists which will contain boundary points.
+    lf : List Point DoubleFloat := nil()
+    rt : List Point DoubleFloat := nil()
+    bt : List Point DoubleFloat := nil()
+    tp : List Point DoubleFloat := nil()
+    -- Determine values of the independent variable at the which
+    -- the rational function has a pole as well as the values of
+    -- the independent variable for which there is a point on the
+    -- upper or lower boundary.
+    singList : List DoubleFloat :=
+      roots : List Float := kinte(den,EPSILON)
+      outList : List DoubleFloat := nil()
+      for root in roots repeat
+        if (indVarMinNF < root) and (root < indVarMaxNF) then
+          outList := cons(NFtoSF root,outList)
+      sort((x,y) +-> x < y, outList)
+    topList : List DoubleFloat :=
+      roots : List Float := kinte(eval(pRN,depVar,depVarMax),EPSILON)
+      outList : List DoubleFloat := nil()
+      for root in roots repeat
+        if (indVarMinNF < root) and (root < indVarMaxNF) then
+          outList := cons(NFtoSF root,outList)
+      sort((x,y) +-> x < y, outList)
+    botList : List DoubleFloat :=
+      roots : List Float := kinte(eval(pRN,depVar,depVarMin),EPSILON)
+      outList : List DoubleFloat := nil()
+      for root in roots repeat
+        if (indVarMinNF < root) and (root < indVarMaxNF) then
+          outList := cons(NFtoSF root,outList)
+      sort((x,y) +-> x < y, outList)
+    -- We wish to determine if the graph has points on the 'left'
+    -- and 'right' boundaries, so we compute the value of the
+    -- rational function at the lefthand and righthand values of
+    -- the dependent variable.  If the function has a singularity
+    -- on the left or right boundary, then 'leftVal' or 'rightVal'
+    -- is given a dummy valuewhich will convince the program that
+    -- there is no point on the left or right boundary.
+    denUPolyRN := RNPolyToUPoly(coerceCoefsToRNs(den))
+    if elt(denUPolyRN,indVarMin) = 0$(Fraction Integer) then
+      leftVal  := depVarMinSF - (abs(depVarMinSF) + 1$DoubleFloat)
+    else
+      leftVal  := f(indVarMinSF)
+    if elt(denUPolyRN,indVarMax) = 0$(Fraction Integer) then
+      rightVal := depVarMinSF - (abs(depVarMinSF) + 1$DoubleFloat)
+    else
+      rightVal := f(indVarMaxSF)
+    -- Now put boundary points on the appropriate lists.
+    if depVar = x then
+      if (xMinSF < leftVal) and (leftVal < xMaxSF) then
+        bt := cons(makePt(leftVal,yMinSF),bt)
+      if (xMinSF < rightVal) and (rightVal < xMaxSF) then
+        tp := cons(makePt(rightVal,yMaxSF),tp)
+      for val in botList repeat
+        lf := cons(makePt(xMinSF,val),lf)
+      for val in topList repeat
+        rt := cons(makePt(xMaxSF,val),rt)
+    else
+      if (yMinSF < leftVal) and (leftVal < yMaxSF) then
+        lf := cons(makePt(xMinSF,leftVal),lf)
+      if (yMinSF < rightVal) and (rightVal < yMaxSF) then
+        rt := cons(makePt(xMaxSF,rightVal),rt)
+      for val in botList repeat
+        bt := cons(makePt(val,yMinSF),bt)
+      for val in topList repeat
+        tp := cons(makePt(val,yMaxSF),tp)
+    bran : List List Point DoubleFloat := nil()
+    -- Determine segments on which the rational function is to
+    -- be plotted.
+    if (depVarMinSF < leftVal) and (leftVal < depVarMaxSF) then
+      lo := indVarMinSF
+    else
+      if null topList then
+        if null botList then
+          return [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],_
+                                          htans,vtans,bran]
+        else
+          lo := first botList
+          botList := rest botList
+      else
+        if null botList then
+          lo := first topList
+          topList := rest topList
+        else
+          bot := first botList
+          top := first topList
+          if bot < top then
+            lo := bot
+            botList := rest botList
+          else
+            lo := top
+            topList := rest topList
+    hi := 0$DoubleFloat  -- @#$%^&* compiler
+    if (depVarMinSF < rightVal) and (rightVal < depVarMaxSF) then
+      hi := indVarMaxSF
+    else
+      if null topList then
+        if null botList then
+          error "makeRatFcnSketch: plot domain"
+        else
+          hi := last botList
+          botList := remove(hi,botList)
+      else
+        if null botList then
+          hi := last topList
+          topList := remove(hi,topList)
+        else
+          bot := last botList
+          top := last topList
+          if bot > top then
+            hi := bot
+            botList := remove(hi,botList)
+          else
+            hi := top
+            topList := remove(hi,topList)
+    if (depVar = x) then
+      (minSF := xMinSF; maxSF := xMaxSF)
+    else
+      (minSF := yMinSF; maxSF := yMaxSF)
+    segList : List Segment DoubleFloat := nil()
+    repeat
+      segInfo := segmentInfo(f,lo,hi,botList,topList,singList,_
+                                  minSF,maxSF)
+      segList := cons(segInfo.seg,segList)
+      lo := segInfo.left
+      botList := segInfo.lowerVals
+      topList := segInfo.upperVals
+      if lo = hi then break
+    for segment in segList repeat
+      RFPlot : Plot := plot(f,segment)
+      curve := first(listBranches(RFPlot))
+      if depVar = y then
+        bran := cons(curve,bran)
+      else
+        bran := cons(map(swapCoords,curve),bran)
+    [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],htans,vtans,bran]
 
-\end{chunk}
-\pagehead{PlaneAlgebraicCurvePlot}{ACPLOT}
-\pagepic{ps/v103planealgebraiccurveplot.ps}{ACPLOT}{1.00}
+--% the general case
 
-{\bf Exports:}\\
-\begin{tabular}{llllll}
-\cross{ACPLOT}{coerce} &
-\cross{ACPLOT}{listBranches} &
-\cross{ACPLOT}{makeSketch} &
-\cross{ACPLOT}{refine} &
-\cross{ACPLOT}{xRange} &
-\cross{ACPLOT}{yRange} 
-\end{tabular}
+  makeGeneralSketch(pol,x,y,xMin,xMax,yMin,yMax) ==
+    --!! corners of region should not be on curve
+    --!! enlarge region if necessary
+    factoredPol := pol :: (Factored Polynomial Integer)
+    numberOfFactors(factoredPol) > 1 =>
+        error "reducible polynomial"  --!! sketch each factor
+    p := nthFactor(factoredPol,1)
+    dpdx := differentiate(p,x); dpdy := differentiate(p,y)
+    xMinNF := RNtoNF xMin; xMaxNF := RNtoNF xMax
+    yMinNF := RNtoNF yMin; yMaxNF := RNtoNF yMax
+    -- compute singular points; error if singularities in region
+    singPts := rsolve([p,dpdx,dpdy],[x,y],EPSILON)
+--  ptsSuchThat?(singPts,inRect?(#1,xMinNF,xMaxNF,yMinNF,yMaxNF)) =>
+    foo : List Float -> Boolean := s +-> inRect?(s,xMinNF,xMaxNF,yMinNF,yMaxNF)
+    ptsSuchThat?(singPts,foo) =>
+      error "singular pts in region of sketch"
+    -- compute critical points
+    htanPts := rsolve([p,dpdx],[x,y],EPSILON)
+    vtanPts := rsolve([p,dpdy],[x,y],EPSILON)
+    critPts := append(htanPts,vtanPts)
+    -- if there are critical points on the boundary, then enlarge
+    -- the region, but be sure that the new region does not contain
+    -- any singular points
+    hInc : Fraction Integer := (1/20) * (xMax - xMin)
+    vInc : Fraction Integer := (1/20) * (yMax - yMin)
+--  if ptsSuchThat?(critPts,onVertSeg?(#1,yMinNF,yMaxNF,xMinNF)) then
+    foo : List Float -> Boolean := s +-> onVertSeg?(s,yMinNF,yMaxNF,xMinNF)
+    if ptsSuchThat?(critPts,foo) then
+      xMin := newX(critPts,singPts,yMinNF,yMaxNF,xMinNF,xMin,-hInc)
+      xMinNF := RNtoNF xMin
+--  if ptsSuchThat?(critPts,onVertSeg?(#1,yMinNF,yMaxNF,xMaxNF)) then
+    foo : List Float -> Boolean := s +-> onVertSeg?(s,yMinNF,yMaxNF,xMaxNF)
+    if ptsSuchThat?(critPts,foo) then
+      xMax := newX(critPts,singPts,yMinNF,yMaxNF,xMaxNF,xMax,hInc)
+      xMaxNF := RNtoNF xMax
+--  if ptsSuchThat?(critPts,onHorzSeg?(#1,xMinNF,xMaxNF,yMinNF)) then
+    foo : List Float -> Boolean := s +-> onHorzSeg?(s,xMinNF,xMaxNF,yMinNF)
+    if ptsSuchThat?(critPts,foo) then
+      yMin := newY(critPts,singPts,xMinNF,xMaxNF,yMinNF,yMin,-vInc)
+      yMinNF := RNtoNF yMin
+--  if ptsSuchThat?(critPts,onHorzSeg?(#1,xMinNF,xMaxNF,yMaxNF)) then
+    foo : List Float -> Boolean := s +-> onHorzSeg?(s,xMinNF,xMaxNF,yMaxNF)
+    if ptsSuchThat?(critPts,foo) then
+      yMax := newY(critPts,singPts,xMinNF,xMaxNF,yMaxNF,yMax,vInc)
+      yMaxNF := RNtoNF yMax
+    htans := listPtsInRect(htanPts,xMinNF,xMaxNF,yMinNF,yMaxNF)
+    vtans := listPtsInRect(vtanPts,xMinNF,xMaxNF,yMinNF,yMaxNF)
+    crits := append(htans,vtans)
+    -- conversions to DoubleFloats
+    xMinSF := RNtoSF xMin; xMaxSF := RNtoSF xMax
+    yMinSF := RNtoSF yMin; yMaxSF := RNtoSF yMax
+    corners := makeCorners(xMinSF,xMaxSF,yMinSF,yMaxSF)
+    pSF := coerceCoefsToSFs p
+    dpdxSF := coerceCoefsToSFs dpdx
+    dpdySF := coerceCoefsToSFs dpdy
+    delta := min((xMaxSF - xMinSF)/25,(yMaxSF - yMinSF)/25)
+    err := min(delta/100,PLOTERR/100)
+    bound : PositiveInteger := 10
+    -- compute points on the boundary
+    pRN := coerceCoefsToRNs(p)
+    lf : List Point DoubleFloat := 
+      listPtsOnVertBdry(pRN,x,xMin,yMinNF,yMaxNF)
+    rt : List Point DoubleFloat := 
+      listPtsOnVertBdry(pRN,x,xMax,yMinNF,yMaxNF)
+    bt : List Point DoubleFloat := 
+      listPtsOnHorizBdry(pRN,y,yMin,xMinNF,xMaxNF)
+    tp : List Point DoubleFloat := 
+      listPtsOnHorizBdry(pRN,y,yMax,xMinNF,xMaxNF)
+    bdPts : BoundaryPts := [lf,rt,bt,tp]
+    bran := traceBranches(pSF,dpdxSF,dpdySF,x,y,corners,delta,err,_
+                           bound,crits,bdPts)
+    [p,x,y,xMin,xMax,yMin,yMax,bdPts,htans,vtans,bran]
 
-\begin{chunk}{domain ACPLOT PlaneAlgebraicCurvePlot}
-)abbrev domain ACPLOT PlaneAlgebraicCurvePlot
-++ Author: Clifton J. Williamson and Timothy Daly
-++ Date Created: Fall 1988
-++ Date Last Updated: 27 April 1990
-++ Description:
-++ Plot a NON-SINGULAR plane algebraic curve p(x,y) = 0.
+  refine(plot,stepFraction) ==
+    p := plot.poly; x := plot.xVar; y := plot.yVar
+    dpdx := differentiate(p,x); dpdy := differentiate(p,y)
+    pSF := coerceCoefsToSFs p
+    dpdxSF := coerceCoefsToSFs dpdx
+    dpdySF := coerceCoefsToSFs dpdy
+    xMin := plot.minXVal; xMax := plot.maxXVal
+    yMin := plot.minYVal; yMax := plot.maxYVal
+    xMinSF := RNtoSF xMin; xMaxSF := RNtoSF xMax
+    yMinSF := RNtoSF yMin; yMaxSF := RNtoSF yMax
+    corners := makeCorners(xMinSF,xMaxSF,yMinSF,yMaxSF)
+    pSF := coerceCoefsToSFs p
+    dpdxSF := coerceCoefsToSFs dpdx
+    dpdySF := coerceCoefsToSFs dpdy
+    delta :=
+      stepFraction * min((xMaxSF - xMinSF)/25,(yMaxSF - yMinSF)/25)
+    err := min(delta/100,PLOTERR/100)
+    bound : PositiveInteger := 10
+    crits := append(plot.hTanPts,plot.vTanPts)
+    bdPts := plot.bdryPts
+    bran := traceBranches(pSF,dpdxSF,dpdySF,x,y,corners,delta,err,_
+                           bound,crits,bdPts)
+    htans := plot.hTanPts; vtans := plot.vTanPts
+    [p,x,y,xMin,xMax,yMin,yMax,bdPts,htans,vtans,bran]
 
-PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _
- with
+  traceBranches(pSF,dpdxSF,dpdySF,x,y,corners,delta,err,bound,_
+                    crits,bdPts) ==
+    -- for boundary points, trace curve from boundary to boundary
+    -- add the branch to the list of branches
+    -- update list of boundary points by deleting first and last
+    -- points on this branch
+    -- update list of critical points by deleting any critical
+    -- points which were plotted
+    lf := bdPts.left; rt := bdPts.right
+    tp := bdPts.top ; bt := bdPts.bottom
+    bdry := append(append(lf,rt),append(bt,tp))
+    bran : List List Point DoubleFloat := nil()
+    while not null bdry repeat
+      pt := first bdry
+      p0 := dummyFirstPt(pt,dpdxSF,dpdySF,x,y,lf,rt,bt,tp)
+      segInfo := listPtsOnSegment(pSF,dpdxSF,dpdySF,x,y,p0,pt,_
+                       corners,delta,err,bound,crits,bdry)
+      bran  := cons(first segInfo,bran)
+      crits := second segInfo
+      bdry  := third segInfo
+    -- trace loops beginning and ending with critical points
+    -- add the branch to the list of branches
+    -- update list of critical points by deleting any critical
+    -- points which were plotted
+    while not null crits repeat
+      pt := first crits
+      segInfo := listPtsOnLoop(pSF,dpdxSF,dpdySF,x,y,pt,_
+                       corners,delta,err,bound,crits,bdry)
+      bran  := cons(first segInfo,bran)
+      crits := second segInfo
+    bran
 
-  makeSketch:(Polynomial Integer,Symbol,Symbol,Segment Fraction Integer,_
-               Segment Fraction Integer) -> %
-     ++ makeSketch(p,x,y,a..b,c..d) creates an ACPLOT of the
-     ++ curve \spad{p = 0} in the region a <= x <= b, c <= y <= d.
-     ++ More specifically, 'makeSketch' plots a non-singular algebraic curve
-     ++ \spad{p = 0} in an rectangular region xMin <= x <= xMax,
-     ++ yMin <= y <= yMax. The user inputs
-     ++ \spad{makeSketch(p,x,y,xMin..xMax,yMin..yMax)}.
-     ++ Here p is a polynomial in the variables x and y with
-     ++ integer coefficients (p belongs to the domain
-     ++ \spad{Polynomial Integer}). The case
-     ++ where p is a polynomial in only one of the variables is
-     ++ allowed.  The variables x and y are input to specify the
-     ++ the coordinate axes.  The horizontal axis is the x-axis and
-     ++ the vertical axis is the y-axis.  The rational numbers
-     ++ xMin,...,yMax specify the boundaries of the region in
-     ++ which the curve is to be plotted.
-     ++
-     ++X makeSketch(x+y,x,y,-1/2..1/2,-1/2..1/2)$ACPLOT
+  dummyFirstPt(p1,dpdxSF,dpdySF,x,y,lf,rt,bt,tp) ==
+  -- The function 'computeNextPt' requires 2 points, p0 and p1.
+  -- When computing the second point on a branch which starts
+  -- on the boundary, we use the boundary point as p1 and the
+  -- 'dummy' point returned by this function as p0.
+    x1 := xCoord p1; y1 := yCoord p1
+    zero := 0$DoubleFloat; one := 1$DoubleFloat
+    px := ground(eval(dpdxSF,[x,y],[x1,y1]))
+    py := ground(eval(dpdySF,[x,y],[x1,y1]))
+    if px * py < zero then       -- positive slope at p1
+      member?(p1,lf) or member?(p1,bt) =>
+        makePt(x1 - one,y1 - one)
+      makePt(x1 + one,y1 + one)
+    else
+      member?(p1,lf) or member?(p1,tp) =>
+        makePt(x1 - one,y1 + one)
+      makePt(x1 + one,y1 - one)
 
-  refine:(%,DoubleFloat) -> %
-     ++ refine(p,x) is not documented
-     ++
-     ++X sketch:=makeSketch(x+y,x,y,-1/2..1/2,-1/2..1/2)$ACPLOT
-     ++X refined:=refine(sketch,0.1)
 
- == add
+  listPtsOnSegment(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_
+                                 delta,err,bound,crits,bdry) ==
+  -- p1 is a boundary point; p0 is a 'dummy' point
+    bdry := remove(p1,bdry)
+    pointList : List Point DoubleFloat := [p1]
+    ptInfo := computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_
+                                 delta,err,bound,crits,bdry)
+    p2 := ptInfo.newPt
+    ptInfo.type = BDRY =>
+      bdry := remove(p2,bdry)
+      pointList := cons(p2,pointList)
+      [pointList,crits,bdry]
+    if ptInfo.type = CRIT then crits := remove(p2,crits)
+    pointList := cons(p2,pointList)
+    repeat
+      pt0 := second pointList; pt1 := first pointList
+      ptInfo := computeNextPt(pSF,dpdxSF,dpdySF,x,y,pt0,pt1,corners,_
+                                   delta,err,bound,crits,bdry)
+      p2 := ptInfo.newPt
+      ptInfo.type = BDRY =>
+        bdry := remove(p2,bdry)
+        pointList := cons(p2,pointList)
+        return [pointList,crits,bdry]
+      if ptInfo.type = CRIT then crits := remove(p2,crits)
+      pointList := cons(p2,pointList)
+    --!! delete next line (compiler bug)
+    [pointList,crits,bdry]
+
+
+  listPtsOnLoop(pSF,dpdxSF,dpdySF,x,y,p1,corners,_
+                                 delta,err,bound,crits,bdry) ==
+    x1 := xCoord p1; y1 := yCoord p1
+    px := ground(eval(dpdxSF,[x,y],[x1,y1]))
+    py := ground(eval(dpdySF,[x,y],[x1,y1]))
+    p0 := makePt(x1 - 1$DoubleFloat,y1 - 1$DoubleFloat)
+    pointList : List Point DoubleFloat := [p1]
+    ptInfo := computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_
+                                 delta,err,bound,crits,bdry)
+    p2 := ptInfo.newPt
+    ptInfo.type = BDRY =>
+      error "boundary reached while on loop"
+    if ptInfo.type = CRIT then
+      p1 = p2 =>
+        error "first and second points on loop are identical"
+      crits := remove(p2,crits)
+    pointList := cons(p2,pointList)
+    repeat
+      pt0 := second pointList; pt1 := first pointList
+      ptInfo := computeNextPt(pSF,dpdxSF,dpdySF,x,y,pt0,pt1,corners,_
+                                   delta,err,bound,crits,bdry)
+      p2 := ptInfo.newPt
+      ptInfo.type = BDRY =>
+        error "boundary reached while on loop"
+      if ptInfo.type = CRIT then
+        crits := remove(p2,crits)
+        p1 = p2 =>
+          pointList := cons(p2,pointList)
+          return [pointList,crits,bdry]
+      pointList := cons(p2,pointList)
+    --!! delete next line (compiler bug)
+    [pointList,crits,bdry]
+
+  computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_
+                                 delta,err,bound,crits,bdry) ==
+  -- p0=(x0,y0) and p1=(x1,y1) are the last two points on the curve.
+  -- The function computes the next point on the curve.
+  -- The function determines if the next point is a critical point
+  -- or a boundary point.
+  -- The function returns a record of the form
+  -- Record(newPt:Point DoubleFloat,type:String).
+  -- If the new point is a boundary point, then 'type' is
+  -- "boundary point" and 'newPt' is a boundary point to be
+  -- deleted from the list of boundary points yet to be plotted.
+  -- Similarly, if the new point is a critical point, then 'type' is
+  -- "critical point" and 'newPt' is a critical point to be
+  -- deleted from the list of critical points yet to be plotted.
+  -- If the new point is neither a critical point nor a boundary
+  -- point, then 'type' is "nothing in particular".
+    xMinSF := getXMin corners; xMaxSF := getXMax corners
+    yMinSF := getYMin corners; yMaxSF := getYMax corners
+    x0 := xCoord p0; y0 := yCoord p0
+    x1 := xCoord p1; y1 := yCoord p1
+    px := ground(eval(dpdxSF,[x,y],[x1,y1]))
+    py := ground(eval(dpdySF,[x,y],[x1,y1]))
+    -- let m be the slope of the tangent line at p1
+    -- if |m| < 1, we will increment the x-coordinate by delta
+    -- (indicated by 'incVar = x'), find an approximate
+    -- y-coordinate using the tangent line, then find the actual
+    -- y-coordinate using a Newton iteration
+    if abs(py) > abs(px) then
+      incVar0 := incVar := x
+      deltaX := (if x1 > x0 then delta else -delta)
+      x2Approx := x1 + deltaX
+      y2Approx := y1 + (-px/py)*deltaX
+    -- if |m| >= 1, we interchange the roles of the x- and y-
+    -- coordinates
+    else
+      incVar0 := incVar := y
+      deltaY := (if y1 > y0 then delta else -delta)
+      x2Approx := x1 + (-py/px)*deltaY
+      y2Approx := y1 + deltaY
+    lookingFor := NADA
+    -- See if (x2Approx,y2Approx) is out of bounds.
+    -- If so, find where the line segment connecting (x1,y1) and
+    -- (x2Approx,y2Approx) intersects the boundary and use this
+    -- point as (x2Approx,y2Approx).
+    -- If the resulting point is on the left or right boundary,
+    -- we will now consider x as the 'incremented variable' and we
+    -- will compute the y-coordinate using a Newton iteration.
+    -- Similarly, if the point is on the top or bottom boundary,
+    -- we will consider y as the 'incremented variable' and we
+    -- will compute the x-coordinate using a Newton iteration.
+    if x2Approx >= xMaxSF then
+      incVar := x
+      lookingFor := BDRY
+      x2Approx := xMaxSF
+      y2Approx := y1 + (-px/py)*(x2Approx - x1)
+    else
+      if x2Approx <= xMinSF then
+        incVar := x
+        lookingFor := BDRY
+        x2Approx := xMinSF
+        y2Approx := y1 + (-px/py)*(x2Approx - x1)
+    if y2Approx >= yMaxSF then
+      incVar := y
+      lookingFor := BDRY
+      y2Approx := yMaxSF
+      x2Approx := x1 + (-py/px)*(y2Approx - y1)
+    else
+      if y2Approx <= yMinSF then
+        incVar := y
+        lookingFor := BDRY
+        y2Approx := yMinSF
+        x2Approx := x1 + (-py/px)*(y2Approx - y1)
+    -- set xLo = min(x1,x2Approx), xHi = max(x1,x2Approx)
+    -- set yLo = min(y1,y2Approx), yHi = max(y1,y2Approx)
+    if x1 < x2Approx then
+      xLo := x1
+      xHi := x2Approx
+    else
+      xLo := x2Approx
+      xHi := x1
+    if y1 < y2Approx then
+      yLo := y1
+      yHi := y2Approx
+    else
+      yLo := y2Approx
+      yHi := y1
+    -- check for critical points (x*,y*) with x* between
+    -- x1 and x2Approx or y* between y1 and y2Approx
+    -- store values of x2Approx and y2Approx
+    x2Approxx := x2Approx
+    y2Approxx := y2Approx
+    -- xPointList will contain all critical points (x*,y*)
+    -- with x* between x1 and x2Approx
+    xPointList : List Point DoubleFloat := nil()
+    -- yPointList will contain all critical points (x*,y*)
+    -- with y* between y1 and y2Approx
+    yPointList : List Point DoubleFloat := nil()
+    for pt in crits repeat
+      xx := xCoord pt; yy := yCoord pt
+      -- if x1 = x2Approx, then p1 is a point with horizontal
+      -- tangent line
+      -- in this case, we don't want critical points with
+      -- x-coordinate x1
+      if xx = x2Approx and not (xx = x1) then
+        if min(abs(yy-yLo),abs(yy-yHi)) < delta then
+          xPointList := cons(pt,xPointList)
+      if ((xLo < xx) and (xx < xHi)) then
+        if min(abs(yy-yLo),abs(yy-yHi)) < delta then
+          xPointList := cons(pt,nil())
+          x2Approx := xx
+          if xx < x1 then xLo := xx else xHi := xx
+      -- if y1 = y2Approx, then p1 is a point with vertical
+      -- tangent line
+      -- in this case, we don't want critical points with
+      -- y-coordinate y1
+      if yy = y2Approx and not (yy = y1) then
+          yPointList := cons(pt,yPointList)
+      if ((yLo < yy) and (yy < yHi)) then
+        if min(abs(xx-xLo),abs(xx-xHi)) < delta then
+          yPointList := cons(pt,nil())
+          y2Approx := yy
+          if yy < y1 then yLo := yy else yHi := yy
+    -- points in both xPointList and yPointList
+    if (not null xPointList) and (not null yPointList) then
+      xPointList = yPointList =>
+      -- this implies that the lists have only one point
+        incVar := incVar0
+        if incVar = x then
+          y2Approx := y1 + (-px/py)*(x2Approx - x1)
+        else
+          x2Approx := x1 + (-py/px)*(y2Approx - y1)
+        lookingFor := CRIT        -- proceed
+      incVar0 = x =>
+      -- first try Newton iteration with 'y' as incremented variable
+        x2Temp := x1 + (-py/px)*(y2Approx - y1)
+        f := SFPolyToUPoly(eval(pSF,y,y2Approx))
+        x2New := newtonApprox(f,x2Temp,err,bound)
+        x2New case "failed" =>
+          y2Approx := y1 + (-px/py)*(x2Approx - x1)
+          incVar := x
+          lookingFor := CRIT      -- proceed
+        y2Temp := y1 + (-px/py)*(x2Approx - x1)
+        f := SFPolyToUPoly(eval(pSF,x,x2Approx))
+        y2New := newtonApprox(f,y2Temp,err,bound)
+        y2New case "failed" =>
+          return computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_
+                        abs((x2Approx-x1)/2),err,bound,crits,bdry)
+        pt1 := makePt(x2Approx,y2New :: DoubleFloat)
+        pt2 := makePt(x2New :: DoubleFloat,y2Approx)
+        critPt1 := findPtOnList(pt1,crits)
+        critPt2 := findPtOnList(pt2,crits)
+        (critPt1 case "failed") and (critPt2 case "failed") =>
+          abs(x2Approx - x1) > abs(x2Temp - x1) =>
+            return [pt1,NADA]
+          return [pt2,NADA]
+        (critPt1 case "failed") =>
+          return [critPt2::(Point DoubleFloat),CRIT]
+        (critPt2 case "failed") =>
+          return [critPt1::(Point DoubleFloat),CRIT]
+        abs(x2Approx - x1) > abs(x2Temp - x1) =>
+          return [critPt2::(Point DoubleFloat),CRIT]
+        return [critPt1::(Point DoubleFloat),CRIT]
+      y2Temp := y1 + (-px/py)*(x2Approx - x1)
+      f := SFPolyToUPoly(eval(pSF,x,x2Approx))
+      y2New := newtonApprox(f,y2Temp,err,bound)
+      y2New case "failed" =>
+        x2Approx := x1 + (-py/px)*(y2Approx - y1)
+        incVar := y
+        lookingFor := CRIT      -- proceed
+      x2Temp := x1 + (-py/px)*(y2Approx - y1)
+      f := SFPolyToUPoly(eval(pSF,y,y2Approx))
+      x2New := newtonApprox(f,x2Temp,err,bound)
+      x2New case "failed" =>
+        return computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_
+                      abs((y2Approx-y1)/2),err,bound,crits,bdry)
+      pt1 := makePt(x2Approx,y2New :: DoubleFloat)
+      pt2 := makePt(x2New :: DoubleFloat,y2Approx)
+      critPt1 := findPtOnList(pt1,crits)
+      critPt2 := findPtOnList(pt2,crits)
+      (critPt1 case "failed") and (critPt2 case "failed") =>
+        abs(y2Approx - y1) > abs(y2Temp - y1) =>
+          return [pt2,NADA]
+        return [pt1,NADA]
+      (critPt1 case "failed") =>
+        return [critPt2::(Point DoubleFloat),CRIT]
+      (critPt2 case "failed") =>
+        return [critPt1::(Point DoubleFloat),CRIT]
+      abs(y2Approx - y1) > abs(y2Temp - y1) =>
+        return [critPt1::(Point DoubleFloat),CRIT]
+      return [critPt2::(Point DoubleFloat),CRIT]
+    if (not null xPointList) and (null yPointList) then
+      y2Approx := y1 + (-px/py)*(x2Approx - x1)
+      incVar0 = x =>
+        incVar := x
+        lookingFor := CRIT        -- proceed
+      f := SFPolyToUPoly(eval(pSF,x,x2Approx))
+      y2New := newtonApprox(f,y2Approx,err,bound)
+      y2New case "failed" =>
+        x2Approx := x2Approxx
+        y2Approx := y2Approxx     -- proceed
+      pt := makePt(x2Approx,y2New::DoubleFloat)
+      critPt := findPtOnList(pt,crits)
+      critPt case "failed" =>
+        return [pt,NADA]
+      return [critPt :: (Point DoubleFloat),CRIT]
+    if (null xPointList) and (not null yPointList) then
+      x2Approx := x1 + (-py/px)*(y2Approx - y1)
+      incVar0 = y =>
+        incVar := y
+        lookingFor := CRIT        -- proceed
+      f := SFPolyToUPoly(eval(pSF,y,y2Approx))
+      x2New := newtonApprox(f,x2Approx,err,bound)
+      x2New case "failed" =>
+        x2Approx := x2Approxx
+        y2Approx := y2Approxx     -- proceed
+      pt := makePt(x2New::DoubleFloat,y2Approx)
+      critPt := findPtOnList(pt,crits)
+      critPt case "failed" =>
+        return [pt,NADA]
+      return [critPt :: (Point DoubleFloat),CRIT]
+    if incVar = x then
+      x2 := x2Approx
+      f := SFPolyToUPoly(eval(pSF,x,x2))
+      y2New := newtonApprox(f,y2Approx,err,bound)
+      y2New case "failed" =>
+        return computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_
+                               abs((x2-x1)/2),err,bound,crits,bdry)
+      y2 := y2New :: DoubleFloat
+    else
+      y2 := y2Approx
+      f := SFPolyToUPoly(eval(pSF,y,y2))
+      x2New := newtonApprox(f,x2Approx,err,bound)
+      x2New case "failed" =>
+        return computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_
+                               abs((y2-y1)/2),err,bound,crits,bdry)
+      x2 := x2New :: DoubleFloat
+    pt := makePt(x2,y2)
+    --!! check that 'pt' is not out of bounds
+    -- check if you've gotten a critical or boundary point
+    lookingFor = NADA =>
+      [pt,lookingFor]
+    lookingFor = BDRY =>
+      bdryPt := findPtOnList(pt,bdry)
+      bdryPt case "failed" =>
+        error "couldn't find boundary point"
+      [bdryPt :: (Point DoubleFloat),BDRY]
+    critPt := findPtOnList(pt,crits)
+    critPt case "failed" =>
+      [pt,NADA]
+    [critPt :: (Point DoubleFloat),CRIT]
+
+--% Newton iterations
+
+  newtonApprox(f,a0,err,bound) ==
+  -- Newton iteration to approximate a root of the polynomial 'f'
+  -- using an initial approximation of 'a0'
+  -- Newton iteration terminates when consecutive approximations
+  -- are within 'err' of each other
+  -- returns "failed" if this has not been achieved after 'bound'
+  -- iterations
+    Df := differentiate f
+    oldApprox := a0
+    newApprox := a0 - elt(f,a0)/elt(Df,a0)
+    i : PositiveInteger := 1
+    while abs(newApprox - oldApprox) > err repeat
+      i = bound => return "failed"
+      oldApprox := newApprox
+      newApprox := oldApprox - elt(f,oldApprox)/elt(Df,oldApprox)
+      i := i+1
+    newApprox
+
+--% graphics output
+
+  listBranches(acplot) == acplot.branches
+
+--% terminal output
+
+  coerce(acplot:%) ==
+    pp := acplot.poly :: OutputForm
+    xx := acplot.xVar :: OutputForm
+    yy := acplot.yVar :: OutputForm
+    xLo := acplot.minXVal :: OutputForm
+    xHi := acplot.maxXVal :: OutputForm
+    yLo := acplot.minYVal :: OutputForm
+    yHi := acplot.maxYVal :: OutputForm
+    zip := message(" = 0")
+    com := message(",   ")
+    les := message(" <= ")
+    l : List OutputForm :=
+      [pp,zip,com,xLo,les,xx,les,xHi,com,yLo,les,yy,les,yHi]
+    f : List OutputForm := nil()
+    for branch in acplot.branches repeat
+      ll : List OutputForm := [p :: OutputForm for p in branch]
+      f := cons(vconcat ll,f)
+    ff := vconcat(hconcat l,vconcat f)
+    vconcat(message "ACPLOT",ff)
+
+\end{chunk}
+
+\begin{chunk}{COQ ACPLOT}
+(* domain ACPLOT *)
+(*
 
   import PointPackage DoubleFloat
   import Plot
@@ -118750,15 +144398,15 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _
     else
       yLo := y2Approx
       yHi := y1
-    -- check for critical points (x*,y*) with x* between
+    -- check for critical points (x*,y* ) with x* between
     -- x1 and x2Approx or y* between y1 and y2Approx
     -- store values of x2Approx and y2Approx
     x2Approxx := x2Approx
     y2Approxx := y2Approx
-    -- xPointList will contain all critical points (x*,y*)
+    -- xPointList will contain all critical points (x*,y* )
     -- with x* between x1 and x2Approx
     xPointList : List Point DoubleFloat := nil()
-    -- yPointList will contain all critical points (x*,y*)
+    -- yPointList will contain all critical points (x*,y* )
     -- with y* between y1 and y2Approx
     yPointList : List Point DoubleFloat := nil()
     for pt in crits repeat
@@ -118961,11 +144609,6 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _
     ff := vconcat(hconcat l,vconcat f)
     vconcat(message "ACPLOT",ff)
 
-\end{chunk}
-
-\begin{chunk}{COQ ACPLOT}
-(* domain ACPLOT *)
-(*
 *)
 
 \end{chunk}
@@ -119395,12 +145038,121 @@ Plcs(K:Field,PCS:LocalPowerSeriesCategory(K)):Exports == Implementation where
 
     degree(pl)==pl.deg
 
-
 \end{chunk}
 
 \begin{chunk}{COQ PLCS}
 (* domain PLCS *)
 (*
+
+    Rep:= rec
+
+    setOfPlacesName:Symbol:=new(ActualSetOfPlacesName)$Symbol
+
+    a:% + b:% == (a:: Divisor(%)) +$Divisor(%) (b::Divisor(%))
+
+    a:% - b:% == (a:: Divisor(%)) -$Divisor(%) (b::Divisor(%))
+
+    n:Integer * b:% == n *$Divisor(%) (b :: Divisor(%))
+
+    reduce(lp)==
+      lpd:List Divisor(%):= [p :: Divisor(%) for p in lp]
+      reduce("+", lpd, 0$Divisor(%))
+
+    d:Divisor(%) + b:% == d + (b::Divisor(%))
+
+    a:% + d:Divisor(%) == (a::Divisor(%)) + d
+
+    d:Divisor(%) - b:% == d - (b::Divisor(%))
+
+    a:% - d:Divisor(%) == (a::Divisor(%)) - d
+
+    -a:% == - ( a::Divisor(%))
+    
+    outName: nameOfPlace -> OutputForm
+
+    outName(pt)==
+      pt case Symbol => 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
+      bracket(out)
+      
+    coerce(pt:%):OutputForm == 
+      nn:OutputForm:= outName(pt.theName)
+      ee:OutputForm:= degree(pt) :: OutputForm
+      nn ** ee
+
+    a:% = b:% == 
+      ^(a.actualSet =$Symbol b.actualSet) => 
+        a:String:=
+         "From Places Domain: Cannot use old places with new places."
+          " You have declared two different package PAFF or PAFFFF with the "
+           "same arguments. This is not allowed because in that case the two "
+            "packages used the same domain to represent the set of places. "
+             "Two packages having the same arguments should be used in "
+              "different frame"
+        error a
+      a.inName =$Symbol b.inName
+
+    elt(pl,n)== 
+      pt:= (pl :: Rep).theName
+      pt case Symbol => _
+        error "From Places domain : cannot return the coordinates of a leaf"
+      elt(pt,n)$List(K)
+
+    leaf?(pl)==pl.isALeaf
+    
+    itsALeaf_!(pl)==
+      pl.isALeaf := true()
+      void()
+
+    listOfFoundPlaces:List %:=[]
+
+    foundPlaces()==listOfFoundPlaces
+    
+    setFoundPlacesToEmpty()==
+      tmp:=copy listOfFoundPlaces
+      listOfFoundPlaces:=[]
+      setOfPlacesName:Symbol:=new(ActualSetOfPlacesName)$Symbol
+      tmp
+
+    findInExistOnes: % -> %
+    findInExistOnes(pt)==
+      ll:=listOfFoundPlaces
+      found:Boolean:=false()
+      fpl:%
+      while ^found and  ^empty?(ll) repeat
+        fpl:= first ll
+        -- remember: the "=" test is on done on the symbolic name
+        found:= pt.theName = fpl.theName
+        ll:=rest ll
+      ^found => 
+        listOfFoundPlaces:=cons(pt,listOfFoundPlaces)
+        pt
+      fpl
+      
+    create(pt:List(K)):%==
+      newName:=new(SIMPLE)$Symbol
+      newPt:%:=[pt,[],1,false(),newName,setOfPlacesName]$rec
+      findInExistOnes(newPt)
+
+    create(pt:Symbol):%==
+      newPt:%:=[pt,[],1,false(),pt,setOfPlacesName]$rec
+      findInExistOnes(newPt)
+
+    setDegree_!(pt,d)==
+      pt.deg := d
+      void()
+
+    setParam_!(pt,ls)==
+      pt.locPar:=ls
+      void()
+
+    localParam(pt)==pt.locPar
+
+    degree(pl)==pl.deg
+
 *)
 
 \end{chunk}
@@ -119702,6 +145454,7 @@ Plot(): Exports == Implementation where
       ++ \spad{debug(false)} turns debug mode off
 
   Implementation ==> add
+
     import PointPackage(DoubleFloat)
 
 --% local functions
@@ -119742,6 +145495,7 @@ Plot(): Exports == Implementation where
     DEBUG: B := false
 
     Fnan?(x) == x ~= x
+
     Pnan?(x) == any?(Fnan?,x)
 
 --% graphics output
@@ -119757,12 +145511,14 @@ Plot(): Exports == Implementation where
                 outList := concat(newl:=reverse! newl,outList)
                 newl:=nil()
         if not empty? newl then outList := concat(newl:=reverse! newl,outList)
---      print(outList::OutputForm)
       outList
 
     checkRange r == (lo r > hi r => error "ranges cannot be negative"; r)
+
     intersect(s,t) == checkRange (max(lo s,lo t) .. min(hi s,hi t))
+
     union(s,t) == min(lo s,lo t) .. max(hi s,hi t)
+
     join(l,i) ==
       rr := first l
       u : R :=
@@ -119777,28 +145533,39 @@ Plot(): Exports == Implementation where
     parametricRange r == first(r.bounds)
 
     minPoints() == MINPOINTS
+
     setMinPoints n ==
       if n < 3 then error "three points minimum required"
       if MAXPOINTS < n then MAXPOINTS := n
       MINPOINTS := n
+
     maxPoints() == MAXPOINTS
+
     setMaxPoints n ==
       if n < 3 then error "three points minimum required"
       if MINPOINTS > n then MINPOINTS := n
       MAXPOINTS := n
+
     screenResolution() == SCREENRES
+
     setScreenResolution n ==
       if n < 2 then error "buy a new terminal"
       SCREENRES := n
+
     adaptive?() == ADAPTIVE
+
     setAdaptive b == ADAPTIVE := b
+
     parametric? p == p.parametric
 
     numFunEvals() == NUMFUNEVALS
+
     debug b == DEBUG := b
 
     xRange plot == second plot.bounds
+
     yRange plot == third plot.bounds
+
     tRange plot == first plot.bounds
 
     select(l,f,g) ==
@@ -119850,7 +145617,6 @@ Plot(): Exports == Implementation where
       xDiff = 0 or yDiff = 0 => curve
       l := lo tRange; h := hi tRange
       (tDiff := h-l) = 0 => curve
---      if (EQL(yDiff, _$NaNvalue$Lisp)$Lisp) then yDiff := 1::F
       t := curve.knots
       #t < 3 => curve
       p := curve.points; f := curve.source
@@ -119860,17 +145626,6 @@ Plot(): Exports == Implementation where
       while not null t and first t < l repeat (t := rest t; p := rest p)
       #t < 3 => curve
       headert := t; headerp := p
-
-      -- jitter the input points
---      while not null rest rest t repeat
---        t0 := second(t); t1 := third(t)
---        jitter := (random()$I) :: F
---        jitter := sin (jitter)
---        val := t0 + jitter * (t1-t0)/10::F
---        t.2 := val; p.2 := f val
---        t := rest t; p := rest p
---      t := headert; p := headerp
-
       st := t; sp := p
       todot : L L F := nil()
       todop : L L P := nil()
@@ -119974,7 +145729,6 @@ Plot(): Exports == Implementation where
         p := concat(f l,p)
       t := reverse_! concat(h,t)
       p := reverse_! concat(f h,p)
---      print(p::OutputForm)
       xRange : R := select(p,xCoord,min) .. select(p,xCoord,max)
       yRange : R := select(p,yCoord,min) .. select(p,yCoord,max)
       [ f, [tRange,xRange,yRange], t, p ]
@@ -119982,6 +145736,7 @@ Plot(): Exports == Implementation where
     zoom(p,xRange) ==
       [p.parametric, [xRange,third(p.display)], p.bounds, _
        p.axisLabels, p.functions]
+
     zoom(p,xRange,yRange) ==
       [p.parametric, [xRange,yRange], p.bounds, _
        p.axisLabels, p.functions]
@@ -119998,7 +145753,6 @@ Plot(): Exports == Implementation where
         second(t) < l => (t := rest t; p := rest p)
         -- insert new point between t.0 and t.1
         tm : F := (first(t) + second(t))/2::F
---         if DEBUG then output$O (tm::E)
         pm := f tm
         NUMFUNEVALS := NUMFUNEVALS + 1
         t.rest := concat(tm,rest t); t := rest rest t
@@ -120009,6 +145763,7 @@ Plot(): Exports == Implementation where
       [ curve.source, [tRange,xRange,yRange], t, p ]
 
     refine p == refine(p,parametricRange p)
+
     refine(p,nRange) ==
       NUMFUNEVALS := 0
       tRange := parametricRange p
@@ -120020,7 +145775,6 @@ Plot(): Exports == Implementation where
         curves := [adaptivePlot(c,nRange,xRange,yRange, _
                    tlimit) for c in curves]
         xRange := join(curves,1); yRange := join(curves,2)
---      print(NUMFUNEVALS::OUT)
       [p.parametric, p.display, [tRange,xRange,yRange], _
        p.axisLabels, curves ]
 
@@ -120034,7 +145788,6 @@ Plot(): Exports == Implementation where
         tlimit := if parametric? p then 8 else 1
         curves := [adaptivePlot(c,tRange,xRange,yRange,tlimit) for c in curves]
         xRange := join(curves,1); yRange := join(curves,2)
---      print(NUMFUNEVALS::OUT)
       [ p.parametric, [xRange,yRange], [tRange,xRange,yRange],
         p.axisLabels, curves ]
 
@@ -120100,7 +145853,6 @@ Plot(): Exports == Implementation where
         t := [adaptivePlot(p,xRange,xRange,yRange,1) _
                 for f in l for p in t]
         yRange := join(t,2)
---      print(NUMFUNEVALS::OUT)
       [false, [xRange,yRange], [xRange,xRange,yRange], nil(), t ]
 
     plot(l:L(F -> F),xRange:R,yRange:R) ==
@@ -120140,6 +145892,439 @@ Plot(): Exports == Implementation where
 \begin{chunk}{COQ PLOT}
 (* domain PLOT *)
 (*
+
+    import PointPackage(DoubleFloat)
+
+--% local functions
+
+    checkRange     : R -> R
+      -- checks that left-hand endpoint is less than right-hand endpoint
+    intersect      : (R,R) -> R
+      -- intersection of two intervals
+    union          : (R,R) -> R
+      -- union of two intervals
+    join           : (L C,I) -> R
+    parametricRange: % -> R
+    select         : (L P,P -> F,(F,F) -> F) -> F
+    rangeRefine    : (C,R) -> C
+    adaptivePlot   : (C,R,R,R,I) -> C
+    basicPlot      : (F -> P,R) -> C
+    basicRefine    : (C,R) -> C
+    pt             : (F,F) -> P
+    Fnan?           : F -> Boolean
+    Pnan?           : P -> Boolean
+
+--% representation
+
+    Rep := Record( parametric: B, _
+                   display: L R, _
+                   bounds: L R, _
+                   axisLabels: L S, _
+                   functions: L C )
+
+--% global constants
+
+    ADAPTIVE: B := true
+    MINPOINTS: I := 49
+    MAXPOINTS: I := 1000
+    NUMFUNEVALS: I := 0
+    SCREENRES: I := 500
+    ANGLEBOUND: F := cos inv (4::F)
+    DEBUG: B := false
+
+    Fnan?(x) == x ~= x
+
+    Pnan?(x) == any?(Fnan?,x)
+
+--% graphics output
+
+    listBranches plot ==
+      outList : L L P := nil()
+      for curve in plot.functions repeat
+        -- curve is C
+        newl:L P:=nil()
+        for p in curve.points repeat
+          if not Pnan? p then newl:=cons(p,newl)
+          else if not empty? newl then 
+                outList := concat(newl:=reverse! newl,outList)
+                newl:=nil()
+        if not empty? newl then outList := concat(newl:=reverse! newl,outList)
+      outList
+
+    checkRange r == (lo r > hi r => error "ranges cannot be negative"; r)
+
+    intersect(s,t) == checkRange (max(lo s,lo t) .. min(hi s,hi t))
+
+    union(s,t) == min(lo s,lo t) .. max(hi s,hi t)
+
+    join(l,i) ==
+      rr := first l
+      u : R :=
+        i = 0 => first(rr.ranges)
+        i = 1 => second(rr.ranges)
+        third(rr.ranges)
+      for r in rest l repeat
+        i = 0 => u := union(u,first(r.ranges))
+        i = 1 => u := union(u,second(r.ranges))
+        u := union(u,third(r.ranges))
+      u
+    parametricRange r == first(r.bounds)
+
+    minPoints() == MINPOINTS
+
+    setMinPoints n ==
+      if n < 3 then error "three points minimum required"
+      if MAXPOINTS < n then MAXPOINTS := n
+      MINPOINTS := n
+
+    maxPoints() == MAXPOINTS
+
+    setMaxPoints n ==
+      if n < 3 then error "three points minimum required"
+      if MINPOINTS > n then MINPOINTS := n
+      MAXPOINTS := n
+
+    screenResolution() == SCREENRES
+
+    setScreenResolution n ==
+      if n < 2 then error "buy a new terminal"
+      SCREENRES := n
+
+    adaptive?() == ADAPTIVE
+
+    setAdaptive b == ADAPTIVE := b
+
+    parametric? p == p.parametric
+
+    numFunEvals() == NUMFUNEVALS
+
+    debug b == DEBUG := b
+
+    xRange plot == second plot.bounds
+
+    yRange plot == third plot.bounds
+
+    tRange plot == first plot.bounds
+
+    select(l,f,g) ==
+      m := f first l
+      if Fnan? m then m := 0
+      for p in rest l repeat
+        n := m
+        m := g(m, f p)
+        if Fnan? m then m := n
+      m
+
+    rangeRefine(curve,nRange) ==
+      checkRange nRange; l := lo nRange; h := hi nRange
+      t := curve.knots; p := curve.points; f := curve.source
+      while not null t and first t < l repeat
+        (t := rest t; p := rest p)
+      c: L F := nil(); q: L P := nil()
+      while not null t and (first t) <= h repeat
+        c := concat(first t,c); q := concat(first p,q)
+        t := rest t; p := rest p
+      if null c then return basicPlot(f,nRange)
+      if first c < h then
+        c := concat(h,c)
+        q := concat(f h,q)
+        NUMFUNEVALS := NUMFUNEVALS + 1
+      t := c := reverse_! c; p := q := reverse_! q
+      s := (h-l)/(minPoints()::F-1)
+      if (first t) ^= l then
+        t := c := concat(l,c)
+        p := q := concat(f l,p)
+        NUMFUNEVALS := NUMFUNEVALS + 1
+      while not null rest t repeat
+        n := wholePart((second(t) - first(t))/s)
+        d := (second(t) - first(t))/((n+1)::F)
+        for i in 1..n repeat
+          t.rest := concat(first(t) + d,rest t)
+          p.rest := concat(f second t,rest p)
+          NUMFUNEVALS := NUMFUNEVALS + 1
+          t := rest t; p := rest p
+        t := rest t
+        p := rest p
+      xRange := select(q,xCoord,min) .. select(q,xCoord,max)
+      yRange := select(q,yCoord,min) .. select(q,yCoord,max)
+      [ f, [nRange,xRange,yRange], c, q]
+
+    adaptivePlot(curve,tRange,xRange,yRange,pixelfraction) ==
+      xDiff := hi xRange - lo xRange
+      yDiff := hi yRange - lo yRange
+      xDiff = 0 or yDiff = 0 => curve
+      l := lo tRange; h := hi tRange
+      (tDiff := h-l) = 0 => curve
+      t := curve.knots
+      #t < 3 => curve
+      p := curve.points; f := curve.source
+      minLength:F := 4::F/500::F
+      maxLength:F := 1::F/6::F
+      tLimit := tDiff/(pixelfraction*500)::F
+      while not null t and first t < l repeat (t := rest t; p := rest p)
+      #t < 3 => curve
+      headert := t; headerp := p
+      st := t; sp := p
+      todot : L L F := nil()
+      todop : L L P := nil()
+      while not null rest rest st repeat
+        todot := concat_!(todot, st)
+        todop := concat_!(todop, sp)
+        st := rest st; sp := rest sp
+      st := headert; sp := headerp
+      todo1 := todot; todo2 := todop
+      n : I := 0
+      while not null todo1 repeat
+        st := first(todo1)
+        t0 := first(st); t1 := second(st); t2 := third(st)
+        if t2 > h then leave
+        t2 - t0 < tLimit =>
+            todo1 := rest todo1
+            todo2 := rest todo2
+            if not null todo1 then (t := first(todo1); p := first(todo2))
+        sp := first(todo2)
+        x0 := xCoord first(sp); y0 := yCoord first(sp)
+        x1 := xCoord second(sp); y1 := yCoord second(sp)
+        x2 := xCoord third(sp); y2 := yCoord third(sp)
+        a1 := (x1-x0)/xDiff; b1 := (y1-y0)/yDiff
+        a2 := (x2-x1)/xDiff; b2 := (y2-y1)/yDiff
+        s1 := sqrt(a1**2+b1**2); s2 := sqrt(a2**2+b2**2)
+        dp := a1*a2+b1*b2
+
+        s1 < maxLength and s2 < maxLength and _
+          (s1 = 0::F or s2 = 0::F or
+             s1 < minLength and s2 < minLength or _
+             dp/s1/s2 > ANGLEBOUND) =>
+                todo1 := rest todo1
+                todo2 := rest todo2
+                if not null todo1 then (t := first(todo1); p := first(todo2))
+        if n > MAXPOINTS then leave else n := n + 1
+        st := rest t
+        if not null rest rest st then
+          tm := (t0+t1)/2::F
+          tj := tm
+          t.rest := concat(tj,rest t)
+          p.rest := concat(f tj, rest p)
+          todo1 := concat_!(todo1, t)
+          todo2 := concat_!(todo2, p)
+          t := rest t; p := rest p
+          todo1 := concat_!(todo1, t)
+          todo2 := concat_!(todo2, p)
+          t := rest t; p := rest p
+          todo1 := rest todo1; todo2 := rest todo2
+
+          tm := (t1+t2)/2::F
+          tj := tm
+          t.rest := concat(tj, rest t)
+          p.rest := concat(f tj, rest p)
+          todo1 := concat_!(todo1, t)
+          todo2 := concat_!(todo2, p)
+          t := rest t; p := rest p
+          todo1 := concat_!(todo1, t)
+          todo2 := concat_!(todo2, p)
+          todo1 := rest todo1
+          todo2 := rest todo2
+          if not null todo1 then (t := first(todo1); p := first(todo2))
+        else
+          tm := (t0+t1)/2::F
+          tj := tm
+          t.rest := concat(tj,rest t)
+          p.rest := concat(f tj, rest p)
+          todo1 := concat_!(todo1, t)
+          todo2 := concat_!(todo2, p)
+          t := rest t; p := rest p
+          todo1 := concat_!(todo1, t)
+          todo2 := concat_!(todo2, p)
+          t := rest t; p := rest p
+
+          tm := (t1+t2)/2::F
+          tj := tm
+          t.rest := concat(tj, rest t)
+          p.rest := concat(f tj, rest p)
+          todo1 := concat_!(todo1, t)
+          todo2 := concat_!(todo2, p)
+          todo1 := rest todo1
+          todo2 := rest todo2
+          if not null todo1 then (t := first(todo1); p := first(todo2))
+      n > 0 =>
+        NUMFUNEVALS := NUMFUNEVALS + n
+        t := curve.knots; p := curve.points
+        xRange := select(p,xCoord,min) .. select(p,xCoord,max)
+        yRange := select(p,yCoord,min) .. select(p,yCoord,max)
+        [ curve.source, [tRange,xRange,yRange], t, p ]
+      curve
+
+    basicPlot(f,tRange) ==
+      checkRange tRange
+      l := lo tRange
+      h := hi tRange
+      t : L F := list l
+      p : L P := list f l
+      s := (h-l)/(minPoints()-1)::F
+      for i in 2..minPoints()-1 repeat
+        l := l+s 
+        t := concat(l,t) 
+        p := concat(f l,p)
+      t := reverse_! concat(h,t)
+      p := reverse_! concat(f h,p)
+      xRange : R := select(p,xCoord,min) .. select(p,xCoord,max)
+      yRange : R := select(p,yCoord,min) .. select(p,yCoord,max)
+      [ f, [tRange,xRange,yRange], t, p ]
+
+    zoom(p,xRange) ==
+      [p.parametric, [xRange,third(p.display)], p.bounds, _
+       p.axisLabels, p.functions]
+
+    zoom(p,xRange,yRange) ==
+      [p.parametric, [xRange,yRange], p.bounds, _
+       p.axisLabels, p.functions]
+
+    basicRefine(curve,nRange) ==
+      tRange:R := first curve.ranges
+      -- curve := copy$C curve  -- Yet another compiler bug
+      curve: C := [curve.source,curve.ranges,curve.knots,curve.points]
+      t := curve.knots := copy curve.knots
+      p := curve.points := copy curve.points
+      l := lo nRange; h := hi nRange
+      f := curve.source
+      while not null rest t and first t < h repeat
+        second(t) < l => (t := rest t; p := rest p)
+        -- insert new point between t.0 and t.1
+        tm : F := (first(t) + second(t))/2::F
+        pm := f tm
+        NUMFUNEVALS := NUMFUNEVALS + 1
+        t.rest := concat(tm,rest t); t := rest rest t
+        p.rest := concat(pm,rest p); p := rest rest p
+      t := curve.knots; p := curve.points
+      xRange := select(p,xCoord,min) .. select(p,xCoord,max)
+      yRange := select(p,yCoord,min) .. select(p,yCoord,max)
+      [ curve.source, [tRange,xRange,yRange], t, p ]
+
+    refine p == refine(p,parametricRange p)
+
+    refine(p,nRange) ==
+      NUMFUNEVALS := 0
+      tRange := parametricRange p
+      nRange := intersect(tRange,nRange)
+      curves: L C := [basicRefine(c,nRange) for c in p.functions]
+      xRange := join(curves,1); yRange := join(curves,2)
+      if adaptive? then
+        tlimit := if parametric? p then 8 else 1
+        curves := [adaptivePlot(c,nRange,xRange,yRange, _
+                   tlimit) for c in curves]
+        xRange := join(curves,1); yRange := join(curves,2)
+      [p.parametric, p.display, [tRange,xRange,yRange], _
+       p.axisLabels, curves ]
+
+    plot(p:%,tRange:R) ==
+      -- re plot p on a new range making use of the points already
+      -- computed if possible
+      NUMFUNEVALS := 0
+      curves: L C := [rangeRefine(c,tRange) for c in p.functions]
+      xRange := join(curves,1); yRange := join(curves,2)
+      if adaptive? then
+        tlimit := if parametric? p then 8 else 1
+        curves := [adaptivePlot(c,tRange,xRange,yRange,tlimit) for c in curves]
+        xRange := join(curves,1); yRange := join(curves,2)
+      [ p.parametric, [xRange,yRange], [tRange,xRange,yRange],
+        p.axisLabels, curves ]
+
+    pt(xx,yy) == point(l : L F := [xx,yy])
+
+    myTrap: (F-> F, F) -> F
+    myTrap(ff:F-> F, f:F):F ==
+      s := trapNumericErrors(ff(f))$Lisp :: Union(F, "failed")
+      s case "failed" => _$NaNvalue$Lisp
+      r:F:=s::F
+      r > max()$F or r < min()$F => _$NaNvalue$Lisp
+      r
+
+    plot(f:F -> F,xRange:R) ==
+      p := basicPlot((u1:F):P +-> pt(u1,myTrap(f,u1)),xRange)
+      r := p.ranges
+      NUMFUNEVALS := minPoints()
+      if adaptive? then
+        p := adaptivePlot(p,first r,second r,third r,1)
+        r := p.ranges
+      [ false, rest r, r, nil(), [ p ] ]
+
+    plot(f:F -> F,xRange:R,yRange:R) ==
+      p := plot(f,xRange)
+      p.display := [xRange,checkRange yRange]
+      p
+
+    plot(f:F -> F,g:F -> F,tRange:R) ==
+      p := basicPlot((z1:F):P +-> pt(myTrap(f,z1),myTrap(g,z1)),tRange)
+      r := p.ranges
+      NUMFUNEVALS := minPoints()
+      if adaptive? then
+        p := adaptivePlot(p,first r,second r,third r,8)
+        r := p.ranges
+      [ true, rest r, r, nil(), [ p ] ]
+
+    plot(f:F -> F,g:F -> F,tRange:R,xRange:R,yRange:R) ==
+      p := plot(f,g,tRange)
+      p.display := [checkRange xRange,checkRange yRange]
+      p
+
+    pointPlot(f:F -> P,tRange:R) ==
+      p := basicPlot(f,tRange)
+      r := p.ranges
+      NUMFUNEVALS := minPoints()
+      if adaptive? then
+        p := adaptivePlot(p,first r,second r,third r,8)
+        r := p.ranges
+      [ true, rest r, r, nil(), [ p ] ]
+
+    pointPlot(f:F -> P,tRange:R,xRange:R,yRange:R) ==
+      p := pointPlot(f,tRange)
+      p.display := [checkRange xRange,checkRange yRange]
+      p
+
+    plot(l:L(F -> F),xRange:R) ==
+      if null l then error "empty list of functions"
+      t: L C := 
+        [ basicPlot((z1:F):P +-> pt(z1,myTrap(f,z1)),xRange) for f in l ]
+      yRange := join(t,2)
+      NUMFUNEVALS := # l * minPoints()
+      if adaptive? then
+        t := [adaptivePlot(p,xRange,xRange,yRange,1) _
+                for f in l for p in t]
+        yRange := join(t,2)
+      [false, [xRange,yRange], [xRange,xRange,yRange], nil(), t ]
+
+    plot(l:L(F -> F),xRange:R,yRange:R) ==
+      p := plot(l,xRange)
+      p.display := [xRange,checkRange yRange]
+      p
+
+    plotPolar(f,thetaRange) ==
+      plot((u1:F):F +-> f(u1) * cos(u1),
+           (v1:F):F +-> f(v1) * sin(v1),thetaRange)
+
+    plotPolar f == plotPolar(f,segment(0,2*pi()))
+
+--% terminal output
+
+    coerce r ==
+      spaces: OUT := coerce "   "
+      xSymbol := "x = " :: OUT
+      ySymbol := "y = " :: OUT
+      tSymbol := "t = " :: OUT
+      plotSymbol := "PLOT" :: OUT
+      tRange := (parametricRange r) :: OUT
+      f : L OUT := nil()
+      for curve in r.functions repeat
+        xRange := second(curve.ranges) :: OUT
+        yRange := third(curve.ranges) :: OUT
+        l : L OUT := [xSymbol,xRange,spaces,ySymbol,yRange]
+        if parametric? r then
+          l := concat_!([tSymbol,tRange,spaces],l)
+        h : OUT := hconcat l
+        l := [p::OUT for p in curve.points]
+        f := concat(vconcat concat(h,l),f)
+      prefix("PLOT" :: OUT, reverse_! f)
+
 *)
 
 \end{chunk}
@@ -120316,6 +146501,7 @@ Plot3D(): Exports == Implementation where
       ++ debug3D(false) turns debug mode off.
  
   Implementation ==> add
+
     import PointPackage(F)
  
 --% local functions
@@ -120361,8 +146547,11 @@ Plot3D(): Exports == Implementation where
     fourth list == first rest rest rest list
  
     checkRange r == (lo r > hi r => error "ranges cannot be negative"; r)
+
     intersect(s,t) == checkRange (max(lo s,lo t) .. min(hi s,hi t))
+
     union(s:R,t:R) == min(lo s,lo t) .. max(hi s,hi t)
+
     join(l,i) ==
       rr := first l
       u : R :=
@@ -120376,33 +146565,43 @@ Plot3D(): Exports == Implementation where
         i = 2 => union(u,third(r.ranges))
         union(u,fourth(r.ranges))
       u
+
     parametricRange r == first(r.bounds)
  
     minPoints3D() == MINPOINTS
+
     setMinPoints3D n ==
       if n < 3 then error "three points minimum required"
       if MAXPOINTS < n then MAXPOINTS := n
       MINPOINTS := n
+
     maxPoints3D() == MAXPOINTS
+
     setMaxPoints3D n ==
       if n < 3 then error "three points minimum required"
       if MINPOINTS > n then MINPOINTS := n
       MAXPOINTS := n
+
     screenResolution3D() == SCREENRES
+
     setScreenResolution3D n ==
       if n < 2 then error "buy a new terminal"
       SCREENRES := n
+
     adaptive3D?() == ADAPTIVE
+
     setAdaptive3D b == ADAPTIVE := b
  
     numFunEvals3D() == NUMFUNEVALS
+
     debug3D b == DEBUG := b
  
---     setColor(p,c) == p.colNum := c
- 
     xRange plot == second plot.bounds
+
     yRange plot == third plot.bounds
+
     zRange plot == fourth plot.bounds
+
     tRange plot == first plot.bounds
  
     tValues plot ==
@@ -120414,16 +146613,12 @@ Plot3D(): Exports == Implementation where
     select(l,f,g) ==
       m := f first l
       if (EQL(m, _$NaNvalue$Lisp)$Lisp) then m := 0
---      for p in rest l repeat m := g(m,fp)
       for p in rest l repeat
         fp : F := f p
         if (EQL(fp, _$NaNvalue$Lisp)$Lisp) then fp := 0
         m := g(m,fp)
       m
  
---     normalizeColor(p,lo,diff) ==
---       p.colNum := (p.colNum - lo)/diff
- 
     rangeRefine(curve,nRange) ==
       checkRange nRange; l := lo nRange; h := hi nRange
       t := curve.knots; p := curve.points; f := curve.source
@@ -120455,10 +146650,6 @@ Plot3D(): Exports == Implementation where
       xRange := select(q,xCoord,min) .. select(q,xCoord,max)
       yRange := select(q,yCoord,min) .. select(q,yCoord,max)
       zRange := select(q,zCoord,min) .. select(q,zCoord,max)
---       colorLo := select(q,color,min); colorHi := select(q,color,max)
---       (diff := colorHi - colorLo) = 0 =>
---         error "all points are the same color"
---       map(normalizeColor(#1,colorLo,diff),q)$ListPackage1(P)
       [f,[nRange,xRange,yRange,zRange],c,q]
  
 
@@ -120466,7 +146657,6 @@ Plot3D(): Exports == Implementation where
       xDiff := hi xRg - lo xRg
       yDiff := hi yRg - lo yRg
       zDiff := hi zRg - lo zRg
---      xDiff = 0 or yDiff = 0 or zDiff = 0 => curve--!! delete this?
       if xDiff = 0::F then xDiff := 1::F
       if yDiff = 0::F then yDiff := 1::F
       if zDiff = 0::F then zDiff := 1::F
@@ -120501,8 +146691,12 @@ Plot3D(): Exports == Implementation where
            todo2 := rest todo2;
            if not null todo1 then (t := first(todo1); p := first(todo2))
         sp := first(todo2)
-        x0 := xCoord first(sp); y0 := yCoord first(sp); z0 := zCoord first(sp) 
-        x1 := xCoord second(sp); y1 := yCoord second(sp); z1 := zCoord second(sp) 
+        x0 := xCoord first(sp); 
+        y0 := yCoord first(sp); 
+        z0 := zCoord first(sp) 
+        x1 := xCoord second(sp); 
+        y1 := yCoord second(sp); 
+        z1 := zCoord second(sp) 
         x2 := xCoord third(sp); y2 := yCoord third(sp); z2 := zCoord third(sp)
         a1 := (x1-x0)/xDiff; b1 := (y1-y0)/yDiff; c1 := (z1-z0)/zDiff
         a2 := (x2-x1)/xDiff; b2 := (y2-y1)/yDiff; c2 := (z2-z1)/zDiff
@@ -120615,6 +146809,7 @@ Plot3D(): Exports == Implementation where
       [curve.source,[tRange,xRange,yRange,zRange],t,p]
  
     refine p == refine(p,parametricRange p)
+
     refine(p,nRange) ==
       NUMFUNEVALS := 0
       tRange := parametricRange p
@@ -120645,7 +146840,6 @@ Plot3D(): Exports == Implementation where
                       p.screenres) for c in curves]
         xRange := join(curves,1); yRange := join(curves,2)
         zRange := join(curves,3)
---      print(NUMFUNEVALS::OUT)
       [[xRange,yRange,zRange],[tRange,xRange,yRange,zRange],
         p.screenres,p.axisLabels,curves]
  
@@ -120655,8 +146849,6 @@ Plot3D(): Exports == Implementation where
       NUMFUNEVALS := MINPOINTS
       if adaptive3D? then
        p := adaptivePlot(p,first r,second r,third r,fourth r,8,SCREENRES)
---      print(NUMFUNEVALS::OUT)
---      print(p::OUT)
       [ rest r, r, SCREENRES, nil(), [ p ] ]
  
     pointPlot(f:F -> P,tRange:R,xRange:R,yRange:R,zRange:R) ==
@@ -120680,7 +146872,6 @@ Plot3D(): Exports == Implementation where
       NUMFUNEVALS := MINPOINTS
       if adaptive3D? then
        p := adaptivePlot(p,first r,second r,third r,fourth r,8,SCREENRES)
---      print(NUMFUNEVALS::OUT)
       [ rest r, r, SCREENRES, nil(), [ p ] ]
  
     plot(f1:F -> F,f2:F -> F,f3:F -> F,col:F -> F,_
@@ -120722,6 +146913,413 @@ Plot3D(): Exports == Implementation where
 \begin{chunk}{COQ PLOT3D}
 (* domain PLOT3D *)
 (*
+
+    import PointPackage(F)
+ 
+--% local functions
+ 
+    fourth         : L R -> R
+    checkRange     : R -> R
+      -- checks that left-hand endpoint is less than right-hand endpoint
+    intersect      : (R,R) -> R
+      -- intersection of two intervals
+    union          : (R,R) -> R
+      -- union of two intervals
+    join           : (L C,I) -> R
+    parametricRange: % -> R
+--     setColor       : (P,F) -> F
+    select         : (L P,P -> F,(F,F) -> F) -> F
+--     normalizeColor : (P,F,F) -> F
+    rangeRefine    : (C,R) -> C
+    adaptivePlot   : (C,R,R,R,R,I,I) -> C
+    basicPlot      : (F -> P,R) -> C
+    basicRefine    : (C,R) -> C
+    point          : (F,F,F,F) -> P
+ 
+--% representation
+ 
+    Rep := Record( display: L R, _
+                   bounds: L R, _
+                   screenres: I, _
+                   axisLabels: L S, _
+                   functions: L C )
+ 
+--% global constants
+
+    ADAPTIVE    : B := true
+    MINPOINTS   : I := 49
+    MAXPOINTS   : I := 1000
+    NUMFUNEVALS : I := 0
+    SCREENRES   : I := 500
+    ANGLEBOUND  : F := cos inv (4::F) 
+    DEBUG       : B := false
+ 
+    point(xx,yy,zz,col) == point(l : L F := [xx,yy,zz,col])
+ 
+    fourth list == first rest rest rest list
+ 
+    checkRange r == (lo r > hi r => error "ranges cannot be negative"; r)
+
+    intersect(s,t) == checkRange (max(lo s,lo t) .. min(hi s,hi t))
+
+    union(s:R,t:R) == min(lo s,lo t) .. max(hi s,hi t)
+
+    join(l,i) ==
+      rr := first l
+      u : R :=
+        i = 0 => first(rr.ranges)
+        i = 1 => second(rr.ranges)
+        i = 2 => third(rr.ranges)
+        fourth(rr.ranges)
+      for r in rest l repeat
+        i = 0 => union(u,first(r.ranges))
+        i = 1 => union(u,second(r.ranges))
+        i = 2 => union(u,third(r.ranges))
+        union(u,fourth(r.ranges))
+      u
+
+    parametricRange r == first(r.bounds)
+ 
+    minPoints3D() == MINPOINTS
+
+    setMinPoints3D n ==
+      if n < 3 then error "three points minimum required"
+      if MAXPOINTS < n then MAXPOINTS := n
+      MINPOINTS := n
+
+    maxPoints3D() == MAXPOINTS
+
+    setMaxPoints3D n ==
+      if n < 3 then error "three points minimum required"
+      if MINPOINTS > n then MINPOINTS := n
+      MAXPOINTS := n
+
+    screenResolution3D() == SCREENRES
+
+    setScreenResolution3D n ==
+      if n < 2 then error "buy a new terminal"
+      SCREENRES := n
+
+    adaptive3D?() == ADAPTIVE
+
+    setAdaptive3D b == ADAPTIVE := b
+ 
+    numFunEvals3D() == NUMFUNEVALS
+
+    debug3D b == DEBUG := b
+ 
+    xRange plot == second plot.bounds
+
+    yRange plot == third plot.bounds
+
+    zRange plot == fourth plot.bounds
+
+    tRange plot == first plot.bounds
+ 
+    tValues plot ==
+      outList : L L F := nil()
+      for curve in plot.functions repeat
+        outList := concat(curve.knots,outList)
+      outList
+ 
+    select(l,f,g) ==
+      m := f first l
+      if (EQL(m, _$NaNvalue$Lisp)$Lisp) then m := 0
+      for p in rest l repeat
+        fp : F := f p
+        if (EQL(fp, _$NaNvalue$Lisp)$Lisp) then fp := 0
+        m := g(m,fp)
+      m
+ 
+    rangeRefine(curve,nRange) ==
+      checkRange nRange; l := lo nRange; h := hi nRange
+      t := curve.knots; p := curve.points; f := curve.source
+      while not null t and first t < l repeat
+        (t := rest t; p := rest p)
+      c : L F := nil(); q : L P := nil()
+      while not null t and first t <= h repeat
+        c := concat(first t,c); q := concat(first p,q)
+        t := rest t; p := rest p
+      if null c then return basicPlot(f,nRange)
+      if first c < h then
+        c := concat(h,c); q := concat(f h,q)
+        NUMFUNEVALS := NUMFUNEVALS + 1
+      t := c := reverse_! c; p := q := reverse_! q
+      s := (h-l)/(MINPOINTS::F-1)
+      if (first t) ^= l then
+        t := c := concat(l,c); p := q := concat(f l,p)
+        NUMFUNEVALS := NUMFUNEVALS + 1
+      while not null rest t repeat
+        n := wholePart((second(t) - first(t))/s)
+        d := (second(t) - first(t))/((n+1)::F)
+        for i in 1..n repeat
+          t.rest := concat(first(t) + d,rest t); t1 := second t
+          p.rest := concat(f t1,rest p)
+          NUMFUNEVALS := NUMFUNEVALS + 1
+          t := rest t; p := rest p
+        t := rest t
+        p := rest p
+      xRange := select(q,xCoord,min) .. select(q,xCoord,max)
+      yRange := select(q,yCoord,min) .. select(q,yCoord,max)
+      zRange := select(q,zCoord,min) .. select(q,zCoord,max)
+      [f,[nRange,xRange,yRange,zRange],c,q]
+ 
+
+    adaptivePlot(curve,tRg,xRg,yRg,zRg,pixelfraction,resolution) ==
+      xDiff := hi xRg - lo xRg
+      yDiff := hi yRg - lo yRg
+      zDiff := hi zRg - lo zRg
+      if xDiff = 0::F then xDiff := 1::F
+      if yDiff = 0::F then yDiff := 1::F
+      if zDiff = 0::F then zDiff := 1::F
+      l := lo tRg; h := hi tRg
+      (tDiff := h-l) = 0 => curve
+      t := curve.knots
+      #t < 3 => curve
+      p := curve.points; f := curve.source
+      minLength:F := 4::F/resolution::F
+      maxLength := 1/4::F
+      tLimit := tDiff/(pixelfraction*resolution)::F
+      while not null t and first t < l repeat (t := rest t; p := rest p)
+      #t < 3 => curve
+      headert := t; headerp := p
+      st := t; sp := p
+      todot : L L F := nil()
+      todop : L L P := nil()
+      while not null rest rest st repeat
+        todot := concat_!(todot, st) 
+        todop := concat_!(todop, sp)
+        st := rest st; sp := rest sp
+      st := headert; sp := headerp
+      todo1 := todot; todo2 := todop
+      n : I := 0
+
+      while not null todo1 repeat
+        st := first(todo1)
+        t0 := first(st); t1 := second(st); t2 := third(st)
+        if t2 > h then leave
+        t2 - t0 < tLimit => 
+           todo1 := rest todo1
+           todo2 := rest todo2;
+           if not null todo1 then (t := first(todo1); p := first(todo2))
+        sp := first(todo2)
+        x0 := xCoord first(sp); 
+        y0 := yCoord first(sp); 
+        z0 := zCoord first(sp) 
+        x1 := xCoord second(sp); 
+        y1 := yCoord second(sp); 
+        z1 := zCoord second(sp) 
+        x2 := xCoord third(sp); y2 := yCoord third(sp); z2 := zCoord third(sp)
+        a1 := (x1-x0)/xDiff; b1 := (y1-y0)/yDiff; c1 := (z1-z0)/zDiff
+        a2 := (x2-x1)/xDiff; b2 := (y2-y1)/yDiff; c2 := (z2-z1)/zDiff
+        s1 := sqrt(a1**2+b1**2+c1**2); s2 := sqrt(a2**2+b2**2+c2**2)
+        dp := a1*a2+b1*b2+c1*c2
+        s1 < maxLength and s2 < maxLength and _
+           (s1 = 0 or s2 = 0 or
+              s1 < minLength and s2 < minLength or _
+              dp/s1/s2 > ANGLEBOUND) => 
+                todo1 := rest todo1
+                todo2 := rest todo2
+                if not null todo1 then (t := first(todo1); p := first(todo2))
+        if n = MAXPOINTS then leave else n := n + 1
+        --if DEBUG then
+           --r : L F := [minLength,maxLength,s1,s2,dp/s1/s2,ANGLEBOUND]
+           --output(r::E)$O
+        st := rest t
+        if not null rest rest st then
+          tm := (t0+t1)/2::F
+          tj := tm
+          t.rest := concat(tj,rest t)
+          p.rest := concat(f tj, rest p)
+          todo1 := concat_!(todo1, t)
+          todo2 := concat_!(todo2, p)
+          t := rest t; p := rest p
+          todo1 := concat_!(todo1, t)
+          todo2 := concat_!(todo2, p)
+          t := rest t; p := rest p
+          todo1 := rest todo1; todo2 := rest todo2
+
+          tm := (t1+t2)/2::F
+          tj := tm 
+          t.rest := concat(tj, rest t)
+          p.rest := concat(f tj, rest p)
+          todo1 := concat_!(todo1, t)
+          todo2 := concat_!(todo2, p)
+          t := rest t; p := rest p
+          todo1 := concat_!(todo1, t)
+          todo2 := concat_!(todo2, p)
+          todo1 := rest todo1; todo2 := rest todo2
+          if not null todo1 then (t := first(todo1); p := first(todo2))
+        else
+          tm := (t0+t1)/2::F
+          tj := tm
+          t.rest := concat(tj,rest t)
+          p.rest := concat(f tj, rest p)
+          todo1 := concat_!(todo1, t)
+          todo2 := concat_!(todo2, p)
+          t := rest t; p := rest p
+          todo1 := concat_!(todo1, t)
+          todo2 := concat_!(todo2, p)
+          t := rest t; p := rest p
+
+          tm := (t1+t2)/2::F
+          tj := tm 
+          t.rest := concat(tj, rest t)
+          p.rest := concat(f tj, rest p)
+          todo1 := concat_!(todo1, t)
+          todo2 := concat_!(todo2, p)
+          todo1 := rest todo1; todo2 := rest todo2
+          if not null todo1 then (t := first(todo1); p := first(todo2))
+      if n > 0 then
+        NUMFUNEVALS := NUMFUNEVALS + n
+        t := curve.knots; p := curve.points
+        xRg := select(p,xCoord,min) .. select(p,xCoord,max)
+        yRg := select(p,yCoord,min) .. select(p,yCoord,max)
+        zRg := select(p,zCoord,min) .. select(p,zCoord,max)
+        [curve.source,[tRg,xRg,yRg,zRg],t,p]
+      else curve
+ 
+    basicPlot(f,tRange) ==
+      checkRange tRange; l := lo tRange; h := hi tRange
+      t : L F := list l; p : L P := list f l
+      s := (h-l)/(MINPOINTS-1)::F
+      for i in 2..MINPOINTS-1 repeat
+        l := l+s; t := concat(l,t)
+        p := concat(f l,p)
+      t := reverse_! concat(h,t)
+      p := reverse_! concat(f h,p)
+      xRange : R := select(p,xCoord,min) .. select(p,xCoord,max)
+      yRange : R := select(p,yCoord,min) .. select(p,yCoord,max)
+      zRange : R := select(p,zCoord,min) .. select(p,zCoord,max)
+      [f,[tRange,xRange,yRange,zRange],t,p]
+ 
+    zoom(p,xRange,yRange,zRange) ==
+     [[xRange,yRange,zRange],p.bounds,
+      p.screenres,p.axisLabels,p.functions]
+ 
+    basicRefine(curve,nRange) ==
+      tRange:R := first curve.ranges
+      -- curve := copy$C curve  -- Yet another @#$%^&* compiler bug
+      curve: C := [curve.source,curve.ranges,curve.knots,curve.points]
+      t := curve.knots := copy curve.knots
+      p := curve.points := copy curve.points
+      l := lo nRange; h := hi nRange
+      f := curve.source
+      while not null rest t and first(t) < h repeat
+        second(t) < l => (t := rest t; p := rest p)
+        -- insert new point between t.0 and t.1
+        tm:F := (first(t) + second(t))/2::F
+        -- if DEBUG then output$O (tm::E)
+        pm := f tm
+        NUMFUNEVALS := NUMFUNEVALS + 1
+        t.rest := concat(tm,rest t); t := rest rest t
+        p.rest := concat(pm,rest p); p := rest rest p
+      t := curve.knots; p := curve.points
+      xRange := select(p,xCoord,min) .. select(p,xCoord,max)
+      yRange := select(p,yCoord,min) .. select(p,yCoord,max)
+      zRange := select(p,zCoord,min) .. select(p,zCoord,max)
+      [curve.source,[tRange,xRange,yRange,zRange],t,p]
+ 
+    refine p == refine(p,parametricRange p)
+
+    refine(p,nRange) ==
+      NUMFUNEVALS := 0
+      tRange := parametricRange p
+      nRange := intersect(tRange,nRange)
+      curves: L C := [basicRefine(c,nRange) for c in p.functions]
+      xRange := join(curves,1); yRange := join(curves,2)
+      zRange := join(curves,3)
+      scrres := p.screenres
+      if adaptive3D? then
+        tlimit := 8
+        curves := [adaptivePlot(c,nRange,xRange,yRange,zRange, _
+                   tlimit,scrres := 2*scrres) for c in curves]
+        xRange := join(curves,1); yRange := join(curves,2)
+        zRange := join(curves,3)
+      [p.display,[tRange,xRange,yRange,zRange], _
+       scrres,p.axisLabels,curves]
+ 
+    plot(p:%,tRange:R) ==
+      -- re plot p on a new range making use of the points already
+      -- computed if possible
+      NUMFUNEVALS := 0
+      curves: L C := [rangeRefine(c,tRange) for c in p.functions]
+      xRange := join(curves,1); yRange := join(curves,2)
+      zRange := join(curves,3)
+      if adaptive3D? then
+        tlimit := 8
+        curves := [adaptivePlot(c,tRange,xRange,yRange,zRange,tlimit, _
+                      p.screenres) for c in curves]
+        xRange := join(curves,1); yRange := join(curves,2)
+        zRange := join(curves,3)
+      [[xRange,yRange,zRange],[tRange,xRange,yRange,zRange],
+        p.screenres,p.axisLabels,curves]
+ 
+    pointPlot(f:F -> P,tRange:R) ==
+      p := basicPlot(f,tRange)
+      r := p.ranges
+      NUMFUNEVALS := MINPOINTS
+      if adaptive3D? then
+       p := adaptivePlot(p,first r,second r,third r,fourth r,8,SCREENRES)
+      [ rest r, r, SCREENRES, nil(), [ p ] ]
+ 
+    pointPlot(f:F -> P,tRange:R,xRange:R,yRange:R,zRange:R) ==
+      p := pointPlot(f,tRange)
+      p.display:= [checkRange xRange,checkRange yRange,checkRange zRange]
+      p
+ 
+    myTrap: (F-> F, F) -> F
+    myTrap(ff:F-> F, f:F):F ==
+      s := trapNumericErrors(ff(f))$Lisp :: Union(F, "failed")
+      if (s) case "failed" then
+        r:F := _$NaNvalue$Lisp
+      else
+        r:F := s
+      r
+
+    plot(f1:F -> F,f2:F -> F,f3:F -> F,col:F -> F,tRange:R) ==
+      p := basicPlot(
+       (z:F):P+->point(myTrap(f1,z),myTrap(f2,z),myTrap(f3,z),col(z)),tRange)
+      r := p.ranges
+      NUMFUNEVALS := MINPOINTS
+      if adaptive3D? then
+       p := adaptivePlot(p,first r,second r,third r,fourth r,8,SCREENRES)
+      [ rest r, r, SCREENRES, nil(), [ p ] ]
+ 
+    plot(f1:F -> F,f2:F -> F,f3:F -> F,col:F -> F,_
+              tRange:R,xRange:R,yRange:R,zRange:R) ==
+      p := plot(f1,f2,f3,col,tRange)
+      p.display:= [checkRange xRange,checkRange yRange,checkRange zRange]
+      p
+ 
+--% terminal output
+ 
+    coerce r ==
+      spaces := "   " :: OUT
+      xSymbol := "x = " :: OUT; ySymbol := "y = " :: OUT
+      zSymbol := "z = " :: OUT; tSymbol := "t = " :: OUT
+      tRange := (parametricRange r) :: OUT
+      f : L OUT := nil()
+      for curve in r.functions repeat
+        xRange := coerce curve.ranges.1
+        yRange := coerce curve.ranges.2
+        zRange := coerce curve.ranges.3
+        l : L OUT := [xSymbol,xRange,spaces,ySymbol,yRange,_
+                       spaces,zSymbol,zRange]
+        l := concat_!([tSymbol,tRange,spaces],l)
+        h : OUT := hconcat l
+        l := [p::OUT for p in curve.points]
+        f := concat(vconcat concat(h,l),f)
+      prefix("PLOT" :: OUT,reverse_! f)
+ 
+----% graphics output
+ 
+    listBranches plot ==
+      outList : L L P := nil()
+      for curve in plot.functions repeat
+        outList := concat(curve.points,outList)
+      outList
+
 *)
 
 \end{chunk}
@@ -120838,20 +147436,25 @@ PoincareBirkhoffWittLyndonBasis(VarSet: OrderedSet): Public == Private where
       1: constant -> %
          ++ \spad{1} returns the empty list.
       coerce       : $ -> WORD
-         ++ \spad{coerce([l1]*[l2]*...[ln])} returns the word \spad{l1*l2*...*ln},
-         ++ where \spad{[l_i]} is the backeted form of the Lyndon word \spad{l_i}.
+         ++ \spad{coerce([l1]*[l2]*...[ln])} returns the word 
+         ++ \spad{l1*l2*...*ln},
+         ++ where \spad{[l_i]} is the backeted form of the 
+         ++ Lyndon word \spad{l_i}.
       coerce       : VarSet -> $
          ++ \spad{coerce(v)} return \spad{v}
       first        : $ -> LWORD
          ++ \spad{first([l1]*[l2]*...[ln])} returns the Lyndon word \spad{l1}.
       length       : $ -> NNI
-         ++ \spad{length([l1]*[l2]*...[ln])} returns the length of the word \spad{l1*l2*...*ln}.
+         ++ \spad{length([l1]*[l2]*...[ln])} returns the length of the 
+         ++ word \spad{l1*l2*...*ln}.
       listOfTerms  : $ -> LWORDS
-         ++ \spad{listOfTerms([l1]*[l2]*...[ln])} returns the list of words \spad{l1, l2, .... ln}.
+         ++ \spad{listOfTerms([l1]*[l2]*...[ln])} returns the list of 
+         ++ words \spad{l1, l2, .... ln}.
       rest         : $ -> $
          ++ \spad{rest([l1]*[l2]*...[ln])} returns the list \spad{l2, .... ln}.
       retractable? : $ -> Boolean
-         ++ \spad{retractable?([l1]*[l2]*...[ln])} returns true iff \spad{n}  equals \spad{1}.
+         ++ \spad{retractable?([l1]*[l2]*...[ln])} returns true 
+         ++ iff \spad{n}  equals \spad{1}.
       varList      : $ -> List VarSet
          ++ \spad{varList([l1]*[l2]*...[ln])} returns the list of
          ++ variables in the word \spad{l1*l2*...*ln}.
@@ -120920,6 +147523,64 @@ PoincareBirkhoffWittLyndonBasis(VarSet: OrderedSet): Public == Private where
 \begin{chunk}{COQ PBWLB}
 (* domain PBWLB *)
 (*
+
+    -- Representation
+     Rep := LWORDS
+
+    -- Locales
+     recursif: ($,$) -> Boolean
+
+    -- Define
+     1 == nil
+
+     x = y == x =$Rep y
+
+     varList x ==
+        null x => nil
+        le: List VarSet := "setUnion"/ [varList$LWORD l for l in x]
+
+     first x == first(x)$Rep
+     rest x == rest(x)$Rep
+
+     coerce(v: VarSet):$ == [ v::LWORD ]
+     coerce(l: LWORD):$ == [l]
+     listOfTerms(x:$):LWORDS == x pretend LWORDS      
+
+     coerce(x:$):WORD ==
+       null x => 1
+       x.first :: WORD *$WORD coerce(x.rest)
+
+     coerce(x:$):EX ==
+       null x => outputForm(1$Integer)$EX
+       reduce(_* ,[l :: EX for l in x])$List(EX)
+
+     retractable? x == 
+       null x => false
+       null x.rest
+
+     retract x == 
+        #x ^= 1 => error "cannot convert to Lyndon word"
+        x.first
+
+     retractIfCan x ==
+        retractable? x => x.first
+        "failed"
+      
+     length x ==
+        n: Integer := +/[ length l for l in x]
+        n::NNI
+
+     recursif(x, y) ==
+       null y => false
+       null x => true
+       x.first = y.first => recursif(rest(x), rest(y))
+       lexico(x.first, y.first)
+
+     x < y == 
+       lx: NNI := length x; ly: NNI := length y 
+       lx = ly => recursif(x,y)
+       lx < ly
+
 *)
 
 \end{chunk}
@@ -121150,6 +147811,7 @@ Point(R:Ring) : Exports == Implementation where
   Exports ==> PointCategory(R)
  
   Implementation ==> Vector (R) add
+
     PI   ==> PositiveInteger
 
     point(l:List R):% ==
@@ -121175,6 +147837,27 @@ Point(R:Ring) : Exports == Implementation where
 \begin{chunk}{COQ POINT}
 (* domain POINT *)
 (*
+
+    PI   ==> PositiveInteger
+
+    point(l:List R):% ==
+      pt := new(#l,R)
+      for x in l for i in minIndex(pt).. repeat
+        pt.i := x
+      pt
+
+    dimension p == (# p)::PI  -- Vector returns NonNegativeInteger...?
+
+    convert(l:List R):% == point(l)
+
+    cross(p0, p1) ==
+      #p0 ^=3 or #p1^=3 => error "Arguments to cross must be three dimensional"      
+      point [p0.2 * p1.3 - p1.2 * p0.3, _
+             p1.1 * p0.3 - p0.1 * p1.3, _
+             p0.1 * p1.2 - p1.1 * p0.2]
+
+    extend(p,l) == concat(p,point l)
+
 *)
 
 \end{chunk}
@@ -122229,6 +148912,7 @@ Polynomial(R:Ring):
       outputForm(univariate(p, a), a::OutputForm)
 
     if R has Algebra Fraction Integer then
+
       integrate(p, x) == (integrate univariate(p, x)) (x::%)
 
 \end{chunk}
@@ -122236,6 +148920,21 @@ Polynomial(R:Ring):
 \begin{chunk}{COQ POLY}
 (* domain POLY *)
 (*
+ SparseMultivariatePolynomial(R, Symbol) add
+
+    import UserDefinedPartialOrdering(Symbol)
+
+    coerce(p:%):OutputForm ==
+      (r:= retractIfCan(p)@Union(R,"failed")) case R => r::R::OutputForm
+      a :=
+        userOrdered?() => largest variables p
+        mainVariable(p)::Symbol
+      outputForm(univariate(p, a), a::OutputForm)
+
+    if R has Algebra Fraction Integer then
+
+      integrate(p, x) == (integrate univariate(p, x)) (x::%)
+
 *)
 
 \end{chunk}
@@ -122658,7 +149357,8 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T
        empty?(lvar)
 
             ----  is the ideal zero dimensional?  ----
-     zeroDim?(I:Ideal):Boolean == zeroDim?(I,"setUnion"/[variables g for g in I.idl])
+     zeroDim?(I:Ideal):Boolean == 
+       zeroDim?(I,"setUnion"/[variables g for g in I.idl])
 
                ----  test if f is in the radical of I  ----
      inRadical?(f:DPoly,I:Ideal) : Boolean ==
@@ -122681,7 +149381,8 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T
        n1:Z:=monomDim(leadid,truelist)::Z
        ed+n1
 
-     dimension(I:Ideal) : Z == dimension(I,"setUnion"/[variables g for g in I.idl])
+     dimension(I:Ideal) : Z == 
+       dimension(I,"setUnion"/[variables g for g in I.idl])
 
      -- leading term ideal --
      leadingIdeal(I : Ideal) : Ideal ==
@@ -122771,6 +149472,300 @@ PolynomialIdeals(F,Expon,VarSet,DPoly) : C == T
 \begin{chunk}{COQ IDEAL}
 (* domain IDEAL *)
 (*
+
+   ---  Representation ---
+     Rep := Record(idl:List DPoly,isGr:Boolean)
+
+
+                ----  Local Functions  ----
+
+     contractGrob  :    newIdeal          ->  Ideal
+     npoly         :     DPoly            ->  newPoly
+     oldpoly       :     newPoly          ->  Union(DPoly,"failed")
+     leadterm      :   (DPoly,VarSet)     ->  DPoly
+     choosel       :   (DPoly,DPoly)      ->  DPoly
+     isMonic?      :   (DPoly,VarSet)     ->  Boolean
+     randomat      :     List Z           ->  Record(mM:MF,imM:MF)
+     monomDim      : (Ideal,List VarSet)  ->  NNI
+     variables     :       Ideal          ->  List VarSet
+     subset        :     List VarSet      ->  List List VarSet
+     makeleast     : (List VarSet,List VarSet)  ->  List VarSet
+
+     newExpon:  OrderedAbelianMonoidSup
+     newExpon:= Product(NNI,Expon)
+     newPoly := PolynomialRing(F,newExpon)
+
+     import GaloisGroupFactorizer(SparseUnivariatePolynomial Z)
+     import GroebnerPackage(F,Expon,VarSet,DPoly)
+     import GroebnerPackage(F,newExpon,VarSet,newPoly)
+
+     newIdeal ==> List(newPoly)
+
+     npoly(f:DPoly) : newPoly ==
+       f=0$DPoly => 0$newPoly
+       monomial(leadingCoefficient f,makeprod(0,degree f))$newPoly +
+             npoly(reductum f)
+
+     oldpoly(q:newPoly) : Union(DPoly,"failed") ==
+       q=0$newPoly => 0$DPoly
+       dq:newExpon:=degree q
+       n:NNI:=selectfirst (dq)
+       n^=0 => "failed"
+       ((g:=oldpoly reductum q) case "failed") => "failed"
+       monomial(leadingCoefficient q,selectsecond dq)$DPoly + (g::DPoly)
+
+     leadterm(f:DPoly,lvar:List VarSet) : DPoly ==
+       empty?(lf:=variables f)  or lf=lvar => f
+       leadterm(leadingCoefficient univariate(f,lf.first),lvar)
+
+     choosel(f:DPoly,g:DPoly) : DPoly ==
+       g=0 => f
+       (f1:=f exquo g) case "failed" => f
+       choosel(f1::DPoly,g)
+
+     contractGrob(I1:newIdeal) : Ideal ==
+       J1:List(newPoly):=groebner(I1)
+       while (oldpoly J1.first) case "failed" repeat J1:=J1.rest
+       [[(oldpoly f)::DPoly for f in J1],true]
+
+     makeleast(fullVars: List VarSet,leastVars:List VarSet) : List VarSet ==
+       n:= # leastVars
+       #fullVars < n  => error "wrong vars"
+       n=0 => fullVars
+       append([vv for vv in fullVars| ^member?(vv,leastVars)],leastVars)
+
+     isMonic?(f:DPoly,x:VarSet) : Boolean ==
+       ground? leadingCoefficient univariate(f,x)
+
+     subset(lv : List VarSet) : List List VarSet ==
+       #lv =1 => [lv,empty()]
+       v:=lv.1
+       ll:=subset(rest lv)
+       l1:=[concat(v,set) for set in ll]
+       concat(l1,ll)
+
+     monomDim(listm:Ideal,lv:List VarSet) : NNI ==
+       monvar: List List VarSet := []
+       for f in generators listm repeat
+         mvset := variables f
+         #mvset > 1 => monvar:=concat(mvset,monvar)
+         lv:=delete(lv,position(mvset.1,lv))
+       empty? lv => 0
+       lsubset : List List VarSet := sort((a,b)+->#a > #b ,subset(lv))
+       for subs in lsubset repeat
+         ldif:List VarSet:= lv
+         for mvset in monvar while ldif ^=[] repeat
+           ldif:=setDifference(mvset,subs)
+         if ^(empty? ldif) then  return #subs
+       0
+
+               --    Exported  Functions   ----
+
+                 ----  is  I =  J  ?  ----
+     (I:Ideal = J:Ideal) == in?(I,J) and in?(J,I)
+
+               ----  check if f is in I  ----
+     element?(f:DPoly,I:Ideal) : Boolean ==
+       Id:=(groebner I).idl
+       empty? Id => f = 0
+       normalForm(f,Id) = 0
+
+             ---- check if I is contained in J  ----
+     in?(I:Ideal,J:Ideal):Boolean ==
+       J:= groebner J
+       empty?(I.idl) => true
+       "and"/[element?(f,J) for f in I.idl ]
+
+
+            ----  groebner base for an Ideal  ----
+     groebner(I:Ideal) : Ideal  ==
+       I.isGr =>
+         "or"/[^zero? f for f in I.idl] => I
+         [empty(),true]
+       [groebner I.idl ,true]
+
+            ----  Intersection of two ideals  ----
+     intersect(I:Ideal,J:Ideal) : Ideal ==
+       empty?(Id:=I.idl) => I
+       empty?(Jd:=J.idl) => J
+       tp:newPoly := monomial(1,makeprod(1,0$Expon))$newPoly
+       tp1:newPoly:= tp-1
+       contractGrob(concat([tp*npoly f for f in Id],
+                     [tp1*npoly f for f in Jd]))
+
+
+            ----   intersection for a list of ideals  ----
+
+     intersect(lid:List(Ideal)) : Ideal == "intersect"/[l for l in lid]
+
+               ----  quotient by an element  ----
+     quotient(I:Ideal,f:DPoly) : Ideal ==
+       --[[(g exquo f)::DPoly for g in (intersect(I,[f]::%)).idl ],true]
+        import GroebnerInternalPackage(F,Expon,VarSet,DPoly)
+        [minGbasis [(g exquo f)::DPoly
+                 for g in (intersect(I,[f]::%)).idl ],true]
+
+                ----  quotient of two ideals  ----
+     quotient(I:Ideal,J:Ideal) : Ideal ==
+       Jdl := J.idl
+       empty?(Jdl) => ideal [1]
+       [("intersect"/[quotient(I,f) for f in Jdl ]).idl ,true]
+
+
+                ----    sum of two ideals  ----
+     (I:Ideal + J:Ideal) : Ideal == [groebner(concat(I.idl ,J.idl )),true]
+
+                ----   product of two ideals  ----
+     (I:Ideal * J:Ideal):Ideal ==
+       [groebner([:[f*g for f in I.idl ] for g in J.idl ]),true]
+
+                ----  power of an ideal  ----
+     (I:Ideal ** n:NNI) : Ideal ==
+       n=0 => [[1$DPoly],true]
+       (I * (I**(n-1):NNI))
+
+       ----  saturation with respect to the multiplicative set f**n ----
+     saturate(I:Ideal,f:DPoly) : Ideal ==
+       f=0 => error "f is zero"
+       tp:newPoly := (monomial(1,makeprod(1,0$Expon))$newPoly * npoly f)-1
+       contractGrob(concat(tp,[npoly g for g in I.idl ]))
+
+     ----  saturation with respect to a prime principal ideal in lvar ---
+     saturate(I:Ideal,f:DPoly,lvar:List(VarSet)) : Ideal ==
+       Id := I.idl
+       fullVars := "setUnion"/[variables g for g in Id]
+       newVars:=makeleast(fullVars,lvar)
+       subVars := [monomial(1,vv,1) for vv in newVars]
+       J:List DPoly:=groebner([eval(g,fullVars,subVars) for g in Id])
+       ltJ:=[leadterm(g,lvar) for g in J]
+       s:DPoly:=_*/[choosel(ltg,f) for ltg in ltJ]
+       fullPol:=[monomial(1,vv,1) for vv in fullVars]
+       [[eval(g,newVars,fullPol) for g in (saturate(J::%,s)).idl],true]
+
+            ----  is the ideal zero dimensional?  ----
+            ----      in the ring F[lvar]?        ----
+     zeroDim?(I:Ideal,lvar:List VarSet) : Boolean ==
+       J:=(groebner I).idl
+       empty? J => false
+       J = [1] => false
+       n:NNI := # lvar
+       #J < n => false
+       for f in J while ^empty?(lvar) repeat
+         x:=(mainVariable f)::VarSet
+         if isMonic?(f,x) then lvar:=delete(lvar,position(x,lvar))
+       empty?(lvar)
+
+            ----  is the ideal zero dimensional?  ----
+     zeroDim?(I:Ideal):Boolean == 
+       zeroDim?(I,"setUnion"/[variables g for g in I.idl])
+
+               ----  test if f is in the radical of I  ----
+     inRadical?(f:DPoly,I:Ideal) : Boolean ==
+       f=0$DPoly => true
+       tp:newPoly :=(monomial(1,makeprod(1,0$Expon))$newPoly * npoly f)-1
+       Id:=I.idl
+       normalForm(1$newPoly,groebner concat(tp,[npoly g for g in Id])) = 0
+
+              ----   dimension of an ideal  ----
+              ----    in the ring F[lvar]   ----
+     dimension(I:Ideal,lvar:List VarSet) : Z ==
+       I:=groebner I
+       empty?(I.idl) => # lvar
+       element?(1,I) => -1
+       truelist:="setUnion"/[variables f for f in I.idl]
+       "or"/[^member?(vv,lvar) for vv in truelist] => error "wrong variables"
+       truelist:=setDifference(lvar,setDifference(lvar,truelist))
+       ed:Z:=#lvar - #truelist
+       leadid:=leadingIdeal(I)
+       n1:Z:=monomDim(leadid,truelist)::Z
+       ed+n1
+
+     dimension(I:Ideal) : Z == 
+       dimension(I,"setUnion"/[variables g for g in I.idl])
+
+     -- leading term ideal --
+     leadingIdeal(I : Ideal) : Ideal ==
+       Idl:= (groebner I).idl
+       [[(f-reductum f) for f in Idl],true]
+
+               ---- ideal of relations among the fi  ----
+     if VarSet has ConvertibleTo Symbol then
+
+       monompol(df:List NNI,lcf:F,lv:List VarSet) : P ==
+         g:P:=lcf::P
+         for dd in df for v in lv repeat
+           g:= monomial(g,convert v,dd)
+         g
+
+       relationsIdeal(listf : List DPoly): ST ==
+         empty? listf  => [empty(),empty()]$ST
+         nf:=#listf
+         lvint := "setUnion"/[variables g for g in listf]
+         vl: List Symbol := [convert vv for vv in lvint]
+         nvar:List Symbol:=[new() for i in 1..nf]
+         VarSet1:=OrderedVariableList(concat(vl,nvar))
+         lv1:=[variable(vv)$VarSet1::VarSet1 for vv in nvar]
+         DirP:=DirectProduct(nf,NNI)
+         nExponent:=Product(Expon,DirP)
+         nPoly := PolynomialRing(F,nExponent)
+         gp:=GroebnerPackage(F,nExponent,VarSet1,nPoly)
+         lf:List nPoly :=[]
+         lp:List P:=[]
+         for f in listf for i in 1..  repeat
+           vec2:Vector(NNI):=new(nf,0$NNI)
+           vec2.i:=1
+           g:nPoly:=0$nPoly
+           pol:=0$P
+           while f^=0 repeat
+             df:=degree(f-reductum f,lvint)
+             lcf:=leadingCoefficient f
+             pol:=pol+monompol(df,lcf,lvint)
+             g:=g+monomial(lcf,makeprod(degree f,0))$nPoly
+             f:=reductum f
+           lp:=concat(pol,lp)
+           lf:=concat(monomial(1,makeprod(0,directProduct vec2))-g,lf)
+         npol:List P :=[v::P for v in nvar]
+         leq : List Equation P :=
+               [p = pol for p in npol for pol in reverse lp ]
+         lf:=(groebner lf)$gp
+         while lf^=[] repeat
+           q:=lf.first
+           dq:nExponent:=degree q
+           n:=selectfirst (dq)
+           if n=0 then leave "done"
+           lf:=lf.rest
+         solsn:List P:=[]
+         for q in lf repeat
+           g:Polynomial F :=0
+           while q^=0 repeat
+             dq:=degree q
+             lcq:=leadingCoefficient q
+             q:=reductum q
+             vdq:=(selectsecond dq):Vector NNI
+             g:=g+ lcq*
+                _*/[p**vdq.j for p in npol for j in 1..]
+           solsn:=concat(g,solsn)
+         [solsn,leq]$ST
+
+     coerce(Id:List DPoly) : Ideal == [Id,false]
+
+     coerce(I:Ideal) : OutputForm ==
+       Idl := I.idl
+       empty? Idl => [0$DPoly] :: OutputForm
+       Idl :: OutputForm
+
+     ideal(Id:List DPoly) :Ideal  ==  [[f for f in Id|f^=0],false]
+
+     groebnerIdeal(Id:List DPoly) : Ideal == [Id,true]
+
+     generators(I:Ideal) : List DPoly  == I.idl
+
+     groebner?(I:Ideal) : Boolean  ==  I.isGr
+
+     one?(I:Ideal) : Boolean == element?(1, I)
+
+     zero?(I:Ideal) : Boolean == empty? (groebner I).idl
+
 *)
 
 \end{chunk}
@@ -122952,10 +149947,291 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C
           ++ associates of any particular element.
        
   C == FreeModule(R,E) add
+
     --representations
        Term:=  Record(k:E,c:R)
        Rep:=  List Term
 
+    --declarations
+       x,y,p,p1,p2: %
+       n: Integer
+       nn: NonNegativeInteger
+       np: PositiveInteger
+       e: E
+       r: R
+
+    --local operations
+
+       1  == [[0$E,1$R]]
+
+       characteristic  == characteristic$R
+
+       numberOfMonomials x  == (# x)$Rep
+
+       degree p == if null p then 0 else p.first.k
+
+       minimumDegree p == if null p then 0 else (last p).k
+
+       leadingCoefficient p == if null p then 0$R else p.first.c
+
+       leadingMonomial p == if null p then 0 else [p.first]
+
+       reductum p == if null p then p else p.rest
+
+       retractIfCan(p:%):Union(R,"failed") ==
+         null p => 0$R
+         not null p.rest => "failed"
+         zero?(p.first.k) => p.first.c
+         "failed" 
+
+       coefficient(p,e)  ==
+          for tm in p repeat
+            tm.k=e => return tm.c
+            tm.k < e => return 0$R
+          0$R
+
+       recip(p) ==
+           null p => "failed"
+           p.first.k > 0$E => "failed"
+           (u:=recip(p.first.c)) case "failed" => "failed"
+           (u::R)::%
+
+       coerce(r) == if zero? r then 0$% else [[0$E,r]]
+
+       coerce(n) == (n::R)::%
+
+       ground?(p): Boolean == empty? p or (empty? rest p and zero? degree p)
+
+       qsetrest!: (Rep, Rep) -> Rep
+       qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp
+
+       times!: (R,    %) -> %
+       times:  (R, E, %) -> %
+
+       entireRing? := R has EntireRing
+
+       times!(r: R, x: %): % == 
+         res, endcell, newend, xx: Rep
+         if entireRing? then 
+                for tx in x repeat tx.c := r*tx.c
+         else 
+                xx := x
+                res := empty()
+                while not empty? xx repeat 
+                        tx := first xx
+                        tx.c := r * tx.c
+                        if zero? tx.c then 
+                                xx := rest xx
+                        else 
+                                newend := xx
+                                xx := rest xx
+                                if empty? res then 
+                                        res := newend
+                                        endcell := res
+                                else 
+                                        qsetrest!(endcell, newend)
+                                        endcell := newend
+                res;
+
+        --- term * polynomial 
+       termTimes: (R, E, Term) -> Term
+       termTimes(r: R, e: E, tx:Term): Term == [e+tx.k, r*tx.c]
+
+       times(tco: R, tex: E, rx: %): % == 
+        if entireRing? then 
+            map(x1+->termTimes(tco, tex, x1), rx::Rep)
+        else
+            [[tex + tx.k, r] for tx in rx::Rep | not zero? (r := tco * tx.c)]
+
+
+
+       -- local addm!
+       addm!: (Rep, R, E, Rep) -> Rep
+        -- p1 + coef*x^E * p2
+        -- `spare' (commented out) is for storage efficiency (not so good for
+        -- performance though.
+
+       addm!(p1:Rep, coef:R, exp: E, p2:Rep): Rep == 
+                --local res, newend, last: Rep
+                res, newcell, endcell: Rep
+                spare: List Rep
+                res     := empty()
+                endcell := empty()
+                while not empty? p1 and not empty? p2 repeat 
+                        tx := first p1
+                        ty := first p2
+                        exy := exp + ty.k
+                        newcell := empty();
+                        if tx.k = exy then 
+                                newcoef := tx.c + coef * ty.c
+                                if not zero? newcoef then
+                                        tx.c    := newcoef
+                                        newcell := p1
+                                p1 := rest p1
+                                p2 := rest p2
+                        else if tx.k > exy then 
+                                newcell := p1
+                                p1      := rest p1
+                        else 
+                                newcoef := coef * ty.c
+                                if not entireRing? and zero? newcoef then
+                                        newcell := empty()
+                                else
+                                        ttt := [exy, newcoef]
+                                        newcell := cons(ttt, empty())
+                                p2 := rest p2
+                        if not empty? newcell then
+                                if empty? res then
+                                        res := newcell
+                                        endcell := res
+                                else
+                                        qsetrest!(endcell, newcell)
+                                        endcell := newcell
+                if not empty? p1 then  -- then end is const * p1
+                        newcell := p1
+                else  -- then end is (coef, exp) * p2
+                        newcell := times(coef, exp, p2)
+                empty? res => newcell
+                qsetrest!(endcell, newcell)
+                res
+
+       pomopo! (p1, r, e, p2) ==  addm!(p1, r, e, p2)
+
+       p1 * p2 == 
+                xx := p1::Rep
+                empty? xx => p1
+                yy := p2::Rep
+                empty? yy => p2
+                zero? first(xx).k => first(xx).c * p2
+                zero? first(yy).k => p1 * first(yy).c
+                --if #xx > #yy then 
+                --        (xx, yy) := (yy, xx)
+                --        (p1, p2) := (p2, p1)
+                xx := reverse xx
+                res : Rep := empty()
+                for tx in xx repeat res:=addm!(res,tx.c,tx.k,yy)
+                res
+
+       if R has CommutativeRing  then
+
+         p ** np == p ** (np pretend NonNegativeInteger)
+
+         p ^ np  == p ** (np pretend NonNegativeInteger)
+
+         p ^ nn  == p ** nn
+            
+
+         p ** nn  ==
+            null p => 0
+            zero? nn => 1
+            (nn = 1) => p
+            empty? p.rest =>
+              zero?(cc:=p.first.c ** nn) => 0
+              [[nn * p.first.k, cc]]
+            binomThmExpt([p.first], p.rest, nn)
+
+       if R has Field then
+
+         unitNormal(p) ==
+            null p or (lcf:R:=p.first.c) = 1 => [1,p,1]
+            a := inv lcf
+            [lcf::%, [[p.first.k,1],:(a * p.rest)], a::%]
+
+         unitCanonical(p) ==
+            null p or (lcf:R:=p.first.c) = 1 => p
+            a := inv lcf
+            [[p.first.k,1],:(a * p.rest)]
+
+       else if R has IntegralDomain then
+
+         unitNormal(p) ==
+            null p or p.first.c = 1 => [1,p,1]
+            (u,cf,a):=unitNormal(p.first.c)
+            [u::%, [[p.first.k,cf],:(a * p.rest)], a::%]
+
+         unitCanonical(p) ==
+            null p or p.first.c = 1 => p
+            (u,cf,a):=unitNormal(p.first.c)
+            [[p.first.k,cf],:(a * p.rest)]
+
+       if R has IntegralDomain then
+
+         associates?(p1,p2) ==
+            null p1 => null p2
+            null p2 => false
+            p1.first.k = p2.first.k and
+              associates?(p1.first.c,p2.first.c) and
+               ((p2.first.c exquo p1.first.c)::R * p1.rest = p2.rest)
+
+         p exquo r  ==
+           [(if (a:= tm.c exquo r) case "failed"
+               then return "failed" else [tm.k,a])
+                  for tm in p] :: Union(%,"failed")
+
+         if E has CancellationAbelianMonoid then
+
+           fmecg(p1:%,e:E,r:R,p2:%):% ==       -- p1 - r * X**e * p2
+              rout:%:= []
+              r:= - r
+              for tm in p2 repeat
+                 e2:= e + tm.k
+                 c2:= r * tm.c
+                 c2 = 0 => "next term"
+                 while not null p1 and p1.first.k > e2 repeat
+                   (rout:=[p1.first,:rout]; p1:=p1.rest)  --use PUSH and POP?
+                 null p1 or p1.first.k < e2 => rout:=[[e2,c2],:rout]
+                 if (u:=p1.first.c + c2) ^= 0 then rout:=[[e2, u],:rout]
+                 p1:=p1.rest
+              NRECONC(rout,p1)$Lisp
+
+           if R has approximate then
+
+             p1 exquo p2  ==
+               null p2 => error "Division by 0"
+               p2 = 1 => p1
+               p1=p2 => 1
+             --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed"
+               rout:= []@List(Term)
+               while not null p1 repeat
+                  (a:= p1.first.c exquo p2.first.c)
+                  a case "failed" => return "failed"
+                  ee:= subtractIfCan(p1.first.k, p2.first.k)
+                  ee case "failed" => return "failed"
+                  p1:= fmecg(p1.rest, ee, a, p2.rest)
+                  rout:= [[ee,a], :rout]
+               null p1 => reverse(rout)::%    -- nreverse?
+               "failed"
+
+           else -- R not approximate
+
+             p1 exquo p2  ==
+               null p2 => error "Division by 0"
+               p2 = 1 => p1
+               rout:= []@List(Term)
+               while not null p1 repeat
+                  (a:= p1.first.c exquo p2.first.c)
+                  a case "failed" => return "failed"
+                  ee:= subtractIfCan(p1.first.k, p2.first.k)
+                  ee case "failed" => return "failed"
+                  p1:= fmecg(p1.rest, ee, a, p2.rest)
+                  rout:= [[ee,a], :rout]
+               null p1 => reverse(rout)::%    -- nreverse?
+               "failed"
+
+       if R has Field then
+
+          x/r == inv(r)*x
+
+\end{chunk}
+
+\begin{chunk}{COQ PR}
+(* domain PR *)
+(*
+ FreeModule(R,E) add
+
+    --representations
+       Term:=  Record(k:E,c:R)
+       Rep:=  List Term
 
     --declarations
        x,y,p,p1,p2: %
@@ -122964,25 +150240,37 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C
        np: PositiveInteger
        e: E
        r: R
+
     --local operations
+
        1  == [[0$E,1$R]]
+
        characteristic  == characteristic$R
+
        numberOfMonomials x  == (# x)$Rep
+
        degree p == if null p then 0 else p.first.k
+
        minimumDegree p == if null p then 0 else (last p).k
+
        leadingCoefficient p == if null p then 0$R else p.first.c
+
        leadingMonomial p == if null p then 0 else [p.first]
+
        reductum p == if null p then p else p.rest
+
        retractIfCan(p:%):Union(R,"failed") ==
          null p => 0$R
          not null p.rest => "failed"
          zero?(p.first.k) => p.first.c
          "failed" 
+
        coefficient(p,e)  ==
           for tm in p repeat
             tm.k=e => return tm.c
             tm.k < e => return 0$R
           0$R
+
        recip(p) ==
            null p => "failed"
            p.first.k > 0$E => "failed"
@@ -122990,6 +150278,7 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C
            (u::R)::%
 
        coerce(r) == if zero? r then 0$% else [[0$E,r]]
+
        coerce(n) == (n::R)::%
 
        ground?(p): Boolean == empty? p or (empty? rest p and zero? degree p)
@@ -123028,11 +150317,12 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C
         --- term * polynomial 
        termTimes: (R, E, Term) -> Term
        termTimes(r: R, e: E, tx:Term): Term == [e+tx.k, r*tx.c]
+
        times(tco: R, tex: E, rx: %): % == 
         if entireRing? then 
-                map(x1+->termTimes(tco, tex, x1), rx::Rep)
+            map(x1+->termTimes(tco, tex, x1), rx::Rep)
         else
-                [[tex + tx.k, r] for tx in rx::Rep | not zero? (r := tco * tx.c)]
+            [[tex + tx.k, r] for tx in rx::Rep | not zero? (r := tco * tx.c)]
 
 
 
@@ -123041,13 +150331,13 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C
         -- p1 + coef*x^E * p2
         -- `spare' (commented out) is for storage efficiency (not so good for
         -- performance though.
+
        addm!(p1:Rep, coef:R, exp: E, p2:Rep): Rep == 
                 --local res, newend, last: Rep
                 res, newcell, endcell: Rep
                 spare: List Rep
                 res     := empty()
                 endcell := empty()
-                --spare   := empty()
                 while not empty? p1 and not empty? p2 repeat 
                         tx := first p1
                         ty := first p2
@@ -123058,8 +150348,6 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C
                                 if not zero? newcoef then
                                         tx.c    := newcoef
                                         newcell := p1
-                                --else
-                                --        spare   := cons(p1, spare)
                                 p1 := rest p1
                                 p2 := rest p2
                         else if tx.k > exy then 
@@ -123069,15 +150357,6 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C
                                 newcoef := coef * ty.c
                                 if not entireRing? and zero? newcoef then
                                         newcell := empty()
-                                --else if empty? spare then
-                                --        ttt := [exy, newcoef]
-                                --        newcell := cons(ttt, empty())
-                                --else
-                                --        newcell := first spare
-                                --        spare   := rest spare
-                                --        ttt := first newcell
-                                --        ttt.k := exy
-                                --        ttt.c := newcoef
                                 else
                                         ttt := [exy, newcoef]
                                         newcell := cons(ttt, empty())
@@ -123096,7 +150375,9 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C
                 empty? res => newcell
                 qsetrest!(endcell, newcell)
                 res
+
        pomopo! (p1, r, e, p2) ==  addm!(p1, r, e, p2)
+
        p1 * p2 == 
                 xx := p1::Rep
                 empty? xx => p1
@@ -123112,36 +150393,18 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C
                 for tx in xx repeat res:=addm!(res,tx.c,tx.k,yy)
                 res
 
---     if R has EntireRing then
---         p1 * p2  ==
---            null p1 => 0
---            null p2 => 0
---            zero?(p1.first.k) => p1.first.c * p2
---            one? p2 => p1
---            +/[[[t1.k+t2.k,t1.c*t2.c]$Term for t2 in p2]
---                   for t1 in reverse(p1)]
---                   -- This 'reverse' is an efficiency improvement:
---                   -- reduces both time and space [Abbott/Bradford/Davenport]
---        else
---         p1 * p2  ==
---            null p1 => 0
---            null p2 => 0
---            zero?(p1.first.k) => p1.first.c * p2
---            one? p2 => p1
---            +/[[[t1.k+t2.k,r]$Term for t2 in p2 | (r:=t1.c*t2.c) ^= 0]
---                 for t1 in reverse(p1)]
---                  -- This 'reverse' is an efficiency improvement:
---                  -- reduces both time and space [Abbott/Bradford/Davenport]
        if R has CommutativeRing  then
+
          p ** np == p ** (np pretend NonNegativeInteger)
+
          p ^ np  == p ** (np pretend NonNegativeInteger)
+
          p ^ nn  == p ** nn
             
 
          p ** nn  ==
             null p => 0
             zero? nn => 1
---            one? nn => p
             (nn = 1) => p
             empty? p.rest =>
               zero?(cc:=p.first.c ** nn) => 0
@@ -123149,35 +150412,45 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C
             binomThmExpt([p.first], p.rest, nn)
 
        if R has Field then
+
          unitNormal(p) ==
             null p or (lcf:R:=p.first.c) = 1 => [1,p,1]
             a := inv lcf
             [lcf::%, [[p.first.k,1],:(a * p.rest)], a::%]
+
          unitCanonical(p) ==
             null p or (lcf:R:=p.first.c) = 1 => p
             a := inv lcf
             [[p.first.k,1],:(a * p.rest)]
+
        else if R has IntegralDomain then
+
          unitNormal(p) ==
             null p or p.first.c = 1 => [1,p,1]
             (u,cf,a):=unitNormal(p.first.c)
             [u::%, [[p.first.k,cf],:(a * p.rest)], a::%]
+
          unitCanonical(p) ==
             null p or p.first.c = 1 => p
             (u,cf,a):=unitNormal(p.first.c)
             [[p.first.k,cf],:(a * p.rest)]
+
        if R has IntegralDomain then
+
          associates?(p1,p2) ==
             null p1 => null p2
             null p2 => false
             p1.first.k = p2.first.k and
               associates?(p1.first.c,p2.first.c) and
                ((p2.first.c exquo p1.first.c)::R * p1.rest = p2.rest)
+
          p exquo r  ==
            [(if (a:= tm.c exquo r) case "failed"
                then return "failed" else [tm.k,a])
                   for tm in p] :: Union(%,"failed")
+
          if E has CancellationAbelianMonoid then
+
            fmecg(p1:%,e:E,r:R,p2:%):% ==       -- p1 - r * X**e * p2
               rout:%:= []
               r:= - r
@@ -123191,7 +150464,9 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C
                  if (u:=p1.first.c + c2) ^= 0 then rout:=[[e2, u],:rout]
                  p1:=p1.rest
               NRECONC(rout,p1)$Lisp
+
            if R has approximate then
+
              p1 exquo p2  ==
                null p2 => error "Division by 0"
                p2 = 1 => p1
@@ -123207,11 +150482,12 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C
                   rout:= [[ee,a], :rout]
                null p1 => reverse(rout)::%    -- nreverse?
                "failed"
+
            else -- R not approximate
+
              p1 exquo p2  ==
                null p2 => error "Division by 0"
                p2 = 1 => p1
-             --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed"
                rout:= []@List(Term)
                while not null p1 repeat
                   (a:= p1.first.c exquo p2.first.c)
@@ -123222,14 +150498,11 @@ PolynomialRing(R:Ring,E:OrderedAbelianMonoid): T == C
                   rout:= [[ee,a], :rout]
                null p1 => reverse(rout)::%    -- nreverse?
                "failed"
+
        if R has Field then
-          x/r == inv(r)*x
 
-\end{chunk}
+          x/r == inv(r)*x
 
-\begin{chunk}{COQ PR}
-(* domain PR *)
-(*
 *)
 
 \end{chunk}
@@ -123342,6 +150615,10 @@ PositiveInteger: Join(AbelianSemiGroup,OrderedSet,Monoid) with
 \begin{chunk}{COQ PI}
 (* domain PI *)
 (*
+ SubDomain(NonNegativeInteger,#1 > 0) add
+     x:%
+     y:%
+
 *)
 
 \end{chunk}
@@ -123597,6 +150874,10 @@ PrimeField(p:PositiveInteger): Exp == Impl where
 \begin{chunk}{COQ PF}
 (* domain PF *)
 (*
+ InnerPrimeField(p) add
+    if not prime?(p)$IntegerPrimesPackage(Integer) then
+      error "Argument to prime field must be a prime"
+
 *)
 
 \end{chunk}
@@ -123799,22 +151080,29 @@ o )show PrimitiveArray
 ++ Minimum index is 0 in this type, cannot be changed
 
 PrimitiveArray(S:Type): OneDimensionalArrayAggregate S == add
+
    Qmax ==> QVMAXINDEX$Lisp
    Qsize ==> QVSIZE$Lisp
---   Qelt ==> QVELT$Lisp
---   Qsetelt ==> QSETVELT$Lisp
    Qelt ==> ELT$Lisp
    Qsetelt ==> SETELT$Lisp
    Qnew ==> MAKE_-ARRAY$Lisp
 
    #x                          == Qsize x
+
    minIndex x                  == 0
+
    empty()                     == Qnew(0$Lisp)
+
    new(n, x)                   == fill_!(Qnew n, x)
+
    qelt(x, i)                  == Qelt(x, i)
+
    elt(x:%, i:Integer)         == Qelt(x, i)
+
    qsetelt_!(x, i, s)          == Qsetelt(x, i, s)
+
    setelt(x:%, i:Integer, s:S) == Qsetelt(x, i, s)
+
    fill_!(x, s)       == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x)
 
 \end{chunk}
@@ -123822,6 +151110,31 @@ PrimitiveArray(S:Type): OneDimensionalArrayAggregate S == add
 \begin{chunk}{COQ PRIMARR}
 (* domain PRIMARR *)
 (*
+
+   Qmax ==> QVMAXINDEX$Lisp
+   Qsize ==> QVSIZE$Lisp
+   Qelt ==> ELT$Lisp
+   Qsetelt ==> SETELT$Lisp
+   Qnew ==> MAKE_-ARRAY$Lisp
+
+   #x                          == Qsize x
+
+   minIndex x                  == 0
+
+   empty()                     == Qnew(0$Lisp)
+
+   new(n, x)                   == fill_!(Qnew n, x)
+
+   qelt(x, i)                  == Qelt(x, i)
+
+   elt(x:%, i:Integer)         == Qelt(x, i)
+
+   qsetelt_!(x, i, s)          == Qsetelt(x, i, s)
+
+   setelt(x:%, i:Integer, s:S) == Qsetelt(x, i, s)
+
+   fill_!(x, s)       == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x)
+
 *)
 
 \end{chunk}
@@ -124071,6 +151384,7 @@ Product (A:SetCategory,B:SetCategory) : C == T
        x=y ==
            x.acomp = y.acomp => x.bcomp = y.bcomp
            false
+
        makeprod(a:A,b:B) :%   == [a,b]
  
        selectfirst(x:%) : A   == x.acomp
@@ -124078,17 +151392,23 @@ Product (A:SetCategory,B:SetCategory) : C == T
        selectsecond (x:%) : B == x.bcomp
  
        if A has Monoid and B has Monoid then
+
           1 == [1$A,1$B]
+
           x * y == [x.acomp * y.acomp,x.bcomp * y.bcomp]
+
           x ** p == [x.acomp ** p ,x.bcomp ** p]
  
        if A has Finite and B has Finite then
+
           size == size$A () * size$B ()
  
        if A has Group and B has Group then
+
           inv(x) == [inv(x.acomp),inv(x.bcomp)]
  
        if A has AbelianMonoid and B has AbelianMonoid then
+
           0 == [0$A,0$B]
  
           x + y == [x.acomp + y.acomp,x.bcomp + y.bcomp]
@@ -124097,20 +151417,26 @@ Product (A:SetCategory,B:SetCategory) : C == T
  
        if A has CancellationAbelianMonoid and
           B has CancellationAbelianMonoid then
+
             subtractIfCan(x, y) : Union(%,"failed") ==
               (na:= subtractIfCan(x.acomp, y.acomp)) case "failed" => "failed"
               (nb:= subtractIfCan(x.bcomp, y.bcomp)) case "failed" => "failed"
               [na::A,nb::B]
  
        if A has AbelianGroup and B has AbelianGroup then
+
           - x == [- x.acomp,-x.bcomp]
+
           (x - y):% == [x.acomp - y.acomp,x.bcomp - y.bcomp]
+
           d * x == [d * x.acomp,d * x.bcomp]
  
        if A has OrderedAbelianMonoidSup and B has OrderedAbelianMonoidSup then
+
           sup(x,y) == [sup(x.acomp,y.acomp),sup(x.bcomp,y.bcomp)]
  
        if A has OrderedSet and B has OrderedSet then
+
           x < y ==
                xa:= x.acomp ; ya:= y.acomp
                xa < ya => true
@@ -124118,15 +151444,89 @@ Product (A:SetCategory,B:SetCategory) : C == T
                xa = ya => (xb < yb)
                false
  
---     coerce(x:%):Symbol ==
---      PrintableForm()
---      formList([x.acomp::Expression,x.bcomp::Expression])$PrintableForm
-
 \end{chunk}
 
 \begin{chunk}{COQ PRODUCT}
 (* domain PRODUCT *)
 (*
+ 
+    --representations
+       Rep := Record(acomp:A,bcomp:B)
+ 
+    --declarations
+       x,y: %
+       i: NonNegativeInteger
+       p: NonNegativeInteger
+       a: A
+       b: B
+       d: Integer
+ 
+    --define
+       coerce(x):OutputForm == paren [(x.acomp)::OutputForm,
+                                      (x.bcomp)::OutputForm]
+       x=y ==
+           x.acomp = y.acomp => x.bcomp = y.bcomp
+           false
+
+       makeprod(a:A,b:B) :%   == [a,b]
+ 
+       selectfirst(x:%) : A   == x.acomp
+ 
+       selectsecond (x:%) : B == x.bcomp
+ 
+       if A has Monoid and B has Monoid then
+
+          1 == [1$A,1$B]
+
+          x * y == [x.acomp * y.acomp,x.bcomp * y.bcomp]
+
+          x ** p == [x.acomp ** p ,x.bcomp ** p]
+ 
+       if A has Finite and B has Finite then
+
+          size == size$A () * size$B ()
+ 
+       if A has Group and B has Group then
+
+          inv(x) == [inv(x.acomp),inv(x.bcomp)]
+ 
+       if A has AbelianMonoid and B has AbelianMonoid then
+
+          0 == [0$A,0$B]
+ 
+          x + y == [x.acomp + y.acomp,x.bcomp + y.bcomp]
+ 
+          c:NonNegativeInteger * x == [c * x.acomp,c*x.bcomp]
+ 
+       if A has CancellationAbelianMonoid and
+          B has CancellationAbelianMonoid then
+
+            subtractIfCan(x, y) : Union(%,"failed") ==
+              (na:= subtractIfCan(x.acomp, y.acomp)) case "failed" => "failed"
+              (nb:= subtractIfCan(x.bcomp, y.bcomp)) case "failed" => "failed"
+              [na::A,nb::B]
+ 
+       if A has AbelianGroup and B has AbelianGroup then
+
+          - x == [- x.acomp,-x.bcomp]
+
+          (x - y):% == [x.acomp - y.acomp,x.bcomp - y.bcomp]
+
+          d * x == [d * x.acomp,d * x.bcomp]
+ 
+       if A has OrderedAbelianMonoidSup and B has OrderedAbelianMonoidSup then
+
+          sup(x,y) == [sup(x.acomp,y.acomp),sup(x.bcomp,y.bcomp)]
+ 
+       if A has OrderedSet and B has OrderedSet then
+
+          x < y ==
+               xa:= x.acomp ; ya:= y.acomp
+               xa < ya => true
+               xb:= x.bcomp ; yb:= y.bcomp
+               xa = ya => (xb < yb)
+               false
+ 
 *)
 
 \end{chunk}
@@ -124567,11 +151967,119 @@ ProjectiveSpace(dim,K):Exports == Implementation where
       
     lastNonNul(pt)==lastNonNull(pt)
     
-\end{chunk}
-
-\begin{chunk}{COQ PROJSP}
-(* domain PROJSP *)
-(*
+\end{chunk}
+
+\begin{chunk}{COQ PROJSP}
+(* domain PROJSP *)
+(*
+
+    Rep:= List(K)
+
+    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(pt)==
+      K has PseudoAlgebraicClosureOfPerfectFieldCategory => _
+        maxTower(pt pretend Rep)
+      1$K
+    
+    degree(pt)==
+      K has PseudoAlgebraicClosureOfPerfectFieldCategory => _
+        extDegree definingField pt
+      1
+      
+    coerce(pt:%):List(K) == pt pretend Rep   
+      
+    projectivePoint(pt:LIST(K))==
+        pt :: %
+
+    list(ptt)==
+      ptt pretend Rep
+
+    pointValue(ptt)==
+      ptt pretend Rep
+
+    conjugate(p,e)==
+      lp:Rep:=p
+      pc:List(K):=[c**e for c in lp]
+      projectivePoint(pc)
+
+    homogenize(ptt,nV)==
+      if K has Field then
+        pt:=list(ptt)$%
+        zero?(pt.nV) => error "Impossible to homogenize this point"
+        divPt:=pt.nV
+        ([(a/divPt) for a in pt])
+      else
+        ptt
+
+    rational?(p,n)== p=conjugate(p,n)
+
+    rational?(p)==rational?(p,characteristic()$K)
+
+    removeConjugate(l)==removeConjugate(l,characteristic()$K)
+
+    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(p)==conjugate(p,characteristic()$K)
+
+    orbit(p)==orbit(p,characteristic()$K)
+
+    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"
+
+    aa:% = bb:% ==
+      ah:=homogenize(aa)
+      bh:=homogenize(bb)
+      ah =$Rep bh
+
+    coerce(pt:LIST(K))==
+        ^(dim=#pt) => error "Le point n'a pas la bonne dimension"
+        reduce("and",[zero?(a) for a in pt]) => _
+          error "Ce n'est pas un point projectif"
+        ptt:%:= pt
+        homogenize ptt
+
+    homogenize(ptt)==
+      homogenize(ptt,lastNonNull(ptt))
+
+    nonZero?: K -> Boolean
+    nonZero?(a)==
+      not(zero?(a))
+
+    lastNonNull(ptt)==
+      pt:=ptt pretend Rep
+      (dim pretend Integer)+1-_
+        (position("nonZero?",(reverse(pt)$LIST(K)))$LIST(K))
+      
+    lastNonNul(pt)==lastNonNull(pt)
+    
 *)
 
 \end{chunk}
@@ -124765,6 +152273,7 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where
     retractToGrn: % -> K 
   
   Impl == add
+
     Rep := Union(recRep,K)
     
     -- signature of local function  
@@ -125029,6 +152538,266 @@ PseudoAlgebraicClosureOfAlgExtOfRationalNumber(downLevel:K):Exp == Impl where
 \begin{chunk}{COQ PACEXT}
 (* domain PACEXT *)
 (*
+
+    Rep := Union(recRep,K)
+    
+    -- signature of local function  
+    replaceRecEl: (%,SUP(%)) -> %
+
+    down: % -> %
+
+    retractPol( pol:SUP(%) ):SUP(K)==
+      zero? pol => 0$SUP(K)
+      lc := leadingCoefficient pol
+      d := degree pol
+      rlc := retractToGrn( lc )
+      monomial( rlc , d )$SUP(K) + retractPol( reductum pol )
+
+    retractToGrn(aa)==
+      aa case K => aa
+      a:=(aa pretend recRep)
+      el:=  a.recEl
+      t:=   a.recTower
+      d:=   a.recDeg * extDegree downLevel
+      pt:=  a.recPrevTower
+      n:= a.recName
+      newElement(retractPol el, retractPol t, d, retractToGrn pt, n)$K
+      
+    newElement(pol,subF,inName)  ==
+        -- pol is an irreducible polynomial over the field extension
+        -- given by subF. 
+        -- The output of this function is a root of pol.
+      dp:=degree pol
+      listCoef: List % := coefficients pol
+      a1:% := inv first listCoef
+      b1:% := last listCoef
+      rr:% := b1*a1
+      one?(dp) =>
+        one?(#listCoef) => 0
+        - rr
+      ground?(pol) => error "Cannot create a new element with a constant"
+      d:PI := (dp pretend PI) * extDegree(subF)
+      [monomial(1$%,1)$SUP(%),pol,d,subF,inName] :: Rep
+
+    coerce(a:Integer):%== (a :: K) 
+    
+    down(a:%) == 
+      a case K => a
+      aa:=(a pretend recRep)
+      elel := aa.recEl
+      ^ground?(elel)$SUP(%) => a
+      gel:%:=ground(elel)
+      down(gel)
+
+    n:INT * a:% ==
+      one?(n) => a
+      zero?(a) or zero?(n) => 0
+      (n < 0) => - ((-n)*a)
+      mm:PositiveInteger:=(n pretend PositiveInteger)
+      double(mm,a)$RepeatedDoubling(%)
+
+    replaceRecEl(a,el)==
+      a case K => a
+      aa:=copy a
+      aa.recEl := el
+      aa
+
+    localTower :% := downLevel
+        
+    lift(a) == 
+      a case K => monomial(a,0)
+      (a pretend recRep).recEl
+
+    lift(a,b)==
+      extDegree a > extDegree b => _
+        error "Cannot lift something at lower level !!!!!"
+      extDegree a < extDegree b => monomial(a,0)$SUP(%)
+      lift a
+
+    reduce(a)==
+      localTower case K => 
+        coefficient(a,0)
+      ar:= a rem (localTower pretend recRep).recTower
+      replaceRecEl(localTower,ar)
+       
+    maxTower(la)==
+        --return an element from the list la which is in the largest
+        --extension of the ground field
+        --PRECONDITION: all elements in same tower, else no meaning?
+      m:="max"/[extDegree(a)$% for a in la]
+      first [b for b in la | extDegree(b)=m]
+
+    ground?(a)== a case K
+
+    vectorise(a,lev)==
+      da:=extDegree a
+      dlev:=extDegree lev
+      dlev < da => _
+        error "Cannot vectorise at a lower level than the element to vectorise"
+      lev case K => [a]
+      pa:SUP(%)
+      na:%
+      ^(da = dlev) =>
+        pa:=  monomial(a,0)$SUP(%)
+        na:=  replaceRecEl(lev,pa)
+        vectorise(na,lev)$%
+
+      prevLev:=previousTower(lev)
+      a case K => error "At this point a is not suppose to be in K"
+      aEl:=(a pretend recRep).recEl
+      daEl:=degree definingPolynomial(a)$%
+      lv:=[vectorise(c,prevLev)$% for c in entries(vectorise(aEl,daEl)$SUP(%))]
+      concat lv        
+
+    retractIfCan(a:%):Union(K,"failed")==
+      a case K => a
+      "failed"
+
+    retractIfCan(a:%):Union(Integer,"failed")==
+      a case K => retractIfCan(a)$K
+      "failed"
+
+    setTower!(a) ==
+      if a case K then
+        localTower := downLevel
+      else
+        localTower:=a
+      void()
+      
+    definingPolynomial == definingPolynomial(localTower)
+         
+    a:% + b:% ==
+      (a case K) and (b case K) => a +$K b
+      extDegree(a) > extDegree(b) => b + a
+      res1:SUP(%)
+      res2:%
+      if extDegree(a) = extDegree(b) then
+        res1:=   b.recEl +$SUP(%) a.recEl
+        res2:=   replaceRecEl(b,res1)
+      else
+        res1:=   b.recEl +$SUP(%) monomial(a,0)$SUP(%)
+        res2:= replaceRecEl(b,res1)
+      down(res2)
+         
+    a:% * b:% ==
+      (a case K) and (b case K) => a *$K b
+      extDegree(a) > extDegree(b) => b * a
+      res1:SUP(%)
+      res2:%
+      if extDegree(a) = extDegree(b) then
+        res1:=   b.recEl *$SUP(%) a.recEl rem b.recTower
+        res2:=   replaceRecEl(b,res1)
+      else
+        res1:=   b.recEl *$SUP(%) monomial(a,0)$SUP(%)
+        res2:=  replaceRecEl(b,res1)
+      down(res2)
+      
+    distinguishedRootsOf(polyZero,ee) ==
+        setTower!(ee)
+        zero?(polyZero) => error "to lazy to give you all the roots of 0 !!!"
+        factorf: Factored SUP % :=  factor(polyZero,localTower)$FACTRN(%)
+        listFact:List SUP %  := [pol.fctr for pol in factorList(factorf)]
+        listOfZeros:List(%):=empty()
+        for p in listFact repeat
+          root:=newElement(p, new(E::Symbol)$Symbol)
+          listOfZeros:List(%):=concat([ root ], listOfZeros)
+        listOfZeros
+    
+    1 == 1$K
+
+    0 == 0$K
+      
+    newElement(poll:SUP(%),inName:Symbol)==
+      newElement(poll,localTower,inName)$%
+
+    --Field operations 
+    inv(a)==
+      a case K => inv(a)$K
+      aRecEl:= (a pretend recRep).recEl
+      aDefPoly:= (a pretend recRep).recTower
+      aInv := extendedEuclidean( aRecEl , aDefPoly, 1 )
+      aInv  case "failed" => error "PACOFF : division by zero"
+      -- On doit retourner un Record représentant l'inverse de a.
+      -- Ce Record est exactement le même que celui de a sauf
+      -- qu'il faut remplacer le polynôme du selecteur recEl
+      -- par le polynôme représentant l'inverse de a :
+      -- C'est ce que fait la fonction replaceRecEl.
+      replaceRecEl( a , aInv.coef1 )     
+
+    a:% / b:% == a * inv(b)
+    
+    a:K * b:%==
+      (a :: %) * b
+      
+    b:% * a:K == a*b
+
+    a:% - b:% ==
+      a + (-b)
+    
+    a:% * b:Fraction(Integer) ==
+      bn:=numer b
+      bd:=denom b
+      ebn:%:= bn * 1$%
+      ebd:%:= bd * 1$%
+      a * ebn * inv(ebd)
+
+    -a:% ==
+       a case K => -$K a 
+       [-$SUP(%) (a pretend recRep).recEl,_
+        (a pretend recRep).recTower,_
+        (a pretend recRep).recDeg,_
+        (a pretend recRep).recPrevTower,_
+        (a pretend recRep).recName ]
+        
+    bb:% = aa:% ==
+      b:=down bb
+      a:=down aa
+      ^( extDegree(b) =$NNI extDegree(a) ) => false
+      (b case K)  =>  ( (retract a)@K  =$K (retract b)@K )
+      rda := a :: recRep
+      rdb := b :: recRep
+      not (rda.recTower =$SUP(%) rdb.recTower) => false
+      rdb.recEl =$SUP(%) rda.recEl
+        
+    zero?(a:%) == 
+      da:=down a  -- just to be sure !!!
+      ^(da case K) => false
+      zero?(da)$K
+    
+    one?(a:%) ==
+      da:= down a  -- just to be sure !!!
+      ^(da case K) => false
+      one?(da)$K
+    
+    coerce(a:K):% == a       
+               
+    coerce(a:%):OutputForm ==
+      a case K => ((retract a)@K) ::OutputForm
+      outputForm((a pretend recRep).recEl,_
+                ((a pretend recRep).recName)::OutputForm) $SUP(%)
+
+    fullOutput(a:%):OutputForm==
+      a case K => ((retract a)@K) ::OutputForm
+      (a pretend recRep)::OutputForm
+      
+    definingPolynomial(a:%): SUP % ==
+      a case K => monomial(1,1)$SUP(%)
+      (a pretend recRep).recTower
+
+    extDegree(a:%): PI ==
+      a case K => 1
+      (a pretend recRep).recDeg
+      
+    previousTower(a:%):% ==
+      a case K => error "No previous extension for ground field element"
+      (a pretend recRep).recPrevTower
+ 
+    name(a:%):Symbol ==
+      a case K => error "No name for ground field element"
+      (a pretend recRep).recName
+
+    characteristic == characteristic()$K
+
 *)
 
 \end{chunk}
@@ -125300,6 +153069,7 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where
     fullOutput: % -> OutputForm
   
   Implementation == add
+
     Rep := Union(recRep,K)
     
     -- signature of local function  
@@ -125591,10 +153361,299 @@ PseudoAlgebraicClosureOfFiniteField(K):Exports == Implementation where
       
 \end{chunk}
 
-
 \begin{chunk}{COQ PACOFF}
 (* domain PACOFF *)
 (*
+
+    Rep := Union(recRep,K)
+    
+    -- signature of local function  
+    replaceRecEl: (%,SUP(%)) -> %
+    down: % -> %
+    localRandom: % -> %
+    repPolynomial : % -> SUP(%)
+    
+    replaceRecEl(a,el)==
+      a case K => a
+      aa:=copy a
+      aa.recEl := el
+      aa
+
+    -- local variable    
+    localTower :% := 1$K
+        
+    localSize :NNI := size()$K
+    -- implemetation of exported function
+
+    degree(a)==
+      da:PositiveInteger:= extDegree a
+      coerce(da@PositiveInteger)$OnePointCompletion(PositiveInteger)
+
+    repPolynomial(a)==
+      a case K => error "Is in ground field"
+      (a pretend recRep).recEl
+
+    inv(a)==
+      a case K => inv(a)$K
+      aRecEl:= repPolynomial a
+      aDefPoly:= definingPolynomial a 
+      aInv := extendedEuclidean( aRecEl , aDefPoly, 1 )
+      aInv  case "failed" => error "PACOFF : division by zero"
+      down replaceRecEl( a , aInv.coef1 )
+      
+    a:% ** n:PositiveInteger == 
+      zero?(a) => 0
+      expt( a , n )$RepeatedSquaring(%)
+
+    a:% ** n:NonNegativeInteger == 
+      zero?(a) and zero?(n) => error " --- 0^0 not defined "
+      zero?(n) => 1$%
+      a ** ( n pretend PositiveInteger )
+
+    a:% ** n:Integer ==
+      n < 0 => inv( a ** ( (-n)  pretend PositiveInteger) )
+      a ** ( n pretend NonNegativeInteger )
+
+    unitNormal(a)==
+      zero? a => [1,0,1]
+      [a,1,inv a]
+
+    ground?(a)== a case K
+
+    vectorise(a,lev)==
+      da:=extDegree a
+      dlev:=extDegree lev
+      dlev < da => _
+       error "Cannot vectorise at a lower level than the element to vectorise"
+      lev case K => [a]
+      pa:SUP(%)
+      na:%
+      ^(da = dlev) =>
+        pa:=  monomial(a,0)$SUP(%)
+        na:=  replaceRecEl(lev,pa)
+        vectorise(na,lev)$%
+      prevLev:=previousTower(lev)
+      a case K => _
+       error "At this point a is not suppose to be in K, big error"
+      aEl:=(a pretend recRep).recEl
+      daEl:=degree(definingPolynomial a)$SUP(%)
+      lv:=[vectorise(c,prevLev)$% for c in entries(vectorise(aEl,daEl)$SUP(%))]
+      concat lv        
+          
+    size == localSize
+
+    setTower!(a) ==
+      localTower:=a
+      localSize:=(size()$K)**extDegree(a)
+      void()
+      
+    localRandom(a) ==
+        --return a random element at the extension of a
+      a case K => random()$K
+      subF:=previousTower(a)
+      d:=degree(a.recTower)-1
+      pol:=reduce("+",[monomial(localRandom(subF),i)$SUP(%) for i in 0..d])
+      down replaceRecEl(a,pol)
+         
+    a:% + b:% ==
+      (a case K) and (b case K) => a +$K b
+      extDegree(a) > extDegree(b) => b + a
+      res1:SUP(%)
+      res2:%
+      if extDegree(a) = extDegree(b) then
+        res1:=   b.recEl +$SUP(%) a.recEl
+        res2:=   replaceRecEl(b,res1)
+      else
+        res1:=   b.recEl +$SUP(%) monomial(a,0)$SUP(%)
+        res2:= replaceRecEl(b,res1)
+      down(res2)
+         
+    a:% * b:% ==
+      (a case K) and (b case K) => a *$K b
+      extDegree(a) > extDegree(b) => b * a
+      res1:SUP(%)
+      res2:%
+      if extDegree(a) = extDegree(b) then
+        res1:=   b.recEl *$SUP(%) a.recEl rem b.recTower
+        res2:=   replaceRecEl(b,res1)
+      else
+        res1:=   b.recEl *$SUP(%) monomial(a,0)$SUP(%)
+        res2:=  replaceRecEl(b,res1)
+      down(res2)
+      
+    distinguishedRootsOf(polyZero,ee) ==
+        setTower!(ee)
+        zero?(polyZero) => error "to lazy to give you all the roots of 0 !!!"
+        factorf: Factored SUP % :=  factor(polyZero)$FFFACTSE(%,SUP(%))
+        listFact:List SUP %  := [pol.fctr for pol in factorList(factorf)]
+        listOfZeros:List(%):=empty()
+        for p in listFact repeat
+          root:=newElement(p, new(D::Symbol)$Symbol)
+          listOfZeros:List(%):=concat([ root ], listOfZeros)
+        listOfZeros
+    
+    random==
+      localRandom(localTower)
+
+    extDegOfGrdField:PI := 
+      i: PI := 1
+      while characteristic()$K ** i < size()$K repeat
+        i:= i + 1
+      i
+
+    charthRoot(a : %): % ==
+      --return a**(1/chararcteristic )
+      a case K => charthRoot(retract a)$K
+      b:NNI := extDegree(a) * extDegOfGrdField
+      j := subtractIfCan(b,1)
+      if (j case "failed") then b:= 0
+      else b:= j
+      c:= (characteristic()$K) ** b
+      a**c
+
+    conjugate(a)==
+      a ** size()$K 
+
+    1 == 1$K
+
+    0 == 0$K
+
+    newElement(pol:SUP(%),subF:%,inName:Symbol): % ==
+        -- pol is an irreducible polynomial over the field extension
+        -- given by subF. 
+        -- The output of this function is a root of pol.
+      dp:=degree pol
+      one?(dp) =>
+        listCoef:=coefficients(pol)
+        one?(#listCoef) => 0
+        - last(listCoef) / first(listCoef)
+      ground?(pol) => error "Cannot create a new element with a constant"
+      d:PI := (dp pretend PI) * extDegree(subF)
+      [monomial(1$%,1),pol,d,subF,inName] :: Rep
+      
+    newElement(poll:SUP(%),inName:Symbol)==
+      newElement(poll,localTower,inName)
+       
+    maxTower(la)==
+        --return an element from the list la which is in the largest
+        --extension of the ground field
+        --PRECONDITION: all elements in same tower, else no meaning?
+      m:=reduce("max",[extDegree(a) for a in la])
+      first [b for b in la | extDegree(b)=m]
+
+    --Field operations 
+
+    a:% / b:% == a * inv(b)
+    
+    a:K * b:%==
+      (a :: %) * b
+      
+    b:% * a:K == a*b
+
+    a:% - b:% ==
+      a + (-b)
+    
+    a:% * b:Fraction(Integer) ==
+      bn:=numer b
+      bd:=denom b
+      ebn:%:= bn * 1$%
+      ebd:%:= bd * 1$%
+      a * ebn * inv(ebd)
+
+    -a:% ==
+       a case K => -$K a 
+       [-$SUP(%) (a pretend recRep).recEl,_
+        (a pretend recRep).recTower,_
+        (a pretend recRep).recDeg,_
+        (a pretend recRep).recPrevTower,_
+        (a pretend recRep).recName ]
+       
+    n:INT * a:% ==
+      one?(n) => a
+      zero?(a) or zero?(n) => 0
+      (n < 0) => - ((-n)*a)
+      mm:PositiveInteger:=(n pretend PositiveInteger)
+      double(mm,a)$RepeatedDoubling(%)
+        
+    bb:% = aa:% ==
+      b:=down bb
+      a:=down aa
+      ^( extDegree(b) =$NNI extDegree(a) ) => false
+      (b case K)  =>  ( (retract a)  =$K (retract b) )
+      rda := a :: recRep
+      rdb := b :: recRep
+      not (rda.recTower =$SUP(%) rdb.recTower) => false
+      rdb.recEl =$SUP(%) rda.recEl
+        
+    zero?(a:%) == 
+      da:=down a  -- just to be sure !!!
+      ^(da case K) => false
+      zero?(da)$K
+    
+    one?(a:%) ==
+      da:= down a  -- just to be sure !!!
+      ^(da case K) => false
+      one?(da)$K
+    
+    --Coerce Functions
+      
+    coerce(a:K) == a       
+
+    retractIfCan(a)==
+      a case K => a
+      "failed"
+               
+    coerce(a:%):OutputForm ==
+      a case K => (retract a)::OutputForm
+      outputForm((a pretend recRep).recEl,_
+                ((a pretend recRep).recName)::OutputForm) $SUP(%)
+
+    fullOutput(a:%):OutputForm==
+      a case K => (retract a)::OutputForm
+      (a pretend recRep)::OutputForm
+      
+    definingPolynomial(a:%): SUP % ==
+      a case K => 1
+      (a pretend recRep).recTower
+
+    extDegree(a:%): PI ==
+      a case K => 1
+      (a pretend recRep).recDeg
+      
+    previousTower(a:%):% ==
+      a case K => error "No previous extension for ground field element"
+      (a pretend recRep).recPrevTower
+ 
+    name(a:%):Symbol ==
+      a case K => error "No name for ground field element"
+      (a pretend recRep).recName
+
+    -- function related to the ground field 
+    
+    lookup(a:%)==
+      aa:=down a
+      ^(aa case K) => _
+        error "From NonGlobalDynamicExtensionOfFiniteField fnc Lookup: Cannot take i-dex"
+      lookup(retract aa)$K
+
+    index(i)==(index(i)$K) 
+
+    fromPrimeField? == characteristic()$K = size()$K
+    
+    representationType == representationType()$K
+   
+    characteristic == characteristic()$K
+
+    -- implementation of local functions
+    
+    down(a:%) == 
+      a case K => a
+      aa:=(a pretend recRep)
+      elel := aa.recEl
+      ^ground?(elel) => a
+      gel:%:=ground(elel)
+      down(gel)
+      
 *)
 
 \end{chunk}
@@ -125845,6 +153904,7 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where
     newElement: (SUP(%), SUP(%), PI,  %, Symbol) -> %
   
   Implementation == add
+
     Rep := Union(recRep,K)
     
     -- signature of local function  
@@ -126091,10 +154151,254 @@ PseudoAlgebraicClosureOfRationalNumber:Exports == Implementation where
 
 \end{chunk}
 
-
 \begin{chunk}{COQ PACRAT}
 (* domain PACRAT *)
 (*
+
+    Rep := Union(recRep,K)
+    
+    -- signature of local function  
+    replaceRecEl: (%,SUP(%)) -> %
+    down: % -> %
+    
+    down(a:%) == 
+      a case K => a
+      aa:=(a pretend recRep)
+      elel := aa.recEl
+      ^ground?(elel)$SUP(%) => a
+      gel:%:=ground(elel)
+      down(gel)
+      
+    coerce(a:Integer):%== (a :: K)
+
+    n:INT * a:% ==
+      one?(n) => a
+      zero?(a) or zero?(n) => 0
+      (n < 0) => - ((-n)*a)
+      mm:PositiveInteger:=(n pretend PositiveInteger)
+      double(mm,a)$RepeatedDoubling(%)
+
+    replaceRecEl(a,el)==
+      a case K => a
+      aa:=copy a
+      aa.recEl := el
+      aa
+
+    -- local variable    
+    localTower :% := 1$K
+        
+    -- implemetation of exported function
+
+    lift(a) == 
+      a case K => monomial(a,0)
+      (a pretend recRep).recEl
+
+    lift(a,b)==
+      extDegree a > extDegree b => _
+          error "Cannot lift something at lower level !!!!!"
+      extDegree a < extDegree b => monomial(a,0)$SUP(%)
+      lift a
+
+    reduce(a)==
+      localTower case K => 
+        coefficient(a,0)
+      ar:= a rem (localTower pretend recRep).recTower
+      replaceRecEl(localTower,ar)
+       
+    maxTower(la)==
+        --return an element from the list la which is in the largest
+        --extension of the ground field
+        --PRECONDITION: all elements in same tower, else no meaning?
+      m:="max"/[extDegree(a)$% for a in la]
+      first [b for b in la | extDegree(b)=m]
+
+    ground?(a)== a case K
+
+    vectorise(a,lev)==
+      da:=extDegree a
+      dlev:=extDegree lev
+      dlev < da => _
+        error "Cannot vectorise at a lower level than the element to vectorise"
+      lev case K => [a]
+      pa:SUP(%)
+      na:%
+      ^(da = dlev) =>
+        pa:=  monomial(a,0)$SUP(%)
+        na:=  replaceRecEl(lev,pa)
+        vectorise(na,lev)$%
+      prevLev:=previousTower(lev)
+      a case K => error "At this point a is not suppose to be in K"
+      aEl:=(a pretend recRep).recEl
+      daEl:=degree definingPolynomial(a)$%
+      lv:=[vectorise(c,prevLev)$% for c in entries(vectorise(aEl,daEl)$SUP(%))]
+      concat lv        
+
+    setTower!(a) ==
+      localTower:=a
+      void()
+      
+    definingPolynomial == definingPolynomial(localTower)
+         
+    a:% + b:% ==
+      (a case K) and (b case K) => a +$K b
+      extDegree(a) > extDegree(b) => b + a
+      res1:SUP(%)
+      res2:%
+      if extDegree(a) = extDegree(b) then
+        res1:=   b.recEl +$SUP(%) a.recEl
+        res2:=   replaceRecEl(b,res1)
+      else
+        res1:=   b.recEl +$SUP(%) monomial(a,0)$SUP(%)
+        res2:= replaceRecEl(b,res1)
+      down(res2)
+         
+    a:% * b:% ==
+      (a case K) and (b case K) => a *$K b
+      extDegree(a) > extDegree(b) => b * a
+      res1:SUP(%)
+      res2:%
+      if extDegree(a) = extDegree(b) then
+        res1:=   b.recEl *$SUP(%) a.recEl rem b.recTower
+        res2:=   replaceRecEl(b,res1)
+      else
+        res1:=   b.recEl *$SUP(%) monomial(a,0)$SUP(%)
+        res2:=  replaceRecEl(b,res1)
+      down(res2)
+      
+    distinguishedRootsOf(polyZero,ee) ==
+        setTower!(ee)
+        zero?(polyZero) => error "to lazy to give you all the roots of 0 !!!"
+        factorf: Factored SUP % :=  factor(polyZero,ee)$FACTRN(%)
+        listFact:List SUP %  := [pol.fctr for pol in factorList(factorf)]
+        listOfZeros:List(%):=empty()
+        for p in listFact repeat
+          root:=newElement(p, new(D::Symbol)$Symbol)
+          listOfZeros:List(%):=concat([ root ], listOfZeros)
+        listOfZeros
+
+    1 == 1$K
+
+    0 == 0$K
+
+    newElement(pol:SUP(%),subF:%,inName:Symbol): % ==
+        -- pol is an irreducible polynomial over the field extension
+        -- given by subF. 
+        -- The output of this function is a root of pol.
+      dp:=degree pol
+      one?(dp) =>
+        listCoef:=coefficients(pol)
+        one?(#listCoef) => 0
+        - last(listCoef) / first(listCoef)
+      ground?(pol) => error "Cannot create a new element with a constant"
+      d:PI := (dp pretend PI) * extDegree(subF)
+      [monomial(1$%,1),pol,d,subF,inName] :: Rep
+      
+    newElement(poll:SUP(%),inName:Symbol)==
+      newElement(poll,localTower,inName)
+
+    newElement(elPol:SUP(%),pol:SUP(%),d:PI,subF:%,inName:Symbol): % ==
+      [elPol, pol,d,subF,inName] :: Rep
+
+    --Field operations 
+    inv(a)==
+      a case K => inv(a)$K
+      aRecEl:= (a pretend recRep).recEl
+      aDefPoly:= (a pretend recRep).recTower
+      aInv := extendedEuclidean( aRecEl , aDefPoly, 1 )
+      aInv  case "failed" => error "PACOFF : division by zero"
+      -- On doit retourner un Record représentant l'inverse de a.
+      -- Ce Record est exactement le même que celui de a sauf
+      -- qu'il faut remplacer le polynôme du selecteur recEl
+      -- par le polynôme représentant l'inverse de a :
+      -- C'est ce que fait la fonction replaceRecEl.
+      replaceRecEl( a , aInv.coef1 )     
+
+    a:% / b:% == a * inv(b)
+    
+    a:K * b:%==
+      (a :: %) * b
+      
+    b:% * a:K == a*b
+
+    a:% - b:% ==
+      a + (-b)
+    
+    a:% * b:Fraction(Integer) ==
+      bn:=numer b
+      bd:=denom b
+      ebn:%:= bn * 1$%
+      ebd:%:= bd * 1$%
+      a * ebn * inv(ebd)
+
+    -a:% ==
+       a case K => -$K a 
+       [-$SUP(%) (a pretend recRep).recEl,_
+        (a pretend recRep).recTower,_
+        (a pretend recRep).recDeg,_
+        (a pretend recRep).recPrevTower,_
+        (a pretend recRep).recName ]
+        
+    bb:% = aa:% ==
+      b:=down bb
+      a:=down aa
+      ^( extDegree(b) =$NNI extDegree(a) ) => false
+      (b case K)  =>  ( (retract a)@K  =$K (retract b)@K )
+      rda := a :: recRep
+      rdb := b :: recRep
+      not (rda.recTower =$SUP(%) rdb.recTower) => false
+      rdb.recEl =$SUP(%) rda.recEl
+        
+    zero?(a:%) == 
+      da:=down a  -- just to be sure !!!
+      ^(da case K) => false
+      zero?(da)$K
+    
+    one?(a:%) ==
+      da:= down a  -- just to be sure !!!
+      ^(da case K) => false
+      one?(da)$K
+    
+    --Coerce Functions
+      
+    coerce(a:K):% == a       
+
+    retractIfCan(a:%):Union(Integer,"failed")==
+      a case K => retractIfCan(a)$K
+      "failed"
+         
+    retractIfCan(a:%):Union(K,"failed")==
+      a case K => a
+      "failed"
+               
+    coerce(a:%):OutputForm ==
+      a case K => ((retract a)@K) ::OutputForm
+      outputForm((a pretend recRep).recEl,_
+                ((a pretend recRep).recName)::OutputForm) $SUP(%)
+
+    fullOutput(a:%):OutputForm==
+      a case K => ((retract a)@K) ::OutputForm
+      (a pretend recRep)::OutputForm
+      
+    definingPolynomial(a:%): SUP % ==
+      a case K => monomial(1,1)$SUP(%)
+      (a pretend recRep).recTower
+
+    extDegree(a:%): PI ==
+      a case K => 1
+      (a pretend recRep).recDeg
+      
+    previousTower(a:%):% ==
+      a case K => error "No previous extension for ground field element"
+      (a pretend recRep).recPrevTower
+ 
+    name(a:%):Symbol ==
+      a case K => error "No name for ground field element"
+      (a pretend recRep).recName
+
+    -- function related to the ground field 
+    
+    characteristic == characteristic()$K
+
 *)
 
 \end{chunk}
@@ -126211,7 +154515,9 @@ QuadraticForm(n, K): T == Impl where
             not symmetric? m =>
                 error "quadraticForm requires a symmetric matrix"
             m::%
+
         matrix q == q pretend SM(n,K)
+
         elt(q,v) == dot(v, (matrix q * v))
 
 \end{chunk}
@@ -126219,6 +154525,18 @@ QuadraticForm(n, K): T == Impl where
 \begin{chunk}{COQ QFORM}
 (* domain QFORM *)
 (*
+ SM(n,K) add
+        Rep := SM(n,K)
+ 
+        quadraticForm m ==
+            not symmetric? m =>
+                error "quadraticForm requires a symmetric matrix"
+            m::%
+
+        matrix q == q pretend SM(n,K)
+
+        elt(q,v) == dot(v, (matrix q * v))
+
 *)
 
 \end{chunk}
@@ -126421,6 +154739,7 @@ QuasiAlgebraicSet(R, Var,Expon,Dpoly) : C == T
          ++ inequation reduced with respect to the basis, using a heuristic
          ++ algorithm based on factoring.
    T  == add
+
      Rep := Record(status:Status,zero:List Dpoly, nzero:Dpoly)
      x:$
  
@@ -126450,7 +154769,7 @@ QuasiAlgebraicSet(R, Var,Expon,Dpoly) : C == T
          mset:=[setDifference(s,nzro) for s in mset]
          zro:=groebner [*/s for s in mset]
          member? (1$Dpoly, zro) => empty()
-         [x.status, zro, primitivePart redPol(*/nzro, zro)]
+         [x.status, zro, primitivePart redPol( */nzro, zro)]
  
      npoly(f:Dpoly) : newPoly ==
        zero? f => 0
@@ -126475,10 +154794,15 @@ QuasiAlgebraicSet(R, Var,Expon,Dpoly) : C == T
        x.status :: Boolean
  
      empty() == [true::Status, [1$Dpoly], 0$Dpoly]
+
      status x == x.status
+
      setStatus(x,t) == [t,x.zero,x.nzero]
+
      definingEquations x == x.zero
+
      definingInequation x == x.nzero
+
      quasiAlgebraicSet(z0,n0) == ["failed", z0, n0]
  
      idealSimplify x ==
@@ -126503,13 +154827,105 @@ QuasiAlgebraicSet(R, Var,Expon,Dpoly) : C == T
  
      overset?(p,qlist) ==
        empty? qlist => false
-       or/[(brace$(Set Dpoly) q) <$(Set Dpoly) (brace$(Set Dpoly) p) for q in qlist]
+       or/[(brace$(Set Dpoly) q) <$(Set Dpoly) (brace$(Set Dpoly) p) _
+           for q in qlist]
 
 \end{chunk}
 
 \begin{chunk}{COQ QALGSET}
 (* domain QALGSET *)
 (*
+
+     Rep := Record(status:Status,zero:List Dpoly, nzero:Dpoly)
+     x:$
+ 
+     import GroebnerPackage(R,Expon,Var,Dpoly)
+     import GroebnerPackage(R,newExpon,Var,newPoly)
+     import GroebnerInternalPackage(R,Expon,Var,Dpoly)
+ 
+                       ----  Local Functions  ----
+ 
+     minset   : List List Dpoly -> List List Dpoly
+     overset? : (List Dpoly, List List Dpoly) -> Boolean
+     npoly    : Dpoly            ->  newPoly
+     oldpoly  : newPoly          ->  Union(Dpoly,"failed")
+ 
+ 
+     if (R has EuclideanDomain) and (R has CharacteristicZero) then
+       factorset (y:Dpoly):List Dpoly ==
+         ground? y => []
+         [j.factor for j in factors factor$mrf  y]
+ 
+       simplify x ==
+         if x.status case "failed" then
+           x:=quasiAlgebraicSet(zro:=groebner x.zero, redPol(x.nzero,zro))
+         (pnzero:=x.nzero)=0 => empty()
+         nzro:=factorset pnzero
+         mset:=minset [factorset p for p in x.zero]
+         mset:=[setDifference(s,nzro) for s in mset]
+         zro:=groebner [*/s for s in mset]
+         member? (1$Dpoly, zro) => empty()
+         [x.status, zro, primitivePart redPol(*/nzro, zro)]
+ 
+     npoly(f:Dpoly) : newPoly ==
+       zero? f => 0
+       monomial(leadingCoefficient f,makeprod(0,degree f))$newPoly +
+             npoly(reductum f)
+ 
+     oldpoly(q:newPoly) : Union(Dpoly,"failed") ==
+       q=0$newPoly => 0$Dpoly
+       dq:newExpon:=degree q
+       n:NNI:=selectfirst (dq)
+       n^=0 => "failed"
+       ((g:=oldpoly reductum q) case "failed") => "failed"
+       monomial(leadingCoefficient q,selectsecond dq)$Dpoly + (g::Dpoly)
+ 
+     coerce x ==
+       x.status = true => "Empty"::Ex
+       bracket [[hconcat(f::Ex, " = 0"::Ex) for f in x.zero ]::Ex,
+                 hconcat( x.nzero::Ex, " != 0"::Ex)]
+ 
+     empty? x ==
+       if x.status case "failed" then x:=idealSimplify x
+       x.status :: Boolean
+ 
+     empty() == [true::Status, [1$Dpoly], 0$Dpoly]
+
+     status x == x.status
+
+     setStatus(x,t) == [t,x.zero,x.nzero]
+
+     definingEquations x == x.zero
+
+     definingInequation x == x.nzero
+
+     quasiAlgebraicSet(z0,n0) == ["failed", z0, n0]
+ 
+     idealSimplify x ==
+       x.status case Boolean => x
+       z0:= x.zero
+       n0:= x.nzero
+       empty? z0 => [false, z0, n0]
+       member? (1$Dpoly, z0) => empty()
+       tp:newPoly:=(monomial(1,makeprod(1,0$Expon))$newPoly * npoly n0)-1
+       ngb:=groebner concat(tp, [npoly g for g in z0])
+       member? (1$newPoly, ngb) => empty()
+       gb:List Dpoly:=nil
+       while not empty? ngb repeat
+         if ((f:=oldpoly ngb.first) case Dpoly) then gb:=concat(f, gb)
+         ngb:=ngb.rest
+       [false::Status, gb, primitivePart redPol(n0, gb)]
+ 
+ 
+     minset lset ==
+       empty? lset => lset
+       [s for s  in lset | ^(overset?(s,lset))]
+ 
+     overset?(p,qlist) ==
+       empty? qlist => false
+       or/[(brace$(Set Dpoly) q) <$(Set Dpoly) (brace$(Set Dpoly) p) _
+           for q in qlist]
+
 *)
 
 \end{chunk}
@@ -126911,17 +155327,22 @@ o )show Quaternion
 ++ imaginary part and the k imaginary part.
  
 Quaternion(R:CommutativeRing): QuaternionCategory(R) == add
+
   Rep := Record(r:R,i:R,j:R,k:R)
  
   0 == [0,0,0,0]
+
   1 == [1,0,0,0]
  
   a,b,c,d : R
   x,y : $
  
   real  x == x.r
+
   imagI x == x.i
+
   imagJ x == x.j
+
   imagK x == x.k
  
   quatern(a,b,c,d) == [a,b,c,d]
@@ -126936,6 +155357,31 @@ Quaternion(R:CommutativeRing): QuaternionCategory(R) == add
 \begin{chunk}{COQ QUAT}
 (* domain QUAT *)
 (*
+
+  Rep := Record(r:R,i:R,j:R,k:R)
+ 
+  0 == [0,0,0,0]
+
+  1 == [1,0,0,0]
+ 
+  a,b,c,d : R
+  x,y : $
+ 
+  real  x == x.r
+
+  imagI x == x.i
+
+  imagJ x == x.j
+
+  imagK x == x.k
+ 
+  quatern(a,b,c,d) == [a,b,c,d]
+ 
+  x * y == [x.r*y.r-x.i*y.i-x.j*y.j-x.k*y.k,
+               x.r*y.i+x.i*y.r+x.j*y.k-x.k*y.j,
+                 x.r*y.j+x.j*y.r+x.k*y.i-x.i*y.k,
+                   x.r*y.k+x.k*y.r+x.i*y.j-x.j*y.i]
+
 *)
 
 \end{chunk}
@@ -127016,10 +155462,15 @@ QueryEquation(): Exports == Implementation where
     value: % -> String
       ++ value(q) returns the value (i.e. right hand side) of \axiom{q}.
   Implementation == add
+
     Rep := Record(var:Symbol, val:String)
+
     coerce(u) == coerce(u.var)$Symbol = coerce(u.val)$String
+
     equation(x,s) == [x,s]
+
     variable q == q.var
+
     value q == q.val
 
 \end{chunk}
@@ -127027,6 +155478,17 @@ QueryEquation(): Exports == Implementation where
 \begin{chunk}{COQ QEQUAT}
 (* domain QEQUAT *)
 (*
+
+    Rep := Record(var:Symbol, val:String)
+
+    coerce(u) == coerce(u.var)$Symbol = coerce(u.val)$String
+
+    equation(x,s) == [x,s]
+
+    variable q == q.var
+
+    value q == q.val
+
 *)
 
 \end{chunk}
@@ -127902,24 +156364,36 @@ Queue(S:SetCategory): QueueAggregate S with
         ++X count(4,a)
 
   == Stack S add
+
     Rep := Reference List S
+
     lastTail==> LAST$Lisp
+
     enqueue_!(e,q) ==
         if null deref q then setref(q, list e)
         else lastTail.(deref q).rest := list e
         e
+
     insert_!(e,q) == (enqueue_!(e,q);q)
+
     dequeue_! q ==
         empty? q => error "empty queue"
         e := first deref q
         setref(q,rest deref q)
         e
+
     extract_! q == dequeue_! q
+
     rotate_! q == if empty? q then q else (enqueue_!(dequeue_! q,q); q)
+
     length q == # deref q
+
     front q == if empty? q then error "empty queue" else first deref q
+
     inspect q == front q
+
     back q == if empty? q then error "empty queue" else last deref q
+
     queue q == ref copy q
 
 \end{chunk}
@@ -127927,6 +156401,38 @@ Queue(S:SetCategory): QueueAggregate S with
 \begin{chunk}{COQ QUEUE}
 (* domain QUEUE *)
 (*
+
+    Rep := Reference List S
+
+    lastTail==> LAST$Lisp
+
+    enqueue_!(e,q) ==
+        if null deref q then setref(q, list e)
+        else lastTail.(deref q).rest := list e
+        e
+
+    insert_!(e,q) == (enqueue_!(e,q);q)
+
+    dequeue_! q ==
+        empty? q => error "empty queue"
+        e := first deref q
+        setref(q,rest deref q)
+        e
+
+    extract_! q == dequeue_! q
+
+    rotate_! q == if empty? q then q else (enqueue_!(dequeue_! q,q); q)
+
+    length q == # deref q
+
+    front q == if empty? q then error "empty queue" else first deref q
+
+    inspect q == front q
+
+    back q == if empty? q then error "empty queue" else last deref q
+
+    queue q == ref copy q
+
 *)
 
 \end{chunk}
@@ -128304,19 +156810,33 @@ RadicalFunctionField(F, UP, UPUP, radicnd, n): Exports == Impl where
     mini := minIndex ibasis
 
     discriminant()                   == (INIT; discPoly())
+
     radcand()                        == (INIT; newrad())
+
     integralBasis()                  == (INIT; diag ibasis)
+
     integralBasisAtInfinity()        == (INIT; diag infbasis)
+
     basisvec()                       == (INIT; ibasis)
+
     integralMatrix()                 == diagonalMatrix basisvec()
+
     integralMatrixAtInfinity()       == (INIT; diagonalMatrix infbasis)
+
     inverseIntegralMatrix()          == (INIT; diagonalMatrix invibasis)
+
     inverseIntegralMatrixAtInfinity()==(INIT;diagonalMatrix invinfbasis)
+
     definingPolynomial()             == modulus
+
     ramified?(point:F)               == zero?(radcand() point)
+
     branchPointAtInfinity?()  == (degree(radcand()) exquo n) case "failed"
+
     elliptic()     == (n = 2 and degree(radcand()) = 3 => radcand(); "failed")
+
     hyperelliptic() == (n=2 and odd? degree(radcand()) => radcand(); "failed")
+
     diag v == [reduce monomial(qelt(v,i+mini), i) for i in 0..n1]
 
     integralRepresents(v, d) ==
@@ -128338,16 +156858,16 @@ RadicalFunctionField(F, UP, UPUP, radicnd, n): Exports == Impl where
                                          for i in mini..maxIndex v]$Vector(RF))
       [diagonalMatrix(cd.num), cd.den]
 
--- return (d0,...,d(n-1)) s.t. (1/d0, y/d1,...,y**(n-1)/d(n-1))
--- is an integral basis for the curve y**d = p
--- requires that p has no factor of multiplicity >= d
+    -- return (d0,...,d(n-1)) s.t. (1/d0, y/d1,...,y**(n-1)/d(n-1))
+    -- is an integral basis for the curve y**d = p
+    -- requires that p has no factor of multiplicity >= d
     iBasis(p, d) ==
       pl := fullVector(squareFree p, d)
       d1 := (d - 1)::N
       [*/[pl.j ** ((i * j) quo d) for j in 0..d1] for i in 0..d1]
 
--- returns a vector [a0,a1,...,a_{m-1}] of length m such that
--- p = a0^0 a1^1 ... a_{m-1}^{m-1}
+    -- returns a vector [a0,a1,...,a_{m-1}] of length m such that
+    -- p = a0^0 a1^1 ... a_{m-1}^{m-1}
     fullVector(p, m) ==
       ans:PrimitiveArray(UP) := new(m, 0)
       ans.0 := unit p
@@ -128358,8 +156878,8 @@ RadicalFunctionField(F, UP, UPUP, radicnd, n): Exports == Impl where
           (u::REC).factor
       ans
 
--- return (f0,...,f(n-1)) s.t. (f0, y f1,..., y**(n-1) f(n-1))
--- is a local integral basis at infinity for the curve y**d = p
+    -- return (f0,...,f(n-1)) s.t. (f0, y f1,..., y**(n-1) f(n-1))
+    -- is a local integral basis at infinity for the curve y**d = p
     inftyBasis(p, m) ==
       rt := rootPoly(p(x := inv(monomial(1, 1)$UP :: RF)), m)
       m ^= rt.exponent =>
@@ -128452,6 +156972,192 @@ RadicalFunctionField(F, UP, UPUP, radicnd, n): Exports == Impl where
 \begin{chunk}{COQ RADFF}
 (* domain RADFF *)
 (*
+ SimpleAlgebraicExtension(RF, UPUP, MOD) add
+    import ChangeOfVariable(F, UP, UPUP)
+    import InnerCommonDenominator(UP, RF, Vector UP, Vector RF)
+    import UnivariatePolynomialCategoryFunctions2(RF, UPUP, UP, UP2)
+
+    diag        : Vector RF -> Vector $
+    startUp     : Boolean -> Void
+    fullVector  : (Factored UP, N) -> PrimitiveArray UP
+    iBasis      : (UP, N) -> Vector UP
+    inftyBasis  : (RF, N) -> Vector RF
+    basisvec    : () -> Vector RF
+    char0StartUp: () -> Void
+    charPStartUp: () -> Void
+    getInfBasis : () -> Void
+    radcand     : () -> UP
+    charPintbas : (UPUP, RF, Vector RF, Vector RF) -> Void
+
+    brandNew?:Reference(Boolean) := ref true
+    discPoly:Reference(RF) := ref(0$RF)
+    newrad:Reference(UP) := ref(0$UP)
+    n1 := (n - 1)::N
+    modulus := MOD
+    ibasis:Vector(RF)     := new(n, 0)
+    invibasis:Vector(RF)  := new(n, 0)
+    infbasis:Vector(RF)   := new(n, 0)
+    invinfbasis:Vector(RF):= new(n, 0)
+    mini := minIndex ibasis
+
+    discriminant()                   == (INIT; discPoly())
+
+    radcand()                        == (INIT; newrad())
+
+    integralBasis()                  == (INIT; diag ibasis)
+
+    integralBasisAtInfinity()        == (INIT; diag infbasis)
+
+    basisvec()                       == (INIT; ibasis)
+
+    integralMatrix()                 == diagonalMatrix basisvec()
+
+    integralMatrixAtInfinity()       == (INIT; diagonalMatrix infbasis)
+
+    inverseIntegralMatrix()          == (INIT; diagonalMatrix invibasis)
+
+    inverseIntegralMatrixAtInfinity()==(INIT;diagonalMatrix invinfbasis)
+
+    definingPolynomial()             == modulus
+
+    ramified?(point:F)               == zero?(radcand() point)
+
+    branchPointAtInfinity?()  == (degree(radcand()) exquo n) case "failed"
+
+    elliptic()     == (n = 2 and degree(radcand()) = 3 => radcand(); "failed")
+
+    hyperelliptic() == (n=2 and odd? degree(radcand()) => radcand(); "failed")
+
+    diag v == [reduce monomial(qelt(v,i+mini), i) for i in 0..n1]
+
+    integralRepresents(v, d) ==
+      ib := basisvec()
+      represents
+        [qelt(ib, i) * (qelt(v, i) /$RF d) for i in mini .. maxIndex ib]
+
+    integralCoordinates f ==
+      v  := coordinates f
+      ib := basisvec()
+      splitDenominator
+        [qelt(v,i) / qelt(ib,i) for i in mini .. maxIndex ib]$Vector(RF)
+
+    integralDerivationMatrix d ==
+      dlogp := differentiate(radicnd, d) / (n * radicnd)
+      v := basisvec()
+      cd := splitDenominator(
+                [(i - mini) * dlogp + differentiate(qelt(v, i), d) / qelt(v, i)
+                                         for i in mini..maxIndex v]$Vector(RF))
+      [diagonalMatrix(cd.num), cd.den]
+
+    -- return (d0,...,d(n-1)) s.t. (1/d0, y/d1,...,y**(n-1)/d(n-1))
+    -- is an integral basis for the curve y**d = p
+    -- requires that p has no factor of multiplicity >= d
+    iBasis(p, d) ==
+      pl := fullVector(squareFree p, d)
+      d1 := (d - 1)::N
+      [*/[pl.j ** ((i * j) quo d) for j in 0..d1] for i in 0..d1]
+
+    -- returns a vector [a0,a1,...,a_{m-1}] of length m such that
+    -- p = a0^0 a1^1 ... a_{m-1}^{m-1}
+    fullVector(p, m) ==
+      ans:PrimitiveArray(UP) := new(m, 0)
+      ans.0 := unit p
+      l := factors p
+      for i in 1..maxIndex ans repeat
+        ans.i :=
+          (u := find(s+->s.exponent = i, l)) case "failed" => 1
+          (u::REC).factor
+      ans
+
+    -- return (f0,...,f(n-1)) s.t. (f0, y f1,..., y**(n-1) f(n-1))
+    -- is a local integral basis at infinity for the curve y**d = p
+    inftyBasis(p, m) ==
+      rt := rootPoly(p(x := inv(monomial(1, 1)$UP :: RF)), m)
+      m ^= rt.exponent =>
+        error "Curve not irreducible after change of variable 0 -> infinity"
+      a    := (rt.coef) x
+      b:RF := 1
+      v    := iBasis(rt.radicand, m)
+      w:Vector(RF) := new(m, 0)
+      for i in mini..maxIndex v repeat
+        qsetelt_!(w, i, b / ((qelt(v, i)::RF) x))
+        b := b * a
+      w
+
+    charPintbas(p, c, v, w) ==
+      degree(p) ^= n => error "charPintbas: should not happen"
+      q:UP2 := map(s+->retract(s)@UP, p)
+      ib := integralBasis()$FunctionFieldIntegralBasis(UP, UP2,
+                                          SimpleAlgebraicExtension(UP, UP2, q))
+      not diagonal?(ib.basis)=> 
+         error "charPintbas: integral basis not diagonal"
+      a:RF := 1
+      for i in minRowIndex(ib.basis) .. maxRowIndex(ib.basis)
+        for j in minColIndex(ib.basis) .. maxColIndex(ib.basis)
+          for k in mini .. maxIndex v repeat
+            qsetelt_!(v, k, (qelt(ib.basis, i, j) / ib.basisDen) * a)
+            qsetelt_!(w, k, qelt(ib.basisInv, i, j) * inv a)
+            a := a * c
+      void
+
+    charPStartUp() ==
+      r      := mkIntegral modulus
+      charPintbas(r.poly, r.coef, ibasis, invibasis)
+      x      := inv(monomial(1, 1)$UP :: RF)
+      invmod := monomial(1, n)$UPUP - (radicnd x)::UPUP
+      r      := mkIntegral invmod
+      charPintbas(r.poly, (r.coef) x, infbasis, invinfbasis)
+
+    startUp b ==
+      brandNew?() := b
+      if zero?(p := characteristic()$F) or p > n then char0StartUp()
+                                                 else charPStartUp()
+      dsc:RF := ((-1)$Z ** ((n *$N n1) quo 2::N) * (n::Z)**n)$Z *
+               radicnd ** n1 *
+                  */[qelt(ibasis, i) ** 2 for i in mini..maxIndex ibasis]
+      discPoly() := primitivePart(numer dsc) / denom(dsc)
+      void
+
+    char0StartUp() ==
+      rp          := rootPoly(radicnd, n)
+      rp.exponent ^= n => 
+         error "RadicalFunctionField: curve is not irreducible"
+      newrad()    := rp.radicand
+      ib          := iBasis(newrad(), n)
+      infb        := inftyBasis(radicnd, n)
+      invden:RF   := 1
+      for i in mini..maxIndex ib repeat
+        qsetelt_!(invibasis, i, a := qelt(ib, i) * invden)
+        qsetelt_!(ibasis, i, inv a)
+        invden := invden / rp.coef        -- always equals 1/rp.coef**(i-mini)
+        qsetelt_!(infbasis, i, a := qelt(infb, i))
+        qsetelt_!(invinfbasis, i, inv a)
+      void
+
+    ramified?(p:UP) ==
+      (r := retractIfCan(p)@Union(F, "failed")) case F =>
+        singular?(r::F)
+      (radcand() exquo p) case UP
+
+    singular?(p:UP) ==
+      (r := retractIfCan(p)@Union(F, "failed")) case F =>
+        singular?(r::F)
+      (radcand() exquo(p**2)) case UP
+
+    branchPoint?(p:UP) ==
+      (r := retractIfCan(p)@Union(F, "failed")) case F =>
+        branchPoint?(r::F)
+      ((q := (radcand() exquo p)) case UP) and
+        ((q::UP exquo p) case "failed")
+
+    singular?(point:F) ==
+      zero?(radcand()  point) and
+        zero?(((radcand() exquo (monomial(1,1)$UP-point::UP))::UP) point)
+
+    branchPoint?(point:F) ==
+      zero?(radcand()  point) and not
+        zero?(((radcand() exquo (monomial(1,1)$UP-point::UP))::UP) point)
+
 *)
 
 \end{chunk}
@@ -129013,6 +157719,7 @@ RadixExpansion(bb): Exports == Implementation where
       ++ e.g., \spad{fractRadix([1],[6])} will return \spad{0.16666666...}.
 
   Implementation ==> add
+
     -- The efficiency of arithmetic operations is poor.
     -- Could use a lazy eval where either rational rep
     -- or list of ragit rep (the current) or both are kept
@@ -129033,26 +157740,42 @@ RadixExpansion(bb): Exports == Implementation where
 
     -- Arithmetic operations
     characteristic() == 0
+
     differentiate a == 0
 
     0     == [1, nil(),  nil(), nil()]
+
     1     == [1, [1], nil(), nil()]
+
     - a   == (a = 0 => 0; [-a.sgn, a.int, a.pfx, a.cyc])
+
     a + b == (a::RN + b::RN)::%
+
     a - b == (a::RN - b::RN)@RN::%
+
     n * a == (n     * a::RN)::%
+
     a * b == (a::RN * b::RN)::%
+
     a / b == (a::RN / b::RN)::%
+
     (i:I) / (j:I) == (i/j)@RN :: %
+
     a < b == a::RN < b::RN
+
     a = b == a.sgn = b.sgn and a.int = b.int and
              a.pfx = b.pfx and a.cyc = b.cyc
+
     numer a == numer(a::RN)
+
     denom a == denom(a::RN)
 
     -- Algebraic coercions
+
     coerce(a):RN == (wholePart a) :: RN + fractionPart a
+
     coerce(n):%  == n :: RN :: %
+
     coerce(q):%  ==
       s := 1; if q < 0 then (s := -1; q := -q)
       qr      := divide(numer q,denom q)
@@ -129067,13 +157790,16 @@ RadixExpansion(bb): Exports == Implementation where
       "failed"
 
     -- Exported constructor/destructors
+
     ceiling a == ceiling(a::RN)
+
     floor a == floor(a::RN)
 
     wholePart a ==
       n0 := 0
       for r in a.int repeat n0 := bb*n0 + r
       a.sgn*n0
+
     fractionPart a ==
       n0 := 0
       for r in a.pfx repeat n0 := bb*n0 + r
@@ -129086,13 +157812,17 @@ RadixExpansion(bb): Exports == Implementation where
       a.sgn*n/d
 
     wholeRagits  a == a.int
+
     fractRagits  a == concat(construct(a.pfx)@ST,repeating a.cyc)
+
     prefixRagits a == a.pfx
+
     cycleRagits  a == a.cyc
 
     wholeRadix li ==
       checkRagits li
       [1, li, nil(), nil()]
+
     fractRadix(lpfx, lcyc) ==
       checkRagits lpfx; checkRagits lcyc
       [1, nil(), lpfx, lcyc]
@@ -129204,6 +157934,216 @@ RadixExpansion(bb): Exports == Implementation where
 \begin{chunk}{COQ RADIX}
 (* domain RADIX *)
 (*
+
+    -- The efficiency of arithmetic operations is poor.
+    -- Could use a lazy eval where either rational rep
+    -- or list of ragit rep (the current) or both are kept
+    -- as demanded.
+
+    bb < 2 => error "Radix base must be at least 2"
+    Rep := Record(sgn: Integer,      int: List Integer,
+                  pfx: List Integer, cyc: List Integer)
+
+    q:     RN
+    qr:    QuoRem
+    a,b:   %
+    n:     I
+
+    radixInt:    (I, I)    -> List I
+    radixFrac:   (I, I, I) -> Record(pfx: List I, cyc: List I)
+    checkRagits: List I    -> Boolean
+
+    -- Arithmetic operations
+    characteristic() == 0
+
+    differentiate a == 0
+
+    0     == [1, nil(),  nil(), nil()]
+
+    1     == [1, [1], nil(), nil()]
+
+    - a   == (a = 0 => 0; [-a.sgn, a.int, a.pfx, a.cyc])
+
+    a + b == (a::RN + b::RN)::%
+
+    a - b == (a::RN - b::RN)@RN::%
+
+    n * a == (n     * a::RN)::%
+
+    a * b == (a::RN * b::RN)::%
+
+    a / b == (a::RN / b::RN)::%
+
+    (i:I) / (j:I) == (i/j)@RN :: %
+
+    a < b == a::RN < b::RN
+
+    a = b == a.sgn = b.sgn and a.int = b.int and
+             a.pfx = b.pfx and a.cyc = b.cyc
+
+    numer a == numer(a::RN)
+
+    denom a == denom(a::RN)
+
+    -- Algebraic coercions
+
+    coerce(a):RN == (wholePart a) :: RN + fractionPart a
+
+    coerce(n):%  == n :: RN :: %
+
+    coerce(q):%  ==
+      s := 1; if q < 0 then (s := -1; q := -q)
+      qr      := divide(numer q,denom q)
+      whole   := radixInt (qr.quotient,bb)
+      fractn  := radixFrac(qr.remainder,denom q,bb)
+      cycle   := (fractn.cyc = [0] => nil(); fractn.cyc)
+      [s,whole,fractn.pfx,cycle]
+
+    retractIfCan(a):Union(RN,"failed") == a::RN
+    retractIfCan(a):Union(I,"failed") ==
+      empty?(a.pfx) and empty?(a.cyc) => wholePart a
+      "failed"
+
+    -- Exported constructor/destructors
+
+    ceiling a == ceiling(a::RN)
+
+    floor a == floor(a::RN)
+
+    wholePart a ==
+      n0 := 0
+      for r in a.int repeat n0 := bb*n0 + r
+      a.sgn*n0
+
+    fractionPart a ==
+      n0 := 0
+      for r in a.pfx repeat n0 := bb*n0 + r
+      null a.cyc =>
+          a.sgn*n0/bb**((#a.pfx)::NNI)
+      n1 := n0
+      for r in a.cyc repeat n1 := bb*n1 + r
+      n := n1 - n0
+      d := (bb**((#a.cyc)::NNI) - 1) * bb**((#a.pfx)::NNI)
+      a.sgn*n/d
+
+    wholeRagits  a == a.int
+
+    fractRagits  a == concat(construct(a.pfx)@ST,repeating a.cyc)
+
+    prefixRagits a == a.pfx
+
+    cycleRagits  a == a.cyc
+
+    wholeRadix li ==
+      checkRagits li
+      [1, li, nil(), nil()]
+
+    fractRadix(lpfx, lcyc) ==
+      checkRagits lpfx; checkRagits lcyc
+      [1, nil(), lpfx, lcyc]
+
+    -- Output
+
+    ALPHAS : String := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+
+    intToExpr(i:I): OUT ==
+      -- computes a digit for bases between 11 and 36
+      i < 10 => i :: OUT
+      elt(ALPHAS,(i-10) + minIndex(ALPHAS)) :: OUT
+
+    exprgroup(le: List OUT): OUT ==
+      empty? le      => error "exprgroup needs non-null list"
+      empty? rest le => first le
+      abs bb <= 36 => hconcat le
+      blankSeparate le
+
+    intgroup(li: List I): OUT ==
+      empty? li      => error "intgroup needs non-null list"
+      empty? rest li => intToExpr first(li)
+      abs bb <= 10 => hconcat [i :: OUT for i in li]
+      abs bb <= 36 => hconcat [intToExpr(i) for i in li]
+      blankSeparate [i :: OUT for i in li]
+
+    overBar(li: List I): OUT == overbar intgroup li
+
+    coerce(a): OUT ==
+      le : List OUT := nil()
+      if not null a.cyc then le := concat(overBar  a.cyc,le)
+      if not null a.pfx then le := concat(intgroup a.pfx,le)
+      if not null le    then le := concat("." :: OUT,le)
+      if not null a.int then le := concat(intgroup a.int,le)
+      else le := concat(0 :: OUT,le)
+      rex := exprgroup le
+      if a.sgn < 0 then -rex else rex
+
+    -- Construction utilities
+    checkRagits li ==
+      for i in li repeat if i < 0 or i >= bb then
+        error "Each ragit (digit) must be between 0 and base-1"
+      true
+
+    radixInt(n,bas) ==
+      rits: List I := nil()
+      while abs n ^= 0 repeat
+        qr   := divide(n,bas)
+        n    := qr.quotient
+        rits := concat(qr.remainder,rits)
+      rits
+
+    radixFrac(num,den,bas) ==
+      -- Rits is the sequence of quotient/remainder pairs
+      -- in calculating the radix expansion of the rational number.
+      -- We wish to find p and c such that
+      --    rits.i are distinct    for 0<=i<=p+c-1
+      --    rits.i = rits.(i+p)    for i>p
+      -- I.e. p is the length of the non-periodic prefix and c is
+      -- the length of the cycle.
+
+      -- Compute p and c using Floyd's algorithm.
+      -- 1. Find smallest n s.t. rits.n = rits.(2*n)
+      qr    := divide(bas * num, den)
+      i : I := 0
+      qr1i  := qr2i := qr
+      rits: List QuoRem := [qr]
+      until qr1i = qr2i repeat
+        qr1i := divide(bas * qr1i.remainder,den)
+        qrt  := divide(bas * qr2i.remainder,den)
+        qr2i := divide(bas * qrt.remainder,den)
+        rits := concat(qr2i, concat(qrt, rits))
+        i    := i + 1
+      rits := reverse_! rits
+      n    := i
+      -- 2. Find p = first i such that rits.i = rits.(i+n)
+      ritsi := rits
+      ritsn := rits; for i in 1..n repeat ritsn := rest ritsn
+      i := 0
+      while first(ritsi) ^= first(ritsn) repeat
+        ritsi := rest ritsi
+        ritsn := rest ritsn
+        i     := i + 1
+      p := i
+      -- 3. Find c = first i such that rits.p = rits.(p+i)
+      ritsn := rits; for i in 1..n repeat ritsn := rest ritsn
+      rn    := first ritsn
+      cfound:= false
+      c : I := 0
+      for i in 1..p while not cfound repeat
+        ritsn := rest ritsn
+        if rn = first(ritsn) then
+          c := i
+          cfound := true
+      if not cfound then c := n
+      -- 4. Now produce the lists of ragits.
+      ritspfx: List I := nil()
+      ritscyc: List I := nil()
+      for i in 1..p repeat
+        ritspfx := concat(first(rits).quotient, ritspfx)
+        rits    := rest rits
+      for i in 1..c repeat
+        ritscyc := concat(first(rits).quotient, ritscyc)
+        rits    := rest rits
+      [reverse_! ritspfx, reverse_! ritscyc]
+
 *)
 
 \end{chunk}
@@ -130785,7 +159725,6 @@ RealClosure(TheField): PUB == PRIV where
           xx:$ := coerce(x)
           outputForm(univariate(xx.val),x.outForm)$SUP
 
-
        inv(x) ==
           (res:= recip x) case "failed" => error "Division by 0"
           res :: $
@@ -130835,10 +159774,6 @@ RealClosure(TheField): PUB == PRIV where
          zero?(rep.val,rep.seg)$SEG => 0
          rep
 
---       zero?(x) ==
---          x case TheField => zero?(x)$TheField
---          zero?(x.val,x.seg)$SEG
- 
        zero?(x) ==
           x case TheField => zero?(x)$TheField
           false
@@ -130868,12 +159803,10 @@ RealClosure(TheField): PUB == PRIV where
               -- however wee need to call lessAlgebraic  
           nonNull([x.seg,x.val + y.val,x.outForm,x.order])
 
-
        -x ==
           x case TheField => -$TheField (x::TheField)
           [x.seg,-$PME x.val,x.outForm,x.order]$Rec
 
-
        retractIfCan(x:$):Union(TheField,"failed") ==
           x case TheField => x
           o := x.order
@@ -130890,7 +159823,6 @@ RealClosure(TheField): PUB == PRIV where
           o = res.order => error "Can't retract"
           retract res
 
-
        lessAlgebraic(x) ==
           x case TheField => x
           degree(x.val) = 0 => leadingCoefficient(x.val)
@@ -130910,6 +159842,243 @@ RealClosure(TheField): PUB == PRIV where
 \begin{chunk}{COQ RECLOS}
 (* domain RECLOS *)
 (*
+
+-- local functions
+
+       lessAlgebraic  : $ -> $
+       newElementIfneeded : (SEG,E) -> $
+
+-- Representation
+
+       Rec := Record(seg: SEG, val:PME, outForm:E, order:N)
+       Rep := Union(TheField,Rec)
+
+-- global (mutable) variables
+
+       orderOfCreation : N := 1$N
+          -- it is internally used to sort the algebraic levels
+
+       instanceName : Symbol := new()$Symbol
+          -- this used to print the results, thus different instanciations
+          -- use different names
+
+-- now the code
+
+       relativeApprox(nbe,prec) ==
+          nbe case TheField => retract(nbe)
+          appr := relativeApprox(nbe.val, nbe.seg, prec)
+          -- now appr has the good exact precision but is $
+          relativeApprox(appr,prec)
+
+
+       approximate(nbe,prec) ==
+          abs(nbe) < prec => 0
+          nbe case TheField => retract(nbe)
+          appr := approximate(nbe.val, nbe.seg, prec)
+          -- now appr has the good exact precision but is $
+          approximate(appr,prec)
+
+       newElementIfneeded(s,o) ==
+         p := definingPolynomial(s)
+         degree(p) = 1 => 
+             - coefficient(p,0) / leadingCoefficient(p)
+         res := [s, monomial(1,1), o, orderOfCreation ]$Rec
+         orderOfCreation := orderOfCreation + 1
+         res :: $
+
+       algebraicOf(s,o) ==
+         pol := definingPolynomial(s)
+         degree(pol) = 1 => 
+           -coefficient(pol,0) / leadingCoefficient(pol) 
+         res := [s, monomial(1,1), o, orderOfCreation ]$Rec
+         orderOfCreation := orderOfCreation + 1
+         res :: $
+         
+       rename!(x,o) ==
+         x.outForm := o
+         x
+
+       rename(x,o) ==
+         [x.seg, x.val, o, x.order]$Rec
+
+       rootOf(pol,n) ==
+        degree(pol) = 0 => "failed"
+        degree(pol) = 1 =>
+          if n=1
+          then
+            -coefficient(pol,0) / leadingCoefficient(pol)
+          else
+            "failed"
+        r := rootOf(pol,n)$SEG
+        r case "failed" => "failed"
+        o := hconcat(instanceName :: E , orderOfCreation :: E)$E
+        algebraicOf(r,o)
+
+       allRootsOf(pol:SUP):List($) == 
+        degree(pol)=0 => []
+        degree(pol)=1 => [-coefficient(pol,0) / leadingCoefficient(pol)]
+        liste := allRootsOf(pol)$SEG
+        res : List $ := []
+        for term in liste repeat
+           o := hconcat(instanceName :: E , orderOfCreation :: E)$E
+           res := cons(algebraicOf(term,o), res)
+        reverse! res
+
+       coerce(x:$):$ ==
+          x case TheField => x
+          [x.seg,x.val rem$PME definingPolynomial(x.seg),x.outForm,x.order]$Rec
+
+       positive?(x) == 
+          x case TheField => positive?(x)$TheField
+          positive?(x.val,x.seg)$SEG
+
+       negative?(x) == 
+          x case TheField => negative?(x)$TheField
+          negative?(x.val,x.seg)$SEG
+
+       abs(x) == sign(x)*x
+
+       sign(x) ==
+          x case TheField => sign(x)$TheField
+          sign(x.val,x.seg)$SEG
+
+       x < y == positive?(y-x)
+
+       x = y == zero?(x-y)
+
+       mainCharacterization(x) ==
+          x case TheField => "failed"
+          x.seg
+
+       mainDefiningPolynomial(x) ==
+          x case TheField => "failed"
+          definingPolynomial x.seg
+
+       mainForm(x) ==
+          x case TheField => "failed"
+          x.outForm
+
+       mainValue(x) ==
+          x case TheField => "failed"
+          x.val
+
+       coerce(x:$):E ==
+          x case TheField => x::TheField :: E
+          xx:$ := coerce(x)
+          outputForm(univariate(xx.val),x.outForm)$SUP
+
+       inv(x) ==
+          (res:= recip x) case "failed" => error "Division by 0"
+          res :: $
+
+       recip(x) ==
+         x case TheField =>
+           if ((r := recip(x)$TheField) case TheField)
+           then r::$
+           else "failed"
+         if ((r := recip(x.val,x.seg)$SEG) case "failed")
+         then "failed"
+         else lessAlgebraic([x.seg,r::PME,x.outForm,x.order]$Rec) 
+
+       (n:Z * x:$):$ == 
+          x case TheField => n *$TheField x
+          zero?(n) => 0
+          one?(n) => x
+          [x.seg,map(z+->n*z, x.val),x.outForm,x.order]$Rec
+
+       (rn:TheField * x:$):$ == 
+          x case TheField => rn *$TheField x
+          zero?(rn) => 0
+          one?(rn) => x
+          [x.seg,map(z+->rn*z, x.val),x.outForm,x.order]$Rec
+
+       (x:$ * y:$):$ ==
+          (x case TheField) and (y case TheField) => x *$TheField y
+          (x case TheField) => x::TheField * y
+              -- x is no longer TheField
+          (y case TheField) => y::TheField * x
+              -- now both are algebraic
+          y.order > x.order => 
+            [y.seg,map(z+->x*z , y.val),y.outForm,y.order]$Rec
+          x.order > y.order => 
+            [x.seg,map(z+->z*y , x.val),x.outForm,x.order]$Rec
+              -- now x.exp = y.exp
+              -- we will multiply the polynomials and then reduce
+              -- however wee need to call lessAlgebraic  
+          lessAlgebraic([x.seg,
+                         (x.val * y.val) rem definingPolynomial(x.seg),
+                         x.outForm,
+                         x.order]$Rec)
+
+       nonNull(rep:Rec):$ ==
+         degree(rep.val)=0 => leadingCoefficient(rep.val)
+         numberOfMonomials(rep.val) = 1 => rep
+         zero?(rep.val,rep.seg)$SEG => 0
+         rep
+
+       zero?(x) ==
+          x case TheField => zero?(x)$TheField
+          false
+ 
+       x + y ==
+          (x case TheField) and (y case TheField) => x +$TheField y
+          (x case TheField) => 
+             if zero?(x)
+             then 
+               y
+             else 
+               nonNull([y.seg,x::PME+(y.val),y.outForm,y.order]$Rec)
+             -- x is no longer TheField
+          (y case TheField) => 
+             if zero?(y)
+             then 
+               x
+             else 
+               nonNull([x.seg,(x.val)+y::PME,x.outForm,x.order]$Rec)
+             -- now both are algebraic
+          y.order > x.order => 
+               nonNull([y.seg,x::PME+y.val,y.outForm,y.order]$Rec)
+          x.order > y.order => 
+               nonNull([x.seg,(x.val)+y::PME,x.outForm,x.order]$Rec)
+              -- now x.exp = y.exp 
+              -- we simply add polynomials (since degree cannot increase)
+              -- however wee need to call lessAlgebraic  
+          nonNull([x.seg,x.val + y.val,x.outForm,x.order])
+
+       -x ==
+          x case TheField => -$TheField (x::TheField)
+          [x.seg,-$PME x.val,x.outForm,x.order]$Rec
+
+       retractIfCan(x:$):Union(TheField,"failed") ==
+          x case TheField => x
+          o := x.order
+          res := lessAlgebraic x
+          res case TheField => res
+          o = res.order => "failed"
+          retractIfCan res
+
+       retract(x:$):TheField ==
+          x case TheField => x
+          o := x.order
+          res := lessAlgebraic x
+          res case TheField => res
+          o = res.order => error "Can't retract"
+          retract res
+
+       lessAlgebraic(x) ==
+          x case TheField => x
+          degree(x.val) = 0 => leadingCoefficient(x.val)
+          def := definingPolynomial(x.seg)
+          degree(def) = 1 => 
+            x.val.(- coefficient(def,0) / leadingCoefficient(def))
+          x
+
+       0 == (0$TheField) :: $
+
+       1 == (1$TheField) :: $
+
+       coerce(rn:TheField):$ == rn :: $
+
 *)
 
 \end{chunk}
@@ -131124,6 +160293,7 @@ RectangularMatrix(m,n,R): Exports == Implementation where
       ans pretend $
  
     row(x,i)    == directProduct row(x pretend Matrix(R),i)
+
     column(x,j) == directProduct column(x pretend Matrix(R),j)
  
     coerce(x:$):Matrix(R) == copy(x pretend Matrix(R))
@@ -131140,7 +160310,9 @@ RectangularMatrix(m,n,R): Exports == Implementation where
     if R has IntegralDomain then
  
       rank x    == rank(x pretend Matrix(R))
+
       nullity x == nullity(x pretend Matrix(R))
+
       nullSpace x ==
         [directProduct c for c in nullSpace(x pretend Matrix(R))]
  
@@ -131149,6 +160321,7 @@ RectangularMatrix(m,n,R): Exports == Implementation where
       dimension() == (m * n) :: CardinalNumber
  
     if R has ConvertibleTo InputForm then
+
       convert(x:$):InputForm ==
          convert [convert("rectangularMatrix"::Symbol)@InputForm,
                   convert(x::Matrix(R))]$List(InputForm)
@@ -131158,6 +160331,64 @@ RectangularMatrix(m,n,R): Exports == Implementation where
 \begin{chunk}{COQ RMATRIX}
 (* domain RMATRIX *)
 (*
+ Matrix R add
+    minr ==> minRowIndex
+    maxr ==> maxRowIndex
+    minc ==> minColIndex
+    maxc ==> maxColIndex
+    mini ==> minIndex
+    maxi ==> maxIndex
+ 
+    ZERO := new(m,n,0)$Matrix(R) pretend $
+    0    == ZERO
+ 
+    coerce(x:$):OutputForm == coerce(x pretend Matrix R)$Matrix(R)
+
+    matrix(l: List List R) ==
+      -- error check: this is a top level function
+      #l ^= m => error "matrix: wrong number of rows"
+      for ll in l repeat
+        #ll ^= n => error "matrix: wrong number of columns"
+      ans : Matrix R := new(m,n,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 pretend $
+ 
+    row(x,i)    == directProduct row(x pretend Matrix(R),i)
+
+    column(x,j) == directProduct column(x pretend Matrix(R),j)
+ 
+    coerce(x:$):Matrix(R) == copy(x pretend Matrix(R))
+ 
+    rectangularMatrix x ==
+      (nrows(x) ^= m) or (ncols(x) ^= n) =>
+        error "rectangularMatrix: matrix of bad dimensions"
+      copy(x) pretend $
+ 
+    if R has EuclideanDomain then
+ 
+      rowEchelon x == rowEchelon(x pretend Matrix(R)) pretend $
+ 
+    if R has IntegralDomain then
+ 
+      rank x    == rank(x pretend Matrix(R))
+
+      nullity x == nullity(x pretend Matrix(R))
+
+      nullSpace x ==
+        [directProduct c for c in nullSpace(x pretend Matrix(R))]
+ 
+    if R has Field then
+ 
+      dimension() == (m * n) :: CardinalNumber
+ 
+    if R has ConvertibleTo InputForm then
+
+      convert(x:$):InputForm ==
+         convert [convert("rectangularMatrix"::Symbol)@InputForm,
+                  convert(x::Matrix(R))]$List(InputForm)
+
 *)
 
 \end{chunk}
@@ -131258,16 +160489,23 @@ Reference(S:Type): Type with
         if S has SetCategory then SetCategory
 
     == add
+
         Rep := Record(value: S)
 
         p = q        == EQ(p, q)$Lisp
+
         ref v        == [v]
+
         elt p        == p.value
+
         setelt(p, v) == p.value := v
+
         deref p      == p.value
+
         setref(p, v) == p.value := v
 
         if S has SetCategory then
+
           coerce p ==
             prefix(message("ref"@String), [p.value::OutputForm])
 
@@ -131276,6 +160514,26 @@ Reference(S:Type): Type with
 \begin{chunk}{COQ REF}
 (* domain REF *)
 (*
+
+        Rep := Record(value: S)
+
+        p = q        == EQ(p, q)$Lisp
+
+        ref v        == [v]
+
+        elt p        == p.value
+
+        setelt(p, v) == p.value := v
+
+        deref p      == p.value
+
+        setref(p, v) == p.value := v
+
+        if S has SetCategory then
+
+          coerce p ==
+            prefix(message("ref"@String), [p.value::OutputForm])
+
 *)
 
 \end{chunk}
@@ -133238,43 +162496,59 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where
      Rep ==> LP
 
      rep(s:$):Rep == s pretend Rep
+
      per(l:Rep):$ == l pretend $
 
      copy ts ==
        per(copy(rep(ts))$LP)
+
      empty() ==
        per([])
+
      empty?(ts:$) ==
        empty?(rep(ts))
+
      parts ts ==
        rep(ts)
+
      members ts ==
        rep(ts)
+
      map (f : PtoP, ts : $) : $ ==
        construct(map(f,rep(ts))$LP)$$
+
      map! (f : PtoP, ts : $) : $  ==
        construct(map!(f,rep(ts))$LP)$$
+
      member? (p,ts) ==
        member?(p,rep(ts))$LP
+
      unitIdealIfCan() ==
        "failed"::Union($,"failed")
+
      roughUnitIdeal? ts ==
        false
+
      coerce(ts:$) : OutputForm ==
        lp : List(P) := reverse(rep(ts))
        brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm
+
      mvar ts ==
        empty? ts => error "mvar$REGSET: #1 is empty"
        mvar(first(rep(ts)))$P
+
      first ts ==
        empty? ts => "failed"::Union(P,"failed")
        first(rep(ts))::Union(P,"failed")
+
      last ts ==
        empty? ts => "failed"::Union(P,"failed")
        last(rep(ts))::Union(P,"failed")
+
      rest ts ==
        empty? ts => "failed"::Union($,"failed")
        per(rest(rep(ts)))::Union($,"failed")
+
      coerce(ts:$) : (List P) ==
        rep(ts)
 
@@ -133342,7 +162616,7 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where
        empty? lp => ts
        internalAugment(rest lp, internalAugment(first lp, ts))
 
-     internalAugment(p:P,ts:$,rem?:B,red?:B,prim?:B,sqfr?:B,extend?:B): Split ==
+     internalAugment(p:P,ts:$,rem?:B,red?:B,prim?:B,sqfr?:B,extend?:B):Split ==
        -- ASSUME p is not a constant
        -- ASSUME mvar(p) is not algebraic w.r.t. ts
        -- ASSUME init(p) invertible modulo ts
@@ -133399,15 +162673,19 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where
      squareFreePart(p:P, ts: $): List PWT ==
        toseSquareFreePart(p,ts)$regsetgcdpack
 
-     intersect(p:P, ts: $): List($) == decompose([p], [ts], false, false)$regsetdecomppack
+     intersect(p:P, ts: $): List($) == 
+       decompose([p], [ts], false, false)$regsetdecomppack
 
-     intersect(lp: LP, lts: List($)): List($) == decompose(lp, lts, false, false)$regsetdecomppack
+     intersect(lp: LP, lts: List($)): List($) == 
+       decompose(lp, lts, false, false)$regsetdecomppack
         -- SOLVE in the regular zero sense 
         -- and DO NOT PRINT info
 
-     decompose(p:P, ts: $): List($) == decompose([p], [ts], true, false)$regsetdecomppack
+     decompose(p:P, ts: $): List($) == 
+       decompose([p], [ts], true, false)$regsetdecomppack
 
-     decompose(lp: LP, lts: List($)): List($) == decompose(lp, lts, true, false)$regsetdecomppack
+     decompose(lp: LP, lts: List($)): List($) == 
+       decompose(lp, lts, true, false)$regsetdecomppack
         -- SOLVE in the closure sense 
         -- and DO NOT PRINT info
 
@@ -133437,7 +162715,8 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where
            if info? then (s1,s2,s3) := ("w","g","i") else (s1,s2,s3) := (e,e,e)
            if info? 
              then 
-               (dom1, dom2, dom3) := ("QCMPACK", "REGSETGCD: Gcd", "REGSETGCD: Inv Set")
+               (dom1, dom2, dom3) := _
+                  ("QCMPACK", "REGSETGCD: Gcd", "REGSETGCD: Inv Set")
              else
                (dom1, dom2, dom3) := (e,e,e)
            startTable!(s1,"W",dom1)$quasicomppack
@@ -133490,7 +162769,6 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where
        lts: List($) := []
        (numberOfVariables(lp,lts)$regsetdecomppack :: Z - #lp :: Z) < 2
 
---     lin?(p:P):Boolean == ground?(init(p)) and one?(mdeg(p))
      lin?(p:P):Boolean == ground?(init(p)) and (mdeg(p) = 1)
 
      pre_process(lp:LP,clos?:B,info?:B): Record(val: LP, towers: Split) ==
@@ -133562,6 +162840,349 @@ RegularTriangularSet(R,E,V,P) : Exports == Implementation where
 \begin{chunk}{COQ REGSET}
 (* domain REGSET *)
 (*
+
+     Rep ==> LP
+
+     rep(s:$):Rep == s pretend Rep
+
+     per(l:Rep):$ == l pretend $
+
+     copy ts ==
+       per(copy(rep(ts))$LP)
+
+     empty() ==
+       per([])
+
+     empty?(ts:$) ==
+       empty?(rep(ts))
+
+     parts ts ==
+       rep(ts)
+
+     members ts ==
+       rep(ts)
+
+     map (f : PtoP, ts : $) : $ ==
+       construct(map(f,rep(ts))$LP)$$
+
+     map! (f : PtoP, ts : $) : $  ==
+       construct(map!(f,rep(ts))$LP)$$
+
+     member? (p,ts) ==
+       member?(p,rep(ts))$LP
+
+     unitIdealIfCan() ==
+       "failed"::Union($,"failed")
+
+     roughUnitIdeal? ts ==
+       false
+
+     coerce(ts:$) : OutputForm ==
+       lp : List(P) := reverse(rep(ts))
+       brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm
+
+     mvar ts ==
+       empty? ts => error "mvar$REGSET: #1 is empty"
+       mvar(first(rep(ts)))$P
+
+     first ts ==
+       empty? ts => "failed"::Union(P,"failed")
+       first(rep(ts))::Union(P,"failed")
+
+     last ts ==
+       empty? ts => "failed"::Union(P,"failed")
+       last(rep(ts))::Union(P,"failed")
+
+     rest ts ==
+       empty? ts => "failed"::Union($,"failed")
+       per(rest(rep(ts)))::Union($,"failed")
+
+     coerce(ts:$) : (List P) ==
+       rep(ts)
+
+     collectUpper (ts,v) ==
+       empty? ts => ts
+       lp := rep(ts)
+       newlp : Rep := []
+       while (not empty? lp) and (mvar(first(lp)) > v) repeat
+         newlp := cons(first(lp),newlp)
+         lp := rest lp
+       per(reverse(newlp))
+
+     collectUnder (ts,v) ==
+       empty? ts => ts
+       lp := rep(ts)
+       while (not empty? lp) and (mvar(first(lp)) >= v) repeat
+         lp := rest lp
+       per(lp)
+
+     construct(lp:List(P)) ==
+       ts : $ := per([])
+       empty? lp => ts
+       lp := sort(infRittWu?,lp)
+       while not empty? lp repeat
+         eif := extendIfCan(ts,first(lp))
+         not (eif case $) =>
+           error"in construct : List P -> $  from REGSET : bad #1"
+         ts := eif::$
+         lp := rest lp
+       ts
+
+     extendIfCan(ts:$,p:P) ==
+       ground? p => "failed"::Union($,"failed")       
+       empty? ts => 
+         p := primitivePart p
+         (per([p]))::Union($,"failed")
+       not (mvar(ts) < mvar(p)) => "failed"::Union($,"failed")
+       invertible?(init(p),ts)@Boolean => 
+         (per(cons(p,rep(ts))))::Union($,"failed")
+       "failed"::Union($,"failed")
+
+     removeZero(p:P, ts:$): P ==
+       (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_-)
+
+     internalAugment(p:P,ts:$): $ ==
+       -- ASSUME that adding p to ts DOES NOT require any split
+       ground? p => error "in internalAugment$REGSET: ground? #1"
+       first(internalAugment(p,ts,false,false,false,false,false))
+
+     internalAugment(lp:List(P),ts:$): $ ==
+       -- ASSUME that adding p to ts DOES NOT require any split
+       empty? lp => ts
+       internalAugment(rest lp, internalAugment(first lp, ts))
+
+     internalAugment(p:P,ts:$,rem?:B,red?:B,prim?:B,sqfr?:B,extend?:B):Split ==
+       -- ASSUME p is not a constant
+       -- ASSUME mvar(p) is not algebraic w.r.t. ts
+       -- ASSUME init(p) invertible modulo ts
+       -- if rem? then REDUCE p by remainder
+       -- if prim? then REPLACE p by its main primitive part
+       -- if sqfr? then FACTORIZE SQUARE FREE p over R
+       -- if extend? DO NOT ASSUME every pol in ts_v_+ is invertible modulo ts
+       v := mvar(p)
+       ts_v_- := collectUnder(ts,v)
+       ts_v_+ := collectUpper(ts,v)
+       if rem? then p := remainder(p,ts_v_-).polnum
+       -- if rem? then p := reduceByQuasiMonic(p,ts_v_-)
+       if red? then p := removeZero(p,ts_v_-)
+       if prim? then p := mainPrimitivePart p
+       if sqfr?
+         then
+           lsfp := squareFreeFactors(p)$polsetpack
+           lts: Split := [per(cons(f,rep(ts_v_-))) for f in lsfp]
+         else
+           lts: Split := [per(cons(p,rep(ts_v_-)))]
+       extend? => extend(members(ts_v_+),lts)
+       [per(concat(rep(ts_v_+),rep(us))) for us in lts]
+
+     augment(p:P,ts:$): List $ ==
+       ground? p => error "in augment$REGSET: ground? #1"
+       algebraic?(mvar(p),ts) => error "in augment$REGSET: bad #1"
+       -- ASSUME init(p) invertible modulo ts
+       -- DOES NOT ASSUME anything else.
+       -- THUS reduction, mainPrimitivePart and squareFree are NEEDED
+       internalAugment(p,ts,true,true,true,true,true)
+
+     extend(p:P,ts:$): List $ ==
+       ground? p => error "in extend$REGSET: ground? #1"
+       v := mvar(p)
+       not (mvar(ts) < mvar(p)) => error "in extend$REGSET: bad #1"
+       lts: List($) := []
+       split: List($) := invertibleSet(init(p),ts)
+       for us in split repeat
+         lts := concat(augment(p,us),lts)
+       lts
+
+     invertible?(p:P,ts:$): Boolean == 
+       toseInvertible?(p,ts)$regsetgcdpack
+       
+     invertible?(p:P,ts:$): List BWT ==
+       toseInvertible?(p,ts)$regsetgcdpack
+
+     invertibleSet(p:P,ts:$): Split ==
+       toseInvertibleSet(p,ts)$regsetgcdpack
+
+     lastSubResultant(p1:P,p2:P,ts:$): List PWT ==
+       toseLastSubResultant(p1,p2,ts)$regsetgcdpack
+
+     squareFreePart(p:P, ts: $): List PWT ==
+       toseSquareFreePart(p,ts)$regsetgcdpack
+
+     intersect(p:P, ts: $): List($) == 
+       decompose([p], [ts], false, false)$regsetdecomppack
+
+     intersect(lp: LP, lts: List($)): List($) == 
+       decompose(lp, lts, false, false)$regsetdecomppack
+        -- SOLVE in the regular zero sense 
+        -- and DO NOT PRINT info
+
+     decompose(p:P, ts: $): List($) == 
+       decompose([p], [ts], true, false)$regsetdecomppack
+
+     decompose(lp: LP, lts: List($)): List($) == 
+       decompose(lp, lts, true, false)$regsetdecomppack
+        -- SOLVE in the closure sense 
+        -- and DO NOT PRINT info
+
+     zeroSetSplit(lp:List(P)) == zeroSetSplit(lp,true,false)
+        -- by default SOLVE in the closure sense 
+        -- and DO NOT PRINT info
+
+     zeroSetSplit(lp:List(P), clos?: B) == zeroSetSplit(lp,clos?, false)
+        -- DO NOT PRINT info
+
+     zeroSetSplit(lp:List(P), clos?: B, info?: B) ==
+       -- if clos? then SOLVE in the closure sense 
+       -- if info? then PRINT info
+       -- by default USE hash-tables
+       -- and PREPROCESS the input system
+       zeroSetSplit(lp,true,clos?,info?,true)
+
+     zeroSetSplit(lp:List(P),hash?:B,clos?:B,info?:B,prep?:B) == 
+       -- if hash? then USE hash-tables
+       -- if info? then PRINT information
+       -- if clos? then SOLVE in the closure sense
+       -- if prep? then PREPROCESS the input system
+       if hash? 
+         then
+           s1, s2, s3, dom1, dom2, dom3: String
+           e: String := empty()$String
+           if info? then (s1,s2,s3) := ("w","g","i") else (s1,s2,s3) := (e,e,e)
+           if info? 
+             then 
+               (dom1, dom2, dom3) := _
+                  ("QCMPACK", "REGSETGCD: Gcd", "REGSETGCD: Inv Set")
+             else
+               (dom1, dom2, dom3) := (e,e,e)
+           startTable!(s1,"W",dom1)$quasicomppack
+           startTableGcd!(s2,"G",dom2)$regsetgcdpack
+           startTableInvSet!(s3,"I",dom3)$regsetgcdpack
+       lts := internalZeroSetSplit(lp,clos?,info?,prep?)
+       if hash? 
+         then
+           stopTable!()$quasicomppack
+           stopTableGcd!()$regsetgcdpack
+           stopTableInvSet!()$regsetgcdpack
+       lts
+
+     internalZeroSetSplit(lp:LP,clos?:B,info?:B,prep?:B) ==
+       -- if info? then PRINT information
+       -- if clos? then SOLVE in the closure sense
+       -- if prep? then PREPROCESS the input system
+       if prep?
+         then
+           pp := pre_process(lp,clos?,info?)
+           lp := pp.val
+           lts := pp.towers
+         else
+           ts: $ := [[]]
+           lts := [ts]
+       lp := remove(zero?, lp)
+       any?(ground?, lp) => []
+       empty? lp => lts
+       empty? lts => lts
+       lp := sort(infRittWu?,lp)
+       clos? => decompose(lp,lts, clos?, info?)$regsetdecomppack
+       -- IN DIM > 0 with clos? the following is false ...
+       for p in lp repeat
+         lts := decompose([p],lts, clos?, info?)$regsetdecomppack
+       lts
+
+     largeSystem?(lp:LP): Boolean == 
+       -- Gonnet and Gerdt and not Wu-Wang.2
+       #lp > 16 => true
+       #lp < 13 => false
+       lts: List($) := []
+       (#lp :: Z - numberOfVariables(lp,lts)$regsetdecomppack :: Z) > 3
+
+     smallSystem?(lp:LP): Boolean == 
+       -- neural, Vermeer, Liu, and not f-633 and not Hairer-2
+       #lp < 5
+
+     mediumSystem?(lp:LP): Boolean == 
+       -- f-633 and not Hairer-2
+       lts: List($) := []
+       (numberOfVariables(lp,lts)$regsetdecomppack :: Z - #lp :: Z) < 2
+
+     lin?(p:P):Boolean == ground?(init(p)) and (mdeg(p) = 1)
+
+     pre_process(lp:LP,clos?:B,info?:B): Record(val: LP, towers: Split) ==
+       -- if info? then PRINT information
+       -- if clos? then SOLVE in the closure sense
+       ts: $ := [[]]; 
+       lts: Split := [ts]
+       empty? lp => [lp,lts]
+       lp1: List P := []
+       lp2: List P := []
+       for p in lp repeat 
+          ground? (tail p) => lp1 := cons(p, lp1)
+          lp2 := cons(p, lp2)
+       lts: Split := decompose(lp1,[ts],clos?,info?)$regsetdecomppack
+       probablyZeroDim?(lp)$polsetpack =>
+          largeSystem?(lp) => return [lp2,lts]
+          if #lp > 7
+            then 
+              -- Butcher (8,8) + Wu-Wang.2 (13,16) 
+              lp2 := crushedSet(lp2)$polsetpack
+              lp2 := remove(zero?,lp2)
+              any?(ground?,lp2) => return [lp2, lts]
+              lp3 := [p for p in lp2 | lin?(p)]
+              lp4 := [p for p in lp2 | not lin?(p)]
+              if clos?
+                then 
+                  lts := decompose(lp4,lts, clos?, info?)$regsetdecomppack
+                else
+                  lp4 := sort(infRittWu?,lp4)
+                  for p in lp4 repeat
+                    lts := decompose([p],lts, clos?, info?)$regsetdecomppack
+              lp2 := lp3
+            else
+              lp2 := crushedSet(lp2)$polsetpack
+              lp2 := remove(zero?,lp2)
+              any?(ground?,lp2) => return [lp2, lts]
+          if clos?
+            then
+              lts := decompose(lp2,lts, clos?, info?)$regsetdecomppack
+            else
+              lp2 := sort(infRittWu?,lp2)
+              for p in lp2 repeat
+                lts := decompose([p],lts, clos?, info?)$regsetdecomppack
+          lp2 := []
+          return [lp2,lts]
+       smallSystem?(lp) => [lp2,lts]
+       mediumSystem?(lp) => [crushedSet(lp2)$polsetpack,lts]
+       lp3 := [p for p in lp2 | lin?(p)]
+       lp4 := [p for p in lp2 | not lin?(p)]
+       if clos?
+         then 
+           lts := decompose(lp4,lts, clos?, info?)$regsetdecomppack
+         else
+           lp4 := sort(infRittWu?,lp4)
+           for p in lp4 repeat
+             lts := decompose([p],lts, clos?, info?)$regsetdecomppack
+       if clos?
+         then 
+           lts := decompose(lp3,lts, clos?, info?)$regsetdecomppack
+         else
+           lp3 := sort(infRittWu?,lp3)
+           for p in lp3 repeat
+             lts := decompose([p],lts, clos?, info?)$regsetdecomppack
+       lp2 := []
+       return [lp2,lts]
+
 *)
 
 \end{chunk}
@@ -133682,26 +163303,47 @@ ResidueRing(F,Expon,VarSet,FPol,LFPol) : Dom  == Body
      lift     :     $  -> FPol
      ++ lift(x) return the canonical representative of the equivalence class x
    Body  ==  add 
+
     --representation
+
       Rep:= FPol
+
       import GroebnerPackage(F,Expon,VarSet,FPol)
+
       relations:= groebner(LFPol)
+
       relations = [1] => error "the residue ring is the zero ring"
+
     --declarations
+
       x,y: $
+
     --definitions
+
       0 == 0$Rep
+
       1 == 1$Rep
+
       reduce(f : FPol) : $ == normalForm(f,relations)
+
       coerce(f : FPol) : $ == normalForm(f,relations)
+
       lift x  == x :: Rep :: FPol
+
       x + y == x +$Rep y
+
       -x == -$Rep x
+
       x*y == normalForm(lift(x *$Rep y),relations)
+
       (n : Integer) * x == n *$Rep x
+
       (a : F) * x == a *$Rep x
+
       x = y == x =$Rep y
+
       characteristic()      == characteristic()$F
+
       coerce(x) : OutputForm == coerce(x)$Rep
 
 \end{chunk}
@@ -133709,6 +163351,49 @@ ResidueRing(F,Expon,VarSet,FPol,LFPol) : Dom  == Body
 \begin{chunk}{COQ RESRING}
 (* domain RESRING *)
 (*
+
+    --representation
+
+      Rep:= FPol
+
+      import GroebnerPackage(F,Expon,VarSet,FPol)
+
+      relations:= groebner(LFPol)
+
+      relations = [1] => error "the residue ring is the zero ring"
+
+    --declarations
+
+      x,y: $
+
+    --definitions
+
+      0 == 0$Rep
+
+      1 == 1$Rep
+
+      reduce(f : FPol) : $ == normalForm(f,relations)
+
+      coerce(f : FPol) : $ == normalForm(f,relations)
+
+      lift x  == x :: Rep :: FPol
+
+      x + y == x +$Rep y
+
+      -x == -$Rep x
+
+      x*y == normalForm(lift(x *$Rep y),relations)
+
+      (n : Integer) * x == n *$Rep x
+
+      (a : F) * x == a *$Rep x
+
+      x = y == x =$Rep y
+
+      characteristic()      == characteristic()$F
+
+      coerce(x) : OutputForm == coerce(x)$Rep
+
 *)
 
 \end{chunk}
@@ -133931,10 +163616,12 @@ Result():Exports==Implementation where
 
     -- Constant
     colon := ": "::Symbol::O
+
     elide := "..."::Symbol::O
 
     -- Flags
     showScalarValuesFlag : Boolean := false
+
     showArrayValuesFlag  : Boolean := false
 
     cleanUpDomainForm(d:SExpression):O ==
@@ -133944,7 +163631,8 @@ Result():Exports==Implementation where
       -- then we have some kind of value.  Since we often can't print these
       -- ****ers we just elide them.
       not atom? car d => elide
-      prefix((car d)::O,[cleanUpDomainForm(u) for u in destruct cdr(d)]$List(O))
+      prefix((car d)::O,[cleanUpDomainForm(u) _
+                         for u in destruct cdr(d)]$List(O))
 
     display(v:Any,d:SExpression):O ==
       not list? d => error "Domain form is non-list"
@@ -133964,6 +163652,7 @@ Result():Exports==Implementation where
       bracket [makeEntry(key,r.key) for key in reverse! keys(r)]
 
     showArrayValues(b:Boolean):Boolean  == showArrayValuesFlag := b
+
     showScalarValues(b:Boolean):Boolean == showScalarValuesFlag := b
 
 \end{chunk}
@@ -133971,6 +163660,48 @@ Result():Exports==Implementation where
 \begin{chunk}{COQ RESULT}
 (* domain RESULT *)
 (*
+
+    -- Constant
+    colon := ": "::Symbol::O
+
+    elide := "..."::Symbol::O
+
+    -- Flags
+    showScalarValuesFlag : Boolean := false
+
+    showArrayValuesFlag  : Boolean := false
+
+    cleanUpDomainForm(d:SExpression):O ==
+      not list? d => d::O
+      #d=1 => (car d)::O
+      -- If the car is an atom then we have a domain constructor, if not
+      -- then we have some kind of value.  Since we often can't print these
+      -- ****ers we just elide them.
+      not atom? car d => elide
+      prefix((car d)::O,[cleanUpDomainForm(u) _
+                         for u in destruct cdr(d)]$List(O))
+
+    display(v:Any,d:SExpression):O ==
+      not list? d => error "Domain form is non-list"
+      #d=1 =>
+       showScalarValuesFlag => objectOf v
+       cleanUpDomainForm d
+      car(d) = convert("Complex"::Symbol)@SExpression =>
+       showScalarValuesFlag => objectOf v
+       cleanUpDomainForm d
+      showArrayValuesFlag => objectOf v
+      cleanUpDomainForm d
+       
+    makeEntry(k:Symbol,v:Any):O ==
+      hconcat [k::O,colon,display(v,dom v)]
+
+    coerce(r:%):O == 
+      bracket [makeEntry(key,r.key) for key in reverse! keys(r)]
+
+    showArrayValues(b:Boolean):Boolean  == showArrayValuesFlag := b
+
+    showScalarValues(b:Boolean):Boolean == showScalarValuesFlag := b
+
 *)
 
 \end{chunk}
@@ -134145,6 +163876,7 @@ RewriteRule(Base, R, F): Exports == Implementation where
       ++ but just applied formally to their arguments.
 
   Implementation ==> add
+
     import ApplyRules(Base, R, F)
     import PatternFunctions1(Base, F)
     import FunctionSpaceAssertions(R, F)
@@ -134159,12 +163891,19 @@ RewriteRule(Base, R, F): Exports == Implementation where
     F2Symbol    : F -> F
 
     pattern x                == x.pat
+
     lhs x                    == x.lft
+
     rhs x                    == x.rgt
+
     quotedOperators x        == x.qot
+
     mkRule(pt, p, s, l)      == [pt, p, s, l]
+
     coerce(eq:Equation F):$  == rule(lhs eq, rhs eq, empty())
+
     rule(l, r)               == rule(l, r, empty())
+
     elt(r:$, s:F) == applyRules([r pretend RewriteRule(Base, R, F)], s)
 
     suchThat(x, l, f) ==
@@ -134177,7 +163916,7 @@ RewriteRule(Base, R, F): Exports == Implementation where
     elt(r:$, s:F, n:PositiveInteger) ==
       applyRules([r pretend RewriteRule(Base, R, F)], s, n)
 
--- remove the extra properties from the constant symbols in f
+    -- remove the extra properties from the constant symbols in f
     F2Symbol f ==
       l := select_!(z+->symbolIfCan z case Symbol, tower f)$List(Kernel F)
       eval(f, l, [symbolIfCan(k)::Symbol::F for k in l])
@@ -134198,21 +163937,22 @@ RewriteRule(Base, R, F): Exports == Implementation where
       retractIfCan(f)@Union(R, "failed") case R => convert f
       convert optional f
 
--- appear?(x, [p1,...,pn]) is true if x appears as a variable in
--- a composite pattern pi.
+    -- appear?(x, [p1,...,pn]) is true if x appears as a variable in
+    -- a composite pattern pi.
     appear?(x, l) ==
       for p in l | p ^= x repeat
         member?(x, variables p) => return true
       false
 
--- a sum/product p1 @ ... @ pn is "bad" if it will not match
--- a sum/product p1 @ ... @ pn @ p(n+1)
--- in which case one should transform p1 @ ... @ pn to
--- p1 @ ... @ ?p(n+1) which does not change its meaning.
--- examples of "bad" combinations
---   sin(x) @ sin(y)     sin(x) @ x
--- examples of "good" combinations
---   sin(x) @ y
+    -- a sum/product p1 @ ... @ pn is "bad" if it will not match
+    -- a sum/product p1 @ ... @ pn @ p(n+1)
+    -- in which case one should transform p1 @ ... @ pn to
+    -- p1 @ ... @ ?p(n+1) which does not change its meaning.
+    -- examples of "bad" combinations
+    --   sin(x) @ sin(y)     sin(x) @ x
+    -- examples of "good" combinations
+    --   sin(x) @ y
+
     bad? u ==
       u case List(P) =>
         for x in u::List(P) repeat
@@ -134234,6 +163974,99 @@ RewriteRule(Base, R, F): Exports == Implementation where
 \begin{chunk}{COQ RULE}
 (* domain RULE *)
 (*
+
+    import ApplyRules(Base, R, F)
+    import PatternFunctions1(Base, F)
+    import FunctionSpaceAssertions(R, F)
+
+    Rep := Record(pat: P, lft: F, rgt: F, qot: List Symbol)
+
+    mkRule      : (P, F, F, List Symbol) -> $
+    transformLhs: P -> Record(plus: F, times: F)
+    bad?        : Union(List P, "failed") -> Boolean
+    appear?     : (P, List P) -> Boolean
+    opt         : F -> P
+    F2Symbol    : F -> F
+
+    pattern x                == x.pat
+
+    lhs x                    == x.lft
+
+    rhs x                    == x.rgt
+
+    quotedOperators x        == x.qot
+
+    mkRule(pt, p, s, l)      == [pt, p, s, l]
+
+    coerce(eq:Equation F):$  == rule(lhs eq, rhs eq, empty())
+
+    rule(l, r)               == rule(l, r, empty())
+
+    elt(r:$, s:F) == applyRules([r pretend RewriteRule(Base, R, F)], s)
+
+    suchThat(x, l, f) ==
+      mkRule(suchThat(pattern x,l,f),  lhs x, rhs x, quotedOperators x)
+
+    x = y ==
+     (lhs x = lhs y) and (rhs x = rhs y) and
+        (quotedOperators x = quotedOperators y)
+
+    elt(r:$, s:F, n:PositiveInteger) ==
+      applyRules([r pretend RewriteRule(Base, R, F)], s, n)
+
+    -- remove the extra properties from the constant symbols in f
+    F2Symbol f ==
+      l := select_!(z+->symbolIfCan z case Symbol, tower f)$List(Kernel F)
+      eval(f, l, [symbolIfCan(k)::Symbol::F for k in l])
+
+    retractIfCan r ==
+      constant? pattern r =>
+        (u:= retractIfCan(lhs r)@Union(Kernel F,"failed")) case "failed"
+          => "failed"
+        F2Symbol(u::Kernel(F)::F) = rhs r
+      "failed"
+
+    rule(p, s, l) ==
+      lh := transformLhs(pt := convert(p)@P)
+      mkRule(opt(lh.times) * (opt(lh.plus) + pt),
+             lh.times * (lh.plus + p), lh.times * (lh.plus + s), l)
+
+    opt f ==
+      retractIfCan(f)@Union(R, "failed") case R => convert f
+      convert optional f
+
+    -- appear?(x, [p1,...,pn]) is true if x appears as a variable in
+    -- a composite pattern pi.
+    appear?(x, l) ==
+      for p in l | p ^= x repeat
+        member?(x, variables p) => return true
+      false
+
+    -- a sum/product p1 @ ... @ pn is "bad" if it will not match
+    -- a sum/product p1 @ ... @ pn @ p(n+1)
+    -- in which case one should transform p1 @ ... @ pn to
+    -- p1 @ ... @ ?p(n+1) which does not change its meaning.
+    -- examples of "bad" combinations
+    --   sin(x) @ sin(y)     sin(x) @ x
+    -- examples of "good" combinations
+    --   sin(x) @ y
+
+    bad? u ==
+      u case List(P) =>
+        for x in u::List(P) repeat
+          generic? x and not appear?(x, u::List(P)) => return false
+        true
+      false
+
+    transformLhs p ==
+      bad? isPlus p  => [new()$Symbol :: F, 1]
+      bad? isTimes p => [0, new()$Symbol :: F]
+      [0, 1]
+
+    coerce(x:$):OutputForm ==
+      infix(" == "::Symbol::OutputForm,
+            lhs(x)::OutputForm, rhs(x)::OutputForm)
+
 *)
 
 \end{chunk}
@@ -134407,21 +164240,413 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where
 
   PRIV == add
 
+    -- local functions
 
+   makeChar:             (TheField,TheField,ThePolDom) ->     $
+   refine! :                              $            ->     $
+   sturmIsolate : (List(P), TheField, TheField,N,N)    -> List TwoPoints
+   isolate :                            List(P)        -> List TwoPoints
+   rootBound :                             P           ->   TheField
+   linearRecip :                       ( P , $)        -> Union(P, "failed")
+   linearZero? :                     (TheField,$)      ->     B
+   linearSign :                          (P,$)         ->     Z
+   sturmNthRoot : (List(P), TheField, TheField,N,N,N)  -> _
+        Union(TwoPoints,"failed")
+   addOne :                              P             ->      P
+   minus :                               P             ->      P
+   translate :                    (P,TheField)         ->      P
+   dilate :                       (P,TheField)         ->      P
+   invert :                              P             ->      P
+   evalOne :                             P             ->   TheField
+   hasVarsl:                     List(TheField)        ->      B
+   hasVars:                              P             ->      B
+
+-- Representation
+
+   Rep:= Record(low:TheField,high:TheField,defPol:ThePolDom)
+
+-- and now the code !
+
+
+   size(rootCode) ==
+     rootCode.high - rootCode.low
+
+   relativeApprox(pval,rootCode,prec) ==
+     -- beurk !
+     dPol := rootCode.defPol
+     degree(dPol) = 1 => 
+       c := -coefficient(dPol,0)/leadingCoefficient(dPol)
+       pval.c
+     pval := pval rem dPol
+     degree(pval) = 0 => leadingCoefficient(pval)
+     zero?(pval,rootCode)  => 0
+     while mightHaveRoots(pval,rootCode) repeat
+          rootCode := refine(rootCode)
+     dpval := differentiate(pval)
+     degree(dpval) = 0 =>
+       l := left(rootCode)
+       r := right(rootCode)
+       a := pval.l
+       b := pval.r
+       while ( abs(2*(a-b)/(a+b)) > prec ) repeat
+         rootCode := refine(rootCode)
+         l := left(rootCode)
+         r := right(rootCode)
+         a := pval.l
+         b := pval.r
+       (a+b)/(2::TheField)
+     zero?(dpval,rootCode) => 
+        relativeApprox(pval, 
+                       [left(rootCode),
+                         right(rootCode),
+                           gcd(dpval,rootCode.defPol)]$Rep,
+                       prec)
+     while mightHaveRoots(dpval,rootCode) repeat
+          rootCode := refine(rootCode)
+     l := left(rootCode)
+     r := right(rootCode)
+     a := pval.l
+     b := pval.r
+     while ( abs(2*(a-b)/(a+b)) > prec ) repeat
+       rootCode := refine(rootCode)
+       l := left(rootCode)
+       r := right(rootCode)
+       a := pval.l
+       b := pval.r
+     (a+b)/(2::TheField)
+
+   approximate(pval,rootCode,prec) ==
+     -- glurp
+     dPol := rootCode.defPol
+     degree(dPol) = 1 => 
+       c := -coefficient(dPol,0)/leadingCoefficient(dPol)
+       pval.c
+     pval := pval rem dPol
+     degree(pval) = 0 => leadingCoefficient(pval)
+     dpval := differentiate(pval)
+     degree(dpval) = 0 =>
+       l := left(rootCode)
+       r := right(rootCode)
+       while ( abs((a := pval.l) - (b := pval.r)) > prec ) repeat
+         rootCode := refine(rootCode)
+         l := left(rootCode)
+         r := right(rootCode)
+       (a+b)/(2::TheField)
+     zero?(dpval,rootCode) => 
+        approximate(pval, 
+                    [left(rootCode),
+                     right(rootCode),
+                      gcd(dpval,rootCode.defPol)]$Rep,
+                    prec)
+     while mightHaveRoots(dpval,rootCode) repeat
+          rootCode := refine(rootCode)
+     l := left(rootCode)
+     r := right(rootCode)
+     while ( abs((a := pval.l) - (b := pval.r)) > prec ) repeat
+       rootCode := refine(rootCode)
+       l := left(rootCode)
+       r := right(rootCode)
+     (a+b)/(2::TheField)
+
+
+   addOne(p) == p.(monomial(1,1)+(1::P))
+
+   minus(p) == p.(monomial(-1,1))
+
+   translate(p,a) == p.(monomial(1,1)+(a::P))
+
+   dilate(p,a) == p.(monomial(a,1))
+
+   evalOne(p) == "+" / coefficients(p)
+
+   invert(p) == 
+        d := degree(p)
+        mapExponents(z +-> (d-z)::N, p)
+
+   rootBound(p) ==
+     res : TheField := 1
+     raw :TheField := 1+boundOfCauchy(p)$UTIL
+     while (res < raw) repeat
+       res := 2*(res)
+     res
+
+   sturmNthRoot(lp,l,r,vl,vr,n) ==
+    nv := (vl - vr)::N
+    nv < n => "failed"
+    ((nv = 1) and (n = 1)) => [l,r]
+    int := (l+r)/(2::TheField)
+    lt:List(TheField):=[]
+    for t in lp repeat
+        lt := cons(t.int , lt)
+    vi := sturmVariationsOf(reverse! lt)$UTIL
+    o :Z := n - vl + vi
+    if o > 0
+    then 
+       sturmNthRoot(lp,int,r,vi,vr,o::N)
+    else
+       sturmNthRoot(lp,l,int,vl,vi,n)
+
+   sturmIsolate(lp,l,r,vl,vr) ==
+    r <= l => error "ROIRC: sturmIsolate: bad bounds"
+    n := (vl - vr)::N
+    zero?(n) => []
+    one?(n) => [[l,r]]
+    int := (l+r)/(2::TheField)
+    vi := sturmVariationsOf( [t.int for t in lp ] )$UTIL
+    append(sturmIsolate(lp,l,int,vl,vi),sturmIsolate(lp,int,r,vi,vr))
+
+   isolate(lp) ==
+     b := rootBound(first(lp))
+     l1,l2 : List(TheField)
+     (l1,l2) := ([] , [])
+     for t in reverse(lp) repeat
+       if odd?(degree(t))
+       then
+        (l1,l2):= (cons(-leadingCoefficient(t),l1),
+                   cons(leadingCoefficient(t),l2))
+       else
+        (l1,l2):= (cons(leadingCoefficient(t),l1),
+                   cons(leadingCoefficient(t),l2))
+     sturmIsolate(lp,
+                  -b,
+                  b,
+                  sturmVariationsOf(l1)$UTIL,
+                  sturmVariationsOf(l2)$UTIL)
+
+   rootOf(pol,n) ==
+    ls := sturmSequence(pol)$UTIL
+    pol := unitCanonical(first(ls)) -- this one is SqFR
+    degree(pol) = 0 => "failed"
+    numberOfMonomials(pol) = 1 => ([0,1,monomial(1,1)]$Rep)::$
+    b := rootBound(pol)
+    l1,l2 : List(TheField)
+    (l1,l2) := ([] , [])
+    for t in reverse(ls) repeat
+      if odd?(degree(t))
+      then
+       (l1,l2):= (cons(leadingCoefficient(t),l1),
+                  cons(-leadingCoefficient(t),l2))
+      else
+       (l1,l2):= (cons(leadingCoefficient(t),l1),
+                  cons(leadingCoefficient(t),l2))
+    res := sturmNthRoot(ls,
+                        -b,
+                        b,
+                        sturmVariationsOf(l2)$UTIL,
+                        sturmVariationsOf(l1)$UTIL,
+                        n)
+    res case "failed" => "failed"
+    makeChar(res.low,res.high,pol)
+
+   allRootsOf(pol) == 
+    ls := sturmSequence(unitCanonical pol)$UTIL
+    pol := unitCanonical(first(ls)) -- this one is SqFR
+    degree(pol) = 0 => []
+    numberOfMonomials(pol) = 1 => [[0,1,monomial(1,1)]$Rep]
+    [ makeChar(term.low,term.high,pol) for term in isolate(ls) ]
+
+
+   hasVarsl(l:List(TheField)) ==
+    null(l) => false
+    f := sign(first(l))
+    for term in rest(l) repeat
+      if f*term < 0 then return(true)
+    false
+    
+   hasVars(p:P) ==
+    zero?(p) => error "ROIRC: hasVars: null polynonial"
+    zero?(coefficient(p,0)) => true
+    hasVarsl(coefficients(p))
 
--- local functions
 
+   mightHaveRoots(p,rootChar) == 
+      a := rootChar.low
+      q := translate(p,a)
+      not(hasVars(q)) => false
+      a := (rootChar.high) - a
+      q := dilate(q,a)
+      sign(coefficient(q,0))*sign(evalOne(q)) <= 0 => true
+      q := minus(addOne(q))
+      not(hasVars(q)) => false
+      q := invert(q)
+      hasVars(addOne(q))
+
+   coerce(rootChar:$):O == 
+     commaSeparate([ hconcat("[" :: O , (rootChar.low)::O), 
+                     hconcat((rootChar.high)::O,"[" ::O ) ])
+
+   c1 = c2 == 
+     mM := max(c1.low,c2.low)
+     Mm := min(c1.high,c2.high)
+     mM >= Mm => false
+     rr : ThePolDom := gcd(c1.defPol,c2.defPol)
+     degree(rr) = 0 => false
+     sign(rr.mM) * sign(rr.Mm) <= 0
+
+   makeChar(left,right,pol) == 
+    res :$ := [left,right,leadingMonomial(pol)+reductum(pol)]$Rep -- safe copy
+    while zero?(pol.(res.high)) repeat refine!(res)
+    while (res.high * res.low < 0 ) repeat refine!(res)
+    zero?(pol.(res.low)) => [res.low,res.high,monomial(1,1)-(res.low)::P]
+    res
+
+   definingPolynomial(rootChar) == rootChar.defPol
+
+   linearRecip(toTest,rootChar) ==
+      c := - inv(leadingCoefficient(toTest)) * coefficient(toTest,0)
+      r := recip(rootChar.defPol.c)
+      if (r case "failed")
+      then
+        if (c - rootChar.low) * (c - rootChar.high) <= 0
+        then 
+          "failed"
+        else
+          newPol := (rootChar.defPol exquo toTest)::P
+          ((1$ThePolDom - inv(newPol.c)*newPol) exquo toTest)::P
+      else
+         ((1$ThePolDom - (r::TheField)*rootChar.defPol) exquo toTest)::P
+
+   recip(toTest,rootChar) ==
+     degree(toTest) = 0 or degree(rootChar.defPol) <= degree(toTest) =>
+       error "IRC: recip: Not reduced"
+     degree(rootChar.defPol) = 1 =>
+       error "IRC: recip: Linear Defining Polynomial"
+     degree(toTest) = 1 =>
+       linearRecip(toTest, rootChar)
+     d := extendedEuclidean((rootChar.defPol),toTest)
+     (degree(d.generator) = 0 ) => 
+         d.coef2
+     d.generator := unitCanonical(d.generator)
+     (d.generator.(rootChar.low) *
+      d.generator.(rootChar.high)<= 0) => "failed"
+     newPol := (rootChar.defPol exquo (d.generator))::P
+     degree(newPol) = 1 =>
+       c := - inv(leadingCoefficient(newPol)) * coefficient(newPol,0)
+       inv(toTest.c)::P
+     degree(toTest) = 1 => 
+       c := - coefficient(toTest,0)/ leadingCoefficient(toTest)
+       ((1$ThePolDom - inv(newPol.(c))*newPol) exquo toTest)::P
+     d := extendedEuclidean(newPol,toTest)
+     d.coef2
+
+   linearSign(toTest,rootChar) ==
+      c := - inv(leadingCoefficient(toTest)) * coefficient(toTest,0)
+      ev := sign(rootChar.defPol.c)
+      if zero?(ev)
+      then
+        if (c - rootChar.low) * (c - rootChar.high) <= 0
+        then
+          0
+        else
+          sign(toTest.(rootChar.high))
+      else
+        if (ev*sign(rootChar.defPol.(rootChar.high)) <= 0 )
+        then
+          sign(toTest.(rootChar.high))
+        else
+          sign(toTest.(rootChar.low))
+
+   sign(toTest,rootChar) ==
+     degree(toTest) = 0 or degree(rootChar.defPol) <= degree(toTest) =>
+       error "IRC: sign: Not reduced"
+     degree(rootChar.defPol) = 1 =>
+       error "IRC: sign: Linear Defining Polynomial"
+     degree(toTest) = 1 =>
+      linearSign(toTest, rootChar)
+     s := sign(leadingCoefficient(toTest))
+     toTest := monomial(1,degree(toTest))+
+               inv(leadingCoefficient(toTest))*reductum(toTest)
+     delta := gcd(toTest,rootChar.defPol)
+     newChar := [rootChar.low,rootChar.high,rootChar.defPol]$Rep
+     if degree(delta) > 0
+     then
+       if sign(delta.(rootChar.low) * delta.(rootChar.high)) <= 0
+       then
+        return(0)
+       else
+        newChar.defPol := (newChar.defPol exquo delta) :: P
+        toTest := toTest rem (newChar.defPol)
+     degree(toTest) = 0 => s * sign(leadingCoefficient(toTest))
+     degree(toTest) = 1 => s * linearSign(toTest, newChar)
+     while mightHaveRoots(toTest,newChar) repeat
+       newChar := refine(newChar)
+     s*sign(toTest.(newChar.low))
+
+   linearZero?(c,rootChar) == 
+      zero?((rootChar.defPol).c) and 
+       (c - rootChar.low) * (c - rootChar.high) <= 0
+
+   zero?(toTest,rootChar) ==
+     degree(toTest) = 0 or degree(rootChar.defPol) <= degree(toTest) =>
+       error "IRC: zero?: Not reduced"
+     degree(rootChar.defPol) = 1 =>
+       error "IRC: zero?: Linear Defining Polynomial"
+     degree(toTest) = 1 => 
+      linearZero?(- inv(leadingCoefficient(toTest)) * coefficient(toTest,0),
+                  rootChar)
+     toTest := monomial(1,degree(toTest))+
+               inv(leadingCoefficient(toTest))*reductum(toTest)
+     delta := gcd(toTest,rootChar.defPol)
+     degree(delta) = 0 => false
+     sign(delta.(rootChar.low) * delta.(rootChar.high)) <= 0
+
+
+   refine!(rootChar) ==
+     -- this is not a safe function, it can work with badly created object
+     -- we do not assume (rootChar.defPol).(rootChar.high) <> 0
+        int := middle(rootChar)
+        s1 := sign((rootChar.defPol).(rootChar.low))
+        zero?(s1) =>
+          rootChar.high := int
+          rootChar.defPol := monomial(1,1) - (rootChar.low)::P
+          rootChar
+        s2 := sign((rootChar.defPol).int)
+        zero?(s2) =>
+          rootChar.low := int
+          rootChar.defPol := monomial(1,1) - int::P
+          rootChar
+        if (s1*s2 < 0)
+        then 
+          rootChar.high := int
+        else 
+          rootChar.low := int
+        rootChar
+
+   refine(rootChar) ==
+     -- we assume (rootChar.defPol).(rootChar.high) <> 0
+        int := middle(rootChar)
+        s:= (rootChar.defPol).int * (rootChar.defPol).(rootChar.high)
+        zero?(s) => [int,rootChar.high,monomial(1,1)-int::P]
+        if s < 0 
+        then 
+          [int,rootChar.high,rootChar.defPol]
+        else 
+          [rootChar.low,int,rootChar.defPol]
+
+   left(rootChar) == rootChar.low
+
+   right(rootChar) == rootChar.high
+
+   middle(rootChar) == (rootChar.low + rootChar.high)/(2::TheField)
+
+\end{chunk}
+
+\begin{chunk}{COQ ROIRC}
+(* domain ROIRC *)
+(*
+
+    -- local functions
 
    makeChar:             (TheField,TheField,ThePolDom) ->     $
    refine! :                              $            ->     $
    sturmIsolate : (List(P), TheField, TheField,N,N)    -> List TwoPoints
    isolate :                            List(P)        -> List TwoPoints
    rootBound :                             P           ->   TheField
---   varStar :                                P          ->     N
    linearRecip :                       ( P , $)        -> Union(P, "failed")
    linearZero? :                     (TheField,$)      ->     B
    linearSign :                          (P,$)         ->     Z
-   sturmNthRoot : (List(P), TheField, TheField,N,N,N)  -> Union(TwoPoints,"failed")
+   sturmNthRoot : (List(P), TheField, TheField,N,N,N)  -> _
+        Union(TwoPoints,"failed")
    addOne :                              P             ->      P
    minus :                               P             ->      P
    translate :                    (P,TheField)         ->      P
@@ -134633,16 +164858,13 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where
       a := rootChar.low
       q := translate(p,a)
       not(hasVars(q)) => false
---      varStar(q) = 0 => false
       a := (rootChar.high) - a
       q := dilate(q,a)
       sign(coefficient(q,0))*sign(evalOne(q)) <= 0 => true
       q := minus(addOne(q))
       not(hasVars(q)) => false
---      varStar(q) = 0 => false
       q := invert(q)
       hasVars(addOne(q))
---      ^(varStar(addOne(q)) = 0)
 
    coerce(rootChar:$):O == 
      commaSeparate([ hconcat("[" :: O , (rootChar.low)::O), 
@@ -134657,11 +164879,6 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where
      sign(rr.mM) * sign(rr.Mm) <= 0
 
    makeChar(left,right,pol) == 
--- The following lines of code, which check for a possible error,
--- cause major performance problems and were removed by Renaud Rioboo,
--- the original author. They were originally inserted for debugging.
---    right <= left => error "ROIRC: makeChar: Bad interval"
---    (pol.left * pol.right) > 0 => error "ROIRC: makeChar: Bad pol"
     res :$ := [left,right,leadingMonomial(pol)+reductum(pol)]$Rep -- safe copy
     while zero?(pol.(res.high)) repeat refine!(res)
     while (res.high * res.low < 0 ) repeat refine!(res)
@@ -134807,19 +165024,6 @@ RightOpenIntervalRootCharacterization(TheField,ThePolDom) : PUB == PRIV where
 
    middle(rootChar) == (rootChar.low + rootChar.high)/(2::TheField)
 
---   varStar(p) == -- if 0 no roots in [0,:infty[
---     res : N := 0
---     lsg := sign(coefficient(p,0))
---     l := [ sign(i) for i in reverse!(coefficients(p))]
---     for sg in l repeat
---      if (sg ^= lsg) then res := res + 1
---      lsg := sg
---     res
-\end{chunk}
-
-\begin{chunk}{COQ ROIRC}
-(* domain ROIRC *)
-(*
 *)
 
 \end{chunk}
@@ -135310,10 +165514,13 @@ RomanNumeral(): IntegerNumberSystem with
       ++ roman(n) creates a roman numeral for n.
 
   == Integer add
+
         import NumberFormats()
 
         roman(n:Integer) == n::%
+
         roman(sy:Symbol) == convert sy
+
         convert(sy:Symbol):%    == ScanRoman(string sy)::%
 
         coerce(r:%):OutputForm ==
@@ -135328,6 +165535,22 @@ RomanNumeral(): IntegerNumberSystem with
 \begin{chunk}{COQ ROMAN}
 (* domain ROMAN *)
 (*
+
+        import NumberFormats()
+
+        roman(n:Integer) == n::%
+
+        roman(sy:Symbol) == convert sy
+
+        convert(sy:Symbol):%    == ScanRoman(string sy)::%
+
+        coerce(r:%):OutputForm ==
+            n := convert(r)@Integer
+            -- okay, we stretch it
+            zero? n => n::OutputForm
+            negative? n => - ((-r)::OutputForm)
+            FormatRoman(n::PositiveInteger)::Symbol::OutputForm
+
 *)
 
 \end{chunk}
@@ -135601,7 +165824,7 @@ RoutinesTable(): E == I where
       ++ getMeasure(R,s) gets the current value of the maximum measure for 
       ++ the given NAG routine.
     getExplanations:(%,ST) -> LST
-      ++ getExplanations(R,s) gets the explanations of the output parameters for 
+      ++ getExplanations(R,s) gets explanations of the output parameters for 
       ++ the given NAG routine.
     deleteRoutine!:(%,Symbol) -> %
       ++ deleteRoutine!(R,s) destructively deletes the given routine from 
@@ -135699,7 +165922,8 @@ RoutinesTable(): E == I where
         e.defaultMin := newValue
         a := coerce(e)$AnyFunctions1(Entry)
         insert!([s,a],R)
-      error("changeThreshhold","Cannot find routine of that name")$ErrorFunctions
+      error("changeThreshhold",_
+            "Cannot find routine of that name")$ErrorFunctions
       
     changeMeasure(R:%,s:Symbol,newValue:F):% ==
       (a := search(s,R)) case Any =>
@@ -135730,76 +165954,89 @@ RoutinesTable(): E == I where
       ode := "ODE"
       pde := "PDE"
       opt := "Optimization"
-      d01ajfExplList:LST := ["result:  Calculated value of the integral",
-                                 "iw:  iw(1) contains the actual number of sub-intervals used, the rest is workspace",
-                                  "w:  contains the end-points of the sub-intervals used along with the integral contributions and error estimates over the sub-intervals",
-                                   "abserr:  the estimate of the absolute error of the result",
-                                    "ifail:  the error warning parameter",
-                                     "method:  details of the method used and measures of all methods",
-                                      "attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
-      d01asfExplList:LST := ["result:  Calculated value of the integral",
-                                 "iw:  iw(1) contains the actual number of sub-intervals used, the rest is workspace",
-                                  "lst:  contains the actual number of sub-intervals used",
-                                   "erlst:  contains the error estimates over the sub-intervals",
-                                    "rslst:  contains the integral contributions of the sub-intervals",
-                                     "ierlst:  contains the error flags corresponding to the values in rslst",
-                                      "abserr:  the estimate of the absolute error of the result",
-                                       "ifail:  the error warning parameter",
-                                        "method:  details of the method used and measures of all methods",
-                                         "attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
-      d01fcfExplList:LST := ["result:  Calculated value of the integral",
-                                 "acc:  the estimate of the relative error of the result",
-                                  "minpts:  the number of integrand evaluations",
-                                   "ifail:  the error warning parameter",
-                                    "method:  details of the method used and measures of all methods",
-                                     "attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
-      d01transExplList:LST := ["result:  Calculated value of the integral",
-                                   "abserr:  the estimate of the absolute error of the result",
-                                    "method:  details of the method and transformation used and measures of all methods",
-                                     "d01***AnnaTypeAnswer:  the individual results from the routines",
-                                      "attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
-      d02bhfExplList:LST := ["x:  the value of x at the end of the calculation",
-                                  "y:  the computed values of Y\[1\]..Y\[n\] at x",
-                                   "tol:   the (possible) estimate of the error; this is not guarunteed",
-                                    "ifail:  the error warning parameter",
-                                     "method:  details of the method used and measures of all methods",
-                                      "intensityFunctions:  a list of the attributes and values pertaining to the ODE which had some bearing on the choice of method"]
-      d02bbfExplList:LST := concat(["result:  the computed values of the solution at the required points"],d02bhfExplList)$LST
-      d03eefExplList:LST := ["See the NAG On-line Documentation for D03EEF/D03EDF",
-                                  "u:  the computed solution u[i][j] is returned in u(i+(j-1)*ngx),for i = 1,2,..ngx; j = 1,2,..ngy"]
-      e04fdfExplList:LST := ["x:  the position of the minimum",
-                                  "objf:  the value of the objective function at x",
-                                   "ifail:  the error warning parameter",
-                                    "method:  details of the method used and measures of all methods",
-                                      "attributes:  a list of the attributes pertaining to the function or functions which had some bearing on the choice of method"]
-      e04dgfExplList:LST := concat(e04fdfExplList,
-                                        ["objgrd:  the values of the derivatives at x",
-                                          "iter:  the number of iterations performed"])$LST
-      e04jafExplList:LST := concat(e04fdfExplList,
-                                        ["bu:  the values of the upper bounds used",
-                                          "bl:  the values of the lower bounds used"])$LST
-      e04ucfExplList:LST := concat(e04dgfExplList,
-                                        ["istate:  the status of every constraint at x",
-                                          "clamda:  the QP multipliers for the last QP sub-problem",
-                                           "For other output parameters see the NAG On-line Documentation for E04UCF"])$LST
-      e04mbfExplList:LST := concat(e04fdfExplList,
-                                        ["istate:  the status of every constraint at x",
-                                          "clamda:  the Lagrange multipliers for each constraint"])$LST
-      d01ajfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"],  
-                          [5,"delete"], [6,"delete"]]
-      d01akfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"]]
-      d01alfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"], 
-                          [5,"delete"], [6,"delete"], [7,"delete"]]
-      d01amfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"], 
-                          [5,"delete"], [6,"delete"]]
-      d01anfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"], 
-                          [5,"delete"], [6,"delete"], [7,"delete"]]
-      d01apfIfail:IFL :=
-        [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"], [5,"delete"]]
-      d01aqfIfail:IFL :=
-        [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"], [5,"delete"]]
-      d01asfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], [4,"delete"], 
-            [5,"delete"], [6,"delete"], [7,"delete"], [8,"delete"], [9,"delete"]]
+      d01ajfExplList:LST := _
+       ["result:  Calculated value of the integral",_
+"iw:  iw(1) contains the actual number of sub-intervals used, the rest is workspace",_
+"w:  contains the end-points of the sub-intervals used along with the integral contributions and error estimates over the sub-intervals",_
+        "abserr:  the estimate of the absolute error of the result",_
+        "ifail:  the error warning parameter",_
+        "method:  details of the method used and measures of all methods",_
+"attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
+      d01asfExplList:LST := 
+        ["result:  Calculated value of the integral",_
+"iw:  iw(1) contains the actual number of sub-intervals used, the rest is workspace",_
+         "lst:  contains the actual number of sub-intervals used",_
+         "erlst:  contains the error estimates over the sub-intervals",_
+         "rslst:  contains the integral contributions of the sub-intervals",_
+     "ierlst:  contains the error flags corresponding to the values in rslst",_
+         "abserr:  the estimate of the absolute error of the result",_
+         "ifail:  the error warning parameter",_
+         "method:  details of the method used and measures of all methods",_
+"attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
+      d01fcfExplList:LST := _
+       ["result:  Calculated value of the integral",_
+        "acc:  the estimate of the relative error of the result",_
+        "minpts:  the number of integrand evaluations",_
+        "ifail:  the error warning parameter",_
+        "method:  details of the method used and measures of all methods",_
+"attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
+      d01transExplList:LST := 
+       ["result:  Calculated value of the integral",_
+        "abserr:  the estimate of the absolute error of the result",_
+"method:  details of the method and transformation used and measures of all methods",_
+        "d01***AnnaTypeAnswer:  the individual results from the routines",_
+"attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
+      d02bhfExplList:LST := _
+       ["x:  the value of x at the end of the calculation",_
+        "y:  the computed values of Y\[1\]..Y\[n\] at x",_
+         "tol:  the (possible) estimate of the error; this is not guarunteed",_
+         "ifail:  the error warning parameter",_
+         "method:  details of the method used and measures of all methods",_
+"intensityFunctions:  a list of the attributes and values pertaining to the ODE which had some bearing on the choice of method"]
+      d02bbfExplList:LST := concat([_
+       "result:  the computed values of the solution at the required points"],_
+        d02bhfExplList)$LST
+      d03eefExplList:LST := 
+       ["See the NAG On-line Documentation for D03EEF/D03EDF",_
+         "u:  the computed solution u[i][j] is returned in u(i+(j-1)*ngx),_
+          for i = 1,2,..ngx; j = 1,2,..ngy"]
+      e04fdfExplList:LST := ["x:  the position of the minimum",_
+        "objf:  the value of the objective function at x",_
+        "ifail:  the error warning parameter",_
+        "method:  details of the method used and measures of all methods",_
+         "attributes:  a list of the attributes pertaining to the function or _
+          functions which had some bearing on the choice of method"]
+      e04dgfExplList:LST := concat(e04fdfExplList,_
+        ["objgrd:  the values of the derivatives at x",_
+         "iter:  the number of iterations performed"])$LST
+      e04jafExplList:LST := concat(e04fdfExplList,_
+         ["bu:  the values of the upper bounds used",_
+          "bl:  the values of the lower bounds used"])$LST
+      e04ucfExplList:LST := concat(e04dgfExplList,_
+       ["istate:  the status of every constraint at x",_
+        "clamda:  the QP multipliers for the last QP sub-problem",_
+ "For other output parameters see the NAG On-line Documentation for E04UCF"]_
+        )$LST
+      e04mbfExplList:LST := concat(e04fdfExplList,_
+       ["istate:  the status of every constraint at x",_
+        "clamda:  the Lagrange multipliers for each constraint"])$LST
+      d01ajfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"], [6,"delete"]]
+      d01akfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"]]
+      d01alfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"], [6,"delete"], [7,"delete"]]
+      d01amfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"], [6,"delete"]]
+      d01anfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"], [6,"delete"], [7,"delete"]]
+      d01apfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"]]
+      d01aqfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"]]
+      d01asfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"], [6,"delete"], [7,"delete"], _
+        [8,"delete"], [9,"delete"]]
       d01fcfIfail:IFL := [[1,"delete"], [2,"incrFunEvals"], [3,"delete"]]
       d01gbfIfail:IFL := [[1,"delete"], [2,"incrFunEvals"]]
       d02bbfIfail:IFL := 
@@ -135813,48 +166050,73 @@ RoutinesTable(): E == I where
          [4,"delete"], [5,"delete"], [6,"no action"], [7,"delete"]]
       d02ejfIfail:IFL := 
         [[1,"delete"], [2,"decrease tolerance"], [3,"increase tolerance"],
-         [4,"delete"], [5,"delete"], [6,"no action"], [7,"delete"], [8,"delete"],
-          [9,"delete"]]
+         [4,"delete"], [5,"delete"], [6,"no action"], [7,"delete"], _
+         [8,"delete"], [9,"delete"]]
       e04dgfIfail:IFL := [[3,"delete"], [4,"no action"], [6,"delete"], 
                           [7,"delete"], [8,"delete"], [9,"delete"]]
       e04fdfIfail:IFL := 
         [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], 
           [5,"no action"], [6,"no action"], [7,"delete"], [8,"delete"]]
-      e04gcfIfail:IFL := [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], 
-        [5,"no action"], [6,"no action"], [7,"delete"], [8,"delete"], [9,"delete"]]
-      e04jafIfail:IFL := [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], 
-        [5,"no action"], [6,"no action"], [7,"delete"], [8,"delete"], [9,"delete"]]
+      e04gcfIfail:IFL := [[1,"delete"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"no action"], [6,"no action"], [7,"delete"], _
+        [8,"delete"], [9,"delete"]]
+      e04jafIfail:IFL := [[1,"delete"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"no action"], [6,"no action"], [7,"delete"], _
+        [8,"delete"], [9,"delete"]]
       e04mbfIfail:IFL := 
         [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], [5,"delete"]]
       e04nafIfail:IFL := 
         [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], [5,"delete"],
           [6,"delete"], [7,"delete"], [8,"delete"], [9,"delete"]]
-      e04ucfIfail:IFL := [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], 
-        [5,"delete"], [6,"delete"], [7,"delete"], [8,"delete"], [9,"delete"]]
-      d01ajfEntry:Entry := [int, f, "d01ajfAnnaType",0.4,0.4,d01ajfIfail,d01ajfExplList]
-      d01akfEntry:Entry := [int, f, "d01akfAnnaType",0.6,1.0,d01akfIfail,d01ajfExplList]
-      d01alfEntry:Entry := [int, f, "d01alfAnnaType",0.6,0.6,d01alfIfail,d01ajfExplList]
-      d01amfEntry:Entry := [int, i, "d01amfAnnaType",0.5,0.5,d01amfIfail,d01ajfExplList]
-      d01anfEntry:Entry := [int, f, "d01anfAnnaType",0.6,0.9,d01anfIfail,d01ajfExplList]
-      d01apfEntry:Entry := [int, f, "d01apfAnnaType",0.7,0.7,d01apfIfail,d01ajfExplList]
-      d01aqfEntry:Entry := [int, f, "d01aqfAnnaType",0.6,0.7,d01aqfIfail,d01ajfExplList]
-      d01asfEntry:Entry := [int, s, "d01asfAnnaType",0.6,0.9,d01asfIfail,d01asfExplList]
-      d01transEntry:Entry:=[int, i, "d01TransformFunctionType",0.6,0.9,[],d01transExplList]
-      d01gbfEntry:Entry := [int, m, "d01gbfAnnaType",0.6,0.6,d01gbfIfail,d01fcfExplList]
-      d01fcfEntry:Entry := [int, m, "d01fcfAnnaType",0.5,0.5,d01fcfIfail,d01fcfExplList]
-      d02bbfEntry:Entry := [ode, "IVP", "d02bbfAnnaType",0.7,0.5,d02bbfIfail,d02bbfExplList]
-      d02bhfEntry:Entry := [ode, "IVP", "d02bhfAnnaType",0.7,0.49,d02bhfIfail,d02bhfExplList]
-      d02cjfEntry:Entry := [ode, "IVP", "d02cjfAnnaType",0.7,0.5,d02cjfIfail,d02bbfExplList]
-      d02ejfEntry:Entry := [ode, "IVP", "d02ejfAnnaType",0.7,0.5,d02ejfIfail,d02bbfExplList]
-      d03eefEntry:Entry := [pde, "2", "d03eefAnnaType",0.6,0.5,[],d03eefExplList]
-      --d03fafEntry:Entry := [pde, "3", "d03fafAnnaType",0.6,0.5,[],[]]
-      e04dgfEntry:Entry := [opt, "CGA", "e04dgfAnnaType",0.4,0.4,e04dgfIfail,e04dgfExplList]
-      e04fdfEntry:Entry := [opt, "SS", "e04fdfAnnaType",0.7,0.7,e04fdfIfail,e04fdfExplList]
-      e04gcfEntry:Entry := [opt, "SS", "e04gcfAnnaType",0.8,0.8,e04gcfIfail,e04fdfExplList]
-      e04jafEntry:Entry := [opt, "QNA", "e04jafAnnaType",0.5,0.5,e04jafIfail,e04jafExplList]
-      e04mbfEntry:Entry := [opt, "LP", "e04mbfAnnaType",0.7,0.7,e04mbfIfail,e04mbfExplList]
-      e04nafEntry:Entry := [opt, "QP", "e04nafAnnaType",0.7,0.7,e04nafIfail,e04mbfExplList]
-      e04ucfEntry:Entry := [opt, "SQP", "e04ucfAnnaType",0.6,0.6,e04ucfIfail,e04ucfExplList]
+      e04ucfIfail:IFL := [[1,"delete"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"], [6,"delete"], [7,"delete"], _
+        [8,"delete"], [9,"delete"]]
+      d01ajfEntry:Entry := 
+        [int, f, "d01ajfAnnaType",0.4,0.4,d01ajfIfail,d01ajfExplList]
+      d01akfEntry:Entry := 
+        [int, f, "d01akfAnnaType",0.6,1.0,d01akfIfail,d01ajfExplList]
+      d01alfEntry:Entry := 
+        [int, f, "d01alfAnnaType",0.6,0.6,d01alfIfail,d01ajfExplList]
+      d01amfEntry:Entry := 
+        [int, i, "d01amfAnnaType",0.5,0.5,d01amfIfail,d01ajfExplList]
+      d01anfEntry:Entry := 
+        [int, f, "d01anfAnnaType",0.6,0.9,d01anfIfail,d01ajfExplList]
+      d01apfEntry:Entry := 
+        [int, f, "d01apfAnnaType",0.7,0.7,d01apfIfail,d01ajfExplList]
+      d01aqfEntry:Entry := 
+        [int, f, "d01aqfAnnaType",0.6,0.7,d01aqfIfail,d01ajfExplList]
+      d01asfEntry:Entry := 
+        [int, s, "d01asfAnnaType",0.6,0.9,d01asfIfail,d01asfExplList]
+      d01transEntry:Entry:=
+        [int, i, "d01TransformFunctionType",0.6,0.9,[],d01transExplList]
+      d01gbfEntry:Entry := 
+        [int, m, "d01gbfAnnaType",0.6,0.6,d01gbfIfail,d01fcfExplList]
+      d01fcfEntry:Entry := 
+        [int, m, "d01fcfAnnaType",0.5,0.5,d01fcfIfail,d01fcfExplList]
+      d02bbfEntry:Entry := 
+        [ode, "IVP", "d02bbfAnnaType",0.7,0.5,d02bbfIfail,d02bbfExplList]
+      d02bhfEntry:Entry := 
+        [ode, "IVP", "d02bhfAnnaType",0.7,0.49,d02bhfIfail,d02bhfExplList]
+      d02cjfEntry:Entry := 
+        [ode, "IVP", "d02cjfAnnaType",0.7,0.5,d02cjfIfail,d02bbfExplList]
+      d02ejfEntry:Entry := 
+        [ode, "IVP", "d02ejfAnnaType",0.7,0.5,d02ejfIfail,d02bbfExplList]
+      d03eefEntry:Entry := 
+        [pde, "2", "d03eefAnnaType",0.6,0.5,[],d03eefExplList]
+      e04dgfEntry:Entry := 
+        [opt, "CGA", "e04dgfAnnaType",0.4,0.4,e04dgfIfail,e04dgfExplList]
+      e04fdfEntry:Entry := 
+        [opt, "SS", "e04fdfAnnaType",0.7,0.7,e04fdfIfail,e04fdfExplList]
+      e04gcfEntry:Entry := 
+        [opt, "SS", "e04gcfAnnaType",0.8,0.8,e04gcfIfail,e04fdfExplList]
+      e04jafEntry:Entry := 
+        [opt, "QNA", "e04jafAnnaType",0.5,0.5,e04jafIfail,e04jafExplList]
+      e04mbfEntry:Entry := 
+        [opt, "LP", "e04mbfAnnaType",0.7,0.7,e04mbfIfail,e04mbfExplList]
+      e04nafEntry:Entry := 
+        [opt, "QP", "e04nafAnnaType",0.7,0.7,e04nafIfail,e04mbfExplList]
+      e04ucfEntry:Entry := 
+        [opt, "SQP", "e04ucfAnnaType",0.6,0.6,e04ucfIfail,e04ucfExplList]
       rl:RList :=
         [["d01apf" :: Symbol, coerce(d01apfEntry)$AnyFunctions1(Entry)],_
          ["d01aqf" :: Symbol, coerce(d01aqfEntry)$AnyFunctions1(Entry)],_
@@ -135864,7 +166126,7 @@ RoutinesTable(): E == I where
          ["d01ajf" :: Symbol, coerce(d01ajfEntry)$AnyFunctions1(Entry)],_
          ["d01asf" :: Symbol, coerce(d01asfEntry)$AnyFunctions1(Entry)],_
          ["d01amf" :: Symbol, coerce(d01amfEntry)$AnyFunctions1(Entry)],_
-         ["d01transform" :: Symbol, coerce(d01transEntry)$AnyFunctions1(Entry)],_
+         ["d01transform"::Symbol, coerce(d01transEntry)$AnyFunctions1(Entry)],_
          ["d01gbf" :: Symbol, coerce(d01gbfEntry)$AnyFunctions1(Entry)],_
          ["d01fcf" :: Symbol, coerce(d01fcfEntry)$AnyFunctions1(Entry)],_
          ["d02bbf" :: Symbol, coerce(d02bbfEntry)$AnyFunctions1(Entry)],_
@@ -135872,7 +166134,6 @@ RoutinesTable(): E == I where
          ["d02cjf" :: Symbol, coerce(d02cjfEntry)$AnyFunctions1(Entry)],_
          ["d02ejf" :: Symbol, coerce(d02ejfEntry)$AnyFunctions1(Entry)],_
          ["d03eef" :: Symbol, coerce(d03eefEntry)$AnyFunctions1(Entry)],_
-         --["d03faf" :: Symbol, coerce(d03fafEntry)$AnyFunctions1(Entry)],
          ["e04dgf" :: Symbol, coerce(e04dgfEntry)$AnyFunctions1(Entry)],_
          ["e04fdf" :: Symbol, coerce(e04fdfEntry)$AnyFunctions1(Entry)],_
          ["e04gcf" :: Symbol, coerce(e04gcfEntry)$AnyFunctions1(Entry)],_
@@ -135922,6 +166183,347 @@ RoutinesTable(): E == I where
 \begin{chunk}{COQ ROUTINE}
 (* domain ROUTINE *)
 (*
+
+    Rep := Result
+    import Rep
+
+    theRoutinesTable:% := routines()
+
+    showTheRoutinesTable():% == theRoutinesTable
+
+    integrationRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
+      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
+        elt(a,chapter) = "Integration"
+      false
+
+    selectIntegrationRoutines(R:%):% == select(integrationRoutine?,R)
+     
+    optimizationRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
+      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
+        elt(a,chapter) = "Optimization"
+      false
+
+    selectOptimizationRoutines(R:%):% == select(optimizationRoutine?,R)
+     
+    PDERoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
+      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
+        elt(a,chapter) = "PDE"
+      false
+
+    selectPDERoutines(R:%):% == select(PDERoutine?,R)
+     
+    ODERoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
+      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
+        elt(a,chapter) = "ODE"
+      false
+
+    selectODEIVPRoutines(R:%):% == select(ODERoutine?,R)
+     
+    sumOfSquaresRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
+      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
+        elt(a,type) = "SS"
+      false
+
+    selectSumOfSquaresRoutines(R:%):% == select(sumOfSquaresRoutine?,R)
+
+    finiteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
+      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
+        elt(a,type) = "One-dimensional finite"
+      false
+
+    selectFiniteRoutines(R:%):% == select(finiteRoutine?,R)
+
+    infiniteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
+      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
+        elt(a,type) = "One-dimensional infinite"
+      false
+
+    semiInfiniteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
+      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
+        elt(a,type) = "One-dimensional semi-infinite"
+      false
+
+    nonFiniteRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
+      (semiInfiniteRoutine?(r) or infiniteRoutine?(r))
+
+    selectNonFiniteRoutines(R:%):% == select(nonFiniteRoutine?,R)
+
+    multiDimensionalRoutine?(r:Record(key:Symbol,entry:Any)):Boolean ==
+      (a := retractIfCan(r.entry)$AnyFunctions1(Entry)) case Entry =>
+        elt(a,type) = "Multi-dimensional"
+      false
+
+    selectMultiDimensionalRoutines(R:%):% == select(multiDimensionalRoutine?,R)
+
+    concat(a:%,b:%):% ==
+      membersOfa := (members(a)@List(Record(key:Symbol,entry:Any)))
+      membersOfb := (members(b)@List(Record(key:Symbol,entry:Any)))
+      allMembers:=
+        concat(membersOfa,membersOfb)$List(Record(key:Symbol,entry:Any))
+      construct(allMembers)
+
+    changeThreshhold(R:%,s:Symbol,newValue:F):% ==
+      (a := search(s,R)) case Any =>
+        e := retract(a)$AnyFunctions1(Entry)
+        e.defaultMin := newValue
+        a := coerce(e)$AnyFunctions1(Entry)
+        insert!([s,a],R)
+      error("changeThreshhold",_
+            "Cannot find routine of that name")$ErrorFunctions
+      
+    changeMeasure(R:%,s:Symbol,newValue:F):% ==
+      (a := search(s,R)) case Any =>
+        e := retract(a)$AnyFunctions1(Entry)
+        e.measure := newValue
+        a := coerce(e)$AnyFunctions1(Entry)
+        insert!([s,a],R)
+      error("changeMeasure","Cannot find routine of that name")$ErrorFunctions
+      
+    getMeasure(R:%,s:Symbol):F ==
+      (a := search(s,R)) case Any =>
+        e := retract(a)$AnyFunctions1(Entry)
+        e.measure
+      error("getMeasure","Cannot find routine of that name")$ErrorFunctions
+
+    deleteRoutine!(R:%,s:Symbol):% ==
+      (a := search(s,R)) case Any =>
+        e:Record(key:Symbol,entry:Any) := [s,a]
+        remove!(e,R)
+      error("deleteRoutine!","Cannot find routine of that name")$ErrorFunctions
+
+    routines():% ==
+      f := "One-dimensional finite"
+      s := "One-dimensional semi-infinite"
+      i := "One-dimensional infinite"
+      m := "Multi-dimensional"
+      int := "Integration"
+      ode := "ODE"
+      pde := "PDE"
+      opt := "Optimization"
+      d01ajfExplList:LST := _
+       ["result:  Calculated value of the integral",_
+"iw:  iw(1) contains the actual number of sub-intervals used, the rest is workspace",_
+"w:  contains the end-points of the sub-intervals used along with the integral contributions and error estimates over the sub-intervals",_
+        "abserr:  the estimate of the absolute error of the result",_
+        "ifail:  the error warning parameter",_
+        "method:  details of the method used and measures of all methods",_
+"attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
+      d01asfExplList:LST := 
+        ["result:  Calculated value of the integral",_
+"iw:  iw(1) contains the actual number of sub-intervals used, the rest is workspace",_
+         "lst:  contains the actual number of sub-intervals used",_
+         "erlst:  contains the error estimates over the sub-intervals",_
+         "rslst:  contains the integral contributions of the sub-intervals",_
+     "ierlst:  contains the error flags corresponding to the values in rslst",_
+         "abserr:  the estimate of the absolute error of the result",_
+         "ifail:  the error warning parameter",_
+         "method:  details of the method used and measures of all methods",_
+"attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
+      d01fcfExplList:LST := _
+       ["result:  Calculated value of the integral",_
+        "acc:  the estimate of the relative error of the result",_
+        "minpts:  the number of integrand evaluations",_
+        "ifail:  the error warning parameter",_
+        "method:  details of the method used and measures of all methods",_
+"attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
+      d01transExplList:LST := 
+       ["result:  Calculated value of the integral",_
+        "abserr:  the estimate of the absolute error of the result",_
+"method:  details of the method and transformation used and measures of all methods",_
+        "d01***AnnaTypeAnswer:  the individual results from the routines",_
+"attributes:  a list of the attributes pertaining to the integrand which had some bearing on the choice of method"]
+      d02bhfExplList:LST := _
+       ["x:  the value of x at the end of the calculation",_
+        "y:  the computed values of Y\[1\]..Y\[n\] at x",_
+         "tol:  the (possible) estimate of the error; this is not guarunteed",_
+         "ifail:  the error warning parameter",_
+         "method:  details of the method used and measures of all methods",_
+"intensityFunctions:  a list of the attributes and values pertaining to the ODE which had some bearing on the choice of method"]
+      d02bbfExplList:LST := concat([_
+       "result:  the computed values of the solution at the required points"],_
+        d02bhfExplList)$LST
+      d03eefExplList:LST := 
+       ["See the NAG On-line Documentation for D03EEF/D03EDF",_
+         "u:  the computed solution u[i][j] is returned in u(i+(j-1)*ngx),_
+          for i = 1,2,..ngx; j = 1,2,..ngy"]
+      e04fdfExplList:LST := ["x:  the position of the minimum",_
+        "objf:  the value of the objective function at x",_
+        "ifail:  the error warning parameter",_
+        "method:  details of the method used and measures of all methods",_
+         "attributes:  a list of the attributes pertaining to the function or _
+          functions which had some bearing on the choice of method"]
+      e04dgfExplList:LST := concat(e04fdfExplList,_
+        ["objgrd:  the values of the derivatives at x",_
+         "iter:  the number of iterations performed"])$LST
+      e04jafExplList:LST := concat(e04fdfExplList,_
+         ["bu:  the values of the upper bounds used",_
+          "bl:  the values of the lower bounds used"])$LST
+      e04ucfExplList:LST := concat(e04dgfExplList,_
+       ["istate:  the status of every constraint at x",_
+        "clamda:  the QP multipliers for the last QP sub-problem",_
+ "For other output parameters see the NAG On-line Documentation for E04UCF"]_
+        )$LST
+      e04mbfExplList:LST := concat(e04fdfExplList,_
+       ["istate:  the status of every constraint at x",_
+        "clamda:  the Lagrange multipliers for each constraint"])$LST
+      d01ajfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"], [6,"delete"]]
+      d01akfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"]]
+      d01alfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"], [6,"delete"], [7,"delete"]]
+      d01amfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"], [6,"delete"]]
+      d01anfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"], [6,"delete"], [7,"delete"]]
+      d01apfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"]]
+      d01aqfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"]]
+      d01asfIfail:IFL := [[1,"incrFunEvals"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"], [6,"delete"], [7,"delete"], _
+        [8,"delete"], [9,"delete"]]
+      d01fcfIfail:IFL := [[1,"delete"], [2,"incrFunEvals"], [3,"delete"]]
+      d01gbfIfail:IFL := [[1,"delete"], [2,"incrFunEvals"]]
+      d02bbfIfail:IFL := 
+        [[1,"delete"], [2,"decrease tolerance"], [3,"increase tolerance"],
+         [4,"delete"], [5,"delete"], [6,"delete"], [7,"delete"]]
+      d02bhfIfail:IFL := 
+        [[1,"delete"], [2,"decrease tolerance"], [3,"increase tolerance"],
+         [4,"no action"], [5,"delete"], [6,"delete"], [7,"delete"]]
+      d02cjfIfail:IFL := 
+        [[1,"delete"], [2,"decrease tolerance"], [3,"increase tolerance"],
+         [4,"delete"], [5,"delete"], [6,"no action"], [7,"delete"]]
+      d02ejfIfail:IFL := 
+        [[1,"delete"], [2,"decrease tolerance"], [3,"increase tolerance"],
+         [4,"delete"], [5,"delete"], [6,"no action"], [7,"delete"], _
+         [8,"delete"], [9,"delete"]]
+      e04dgfIfail:IFL := [[3,"delete"], [4,"no action"], [6,"delete"], 
+                          [7,"delete"], [8,"delete"], [9,"delete"]]
+      e04fdfIfail:IFL := 
+        [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], 
+          [5,"no action"], [6,"no action"], [7,"delete"], [8,"delete"]]
+      e04gcfIfail:IFL := [[1,"delete"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"no action"], [6,"no action"], [7,"delete"], _
+        [8,"delete"], [9,"delete"]]
+      e04jafIfail:IFL := [[1,"delete"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"no action"], [6,"no action"], [7,"delete"], _
+        [8,"delete"], [9,"delete"]]
+      e04mbfIfail:IFL := 
+        [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], [5,"delete"]]
+      e04nafIfail:IFL := 
+        [[1,"delete"], [2,"delete"], [3,"delete"], [4,"delete"], [5,"delete"],
+          [6,"delete"], [7,"delete"], [8,"delete"], [9,"delete"]]
+      e04ucfIfail:IFL := [[1,"delete"], [2,"delete"], [3,"delete"], _
+        [4,"delete"], [5,"delete"], [6,"delete"], [7,"delete"], _
+        [8,"delete"], [9,"delete"]]
+      d01ajfEntry:Entry := 
+        [int, f, "d01ajfAnnaType",0.4,0.4,d01ajfIfail,d01ajfExplList]
+      d01akfEntry:Entry := 
+        [int, f, "d01akfAnnaType",0.6,1.0,d01akfIfail,d01ajfExplList]
+      d01alfEntry:Entry := 
+        [int, f, "d01alfAnnaType",0.6,0.6,d01alfIfail,d01ajfExplList]
+      d01amfEntry:Entry := 
+        [int, i, "d01amfAnnaType",0.5,0.5,d01amfIfail,d01ajfExplList]
+      d01anfEntry:Entry := 
+        [int, f, "d01anfAnnaType",0.6,0.9,d01anfIfail,d01ajfExplList]
+      d01apfEntry:Entry := 
+        [int, f, "d01apfAnnaType",0.7,0.7,d01apfIfail,d01ajfExplList]
+      d01aqfEntry:Entry := 
+        [int, f, "d01aqfAnnaType",0.6,0.7,d01aqfIfail,d01ajfExplList]
+      d01asfEntry:Entry := 
+        [int, s, "d01asfAnnaType",0.6,0.9,d01asfIfail,d01asfExplList]
+      d01transEntry:Entry:=
+        [int, i, "d01TransformFunctionType",0.6,0.9,[],d01transExplList]
+      d01gbfEntry:Entry := 
+        [int, m, "d01gbfAnnaType",0.6,0.6,d01gbfIfail,d01fcfExplList]
+      d01fcfEntry:Entry := 
+        [int, m, "d01fcfAnnaType",0.5,0.5,d01fcfIfail,d01fcfExplList]
+      d02bbfEntry:Entry := 
+        [ode, "IVP", "d02bbfAnnaType",0.7,0.5,d02bbfIfail,d02bbfExplList]
+      d02bhfEntry:Entry := 
+        [ode, "IVP", "d02bhfAnnaType",0.7,0.49,d02bhfIfail,d02bhfExplList]
+      d02cjfEntry:Entry := 
+        [ode, "IVP", "d02cjfAnnaType",0.7,0.5,d02cjfIfail,d02bbfExplList]
+      d02ejfEntry:Entry := 
+        [ode, "IVP", "d02ejfAnnaType",0.7,0.5,d02ejfIfail,d02bbfExplList]
+      d03eefEntry:Entry := 
+        [pde, "2", "d03eefAnnaType",0.6,0.5,[],d03eefExplList]
+      e04dgfEntry:Entry := 
+        [opt, "CGA", "e04dgfAnnaType",0.4,0.4,e04dgfIfail,e04dgfExplList]
+      e04fdfEntry:Entry := 
+        [opt, "SS", "e04fdfAnnaType",0.7,0.7,e04fdfIfail,e04fdfExplList]
+      e04gcfEntry:Entry := 
+        [opt, "SS", "e04gcfAnnaType",0.8,0.8,e04gcfIfail,e04fdfExplList]
+      e04jafEntry:Entry := 
+        [opt, "QNA", "e04jafAnnaType",0.5,0.5,e04jafIfail,e04jafExplList]
+      e04mbfEntry:Entry := 
+        [opt, "LP", "e04mbfAnnaType",0.7,0.7,e04mbfIfail,e04mbfExplList]
+      e04nafEntry:Entry := 
+        [opt, "QP", "e04nafAnnaType",0.7,0.7,e04nafIfail,e04mbfExplList]
+      e04ucfEntry:Entry := 
+        [opt, "SQP", "e04ucfAnnaType",0.6,0.6,e04ucfIfail,e04ucfExplList]
+      rl:RList :=
+        [["d01apf" :: Symbol, coerce(d01apfEntry)$AnyFunctions1(Entry)],_
+         ["d01aqf" :: Symbol, coerce(d01aqfEntry)$AnyFunctions1(Entry)],_
+         ["d01alf" :: Symbol, coerce(d01alfEntry)$AnyFunctions1(Entry)],_
+         ["d01anf" :: Symbol, coerce(d01anfEntry)$AnyFunctions1(Entry)],_
+         ["d01akf" :: Symbol, coerce(d01akfEntry)$AnyFunctions1(Entry)],_
+         ["d01ajf" :: Symbol, coerce(d01ajfEntry)$AnyFunctions1(Entry)],_
+         ["d01asf" :: Symbol, coerce(d01asfEntry)$AnyFunctions1(Entry)],_
+         ["d01amf" :: Symbol, coerce(d01amfEntry)$AnyFunctions1(Entry)],_
+         ["d01transform"::Symbol, coerce(d01transEntry)$AnyFunctions1(Entry)],_
+         ["d01gbf" :: Symbol, coerce(d01gbfEntry)$AnyFunctions1(Entry)],_
+         ["d01fcf" :: Symbol, coerce(d01fcfEntry)$AnyFunctions1(Entry)],_
+         ["d02bbf" :: Symbol, coerce(d02bbfEntry)$AnyFunctions1(Entry)],_
+         ["d02bhf" :: Symbol, coerce(d02bhfEntry)$AnyFunctions1(Entry)],_
+         ["d02cjf" :: Symbol, coerce(d02cjfEntry)$AnyFunctions1(Entry)],_
+         ["d02ejf" :: Symbol, coerce(d02ejfEntry)$AnyFunctions1(Entry)],_
+         ["d03eef" :: Symbol, coerce(d03eefEntry)$AnyFunctions1(Entry)],_
+         ["e04dgf" :: Symbol, coerce(e04dgfEntry)$AnyFunctions1(Entry)],_
+         ["e04fdf" :: Symbol, coerce(e04fdfEntry)$AnyFunctions1(Entry)],_
+         ["e04gcf" :: Symbol, coerce(e04gcfEntry)$AnyFunctions1(Entry)],_
+         ["e04jaf" :: Symbol, coerce(e04jafEntry)$AnyFunctions1(Entry)],_
+         ["e04mbf" :: Symbol, coerce(e04mbfEntry)$AnyFunctions1(Entry)],_
+         ["e04naf" :: Symbol, coerce(e04nafEntry)$AnyFunctions1(Entry)],_
+         ["e04ucf" :: Symbol, coerce(e04ucfEntry)$AnyFunctions1(Entry)]]
+      construct(rl)
+
+    getIFL(s:Symbol,l:%):Union(IFL,"failed") ==
+      o := search(s,l)$%
+      o case "failed" => "failed"
+      e := retractIfCan(o)$AnyFunctions1(Entry)
+      e case "failed" => "failed"
+      e.failList
+
+    getInstruction(l:IFL,ifailValue:Integer):Union(ST,"failed") ==
+      output := empty()$ST
+      for i in 1..#l repeat
+        if ((l.i).ifail=ifailValue)@Boolean then 
+          output := (l.i).instruction
+      empty?(output)$ST => "failed"
+      output
+
+    recoverAfterFail(routs:%,routineName:ST,
+                      ifailValue:Integer):Union(ST,"failed") ==
+      name := routineName :: Symbol
+      failedList := getIFL(name,routs)
+      failedList case "failed" => "failed"
+      empty? failedList => "failed"
+      instr := getInstruction(failedList,ifailValue)
+      instr case "failed" => concat(routineName," failed")$ST
+      (instr = "delete")@Boolean => 
+        deleteRoutine!(routs,name)
+        concat(routineName," failed - trying alternatives")$ST
+      instr
+
+    getExplanations(R:%,routineName:ST):LST ==
+      name := routineName :: Symbol
+      (a := search(name,R)) case Any => 
+        e := retract(a)$AnyFunctions1(Entry)
+        e.explList
+      empty()$LST
+
 *)
 
 \end{chunk}
@@ -135996,9 +166598,13 @@ RuleCalled(f:Symbol): SetCategory with
         name: % -> Symbol 
                 ++ name(x) returns the symbol
  == add
+
   name r                 == f
+
   coerce(r:%):OutputForm == f::OutputForm
+
   x = y                  == true
+
   latex(x:%):String      == latex f
 
 \end{chunk}
@@ -136006,6 +166612,15 @@ RuleCalled(f:Symbol): SetCategory with
 \begin{chunk}{COQ RULECOLD}
 (* domain RULECOLD *)
 (*
+
+  name r                 == f
+
+  coerce(r:%):OutputForm == f::OutputForm
+
+  x = y                  == true
+
+  latex(x:%):String      == latex f
+
 *)
 
 \end{chunk}
@@ -136106,15 +166721,21 @@ Ruleset(Base, R, F): Exports == Implementation where
       ++ elt(r,f,n) or r(f, n) applies all the rules of r to f at most n times.
 
   Implementation ==> add
+
     import ApplyRules(Base, R, F)
 
     Rep := Set RR
 
     ruleset l                        == {l}$Rep
+
     coerce(x:$):OutputForm           == coerce(x)$Rep
+
     x = y                            == x =$Rep y
+
     elt(x:$, f:F)                    == applyRules(rules x, f)
+
     elt(r:$, s:F, n:PositiveInteger) == applyRules(rules r, s, n)
+
     rules x                          == parts(x)$Rep
 
 \end{chunk}
@@ -136122,6 +166743,23 @@ Ruleset(Base, R, F): Exports == Implementation where
 \begin{chunk}{COQ RULESET}
 (* domain RULESET *)
 (*
+
+    import ApplyRules(Base, R, F)
+
+    Rep := Set RR
+
+    ruleset l                        == {l}$Rep
+
+    coerce(x:$):OutputForm           == coerce(x)$Rep
+
+    x = y                            == x =$Rep y
+
+    elt(x:$, f:F)                    == applyRules(rules x, f)
+
+    elt(r:$, s:F, n:PositiveInteger) == applyRules(rules r, s, n)
+
+    rules x                          == parts(x)$Rep
+
 *)
 
 \end{chunk}
@@ -136276,6 +166914,7 @@ ScriptFormulaFormat(): public == private where
       ++ formatted object t to strings.
 
   private == add
+
     import OutputForm
     import Character
     import Integer
@@ -136308,7 +166947,6 @@ ScriptFormulaFormat(): public == private where
                             " habove "," here "," labove "]$(L S)
     naryPrecs     : L I := [700,700,800,  800,110,110,  0,    0, 0,
                             0,  0,  0]$(L I)
---  naryNGOps     : L S := ["ROW"," here "]$(L S)
     naryNGOps     : L S := nil$(L S)
 
     plexOps       : L S := ["SIGMA","PI","INTSIGN","INDEFINTEGRAL"]$(L S)
@@ -136501,9 +167139,6 @@ ScriptFormulaFormat(): public == private where
         if tmp ^= "" then form := append(form,[" presub ",tmp])$(List S)
         group concat form
       op = "MATRIX" => formatMatrix rest args
---    op = "ZAG" =>
---      concat ["\zag{",formatFormula(first args, minPrec),"}{",
---        formatFormula(first rest args,minPrec),"}"]
       concat ["not done yet for ",op]
 
     formatPlex(op : S, args : L E, prec : I) : S ==
@@ -136636,6 +167271,358 @@ ScriptFormulaFormat(): public == private where
 \begin{chunk}{COQ FORMULA}
 (* domain FORMULA *)
 (*
+
+    import OutputForm
+    import Character
+    import Integer
+    import List OutputForm
+    import List String
+
+    Rep := Record(prolog : L S, formula : L S, epilog : L S)
+
+    -- local variables declarations and definitions
+
+    expr: E
+    prec,opPrec: I
+    str:  S
+    blank         : S := " @@ "
+
+    maxPrec       : I   := 1000000
+    minPrec       : I   := 0
+
+    splitChars    : S   := " <>[](){}+*=,-%"
+
+    unaryOps      : L S := ["-","^"]$(L S)
+    unaryPrecs    : L I := [700,260]$(L I)
+
+    -- the precedence of / in the following is relatively low because
+    -- the bar obviates the need for parentheses.
+    binaryOps     : L S := ["+->","|","**","/","<",">","=","OVER"]$(L S)
+    binaryPrecs   : L I := [0,0,900, 700,400,400,400,   700]$(L I)
+
+    naryOps       : L S := ["-","+","*",blank,",",";"," ","ROW","",
+                            " habove "," here "," labove "]$(L S)
+    naryPrecs     : L I := [700,700,800,  800,110,110,  0,    0, 0,
+                            0,  0,  0]$(L I)
+    naryNGOps     : L S := nil$(L S)
+
+    plexOps       : L S := ["SIGMA","PI","INTSIGN","INDEFINTEGRAL"]$(L S)
+    plexPrecs     : L I := [    700, 800,      700,            700]$(L I)
+
+    specialOps    : L S := ["MATRIX","BRACKET","BRACE","CONCATB",     _
+                            "AGGLST","CONCAT","OVERBAR","ROOT","SUB", _
+                            "SUPERSUB","ZAG","AGGSET","SC","PAREN"]
+
+    -- the next two lists provide translations for some strings for
+    -- which the formula formatter provides special variables.
+
+    specialStrings : L S :=
+      ["5","..."]
+    specialStringsInFormula : L S :=
+      [" alpha "," ellipsis "]
+
+    -- local function signatures
+
+    addBraces:      S -> S
+    addBrackets:    S -> S
+    group:          S -> S
+    formatBinary:   (S,L E, I) -> S
+    formatFunction: (S,L E, I) -> S
+    formatMatrix:   L E -> S
+    formatNary:     (S,L E, I) -> S
+    formatNaryNoGroup: (S,L E, I) -> S
+    formatNullary:  S -> S
+    formatPlex:     (S,L E, I) -> S
+    formatSpecial:  (S,L E, I) -> S
+    formatUnary:    (S,  E, I) -> S
+    formatFormula:      (E,I) -> S
+    parenthesize:   S -> S
+    precondition:   E -> E
+    postcondition:  S -> S
+    splitLong:      (S,I) -> L S
+    splitLong1:     (S,I) -> L S
+    stringify:      E -> S
+
+    -- public function definitions
+
+    new() : % == [[".eq set blank @",":df."]$(L S),
+      [""]$(L S), [":edf."]$(L S)]$Rep
+
+    coerce(expr : E): % ==
+      f : % := new()$%
+      f.formula := [postcondition
+        formatFormula(precondition expr, minPrec)]$(L S)
+      f
+
+    convert(expr : E, stepNum : I): % ==
+      f : % := new()$%
+      f.formula := concat(["<leqno lparen ",string(stepNum)$S,
+        " rparen>"], [postcondition
+          formatFormula(precondition expr, minPrec)]$(L S))
+      f
+
+    display(f : %, len : I) ==
+      s,t : S
+      for s in f.prolog repeat sayFORMULA(s)$Lisp
+      for s in f.formula repeat
+        for t in splitLong(s, len) repeat sayFORMULA(t)$Lisp
+      for s in f.epilog repeat sayFORMULA(s)$Lisp
+      void()$Void
+
+    display(f : %) ==
+      display(f, _$LINELENGTH$Lisp pretend I)
+
+    prologue(f : %) == f.prolog
+    formula(f : %)  == f.formula
+    epilogue(f : %) == f.epilog
+
+    setPrologue!(f : %, l : L S) == f.prolog := l
+    setFormula!(f : %, l : L S)  == f.formula := l
+    setEpilogue!(f : %, l : L S) == f.epilog := l
+
+    coerce(f : %): E ==
+      s,t : S
+      l : L S := nil
+      for s in f.prolog repeat l := concat(s,l)
+      for s in f.formula repeat
+        for t in splitLong(s, (_$LINELENGTH$Lisp pretend Integer) - 4) repeat
+          l := concat(t,l)
+      for s in f.epilog repeat l := concat(s,l)
+      (reverse l) :: E
+
+    -- local function definitions
+
+    postcondition(str: S): S ==
+      len : I := #str
+      len < 4 => str
+      plus : Character := char "+"
+      minus: Character := char "-"
+      for i in 1..(len-1) repeat
+        if (str.i =$Character plus) and (str.(i+1) =$Character minus)
+          then setelt(str,i,char " ")$S
+      str
+
+    stringify expr == object2String(expr)$Lisp pretend S
+
+    splitLong(str : S, len : I): L S ==
+      -- this blocks into lines
+      if len < 20 then len := _$LINELENGTH$Lisp
+      splitLong1(str, len)
+
+    splitLong1(str : S, len : I) ==
+      l : List S := nil
+      s : S := ""
+      ls : I := 0
+      ss : S
+      lss : I
+      for ss in split(str,char " ") repeat
+        lss := #ss
+        if ls + lss > len then
+          l := concat(s,l)$List(S)
+          s := ""
+          ls := 0
+        lss > len => l := concat(ss,l)$List(S)
+        ls := ls + lss + 1
+        s := concat(s,concat(ss," ")$S)$S
+      if ls > 0 then l := concat(s,l)$List(S)
+      reverse l
+
+    group str ==
+      concat ["<",str,">"]
+
+    addBraces str ==
+      concat ["left lbrace ",str," right rbrace"]
+
+    addBrackets str ==
+      concat ["left lb ",str," right rb"]
+
+    parenthesize str ==
+      concat ["left lparen ",str," right rparen"]
+
+    precondition expr ==
+      outputTran(expr)$Lisp
+
+    formatSpecial(op : S, args : L E, prec : I) : S ==
+      op = "AGGLST" =>
+        formatNary(",",args,prec)
+      op = "AGGSET" =>
+        formatNary(";",args,prec)
+      op = "CONCATB" =>
+        formatNary(" ",args,prec)
+      op = "CONCAT" =>
+        formatNary("",args,prec)
+      op = "BRACKET" =>
+        group addBrackets formatFormula(first args, minPrec)
+      op = "BRACE" =>
+        group addBraces formatFormula(first args, minPrec)
+      op = "PAREN" =>
+        group parenthesize formatFormula(first args, minPrec)
+      op = "OVERBAR" =>
+        null args => ""
+        group concat [formatFormula(first args, minPrec)," bar"]
+      op = "ROOT" =>
+        null args => ""
+        tmp : S := formatFormula(first args, minPrec)
+        null rest args => group concat ["sqrt ",tmp]
+        group concat ["midsup adjust(u 1.5 r 9) ",
+          formatFormula(first rest args, minPrec)," sqrt ",tmp]
+      op = "SC" =>
+        formatNary(" labove ",args,prec)
+      op = "SUB" =>
+        group concat [formatFormula(first args, minPrec)," sub ",
+          formatSpecial("AGGLST",rest args,minPrec)]
+      op = "SUPERSUB" =>
+        -- variable name
+        form : List S := [formatFormula(first args, minPrec)]
+        -- subscripts
+        args := rest args
+        null args => concat form
+        tmp : S := formatFormula(first args, minPrec)
+        if tmp ^= "" then form := append(form,[" sub ",tmp])$(List S)
+        -- superscripts
+        args := rest args
+        null args => group concat form
+        tmp : S := formatFormula(first args, minPrec)
+        if tmp ^= "" then form := append(form,[" sup ",tmp])$(List S)
+        -- presuperscripts
+        args := rest args
+        null args => group concat form
+        tmp : S := formatFormula(first args, minPrec)
+        if tmp ^= "" then form := append(form,[" presup ",tmp])$(List S)
+        -- presubscripts
+        args := rest args
+        null args => group concat form
+        tmp : S := formatFormula(first args, minPrec)
+        if tmp ^= "" then form := append(form,[" presub ",tmp])$(List S)
+        group concat form
+      op = "MATRIX" => formatMatrix rest args
+      concat ["not done yet for ",op]
+
+    formatPlex(op : S, args : L E, prec : I) : S ==
+      hold : S
+      p : I := position(op,plexOps)
+      p < 1 => error "unknown Script Formula Formatter unary op"
+      opPrec := plexPrecs.p
+      n : I := #args
+      (n ^= 2) and (n ^= 3) => error "wrong number of arguments for plex"
+      s : S :=
+        op = "SIGMA"   => "sum"
+        op = "PI"      => "product"
+        op = "INTSIGN" => "integral"
+        op = "INDEFINTEGRAL" => "integral"
+        "????"
+      hold := formatFormula(first args,minPrec)
+      args := rest args
+      if op ^= "INDEFINTEGRAL" then
+        if hold ^= "" then
+          s := concat [s," from",group concat ["\displaystyle ",hold]]
+        if not null rest args then
+          hold := formatFormula(first args,minPrec)
+          if hold ^= "" then
+            s := concat [s," to",group concat ["\displaystyle ",hold]]
+          args := rest args
+        s := concat [s," ",formatFormula(first args,minPrec)]
+      else
+        hold := group concat [hold," ",formatFormula(first args,minPrec)]
+        s := concat [s," ",hold]
+      if opPrec < prec then s := parenthesize s
+      group s
+
+    formatMatrix(args : L E) : S ==
+      -- format for args is [[ROW ...],[ROW ...],[ROW ...]]
+      group addBrackets formatNary(" habove ",args,minPrec)
+
+    formatFunction(op : S, args : L E, prec : I) : S ==
+      group concat [op, " ", parenthesize formatNary(",",args,minPrec)]
+
+    formatNullary(op : S) ==
+      op = "NOTHING" => ""
+      group concat [op,"()"]
+
+    formatUnary(op : S, arg : E, prec : I) ==
+      p : I := position(op,unaryOps)
+      p < 1 => error "unknown Script Formula Formatter unary op"
+      opPrec := unaryPrecs.p
+      s : S := concat [op,formatFormula(arg,opPrec)]
+      opPrec < prec => group parenthesize s
+      op = "-" => s
+      group s
+
+    formatBinary(op : S, args : L E, prec : I) : S ==
+      p : I := position(op,binaryOps)
+      p < 1 => error "unknown Script Formula Formatter binary op"
+      op :=
+        op = "**"    => " sup "
+        op = "/"     => " over "
+        op = "OVER"  => " over "
+        op
+      opPrec := binaryPrecs.p
+      s : S := formatFormula(first args, opPrec)
+      s := concat [s,op,formatFormula(first rest args, opPrec)]
+      group
+        op = " over " => s
+        opPrec < prec => parenthesize s
+        s
+
+    formatNary(op : S, args : L E, prec : I) : S ==
+      group formatNaryNoGroup(op, args, prec)
+
+    formatNaryNoGroup(op : S, args : L E, prec : I) : S ==
+      null args => ""
+      p : I := position(op,naryOps)
+      p < 1 => error "unknown Script Formula Formatter nary op"
+      op :=
+        op = ","     => ", @@ "
+        op = ";"     => "; @@ "
+        op = "*"     => blank
+        op = " "     => blank
+        op = "ROW"   => " here "
+        op
+      l : L S := nil
+      opPrec := naryPrecs.p
+      for a in args repeat
+        l := concat(op,concat(formatFormula(a,opPrec),l)$L(S))$L(S)
+      s : S := concat reverse rest l
+      opPrec < prec => parenthesize s
+      s
+
+    formatFormula(expr,prec) ==
+      i : Integer
+      ATOM(expr)$Lisp pretend Boolean =>
+        str := stringify expr
+        INTEGERP(expr)$Lisp =>
+          i := expr : Integer
+          if (i < 0) or (i > 9) then group str else str
+        (i := position(str,specialStrings)) > 0 =>
+          specialStringsInFormula.i
+        str
+      l : L E := (expr pretend L E)
+      null l => blank
+      op : S := stringify first l
+      args : L E := rest l
+      nargs : I := #args
+
+      -- special cases
+      member?(op, specialOps) => formatSpecial(op,args,prec)
+      member?(op, plexOps)    => formatPlex(op,args,prec)
+
+      -- nullary case
+      0 = nargs => formatNullary op
+
+      -- unary case
+      (1 = nargs) and member?(op, unaryOps) =>
+        formatUnary(op, first args, prec)
+
+      -- binary case
+      (2 = nargs) and member?(op, binaryOps) =>
+        formatBinary(op, args, prec)
+
+      -- nary case
+      member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec)
+      member?(op,naryOps) => formatNary(op,args, prec)
+      op := formatFormula(first l,minPrec)
+      formatFunction(op,args,prec)
+
 *)
 
 \end{chunk}
@@ -136887,15 +167874,23 @@ Segment(S:Type): SegmentCategory(S) with
     Rep := Record(low: S, high: S, incr: Integer)
 
     a..b == [a,b,1]
+
     lo s == s.low
+
     low s == s.low
+
     hi s == s.high
+
     high s == s.high
+
     incr s == s.incr
+
     segment(a,b) == [a,b,1]
+
     BY(s, r) == [lo s, hi s, r]
 
     if S has SetCategory then
+
       (s1:%) = (s2:%) ==
         s1.low = s2.low and s1.high=s2.high and s1.incr = s2.incr
 
@@ -136910,21 +167905,22 @@ Segment(S:Type): SegmentCategory(S) with
       expand(ls: List %):List S ==
         lr := nil()$List(S)
         for s in ls repeat
-          l := lo s
-          h := hi s
-          inc := (incr s)::S
-          zero? inc => error "Cannot expand a segment with an increment of zero"
-          if inc > 0 then
-            while l <= h repeat
-              lr := concat(l, lr)
-              l := l + inc
-          else 
-            while l >= h repeat
-              lr := concat(l, lr)
-              l := l + inc
+         l := lo s
+         h := hi s
+         inc := (incr s)::S
+         zero? inc => error "Cannot expand a segment with an increment of zero"
+         if inc > 0 then
+           while l <= h repeat
+             lr := concat(l, lr)
+             l := l + inc
+         else 
+           while l >= h repeat
+             lr := concat(l, lr)
+             l := l + inc
         reverse_! lr
 
       expand(s : %) == expand([s]$List(%))$%
+
       map(f : S->S, s : %): List S ==
         lr := nil()$List(S)
         l := lo s
@@ -136945,6 +167941,72 @@ Segment(S:Type): SegmentCategory(S) with
 \begin{chunk}{COQ SEG}
 (* domain SEG *)
 (*
+
+    Rep := Record(low: S, high: S, incr: Integer)
+
+    a..b == [a,b,1]
+
+    lo s == s.low
+
+    low s == s.low
+
+    hi s == s.high
+
+    high s == s.high
+
+    incr s == s.incr
+
+    segment(a,b) == [a,b,1]
+
+    BY(s, r) == [lo s, hi s, r]
+
+    if S has SetCategory then
+
+      (s1:%) = (s2:%) ==
+        s1.low = s2.low and s1.high=s2.high and s1.incr = s2.incr
+
+      coerce(s:%):OutputForm ==
+        seg := SEGMENT(s.low::OutputForm, s.high::OutputForm)
+        s.incr = 1 => seg
+        infix(" by "::OutputForm, seg, s.incr::OutputForm)
+
+    convert a == [a,a,1]
+
+    if S has OrderedRing then
+      expand(ls: List %):List S ==
+        lr := nil()$List(S)
+        for s in ls repeat
+         l := lo s
+         h := hi s
+         inc := (incr s)::S
+         zero? inc => error "Cannot expand a segment with an increment of zero"
+         if inc > 0 then
+           while l <= h repeat
+             lr := concat(l, lr)
+             l := l + inc
+         else 
+           while l >= h repeat
+             lr := concat(l, lr)
+             l := l + inc
+        reverse_! lr
+
+      expand(s : %) == expand([s]$List(%))$%
+
+      map(f : S->S, s : %): List S ==
+        lr := nil()$List(S)
+        l := lo s
+        h := hi s
+        inc := (incr s)::S
+        if inc > 0 then
+          while l <= h repeat
+            lr := concat(f l, lr)
+            l := l + inc
+        else
+          while l >= h repeat
+            lr := concat(f l, lr)
+            l := l + inc
+        reverse_! lr
+
 *)
 
 \end{chunk}
@@ -137150,6 +168212,12 @@ SegmentBinding(S:Type): Type with
 \begin{chunk}{COQ SEGBIND}
 (* domain SEGBIND *)
 (*
+
+     b1 = b2       == variable b1 = variable b2 and segment b1 = segment b2
+
+     coerce(b:%):OutputForm ==
+       variable(b)::OutputForm = segment(b)::OutputForm
+
 *)
 
 \end{chunk}
@@ -137625,13 +168693,21 @@ o )show Set
 ++ \tab{5}\spad{insert(x,t)} and \spad{remove(x,t)} is \spad{O(n)}
 
 Set(S:SetCategory): FiniteSetAggregate S == add
+
    Rep := FlexibleArray(S)
+
    # s       == _#$Rep s
+
    brace()   == empty()
+
    set()     == empty()
+
    empty()   == empty()$Rep
+
    copy s    == copy(s)$Rep
+
    parts s   == parts(s)$Rep
+
    inspect s == (empty? s => error "Empty set"; s(maxIndex s))
 
    extract_! s ==
@@ -137659,8 +168735,11 @@ Set(S:SetCategory): FiniteSetAggregate S == add
                           convert(parts x)@InputForm]
 
    if S has OrderedSet then
+
      s = t == s =$Rep t
+
      max s == inspect s
+
      min s == (empty? s => error "Empty set"; s(minIndex s))
 
      construct l ==
@@ -137758,6 +168837,7 @@ Set(S:SetCategory): FiniteSetAggregate S == add
        r
 
     else
+
       insert_!(x, s) ==
         for k in minIndex s .. maxIndex s repeat
           s.k = x => return s
@@ -137776,6 +168856,164 @@ Set(S:SetCategory): FiniteSetAggregate S == add
 \begin{chunk}{COQ SET}
 (* domain SET *)
 (*
+
+   Rep := FlexibleArray(S)
+
+   # s       == _#$Rep s
+
+   brace()   == empty()
+
+   set()     == empty()
+
+   empty()   == empty()$Rep
+
+   copy s    == copy(s)$Rep
+
+   parts s   == parts(s)$Rep
+
+   inspect s == (empty? s => error "Empty set"; s(maxIndex s))
+
+   extract_! s ==
+     x := inspect s
+     delete_!(s, maxIndex s)
+     x
+
+   find(f, s) == find(f, s)$Rep
+
+   map(f, s) == map_!(f,copy s)
+
+   map_!(f,s) ==
+     map_!(f,s)$Rep
+     removeDuplicates_! s
+
+   reduce(f, s) == reduce(f, s)$Rep
+
+   reduce(f, s, x) == reduce(f, s, x)$Rep
+
+   reduce(f, s, x, y) == reduce(f, s, x, y)$Rep
+
+   if S has ConvertibleTo InputForm then
+     convert(x:%):InputForm ==
+        convert [convert("set"::Symbol)@InputForm,
+                          convert(parts x)@InputForm]
+
+   if S has OrderedSet then
+
+     s = t == s =$Rep t
+
+     max s == inspect s
+
+     min s == (empty? s => error "Empty set"; s(minIndex s))
+
+     construct l ==
+       zero?(n := #l) => empty()
+       a := new(n, first l)
+       for i in minIndex(a).. for x in l repeat a.i := x
+       removeDuplicates_! sort_! a
+
+     insert_!(x, s) ==
+       n := inc maxIndex s
+       k := minIndex s
+       while k < n and x > s.k repeat k := inc k
+       k < n and s.k = x => s
+       insert_!(x, s, k)
+
+     member?(x, s) == -- binary search
+       empty? s => false
+       t := maxIndex s
+       b := minIndex s
+       while b < t repeat
+         m := (b+t) quo 2
+         if x > s.m then b := m+1 else t := m
+       x = s.t
+
+     remove_!(x:S, s:%) ==
+       n := inc maxIndex s
+       k := minIndex s
+       while k < n and x > s.k repeat k := inc k
+       k < n and x = s.k => delete_!(s, k)
+       s
+
+     -- the set operations are implemented as variations of merging
+     intersect(s, t) ==
+       m := maxIndex s
+       n := maxIndex t
+       i := minIndex s
+       j := minIndex t
+       r := empty()
+       while i <= m and j <= n repeat
+         s.i = t.j => (concat_!(r, s.i); i := i+1; j := j+1)
+         if s.i < t.j then i := i+1 else j := j+1
+       r
+
+     difference(s:%, t:%) ==
+       m := maxIndex s
+       n := maxIndex t
+       i := minIndex s
+       j := minIndex t
+       r := empty()
+       while i <= m and j <= n repeat
+         s.i = t.j => (i := i+1; j := j+1)
+         s.i < t.j => (concat_!(r, s.i); i := i+1)
+         j := j+1
+       while i <= m repeat (concat_!(r, s.i); i := i+1)
+       r
+
+     symmetricDifference(s, t) ==
+       m := maxIndex s
+       n := maxIndex t
+       i := minIndex s
+       j := minIndex t
+       r := empty()
+       while i <= m and j <= n repeat
+         s.i < t.j => (concat_!(r, s.i); i := i+1)
+         s.i > t.j => (concat_!(r, t.j); j := j+1)
+         i := i+1; j := j+1
+       while i <= m repeat (concat_!(r, s.i); i := i+1)
+       while j <= n repeat (concat_!(r, t.j); j := j+1)
+       r
+
+     subset?(s, t) ==
+       m := maxIndex s
+       n := maxIndex t
+       m > n => false
+       i := minIndex s
+       j := minIndex t
+       while i <= m and j <= n repeat
+         s.i = t.j => (i := i+1; j := j+1)
+         s.i > t.j => j := j+1
+         return false
+       i > m
+
+     union(s:%, t:%) ==
+       m := maxIndex s
+       n := maxIndex t
+       i := minIndex s
+       j := minIndex t
+       r := empty()
+       while i <= m and j <= n repeat
+         s.i = t.j => (concat_!(r, s.i); i := i+1; j := j+1)
+         s.i < t.j => (concat_!(r, s.i); i := i+1)
+         (concat_!(r, t.j); j := j+1)
+       while i <= m repeat (concat_!(r, s.i); i := i+1)
+       while j <= n repeat (concat_!(r, t.j); j := j+1)
+       r
+
+    else
+
+      insert_!(x, s) ==
+        for k in minIndex s .. maxIndex s repeat
+          s.k = x => return s
+        insert_!(x, s, inc maxIndex s)
+
+      remove_!(x:S, s:%) ==
+        n := inc maxIndex s
+        k := minIndex s
+        while k < n repeat
+          x = s.k => return delete_!(s, k)
+          k := inc k
+        s
+
 *)
 
 \end{chunk}
@@ -137899,26 +169137,33 @@ SetOfMIntegersInOneToN(m, n): Exports == Implementation where
       ++ between p and the k^{th} element of S.
  
   Implementation ==> add
+
     Rep := Record(bits:Bits, pos:N)
  
     reallyEnumerate: () -> Vector %
+
     enum: (N, N, PI) -> List Bits
  
     all:Reference Vector % := ref empty()
+
     sz:Reference N := ref 0
  
     s1 = s2                == s1.bits =$Bits s2.bits
+
     coerce(s:%):OutputForm == brace [i::OutputForm for i in elements s]
+
     random()               == index((1 + (random()$Integer rem size()))::PI)
+
     reallyEnumerate()      == [[b, i] for b in enum(m, n, n) for i in 1..]
+
     member?(p, s)          == s.bits.p
  
     enumerate() ==
       if empty? all() then all() := reallyEnumerate()
       all()
  
--- enumerates the sets of p integers in 1..q, returns them as sets in 1..n
--- must have p <= q
+    -- enumerates the sets of p integers in 1..q, returns them as sets in 1..n
+    -- must have p <= q
     enum(p, q, n) ==
       zero? p or zero? q => empty()
       p = q =>
@@ -138011,6 +169256,120 @@ SetOfMIntegersInOneToN(m, n): Exports == Implementation where
 \begin{chunk}{COQ SETMN}
 (* domain SETMN *)
 (*
+
+    Rep := Record(bits:Bits, pos:N)
+ 
+    reallyEnumerate: () -> Vector %
+
+    enum: (N, N, PI) -> List Bits
+ 
+    all:Reference Vector % := ref empty()
+
+    sz:Reference N := ref 0
+ 
+    s1 = s2                == s1.bits =$Bits s2.bits
+
+    coerce(s:%):OutputForm == brace [i::OutputForm for i in elements s]
+
+    random()               == index((1 + (random()$Integer rem size()))::PI)
+
+    reallyEnumerate()      == [[b, i] for b in enum(m, n, n) for i in 1..]
+
+    member?(p, s)          == s.bits.p
+ 
+    enumerate() ==
+      if empty? all() then all() := reallyEnumerate()
+      all()
+ 
+    -- enumerates the sets of p integers in 1..q, returns them as sets in 1..n
+    -- must have p <= q
+    enum(p, q, n) ==
+      zero? p or zero? q => empty()
+      p = q =>
+        b := new(n, false)$Bits
+        for i in 1..p repeat b.i := true
+        [b]
+      q1 := (q - 1)::N
+      l := enum((p - 1)::N, q1, n)
+      if empty? l then l := [new(n, false)$Bits]
+      for s in l repeat s.q := true
+      concat_!(enum(p, q1, n), l)
+ 
+    size() ==
+      if zero? sz() then
+         sz() := binomial(n, m)$IntegerCombinatoricFunctions(Integer) :: N
+      sz()
+ 
+    lookup s ==
+      if empty? all() then all() := reallyEnumerate()
+      if zero?(s.pos) then s.pos := position(s, all()) :: N
+      s.pos :: PI
+      
+    index p ==
+      p > size() => error "index: argument too large"
+      if empty? all() then all() := reallyEnumerate()
+      all().p
+ 
+    setOfMinN l ==
+      s := new(n, false)$Bits
+      count:N := 0
+      for i in l repeat
+        count := count + 1
+        count > m or zero? i or i > n or s.i =>
+          error "setOfMinN: improper set of integers"
+        s.i := true
+      count < m => error "setOfMinN: improper set of integers"
+      [s, 0]
+ 
+    elements s ==
+      b := s.bits
+      l:List PI := empty()
+      found:N := 0
+      i:PI := 1
+      while found < m repeat
+          if b.i then
+              l := concat(i, l)
+              found := found + 1
+          i := i + 1
+      reverse_! l
+ 
+    incrementKthElement(s, k) ==
+      b := s.bits
+      found:N := 0
+      i:N := 1
+      while found < k repeat
+          if b.i then found := found + 1
+          i := i + 1
+      i > n or b.i => "failed"
+      newb := copy b
+      newb.i := true
+      newb.((i-1)::N) := false
+      [newb, 0]
+ 
+    delta(s, k, p) ==
+      b := s.bits
+      count:N := found:N := 0
+      i:PI := 1
+      while found < k repeat
+          if b.i then
+             found := found + 1
+             if i > p and found < k then count := count + 1
+          i := i + 1
+      count
+ 
+    replaceKthElement(s, k, p) ==
+      b := s.bits
+      found:N := 0
+      i:PI := 1
+      while found < k repeat
+          if b.i then found := found + 1
+          if found < k then i := i + 1
+      b.p and i ^= p => "failed"
+      newb := copy b
+      newb.p := true
+      newb.i := false
+      [newb, (i = p => s.pos; 0)]
+
 *)
 
 \end{chunk}
@@ -138466,10 +169825,15 @@ o )show SequentialDifferentialVariable
 
 SequentialDifferentialVariable(S:OrderedSet):DifferentialVariableCategory(S)
   == add
+
     Rep := Record(var:S, ord:NonNegativeInteger)
+
     makeVariable(s,n) == [s, n]
+
     variable v     == v.var
+
     order v        == v.ord
+
     v < u ==
       variable v = variable u => order v < order u
       variable v < variable u
@@ -138479,6 +169843,19 @@ SequentialDifferentialVariable(S:OrderedSet):DifferentialVariableCategory(S)
 \begin{chunk}{COQ SDVAR}
 (* domain SDVAR *)
 (*
+
+    Rep := Record(var:S, ord:NonNegativeInteger)
+
+    makeVariable(s,n) == [s, n]
+
+    variable v     == v.var
+
+    order v        == v.ord
+
+    v < u ==
+      variable v = variable u => order v < order u
+      variable v < variable u
+
 *)
 
 \end{chunk}
@@ -138712,6 +170089,7 @@ SExpressionOf(Str, Sym, Int, Flt, Expr): Decl == Body where
     Decl ==> SExpressionCategory(Str, Sym, Int, Flt, Expr)
 
     Body ==> add
+
         Rep := Expr
 
         dotex:OutputForm := INTERN(".")$Lisp
@@ -138728,36 +170106,57 @@ SExpressionOf(Str, Sym, Int, Flt, Expr): Decl == Body where
             paren blankSeparate l1
 
         b1 = b2        == EQUAL(b1,b2)$Lisp
+
         eq(b1, b2)     == EQ(b1,b2)$Lisp
 
         null? b      == NULL(b)$Lisp
+
         atom? b      == ATOM(b)$Lisp
+
         pair? b      == CONSP(b)$Lisp
 
         list?    b   == CONSP(b)$Lisp or NULL(b)$Lisp
+
         string?  b   == STRINGP(b)$Lisp
+
         symbol?  b   == IDENTP(b)$Lisp
+
         integer? b   == INTEGERP(b)$Lisp
+
         float?   b   == FLOATP(b)$Lisp
 
         destruct b == (list? b    => b pretend List %; error "Non-list")
+
         string b == (STRINGP(b)$Lisp=> b pretend Str;error "Non-string")
+
         symbol b == (IDENTP(b)$Lisp => b pretend Sym;error "Non-symbol")
+
         float   b == (FLOATP(b)$Lisp  => b pretend Flt;error "Non-float")
+
         integer b == (INTEGERP(b)$Lisp => b pretend Int;error "Non-integer")
+
         expr    b == b pretend Expr
 
         convert(l:  List %) == l  pretend %
+
         convert(st: Str)    == st pretend %
+
         convert(sy: Sym)    == sy pretend %
+
         convert(n:  Int)    == n  pretend %
+
         convert(f:  Flt)    == f  pretend %
+
         convert(e:  Expr)   == e
 
         car b        == CAR(b)$Lisp
+
         cdr b        == CDR(b)$Lisp
+
         #   b        == LENGTH(b)$Lisp
+
         elt(b:%, i:Integer)       == destruct(b).i
+
         elt(b:%, li:List Integer) ==
           for i in li repeat b := destruct(b).i
           b
@@ -138767,6 +170166,78 @@ SExpressionOf(Str, Sym, Int, Flt, Expr): Decl == Body where
 \begin{chunk}{COQ SEXOF}
 (* domain SEXOF *)
 (*
+
+        Rep := Expr
+
+        dotex:OutputForm := INTERN(".")$Lisp
+
+        coerce(b:%):OutputForm ==
+            null? b => paren empty()
+            atom? b => coerce(b)$Rep
+            r := b
+            while not atom? r repeat r := cdr r
+            l1 := [b1::OutputForm for b1 in (l := destruct b)]
+            not null? r =>
+              paren blankSeparate concat_!(l1, [dotex, r::OutputForm])
+            #l = 2 and (first(l1) = QUOTE)@Boolean => quote first rest l1
+            paren blankSeparate l1
+
+        b1 = b2        == EQUAL(b1,b2)$Lisp
+
+        eq(b1, b2)     == EQ(b1,b2)$Lisp
+
+        null? b      == NULL(b)$Lisp
+
+        atom? b      == ATOM(b)$Lisp
+
+        pair? b      == CONSP(b)$Lisp
+
+        list?    b   == CONSP(b)$Lisp or NULL(b)$Lisp
+
+        string?  b   == STRINGP(b)$Lisp
+
+        symbol?  b   == IDENTP(b)$Lisp
+
+        integer? b   == INTEGERP(b)$Lisp
+
+        float?   b   == FLOATP(b)$Lisp
+
+        destruct b == (list? b    => b pretend List %; error "Non-list")
+
+        string b == (STRINGP(b)$Lisp=> b pretend Str;error "Non-string")
+
+        symbol b == (IDENTP(b)$Lisp => b pretend Sym;error "Non-symbol")
+
+        float   b == (FLOATP(b)$Lisp  => b pretend Flt;error "Non-float")
+
+        integer b == (INTEGERP(b)$Lisp => b pretend Int;error "Non-integer")
+
+        expr    b == b pretend Expr
+
+        convert(l:  List %) == l  pretend %
+
+        convert(st: Str)    == st pretend %
+
+        convert(sy: Sym)    == sy pretend %
+
+        convert(n:  Int)    == n  pretend %
+
+        convert(f:  Flt)    == f  pretend %
+
+        convert(e:  Expr)   == e
+
+        car b        == CAR(b)$Lisp
+
+        cdr b        == CDR(b)$Lisp
+
+        #   b        == LENGTH(b)$Lisp
+
+        elt(b:%, i:Integer)       == destruct(b).i
+
+        elt(b:%, li:List Integer) ==
+          for i in li repeat b := destruct(b).i
+          b
+
 *)
 
 \end{chunk}
@@ -139023,24 +170494,204 @@ o )show SimpleAlgebraicExtension
 \cross{SAE}{?rem?} 
 \end{tabular}
 
-\begin{chunk}{domain SAE SimpleAlgebraicExtension}
-)abbrev domain SAE SimpleAlgebraicExtension
-++ Author: Barry Trager, Manuel Bronstein, Clifton Williamson
-++ Date Created: 1986
-++ Date Last Updated: 9 May 1994
-++ Description:
-++ Algebraic extension of a ring by a single polynomial.
-++ Domain which represents simple algebraic extensions of arbitrary
-++ rings. The first argument to the domain, R, is the underlying ring,
-++ the second argument is a domain of univariate polynomials over K,
-++ while the last argument specifies the defining minimal polynomial.
-++ The elements of the domain are canonically represented as polynomials
-++ of degree less than that of the minimal polynomial with coefficients
-++ in R. The second argument is both the type of the third argument and
-++ the underlying representation used by \spadtype{SAE} itself.
+\begin{chunk}{domain SAE SimpleAlgebraicExtension}
+)abbrev domain SAE SimpleAlgebraicExtension
+++ Author: Barry Trager, Manuel Bronstein, Clifton Williamson
+++ Date Created: 1986
+++ Date Last Updated: 9 May 1994
+++ Description:
+++ Algebraic extension of a ring by a single polynomial.
+++ Domain which represents simple algebraic extensions of arbitrary
+++ rings. The first argument to the domain, R, is the underlying ring,
+++ the second argument is a domain of univariate polynomials over K,
+++ while the last argument specifies the defining minimal polynomial.
+++ The elements of the domain are canonically represented as polynomials
+++ of degree less than that of the minimal polynomial with coefficients
+++ in R. The second argument is both the type of the third argument and
+++ the underlying representation used by \spadtype{SAE} itself.
+
+SimpleAlgebraicExtension(R:CommutativeRing,
+ UP:UnivariatePolynomialCategory R, M:UP): MonogenicAlgebra(R, UP) == add
+
+    --sqFr(pb): FactorS(Poly) from UnivPolySquareFree(Poly)
+
+    --degree(M) > 0 and M must be monic if R is not a field.
+    if (r := recip leadingCoefficient M) case "failed" then
+                                    error "Modulus cannot be made monic"
+    Rep := UP
+    x,y :$
+    c: R
+
+    mkDisc   : Boolean -> Void
+
+    mkDiscMat: Boolean -> Void
+
+    M   := r::R * M
+
+    d   := degree M
+
+    d1  := subtractIfCan(d,1)::NonNegativeInteger
+
+    discmat:Matrix(R) := zero(d, d)
+
+    nodiscmat?:Reference(Boolean) := ref true
+
+    disc:Reference(R) := ref 0
+
+    nodisc?:Reference(Boolean) := ref true
+
+    bsis := [monomial(1, i)$Rep for i in 0..d1]$Vector(Rep)
+
+    if R has Finite then
+
+         size == size$R ** d
+
+         random == represents([random()$R for i in 0..d1])
+
+    0 == 0$Rep
+
+    1 == 1$Rep
+
+    c * x == c *$Rep x
+
+    n:Integer * x == n *$Rep x
+
+    coerce(n:Integer):$   == coerce(n)$Rep
+
+    coerce(c) == monomial(c,0)$Rep
+
+    coerce(x):OutputForm == coerce(x)$Rep
+
+    lift(x) == x pretend Rep
+
+    reduce(p:UP):$ == (monicDivide(p,M)$Rep).remainder
+
+    x = y == x =$Rep y
+
+    x + y == x +$Rep y
+
+    - x == -$Rep x
+
+    x * y == reduce((x *$Rep y) pretend UP)
+
+    coordinates(x) == [coefficient(lift(x),i) for i in 0..d1]
+
+    represents(vect) == +/[monomial(vect.(i+1),i) for i in 0..d1]
+
+    definingPolynomial()  == M
+
+    characteristic()      == characteristic()$R
+
+    rank()                == d::PositiveInteger
+
+    basis()               == copy(bsis@Vector(Rep) pretend Vector($))
+
+    if R has Field then
+
+      minimalPolynomial x == squareFreePart characteristicPolynomial x
+
+    if R has Field then
+
+      coordinates(x:$,bas: Vector $) ==
+        (m := inverse transpose coordinates bas) case "failed" =>
+          error "coordinates: second argument must be a basis"
+        (m :: Matrix R) * coordinates(x)
+
+    else if R has IntegralDomain then
+
+      coordinates(x:$,bas: Vector $) ==
+        -- we work over the quotient field of R to invert a matrix
+        qf := Fraction R
+        imatqf := InnerMatrixQuotientFieldFunctions(R,Vector R,Vector R,_
+                   Matrix R,qf,Vector qf,Vector qf,Matrix qf)
+        mat := transpose coordinates bas
+        (m := inverse(mat)$imatqf) case "failed" =>
+          error "coordinates: second argument must be a basis"
+        coordsQF: Vector qf := 
+          map(y +-> y::qf,coordinates x)$VectorFunctions2(R,qf)
+        -- here are the coordinates as elements of the quotient field:
+        vecQF := (m :: Matrix qf) * coordsQF
+        vec : Vector R := new(d,0)
+        for i in 1..d repeat
+          xi := qelt(vecQF,i)
+          denom(xi) = 1 => qsetelt_!(vec,i,numer xi)
+          error "coordinates: coordinates are not integral over ground ring"
+        vec
+
+    reducedSystem(m:Matrix $):Matrix(R) ==
+      reducedSystem(map(lift, m)$MatrixCategoryFunctions2($, Vector $,
+               Vector $, Matrix $, UP, Vector UP, Vector UP, Matrix UP))
+
+    reducedSystem(m:Matrix $, v:Vector $):Record(mat:Matrix R,vec:Vector R) ==
+      reducedSystem(map(lift, m)$MatrixCategoryFunctions2($, Vector $,
+               Vector $, Matrix $, UP, Vector UP, Vector UP, Matrix UP),
+                                    map(lift, v)$VectorFunctions2($, UP))
+
+    discriminant() ==
+      if nodisc?() then mkDisc false
+      disc()
+
+    mkDisc b ==
+      nodisc?() := b
+      disc() := discriminant M
+      void
+
+    traceMatrix() ==
+      if nodiscmat?() then mkDiscMat false
+      discmat
+
+    mkDiscMat b ==
+      nodiscmat?() := b
+      mr := minRowIndex discmat; mc := minColIndex discmat
+      for i in 0..d1 repeat
+        for j in 0..d1 repeat
+          qsetelt_!(discmat,mr + i,mc + j,trace reduce monomial(1,i + j))
+      void
+
+    trace x ==          --this could be coded perhaps more efficiently
+      xn := x;  ans := coefficient(lift xn, 0)
+      for n in 1..d1 repeat
+        (xn := generator() * xn;  ans := coefficient(lift xn, n) + ans)
+      ans
+
+    if R has Finite then
+
+       index k ==
+         i:Integer := k rem size()
+         p:Integer := size()$R
+         ans:$ := 0
+         for j in 0.. while i > 0 repeat
+           h := i rem p
+           -- index(p) = 0$R
+           if h ^= 0 then
+             -- here was a bug: "index" instead of
+             -- "coerce", otherwise it wouldn't work for
+             -- Rings R where "coerce: I-> R" is not surjective
+             a := index(h :: PositiveInteger)$R
+             ans := ans + reduce monomial(a, j)
+           i := i quo p
+         ans
+
+       lookup(z : $) : PositiveInteger ==
+         -- z = index lookup z, n = lookup index n
+         -- the answer is merely the Horner evaluation of the
+         -- representation with the size of R (as integers).
+         zero?(z) => size()$$ pretend PositiveInteger
+         p  :            Integer := size()$R
+         co :            Integer := lookup(leadingCoefficient z)$R
+         n  : NonNegativeInteger := degree(z)
+         while not zero?(z := reductum z) repeat
+          co := co * p ** ((n - (n := degree z)) pretend
+            NonNegativeInteger) + lookup(leadingCoefficient z)$R
+         n = 0 => co pretend PositiveInteger
+         (co * p ** n) pretend PositiveInteger
+
+\end{chunk}
+
+\begin{chunk}{COQ SAE}
+(* domain SAE *)
+(*
 
-SimpleAlgebraicExtension(R:CommutativeRing,
- UP:UnivariatePolynomialCategory R, M:UP): MonogenicAlgebra(R, UP) == add
     --sqFr(pb): FactorS(Poly) from UnivPolySquareFree(Poly)
 
     --degree(M) > 0 and M must be monic if R is not a field.
@@ -139051,51 +170702,82 @@ SimpleAlgebraicExtension(R:CommutativeRing,
     c: R
 
     mkDisc   : Boolean -> Void
+
     mkDiscMat: Boolean -> Void
 
     M   := r::R * M
+
     d   := degree M
+
     d1  := subtractIfCan(d,1)::NonNegativeInteger
+
     discmat:Matrix(R) := zero(d, d)
+
     nodiscmat?:Reference(Boolean) := ref true
+
     disc:Reference(R) := ref 0
+
     nodisc?:Reference(Boolean) := ref true
+
     bsis := [monomial(1, i)$Rep for i in 0..d1]$Vector(Rep)
 
     if R has Finite then
+
          size == size$R ** d
+
          random == represents([random()$R for i in 0..d1])
+
     0 == 0$Rep
+
     1 == 1$Rep
+
     c * x == c *$Rep x
+
     n:Integer * x == n *$Rep x
+
     coerce(n:Integer):$   == coerce(n)$Rep
+
     coerce(c) == monomial(c,0)$Rep
+
     coerce(x):OutputForm == coerce(x)$Rep
+
     lift(x) == x pretend Rep
+
     reduce(p:UP):$ == (monicDivide(p,M)$Rep).remainder
+
     x = y == x =$Rep y
+
     x + y == x +$Rep y
+
     - x == -$Rep x
+
     x * y == reduce((x *$Rep y) pretend UP)
+
     coordinates(x) == [coefficient(lift(x),i) for i in 0..d1]
+
     represents(vect) == +/[monomial(vect.(i+1),i) for i in 0..d1]
+
     definingPolynomial()  == M
+
     characteristic()      == characteristic()$R
+
     rank()                == d::PositiveInteger
+
     basis()               == copy(bsis@Vector(Rep) pretend Vector($))
-    --!! I inserted 'copy' in the definition of 'basis'  -- cjw 7/19/91
 
     if R has Field then
+
       minimalPolynomial x == squareFreePart characteristicPolynomial x
 
     if R has Field then
+
       coordinates(x:$,bas: Vector $) ==
         (m := inverse transpose coordinates bas) case "failed" =>
           error "coordinates: second argument must be a basis"
         (m :: Matrix R) * coordinates(x)
 
     else if R has IntegralDomain then
+
       coordinates(x:$,bas: Vector $) ==
         -- we work over the quotient field of R to invert a matrix
         qf := Fraction R
@@ -139152,6 +170834,7 @@ SimpleAlgebraicExtension(R:CommutativeRing,
       ans
 
     if R has Finite then
+
        index k ==
          i:Integer := k rem size()
          p:Integer := size()$R
@@ -139167,6 +170850,7 @@ SimpleAlgebraicExtension(R:CommutativeRing,
              ans := ans + reduce monomial(a, j)
            i := i quo p
          ans
+
        lookup(z : $) : PositiveInteger ==
          -- z = index lookup z, n = lookup index n
          -- the answer is merely the Horner evaluation of the
@@ -139181,31 +170865,6 @@ SimpleAlgebraicExtension(R:CommutativeRing,
          n = 0 => co pretend PositiveInteger
          (co * p ** n) pretend PositiveInteger
 
---
---   KA:=BasicPolynomialFunctions(Poly)
---   minPoly(x) ==
---      ffe:= SqFr(resultant(M::KA, KA.var - lift(x)::KA)).fs.first
---      ffe.flag = "SQFR" => ffe.f
---      mdeg:= (degree(ffe.f) // K.characteristic)::Integer
---      mat:= Zero()::Matrix<mdeg+1,deg+mdeg+1>(K)
---      xi:=L.1;  setelt(mat,1,1,K.1);  setelt(mat,1,(deg+1),K.1)
---      for i in 1..mdeg repeat
---         xi:= x * xi;  xp:= lift(xi)
---         while xp ^= KA.0 repeat
---            setelt(mat,(mdeg+1),(degree(xp)+1),LeadingCoef(xp))
---            xp:=reductum(xp)
---         setelt(mat,(mdeg+1),(deg+i+1),K.1)
---         EchelonLastRow(mat)
---         if and/(elt(mat,(i+1),j) = K.0 for j in 1..deg)
---           then return unitNormal(+/(elt(mat,(i+1),(deg+j+1))*(B::KA)**j
---                                       for j in 0..i)).a
---      ffe.f
-
-\end{chunk}
-
-\begin{chunk}{COQ SAE}
-(* domain SAE *)
-(*
 *)
 
 \end{chunk}
@@ -139369,6 +171028,7 @@ SimpleCell(TheField,ThePols) : PUB == PRIV where
        allSimpleCells([p],var)
 
      PACK ==> CylindricalAlgebraicDecompositionUtilities(TheField,ThePols)
+
      allSimpleCells(lp:List(ThePols),var:Symbol) ==
        lp1 := gcdBasis(lp)$PACK
        null(lp1) => [pointToCell(0,true,var)]
@@ -139391,6 +171051,80 @@ SimpleCell(TheField,ThePols) : PUB == PRIV where
 \begin{chunk}{COQ SCELL}
 (* domain SCELL *)
 (*
+
+     Rep := Record(samplePoint:TheField,
+                   hasDim:B,
+                   varOf:Symbol)
+
+     samplePoint(c) == c.samplePoint
+
+     stablePol(c) == error "Prout"
+
+     hasDimension?(c) == c.hasDim
+
+     variableOf(c) == c.varOf
+
+     coerce(c:%):O ==
+       o : O := ((c.varOf)::O) = ((c.samplePoint)::O)
+       brace [o,(c.hasDim)::O]
+
+     separe(liste,gauche,droite) ==
+       milieu : TheField := (gauche + droite) / (2::TheField)
+       liste = [] => [milieu]
+       #liste = 1 => [gauche,first(liste),droite]
+       nbe := first(liste)
+       lg :List(TheField) := []
+       ld :List(TheField) := rest(liste)
+       sg := sign(milieu-nbe)
+       while sg > 0 repeat
+         lg := cons(nbe,lg)
+         ld = [] => return(separe(reverse(lg),gauche,milieu))
+         nbe := first(ld)
+         sg := sign(milieu-nbe)
+         ld := rest(ld)
+       sg < 0 =>
+         append(separe(reverse(lg),gauche,milieu),
+                rest(separe(cons(nbe,ld),milieu,droite)))
+       newDroite := (gauche+milieu)/(2::TheField)
+       null lg =>
+           newGauche := (milieu+droite)/(2::TheField)
+           while newGauche >= first(ld) repeat
+             newGauche := (milieu+newGauche)/(2::TheField)
+           append([gauche,milieu],separe(ld,newGauche,droite))
+       while newDroite <= first(lg) repeat
+         newDroite := (newDroite+milieu)/(2::TheField)
+       newGauche := (milieu+droite)/(2::TheField)
+       null ld => append(separe(reverse(lg),gauche,newDroite),[milieu,droite])
+       while newGauche >= first(ld) repeat
+         newGauche := (milieu+newGauche)/(2::TheField)
+       append(separe(reverse(lg),gauche,newDroite),
+              cons(milieu,separe(ld,newGauche,droite)))
+
+     pointToCell(sp,hasDim?,varName) ==
+       [sp,hasDim?,varName]$Rep
+
+     allSimpleCells(p:ThePols,var:Symbol) ==
+       allSimpleCells([p],var)
+
+     PACK ==> CylindricalAlgebraicDecompositionUtilities(TheField,ThePols)
+
+     allSimpleCells(lp:List(ThePols),var:Symbol) ==
+       lp1 := gcdBasis(lp)$PACK
+       null(lp1) => [pointToCell(0,true,var)]
+       b := ("max" / [ boundOfCauchy(p)$VARS for p in lp1 ])::TheField
+       l := "append" / [allRootsOf(makeSUP(unitCanonical(p))) for p in lp1]
+       l := sort(l)
+       l1 := separe(l,-b,b)
+       res : List(%) := [pointToCell(first(l1),true,var)]
+       l1 := rest(l1)
+       while not(null(l1)) repeat
+         res := cons(pointToCell(first(l1),false,var),res)
+         l1 := rest(l1)
+         l1 = [] => return(error "Liste vide")
+         res := cons(pointToCell(first(l1),true,var),res)
+         l1 := rest(l1)
+       reverse! res
+
 *)
 
 \end{chunk}
@@ -139522,6 +171256,36 @@ SimpleFortranProgram(R,FS): Exports == Implementation where
 \begin{chunk}{COQ SFORT}
 (* domain SFORT *)
 (*
+
+    Rep := Record(name : Symbol, type : FST, body : FS )
+
+    fortran(fname, ftype, res) ==
+      construct(fname,ftype,res)$Rep
+
+    nameOf(u:$):Symbol == u . name
+
+    typeOf(u:$):Union(FST,"void") == u . type
+
+    bodyOf(u:$):FS == u . body
+
+    argumentsOf(u:$):List Symbol == variables(bodyOf u)$FS
+
+    coerce(u:$):OutputForm ==
+      coerce(nameOf u)$Symbol
+
+    outputAsFortran(u:$):Void ==
+      ftype := (checkType(typeOf(u)::OutputForm)$Lisp)::OutputForm
+      fname := nameOf(u)::OutputForm
+      args := argumentsOf(u)
+      nargs:=args::OutputForm
+      val  := bodyOf(u)::OutputForm
+      fortFormatHead(ftype,fname,nargs)$Lisp
+      fortFormatTypes(ftype,args)$Lisp
+      dispfortexp1$Lisp ["="::OutputForm, fname, val]@List(OutputForm)
+      dispfortexp1$Lisp "RETURN"::OutputForm
+      dispfortexp1$Lisp "END"::OutputForm
+      void()$Void
+
 *)
 
 \end{chunk}
@@ -140032,48 +171796,89 @@ SingleInteger(): Join(IntegerNumberSystem,Logic,OpenMath) with
       OMputEndObject(dev)
 
    reducedSystem m      == m pretend Matrix(Integer)
+
    coerce(x):OutputForm == (convert(x)@Integer)::OutputForm
+
    convert(x:%):Integer == x pretend Integer
+
    i:Integer * y:%      == i::% * y
+
    0         == 0$Lisp
+
    1         == 1$Lisp
+
    base()    == 2$Lisp
+
    max()     == MAXINT
+
    min()     == MININT
+
    x = y     == EQL(x,y)$Lisp
+
    _~ x      == LOGNOT(x)$Lisp
+
    not(x)    == LOGNOT(x)$Lisp
+
    _/_\(x,y) == LOGAND(x,y)$Lisp
+
    _\_/(x,y) == LOGIOR(x,y)$Lisp
+
    Not(x)    == LOGNOT(x)$Lisp
+
    And(x,y)  == LOGAND(x,y)$Lisp
+
    Or(x,y)   == LOGIOR(x,y)$Lisp
+
    xor(x,y)  == LOGXOR(x,y)$Lisp
+
    x < y     == QSLESSP(x,y)$Lisp
+
    inc x     == QSADD1(x)$Lisp
+
    dec x     == QSSUB1(x)$Lisp
+
    - x       == QSMINUS(x)$Lisp
+
    x + y     == QSPLUS(x,y)$Lisp
+
    x:% - y:% == QSDIFFERENCE(x,y)$Lisp
+
    x:% * y:% == QSTIMES(x,y)$Lisp
+
    x:% ** n:NonNegativeInteger == ((EXPT(x, n)$Lisp) @ Integer)::%
+
    x quo y   == QSQUOTIENT(x,y)$Lisp
+
    x rem y   == QSREMAINDER(x,y)$Lisp
+
    divide(x, y)   == CONS(QSQUOTIENT(x,y)$Lisp,QSREMAINDER(x,y)$Lisp)$Lisp
+
    gcd(x,y)  == GCD(x,y)$Lisp
+
    abs(x)    == QSABSVAL(x)$Lisp
+
    odd?(x)   == QSODDP(x)$Lisp
+
    zero?(x)  == QSZEROP(x)$Lisp
---   one?(x)   == ONEP(x)$Lisp
+
    one?(x)   == x = 1
+
    max(x,y)  == QSMAX(x,y)$Lisp
+
    min(x,y)  == QSMIN(x,y)$Lisp
+
    hash(x)   == SXHASH(x)$Lisp
+
    length(x) == INTEGER_-LENGTH(x)$Lisp
+
    shift(x,n)    == QSLEFTSHIFT(x,n)$Lisp
+
    mulmod(a,b,p) == QSMULTMOD(a,b,p)$Lisp
+
    addmod(a,b,p) == QSADDMOD(a,b,p)$Lisp
+
    submod(a,b,p) == QSDIFMOD(a,b,p)$Lisp
+
    negative?(x)  == QSMINUSP$Lisp x
 
 
@@ -140099,6 +171904,7 @@ SingleInteger(): Join(IntegerNumberSystem,Logic,OpenMath) with
    random(n) == RANDOM(n)$Lisp
 
    UCA ==> Record(unit:%,canonical:%,associate:%)
+
    unitNormal x ==
       x < 0 => [-1,-x,-1]$UCA
       [1,x,1]$UCA
@@ -140110,6 +171916,175 @@ SingleInteger(): Join(IntegerNumberSystem,Logic,OpenMath) with
 \begin{chunk}{COQ SINT}
 (* domain SINT *)
 (*
+
+   seed : % := 1$Lisp               -- for random()
+   MAXINT ==> MOST_-POSITIVE_-FIXNUM$Lisp
+   MININT ==> MOST_-NEGATIVE_-FIXNUM$Lisp
+   BASE ==> 67108864$Lisp           -- 2**26
+   MULTIPLIER ==> 314159269$Lisp    -- from Knuth's table
+   MODULUS ==> 2147483647$Lisp      -- 2**31-1
+
+   writeOMSingleInt(dev: OpenMathDevice, x: %): Void ==
+    if x < 0 then
+      OMputApp(dev)
+      OMputSymbol(dev, "arith1", "unary_minus")
+      OMputInteger(dev, convert(-x))
+      OMputEndApp(dev)
+    else
+      OMputInteger(dev, convert(x))
+
+   OMwrite(x: %): String ==
+    s: String := ""
+    sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+    dev: OpenMathDevice := OMopenString(sp @ String, OMencodingXML)
+    OMputObject(dev)
+    writeOMSingleInt(dev, x)
+    OMputEndObject(dev)
+    OMclose(dev)
+    s := OM_-STRINGPTRTOSTRING(sp)$Lisp @ String
+    s
+
+   OMwrite(x: %, wholeObj: Boolean): String ==
+    s: String := ""
+    sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+    dev: OpenMathDevice := OMopenString(sp @ String, OMencodingXML)
+    if wholeObj then
+      OMputObject(dev)
+    writeOMSingleInt(dev, x)
+    if wholeObj then
+      OMputEndObject(dev)
+    OMclose(dev)
+    s := OM_-STRINGPTRTOSTRING(sp)$Lisp @ String
+    s
+
+   OMwrite(dev: OpenMathDevice, x: %): Void ==
+    OMputObject(dev)
+    writeOMSingleInt(dev, x)
+    OMputEndObject(dev)
+
+   OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void ==
+    if wholeObj then
+      OMputObject(dev)
+    writeOMSingleInt(dev, x)
+    if wholeObj then
+      OMputEndObject(dev)
+
+   reducedSystem m      == m pretend Matrix(Integer)
+
+   coerce(x):OutputForm == (convert(x)@Integer)::OutputForm
+
+   convert(x:%):Integer == x pretend Integer
+
+   i:Integer * y:%      == i::% * y
+
+   0         == 0$Lisp
+
+   1         == 1$Lisp
+
+   base()    == 2$Lisp
+
+   max()     == MAXINT
+
+   min()     == MININT
+
+   x = y     == EQL(x,y)$Lisp
+
+   _~ x      == LOGNOT(x)$Lisp
+
+   not(x)    == LOGNOT(x)$Lisp
+
+   _/_\(x,y) == LOGAND(x,y)$Lisp
+
+   _\_/(x,y) == LOGIOR(x,y)$Lisp
+
+   Not(x)    == LOGNOT(x)$Lisp
+
+   And(x,y)  == LOGAND(x,y)$Lisp
+
+   Or(x,y)   == LOGIOR(x,y)$Lisp
+
+   xor(x,y)  == LOGXOR(x,y)$Lisp
+
+   x < y     == QSLESSP(x,y)$Lisp
+
+   inc x     == QSADD1(x)$Lisp
+
+   dec x     == QSSUB1(x)$Lisp
+
+   - x       == QSMINUS(x)$Lisp
+
+   x + y     == QSPLUS(x,y)$Lisp
+
+   x:% - y:% == QSDIFFERENCE(x,y)$Lisp
+
+   x:% * y:% == QSTIMES(x,y)$Lisp
+
+   x:% ** n:NonNegativeInteger == ((EXPT(x, n)$Lisp) @ Integer)::%
+
+   x quo y   == QSQUOTIENT(x,y)$Lisp
+
+   x rem y   == QSREMAINDER(x,y)$Lisp
+
+   divide(x, y)   == CONS(QSQUOTIENT(x,y)$Lisp,QSREMAINDER(x,y)$Lisp)$Lisp
+
+   gcd(x,y)  == GCD(x,y)$Lisp
+
+   abs(x)    == QSABSVAL(x)$Lisp
+
+   odd?(x)   == QSODDP(x)$Lisp
+
+   zero?(x)  == QSZEROP(x)$Lisp
+
+   one?(x)   == x = 1
+
+   max(x,y)  == QSMAX(x,y)$Lisp
+
+   min(x,y)  == QSMIN(x,y)$Lisp
+
+   hash(x)   == SXHASH(x)$Lisp
+
+   length(x) == INTEGER_-LENGTH(x)$Lisp
+
+   shift(x,n)    == QSLEFTSHIFT(x,n)$Lisp
+
+   mulmod(a,b,p) == QSMULTMOD(a,b,p)$Lisp
+
+   addmod(a,b,p) == QSADDMOD(a,b,p)$Lisp
+
+   submod(a,b,p) == QSDIFMOD(a,b,p)$Lisp
+
+   negative?(x)  == QSMINUSP$Lisp x
+
+
+   reducedSystem(m, v) ==
+        [m pretend Matrix(Integer), v pretend Vector(Integer)]
+
+   positiveRemainder(x,n) ==
+      r := QSREMAINDER(x,n)$Lisp
+      QSMINUSP(r)$Lisp =>
+          QSMINUSP(n)$Lisp => QSDIFFERENCE(x, n)$Lisp
+          QSPLUS(r, n)$Lisp
+      r
+
+   coerce(x:Integer):% ==
+      (x <= max pretend Integer) and (x >= min pretend Integer) =>
+        x pretend %
+      error "integer too large to represent in a machine word"
+
+   random() ==
+      seed := REMAINDER(TIMES(MULTIPLIER,seed)$Lisp,MODULUS)$Lisp
+      REMAINDER(seed,BASE)$Lisp
+
+   random(n) == RANDOM(n)$Lisp
+
+   UCA ==> Record(unit:%,canonical:%,associate:%)
+
+   unitNormal x ==
+      x < 0 => [-1,-x,-1]$UCA
+      [1,x,1]$UCA
+
+)bo $noSubsets := false
+
 *)
 
 \end{chunk}
@@ -140199,12 +172174,19 @@ SingletonAsOrderedSet(): OrderedSet with
               create:() -> %
               convert:% -> Symbol
   ==  add
+
    create() == "?" pretend %
+
    a<b == false -- only one element
+
    coerce(a) == outputForm "?"  -- CJW doesn't like this: change ?
+
    a=b == true  -- only one element
+
    min(a,b) == a  -- only one element
+
    max(a,b) == a  -- only one element
+
    convert a == coerce("?")
 
 \end{chunk}
@@ -140212,6 +172194,21 @@ SingletonAsOrderedSet(): OrderedSet with
 \begin{chunk}{COQ SAOS}
 (* domain SAOS *)
 (*
+
+   create() == "?" pretend %
+
+   a<b == false -- only one element
+
+   coerce(a) == outputForm "?"  -- CJW doesn't like this: change ?
+
+   a=b == true  -- only one element
+
+   min(a,b) == a  -- only one element
+
+   max(a,b) == a  -- only one element
+
+   convert a == coerce("?")
+
 *)
 
 \end{chunk}
@@ -141086,11 +173083,621 @@ SparseEchelonMatrix(C : OrderedSet, D : Ring) : Cat == Def where
                 qsetelt!(res.Rows, k, r)
             res
 
-\end{chunk}
-
-\begin{chunk}{COQ SEM}
-(* domain SEM *)
-(*
+\end{chunk}
+
+\begin{chunk}{COQ SEM}
+(* domain SEM *)
+(*
+
+    minInd : I := minIndex([i for i in 1..1])
+    offset : I := minInd-1
+    emptyRec : ROWREC := [empty, empty]
+    noChecks? : B := D has lazyRepresentation  -- flag for lazy representation
+    seed : I := 113                   -- seed for random number generation
+    GCDmode : Sy := iter              -- flag for gcd algorithm
+
+    greater(r1 : ROWREC, r2 : ROWREC) : B ==
+        empty? r1.Indices => false
+        empty? r2.Indices => true
+        first(r2.Indices) < first(r1.Indices)
+
+    -- -------------- --
+    -- Representation --
+    -- -------------- --
+
+    -- For efficiency reasons most checks for correct index ranges are omitted.
+
+    Rep := Record(NCols : NNI, NRows : NNI, AllInds : L C, Rows : V ROWREC)
+
+    ncols(A : %) : NNI == A.NCols
+
+    nrows(A : %) : NNI == A.NRows
+
+    allIndices(A : %) : L C == copy A.AllInds
+
+    row(A : %, i : I) : ROWREC ==
+        -- i < 0 or i > A.NRows => error "index out of range"
+        qelt(A.Rows, i)
+
+    setRow!(A : %, i : I, r : ROWREC) : Void ==
+        -- i < 0 or i > A.NRows => error "index out of range"
+        qsetelt!(A.Rows, i, r)
+        void
+
+    setRow!(A : %, i : I, inds : L C, ents : L D) : Void ==
+        -- i < 0 or i > A.NRows => error "index out of range"
+        -- #inds  ^=  #ents => error "improper row"
+        qsetelt!(A.Rows, i, [inds, ents])
+        void
+
+    new(inds : L C, n : I) : % ==
+        [#inds, n::NNI, inds, [copy emptyRec  for i in 1..n]]
+
+    elt(A : %, i : I, c : C) : D ==
+        r := row(A, i)
+        pos := position(c, r.Indices)
+        pos < minInd => 0$D
+        qelt(r.Entries, pos)
+
+    setelt!(A : %, i : I, c : C, d : D) : Void ==
+        r := row(A, i)
+        pos := position(c, r.Indices)
+        if pos >= minInd then
+            qsetelt!(r.Entries, pos, d)
+        else
+            j := minInd
+            for ind in r.Indices  while c < ind repeat
+                j := j+1
+            r.Indices := insert!(c, r.Indices, j)
+            r.Entries := insert!(d, r.Entries, j)
+        qsetelt!(A.Rows, i, r)
+        void
+
+    coerce(A : %) : MD ==
+        zero? A.NCols => error "cannot coerce matrix with zero columns"
+        AA : MD := new(A.NRows, A.NCols, 0$D)
+        for r in entries(A.Rows)  for i in minRowIndex(AA).. repeat
+            inds := r.Indices
+            ents := r.Entries
+            for ind in A.AllInds  for j in minColIndex(AA).. _
+                    while not empty? inds repeat
+                if ind = first inds then
+                    qsetelt!(AA, i, j, first ents)
+                    inds := rest inds
+                    ents := rest ents
+        AA
+
+    coerce(A : %) : OUT ==
+        zero? A.NCols => 0$D ::OUT
+        A::MD::OUT
+
+    copy(A : %) : % ==
+        resRows : V ROWREC := new(A.NRows, emptyRec)
+        for l in 1..A.NRows repeat
+            r := qelt(A.Rows, l)
+            qsetelt!(resRows, l, [copy r.Indices, copy r.Entries])
+        [A.NCols, A.NRows, copy A.AllInds, resRows]
+
+    -- ----------------------- --
+    -- Basic Matrix Operations --
+    -- ----------------------- --
+
+    elimZeroCols!(A : %) : Void ==
+        newInds : L C := empty
+        for r in entries(A.Rows) repeat
+            newInds := removeDuplicates! merge!((x, y) +-> y < x,
+                                                newInds, r.Indices)
+        A.AllInds := newInds
+        void
+
+    purge!(A : %, crit : C-> B) : Void ==
+        newInds : L C := empty
+        for c in A.AllInds repeat
+            if not crit c then
+                newInds := cons(c, newInds)
+        newInds := reverse! newInds
+        if #newInds  ^=  #A.AllInds then
+            A.AllInds := newInds
+            for l in 1..A.NRows repeat
+                r := qelt(A.Rows, l)
+                newInds : L C := empty
+                newEnts : L D := empty
+                for c in r.Indices   for e in r.Entries repeat
+                    if not crit c then
+                        newInds := cons(c, newInds)
+                        newEnts := cons(e, newEnts)
+                qsetelt!(A.Rows, l, [reverse! newInds, reverse! newEnts])
+        void
+
+    sortedPurge!(A : %, crit : C-> B) : Void ==
+        if crit first A.AllInds then
+            while not(empty? A.AllInds) and crit first A.AllInds repeat
+                A.AllInds := rest A.AllInds
+            for l in 1..A.NRows repeat
+                r := qelt(A.Rows, l)
+                while not(empty? r.Indices) and crit first r.Indices repeat
+                    r.Indices := rest r.Indices
+                    r.Entries := rest r.Entries
+                qsetelt!(A.Rows, l, r)
+        void
+
+    deleteRow!(A : %, i : I) : Void ==
+        i > A.NRows => A
+        nr := (A.NRows-1)::NNI
+        resRows : V ROWREC := new(nr, emptyRec)
+        for l in 1..(i-1) repeat
+            qsetelt!(resRows, l, qelt(A.Rows, l))
+        for l in (i+1)..A.NRows repeat
+            qsetelt!(resRows, l-1, qelt(A.Rows, l))
+        A.NRows := nr
+        A.Rows := resRows
+        void
+
+    consRow!(A : %, r : ROWREC) : Void ==
+        A.NRows := A.NRows + 1
+        newRows : L ROWREC := cons(r, entries A.Rows)
+        A.Rows := construct newRows
+        newInds := setDifference(r.Indices, A.AllInds)
+        if not empty? newInds then
+            A.AllInds := merge((x, y) +-> y < x, A.AllInds,
+                               sort!((x, y) +-> y < x, newInds))
+        void
+
+    appendRow!(A : %, r : ROWREC) : Void ==
+        A.NRows := A.NRows + 1
+        newRows : L ROWREC := concat(entries A.Rows, r)
+        A.Rows := construct newRows
+        newInds := setDifference(r.Indices, A.AllInds)
+        if not empty? newInds then
+            A.AllInds := merge((x, y) +-> y < x, A.AllInds,
+                               sort!((x, y) +-> y < x, newInds))
+        void
+
+    extract(A : %, i1 : I, i2 : I) : % ==
+        nr := (i2-i1+1)::NNI
+        resRows : V ROWREC := new(nr, emptyRec)
+        newInds : L C := empty
+        for i in i1..i2 repeat
+            qsetelt!(resRows, i-i1+1, row(A, i))
+            newInds := removeDuplicates! merge((x, y) +-> y < x,
+                                               newInds, row(A, i).Indices)
+        [A.NCols, nr, newInds, resRows]
+
+    join(A1 : %, A2 : %) : % ==
+        newInds := removeDuplicates! merge((x : C, y : C) : Boolean +-> y < x,
+                                           A1.AllInds, A2.AllInds)
+        newNRows := A1.NRows + A2.NRows
+        newRows : V ROWREC := new(newNRows, emptyRec)
+        for l in 1..A1.NRows repeat
+            qsetelt!(newRows, l, qelt(A1.Rows, l))
+        for l in 1..A2.NRows repeat
+            qsetelt!(newRows, A1.NRows+l, qelt(A2.Rows, l))
+        [#newInds, newNRows, newInds, newRows]
+
+    horizJoin(A1 : %, A2 : %) : % ==
+        A1.NRows ^= A2.NRows => error "incompatible dimensions in horizJoin"
+        newInds := append(A1.AllInds, A2.AllInds)
+        res : % := new(newInds, A1.NRows)
+        for i in 1..A1.NRows repeat
+            r1 := row(A1, i)
+            r2 := row(A2, i)
+            setRow!(res, i, append(r1.Indices, r2.Indices), _
+                            append(r1.Entries, r2.Entries))
+        res
+
+    horizSplit(A : %, c : C) : Record(Left : %, Right : %) ==
+        rinds : L C := allIndices A
+        linds : L C := empty
+        while not(empty? rinds) and (first(rinds) > c) repeat
+            linds := cons(first(rinds), linds)
+            rinds := rest rinds
+        empty? linds => [new(linds, A.NRows), A]
+        linds := reverse! linds
+        empty? rinds => [A, new(rinds, A.NRows)]
+        LA : % := new(linds, A.NRows)
+        RA : % := new(rinds, A.NRows)
+        for i in 1..A.NRows repeat
+            r := row(A, i)
+            ri : L C := r.Indices
+            re : L D := r.Entries
+            li : L C := empty
+            le : L D := empty
+            while not(empty? ri) and (first(ri) > c) repeat
+                li := cons(first(ri), li)
+                le := cons(first re, le)
+                ri := rest ri
+                re := rest re
+            if not empty? li then
+                li := reverse! li
+                le := reverse! le
+                setRow!(LA, i, li, le)
+            if not empty? ri then
+                setRow!(RA, i, ri, re)
+        [LA, RA]
+
+    -- ----------- --
+    -- Row Echelon --
+    -- ----------- --
+
+    addRows(d1 : D, r1 : ROWREC, d2 : D, r2 : ROWREC) : ROWREC ==
+        -- Computes linear combination of two rows.
+        -- Local function.
+        empty? r1.Indices =>
+            one? d2 => r2
+            [r2.Indices, [d2*e2  for e2 in r2.Entries]]
+        empty? r2.Indices =>
+            one? d1 => r1
+            [r1.Indices, [d1*e1  for e1 in r1.Entries]]
+        resI : L C := empty
+        resE : L D := empty
+        lent1 : L D
+        lent2 : L D
+        if not(noChecks?) and one? d1 then
+            lent1 := r1.Entries
+        else
+            lent1 := [d1*e1  for e1 in r1.Entries]
+        if not(noChecks?) and one? d2 then
+            lent2 := copy r2.Entries
+        else
+            lent2 := [d2*e2  for e2 in r2.Entries]
+        lind2 := copy r2.Indices
+
+        for c1 in r1.Indices  for e1 in lent1 repeat
+            while not(empty? lind2) and c1 < first(lind2) repeat
+                resI := cons(first lind2, resI)
+                resE := cons(first(lent2), resE)
+                lind2 := rest lind2
+                lent2 := rest lent2
+            if not(empty? lind2) and first(lind2) = c1 then
+                sum := e1+first(lent2)
+                if noChecks? or not zero? sum then
+                    resI := cons(c1, resI)
+                    resE := cons(sum, resE)
+                lind2 := rest lind2
+                lent2 := rest lent2
+            else
+                resI := cons(c1, resI)
+                resE := cons(e1, resE)
+
+        resI := concat!(reverse! resI, lind2)
+        resE := concat!(reverse! resE, lent2)
+        while not(empty? resE) and zero? first resE repeat
+            resI := rest resI
+            resE := rest resE
+        [resI, resE]
+
+    pivot(A : %, i : I) : Record(Index : C, Entry : D) ==
+        r := row(A, i)
+        empty? r.Indices => error "empty row"
+        [first r.Indices, first r.Entries]
+
+    pivots(A : %) : ROWREC ==
+        resI : L C := empty
+        resE : L D := empty
+        for r in entries A.Rows | not empty? r.Indices repeat
+            resI := cons(first r.Indices, resI)
+            resE := cons(first r.Entries, resE)
+        [reverse! resI, reverse! resE]
+
+    rowEchelon(AA : %) : Record(Ech : %, Lt : MD, Pivots : L D, Rank : NNI) ==
+        A := copy AA
+        LTr : MD := diagonalMatrix [1$D  for i in 1..A.NRows]
+        Pivs : L D := empty
+
+        -- check pivots
+        for i in 1..A.NRows repeat
+            r := qelt(A.Rows, i)
+            changed? : B := false
+            while not(empty? r.Entries) and zero? first r.Entries repeat
+                r.Entries := rest r.Entries
+                r.Indices := rest r.Indices
+                changed? := true
+            if changed? then
+                qsetelt!(A.Rows, i, r)
+
+        -- sort rows by pivots (bubble sort)
+        sorted? : B := false
+        until sorted? repeat
+            sorted? := true
+            oldr := qelt(A.Rows, 1)
+            for i in 2..A.NRows repeat
+                newr := qelt(A.Rows, i)
+                if greater(newr, oldr) then
+                    qsetelt!(A.Rows, i, oldr)
+                    qsetelt!(A.Rows, i-1, newr)
+                    swapRows!(LTr, i-1, i)
+                    sorted? := false
+                else
+                    oldr := newr
+
+        -- fraction-free elimination
+        finished? : B := false
+        pivlen, pivrow, rk : NNI
+        for i in 1..A.NRows  until finished? repeat
+            r := qelt(A.Rows, i)
+            finished? := empty? r.Indices
+            if finished? then
+                rk : NNI := (i-1)::NNI
+            else                         -- search good pivot
+                pivind := first r.Indices
+                pivlen := #r.Indices
+                pivrow := i
+                k : I := 0
+                for j in (i+1)..A.NRows _
+                        while not(empty? qelt(A.Rows, j).Indices) and _
+                            pivind = first(qelt(A.Rows, j).Indices) repeat
+                    len := #qelt(A.Rows, j).Indices
+                    k := k+1
+                    if len < pivlen then
+                        pivlen := len
+                        pivrow := j
+                piv : D := first qelt(A.Rows, pivrow).Entries
+                Pivs := cons(piv, Pivs)
+
+                -- elimination necessary?
+                if k > 0 then
+                    if pivrow ^= i then
+                        pr := qelt(A.Rows, pivrow)
+                        qsetelt!(A.Rows, pivrow, qelt(A.Rows, i))
+                        qsetelt!(A.Rows, i, pr)
+                        swapRows!(LTr, i, pivrow)
+
+                    -- elimination (and resorting of rows)
+                    pr := copy qelt(A.Rows, i)
+                    pr.Indices := rest pr.Indices
+                    pr.Entries := rest pr.Entries
+                    for j in (i+1)..(i+k) repeat
+                        r := copy qelt(A.Rows, i+1)
+                        c := first r.Entries
+                        r.Indices := rest r.Indices
+                        r.Entries := rest r.Entries
+                        r := addRows(piv, r, -c, pr)
+                        for l in 1..A.NRows repeat
+                            f := piv*qelt(LTr, i+1, l) - c*qelt(LTr, i, l)
+                            qsetelt!(LTr, i+1, l, f)
+                        for l in (i+2)..(2*i+k+1-j) repeat
+                            qsetelt!(A.Rows, l-1, qelt(A.Rows, l))
+                            swapRows!(LTr, l-1, l)
+                        for l in (2*i+k+2-j)..A.NRows _
+                                while greater(qelt(A.Rows, l), r) repeat
+                            qsetelt!(A.Rows, l-1, qelt(A.Rows, l))
+                            swapRows!(LTr, l-1, l)
+                        qsetelt!(A.Rows, l-1, r)
+
+        if not finished? then
+            rk : NNI := A.NRows
+        [A, LTr, Pivs, rk]
+
+    if D has GcdDomain then
+
+        setGcdMode(s : Sy) : Sy ==
+            tmp := GCDmode
+            (s = iter) or (s = rand) =>
+                GCDmode := s
+                tmp
+            error "unknown gcd mode"
+
+        randomGCD(le : L D) : D ==
+            -- Probabilistic technique.
+            #le = 2 => gcd(first le, second le)
+            f := first le
+            g := second le
+            l := rest rest le
+            while not empty? l repeat
+                one? first l => return 1$D
+                f := f + (1+random(113)$I)*first(l)
+                l := rest l
+                if not empty? l then
+                    one? first l => return 1$D
+                    g := g + (1+random(113)$I)*first(l)
+                    l := rest l
+            h := gcd(f, g)
+            l := [h]
+            for e in le repeat
+                tmp := e exquo h
+                if tmp case "failed" then
+                    l := cons(e, l)
+            one?(#l) => h
+            randomGCD l
+
+        iteratedGCD(le : L D) : D ==
+            -- Computes gcd iteratively
+            res := gcd(first le, second le)
+            l := rest rest le
+            while not(empty?(l) or one?(res)) repeat
+                res := gcd(res, first l)
+                l := rest l
+            res
+
+        makePrimitive(r : ROWREC) : Record(GCD : D, Row : ROWREC) ==
+            -- remove common gcd of row
+            le := r.Entries
+            one?(#le) => [first le, [r.Indices, [1$D]]]
+            g : D
+            if GCDmode = 'iterated then
+                g := iteratedGCD le
+            else
+                g := randomGCD le
+            one? g => [1, r]
+            le := [(e exquo g)::D  for e in le]
+            [g, [r.Indices, le]]
+
+        primitiveRowEchelon(AA : %) : _
+                Record(Ech : %, Lt : MFD, Pivots : L D, Rank : NNI) ==
+            A := copy AA
+            LTr : MFD := diagonalMatrix [1$FD  for i in 1..A.NRows]
+            Pivs : L D := empty
+
+            -- check pivots
+            for i in 1..A.NRows repeat
+                r := qelt(A.Rows, i)
+                changed? : B := false
+                while not(empty? r.Entries) and zero? first r.Entries repeat
+                    r.Entries := rest r.Entries
+                    r.Indices := rest r.Indices
+                    changed? := true
+                if changed? then
+                    qsetelt!(A.Rows, i, r)
+
+            -- sort rows by pivots (bubble sort)
+            sorted? : B := false
+            until sorted? repeat
+                sorted? := true
+                oldr := qelt(A.Rows, 1)
+                for i in 2..A.NRows repeat
+                    newr := qelt(A.Rows, i)
+                    if greater(newr, oldr) then
+                        qsetelt!(A.Rows, i, oldr)
+                        qsetelt!(A.Rows, i-1, newr)
+                        swapRows!(LTr, i-1, i)
+                        sorted? := false
+                    else
+                        oldr := newr
+
+            -- primitive fraction-free elimination
+            finished? : B := false
+            pivlen, pivrow, rk : NNI
+            for i in 1..A.NRows  until finished? repeat
+                r := qelt(A.Rows, i)
+                finished? := empty? r.Indices
+                if finished? then
+                    rk : NNI := (i-1)::NNI
+                else                          -- search good pivot
+                    pivind := first r.Indices
+                    pivlen := #r.Indices
+                    pivrow := i
+                    k : I := 0
+                    for j in (i+1)..A.NRows _
+                            while not(empty? qelt(A.Rows, j).Indices) and _
+                              pivind = first(qelt(A.Rows, j).Indices) repeat
+                        len := #qelt(A.Rows, j).Indices
+                        k := k+1
+                        if len < pivlen then
+                            pivlen := len
+                            pivrow := j
+
+                    -- make row primitive
+                    tmp := makePrimitive qelt(A.Rows, pivrow)
+                    if not one? tmp.GCD then
+                        qsetelt!(A.Rows, pivrow, tmp.Row)
+                        q : FD := 1/tmp.GCD
+                        for l in 1..A.NRows | not zero? qelt(LTr, pivrow, l) _
+                                repeat
+                            qsetelt!(LTr, pivrow, l, q*qelt(LTr, pivrow, l))
+                    piv : D := first qelt(A.Rows, pivrow).Entries
+                    Pivs := cons(piv, Pivs)
+
+                    -- elimination necessary?
+                    if k > 0 then
+                        if pivrow ^= i then
+                            pr := qelt(A.Rows, pivrow)
+                            qsetelt!(A.Rows, pivrow, qelt(A.Rows, i))
+                            qsetelt!(A.Rows, i, pr)
+                            swapRows!(LTr, i, pivrow)
+
+                        -- elimination (and resorting of rows)
+                        pr := copy tmp.Row
+                        pr.Indices := rest pr.Indices
+                        pr.Entries := rest pr.Entries
+                        for j in (i+1)..(i+k) repeat
+                            r := copy qelt(A.Rows, i+1)
+                            c := first r.Entries
+                            r.Indices := rest r.Indices
+                            r.Entries := rest r.Entries
+                            r := addRows(piv, r, -c, pr)
+                            for l in 1..A.NRows repeat
+                                fd : FD := piv *$FD qelt(LTr, i+1, l) - _
+                                           (c*qelt(LTr, i, l))::FD
+                                qsetelt!(LTr, i+1, l, fd)
+                            for l in (i+2)..(2*i+k+1-j) repeat
+                                qsetelt!(A.Rows, l-1, qelt(A.Rows, l))
+                                swapRows!(LTr, l-1, l)
+                            for l in (2*i+k+2-j)..A.NRows _
+                                    while greater(qelt(A.Rows, l), r) repeat
+                                qsetelt!(A.Rows, l-1, qelt(A.Rows, l))
+                                swapRows!(LTr, l-1, l)
+                            qsetelt!(A.Rows, l-1, r)
+
+            if not finished? then
+                rk : NNI := A.NRows
+            [A, LTr, Pivs, rk]
+
+    -- -------------- --
+    -- Multiplication --
+    -- -------------- --
+
+    L : MD * AA : % ==
+        ncols(L) ^= AA.NRows => error "improper matrix dimensions"
+        A := copy AA
+        rlen := nrows L
+        res : % := new(A.AllInds, rlen)
+
+        for c in A.AllInds repeat
+            tmp : V D := new(rlen, 0$D)
+            for i in 1..A.NRows repeat
+                r := qelt(A.Rows, i)
+                inds := r.Indices
+                if not(empty? inds) and first(inds) = c then
+                    for k in 1..rlen | not zero? qelt(L, k, i) repeat
+                        qsetelt!(tmp, k, qelt(tmp, k) + qelt(L, k, i)* _
+                                 first(r.Entries))
+                    r.Entries := rest r.Entries
+                    r.Indices := rest inds
+                    qsetelt!(A.Rows, i, r)
+            for k in 1..rlen | not zero? qelt(tmp, k) repeat
+                r := qelt(res.Rows, k)
+                r.Indices := cons(c, r.Indices)
+                r.Entries := cons(qelt(tmp, k), r.Entries)
+                qsetelt!(res.Rows, k, r)
+
+        for k in 1..rlen repeat
+            r := qelt(res.Rows, k)
+            r.Indices := reverse! r.Indices
+            r.Entries := reverse! r.Entries
+            qsetelt!(res.Rows, k, r)
+        res
+
+    if D has IntegralDomain then
+
+        mult(f : FD, d : D) : D ==
+            res := numer(f)*d
+            tmp := res exquo denom(f)
+            tmp case "failed" => error "cannot divide in mult"
+            tmp::D
+
+        L : MFD * AA : % ==
+            ncols(L) ^= AA.NRows => error "improper matrix dimensions"
+            A := copy AA
+            rlen := nrows L
+            res : % := new(A.AllInds, rlen)
+
+            for c in A.AllInds repeat
+                tmp : V FD := new(rlen, 0$FD)
+                for i in 1..A.NRows repeat
+                    r := qelt(A.Rows, i)
+                    inds := r.Indices
+                    if not(empty? inds) and first(inds) = c then
+                        for k in 1..rlen | not zero? qelt(L, k, i) repeat
+                            qsetelt!(tmp, k, qelt(tmp, k) + qelt(L, k, i)* _
+                                     first(r.Entries))
+                        r.Entries := rest r.Entries
+                        r.Indices := rest inds
+                        qsetelt!(A.Rows, i, r)
+                for k in 1..rlen | not zero? qelt(tmp, k) repeat
+                    d : Union(D, "failed") := retractIfCan qelt(tmp, k)
+                    d case "failed" => error "cannot divide in *"
+                    r := qelt(res.Rows, k)
+                    r.Indices := cons(c, r.Indices)
+                    r.Entries := cons(d::D, r.Entries)
+                    qsetelt!(res.Rows, k, r)
+
+            for k in 1..rlen repeat
+                r := qelt(res.Rows, k)
+                r.Indices := reverse! r.Indices
+                r.Entries := reverse! r.Entries
+                qsetelt!(res.Rows, k, r)
+            res
+
 *)
 
 \end{chunk}
@@ -141904,6 +174511,541 @@ SparseMultivariatePolynomial(R: Ring,VarSet: OrderedSet): C == T where
 \begin{chunk}{COQ SMP}
 (* domain SMP *)
 (*
+    --constants
+    --D := F(%) replaced by next line until compiler support completed
+
+    --representations
+      D := SparseUnivariatePolynomial(%)
+      VPoly:=  Record(v:VarSet,ts:D)
+      Rep:=  Union(R,VPoly)
+
+    --declarations
+      fn: R -> R
+      n: Integer
+      k: NonNegativeInteger
+      kp:PositiveInteger
+      k1:NonNegativeInteger
+      c: R
+      mvar: VarSet
+      val : R
+      var:VarSet
+      up: D
+      p,p1,p2,pval: %
+      Lval : List(R)
+      Lpval : List(%)
+      Lvar : List(VarSet)
+
+    --define
+      0 == 
+        0$R::%
+
+      1 == 
+        1$R::%
+
+      zero? p == 
+        p case R and zero?(p)$R
+
+      one? p == 
+        p case R and ((p) = 1)$R
+
+      -- a local function
+      red(p:%):% ==
+        p case R => 0
+        if ground?(reductum p.ts) then 
+          leadingCoefficient(reductum p.ts) else [p.v,reductum p.ts]$VPoly
+
+      numberOfMonomials(p): NonNegativeInteger ==
+        p case R => 
+          zero?(p)$R => 0
+          1
+        +/[numberOfMonomials q for q in coefficients(p.ts)]
+
+      coerce(mvar):% == 
+        [mvar,monomial(1,1)$D]$VPoly
+
+      monomial? p ==
+        p case R => true
+        sup : D := p.ts
+        1 ^= numberOfMonomials(sup) => false
+        monomial? leadingCoefficient(sup)$D
+
+--    local
+
+      moreThanOneVariable?: % -> Boolean
+
+      moreThanOneVariable? p == 
+         p case R => false
+         q:=p.ts
+         any?(x1+->not ground? x1 ,coefficients q) => true
+         false
+
+      -- if we already know we use this (slighlty) faster function
+      univariateKnown: % -> SparseUnivariatePolynomial R 
+
+      univariateKnown p == 
+        p case R => (leadingCoefficient p) :: SparseUnivariatePolynomial(R)
+        monomial( leadingCoefficient p,degree p.ts)+ univariateKnown(red p)
+
+      univariate p ==
+        p case R =>(leadingCoefficient p) :: SparseUnivariatePolynomial(R)
+        moreThanOneVariable?  p => error "not univariate"
+        monomial( leadingCoefficient p,degree p.ts)+ univariate(red p)
+
+      multivariate (u:SparseUnivariatePolynomial(R),var:VarSet) ==
+        ground? u => (leadingCoefficient u) ::%
+        [var,monomial(leadingCoefficient u,degree u)$D]$VPoly +
+           multivariate(reductum u,var)
+
+      univariate(p:%,mvar:VarSet):SparseUnivariatePolynomial(%) ==
+        p case R or mvar>p.v  => monomial(p,0)$D
+        pt:=p.ts
+        mvar=p.v => pt
+        monomial(1,p.v,degree pt)*univariate(leadingCoefficient pt,mvar)+
+          univariate(red p,mvar)
+
+      --  a local functions, used in next definition
+      unlikeUnivReconstruct(u:SparseUnivariatePolynomial(%),mvar:VarSet):% ==
+        zero? (d:=degree u) => coefficient(u,0)
+        monomial(leadingCoefficient u,mvar,d)+
+            unlikeUnivReconstruct(reductum u,mvar)
+
+      multivariate(u:SparseUnivariatePolynomial(%),mvar:VarSet):% ==
+        ground? u => coefficient(u,0)
+        uu:=u
+        while not zero? uu repeat
+          cc:=leadingCoefficient uu
+          cc case R or mvar > cc.v => uu:=reductum uu
+          return unlikeUnivReconstruct(u,mvar)
+        [mvar,u]$VPoly
+
+      ground?(p:%):Boolean ==
+        p case R => true
+        false
+
+      monomial(p,mvar,k1) ==
+        zero? k1 or zero? p => p
+        p case R or mvar>p.v => [mvar,monomial(p,k1)$D]$VPoly
+        p*[mvar,monomial(1,k1)$D]$VPoly
+
+      monomial(c:R,e:IndexedExponents(VarSet)):% ==
+        zero? e => (c::%)
+        monomial(1,leadingSupport e, leadingCoefficient e) *
+            monomial(c,reductum e)
+
+      coefficient(p:%, e:IndexedExponents(VarSet)) : R ==
+        zero? e =>
+          p case R  => p::R
+          coefficient(coefficient(p.ts,0),e)
+        p case R => 0
+        ve := leadingSupport e
+        vp := p.v
+        ve < vp =>
+          coefficient(coefficient(p.ts,0),e)
+        ve > vp => 0
+        coefficient(coefficient(p.ts,leadingCoefficient e),reductum e)
+
+      coerce(n) == 
+        n::R::%
+
+      coerce(c) == 
+        c::%
+
+      characteristic == 
+        characteristic$R
+
+      recip(p) ==
+        p case R => (uu:=recip(p::R);uu case "failed" => "failed"; uu::%)
+        "failed"
+
+      - p ==
+        p case R => -$R p
+        [p.v, - p.ts]$VPoly
+
+      n * p ==
+        p case R => n * p::R
+        mvar:=p.v
+        up:=n*p.ts
+        if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly
+
+      c * p ==
+        c = 1 => p
+        p case R => c * p::R
+        mvar:=p.v
+        up:=c*p.ts
+        if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly
+
+      p1 + p2 ==
+        p1 case R and p2 case R => p1 +$R p2
+        p1 case R => [p2.v, p1::D + p2.ts]$VPoly
+        p2 case R => [p1.v,  p1.ts + p2::D]$VPoly
+        p1.v = p2.v => 
+             mvar:=p1.v
+             up:=p1.ts+p2.ts
+             if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly
+        p1.v < p2.v =>
+             [p2.v, p1::D + p2.ts]$VPoly
+        [p1.v, p1.ts + p2::D]$VPoly
+
+      p1 - p2 ==
+        p1 case R and p2 case R => p1 -$R p2
+        p1 case R => [p2.v, p1::D - p2.ts]$VPoly
+        p2 case R => [p1.v,  p1.ts - p2::D]$VPoly
+        p1.v = p2.v =>
+             mvar:=p1.v
+             up:=p1.ts-p2.ts
+             if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly
+        p1.v < p2.v =>
+             [p2.v, p1::D - p2.ts]$VPoly
+        [p1.v, p1.ts - p2::D]$VPoly
+
+      p1 = p2 ==
+        p1 case R =>
+            p2 case R => p1 =$R p2
+            false
+        p2 case R => false
+        p1.v = p2.v => p1.ts = p2.ts
+        false
+
+      p1 * p2 ==
+        p1 case R => p1::R * p2
+        p2 case R => 
+           mvar:=p1.v
+           up:=p1.ts*p2
+           if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly
+        p1.v = p2.v => 
+           mvar:=p1.v
+           up:=p1.ts*p2.ts
+           if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly
+        p1.v > p2.v => 
+           mvar:=p1.v
+           up:=p1.ts*p2
+           if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly
+           --- p1.v < p2.v 
+        mvar:=p2.v
+        up:=p1*p2.ts
+        if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly
+
+      p ^ kp == 
+        p ** (kp pretend NonNegativeInteger)
+
+      p ** kp == 
+        p ** (kp pretend NonNegativeInteger )
+
+      p ^ k == 
+        p ** k
+
+      p ** k  ==
+         p case R => p::R ** k
+         -- univariate special case 
+         not moreThanOneVariable? p => 
+             multivariate( (univariateKnown p) ** k , p.v)
+         mvar:=p.v
+         up:=p.ts ** k
+         if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly
+
+      if R has IntegralDomain then
+
+         UnitCorrAssoc ==> Record(unit:%,canonical:%,associate:%)
+         unitNormal(p) ==
+            u,c,a:R
+            p case R =>
+              (u,c,a):= unitNormal(p::R)$R
+              [u::%,c::%,a::%]$UnitCorrAssoc
+            (u,c,a):= unitNormal(leadingCoefficient(p))$R
+            [u::%,(a*p)::%,a::%]$UnitCorrAssoc
+
+         unitCanonical(p) ==
+            p case R => unitCanonical(p::R)$R
+            (u,c,a):= unitNormal(leadingCoefficient(p))$R
+            a*p
+
+         unit? p ==
+            p case R => unit?(p::R)$R
+            false
+
+         associates?(p1,p2) ==
+            p1 case R => p2 case R and associates?(p1,p2)$R
+            p2 case VPoly and p1.v = p2.v and associates?(p1.ts,p2.ts)
+
+         if R has approximate then
+
+           p1  exquo  p2  ==
+              p1 case R and p2 case R =>
+                a:= (p1::R  exquo  p2::R)
+                if a case "failed" then "failed" else a::%
+              zero? p1 => p1
+              (p2 = 1) => p1
+              p1 case R or p2 case VPoly and p1.v < p2.v => "failed"
+              p2 case R or p1.v > p2.v =>
+                 a:= (p1.ts  exquo  p2::D)
+                 a case "failed" => "failed"
+                 [p1.v,a]$VPoly::%
+              -- The next test is useful in the case that R has inexact
+              -- arithmetic (in particular when it is Interval(...)).
+              -- In the case where the test succeeds, empirical evidence
+              -- suggests that it can speed up the computation several times,
+              -- but in other cases where there are a lot of variables
+              -- p1 and p2 differ only in the low order terms (e.g. p1=p2+1)
+              -- it slows exquo down by about 15-20%.
+              p1 = p2 => 1
+              a:= p1.ts  exquo  p2.ts
+              a case "failed" => "failed"
+              mvar:=p1.v
+              up:SUP %:=a
+              if ground? (up) then 
+                leadingCoefficient(up) else [mvar,up]$VPoly::%
+         else
+
+           p1 exquo p2 ==
+              p1 case R and p2 case R =>
+                a:= (p1::R  exquo  p2::R)
+                if a case "failed" then "failed" else a::%
+              zero? p1 => p1
+              (p2 = 1) => p1
+              p1 case R or p2 case VPoly and p1.v < p2.v => "failed"
+              p2 case R or p1.v > p2.v =>
+                 a:= (p1.ts  exquo  p2::D)
+                 a case "failed" => "failed"
+                 [p1.v,a]$VPoly::%
+              a:= p1.ts  exquo  p2.ts
+              a case "failed" => "failed"
+              mvar:=p1.v
+              up:SUP %:=a
+              if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly::%
+
+      map(fn,p) ==
+         p case R => fn(p)
+         mvar:=p.v
+         up:=map(x1+->map(fn,x1),p.ts)
+         if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly
+
+      if R has Field then
+
+        (p : %) / (r : R) == 
+          inv(r) * p
+
+      if R has GcdDomain then
+
+        content(p) ==
+          p case R => p
+          c :R :=0
+          up:=p.ts
+          while not(zero? up) and not(c = 1) repeat
+              c:=gcd(c,content leadingCoefficient(up))
+              up := reductum up
+          c
+
+      if R has EuclideanDomain and 
+          R has CharacteristicZero and 
+           not(R has FloatingPointSystem)  then
+
+        content(p,mvar) ==
+          p case R => p
+          gcd(coefficients univariate(p,mvar))$pgcd
+
+        gcd(p1,p2) == 
+          gcd(p1,p2)$pgcd
+
+        gcd(lp:List %) == 
+          gcd(lp)$pgcd
+
+        gcdPolynomial(a:SUP $,b:SUP $):SUP $ == 
+          gcd(a,b)$pgcd
+
+      else if R has GcdDomain then
+
+        content(p,mvar) ==
+          p case R => p
+          content univariate(p,mvar)
+
+        gcd(p1,p2) ==
+           p1 case R =>
+              p2 case R => gcd(p1,p2)$R::%
+              zero? p1 => p2
+              gcd(p1, content(p2.ts))
+           p2 case R =>
+              zero? p2 => p1
+              gcd(p2, content(p1.ts))
+           p1.v < p2.v => gcd(p1, content(p2.ts))
+           p1.v > p2.v => gcd(content(p1.ts), p2)
+           mvar:=p1.v
+           up:=gcd(p1.ts, p2.ts)
+           if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly
+
+        if R has FloatingPointSystem then
+
+           -- eventually need a better notion of gcd's over floats
+           -- this essentially computes the gcds of the monomial contents
+           gcdPolynomial(a:SUP $,b:SUP $):SUP $ ==
+              ground? (a) =>
+                  zero? a => b
+                  gcd(leadingCoefficient a, content b)::SUP $
+              ground?(b) =>
+                  zero? b => b
+                  gcd(leadingCoefficient b, content a)::SUP $
+              conta := content a
+              mona:SUP $ := monomial(conta, minimumDegree a)
+              if mona ^= 1 then
+                   a := (a exquo mona)::SUP $
+              contb := content b
+              monb:SUP $ := monomial(contb, minimumDegree b)
+              if monb ^= 1 then
+                   b := (b exquo monb)::SUP $
+              mong:SUP $  := monomial(gcd(conta, contb),
+                                      min(degree mona, degree monb))
+              degree(a) >= degree b =>
+                   not((a exquo b) case "failed") =>
+                        mong * b
+                   mong
+              not((b exquo a) case "failed") => mong * a
+              mong
+
+      coerce(p):OutputForm ==
+        p case R => (p::R)::OutputForm
+        outputForm(p.ts,p.v::OutputForm)
+
+      coefficients p ==
+        p case R => list(p :: R)$List(R)
+        "append"/[coefficients(p1)$% for p1 in coefficients(p.ts)]
+
+      retract(p:%):R ==
+        p case R => p :: R
+        error "cannot retract nonconstant polynomial"
+
+      retractIfCan(p:%):Union(R, "failed") ==
+        p case R => p::R
+        "failed"
+
+      mymerge:(List VarSet,List VarSet) ->List VarSet
+      mymerge(l:List VarSet,m:List VarSet):List VarSet ==
+         empty? l => m
+         empty? m => l
+         first l = first m => 
+            empty? rest l => 
+                 setrest!(l,rest m)
+                 l
+            empty? rest m => l 
+            setrest!(l, mymerge(rest l, rest m))
+            l
+         first l > first m =>
+            empty? rest l => 
+                setrest!(l,m) 
+                l
+            setrest!(l, mymerge(rest l, m))
+            l
+         empty? rest m => 
+             setrest!(m,l)
+             m
+         setrest!(m,mymerge(l,rest m))
+         m
+         
+      variables p ==
+         p case R => empty()
+         lv:List VarSet:=empty()
+         q := p.ts
+         while not zero? q repeat
+           lv:=mymerge(lv,variables leadingCoefficient q)
+           q := reductum q
+         cons(p.v,lv)
+
+      mainVariable p ==
+         p case R => "failed"
+         p.v
+
+      eval(p,mvar,pval) == 
+        univariate(p,mvar)(pval)
+
+      eval(p,mvar,val) ==
+        univariate(p,mvar)(val)
+
+      evalSortedVarlist(p,Lvar,Lpval):% ==
+        p case R => p
+        empty? Lvar or empty? Lpval => p
+        mvar := Lvar.first
+        mvar > p.v => evalSortedVarlist(p,Lvar.rest,Lpval.rest)
+        pval := Lpval.first
+        pts := map(x1+->evalSortedVarlist(x1,Lvar,Lpval),p.ts)
+        mvar=p.v =>
+             pval case R => pts (pval::R)
+             pts pval
+        multivariate(pts,p.v)
+
+      eval(p,Lvar,Lpval) ==
+        empty? rest Lvar => evalSortedVarlist(p,Lvar,Lpval)
+        sorted?((x1,x2) +-> x1 > x2, Lvar) => evalSortedVarlist(p,Lvar,Lpval)
+        nlvar := sort((x1,x2) +-> x1 > x2,Lvar)
+        nlpval :=
+           Lvar = nlvar => Lpval
+           nlpval := [Lpval.position(mvar,Lvar) for mvar in nlvar]
+        evalSortedVarlist(p,nlvar,nlpval)
+
+      eval(p,Lvar,Lval) ==
+        eval(p,Lvar,[val::% for val in Lval]$(List %)) -- kill?
+
+      degree(p,mvar) ==
+        p case R => 0
+        mvar= p.v => degree p.ts
+        mvar > p.v => 0    -- might as well take advantage of the order
+        max(degree(leadingCoefficient p.ts,mvar),degree(red p,mvar))
+
+      degree(p,Lvar) == 
+        [degree(p,mvar)  for mvar in Lvar]
+
+      degree p ==
+        p case R => 0
+        degree(leadingCoefficient(p.ts)) + monomial(degree(p.ts), p.v)
+
+      minimumDegree p ==
+        p case R => 0
+        md := minimumDegree p.ts
+        minimumDegree(coefficient(p.ts,md)) + monomial(md, p.v)
+
+      minimumDegree(p,mvar) ==
+        p case R => 0
+        mvar = p.v => minimumDegree p.ts
+        md:=minimumDegree(leadingCoefficient p.ts,mvar)
+        zero? (p1:=red p) => md
+        min(md,minimumDegree(p1,mvar))
+
+      minimumDegree(p,Lvar) ==
+        [minimumDegree(p,mvar) for mvar in Lvar]
+
+      totalDegree(p, Lvar) ==
+        ground? p => 0
+        null setIntersection(Lvar, variables p) => 0
+        u := univariate(p, mv := mainVariable(p)::VarSet)
+        weight:NonNegativeInteger := (member?(mv,Lvar) => 1; 0)
+        tdeg:NonNegativeInteger := 0
+        while u ^= 0 repeat
+            termdeg:NonNegativeInteger := weight*degree u +
+                           totalDegree(leadingCoefficient u, Lvar)
+            tdeg := max(tdeg, termdeg)
+            u := reductum u
+        tdeg
+
+      if R has CommutativeRing then
+
+        differentiate(p,mvar) ==
+          p case R => 0
+          mvar=p.v =>  
+             up:=differentiate p.ts
+             if ground? up then leadingCoefficient(up) else [mvar,up]$VPoly
+          up:=map(x1 +-> differentiate(x1,mvar),p.ts)
+          if ground? up then leadingCoefficient(up) else [p.v,up]$VPoly
+
+      leadingCoefficient(p) ==
+         p case R => p
+         leadingCoefficient(leadingCoefficient(p.ts))
+
+      leadingMonomial p ==
+          p case R => p
+          monomial(leadingMonomial leadingCoefficient(p.ts),
+                   p.v, degree(p.ts))
+
+      reductum(p) == 
+          p case R => 0
+          p - leadingMonomial p
+
 *)
 
 \end{chunk}
@@ -142730,6 +175872,7 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_
     if Coef has Field then
 
          SF2==> StreamFunctions2
+
          p:% / r:Coef ==
            (map((z1:SMP):SMP +-> z1/$SMP r,stream p)$SF2(SMP,SMP)) @ %
 
@@ -142738,6 +175881,300 @@ SparseMultivariateTaylorSeries(Coef,Var,SMP):_
 \begin{chunk}{COQ SMTS}
 (* domain SMTS *)
 (*
+ 
+    Rep := StS -- Below we use the fact that Rep of PS is Stream SMP.
+
+    coefficientes(s:%):StS ==
+      s::Rep
+
+    series(st:StS):% ==
+      st
+
+    extend(x,n) == 
+      extend(x,n + 1)$Rep
+
+    complete x == 
+      complete(x)$Rep
+
+    stream(x:%):Rep == 
+      x @ Rep
+
+    evalstream:(%,L Var,L SMP) -> StS
+    evalstream(s:%,lv:(L Var),lsmp:(L SMP)):(ST SMP) ==
+      scan(0,_+$SMP,
+        map((z1:SMP):SMP+->eval(z1,lv,lsmp),s pretend StS))$ST2(SMP,SMP)
+ 
+    addvariable:(Var,InnerTaylorSeries Coef) -> %
+    addvariable(v,s) ==
+      ints := integers(0)$STT pretend ST NNI
+      map((n1:NNI,c2:Coef):SMP+->monomial(c2 :: SMP,v,n1)$SMP,
+             ints,s pretend ST Coef)$ST3(NNI,Coef,SMP)
+
+    -- We can extract a polynomial giving the terms of given total degree 
+    coefficient(s,n) == 
+      elt(s,n + 1)$Rep  -- 1-based indexing for streams
+
+    -- Here we have to take into account that we reduce the degree of each
+    -- term of the stream by a constant
+    coefficient(s:%,lv:List Var,ln:List NNI):% ==
+      map ((z1:SMP):SMP +-> coefficient(z1,lv,ln),rest(s,reduce(_+,ln)))
+
+    -- the coefficient of a particular monomial:
+    coefficient(s:%,m:IndexedExponents Var):Coef ==
+      n:=leadingCoefficient(mon:=m)
+      while not zero?(mon:=reductum mon) repeat
+        n:=n+leadingCoefficient mon
+      coefficient(coefficient(s,n),m)
+ 
+--% creation of series
+ 
+    coerce(r:Coef) == 
+      monom(r::SMP,0)$STT
+
+    smp:SMP * p:% == 
+      (((smp)    * (p @ Rep))$STT) @ %
+
+    r:Coef * p:% ==  
+      (((r::SMP) * (p @ Rep))$STT) @ %
+
+    p:% * r:Coef ==  
+      (((r::SMP) * (p @ Rep))$STT) @ %
+
+    mts(p:SMP):% ==
+      (uv := mainVariable p) case "failed" => monom(p,0)$STT
+      v := uv :: Var
+      s : % := 0
+      up := univariate(p,v)
+      while not zero? up repeat
+        s := s + monomial(1,v,degree up) * mts(leadingCoefficient up)
+        up := reductum up
+      s
+ 
+    coerce(p:SMP) == 
+      mts p
+
+    coerce(v:Var) == 
+      v :: SMP :: %
+ 
+    monomial(r:%,v:Var,n:NNI) ==
+      r * monom(monomial(1,v,n)$SMP,n)$STT
+ 
+--% evaluation
+ 
+    substvar: (SMP,L Var,L %) -> %
+    substvar(p,vl,q) ==
+      null vl => monom(p,0)$STT
+      (uv := mainVariable p) case "failed" => monom(p,0)$STT
+      v := uv :: Var
+      v = first vl =>
+        s : % := 0
+        up := univariate(p,v)
+        while not zero? up repeat
+          c := leadingCoefficient up
+          s := s + first q ** degree up * substvar(c,rest vl,rest q)
+          up := reductum up
+        s
+      substvar(p,rest vl,rest q)
+ 
+    sortmfirst:(SMP,L Var,L %) -> %
+    sortmfirst(p,vl,q) ==
+      nlv : L Var := sort((v1:Var,v2:Var):Boolean +-> v1 > v2,vl)
+      nq : L % := [q position$(L Var) (i,vl) for i in nlv]
+      substvar(p,nlv,nq)
+ 
+    csubst(vl,q) == 
+      (p1:SMP):StS+->sortmfirst(p1,vl,q pretend L(%)) pretend StS
+ 
+    restCheck(s:StS):StS ==
+      -- checks that stream is null or first element is 0
+      -- returns empty() or rest of stream
+      empty? s => s
+      not zero? frst s =>
+        error "eval: constant coefficient should be 0"
+      rst s
+ 
+    eval(s:%,v:L Var,q:L %) ==
+      #v ^= #q =>
+        error "eval: number of variables should equal number of values"
+      nq : L StS := [restCheck(i pretend StS) for i in q]
+      addiag(map(csubst(v,nq),s pretend StS)$ST2(SMP,StS))$STT @ %
+ 
+    substmts(v:Var,p:SMP,q:%):% ==
+      up := univariate(p,v)
+      ss : % := 0
+      while not zero? up repeat
+        d:=degree up
+        c:SMP:=leadingCoefficient up
+        ss := ss + c* q ** d
+        up := reductum up
+      ss
+ 
+    subststream(v:Var,p:SMP,q:StS):StS==
+      substmts(v,p,q @ %) pretend StS
+ 
+    comp1:(Var,StS,StS) -> StS
+    comp1(v,r,t)== 
+      addiag(map((p1:SMP):StS +-> subststream(v,p1,t),r)$ST2(SMP,StS))$STT
+ 
+    comp(v:Var,s:StS,t:StS):StS == delay
+      empty? s => s
+      f := frst s; r : StS := rst s;
+      empty? r => s
+      empty? t => concat(f,comp1(v,r,empty()$StS))
+      not zero? frst t =>
+        error "eval: constant coefficient should be zero"
+      concat(f,comp1(v,r,rst t))
+ 
+    eval(s:%,v:Var,t:%) == comp(v,s pretend StS,t pretend StS)
+ 
+--% differentiation and integration
+ 
+    differentiate(s:%,v:Var):% ==
+      empty? s => 0
+      map((z1:SMP):SMP +-> differentiate(z1,v),rst s)
+ 
+    if Coef has Algebra Fraction Integer then
+ 
+      (x:%) ** (r:RN) == 
+        powern(r,stream x)$STT
+
+      (r:RN) * (x:%)  == 
+        map((z1:SMP):SMP +-> r*z1,stream x)$ST2(SMP,SMP) @ %
+
+      (x:%) * (r:RN)  == 
+        map((z1:SMP):SMP +-> z1*r,stream x)$ST2(SMP,SMP) @ %
+ 
+      exp x == 
+        exp(stream x)$STF
+
+      log x == 
+        log(stream x)$STF
+ 
+      sin x == 
+        sin(stream x)$STF
+
+      cos x == 
+        cos(stream x)$STF
+
+      tan x == 
+        tan(stream x)$STF
+
+      cot x == 
+        cot(stream x)$STF
+
+      sec x == 
+        sec(stream x)$STF
+
+      csc x == 
+        csc(stream x)$STF
+ 
+      asin x == 
+        asin(stream x)$STF
+
+      acos x == 
+        acos(stream x)$STF
+
+      atan x == 
+        atan(stream x)$STF
+
+      acot x == 
+        acot(stream x)$STF
+
+      asec x == 
+        asec(stream x)$STF
+
+      acsc x == 
+        acsc(stream x)$STF
+ 
+      sinh x == 
+        sinh(stream x)$STF
+
+      cosh x == 
+        cosh(stream x)$STF
+
+      tanh x == 
+        tanh(stream x)$STF
+
+      coth x == 
+        coth(stream x)$STF
+
+      sech x == 
+        sech(stream x)$STF
+
+      csch x == 
+        csch(stream x)$STF
+ 
+      asinh x == 
+        asinh(stream x)$STF
+
+      acosh x == 
+        acosh(stream x)$STF
+
+      atanh x == 
+        atanh(stream x)$STF
+
+      acoth x == 
+        acoth(stream x)$STF
+
+      asech x == 
+        asech(stream x)$STF
+
+      acsch x == 
+        acsch(stream x)$STF
+ 
+      intsmp(v:Var,p: SMP): SMP ==
+        up := univariate(p,v)
+        ss : SMP := 0
+        while not zero? up repeat
+          d := degree up
+          c := leadingCoefficient up
+          ss := ss + inv((d+1) :: RN) * monomial(c,v,d+1)$SMP
+          up := reductum up
+        ss
+ 
+      fintegrate(f,v,r) ==
+        concat(r::SMP,delay map((z1:SMP):SMP +-> intsmp(v,z1),f() pretend StS))
+
+      integrate(s,v,r) ==
+        concat(r::SMP,map((z1:SMP):SMP +-> intsmp(v,z1),s pretend StS))
+ 
+    -- If there is more than one term of the same order, group them.
+    tout(p:SMP):OUT ==
+      pe := p :: OUT
+      monomial? p => pe
+      paren pe
+ 
+    -- check a global Lisp variable
+    showAll?: () -> Boolean
+    showAll?() == true
+ 
+    coerce(s:%):OUT ==
+      uu := s pretend Stream(SMP)
+      empty? uu => (0$SMP) :: OUT
+      n : NNI; count : NNI := _$streamCount$Lisp
+      l : List OUT := empty()
+      for n in 0..count while not empty? uu repeat
+        if frst(uu) ^= 0 then l := concat(tout frst uu,l)
+        uu := rst uu
+      if showAll?() then
+        for n in n.. while explicitEntries? uu and _
+               not eq?(uu,rst uu) repeat
+          if frst(uu) ^= 0 then l := concat(tout frst uu,l)
+          uu := rst uu
+      l :=
+        explicitlyEmpty? uu => l
+        eq?(uu,rst uu) and frst uu = 0 => l
+        concat(prefix("O" :: OUT,[n :: OUT]),l)
+      empty? l => (0$SMP) :: OUT
+      reduce("+",reverse_! l)
+
+    if Coef has Field then
+
+         SF2==> StreamFunctions2
+
+         p:% / r:Coef ==
+           (map((z1:SMP):SMP +-> z1/$SMP r,stream p)$SF2(SMP,SMP)) @ %
+
 *)
 
 \end{chunk}
@@ -143560,30 +176997,55 @@ SparseUnivariateLaurentSeries(Coef,var,cen): Exports == Implementation where
       (uls1:%) ** (uls2:%) == exp(log(uls1) * uls2)
 
       exp uls   == exp(uls)$EFULS
+
       log uls   == log(uls)$EFULS
+
       sin uls   == sin(uls)$EFULS
+
       cos uls   == cos(uls)$EFULS
+
       tan uls   == tan(uls)$EFULS
+
       cot uls   == cot(uls)$EFULS
+
       sec uls   == sec(uls)$EFULS
+
       csc uls   == csc(uls)$EFULS
+
       asin uls  == asin(uls)$EFULS
+
       acos uls  == acos(uls)$EFULS
+
       atan uls  == atan(uls)$EFULS
+
       acot uls  == acot(uls)$EFULS
+
       asec uls  == asec(uls)$EFULS
+
       acsc uls  == acsc(uls)$EFULS
+
       sinh uls  == sinh(uls)$EFULS
+
       cosh uls  == cosh(uls)$EFULS
+
       tanh uls  == tanh(uls)$EFULS
+
       coth uls  == coth(uls)$EFULS
+
       sech uls  == sech(uls)$EFULS
+
       csch uls  == csch(uls)$EFULS
+
       asinh uls == asinh(uls)$EFULS
+
       acosh uls == acosh(uls)$EFULS
+
       atanh uls == atanh(uls)$EFULS
+
       acoth uls == acoth(uls)$EFULS
+
       asech uls == asech(uls)$EFULS
+
       acsch uls == acsch(uls)$EFULS
 
       if Coef has CommutativeRing then
@@ -143619,6 +177081,177 @@ SparseUnivariateLaurentSeries(Coef,var,cen): Exports == Implementation where
 \begin{chunk}{COQ SULS}
 (* domain SULS *)
 (*
+ InnerSparseUnivariatePowerSeries(Coef) add
+
+    Rep := InnerSparseUnivariatePowerSeries(Coef)
+
+    variable x == var
+    center   x == cen
+
+    coerce(v: Variable(var)) ==
+      zero? cen => monomial(1,1)
+      monomial(1,1) + monomial(cen,0)
+
+    pole? x == negative? order(x,0)
+
+--% operations with Taylor series
+
+    coerce(uts:SUTS) == uts pretend %
+
+    taylorIfCan uls ==
+      pole? uls => "failed"
+      uls pretend SUTS
+
+    taylor uls ==
+      (uts := taylorIfCan uls) case "failed" =>
+        error "taylor: Laurent series has a pole"
+      uts :: SUTS
+
+    retractIfCan(x:%):Union(SUTS,"failed") == taylorIfCan x
+
+    laurent(n,uts) == monomial(1,n) * (uts :: %)
+
+    removeZeroes uls    == uls
+    removeZeroes(n,uls) == uls
+
+    taylorRep uls == taylor(monomial(1,-order(uls,0)) * uls)
+    degree uls    == order(uls,0)
+
+    numer uls == taylorRep uls
+    denom uls == monomial(1,(-order(uls,0)) :: NNI)$SUTS
+
+    (uts:SUTS) * (uls:%) == (uts :: %) * uls
+    (uls:%) * (uts:SUTS) == uls * (uts :: %)
+
+    if Coef has Field then
+      (uts1:SUTS) / (uts2:SUTS) == (uts1 :: %) / (uts2 :: %)
+
+    recip(uls) == iExquo(1,uls,false)
+
+    if Coef has IntegralDomain then
+      uls1 exquo uls2 == iExquo(uls1,uls2,false)
+
+    if Coef has Field then
+      uls1:% / uls2:% ==
+        (q := uls1 exquo uls2) case "failed" =>
+          error "quotient cannot be computed"
+        q :: %
+
+    differentiate(uls:%,v:Variable(var)) == differentiate uls
+
+    elt(uls1:%,uls2:%) ==
+      order(uls2,1) < 1 =>
+        error "elt: second argument must have positive order"
+      negative?(ord := order(uls1,0)) =>
+        (recipr := recip uls2) case "failed" =>
+          error "elt: second argument not invertible"
+        uls3 := uls1 * monomial(1,-ord)
+        iCompose(uls3,uls2) * (recipr :: %) ** ((-ord) :: NNI)
+      iCompose(uls1,uls2)
+
+    if Coef has IntegralDomain then
+      rationalFunction(uls,n) ==
+        zero?(e := order(uls,0)) =>
+          negative? n => 0
+          polynomial(taylor uls,n :: NNI) :: RF
+        negative?(m := n - e) => 0
+        poly := polynomial(taylor(monomial(1,-e) * uls),m :: NNI) :: RF
+        v := variable(uls) :: RF; c := center(uls) :: P :: RF
+        poly / (v - c) ** ((-e) :: NNI)
+
+      rationalFunction(uls,n1,n2) == rationalFunction(truncate(uls,n1,n2),n2)
+
+    if Coef has Algebra Fraction Integer then
+
+      integrate uls ==
+        zero? coefficient(uls,-1) =>
+          error "integrate: series has term of order -1"
+        integrate(uls)$Rep
+
+      integrate(uls:%,v:Variable(var)) == integrate uls
+
+      (uls1:%) ** (uls2:%) == exp(log(uls1) * uls2)
+
+      exp uls   == exp(uls)$EFULS
+
+      log uls   == log(uls)$EFULS
+
+      sin uls   == sin(uls)$EFULS
+
+      cos uls   == cos(uls)$EFULS
+
+      tan uls   == tan(uls)$EFULS
+
+      cot uls   == cot(uls)$EFULS
+
+      sec uls   == sec(uls)$EFULS
+
+      csc uls   == csc(uls)$EFULS
+
+      asin uls  == asin(uls)$EFULS
+
+      acos uls  == acos(uls)$EFULS
+
+      atan uls  == atan(uls)$EFULS
+
+      acot uls  == acot(uls)$EFULS
+
+      asec uls  == asec(uls)$EFULS
+
+      acsc uls  == acsc(uls)$EFULS
+
+      sinh uls  == sinh(uls)$EFULS
+
+      cosh uls  == cosh(uls)$EFULS
+
+      tanh uls  == tanh(uls)$EFULS
+
+      coth uls  == coth(uls)$EFULS
+
+      sech uls  == sech(uls)$EFULS
+
+      csch uls  == csch(uls)$EFULS
+
+      asinh uls == asinh(uls)$EFULS
+
+      acosh uls == acosh(uls)$EFULS
+
+      atanh uls == atanh(uls)$EFULS
+
+      acoth uls == acoth(uls)$EFULS
+
+      asech uls == asech(uls)$EFULS
+
+      acsch uls == acsch(uls)$EFULS
+
+      if Coef has CommutativeRing then
+
+        (uls:%) ** (r:RN) == cRationalPower(uls,r)
+
+      else
+
+        (uls:%) ** (r:RN) ==
+          negative?(ord0 := order(uls,0)) =>
+            order := ord0 :: I
+            (n := order exquo denom(r)) case "failed" =>
+              error "**: rational power does not exist"
+            uts := retract(uls * monomial(1,-order))@SUTS
+            utsPow := (uts ** r) :: %
+            monomial(1,(n :: I) * numer(r)) * utsPow
+          uts := retract(uls)@SUTS
+          (uts ** r) :: %
+
+--% OutputForms
+
+    coerce(uls:%): OUT ==
+      st := getStream uls
+      if not(explicitlyEmpty? st or explicitEntries? st) _
+        and (nx := retractIfCan(elt getRef uls))@Union(I,"failed") case I then
+        count : NNI := _$streamCount$Lisp
+        degr := min(count,(nx :: I) + count + 1)
+        extend(uls,degr)
+      seriesToOutputForm(st,getRef uls,variable uls,center uls,1)
+
 *)
 
 \end{chunk}
@@ -143987,6 +177620,7 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with
         ++ fmecg(p1,e,r,p2) finds x : p1 - r * x**e * p2
     == PolynomialRing(R,NonNegativeInteger)
   add
+
    --representations
    Term := Record(k:NonNegativeInteger,c:R)
    Rep  := List Term
@@ -144002,9 +177636,13 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with
    upmp := UnivariatePolynomialMultiplicationPackage(R,%)
 
    if R has FieldOfPrimeCharacteristic  then 
+
          p ** np == p ** (np pretend NonNegativeInteger)
+
          p ^ np  == p ** (np pretend NonNegativeInteger)
+
          p ^ n  == p ** n
+
          p ** n  ==
             null p => 0
             zero? n => 1
@@ -144087,66 +177725,64 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with
              p1:=p1.rest
           NRECONC(rout,p1)$Lisp
 
--- implementation using karatsuba algorithm conditionally
---
---   p1 * p2 ==
---     xx := p1::Rep
---     empty? xx => p1
---     yy := p2::Rep
---     empty? yy => p2
---     zero? first(xx).k => first(xx).c * p2
---     zero? first(yy).k => p1 * first(yy).c
---     (first(xx).k > kBound) and (first(yy).k > kBound) and (#xx > kBound) and (#yy > kBound) =>
---       karatsubaOnce(p1,p2)$upmp
---     xx := reverse xx
---     res : Rep := empty()
---     for tx in xx repeat res:= rep pomopo!( res,tx.c,tx.k,p2)
---     res
-
-
    univariate(p:%) == p pretend SparseUnivariatePolynomial(R)
+
    multivariate(sup:SparseUnivariatePolynomial(R),v:SingletonAsOrderedSet) ==
       sup pretend %
+
    univariate(p:%,v:SingletonAsOrderedSet) ==
      zero? p => 0
      monomial(leadingCoefficient(p)::%,degree p) +
          univariate(reductum p,v)
+
    multivariate(supp:SparseUnivariatePolynomial(%),v:SingletonAsOrderedSet) ==
      zero? supp => 0
      lc:=leadingCoefficient supp
      degree lc > 0 => error "bad form polynomial"
      monomial(leadingCoefficient lc,degree supp) +
          multivariate(reductum supp,v)
+
    if R has FiniteFieldCategory and R has PolynomialFactorizationExplicit then
      RXY ==> SparseUnivariatePolynomial SparseUnivariatePolynomial R
+
      squareFreePolynomial pp ==
         squareFree(pp)$UnivariatePolynomialSquareFree(%,FP)
+
      factorPolynomial pp ==
           (generalTwoFactor(pp pretend RXY)$TwoFactorize(R))
                       pretend Factored SparseUnivariatePolynomial %
+
      factorSquareFreePolynomial pp ==
           (generalTwoFactor(pp pretend RXY)$TwoFactorize(R))
                       pretend Factored SparseUnivariatePolynomial %
+
      gcdPolynomial(pp,qq) == gcd(pp,qq)$FP
+
      factor p == factor(p)$DistinctDegreeFactorize(R,%)
+
      solveLinearPolynomialEquation(lpp,pp) ==
-       solveLinearPolynomialEquation(lpp, pp)$FiniteFieldSolveLinearPolynomialEquation(R,%,FP)
+       solveLinearPolynomialEquation(lpp, pp)_
+         $FiniteFieldSolveLinearPolynomialEquation(R,%,FP)
+
    else if R has PolynomialFactorizationExplicit then
      import PolynomialFactorizationByRecursionUnivariate(R,%)
+
      solveLinearPolynomialEquation(lpp,pp)==
        solveLinearPolynomialEquationByRecursion(lpp,pp)
+
      factorPolynomial(pp) ==
        factorByRecursion(pp)
+
      factorSquareFreePolynomial(pp) ==
        factorSquareFreeByRecursion(pp)
 
    if R has IntegralDomain then
     if R has approximate then
+
      p1 exquo p2  ==
         null p2 => error "Division by 0"
         p2 = 1 => p1
         p1=p2 => 1
-      --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed"
         rout:= []@List(Term)
         while not null p1 repeat
            (a:= p1.first.c exquo p2.first.c)
@@ -144157,11 +177793,12 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with
            rout:= [[ee,a], :rout]
         null p1 => reverse(rout)::%    -- nreverse?
         "failed"
+
     else -- R not approximate
+
      p1 exquo p2  ==
         null p2 => error "Division by 0"
         p2 = 1 => p1
-      --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed"
         rout:= []@List(Term)
         while not null p1 repeat
            (a:= p1.first.c exquo p2.first.c)
@@ -144172,6 +177809,7 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with
            rout:= [[ee,a], :rout]
         null p1 => reverse(rout)::%    -- nreverse?
         "failed"
+
    fmecg(p1,e,r,p2) ==       -- p1 - r * x**e * p2
           rout:%:= []
           r:= - r
@@ -144185,6 +177823,7 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with
              if (u:=p1.first.c + c2) ^= 0 then rout:=[[e2, u],:rout]
              p1:=p1.rest
           NRECONC(rout,p1)$Lisp
+
    pseudoRemainder(p1,p2) ==
      null p2 => error "PseudoDivision by Zero"
      null p1 => 0
@@ -144198,6 +177837,7 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with
        e1:= (e1 - 1):NonNegativeInteger
      e1 = 0 => p1
      co ** e1 * p1
+
    toutput(t1:Term,v:OutputForm):OutputForm ==
      t1.k = 0 => t1.c :: OutputForm
      if t1.k = 1
@@ -144207,6 +177847,7 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with
      t1.c = -1 and
           ((t1.c :: OutputForm) = (-1$Integer)::OutputForm)@Boolean => - mon
      t1.c::OutputForm * mon
+
    outputForm(p:%,v:OutputForm) ==
      l: List(OutputForm)
      l:=[toutput(t,v) for t in p]
@@ -144214,6 +177855,7 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with
      reduce("+",l)
 
    coerce(p:%):OutputForm == outputForm(p, "?"::OutputForm)
+
    elt(p:%,val:R) ==
       null p => 0$R
       co:=p.first.c
@@ -144246,47 +177888,16 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with
       [reverse_!(rout),p1]
 
    if R has IntegralDomain then
+
        discriminant(p) == discriminant(p)$PseudoRemainderSequence(R,%)
---     discriminant(p) ==
---       null p or zero?(p.first.k) => error "cannot take discriminant of constants"
---       dp:=differentiate p
---       corr:=  p.first.c ** ((degree p - 1 - degree dp)::NonNegativeInteger)
---       (-1)**((p.first.k*(p.first.k-1)) quo 2):NonNegativeInteger
---         * (corr * resultant(p,dp) exquo p.first.c)::R
-
-       subResultantGcd(p1,p2) == subResultantGcd(p1,p2)$PseudoRemainderSequence(R,%)
---     subResultantGcd(p1,p2) ==    --args # 0, non-coef, prim, ans not prim
---       --see algorithm 1 (p. 4) of Brown's latest (unpublished) paper
---       if p1.first.k < p2.first.k then (p1,p2):=(p2,p1)
---       p:=pseudoRemainder(p1,p2)
---       co:=1$R;
---       e:= (p1.first.k - p2.first.k):NonNegativeInteger
---       while not null p and p.first.k ^= 0 repeat
---         p1:=p2; p2:=p; p:=pseudoRemainder(p1,p2)
---         null p or p.first.k = 0 => "enuf"
---         co:=(p1.first.c ** e exquo co ** max(0, (e-1))::NonNegativeInteger)::R
---         e:= (p1.first.k - p2.first.k):NonNegativeInteger;  c1:=co**e
---         p:=[[tm.k,((tm.c exquo p1.first.c)::R exquo c1)::R] for tm in p]
---       if null p then p2 else 1$%
+
+       subResultantGcd(p1,p2) == 
+         subResultantGcd(p1,p2)$PseudoRemainderSequence(R,%)
 
        resultant(p1,p2) == resultant(p1,p2)$PseudoRemainderSequence(R,%)
---     resultant(p1,p2) ==      --SubResultant PRS Algorithm
---        null p1 or null p2 => 0$R
---        0 = degree(p1) => ((first p1).c)**degree(p2)
---        0 = degree(p2) => ((first p2).c)**degree(p1)
---        if p1.first.k < p2.first.k then
---          (if odd?(p1.first.k) then p1:=-p1;  (p1,p2):=(p2,p1))
---        p:=pseudoRemainder(p1,p2)
---        co:=1$R;  e:=(p1.first.k-p2.first.k):NonNegativeInteger
---        while not null p repeat
---           if not odd?(e) then p:=-p
---           p1:=p2;  p2:=p;  p:=pseudoRemainder(p1,p2)
---           co:=(p1.first.c ** e exquo co ** max(e:Integer-1,0):NonNegativeInteger)::R
---           e:= (p1.first.k - p2.first.k):NonNegativeInteger;  c1:=co**e
---           p:=(p exquo ((leadingCoefficient p1) * c1))::%
---        degree p2 > 0 => 0$R
---        (p2.first.c**e exquo co**((e-1)::NonNegativeInteger))::R
+
    if R has GcdDomain then
+
      content(p) == if null p then 0$R else "gcd"/[tm.c for tm in p]
         --make CONTENT more efficient?
 
@@ -144301,9 +177912,9 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with
                         p2 pretend SparseUnivariatePolynomial R) pretend %
 
    if R has Field then
+
      divide( p1, p2)  ==
        zero? p2 => error "Division by 0"
---       one? p2 => [p1,0]
        (p2 = 1) => [p1,0]
        ct:=inv(p2.first.c)
        n:=p2.first.k
@@ -144322,6 +177933,314 @@ SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with
 \begin{chunk}{COQ SUP}
 (* domain SUP *)
 (*
+
+   --representations
+   Term := Record(k:NonNegativeInteger,c:R)
+   Rep  := List Term
+   p:%
+   n:NonNegativeInteger
+   np: PositiveInteger
+   FP ==> SparseUnivariatePolynomial %
+   pp,qq: FP
+   lpp:List FP
+
+   -- for karatsuba 
+   kBound: NonNegativeInteger := 63
+   upmp := UnivariatePolynomialMultiplicationPackage(R,%)
+
+   if R has FieldOfPrimeCharacteristic  then 
+
+         p ** np == p ** (np pretend NonNegativeInteger)
+
+         p ^ np  == p ** (np pretend NonNegativeInteger)
+
+         p ^ n  == p ** n
+
+         p ** n  ==
+            null p => 0
+            zero? n => 1
+            (n = 1) => p
+            empty? p.rest =>
+              zero?(cc:=p.first.c ** n) => 0
+              [[n * p.first.k, cc]]
+            -- not worth doing special trick if characteristic is too small 
+            if characteristic()$R < 3 then _
+              return expt(p,n pretend PositiveInteger)$RepeatedSquaring(%)
+            y:%:=1
+            -- break up exponent in qn * characteristic + rn
+            -- exponentiating by the characteristic is fast
+            rec := divide(n, characteristic()$R)
+            qn:= rec.quotient
+            rn:= rec.remainder
+            repeat 
+                if rn = 1 then y := y * p 
+                if rn > 1 then y:= y * binomThmExpt([p.first], p.rest, rn)
+                zero? qn => return y
+                -- raise to the characteristic power
+                p:= [[t.k * characteristic()$R , primeFrobenius(t.c)$R ]$Term _
+                     for t in p]
+                rec := divide(qn, characteristic()$R)
+                qn:= rec.quotient 
+                rn:= rec.remainder
+            y 
+
+   zero?(p): Boolean == 
+     empty?(p)
+
+   one?(p):Boolean == 
+     not empty? p and (empty? rest p and zero? first(p).k and one? first(p).c)
+
+   one?(p):Boolean == 
+     not empty? p and (empty? rest p and zero? first(p).k and (first(p).c = 1))
+
+   ground?(p): Boolean == 
+     empty? p or (empty? rest p and zero? first(p).k)
+
+   multiplyExponents(p,n) == 
+     [ [u.k*n,u.c] for u in p]
+
+   divideExponents(p,n) ==
+     null p => p
+     m:= (p.first.k :: Integer exquo n::Integer)
+     m case "failed" => "failed"
+     u:= divideExponents(p.rest,n)
+     u case "failed" => "failed"
+     [[m::Integer::NonNegativeInteger,p.first.c],:u]
+
+   karatsubaDivide(p, n)  ==
+     zero? n => [p, 0]
+     lowp: Rep := p
+     highp: Rep := []
+     repeat
+       if empty? lowp then break
+       t := first lowp
+       if t.k < n then break
+       lowp := rest lowp
+       highp := cons([subtractIfCan(t.k,n)::NonNegativeInteger,t.c]$Term,highp)
+     [ reverse highp,  lowp]
+
+   shiftRight(p, n)  ==
+      [[subtractIfCan(t.k,n)::NonNegativeInteger,t.c]$Term for t in p]
+
+   shiftLeft(p, n)  ==
+      [[t.k + n,t.c]$Term for t in p]
+
+   pomopo!(p1,r,e,p2) ==
+          rout:%:= []
+          for tm in p2 repeat
+             e2:= e + tm.k
+             c2:= r * tm.c
+             c2 = 0 => "next term"
+             while not null p1 and p1.first.k > e2 repeat
+               (rout:=[p1.first,:rout]; p1:=p1.rest)  --use PUSH and POP?
+             null p1 or p1.first.k < e2 => rout:=[[e2,c2],:rout]
+             if (u:=p1.first.c + c2) ^= 0 then rout:=[[e2, u],:rout]
+             p1:=p1.rest
+          NRECONC(rout,p1)$Lisp
+
+   univariate(p:%) == p pretend SparseUnivariatePolynomial(R)
+
+   multivariate(sup:SparseUnivariatePolynomial(R),v:SingletonAsOrderedSet) ==
+      sup pretend %
+
+   univariate(p:%,v:SingletonAsOrderedSet) ==
+     zero? p => 0
+     monomial(leadingCoefficient(p)::%,degree p) +
+         univariate(reductum p,v)
+
+   multivariate(supp:SparseUnivariatePolynomial(%),v:SingletonAsOrderedSet) ==
+     zero? supp => 0
+     lc:=leadingCoefficient supp
+     degree lc > 0 => error "bad form polynomial"
+     monomial(leadingCoefficient lc,degree supp) +
+         multivariate(reductum supp,v)
+
+   if R has FiniteFieldCategory and R has PolynomialFactorizationExplicit then
+     RXY ==> SparseUnivariatePolynomial SparseUnivariatePolynomial R
+
+     squareFreePolynomial pp ==
+        squareFree(pp)$UnivariatePolynomialSquareFree(%,FP)
+
+     factorPolynomial pp ==
+          (generalTwoFactor(pp pretend RXY)$TwoFactorize(R))
+                      pretend Factored SparseUnivariatePolynomial %
+
+     factorSquareFreePolynomial pp ==
+          (generalTwoFactor(pp pretend RXY)$TwoFactorize(R))
+                      pretend Factored SparseUnivariatePolynomial %
+
+     gcdPolynomial(pp,qq) == gcd(pp,qq)$FP
+
+     factor p == factor(p)$DistinctDegreeFactorize(R,%)
+
+     solveLinearPolynomialEquation(lpp,pp) ==
+       solveLinearPolynomialEquation(lpp, pp)_
+         $FiniteFieldSolveLinearPolynomialEquation(R,%,FP)
+
+   else if R has PolynomialFactorizationExplicit then
+     import PolynomialFactorizationByRecursionUnivariate(R,%)
+
+     solveLinearPolynomialEquation(lpp,pp)==
+       solveLinearPolynomialEquationByRecursion(lpp,pp)
+
+     factorPolynomial(pp) ==
+       factorByRecursion(pp)
+
+     factorSquareFreePolynomial(pp) ==
+       factorSquareFreeByRecursion(pp)
+
+   if R has IntegralDomain then
+    if R has approximate then
+
+     p1 exquo p2  ==
+        null p2 => error "Division by 0"
+        p2 = 1 => p1
+        p1=p2 => 1
+        rout:= []@List(Term)
+        while not null p1 repeat
+           (a:= p1.first.c exquo p2.first.c)
+           a case "failed" => return "failed"
+           ee:= subtractIfCan(p1.first.k, p2.first.k)
+           ee case "failed" => return "failed"
+           p1:= fmecg(p1.rest, ee, a, p2.rest)
+           rout:= [[ee,a], :rout]
+        null p1 => reverse(rout)::%    -- nreverse?
+        "failed"
+
+    else -- R not approximate
+
+     p1 exquo p2  ==
+        null p2 => error "Division by 0"
+        p2 = 1 => p1
+        rout:= []@List(Term)
+        while not null p1 repeat
+           (a:= p1.first.c exquo p2.first.c)
+           a case "failed" => return "failed"
+           ee:= subtractIfCan(p1.first.k, p2.first.k)
+           ee case "failed" => return "failed"
+           p1:= fmecg(p1.rest, ee, a, p2.rest)
+           rout:= [[ee,a], :rout]
+        null p1 => reverse(rout)::%    -- nreverse?
+        "failed"
+
+   fmecg(p1,e,r,p2) ==       -- p1 - r * x**e * p2
+          rout:%:= []
+          r:= - r
+          for tm in p2 repeat
+             e2:= e + tm.k
+             c2:= r * tm.c
+             c2 = 0 => "next term"
+             while not null p1 and p1.first.k > e2 repeat
+               (rout:=[p1.first,:rout]; p1:=p1.rest)  --use PUSH and POP?
+             null p1 or p1.first.k < e2 => rout:=[[e2,c2],:rout]
+             if (u:=p1.first.c + c2) ^= 0 then rout:=[[e2, u],:rout]
+             p1:=p1.rest
+          NRECONC(rout,p1)$Lisp
+
+   pseudoRemainder(p1,p2) ==
+     null p2 => error "PseudoDivision by Zero"
+     null p1 => 0
+     co:=p2.first.c;
+     e:=p2.first.k;
+     p2:=p2.rest;
+     e1:=max(p1.first.k:Integer-e+1,0):NonNegativeInteger
+     while not null p1 repeat
+       if (u:=subtractIfCan(p1.first.k,e)) case "failed" then leave
+       p1:=fmecg(co * p1.rest, u, p1.first.c, p2)
+       e1:= (e1 - 1):NonNegativeInteger
+     e1 = 0 => p1
+     co ** e1 * p1
+
+   toutput(t1:Term,v:OutputForm):OutputForm ==
+     t1.k = 0 => t1.c :: OutputForm
+     if t1.k = 1
+       then mon:= v
+       else mon := v ** t1.k::OutputForm
+     t1.c = 1 => mon
+     t1.c = -1 and
+          ((t1.c :: OutputForm) = (-1$Integer)::OutputForm)@Boolean => - mon
+     t1.c::OutputForm * mon
+
+   outputForm(p:%,v:OutputForm) ==
+     l: List(OutputForm)
+     l:=[toutput(t,v) for t in p]
+     null l => (0$Integer)::OutputForm -- else FreeModule 0 problems
+     reduce("+",l)
+
+   coerce(p:%):OutputForm == outputForm(p, "?"::OutputForm)
+
+   elt(p:%,val:R) ==
+      null p => 0$R
+      co:=p.first.c
+      n:=p.first.k
+      for tm in p.rest repeat
+       co:= co * val ** (n - (n:=tm.k)):NonNegativeInteger + tm.c
+      n = 0 => co
+      co * val ** n
+   elt(p:%,val:%) ==
+      null p => 0$%
+      coef:% := p.first.c :: %
+      n:=p.first.k
+      for tm in p.rest repeat
+       coef:= coef * val ** (n-(n:=tm.k)):NonNegativeInteger+(tm.c::%)
+      n = 0 => coef
+      coef * val ** n
+
+   monicDivide(p1:%,p2:%) ==
+      null p2 => error "monicDivide: division by 0"
+      leadingCoefficient p2 ^= 1 => error "Divisor Not Monic"
+      p2 = 1 => [p1,0]
+      null p1 => [0,0]
+      degree p1 < (n:=degree p2) => [0,p1]
+      rout:Rep := []
+      p2 := p2.rest
+      while not null p1 repeat
+         (u:=subtractIfCan(p1.first.k, n)) case "failed" => leave
+         rout:=[[u, p1.first.c], :rout]
+         p1:=fmecg(p1.rest, rout.first.k, rout.first.c, p2)
+      [reverse_!(rout),p1]
+
+   if R has IntegralDomain then
+
+       discriminant(p) == discriminant(p)$PseudoRemainderSequence(R,%)
+
+       subResultantGcd(p1,p2) == 
+         subResultantGcd(p1,p2)$PseudoRemainderSequence(R,%)
+
+       resultant(p1,p2) == resultant(p1,p2)$PseudoRemainderSequence(R,%)
+
+   if R has GcdDomain then
+
+     content(p) == if null p then 0$R else "gcd"/[tm.c for tm in p]
+        --make CONTENT more efficient?
+
+     primitivePart(p) ==
+        null p => p
+        ct :=content(p)
+        unitCanonical((p exquo ct)::%)
+               -- exquo  present since % is now an IntegralDomain
+
+     gcd(p1,p2) ==
+          gcdPolynomial(p1 pretend SparseUnivariatePolynomial R,
+                        p2 pretend SparseUnivariatePolynomial R) pretend %
+
+   if R has Field then
+
+     divide( p1, p2)  ==
+       zero? p2 => error "Division by 0"
+       (p2 = 1) => [p1,0]
+       ct:=inv(p2.first.c)
+       n:=p2.first.k
+       p2:=p2.rest
+       rout:=empty()$List(Term)
+       while p1 ^= 0 repeat
+          (u:=subtractIfCan(p1.first.k, n)) case "failed" => leave
+          rout:=[[u, ct * p1.first.c], :rout]
+          p1:=fmecg(p1.rest, rout.first.k, rout.first.c, p2)
+       [reverse_!(rout),p1]
+
+     p / co == inv(co) * p
+
 *)
 
 \end{chunk}
@@ -144715,6 +178634,7 @@ SparseUnivariatePolynomialExpressions(R: Ring): Exports == Implementation where
     Implementation == SparseUnivariatePolynomial R add
 
         if R has TranscendentalFunctionCategory then
+
             log(p: %): % ==
                 ground? p => coerce log ground p
                 output(hconcat("log p for p= ", p::OutputForm))$OutputPackage
@@ -144745,6 +178665,34 @@ SparseUnivariatePolynomialExpressions(R: Ring): Exports == Implementation where
 \begin{chunk}{COQ SUPEXPR}
 (* domain SUPEXPR *)
 (*
+
+        if R has TranscendentalFunctionCategory then
+
+            log(p: %): % ==
+                ground? p => coerce log ground p
+                output(hconcat("log p for p= ", p::OutputForm))$OutputPackage
+                error "SUPTRAFUN: log only defined for elements of the coefficient ring"
+
+            exp(p: %): % ==
+                ground? p => coerce exp ground p
+                output(hconcat("exp p for p= ", p::OutputForm))$OutputPackage
+                error "SUPTRAFUN: exp only defined for elements of the coefficient ring"
+            sin(p: %): % ==
+                ground? p => coerce sin ground p
+                output(hconcat("sin p for p= ", p::OutputForm))$OutputPackage
+                error "SUPTRAFUN: sin only defined for elements of the coefficient ring"
+            asin(p: %): % ==
+                ground? p => coerce asin ground p
+                output(hconcat("asin p for p= ", p::OutputForm))$OutputPackage
+                error "SUPTRAFUN: asin only defined for elements of the coefficient ring"
+            cos(p: %): % ==
+                ground? p => coerce cos ground p
+                output(hconcat("cos p for p= ", p::OutputForm))$OutputPackage
+                error "SUPTRAFUN: cos only defined for elements of the coefficient ring"
+            acos(p: %): % ==
+                ground? p => coerce acos ground p
+                output(hconcat("acos p for p= ", p::OutputForm))$OutputPackage
+                error "SUPTRAFUN: acos only defined for elements of the coefficient ring"
 *)
 
 \end{chunk}
@@ -145088,6 +179036,7 @@ SparseUnivariatePuiseuxSeries(Coef,var,cen): Exports == Implementation where
     getExpon pxs == pxs.expon
 
     variable x == var
+
     center   x == cen
 
     coerce(v: Variable(var)) ==
@@ -145124,6 +179073,45 @@ SparseUnivariatePuiseuxSeries(Coef,var,cen): Exports == Implementation where
 \begin{chunk}{COQ SUPXS}
 (* domain SUPXS *)
 (*
+
+    Rep := Record(expon:RN,lSeries:SULS)
+
+    getExpon: % -> RN
+    getExpon pxs == pxs.expon
+
+    variable x == var
+
+    center   x == cen
+
+    coerce(v: Variable(var)) ==
+      zero? cen => monomial(1,1)
+      monomial(1,1) + monomial(cen,0)
+
+    coerce(uts:SUTS) == uts :: SULS :: %
+
+    retractIfCan(upxs:%):Union(SUTS,"failed") ==
+      (uls := retractIfCan(upxs)@Union(SULS,"failed")) case "failed" =>
+        "failed"
+      retractIfCan(uls :: SULS)@Union(SUTS,"failed")
+
+    if Coef has "*": (Fraction Integer, Coef) -> Coef then
+      differentiate(upxs:%,v:Variable(var)) == differentiate upxs
+
+    if Coef has Algebra Fraction Integer then
+      integrate(upxs:%,v:Variable(var)) == integrate upxs
+
+--% OutputForms
+
+    coerce(x:%): OUT ==
+      sups : SUPS := laurentRep(x) pretend SUPS
+      st := getStream sups; refer := getRef sups
+      if not(explicitlyEmpty? st or explicitEntries? st) _
+        and (nx := retractIfCan(elt refer)@Union(I,"failed")) case I then
+        count : NNI := _$streamCount$Lisp
+        degr := min(count,(nx :: I) + count + 1)
+        extend(sups,degr)
+      seriesToOutputForm(st,refer,variable x,center x,rationalPower x)
+
 *)
 
 \end{chunk}
@@ -145297,17 +179285,23 @@ SparseUnivariateSkewPolynomial(R:Ring, sigma:Automorphism R, delta: R -> R):
         ++ outputForm(p, x) returns the output form of p using x for the
         ++ otherwise anonymous variable.
    == SparseUnivariatePolynomial R add
+
       import UnivariateSkewPolynomialCategoryOps(R, %)
  
       x:% * y:%      == times(x, y, sigma, delta)
+
       apply(p, c, r) == apply(p, c, r, sigma, delta)
  
       if R has IntegralDomain then
+
           monicLeftDivide(a, b)  == monicLeftDivide(a, b, sigma)
+
           monicRightDivide(a, b) == monicRightDivide(a, b, sigma)
  
       if R has Field then
+
           leftDivide(a, b)  == leftDivide(a, b, sigma)
+
           rightDivide(a, b) == rightDivide(a, b, sigma)
 
 \end{chunk}
@@ -145315,6 +179309,25 @@ SparseUnivariateSkewPolynomial(R:Ring, sigma:Automorphism R, delta: R -> R):
 \begin{chunk}{COQ ORESUP}
 (* domain ORESUP *)
 (*
+
+      import UnivariateSkewPolynomialCategoryOps(R, %)
+ 
+      x:% * y:%      == times(x, y, sigma, delta)
+
+      apply(p, c, r) == apply(p, c, r, sigma, delta)
+ 
+      if R has IntegralDomain then
+
+          monicLeftDivide(a, b)  == monicLeftDivide(a, b, sigma)
+
+          monicRightDivide(a, b) == monicRightDivide(a, b, sigma)
+ 
+      if R has Field then
+
+          leftDivide(a, b)  == leftDivide(a, b, sigma)
+
+          rightDivide(a, b) == rightDivide(a, b, sigma)
+
 *)
 
 \end{chunk}
@@ -145617,21 +179630,26 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where
         ++ by integers.
 
   Implementation ==> InnerSparseUnivariatePowerSeries(Coef) add
+
     import REF
 
     Rep := InnerSparseUnivariatePowerSeries(Coef)
 
     makeTerm: (Integer,Coef) -> Term
     makeTerm(exp,coef) == [exp,coef]
+
     getCoef: Term -> Coef
     getCoef term == term.c
+
     getExpon: Term -> Integer
     getExpon term == term.k
 
     monomial(coef,expon) == monomial(coef,expon)$Rep
+
     extend(x,n) == extend(x,n)$Rep
 
     0 == monomial(0,0)$Rep
+
     1 == monomial(1,0)$Rep
 
     recip uts == iExquo(1,uts,true)
@@ -145685,6 +179703,7 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where
     polynomial(x,n1,n2) == polynomial(truncate(x,n1,n2),n2)
 
     truncate(x,n)     == truncate(x,n)$Rep
+
     truncate(x,n1,n2) == truncate(x,n1,n2)$Rep
 
     iCoefficients: (ST,REF,I) -> Stream Coef
@@ -145734,14 +179753,17 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where
 --% Values
 
     variable x == var
+
     center   x == cen
 
     coefficient(x,n) == coefficient(x,n)$Rep
+
     elt(x:%,n:NonNegativeInteger) == coefficient(x,n)
 
     pole? x == false
 
     order x    == (order(x)$Rep) :: NNI
+
     order(x,n) == (order(x,n)$Rep) :: NNI
 
 --% Composition
@@ -145767,44 +179789,66 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where
         (uts:%) ** (r:RN) == cRationalPower(uts,r)
 
         exp uts == cExp uts
+
         log uts == cLog uts
 
         sin uts == cSin uts
+
         cos uts == cCos uts
+
         tan uts == cTan uts
+
         cot uts == cCot uts
+
         sec uts == cSec uts
+
         csc uts == cCsc uts
 
         asin uts == cAsin uts
+
         acos uts == cAcos uts
+
         atan uts == cAtan uts
+
         acot uts == cAcot uts
+
         asec uts == cAsec uts
+
         acsc uts == cAcsc uts
 
         sinh uts == cSinh uts
+
         cosh uts == cCosh uts
+
         tanh uts == cTanh uts
+
         coth uts == cCoth uts
+
         sech uts == cSech uts
+
         csch uts == cCsch uts
 
         asinh uts == cAsinh uts
+
         acosh uts == cAcosh uts
+
         atanh uts == cAtanh uts
+
         acoth uts == cAcoth uts
+
         asech uts == cAsech uts
+
         acsch uts == cAcsch uts
 
       else
 
         ZERO    : SG := "series must have constant coefficient zero"
+
         ONE     : SG := "series must have constant coefficient one"
+
         NPOWERS : SG := "series expansion has terms of negative degree"
 
         (uts:%) ** (r:RN) ==
---          not one? coefficient(uts,0) =>
           not (coefficient(uts,0) = 1) =>
             error "**: constant coefficient must be one"
           onePlusX : % := monomial(1,0) + monomial(1,1)
@@ -145818,7 +179862,6 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where
           error concat("exp: ",ZERO)
 
         log uts ==
---          one? coefficient(uts,0) =>
           (coefficient(uts,0) = 1) =>
             log1PlusX := cLog(monomial(1,0) + monomial(1,1))
             iCompose(log1PlusX,uts - 1)
@@ -145871,8 +179914,11 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where
           error concat("atan: ",ZERO)
 
         acos z == error "acos: acos undefined on this coefficient domain"
+
         acot z == error "acot: acot undefined on this coefficient domain"
+
         asec z == error "asec: asec undefined on this coefficient domain"
+
         acsc z == error "acsc: acsc undefined on this coefficient domain"
 
         sinh uts ==
@@ -145922,15 +179968,17 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where
           error concat("atanh: ",ZERO)
 
         acosh uts == error "acosh: acosh undefined on this coefficient domain"
+
         acoth uts == error "acoth: acoth undefined on this coefficient domain"
+
         asech uts == error "asech: asech undefined on this coefficient domain"
+
         acsch uts == error "acsch: acsch undefined on this coefficient domain"
 
     if Coef has Field then
       if Coef has Algebra Fraction Integer then
 
         (uts:%) ** (r:Coef) ==
---          not one? coefficient(uts,1) =>
           not (coefficient(uts,1) = 1) =>
             error "**: constant coefficient should be 1"
           cPower(uts,r)
@@ -145947,6 +179995,366 @@ SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where
 \begin{chunk}{COQ SUTS}
 (* domain SUTS *)
 (*
+
+    import REF
+
+    Rep := InnerSparseUnivariatePowerSeries(Coef)
+
+    makeTerm: (Integer,Coef) -> Term
+    makeTerm(exp,coef) == [exp,coef]
+
+    getCoef: Term -> Coef
+    getCoef term == term.c
+
+    getExpon: Term -> Integer
+    getExpon term == term.k
+
+    monomial(coef,expon) == monomial(coef,expon)$Rep
+
+    extend(x,n) == extend(x,n)$Rep
+
+    0 == monomial(0,0)$Rep
+
+    1 == monomial(1,0)$Rep
+
+    recip uts == iExquo(1,uts,true)
+
+    if Coef has IntegralDomain then
+      uts1 exquo uts2 == iExquo(uts1,uts2,true)
+
+    quoByVar uts == taylorQuoByVar(uts)$Rep
+
+    differentiate(x:%,v:Variable(var)) == differentiate x
+
+--% Creation and destruction of series
+
+    coerce(v: Variable(var)) ==
+      zero? cen => monomial(1,1)
+      monomial(1,1) + monomial(cen,0)
+
+    coerce(p:UP) ==
+      zero? p => 0
+      if not zero? cen then p := p(monomial(1,1)$UP + monomial(cen,0)$UP)
+      st : ST := empty()
+      while not zero? p repeat
+        st := concat(makeTerm(degree p,leadingCoefficient p),st)
+        p := reductum p
+      makeSeries(ref plusInfinity(),st)
+
+    univariatePolynomial(x,n) ==
+      extend(x,n); st := getStream x
+      ans : UP := 0; oldDeg : I := 0;
+      mon := monomial(1,1)$UP - monomial(center x,0)$UP; monPow : UP := 1
+      while explicitEntries? st repeat
+        (xExpon := getExpon(xTerm := frst st)) > n => return ans
+        pow := (xExpon - oldDeg) :: NNI; oldDeg := xExpon
+        monPow := monPow * mon ** pow
+        ans := ans + getCoef(xTerm) * monPow
+        st := rst st
+      ans
+
+    polynomial(x,n) ==
+      extend(x,n); st := getStream x
+      ans : P := 0; oldDeg : I := 0;
+      mon := (var :: P) - (center(x) :: P); monPow : P := 1
+      while explicitEntries? st repeat
+        (xExpon := getExpon(xTerm := frst st)) > n => return ans
+        pow := (xExpon - oldDeg) :: NNI; oldDeg := xExpon
+        monPow := monPow * mon ** pow
+        ans := ans + getCoef(xTerm) * monPow
+        st := rst st
+      ans
+
+    polynomial(x,n1,n2) == polynomial(truncate(x,n1,n2),n2)
+
+    truncate(x,n)     == truncate(x,n)$Rep
+
+    truncate(x,n1,n2) == truncate(x,n1,n2)$Rep
+
+    iCoefficients: (ST,REF,I) -> Stream Coef
+    iCoefficients(x,refer,n) == delay
+      -- when this function is called, we are computing the nth order
+      -- coefficient of the series
+      explicitlyEmpty? x => empty()
+      -- if terms up to order n have not been computed,
+      -- apply lazy evaluation
+      nn := n :: COM
+      while (nx := elt refer) < nn repeat lazyEvaluate x
+      -- must have nx >= n
+      explicitEntries? x =>
+        xCoef := getCoef(xTerm := frst x); xExpon := getExpon xTerm
+        xExpon = n => concat(xCoef,iCoefficients(rst x,refer,n + 1))
+        -- must have nx > n
+        concat(0,iCoefficients(x,refer,n + 1))
+      concat(0,iCoefficients(x,refer,n + 1))
+
+    coefficients uts ==
+      refer := getRef uts; x := getStream uts
+      iCoefficients(x,refer,0)
+
+    terms uts == terms(uts)$Rep pretend Stream Record(k:NNI,c:Coef)
+
+    iSeries: (Stream Coef,I,REF) -> ST
+    iSeries(st,n,refer) == delay
+      -- when this function is called, we are creating the nth order
+      -- term of a series
+      empty? st => (setelt(refer,plusInfinity()); empty())
+      setelt(refer,n :: COM)
+      zero? (coef := frst st) => iSeries(rst st,n + 1,refer)
+      concat(makeTerm(n,coef),iSeries(rst st,n + 1,refer))
+
+    series(st:Stream Coef) ==
+      refer := ref(-1)
+      makeSeries(refer,iSeries(st,0,refer))
+
+    nniToI: Stream Record(k:NNI,c:Coef) -> ST
+    nniToI st ==
+      empty? st => empty()
+      term : Term := [(frst st).k,(frst st).c]
+      concat(term,nniToI rst st)
+
+    series(st:Stream Record(k:NNI,c:Coef)) == series(nniToI st)$Rep
+
+--% Values
+
+    variable x == var
+
+    center   x == cen
+
+    coefficient(x,n) == coefficient(x,n)$Rep
+
+    elt(x:%,n:NonNegativeInteger) == coefficient(x,n)
+
+    pole? x == false
+
+    order x    == (order(x)$Rep) :: NNI
+
+    order(x,n) == (order(x,n)$Rep) :: NNI
+
+--% Composition
+
+    elt(uts1:%,uts2:%) ==
+      zero? uts2 => coefficient(uts1,0) :: %
+      not zero? coefficient(uts2,0) =>
+        error "elt: second argument must have positive order"
+      iCompose(uts1,uts2)
+
+--% Integration
+
+    if Coef has Algebra Fraction Integer then
+
+      integrate(x:%,v:Variable(var)) == integrate x
+
+--% Transcendental functions
+
+      (uts1:%) ** (uts2:%) == exp(log(uts1) * uts2)
+
+      if Coef has CommutativeRing then
+
+        (uts:%) ** (r:RN) == cRationalPower(uts,r)
+
+        exp uts == cExp uts
+
+        log uts == cLog uts
+
+        sin uts == cSin uts
+
+        cos uts == cCos uts
+
+        tan uts == cTan uts
+
+        cot uts == cCot uts
+
+        sec uts == cSec uts
+
+        csc uts == cCsc uts
+
+        asin uts == cAsin uts
+
+        acos uts == cAcos uts
+
+        atan uts == cAtan uts
+
+        acot uts == cAcot uts
+
+        asec uts == cAsec uts
+
+        acsc uts == cAcsc uts
+
+        sinh uts == cSinh uts
+
+        cosh uts == cCosh uts
+
+        tanh uts == cTanh uts
+
+        coth uts == cCoth uts
+
+        sech uts == cSech uts
+
+        csch uts == cCsch uts
+
+        asinh uts == cAsinh uts
+
+        acosh uts == cAcosh uts
+
+        atanh uts == cAtanh uts
+
+        acoth uts == cAcoth uts
+
+        asech uts == cAsech uts
+
+        acsch uts == cAcsch uts
+
+      else
+
+        ZERO    : SG := "series must have constant coefficient zero"
+
+        ONE     : SG := "series must have constant coefficient one"
+
+        NPOWERS : SG := "series expansion has terms of negative degree"
+
+        (uts:%) ** (r:RN) ==
+          not (coefficient(uts,0) = 1) =>
+            error "**: constant coefficient must be one"
+          onePlusX : % := monomial(1,0) + monomial(1,1)
+          ratPow := cPower(uts,r :: Coef)
+          iCompose(ratPow,uts - 1)
+
+        exp uts ==
+          zero? coefficient(uts,0) =>
+            expx := cExp monomial(1,1)
+            iCompose(expx,uts)
+          error concat("exp: ",ZERO)
+
+        log uts ==
+          (coefficient(uts,0) = 1) =>
+            log1PlusX := cLog(monomial(1,0) + monomial(1,1))
+            iCompose(log1PlusX,uts - 1)
+          error concat("log: ",ONE)
+
+        sin uts ==
+          zero? coefficient(uts,0) =>
+            sinx := cSin monomial(1,1)
+            iCompose(sinx,uts)
+          error concat("sin: ",ZERO)
+
+        cos uts ==
+          zero? coefficient(uts,0) =>
+            cosx := cCos monomial(1,1)
+            iCompose(cosx,uts)
+          error concat("cos: ",ZERO)
+
+        tan uts ==
+          zero? coefficient(uts,0) =>
+            tanx := cTan monomial(1,1)
+            iCompose(tanx,uts)
+          error concat("tan: ",ZERO)
+
+        cot uts ==
+          zero? uts => error "cot: cot(0) is undefined"
+          zero? coefficient(uts,0) => error concat("cot: ",NPOWERS)
+          error concat("cot: ",ZERO)
+
+        sec uts ==
+          zero? coefficient(uts,0) =>
+            secx := cSec monomial(1,1)
+            iCompose(secx,uts)
+          error concat("sec: ",ZERO)
+
+        csc uts ==
+          zero? uts => error "csc: csc(0) is undefined"
+          zero? coefficient(uts,0) => error concat("csc: ",NPOWERS)
+          error concat("csc: ",ZERO)
+
+        asin uts ==
+          zero? coefficient(uts,0) =>
+            asinx := cAsin monomial(1,1)
+            iCompose(asinx,uts)
+          error concat("asin: ",ZERO)
+
+        atan uts ==
+          zero? coefficient(uts,0) =>
+            atanx := cAtan monomial(1,1)
+            iCompose(atanx,uts)
+          error concat("atan: ",ZERO)
+
+        acos z == error "acos: acos undefined on this coefficient domain"
+
+        acot z == error "acot: acot undefined on this coefficient domain"
+
+        asec z == error "asec: asec undefined on this coefficient domain"
+
+        acsc z == error "acsc: acsc undefined on this coefficient domain"
+
+        sinh uts ==
+          zero? coefficient(uts,0) =>
+            sinhx := cSinh monomial(1,1)
+            iCompose(sinhx,uts)
+          error concat("sinh: ",ZERO)
+
+        cosh uts ==
+          zero? coefficient(uts,0) =>
+            coshx := cCosh monomial(1,1)
+            iCompose(coshx,uts)
+          error concat("cosh: ",ZERO)
+
+        tanh uts ==
+          zero? coefficient(uts,0) =>
+            tanhx := cTanh monomial(1,1)
+            iCompose(tanhx,uts)
+          error concat("tanh: ",ZERO)
+
+        coth uts ==
+          zero? uts => error "coth: coth(0) is undefined"
+          zero? coefficient(uts,0) => error concat("coth: ",NPOWERS)
+          error concat("coth: ",ZERO)
+
+        sech uts ==
+          zero? coefficient(uts,0) =>
+            sechx := cSech monomial(1,1)
+            iCompose(sechx,uts)
+          error concat("sech: ",ZERO)
+
+        csch uts ==
+          zero? uts => error "csch: csch(0) is undefined"
+          zero? coefficient(uts,0) => error concat("csch: ",NPOWERS)
+          error concat("csch: ",ZERO)
+
+        asinh uts ==
+          zero? coefficient(uts,0) =>
+            asinhx := cAsinh monomial(1,1)
+            iCompose(asinhx,uts)
+          error concat("asinh: ",ZERO)
+
+        atanh uts ==
+          zero? coefficient(uts,0) =>
+            atanhx := cAtanh monomial(1,1)
+            iCompose(atanhx,uts)
+          error concat("atanh: ",ZERO)
+
+        acosh uts == error "acosh: acosh undefined on this coefficient domain"
+
+        acoth uts == error "acoth: acoth undefined on this coefficient domain"
+
+        asech uts == error "asech: asech undefined on this coefficient domain"
+
+        acsch uts == error "acsch: acsch undefined on this coefficient domain"
+
+    if Coef has Field then
+      if Coef has Algebra Fraction Integer then
+
+        (uts:%) ** (r:Coef) ==
+          not (coefficient(uts,1) = 1) =>
+            error "**: constant coefficient should be 1"
+          cPower(uts,r)
+
+--% OutputForms
+
+    coerce(x:%): OUT ==
+      count : NNI := _$streamCount$Lisp
+      extend(x,count)
+      seriesToOutputForm(getStream x,getRef x,variable x,center x,1)
+
 *)
 
 \end{chunk}
@@ -146202,9 +180610,11 @@ SplitHomogeneousDirectProduct(dimtot,dim1,S) : T == C where
 
    T == DirectProductCategory(dimtot,S)
    C == DirectProduct(dimtot,S) add
+
         Rep:=Vector(S)
+
         lessThanRlex(v1:%,v2:%,low:NNI,high:NNI):Boolean ==
- -- reverse lexicographical ordering
+          -- reverse lexicographical ordering
           n1:S:=0
           n2:S:=0
           for i in low..high repeat
@@ -146228,6 +180638,29 @@ SplitHomogeneousDirectProduct(dimtot,dim1,S) : T == C where
 \begin{chunk}{COQ SHDP}
 (* domain SHDP *)
 (*
+
+        Rep:=Vector(S)
+
+        lessThanRlex(v1:%,v2:%,low:NNI,high:NNI):Boolean ==
+          -- reverse lexicographical ordering
+          n1:S:=0
+          n2:S:=0
+          for i in low..high repeat
+            n1:= n1+qelt(v1,i)
+            n2:=n2+qelt(v2,i)
+          n1<n2 => true
+          n2<n1 => false
+          for i in reverse(low..high) repeat
+            if qelt(v2,i) < qelt(v1,i) then return true
+            if qelt(v1,i) < qelt(v2,i) then return false
+          false
+
+        (v1:% < v2:%):Boolean ==
+          lessThanRlex(v1,v2,1,dim1) => true
+          for i in 1..dim1 repeat
+                if qelt(v1,i) ^= qelt(v2,i) then return false
+          lessThanRlex(v1,v2,dim1+1,dimtot)
+
 *)
 
 \end{chunk}
@@ -146411,48 +180844,67 @@ SplittingNode(V,C) : Exports == Implementation where
      Rep ==> VTB
 
      rep(n:%):Rep == n pretend Rep
+
      per(r:Rep):% == r pretend %
 
      empty() == per [empty()$V,empty()$C,false]$Rep
+
      empty?(n:%) == empty?((rep n).val)$V and  empty?((rep n).tower)$C
+
      value(n:%) == (rep n).val
+
      condition(n:%) == (rep n).tower
+
      status(n:%) == (rep n).flag
+
      construct(v:V,t:C,b:B) ==  per [v,t,b]$Rep
+
      construct(v:V,t:C) == [v,t,false]$%
+
      construct(vt:VT) == [vt.val,vt.tower]$%
+
      construct(lvt:List VT) == [[vt]$% for vt in lvt]
+
      construct(v:V,lt: List C) == [[v,t]$% for t in lt]
+
      copy(n:%) == per copy rep n
+
      setValue!(n:%,v:V) == 
         (rep n).val := v
         n
+
      setCondition!(n:%,t:C) ==
         (rep n).tower := t
         n
+
      setStatus!(n:%,b:B) ==
         (rep n).flag := b
         n
+
      setEmpty!(n:%) ==
         (rep n).val := empty()$V
         (rep n).tower := empty()$C
         n
+
      infLex?(n1,n2,o1,o2) ==
         o1((rep n1).val,(rep n2).val) => true
         (rep n1).val = (rep n2).val => 
            o2((rep n1).tower,(rep n2).tower)
         false
+
      subNode?(n1,n2,o2) ==
         (rep n1).val = (rep n2).val => 
            o2((rep n1).tower,(rep n2).tower)
         false
-     -- sample() == empty()
+
      n1:% = n2:% ==
         (rep n1).val ~= (rep n2).val => false
         (rep n1).tower = (rep n2).tower
+
      n1:% ~= n2:% ==
         (rep n1).val = (rep n2).val => false
         (rep n1).tower ~= (rep n2).tower
+
      coerce(n:%):O ==
         l1,l2,l3,l : List O
         l1 := [message("value == "), ((rep n).val)::O]
@@ -146472,6 +180924,85 @@ SplittingNode(V,C) : Exports == Implementation where
 \begin{chunk}{COQ SPLNODE}
 (* domain SPLNODE *)
 (*
+
+     Rep ==> VTB
+
+     rep(n:%):Rep == n pretend Rep
+
+     per(r:Rep):% == r pretend %
+
+     empty() == per [empty()$V,empty()$C,false]$Rep
+
+     empty?(n:%) == empty?((rep n).val)$V and  empty?((rep n).tower)$C
+
+     value(n:%) == (rep n).val
+
+     condition(n:%) == (rep n).tower
+
+     status(n:%) == (rep n).flag
+
+     construct(v:V,t:C,b:B) ==  per [v,t,b]$Rep
+
+     construct(v:V,t:C) == [v,t,false]$%
+
+     construct(vt:VT) == [vt.val,vt.tower]$%
+
+     construct(lvt:List VT) == [[vt]$% for vt in lvt]
+
+     construct(v:V,lt: List C) == [[v,t]$% for t in lt]
+
+     copy(n:%) == per copy rep n
+
+     setValue!(n:%,v:V) == 
+        (rep n).val := v
+        n
+
+     setCondition!(n:%,t:C) ==
+        (rep n).tower := t
+        n
+
+     setStatus!(n:%,b:B) ==
+        (rep n).flag := b
+        n
+
+     setEmpty!(n:%) ==
+        (rep n).val := empty()$V
+        (rep n).tower := empty()$C
+        n
+
+     infLex?(n1,n2,o1,o2) ==
+        o1((rep n1).val,(rep n2).val) => true
+        (rep n1).val = (rep n2).val => 
+           o2((rep n1).tower,(rep n2).tower)
+        false
+
+     subNode?(n1,n2,o2) ==
+        (rep n1).val = (rep n2).val => 
+           o2((rep n1).tower,(rep n2).tower)
+        false
+
+     n1:% = n2:% ==
+        (rep n1).val ~= (rep n2).val => false
+        (rep n1).tower = (rep n2).tower
+
+     n1:% ~= n2:% ==
+        (rep n1).val = (rep n2).val => false
+        (rep n1).tower ~= (rep n2).tower
+
+     coerce(n:%):O ==
+        l1,l2,l3,l : List O
+        l1 := [message("value == "), ((rep n).val)::O]
+        o1 : O := blankSeparate l1
+        l2 := [message(" tower == "), ((rep n).tower)::O]
+        o2 : O := blankSeparate l2
+        if ((rep n).flag)
+          then
+            o3 := message(" closed == true")
+          else 
+            o3 := message(" closed == false")
+        l := [o1,o2,o3]
+        bracket commaSeparate l
+
 *)
 
 \end{chunk}
@@ -146757,18 +181288,23 @@ SplittingTree(V,C) : Exports == Implementation where
      Rep ==> A
 
      rep(n:%):Rep == n pretend Rep
+
      per(r:Rep):% == r pretend %
 
      construct(s:S) == 
         per [s,[]]$A
+
      construct(v:V,t:C,la:List(%)) ==
         per [[v,t]$S,la]$A
+
      construct(v:V,t:C,ls:List(S)) ==
         per [[v,t]$S,[[s]$% for s in ls]]$A
+
      construct(v1:V,t:C,v2:V,lt:List(C)) ==
         [v1,t,([v2,lt]$S)@(List S)]$%
 
      empty?(a:%) == empty?((rep a).root) and empty?((rep a).subTrees)
+
      empty() == [empty()$S]$%
 
      remove(s:S,a:%) ==
@@ -146798,48 +181334,62 @@ SplittingTree(V,C) : Exports == Implementation where
 
      value(a:%) == 
         (rep a).root
+
      children(a:%) == 
         (rep a).subTrees
+
      leaf?(a:%) == 
         empty? a => false
         empty? (rep a).subTrees
+
      setchildren!(a:%,la:List(%)) == 
         (rep a).subTrees := la
         a
+
      setvalue!(a:%,s:S) ==
         (rep a).root := s
         s
+
      cyclic?(a:%) == false
+
      map(foo:(S -> S),a:%) ==
        empty? a => a
        b : % := [foo(value(a))]$%
        leaf? a => b
        setchildren!(b,[map(foo,c) for c in children(a)])
+
      map!(foo:(S -> S),a:%) ==
        empty? a => a
        setvalue!(a,foo(value(a)))
        leaf? a => a
        setchildren!(a,[map!(foo,c) for c in children(a)])
+
      copy(a:%) == 
        map(copy,a)
+
      eq?(a1:%,a2:%) ==
        error"in eq? from SPLTREE : la vache qui rit est-elle folle?"
+
      nodes(a:%) == 
        empty? a => []
        leaf? a => [a]
        cons(a,concat([nodes(c) for c in children(a)]))
+
      leaves(a:%) ==
        empty? a => []
        leaf? a => [value(a)]
        concat([leaves(c) for c in children(a)])
+
      members(a:%) ==
        empty? a => []
        leaf? a => [value(a)]
        cons(value(a),concat([members(c) for c in children(a)]))
+
      #(a:%) ==
        empty? a => 0$NNI
        leaf? a => 1$NNI
        reduce("+",[#c for c in children(a)],1$NNI)$(List NNI)
+
      a1:% = a2:% ==
        empty? a1 => empty? a2
        empty? a2 => false
@@ -146849,7 +181399,7 @@ SplittingTree(V,C) : Exports == Implementation where
        leaf? a2 => false
        value(a1) ~=$S value(a2) => false
        children(a1) = children(a2)
-     -- sample() == [sample()$S]$%
+
      localCoerce(a:%,k:NNI):O ==
        s : String
        if k = 1 then  s := "* " else s := "-> "
@@ -146859,6 +181409,7 @@ SplittingTree(V,C) : Exports == Implementation where
        lo : List O := [localCoerce(c,k+1) for c in children(a)]
        lo := cons(ro,lo)
        vconcat(lo)$O
+
      coerce(a:%):O ==
        empty? a => vconcat(message(" ")$O,message("* []")$O)
        vconcat(message(" ")$O,localCoerce(a,1))
@@ -146944,6 +181495,212 @@ SplittingTree(V,C) : Exports == Implementation where
 \begin{chunk}{COQ SPLTREE}
 (* domain SPLTREE *)
 (*
+
+     Rep ==> A
+
+     rep(n:%):Rep == n pretend Rep
+
+     per(r:Rep):% == r pretend %
+
+     construct(s:S) == 
+        per [s,[]]$A
+
+     construct(v:V,t:C,la:List(%)) ==
+        per [[v,t]$S,la]$A
+
+     construct(v:V,t:C,ls:List(S)) ==
+        per [[v,t]$S,[[s]$% for s in ls]]$A
+
+     construct(v1:V,t:C,v2:V,lt:List(C)) ==
+        [v1,t,([v2,lt]$S)@(List S)]$%
+
+     empty?(a:%) == empty?((rep a).root) and empty?((rep a).subTrees)
+
+     empty() == [empty()$S]$%
+
+     remove(s:S,a:%) ==
+       empty? a => a
+       (s = value(a)) and (status(s) = status(value(a))) => empty()$%
+       la := children(a)
+       lb : List % := []
+       while (not empty? la) repeat
+          lb := cons(remove(s,first la), lb)
+          la := rest la
+       lb := reverse remove(empty?,lb)
+       [value(value(a)),condition(value(a)),lb]$%
+
+     remove!(s:S,a:%) ==
+       empty? a => a
+       (s = value(a)) and (status(s) = status(value(a))) =>
+         (rep a).root := empty()$S
+         (rep a).subTrees := []
+         a
+       la := children(a)
+       lb : List % := []
+       while (not empty? la) repeat
+          lb := cons(remove!(s,first la), lb)
+          la := rest la
+       lb := reverse remove(empty()$%,lb)
+       setchildren!(a,lb)
+
+     value(a:%) == 
+        (rep a).root
+
+     children(a:%) == 
+        (rep a).subTrees
+
+     leaf?(a:%) == 
+        empty? a => false
+        empty? (rep a).subTrees
+
+     setchildren!(a:%,la:List(%)) == 
+        (rep a).subTrees := la
+        a
+
+     setvalue!(a:%,s:S) ==
+        (rep a).root := s
+        s
+
+     cyclic?(a:%) == false
+
+     map(foo:(S -> S),a:%) ==
+       empty? a => a
+       b : % := [foo(value(a))]$%
+       leaf? a => b
+       setchildren!(b,[map(foo,c) for c in children(a)])
+
+     map!(foo:(S -> S),a:%) ==
+       empty? a => a
+       setvalue!(a,foo(value(a)))
+       leaf? a => a
+       setchildren!(a,[map!(foo,c) for c in children(a)])
+
+     copy(a:%) == 
+       map(copy,a)
+
+     eq?(a1:%,a2:%) ==
+       error"in eq? from SPLTREE : la vache qui rit est-elle folle?"
+
+     nodes(a:%) == 
+       empty? a => []
+       leaf? a => [a]
+       cons(a,concat([nodes(c) for c in children(a)]))
+
+     leaves(a:%) ==
+       empty? a => []
+       leaf? a => [value(a)]
+       concat([leaves(c) for c in children(a)])
+
+     members(a:%) ==
+       empty? a => []
+       leaf? a => [value(a)]
+       cons(value(a),concat([members(c) for c in children(a)]))
+
+     #(a:%) ==
+       empty? a => 0$NNI
+       leaf? a => 1$NNI
+       reduce("+",[#c for c in children(a)],1$NNI)$(List NNI)
+
+     a1:% = a2:% ==
+       empty? a1 => empty? a2
+       empty? a2 => false
+       leaf? a1 =>
+         not leaf? a2 => false
+         value(a1) =$S value(a2)
+       leaf? a2 => false
+       value(a1) ~=$S value(a2) => false
+       children(a1) = children(a2)
+
+     localCoerce(a:%,k:NNI):O ==
+       s : String
+       if k = 1 then  s := "* " else s := "-> "
+       for i in 2..k repeat s := concat("-+",s)$String
+       ro : O := left(hconcat(message(s)$O,value(a)::O)$O)$O
+       leaf? a => ro
+       lo : List O := [localCoerce(c,k+1) for c in children(a)]
+       lo := cons(ro,lo)
+       vconcat(lo)$O
+
+     coerce(a:%):O ==
+       empty? a => vconcat(message(" ")$O,message("* []")$O)
+       vconcat(message(" ")$O,localCoerce(a,1))
+       
+     extractSplittingLeaf(a:%) ==
+       empty? a => "failed"::Union(%,"failed")
+       status(value(a))$S => "failed"::Union(%,"failed")
+       la := children(a)
+       empty? la => a
+       while (not empty? la) repeat
+          esl := extractSplittingLeaf(first la)
+          (esl case %) => return(esl)
+          la := rest la
+       "failed"::Union(%,"failed")
+       
+     updateStatus!(a:%) ==
+       la := children(a)
+       (empty? la) or (status(value(a))$S) => a
+       done := true
+       while (not empty? la) and done repeat
+          done := done and status(value(updateStatus! first la))
+          la := rest la
+       setStatus!(value(a),done)$S
+       a
+     
+     result(a:%) ==
+       empty? a => []
+       not status(value(a))$S => 
+          error"in result from SLPTREE : mad cow!"
+       ls : List S := leaves(a)
+       [[value(s),condition(s)]$VT for s in ls]
+
+     conditions(a:%) ==
+       empty? a => []
+       ls : List S := leaves(a)
+       [condition(s) for s in ls]
+
+     nodeOf?(s:S,a:%) ==
+       empty? a => false
+       s =$S value(a) => true
+       la := children(a)
+       while (not empty? la) and (not nodeOf?(s,first la)) repeat
+          la := rest la
+       not empty? la
+
+     subNodeOf?(s:S,a:%,sub?:((C,C) -> B)) ==
+       empty? a => false
+       -- s =$S value(a) => true
+       status(value(a)$%)$S and subNode?(s,value(a),sub?)$S => true
+       la := children(a)
+       while (not empty? la) and (not subNodeOf?(s,first la,sub?)) repeat
+          la := rest la
+       not empty? la
+
+     splitNodeOf!(l:%,a:%,ls:List(S)) ==
+       ln := removeDuplicates ls
+       la : List % := []
+       while not empty? ln repeat
+          if not nodeOf?(first ln,a)
+            then
+              la := cons([first ln]$%, la)
+          ln := rest ln
+       la := reverse la
+       setchildren!(l,la)$%
+       if empty? la then (rep l).root := [empty()$V,empty()$C,true]$S
+       updateStatus!(a)
+
+     splitNodeOf!(l:%,a:%,ls:List(S),sub?:((C,C) -> B)) ==
+       ln := removeDuplicates ls
+       la : List % := []
+       while not empty? ln repeat
+          if not subNodeOf?(first ln,a,sub?)
+            then
+              la := cons([first ln]$%, la)
+          ln := rest ln
+       la := reverse la
+       setchildren!(l,la)$%
+       if empty? la then (rep l).root := [empty()$V,empty()$C,true]$S
+       updateStatus!(a)
+
 *)
 
 \end{chunk}
@@ -147701,43 +182458,59 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where
      Rep ==> LP
 
      rep(s:$):Rep == s pretend Rep
+
      per(l:Rep):$ == l pretend $
 
      copy ts ==
        per(copy(rep(ts))$LP)
+
      empty() ==
        per([])
+
      empty?(ts:$) ==
        empty?(rep(ts))
+
      parts ts ==
        rep(ts)
+
      members ts ==
        rep(ts)
+
      map (f : PtoP, ts : $) : $ ==
        construct(map(f,rep(ts))$LP)$$
+
      map! (f : PtoP, ts : $) : $  ==
        construct(map!(f,rep(ts))$LP)$$
+
      member? (p,ts) ==
        member?(p,rep(ts))$LP
+
      unitIdealIfCan() ==
        "failed"::Union($,"failed")
+
      roughUnitIdeal? ts ==
        false
+
      coerce(ts:$) : OutputForm ==
        lp : List(P) := reverse(rep(ts))
        brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm
+
      mvar ts ==
        empty? ts => error "mvar$SREGSET: #1 is empty"
        mvar(first(rep(ts)))$P
+
      first ts ==
        empty? ts => "failed"::Union(P,"failed")
        first(rep(ts))::Union(P,"failed")
+
      last ts ==
        empty? ts => "failed"::Union(P,"failed")
        last(rep(ts))::Union(P,"failed")
+
      rest ts ==
        empty? ts => "failed"::Union($,"failed")
        per(rest(rep(ts)))::Union($,"failed")
+
      coerce(ts:$) : (List P) ==
        rep(ts)
 
@@ -147963,7 +182736,6 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where
        lts: List($) := []
        (numberOfVariables(lp,lts)$regsetdecomppack :: Z - #lp :: Z) < 2
 
---     lin?(p:P):Boolean == ground?(init(p)) and one?(mdeg(p))
      lin?(p:P):Boolean == ground?(init(p)) and (mdeg(p) = 1)
 
      pre_process(lp:LP,clos?:B,info?:B): Record(val: LP, towers: Split) ==
@@ -148035,6 +182807,354 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where
 \begin{chunk}{COQ SREGSET}
 (* domain SREGSET *)
 (*
+
+     Rep ==> LP
+
+     rep(s:$):Rep == s pretend Rep
+
+     per(l:Rep):$ == l pretend $
+
+     copy ts ==
+       per(copy(rep(ts))$LP)
+
+     empty() ==
+       per([])
+
+     empty?(ts:$) ==
+       empty?(rep(ts))
+
+     parts ts ==
+       rep(ts)
+
+     members ts ==
+       rep(ts)
+
+     map (f : PtoP, ts : $) : $ ==
+       construct(map(f,rep(ts))$LP)$$
+
+     map! (f : PtoP, ts : $) : $  ==
+       construct(map!(f,rep(ts))$LP)$$
+
+     member? (p,ts) ==
+       member?(p,rep(ts))$LP
+
+     unitIdealIfCan() ==
+       "failed"::Union($,"failed")
+
+     roughUnitIdeal? ts ==
+       false
+
+     coerce(ts:$) : OutputForm ==
+       lp : List(P) := reverse(rep(ts))
+       brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm
+
+     mvar ts ==
+       empty? ts => error "mvar$SREGSET: #1 is empty"
+       mvar(first(rep(ts)))$P
+
+     first ts ==
+       empty? ts => "failed"::Union(P,"failed")
+       first(rep(ts))::Union(P,"failed")
+
+     last ts ==
+       empty? ts => "failed"::Union(P,"failed")
+       last(rep(ts))::Union(P,"failed")
+
+     rest ts ==
+       empty? ts => "failed"::Union($,"failed")
+       per(rest(rep(ts)))::Union($,"failed")
+
+     coerce(ts:$) : (List P) ==
+       rep(ts)
+
+     collectUpper (ts,v) ==
+       empty? ts => ts
+       lp := rep(ts)
+       newlp : Rep := []
+       while (not empty? lp) and (mvar(first(lp)) > v) repeat
+         newlp := cons(first(lp),newlp)
+         lp := rest lp
+       per(reverse(newlp))
+
+     collectUnder (ts,v) ==
+       empty? ts => ts
+       lp := rep(ts)
+       while (not empty? lp) and (mvar(first(lp)) >= v) repeat
+         lp := rest lp
+       per(lp)
+
+     construct(lp:List(P)) ==
+       ts : $ := per([])
+       empty? lp => ts
+       lp := sort(infRittWu?,lp)
+       while not empty? lp repeat
+         eif := extendIfCan(ts,first(lp))
+         not (eif case $) =>
+           error"in construct : List P -> $  from SREGSET : bad #1"
+         ts := eif::$
+         lp := rest lp
+       ts
+
+     extendIfCan(ts:$,p:P) ==
+       ground? p => "failed"::Union($,"failed")       
+       empty? ts => 
+         p := squareFreePart primitivePart p
+         (per([p]))::Union($,"failed")
+       not (mvar(ts) < mvar(p)) => "failed"::Union($,"failed")
+       invertible?(init(p),ts)@Boolean => 
+         lts: Split := augment(p,ts)
+         #lts ~= 1 => "failed"::Union($,"failed")
+         (first lts)::Union($,"failed")
+       "failed"::Union($,"failed")
+
+     removeZero(p:P, ts:$): P ==
+       (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_-)
+
+     internalAugment(p:P,ts:$): $ ==
+       -- ASSUME that adding p to ts DOES NOT require any split
+       ground? p => error "in internalAugment$SREGSET: ground? #1"
+       first(internalAugment(p,ts,false,false,false,false,false))
+
+     internalAugment(lp:List(P),ts:$): $ ==
+       -- ASSUME that adding p to ts DOES NOT require any split
+       empty? lp => ts
+       internalAugment(rest lp, internalAugment(first lp, ts))
+
+     internalAugment(p:P,ts:$,rem?:B,red?:B,prim?:B,sqfr?:B,extend?:B):Split ==
+       -- ASSUME p is not a constant
+       -- ASSUME mvar(p) is not algebraic w.r.t. ts
+       -- ASSUME init(p) invertible modulo ts
+       -- if rem? then REDUCE p by remainder
+       -- if prim? then REPLACE p by its main primitive part
+       -- if sqfr? then FACTORIZE SQUARE FREE p over R
+       -- if extend? DO NOT ASSUME every pol in ts_v_+ is invertible modulo ts
+       v := mvar(p)
+       ts_v_- := collectUnder(ts,v)
+       ts_v_+ := collectUpper(ts,v)
+       if rem? then p := remainder(p,ts_v_-).polnum
+       -- if rem? then p := reduceByQuasiMonic(p,ts_v_-)
+       if red? then p := removeZero(p,ts_v_-)
+       if prim? then p := mainPrimitivePart p
+       lts: Split
+       if sqfr?
+         then
+           lts: Split := []
+           lsfp := squareFreeFactors(p)$polsetpack
+           for f in lsfp repeat
+             (ground? f) or (mvar(f) < v) => "leave"
+             lpwt := squareFreePart(f,ts_v_-)
+             for pwt in lpwt repeat 
+               sfp := pwt.val; us := pwt.tower
+               lts := cons( per(cons(pwt.val, rep(pwt.tower))), lts)
+         else
+           lts: Split := [per(cons(p,rep(ts_v_-)))]
+       extend? => extend(members(ts_v_+),lts)
+       [per(concat(rep(ts_v_+),rep(us))) for us in lts]
+
+     augment(p:P,ts:$): List $ ==
+       ground? p => error "in augment$SREGSET: ground? #1"
+       algebraic?(mvar(p),ts) => error "in augment$SREGSET: bad #1"
+       -- ASSUME init(p) invertible modulo ts
+       -- DOES NOT ASSUME anything else.
+       -- THUS reduction, mainPrimitivePart and squareFree are NEEDED
+       internalAugment(p,ts,true,true,true,true,true)
+
+     extend(p:P,ts:$): List $ ==
+       ground? p => error "in extend$SREGSET: ground? #1"
+       v := mvar(p)
+       not (mvar(ts) < mvar(p)) => error "in extend$SREGSET: bad #1"
+       split: List($) := invertibleSet(init(p),ts)
+       lts: List($) := []
+       for us in split repeat
+         lts := concat(augment(p,us),lts)
+       lts
+
+     invertible?(p:P,ts:$): Boolean == 
+       stoseInvertible?(p,ts)$regsetgcdpack
+       
+     invertible?(p:P,ts:$): List BWT ==
+       stoseInvertible?_sqfreg(p,ts)$regsetgcdpack
+
+     invertibleSet(p:P,ts:$): Split ==
+       stoseInvertibleSet_sqfreg(p,ts)$regsetgcdpack
+
+     lastSubResultant(p1:P,p2:P,ts:$): List PWT ==
+       stoseLastSubResultant(p1,p2,ts)$regsetgcdpack
+
+     squareFreePart(p:P, ts: $): List PWT ==
+       stoseSquareFreePart(p,ts)$regsetgcdpack
+
+     intersect(p:P, ts: $): List($) ==
+       decompose([p], [ts], false, false)$regsetdecomppack
+
+     intersect(lp: LP, lts: List($)): List($) ==
+       decompose(lp, lts, false, false)$regsetdecomppack
+        -- SOLVE in the regular zero sense 
+        -- and DO NOT PRINT info
+
+     decompose(lp: LP, lts: List($)): List($) ==
+        decompose(lp, lts, true, false)$regsetdecomppack
+        -- SOLVE in the closure sense 
+        -- and DO NOT PRINT info
+
+     zeroSetSplit(lp:List(P)) == zeroSetSplit(lp,true,false)
+        -- by default SOLVE in the closure sense 
+        -- and DO NOT PRINT info
+
+     zeroSetSplit(lp:List(P), clos?: B) == zeroSetSplit(lp,clos?, false)
+
+     zeroSetSplit(lp:List(P), clos?: B, info?: B) ==
+       -- if clos? then SOLVE in the closure sense 
+       -- if info? then PRINT info
+       -- by default USE hash-tables
+       -- and PREPROCESS the input system
+       zeroSetSplit(lp,true,clos?,info?,true)
+
+     zeroSetSplit(lp:List(P),hash?:B,clos?:B,info?:B,prep?:B) == 
+       -- if hash? then USE hash-tables
+       -- if info? then PRINT information
+       -- if clos? then SOLVE in the closure sense
+       -- if prep? then PREPROCESS the input system
+       if hash? 
+         then
+           s1, s2, s3, dom1, dom2, dom3: String
+           e: String := empty()$String
+           if info? then (s1,s2,s3) := ("w","g","i") else (s1,s2,s3) := (e,e,e)
+           if info? 
+             then 
+               (dom1, dom2, dom3) := _
+                  ("QCMPACK", "REGSETGCD: Gcd", "REGSETGCD: Inv Set")
+             else
+               (dom1, dom2, dom3) := (e,e,e)
+           startTable!(s1,"W",dom1)$quasicomppack
+           startTableGcd!(s2,"G",dom2)$regsetgcdpack
+           startTableInvSet!(s3,"I",dom3)$regsetgcdpack
+       lts := internalZeroSetSplit(lp,clos?,info?,prep?)
+       if hash? 
+         then
+           stopTable!()$quasicomppack
+           stopTableGcd!()$regsetgcdpack
+           stopTableInvSet!()$regsetgcdpack
+       lts
+
+     internalZeroSetSplit(lp:LP,clos?:B,info?:B,prep?:B) ==
+       -- if info? then PRINT information
+       -- if clos? then SOLVE in the closure sense
+       -- if prep? then PREPROCESS the input system
+       if prep?
+         then
+           pp := pre_process(lp,clos?,info?)
+           lp := pp.val
+           lts := pp.towers
+         else
+           ts: $ := [[]]
+           lts := [ts]
+       lp := remove(zero?, lp)
+       any?(ground?, lp) => []
+       empty? lp => lts
+       empty? lts => lts
+       lp := sort(infRittWu?,lp)
+       clos? => decompose(lp,lts, clos?, info?)$regsetdecomppack
+       -- IN DIM > 0 with clos? the following is not false ...
+       for p in lp repeat
+         lts := decompose([p],lts, clos?, info?)$regsetdecomppack
+       lts
+
+     largeSystem?(lp:LP): Boolean == 
+       -- Gonnet and Gerdt and not Wu-Wang.2
+       #lp > 16 => true
+       #lp < 13 => false
+       lts: List($) := []
+       (#lp :: Z - numberOfVariables(lp,lts)$regsetdecomppack :: Z) > 3
+
+     smallSystem?(lp:LP): Boolean == 
+       -- neural, Vermeer, Liu, and not f-633 and not Hairer-2
+       #lp < 5
+
+     mediumSystem?(lp:LP): Boolean == 
+       -- f-633 and not Hairer-2
+       lts: List($) := []
+       (numberOfVariables(lp,lts)$regsetdecomppack :: Z - #lp :: Z) < 2
+
+     lin?(p:P):Boolean == ground?(init(p)) and (mdeg(p) = 1)
+
+     pre_process(lp:LP,clos?:B,info?:B): Record(val: LP, towers: Split) ==
+       -- if info? then PRINT information
+       -- if clos? then SOLVE in the closure sense
+       ts: $ := [[]]; 
+       lts: Split := [ts]
+       empty? lp => [lp,lts]
+       lp1: List P := []
+       lp2: List P := []
+       for p in lp repeat 
+          ground? (tail p) => lp1 := cons(p, lp1)
+          lp2 := cons(p, lp2)
+       lts: Split := decompose(lp1,[ts],clos?,info?)$regsetdecomppack
+       probablyZeroDim?(lp)$polsetpack =>
+          largeSystem?(lp) => return [lp2,lts]
+          if #lp > 7
+            then 
+              -- Butcher (8,8) + Wu-Wang.2 (13,16) 
+              lp2 := crushedSet(lp2)$polsetpack
+              lp2 := remove(zero?,lp2)
+              any?(ground?,lp2) => return [lp2, lts]
+              lp3 := [p for p in lp2 | lin?(p)]
+              lp4 := [p for p in lp2 | not lin?(p)]
+              if clos?
+                then 
+                  lts := decompose(lp4,lts, clos?, info?)$regsetdecomppack
+                else
+                  lp4 := sort(infRittWu?,lp4)
+                  for p in lp4 repeat
+                    lts := decompose([p],lts, clos?, info?)$regsetdecomppack
+              lp2 := lp3
+            else
+              lp2 := crushedSet(lp2)$polsetpack
+              lp2 := remove(zero?,lp2)
+              any?(ground?,lp2) => return [lp2, lts]
+          if clos?
+            then
+              lts := decompose(lp2,lts, clos?, info?)$regsetdecomppack
+            else
+              lp2 := sort(infRittWu?,lp2)
+              for p in lp2 repeat
+                lts := decompose([p],lts, clos?, info?)$regsetdecomppack
+          lp2 := []
+          return [lp2,lts]
+       smallSystem?(lp) => [lp2,lts]
+       mediumSystem?(lp) => [crushedSet(lp2)$polsetpack,lts]
+       lp3 := [p for p in lp2 | lin?(p)]
+       lp4 := [p for p in lp2 | not lin?(p)]
+       if clos?
+         then 
+           lts := decompose(lp4,lts, clos?, info?)$regsetdecomppack
+         else
+           lp4 := sort(infRittWu?,lp4)
+           for p in lp4 repeat
+             lts := decompose([p],lts, clos?, info?)$regsetdecomppack
+       if clos?
+         then 
+           lts := decompose(lp3,lts, clos?, info?)$regsetdecomppack
+         else
+           lp3 := sort(infRittWu?,lp3)
+           for p in lp3 repeat
+             lts := decompose([p],lts, clos?, info?)$regsetdecomppack
+       lp2 := []
+       return [lp2,lts]
+
 *)
 
 \end{chunk}
@@ -148421,6 +183541,7 @@ SquareMatrix(ndim,R): Exports == Implementation where
     if R has ConvertibleTo InputForm then ConvertibleTo InputForm
  
   Implementation ==> Matrix R add
+
     minr ==> minRowIndex
     maxr ==> maxRowIndex
     minc ==> minColIndex
@@ -148429,8 +183550,11 @@ SquareMatrix(ndim,R): Exports == Implementation where
     maxi ==> maxIndex
  
     ZERO := scalarMatrix 0
+
     0    == ZERO
+
     ONE  := scalarMatrix 1
+
     1    == ONE
 
     characteristic() == characteristic()$R
@@ -148447,7 +183571,9 @@ SquareMatrix(ndim,R): Exports == Implementation where
       ans pretend $
  
     row(x,i)    == directProduct row(x pretend Matrix(R),i)
+
     column(x,j) == directProduct column(x pretend Matrix(R),j)
+
     coerce(x:$):OutputForm == coerce(x pretend Matrix R)$Matrix(R)
  
     scalarMatrix r == scalarMatrix(ndim,r)$Matrix(R) pretend $
@@ -148476,6 +183602,7 @@ SquareMatrix(ndim,R): Exports == Implementation where
     if R has commutative("*") then
  
       determinant x == determinant(x pretend Matrix(R))
+
       minordet x    == minordet(x pretend Matrix(R))
  
     if R has EuclideanDomain then
@@ -148485,7 +183612,9 @@ SquareMatrix(ndim,R): Exports == Implementation where
     if R has IntegralDomain then
  
       rank x    == rank(x pretend Matrix(R))
+
       nullity x == nullity(x pretend Matrix(R))
+
       nullSpace x ==
         [directProduct c for c in nullSpace(x pretend Matrix(R))]
  
@@ -148503,6 +183632,7 @@ SquareMatrix(ndim,R): Exports == Implementation where
       recip x == inverse x
  
     if R has ConvertibleTo InputForm then
+
       convert(x:$):InputForm ==
          convert [convert("squareMatrix"::Symbol)@InputForm,
                   convert(x::Matrix(R))]$List(InputForm)
@@ -148513,6 +183643,103 @@ SquareMatrix(ndim,R): Exports == Implementation where
 \begin{chunk}{COQ SQMATRIX}
 (* domain SQMATRIX *)
 (*
+
+    minr ==> minRowIndex
+    maxr ==> maxRowIndex
+    minc ==> minColIndex
+    maxc ==> maxColIndex
+    mini ==> minIndex
+    maxi ==> maxIndex
+ 
+    ZERO := scalarMatrix 0
+
+    0    == ZERO
+
+    ONE  := scalarMatrix 1
+
+    1    == ONE
+
+    characteristic() == characteristic()$R
+ 
+    matrix(l: List List R) ==
+      -- error check: this is a top level function
+      #l ^= ndim => error "matrix: wrong number of rows"
+      for ll in l repeat
+        #ll ^= ndim => error "matrix: wrong number of columns"
+      ans : Matrix R := new(ndim,ndim,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 pretend $
+ 
+    row(x,i)    == directProduct row(x pretend Matrix(R),i)
+
+    column(x,j) == directProduct column(x pretend Matrix(R),j)
+
+    coerce(x:$):OutputForm == coerce(x pretend Matrix R)$Matrix(R)
+ 
+    scalarMatrix r == scalarMatrix(ndim,r)$Matrix(R) pretend $
+ 
+    diagonalMatrix l ==
+      #l ^= ndim =>
+        error "diagonalMatrix: wrong number of entries in list"
+      diagonalMatrix(l)$Matrix(R) pretend $
+ 
+    coerce(x:$):Matrix(R) == copy(x pretend Matrix(R))
+ 
+    squareMatrix x ==
+      (nrows(x) ^= ndim) or (ncols(x) ^= ndim) =>
+        error "squareMatrix: matrix of bad dimensions"
+      copy(x) pretend $
+ 
+    x:$ * v:Col ==
+      directProduct((x pretend Matrix(R)) * (v :: Vector(R)))
+ 
+    v:Row * x:$ ==
+      directProduct((v :: Vector(R)) * (x pretend Matrix(R)))
+ 
+    x:$ ** n:NonNegativeInteger ==
+      ((x pretend Matrix(R)) ** n) pretend $
+ 
+    if R has commutative("*") then
+ 
+      determinant x == determinant(x pretend Matrix(R))
+
+      minordet x    == minordet(x pretend Matrix(R))
+ 
+    if R has EuclideanDomain then
+ 
+      rowEchelon x == rowEchelon(x pretend Matrix(R)) pretend $
+ 
+    if R has IntegralDomain then
+ 
+      rank x    == rank(x pretend Matrix(R))
+
+      nullity x == nullity(x pretend Matrix(R))
+
+      nullSpace x ==
+        [directProduct c for c in nullSpace(x pretend Matrix(R))]
+ 
+    if R has Field then
+ 
+      dimension() == (m * n) :: CardinalNumber
+ 
+      inverse x ==
+        (u := inverse(x pretend Matrix(R))) case "failed" => "failed"
+        (u :: Matrix(R)) pretend $
+ 
+      x:$ ** n:Integer ==
+        ((x pretend Matrix(R)) ** n) pretend $
+ 
+      recip x == inverse x
+ 
+    if R has ConvertibleTo InputForm then
+
+      convert(x:$):InputForm ==
+         convert [convert("squareMatrix"::Symbol)@InputForm,
+                  convert(x::Matrix(R))]$List(InputForm)
+
+
 *)
 
 \end{chunk}
@@ -149309,29 +184536,47 @@ Stack(S:SetCategory): StackAggregate S with
         ++X count(4,a)
 
   == add
+
     Rep := Reference List S
+
     s = t == deref s = deref t
+
     coerce(d:%): OutputForm == bracket [e::OutputForm for e in deref d]
+
     copy s == ref copy deref s
+
     depth s == # deref s
+
     # s == depth s
+
     pop_! (s:%):S ==
         empty? s => error "empty stack"
         e := first deref s
         setref(s,rest deref s)
         e
+
     extract_! (s:%):S == pop_! s
+
     top (s:%):S ==
         empty? s => error "empty stack"
         first deref s
+
     inspect s == top s
+
     push_!(e,s) == (setref(s,cons(e,deref s));e)
+
     insert_!(e:S,s:%):% == (push_!(e,s);s)
+
     empty() == ref nil()$List(S)
+
     empty? s == null deref s
+
     stack s == ref copy s
+
     parts s == copy deref s
+
     map(f,s) == ref map(f,deref s)
+
     map!(f,s) == ref map!(f,deref s)
 
 \end{chunk}
@@ -149339,6 +184584,49 @@ Stack(S:SetCategory): StackAggregate S with
 \begin{chunk}{COQ STACK}
 (* domain STACK *)
 (*
+
+    Rep := Reference List S
+
+    s = t == deref s = deref t
+
+    coerce(d:%): OutputForm == bracket [e::OutputForm for e in deref d]
+
+    copy s == ref copy deref s
+
+    depth s == # deref s
+
+    # s == depth s
+
+    pop_! (s:%):S ==
+        empty? s => error "empty stack"
+        e := first deref s
+        setref(s,rest deref s)
+        e
+
+    extract_! (s:%):S == pop_! s
+
+    top (s:%):S ==
+        empty? s => error "empty stack"
+        first deref s
+
+    inspect s == top s
+
+    push_!(e,s) == (setref(s,cons(e,deref s));e)
+
+    insert_!(e:S,s:%):% == (push_!(e,s);s)
+
+    empty() == ref nil()$List(S)
+
+    empty? s == null deref s
+
+    stack s == ref copy s
+
+    parts s == copy deref s
+
+    map(f,s) == ref map(f,deref s)
+
+    map!(f,s) == ref map!(f,deref s)
+
 *)
 
 \end{chunk}
@@ -149753,11 +185041,13 @@ StochasticDifferential(R:Join(OrderedSet, IntegralDomain)):
     ++ quadratic co-variation.
 
   Implementation ==> SparseMultivariatePolynomial(ER,BSD) add
+
    Rep:=SparseMultivariatePolynomial(ER,BSD)
 
    (v:% / s:ER):% == inv(s) * v
 
    tableQuadVar:Table(%,%)  := table()
+
    tableDrift:Table(%,%) := table()
 
    alterQuadVar!(da:BSD,db:BSD,dXdY:%):Union(%,"failed") ==
@@ -149823,6 +185113,7 @@ StochasticDifferential(R:Join(OrderedSet, IntegralDomain)):
    equation(dx:%,zero:R):Union(Equation %,"failed") ==
     not(0 = zero) => "failed"
     equation(dx,0::%)
+
    equation(zero:R,dx:%):Union(Equation %,"failed") ==
     not(0 = zero) => "failed"
     equation(0::%,dx)
@@ -149868,11 +185159,131 @@ StochasticDifferential(R:Join(OrderedSet, IntegralDomain)):
     (0$Integer = # ll) => true
     (1 = # ll) => true
     uncorrelated1?(first ll,rest ll) and uncorrelated?(rest ll)
+
 \end{chunk}
 
 \begin{chunk}{COQ SD}
 (* domain SD *)
 (*
+
+   Rep:=SparseMultivariatePolynomial(ER,BSD)
+
+   (v:% / s:ER):% == inv(s) * v
+
+   tableQuadVar:Table(%,%)  := table()
+
+   tableDrift:Table(%,%) := table()
+
+   alterQuadVar!(da:BSD,db:BSD,dXdY:%):Union(%,"failed") ==
+    -- next two lines for security only!
+    1 < totalDegree(dXdY)                => "failed"
+    0 ~= coefficient(dXdY,degree(1)$Rep) => "failed"
+    not(0::% = (dXdY*dXdY)::%) => "failed"
+    setelt(tableQuadVar,((da::Rep)*(db::Rep))$Rep,dXdY)$Table(%,%)
+    -- We have to take care here to avoid a bad
+    -- recursion on \axiom{*:(%,%)->%}
+
+   alterDrift!(da:BSD,dx:%):Union(%,"failed") ==
+    1 < totalDegree(dx)                => "failed"
+    0 ~= coefficient(dx,degree(1)$Rep) => "failed"
+    not(0::% = (dx*dx)::%) => "failed"
+    setelt(tableDrift,da::Rep,dx)$Table(%,%)
+
+   multSDOrError(dm:%):% ==
+    c := leadingCoefficient dm
+    (dmm := search(dm/c,tableQuadVar)) 
+      case "failed" =>
+       print hconcat(message("ERROR IN ")$OF,(dm/c)::OF)
+       error "Above product of sd's is not defined"
+    c*dmm
+
+   (dx:% * dy:%) : % ==
+    1 < totalDegree(dx) =>
+     print hconcat(message("ERROR IN ")$OF,dx::OF)
+     error "bad sd in lhs of sd product"
+    1 < totalDegree(dy) =>
+     print hconcat(message("ERROR IN ")$OF,dy::OF)
+     error "bad sd in rhs of sd product"
+    reduce("+",map(multSDOrError,monomials((dx*dy)$Rep)),0)
+    -- We have to take care here to avoid a bad 
+    -- recursion on \axiom{*:(%,%)->%}
+
+   (dx:% ** n:PI) : % ==
+    n = 1 => dx
+    n = 2 => dx*dx
+    n > 2 => 0::%
+
+   (dx:% ^ n:PI) : % == dx**n
+
+   driftSDOrError(dm:%):% ==
+    c := leadingCoefficient dm
+    (dmm := search(dm/c,tableDrift)) 
+      case "failed" =>
+       print hconcat(message("ERROR IN ")$OF,(dm/c)::OF)
+       error "drift of sd is not defined"
+    c*dmm
+
+   drift(dx:%):% ==
+    reduce("+",map(driftSDOrError,monomials(dx)),0)
+
+   freeOf?(sd,dX) == (0 = coefficient(sd,dX,1))
+
+   coefficient(sd:%,dX:BSD):ER == 
+    retract(coefficient(sd,dX,1))@ER
+
+   listSD(sd) == 
+    [retract(dX)@BSD for dX in primitiveMonomials(sd)]
+
+   equation(dx:%,zero:R):Union(Equation %,"failed") ==
+    not(0 = zero) => "failed"
+    equation(dx,0::%)
+
+   equation(zero:R,dx:%):Union(Equation %,"failed") ==
+    not(0 = zero) => "failed"
+    equation(0::%,dx)
+
+   copyDrift() == tableDrift
+   copyQuadVar() == tableQuadVar
+
+   xDrift(dx:BSD):OF ==
+    (xdx := search(dx::Rep,tableDrift)) case "failed" => "?"::OF
+    xdx::OF
+
+   xQV(dx:BSD,dy:BSD):OF ==
+    (xdxdy := search((dx::% * dy::%)$Rep,tableQuadVar)) 
+      case "failed" => "?"::Symbol::OF
+    xdxdy::OF
+
+   statusIto():OF ==
+    bsd  := copyBSD()$BSD
+    bsdo := [dx::OF for dx in bsd]
+    blank:= ""::Symbol::OF
+    colon:= ":"::Symbol::OF
+    bsdh := "B S D "::Symbol::OF
+    dfth := "drift "::Symbol::OF
+    qvh  := "*"::Symbol::OF
+    head := append([bsdh,colon],bsdo)
+    drift:= append([dfth,colon],[xDrift dx for dx in bsd])
+    space:= append([qvh ,blank],[blank for dx in bsd])
+    qv   := [append([dy::OF,colon],[xQV(dx,dy) for dx in bsd]) 
+                                               for dy in bsd]
+    matrix(append([head,drift,space],qv))$OF
+
+   uncorrelated?(dx:%,dy:%): Boolean == (0::% = dx*dy)
+
+   uncorrelated?(l1:List %,l2:List %): Boolean ==
+    reduce("and", [ 
+     reduce("and",[uncorrelated?(dx,dy) for dy in l2],true) 
+      for dx in l1 ],true)
+
+   uncorrelated1?(l1:List %,ll:List List %): Boolean ==
+    reduce("and",[uncorrelated?(l1,l2) for l2 in ll],true)
+
+   uncorrelated?(ll:List List %): Boolean ==
+    (0$Integer = # ll) => true
+    (1 = # ll) => true
+    uncorrelated1?(first ll,rest ll) and uncorrelated?(rest ll)
+
 *)
 
 \end{chunk}
@@ -150431,6 +185842,7 @@ Stream(S): Exports == Implementation where
 --       ++ Think of the case where f(xi,yi) = xi + yi and a = 0.
 
   Implementation ==> add
+
     MIN ==> 1  -- minimal stream index; see also the defaults in LZSTAGG
     x:%
 
@@ -150446,11 +185858,13 @@ Stream(S): Exports == Implementation where
     -- Could use a record of unions if we could guarantee no tags.
 
     NullStream:    S := _$NullStream$Lisp    pretend S
+
     NonNullStream: S := _$NonNullStream$Lisp pretend S
 
     Rep := Record(firstElt: S, restOfStream: %)
 
     explicitlyEmpty? x == EQ(frst x,NullStream)$Lisp
+
     lazy? x            == EQ(frst x,NonNullStream)$Lisp
 
 --% signatures of local functions
@@ -150465,9 +185879,11 @@ Stream(S): Exports == Implementation where
 --% functions to access or change record fields without lazy evaluation
 
     frst x == x.firstElt
+
     rst  x == x.restOfStream
 
     setfrst_!(x,s) == x.firstElt := s
+
     setrst_!(x,y)  == x.restOfStream := y
 
     setToNil_! x ==
@@ -150720,13 +186136,6 @@ Stream(S): Exports == Implementation where
         setrst_!(x,if EQ(rst st,st)$Lisp then x else rst st)
       explicitlyEmpty? x
 
-    --setvalue(x,s) == setfirst_!(x,s)
-
-    --setchildren(x,l) ==
-      --empty? l => error "setchildren: empty list of children"
-      --not(empty? rest l) => error "setchildren: wrong number of children"
-      --setrest_!(x,first l)
-
 --% URAGG functions
 
     first(x,n) == delay
@@ -150789,10 +186198,13 @@ Stream(S): Exports == Implementation where
       concat_!(x,concat(s,empty()))
 
     setfirst_!(x,s) == setelt(x,0,s)
+
     setelt(x,"first",s) == setfirst_!(x,s)
+
     setrest_!(x,y) ==
       empty? x => error "setrest!: empty stream"
       setrst_!(x,y)
+
     setelt(x,"rest",y) == setrest_!(x,y)
 
     setlast_!(x,s) ==
@@ -150855,8 +186267,6 @@ Stream(S): Exports == Implementation where
 
     delay(fs:()->%) == [NonNullStream, fs pretend %]
 
---     explicitlyEmpty? x == markedNull? x
-
     explicitEntries? x ==
       not explicitlyEmpty? x and not lazy? x
 
@@ -150881,8 +186291,10 @@ Stream(S): Exports == Implementation where
       setrestt_!(x,n,y)
 
     generate f    == delay concat(f(), generate f)
+
     gen:(S -> S,S) -> %
     gen(f,s) == delay(ss:=f s; concat(ss, gen(f,ss)))
+
     generate(f,s)==concat(s,gen(f,s))
 
     concat(x:%,y:%) ==delay
@@ -150914,27 +186326,495 @@ Stream(S): Exports == Implementation where
         x
       suntill(p,x)
 
---  if S has SetCategory then
---    mapp: ((S,S) -> S,%,%,S) -> %
---    mapp(f,x,y,a) == delay
---      empty? x or empty? y => empty()
---      concat(f(frst x,frst y), map(f,rst x,rst y,a))
---      map(f,x,y,a) ==
---      explicitlyEmpty? x => empty()
---      eq?(x,rst x) =>
---        frst x=a => y
---        map(f(frst x,#1),y)
---      explicitlyEmpty? y => empty()
---      eq?(y,rst y) =>
---        frst y=a => x
---        p(f(#1,frst y),x)
---      mapp(f,x,y,a)
-
 \end{chunk}
 
 \begin{chunk}{COQ STREAM}
 (* domain STREAM *)
 (*
+
+    MIN ==> 1  -- minimal stream index; see also the defaults in LZSTAGG
+    x:%
+
+    import CyclicStreamTools(S,%)
+
+--% representation
+
+    -- This description of the rep is not quite true.
+    -- The Rep is a pair of one of three forms:
+    --    [value: S,             rest: %]
+    --    [nullstream:    Magic, NIL    ]
+    --    [nonnullstream: Magic, fun: () -> %]
+    -- Could use a record of unions if we could guarantee no tags.
+
+    NullStream:    S := _$NullStream$Lisp    pretend S
+
+    NonNullStream: S := _$NonNullStream$Lisp pretend S
+
+    Rep := Record(firstElt: S, restOfStream: %)
+
+    explicitlyEmpty? x == EQ(frst x,NullStream)$Lisp
+
+    lazy? x            == EQ(frst x,NonNullStream)$Lisp
+
+--% signatures of local functions
+
+    setfrst_!     : (%,S) -> S
+    setrst_!      : (%,%) -> %
+    setToNil_!    : % -> %
+    setrestt_!    : (%,I,%) -> %
+    lazyEval      : % -> %
+    expand_!      : (%,I) -> %
+
+--% functions to access or change record fields without lazy evaluation
+
+    frst x == x.firstElt
+
+    rst  x == x.restOfStream
+
+    setfrst_!(x,s) == x.firstElt := s
+
+    setrst_!(x,y)  == x.restOfStream := y
+
+    setToNil_! x ==
+    -- destructively changes x to a null stream
+      setfrst_!(x,NullStream); setrst_!(x,NIL$Lisp)
+      x
+
+--% SETCAT functions
+
+    if S has SetCategory then
+
+      getm              : (%,L OUT,I) -> L OUT
+      streamCountCoerce : % -> OUT
+      listm             : (%,L OUT,I) -> L OUT
+
+      getm(x,le,n) ==
+        explicitlyEmpty? x => le
+        lazy? x =>
+          n > 0 =>
+            empty? x => le
+            getm(rst x,concat(frst(x) :: OUT,le),n - 1)
+          concat(message("..."),le)
+        eq?(x,rst x) => concat(overbar(frst(x) :: OUT),le)
+        n > 0 => getm(rst x,concat(frst(x) :: OUT,le),n - 1)
+        concat(message("..."),le)
+
+      streamCountCoerce x ==
+      -- this will not necessarily display all stream elements
+      -- which have been computed
+        count := _$streamCount$Lisp
+        -- compute count elements
+        y := x
+        for i in 1..count while not empty? y repeat y := rst y
+        fc := findCycle(count,x)
+        not fc.cycle? => bracket reverse_! getm(x,empty(),count)
+        le : L OUT := empty()
+        for i in 1..fc.prefix repeat
+          le := concat(first(x) :: OUT,le)
+          x := rest x
+        pp : OUT :=
+          fc.period = 1 => overbar(frst(x) :: OUT)
+          pl : L OUT := empty()
+          for i in 1..fc.period repeat
+            pl := concat(frst(x) :: OUT,pl)
+            x  := rest x
+          overbar commaSeparate reverse_! pl
+        bracket reverse_! concat(pp,le)
+
+      listm(x,le,n) ==
+        explicitlyEmpty? x => le
+        lazy? x =>
+          n > 0 =>
+            empty? x => le
+            listm(rst x, concat(frst(x) :: OUT,le),n-1)
+          concat(message("..."),le)
+        listm(rst x,concat(frst(x) :: OUT,le),n-1)
+
+      showAllElements x ==
+      -- this will display all stream elements which have been computed
+      -- and will display at least n elements with n = streamCount$Lisp
+        extend(x,_$streamCount$Lisp)
+        cycElt := cycleElt x
+        cycElt case "failed" =>
+          le := listm(x,empty(),_$streamCount$Lisp)
+          bracket reverse_! le
+        cycEnt := computeCycleEntry(x,cycElt :: %)
+        le : L OUT := empty()
+        while not eq?(x,cycEnt) repeat
+          le := concat(frst(x) :: OUT,le)
+          x := rst x
+        len := computeCycleLength(cycElt :: %)
+        pp : OUT :=
+          len = 1 => overbar(frst(x) :: OUT)
+          pl : L OUT := []
+          for i in 1..len repeat
+            pl := concat(frst(x) :: OUT,pl)
+            x := rst x
+          overbar commaSeparate reverse_! pl
+        bracket reverse_! concat(pp,le)
+
+      showAll?() ==
+        NULL(_$streamsShowAll$Lisp)$Lisp => false
+        true
+
+      coerce(x):OUT ==
+        showAll?() => showAllElements x
+        streamCountCoerce x
+
+--% AGG functions
+
+    lazyCopy:% -> %
+    lazyCopy x == delay
+      empty? x => empty()
+      concat(frst x, copy rst x)
+
+    copy x ==
+      cycElt := cycleElt x
+      cycElt case "failed" => lazyCopy x
+      ce := cycElt :: %
+      len := computeCycleLength(ce)
+      e := computeCycleEntry(x,ce)
+      d := distance(x,e)
+      cycle := complete first(e,len)
+      setrst_!(tail cycle,cycle)
+      d = 0 => cycle
+      head := complete first(x,d::NNI)
+      setrst_!(tail head,cycle)
+      head
+
+--% CNAGG functions
+
+    construct l ==
+      -- copied from defaults to avoid loading defaults
+      empty? l => empty()
+      concat(first l, construct rest l)
+
+--% ELTAGG functions
+
+    elt(x:%,n:I) ==
+      -- copied from defaults to avoid loading defaults
+      n < MIN or empty? x => error "elt: no such element"
+      n = MIN => frst x
+      elt(rst x,n - 1)
+
+    seteltt:(%,I,S) -> S
+    seteltt(x,n,s) ==
+      n = MIN => setfrst_!(x,s)
+      seteltt(rst x,n - 1,s)
+
+    setelt(x,n:I,s:S) ==
+      n < MIN or empty? x => error "setelt: no such element"
+      x := expand_!(x,n - MIN + 1)
+      seteltt(x,n,s)
+
+--% IXAGG functions
+
+    removee: ((S -> Boolean),%) -> %
+    removee(p,x) == delay
+      empty? x => empty()
+      p(frst x) => remove(p,rst x)
+      concat(frst x,remove(p,rst x))
+
+    remove(p,x) ==
+      explicitlyEmpty? x => empty()
+      eq?(x,rst x) =>
+        p(frst x) => empty()
+        x
+      removee(p,x)
+
+    selectt: ((S -> Boolean),%) -> %
+    selectt(p,x) == delay
+      empty? x => empty()
+      not p(frst x) => select(p, rst x)
+      concat(frst x,select(p,rst x))
+
+    select(p,x) ==
+      explicitlyEmpty? x => empty()
+      eq?(x,rst x) =>
+        p(frst x) => x
+        empty()
+      selectt(p,x)
+
+    map(f,x) ==
+      map(f,x pretend Stream(S))$StreamFunctions2(S,S) pretend %
+
+    map(g,x,y) ==
+      xs := x pretend Stream(S); ys := y pretend Stream(S)
+      map(g,xs,ys)$StreamFunctions3(S,S,S) pretend %
+
+    fill_!(x,s) ==
+      setfrst_!(x,s)
+      setrst_!(x,x)
+
+    map_!(f,x) ==
+    -- too many problems with map_! on a lazy stream, so
+    -- in this case, an error message is returned
+      cyclic? x =>
+        tail := cycleTail x ; y := x
+        until y = tail repeat
+          setfrst_!(y,f frst y)
+          y := rst y
+        x
+      explicitlyFinite? x =>
+        y := x
+        while not empty? y repeat
+          setfrst_!(y,f frst y)
+          y := rst y
+        x
+      error "map!: stream with lazy evaluation"
+
+    swap_!(x,m,n) ==
+      (not index?(m,x)) or (not index?(n,x)) =>
+        error "swap!: no such elements"
+      x := expand_!(x,max(m,n) - MIN + 1)
+      xm := elt(x,m); xn := elt(x,n)
+      setelt(x,m,xn); setelt(x,n,xm)
+      x
+
+--% LNAGG functions
+
+    concat(x:%,s:S) == delay
+      empty? x => concat(s,empty())
+      concat(frst x,concat(rst x,s))
+
+    concat(x:%,y:%) == delay
+      empty? x => copy y
+      concat(frst x,concat(rst x, y))
+
+    concat l == delay
+      empty? l => empty()
+      empty?(x := first l) => concat rest l
+      concat(frst x,concat(rst x,concat rest l))
+
+    setelt(x,seg:U,s:S) ==
+      low := lo seg
+      hasHi seg =>
+        high := hi seg
+        high < low => s
+        (not index?(low,x)) or (not index?(high,x)) =>
+          error "setelt: index out of range"
+        x := expand_!(x,high - MIN + 1)
+        y := rest(x,(low - MIN) :: NNI)
+        for i in 0..(high-low) repeat
+          setfrst_!(y,s)
+          y := rst y
+        s
+      not index?(low,x) => error "setelt: index out of range"
+      x := rest(x,(low - MIN) :: NNI)
+      setrst_!(x,x)
+      setfrst_!(x,s)
+
+--% RCAGG functions
+
+    empty() == [NullStream, NIL$Lisp]
+
+    lazyEval x == (rst(x):(()-> %)) ()
+
+    lazyEvaluate x ==
+      st := lazyEval x
+      setfrst_!(x, frst st)
+      setrst_!(x,if EQ(rst st,st)$Lisp then x else rst st)
+      x
+
+    -- empty? is the only function that explicitly causes evaluation
+    -- of a stream element
+    empty? x ==
+      while lazy? x repeat
+        st := lazyEval x
+        setfrst_!(x, frst st)
+        setrst_!(x,if EQ(rst st,st)$Lisp then x else rst st)
+      explicitlyEmpty? x
+
+--% URAGG functions
+
+    first(x,n) == delay
+    -- former name: take
+      n = 0 or empty? x => empty()
+      (concat(frst x, first(rst x,(n-1) :: NNI)))
+
+    concat(s:S,x:%) == [s,x]
+    cons(s,x) == concat(s,x)
+
+    cycleSplit_! x ==
+      cycElt := cycleElt x
+      cycElt case "failed" =>
+        error "cycleSplit_!: non-cyclic stream"
+      y := computeCycleEntry(x,cycElt :: %)
+      eq?(x,y) => (setToNil_! x; return y)
+      z := rst x
+      repeat
+        eq?(y,z) => (setrest_!(x,empty()); return y)
+        x := z ; z := rst z
+
+    expand_!(x,n) ==
+    -- expands cycles (if necessary) so that the first n
+    -- elements of x will not be part of a cycle
+      n < 1 => x
+      y := x
+      for i in 1..n while not empty? y repeat y := rst y
+      cycElt := cycleElt x
+      cycElt case "failed" => x
+      e := computeCycleEntry(x,cycElt :: %)
+      d : I := distance(x,e)
+      d >= n => x
+      if d = 0 then
+        -- roll the cycle 1 entry
+        d := 1
+        t := cycleTail e
+        if eq?(t,e) then
+          t := concat(frst t,empty())
+          e := setrst_!(t,t)
+          setrst_!(x,e)
+        else
+          setrst_!(t,concat(frst e,rst e))
+          e := rst e
+      nLessD := (n-d) :: NNI
+      y := complete first(e,nLessD)
+      e := rest(e,nLessD)
+      setrst_!(tail y,e)
+      setrst_!(rest(x,(d-1) :: NNI),y)
+      x
+
+    first x ==
+      empty? x => error "Can't take the first of an empty stream."
+      frst x
+
+    concat_!(x:%,y:%) ==
+      empty? x => y
+      setrst_!(tail x,y)
+
+    concat_!(x:%,s:S) ==
+      concat_!(x,concat(s,empty()))
+
+    setfirst_!(x,s) == setelt(x,0,s)
+
+    setelt(x,"first",s) == setfirst_!(x,s)
+
+    setrest_!(x,y) ==
+      empty? x => error "setrest!: empty stream"
+      setrst_!(x,y)
+
+    setelt(x,"rest",y) == setrest_!(x,y)
+
+    setlast_!(x,s) ==
+      empty? x => error "setlast!: empty stream"
+      setfrst_!(tail x, s)
+    setelt(x,"last",s) == setlast_!(x,s)
+
+    split_!(x,n) ==
+      n < MIN => error "split!: index out of range"
+      n = MIN =>
+        y : % := empty()
+        setfrst_!(y,frst x)
+        setrst_!(y,rst x)
+        setToNil_! x
+        y
+      x := expand_!(x,n - MIN)
+      x := rest(x,(n - MIN - 1) :: NNI)
+      y := rest x
+      setrst_!(x,empty())
+      y
+
+--% STREAM functions
+
+    coerce(l: L S) == construct l
+
+    repeating l ==
+      empty? l =>
+        error "Need a non-null list to make a repeating stream."
+      x0 : % := x := construct l
+      while not empty? rst x repeat x := rst x
+      setrst_!(x,x0)
+
+    if S has SetCategory then
+
+      repeating?(l, x) ==
+        empty? l =>
+          error "Need a non-empty? list to make a repeating stream."
+        empty? rest l =>
+          not empty? x and frst x = first l and x = rst x
+        x0 := x
+        for s in l repeat
+          empty? x or s ^= frst x => return false
+          x := rst x
+        eq?(x,x0)
+
+    findCycle(n, x) ==
+      hd := x
+      -- Determine whether periodic within n.
+      tl := rest(x, n)
+      explicitlyEmpty? tl => [false, 0, 0]
+      i := 0; while not eq?(x,tl) repeat (x := rst x; i := i + 1)
+      i = n => [false, 0, 0]
+      -- Find period. Now x=tl, so step over and find it again.
+      x := rst x; per := 1
+      while not eq?(x,tl) repeat (x := rst x; per := per + 1)
+      -- Find non-periodic part.
+      x := hd; xp := rest(hd, per); npp := 0
+      while not eq?(x,xp) repeat (x := rst x; xp := rst xp; npp := npp+1)
+      [true, npp, per]
+
+    delay(fs:()->%) == [NonNullStream, fs pretend %]
+
+    explicitEntries? x ==
+      not explicitlyEmpty? x and not lazy? x
+
+    numberOfComputedEntries x ==
+      explicitEntries? x => numberOfComputedEntries(rst x) + 1
+      0
+
+    if S has SetCategory then
+
+      output(n,x) ==
+        (not(n>0))or empty? x => void()
+        mathPrint(frst(x)::OUT)$Lisp
+        output(n-1, rst x)
+
+    setrestt_!(x,n,y) ==
+      n = 0 => setrst_!(x,y)
+      setrestt_!(rst x,n-1,y)
+
+    setrest_!(x,n,y) ==
+      n < 0 or empty? x => error "setrest!: no such rest"
+      x := expand_!(x,n+1)
+      setrestt_!(x,n,y)
+
+    generate f    == delay concat(f(), generate f)
+
+    gen:(S -> S,S) -> %
+    gen(f,s) == delay(ss:=f s; concat(ss, gen(f,ss)))
+
+    generate(f,s)==concat(s,gen(f,s))
+
+    concat(x:%,y:%) ==delay
+      empty? x => y
+      concat(frst x,concat(rst x,y))
+
+    swhilee:(S -> Boolean,%) -> %
+    swhilee(p,x) == delay
+      empty? x      => empty()
+      not p(frst x) => empty()
+      concat(frst x,filterWhile(p,rst x))
+    filterWhile(p,x)==
+      explicitlyEmpty? x => empty()
+      eq?(x,rst x) =>
+        p(frst x) => x
+        empty()
+      swhilee(p,x)
+
+    suntill: (S -> Boolean,%) -> %
+    suntill(p,x) == delay
+      empty? x  => empty()
+      p(frst x) => concat(frst x,empty())
+      concat(frst x, filterUntil(p, rst x))
+
+    filterUntil(p,x)==
+      explicitlyEmpty? x => empty()
+      eq?(x,rst x) =>
+        p(frst x) => concat(frst x,empty())
+        x
+      suntill(p,x)
+
 *)
 
 \end{chunk}
@@ -151651,6 +187531,7 @@ o )show String
 ++ This is the domain of character strings. Strings are 1 based.
 
 String(): StringCategory == IndexedString(1) add 
+
     string n == PRINC_-TO_-STRING(n)$Lisp
 
     OMwrite(x: %): String ==
@@ -151694,6 +187575,45 @@ String(): StringCategory == IndexedString(1) add
 \begin{chunk}{COQ STRING}
 (* domain STRING *)
 (*
+
+    string n == PRINC_-TO_-STRING(n)$Lisp
+
+    OMwrite(x: %): String ==
+      s: String := ""
+      sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+      dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
+      OMputObject(dev)
+      OMputString(dev, x pretend String)
+      OMputEndObject(dev)
+      OMclose(dev)
+      s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+      s
+
+    OMwrite(x: %, wholeObj: Boolean): String ==
+      s: String := ""
+      sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+      dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
+      if wholeObj then
+        OMputObject(dev)
+      OMputString(dev, x pretend String)
+      if wholeObj then
+        OMputEndObject(dev)
+      OMclose(dev)
+      s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+      s
+
+    OMwrite(dev: OpenMathDevice, x: %): Void ==
+      OMputObject(dev)
+      OMputString(dev, x pretend String)
+      OMputEndObject(dev)
+
+    OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void ==
+      if wholeObj then
+        OMputObject(dev)
+      OMputString(dev, x pretend String)
+      if wholeObj then
+        OMputEndObject(dev)
+
 *)
 
 \end{chunk}
@@ -152268,6 +188188,7 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where
       ++ of the 3 dimensional subspace s.
  
   Implementation ==> add
+
     import String()
 
     Rep := Record(pt:POINT, index:NNI, property:PROP, _
@@ -152280,10 +188201,12 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where
                    noChildren: NNI, _
                    parentField:List %) -- needn't be list but...base case?
 
-    TELLWATT : String := "Non-null list: Please inform Stephen Watt"
+    TELLWATT : String := "Non-null list: Please inform Tim Daly"
  
     leaf? space ==  empty? children space
+
     root? space == (space.levelField = 0$NNI)
+
     internal? space == ^(root? space and leaf? space)
  
     new() ==
@@ -152312,6 +188235,7 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where
       space.childrenField.num
 
     children space == space.childrenField
+
     numberOfChildren space == space.noChildren
  
     shallowCopy space ==
@@ -152354,7 +188278,8 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where
       for s in rest listOfSpaces repeat
            -- because of the initial deepCopy, above, everything is
            -- deepCopied to be consistent...more hmmm...
-        space.childrenField := append(space.childrenField,[deepCopy c for c in s.childrenField])
+        space.childrenField := _
+          append(space.childrenField,[deepCopy c for c in s.childrenField])
       space
 
     separate space ==
@@ -152511,33 +188436,321 @@ SubSpace(n:PI,R:Ring) : Exports == Implementation where
       node := space
       while ^root? node repeat node := parent node
       (node.pointDataField).(space.index)
+
     extractIndex space == space.index
+
     extractClosed space == closed? space.property
+
     extractProperty space == space.property
  
     parent space ==
-      empty? space.parentField => error "This is a top level SubSpace - it does not have a parent"
+      empty? space.parentField => _
+         error "This is a top level SubSpace - it does not have a parent"
       first space.parentField
+
     pointData space == space.pointDataField
+
     level space == space.levelField
+
     s1 = s2 ==
         ------------ extra checks for list of point data
       (leaf? s1 and leaf? s2) =>
-        (s1.pt = s2.pt) and (s1.property = s2.property) and (s1.levelField = s2.levelField)
+        (s1.pt = s2.pt) and (s1.property = s2.property) _
+                        and (s1.levelField = s2.levelField)
       -- note that the ordering of children is important
       #s1.childrenField ^= #s2.childrenField => false
       and/[c1 = c2 for c1 in s1.childrenField for c2 in s2.childrenField]
        and (s1.property = s2.property) and (s1.levelField = s2.levelField)
+
     coerce(space:%):O ==
       hconcat([n::O,"-Space with depth of "::O,                     _
-              (n - space.levelField)::O," and "::O,(s:=(#space.childrenField))::O,  _
-              (s=1 => " component"::O;" components"::O)])
+        (n - space.levelField)::O," and "::O,(s:=(#space.childrenField))::O,  _
+        (s=1 => " component"::O;" components"::O)])
 
 \end{chunk}
 
 \begin{chunk}{COQ SUBSPACE}
 (* domain SUBSPACE *)
 (*
+
+    import String()
+
+    Rep := Record(pt:POINT, index:NNI, property:PROP, _
+                   childrenField:List %, _
+                   lastChild: List %, _ 
+                   levelField:NNI, _
+                   pointDataField:L POINT, _
+                   lastPoint: L POINT, _
+                   noPoints: NNI, _
+                   noChildren: NNI, _
+                   parentField:List %) -- needn't be list but...base case?
+
+    TELLWATT : String := "Non-null list: Please inform Tim Daly"
+ 
+    leaf? space ==  empty? children space
+
+    root? space == (space.levelField = 0$NNI)
+
+    internal? space == ^(root? space and leaf? space)
+ 
+    new() ==
+      [point(empty())$POINT,0,new()$PROP,empty(),empty(),0,_
+                                     empty(),empty(),0,0,empty()]
+    subspace() == new()
+ 
+    birth momma ==
+      baby := new()
+      baby.levelField := momma.levelField+1
+      baby.parentField := [momma]
+      if not empty?(lastKid := momma.lastChild) then
+        not empty? rest lastKid => error TELLWATT
+      if empty? lastKid
+        then
+          momma.childrenField := [baby]
+          momma.lastChild := momma.childrenField
+          momma.noChildren := 1
+        else
+          setrest_!(lastKid,[baby])
+          momma.lastChild := rest lastKid
+          momma.noChildren := momma.noChildren + 1
+      baby
+ 
+    child(space,num) ==
+      space.childrenField.num
+
+    children space == space.childrenField
+
+    numberOfChildren space == space.noChildren
+ 
+    shallowCopy space ==
+      node := new()
+      node.pt         := space.pt
+      node.index      := space.index
+      node.property   := copy(space.property)
+      node.levelField := space.levelField
+      node.parentField := nil()
+      if root? space then
+        node.pointDataField := copy(space.pointDataField)
+        node.lastPoint := tail(node.pointDataField)
+        node.noPoints := space.noPoints
+      node
+
+    deepCopy space ==
+      node := shallowCopy(space)
+      leaf? space => node
+      for c in children space repeat
+        cc := deepCopy c
+        cc.parentField := [node]
+        node.childrenField := cons(cc,node.childrenField)
+      node.childrenField := reverse_!(node.childrenField)
+      node.lastChild := tail node.childrenField
+      node
+
+    merge(s1,s2) ==
+       ------------------ need to worry about reindexing s2 & parentField
+      n1 : Rep := deepCopy s1
+      n2 : Rep := deepCopy s2
+      n1.childrenField := append(children n1,children n2)
+      n1
+
+    merge listOfSpaces ==
+       ------------------ need to worry about reindexing & parentField
+      empty? listOfSpaces => error "empty list passed as argument to merge"
+           -- notice that the properties of the first subspace on the
+           -- list are the ones that are inherited...hmmmm...
+      space := deepCopy first listOfSpaces
+      for s in rest listOfSpaces repeat
+           -- because of the initial deepCopy, above, everything is
+           -- deepCopied to be consistent...more hmmm...
+        space.childrenField := _
+          append(space.childrenField,[deepCopy c for c in s.childrenField])
+      space
+
+    separate space ==
+       ------------------ need to worry about reindexing & parentField
+      spaceList := empty()
+      for s in space.childrenField repeat
+        spc:=shallowCopy space
+        spc.childrenField:=[deepCopy s]
+        spaceList := cons(spc,spaceList)
+      spaceList
+ 
+    addPoint(space:%,path:List NNI,point:POINT) ==
+      if not empty?(lastPt := space.lastPoint) then
+        not empty? rest lastPt => error TELLWATT
+      if empty? lastPt
+        then
+          space.pointDataField := [point]
+          space.lastPoint := space.pointDataField
+        else
+          setrest_!(lastPt,[point])
+          space.lastPoint := rest lastPt
+      space.noPoints := space.noPoints + 1
+      which := space.noPoints
+      node := space
+      depth : NNI := 0
+      for i in path repeat
+        node := child(node,i)
+        depth := depth + 1
+      for more in depth..(n-1) repeat
+        node := birth node
+      node.pt := point      -- will be obsolete field
+      node.index := which
+      space
+
+    addPoint2(space:%,point:POINT) ==
+      if not empty?(lastPt := space.lastPoint) then
+        not empty? rest lastPt => error TELLWATT
+      if empty? lastPt
+        then
+          space.pointDataField := [point]
+          space.lastPoint := space.pointDataField
+        else
+          setrest_!(lastPt,[point])
+          space.lastPoint := rest lastPt
+      space.noPoints := space.noPoints + 1
+      which := space.noPoints
+      node := space
+      depth : NNI := 0
+      node := birth node
+      first := node
+      for more in 1..n-1 repeat
+        node := birth node
+      node.pt := point      -- will be obsolete field
+      node.index := which
+      first
+
+    addPointLast(space:%,node:%, point:POINT, depth:NNI) ==
+      if not empty?(lastPt := space.lastPoint) then
+        not empty? rest lastPt => error TELLWATT
+      if empty? lastPt
+        then
+          space.pointDataField := [point]
+          space.lastPoint := space.pointDataField
+        else
+          setrest_!(lastPt,[point])
+          space.lastPoint := rest lastPt
+      space.noPoints := space.noPoints + 1
+      which := space.noPoints
+      if depth = 2 then node := child(node, 2)
+      for more in depth..(n-1) repeat
+        node := birth node
+      node.pt := point      -- will be obsolete field
+      node.index := which
+      node -- space
+
+    addPoint(space:%,path:List NNI,which:NNI) ==
+      node := space
+      depth : NNI := 0
+      for i in path repeat
+        node := child(node,i)
+        depth := depth + 1
+      for more in depth..(n-1) repeat
+        node := birth node
+      node.pt := space.pointDataField.which   -- will be obsolete field
+      node.index := which
+      space
+
+    addPoint(space:%,point:POINT) ==
+      root? space =>
+        if not empty?(lastPt := space.lastPoint) then
+          not empty? rest lastPt => error TELLWATT
+        if empty? lastPt
+          then
+            space.pointDataField := [point]
+            space.lastPoint := space.pointDataField
+          else
+            setrest_!(lastPt,[point])
+            space.lastPoint := rest lastPt
+        space.noPoints := space.noPoints + 1
+      error "You need to pass a top level SubSpace (level should be zero)"
+ 
+    modifyPoint(space:%,path:List NNI,point:POINT) ==
+      if not empty?(lastPt := space.lastPoint) then
+        not empty? rest lastPt => error TELLWATT
+      if empty? lastPt
+        then
+          space.pointDataField := [point]
+          space.lastPoint := space.pointDataField
+        else
+          setrest_!(lastPt,[point])
+          space.lastPoint := rest lastPt
+      space.noPoints := space.noPoints + 1
+      which := space.noPoints
+      node := space
+      for i in path repeat
+        node := child(node,i)
+      node.pt := point       ---------- will be obsolete field
+      node.index := which
+      space
+
+    modifyPoint(space:%,path:List NNI,which:NNI) ==
+      node := space
+      for i in path repeat
+        node := child(node,i)
+      node.pt := space.pointDataField.which ---------- will be obsolete field
+      node.index := which
+      space
+
+    modifyPoint(space:%,which:NNI,point:POINT) ==
+      root? space =>
+        space.pointDataField.which := point
+        space
+      error "You need to pass a top level SubSpace (level should be zero)"
+ 
+    closeComponent(space,path,val) ==
+      node := space
+      for i in path repeat
+        node := child(node,i)
+      close(node.property,val)
+      space
+
+    defineProperty(space,path,prop) ==
+      node := space
+      for i in path repeat
+        node := child(node,i)
+      node.property := prop
+      space
+ 
+    traverse(space,path) ==
+      for i in path repeat space := child(space,i)
+      space
+
+    extractPoint space ==
+      node := space
+      while ^root? node repeat node := parent node
+      (node.pointDataField).(space.index)
+
+    extractIndex space == space.index
+
+    extractClosed space == closed? space.property
+
+    extractProperty space == space.property
+ 
+    parent space ==
+      empty? space.parentField => _
+         error "This is a top level SubSpace - it does not have a parent"
+      first space.parentField
+
+    pointData space == space.pointDataField
+
+    level space == space.levelField
+
+    s1 = s2 ==
+        ------------ extra checks for list of point data
+      (leaf? s1 and leaf? s2) =>
+        (s1.pt = s2.pt) and (s1.property = s2.property) _
+                        and (s1.levelField = s2.levelField)
+      -- note that the ordering of children is important
+      #s1.childrenField ^= #s2.childrenField => false
+      and/[c1 = c2 for c1 in s1.childrenField for c2 in s2.childrenField]
+       and (s1.property = s2.property) and (s1.levelField = s2.levelField)
+
+    coerce(space:%):O ==
+      hconcat([n::O,"-Space with depth of "::O,                     _
+        (n - space.levelField)::O," and "::O,(s:=(#space.childrenField))::O,  _
+        (s=1 => " component"::O;" components"::O)])
+
 *)
 
 \end{chunk}
@@ -152643,17 +188856,25 @@ SubSpaceComponentProperty() : Exports == Implementation where
         ++ copy(x) is not documented
  
   Implementation ==> add
+
     Rep := Record(closed:B, solid:B)
+
     closed? p == p.closed
+
     solid? p == p.solid
+
     close(p,b) == p.closed := b
+
     solid(p,b) == p.solid := b
+
     new() == [false,false]
+
     copy p ==
       annuderOne := new()
       close(annuderOne,closed? p)
       solid(annuderOne,solid? p)
       annuderOne
+
     coerce p ==
       hconcat(["Component is "::O,
               (closed? p => ""::O; "not "::O),"closed, "::O, _
@@ -152664,6 +188885,30 @@ SubSpaceComponentProperty() : Exports == Implementation where
 \begin{chunk}{COQ COMPPROP}
 (* domain COMPPROP *)
 (*
+
+    Rep := Record(closed:B, solid:B)
+
+    closed? p == p.closed
+
+    solid? p == p.solid
+
+    close(p,b) == p.closed := b
+
+    solid(p,b) == p.solid := b
+
+    new() == [false,false]
+
+    copy p ==
+      annuderOne := new()
+      close(annuderOne,closed? p)
+      solid(annuderOne,solid? p)
+      annuderOne
+
+    coerce p ==
+      hconcat(["Component is "::O,
+              (closed? p => ""::O; "not "::O),"closed, "::O, _
+              (solid? p => ""::O; "not "::O),"solid"::O ])
+
 *)
 
 \end{chunk}
@@ -152752,10 +188997,15 @@ SuchThat(S1, S2): Cat == Capsule where
                 ++ rhs(f) returns the right side of f
  
     Capsule == add
+
         Rep := Record(obj: S1, cond: S2)
+
         construct(o, c) == [o, c]$Record(obj: S1, cond: S2)
+
         lhs st == st.obj
+
         rhs st == st.cond
+
         coerce(w):E == infix("|"::E, w.obj::E, w.cond::E)
 
 \end{chunk}
@@ -152763,6 +189013,17 @@ SuchThat(S1, S2): Cat == Capsule where
 \begin{chunk}{COQ SUCH}
 (* domain SUCH *)
 (*
+
+        Rep := Record(obj: S1, cond: S2)
+
+        construct(o, c) == [o, c]$Record(obj: S1, cond: S2)
+
+        lhs st == st.obj
+
+        rhs st == st.cond
+
+        coerce(w):E == infix("|"::E, w.obj::E, w.cond::E)
+
 *)
 
 \end{chunk}
@@ -152893,6 +189154,7 @@ Switch():public == private where
       ++ NOT(x) returns the \axiomType{Switch} expression representing \spad{\~~x}.
     
   private == add
+
     Rep := Record(op:BasicOperator,rands:List EXPR)
 
     -- Public function definitions
@@ -152907,7 +189169,8 @@ Switch():public == private where
         prefix(rat,ran)
       infix(rat,ran)
 
-    coerce(s:Symbol):$ == [nullOp,[[s::Expression(Integer)]$EXPR]$List(EXPR)]$Rep
+    coerce(s:Symbol):$ == 
+      [nullOp,[[s::Expression(Integer)]$EXPR]$List(EXPR)]$Rep
 
     NOT(r:EXPR):% ==
       [operator("~"::Symbol),[r]$List(EXPR)]$Rep
@@ -152941,6 +189204,51 @@ Switch():public == private where
 \begin{chunk}{COQ SWITCH}
 (* domain SWITCH *)
 (*
+
+    Rep := Record(op:BasicOperator,rands:List EXPR)
+
+    -- Public function definitions
+
+    nullOp : BasicOperator := operator NULL
+
+    coerce(s:%):OutputForm ==
+      rat := (s . op)::OutputForm
+      ran := [u::OutputForm for u in s.rands]
+      (s . op) = nullOp => first ran
+      #ran = 1 =>
+        prefix(rat,ran)
+      infix(rat,ran)
+
+    coerce(s:Symbol):$ == 
+      [nullOp,[[s::Expression(Integer)]$EXPR]$List(EXPR)]$Rep
+
+    NOT(r:EXPR):% ==
+      [operator("~"::Symbol),[r]$List(EXPR)]$Rep
+
+    NOT(r:%):% ==
+      [operator("~"::Symbol),[[r]$EXPR]$List(EXPR)]$Rep
+
+    LT(r1:EXPR,r2:EXPR):% ==
+      [operator("<"::Symbol),[r1,r2]$List(EXPR)]$Rep
+
+    GT(r1:EXPR,r2:EXPR):% ==
+      [operator(">"::Symbol),[r1,r2]$List(EXPR)]$Rep
+
+    LE(r1:EXPR,r2:EXPR):% ==
+      [operator("<="::Symbol),[r1,r2]$List(EXPR)]$Rep
+
+    GE(r1:EXPR,r2:EXPR):% ==
+      [operator(">="::Symbol),[r1,r2]$List(EXPR)]$Rep
+
+    AND(r1:EXPR,r2:EXPR):% ==
+      [operator("and"::Symbol),[r1,r2]$List(EXPR)]$Rep
+
+    OR(r1:EXPR,r2:EXPR):% ==
+      [operator("or"::Symbol),[r1,r2]$List(EXPR)]$Rep
+
+    EQ(r1:EXPR,r2:EXPR):% ==
+      [operator("EQ"::Symbol),[r1,r2]$List(EXPR)]$Rep
+
 *)
 
 \end{chunk}
@@ -153458,7 +189766,8 @@ Symbol(): Exports == Implementation where
        ++ argscript(s, [a1,...,an]) returns s
        ++ arg-scripted by \spad{[a1,...,an]}.
      elt: (%, L) -> %
-       ++ elt(s,[a1,...,an]) or s([a1,...,an]) returns s subscripted by \spad{[a1,...,an]}.
+       ++ elt(s,[a1,...,an]) or s([a1,...,an]) 
+       ++ returns s subscripted by \spad{[a1,...,an]}.
      string: % -> String
        ++ string(s) converts the symbol s to a string.
        ++ Error: if the symbol is subscripted.
@@ -153469,13 +189778,20 @@ Symbol(): Exports == Implementation where
        ++ sample() returns a sample of %
 
   Implementation ==> add
+
     count: Reference(Integer) := ref 0
+
     xcount: AssociationList(%, Integer) := empty()
+
     istrings:PrimitiveArray(String) :=
                      construct ["0","1","2","3","4","5","6","7","8","9"]
+
     -- the following 3 strings shall be of empty intersection
+
     nums:String:="0123456789"
+
     ALPHAS:String:="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+
     alphas:String:="abcdefghijklmnopqrstuvwxyz"
 
     writeOMSym(dev: OpenMathDevice, x: %): Void ==
@@ -153528,14 +189844,23 @@ Symbol(): Exports == Implementation where
     syscripts: Scripts -> L
 
     convert(s:%):InputForm == convert(s pretend Symbol)$InputForm
+
     convert(s:%):Symbol    == s pretend Symbol
+
     coerce(s:String):%     == VALUES(INTERN(s)$Lisp)$Lisp
+
     x = y                  == EQUAL(x,y)$Lisp
+
     x < y                  == GGREATERP(y, x)$Lisp
+
     coerce(x:%):OutputForm == outputForm(x pretend Symbol)
+
     subscript(sy, lx)      == script(sy, [lx, nil, nil(), nil(), nil()])
+
     elt(sy,lx)             == subscript(sy,lx)
+
     superscript(sy, lx)    == script(sy,[nil(),lx, nil(), nil(), nil()])
+
     argscript(sy, lx)      == script(sy,[nil(),nil(), nil(), nil(), lx])
 
     patternMatch(x:%,p:Pattern Integer,l:PatternMatchResult(Integer,%))==
@@ -153585,7 +189910,7 @@ Symbol(): Exports == Implementation where
       not scripted? e => PNAME(e)$Lisp
       error "Cannot form string from non-atomic symbols."
 
--- Scripts ==> Record(sub:L,sup:L,presup:L,presub:L,args:L)
+    -- Scripts ==> Record(sub:L,sup:L,presup:L,presub:L,args:L)
     latex e ==
       s : String := (PNAME(name e)$Lisp) @ String
       if #s > 1 and s.1 ^= char "\" then
@@ -153720,6 +190045,268 @@ Symbol(): Exports == Implementation where
 \begin{chunk}{COQ SYMBOL}
 (* domain SYMBOL *)
 (*
+
+    count: Reference(Integer) := ref 0
+
+    xcount: AssociationList(%, Integer) := empty()
+
+    istrings:PrimitiveArray(String) :=
+                     construct ["0","1","2","3","4","5","6","7","8","9"]
+
+    -- the following 3 strings shall be of empty intersection
+
+    nums:String:="0123456789"
+
+    ALPHAS:String:="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+
+    alphas:String:="abcdefghijklmnopqrstuvwxyz"
+
+    writeOMSym(dev: OpenMathDevice, x: %): Void ==
+      scripted? x =>
+        error "Cannot convert a scripted symbol to OpenMath"
+      OMputVariable(dev, x pretend Symbol)
+
+    OMwrite(x: %): String ==
+      s: String := ""
+      sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+      dev: OpenMathDevice := OMopenString(sp @ String, OMencodingXML)
+      OMputObject(dev)
+      writeOMSym(dev, x)
+      OMputEndObject(dev)
+      OMclose(dev)
+      s := OM_-STRINGPTRTOSTRING(sp)$Lisp @ String
+      s
+
+    OMwrite(x: %, wholeObj: Boolean): String ==
+      s: String := ""
+      sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+      dev: OpenMathDevice := OMopenString(sp @ String, OMencodingXML)
+      if wholeObj then
+        OMputObject(dev)
+      writeOMSym(dev, x)
+      if wholeObj then
+        OMputEndObject(dev)
+      OMclose(dev)
+      s := OM_-STRINGPTRTOSTRING(sp)$Lisp @ String
+      s
+
+    OMwrite(dev: OpenMathDevice, x: %): Void ==
+      OMputObject(dev)
+      writeOMSym(dev, x)
+      OMputEndObject(dev)
+
+    OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void ==
+      if wholeObj then
+        OMputObject(dev)
+      writeOMSym(dev, x)
+      if wholeObj then
+        OMputEndObject(dev)
+
+    hd:String    := "*"
+    lhd          := #hd
+    ord0         := ord char("0")$Character
+
+    istring  : Integer -> String
+    syprefix : Scripts -> String
+    syscripts: Scripts -> L
+
+    convert(s:%):InputForm == convert(s pretend Symbol)$InputForm
+
+    convert(s:%):Symbol    == s pretend Symbol
+
+    coerce(s:String):%     == VALUES(INTERN(s)$Lisp)$Lisp
+
+    x = y                  == EQUAL(x,y)$Lisp
+
+    x < y                  == GGREATERP(y, x)$Lisp
+
+    coerce(x:%):OutputForm == outputForm(x pretend Symbol)
+
+    subscript(sy, lx)      == script(sy, [lx, nil, nil(), nil(), nil()])
+
+    elt(sy,lx)             == subscript(sy,lx)
+
+    superscript(sy, lx)    == script(sy,[nil(),lx, nil(), nil(), nil()])
+
+    argscript(sy, lx)      == script(sy,[nil(),nil(), nil(), nil(), lx])
+
+    patternMatch(x:%,p:Pattern Integer,l:PatternMatchResult(Integer,%))==
+      (patternMatch(x pretend Symbol, p, l pretend
+       PatternMatchResult(Integer, Symbol))$PatternMatchSymbol(Integer))
+         pretend PatternMatchResult(Integer, %)
+
+    patternMatch(x:%, p:Pattern Float, l:PatternMatchResult(Float, %)) ==
+      (patternMatch(x pretend Symbol, p, l pretend
+       PatternMatchResult(Float, Symbol))$PatternMatchSymbol(Float))
+         pretend PatternMatchResult(Float, %)
+
+    convert(x:%):Pattern(Float) ==
+      coerce(x pretend Symbol)$Pattern(Float)
+
+    convert(x:%):Pattern(Integer) ==
+      coerce(x pretend Symbol)$Pattern(Integer)
+
+    syprefix sc ==
+      ns: List Integer := [#sc.presub, #sc.presup, #sc.sup, #sc.sub]
+      while #ns >= 2 and zero? first ns repeat ns := rest ns
+      concat concat(concat(hd, istring(#sc.args)),
+                                 [istring n for n in reverse_! ns])
+
+    syscripts sc ==
+      all := sc.presub
+      all := concat(sc.presup, all)
+      all := concat(sc.sup, all)
+      all := concat(sc.sub, all)
+      concat(all, sc.args)
+
+    script(sy: %, ls: List L) ==
+      sc: Scripts := [nil(), nil(), nil(), nil(), nil()]
+      if not null ls then (sc.sub    := first ls; ls := rest ls)
+      if not null ls then (sc.sup    := first ls; ls := rest ls)
+      if not null ls then (sc.presup := first ls; ls := rest ls)
+      if not null ls then (sc.presub := first ls; ls := rest ls)
+      if not null ls then (sc.args   := first ls; ls := rest ls)
+      script(sy, sc)
+
+    script(sy: %, sc: Scripts) ==
+      scripted? sy => error "Cannot add scripts to a scripted symbol"
+      (concat(concat(syprefix sc, string name sy)::%::OutputForm,
+                                                syscripts sc)) pretend %
+
+    string e ==
+      not scripted? e => PNAME(e)$Lisp
+      error "Cannot form string from non-atomic symbols."
+
+    -- Scripts ==> Record(sub:L,sup:L,presup:L,presub:L,args:L)
+    latex e ==
+      s : String := (PNAME(name e)$Lisp) @ String
+      if #s > 1 and s.1 ^= char "\" then
+        s := concat("\mbox{\it ", concat(s, "}")$String)$String
+      not scripted? e => s
+      ss : Scripts := scripts e
+      lo : List OutputForm := ss.sub
+      sc : String
+      if not empty? lo then
+        sc := "__{"
+        while not empty? lo repeat
+            sc := concat(sc, latex first lo)$String
+            lo := rest lo
+            if not empty? lo then sc := concat(sc, ", ")$String
+        sc := concat(sc, "}")$String
+        s := concat(s, sc)$String
+      lo := ss.sup
+      if not empty? lo then
+        sc := "^{"
+        while not empty? lo repeat
+            sc := concat(sc, latex first lo)$String
+            lo := rest lo
+            if not empty? lo then sc := concat(sc, ", ")$String
+        sc := concat(sc, "}")$String
+        s := concat(s, sc)$String
+      lo := ss.presup
+      if not empty? lo then
+        sc := "{}^{"
+        while not empty? lo repeat
+            sc := concat(sc, latex first lo)$String
+            lo := rest lo
+            if not empty? lo then sc := concat(sc, ", ")$String
+        sc := concat(sc, "}")$String
+        s := concat(sc, s)$String
+      lo := ss.presub
+      if not empty? lo then
+        sc := "{}__{"
+        while not empty? lo repeat
+            sc := concat(sc, latex first lo)$String
+            lo := rest lo
+            if not empty? lo then sc := concat(sc, ", ")$String
+        sc := concat(sc, "}")$String
+        s := concat(sc, s)$String
+      lo := ss.args
+      if not empty? lo then
+        sc := "\left( {"
+        while not empty? lo repeat
+            sc := concat(sc, latex first lo)$String
+            lo := rest lo
+            if not empty? lo then sc := concat(sc, ", ")$String
+        sc := concat(sc, "} \right)")$String
+        s := concat(s, sc)$String
+      s
+
+    anyRadix(n:Integer,s:String):String ==
+      ns:String:=""
+      repeat
+        qr := divide(n,#s)
+        n  := qr.quotient
+        ns := concat(s.(qr.remainder+minIndex s),ns)
+        if zero?(n) then return ns
+      
+    new() ==
+      sym := anyRadix(count()::Integer,ALPHAS)
+      count() := count() + 1
+      concat("%",sym)::%
+
+    new x ==
+      n:Integer :=
+        (u := search(x, xcount)) case "failed" => 0
+        inc(u::Integer)
+      xcount(x) := n
+      xx := 
+        not scripted? x => string x
+        string name x
+      xx := concat("%",xx)
+      xx :=
+        (position(xx.maxIndex(xx),nums)>=minIndex(nums)) => 
+          concat(xx, anyRadix(n,alphas))
+        concat(xx, anyRadix(n,nums))
+      not scripted? x => xx::%
+      script(xx::%,scripts x)
+
+    resetNew() ==
+      count() := 0
+      for k in keys xcount repeat remove_!(k, xcount)
+      void
+
+    scripted? sy ==
+      not ATOM(sy)$Lisp
+
+    name sy ==
+      not scripted? sy => sy
+      str := string first list sy
+      for i in lhd+1..#str repeat
+        not digit?(str.i) => return((str.(i..#str))::%)
+      error "Improper scripted symbol"
+
+    scripts sy ==
+      not scripted? sy => [nil(), nil(), nil(), nil(), nil()]
+      nscripts: List NonNegativeInteger := [0, 0, 0, 0, 0]
+      lscripts: List L := [nil(), nil(), nil(), nil(), nil()]
+      str  := string first list sy
+      nstr := #str
+      m := minIndex nscripts
+      for i in m.. for j in lhd+1..nstr while digit?(str.j) repeat
+          nscripts.i := (ord(str.j) - ord0)::NonNegativeInteger
+      -- Put the number of function scripts at the end.
+      nscripts := concat(rest nscripts, first nscripts)
+      allscripts := rest list sy
+      m := minIndex lscripts
+      for i in m.. for n in nscripts repeat
+        #allscripts < n => error "Improper script count in symbol"
+        lscripts.i := [a::OutputForm for a in first(allscripts, n)]
+        allscripts := rest(allscripts, n)
+      [lscripts.m, lscripts.(m+1), lscripts.(m+2),
+                                         lscripts.(m+3), lscripts.(m+4)]
+
+    istring n ==
+      n > 9 => error "Can have at most 9 scripts of each kind"
+      istrings.(n + minIndex istrings)
+
+    list sy ==
+      not scripted? sy =>
+         error "Cannot convert a symbol to a list if it is not subscripted"
+      sy pretend List(%)
+
+    sample() == "aSymbol"::%
+
 *)
 
 \end{chunk}
@@ -153981,6 +190568,132 @@ SymbolTable() : exports == implementation where
 \begin{chunk}{COQ SYMTAB}
 (* domain SYMTAB *)
 (*
+
+    Rep := Table(Symbol,FortranType)
+
+    coerce(t:$):OFORM ==
+      coerce(t)$Rep
+
+    coerce(t:$):Table(Symbol,FortranType) ==
+      t pretend Table(Symbol,FortranType)
+
+    symbolTable(l:L Record(key:Symbol,entry:FortranType)):$ ==
+      table(l)$Rep
+
+    empty():$ ==
+      empty()$Rep
+
+    parametersOf(tab:$):L(Symbol) ==
+      keys(tab)
+
+    declare!(name:Symbol,type:FortranType,tab:$):FortranType ==
+      setelt(tab,name,type)$Rep
+      type
+
+    declare!(names:L Symbol,type:FortranType,tab:$):FortranType ==
+      for name in names repeat setelt(tab,name,type)$Rep
+      type
+
+    fortranTypeOf(u:Symbol,tab:$):FortranType ==
+      elt(tab,u)$Rep
+
+    externalList(tab:$):L(Symbol) ==
+     [u for u in keys(tab) | external? fortranTypeOf(u,tab)]
+
+    typeList(type:FortranScalarType,tab:$):TL ==
+      scalarList := []@TL
+      arrayList  := []@TL
+      for u in keys(tab)$Rep repeat
+        uType : FortranType := fortranTypeOf(u,tab)
+        sType : FSTU := scalarTypeOf(uType)
+        if (sType case fst and (sType.fst)=type) then
+          uDim : TL1 := [[v]$T for v in dimensionsOf(uType)]
+          if empty? uDim then 
+            scalarList := cons([u]$TU,scalarList) 
+          else 
+            arrayList := cons([cons([u],uDim)$TL1]$TU,arrayList)
+      -- Scalars come first in case they are integers which are later
+      -- used as an array dimension.
+      append(scalarList,arrayList)
+
+    typeList2(type:FortranScalarType,tab:$):TL ==
+      tl := []@TL
+      symbolType : Symbol := coerce(type)$FortranScalarType
+      for u in keys(tab)$Rep repeat
+        uType : FortranType := fortranTypeOf(u,tab)
+        sType : FSTU := scalarTypeOf(uType)
+        if (sType case fst and (sType.fst)=type) then
+          uDim : TL1 := [[v]$T for v in dimensionsOf(uType)]
+          tl := if empty? uDim then cons([u]$TU,tl)
+                else cons([cons([u],uDim)$TL1]$TU,tl)
+      empty? tl => tl
+      cons([symbolType]$TU,tl)
+
+    updateList(sType:SEX,name:SEX,lDims:SEX,tl:SEX):SEX ==
+      l : SEX := ASSOC(sType,tl)$Lisp
+      entry : SEX := if null?(lDims) then name else CONS(name,lDims)$Lisp
+      null?(l) => CONS([sType,entry]$Lisp,tl)$Lisp
+      RPLACD(l,CONS(entry,cdr l)$Lisp)$Lisp
+      tl
+
+    newTypeLists(tab:$):SEX ==
+      tl := []$Lisp
+      for u in keys(tab)$Rep repeat
+        uType : FortranType := fortranTypeOf(u,tab)
+        sType : FSTU := scalarTypeOf(uType)
+        dims  : L Polynomial Integer := dimensionsOf uType
+        lDims : L SEX := [convert(convert(v)@InputForm)@SEX for v in dims]
+        lType : SEX := if sType case void 
+          then convert(void::Symbol)@SEX 
+          else coerce(sType.fst)$FortranScalarType
+        tl := updateList(lType,convert(u)@SEX,convert(lDims)@SEX,tl)
+      tl
+
+    typeLists(tab:$):L(TL) ==
+      fortranTypes := ["real"::FortranScalarType, _
+             "double precision"::FortranScalarType, _
+             "integer"::FortranScalarType, _
+             "complex"::FortranScalarType, _
+             "logical"::FortranScalarType, _
+             "character"::FortranScalarType]@L(FortranScalarType)
+      tl := []@L TL
+      for u in fortranTypes repeat
+        types : TL := typeList2(u,tab)
+        if (not null types) then 
+          tl := cons(types,tl)$(L TL)
+      tl
+
+    oForm2(w:T):OFORM ==
+      w case S => w.S::OFORM
+      w case P => w.P::OFORM
+
+    oForm(v:TU):OFORM ==
+      v case name => v.name::OFORM
+      v case bounds =>
+        ll : L OFORM := [oForm2(uu) for uu in v.bounds]
+        ll :: OFORM
+
+    outForm(t:TL):L OFORM ==
+     [oForm(u) for u in t]
+
+    printTypes(tab:$):Void ==
+      -- It is important that INTEGER is the first element of this
+      -- list since INTEGER symbols used in type declarations must
+      -- be declared in advance.
+      ft := ["integer"::FortranScalarType, _
+             "real"::FortranScalarType, _
+             "double precision"::FortranScalarType, _
+             "complex"::FortranScalarType, _
+             "logical"::FortranScalarType, _
+             "character"::FortranScalarType]@L(FortranScalarType)
+      for ty in ft repeat
+        tl : TL := typeList(ty,tab)
+        otl : L OFORM := outForm(tl)
+        fortFormatTypes(ty::OFORM,otl)$Lisp
+      el : L OFORM := [u::OFORM for u in externalList(tab)]
+      fortFormatTypes("EXTERNAL"::OFORM,el)$Lisp
+      void()$Void
+
 *)
 
 \end{chunk}
@@ -154137,28 +190850,31 @@ o )show SymmetricPolynomial
 ++ This domain implements symmetric polynomial
 
 SymmetricPolynomial(R:Ring) == PolynomialRing(R,Partition) add
+
        Term:=  Record(k:Partition,c:R)
+
        Rep:=  List Term
 
--- override PR implementation because coeff. arithmetic too expensive (??)
+       -- override PR implementation because coeff. arithmetic too expensive
 
        if R has EntireRing then
+
          (p1:%) * (p2:%)  ==
             null p1 => 0
             null p2 => 0
             zero?(p1.first.k) => p1.first.c * p2
---            one? p2 => p1
             (p2 = 1) => p1
             +/[[[t1.k+t2.k,t1.c*t2.c]$Term for t2 in p2]
                    for t1 in reverse(p1)]
                    -- This 'reverse' is an efficiency improvement:
                    -- reduces both time and space [Abbott/Bradford/Davenport]
+
         else
+
          (p1:%) * (p2:%)  ==
             null p1 => 0
             null p2 => 0
             zero?(p1.first.k) => p1.first.c * p2
---            one? p2 => p1
             (p2 = 1) => p1
             +/[[[t1.k+t2.k,r]$Term for t2 in p2 | (r:=t1.c*t2.c) ^= 0]
                  for t1 in reverse(p1)]
@@ -154170,6 +190886,38 @@ SymmetricPolynomial(R:Ring) == PolynomialRing(R,Partition) add
 \begin{chunk}{COQ SYMPOLY}
 (* domain SYMPOLY *)
 (*
+ PolynomialRing(R,Partition) add
+
+       Term:=  Record(k:Partition,c:R)
+
+       Rep:=  List Term
+
+       -- override PR implementation because coeff. arithmetic too expensive
+
+       if R has EntireRing then
+
+         (p1:%) * (p2:%)  ==
+            null p1 => 0
+            null p2 => 0
+            zero?(p1.first.k) => p1.first.c * p2
+            (p2 = 1) => p1
+            +/[[[t1.k+t2.k,t1.c*t2.c]$Term for t2 in p2]
+                   for t1 in reverse(p1)]
+                   -- This 'reverse' is an efficiency improvement:
+                   -- reduces both time and space [Abbott/Bradford/Davenport]
+
+        else
+
+         (p1:%) * (p2:%)  ==
+            null p1 => 0
+            null p2 => 0
+            zero?(p1.first.k) => p1.first.c * p2
+            (p2 = 1) => p1
+            +/[[[t1.k+t2.k,r]$Term for t2 in p2 | (r:=t1.c*t2.c) ^= 0]
+                 for t1 in reverse(p1)]
+                  -- This 'reverse' is an efficiency improvement:
+                  -- reduces both time and space [Abbott/Bradford/Davenport]
+
 *)
 
 \end{chunk}
@@ -154757,12 +191505,15 @@ Tableau(S:SetCategory):Exports == Implementation where
     Rep := L L S
 
     tableau(lls:(L L S)) == lls pretend %
+
     listOfLists(x:%):(L L S) == x pretend (L L S)
+
     makeupv : (NNI,L S) -> L OUT
     makeupv(n,ls)==
         v:=new(n,message " ")$(List OUT)
         for i in 1..#ls for s in  ls repeat v.i:=box(s::OUT)
         v
+
     maketab : L L S -> OUT
     maketab lls ==
       ll :  L OUT :=
@@ -154778,6 +191529,29 @@ Tableau(S:SetCategory):Exports == Implementation where
 \begin{chunk}{COQ TABLEAU}
 (* domain TABLEAU *)
 (*
+
+    Rep := L L S
+
+    tableau(lls:(L L S)) == lls pretend %
+
+    listOfLists(x:%):(L L S) == x pretend (L L S)
+
+    makeupv : (NNI,L S) -> L OUT
+    makeupv(n,ls)==
+        v:=new(n,message " ")$(List OUT)
+        for i in 1..#ls for s in  ls repeat v.i:=box(s::OUT)
+        v
+
+    maketab : L L S -> OUT
+    maketab lls ==
+      ll :  L OUT :=
+        empty? lls => [[empty()]]
+        sz:NNI:=# first lls
+        [blankSeparate makeupv(sz,i) for i in lls]
+      pile ll
+
+    coerce(x:%):OUT == maketab listOfLists x
+
 *)
 
 \end{chunk}
@@ -155035,6 +191809,7 @@ TaylorSeries(Coef): Exports == Implementation where
         ++ The evaluation of \spad{f()} is delayed.
  
   Implementation ==> SparseMultivariateTaylorSeries(Coef,Symbol,SMP) add
+
     Rep := StS -- Below we use the fact that Rep of PS is Stream SMP.
  
     polynomial(s,n) ==
@@ -155049,6 +191824,17 @@ TaylorSeries(Coef): Exports == Implementation where
 \begin{chunk}{COQ TS}
 (* domain TS *)
 (*
+ SparseMultivariateTaylorSeries(Coef,Symbol,SMP) add
+
+    Rep := StS -- Below we use the fact that Rep of PS is Stream SMP.
+ 
+    polynomial(s,n) ==
+      sum : SMP := 0
+      for i in 0..n while not empty? s repeat
+        sum := sum + frst s
+        s:= rst s
+      sum
+
 *)
 
 \end{chunk}
@@ -155360,6 +192146,7 @@ TexFormat(): public == private where
       ++ to strings.
 
   private == add
+
     import OutputForm
     import Character
     import Integer
@@ -155406,6 +192193,7 @@ TexFormat(): public == private where
       ["cos", "cot", "csc", "log", "sec", "sin", "tan",
         "cosh", "coth", "csch", "sech", "sinh", "tanh",
           "acos","asin","atan","erf","...","$","infinity"]
+
     specialStringsInTeX : L S :=
       ["\cos","\cot","\csc","\log","\sec","\sin","\tan",
         "\cosh","\coth","\csch","\sech","\sinh","\tanh",
@@ -155524,7 +192312,8 @@ TexFormat(): public == private where
         -- of a line has the "\" erased when printed
 
         if ( line.1 = char "%" ) then line := concat(" \", line)
-        else if ( line.1 = char "\" ) and length > 1 and ( line.2 = char "%" ) then
+        else if ( line.1 = char "\" ) and length > 1 _
+                                      and ( line.2 = char "%" ) then
           line := concat(" ", line)
 
         lines := concat(line,lines)$List(S)
@@ -155867,6 +192656,511 @@ TexFormat(): public == private where
 \begin{chunk}{COQ TEX}
 (* domain TEX *)
 (*
+
+    import OutputForm
+    import Character
+    import Integer
+    import List OutputForm
+    import List String
+
+    Rep := Record(prolog : L S, TeX : L S, epilog : L S)
+
+    -- local variables declarations and definitions
+
+    expr: E
+    prec,opPrec: I
+    str:  S
+    blank         : S := " \  "
+
+    maxPrec       : I   := 1000000
+    minPrec       : I   := 0
+
+    unaryOps      : L S := ["-","^"]$(L S)
+    unaryPrecs    : L I := [700,260]$(L I)
+
+    -- the precedence of / in the following is relatively low because
+    -- the bar obviates the need for parentheses.
+    binaryOps     : L S := ["+->","|","**","/","<",">","=","OVER"]$(L S)
+    binaryPrecs   : L I := [0,0,900, 700,400,400,400,   700]$(L I)
+
+    naryOps       : L S := ["-","+","*",blank,",",";"," ","ROW","",
+       " \cr ","&"," \\ "]$(L S)
+    naryPrecs     : L I := [700,700,800,  800,110,110,  0,    0, 0,
+             0,  0,   0]$(L I)
+    naryNGOps     : L S := ["ROW","&"]$(L S)
+
+\getchunk{product(product(i*j,i=a..b),j=c..d) fix}
+
+    specialOps    : L S := ["MATRIX","BRACKET","BRACE","CONCATB","VCONCAT",  _
+                            "AGGLST","CONCAT","OVERBAR","ROOT","SUB","TAG", _
+                            "SUPERSUB","ZAG","AGGSET","SC","PAREN", _
+                            "SEGMENT","QUOTE","theMap" ]
+
+    -- the next two lists provide translations for some strings for
+    -- which TeX provides special macros.
+
+    specialStrings : L S :=
+      ["cos", "cot", "csc", "log", "sec", "sin", "tan",
+        "cosh", "coth", "csch", "sech", "sinh", "tanh",
+          "acos","asin","atan","erf","...","$","infinity"]
+
+    specialStringsInTeX : L S :=
+      ["\cos","\cot","\csc","\log","\sec","\sin","\tan",
+        "\cosh","\coth","\csch","\sech","\sinh","\tanh",
+          "\arccos","\arcsin","\arctan","\erf","\ldots","\$","\infty"]
+
+    -- local function signatures
+
+    addBraces:      S -> S
+    addBrackets:    S -> S
+    group:          S -> S
+    formatBinary:   (S,L E, I) -> S
+    formatFunction: (S,L E, I) -> S
+    formatMatrix:   L E -> S
+    formatNary:     (S,L E, I) -> S
+    formatNaryNoGroup: (S,L E, I) -> S
+    formatNullary:  S -> S
+    formatPlex:     (S,L E, I) -> S
+    formatSpecial:  (S,L E, I) -> S
+    formatUnary:    (S,  E, I) -> S
+    formatTex:      (E,I) -> S
+    newWithNum:     I -> $
+    parenthesize:   S -> S
+    precondition:   E -> E
+    postcondition:  S -> S
+    splitLong:      (S,I) -> L S
+    splitLong1:     (S,I) -> L S
+    stringify:      E -> S
+    ungroup:        S -> S
+
+    -- public function definitions
+
+    new() : $ ==
+      [["$$"]$(L S), [""]$(L S), ["$$"]$(L S)]$Rep
+
+    newWithNum(stepNum: I) : $ ==
+      num : S := concat(concat("\leqno(",string(stepNum)$S),")")$S
+      [["$$"]$(L S), [""]$(L S), [num,"$$"]$(L S)]$Rep
+
+    coerce(expr : E): $ ==
+      f : $ := new()$$
+      f.TeX := [postcondition
+        formatTex(precondition expr, minPrec)]$(L S)
+      f
+
+    convert(expr : E, stepNum : I): $ ==
+      f : $ := newWithNum(stepNum)
+      f.TeX := [postcondition
+        formatTex(precondition expr, minPrec)]$(L S)
+      f
+
+    display(f : $, len : I) ==
+      s,t : S
+      for s in f.prolog repeat sayTeX$Lisp s
+      for s in f.TeX repeat
+        for t in splitLong(s, len) repeat sayTeX$Lisp t
+      for s in f.epilog repeat sayTeX$Lisp s
+      void()$Void
+
+    display(f : $) ==
+      display(f, _$LINELENGTH$Lisp pretend I)
+
+    prologue(f : $) == f.prolog
+    tex(f : $)  == f.TeX
+    epilogue(f : $) == f.epilog
+
+    setPrologue!(f : $, l : L S) == f.prolog := l
+    setTex!(f : $, l : L S)  == f.TeX := l
+    setEpilogue!(f : $, l : L S) == f.epilog := l
+
+    coerce(f : $): E ==
+      s,t : S
+      l : L S := nil
+      for s in f.prolog repeat l := concat(s,l)
+      for s in f.TeX repeat
+        for t in splitLong(s, (_$LINELENGTH$Lisp pretend Integer) - 4) repeat
+          l := concat(t,l)
+      for s in f.epilog repeat l := concat(s,l)
+      (reverse l) :: E
+
+    -- local function definitions
+
+    ungroup(str: S): S ==
+      len : I := #str
+      len < 2 => str
+      lbrace : Character := char "{"
+      rbrace : Character := char "}"
+      -- drop leading and trailing braces
+      if (str.1 =$Character lbrace) and (str.len =$Character rbrace) then
+        u : US := segment(2,len-1)$US
+        str := str.u
+      str
+
+    postcondition(str: S): S ==
+      str := ungroup str
+      len : I := #str
+      plus : Character := char "+"
+      minus: Character := char "-"
+      len < 4 => str
+      for i in 1..(len-1) repeat
+        if (str.i =$Character plus) and (str.(i+1) =$Character minus)
+          then setelt(str,i,char " ")$S
+      str
+
+    stringify expr == (mathObject2String$Lisp expr)@S
+
+    lineConcat( line : S, lines: L S ) : L S ==
+      length := #line
+
+      if ( length > 0 ) then
+        -- If the last character is a backslash then split at "\ ".
+        -- Reinstate the blank.
+
+        if (line.length = char "\" ) then line := concat(line, " ")
+
+        -- Remark: for some reason, "\%" at the beginning
+        -- of a line has the "\" erased when printed
+
+        if ( line.1 = char "%" ) then line := concat(" \", line)
+        else if ( line.1 = char "\" ) and length > 1 _
+                                      and ( line.2 = char "%" ) then
+          line := concat(" ", line)
+
+        lines := concat(line,lines)$List(S)
+      lines
+
+    splitLong(str : S, len : I): L S ==
+      -- this blocks into lines
+      if len < 20 then len := _$LINELENGTH$Lisp
+      splitLong1(str, len)
+
+    splitLong1(str : S, len : I) ==
+      -- We first build the list of lines backwards and then we
+      -- reverse it.
+
+      l : List S := nil
+      s : S := ""
+      ls : I := 0
+      ss : S
+      lss : I
+      for ss in split(str,char " ") repeat
+        -- have the newline macro end a line (even if it means the line
+        -- is slightly too long)
+
+        ss = "\\" =>
+          l := lineConcat( concat(s,ss), l )
+          s := ""
+          ls := 0
+
+        lss := #ss
+
+        -- place certain tokens on their own lines for clarity
+
+        ownLine : Boolean :=
+          u : US := segment(1,4)$US
+          (lss > 3) and ("\end" = ss.u) => true
+          u      := segment(1,5)$US
+          (lss > 4) and ("\left" = ss.u) => true
+          u      := segment(1,6)$US
+          (lss > 5) and (("\right" = ss.u) or ("\begin" = ss.u)) => true
+          false
+
+        if ownLine or (ls + lss > len) then
+          if not empty? s then l := lineConcat( s, l )
+          s := ""
+          ls := 0
+
+        ownLine or lss > len => l := lineConcat( ss, l )
+
+        (lss = 1) and (ss.1 = char "\") =>
+          ls := ls + lss + 2
+          s := concat(s,concat(ss,"  ")$S)$S
+
+        ls := ls + lss + 1
+        s := concat(s,concat(ss," ")$S)$S
+
+      if ls > 0 then l := lineConcat( s, l )
+
+      reverse l
+
+    group str ==
+      concat ["{",str,"}"]
+
+    addBraces str ==
+      concat ["\left\{ ",str," \right\}"]
+
+    addBrackets str ==
+      concat ["\left[ ",str," \right]"]
+
+    parenthesize str ==
+      concat ["\left( ",str," \right)"]
+
+    precondition expr ==
+      outputTran$Lisp expr
+
+    formatSpecial(op : S, args : L E, prec : I) : S ==
+      arg : E
+      prescript : Boolean := false
+      op = "theMap" => "\mbox{theMap(...)}"
+      op = "AGGLST" =>
+        formatNary(",",args,prec)
+      op = "AGGSET" =>
+        formatNary(";",args,prec)
+      op = "TAG" =>
+        group concat [formatTex(first args,prec),
+                      "\rightarrow",
+                       formatTex(second args,prec)]
+      op = "VCONCAT" =>
+        group concat("\begin{array}{c}",
+                     concat(concat([concat(formatTex(u, minPrec),"\\")
+                                    for u in args]::L S),
+                            "\end{array}"))
+      op = "CONCATB" =>
+        formatNary(" ",args,prec)
+      op = "CONCAT" =>
+        formatNary("",args,minPrec)
+      op = "QUOTE" =>
+        group concat("{\tt '}",formatTex(first args, minPrec))
+      op = "BRACKET" =>
+        group addBrackets ungroup formatTex(first args, minPrec)
+      op = "BRACE" =>
+        group addBraces ungroup formatTex(first args, minPrec)
+      op = "PAREN" =>
+        group parenthesize ungroup formatTex(first args, minPrec)
+      op = "OVERBAR" =>
+        null args => ""
+        group concat ["\overline ",formatTex(first args, minPrec)]
+      op = "ROOT" =>
+        null args => ""
+        tmp : S := group formatTex(first args, minPrec)
+        null rest args => group concat ["\sqrt ",tmp]
+        group concat
+          ["\root ",group formatTex(first rest args, minPrec)," \of ",tmp]
+      op = "SEGMENT" =>
+        tmp : S := concat [formatTex(first args, minPrec),".."]
+        group
+          null rest args =>  tmp
+          concat [tmp,formatTex(first rest args, minPrec)]
+      op = "SUB" =>
+        group concat [formatTex(first args, minPrec)," \sb ",
+          formatSpecial("AGGLST",rest args,minPrec)]
+      op = "SUPERSUB" =>
+        -- variable name
+        form : List S := [formatTex(first args, minPrec)]
+        -- subscripts
+        args := rest args
+        null args => concat(form)$S
+        tmp : S := formatTex(first args, minPrec)
+        if (tmp ^= "") and (tmp ^= "{}") and (tmp ^= " ") then
+          form := append(form,[" \sb ",group tmp])$(List S)
+        -- superscripts
+        args := rest args
+        null args => group concat(form)$S
+        tmp : S := formatTex(first args, minPrec)
+        if (tmp ^= "") and (tmp ^= "{}") and (tmp ^= " ") then
+          form := append(form,[" \sp ",group tmp])$(List S)
+        -- presuperscripts
+        args := rest args
+        null args => group concat(form)$S
+        tmp : S := formatTex(first args, minPrec)
+        if (tmp ^= "") and (tmp ^= "{}") and (tmp ^= " ") then
+          form := append([" \sp ",group tmp],form)$(List S)
+          prescript := true
+        -- presubscripts
+        args := rest args
+        null args =>
+          group concat
+            prescript => cons("{}",form)
+            form
+        tmp : S := formatTex(first args, minPrec)
+        if (tmp ^= "") and (tmp ^= "{}") and (tmp ^= " ") then
+          form := append([" \sb ",group tmp],form)$(List S)
+          prescript := true
+        group concat
+          prescript => cons("{}",form)
+          form
+      op = "SC" =>
+        -- need to handle indentation someday
+        null args => ""
+        tmp := formatNaryNoGroup(" \\ ", args, minPrec)
+        group concat ["\begin{array}{l} ",tmp," \end{array} "]
+      op = "MATRIX" => formatMatrix rest args
+      op = "ZAG" =>
+        concat [" \zag{",formatTex(first args, minPrec),"}{",
+          formatTex(first rest args,minPrec),"}"]
+      concat ["not done yet for ",op]
+
+    formatPlex(op : S, args : L E, prec : I) : S ==
+      hold : S
+      p : I := position(op,plexOps)
+      p < 1 => error "unknown Tex unary op"
+      opPrec := plexPrecs.p
+      n : I := #args
+      (n ^= 2) and (n ^= 3) => error "wrong number of arguments for plex"
+      s : S :=
+        op = "SIGMA"   => "\sum"
+        op = "SIGMA2"   => "\sum"
+        op = "PI"      => "\prod"
+\getchunk{define PI2}
+        op = "INTSIGN" => "\int"
+        op = "INDEFINTEGRAL" => "\int"
+        "????"
+      hold := formatTex(first args,minPrec)
+      args := rest args
+      if op ^= "INDEFINTEGRAL" then
+        if hold ^= "" then
+          s := concat [s," \sb",group concat ["\displaystyle ",hold]]
+        if not null rest args then
+          hold := formatTex(first args,minPrec)
+          if hold ^= "" then
+            s := concat [s," \sp",group concat ["\displaystyle ",hold]]
+          args := rest args
+        s := concat [s," ",formatTex(first args,minPrec)]
+      else
+        hold := group concat [hold," ",formatTex(first args,minPrec)]
+        s := concat [s," ",hold]
+      if opPrec < prec then s := parenthesize s
+      group s
+
+    formatMatrix(args : L E) : S ==
+      -- format for args is [[ROW ...],[ROW ...],[ROW ...]]
+      -- generate string for formatting columns (centered)
+      cols : S := "{"
+      for i in 2..#(first(args) pretend L E) repeat
+        cols := concat(cols,"c")
+      cols := concat(cols,"} ")
+      group addBrackets concat
+        ["\begin{array}",cols,formatNaryNoGroup(" \\ ",args,minPrec),
+          " \end{array} "]
+
+    formatFunction(op : S, args : L E, prec : I) : S ==
+      group concat [op, " ", parenthesize formatNary(",",args,minPrec)]
+
+    formatNullary(op : S) ==
+      op = "NOTHING" => ""
+      group concat [op,"()"]
+
+    formatUnary(op : S, arg : E, prec : I) ==
+      p : I := position(op,unaryOps)
+      p < 1 => error "unknown Tex unary op"
+      opPrec := unaryPrecs.p
+      s : S := concat [op,formatTex(arg,opPrec)]
+      opPrec < prec => group parenthesize s
+      op = "-" => s
+      group s
+
+    formatBinary(op : S, args : L E, prec : I) : S ==
+      p : I := position(op,binaryOps)
+      p < 1 => error "unknown Tex binary op"
+      op :=
+        op = "|"     => " \mid "
+        op = "**"    => " \sp "
+        op = "/"     => " \over "
+        op = "OVER"  => " \over "
+        op = "+->"   => " \mapsto "
+        op
+      opPrec := binaryPrecs.p
+      s : S := formatTex(first args, opPrec)
+      if op = " \over " then
+        s := concat [" \frac{",s,"}{",formatTex(first rest args, opPrec),"}"]
+      else if op = " \sp " then
+        s := concat [s,"^",formatTex(first rest args, opPrec)]
+      else
+        s := concat [s,op,formatTex(first rest args, opPrec)]
+      group
+        op = " \over " => s
+        opPrec < prec => parenthesize s
+        s
+
+    formatNary(op : S, args : L E, prec : I) : S ==
+      group formatNaryNoGroup(op, args, prec)
+
+    formatNaryNoGroup(op : S, args : L E, prec : I) : S ==
+      null args => ""
+      p : I := position(op,naryOps)
+      p < 1 => error "unknown Tex nary op"
+      op :=
+        op = ","     => ", \: "
+        op = ";"     => "; \: "
+        op = "*"     => blank
+        op = " "     => " \ "
+        op = "ROW"   => " & "
+        op
+      l : L S := nil
+      opPrec := naryPrecs.p
+      for a in args repeat
+        l := concat(op,concat(formatTex(a,opPrec),l)$L(S))$L(S)
+      s : S := concat reverse rest l
+      opPrec < prec => parenthesize s
+      s
+
+    formatTex(expr,prec) ==
+      i,len : Integer
+      intSplitLen : Integer := 20
+      ATOM(expr)$Lisp pretend Boolean =>
+        str := stringify expr
+        len := #str
+        INTEGERP$Lisp expr =>
+          i := expr pretend Integer
+          if (i < 0) or (i > 9)
+            then
+              group
+                 nstr : String := ""
+                 -- insert some blanks into the string, if too long
+                 while ((len := #str) > intSplitLen) repeat
+                   nstr := concat [nstr," ",
+                     elt(str,segment(1,intSplitLen)$US)]
+                   str := elt(str,segment(intSplitLen+1)$US)
+                 empty? nstr => str
+                 nstr :=
+                   empty? str => nstr
+                   concat [nstr," ",str]
+                 elt(nstr,segment(2)$US)
+            else str
+        str = "%pi" => "\pi"
+        str = "%e"  => "e"
+        str = "%i"  => "i"
+        len > 1 and str.1 = char "%" and str.2 = char "%" =>
+          u : US := segment(3,len)$US
+          concat(" \%\%",str.u)
+        len > 0 and str.1 = char "%" => concat(" \",str)
+        len > 1 and digit? str.1 => group str -- should handle floats
+        len > 0 and str.1 = char "_"" =>
+          concat(concat(" \mbox{\tt ",str),"} ")
+        len = 1 and str.1 = char " " => "{\ }"
+        (i := position(str,specialStrings)) > 0 =>
+          specialStringsInTeX.i
+        (i := position(char " ",str)) > 0 =>
+          -- We want to preserve spacing, so use a roman font.
+          concat(concat(" \mbox{\rm ",str),"} ")
+        str
+      l : L E := (expr pretend L E)
+      null l => blank
+      op : S := stringify first l
+      args : L E := rest l
+      nargs : I := #args
+
+      -- special cases
+      member?(op, specialOps) => formatSpecial(op,args,prec)
+      member?(op, plexOps)    => formatPlex(op,args,prec)
+
+      -- nullary case
+      0 = nargs => formatNullary op
+
+      -- unary case
+      (1 = nargs) and member?(op, unaryOps) =>
+        formatUnary(op, first args, prec)
+
+      -- binary case
+      (2 = nargs) and member?(op, binaryOps) =>
+        formatBinary(op, args, prec)
+
+      -- nary case
+      member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec)
+      member?(op,naryOps) => formatNary(op,args, prec)
+      op := formatTex(first l,minPrec)
+      formatFunction(op,args,prec)
+
 *)
 
 \end{chunk}
@@ -156144,6 +193438,7 @@ TextFile: Cat == Def where
           ++ this test is always true.
  
     Def == File(String) add
+
         FileState ==> SExpression
  
         Rep := Record(fileName:   FileName,    _
@@ -156151,6 +193446,7 @@ TextFile: Cat == Def where
                       fileIOmode: String)
  
         read_! f      == readLine_! f
+
         readIfCan_! f == readLineIfCan_! f
  
         readLine_! f ==
@@ -156158,24 +193454,29 @@ TextFile: Cat == Def where
             s: String := read_-line(f.fileState)$Lisp
             PLACEP(s)$Lisp => error "End of file"
             s
+
         readLineIfCan_! f ==
             f.fileIOmode ^= "input"  => error "File not in read state"
             s: String := read_-line(f.fileState)$Lisp
             PLACEP(s)$Lisp => "failed"
             s
+
         write_!(f, x) ==
             f.fileIOmode ^= "output" => error "File not in write state"
             PRINC(x, f.fileState)$Lisp
             x
+
         writeLine_! f ==
             f.fileIOmode ^= "output" => error "File not in write state"
             TERPRI(f.fileState)$Lisp
             ""
+
         writeLine_!(f, x) ==
             f.fileIOmode ^= "output" => error "File not in write state"
             PRINC(x, f.fileState)$Lisp
             TERPRI(f.fileState)$Lisp
             x
+
         endOfFile? f ==
           f.fileIOmode = "output" => false
           (EOFP(f.fileState)$Lisp pretend Boolean) => true
@@ -156186,6 +193487,50 @@ TextFile: Cat == Def where
 \begin{chunk}{COQ TEXTFILE}
 (* domain TEXTFILE *)
 (*
+
+        FileState ==> SExpression
+ 
+        Rep := Record(fileName:   FileName,    _
+                      fileState:  FileState,   _
+                      fileIOmode: String)
+ 
+        read_! f      == readLine_! f
+
+        readIfCan_! f == readLineIfCan_! f
+ 
+        readLine_! f ==
+            f.fileIOmode ^= "input"  => error "File not in read state"
+            s: String := read_-line(f.fileState)$Lisp
+            PLACEP(s)$Lisp => error "End of file"
+            s
+
+        readLineIfCan_! f ==
+            f.fileIOmode ^= "input"  => error "File not in read state"
+            s: String := read_-line(f.fileState)$Lisp
+            PLACEP(s)$Lisp => "failed"
+            s
+
+        write_!(f, x) ==
+            f.fileIOmode ^= "output" => error "File not in write state"
+            PRINC(x, f.fileState)$Lisp
+            x
+
+        writeLine_! f ==
+            f.fileIOmode ^= "output" => error "File not in write state"
+            TERPRI(f.fileState)$Lisp
+            ""
+
+        writeLine_!(f, x) ==
+            f.fileIOmode ^= "output" => error "File not in write state"
+            PRINC(x, f.fileState)$Lisp
+            TERPRI(f.fileState)$Lisp
+            x
+
+        endOfFile? f ==
+          f.fileIOmode = "output" => false
+          (EOFP(f.fileState)$Lisp pretend Boolean) => true
+          false
+
 *)
 
 \end{chunk}
@@ -156371,6 +193716,7 @@ TheSymbolTable() : Exports == Implementation where
 
     -- These are the global variables we want to update:
     theSymbolTable : $ := empty()$Rep
+
     currentSubProgramName : Symbol := MAIN
 
     newEntry():Entry ==
@@ -156410,10 +193756,10 @@ TheSymbolTable() : Exports == Implementation where
     currentSubProgram():Symbol ==
       currentSubProgramName
 
-    endSubProgram():Symbol ==
     -- If we want to support more complex languages then we should keep
     -- a list of subprograms / blocks - but for the moment lets stick with
     -- Fortran.
+    endSubProgram():Symbol ==
       currentSubProgramName := MAIN
 
     newSubProgram(u:Symbol):Void ==
@@ -156457,8 +193803,8 @@ TheSymbolTable() : Exports == Implementation where
       declare!(u,type, elt(elt(syms,asp)$Rep,symtab)$Entry)$SymbolTable
 
     declare!(u:Symbol,type:FortranType,asp:Symbol):FortranType ==
-      checkIfEntryExists(asp,theSymbolTable)
-      declare!(u,type,elt(elt(theSymbolTable,asp)$Rep,symtab)$Entry)$SymbolTable
+     checkIfEntryExists(asp,theSymbolTable)
+     declare!(u,type,elt(elt(theSymbolTable,asp)$Rep,symtab)$Entry)$SymbolTable
 
     printHeader(u:Symbol,symbols:$):Void ==
       entry := elt(symbols,u)$Rep
@@ -156480,6 +193826,120 @@ TheSymbolTable() : Exports == Implementation where
 \begin{chunk}{COQ SYMS}
 (* domain SYMS *)
 (*
+
+    Entry : Domain  := Record(symtab:SymbolTable, _
+                              returnType:FSTU, _
+                              argList:List Symbol)
+
+    Rep := Table(Symbol,Entry)
+
+    -- These are the global variables we want to update:
+    theSymbolTable : $ := empty()$Rep
+
+    currentSubProgramName : Symbol := MAIN
+
+    newEntry():Entry ==
+      construct(empty()$SymbolTable,["void"]$FSTU,[]::List(Symbol))$Entry
+
+    checkIfEntryExists(name:Symbol,tab:$) : Void ==
+      key?(name,tab) => void()$Void
+      setelt(tab,name,newEntry())$Rep
+      void()$Void
+
+    returnTypeOf(name:Symbol,tab:$):FSTU ==
+      elt(elt(tab,name)$Rep,returnType)$Entry
+
+    argumentListOf(name:Symbol,tab:$):List(Symbol) ==
+      elt(elt(tab,name)$Rep,argList)$Entry
+
+    symbolTableOf(name:Symbol,tab:$):SymbolTable ==
+      elt(elt(tab,name)$Rep,symtab)$Entry
+
+    coerce(u:$):OutputForm ==
+      coerce(u)$Rep
+
+    showTheSymbolTable():$ ==
+      theSymbolTable
+
+    clearTheSymbolTable():Void ==
+      theSymbolTable := empty()$Rep
+      void()$Void
+
+    clearTheSymbolTable(u:Symbol):Void ==
+      remove!(u,theSymbolTable)$Rep
+      void()$Void
+
+    empty():$ ==
+      empty()$Rep
+
+    currentSubProgram():Symbol ==
+      currentSubProgramName
+
+    -- If we want to support more complex languages then we should keep
+    -- a list of subprograms / blocks - but for the moment lets stick with
+    -- Fortran.
+    endSubProgram():Symbol ==
+      currentSubProgramName := MAIN
+
+    newSubProgram(u:Symbol):Void ==
+      setelt(theSymbolTable,u,newEntry())$Rep
+      currentSubProgramName := u
+      void()$Void
+
+    argumentList!(u:Symbol,args:List Symbol,symbols:$):Void ==
+      checkIfEntryExists(u,symbols)
+      setelt(elt(symbols,u)$Rep,argList,args)$Entry
+
+    argumentList!(u:Symbol,args:List Symbol):Void ==
+      argumentList!(u,args,theSymbolTable)
+
+    argumentList!(args:List Symbol):Void ==
+      checkIfEntryExists(currentSubProgramName,theSymbolTable)
+      setelt(elt(theSymbolTable,currentSubProgramName)$Rep, _
+             argList,args)$Entry
+
+    returnType!(u:Symbol,type:FSTU,symbols:$):Void ==
+      checkIfEntryExists(u,symbols)
+      setelt(elt(symbols,u)$Rep,returnType,type)$Entry
+
+    returnType!(u:Symbol,type:FSTU):Void ==
+      returnType!(u,type,theSymbolTable)
+
+    returnType!(type:FSTU ):Void ==
+      checkIfEntryExists(currentSubProgramName,theSymbolTable)
+      setelt(elt(theSymbolTable,currentSubProgramName)$Rep, _
+             returnType,type)$Entry
+
+    declare!(u:Symbol,type:FortranType):FortranType ==
+      declare!(u,type,currentSubProgramName,theSymbolTable)
+
+    declare!(u:Symbol,type:FortranType,asp:Symbol,symbols:$):FortranType ==
+      checkIfEntryExists(asp,symbols)
+      declare!(u,type, elt(elt(symbols,asp)$Rep,symtab)$Entry)$SymbolTable
+
+    declare!(u:List Symbol,type:FortranType,asp:Symbol,syms:$):FortranType ==
+      checkIfEntryExists(asp,syms)
+      declare!(u,type, elt(elt(syms,asp)$Rep,symtab)$Entry)$SymbolTable
+
+    declare!(u:Symbol,type:FortranType,asp:Symbol):FortranType ==
+     checkIfEntryExists(asp,theSymbolTable)
+     declare!(u,type,elt(elt(theSymbolTable,asp)$Rep,symtab)$Entry)$SymbolTable
+
+    printHeader(u:Symbol,symbols:$):Void ==
+      entry := elt(symbols,u)$Rep
+      fortFormatHead(elt(entry,returnType)$Entry::OutputForm,u::OutputForm, _
+                     elt(entry,argList)$Entry::OutputForm)$Lisp
+      printTypes(elt(entry,symtab)$Entry)$SymbolTable
+
+    printHeader(u:Symbol):Void ==
+      printHeader(u,theSymbolTable)
+
+    printHeader():Void ==
+      printHeader(currentSubProgramName,theSymbolTable)
+
+    printTypes(u:Symbol):Void ==
+      printTypes(elt(elt(theSymbolTable,u)$Rep,symtab)$Entry)$SymbolTable
+
 *)
 
 \end{chunk}
@@ -156629,30 +194089,41 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where
   Exports ==> HomogeneousAggregate(R) with
 
     if R has Ring then
+
       zeroMatrix : (NNI,NNI,NNI) -> $
          ++ zeroMatrix(i,j,k) create a matrix with all zero terms
+
       identityMatrix : (NNI) -> $
          ++ identityMatrix(n) create an identity matrix
          ++ we note that this must be square
+
       plus : ($,$) -> $
          ++ plus(x,y) adds two matrices, term by term
          ++ we note that they must be the same size
+
     construct : (L L L R) -> $
-       ++ construct(lll) creates a 3-D matrix from a List List List R lll
+      ++ construct(lll) creates a 3-D matrix from a List List List R lll
+
     elt : ($,NNI,NNI,NNI) -> R
-       ++ elt(x,i,j,k) extract an element from the matrix x
+      ++ elt(x,i,j,k) extract an element from the matrix x
+
     setelt! :($,NNI,NNI,NNI,R) -> R
-       ++ setelt!(x,i,j,k,s) (or x.i.j.k:=s) sets a specific element of the array to some value of type R
+      ++ setelt!(x,i,j,k,s) (or x.i.j.k:=s) sets a specific element 
+      ++ of the array to some value of type R
+
     coerce : (PA PA PA R) -> $
-       ++ coerce(p) moves from the representation type
-       ++ (PrimitiveArray  PrimitiveArray  PrimitiveArray R)
-       ++ to the domain
+      ++ coerce(p) moves from the representation type
+      ++ (PrimitiveArray  PrimitiveArray  PrimitiveArray R) to the domain
+
     coerce : $ -> (PA PA PA R)
-            ++ coerce(x) moves from the domain to the representation type
+      ++ coerce(x) moves from the domain to the representation type
+
     matrixConcat3D : (Symbol,$,$) -> $
-         ++ matrixConcat3D(s,x,y) concatenates two 3-D matrices along a specified axis
+      ++ matrixConcat3D(s,x,y) concatenates two 3-D matrices 
+      ++along a specified axis
+
     matrixDimensions : $ -> Vector NNI
-         ++ matrixDimensions(x) returns the dimensions of a matrix
+      ++ matrixDimensions(x) returns the dimensions of a matrix
 
   Implementation ==>  (PA PA PA R) add
 
@@ -156741,8 +194212,215 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where
       iLength := matDims.1
       jLength := matDims.2
       kLength := matDims.3
-      ((i > iLength) or (j > jLength) or (k > kLength) or (i=0) or (j=0) or_
-(k=0)) => error "coordinates must be within the bounds of the matrix"
+      ((i > iLength) or (j > jLength) or (k > kLength) or (i=0) _
+                     or (j=0) or (k=0)) => _
+         error "coordinates must be within the bounds of the matrix"
+      matrixRep : PA PA PA R := mat :: (PA PA PA R)
+      elt(elt(elt(matrixRep,i-1)$(PA PA PA R),j-1)$(PA PA R),k-1)$(PA R)
+
+    setelt!(mat : $,i : NNI,j : NNI,k : NNI,val : R)_
+       : R ==
+      matDims := matrixDimensions(mat)
+      iLength := matDims.1
+      jLength := matDims.2
+      kLength := matDims.3
+      ((i > iLength) or (j > jLength) or (k > kLength) or (i=0) _
+                     or (j=0) or (k=0)) => _
+        error "coordinates must be within the bounds of the matrix"
+      matrixRep : PA PA PA R := mat :: (PA PA PA R)
+      row2 : PA PA R := copy(elt(matrixRep,i-1)$(PA PA PA R))$(PA PA R)
+      row1 : PA R := copy(elt(row2,j-1)$(PA PA R))$(PA R)
+      setelt(row1,k-1,val)$(PA R)
+      setelt(row2,j-1,row1)$(PA PA R)
+      setelt(matrixRep,i-1,row2)$(PA PA PA R)
+      val
+
+    if R has Ring then
+
+      zeroMatrix(iLength:NNI,jLength:NNI,kLength:NNI) : $ ==
+        (new(iLength,_
+          new(jLength,_
+           new(kLength,(0$R))$(PA R))$(PA PA R))$(PA PA PA R)) :: $
+
+      identityMatrix(iLength:NNI) : $ ==
+        retValueRep : PA PA PA R := _
+          zeroMatrix(iLength,iLength,iLength)$$ :: (PA PA PA R)
+        row1 : PA R
+        row2 : PA PA R
+        row1empty : PA R := new(iLength,0$R)$(PA R)
+        row2empty : PA PA R := new(iLength,copy(row1empty)$(PA R))$(PA PA R)
+        for count in 0..(iLength-1) repeat
+          row1 := copy(row1empty)$(PA R)
+          setelt(row1,count,1$R)$(PA R)
+          row2 := copy(row2empty)$(PA PA R)
+          setelt(row2,count,copy(row1)$(PA R))$(PA PA R)
+          setelt(retValueRep,count,copy(row2)$(PA PA R))$(PA PA PA R)
+        retValueRep :: $
+
+
+      plus(mat1 : $,mat2 :$) : $ ==
+
+        mat1Dims := matrixDimensions(mat1)
+        iLength1 := mat1Dims.1
+        jLength1 := mat1Dims.2
+        kLength1 := mat1Dims.3
+
+        mat2Dims := matrixDimensions(mat2)
+        iLength2 := mat2Dims.1
+        jLength2 := mat2Dims.2
+        kLength2 := mat2Dims.3
+
+        -- check that the dimensions are the same
+        (^(iLength1 = iLength2) or ^(jLength1 = jLength2) _
+                                or ^(kLength1 = kLength2))_
+         => error "error the matrices are different sizes"
+
+        sum : R
+        row1 : (PA R) := new(kLength1,0$R)$(PA R)
+        row2 : (PA PA R) := new(jLength1,copy(row1)$(PA R))$(PA PA R)
+        row3 : (PA PA PA R) := new(iLength1,copy(row2)$(PA PA R))$(PA PA PA R)
+
+        for i in 1..iLength1 repeat
+          for j in 1..jLength1 repeat
+            for k in 1..kLength1 repeat
+              sum := (elt(mat1,i,j,k)::R +$R_
+                      elt(mat2,i,j,k)::R)
+              setelt(row1,k-1,sum)$(PA R)
+            setelt(row2,j-1,copy(row1)$(PA R))$(PA PA R)
+          setelt(row3,i-1,copy(row2)$(PA PA R))$(PA PA PA R)
+
+        resultMatrix := (row3 pretend $)
+
+        resultMatrix
+
+    construct(listRep : L L L R) : $ ==
+
+      (#listRep)$(L L L R) = 0 => error "empty list"
+      (#(listRep.1))$(L L R) = 0 => error "empty list"
+      (#((listRep.1).1))$(L R) = 0 => error "empty list"
+      iLength := (#listRep)$(L L L R)
+      jLength := (#(listRep.1))$(L L R)
+      kLength := (#((listRep.1).1))$(L R)
+
+      --first check that the matrix is in the correct form
+      for subList in listRep repeat
+        ^((#subList)$(L L R) = jLength) => error_
+             "can not have an irregular shaped matrix"
+        for subSubList in subList repeat
+          ^((#(subSubList))$(L R) = kLength) => error_
+             "can not have an irregular shaped matrix"
+
+      row1 : (PA R) := new(kLength,((listRep.1).1).1)$(PA R)
+      row2 : (PA PA R) := new(jLength,copy(row1)$(PA R))$(PA PA R)
+      row3 : (PA PA PA R) := new(iLength,copy(row2)$(PA PA R))$(PA PA PA R)
+         
+      for i in 1..iLength repeat
+        for j in 1..jLength repeat
+          for k in 1..kLength repeat
+
+            element := elt(elt(elt(listRep,i)$(L L L R),j)$(L L R),k)$(L R)
+            setelt(row1,k-1,element)$(PA R)
+          setelt(row2,j-1,copy(row1)$(PA R))$(PA PA R)
+        setelt(row3,i-1,copy(row2)$(PA PA R))$(PA PA PA R)
+
+      resultMatrix := (row3 pretend $)
+
+      resultMatrix
+
+\end{chunk}
+
+\begin{chunk}{COQ M3D}
+(* domain M3D *)
+(*
+
+    import (PA PA PA R)
+    import (PA PA R)
+    import (PA R)
+    import R
+
+    matrix1,matrix2,resultMatrix : $
+
+    -- function to concatenate two matrices
+    -- the first argument must be a symbol, which is either i,j or k
+    -- to specify the direction in which the concatenation is to take place
+    matrixConcat3D(dir : Symbol,mat1 : $,mat2 : $) : $ ==
+      ^((dir = (i::Symbol)) or (dir = (j::Symbol)) or (dir = (k::Symbol)))_
+       => error "the axis of concatenation must be i,j or k"
+      mat1Dim := matrixDimensions(mat1)
+      mat2Dim := matrixDimensions(mat2)
+      iDim1 := mat1Dim.1
+      jDim1 := mat1Dim.2
+      kDim1 := mat1Dim.3
+      iDim2 := mat2Dim.1
+      jDim2 := mat2Dim.2
+      kDim2 := mat2Dim.3
+      matRep1 : (PA PA PA R) := copy(mat1 :: (PA PA PA R))$(PA PA PA R)
+      matRep2 : (PA PA PA R) := copy(mat2 :: (PA PA PA R))$(PA PA PA R)
+      retVal : $
+
+      if (dir = (i::Symbol)) then
+        -- j,k dimensions must agree
+        if (^((jDim1 = jDim2) and (kDim1=kDim2)))
+        then
+          error "jxk do not agree"
+        else
+          retVal := (coerce(concat(matRep1,matRep2)$(PA PA PA R))$$)@$
+
+      if (dir = (j::Symbol)) then
+        -- i,k dimensions must agree
+        if (^((iDim1 = iDim2) and (kDim1=kDim2)))
+        then
+          error "ixk do not agree"
+        else
+          for i in 0..(iDim1-1) repeat
+            setelt(matRep1,i,(concat(elt(matRep1,i)$(PA PA PA R)_
+             ,elt(matRep2,i)$(PA PA PA R))$(PA PA R))@(PA PA R))$(PA PA PA R)
+          retVal := (coerce(matRep1)$$)@$
+
+      if (dir = (k::Symbol)) then
+        temp : (PA PA R)
+        -- i,j dimensions must agree
+        if (^((iDim1 = iDim2) and (jDim1=jDim2)))
+        then
+          error "ixj do not agree"
+        else
+          for i in 0..(iDim1-1) repeat
+            temp := copy(elt(matRep1,i)$(PA PA PA R))$(PA PA R)
+            for j in 0..(jDim1-1) repeat
+              setelt(temp,j,concat(elt(elt(matRep1,i)$(PA PA PA R)_
+              ,j)$(PA PA R),elt(elt(matRep2,i)$(PA PA PA R),j)$(PA PA R)_
+              )$(PA R))$(PA PA R)
+            setelt(matRep1,i,temp)$(PA PA PA R)
+          retVal := (coerce(matRep1)$$)@$
+
+      retVal
+
+    matrixDimensions(mat : $) : Vector NNI ==
+      matRep : (PA PA PA R) := mat :: (PA PA PA R)
+      iDim : NNI := (#matRep)$(PA PA PA R)
+      matRep2 : PA PA R := elt(matRep,0)$(PA PA PA R)
+      jDim : NNI := (#matRep2)$(PA PA R)
+      matRep3 : (PA R) := elt(matRep2,0)$(PA PA R)
+      kDim : NNI := (#matRep3)$(PA R)
+      retVal : Vector NNI := new(3,0)$(Vector NNI)
+      retVal.1 := iDim
+      retVal.2 := jDim
+      retVal.3 := kDim
+      retVal
+
+    coerce(matrixRep : (PA PA PA R)) : $ == matrixRep pretend $
+
+    coerce(mat : $) : (PA PA PA R) == mat pretend (PA PA PA R)
+
+    -- i,j,k must be with in the bounds of the matrix
+    elt(mat : $,i : NNI,j : NNI,k : NNI) : R ==
+      matDims := matrixDimensions(mat)
+      iLength := matDims.1
+      jLength := matDims.2
+      kLength := matDims.3
+      ((i > iLength) or (j > jLength) or (k > kLength) or (i=0) _
+                     or (j=0) or (k=0)) => _
+         error "coordinates must be within the bounds of the matrix"
       matrixRep : PA PA PA R := mat :: (PA PA PA R)
       elt(elt(elt(matrixRep,i-1)$(PA PA PA R),j-1)$(PA PA R),k-1)$(PA R)
 
@@ -156752,8 +194430,9 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where
       iLength := matDims.1
       jLength := matDims.2
       kLength := matDims.3
-      ((i > iLength) or (j > jLength) or (k > kLength) or (i=0) or (j=0) or_
-(k=0)) => error "coordinates must be within the bounds of the matrix"
+      ((i > iLength) or (j > jLength) or (k > kLength) or (i=0) _
+                     or (j=0) or (k=0)) => _
+        error "coordinates must be within the bounds of the matrix"
       matrixRep : PA PA PA R := mat :: (PA PA PA R)
       row2 : PA PA R := copy(elt(matrixRep,i-1)$(PA PA PA R))$(PA PA R)
       row1 : PA R := copy(elt(row2,j-1)$(PA PA R))$(PA R)
@@ -156763,11 +194442,15 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where
       val
 
     if R has Ring then
+
       zeroMatrix(iLength:NNI,jLength:NNI,kLength:NNI) : $ ==
-        (new(iLength,new(jLength,new(kLength,(0$R))$(PA R))$(PA PA R))$(PA PA PA R)) :: $
+        (new(iLength,_
+          new(jLength,_
+           new(kLength,(0$R))$(PA R))$(PA PA R))$(PA PA PA R)) :: $
 
       identityMatrix(iLength:NNI) : $ ==
-        retValueRep : PA PA PA R := zeroMatrix(iLength,iLength,iLength)$$ :: (PA PA PA R)
+        retValueRep : PA PA PA R := _
+          zeroMatrix(iLength,iLength,iLength)$$ :: (PA PA PA R)
         row1 : PA R
         row2 : PA PA R
         row1empty : PA R := new(iLength,0$R)$(PA R)
@@ -156794,7 +194477,8 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where
         kLength2 := mat2Dims.3
 
         -- check that the dimensions are the same
-        (^(iLength1 = iLength2) or ^(jLength1 = jLength2) or ^(kLength1 = kLength2))_
+        (^(iLength1 = iLength2) or ^(jLength1 = jLength2) _
+                                or ^(kLength1 = kLength2))_
          => error "error the matrices are different sizes"
 
         sum : R
@@ -156827,10 +194511,10 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where
       --first check that the matrix is in the correct form
       for subList in listRep repeat
         ^((#subList)$(L L R) = jLength) => error_
- "can not have an irregular shaped matrix"
+             "can not have an irregular shaped matrix"
         for subSubList in subList repeat
           ^((#(subSubList))$(L R) = kLength) => error_
- "can not have an irregular shaped matrix"
+             "can not have an irregular shaped matrix"
 
       row1 : (PA R) := new(kLength,((listRep.1).1).1)$(PA R)
       row2 : (PA PA R) := new(jLength,copy(row1)$(PA R))$(PA PA R)
@@ -156849,11 +194533,6 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where
 
       resultMatrix
 
-\end{chunk}
-
-\begin{chunk}{COQ M3D}
-(* domain M3D *)
-(*
 *)
 
 \end{chunk}
@@ -157359,9 +195038,9 @@ ThreeDimensionalViewport(): Exports == Implementation where
     key                   :  %                                       -> I
       ++ key(v) returns the process ID number of the given three-dimensional
       ++ viewport, v, which is of domain \spadtype{ThreeDimensionalViewport}.
---    print                 :  %                                       -> Void
 
   Implementation ==> add
+
     import Color()
     import ViewDefaultsPackage()
     import Plot3D()
@@ -157376,7 +195055,8 @@ ThreeDimensionalViewport(): Exports == Implementation where
     import Set(PositiveInteger)
 
     Rep := Record (key:I, fun:I, _
-                   title:S, moveTo:XYNN, size:XYP, viewpoint:V, colors:H, flags:FLAG, _
+                   title:S, moveTo:XYNN, size:XYP, viewpoint:V, _
+                   colors:H, flags:FLAG, _
                    lighting:LR, perspective:PR, volume:VR, _
                    space3D:SPACE3, _
                    optionsField:L DROP)
@@ -157390,7 +195070,7 @@ ThreeDimensionalViewport(): Exports == Implementation where
     defaultDeltaY : Reference(SF) := ref 0
 
 
---%Local Functions
+    --%Local Functions
     checkViewport (viewport:%):B ==
         -- checks to see if this viewport still exists
         -- by sending the key to the viewport manager and
@@ -157406,7 +195086,8 @@ ThreeDimensionalViewport(): Exports == Implementation where
     
     arcsinTemp(x:SF):SF ==
       -- the asin function doesn't exist in the SF domain currently
-      x >= 1  => (pi()$SF / 2)  -- to avoid floating point error from SF (ie 1.0 -> 1.00001)
+      -- to avoid floating point error from SF (ie 1.0 -> 1.00001)
+      x >= 1  => (pi()$SF / 2)  
       x <= -1 => 3 * pi()$SF / 2
       convert(asin(convert(x)@Float)$Float)@SF
 
@@ -157429,15 +195110,15 @@ ThreeDimensionalViewport(): Exports == Implementation where
           1$SF,1$SF,1$SF,deref defaultDeltaX, deref defaultDeltaY])
         -- etc - 3D specific stuff...
 
---%Exported Functions : Default Settings
+    --%Exported Functions : Default Settings
     viewport3D() ==
       [0,typeVIEW3D,"AXIOM3D",[viewPosDefault().1,viewPosDefault().2], _
        [viewSizeDefault().1,viewSizeDefault().2], _
         [deref defaultTheta,deref defaultPhi,deref defaultZoom, _
-          1$SF,1$SF,1$SF,deref defaultDeltaX, deref defaultDeltaY], [0,27], _
-            [noControl,wireMesh,yes,no,no,no], [0$SF,0$SF,1$SF,0$SF,0$SF,1$SF], _
-              [yes, EYED, HITHER], [0$SF,1$SF,0$SF,1$SF,0$SF,1$SF,no,yes], _
-                create3Space()$SPACE3, [] ]
+         1$SF,1$SF,1$SF,deref defaultDeltaX, deref defaultDeltaY], [0,27], _
+          [noControl,wireMesh,yes,no,no,no], [0$SF,0$SF,1$SF,0$SF,0$SF,1$SF], _
+           [yes, EYED, HITHER], [0$SF,1$SF,0$SF,1$SF,0$SF,1$SF,no,yes], _
+            create3Space()$SPACE3, [] ]
 
     subspace viewport ==
       viewport.space3D
@@ -157466,9 +195147,11 @@ ThreeDimensionalViewport(): Exports == Implementation where
       makeViewport3D v
 
     makeViewport3D viewport ==
-      doOptions viewport --local function to extract and assign optional arguments for 3D viewports
+      --local function to extract and assign optional args for 3D viewports
+      doOptions viewport 
       sayBrightly(["   Transmitting data..."::E]$List(E))$Lisp
-      transform := coord(viewport.optionsField,cartesian$COORDSYS)$DrawOptionFunctions0
+      transform := _
+        coord(viewport.optionsField,cartesian$COORDSYS)$DrawOptionFunctions0
       check(viewport.space3D)
       lpts := lp(viewport.space3D) 
       lllipts  := lllip(viewport.space3D)
@@ -157483,7 +195166,8 @@ ThreeDimensionalViewport(): Exports == Implementation where
       for pt in lpts repeat
         insert_!(dimension pt,s)
       #s > 1 => error "All points should have the same dimension"
-      (n := first parts s) < 3 => error "Dimension of points should be greater than 2"
+      (n := first parts s) < 3 => _
+        error "Dimension of points should be greater than 2"
       sendI(VIEW,viewport.fun)$Lisp
       sendI(VIEW,makeVIEW3D)$Lisp
       sendSTR(VIEW,viewport.title)$Lisp
@@ -157527,41 +195211,53 @@ ThreeDimensionalViewport(): Exports == Implementation where
         sendSF(VIEW,color aPoint)$Lisp  -- change to c
           -- now, send the 3d subspace structure
       sendI(VIEW,#lllipts)$Lisp
-      for allipts in lllipts for oneprop in lprops for onelprops in llprops repeat
-           -- the following is false for f(x,y) and user-defined for [x(t),y(t),z(t)]
-           -- this is temporary - until the generalized points stuff gets put in
-        sendI(VIEW,(closed? oneprop => yes; no))$Lisp
-        sendI(VIEW,(solid? oneprop => yes; no))$Lisp
-        sendI(VIEW,#allipts)$Lisp
-        for alipts in allipts for tinyprop in onelprops repeat
-           -- the following is false for f(x,y) and true for [x(t),y(t),z(t)]
-           -- this is temporary -- until the generalized points stuff gets put in
-          sendI(VIEW,(closed? tinyprop => yes;no))$Lisp
-          sendI(VIEW,(solid? tinyprop => yes;no))$Lisp
-          sendI(VIEW,#alipts)$Lisp
-          for oneIndexedPoint in alipts repeat
-            sendI(VIEW,oneIndexedPoint)$Lisp 
+      for allipts in lllipts _
+       for oneprop in lprops _
+        for onelprops in llprops repeat
+         -- the following is false for f(x,y) and 
+         -- user-defined for [x(t),y(t),z(t)]
+         -- this is temporary until the generalized points stuff gets put in
+         sendI(VIEW,(closed? oneprop => yes; no))$Lisp
+         sendI(VIEW,(solid? oneprop => yes; no))$Lisp
+         sendI(VIEW,#allipts)$Lisp
+         for alipts in allipts for tinyprop in onelprops repeat
+            -- the following is false for f(x,y) and true for [x(t),y(t),z(t)]
+            -- this is temporary until the generalized points stuff gets put in
+           sendI(VIEW,(closed? tinyprop => yes;no))$Lisp
+           sendI(VIEW,(solid? tinyprop => yes;no))$Lisp
+           sendI(VIEW,#alipts)$Lisp
+           for oneIndexedPoint in alipts repeat
+             sendI(VIEW,oneIndexedPoint)$Lisp 
       viewport.key := getI(VIEW)$Lisp
       viewport
          -- the key (now set to 0) should be what the viewport returns
 
     viewThetaDefault    == convert(defaultTheta())@F
+
     viewThetaDefault  t == 
       defaultTheta() := convert(t)@SF
       t
+
     viewPhiDefault      == convert(defaultPhi())@F
+
     viewPhiDefault    t == 
       defaultPhi() := convert(t)@SF
       t
+
     viewZoomDefault     == convert(defaultZoom())@F
+
     viewZoomDefault   t == 
       defaultZoom() := convert(t)@SF
       t
+
     viewDeltaXDefault   == convert(defaultDeltaX())@F
+
     viewDeltaXDefault t == 
       defaultDeltaX() := convert(t)@SF
       t
+
     viewDeltaYDefault   == convert(defaultDeltaY())@F
+
     viewDeltaYDefault t == 
       defaultDeltaY() := convert(t)@SF
       t
@@ -157687,13 +195383,14 @@ ThreeDimensionalViewport(): Exports == Implementation where
           sendSF(VIEW,viewport.viewpoint.phi)$Lisp
           getI(VIEW)$Lisp          -- acknowledge
 
-
     viewpoint (viewport:%,Theta:F,Phi:F,Scale:F,DeltaX:F,DeltaY:F):Void ==
       viewport.viewpoint := 
-        [convert(Theta)@SF,convert(Phi)@SF,convert(Scale)@SF,1$SF,1$SF,1$SF,convert(DeltaX)@SF,convert(DeltaY)@SF]
+        [convert(Theta)@SF,convert(Phi)@SF,convert(Scale)@SF,1$SF,1$SF,1$SF,_
+         convert(DeltaX)@SF,convert(DeltaY)@SF]
 
     viewpoint (viewport:%,Theta:I,Phi:I,Scale:F,DeltaX:F,DeltaY:F):Void ==
-      viewport.viewpoint := [convert(Theta)@SF * degreesSF,convert(Phi)@SF * degreesSF,
+      viewport.viewpoint := _
+       [convert(Theta)@SF * degreesSF,convert(Phi)@SF * degreesSF,_
         convert(Scale)@SF,1$SF,1$SF,1$SF,convert(DeltaX)@SF,convert(DeltaY)@SF]
 
     viewpoint (viewport:%,Theta:F,Phi:F):Void ==
@@ -157842,9 +195539,10 @@ ThreeDimensionalViewport(): Exports == Implementation where
           sendSTR(VIEW,Filename)$Lisp
           m := minIndex(avail := viewWriteAvailable())
           for aTypeOfFile in thingsToWrite repeat
-            if (writeTypeInt:= position(upperCase aTypeOfFile,avail)-m) < 0 then
+            if (writeTypeInt:=position(upperCase aTypeOfFile,avail)-m) < 0 then
               sayBrightly(["  > "::E,(concat(aTypeOfFile, _
-                " is not a valid file type for writing a 3D viewport"))::E]$List(E))$Lisp
+                " is not a valid file type for writing a 3D viewport"))::E_
+                 ]$List(E))$Lisp
             else
               sendI(VIEW,writeTypeInt+(1$I))$Lisp
           sendI(VIEW,0$I)$Lisp     -- no more types of things to write
@@ -157910,7 +195608,8 @@ ThreeDimensionalViewport(): Exports == Implementation where
           getI(VIEW)$Lisp          -- acknowledge
 
     modifyPointData(viewport,anIndex,aPoint) ==
-      (n := dimension aPoint) < 3 => error "The point should have dimension of at least 3"
+      (n := dimension aPoint) < 3 => _
+        error "The point should have dimension of at least 3"
       viewport.space3D := modifyPointData(viewport.space3D,anIndex,aPoint)
       (key(viewport) ^= 0$I) =>
         sendI(VIEW,typeVIEW3D)$Lisp
@@ -157924,18 +195623,594 @@ ThreeDimensionalViewport(): Exports == Implementation where
           else sendSF(VIEW,color aPoint)$Lisp
           getI(VIEW)$Lisp          -- acknowledge
 
---    print viewport ==
---      (key(viewport) ^= 0$I) =>
---        sendI(VIEW,typeVIEW3D)$Lisp
---        sendI(VIEW,printViewport)$Lisp
---        checkViewport viewport =>
---          getI(VIEW)$Lisp          -- acknowledge
-
 \end{chunk}
 
 \begin{chunk}{COQ VIEW3D}
 (* domain VIEW3D *)
 (*
+
+    import Color()
+    import ViewDefaultsPackage()
+    import Plot3D()
+    import TubePlot()
+    import POINT
+    import PointPackage(SF)
+    import SubSpaceComponentProperty()
+    import SPACE3
+    import MeshCreationRoutinesForThreeDimensions()
+    import DrawOptionFunctions0
+    import COORDSYS
+    import Set(PositiveInteger)
+
+    Rep := Record (key:I, fun:I, _
+                   title:S, moveTo:XYNN, size:XYP, viewpoint:V, _
+                   colors:H, flags:FLAG, _
+                   lighting:LR, perspective:PR, volume:VR, _
+                   space3D:SPACE3, _
+                   optionsField:L DROP)
+
+    degrees := pi()$F / 180.0
+    degreesSF := pi()$SF / 180
+    defaultTheta  : Reference(SF) := ref(convert(pi()$F/4.0)@SF)
+    defaultPhi    : Reference(SF) := ref(convert(-pi()$F/4.0)@SF)
+    defaultZoom   : Reference(SF) := ref(convert(1.2)@SF)
+    defaultDeltaX : Reference(SF) := ref 0
+    defaultDeltaY : Reference(SF) := ref 0
+
+
+    --%Local Functions
+    checkViewport (viewport:%):B ==
+        -- checks to see if this viewport still exists
+        -- by sending the key to the viewport manager and
+        -- waiting for its reply after it checks it against
+        -- the viewports in its list. a -1 means it doesn't
+        -- exist.
+      sendI(VIEW,viewport.key)$Lisp
+      i := getI(VIEW)$Lisp
+      (i < 0$I) => 
+        viewport.key := 0$I
+        error "This viewport has already been closed!"
+      true
+    
+    arcsinTemp(x:SF):SF ==
+      -- the asin function doesn't exist in the SF domain currently
+      -- to avoid floating point error from SF (ie 1.0 -> 1.00001)
+      x >= 1  => (pi()$SF / 2)  
+      x <= -1 => 3 * pi()$SF / 2
+      convert(asin(convert(x)@Float)$Float)@SF
+
+    arctanTemp(x:SF):SF == convert(atan(convert(x)@Float)$Float)@SF
+
+    doOptions(v:Rep):Void ==    
+      v.title := title(v.optionsField,"AXIOM3D")
+      st:S := style(v.optionsField,"wireMesh")
+      if (st = "shade" or st = "render") then
+        v.flags.style := rendered
+      else if (st = "solid" or st = "opaque") then
+        v.flags.style := opaque
+      else if (st = "contour") then
+        v.flags.style := contour      
+      else if (st = "smooth") then
+        v.flags.style := smooth
+      else v.flags.style := wireMesh
+      v.viewpoint := viewpoint(v.optionsField,
+        [deref defaultTheta,deref defaultPhi,deref defaultZoom, _
+          1$SF,1$SF,1$SF,deref defaultDeltaX, deref defaultDeltaY])
+        -- etc - 3D specific stuff...
+
+    --%Exported Functions : Default Settings
+    viewport3D() ==
+      [0,typeVIEW3D,"AXIOM3D",[viewPosDefault().1,viewPosDefault().2], _
+       [viewSizeDefault().1,viewSizeDefault().2], _
+        [deref defaultTheta,deref defaultPhi,deref defaultZoom, _
+         1$SF,1$SF,1$SF,deref defaultDeltaX, deref defaultDeltaY], [0,27], _
+          [noControl,wireMesh,yes,no,no,no], [0$SF,0$SF,1$SF,0$SF,0$SF,1$SF], _
+           [yes, EYED, HITHER], [0$SF,1$SF,0$SF,1$SF,0$SF,1$SF,no,yes], _
+            create3Space()$SPACE3, [] ]
+
+    subspace viewport ==
+      viewport.space3D
+
+    subspace(viewport,space) ==
+      viewport.space3D := space
+      viewport
+
+    options viewport ==
+      viewport.optionsField
+
+    options(viewport,opts) ==
+      viewport.optionsField := opts
+      viewport
+
+    makeViewport3D(space:SPACE3,Title:S):% ==
+      v := viewport3D()
+      v.space3D := space
+      v.optionsField := [title(Title)]
+      makeViewport3D v
+
+    makeViewport3D(space:SPACE3,opts:L DROP):% ==
+      v := viewport3D()
+      v.space3D := space
+      v.optionsField := opts
+      makeViewport3D v
+
+    makeViewport3D viewport ==
+      --local function to extract and assign optional args for 3D viewports
+      doOptions viewport 
+      sayBrightly(["   Transmitting data..."::E]$List(E))$Lisp
+      transform := _
+        coord(viewport.optionsField,cartesian$COORDSYS)$DrawOptionFunctions0
+      check(viewport.space3D)
+      lpts := lp(viewport.space3D) 
+      lllipts  := lllip(viewport.space3D)
+      llprops := llprop(viewport.space3D)
+      lprops  := lprop(viewport.space3D)
+        -- check for dimensionality of points
+        -- if they are all 4D points, then everything is okay
+        -- if they are all 3D points, then pad an extra constant
+        -- coordinate for color
+        -- if they have varying dimensionalities, give an error
+      s := brace()$Set(PI)
+      for pt in lpts repeat
+        insert_!(dimension pt,s)
+      #s > 1 => error "All points should have the same dimension"
+      (n := first parts s) < 3 => _
+        error "Dimension of points should be greater than 2"
+      sendI(VIEW,viewport.fun)$Lisp
+      sendI(VIEW,makeVIEW3D)$Lisp
+      sendSTR(VIEW,viewport.title)$Lisp
+      sendSF(VIEW,viewport.viewpoint.deltaX)$Lisp
+      sendSF(VIEW,viewport.viewpoint.deltaY)$Lisp
+      sendSF(VIEW,viewport.viewpoint.scale)$Lisp
+      sendSF(VIEW,viewport.viewpoint.scaleX)$Lisp
+      sendSF(VIEW,viewport.viewpoint.scaleY)$Lisp
+      sendSF(VIEW,viewport.viewpoint.scaleZ)$Lisp
+      sendSF(VIEW,viewport.viewpoint.theta)$Lisp
+      sendSF(VIEW,viewport.viewpoint.phi)$Lisp
+      sendI(VIEW,viewport.moveTo.X)$Lisp
+      sendI(VIEW,viewport.moveTo.Y)$Lisp
+      sendI(VIEW,viewport.size.X)$Lisp
+      sendI(VIEW,viewport.size.Y)$Lisp
+      sendI(VIEW,viewport.flags.showCP)$Lisp
+      sendI(VIEW,viewport.flags.style)$Lisp
+      sendI(VIEW,viewport.flags.axesOn)$Lisp
+      sendI(VIEW,viewport.flags.diagonalsOn)$Lisp
+      sendI(VIEW,viewport.flags.outlineRenderOn)$Lisp
+      sendI(VIEW,viewport.flags.showRegionField)$Lisp  -- add to make3D.c
+      sendI(VIEW,viewport.volume.clipRegionField)$Lisp  -- add to make3D.c
+      sendI(VIEW,viewport.volume.clipSurfaceField)$Lisp  -- add to make3D.c
+      sendI(VIEW,viewport.colors.hueOffset)$Lisp
+      sendI(VIEW,viewport.colors.hueNumber)$Lisp
+      sendSF(VIEW,viewport.lighting.lightX)$Lisp
+      sendSF(VIEW,viewport.lighting.lightY)$Lisp
+      sendSF(VIEW,viewport.lighting.lightZ)$Lisp
+      sendSF(VIEW,viewport.lighting.translucence)$Lisp
+      sendI(VIEW,viewport.perspective.perspectiveField)$Lisp
+      sendSF(VIEW,viewport.perspective.eyeDistance)$Lisp
+        -- new, crazy points domain stuff
+          -- first, send the point data list
+      sendI(VIEW,#lpts)$Lisp
+      for pt in lpts repeat
+        aPoint := transform pt
+        sendSF(VIEW,xCoord aPoint)$Lisp
+        sendSF(VIEW,yCoord aPoint)$Lisp
+        sendSF(VIEW,zCoord aPoint)$Lisp
+        n = 3 => sendSF(VIEW,zCoord aPoint)$Lisp
+        sendSF(VIEW,color aPoint)$Lisp  -- change to c
+          -- now, send the 3d subspace structure
+      sendI(VIEW,#lllipts)$Lisp
+      for allipts in lllipts _
+       for oneprop in lprops _
+        for onelprops in llprops repeat
+         -- the following is false for f(x,y) and 
+         -- user-defined for [x(t),y(t),z(t)]
+         -- this is temporary until the generalized points stuff gets put in
+         sendI(VIEW,(closed? oneprop => yes; no))$Lisp
+         sendI(VIEW,(solid? oneprop => yes; no))$Lisp
+         sendI(VIEW,#allipts)$Lisp
+         for alipts in allipts for tinyprop in onelprops repeat
+            -- the following is false for f(x,y) and true for [x(t),y(t),z(t)]
+            -- this is temporary until the generalized points stuff gets put in
+           sendI(VIEW,(closed? tinyprop => yes;no))$Lisp
+           sendI(VIEW,(solid? tinyprop => yes;no))$Lisp
+           sendI(VIEW,#alipts)$Lisp
+           for oneIndexedPoint in alipts repeat
+             sendI(VIEW,oneIndexedPoint)$Lisp 
+      viewport.key := getI(VIEW)$Lisp
+      viewport
+         -- the key (now set to 0) should be what the viewport returns
+
+    viewThetaDefault    == convert(defaultTheta())@F
+
+    viewThetaDefault  t == 
+      defaultTheta() := convert(t)@SF
+      t
+
+    viewPhiDefault      == convert(defaultPhi())@F
+
+    viewPhiDefault    t == 
+      defaultPhi() := convert(t)@SF
+      t
+
+    viewZoomDefault     == convert(defaultZoom())@F
+
+    viewZoomDefault   t == 
+      defaultZoom() := convert(t)@SF
+      t
+
+    viewDeltaXDefault   == convert(defaultDeltaX())@F
+
+    viewDeltaXDefault t == 
+      defaultDeltaX() := convert(t)@SF
+      t
+
+    viewDeltaYDefault   == convert(defaultDeltaY())@F
+
+    viewDeltaYDefault t == 
+      defaultDeltaY() := convert(t)@SF
+      t
+
+--Exported Functions: Available features for 3D viewports
+    lighting(viewport,Xlight,Ylight,Zlight) ==
+      viewport.lighting.lightX := convert(Xlight)@SF
+      viewport.lighting.lightY := convert(Ylight)@SF
+      viewport.lighting.lightZ := convert(Zlight)@SF
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,lightDef)$Lisp
+        checkViewport viewport =>
+          sendSF(VIEW,viewport.lighting.lightX)$Lisp
+          sendSF(VIEW,viewport.lighting.lightY)$Lisp
+          sendSF(VIEW,viewport.lighting.lightZ)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    axes (viewport,onOff) ==
+      if onOff = "on" then viewport.flags.axesOn := yes
+      else viewport.flags.axesOn := no
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,axesOnOff)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,viewport.flags.axesOn)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    diagonals (viewport,onOff) ==
+      if onOff = "on" then viewport.flags.diagonalsOn := yes
+      else viewport.flags.diagonalsOn := no
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,diagOnOff)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,viewport.flags.diagonalsOn)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    outlineRender (viewport,onOff) ==
+      if onOff = "on" then viewport.flags.outlineRenderOn := yes
+      else viewport.flags.outlineRenderOn := no
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,outlineOnOff)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,viewport.flags.outlineRenderOn)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    controlPanel (viewport,onOff) ==
+      if onOff = "on" then viewport.flags.showCP := yes
+      else viewport.flags.showCP := no
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,hideControl)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,viewport.flags.showCP)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    drawStyle (viewport,how) ==
+      if (how = "shade") then                    -- render
+        viewport.flags.style := rendered
+      else if (how = "solid") then               -- opaque
+        viewport.flags.style := opaque
+      else if (how = "contour") then             -- contour
+        viewport.flags.style := contour
+      else if (how = "smooth") then              -- smooth
+        viewport.flags.style := smooth
+      else viewport.flags.style := wireMesh
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,viewport.flags.style)$Lisp
+        checkViewport viewport =>
+          getI(VIEW)$Lisp          -- acknowledge
+
+    reset viewport ==
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,SPADBUTTONPRESS)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,RESET)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    close viewport ==
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,closeAll)$Lisp
+        checkViewport viewport =>
+          getI(VIEW)$Lisp          -- acknowledge
+          viewport.key := 0$I
+
+    viewpoint (viewport:%):V ==
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,queryVIEWPOINT)$Lisp
+        checkViewport viewport =>
+          deltaX_sf : SF := getSF(VIEW)$Lisp
+          deltaY_sf : SF := getSF(VIEW)$Lisp
+          scale_sf  : SF := getSF(VIEW)$Lisp
+          scaleX_sf : SF := getSF(VIEW)$Lisp
+          scaleY_sf : SF := getSF(VIEW)$Lisp
+          scaleZ_sf : SF := getSF(VIEW)$Lisp
+          theta_sf  : SF := getSF(VIEW)$Lisp
+          phi_sf    : SF := getSF(VIEW)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+          viewport.viewpoint := 
+            [ theta_sf, phi_sf, scale_sf, scaleX_sf, scaleY_sf, scaleZ_sf, 
+              deltaX_sf, deltaY_sf ]
+        viewport.viewpoint
+
+    viewpoint (viewport:%, viewpt:V):Void ==
+      viewport.viewpoint := viewpt
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,changeVIEWPOINT)$Lisp
+        checkViewport viewport =>
+          sendSF(VIEW,viewport.viewpoint.deltaX)$Lisp
+          sendSF(VIEW,viewport.viewpoint.deltaY)$Lisp
+          sendSF(VIEW,viewport.viewpoint.scale)$Lisp
+          sendSF(VIEW,viewport.viewpoint.scaleX)$Lisp
+          sendSF(VIEW,viewport.viewpoint.scaleY)$Lisp
+          sendSF(VIEW,viewport.viewpoint.scaleZ)$Lisp
+          sendSF(VIEW,viewport.viewpoint.theta)$Lisp
+          sendSF(VIEW,viewport.viewpoint.phi)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    viewpoint (viewport:%,Theta:F,Phi:F,Scale:F,DeltaX:F,DeltaY:F):Void ==
+      viewport.viewpoint := 
+        [convert(Theta)@SF,convert(Phi)@SF,convert(Scale)@SF,1$SF,1$SF,1$SF,_
+         convert(DeltaX)@SF,convert(DeltaY)@SF]
+
+    viewpoint (viewport:%,Theta:I,Phi:I,Scale:F,DeltaX:F,DeltaY:F):Void ==
+      viewport.viewpoint := _
+       [convert(Theta)@SF * degreesSF,convert(Phi)@SF * degreesSF,_
+        convert(Scale)@SF,1$SF,1$SF,1$SF,convert(DeltaX)@SF,convert(DeltaY)@SF]
+
+    viewpoint (viewport:%,Theta:F,Phi:F):Void ==
+      viewport.viewpoint.theta := convert(Theta)@SF * degreesSF
+      viewport.viewpoint.phi   := convert(Phi)@SF * degreesSF
+
+    viewpoint (viewport:%,X:F,Y:F,Z:F):Void ==
+      Theta : F
+      Phi : F
+      if (X=0$F) and (Y=0$F) then
+        Theta := 0$F
+        if (Z>=0$F) then
+          Phi := 0$F
+        else 
+          Phi := 180.0
+      else
+        Theta := asin(Y/(R := sqrt(X*X+Y*Y)))
+        if (Z=0$F) then
+          Phi := 90.0
+        else
+          Phi := atan(Z/R)
+      rotate(viewport, Theta * degrees, Phi * degrees)
+    
+    title (viewport,Title) == 
+      viewport.title := Title
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,TITLE)$Lisp
+        checkViewport viewport =>
+          sendSTR(VIEW,Title)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    colorDef (viewport,HueOffset,HueNumber) ==
+      viewport.colors := [h := (hue HueOffset),(hue HueNumber) - h]
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,COLORDEF)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,hue HueOffset)$Lisp
+          sendI(VIEW,hue HueNumber)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    dimensions (viewport,ViewX,ViewY,ViewWidth,ViewHeight) ==
+      viewport.moveTo := [ViewX,ViewY]
+      viewport.size   := [ViewWidth,ViewHeight]
+
+    move(viewport,xLoc,yLoc) ==
+      viewport.moveTo := [xLoc,yLoc]
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,MOVE)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,xLoc)$Lisp
+          sendI(VIEW,yLoc)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    resize(viewport,xSize,ySize) ==
+      viewport.size := [xSize,ySize]
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,RESIZE)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,xSize)$Lisp
+          sendI(VIEW,ySize)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+ 
+    coerce viewport ==
+      (key(viewport) = 0$I) =>
+        hconcat
+          ["Closed or Undefined ThreeDimensionalViewport: "::E,
+           (viewport.title)::E]
+      hconcat ["ThreeDimensionalViewport: "::E, (viewport.title)::E]
+
+    key viewport == viewport.key
+
+    rotate(viewport:%,Theta:I,Phi:I) ==
+      rotate(viewport,Theta::F * degrees,Phi::F * degrees) 
+
+    rotate(viewport:%,Theta:F,Phi:F) ==
+      viewport.viewpoint.theta := convert(Theta)@SF
+      viewport.viewpoint.phi   := convert(Phi)@SF
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,ROTATE)$Lisp
+        checkViewport viewport =>
+          sendSF(VIEW,viewport.viewpoint.theta)$Lisp
+          sendSF(VIEW,viewport.viewpoint.phi)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    zoom(viewport:%,Scale:F) ==
+      viewport.viewpoint.scale := convert(Scale)@SF
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,ZOOM)$Lisp
+        checkViewport viewport =>
+          sendSF(VIEW,viewport.viewpoint.scale)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    zoom(viewport:%,ScaleX:F,ScaleY:F,ScaleZ:F) ==
+      viewport.viewpoint.scaleX := convert(ScaleX)@SF
+      viewport.viewpoint.scaleY := convert(ScaleY)@SF
+      viewport.viewpoint.scaleZ := convert(ScaleZ)@SF
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,zoomx)$Lisp
+        checkViewport viewport =>
+          sendSF(VIEW,viewport.viewpoint.scaleX)$Lisp
+          sendSF(VIEW,viewport.viewpoint.scaleY)$Lisp
+          sendSF(VIEW,viewport.viewpoint.scaleZ)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    translate(viewport,DeltaX,DeltaY) ==
+      viewport.viewpoint.deltaX := convert(DeltaX)@SF
+      viewport.viewpoint.deltaY := convert(DeltaY)@SF
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,TRANSLATE)$Lisp
+        checkViewport viewport =>
+          sendSF(VIEW,viewport.viewpoint.deltaX)$Lisp
+          sendSF(VIEW,viewport.viewpoint.deltaY)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    intensity(viewport,Amount) ==
+      if (Amount < 0$F) or (Amount > 1$F) then
+        error "The intensity must be a value between 0 and 1, inclusively."
+      viewport.lighting.translucence := convert(Amount)@SF
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,translucenceDef)$Lisp
+        checkViewport viewport =>
+          sendSF(VIEW,viewport.lighting.translucence)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    write(viewport:%,Filename:S,aThingToWrite:S) ==
+      write(viewport,Filename,[aThingToWrite])
+    
+    write(viewport,Filename) ==
+      write(viewport,Filename,viewWriteDefault())
+
+    write(viewport:%,Filename:S,thingsToWrite:L S) ==
+      stringToSend : S := ""
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,writeView)$Lisp
+        checkViewport viewport =>
+          sendSTR(VIEW,Filename)$Lisp
+          m := minIndex(avail := viewWriteAvailable())
+          for aTypeOfFile in thingsToWrite repeat
+            if (writeTypeInt:=position(upperCase aTypeOfFile,avail)-m) < 0 then
+              sayBrightly(["  > "::E,(concat(aTypeOfFile, _
+                " is not a valid file type for writing a 3D viewport"))::E_
+                 ]$List(E))$Lisp
+            else
+              sendI(VIEW,writeTypeInt+(1$I))$Lisp
+          sendI(VIEW,0$I)$Lisp     -- no more types of things to write
+          getI(VIEW)$Lisp          -- acknowledge
+          Filename
+
+    perspective (viewport,onOff) ==
+      if onOff = "on" then viewport.perspective.perspectiveField := yes
+      else viewport.perspective.perspectiveField := no
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,perspectiveOnOff)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,viewport.perspective.perspectiveField)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    showRegion (viewport,onOff) ==
+      if onOff = "on" then viewport.flags.showRegionField := yes
+      else viewport.flags.showRegionField := no
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,region3D)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,viewport.flags.showRegionField)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    showClipRegion (viewport,onOff) ==
+      if onOff = "on" then viewport.volume.clipRegionField := yes
+      else viewport.volume.clipRegionField := no
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,clipRegionOnOff)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,viewport.volume.clipRegionField)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    clipSurface (viewport,onOff) ==
+      if onOff = "on" then viewport.volume.clipSurfaceField := yes
+      else viewport.volume.clipSurfaceField := no
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,clipSurfaceOnOff)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,viewport.volume.clipSurfaceField)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    eyeDistance(viewport:%,EyeDistance:F) ==
+      viewport.perspective.eyeDistance := convert(EyeDistance)@SF
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,eyeDistanceData)$Lisp
+        checkViewport viewport =>
+          sendSF(VIEW,viewport.perspective.eyeDistance)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    hitherPlane(viewport:%,HitherPlane:F) ==
+      viewport.perspective.hitherPlane := convert(HitherPlane)@SF
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,hitherPlaneData)$Lisp
+        checkViewport viewport =>
+          sendSF(VIEW,viewport.perspective.hitherPlane)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    modifyPointData(viewport,anIndex,aPoint) ==
+      (n := dimension aPoint) < 3 => _
+        error "The point should have dimension of at least 3"
+      viewport.space3D := modifyPointData(viewport.space3D,anIndex,aPoint)
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW3D)$Lisp
+        sendI(VIEW,modifyPOINT)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,anIndex)$Lisp
+          sendSF(VIEW,xCoord aPoint)$Lisp
+          sendSF(VIEW,yCoord aPoint)$Lisp
+          sendSF(VIEW,zCoord aPoint)$Lisp
+          if (n = 3) then sendSF(VIEW,convert(0.5)@SF)$Lisp
+          else sendSF(VIEW,color aPoint)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
 *)
 
 \end{chunk}
@@ -158086,6 +196361,7 @@ ThreeSpace(R:Ring):Exports == Implementation where
 
   Exports ==> ThreeSpaceCategory(R)
   Implementation ==> add
+
     import COMPPROP
     import POINT
     import SUBSPACE
@@ -158097,6 +196373,7 @@ ThreeSpace(R:Ring):Exports == Implementation where
                    converted:B)
  
 --% Local Functions
+
     convertSpace : % -> %
     convertSpace space ==
       space.converted => space
@@ -158122,6 +196399,7 @@ ThreeSpace(R:Ring):Exports == Implementation where
       
 
 --% Exported Functions
+
     polygon(space:%,points:L POINT) ==
       #points < 3 =>
         error "You need at least 3 points to define a polygon"
@@ -158132,29 +196410,37 @@ ThreeSpace(R:Ring):Exports == Implementation where
         addPointLast(space.subspaceField, pt, p, 2)
       space.converted := false
       space
-    create3Space() == [ new()$SUBSPACE, [], [ [], [], [], [] ], [0,0,0,0], false ]
+
+    create3Space() == 
+      [ new()$SUBSPACE, [], [ [], [], [], [] ], [0,0,0,0], false ]
+
     create3Space(s) == [ s, [], [ [], [], [], [] ], [0,0,0,0], false ]
+
     numberOfComponents(space) == #(children((space::Rep).subspaceField))
+
     numberOfComposites(space) == #((space::Rep).compositesField)
+
     merge(listOfThreeSpaces) ==
-          -- * -- we may want to remove duplicate components when that functionality exists in List
-      newspace := create3Space(merge([ts.subspaceField for ts in listOfThreeSpaces]))
---      newspace.compositesField := [for cs in ts.compositesField for ts in listOfThreeSpaces]
+      newspace := _
+        create3Space(merge([ts.subspaceField for ts in listOfThreeSpaces]))
       for ts in listOfThreeSpaces repeat 
-        newspace.compositesField := append(ts.compositesField,newspace.compositesField)
+        newspace.compositesField := _
+          append(ts.compositesField,newspace.compositesField)
       newspace
+
     merge(s1,s2) == merge([s1,s2])
+
     composite(listOfThreeSpaces) ==
       space := create3Space()
       space.subspaceField := merge [s.subspaceField for s in listOfThreeSpaces]
       space.compositesField := [deepCopy space.subspaceField]
---      for aSpace in listOfThreeSpaces repeat
-          -- create a composite (which are supercomponents that group
-          -- separate components together) out of all possible components
---        space.compositesField := append(children aSpace.subspaceField,space.compositesField)
       space
-    components(space) == [create3Space(s) for s in separate space.subspaceField]
+
+    components(space) == 
+      [create3Space(s) for s in separate space.subspaceField]
+
     composites(space) == [create3Space(s) for s in space.compositesField]
+
     copy(space) ==
       spc := create3Space(deepCopy(space.subspaceField))
       spc.compositesField := [deepCopy s for s in space.compositesField]
@@ -158164,6 +196450,7 @@ ThreeSpace(R:Ring):Exports == Implementation where
       for p in listOfPoints repeat
         addPoint(space.subspaceField,p)
       #(pointData space.subspaceField)
+
     modifyPointData(space,i,p) ==
       modifyPoint(space.subspaceField,i,p)
       space
@@ -158174,25 +196461,34 @@ ThreeSpace(R:Ring):Exports == Implementation where
       --     xxx(p)   : create a new three space with xxx, p
       --     xxx(s,p) : add xxx, p, to a three space, s
       --     xxx(s,q) : add an xxx, convertable from q, to a three space, s
-      --     xxx(s,i) : add an xxx, the data for xxx being indexed by reference  *** complete this
+      --     xxx(s,i) : add an xxx, the data for xxx being indexed by reference
+
     point?(space:%) ==
       #(c:=children space.subspaceField) > 1$NNI => 
         error "This ThreeSpace has more than one component"
         -- our 3-space has one component, a list of list of points
-      #(kid:=children first c) = 1$NNI => -- the component has one subcomponent (a list of points)
-        #(children first kid) = 1$NNI  -- this list of points only has one entry, so it's a point
+        -- the component has one subcomponent (a list of points)
+      #(kid:=children first c) = 1$NNI => 
+        -- this list of points only has one entry, so it's a point
+        #(children first kid) = 1$NNI  
       false
+
     point(space:%) ==
-      point? space => extractPoint(traverse(space.subspaceField,[1,1,1]::L NNI))
-      error "This ThreeSpace holds something other than a single point - try the objects() command"
+      point? space => _
+        extractPoint(traverse(space.subspaceField,[1,1,1]::L NNI))
+      error "This ThreeSpace is not a single point - try the objects() command"
+
     point(aPoint:POINT) == point(create3Space(),aPoint)
+
     point(space:%,aPoint:POINT) ==
       addPoint(space.subspaceField,[],aPoint)
       space.converted := false
       space
+
     point(space:%,l:L R) ==
       pt := point(l)
       point(space,pt)
+
     point(space:%,i:NNI) ==
       addPoint(space.subspaceField,[],i)
       space.converted := false
@@ -158202,13 +196498,17 @@ ThreeSpace(R:Ring):Exports == Implementation where
       #(c:=children space.subspaceField) > 1$NNI => 
         error "This ThreeSpace has more than one component"
         -- our 3-space has one component, a list of list of points
-      #(children first c) = 1$NNI -- there is only one subcomponent, so it's a list of points
+        -- there is only one subcomponent, so it's a list of points
+      #(children first c) = 1$NNI 
+
     curve(space:%) ==
       curve? space => 
         spc := first children first children space.subspaceField
         [extractPoint(s) for s in children spc]
-      error "This ThreeSpace holds something other than a curve - try the objects() command"
+      error "This ThreeSpace is not a curve - try the objects() command"
+
     curve(points:L POINT) == curve(create3Space(),points)
+
     curve(space:%,points:L POINT) ==
       addPoint(space.subspaceField,[],first points)
       path : L NNI := [#(children space.subspaceField),1]
@@ -158216,6 +196516,7 @@ ThreeSpace(R:Ring):Exports == Implementation where
         addPoint(space.subspaceField,path,p)
       space.converted := false
       space
+
     curve(space:%,points:L L R) ==
       pts := map(point,points)
       curve(space,pts)
@@ -158224,17 +196525,21 @@ ThreeSpace(R:Ring):Exports == Implementation where
       #(c:=children space.subspaceField) > 1$NNI => 
         error "This ThreeSpace has more than one component"
         -- our 3-space has one component, a list of list of points
-      #(kid := children first c) = 1$NNI => -- there is one subcomponent => it's a list of points
+        -- there is one subcomponent => it's a list of points
+      #(kid := children first c) = 1$NNI => 
         extractClosed first kid   -- is it a closed curve?
       false
+
     closedCurve(space:%) ==
       closedCurve? space => 
         spc := first children first children space.subspaceField 
           -- get the list of points
         [extractPoint(s) for s in children spc]  
           -- for now, we are not repeating points...
-      error "This ThreeSpace holds something other than a curve - try the objects() command"
+      error "This ThreeSpace is not a curve - try the objects() command"
+
     closedCurve(points:L POINT) == closedCurve(create3Space(),points)
+
     closedCurve(space:%,points:L POINT) ==
       addPoint(space.subspaceField,[],first points)
       path : L NNI := [#(children space.subspaceField),1]
@@ -158243,6 +196548,7 @@ ThreeSpace(R:Ring):Exports == Implementation where
         addPoint(space.subspaceField,path,p)
       space.converted := false
       space
+
     closedCurve(space:%,points:L L R) ==
       pts := map(point,points)
       closedCurve(space,pts)
@@ -158257,13 +196563,17 @@ ThreeSpace(R:Ring):Exports == Implementation where
           -- the remaining points (2 or more) in the second, and last, child
         #(children first kid) = 1$NNI and #(children second kid) > 2::NNI
       false  -- => returns Void...?
+
     polygon(space:%) ==
       polygon? space =>
         listOfPoints : L POINT := 
-          [extractPoint(first children first (cs := children first children space.subspaceField))]
+          [extractPoint(first children first _
+            (cs := children first children space.subspaceField))]
         [extractPoint(s) for s in children second cs]
-      error "This ThreeSpace holds something other than a polygon - try the objects() command"
+      error "This ThreeSpace is not a polygon - try the objects() command"
+
     polygon(points:L POINT) == polygon(create3Space(),points)
+
     polygon(space:%,points:L L R) ==
       pts := map(point,points)
       polygon(space,pts) 
@@ -158289,22 +196599,28 @@ ThreeSpace(R:Ring):Exports == Implementation where
             error "Mesh defined with single point curves (use curve())"
           true
       false
+
     mesh(space:%) ==
       mesh? space =>
         llp : L L POINT := []
         for lpSpace in children first children space.subspaceField repeat
           llp := cons([extractPoint(s) for s in children lpSpace],llp)
         llp
-      error "This ThreeSpace holds something other than a mesh - try the objects() command"
+      error "This ThreeSpace is not a mesh - try the objects() command"
+
     mesh(points:L L POINT) == mesh(create3Space(),points,false,false)
-    mesh(points:L L POINT,prop1:B,prop2:B) == mesh(create3Space(),points,prop1,prop2)
---+ old ones \/
+
+    mesh(points:L L POINT,prop1:B,prop2:B) == 
+      mesh(create3Space(),points,prop1,prop2)
+
+    --+ old ones \/
     mesh(space:%,llpoints:L L L R,lprops:L PROP,prop:PROP) ==
       pts := [map(point,points) for points in llpoints]
       mesh(space,pts,lprops,prop)
     mesh(space:%,llp:L L POINT,lprops:L PROP,prop:PROP) ==
       addPoint(space.subspaceField,[],first first llp)
-      defineProperty(space.subspaceField,path:L NNI:=[#children space.subspaceField],prop)
+      defineProperty(space.subspaceField,path:L NNI:=_
+        [#children space.subspaceField],prop)
       path := append(path,[1])
       defineProperty(space.subspaceField,path,first lprops)
       for p in rest (first llp) repeat
@@ -158317,12 +196633,16 @@ ThreeSpace(R:Ring):Exports == Implementation where
           addPoint(space.subspaceField,path,p)
       space.converted := false
       space
---+ old ones /\
+
+    --+ old ones /\
+
     mesh(space:%,llpoints:L L L R,prop1:B,prop2:B) ==
       pts := [map(point,points) for points in llpoints]
       mesh(space,pts,prop1,prop2)
+
     mesh(space:%,llp:L L POINT,prop1:B,prop2:B) ==
-        -- prop2 refers to property of the ends of a surface (list of lists of points)
+        -- prop2 refers to property of the ends of a surface 
+        -- (list of lists of points)
         -- while prop1 refers to the individual curves (list of points)
         -- ** note we currently use Booleans for closed (rather than a pair
         -- ** of booleans for closed and solid)
@@ -158331,7 +196651,8 @@ ThreeSpace(R:Ring):Exports == Implementation where
       propB : PROP := new()
       close(propB,prop2)
       addPoint(space.subspaceField,[],first first llp)
-      defineProperty(space.subspaceField,path:L NNI:=[#children space.subspaceField],propB)
+      defineProperty(space.subspaceField,path:L NNI:=_
+        [#children space.subspaceField],propB)
       path := append(path,[1])
       defineProperty(space.subspaceField,path,propA)
       for p in rest (first llp) repeat
@@ -158348,15 +196669,15 @@ ThreeSpace(R:Ring):Exports == Implementation where
     lp space ==
       if ^space.converted then space := convertSpace space 
       space.rep3DField.lp
+
     lllip space   == 
       if ^space.converted then space := convertSpace space 
       space.rep3DField.llliPt
---    lllp space   == 
---      if ^space.converted then space := convertSpace space 
---      space.rep3DField.lllPt
+
     llprop space == 
       if ^space.converted then space := convertSpace space 
       space.rep3DField.llProp
+
     lprop space  == 
       if ^space.converted then space := convertSpace space 
       space.rep3DField.lProp
@@ -158403,6 +196724,364 @@ ThreeSpace(R:Ring):Exports == Implementation where
 \begin{chunk}{COQ SPACE3}
 (* domain SPACE3 *)
 (*
+
+    import COMPPROP
+    import POINT
+    import SUBSPACE
+    import ListFunctions2(List(R),POINT)
+    import Set(NNI)
+
+    Rep := Record( subspaceField:SUBSPACE, compositesField:L SUBSPACE, _
+                   rep3DField:REP3D, objectsField:OBJ3D, _
+                   converted:B)
+ 
+--% Local Functions
+
+    convertSpace : % -> %
+    convertSpace space ==
+      space.converted => space
+      space.converted := true
+      lllipt : L L L NNI := [] 
+      llprop : L L PROP := []
+      lprop : L PROP := []
+      for component in children space.subspaceField repeat
+        lprop := cons(extractProperty component,lprop)  
+        tmpllipt : L L NNI := []
+        tmplprop : L PROP := []
+        for curve in children component repeat
+          tmplprop := cons(extractProperty curve,tmplprop)
+          tmplipt : L NNI := []
+          for point in children curve repeat
+            tmplipt := cons(extractIndex point,tmplipt)
+          tmpllipt := cons(reverse_! tmplipt,tmpllipt)
+        llprop := cons(reverse_! tmplprop, llprop)
+        lllipt := cons(reverse_! tmpllipt, lllipt)
+      space.rep3DField := [pointData space.subspaceField, 
+                           reverse_! lllipt,reverse_! llprop,reverse_! lprop]
+      space
+      
+
+--% Exported Functions
+
+    polygon(space:%,points:L POINT) ==
+      #points < 3 =>
+        error "You need at least 3 points to define a polygon"
+      pt := addPoint2(space.subspaceField,first points)
+      points := rest points
+      addPointLast(space.subspaceField, pt, first points, 1)
+      for p in rest points repeat
+        addPointLast(space.subspaceField, pt, p, 2)
+      space.converted := false
+      space
+
+    create3Space() == 
+      [ new()$SUBSPACE, [], [ [], [], [], [] ], [0,0,0,0], false ]
+
+    create3Space(s) == [ s, [], [ [], [], [], [] ], [0,0,0,0], false ]
+
+    numberOfComponents(space) == #(children((space::Rep).subspaceField))
+
+    numberOfComposites(space) == #((space::Rep).compositesField)
+
+    merge(listOfThreeSpaces) ==
+      newspace := _
+        create3Space(merge([ts.subspaceField for ts in listOfThreeSpaces]))
+      for ts in listOfThreeSpaces repeat 
+        newspace.compositesField := _
+          append(ts.compositesField,newspace.compositesField)
+      newspace
+
+    merge(s1,s2) == merge([s1,s2])
+
+    composite(listOfThreeSpaces) ==
+      space := create3Space()
+      space.subspaceField := merge [s.subspaceField for s in listOfThreeSpaces]
+      space.compositesField := [deepCopy space.subspaceField]
+      space
+
+    components(space) == 
+      [create3Space(s) for s in separate space.subspaceField]
+
+    composites(space) == [create3Space(s) for s in space.compositesField]
+
+    copy(space) ==
+      spc := create3Space(deepCopy(space.subspaceField))
+      spc.compositesField := [deepCopy s for s in space.compositesField]
+      spc
+
+    enterPointData(space,listOfPoints) ==
+      for p in listOfPoints repeat
+        addPoint(space.subspaceField,p)
+      #(pointData space.subspaceField)
+
+    modifyPointData(space,i,p) ==
+      modifyPoint(space.subspaceField,i,p)
+      space
+
+      -- 3D primitives, each grouped in the following order
+      --     xxx?(s)  : query whether the threespace, s, holds an xxx
+      --     xxx(s)   : extract xxx from threespace, s
+      --     xxx(p)   : create a new three space with xxx, p
+      --     xxx(s,p) : add xxx, p, to a three space, s
+      --     xxx(s,q) : add an xxx, convertable from q, to a three space, s
+      --     xxx(s,i) : add an xxx, the data for xxx being indexed by reference
+
+    point?(space:%) ==
+      #(c:=children space.subspaceField) > 1$NNI => 
+        error "This ThreeSpace has more than one component"
+        -- our 3-space has one component, a list of list of points
+        -- the component has one subcomponent (a list of points)
+      #(kid:=children first c) = 1$NNI => 
+        -- this list of points only has one entry, so it's a point
+        #(children first kid) = 1$NNI  
+      false
+
+    point(space:%) ==
+      point? space => _
+        extractPoint(traverse(space.subspaceField,[1,1,1]::L NNI))
+      error "This ThreeSpace is not a single point - try the objects() command"
+
+    point(aPoint:POINT) == point(create3Space(),aPoint)
+
+    point(space:%,aPoint:POINT) ==
+      addPoint(space.subspaceField,[],aPoint)
+      space.converted := false
+      space
+
+    point(space:%,l:L R) ==
+      pt := point(l)
+      point(space,pt)
+
+    point(space:%,i:NNI) ==
+      addPoint(space.subspaceField,[],i)
+      space.converted := false
+      space
+
+    curve?(space:%) ==
+      #(c:=children space.subspaceField) > 1$NNI => 
+        error "This ThreeSpace has more than one component"
+        -- our 3-space has one component, a list of list of points
+        -- there is only one subcomponent, so it's a list of points
+      #(children first c) = 1$NNI 
+
+    curve(space:%) ==
+      curve? space => 
+        spc := first children first children space.subspaceField
+        [extractPoint(s) for s in children spc]
+      error "This ThreeSpace is not a curve - try the objects() command"
+
+    curve(points:L POINT) == curve(create3Space(),points)
+
+    curve(space:%,points:L POINT) ==
+      addPoint(space.subspaceField,[],first points)
+      path : L NNI := [#(children space.subspaceField),1]
+      for p in rest points repeat
+        addPoint(space.subspaceField,path,p)
+      space.converted := false
+      space
+
+    curve(space:%,points:L L R) ==
+      pts := map(point,points)
+      curve(space,pts)
+      
+    closedCurve?(space:%) ==
+      #(c:=children space.subspaceField) > 1$NNI => 
+        error "This ThreeSpace has more than one component"
+        -- our 3-space has one component, a list of list of points
+        -- there is one subcomponent => it's a list of points
+      #(kid := children first c) = 1$NNI => 
+        extractClosed first kid   -- is it a closed curve?
+      false
+
+    closedCurve(space:%) ==
+      closedCurve? space => 
+        spc := first children first children space.subspaceField 
+          -- get the list of points
+        [extractPoint(s) for s in children spc]  
+          -- for now, we are not repeating points...
+      error "This ThreeSpace is not a curve - try the objects() command"
+
+    closedCurve(points:L POINT) == closedCurve(create3Space(),points)
+
+    closedCurve(space:%,points:L POINT) ==
+      addPoint(space.subspaceField,[],first points)
+      path : L NNI := [#(children space.subspaceField),1]
+      closeComponent(space.subspaceField,path,true)
+      for p in rest points repeat
+        addPoint(space.subspaceField,path,p)
+      space.converted := false
+      space
+
+    closedCurve(space:%,points:L L R) ==
+      pts := map(point,points)
+      closedCurve(space,pts)
+
+    polygon?(space:%) ==
+      #(c:=children space.subspaceField) > 1$NNI => 
+        error "This ThreeSpace has more than one component"
+        -- our 3-space has one component, a list of list of points
+      #(kid:=children first c) = 2::NNI => 
+          -- there are two subcomponents
+          -- the convention is to have one point in the first child and to put 
+          -- the remaining points (2 or more) in the second, and last, child
+        #(children first kid) = 1$NNI and #(children second kid) > 2::NNI
+      false  -- => returns Void...?
+
+    polygon(space:%) ==
+      polygon? space =>
+        listOfPoints : L POINT := 
+          [extractPoint(first children first _
+            (cs := children first children space.subspaceField))]
+        [extractPoint(s) for s in children second cs]
+      error "This ThreeSpace is not a polygon - try the objects() command"
+
+    polygon(points:L POINT) == polygon(create3Space(),points)
+
+    polygon(space:%,points:L L R) ==
+      pts := map(point,points)
+      polygon(space,pts) 
+
+    mesh?(space:%) ==
+      #(c:=children space.subspaceField) > 1$NNI => 
+        error "This ThreeSpace has more than one component"
+        -- our 3-space has one component, a list of list of points
+      #(kid:=children first c) > 1$NNI => 
+          -- there are two or more subcomponents (list of points)
+          -- so this may be a definition of a mesh; if the size
+          -- of each list of points is the same and they are all
+          -- greater than 1(?) then we have an acceptable mesh
+          -- use a set to hold the curve size info: if heterogenous
+          -- curve sizes exist, then the set would hold all the sizes;
+          -- otherwise it would just have the one element indicating
+          -- the sizes for all the curves
+          whatSizes := brace()$Set(NNI)
+          for eachCurve in kid repeat
+            insert_!(#children eachCurve,whatSizes)
+          #whatSizes > 1 => error "Mesh defined with curves of different sizes"
+          first parts whatSizes < 2 => 
+            error "Mesh defined with single point curves (use curve())"
+          true
+      false
+
+    mesh(space:%) ==
+      mesh? space =>
+        llp : L L POINT := []
+        for lpSpace in children first children space.subspaceField repeat
+          llp := cons([extractPoint(s) for s in children lpSpace],llp)
+        llp
+      error "This ThreeSpace is not a mesh - try the objects() command"
+
+    mesh(points:L L POINT) == mesh(create3Space(),points,false,false)
+
+    mesh(points:L L POINT,prop1:B,prop2:B) == 
+      mesh(create3Space(),points,prop1,prop2)
+
+    --+ old ones \/
+    mesh(space:%,llpoints:L L L R,lprops:L PROP,prop:PROP) ==
+      pts := [map(point,points) for points in llpoints]
+      mesh(space,pts,lprops,prop)
+    mesh(space:%,llp:L L POINT,lprops:L PROP,prop:PROP) ==
+      addPoint(space.subspaceField,[],first first llp)
+      defineProperty(space.subspaceField,path:L NNI:=_
+        [#children space.subspaceField],prop)
+      path := append(path,[1])
+      defineProperty(space.subspaceField,path,first lprops)
+      for p in rest (first llp) repeat
+        addPoint(space.subspaceField,path,p)
+      for lp in rest llp for aProp in rest lprops for count in 2.. repeat
+        addPoint(space.subspaceField,path := [first path],first lp)
+        path := append(path,[count])
+        defineProperty(space.subspaceField,path,aProp)
+        for p in rest lp repeat
+          addPoint(space.subspaceField,path,p)
+      space.converted := false
+      space
+
+    --+ old ones /\
+
+    mesh(space:%,llpoints:L L L R,prop1:B,prop2:B) ==
+      pts := [map(point,points) for points in llpoints]
+      mesh(space,pts,prop1,prop2)
+
+    mesh(space:%,llp:L L POINT,prop1:B,prop2:B) ==
+        -- prop2 refers to property of the ends of a surface 
+        -- (list of lists of points)
+        -- while prop1 refers to the individual curves (list of points)
+        -- ** note we currently use Booleans for closed (rather than a pair
+        -- ** of booleans for closed and solid)
+      propA : PROP := new()
+      close(propA,prop1)
+      propB : PROP := new()
+      close(propB,prop2)
+      addPoint(space.subspaceField,[],first first llp)
+      defineProperty(space.subspaceField,path:L NNI:=_
+        [#children space.subspaceField],propB)
+      path := append(path,[1])
+      defineProperty(space.subspaceField,path,propA)
+      for p in rest (first llp) repeat
+        addPoint(space.subspaceField,path,p)
+      for lp in rest llp for count in 2.. repeat
+        addPoint(space.subspaceField,path := [first path],first lp)
+        path := append(path,[count])
+        defineProperty(space.subspaceField,path,propA)
+        for p in rest lp repeat
+          addPoint(space.subspaceField,path,p)
+      space.converted := false
+      space
+
+    lp space ==
+      if ^space.converted then space := convertSpace space 
+      space.rep3DField.lp
+
+    lllip space   == 
+      if ^space.converted then space := convertSpace space 
+      space.rep3DField.llliPt
+
+    llprop space == 
+      if ^space.converted then space := convertSpace space 
+      space.rep3DField.llProp
+
+    lprop space  == 
+      if ^space.converted then space := convertSpace space 
+      space.rep3DField.lProp
+
+      -- this function is just to see how this representation really
+      -- does work
+    objects space ==
+      if ^space.converted then space := convertSpace space 
+      numPts        := 0$NNI
+      numCurves     := 0$NNI
+      numPolys      := 0$NNI
+      numConstructs := 0$NNI
+      for component in children space.subspaceField repeat
+        #(kid:=children component) = 1 =>
+          #(children first kid) = 1 => numPts := numPts + 1
+          numCurves := numCurves + 1
+        (#kid = 2) and _
+          (#children first kid = 1) and _
+          (#children first rest kid ^= 1) =>
+             numPolys := numPolys + 1
+        numConstructs := numConstructs + 1
+        -- otherwise, a mathematical surface is assumed
+        -- there could also be garbage representation
+        -- since there are always more permutations that
+        -- we could ever want, so the user should not
+        -- fumble around too much with the structure
+        -- as other applications need to interpret it
+      [numPts,numCurves,numPolys,numConstructs]
+
+    check(s) ==
+      ^s.converted => convertSpace s
+      s
+
+    subspace(s) == s.subspaceField
+
+    coerce(s) == 
+      if ^s.converted then s := convertSpace s
+      hconcat(["3-Space with "::O, _
+               (sizo:=#(s.rep3DField.llliPt))::O, _
+               (sizo=1=>" component"::O;" components"::O)])
+
 *)
 
 \end{chunk}
@@ -158604,6 +197283,7 @@ Tree(S: SetCategory): T==C where
        ++X cyclicParents t1
 
  C== add
+
     cycleTreeMax ==> 5
 
     Rep := Union(node:Record(value: S, args: List %),empty:"empty")
@@ -158611,84 +197291,112 @@ Tree(S: SetCategory): T==C where
     br:%
     s: S
     ls: List S
+
     empty? t == t case empty
+
     empty()  == ["empty"]
+
     children t == 
       t case empty => error "cannot take the children of an empty tree" 
       (t.node.args)@List(%)
+
     setchildren_!(t,lt) == 
       t case empty => error "cannot set children of an empty tree"
       (t.node.args:=lt;t pretend %)
+
     setvalue_!(t,s) == 
       t case empty => error "cannot set value of an empty tree"
       (t.node.value:=s;s)
+
     count(n, t) == 
       t case empty => 0
       i := +/[count(n, c) for c in children t]
       value t = n => i + 1
       i
+
     count(fn: S -> Boolean, t: %): NonNegativeInteger ==
       t case empty => 0
       i := +/[count(fn, c) for c in children t]
       fn value t => i + 1
       i
+
     map(fn, t) == 
       t case empty => t
       tree(fn value t,[map(fn, c) for c in children t])
+
     map_!(fn, t) == 
       t case empty => t
       setvalue_!(t, fn value t)
       for c in children t repeat map_!(fn, c)
+
     tree(s,lt) == [[s,lt]]
+
     tree(s) == [[s,[]]]
+
     tree(ls) ==
       empty? ls => empty()
       tree(first ls, [tree s for s in rest ls])
+
     value t ==
       t case empty => error "cannot take the value of an empty tree" 
       t.node.value
+
     child?(t1,t2) == 
       empty? t2 => false
       "or"/[t1 = t for t in children t2]
+
     distance1(t1: %, t2: %): Integer ==
       t1 = t2 => 0
       t2 case empty => -1
       u := [n for t in children t2 | (n := distance1(t1,t)) >= 0]
       #u > 0 => 1 + "min"/u 
       -1 
+
     distance(t1,t2) == 
       n := distance1(t1, t2)
       n >= 0 => n
       distance1(t2, t1)
+
     node?(t1, t2) ==
       t1 = t2 => true
       t case empty => false
       "or"/[node?(t1, t) for t in children t2]
+
     leaf? t == 
       t case empty => false
       empty? children t
+
     leaves t == 
       t case empty => empty()
       leaf? t => [value t]
       "append"/[leaves c for c in children t]
+
     less? (t, n) == # t < n
+
     more?(t, n) == # t > n
+
     nodes t ==       ---buggy
       t case empty => empty()
       nl := [nodes c for c in children t]
       nl = empty() => [t]
       cons(t,"append"/nl)
+
     size? (t, n) == # t = n
+
     any?(fn, t) ==  ---bug fixed
       t case empty => false
       fn value t or "or"/[any?(fn, c) for c in children t]
+
     every?(fn, t) == 
       t case empty => true
       fn value t and "and"/[every?(fn, c) for c in children t]
+
     member?(n, t) == 
       t case empty => false
       n = value t or "or"/[member?(n, c) for c in children t]
+
     members t == parts t
+
     parts t == --buggy?
       t case empty => empty()
       u := [parts c for c in children t]
@@ -158711,8 +197419,11 @@ Tree(S: SetCategory): T==C where
         "and"/[equal?(x,y,ot1, ot2,k + 1) for x in c1 for y in c2]
 
     -----> #
+
     treeCount: (%, %, NonNegativeInteger) -> NonNegativeInteger    
+
     # t == treeCount(t, t, 0)
+
     treeCount(t, origTree, k) ==
       k = cycleTreeMax and cyclic? origTree => 
         error "# is not defined on cyclic trees"
@@ -158720,8 +197431,11 @@ Tree(S: SetCategory): T==C where
       1 + +/[treeCount(c, origTree, k + 1) for c in children t]
  
     -----> copy
+
     copy1: (%, %, Integer) -> %
+
     copy t == copy1(t, t, 0)
+
     copy1(t, origTree, k) == 
       k = cycleTreeMax and cyclic? origTree => 
         error "use cyclicCopy to copy a cyclic tree"
@@ -158739,7 +197453,9 @@ Tree(S: SetCategory): T==C where
 
     -----> coerce to OutputForm
     if S has SetCategory then
+
       multipleOverbar: (OutputForm, Integer, List %) -> OutputForm
+
       coerce1: (%, List %, List %) -> OutputForm
 
       coerce(t:%): OutputForm == coerce1(t, empty()$(List %), cyclicParents t)
@@ -158763,6 +197479,7 @@ Tree(S: SetCategory): T==C where
         overlabel(c::OutputForm, x)
  
     -----> cyclic?
+
     cyclic2?: (%, List %) -> Boolean
 
     cyclic? t == cyclic2?(t, empty()$(List %))
@@ -158775,6 +197492,7 @@ Tree(S: SetCategory): T==C where
       false
  
     -----> cyclicCopy
+
     cyclicCopy2: (%, List %) -> %
     copyCycle2: (%, List %) -> %
     copyCycle4: (%, %, %, List %) -> %
@@ -158799,6 +197517,7 @@ Tree(S: SetCategory): T==C where
            [copyCycle4(c, cycle, newCycle, cycleList) for c in children t])
 
     -----> cyclicEntries
+
     cyclicEntries3: (%, List %, List %) -> List %
 
     cyclicEntries(t) == cyclicEntries3(t, empty()$(List %), empty()$(List %))
@@ -158812,6 +197531,7 @@ Tree(S: SetCategory): T==C where
       cl
    
     -----> cyclicEqual?
+
     cyclicEqual4?: (%, %, List %, List %) -> Boolean
 
     cyclicEqual?(t1, t2) ==
@@ -158829,6 +197549,7 @@ Tree(S: SetCategory): T==C where
                  for x in children t1 for y in children t2]
 
     -----> cyclicParents t
+
     cyclicParents3: (%, List %, List %) -> List %
 
     cyclicParents t == cyclicParents3(t, empty()$(List %), empty()$(List %))
@@ -158875,6 +197596,314 @@ Tree(S: SetCategory): T==C where
 \begin{chunk}{COQ TREE}
 (* domain TREE *)
 (*
+
+    cycleTreeMax ==> 5
+
+    Rep := Union(node:Record(value: S, args: List %),empty:"empty")
+    t:%
+    br:%
+    s: S
+    ls: List S
+
+    empty? t == t case empty
+
+    empty()  == ["empty"]
+
+    children t == 
+      t case empty => error "cannot take the children of an empty tree" 
+      (t.node.args)@List(%)
+
+    setchildren_!(t,lt) == 
+      t case empty => error "cannot set children of an empty tree"
+      (t.node.args:=lt;t pretend %)
+
+    setvalue_!(t,s) == 
+      t case empty => error "cannot set value of an empty tree"
+      (t.node.value:=s;s)
+
+    count(n, t) == 
+      t case empty => 0
+      i := +/[count(n, c) for c in children t]
+      value t = n => i + 1
+      i
+
+    count(fn: S -> Boolean, t: %): NonNegativeInteger ==
+      t case empty => 0
+      i := +/[count(fn, c) for c in children t]
+      fn value t => i + 1
+      i
+
+    map(fn, t) == 
+      t case empty => t
+      tree(fn value t,[map(fn, c) for c in children t])
+
+    map_!(fn, t) == 
+      t case empty => t
+      setvalue_!(t, fn value t)
+      for c in children t repeat map_!(fn, c)
+
+    tree(s,lt) == [[s,lt]]
+
+    tree(s) == [[s,[]]]
+
+    tree(ls) ==
+      empty? ls => empty()
+      tree(first ls, [tree s for s in rest ls])
+
+    value t ==
+      t case empty => error "cannot take the value of an empty tree" 
+      t.node.value
+
+    child?(t1,t2) == 
+      empty? t2 => false
+      "or"/[t1 = t for t in children t2]
+
+    distance1(t1: %, t2: %): Integer ==
+      t1 = t2 => 0
+      t2 case empty => -1
+      u := [n for t in children t2 | (n := distance1(t1,t)) >= 0]
+      #u > 0 => 1 + "min"/u 
+      -1 
+
+    distance(t1,t2) == 
+      n := distance1(t1, t2)
+      n >= 0 => n
+      distance1(t2, t1)
+
+    node?(t1, t2) ==
+      t1 = t2 => true
+      t case empty => false
+      "or"/[node?(t1, t) for t in children t2]
+
+    leaf? t == 
+      t case empty => false
+      empty? children t
+
+    leaves t == 
+      t case empty => empty()
+      leaf? t => [value t]
+      "append"/[leaves c for c in children t]
+
+    less? (t, n) == # t < n
+
+    more?(t, n) == # t > n
+
+    nodes t ==       ---buggy
+      t case empty => empty()
+      nl := [nodes c for c in children t]
+      nl = empty() => [t]
+      cons(t,"append"/nl)
+
+    size? (t, n) == # t = n
+
+    any?(fn, t) ==  ---bug fixed
+      t case empty => false
+      fn value t or "or"/[any?(fn, c) for c in children t]
+
+    every?(fn, t) == 
+      t case empty => true
+      fn value t and "and"/[every?(fn, c) for c in children t]
+
+    member?(n, t) == 
+      t case empty => false
+      n = value t or "or"/[member?(n, c) for c in children t]
+
+    members t == parts t
+
+    parts t == --buggy?
+      t case empty => empty()
+      u := [parts c for c in children t]
+      u = empty() => [value t]
+      cons(value t,"append"/u)
+ 
+    ---Functions that guard against cycles: =, #, copy-------------
+
+    -----> =   
+    equal?: (%, %, %, %, Integer) -> Boolean
+
+    t1 = t2 == equal?(t1, t2, t1, t2, 0) 
+
+    equal?(t1, t2, ot1, ot2, k) ==
+      k = cycleTreeMax and (cyclic? ot1 or cyclic? ot2) => 
+        error "use cyclicEqual? to test equality on cyclic trees"
+      t1 case empty => t2 case empty
+      t2 case empty => false
+      value t1 = value t2 and (c1 := children t1) = (c2 := children t2) and
+        "and"/[equal?(x,y,ot1, ot2,k + 1) for x in c1 for y in c2]
+
+    -----> #
+
+    treeCount: (%, %, NonNegativeInteger) -> NonNegativeInteger    
+
+    # t == treeCount(t, t, 0)
+
+    treeCount(t, origTree, k) ==
+      k = cycleTreeMax and cyclic? origTree => 
+        error "# is not defined on cyclic trees"
+      t case empty => 0
+      1 + +/[treeCount(c, origTree, k + 1) for c in children t]
+ 
+    -----> copy
+
+    copy1: (%, %, Integer) -> %
+
+    copy t == copy1(t, t, 0)
+
+    copy1(t, origTree, k) == 
+      k = cycleTreeMax and cyclic? origTree => 
+        error "use cyclicCopy to copy a cyclic tree"
+      t case empty  => t
+      empty? children t => tree value t
+      tree(value t, [copy1(x, origTree, k + 1) for x in children t])
+      
+    -----------Functions that allow cycles---------------
+    --local utility functions:
+    eqUnion: (List %, List %) -> List %
+    eqMember?: (%, List %) -> Boolean
+    eqMemberIndex: (%, List %, Integer) -> Integer
+    lastNode: List % -> List %
+    insert: (%, List %) -> List %
+
+    -----> coerce to OutputForm
+    if S has SetCategory then
+
+      multipleOverbar: (OutputForm, Integer, List %) -> OutputForm
+
+      coerce1: (%, List %, List %) -> OutputForm
+
+      coerce(t:%): OutputForm == coerce1(t, empty()$(List %), cyclicParents t)
+
+      coerce1(t,parents, pl) ==
+        t case empty => empty()@List(S)::OutputForm
+        eqMember?(t, parents) => 
+          multipleOverbar((".")::OutputForm,eqMemberIndex(t, pl,0),pl)
+        empty? children t => value t::OutputForm
+        nodeForm := (value t)::OutputForm
+        if (k := eqMemberIndex(t, pl, 0)) > 0 then
+           nodeForm := multipleOverbar(nodeForm, k, pl)
+        prefix(nodeForm, 
+          [coerce1(br,cons(t,parents),pl) for br in children t])
+
+      multipleOverbar(x, k, pl) ==
+        k < 1 => x
+        #pl = 1 => overbar x
+        s : String := "abcdefghijklmnopqrstuvwxyz"
+        c := s.(1 + ((k - 1) rem 26))
+        overlabel(c::OutputForm, x)
+ 
+    -----> cyclic?
+
+    cyclic2?: (%, List %) -> Boolean
+
+    cyclic? t == cyclic2?(t, empty()$(List %))
+
+    cyclic2?(x,parents) ==  
+      empty? x => false
+      eqMember?(x, parents) => true
+      for y in children x repeat
+        cyclic2?(y,cons(x, parents)) => return true
+      false
+ 
+    -----> cyclicCopy
+
+    cyclicCopy2: (%, List %) -> %
+    copyCycle2: (%, List %) -> %
+    copyCycle4: (%, %, %, List %) -> %
+
+    cyclicCopy(t) == cyclicCopy2(t, cyclicEntries t)
+
+    cyclicCopy2(t, cycles) ==
+      eqMember?(t, cycles) => return copyCycle2(t, cycles)
+      tree(value t, [cyclicCopy2(c, cycles) for c in children t])
+   
+    copyCycle2(cycle, cycleList) == 
+      newCycle := tree(value cycle, nil)
+      setchildren!(newCycle,
+        [copyCycle4(c,cycle,newCycle, cycleList) for c in children cycle])
+      newCycle
+
+    copyCycle4(t, cycle, newCycle, cycleList) == 
+      empty? cycle => empty()
+      eq?(t, cycle) => newCycle
+      eqMember?(t, cycleList) => copyCycle2(t, cycleList)
+      tree(value t,
+           [copyCycle4(c, cycle, newCycle, cycleList) for c in children t])
+
+    -----> cyclicEntries
+
+    cyclicEntries3: (%, List %, List %) -> List %
+
+    cyclicEntries(t) == cyclicEntries3(t, empty()$(List %), empty()$(List %))
+
+    cyclicEntries3(t, parents, cl) ==
+      empty? t => cl
+      eqMember?(t, parents) => insert(t, cl)
+      parents := cons(t, parents)
+      for y in children t repeat
+        cl := cyclicEntries3(t, parents, cl)
+      cl
+   
+    -----> cyclicEqual?
+
+    cyclicEqual4?: (%, %, List %, List %) -> Boolean
+
+    cyclicEqual?(t1, t2) ==
+      cp1 := cyclicParents t1
+      cp2 := cyclicParents t2
+      #cp1 ^= #cp2 or null cp1 => t1 = t2
+      cyclicEqual4?(t1, t2, cp1, cp2)
+
+    cyclicEqual4?(t1, t2, cp1, cp2) == 
+      t1 case empty => t2 case empty
+      t2 case empty => false
+      0 ^= (k := eqMemberIndex(t1, cp1, 0)) => eq?(t2, cp2 . k)
+      value t1 = value t2 and 
+        "and"/[cyclicEqual4?(x,y,cp1,cp2) 
+                 for x in children t1 for y in children t2]
+
+    -----> cyclicParents t
+
+    cyclicParents3: (%, List %, List %) -> List %
+
+    cyclicParents t == cyclicParents3(t, empty()$(List %), empty()$(List %))
+
+    cyclicParents3(x, parents, pl) ==
+      empty? x => pl
+      eqMember?(x, parents) => 
+        cycleMembers := [y for y in parents while not eq?(x,y)]
+        eqUnion(cons(x, cycleMembers), pl)
+      parents := cons(x, parents)
+      for y in children x repeat 
+        pl := cyclicParents3(y, parents, pl)
+      pl
+
+    insert(x, l) ==
+      eqMember?(x, l) => l
+      cons(x, l)
+
+    lastNode l ==
+      empty? l => error "empty tree has no last node"
+      while not empty? rest l repeat l := rest l
+      l
+
+    eqMember?(y,l) ==
+      for x in l repeat eq?(x,y) => return true
+      false
+
+    eqMemberIndex(x, l, k) ==
+      null l => k
+      k := k + 1
+      eq?(x, first l) => k
+      eqMemberIndex(x, rest l, k)
+
+    eqUnion(u, v) ==
+      null u => v
+      x := first u
+      newV :=
+        eqMember?(x, v) => v
+        cons(x, v)
+      eqUnion(rest u, newV)
+
 *)
 
 \end{chunk}
@@ -158987,6 +198016,7 @@ TubePlot(Curve): Exports == Implementation where
     listLoops plot == plot.loops
  
     closed? plot == plot.closedTube?
+
     open? plot   == not plot.closedTube?
  
     setClosed(plot,flag) == plot.closedTube? := flag
@@ -158998,6 +198028,21 @@ TubePlot(Curve): Exports == Implementation where
 \begin{chunk}{COQ TUBE}
 (* domain TUBE *)
 (*
+ 
+    Rep := Record(parCurve:Curve,loops:L L Pt,closedTube?:B)
+ 
+    getCurve plot == plot.parCurve
+ 
+    listLoops plot == plot.loops
+ 
+    closed? plot == plot.closedTube?
+
+    open? plot   == not plot.closedTube?
+ 
+    setClosed(plot,flag) == plot.closedTube? := flag
+ 
+    tube(curve,ll,b) == [curve,ll,b]
+
 *)
 
 \end{chunk}
@@ -159107,10 +198152,13 @@ Tuple(S:Type): CoercibleTo(PrimitiveArray S) with
 
   if S has SetCategory then SetCategory
  == add
+
   Rep := Record(len : NonNegativeInteger, elts : PrimitiveArray S)
 
   coerce(x: PrimitiveArray S): %  == [#x, x]
+
   coerce(x:%): PrimitiveArray(S) == x.elts
+
   length x == x.len
 
   select(x, n) ==
@@ -159118,7 +198166,9 @@ Tuple(S:Type): CoercibleTo(PrimitiveArray S) with
     x.elts.n
 
   if S has SetCategory then
+
     x = y == (x.len = y.len) and (x.elts =$PrimitiveArray(S) y.elts)
+
     coerce(x : %): OutputForm ==
       paren [(x.elts.i)::OutputForm
              for i in minIndex x.elts .. maxIndex x.elts]$List(OutputForm)
@@ -159128,6 +198178,27 @@ Tuple(S:Type): CoercibleTo(PrimitiveArray S) with
 \begin{chunk}{COQ TUPLE}
 (* domain TUPLE *)
 (*
+
+  Rep := Record(len : NonNegativeInteger, elts : PrimitiveArray S)
+
+  coerce(x: PrimitiveArray S): %  == [#x, x]
+
+  coerce(x:%): PrimitiveArray(S) == x.elts
+
+  length x == x.len
+
+  select(x, n) ==
+    n >= x.len => error "Index out of bounds"
+    x.elts.n
+
+  if S has SetCategory then
+
+    x = y == (x.len = y.len) and (x.elts =$PrimitiveArray(S) y.elts)
+
+    coerce(x : %): OutputForm ==
+      paren [(x.elts.i)::OutputForm
+             for i in minIndex x.elts .. maxIndex x.elts]$List(OutputForm)
+
 *)
 
 \end{chunk}
@@ -160390,7 +199461,9 @@ TwoDimensionalViewport ():Exports == Implementation where
 
 
     graphStates viewport  == viewport.graphStatesField
+
     graphs viewport       == viewport.graphsField
+
     key viewport          == viewport.key
 
     dimensions(viewport,ViewX,ViewY,ViewWidth,ViewHeight) ==
@@ -160475,7 +199548,7 @@ TwoDimensionalViewport ():Exports == Implementation where
 
     makeViewport2D viewportDollar ==
       viewport := viewportDollar::Rep
---local function to extract and assign optional arguments for 2D viewports  
+      --local function to extract and assign optional args for 2D viewports  
       doOptions viewport 
       sayBrightly(_
        ["   AXIOM2D data being transmitted to the viewport manager..."::E]_
@@ -160716,6 +199789,388 @@ TwoDimensionalViewport ():Exports == Implementation where
 \begin{chunk}{COQ VIEW2D}
 (* domain VIEW2D *)
 (*
+
+    import GraphImage()
+    import Color()
+    import Palette()
+    import ViewDefaultsPackage()
+    import DrawOptionFunctions0
+    import POINT
+
+    Rep := Record (key:I, graphsField:V GU, graphStatesField:V GS, _
+                   title:STR, moveTo:XYNN, size:XYP, flags:FLAG, _
+                   optionsField:L DROP)
+
+    defaultGS : GS := [convert(0.9)@SF, convert(0.9)@SF, 0$SF, 0$SF, _
+                      yes, yes, no, _
+                      yes, axesColorDefault(), no, unitsColorDefault(), _
+                      yes]
+
+
+     --% Local Functions
+    checkViewport (viewport:$):B ==
+        -- checks to see if this viewport still exists
+        -- by sending the key to the viewport manager and
+        -- waiting for its reply after it checks it against
+        -- the viewports in its list. a -1 means it doesn't
+        -- exist.
+      sendI(VIEW,viewport.key)$Lisp
+      i := getI(VIEW)$Lisp
+      (i < 0$I) => 
+        viewport.key := 0$I
+        error "This viewport has already been closed!"
+      true
+
+    doOptions(v:Rep):Void ==    
+      v.title := title(v.optionsField,"AXIOM2D")
+      -- etc - 2D specific stuff...
+
+     --% Exported Functions
+
+    options viewport ==
+      viewport.optionsField
+
+    options(viewport,opts) ==
+      viewport.optionsField := opts
+      viewport
+
+    putGraph (viewport,aGraph,which) ==
+      if ((which > maxGRAPHS) or (which < 1)) then
+        error "Trying to put a graph with a negative index or too big an index"
+      viewport.graphsField.which := aGraph
+
+    getGraph (viewport,which) ==
+      if ((which > maxGRAPHS) or (which < 1)) then
+        error "Trying to get a graph with a negative index or too big an index"
+      viewport.graphsField.which case "undefined" =>
+        error "Graph is undefined!"
+      viewport.graphsField.which::GraphImage
+
+
+    graphStates viewport  == viewport.graphStatesField
+
+    graphs viewport       == viewport.graphsField
+
+    key viewport          == viewport.key
+
+    dimensions(viewport,ViewX,ViewY,ViewWidth,ViewHeight) ==
+      viewport.moveTo := [ViewX,ViewY]
+      viewport.size   := [ViewWidth,ViewHeight]
+
+    move(viewport,xLoc,yLoc) ==
+      viewport.moveTo := [xLoc,yLoc]
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,MOVE)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,xLoc)$Lisp
+          sendI(VIEW,yLoc)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    update(viewport,graph,slot) ==
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,putGraph2D)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,key graph)$Lisp
+          sendI(VIEW,slot)$Lisp
+          getI(VIEW)$Lisp -- acknowledge 
+
+    resize(viewport,xSize,ySize) ==
+      viewport.size := [xSize,ySize]
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,RESIZE)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,xSize)$Lisp
+          sendI(VIEW,ySize)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    translate(viewport,graphIndex,xTranslateF,yTranslateF) ==
+      xTranslate := convert(xTranslateF)@SF
+      yTranslate := convert(yTranslateF)@SF
+      if (graphIndex > maxGRAPHS) then
+        error "Referring to a graph with too big an index"
+      viewport.graphStatesField.graphIndex.deltaX := xTranslate
+      viewport.graphStatesField.graphIndex.deltaY := yTranslate
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,TRANSLATE2D)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,graphIndex)$Lisp
+          sendSF(VIEW,xTranslate)$Lisp
+          sendSF(VIEW,yTranslate)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    scale(viewport,graphIndex,xScaleF,yScaleF) ==
+      xScale := convert(xScaleF)@SF
+      yScale := convert(yScaleF)@SF
+      if (graphIndex > maxGRAPHS) then
+        error "Referring to a graph with too big an index"
+      -- check union (undefined?)
+      viewport.graphStatesField.graphIndex.scaleX := xScale
+      -- check union (undefined?)
+      viewport.graphStatesField.graphIndex.scaleY := yScale
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,SCALE2D)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,graphIndex)$Lisp
+          sendSF(VIEW,xScale)$Lisp
+          sendSF(VIEW,yScale)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    viewport2D ==
+      [0,new(maxGRAPHS,"undefined"), _
+       new(maxGRAPHS,copy defaultGS),"AXIOM2D", _
+        [viewPosDefault().1,viewPosDefault().2],_
+         [viewSizeDefault().1,viewSizeDefault().2], _
+          [noControl], [] ]
+      
+    makeViewport2D(g:G,opts:L DROP) ==
+      viewport               := viewport2D()
+      viewport.graphsField.1 := g
+      viewport.optionsField := opts
+      makeViewport2D viewport
+
+    makeViewport2D viewportDollar ==
+      viewport := viewportDollar::Rep
+      --local function to extract and assign optional args for 2D viewports  
+      doOptions viewport 
+      sayBrightly(_
+       ["   AXIOM2D data being transmitted to the viewport manager..."::E]_
+        $List(E))$Lisp
+      sendI(VIEW,typeVIEW2D)$Lisp
+      sendI(VIEW,makeVIEW2D)$Lisp
+      sendSTR(VIEW,viewport.title)$Lisp
+      sendI(VIEW,viewport.moveTo.X)$Lisp
+      sendI(VIEW,viewport.moveTo.Y)$Lisp
+      sendI(VIEW,viewport.size.X)$Lisp
+      sendI(VIEW,viewport.size.Y)$Lisp
+      sendI(VIEW,viewport.flags.showCP)$Lisp
+      for i in 1..maxGRAPHS repeat
+        g := (graphs viewport).i
+        if g case "undefined" then
+          sendI(VIEW,0$I)$Lisp
+        else
+          sendI(VIEW,key(g::G))$Lisp
+          gs := (graphStates viewport).i
+          sendSF(VIEW,gs.scaleX)$Lisp
+          sendSF(VIEW,gs.scaleY)$Lisp
+          sendSF(VIEW,gs.deltaX)$Lisp
+          sendSF(VIEW,gs.deltaY)$Lisp
+          sendI(VIEW,gs.points)$Lisp
+          sendI(VIEW,gs.connect)$Lisp
+          sendI(VIEW,gs.spline)$Lisp
+          sendI(VIEW,gs.axes)$Lisp
+          hueShade:=hue hue gs.axesColor+shade gs.axesColor * numberOfHues()
+          sendI(VIEW,hueShade)$Lisp
+          sendI(VIEW,gs.units)$Lisp
+          hueShade:=hue hue gs.unitsColor+shade gs.unitsColor * numberOfHues()
+          sendI(VIEW,hueShade)$Lisp
+          sendI(VIEW,gs.showing)$Lisp
+      viewport.key := getI(VIEW)$Lisp
+      viewport
+
+    graphState(viewport,num,sX,sY,dX,dY,Points,Lines,Spline, _
+               Axes,AxesColor,Units,UnitsColor,Showing) ==
+      viewport.graphStatesField.num := [sX,sY,dX,dY,Points,Lines,Spline, _
+                                       Axes,AxesColor,Units,UnitsColor,Showing]
+
+    title(viewport,Title) == 
+      viewport.title := Title
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,TITLE)$Lisp
+        checkViewport viewport =>
+          sendSTR(VIEW,Title)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    reset viewport ==
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,SPADBUTTONPRESS)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,reset2D)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    axes (viewport:$,graphIndex:PI,onOff:STR) : Void ==
+      if (graphIndex > maxGRAPHS) then
+        error "Referring to a graph with too big an index"
+      if onOff = "on" then
+        status := yes
+      else
+        status := no
+      -- check union (undefined?)
+      viewport.graphStatesField.graphIndex.axes := status
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,axesOnOff2D)$Lisp 
+        checkViewport viewport =>
+          sendI(VIEW,graphIndex)$Lisp
+          sendI(VIEW,status)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    axes (viewport:$,graphIndex:PI,color:PAL) : Void ==
+      if (graphIndex > maxGRAPHS) then
+        error "Referring to a graph with too big an index"
+      viewport.graphStatesField.graphIndex.axesColor := color
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,axesColor2D)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,graphIndex)$Lisp
+          hueShade := hue hue color + shade color * numberOfHues()
+          sendI(VIEW,hueShade)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    units (viewport:$,graphIndex:PI,onOff:STR) : Void ==
+      if (graphIndex > maxGRAPHS) then
+        error "Referring to a graph with too big an index"
+      if onOff = "on" then
+        status := yes
+      else
+        status := no
+      -- check union (undefined?)
+      viewport.graphStatesField.graphIndex.units := status  
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,unitsOnOff2D)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,graphIndex)$Lisp
+          sendI(VIEW,status)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    units (viewport:$,graphIndex:PI,color:PAL) : Void ==
+      if (graphIndex > maxGRAPHS) then
+        error "Referring to a graph with too big an index"
+      viewport.graphStatesField.graphIndex.unitsColor := color
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,unitsColor2D)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,graphIndex)$Lisp
+          hueShade := hue hue color + shade color * numberOfHues()
+          sendI(VIEW,hueShade)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    connect (viewport:$,graphIndex:PI,onOff:STR) : Void ==
+      if (graphIndex > maxGRAPHS) then
+        error "Referring to a graph with too big an index"
+      if onOff = "on" then
+        status := 1$I
+      else
+        status := 0$I
+      -- check union (undefined?)
+      viewport.graphStatesField.graphIndex.connect := status  
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,connectOnOff)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,graphIndex)$Lisp
+          sendI(VIEW,status)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    points (viewport:$,graphIndex:PI,onOff:STR) : Void ==
+      if (graphIndex > maxGRAPHS) then
+        error "Referring to a graph with too big an index"
+      if onOff = "on" then
+        status := 1$I
+      else
+        status := 0$I
+      -- check union (undefined?)
+      viewport.graphStatesField.graphIndex.points := status  
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,pointsOnOff)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,graphIndex)$Lisp
+          sendI(VIEW,status)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    region (viewport:$,graphIndex:PI,onOff:STR) : Void ==
+      if (graphIndex > maxGRAPHS) then
+        error "Referring to a graph with too big an index"
+      if onOff = "on" then
+        status := 1$I
+      else
+        status := 0$I
+      -- check union (undefined?)
+      viewport.graphStatesField.graphIndex.spline := status  
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,spline2D)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,graphIndex)$Lisp
+          sendI(VIEW,status)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    show (viewport,graphIndex,onOff) ==
+      if (graphIndex > maxGRAPHS) then
+        error "Referring to a graph with too big an index"
+      if onOff = "on" then
+        status := 1$I
+      else
+        status := 0$I
+      -- check union (undefined?)
+      viewport.graphStatesField.graphIndex.showing := status  
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,showing2D)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,graphIndex)$Lisp
+          sendI(VIEW,status)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    controlPanel (viewport,onOff) ==
+      if onOff = "on" then viewport.flags.showCP := yes
+      else viewport.flags.showCP := no
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,hideControl2D)$Lisp
+        checkViewport viewport =>
+          sendI(VIEW,viewport.flags.showCP)$Lisp
+          getI(VIEW)$Lisp          -- acknowledge
+
+    close viewport ==
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,closeAll2D)$Lisp
+        checkViewport viewport =>
+          getI(VIEW)$Lisp          -- acknowledge
+          viewport.key := 0$I
+
+    coerce viewport ==
+      (key(viewport) = 0$I) =>
+        hconcat ["Closed or Undefined TwoDimensionalViewport: "::E,
+                  (viewport.title)::E]
+      hconcat ["TwoDimensionalViewport: "::E, (viewport.title)::E]
+
+    write(viewport:$,Filename:STR,aThingToWrite:STR) ==
+      write(viewport,Filename,[aThingToWrite])
+    
+    write(viewport,Filename) ==
+      write(viewport,Filename,viewWriteDefault())
+
+    write(viewport:$,Filename:STR,thingsToWrite:L STR) ==
+      stringToSend : STR := ""
+      (key(viewport) ^= 0$I) =>
+        sendI(VIEW,typeVIEW2D)$Lisp
+        sendI(VIEW,writeView)$Lisp
+        checkViewport viewport =>
+          sendSTR(VIEW,Filename)$Lisp
+          m := minIndex(avail := viewWriteAvailable())
+          for aTypeOfFile in thingsToWrite repeat
+            if (writeTypeInt:=position(upperCase aTypeOfFile,avail)-m) < 0 then
+              sayBrightly(["  > "::E,(concat(aTypeOfFile, _
+                " is not a valid file type for writing a 2D viewport"))::E]_
+                  $List(E))$Lisp
+            else
+              sendI(VIEW,writeTypeInt+(1$I))$Lisp
+          sendI(VIEW,0$I)$Lisp     -- no more types of things to write
+          getI(VIEW)$Lisp          -- acknowledge
+          Filename
+
 *)
 
 \end{chunk}
@@ -161505,6 +200960,7 @@ UnivariateLaurentSeries(Coef,var,cen): Exports == Implementation where
   Implementation ==> UnivariateLaurentSeriesConstructor(Coef,UTS) add
 
     variable x == var
+
     center   x == cen
 
     coerce(v:Variable(var)) ==
@@ -161514,6 +200970,7 @@ UnivariateLaurentSeries(Coef,var,cen): Exports == Implementation where
     differentiate(x:%,v:Variable(var)) == differentiate x
 
     if Coef has Algebra Fraction Integer then
+
       integrate(x:%,v:Variable(var)) == integrate x
 
 \end{chunk}
@@ -161521,6 +200978,22 @@ UnivariateLaurentSeries(Coef,var,cen): Exports == Implementation where
 \begin{chunk}{COQ ULS}
 (* domain ULS *)
 (*
+ UnivariateLaurentSeriesConstructor(Coef,UTS) add
+
+    variable x == var
+
+    center   x == cen
+
+    coerce(v:Variable(var)) ==
+      zero? cen => monomial(1,1)
+      monomial(1,1) + monomial(cen,0)
+
+    differentiate(x:%,v:Variable(var)) == differentiate x
+
+    if Coef has Algebra Fraction Integer then
+
+      integrate(x:%,v:Variable(var)) == integrate x
+
 *)
 
 \end{chunk}
@@ -161938,21 +201411,27 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_
     getUTS   : % -> UTS
 
     getExpon x == x.expon
+
     getUTS   x == x.ps
 
 --% creation and destruction
 
     laurent(n,psr) == [n,psr]
+
     taylorRep x    == getUTS x
+
     degree x       == getExpon x
 
     0 == laurent(0,0)
+
     1 == laurent(0,1)
 
     monomial(s,e) == laurent(e,s::UTS)
 
     coerce(uts:UTS):% == laurent(0,uts)
+
     coerce(r:Coef):%  == r :: UTS  :: %
+
     coerce(i:I):%     == i :: Coef :: %
 
     taylorIfCan uls ==
@@ -161971,8 +201450,10 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_
 
     termExpon: TERM -> I
     termExpon term == term.k
+
     termCoef: TERM -> Coef
     termCoef term == term.c
+
     rec: (I,Coef) -> TERM
     rec(exponent,coef) == [exponent,coef]
 
@@ -162083,6 +201564,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_
 --% values
 
     variable x == variable getUTS x
+
     center   x == center   getUTS x
 
     coefficient(x,n) ==
@@ -162095,6 +201577,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_
 --% other functions
 
     order x == getExpon x + order getUTS x
+
     order(x,n) ==
       (m := n - (e := getExpon x)) < 0 => n
       e + order(getUTS x,m :: NNI)
@@ -162109,6 +201592,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_
       laurent(e,truncate(getUTS x,m1 :: NNI,(n2 - e) :: NNI))
 
     if Coef has IntegralDomain then
+
       rationalFunction(x,n) ==
         (m := n - (e := getExpon x)) < 0 => 0
         poly := polynomial(getUTS x,m :: NNI) :: RF
@@ -162126,17 +201610,6 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_
         positive? e => poly * (v - c) ** (e :: NNI)
         poly / (v - c) ** ((-e) :: NNI)
 
-      --  La fonction < exquo > manque dans laurent.spad,
-      --les lignes suivantes le mettent en evidence : 
-      --
-      --ls := laurent(0,series [i for i in 1..])$ULS(INT,x,0)
-      ---- missing function in laurent.spad of Axiom 2.0a version of
-      ---- Friday March 10, 1995 at 04:15:22 on 615:
-      --exquo(ls,ls)
-      --
-      --  Je l'ai ajoutee a laurent.spad.
-      --
-      --Frederic Lehobey
       x exquo y ==
         x := removeZeroes(1000,x)
         y := removeZeroes(1000,y)
@@ -162154,6 +201627,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_
           app * ((variable(x) :: Coef) - center(x)) ** e
 
     complete x == laurent(getExpon x,complete getUTS x)
+
     extend(x,n) ==
       e := getExpon x
       (m := n - e) < 0 => x
@@ -162174,6 +201648,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_
               multiplyCoefficients((z1:I):Coef +-> (e + z1)::Coef,getUTS x))
 
     if Coef has PartialDifferentialRing(Symbol) then
+
       differentiate(x:%,s:Symbol) ==
         (s = variable(x)) => differentiate x
         map((z1:Coef):Coef +-> differentiate(z1,s),x) 
@@ -162184,6 +201659,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_
     if Coef has Field then
 
       retract(x:%):UTS                      == taylor x
+
       retractIfCan(x:%):Union(UTS,"failed") == taylorIfCan x
 
       (x:%) ** (n:I) ==
@@ -162195,6 +201671,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_
         laurent(minusN * getExpon(xInv),getUTS(xInv) ** minusN)
 
       (x:UTS) * (y:%) == (x :: %) * y
+
       (x:%) * (y:UTS) == x * (y :: %)
 
       inv x ==
@@ -162231,30 +201708,55 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_
          (x:%) ** (r:RN) == x **$EFULS r
 
       exp x   == exp(x)$EFULS
+
       log x   == log(x)$EFULS
+
       sin x   == sin(x)$EFULS
+
       cos x   == cos(x)$EFULS
+
       tan x   == tan(x)$EFULS
+
       cot x   == cot(x)$EFULS
+
       sec x   == sec(x)$EFULS
+
       csc x   == csc(x)$EFULS
+
       asin x  == asin(x)$EFULS
+
       acos x  == acos(x)$EFULS
+
       atan x  == atan(x)$EFULS
+
       acot x  == acot(x)$EFULS
+
       asec x  == asec(x)$EFULS
+
       acsc x  == acsc(x)$EFULS
+
       sinh x  == sinh(x)$EFULS
+
       cosh x  == cosh(x)$EFULS
+
       tanh x  == tanh(x)$EFULS
+
       coth x  == coth(x)$EFULS
+
       sech x  == sech(x)$EFULS
+
       csch x  == csch(x)$EFULS
+
       asinh x == asinh(x)$EFULS
+
       acosh x == acosh(x)$EFULS
+
       atanh x == atanh(x)$EFULS
+
       acoth x == acoth(x)$EFULS
+
       asech x == asech(x)$EFULS
+
       acsch x == acsch(x)$EFULS
 
       ratInv: I -> Coef
@@ -162270,6 +201772,7 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_
 
       if Coef has integrate: (Coef,Symbol) -> Coef and _
          Coef has variables: Coef -> List Symbol then
+
         integrate(x:%,s:Symbol) ==
           (s = variable(x)) => integrate x
           not entry?(s,variables center x)
@@ -162303,8 +201806,8 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_
       c = -1 => -mon
       (c :: OUT) * mon
 
-    showAll?:() -> Boolean
     -- check a global Lisp variable
+    showAll?:() -> Boolean
     showAll?() == true
 
     termsToOutputForm:(I,ST,OUT) -> OUT
@@ -162345,6 +201848,445 @@ UnivariateLaurentSeriesConstructor(Coef,UTS):_
 \begin{chunk}{COQ ULSCONS}
 (* domain ULSCONS *)
 (*
+
+    Rep := Record(expon:I,ps:UTS)
+
+    getExpon : % -> I
+    getUTS   : % -> UTS
+
+    getExpon x == x.expon
+
+    getUTS   x == x.ps
+
+--% creation and destruction
+
+    laurent(n,psr) == [n,psr]
+
+    taylorRep x    == getUTS x
+
+    degree x       == getExpon x
+
+    0 == laurent(0,0)
+
+    1 == laurent(0,1)
+
+    monomial(s,e) == laurent(e,s::UTS)
+
+    coerce(uts:UTS):% == laurent(0,uts)
+
+    coerce(r:Coef):%  == r :: UTS  :: %
+
+    coerce(i:I):%     == i :: Coef :: %
+
+    taylorIfCan uls ==
+      n := getExpon uls
+      n < 0 =>
+        uls := removeZeroes(-n,uls)
+        getExpon(uls) < 0 => "failed"
+        getUTS uls
+      n = 0 => getUTS uls
+      getUTS(uls) * monom(1,n :: NNI)
+
+    taylor uls ==
+      (uts := taylorIfCan uls) case "failed" =>
+        error "taylor: Laurent series has a pole"
+      uts :: UTS
+
+    termExpon: TERM -> I
+    termExpon term == term.k
+
+    termCoef: TERM -> Coef
+    termCoef term == term.c
+
+    rec: (I,Coef) -> TERM
+    rec(exponent,coef) == [exponent,coef]
+
+    recs: (ST,I) -> Stream TERM
+    recs(st,n) == delay
+      empty? st => empty()
+      zero? (coef := frst st) => recs(rst st,n + 1)
+      concat(rec(n,coef),recs(rst st,n + 1))
+
+    terms x == recs(coefficients getUTS x,getExpon x)
+
+    recsToCoefs: (Stream TERM,I) -> ST
+    recsToCoefs(st,n) == delay
+      empty? st => empty()
+      term := frst st; ex := termExpon term
+      n = ex => concat(termCoef term,recsToCoefs(rst st,n + 1))
+      concat(0,recsToCoefs(rst st,n + 1))
+
+    series st ==
+      empty? st => 0
+      ex := termExpon frst st
+      laurent(ex,series recsToCoefs(st,ex))
+
+--% normalizations
+
+    removeZeroes x ==
+      empty? coefficients(xUTS := getUTS x) => 0
+      coefficient(xUTS,0) = 0 =>
+        removeZeroes laurent(getExpon(x) + 1,quoByVar xUTS)
+      x
+
+    removeZeroes(n,x) ==
+      n <= 0 => x
+      empty? coefficients(xUTS := getUTS x) => 0
+      coefficient(xUTS,0) = 0 =>
+        removeZeroes(n - 1,laurent(getExpon(x) + 1,quoByVar xUTS))
+      x
+
+--% predicates
+
+    x = y ==
+      EQ(x,y)$Lisp => true
+      (expDiff := getExpon(x) - getExpon(y)) = 0 =>
+        getUTS(x) = getUTS(y)
+      abs(expDiff) > _$streamCount$Lisp => false
+      expDiff > 0 =>
+        getUTS(x) * monom(1,expDiff :: NNI) = getUTS(y)
+      getUTS(y) * monom(1,(- expDiff) :: NNI) = getUTS(x)
+
+    pole? x ==
+      (n := degree x) >= 0 => false
+      x := removeZeroes(-n,x)
+      degree x < 0
+
+--% arithmetic
+
+    x + y  ==
+      n := getExpon(x) - getExpon(y)
+      n >= 0 =>
+        laurent(getExpon y,getUTS(y) + getUTS(x) * monom(1,n::NNI))
+      laurent(getExpon x,getUTS(x) + getUTS(y) * monom(1,(-n)::NNI))
+
+    x - y  ==
+      n := getExpon(x) - getExpon(y)
+      n >= 0 =>
+        laurent(getExpon y,getUTS(x) * monom(1,n::NNI) - getUTS(y))
+      laurent(getExpon x,getUTS(x) - getUTS(y) * monom(1,(-n)::NNI))
+
+    x:% * y:% == laurent(getExpon x + getExpon y,getUTS x * getUTS y)
+
+    x:% ** n:NNI ==
+      zero? n =>
+        zero? x => error "0 ** 0 is undefined"
+        1
+      laurent(n * getExpon(x),getUTS(x) ** n)
+
+    recip x ==
+      x := removeZeroes(1000,x)
+      zero? coefficient(x,d := degree x) => "failed"
+      (uts := recip getUTS x) case "failed" => "failed"
+      laurent(-d,uts :: UTS)
+
+    elt(uls1:%,uls2:%) ==
+      (uts := taylorIfCan uls2) case "failed" =>
+        error "elt: second argument must have positive order"
+      uts2 := uts :: UTS
+      not zero? coefficient(uts2,0) =>
+        error "elt: second argument must have positive order"
+      if (deg := getExpon uls1) < 0 then uls1 := removeZeroes(-deg,uls1)
+      (deg := getExpon uls1) < 0 =>
+        (recipr := recip(uts2 :: %)) case "failed" =>
+          error "elt: second argument not invertible"
+        uts1 := taylor(uls1 * monomial(1,-deg))
+        (elt(uts1,uts2) :: %) * (recipr :: %) ** ((-deg) :: NNI)
+      elt(taylor uls1,uts2) :: %
+
+    eval(uls:%,r:Coef) ==
+      if (n := getExpon uls) < 0 then uls := removeZeroes(-n,uls)
+      uts := getUTS uls
+      (n := getExpon uls) < 0 =>
+        zero? r => error "eval: 0 raised to negative power"
+        (recipr := recip r) case "failed" =>
+          error "eval: non-unit raised to negative power"
+        (recipr :: Coef) ** ((-n) :: NNI) *$STTAYLOR eval(uts,r)
+      zero? n => eval(uts,r)
+      r ** (n :: NNI) *$STTAYLOR eval(uts,r)
+
+--% values
+
+    variable x == variable getUTS x
+
+    center   x == center   getUTS x
+
+    coefficient(x,n) ==
+      a := n - getExpon(x)
+      a >= 0 => coefficient(getUTS x,a :: NNI)
+      0
+
+    elt(x:%,n:I) == coefficient(x,n)
+
+--% other functions
+
+    order x == getExpon x + order getUTS x
+
+    order(x,n) ==
+      (m := n - (e := getExpon x)) < 0 => n
+      e + order(getUTS x,m :: NNI)
+
+    truncate(x,n) ==
+      (m := n - (e := getExpon x)) < 0 => 0
+      laurent(e,truncate(getUTS x,m :: NNI))
+
+    truncate(x,n1,n2) ==
+      if n2 < n1 then (n1,n2) := (n2,n1)
+      (m1 := n1 - (e := getExpon x)) < 0 => truncate(x,n2)
+      laurent(e,truncate(getUTS x,m1 :: NNI,(n2 - e) :: NNI))
+
+    if Coef has IntegralDomain then
+
+      rationalFunction(x,n) ==
+        (m := n - (e := getExpon x)) < 0 => 0
+        poly := polynomial(getUTS x,m :: NNI) :: RF
+        zero? e => poly
+        v := variable(x) :: RF; c := center(x) :: P :: RF
+        positive? e => poly * (v - c) ** (e :: NNI)
+        poly / (v - c) ** ((-e) :: NNI)
+
+      rationalFunction(x,n1,n2) ==
+        if n2 < n1 then (n1,n2) := (n2,n1)
+        (m1 := n1 - (e := getExpon x)) < 0 => rationalFunction(x,n2)
+        poly := polynomial(getUTS x,m1 :: NNI,(n2 - e) :: NNI) :: RF
+        zero? e => poly
+        v := variable(x) :: RF; c := center(x) :: P :: RF
+        positive? e => poly * (v - c) ** (e :: NNI)
+        poly / (v - c) ** ((-e) :: NNI)
+
+      x exquo y ==
+        x := removeZeroes(1000,x)
+        y := removeZeroes(1000,y)
+        zero? coefficient(y, d := degree y) => "failed"
+        (uts := (getUTS x) exquo (getUTS y)) case "failed" => "failed"
+        laurent(degree x-d,uts :: UTS)
+
+    if Coef has coerce: Symbol -> Coef then
+      if Coef has "**": (Coef,I) -> Coef then
+
+        approximate(x,n) ==
+          (m := n - (e := getExpon x)) < 0 => 0
+          app := approximate(getUTS x,m :: NNI)
+          zero? e => app
+          app * ((variable(x) :: Coef) - center(x)) ** e
+
+    complete x == laurent(getExpon x,complete getUTS x)
+
+    extend(x,n) ==
+      e := getExpon x
+      (m := n - e) < 0 => x
+      laurent(e,extend(getUTS x,m :: NNI))
+
+    map(f:Coef -> Coef,x:%) == laurent(getExpon x,map(f,getUTS x))
+
+    multiplyCoefficients(f,x) ==
+      e := getExpon x
+      laurent(e,multiplyCoefficients((z1:I):Coef +-> f(e + z1),getUTS x))
+
+    multiplyExponents(x,n) ==
+      laurent(n * getExpon x,multiplyExponents(getUTS x,n))
+
+    differentiate x ==
+      e := getExpon x
+      laurent(e - 1,
+              multiplyCoefficients((z1:I):Coef +-> (e + z1)::Coef,getUTS x))
+
+    if Coef has PartialDifferentialRing(Symbol) then
+
+      differentiate(x:%,s:Symbol) ==
+        (s = variable(x)) => differentiate x
+        map((z1:Coef):Coef +-> differentiate(z1,s),x) 
+                                 - differentiate(center x,s)*differentiate(x)
+
+    characteristic() == characteristic()$Coef
+
+    if Coef has Field then
+
+      retract(x:%):UTS                      == taylor x
+
+      retractIfCan(x:%):Union(UTS,"failed") == taylorIfCan x
+
+      (x:%) ** (n:I) ==
+        zero? n =>
+          zero? x => error "0 ** 0 is undefined"
+          1
+        n > 0 => laurent(n * getExpon(x),getUTS(x) ** (n :: NNI))
+        xInv := inv x; minusN := (-n) :: NNI
+        laurent(minusN * getExpon(xInv),getUTS(xInv) ** minusN)
+
+      (x:UTS) * (y:%) == (x :: %) * y
+
+      (x:%) * (y:UTS) == x * (y :: %)
+
+      inv x ==
+        (xInv := recip x) case "failed" =>
+          error "multiplicative inverse does not exist"
+        xInv :: %
+
+      (x:%) / (y:%) ==
+        (yInv := recip y) case "failed" =>
+          error "inv: multiplicative inverse does not exist"
+        x * (yInv :: %)
+
+      (x:UTS) / (y:UTS) == (x :: %) / (y :: %)
+
+      numer x ==
+        (n := degree x) >= 0 => taylor x
+        x := removeZeroes(-n,x)
+        (n := degree x) = 0 => taylor x
+        getUTS x
+
+      denom x ==
+        (n := degree x) >= 0 => 1
+        x := removeZeroes(-n,x)
+        (n := degree x) = 0 => 1
+        monom(1,(-n) :: NNI)
+
+--% algebraic and transcendental functions
+
+    if Coef has Algebra Fraction Integer then
+
+      coerce(r:RN) == r :: Coef :: %
+
+      if Coef has Field then
+         (x:%) ** (r:RN) == x **$EFULS r
+
+      exp x   == exp(x)$EFULS
+
+      log x   == log(x)$EFULS
+
+      sin x   == sin(x)$EFULS
+
+      cos x   == cos(x)$EFULS
+
+      tan x   == tan(x)$EFULS
+
+      cot x   == cot(x)$EFULS
+
+      sec x   == sec(x)$EFULS
+
+      csc x   == csc(x)$EFULS
+
+      asin x  == asin(x)$EFULS
+
+      acos x  == acos(x)$EFULS
+
+      atan x  == atan(x)$EFULS
+
+      acot x  == acot(x)$EFULS
+
+      asec x  == asec(x)$EFULS
+
+      acsc x  == acsc(x)$EFULS
+
+      sinh x  == sinh(x)$EFULS
+
+      cosh x  == cosh(x)$EFULS
+
+      tanh x  == tanh(x)$EFULS
+
+      coth x  == coth(x)$EFULS
+
+      sech x  == sech(x)$EFULS
+
+      csch x  == csch(x)$EFULS
+
+      asinh x == asinh(x)$EFULS
+
+      acosh x == acosh(x)$EFULS
+
+      atanh x == atanh(x)$EFULS
+
+      acoth x == acoth(x)$EFULS
+
+      asech x == asech(x)$EFULS
+
+      acsch x == acsch(x)$EFULS
+
+      ratInv: I -> Coef
+      ratInv n ==
+        zero? n => 1
+        inv(n :: RN) :: Coef
+
+      integrate x ==
+        not zero? coefficient(x,-1) =>
+          error "integrate: series has term of order -1"
+        e := getExpon x
+        laurent(e+1,multiplyCoefficients((z:I):Coef+->ratInv(e+1+z),getUTS x))
+
+      if Coef has integrate: (Coef,Symbol) -> Coef and _
+         Coef has variables: Coef -> List Symbol then
+
+        integrate(x:%,s:Symbol) ==
+          (s = variable(x)) => integrate x
+          not entry?(s,variables center x)
+             => map((z1:Coef):Coef+->integrate(z1,s),x)
+          error "integrate: center is a function of variable of integration"
+
+      if Coef has TranscendentalFunctionCategory and _
+         Coef has PrimitiveFunctionCategory and _
+         Coef has AlgebraicallyClosedFunctionSpace Integer then
+
+        integrateWithOneAnswer: (Coef,Symbol) -> Coef
+        integrateWithOneAnswer(f,s) ==
+          res := integrate(f,s)$FunctionSpaceIntegration(I,Coef)
+          res case Coef => res :: Coef
+          first(res :: List Coef)
+
+        integrate(x:%,s:Symbol) ==
+          (s = variable(x)) => integrate x
+          not entry?(s,variables center x) =>
+            map((z1:Coef):Coef +-> integrateWithOneAnswer(z1,s),x)
+          error "integrate: center is a function of variable of integration"
+
+    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
+
+    termsToOutputForm:(I,ST,OUT) -> OUT
+    termsToOutputForm(m,uu,xxx) ==
+      l : L OUT := empty()
+      empty? uu => (0$Coef) :: OUT
+      n : NNI ; count : NNI := _$streamCount$Lisp
+      for n in 0..count while not empty? uu repeat
+        if frst(uu) ^= 0 then
+          l := concat(termOutput((n :: I) + m,frst(uu),xxx),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) + m,frst(uu),xxx),l)
+          uu := rst uu
+      l :=
+        explicitlyEmpty? uu => l
+        eq?(uu,rst uu) and frst uu = 0 => l
+        concat(prefix("O" :: OUT,[xxx ** ((n :: I) + m) :: OUT]),l)
+      empty? l => (0$Coef) :: OUT
+      reduce("+",reverse_! l)
+
+    coerce(x:%):OUT ==
+      x := removeZeroes(_$streamCount$Lisp,x)
+      m := degree x
+      uts := getUTS x
+      p := coefficients uts
+      var := variable uts; cen := center uts
+      xxx :=
+        zero? cen => var :: OUT
+        paren(var :: OUT - cen :: OUT)
+      termsToOutputForm(m,p,xxx)
+
 *)
 
 \end{chunk}
@@ -163307,8 +203249,11 @@ UnivariatePolynomial(x:Symbol, R:Ring):
     fmecg: (%,NonNegativeInteger,R,%) -> %
         ++ fmecg(p1,e,r,p2) finds x : p1 - r * x**e * p2
    == SparseUnivariatePolynomial(R)   add
+
     Rep:=SparseUnivariatePolynomial(R)
+
     coerce(p:%):OutputForm  == outputForm(p, outputForm x)
+
     coerce(v:Variable(x)):% == monomial(1, 1)
 
 \end{chunk}
@@ -163316,6 +203261,13 @@ UnivariatePolynomial(x:Symbol, R:Ring):
 \begin{chunk}{COQ UP}
 (* domain UP *)
 (*
+
+    Rep:=SparseUnivariatePolynomial(R)
+
+    coerce(p:%):OutputForm  == outputForm(p, outputForm x)
+
+    coerce(v:Variable(x)):% == monomial(1, 1)
+
 *)
 
 \end{chunk}
@@ -163656,6 +203608,7 @@ UnivariatePuiseuxSeries(Coef,var,cen): Exports == Implementation where
     getExpon pxs == pxs.expon
 
     variable upxs == var
+
     center   upxs == cen
 
     coerce(uts:UTS) == uts :: ULS :: %
@@ -163665,14 +203618,6 @@ UnivariatePuiseuxSeries(Coef,var,cen): Exports == Implementation where
         "failed"
       retractIfCan(ulsIfCan :: ULS)
 
-    --retract(upxs:%):UTS ==
-      --(ulsIfCan := retractIfCan(upxs)@Union(ULS,"failed")) case "failed" =>
-        --error "retractIfCan: series has fractional exponents"
-      --utsIfCan := retractIfCan(ulsIfCan :: ULS)@Union(UTS,"failed")
-      --utsIfCan case "failed" =>
-        --error "retractIfCan: series has negative exponents"
-      --utsIfCan :: UTS
-
     coerce(v:Variable(var)) ==
       zero? cen => monomial(1,1)
       monomial(1,1) + monomial(cen,0)
@@ -163722,8 +203667,8 @@ UnivariatePuiseuxSeries(Coef,var,cen): Exports == Implementation where
       c = -1 => -mon
       (c :: OUT) * mon
 
-    showAll?:() -> Boolean
     -- check a global Lisp variable
+    showAll?:() -> Boolean
     showAll?() == true
 
     termsToOutputForm:(RN,RN,ST,OUT) -> OUT
@@ -163764,6 +203709,109 @@ UnivariatePuiseuxSeries(Coef,var,cen): Exports == Implementation where
 \begin{chunk}{COQ UPXS}
 (* domain UPXS *)
 (*
+
+    Rep := Record(expon:RN,lSeries:ULS)
+
+    getExpon: % -> RN
+    getExpon pxs == pxs.expon
+
+    variable upxs == var
+
+    center   upxs == cen
+
+    coerce(uts:UTS) == uts :: ULS :: %
+
+    retractIfCan(upxs:%):Union(UTS,"failed") ==
+      (ulsIfCan := retractIfCan(upxs)@Union(ULS,"failed")) case "failed" =>
+        "failed"
+      retractIfCan(ulsIfCan :: ULS)
+
+    coerce(v:Variable(var)) ==
+      zero? cen => monomial(1,1)
+      monomial(1,1) + monomial(cen,0)
+
+    if Coef has "*": (Fraction Integer, Coef) -> Coef then
+      differentiate(upxs:%,v:Variable(var)) == differentiate upxs
+
+    if Coef has Algebra Fraction Integer then
+      integrate(upxs:%,v:Variable(var)) == integrate upxs
+
+    if Coef has coerce: Symbol -> Coef then
+      if Coef has "**": (Coef,RN) -> Coef then
+
+        roundDown: RN -> I
+        roundDown rn ==
+          -- returns the largest integer <= rn
+          (den := denom rn) = 1 => numer rn
+          n := (num := numer rn) quo den
+          positive?(num) => n
+          n - 1
+
+        stToCoef: (ST,Coef,NNI,NNI) -> Coef
+        stToCoef(st,term,n,n0) ==
+          (n > n0) or (empty? st) => 0
+          frst(st) * term ** n + stToCoef(rst st,term,n + 1,n0)
+
+        approximateLaurent: (ULS,Coef,I) -> Coef
+        approximateLaurent(x,term,n) ==
+          (m := n - (e := degree x)) < 0 => 0
+          app := stToCoef(coefficients taylorRep x,term,0,m :: NNI)
+          zero? e => app
+          app * term ** (e :: RN)
+
+        approximate(x,r) ==
+          e := rationalPower(x)
+          term := ((variable(x) :: Coef) - center(x)) ** e
+          approximateLaurent(laurentRep x,term,roundDown(r / e))
+
+    termOutput:(RN,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
+
+    termsToOutputForm:(RN,RN,ST,OUT) -> OUT
+    termsToOutputForm(m,rat,uu,xxx) ==
+      l : L OUT := empty()
+      empty? uu => 0 :: OUT
+      n : NNI; count : NNI := _$streamCount$Lisp
+      for n in 0..count while not empty? uu repeat
+        if frst(uu) ^= 0 then
+          l := concat(termOutput((n :: I) * rat + m,frst uu,xxx),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) * rat + m,frst uu,xxx),l)
+          uu := rst uu
+      l :=
+        explicitlyEmpty? uu => l
+        eq?(uu,rst uu) and frst uu = 0 => l
+        concat(prefix("O" :: OUT,[xxx ** (((n::I) * rat + m) :: OUT)]),l)
+      empty? l => 0 :: OUT
+      reduce("+",reverse_! l)
+
+    coerce(upxs:%):OUT ==
+      rat := getExpon upxs; uls := laurentRep upxs
+      count : I := _$streamCount$Lisp
+      uls := removeZeroes(_$streamCount$Lisp,uls)
+      m : RN := (degree uls) * rat
+      p := coefficients taylorRep uls
+      xxx :=
+        zero? cen => var :: OUT
+        paren(var :: OUT - cen :: OUT)
+      termsToOutputForm(m,rat,p,xxx)
+
 *)
 
 \end{chunk}
@@ -164092,16 +204140,21 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_
     getULS  : % -> ULS
 
     getExpon pxs == pxs.expon
+
     getULS   pxs == pxs.lSeries
 
 --% creation and destruction
 
     puiseux(n,ls)   == [n,ls]
+
     laurentRep x    == getULS x
+
     rationalPower x == getExpon x
+
     degree x        == getExpon(x) * degree(getULS(x))
 
     0 == puiseux(1,0)
+
     1 == puiseux(1,1)
 
     monomial(c,k) ==
@@ -164110,12 +204163,13 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_
       puiseux(k,monomial(c,1))
 
     coerce(ls:ULS) == puiseux(1,ls)
+
     coerce(r:Coef) == r :: ULS  :: %
+
     coerce(i:I)    == i :: Coef :: %
 
     laurentIfCan upxs ==
       r := getExpon upxs
---      one? denom r =>
       (denom r) = 1 =>
         multiplyExponents(getULS upxs,numer(r) :: PI)
       "failed"
@@ -164185,7 +204239,9 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_
       puiseux(r,op(multiplyExponents(ls1,m1),multiplyExponents(ls2,m2)))
 
     pxs1 + pxs2     == applyFcn((z1:ULS,z2:ULS):ULS+->z1 +$ULS z2,pxs1,pxs2)
+
     pxs1 - pxs2     == applyFcn((z1:ULS,z2:ULS):ULS+->z1 -$ULS z2,pxs1,pxs2)
+
     pxs1:% * pxs2:% == applyFcn((z1:ULS,z2:ULS):ULS+->z1 *$ULS z2,pxs1,pxs2)
 
     pxs:% ** n:NNI == puiseux(getExpon pxs,getULS(pxs)**n)
@@ -164218,6 +204274,7 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_
 
     if Coef has "**": (Coef,Integer) -> Coef and
        Coef has "**": (Coef, RN) -> Coef then
+
          eval(upxs:%,a:Coef) == eval(getULS upxs,a ** getExpon(upxs))
 
     if Coef has Field then
@@ -164232,10 +204289,10 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_
 --% values
 
     variable upxs == variable getULS upxs
+
     center   upxs == center   getULS upxs
 
     coefficient(upxs,rn) ==
---      one? denom(n := rn / getExpon upxs) =>
       (denom(n := rn / getExpon upxs)) = 1 =>
         coefficient(getULS upxs,numer n)
       0
@@ -164261,6 +204318,7 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_
       n
 
     order upxs == getExpon upxs * order getULS upxs
+
     order(upxs,r) ==
       e := getExpon upxs
       ord := order(getULS upxs, n := roundDown(r / e))
@@ -164276,6 +204334,7 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_
       puiseux(e,truncate(getULS upxs,roundUp(r1 / e),roundDown(r2 / e)))
 
     complete upxs == puiseux(getExpon upxs,complete getULS upxs)
+
     extend(upxs,r) ==
       e := getExpon upxs
       puiseux(e,extend(getULS upxs,roundDown(r / e)))
@@ -164284,12 +204343,9 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_
 
     characteristic() == characteristic()$Coef
 
-    -- multiplyCoefficients(f,upxs) ==
-      -- r := getExpon upxs
-      -- puiseux(r,multiplyCoefficients(f(#1 * r),getULS upxs))
-
     multiplyExponents(upxs:%,n:RN) ==
       puiseux(n * getExpon(upxs),getULS upxs)
+
     multiplyExponents(upxs:%,n:PI) ==
       puiseux(n * getExpon(upxs),getULS upxs)
 
@@ -164350,9 +204406,9 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_
           error "integrate: center is a function of variable of integration"
 
       if Coef has Field then
+
          (upxs:%) ** (q:RN) ==
            num := numer q; den := denom q
---           one? den => upxs ** num
            den = 1 => upxs ** num
            r := rationalPower upxs; uls := laurentRep upxs
            deg := degree uls
@@ -164368,30 +204424,55 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_
         puiseux(rationalPower upxs,fcn laurentRep upxs)
 
       exp upxs   == applyUnary(exp,upxs)
+
       log upxs   == applyUnary(log,upxs)
+
       sin upxs   == applyUnary(sin,upxs)
+
       cos upxs   == applyUnary(cos,upxs)
+
       tan upxs   == applyUnary(tan,upxs)
+
       cot upxs   == applyUnary(cot,upxs)
+
       sec upxs   == applyUnary(sec,upxs)
+
       csc upxs   == applyUnary(csc,upxs)
+
       asin upxs  == applyUnary(asin,upxs)
+
       acos upxs  == applyUnary(acos,upxs)
+
       atan upxs  == applyUnary(atan,upxs)
+
       acot upxs  == applyUnary(acot,upxs)
+
       asec upxs  == applyUnary(asec,upxs)
+
       acsc upxs  == applyUnary(acsc,upxs)
+
       sinh upxs  == applyUnary(sinh,upxs)
+
       cosh upxs  == applyUnary(cosh,upxs)
+
       tanh upxs  == applyUnary(tanh,upxs)
+
       coth upxs  == applyUnary(coth,upxs)
+
       sech upxs  == applyUnary(sech,upxs)
+
       csch upxs  == applyUnary(csch,upxs)
+
       asinh upxs == applyUnary(asinh,upxs)
+
       acosh upxs == applyUnary(acosh,upxs)
+
       atanh upxs == applyUnary(atanh,upxs)
+
       acoth upxs == applyUnary(acoth,upxs)
+
       asech upxs == applyUnary(asech,upxs)
+
       acsch upxs == applyUnary(acsch,upxs)
 
 \end{chunk}
@@ -164399,6 +204480,350 @@ UnivariatePuiseuxSeriesConstructor(Coef,ULS):_
 \begin{chunk}{COQ UPXSCONS}
 (* domain UPXSCONS *)
 (*
+
+--% representation
+
+    Rep := Record(expon:RN,lSeries:ULS)
+
+    getExpon: % -> RN
+    getULS  : % -> ULS
+
+    getExpon pxs == pxs.expon
+
+    getULS   pxs == pxs.lSeries
+
+--% creation and destruction
+
+    puiseux(n,ls)   == [n,ls]
+
+    laurentRep x    == getULS x
+
+    rationalPower x == getExpon x
+
+    degree x        == getExpon(x) * degree(getULS(x))
+
+    0 == puiseux(1,0)
+
+    1 == puiseux(1,1)
+
+    monomial(c,k) ==
+      k = 0 => c :: %
+      k < 0 => puiseux(-k,monomial(c,-1))
+      puiseux(k,monomial(c,1))
+
+    coerce(ls:ULS) == puiseux(1,ls)
+
+    coerce(r:Coef) == r :: ULS  :: %
+
+    coerce(i:I)    == i :: Coef :: %
+
+    laurentIfCan upxs ==
+      r := getExpon upxs
+      (denom r) = 1 =>
+        multiplyExponents(getULS upxs,numer(r) :: PI)
+      "failed"
+
+    laurent upxs ==
+      (uls := laurentIfCan upxs) case "failed" =>
+        error "laurent: Puiseux series has fractional powers"
+      uls :: ULS
+
+    multExp: (RN,LTerm) -> PTerm
+    multExp(r,lTerm) == [r * lTerm.k,lTerm.c]
+
+    terms upxs == 
+      map((t1:LTerm):PTerm+->multExp(getExpon upxs,t1),terms getULS upxs)$ST2LP
+
+    clearDen: (I,PTerm) -> LTerm
+    clearDen(n,lTerm) ==
+      (int := retractIfCan(n * lTerm.k)@Union(I,"failed")) case "failed" =>
+        error "series: inappropriate denominator"
+      [int :: I,lTerm.c]
+
+    series(n,stream) ==
+      str := map((t1:PTerm):LTerm +-> clearDen(n,t1),stream)$ST2PL
+      puiseux(1/n,series str)
+
+--% normalizations
+
+    rewrite:(%,PI) -> %
+    rewrite(upxs,m) ==
+      -- rewrites a series in x**r as a series in x**(r/m)
+      puiseux((getExpon upxs)*(1/m),multiplyExponents(getULS upxs,m))
+
+    ratGcd: (RN,RN) -> RN
+    ratGcd(r1,r2) ==
+      -- if r1 = prod(p prime,p ** ep(r1)) and
+      -- if r2 = prod(p prime,p ** ep(r2)), then
+      -- ratGcd(r1,r2) = prod(p prime,p ** min(ep(r1),ep(r2)))
+      gcd(numer r1,numer r2) / lcm(denom r1,denom r2)
+
+    withNewExpon:(%,RN) -> %
+    withNewExpon(upxs,r) ==
+      rewrite(upxs,numer(getExpon(upxs)/r) pretend PI)
+
+--% predicates
+
+    upxs1 = upxs2 ==
+      r1 := getExpon upxs1; r2 := getExpon upxs2
+      ls1 := getULS upxs1; ls2 := getULS upxs2
+      (r1 = r2) => (ls1 = ls2)
+      r := ratGcd(r1,r2)
+      m1 := numer(getExpon(upxs1)/r) pretend PI
+      m2 := numer(getExpon(upxs2)/r) pretend PI
+      multiplyExponents(ls1,m1) = multiplyExponents(ls2,m2)
+
+    pole? upxs == pole? getULS upxs
+
+--% arithmetic
+
+    applyFcn:((ULS,ULS) -> ULS,%,%) -> %
+    applyFcn(op,pxs1,pxs2) ==
+      r1 := getExpon pxs1; r2 := getExpon pxs2
+      ls1 := getULS pxs1; ls2 := getULS pxs2
+      (r1 = r2) => puiseux(r1,op(ls1,ls2))
+      r := ratGcd(r1,r2)
+      m1 := numer(getExpon(pxs1)/r) pretend PI
+      m2 := numer(getExpon(pxs2)/r) pretend PI
+      puiseux(r,op(multiplyExponents(ls1,m1),multiplyExponents(ls2,m2)))
+
+    pxs1 + pxs2     == applyFcn((z1:ULS,z2:ULS):ULS+->z1 +$ULS z2,pxs1,pxs2)
+
+    pxs1 - pxs2     == applyFcn((z1:ULS,z2:ULS):ULS+->z1 -$ULS z2,pxs1,pxs2)
+
+    pxs1:% * pxs2:% == applyFcn((z1:ULS,z2:ULS):ULS+->z1 *$ULS z2,pxs1,pxs2)
+
+    pxs:% ** n:NNI == puiseux(getExpon pxs,getULS(pxs)**n)
+
+    recip pxs ==
+      rec := recip getULS pxs
+      rec case "failed" => "failed"
+      puiseux(getExpon pxs,rec :: ULS)
+
+    RATALG : Boolean := Coef has Algebra(Fraction Integer)
+
+    elt(upxs1:%,upxs2:%) ==
+      uls1 := laurentRep upxs1; uls2 := laurentRep upxs2
+      r1 := rationalPower upxs1; r2 := rationalPower upxs2
+      (n := retractIfCan(r1)@Union(Integer,"failed")) case Integer =>
+        puiseux(r2,uls1(uls2 ** r1))
+      RATALG =>
+        if zero? (coef := coefficient(uls2,deg := degree uls2)) then
+          deg := order(uls2,deg + 1000)
+          zero? (coef := coefficient(uls2,deg)) =>
+            error "elt: series with many leading zero coefficients"
+        -- a fractional power of a Laurent series may not be defined:
+        -- if f(x) = c * x**n + ..., then f(x) ** (p/q) will be defined
+        -- only if q divides n
+        b := lcm(denom r1,deg); c := b quo deg
+        mon : ULS := monomial(1,c)
+        uls2 := elt(uls2,mon) ** r1
+        puiseux(r2*(1/c),elt(uls1,uls2))
+      error "elt: rational powers not available for this coefficient domain"
+
+    if Coef has "**": (Coef,Integer) -> Coef and
+       Coef has "**": (Coef, RN) -> Coef then
+
+         eval(upxs:%,a:Coef) == eval(getULS upxs,a ** getExpon(upxs))
+
+    if Coef has Field then
+
+      pxs1:% / pxs2:% == applyFcn((z1:ULS,z2:ULS):ULS+->z1 /$ULS z2,pxs1,pxs2)
+
+      inv upxs ==
+        (invUpxs := recip upxs) case "failed" =>
+          error "inv: multiplicative inverse does not exist"
+        invUpxs :: %
+
+--% values
+
+    variable upxs == variable getULS upxs
+
+    center   upxs == center   getULS upxs
+
+    coefficient(upxs,rn) ==
+      (denom(n := rn / getExpon upxs)) = 1 =>
+        coefficient(getULS upxs,numer n)
+      0
+
+    elt(upxs:%,rn:RN) == coefficient(upxs,rn)
+
+--% other functions
+
+    roundDown: RN -> I
+    roundDown rn ==
+      -- returns the largest integer <= rn
+      (den := denom rn) = 1 => numer rn
+      n := (num := numer rn) quo den
+      positive?(num) => n
+      n - 1
+
+    roundUp: RN -> I
+    roundUp rn ==
+      -- returns the smallest integer >= rn
+      (den := denom rn) = 1 => numer rn
+      n := (num := numer rn) quo den
+      positive?(num) => n + 1
+      n
+
+    order upxs == getExpon upxs * order getULS upxs
+
+    order(upxs,r) ==
+      e := getExpon upxs
+      ord := order(getULS upxs, n := roundDown(r / e))
+      ord = n => r
+      ord * e
+
+    truncate(upxs,r) ==
+      e := getExpon upxs
+      puiseux(e,truncate(getULS upxs,roundDown(r / e)))
+
+    truncate(upxs,r1,r2) ==
+      e := getExpon upxs
+      puiseux(e,truncate(getULS upxs,roundUp(r1 / e),roundDown(r2 / e)))
+
+    complete upxs == puiseux(getExpon upxs,complete getULS upxs)
+
+    extend(upxs,r) ==
+      e := getExpon upxs
+      puiseux(e,extend(getULS upxs,roundDown(r / e)))
+
+    map(fcn,upxs) == puiseux(getExpon upxs,map(fcn,getULS upxs))
+
+    characteristic() == characteristic()$Coef
+
+    multiplyExponents(upxs:%,n:RN) ==
+      puiseux(n * getExpon(upxs),getULS upxs)
+
+    multiplyExponents(upxs:%,n:PI) ==
+      puiseux(n * getExpon(upxs),getULS upxs)
+
+    if Coef has "*": (Fraction Integer, Coef) -> Coef then
+
+      differentiate upxs ==
+        r := getExpon upxs
+        puiseux(r,differentiate getULS upxs) * monomial(r :: Coef,r-1)
+
+      if Coef has PartialDifferentialRing(Symbol) then
+
+        differentiate(upxs:%,s:Symbol) ==
+          (s = variable(upxs)) => differentiate upxs
+          dcds := differentiate(center upxs,s)
+          map((z1:Coef):Coef+->differentiate(z1,s),upxs)
+                                               - dcds*differentiate(upxs)
+
+    if Coef has Algebra Fraction Integer then
+
+      coerce(r:RN) == r :: Coef :: %
+
+      ratInv: RN -> Coef
+      ratInv r ==
+        zero? r => 1
+        inv(r) :: Coef
+
+      integrate upxs ==
+        not zero? coefficient(upxs,-1) =>
+          error "integrate: series has term of order -1"
+        r := getExpon upxs
+        uls := getULS upxs
+        uls := multiplyCoefficients((z1:Integer):Coef+->ratInv(z1*r+1),uls)
+        monomial(1,1) * puiseux(r,uls)
+
+      if Coef has integrate: (Coef,Symbol) -> Coef and _
+         Coef has variables: Coef -> List Symbol then
+
+        integrate(upxs:%,s:Symbol) ==
+          (s = variable(upxs)) => integrate upxs
+          not entry?(s,variables center upxs) 
+            => map((z1:Coef):Coef +-> integrate(z1,s),upxs)
+          error "integrate: center is a function of variable of integration"
+
+      if Coef has TranscendentalFunctionCategory and _
+         Coef has PrimitiveFunctionCategory and _
+         Coef has AlgebraicallyClosedFunctionSpace Integer then
+
+        integrateWithOneAnswer: (Coef,Symbol) -> Coef
+        integrateWithOneAnswer(f,s) ==
+          res := integrate(f,s)$FunctionSpaceIntegration(I,Coef)
+          res case Coef => res :: Coef
+          first(res :: List Coef)
+
+        integrate(upxs:%,s:Symbol) ==
+          (s = variable(upxs)) => integrate upxs
+          not entry?(s,variables center upxs) =>
+            map((z1:Coef):Coef +-> integrateWithOneAnswer(z1,s),upxs)
+          error "integrate: center is a function of variable of integration"
+
+      if Coef has Field then
+
+         (upxs:%) ** (q:RN) ==
+           num := numer q; den := denom q
+           den = 1 => upxs ** num
+           r := rationalPower upxs; uls := laurentRep upxs
+           deg := degree uls
+           if zero?(coef := coefficient(uls,deg)) then
+             deg := order(uls,deg + 1000)
+             zero?(coef := coefficient(uls,deg)) =>
+               error "power of series with many leading zero coefficients"
+           ulsPow := (uls * monomial(1,-deg)$ULS) ** q
+           puiseux(r,ulsPow) * monomial(1,deg*q*r)
+
+      applyUnary: (ULS -> ULS,%) -> %
+      applyUnary(fcn,upxs) ==
+        puiseux(rationalPower upxs,fcn laurentRep upxs)
+
+      exp upxs   == applyUnary(exp,upxs)
+
+      log upxs   == applyUnary(log,upxs)
+
+      sin upxs   == applyUnary(sin,upxs)
+
+      cos upxs   == applyUnary(cos,upxs)
+
+      tan upxs   == applyUnary(tan,upxs)
+
+      cot upxs   == applyUnary(cot,upxs)
+
+      sec upxs   == applyUnary(sec,upxs)
+
+      csc upxs   == applyUnary(csc,upxs)
+
+      asin upxs  == applyUnary(asin,upxs)
+
+      acos upxs  == applyUnary(acos,upxs)
+
+      atan upxs  == applyUnary(atan,upxs)
+
+      acot upxs  == applyUnary(acot,upxs)
+
+      asec upxs  == applyUnary(asec,upxs)
+
+      acsc upxs  == applyUnary(acsc,upxs)
+
+      sinh upxs  == applyUnary(sinh,upxs)
+
+      cosh upxs  == applyUnary(cosh,upxs)
+
+      tanh upxs  == applyUnary(tanh,upxs)
+
+      coth upxs  == applyUnary(coth,upxs)
+
+      sech upxs  == applyUnary(sech,upxs)
+
+      csch upxs  == applyUnary(csch,upxs)
+
+      asinh upxs == applyUnary(asinh,upxs)
+
+      acosh upxs == applyUnary(acosh,upxs)
+
+      atanh upxs == applyUnary(atanh,upxs)
+
+      acoth upxs == applyUnary(acoth,upxs)
+
+      asech upxs == applyUnary(asech,upxs)
+
+      acsch upxs == applyUnary(acsch,upxs)
+
 *)
 
 \end{chunk}
@@ -164619,6 +205044,7 @@ UnivariatePuiseuxSeriesWithExponentialSingularity(R,FE,var,cen):_
       ++ Puiseux series.
 
   Implementation ==> PolynomialRing(UPXS,EXPUPXS) add
+
     makeTerm : (UPXS,EXPUPXS) -> Term
     coeff : Term -> UPXS
     exponent : Term -> EXPUPXS
@@ -164642,10 +205068,15 @@ UnivariatePuiseuxSeriesWithExponentialSingularity(R,FE,var,cen):_
       "failed"
 
     makeTerm(coef,expon) == [coef,expon,empty()]
+
     coeff term == term.%coef
+
     exponent term == term.%expon
+
     exponentTerms term == term.%expTerms
+
     setExponentTerms_!(term,list) == term.%expTerms := list
+
     computeExponentTerms_! term ==
       setExponentTerms_!(term,entries complete terms exponent term)
 
@@ -164837,6 +205268,225 @@ UnivariatePuiseuxSeriesWithExponentialSingularity(R,FE,var,cen):_
 \begin{chunk}{COQ UPXSSING}
 (* domain UPXSSING *)
 (*
+
+    makeTerm : (UPXS,EXPUPXS) -> Term
+    coeff : Term -> UPXS
+    exponent : Term -> EXPUPXS
+    exponentTerms : Term -> List PxRec
+    setExponentTerms_! : (Term,List PxRec) -> List PxRec
+    computeExponentTerms_! : Term -> List PxRec
+    terms : % -> List Term
+    sortAndDiscardTerms: List Term -> TRec
+    termsWithExtremeLeadingCoef : (L Term,RN,I) -> Union(L Term,"failed")
+    filterByOrder: (L Term,(RN,RN) -> B) -> Record(%list:L Term,%order:RN)
+    dominantTermOnList : (L Term,RN,I) -> Union(Term,"failed")
+    iDominantTerm : L Term -> Union(Record(%term:Term,%type:String),"failed")
+
+    retractIfCan f ==
+      (numberOfMonomials f = 1) and (zero? degree f) => leadingCoefficient f
+      "failed"
+
+    recip f ==
+      numberOfMonomials f = 1 =>
+        monomial(inv leadingCoefficient f,- degree f)
+      "failed"
+
+    makeTerm(coef,expon) == [coef,expon,empty()]
+
+    coeff term == term.%coef
+
+    exponent term == term.%expon
+
+    exponentTerms term == term.%expTerms
+
+    setExponentTerms_!(term,list) == term.%expTerms := list
+
+    computeExponentTerms_! term ==
+      setExponentTerms_!(term,entries complete terms exponent term)
+
+    terms f ==
+      -- terms with a higher order singularity will appear closer to the
+      -- beginning of the list because of the ordering in EXPPUPXS;
+      -- no "expnonent terms" are computed by this function
+      zero? f => empty()
+      concat(makeTerm(leadingCoefficient f,degree f),terms reductum f)
+
+    sortAndDiscardTerms termList ==
+      -- 'termList' is the list of terms of some function f(var), ordered
+      -- so that terms with a higher order singularity occur at the
+      -- beginning of the list.
+      -- This function returns lists of candidates for the "dominant
+      -- term" in 'termList', i.e. the term which describes the
+      -- asymptotic behavior of f(var) as var -> cen+.
+      -- 'zeroTerms' will contain terms which tend to zero exponentially
+      -- and contains only those terms with the lowest order singularity.
+      -- 'zeroTerms' will be non-empty only when there are no terms of
+      -- infinite or series type.
+      -- 'infiniteTerms' will contain terms which tend to infinity
+      -- exponentially and contains only those terms with the highest
+      -- order singularity.
+      -- 'failedTerms' will contain terms which have an exponential
+      -- singularity, where we cannot say whether the limiting value
+      -- is zero or infinity. Only terms with a higher order sigularity
+      -- than the terms on 'infiniteList' are included.
+      -- 'pSeries' will be a Puiseux series representing a term without an
+      -- exponential singularity.  'pSeries' will be non-zero only when no
+      -- other terms are known to tend to infinity exponentially
+      zeroTerms : List Term := empty()
+      infiniteTerms : List Term := empty()
+      failedTerms : List Term := empty()
+      -- we keep track of whether or not we've found an infinite term
+      -- if so, 'infTermOrd' will be set to a negative value
+      infTermOrd : RN := 0
+      -- we keep track of whether or not we've found a zero term
+      -- if so, 'zeroTermOrd' will be set to a negative value
+      zeroTermOrd : RN := 0
+      ord : RN := 0; pSeries : UPXS := 0  -- dummy values
+      while not empty? termList repeat
+        -- 'expon' is a Puiseux series
+        expon := exponent(term := first termList)
+        -- quit if there is an infinite term with a higher order singularity
+        (ord := order(expon,0)) > infTermOrd => leave "infinite term dominates"
+        -- if ord = 0, we've hit the end of the list
+        (ord = 0) =>
+          -- since we have a series term, don't bother with zero terms
+          leave(pSeries := coeff(term); zeroTerms := empty())
+        coef := coefficient(expon,ord)
+        -- if we can't tell if the lowest order coefficient is positive or
+        -- negative, we have a "failed term"
+        (signum := sign(coef)$SIGNEF) case "failed" =>
+          failedTerms := concat(term,failedTerms)
+          termList := rest termList
+        -- if the lowest order coefficient is positive, we have an
+        -- "infinite term"
+        (sig := signum :: Integer) = 1 =>
+          infTermOrd := ord
+          infiniteTerms := concat(term,infiniteTerms)
+          -- since we have an infinite term, don't bother with zero terms
+          zeroTerms := empty()
+          termList := rest termList
+        -- if the lowest order coefficient is negative, we have a
+        -- "zero term" if there are no infinite terms and no failed
+        -- terms, add the term to 'zeroTerms'
+        if empty? infiniteTerms then
+          zeroTerms :=
+            ord = zeroTermOrd => concat(term,zeroTerms)
+            zeroTermOrd := ord
+            list term
+        termList := rest termList
+      -- reverse "failed terms" so that higher order singularities
+      -- appear at the beginning of the list
+      [zeroTerms,infiniteTerms,reverse_! failedTerms,pSeries]
+
+    termsWithExtremeLeadingCoef(termList,ord,signum) ==
+      -- 'termList' consists of terms of the form [g(x),exp(f(x)),...];
+      -- when 'signum' is +1 (resp. -1), this function filters 'termList'
+      -- leaving only those terms such that coefficient(f(x),ord) is
+      -- maximal (resp. minimal)
+      while (coefficient(exponent first termList,ord) = 0) repeat
+        termList := rest termList
+      empty? termList => error "UPXSSING: can't happen"
+      coefExtreme := coefficient(exponent first termList,ord)
+      outList := list first termList; termList := rest termList
+      for term in termList repeat
+        (coefDiff := coefficient(exponent term,ord) - coefExtreme) = 0 =>
+          outList := concat(term,outList)
+        (sig := sign(coefDiff)$SIGNEF) case "failed" => return "failed"
+        (sig :: Integer) = signum => outList := list term
+      outList
+
+    filterByOrder(termList,predicate) ==
+      -- 'termList' consists of terms of the form [g(x),exp(f(x)),expTerms],
+      -- where 'expTerms' is a list containing some of the terms in the
+      -- series f(x).
+      -- The function filters 'termList' and, when 'predicate' is < (resp. >),
+      -- leaves only those terms with the lowest (resp. highest) order term
+      -- in 'expTerms'
+      while empty? exponentTerms first termList repeat
+        termList := rest termList
+        empty? termList => error "UPXSING: can't happen"
+      ordExtreme := (first exponentTerms first termList).k
+      outList := list first termList
+      for term in rest termList repeat
+        not empty? exponentTerms term =>
+          (ord := (first exponentTerms term).k) = ordExtreme =>
+            outList := concat(term,outList)
+          predicate(ord,ordExtreme) =>
+            ordExtreme := ord
+            outList := list term
+      -- advance pointers on "exponent terms" on terms on 'outList'
+      for term in outList repeat
+        setExponentTerms_!(term,rest exponentTerms term)
+      [outList,ordExtreme]
+
+    dominantTermOnList(termList,ord0,signum) ==
+      -- finds dominant term on 'termList'
+      -- it is known that "exponent terms" of order < 'ord0' are
+      -- the same for all terms on 'termList'
+      newList := termsWithExtremeLeadingCoef(termList,ord0,signum)
+      newList case "failed" => "failed"
+      termList := newList :: List Term
+      empty? rest termList => first termList
+      filtered :=
+        signum = 1 => filterByOrder(termList,(x,y) +-> x < y)
+        filterByOrder(termList,(x,y) +-> x > y)
+      termList := filtered.%list
+      empty? rest termList => first termList
+      dominantTermOnList(termList,filtered.%order,signum)
+
+    iDominantTerm termList ==
+      termRecord := sortAndDiscardTerms termList
+      zeroTerms := termRecord.%zeroTerms
+      infiniteTerms := termRecord.%infiniteTerms
+      failedTerms := termRecord.%failedTerms
+      pSeries := termRecord.%puiseuxSeries
+      -- in future versions, we will deal with "failed terms"
+      -- at present, if any occur, we cannot determine the limit
+      not empty? failedTerms => "failed"
+      not zero? pSeries => [makeTerm(pSeries,0),"series"]
+      not empty? infiniteTerms =>
+        empty? rest infiniteTerms => [first infiniteTerms,"infinity"]
+        for term in infiniteTerms repeat computeExponentTerms_! term
+        ord0 := order exponent first infiniteTerms
+        (dTerm := dominantTermOnList(infiniteTerms,ord0,1)) case "failed" =>
+          return "failed"
+        [dTerm :: Term,"infinity"]
+      empty? rest zeroTerms => [first zeroTerms,"zero"]
+      for term in zeroTerms repeat computeExponentTerms_! term
+      ord0 := order exponent first zeroTerms
+      (dTerm := dominantTermOnList(zeroTerms,ord0,-1)) case "failed" =>
+        return "failed"
+      [dTerm :: Term,"zero"]
+
+    dominantTerm f == iDominantTerm terms f
+
+    limitPlus f ==
+      -- list the terms occurring in 'f'; if there are none, then f = 0
+      empty?(termList := terms f) => 0
+      -- compute dominant term
+      (tInfo := iDominantTerm termList) case "failed" => "failed"
+      termInfo := tInfo :: Record(%term:Term,%type:String)
+      domTerm := termInfo.%term
+      (type := termInfo.%type) = "series" =>
+        -- find limit of series term
+        (ord := order(pSeries := coeff domTerm,1)) > 0 => 0
+        coef := coefficient(pSeries,ord)
+        member?(var,variables coef) => "failed"
+        ord = 0 => coef :: OFE
+        -- in the case of an infinite limit, we need to know the sign
+        -- of the first non-zero coefficient
+        (signum := sign(coef)$SIGNEF) case "failed" => "failed"
+        (signum :: Integer) = 1 => plusInfinity()
+        minusInfinity()
+      type = "zero" => 0
+      -- examine lowest order coefficient in series part of 'domTerm'
+      ord := order(pSeries := coeff domTerm)
+      coef := coefficient(pSeries,ord)
+      member?(var,variables coef) => "failed"
+      (signum := sign(coef)$SIGNEF) case "failed" => "failed"
+      (signum :: Integer) = 1 => plusInfinity()
+      minusInfinity()
+
 *)
 
 \end{chunk}
@@ -165581,8 +206231,11 @@ UnivariateSkewPolynomial(x:Symbol,R:Ring,sigma:Automorphism R,delta: R -> R):
    coerce: Variable x -> %
      ++ coerce(x) returns x as a skew-polynomial.
   == SparseUnivariateSkewPolynomial(R, sigma, delta) add
+
      Rep := SparseUnivariateSkewPolynomial(R, sigma, delta)
+
      coerce(v:Variable(x)):% == monomial(1, 1)
+
      coerce(p:%):OutputForm  == outputForm(p, outputForm x)$Rep
 
 \end{chunk}
@@ -165590,6 +206243,13 @@ UnivariateSkewPolynomial(x:Symbol,R:Ring,sigma:Automorphism R,delta: R -> R):
 \begin{chunk}{COQ OREUP}
 (* domain OREUP *)
 (*
+
+     Rep := SparseUnivariateSkewPolynomial(R, sigma, delta)
+
+     coerce(v:Variable(x)):% == monomial(1, 1)
+
+     coerce(p:%):OutputForm  == outputForm(p, outputForm x)$Rep
+
 *)
 
 \end{chunk}
@@ -165949,13 +206609,225 @@ UnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where
       monomial(1,1) + monomial(cen,0)
 
     coerce(n:I)    == n :: Coef :: %
+
+    coerce(r:Coef) == coerce(r)$STT
+
+    monomial(c,n)  == monom(c,n)$STT
+
+    getExpon: TERM -> NNI
+    getExpon term == term.k
+
+    getCoef: TERM -> Coef
+    getCoef term == term.c
+
+    rec: (NNI,Coef) -> TERM
+    rec(expon,coef) == [expon,coef]
+
+    recs: (ST Coef,NNI) -> ST TERM
+    recs(st,n) == delay$ST(TERM)
+      empty? st => empty()
+      zero? (coef := frst st) => recs(rst st,n + 1)
+      concat(rec(n,coef),recs(rst st,n + 1))
+
+    terms x == recs(stream x,0)
+
+    recsToCoefs: (ST TERM,NNI) -> ST Coef
+    recsToCoefs(st,n) == delay
+      empty? st => empty()
+      term := frst st; expon := getExpon term
+      n = expon => concat(getCoef term,recsToCoefs(rst st,n + 1))
+      concat(0,recsToCoefs(st,n + 1))
+
+    series(st: ST TERM) == recsToCoefs(st,0)
+
+    stToPoly: (ST Coef,P,NNI,NNI) -> P
+    stToPoly(st,term,n,n0) ==
+      (n > n0) or (empty? st) => 0
+      frst(st) * term ** n + stToPoly(rst st,term,n + 1,n0)
+
+    polynomial(x,n) == stToPoly(stream x,(var :: P) - (cen :: P),0,n)
+
+    polynomial(x,n1,n2) ==
+      if n1 > n2 then (n1,n2) := (n2,n1)
+      stToPoly(rest(stream x,n1),(var :: P) - (cen :: P),n1,n2)
+
+    stToUPoly: (ST Coef,UP,NNI,NNI) -> UP
+    stToUPoly(st,term,n,n0) ==
+      (n > n0) or (empty? st) => 0
+      frst(st) * term ** n + stToUPoly(rst st,term,n + 1,n0)
+
+    univariatePolynomial(x,n) ==
+      stToUPoly(stream x,monomial(1,1)$UP - monomial(cen,0)$UP,0,n)
+
+    coerce(p:UP) ==
+      zero? p => 0
+      if not zero? cen then
+        p := p(monomial(1,1)$UP + monomial(cen,0)$UP)
+      st : ST Coef := empty()
+      oldDeg : NNI := degree(p) + 1
+      while not zero? p repeat
+        deg := degree p
+        delta := (oldDeg - deg - 1) :: NNI
+        for i in 1..delta repeat st := concat(0$Coef,st)
+        st := concat(leadingCoefficient p,st)
+        oldDeg := deg; p := reductum p
+      for i in 1..oldDeg repeat st := concat(0$Coef,st)
+      st
+
+    if Coef has coerce: Symbol -> Coef then
+      if Coef has "**": (Coef,NNI) -> Coef then
+
+        stToCoef: (ST Coef,Coef,NNI,NNI) -> Coef
+        stToCoef(st,term,n,n0) ==
+          (n > n0) or (empty? st) => 0
+          frst(st) * term ** n + stToCoef(rst st,term,n + 1,n0)
+
+        approximate(x,n) ==
+          stToCoef(stream x,(var :: Coef) - cen,0,n)
+
+--% values
+
+    variable x == var
+
+    center   s == cen
+
+    coefficient(x,n) ==
+       -- Cannot use elt!  Should return 0 if stream doesn't have it.
+       u := stream x
+       while not empty? u and n > 0 repeat
+         u := rst u
+         n := (n - 1) :: NNI
+       empty? u or n ^= 0 => 0
+       frst u
+
+    elt(x:%,n:NNI) == coefficient(x,n)
+
+--% functions
+
+    map(f,x) == map(f,x)$Rep
+
+    eval(x:%,r:Coef) == eval(stream x,r-cen)$STT
+
+    differentiate x == deriv(stream x)$STT
+
+    differentiate(x:%,v:Variable(var)) == differentiate x
+
+    if Coef has PartialDifferentialRing(Symbol) then
+
+      differentiate(x:%,s:Symbol) ==
+        (s = variable(x)) => differentiate x
+        map(y +-> differentiate(y,s),x) 
+              - differentiate(center x,s)*differentiate(x)
+
+    multiplyCoefficients(f,x) == gderiv(f,stream x)$STT
+
+    lagrange x == lagrange(stream x)$STT
+
+    lambert x == lambert(stream x)$STT
+
+    oddlambert x == oddlambert(stream x)$STT
+
+    evenlambert x == evenlambert(stream x)$STT
+
+    generalLambert(x:%,a:I,d:I) == generalLambert(stream x,a,d)$STT
+
+    extend(x,n) == extend(x,n+1)$Rep
+
+    complete x == complete(x)$Rep
+
+    truncate(x,n) == first(stream x,n + 1)$Rep
+
+    truncate(x,n1,n2) ==
+      if n2 < n1 then (n1,n2) := (n2,n1)
+      m := (n2 - n1) :: NNI
+      st := first(rest(stream x,n1)$Rep,m + 1)$Rep
+      for i in 1..n1 repeat st := concat(0$Coef,st)
+      st
+
+    elt(x:%,y:%) == compose(stream x,stream y)$STT
+
+    revert x == revert(stream x)$STT
+
+    multisect(a,b,x) == multisect(a,b,stream x)$STT
+
+    invmultisect(a,b,x) == invmultisect(a,b,stream x)$STT
+
+    multiplyExponents(x,n) == invmultisect(n,0,x)
+
+    quoByVar x == (empty? x => 0; rst x)
+
+    if Coef has IntegralDomain then
+      unit? x == unit? coefficient(x,0)
+    if Coef has Field then
+      if Coef is RN then
+
+        (x:%) ** (s:Coef) == powern(s,stream x)$STT
+
+      else
+
+        (x:%) ** (s:Coef) == power(s,stream x)$STT
+
+    if Coef has Algebra Fraction Integer then
+
+      coerce(r:RN) == r :: Coef :: %
+
+      integrate x == integrate(0,stream x)$STT
+
+      integrate(x:%,v:Variable(var)) == integrate x
+
+      if Coef has integrate: (Coef,Symbol) -> Coef and _
+         Coef has variables: Coef -> List Symbol then
+
+        integrate(x:%,s:Symbol) ==
+          (s = variable(x)) => integrate x
+          not entry?(s,variables center x) => map(y +-> integrate(y,s),x)
+          error "integrate: center is a function of variable of integration"
+
+      if Coef has TranscendentalFunctionCategory and _
+         Coef has PrimitiveFunctionCategory and _
+         Coef has AlgebraicallyClosedFunctionSpace Integer then
+
+        integrateWithOneAnswer: (Coef,Symbol) -> Coef
+        integrateWithOneAnswer(f,s) ==
+          res := integrate(f,s)$FunctionSpaceIntegration(I,Coef)
+          res case Coef => res :: Coef
+          first(res :: List Coef)
+
+        integrate(x:%,s:Symbol) ==
+          (s = variable(x)) => integrate x
+          not entry?(s,variables center x) =>
+            map(y +-> integrateWithOneAnswer(y,s),x)
+          error "integrate: center is a function of variable of integration"
+
+\end{chunk}
+
+\begin{chunk}{COQ UTS}
+(* domain UTS *)
+(*
+
+    Rep := Stream Coef
+
+--% creation and destruction of series
+
+    stream: % -> Stream Coef
+    stream x  == x pretend Stream(Coef)
+
+    coerce(v:Variable(var)) ==
+      zero? cen => monomial(1,1)
+      monomial(1,1) + monomial(cen,0)
+
+    coerce(n:I)    == n :: Coef :: %
+
     coerce(r:Coef) == coerce(r)$STT
+
     monomial(c,n)  == monom(c,n)$STT
 
     getExpon: TERM -> NNI
     getExpon term == term.k
+
     getCoef: TERM -> Coef
     getCoef term == term.c
+
     rec: (NNI,Coef) -> TERM
     rec(expon,coef) == [expon,coef]
 
@@ -166024,6 +206896,7 @@ UnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where
 --% values
 
     variable x == var
+
     center   s == cen
 
     coefficient(x,n) ==
@@ -166040,51 +206913,79 @@ UnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where
 --% functions
 
     map(f,x) == map(f,x)$Rep
+
     eval(x:%,r:Coef) == eval(stream x,r-cen)$STT
+
     differentiate x == deriv(stream x)$STT
+
     differentiate(x:%,v:Variable(var)) == differentiate x
+
     if Coef has PartialDifferentialRing(Symbol) then
+
       differentiate(x:%,s:Symbol) ==
         (s = variable(x)) => differentiate x
         map(y +-> differentiate(y,s),x) 
               - differentiate(center x,s)*differentiate(x)
+
     multiplyCoefficients(f,x) == gderiv(f,stream x)$STT
+
     lagrange x == lagrange(stream x)$STT
+
     lambert x == lambert(stream x)$STT
+
     oddlambert x == oddlambert(stream x)$STT
+
     evenlambert x == evenlambert(stream x)$STT
+
     generalLambert(x:%,a:I,d:I) == generalLambert(stream x,a,d)$STT
+
     extend(x,n) == extend(x,n+1)$Rep
+
     complete x == complete(x)$Rep
+
     truncate(x,n) == first(stream x,n + 1)$Rep
+
     truncate(x,n1,n2) ==
       if n2 < n1 then (n1,n2) := (n2,n1)
       m := (n2 - n1) :: NNI
       st := first(rest(stream x,n1)$Rep,m + 1)$Rep
       for i in 1..n1 repeat st := concat(0$Coef,st)
       st
+
     elt(x:%,y:%) == compose(stream x,stream y)$STT
+
     revert x == revert(stream x)$STT
+
     multisect(a,b,x) == multisect(a,b,stream x)$STT
+
     invmultisect(a,b,x) == invmultisect(a,b,stream x)$STT
+
     multiplyExponents(x,n) == invmultisect(n,0,x)
+
     quoByVar x == (empty? x => 0; rst x)
+
     if Coef has IntegralDomain then
       unit? x == unit? coefficient(x,0)
     if Coef has Field then
       if Coef is RN then
+
         (x:%) ** (s:Coef) == powern(s,stream x)$STT
+
       else
+
         (x:%) ** (s:Coef) == power(s,stream x)$STT
 
     if Coef has Algebra Fraction Integer then
+
       coerce(r:RN) == r :: Coef :: %
 
       integrate x == integrate(0,stream x)$STT
+
       integrate(x:%,v:Variable(var)) == integrate x
 
       if Coef has integrate: (Coef,Symbol) -> Coef and _
          Coef has variables: Coef -> List Symbol then
+
         integrate(x:%,s:Symbol) ==
           (s = variable(x)) => integrate x
           not entry?(s,variables center x) => map(y +-> integrate(y,s),x)
@@ -166106,14 +207007,6 @@ UnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where
             map(y +-> integrateWithOneAnswer(y,s),x)
           error "integrate: center is a function of variable of integration"
 
---% OutputForms
---  We use the default coerce: % -> OutputForm in UTSCAT&
-
-\end{chunk}
-
-\begin{chunk}{COQ UTS}
-(* domain UTS *)
-(*
 *)
 
 \end{chunk}
@@ -166458,13 +207351,17 @@ UnivariateTaylorSeriesCZero(Coef,var): Exports == Implementation where
       monomial(1,1)
       
     coerce(n:I)    == n :: Coef :: %
+
     coerce(r:Coef) == coerce(r)$STT
+
     monomial(c,n)  == monom(c,n)$STT
 
     getExpon: TERM -> NNI
     getExpon term == term.k
+
     getCoef: TERM -> Coef
     getCoef term == term.c
+
     rec: (NNI,Coef) -> TERM
     rec(expon,coef) == [expon,coef]
 
@@ -166531,6 +207428,7 @@ UnivariateTaylorSeriesCZero(Coef,var): Exports == Implementation where
 --% values
 
     variable x == var
+
     center   x == 0$Coef
     
     coefficient(x,n) ==
@@ -166547,50 +207445,80 @@ UnivariateTaylorSeriesCZero(Coef,var): Exports == Implementation where
 --% functions
 
     map(f,x) == map(f,x)$Rep
+
     eval(x:%,r:Coef) == eval(stream x,r)$STT
+
     differentiate x == deriv(stream x)$STT
+
     differentiate(x:%,v:Variable(var)) == differentiate x
+
     if Coef has PartialDifferentialRing(Symbol) then
+
       differentiate(x:%,s:Symbol) ==
         (s = variable(x)) => differentiate x
         map(differentiate(#1,s),x) - differentiate(0,s)*differentiate(x)
+
     multiplyCoefficients(f,x) == gderiv(f,stream x)$STT
+
     lagrange x == lagrange(stream x)$STT
+
     lambert x == lambert(stream x)$STT
+
     oddlambert x == oddlambert(stream x)$STT
+
     evenlambert x == evenlambert(stream x)$STT
+
     generalLambert(x:%,a:I,d:I) == generalLambert(stream x,a,d)$STT
+
     extend(x,n) == extend(x,n+1)$Rep
+
     complete x == complete(x)$Rep
+
     truncate(x,n) == first(stream x,n + 1)$Rep
+
     truncate(x,n1,n2) ==
       if n2 < n1 then (n1,n2) := (n2,n1)
       m := (n2 - n1) :: NNI
       st := first(rest(stream x,n1)$Rep,m + 1)$Rep
       for i in 1..n1 repeat st := concat(0$Coef,st)
       st
+
     elt(x:%,y:%) == compose(stream x,stream y)$STT
+
     revert x == revert(stream x)$STT
+
     multisect(a,b,x) == multisect(a,b,stream x)$STT
+
     invmultisect(a,b,x) == invmultisect(a,b,stream x)$STT
+
     multiplyExponents(x,n) == invmultisect(n,0,x)
+
     quoByVar x == (empty? x => 0; rst x)
+
     if Coef has IntegralDomain then
+
       unit? x == unit? coefficient(x,0)
+
     if Coef has Field then
       if Coef is RN then
+
         (x:%) ** (s:Coef) == powern(s,stream x)$STT
+
       else
+
         (x:%) ** (s:Coef) == power(s,stream x)$STT
 
     if Coef has Algebra Fraction Integer then
+
       coerce(r:RN) == r :: Coef :: %
 
       integrate x == integrate(0,stream x)$STT
+
       integrate(x:%,v:Variable(var)) == integrate x
 
       if Coef has integrate: (Coef,Symbol) -> Coef and _
          Coef has variables: Coef -> List Symbol then
+
         integrate(x:%,s:Symbol) ==
           (s = variable(x)) => integrate x
           map(integrate(#1,s),x)
@@ -166614,6 +207542,204 @@ UnivariateTaylorSeriesCZero(Coef,var): Exports == Implementation where
 \begin{chunk}{COQ UTSZ}
 (* domain UTSZ *)
 (*
+
+    Rep := Stream Coef
+
+    --% creation and destruction of series
+
+    stream: % -> Stream Coef
+    stream x  == x pretend Stream(Coef)
+
+    coerce(v:Variable(var)) ==
+      monomial(1,1)
+      
+    coerce(n:I)    == n :: Coef :: %
+
+    coerce(r:Coef) == coerce(r)$STT
+
+    monomial(c,n)  == monom(c,n)$STT
+
+    getExpon: TERM -> NNI
+    getExpon term == term.k
+
+    getCoef: TERM -> Coef
+    getCoef term == term.c
+
+    rec: (NNI,Coef) -> TERM
+    rec(expon,coef) == [expon,coef]
+
+    recs: (ST Coef,NNI) -> ST TERM
+    recs(st,n) == delay$ST(TERM)
+      empty? st => empty()
+      zero? (coef := frst st) => recs(rst st,n + 1)
+      concat(rec(n,coef),recs(rst st,n + 1))
+
+    terms x == recs(stream x,0)
+
+    recsToCoefs: (ST TERM,NNI) -> ST Coef
+    recsToCoefs(st,n) == delay
+      empty? st => empty()
+      term := frst st; expon := getExpon term
+      n = expon => concat(getCoef term,recsToCoefs(rst st,n + 1))
+      concat(0,recsToCoefs(st,n + 1))
+
+    series(st: ST TERM) == recsToCoefs(st,0)
+
+    stToPoly: (ST Coef,P,NNI,NNI) -> P
+    stToPoly(st,term,n,n0) ==
+      (n > n0) or (empty? st) => 0
+      frst(st) * term ** n + stToPoly(rst st,term,n + 1,n0)
+
+    polynomial(x,n) == stToPoly(stream x,(var :: P),0,n)
+
+    polynomial(x,n1,n2) ==
+      if n1 > n2 then (n1,n2) := (n2,n1)
+      stToPoly(rest(stream x,n1),(var :: P),n1,n2)
+
+    stToUPoly: (ST Coef,UP,NNI,NNI) -> UP
+    stToUPoly(st,term,n,n0) ==
+      (n > n0) or (empty? st) => 0
+      frst(st) * term ** n + stToUPoly(rst st,term,n + 1,n0)
+
+    univariatePolynomial(x,n) ==
+      stToUPoly(stream x,monomial(1,1)$UP,0,n)
+
+    coerce(p:UP) ==
+      zero? p => 0
+      st : ST Coef := empty()
+      oldDeg : NNI := degree(p) + 1
+      while not zero? p repeat
+        deg := degree p
+        delta := (oldDeg - deg - 1) :: NNI
+        for i in 1..delta repeat st := concat(0$Coef,st)
+        st := concat(leadingCoefficient p,st)
+        oldDeg := deg; p := reductum p
+      for i in 1..oldDeg repeat st := concat(0$Coef,st)
+      st
+
+    if Coef has coerce: Symbol -> Coef then
+      if Coef has "**": (Coef,NNI) -> Coef then
+
+        stToCoef: (ST Coef,Coef,NNI,NNI) -> Coef
+        stToCoef(st,term,n,n0) ==
+          (n > n0) or (empty? st) => 0
+          frst(st) * term ** n + stToCoef(rst st,term,n + 1,n0)
+
+        approximate(x,n) ==
+          stToCoef(stream x,(var :: Coef),0,n)
+
+--% values
+
+    variable x == var
+
+    center   x == 0$Coef
+    
+    coefficient(x,n) ==
+       -- Cannot use elt!  Should return 0 if stream doesn't have it.
+       u := stream x
+       while not empty? u and n > 0 repeat
+         u := rst u
+         n := (n - 1) :: NNI
+       empty? u or n ^= 0 => 0
+       frst u
+
+    elt(x:%,n:NNI) == coefficient(x,n)
+
+--% functions
+
+    map(f,x) == map(f,x)$Rep
+
+    eval(x:%,r:Coef) == eval(stream x,r)$STT
+
+    differentiate x == deriv(stream x)$STT
+
+    differentiate(x:%,v:Variable(var)) == differentiate x
+
+    if Coef has PartialDifferentialRing(Symbol) then
+
+      differentiate(x:%,s:Symbol) ==
+        (s = variable(x)) => differentiate x
+        map(differentiate(#1,s),x) - differentiate(0,s)*differentiate(x)
+
+    multiplyCoefficients(f,x) == gderiv(f,stream x)$STT
+
+    lagrange x == lagrange(stream x)$STT
+
+    lambert x == lambert(stream x)$STT
+
+    oddlambert x == oddlambert(stream x)$STT
+
+    evenlambert x == evenlambert(stream x)$STT
+
+    generalLambert(x:%,a:I,d:I) == generalLambert(stream x,a,d)$STT
+
+    extend(x,n) == extend(x,n+1)$Rep
+
+    complete x == complete(x)$Rep
+
+    truncate(x,n) == first(stream x,n + 1)$Rep
+
+    truncate(x,n1,n2) ==
+      if n2 < n1 then (n1,n2) := (n2,n1)
+      m := (n2 - n1) :: NNI
+      st := first(rest(stream x,n1)$Rep,m + 1)$Rep
+      for i in 1..n1 repeat st := concat(0$Coef,st)
+      st
+
+    elt(x:%,y:%) == compose(stream x,stream y)$STT
+
+    revert x == revert(stream x)$STT
+
+    multisect(a,b,x) == multisect(a,b,stream x)$STT
+
+    invmultisect(a,b,x) == invmultisect(a,b,stream x)$STT
+
+    multiplyExponents(x,n) == invmultisect(n,0,x)
+
+    quoByVar x == (empty? x => 0; rst x)
+
+    if Coef has IntegralDomain then
+
+      unit? x == unit? coefficient(x,0)
+
+    if Coef has Field then
+      if Coef is RN then
+
+        (x:%) ** (s:Coef) == powern(s,stream x)$STT
+
+      else
+
+        (x:%) ** (s:Coef) == power(s,stream x)$STT
+
+    if Coef has Algebra Fraction Integer then
+
+      coerce(r:RN) == r :: Coef :: %
+
+      integrate x == integrate(0,stream x)$STT
+
+      integrate(x:%,v:Variable(var)) == integrate x
+
+      if Coef has integrate: (Coef,Symbol) -> Coef and _
+         Coef has variables: Coef -> List Symbol then
+
+        integrate(x:%,s:Symbol) ==
+          (s = variable(x)) => integrate x
+          map(integrate(#1,s),x)
+          
+      if Coef has TranscendentalFunctionCategory and _
+         Coef has PrimitiveFunctionCategory and _
+         Coef has AlgebraicallyClosedFunctionSpace Integer then
+
+        integrateWithOneAnswer: (Coef,Symbol) -> Coef
+        integrateWithOneAnswer(f,s) ==
+          res := integrate(f,s)$FunctionSpaceIntegration(I,Coef)
+          res case Coef => res :: Coef
+          first(res :: List Coef)
+
+        integrate(x:%,s:Symbol) ==
+          (s = variable(x)) => integrate x
+          map(integrateWithOneAnswer(#1,s),x)
+
 *)
 
 \end{chunk}
@@ -166854,6 +207980,7 @@ UniversalSegment(S: Type): SegmentCategory(S) with
 --    expand : (%, S) -> Stream S
 
   == add
+
     Rec  ==> Record(low: S, high: S, incr: Integer)
     Rec2 ==> Record(low: S, incr: Integer)
     SEG ==> Segment S
@@ -166865,7 +207992,9 @@ UniversalSegment(S: Type): SegmentCategory(S) with
     ls : List %
 
     segment a == [a, 1]$Rec2 :: Rep
+
     segment(a,b) == [a,b,1]$Rec :: Rep
+
     BY(s,i) ==
       s case Rec => [lo s, hi s, i]$Rec ::Rep
       [lo s, i]$Rec2 :: Rep
@@ -166893,6 +208022,7 @@ UniversalSegment(S: Type): SegmentCategory(S) with
       (s :: Rec).incr
 
     SEGMENT(a) == segment a
+
     SEGMENT(a,b) == segment(a,b)
 
     coerce(sg : SEG): % == segment(lo sg, hi sg)
@@ -166922,7 +208052,9 @@ UniversalSegment(S: Type): SegmentCategory(S) with
          infix(" by "::OutputForm, seg, inc::OutputForm)
 
     if S has OrderedRing then
+
       expand(s:%)       == expand([s])
+
       map(f:S->S, s:%)  == map(f, expand s)
 
       plusInc(t: S, a: S): S == t + a
@@ -166949,6 +208081,102 @@ UniversalSegment(S: Type): SegmentCategory(S) with
 \begin{chunk}{COQ UNISEG}
 (* domain UNISEG *)
 (*
+
+    Rec  ==> Record(low: S, high: S, incr: Integer)
+    Rec2 ==> Record(low: S, incr: Integer)
+    SEG ==> Segment S
+
+    Rep := Union(Rec2, Rec)
+    a,b : S
+    s : %
+    i: Integer
+    ls : List %
+
+    segment a == [a, 1]$Rec2 :: Rep
+
+    segment(a,b) == [a,b,1]$Rec :: Rep
+
+    BY(s,i) ==
+      s case Rec => [lo s, hi s, i]$Rec ::Rep
+      [lo s, i]$Rec2 :: Rep
+
+    lo s ==
+      s case Rec2 => (s :: Rec2).low
+      (s :: Rec).low
+
+    low s ==
+      s case Rec2 => (s :: Rec2).low
+      (s :: Rec).low
+
+    hasHi s == s case Rec
+
+    hi s ==
+      not hasHi(s) => error "hi: segment has no upper bound"
+      (s :: Rec).high
+
+    high s ==
+      not hasHi(s) => error "high: segment has no upper bound"
+      (s :: Rec).high
+
+    incr s ==
+      s case Rec2 => (s :: Rec2).incr
+      (s :: Rec).incr
+
+    SEGMENT(a) == segment a
+
+    SEGMENT(a,b) == segment(a,b)
+
+    coerce(sg : SEG): % == segment(lo sg, hi sg)
+
+    convert a == [a,a,1]
+
+    if S has SetCategory then
+
+       (s1:%) = (s2:%) ==
+          s1 case Rec2 =>
+             s2 case Rec2 =>
+                 s1.low = s2.low and s1.incr = s2.incr
+             false
+          s1 case Rec =>
+             s2 case Rec =>
+                 s2.low = s2.low and s1.high=s2.high and s1.incr=s2.incr
+             false
+          false
+
+       coerce(s: %): OutputForm ==
+         seg :=
+           e := (lo s)::OutputForm
+           hasHi s => SEGMENT(e, (hi s)::OutputForm)
+           SEGMENT e
+         inc := incr s
+         inc = 1 => seg
+         infix(" by "::OutputForm, seg, inc::OutputForm)
+
+    if S has OrderedRing then
+
+      expand(s:%)       == expand([s])
+
+      map(f:S->S, s:%)  == map(f, expand s)
+
+      plusInc(t: S, a: S): S == t + a
+
+      expand(ls: List %):Stream S ==
+        st:Stream S := empty()
+        null ls => st
+
+        lb:List(Segment S) := nil()
+        while not null ls and hasHi first ls repeat
+            s  := first ls
+            ls := rest ls
+            ns := BY(SEGMENT(lo s, hi s), incr s)$Segment(S)
+            lb := concat_!(lb,ns)
+        if not null ls then
+            s := first ls
+            st: Stream S := generate(x +-> x+incr(s)::S, lo s)
+        else
+            st: Stream S := empty()
+        concat(construct expand(lb),  st)
+
 *)
 
 \end{chunk}
@@ -167181,19 +208409,29 @@ U8Matrix : MatrixCategory(Integer,
     Qnew1    ==> MAKEMATRIX1U8$Lisp
 
     minRowIndex x == 0
+
     minColIndex x == 0
+
     nrows x == Qnrows(x)
+
     ncols x == Qncols(x)
+
     maxRowIndex x == Qnrows(x) - 1
+
     maxColIndex x == Qncols(x) - 1
 
     qelt(m, i, j) == Qelt2(m, i, j)
+
     elt(m : %, i : Integer, j : Integer) : R == Qelt2(m, i, j)
+
     qsetelt!(m, i, j, r) == Qsetelt2(m, i, j, r)
+
     setelt(m : %, i : Integer, j : Integer, r : R) == Qsetelt2(m, i, j, r)
 
     empty() == Qnew(0$Integer, 0$Integer)
+
     qnew(rows, cols) == Qnew(rows, cols)
+
     new(rows, cols, a) == Qnew1(rows, cols, a)
 
 \end{chunk}
@@ -167201,6 +208439,42 @@ U8Matrix : MatrixCategory(Integer,
 \begin{chunk}{COQ U8MAT}
 (* domain U8MAT *)
 (*
+
+    R ==> Integer
+
+    Qelt2    ==> AREF2U8$Lisp
+    Qsetelt2 ==> SETAREF2U8$Lisp
+    Qnrows   ==> ANROWSU8$Lisp
+    Qncols   ==> ANCOLSU8$Lisp
+    Qnew     ==> MAKEMATRIXU8$Lisp
+    Qnew1    ==> MAKEMATRIX1U8$Lisp
+
+    minRowIndex x == 0
+
+    minColIndex x == 0
+
+    nrows x == Qnrows(x)
+
+    ncols x == Qncols(x)
+
+    maxRowIndex x == Qnrows(x) - 1
+
+    maxColIndex x == Qncols(x) - 1
+
+    qelt(m, i, j) == Qelt2(m, i, j)
+
+    elt(m : %, i : Integer, j : Integer) : R == Qelt2(m, i, j)
+
+    qsetelt!(m, i, j, r) == Qsetelt2(m, i, j, r)
+
+    setelt(m : %, i : Integer, j : Integer, r : R) == Qsetelt2(m, i, j, r)
+
+    empty() == Qnew(0$Integer, 0$Integer)
+
+    qnew(rows, cols) == Qnew(rows, cols)
+
+    new(rows, cols, a) == Qnew1(rows, cols, a)
+
 *)
 
 \end{chunk}
@@ -167433,19 +208707,29 @@ U16Matrix : MatrixCategory(Integer,
     Qnew1    ==> MAKEMATRIX1U16$Lisp
 
     minRowIndex x == 0
+
     minColIndex x == 0
+
     nrows x == Qnrows(x)
+
     ncols x == Qncols(x)
+
     maxRowIndex x == Qnrows(x) - 1
+
     maxColIndex x == Qncols(x) - 1
 
     qelt(m, i, j) == Qelt2(m, i, j)
+
     elt(m : %, i : Integer, j : Integer) : R == Qelt2(m, i, j)
+
     qsetelt!(m, i, j, r) == Qsetelt2(m, i, j, r)
+
     setelt(m : %, i : Integer, j : Integer, r : R) == Qsetelt2(m, i, j, r)
 
     empty() == Qnew(0$Integer, 0$Integer)
+
     qnew(rows, cols) == Qnew(rows, cols)
+
     new(rows, cols, a) == Qnew1(rows, cols, a)
 
 \end{chunk}
@@ -167453,6 +208737,42 @@ U16Matrix : MatrixCategory(Integer,
 \begin{chunk}{COQ U16MAT}
 (* domain U16MAT *)
 (*
+
+    R ==> Integer
+
+    Qelt2    ==> AREF2U16$Lisp
+    Qsetelt2 ==> SETAREF2U16$Lisp
+    Qnrows   ==> ANROWSU16$Lisp
+    Qncols   ==> ANCOLSU16$Lisp
+    Qnew     ==> MAKEMATRIXU16$Lisp
+    Qnew1    ==> MAKEMATRIX1U16$Lisp
+
+    minRowIndex x == 0
+
+    minColIndex x == 0
+
+    nrows x == Qnrows(x)
+
+    ncols x == Qncols(x)
+
+    maxRowIndex x == Qnrows(x) - 1
+
+    maxColIndex x == Qncols(x) - 1
+
+    qelt(m, i, j) == Qelt2(m, i, j)
+
+    elt(m : %, i : Integer, j : Integer) : R == Qelt2(m, i, j)
+
+    qsetelt!(m, i, j, r) == Qsetelt2(m, i, j, r)
+
+    setelt(m : %, i : Integer, j : Integer, r : R) == Qsetelt2(m, i, j, r)
+
+    empty() == Qnew(0$Integer, 0$Integer)
+
+    qnew(rows, cols) == Qnew(rows, cols)
+
+    new(rows, cols, a) == Qnew1(rows, cols, a)
+
 *)
 
 \end{chunk}
@@ -167685,19 +209005,29 @@ U32Matrix : MatrixCategory(Integer,
     Qnew1    ==> MAKEMATRIX1U32$Lisp
 
     minRowIndex x == 0
+
     minColIndex x == 0
+
     nrows x == Qnrows(x)
+
     ncols x == Qncols(x)
+
     maxRowIndex x == Qnrows(x) - 1
+
     maxColIndex x == Qncols(x) - 1
 
     qelt(m, i, j) == Qelt2(m, i, j)
+
     elt(m : %, i : Integer, j : Integer) : R == Qelt2(m, i, j)
+
     qsetelt!(m, i, j, r) == Qsetelt2(m, i, j, r)
+
     setelt(m : %, i : Integer, j : Integer, r : R) == Qsetelt2(m, i, j, r)
 
     empty() == Qnew(0$Integer, 0$Integer)
+
     qnew(rows, cols) == Qnew(rows, cols)
+
     new(rows, cols, a) == Qnew1(rows, cols, a)
 
 \end{chunk}
@@ -167705,6 +209035,42 @@ U32Matrix : MatrixCategory(Integer,
 \begin{chunk}{COQ U32MAT}
 (* domain U32MAT *)
 (*
+
+    R ==> Integer
+
+    Qelt2    ==> AREF2U32$Lisp
+    Qsetelt2 ==> SETAREF2U32$Lisp
+    Qnrows   ==> ANROWSU32$Lisp
+    Qncols   ==> ANCOLSU32$Lisp
+    Qnew     ==> MAKEMATRIXU32$Lisp
+    Qnew1    ==> MAKEMATRIX1U32$Lisp
+
+    minRowIndex x == 0
+
+    minColIndex x == 0
+
+    nrows x == Qnrows(x)
+
+    ncols x == Qncols(x)
+
+    maxRowIndex x == Qnrows(x) - 1
+
+    maxColIndex x == Qncols(x) - 1
+
+    qelt(m, i, j) == Qelt2(m, i, j)
+
+    elt(m : %, i : Integer, j : Integer) : R == Qelt2(m, i, j)
+
+    qsetelt!(m, i, j, r) == Qsetelt2(m, i, j, r)
+
+    setelt(m : %, i : Integer, j : Integer, r : R) == Qsetelt2(m, i, j, r)
+
+    empty() == Qnew(0$Integer, 0$Integer)
+
+    qnew(rows, cols) == Qnew(rows, cols)
+
+    new(rows, cols, a) == Qnew1(rows, cols, a)
+
 *)
 
 \end{chunk}
@@ -168924,10 +210290,15 @@ Variable(sym:Symbol): Join(SetCategory, CoercibleTo Symbol) with
         variable: () -> Symbol
                 ++ variable() returns the symbol
     == add
+
         coerce(x:%):Symbol     == sym
+
         coerce(x:%):OutputForm == sym::OutputForm
+
         variable()             == sym
+
         x = y                  == true
+
         latex(x:%):String      == latex sym
 
 \end{chunk}
@@ -168935,6 +210306,17 @@ Variable(sym:Symbol): Join(SetCategory, CoercibleTo Symbol) with
 \begin{chunk}{COQ VARIABLE}
 (* domain VARIABLE *)
 (*
+
+        coerce(x:%):Symbol     == sym
+
+        coerce(x:%):OutputForm == sym::OutputForm
+
+        variable()             == sym
+
+        x = y                  == true
+
+        latex(x:%):String      == latex sym
+
 *)
 
 \end{chunk}
@@ -169330,8 +210712,11 @@ Vector(R:Type): Exports == Implementation where
      ++ vector(l) converts the list l to a vector.
  Implementation ==>
   IndexedVector(R, VECTORMININDEX) add 
+
      vector l == construct l
+
      if R has ConvertibleTo InputForm then
+
        convert(x:%):InputForm ==
           convert [convert("vector"::Symbol)@InputForm,
                           convert(parts x)@InputForm]
@@ -169341,6 +210726,15 @@ Vector(R:Type): Exports == Implementation where
 \begin{chunk}{COQ VECTOR}
 (* domain VECTOR *)
 (*
+
+     vector l == construct l
+
+     if R has ConvertibleTo InputForm then
+
+       convert(x:%):InputForm ==
+          convert [convert("vector"::Symbol)@InputForm,
+                          convert(parts x)@InputForm]
+
 *)
 
 \end{chunk}
@@ -169493,8 +210887,11 @@ Void: with
         coerce: % -> OutputForm
           ++ coerce(v) coerces void object to outputForm.
     == add
+
         Rep := String
+
         void()      == voidValue()$Lisp
+
         coerce(v:%) == coerce(v)$Rep
 
 \end{chunk}
@@ -169502,6 +210899,13 @@ Void: with
 \begin{chunk}{COQ VOID}
 (* domain VOID *)
 (*
+
+        Rep := String
+
+        void()      == voidValue()$Lisp
+
+        coerce(v:%) == coerce(v)$Rep
+
 *)
 
 \end{chunk}
@@ -169635,26 +211039,36 @@ WeightedPolynomials(R:Ring,VarSet: OrderedSet, E:OrderedAbelianMonoidSup,
                  ++ NB: previously calculated terms are not affected
     ==
   add
+
    --representations
    Rep  := PolynomialRing(P,NonNegativeInteger)
    p:P
    w,x1,x2:$
    n:NonNegativeInteger
    z:Integer
+
    changeWeightLevel(n) ==
         wtlevel:=n
+
    lookupList:List Record(var:VarSet, weight:NonNegativeInteger)
+
    if #vl ^= #wl then error "incompatible length lists in WeightedPolynomial"
+
    lookupList:=[[v,n] for v in vl for n in wl]
+
    -- local operation
+
    innercoerce:(p,z) -> $
+
    lookup:Varset -> NonNegativeInteger
+
    lookup v ==
       l:=lookupList
       while l ^= [] repeat
         v = l.first.var => return l.first.weight
         l:=l.rest
       0
+
    innercoerce(p,z) ==
       z<0 => 0
       zero? p => 0
@@ -169676,15 +211090,21 @@ WeightedPolynomials(R:Ring,VarSet: OrderedSet, E:OrderedAbelianMonoidSup,
               ans:=ans+ monomial(mon*leadingCoefficient(tmp),degree(tmp)+f)
               tmp:=reductum tmp
       ans
+
    coerce(p):$ == innercoerce(p,wtlevel)
+
    coerce(w):P ==  "+"/[c for c in coefficients w]
+
    coerce(p:$):OutputForm ==
      zero? p => (0$Integer)::OutputForm
      degree p = 0 => leadingCoefficient(p):: OutputForm
      reduce("+",(reverse [paren(c::OutputForm) for c in coefficients p])
                  ::List OutputForm)
+
    0 == 0$Rep
+
    1 == 1$Rep
+
    x1 = x2 ==
       -- Note that we must strip out any terms greater than wtlevel
       while degree x1 > wtlevel repeat
@@ -169692,8 +211112,11 @@ WeightedPolynomials(R:Ring,VarSet: OrderedSet, E:OrderedAbelianMonoidSup,
       while degree x2 > wtlevel repeat
             x2 := reductum x2
       x1 =$Rep x2
+
    x1 + x2 == x1 +$Rep x2
+
    -x1 == -(x1::Rep)
+
    x1 * x2 ==
      -- Note that this is probably an extremely inefficient definition
      w:=x1 *$Rep x2
@@ -169706,6 +211129,91 @@ WeightedPolynomials(R:Ring,VarSet: OrderedSet, E:OrderedAbelianMonoidSup,
 \begin{chunk}{COQ WP}
 (* domain WP *)
 (*
+
+   --representations
+   Rep  := PolynomialRing(P,NonNegativeInteger)
+   p:P
+   w,x1,x2:$
+   n:NonNegativeInteger
+   z:Integer
+
+   changeWeightLevel(n) ==
+        wtlevel:=n
+
+   lookupList:List Record(var:VarSet, weight:NonNegativeInteger)
+
+   if #vl ^= #wl then error "incompatible length lists in WeightedPolynomial"
+
+   lookupList:=[[v,n] for v in vl for n in wl]
+
+   -- local operation
+
+   innercoerce:(p,z) -> $
+
+   lookup:Varset -> NonNegativeInteger
+
+   lookup v ==
+      l:=lookupList
+      while l ^= [] repeat
+        v = l.first.var => return l.first.weight
+        l:=l.rest
+      0
+
+   innercoerce(p,z) ==
+      z<0 => 0
+      zero? p => 0
+      mv:= mainVariable p
+      mv case "failed" => monomial(p,0)
+      n:=lookup(mv)
+      up:=univariate(p,mv)
+      ans:$
+      ans:=0
+      while not zero? up  repeat
+        d:=degree up
+        f:=n*d
+        lcup:=leadingCoefficient up
+        up:=up-leadingMonomial up
+        mon:=monomial(1,mv,d)
+        f<=z =>
+            tmp:= innercoerce(lcup,z-f)
+            while not zero? tmp repeat
+              ans:=ans+ monomial(mon*leadingCoefficient(tmp),degree(tmp)+f)
+              tmp:=reductum tmp
+      ans
+
+   coerce(p):$ == innercoerce(p,wtlevel)
+
+   coerce(w):P ==  "+"/[c for c in coefficients w]
+
+   coerce(p:$):OutputForm ==
+     zero? p => (0$Integer)::OutputForm
+     degree p = 0 => leadingCoefficient(p):: OutputForm
+     reduce("+",(reverse [paren(c::OutputForm) for c in coefficients p])
+                 ::List OutputForm)
+
+   0 == 0$Rep
+
+   1 == 1$Rep
+
+   x1 = x2 ==
+      -- Note that we must strip out any terms greater than wtlevel
+      while degree x1 > wtlevel repeat
+            x1 := reductum x1
+      while degree x2 > wtlevel repeat
+            x2 := reductum x2
+      x1 =$Rep x2
+
+   x1 + x2 == x1 +$Rep x2
+
+   -x1 == -(x1::Rep)
+
+   x1 * x2 ==
+     -- Note that this is probably an extremely inefficient definition
+     w:=x1 *$Rep x2
+     while degree(w) > wtlevel repeat
+           w:=reductum w
+     w
+
 *)
 
 \end{chunk}
@@ -170301,12 +211809,14 @@ WuWenTsunTriangularSet(R,E,V,P) : Exports == Implementation where
      Rep ==> LP
 
      rep(s:$):Rep == s pretend Rep
+
      per(l:Rep):$ == l pretend $
 
      removeAssociates (lp:LP):LP ==
        removeDuplicates [primPartElseUnitCanonical(p) for p in lp]
 
-     medialSetWithTrace (ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)):Union(RBT,"failed") == 
+     medialSetWithTrace (ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)):_
+         Union(RBT,"failed") == 
        qs := rewriteIdealWithQuasiMonicGenerators(ps,redOp?,redOp)$pa
        contradiction : B := any?(ground?,ps)
        contradiction => "failed"::Union(RBT,"failed")
@@ -170320,18 +211830,15 @@ WuWenTsunTriangularSet(R,E,V,P) : Exports == Implementation where
              bs := (rec::RBT).bas
              rs := (rec::RBT).top
              rs :=  rewriteIdealWithRemainder(rs,bs)
---             contradiction := ((not empty? rs) and (one? first(rs)))
              contradiction := ((not empty? rs) and (first(rs) = 1))
              if (not empty? rs) and (not contradiction)
                then
                  rs := rewriteSetWithReduction(rs,bs,redOp,redOp?)
---                 contradiction := ((not empty? rs) and (one? first(rs)))
                  contradiction := ((not empty? rs) and (first(rs) = 1))
          if (not empty? rs) and (not contradiction)
            then
              rs := removeDuplicates concat(rs,members(bs)) 
              rs := rewriteIdealWithQuasiMonicGenerators(rs,redOp?,redOp)$pa
---             contradiction := ((not empty? rs) and (one? first(rs)))
              contradiction := ((not empty? rs) and (first(rs) = 1))
        contradiction => "failed"::Union(RBT,"failed")
        ([bs,qs]$RBT)::Union(RBT,"failed")
@@ -170343,7 +211850,8 @@ WuWenTsunTriangularSet(R,E,V,P) : Exports == Implementation where
 
      medialSet(ps:LP) == medialSet(ps,initiallyReduced?,initiallyReduce)
 
-     characteristicSetUsingTrace(ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)):Union($,"failed") ==
+     characteristicSetUsingTrace(ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)):_
+         Union($,"failed") ==
        ps := removeAssociates ps
        ps := remove(zero?,ps)
        contradiction : B := any?(ground?,ps)
@@ -170359,12 +211867,10 @@ WuWenTsunTriangularSet(R,E,V,P) : Exports == Implementation where
              ms := (rec::RBT).bas
              qs := (rec::RBT).top
              qs := rewriteIdealWithRemainder(qs,ms)
---             contradiction := ((not empty? qs) and (one? first(qs))) 
              contradiction := ((not empty? qs) and (first(qs) = 1)) 
              if not contradiction
                then
                  rs :=  rewriteSetWithReduction(qs,ms,lazyPrem,reduced?)
---                 contradiction := ((not empty? rs) and (one? first(rs)))
                  contradiction := ((not empty? rs) and (first(rs) = 1))
              if  (not contradiction) and (not empty? rs)
                then
@@ -170375,7 +211881,8 @@ WuWenTsunTriangularSet(R,E,V,P) : Exports == Implementation where
      characteristicSet(ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)) == 
        characteristicSetUsingTrace(ps,redOp?,redOp)
 
-     characteristicSet(ps:LP) == characteristicSet(ps,initiallyReduced?,initiallyReduce)
+     characteristicSet(ps:LP) ==
+       characteristicSet(ps,initiallyReduced?,initiallyReduce)
 
      characteristicSerie(ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)) == 
        a := [[ps,empty()$$]$NLpT]$ALpT
@@ -170406,7 +211913,8 @@ WuWenTsunTriangularSet(R,E,V,P) : Exports == Implementation where
                       splitNodeOf!(esl::ALpT,a,ln)
        remove(empty()$$,conditions(a))
 
-     characteristicSerie(ps:LP) ==  characteristicSerie (ps,initiallyReduced?,initiallyReduce)
+     characteristicSerie(ps:LP) == 
+       characteristicSerie (ps,initiallyReduced?,initiallyReduce)
 
      if R has GcdDomain
      then
@@ -170429,7 +211937,8 @@ WuWenTsunTriangularSet(R,E,V,P) : Exports == Implementation where
          (per(cons(unitCanonical(p),rep(newts))))::Union($,"failed")
 
        zeroSetSplit lp ==
-         lts : List $ := characteristicSerie(lp,initiallyReduced?,initiallyReduce)
+         lts : List $ := _
+            characteristicSerie(lp,initiallyReduced?,initiallyReduce)
          lts := removeDuplicates(lts)$(List $)
          newlts : List $ := []
          while not empty? lts repeat
@@ -170445,7 +211954,8 @@ WuWenTsunTriangularSet(R,E,V,P) : Exports == Implementation where
      else
 
        zeroSetSplit lp ==
-         lts : List $ := characteristicSerie(lp,initiallyReduced?,initiallyReduce)
+         lts : List $ := _
+           characteristicSerie(lp,initiallyReduced?,initiallyReduce)
          sort(infRittWu?, removeDuplicates lts)
 
 \end{chunk}
@@ -170453,6 +211963,161 @@ WuWenTsunTriangularSet(R,E,V,P) : Exports == Implementation where
 \begin{chunk}{COQ WUTSET}
 (* domain WUTSET *)
 (*
+
+     removeSquares: $ -> Union($,"failed")
+
+     Rep ==> LP
+
+     rep(s:$):Rep == s pretend Rep
+
+     per(l:Rep):$ == l pretend $
+
+     removeAssociates (lp:LP):LP ==
+       removeDuplicates [primPartElseUnitCanonical(p) for p in lp]
+
+     medialSetWithTrace (ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)):_
+         Union(RBT,"failed") == 
+       qs := rewriteIdealWithQuasiMonicGenerators(ps,redOp?,redOp)$pa
+       contradiction : B := any?(ground?,ps)
+       contradiction => "failed"::Union(RBT,"failed")
+       rs : LP := qs
+       bs : $
+       while (not empty? rs) and (not contradiction) repeat
+         rec := basicSet(rs,redOp?)
+         contradiction := (rec case "failed")@B
+         if not contradiction
+           then
+             bs := (rec::RBT).bas
+             rs := (rec::RBT).top
+             rs :=  rewriteIdealWithRemainder(rs,bs)
+             contradiction := ((not empty? rs) and (first(rs) = 1))
+             if (not empty? rs) and (not contradiction)
+               then
+                 rs := rewriteSetWithReduction(rs,bs,redOp,redOp?)
+                 contradiction := ((not empty? rs) and (first(rs) = 1))
+         if (not empty? rs) and (not contradiction)
+           then
+             rs := removeDuplicates concat(rs,members(bs)) 
+             rs := rewriteIdealWithQuasiMonicGenerators(rs,redOp?,redOp)$pa
+             contradiction := ((not empty? rs) and (first(rs) = 1))
+       contradiction => "failed"::Union(RBT,"failed")
+       ([bs,qs]$RBT)::Union(RBT,"failed")
+
+     medialSet(ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)) == 
+       foo: Union(RBT,"failed") := medialSetWithTrace(ps,redOp?,redOp)
+       (foo case "failed") => "failed" :: Union($,"failed")
+       ((foo::RBT).bas) :: Union($,"failed")
+
+     medialSet(ps:LP) == medialSet(ps,initiallyReduced?,initiallyReduce)
+
+     characteristicSetUsingTrace(ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)):_
+         Union($,"failed") ==
+       ps := removeAssociates ps
+       ps := remove(zero?,ps)
+       contradiction : B := any?(ground?,ps)
+       contradiction => "failed"::Union($,"failed")
+       rs : LP := ps
+       qs : LP := ps
+       ms : $
+       while (not empty? rs) and (not contradiction) repeat
+         rec := medialSetWithTrace (qs,redOp?,redOp)
+         contradiction := (rec case "failed")@B
+         if not contradiction
+           then
+             ms := (rec::RBT).bas
+             qs := (rec::RBT).top
+             qs := rewriteIdealWithRemainder(qs,ms)
+             contradiction := ((not empty? qs) and (first(qs) = 1)) 
+             if not contradiction
+               then
+                 rs :=  rewriteSetWithReduction(qs,ms,lazyPrem,reduced?)
+                 contradiction := ((not empty? rs) and (first(rs) = 1))
+             if  (not contradiction) and (not empty? rs)
+               then
+                 qs := removeDuplicates(concat(rs,concat(members(ms),qs)))
+       contradiction => "failed"::Union($,"failed")
+       ms::Union($,"failed")
+
+     characteristicSet(ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)) == 
+       characteristicSetUsingTrace(ps,redOp?,redOp)
+
+     characteristicSet(ps:LP) ==
+       characteristicSet(ps,initiallyReduced?,initiallyReduce)
+
+     characteristicSerie(ps:LP,redOp?:((P,P)->B),redOp:((P,P)->P)) == 
+       a := [[ps,empty()$$]$NLpT]$ALpT
+       while ((esl := extractSplittingLeaf(a)) case ALpT) repeat
+          ps := value(value(esl::ALpT)$ALpT)$NLpT
+          charSet? := characteristicSetUsingTrace(ps,redOp?,redOp)
+          if not (charSet? case $)
+             then
+                setvalue!(esl::ALpT,[nil()$LP,empty()$$,true]$NLpT)
+                updateStatus!(a)
+             else
+                cs := (charSet?)::$
+                lics := initials(cs)
+                lics := removeRedundantFactors(lics)$pa
+                lics := sort(infRittWu?,lics)
+                if empty? lics 
+                   then
+                      setvalue!(esl::ALpT,[ps,cs,true]$NLpT)
+                      updateStatus!(a)
+                   else
+                      ln : List NLpT := [[nil()$LP,cs,true]$NLpT]
+                      while not empty? lics repeat
+                         newps := cons(first(lics),concat(cs::LP,ps))
+                         lics := rest lics
+                         newps := removeDuplicates newps
+                         newps := sort(infRittWu?,newps)
+                         ln := cons([newps,empty()$$,false]$NLpT,ln)
+                      splitNodeOf!(esl::ALpT,a,ln)
+       remove(empty()$$,conditions(a))
+
+     characteristicSerie(ps:LP) == 
+       characteristicSerie (ps,initiallyReduced?,initiallyReduce)
+
+     if R has GcdDomain
+     then
+
+       removeSquares (ts:$):Union($,"failed") ==
+         empty?(ts)$$ => ts::Union($,"failed")
+         p := (first ts)::P
+         rsts : Union($,"failed")
+         rsts := removeSquares((rest ts)::$)
+         not(rsts case $) => "failed"::Union($,"failed")
+         newts := rsts::$
+         empty? newts =>
+           p := squareFreePart(p)
+           (per([primitivePart(p)]$LP))::Union($,"failed")
+         zero? initiallyReduce(init(p),newts) => "failed"::Union($,"failed")
+         p := primitivePart(removeZero(p,newts))
+         ground? p => "failed"::Union($,"failed")
+         not (mvar(newts) < mvar(p)) => "failed"::Union($,"failed")
+         p := squareFreePart(p)
+         (per(cons(unitCanonical(p),rep(newts))))::Union($,"failed")
+
+       zeroSetSplit lp ==
+         lts : List $ := _
+            characteristicSerie(lp,initiallyReduced?,initiallyReduce)
+         lts := removeDuplicates(lts)$(List $)
+         newlts : List $ := []
+         while not empty? lts repeat
+           ts := first lts
+           lts := rest lts
+           iic := removeSquares(ts)
+           if iic case $
+             then
+               newlts := cons(iic::$,newlts)
+         newlts := removeDuplicates(newlts)$(List $)
+         sort(infRittWu?, newlts)
+
+     else
+
+       zeroSetSplit lp ==
+         lts : List $ := _
+           characteristicSerie(lp,initiallyReduced?,initiallyReduce)
+         sort(infRittWu?, removeDuplicates lts)
+
 *)
 
 \end{chunk}
@@ -170645,12 +212310,12 @@ XDistributedPolynomial(vl:OrderedSet,R:Ring): XDPcat == XDPdef where
        mindegTerm p == last(p)$Rep
 
        if R has CommutativeRing then
+
          sh(p:%, n:NNI):% ==
             n=0 => 1
             n=1 => p
             n1: NNI := (n-$I 1)::NNI
             sh(p, sh(p,n1))
-
       
          sh(p1:%, p2:%) ==
            p:% := 0 
@@ -170660,6 +212325,7 @@ XDistributedPolynomial(vl:OrderedSet,R:Ring): XDPcat == XDPdef where
            p
 
        coerce(v: vl):% == coerce(v::WORD)
+
        v:vl * p:% ==
          [[v * t.k , t.c]$TERM for t in p]
 
@@ -170682,10 +212348,13 @@ XDistributedPolynomial(vl:OrderedSet,R:Ring): XDPcat == XDPdef where
 
        rquo(p:% , w: WORD) == 
          [[r::WORD,t.c]$TERM for t in p | not (r:= rquo(t.k,w)) case "failed" ]
+
        lquo(p:% , w: WORD) ==
          [[r::WORD,t.c]$TERM for t in p | not (r:= lquo(t.k,w)) case "failed" ]
+
        rquo(p:% , v: vl) ==
          [[r::WORD,t.c]$TERM for t in p | not (r:= rquo(t.k,v)) case "failed" ]
+
        lquo(p:% , v: vl) ==
          [[r::WORD,t.c]$TERM for t in p | not (r:= lquo(t.k,v)) case "failed" ]
 
@@ -170713,6 +212382,87 @@ XDistributedPolynomial(vl:OrderedSet,R:Ring): XDPcat == XDPdef where
 \begin{chunk}{COQ XDPOLY}
 (* domain XDPOLY *)
 (*
+
+       import( WORD, TERM)
+
+    -- Representation
+       Rep  :=  List TERM
+
+    -- local functions
+       shw: (WORD , WORD) -> %    -- shuffle de 2 mots
+
+    -- definitions
+
+       mindegTerm p == last(p)$Rep
+
+       if R has CommutativeRing then
+
+         sh(p:%, n:NNI):% ==
+            n=0 => 1
+            n=1 => p
+            n1: NNI := (n-$I 1)::NNI
+            sh(p, sh(p,n1))
+      
+         sh(p1:%, p2:%) ==
+           p:% := 0 
+           for t1 in p1 repeat
+             for t2 in p2 repeat
+                p := p + (t1.c * t2.c) * shw(t1.k,t2.k) 
+           p
+
+       coerce(v: vl):% == coerce(v::WORD)
+
+       v:vl * p:% ==
+         [[v * t.k , t.c]$TERM for t in p]
+
+       mirror p == 
+         null p => p
+         monom(mirror$WORD leadingMonomial p, leadingCoefficient p) + _
+               mirror reductum p
+
+       degree(p) == length(maxdeg(p))$WORD
+
+       trunc(p, n) ==
+         p = 0 => p
+         degree(p) > n => trunc( reductum p , n)
+         p
+
+       varList p ==
+         constant? p => []
+         le : List vl := "setUnion"/[varList(t.k) for t in p]
+         sort_!(le)
+
+       rquo(p:% , w: WORD) == 
+         [[r::WORD,t.c]$TERM for t in p | not (r:= rquo(t.k,w)) case "failed" ]
+
+       lquo(p:% , w: WORD) ==
+         [[r::WORD,t.c]$TERM for t in p | not (r:= lquo(t.k,w)) case "failed" ]
+
+       rquo(p:% , v: vl) ==
+         [[r::WORD,t.c]$TERM for t in p | not (r:= rquo(t.k,v)) case "failed" ]
+
+       lquo(p:% , v: vl) ==
+         [[r::WORD,t.c]$TERM for t in p | not (r:= lquo(t.k,v)) case "failed" ]
+
+       shw(w1,w2) ==
+         w1 = 1$WORD => w2::%
+         w2 = 1$WORD => w1::%
+         x: vl := first w1 ; y: vl := first w2
+         x * shw(rest w1,w2) + y * shw(w1,rest w2)
+ 
+       lquo(p:%,q:%):% ==
+         +/  [r * t.c for t in q | (r := lquo(p,t.k)) ^= 0] 
+
+       rquo(p:%,q:%):% ==
+         +/  [r * t.c for t in q | (r := rquo(p,t.k)) ^= 0] 
+
+       coef(p:%,q:%):R ==
+         p = 0 => 0$R
+         q = 0 => 0$R 
+         p.first.k > q.first.k => coef(p.rest,q)
+         p.first.k < q.first.k => coef(p,q.rest) 
+         return p.first.c * q.first.c + coef(p.rest,q.rest)
+
 *)
 
 \end{chunk}
@@ -171748,6 +213498,7 @@ XPBWPolynomial(VarSet:OrderedSet,R:CommutativeRing): XDPcat == XDPdef where
           ++ (truncated up to order \axiom{n}).
 
   XDPdef == FreeModule1(R,BASIS) add
+
        import(TERM)
 
     -- Representation
@@ -171811,7 +213562,6 @@ XPBWPolynomial(VarSet:OrderedSet,R:CommutativeRing): XDPcat == XDPdef where
          r1, r2 : $
          not lexico(first gauche, x) =>     -- cas facile !!!
            monom(append(reverse gauche, cons(x, droite)) pretend BASIS , 1$R)
-
          p: LPOLY := [first gauche , x]      -- on crochete !!!
          null droite =>
            r1 :=  +/ [t.c * process(rest gauche, t.k, droite) for t in _
@@ -171820,10 +213570,10 @@ XPBWPolynomial(VarSet:OrderedSet,R:CommutativeRing): XDPcat == XDPdef where
            r1 + r2 
          rd: List LWORD := rest droite; fd: LWORD := first droite
          r1 := +/ [t.c * process(list t.k, fd, rd) for t in  listOfTerms p] 
-         r1 := +/ [t.c * process(rest gauche, first t.k, rest listOfTerms(t.k))_
+         r1 := +/[t.c * process(rest gauche, first t.k, rest listOfTerms(t.k))_
                   for t in  r1] 
          r2 := process([first gauche, x], fd, rd)
-         r2 := +/ [t.c * process(rest gauche, first t.k, rest listOfTerms(t.k))_
+         r2 := +/[t.c * process(rest gauche, first t.k, rest listOfTerms(t.k))_
                   for t in  r2]
          r1 + r2
 
@@ -171850,12 +213600,14 @@ XPBWPolynomial(VarSet:OrderedSet,R:CommutativeRing): XDPcat == XDPdef where
          +/ [t.c * Rexpand t.k for t in p]
 
        constant? p == (null p) or (leadingMonomial(p) =$BASIS 1)
+
        constant p == 
          null p => 0$R
          p.last.k = 1$BASIS => p.last.c
          0$R
 
        quasiRegular? p == (p=0) or (p.last.k ^= 1$BASIS)
+
        quasiRegular p == 
          p = 0 => p
          p.last.k = 1$BASIS => delete(p, maxIndex p)
@@ -171865,8 +213617,6 @@ XPBWPolynomial(VarSet:OrderedSet,R:CommutativeRing): XDPcat == XDPdef where
          y = 0$$ => 0
          +/ [t.c * prod1(t.k, y) for t in x]
 
---       listOfTerms p == p pretend LTERMS
-
        varList p == 
           lv: List VarSet := "setUnion"/ [varList(b.k)$BASIS for b in p]
           sort(lv)
@@ -171886,6 +213636,7 @@ XPBWPolynomial(VarSet:OrderedSet,R:CommutativeRing): XDPcat == XDPdef where
          +/ [t.c * prod11(t.k, y, n) for t in x]
 
        if R has Module(RN) then
+
          exp (p,n) ==
              p = 0 => 1
              not quasiRegular? p => 
@@ -171927,6 +213678,181 @@ XPBWPolynomial(VarSet:OrderedSet,R:CommutativeRing): XDPcat == XDPdef where
 \begin{chunk}{COQ XPBWPOLY}
 (* domain XPBWPOLY *)
 (*
+
+       import(TERM)
+
+    -- Representation
+       Rep:= LTERMS 
+
+    -- local functions
+       prod1: (BASIS, $) -> $
+       prod2: ($, BASIS) -> $
+       prod : (BASIS, BASIS) -> $
+
+       prod11: (BASIS, $, NNI) -> $
+       prod22: ($, BASIS, NNI) -> $
+
+       outForm : TERM -> EX
+       Dexpand : BASIS -> XDPOLY
+       Rexpand : BASIS -> XRPOLY
+       process : (List LWORD, LWORD, List LWORD) -> $
+       mirror1 : BASIS -> $
+
+    -- functions locales
+       outForm t ==
+           t.c =$R 1 => t.k :: EX
+           t.k =$BASIS 1 => t.c :: EX
+           t.c::EX * t.k ::EX
+
+       prod1(b:BASIS, p:$):$ ==
+         +/ [t.c * prod(b, t.k) for t in p]
+
+       prod2(p:$, b:BASIS):$ ==
+         +/ [t.c * prod(t.k, b) for t in p]
+ 
+       prod11(b,p,n) ==
+           limit: I := n -$I length b
+           +/ [t.c * prod(b, t.k) for t in p| length(t.k) :: I <= limit]
+
+       prod22(p,b,n) ==
+           limit: I := n -$I length b
+           +/ [t.c * prod(t.k, b) for t in p| length(t.k) :: I <= limit]
+
+       prod(g,d) ==
+         d = 1 => monom(g,1)
+         g = 1 => monom(d,1)
+         process(reverse listOfTerms g, first d, rest listOfTerms d)
+
+       Dexpand b == 
+         b = 1 => 1$XDPOLY
+         */ [LiePoly(l)$LPOLY :: XDPOLY for l in listOfTerms b]
+
+       Rexpand b ==
+         b = 1 => 1$XRPOLY
+         */ [LiePoly(l)$LPOLY :: XRPOLY for l in listOfTerms b]
+
+       mirror1(b:BASIS):$ ==
+         b = 1 => 1
+         lp: LPOLY := LiePoly first b
+         lp := mirror lp
+         mirror1(rest b) * lp :: $
+
+       process(gauche, x, droite) ==    -- algo du "collect process"
+         null gauche => monom( cons(x, droite) pretend BASIS, 1$R)
+         r1, r2 : $
+         not lexico(first gauche, x) =>     -- cas facile !!!
+           monom(append(reverse gauche, cons(x, droite)) pretend BASIS , 1$R)
+         p: LPOLY := [first gauche , x]      -- on crochete !!!
+         null droite =>
+           r1 :=  +/ [t.c * process(rest gauche, t.k, droite) for t in _
+                      listOfTerms p]
+           r2 :=  process( rest gauche, x, list first gauche)
+           r1 + r2 
+         rd: List LWORD := rest droite; fd: LWORD := first droite
+         r1 := +/ [t.c * process(list t.k, fd, rd) for t in  listOfTerms p] 
+         r1 := +/[t.c * process(rest gauche, first t.k, rest listOfTerms(t.k))_
+                  for t in  r1] 
+         r2 := process([first gauche, x], fd, rd)
+         r2 := +/[t.c * process(rest gauche, first t.k, rest listOfTerms(t.k))_
+                  for t in  r2]
+         r1 + r2
+
+    -- definitions
+       1 == monom(1$BASIS, 1$R)
+
+       coerce(r:R):$ == [[1$BASIS , r]$TERM ]
+
+       coerce(p:$):EX ==
+         null p => (0$R) :: EX
+         le : List EX := nil
+         for rec in p repeat le := cons(outForm rec, le)
+         reduce(_+, le)$List(EX)
+
+       coerce(v: VarSet):$ == monom(v::BASIS , 1$R)
+       coerce(p: LPOLY):$ ==
+          [[t.k :: BASIS , t.c ]$TERM for t in listOfTerms p]
+
+       coerce(p:$):XDPOLY ==
+         +/ [t.c * Dexpand t.k for t in p]
+
+       coerce(p:$):XRPOLY ==
+         p = 0 => 0$XRPOLY
+         +/ [t.c * Rexpand t.k for t in p]
+
+       constant? p == (null p) or (leadingMonomial(p) =$BASIS 1)
+
+       constant p == 
+         null p => 0$R
+         p.last.k = 1$BASIS => p.last.c
+         0$R
+
+       quasiRegular? p == (p=0) or (p.last.k ^= 1$BASIS)
+
+       quasiRegular p == 
+         p = 0 => p
+         p.last.k = 1$BASIS => delete(p, maxIndex p)
+         p
+    
+       x:$ * y:$ ==
+         y = 0$$ => 0
+         +/ [t.c * prod1(t.k, y) for t in x]
+
+       varList p == 
+          lv: List VarSet := "setUnion"/ [varList(b.k)$BASIS for b in p]
+          sort(lv)
+
+       degree(p) ==
+          p=0 => error "null polynomial"
+          length(leadingMonomial p)
+
+       trunc(p, n) ==
+         p = 0 => p
+         degree(p) > n => trunc( reductum p , n)
+         p
+
+       product(x,y,n) ==
+         x = 0 => 0
+         y = 0 => 0
+         +/ [t.c * prod11(t.k, y, n) for t in x]
+
+       if R has Module(RN) then
+
+         exp (p,n) ==
+             p = 0 => 1
+             not quasiRegular? p => 
+               error "a proper polynomial is required"
+             s : $ := 1 ; r: $ := 1                  -- resultat
+             for i in 1..n repeat
+                k1 :RN := 1/i
+                k2 : R := k1 * 1$R
+                s := k2 * product(p, s, n)
+                r := r + s
+             r
+  
+         log (p,n) ==
+             p = 1 => 0
+             p1: $ := 1 - p
+             not quasiRegular? p1 => 
+               error "constant term <> 1, impossible log "
+             s : $ := - 1 ; r: $ := 0                 -- resultat
+             for i in 1..n repeat
+               k1 :RN := 1/i
+               k2 : R := k1 * 1$R
+               s := product(p1, s, n)
+               r := k2 * s + r
+             r
+ 
+       LiePolyIfCan p ==
+         p = 0 => 0$LPOLY
+         "and"/ [retractable?(t.k)$BASIS for t in p] =>
+            lt : List TERM1 := _
+                 [[retract(t.k)$BASIS, t.c]$TERM1 for t in p]
+            lt pretend LPOLY
+         "failed"
+
+       mirror p ==
+         +/ [t.c * mirror1(t.k) for t in p]
+
 *)
 
 \end{chunk}
@@ -172861,17 +214787,24 @@ XPolynomialRing(R:Ring,E:OrderedMonoid): T == C where
 
 
   C == FreeModule1(R,E) add
+
     --representations
        Rep:=  List TERM
+
     --uses
        repeatMultExpt: (%,NonNegativeInteger) -> %
+
     --define
+
        1  == [[1$E,1$R]]
  
        characteristic  == characteristic$R
+
        #x == #$Rep x
+
        maxdeg p == if null p then  error " polynome nul !!"
                              else p.first.k
+
        mindeg p == if null p then  error " polynome nul !!" 
                              else (last p).k
        
@@ -172882,9 +214815,11 @@ XPolynomialRing(R:Ring,E:OrderedMonoid): T == C where
           0$R
 
        constant? p == (p = 0) or (maxdeg(p) = 1$E)
+
        constant  p == coef(p,1$E)
 
        quasiRegular? p == (p=0) or (last p).k ^= 1$E
+
        quasiRegular  p == 
           quasiRegular?(p) => p
           [t for t in p | not(t.k = 1$E)]
@@ -172896,29 +214831,31 @@ XPolynomialRing(R:Ring,E:OrderedMonoid): T == C where
            (u::R)::%
  
        coerce(r:R) == if r=0$R then 0$% else [[1$E,r]]
+
        coerce(n:Integer) == (n::R)::%
  
        if R has noZeroDivisors then
+
          p1:% * p2:%  ==
             null p1 => 0
             null p2 => 0
             p1.first.k = 1$E => p1.first.c * p2
             p2 = 1 => p1
---            +/[[[t1.k*t2.k,t1.c*t2.c]$TERM for t2 in p2]
---                   for t1 in reverse(p1)]
             +/[[[t1.k*t2.k,t1.c*t2.c]$TERM for t2 in p2]
                    for t1 in p1]
+
         else
+
          p1:% * p2:%  ==
             null p1 => 0
             null p2 => 0
             p1.first.k = 1$E => p1.first.c * p2
             p2 = 1 => p1
---            +/[[[t1.k*t2.k,r]$TERM for t2 in p2 | not (r:=t1.c*t2.c) =$R 0]
---                 for t1 in reverse(p1)]
             +/[[[t1.k*t2.k,r]$TERM for t2 in p2 | not (r:=t1.c*t2.c) =$R 0]
                    for t1 in p1]
+
        p:% ** nn:NNI  == repeatMultExpt(p,nn)
+
        repeatMultExpt(x,nn) ==
                nn = 0 => 1
                y:% := x
@@ -172930,23 +214867,12 @@ XPolynomialRing(R:Ring,E:OrderedMonoid): T == C where
             m=1 => r::EX
             r::EX * m::EX
 
---       coerce(x:%) : EX ==
---         null x => (0$R) :: EX
---         le : List EX := nil
---         for rec in x repeat
---           rec.c = 1$R => le := cons(rec.k :: EX, le)
---           rec.k = 1$E => le := cons(rec.c :: EX, le)
---           le := cons(mkBinary("*"::EX,rec.c :: EX,
---             rec.k :: EX), le)
---         1 = #le => first le
---         mkNary("+" :: EX,le)
-
        coerce(a:%):EX ==
             empty? a => (0$R)::EX
             reduce(_+, reverse_! [outTerm(t.c, t.k) for t in a])$List(EX)
-
  
        if R has Field then
+
           x/r == inv(r)*x
 
 \end{chunk}
@@ -172954,6 +214880,94 @@ XPolynomialRing(R:Ring,E:OrderedMonoid): T == C where
 \begin{chunk}{COQ XPR}
 (* domain XPR *)
 (*
+
+    --representations
+       Rep:=  List TERM
+
+    --uses
+       repeatMultExpt: (%,NonNegativeInteger) -> %
+
+    --define
+
+       1  == [[1$E,1$R]]
+ 
+       characteristic  == characteristic$R
+
+       #x == #$Rep x
+
+       maxdeg p == if null p then  error " polynome nul !!"
+                             else p.first.k
+
+       mindeg p == if null p then  error " polynome nul !!" 
+                             else (last p).k
+       
+       coef(p,e)  ==
+          for tm in p repeat
+            tm.k=e => return tm.c
+            tm.k < e => return 0$R
+          0$R
+
+       constant? p == (p = 0) or (maxdeg(p) = 1$E)
+
+       constant  p == coef(p,1$E)
+
+       quasiRegular? p == (p=0) or (last p).k ^= 1$E
+
+       quasiRegular  p == 
+          quasiRegular?(p) => p
+          [t for t in p | not(t.k = 1$E)]
+
+       recip(p) ==
+           p=0 => "failed"
+           p.first.k > 1$E => "failed"
+           (u:=recip(p.first.c)) case "failed" => "failed"
+           (u::R)::%
+ 
+       coerce(r:R) == if r=0$R then 0$% else [[1$E,r]]
+
+       coerce(n:Integer) == (n::R)::%
+ 
+       if R has noZeroDivisors then
+
+         p1:% * p2:%  ==
+            null p1 => 0
+            null p2 => 0
+            p1.first.k = 1$E => p1.first.c * p2
+            p2 = 1 => p1
+            +/[[[t1.k*t2.k,t1.c*t2.c]$TERM for t2 in p2]
+                   for t1 in p1]
+
+        else
+
+         p1:% * p2:%  ==
+            null p1 => 0
+            null p2 => 0
+            p1.first.k = 1$E => p1.first.c * p2
+            p2 = 1 => p1
+            +/[[[t1.k*t2.k,r]$TERM for t2 in p2 | not (r:=t1.c*t2.c) =$R 0]
+                   for t1 in p1]
+
+       p:% ** nn:NNI  == repeatMultExpt(p,nn)
+
+       repeatMultExpt(x,nn) ==
+               nn = 0 => 1
+               y:% := x
+               for i in 2..nn repeat y:= x * y
+               y
+              
+       outTerm(r:R, m:E):EX ==
+            r=1 => m::EX
+            m=1 => r::EX
+            r::EX * m::EX
+
+       coerce(a:%):EX ==
+            empty? a => (0$R)::EX
+            reduce(_+, reverse_! [outTerm(t.c, t.k) for t in a])$List(EX)
+ 
+       if R has Field then
+
+          x/r == inv(r)*x
+
 *)
 
 \end{chunk}
@@ -173132,6 +215146,7 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring):  Xcat == Xdef where
          ++ as a list of terms.
 
   Xdef == add
+
        import(VPOLY)
 
     -- representation
@@ -173146,6 +215161,7 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring):  Xcat == Xdef where
 
     --define
        construct(lt) == lt pretend REGPOLY
+
        p1:%  =  p2:%  ==
          p1 case R =>
              p2 case R => p1 =$R p2
@@ -173157,9 +215173,6 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring):  Xcat == Xdef where
          r =0 => 0
          r * w::%
 
---       if R has Field then                  -- Bug non resolu !!!!!!!!
---         p:% / r: R == inv(r) * p
- 
        rquo(p1:%, p2:%):% ==
          p2 case R => p1 * p2::R
          p1 case R => p1  * p2.c0
@@ -173183,6 +215196,7 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring):  Xcat == Xdef where
          [constant p, x]$VPOLY
 
        if R has CommutativeRing then
+
          sh(p:%, n:NNI):% ==
             n = 0 => 1
             p case R => (p::R)** n
@@ -173240,8 +215254,11 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring):  Xcat == Xdef where
           p.c0::EX + outForm p.reg 
 
        0 == 0$R::%
+
        1 == 1$R::%
+
        constant? p ==  p case R
+
        constant p == 
           p case R => p
           p.c0
@@ -173254,7 +215271,9 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring):  Xcat == Xdef where
          [0$R,coerce(v)$REGPOLY]$VPOLY
 
        coerce (r:R):% == r::%
+
        coerce (n:Integer) == n::R::%
+
        coerce (w:WORD) == 
          w = 1 => 1$R
          (first w) * coerce(rest w)
@@ -173343,6 +215362,7 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring):  Xcat == Xdef where
          [0$R,p.reg]$VPOLY
 
        characteristic == characteristic()$R
+
        recip p ==
          p case R => recip(p::R)
          "failed"
@@ -173372,7 +215392,7 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring):  Xcat == Xdef where
 
        varList p ==
          p case R => []
-         lv: List VarSet := "setUnion"/[varList(t.c) for t in listOfTerms p.reg]
+         lv: List VarSet:= "setUnion"/[varList(t.c) for t in listOfTerms p.reg]
          lv:= setUnion(lv,[t.k for t in listOfTerms p.reg])
          sort_!(lv)
 
@@ -173381,6 +215401,256 @@ XRecursivePolynomial(VarSet:OrderedSet,R:Ring):  Xcat == Xdef where
 \begin{chunk}{COQ XRPOLY}
 (* domain XRPOLY *)
 (*
+
+       import(VPOLY)
+
+    -- representation
+       Rep     := Union(R,VPOLY)
+
+    -- local functions
+       construct: LTERMS -> REGPOLY
+       simplifie: VPOLY -> %
+       lquo1: (LTERMS,LTERMS) -> %        -- a ajouter
+       coef1: (LTERMS,LTERMS) -> R        -- a ajouter
+       outForm: REGPOLY -> EX
+
+    --define
+       construct(lt) == lt pretend REGPOLY
+
+       p1:%  =  p2:%  ==
+         p1 case R =>
+             p2 case R => p1 =$R p2
+             false
+         p2 case R => false
+         p1.c0 =$R p2.c0 and p1.reg =$REGPOLY p2.reg
+
+       monom(w, r) == 
+         r =0 => 0
+         r * w::%
+
+       rquo(p1:%, p2:%):% ==
+         p2 case R => p1 * p2::R
+         p1 case R => p1  * p2.c0
+         x:REGPOLY := construct [[t.k, a]$TERM for t in listOfTerms(p1.reg) _
+                         | (a:= rquo(t.c,p2)) ^= 0$% ]$LTERMS
+         simplifie [coef(p1,p2) , x]$VPOLY
+
+       trunc(p,n) ==
+         n = 0 or (p case R) => (constant p)::%
+         n1: NNI := (n-1)::NNI
+         lt: LTERMS := [[t.k, r]$TERM for t in listOfTerms p.reg _
+                        | (r := trunc(t.c, n1)) ^= 0]$LTERMS
+         x: REGPOLY := construct lt
+         simplifie [constant p, x]$VPOLY
+
+       unexpand p ==
+         constant? p => (constant p)::%
+         vl: List VarSet := sort((y,z) +-> y > z, varList p)
+         x : REGPOLY := _
+           construct [[v, unexpand r]$TERM for v in vl| (r:=lquo(p,v)) ^= 0]
+         [constant p, x]$VPOLY
+
+       if R has CommutativeRing then
+
+         sh(p:%, n:NNI):% ==
+            n = 0 => 1
+            p case R => (p::R)** n
+            n1: NNI := (n-1)::NNI
+            p1: % := n * sh(p, n1)  
+            lt: LTERMS := [[t.k, sh(t.c, p1)]$TERM for t in listOfTerms p.reg]
+            [p.c0 ** n, construct lt]$VPOLY
+ 
+         sh(p1:%, p2:%) ==
+            p1 case R => p1::R * p2
+            p2 case R => p1 * p2::R 
+            lt1:LTERMS := listOfTerms p1.reg ; lt2:LTERMS := listOfTerms p2.reg
+            x: REGPOLY := construct [[t.k,sh(t.c,p2)]$TERM for t in lt1]
+            y: REGPOLY := construct [[t.k,sh(p1,t.c)]$TERM for t in lt2]
+            [p1.c0*p2.c0,x + y]$VPOLY
+
+       RemainderList p == 
+           p case R => []
+           listOfTerms( p.reg)$REGPOLY
+ 
+       lquo(p1:%,p2:%):% ==
+         p2 case R => p1 * p2
+         p1 case R => p1  *$R p2.c0
+         p1 * p2.c0 +$% lquo1(listOfTerms p1.reg, listOfTerms p2.reg)
+
+       lquo1(x:LTERMS,y:LTERMS):% ==
+         null x => 0$%  
+         null y => 0$%
+         x.first.k < y.first.k => lquo1(x,y.rest)
+         x.first.k = y.first.k => 
+             lquo(x.first.c,y.first.c) + lquo1(x.rest,y.rest)
+         return lquo1(x.rest,y)
+
+       coef(p1:%, p2:%):R ==
+         p1 case R => p1::R * constant p2
+         p2 case R => p1.c0 * p2::R
+         p1.c0 * p2.c0 +$R coef1(listOfTerms p1.reg, listOfTerms p2.reg)
+
+       coef1(x:LTERMS,y:LTERMS):R ==
+         null x => 0$R
+         null y => 0$R
+         x.first.k < y.first.k => coef1(x,y.rest)
+         x.first.k = y.first.k =>
+             coef(x.first.c,y.first.c) + coef1(x.rest,y.rest)
+         return coef1(x.rest,y)
+
+       --------------------------------------------------------------
+       outForm(p:REGPOLY): EX ==
+          le : List EX :=  [t.k::EX * t.c::EX for t in listOfTerms p]
+          reduce(_+, reverse_! le)$List(EX)
+
+       coerce(p:$): EX ==
+          p case R => (p::R)::EX
+          p.c0 = 0 => outForm p.reg
+          p.c0::EX + outForm p.reg 
+
+       0 == 0$R::%
+
+       1 == 1$R::%
+
+       constant? p ==  p case R
+
+       constant p == 
+          p case R => p
+          p.c0
+
+       simplifie p ==
+         p.reg = 0$REGPOLY => (p.c0)::%
+         p
+
+       coerce (v:VarSet):% ==
+         [0$R,coerce(v)$REGPOLY]$VPOLY
+
+       coerce (r:R):% == r::%
+
+       coerce (n:Integer) == n::R::%
+
+       coerce (w:WORD) == 
+         w = 1 => 1$R
+         (first w) * coerce(rest w)
+ 
+       expand p ==
+         p case R => p::R::XDPOLY
+         lt:LTERMS := listOfTerms(p.reg)
+         ep:XDPOLY := (p.c0)::XDPOLY
+         for t in lt repeat
+           ep:= ep + t.k * expand(t.c)
+         ep
+                
+       - p:% ==
+         p case R => -$R p
+         [- p.c0, - p.reg]$VPOLY
+ 
+       p1 + p2 ==
+         p1 case R and p2 case R => p1 +$R p2
+         p1 case R => [p1 + p2.c0 , p2.reg]$VPOLY
+         p2 case R => [p2 + p1.c0 , p1.reg]$VPOLY 
+         simplifie [p1.c0 + p2.c0 , p1.reg +$REGPOLY p2.reg]$VPOLY
+ 
+       p1 - p2 ==
+         p1 case R and p2 case R => p1 -$R p2
+         p1 case R => [p1 - p2.c0 , -p2.reg]$VPOLY
+         p2 case R => [p1.c0 - p2 , p1.reg]$VPOLY
+         simplifie [p1.c0 - p2.c0 , p1.reg -$REGPOLY p2.reg]$VPOLY
+ 
+       n:Integer * p:% ==
+         n=0 => 0$%
+         p case R => n *$R p
+         -- [ n*p.c0,n*p.reg]$VPOLY
+         simplifie [ n*p.c0,n*p.reg]$VPOLY
+
+       r:R * p:% ==
+         r=0 => 0$%
+         p case R => r *$R p
+         -- [ r*p.c0,r*p.reg]$VPOLY
+         simplifie [ r*p.c0,r*p.reg]$VPOLY
+
+       p:% * r:R ==
+         r=0 => 0$%
+         p case R => p *$R r
+         -- [ p.c0 * r,p.reg * r]$VPOLY
+         simplifie [ r*p.c0,r*p.reg]$VPOLY
+
+       v:VarSet * p:% == 
+          p = 0 => 0$%
+          [0$R, v *$REGPOLY p]$VPOLY
+ 
+       p1:% * p2:% ==
+         p1 case R => p1::R * p2
+         p2 case R => p1 * p2::R
+         x:REGPOLY := p1.reg *$REGPOLY p2
+         y:REGPOLY := (p1.c0)::% *$REGPOLY p2.reg  -- maladroit:(p1.c0)::% !!
+         -- [ p1.c0 * p2.c0 , x+y ]$VPOLY
+         simplifie [ p1.c0 * p2.c0 , x+y ]$VPOLY
+
+       lquo(p:%, v:VarSet):% ==
+         p case R => 0
+         coefficient(p.reg,v)$REGPOLY
+
+       lquo(p:%, w:WORD):% ==
+         w = 1$WORD => p
+         lquo(lquo(p,first w),rest w)
+
+       rquo(p:%, v:VarSet):% ==
+         p case R => 0
+         x:REGPOLY := construct [[t.k, a]$TERM for t in listOfTerms(p.reg)
+                         | (a:= rquo(t.c,v)) ^= 0 ]
+         simplifie [constant(coefficient(p.reg,v)) , x]$VPOLY 
+        
+       rquo(p:%, w:WORD):% ==
+         w = 1$WORD => p
+         rquo(rquo(p,rest w),first w)
+ 
+       coef(p:%, w:WORD):R ==
+         constant lquo(p,w)
+
+       quasiRegular? p == 
+         p case R => p = 0$R
+         p.c0 = 0$R
+
+       quasiRegular p ==
+         p case R => 0$%
+         [0$R,p.reg]$VPOLY
+
+       characteristic == characteristic()$R
+
+       recip p ==
+         p case R => recip(p::R)
+         "failed"
+
+       mindeg p ==
+         p case R =>
+           p = 0 => error "XRPOLY.mindeg: polynome nul !!"
+           1$WORD
+         p.c0 ^= 0 => 1$WORD
+         "min"/[(t.k) *$WORD mindeg(t.c) for t in listOfTerms p.reg] 
+
+       maxdeg p ==
+         p case R => 
+            p = 0 => error "XRPOLY.maxdeg: polynome nul !!"
+            1$WORD
+         "max"/[(t.k) *$WORD maxdeg(t.c) for t in listOfTerms p.reg] 
+
+       degree p == 
+          p = 0 => error "XRPOLY.degree: polynome nul !!"
+          length(maxdeg p)
+
+       map(fn,p) ==
+         p case R => fn(p::R)
+         x:REGPOLY := construct [[t.k,a]$TERM for t in listOfTerms p.reg
+                         |(a := map(fn,t.c)) ^= 0$R]
+         simplifie [fn(p.c0),x]$VPOLY
+
+       varList p ==
+         p case R => []
+         lv: List VarSet:= "setUnion"/[varList(t.c) for t in listOfTerms p.reg]
+         lv:= setUnion(lv,[t.k for t in listOfTerms p.reg])
+         sort_!(lv)
+
 *)
 
 \end{chunk}
diff --git a/books/bookvol10.4.pamphlet b/books/bookvol10.4.pamphlet
index 9c06a8c..b91d68b 100644
--- a/books/bookvol10.4.pamphlet
+++ b/books/bookvol10.4.pamphlet
@@ -247,6 +247,137 @@ AffineAlgebraicSetComputeWithGroebnerBasis(K,symb,PolyRing,E,ProjPt):Exports_
 \begin{chunk}{COQ AFALGGRO}
 (* package AFALGGRO *)
 (*
+
+    ss2:List Symbol:= [X1,X2]
+    
+    DD   ==> DistributedMultivariatePolynomial(ss2,K)
+    LexE ==> DirectProduct(#ss2,NonNegativeInteger)
+    OV2  ==> OrderedVariableList(ss2)
+    InGB ==> InterfaceGroebnerPackage(K,ss2,LexE,OV2,DD)
+
+    affineAlgSetLocal : List DD  -> _
+                        Union(List(ProjPt),"failed","Infinite",Integer)
+
+    import PPFC1
+    import PolyRing
+    import ProjPt
+    
+    listVar:List(OV):= [index(i::PI)$OV for i in 1..#symb]
+
+    polyToYX1 : PolyRing ->  DD
+    -- NOTE : polyToYX1 set the last variable to 1 and swap the 1st and 2nd var
+    -- so that a call to grobner will eliminate the second var before the 
+    -- first one 
+    -- 23/10/98 : Ce n'est plus vrai. La fonction a ete "repare'".
+    -- A priori ce la ne creait pas de bug, car on tenait compte de 
+    -- cette particulariite dans la fonction affineAlgSetLocal.
+    -- cette derniere fct a aussi ete "ajuste'"
+    -- 27/10/98 
+    -- Ce n'est pas vraie !!! Il fauit trouve X d'abord et ensuite Y !!
+    -- sinon tout sr la notion de places distinguee fout le camp !!!
+
+    polyToX10 : PolyRing -> SUP(K)
+      
+--fonctions de resolution de sys. alg. de dim 0
+
+    if K has FiniteFieldCategory then
+      
+      affineRationalPoints(crv:PolyRing,extdegree:PI):List(ProjPt) ==
+	--The code of this is almost the same as for algebraicSet
+	--We could just construct the ideal and call algebraicSet
+	--Should we do that? This might be a bit faster.
+        
+	listPtsIdl:List(ProjPt):= empty()
+
+        x:= monomial(1,directProduct(vector([1,0])$Vector(NNI)))$DD
+        y:= monomial(1,directProduct(vector([0,1])$Vector(NNI)))$DD
+	
+	if K has PseudoAlgebraicClosureOfFiniteFieldCategory then 
+	  setTower!(1$K)$K
+        q:= size()$K 
+        px:= x**(q**extdegree) - x
+	py:= y**(q**extdegree) - y
+
+	crvXY1 := polyToYX1 crv
+        rpts:= affineAlgSetLocal([crvXY1,px,py])
+
+        -- si les  3  tests qui suivent ne sont pas la, 
+        -- alors ca ne compile pas !!! ??? 
+        rpts case "failed" =>_
+          error "failed: From affineRationalPoints in AFALGGRO,"
+        rpts case "Infinite" =>_
+          error "Infinite: From affineRationalPoints in AFALGGRO,"
+        rpts case Integer =>_
+          error "Integer: From affineRationalPoints in AFALGGRO,"
+        rpts case List(ProjPt) => rpts 
+        error "Unknown: From affineRationalPoints in AFALGGRO,"
+
+    affineSingularPoints(crb)==
+      F:= polyToYX1 crb
+      Fx:=differentiate(F,index(1)$OV2)
+      Fy:=differentiate(F,index(2)$OV2)
+      affineAlgSetLocal([F,Fx,Fy]) 
+
+    affineAlgSet(ideal : List PolyRing )==
+      idealXY1 := [polyToYX1 pol for pol in ideal]
+      affineAlgSetLocal idealXY1
+      
+    --fonctions de resolution de sys. alg. de dim 0
+    affineAlgSetLocal(idealToXY1:List DD ) ==
+      listPtsIdl:List(ProjPt)
+      idealGroXY1:=groebner(idealToXY1)$InGB
+      listZeroY:List(K):=empty()
+      listZeroX:List(K):=empty()
+      listOfExtDeg:List(Integer):=empty()
+      polyZeroX:DD:=last(idealGroXY1)
+      member?(index(1)$OV2, variables(polyZeroX)$DD) =>
+        print(("The number of point in the algebraic set is not finite")::OF)
+        print(("or the curve is not absolubtly irreducible.")::OF)
+        error "Have a nice day"
+        --now we find all of the projective points where z ^= 0
+      recOfZerosX:=distinguishedRootsOf(univariate(polyZeroX),1$K)$RFP(K)
+      -- HERE CHANGE
+      degExtX:=recOfZerosX.extDegree
+      listZeroX:List K := recOfZerosX.zeros
+      listOfExtDeg:=cons(degExtX,listOfExtDeg)
+      for a in listZeroX repeat
+        tjeker := [(eval(f,index(2)$OV2,a)$DD) for f in idealGroXY1]
+        idealGroaXb1 := [univariate(f)$DD for f in tjeker]
+	recOfZerosOfIdeal:=distinguishedCommonRootsOf(idealGroaXb1,a)$RFP(K)
+        listZeroY:= recOfZerosOfIdeal.zeros
+        listOfExtDeg:=cons(recOfZerosOfIdeal.extDegree,listOfExtDeg)
+        listPtsIdl:=
+          concat( [projectivePoint([a,b,1]) for b in listZeroY] ,listPtsIdl)
+      degExt:=lcm listOfExtDeg
+      zero?(degExt) =>
+        print(("------- Infinite number of points ------")::OF)
+        "Infinite"
+      ^one?(degExt) =>
+        print(("You need an extension of degree")::OF)
+        print(degExt::OF)
+        degExt
+      listPtsIdl
+          
+    polyToYX1(pol)==
+      zero?(pol) => 0
+      dd:= degree pol
+      lc:= leadingCoefficient pol
+      pp:= parts dd
+      ppr:=  rest reverse pp
+      ppv:Vector(NNI):= vector ppr
+      eppr:=directProduct(ppv)$LexE
+      monomial(lc,eppr)$DD + polyToYX1 reductum pol
+
+    polyToX10(pol)==
+      zero?(pol) => 0
+      dd:= degree pol
+      lc:= leadingCoefficient pol
+      pp:= parts dd
+      lp:= last pp
+      ^zero?(lp) => polyToX10 reductum pol
+      e1:= pp.1
+      monomial(lc,e1)$SUP(K) + polyToX10 reductum pol
+      
 *)
 
 \end{chunk}
@@ -464,6 +595,107 @@ AffineAlgebraicSetComputeWithResultant(K,symb,PolyRing,E,ProjPt):Ex==Impl where
 \begin{chunk}{COQ AFALGRES}
 (* package AFALGRES *)
 (*
+    
+    import ProjPt
+        
+    evAtcoef: (UPUP,K) -> SUP(K)
+   
+    evAtcoef(pol,a)==
+      zero?(pol) => 0
+      dd:= degree pol
+      lc:= leadingCoefficient pol
+      monomial( lc(a), dd )$SUP(K)  + evAtcoef( reductum(pol), a )
+
+    polyRing2UPUP(pol)==
+      zero?(pol) => 0
+      dd:= degree pol
+      lc:= leadingCoefficient pol
+      pp:= parts dd
+      monomial(monomial(lc,pp.1)$SUP(K),pp.2)$UPUP+polyRing2UPUP(reductum(pol))
+
+    if K has FiniteFieldCategory then
+      
+      affineRationalPoints(crv:PolyRing,extdegree:PositiveInteger) ==
+	listPtsIdl:List(ProjPt):= empty()
+        x:= monomial(1,directProduct(vector([1,0,0])$Vector(NNI)))$PolyRing
+        y:= monomial(1,directProduct(vector([0,1,0])$Vector(NNI)))$PolyRing
+	if K has PseudoAlgebraicClosureOfFiniteFieldCategory then 
+	  setTower!(1$K)$K
+        q:= size()$K 
+        px:= x**(q**extdegree) - x
+	py:= y**(q**extdegree) - y
+        rpts:= affineAlgSet([crv,px,py])
+        -- si les  3  tests qui suivent ne sont pas la, 
+        -- alors ca ne compile pas !!! ??? 
+        rpts case "failed" => _
+          error "case failed: From affineRationalPoints in AFALGRES"
+        rpts case "Infinite" => _
+          error "case infinite: From affineRationalPoints in AFALGRES"
+        rpts case Integer => _
+          error "case Integer: From affineRationalPoints in AFALGRES"
+        rpts case List(ProjPt) => rpts 
+        error "case unknown: From affineRationalPoints in AFALGRES"
+
+    allPairsAmong(lp)==
+      #lp = 2 => [lp]
+      rlp:=rest lp
+      subL:= allPairsAmong rlp
+      pol:=first lp
+      frontL:= [[pol,p] for p in rlp]
+      concat( frontL , subL )
+
+    affineSingularPoints(pol:PolyRing)==
+      affineSingularPoints( polyRing2UPUP pol )
+
+    affineSingularPoints(pol:UPUP)==
+      ground? pol => "failed"
+      lc := coefficients pol
+      lcb := [ ground?( c )$SUP(K) for c in lc ]
+      reduce("and" , lcb) => "failed"
+      dy:=differentiate(pol)
+      dx:=map(differentiate$SUP(K),pol)
+      affineAlgSetLocal( [ pol, dy, dx ] )
+
+    resultantL: List UPUP -> SUP(K)
+    resultantL(lp)==
+      g:=first lp
+      h:= last lp
+      resultant(g,h)
+   
+    affineAlgSet(lpol:List PolyRing)==
+      affineAlgSetLocal( [ polyRing2UPUP pol for pol in lpol ] )
+
+    affineAlgSetLocal(lpol:List UPUP)== 
+      listPtsIdl:List(ProjPt)
+      allP:= allPairsAmong lpol
+      beforGcd:List SUP(K) := [resultantL(lp) for lp in allP]
+      polyZeroX:SUP(K):=gcd beforGcd
+      zero? polyZeroX => "failed"
+      listZeroY:List(K):=empty()
+      listZeroX:List(K):=empty()
+      recOfZerosX:=distinguishedRootsOf(polyZeroX,1$K)$RFP(K)
+      degExtX:=recOfZerosX.extDegree
+      listZeroX:List K := recOfZerosX.zeros
+      listOfExtDeg:List(Integer):=empty()
+      listOfExtDeg:=cons(degExtX,listOfExtDeg)
+      lpolEval:List SUP(K)
+      for a in listZeroX repeat
+        lpolEval := [ evAtcoef(p,a) for p in lpol ]
+	recOfZerosOfIdeal:=distinguishedCommonRootsOf( lpolEval ,a)$RFP(K)
+        listZeroY:= recOfZerosOfIdeal.zeros
+        listOfExtDeg:=cons(recOfZerosOfIdeal.extDegree,listOfExtDeg)
+        listPtsIdl:=
+          concat( [projectivePoint([a,b,1]) for b in listZeroY] ,listPtsIdl)
+      degExt:=lcm listOfExtDeg
+      zero?(degExt) => 
+        print(("AFALGRES:Infinite number of points")::OutputForm)
+        "Infinite" 
+      ^one?(degExt) =>
+        print(("AFALGRES:You need an extension of degree")::OutputForm)
+        print(degExt::OutputForm)
+        degExt
+      listPtsIdl
+
 *)
 
 \end{chunk}
@@ -590,14 +822,17 @@ AlgebraicFunction(R, F): Exports == Implementation where
         -- un-export when the compiler accepts conditional local functions!
 
   Implementation ==> add
+
     ialg : List F -> F
     dvalg: (List F, SE) -> F
     dalg : List F -> OutputForm
 
     opalg  := operator("rootOf"::Symbol)$CommonOperators
+
     oproot := operator("nthRoot"::Symbol)$CommonOperators
 
     belong? op == has?(op, ALGOP)
+
     dalg l     == second(l)::OutputForm
 
     rootOf(p, x) ==
@@ -631,7 +866,6 @@ AlgebraicFunction(R, F): Exports == Implementation where
         monomial? q => 0
 
         (d := degree q) <= 0 => error "rootOf: constant polynomial"
---        one? d=> - leadingCoefficient(reductum q) / leadingCoefficient q
         (d = 1) => - leadingCoefficient(reductum q) / leadingCoefficient q
         ((rx := retractIfCan(x)@Union(SE, "failed")) case SE) and
           ((r := UP2R q) case UPR) => rootOf(r::UPR, rx::SE)::F
@@ -647,10 +881,10 @@ AlgebraicFunction(R, F): Exports == Implementation where
         ans
 
     else
+
       inrootof(q, x) ==
         monomial? q => 0
         (d := degree q) <= 0 => error "rootOf: constant polynomial"
---        one? d => - leadingCoefficient(reductum q) /leadingCoefficient q
         (d = 1) => - leadingCoefficient(reductum q) /leadingCoefficient q
         kernel(opalg, [q x, x])
 
@@ -698,7 +932,6 @@ AlgebraicFunction(R, F): Exports == Implementation where
 
       inroot l ==
         zero?(n := retract(second l)@Z) => error "root: exponent = 0"
---        one?(x := first l) or one? n => x
         ((x := first l) = 1) or (n = 1) => x
         (r := retractIfCan(x)@Union(R,"failed")) case R => iroot(r::R,n)
         (u := isExpt(x, oproot)) case Record(var:K, exponent:Z) =>
@@ -708,8 +941,8 @@ AlgebraicFunction(R, F): Exports == Implementation where
                    (n * retract(second argument(pr.var))@Z))
         inroot0(x, n, false, false)
 
--- removes powers of positive integers from numer and denom
--- num? or den? is true if numer or denom already processed
+      -- removes powers of positive integers from numer and denom
+      -- num? or den? is true if numer or denom already processed
       inroot0(x, n, num?, den?) ==
         rn:Union(Z, "failed") := (num? => "failed"; retractIfCan numer x)
         rd:Union(Z, "failed") := (den? => "failed"; retractIfCan denom x)
@@ -729,16 +962,20 @@ AlgebraicFunction(R, F): Exports == Implementation where
 
       if R has AlgebraicallyClosedField then iroot(r, n) == nthRoot(r, n)::F
       else
+
         iroot0: (R, Z) -> F
 
         if R has RadicalCategory then
           if R has imaginary:() -> R then iroot(r, n) == nthRoot(r, n)::F
           else
+
             iroot(r, n) ==
               odd? n or r >= 0 => nthRoot(r, n)::F
               iroot0(r, n)
 
-        else iroot(r, n) == iroot0(r, n)
+        else 
+
+            iroot(r, n) == iroot0(r, n)
 
         iroot0(r, n) ==
           rec := rroot(r, n::NonNegativeInteger)
@@ -765,6 +1002,7 @@ AlgebraicFunction(R, F): Exports == Implementation where
       derivative(oproot, [dvroot, lzero])
 
     else   -- R is not retractable to Integer
+
       droot l ==
         x := first(l)::OutputForm
         (n := second l) = 2::F => root x
@@ -784,6 +1022,201 @@ AlgebraicFunction(R, F): Exports == Implementation where
 \begin{chunk}{COQ AF}
 (* package AF *)
 (*
+
+    ialg : List F -> F
+    dvalg: (List F, SE) -> F
+    dalg : List F -> OutputForm
+
+    opalg  := operator("rootOf"::Symbol)$CommonOperators
+
+    oproot := operator("nthRoot"::Symbol)$CommonOperators
+
+    belong? op == has?(op, ALGOP)
+
+    dalg l     == second(l)::OutputForm
+
+    rootOf(p, x) ==
+      k := kernel(x)$K
+      (r := retractIfCan(p)@Union(F, "failed")) case "failed" =>
+        inrootof(p, k::F)
+      n := numer(f := univariate(r::F, k))
+      degree denom f > 0 => error "roofOf: variable appears in denom"
+      inrootof(n, k::F)
+
+    dvalg(l, x) ==
+      p := numer univariate(first l, retract(second l)@K)
+      alpha := kernel(opalg, l)
+      - (map((s:F):F +-> differentiate(s, x), p) alpha)_
+          / ((differentiate p) alpha)
+
+    ialg l ==
+      f := univariate(p := first l, retract(x := second l)@K)
+      degree denom f > 0 => error "roofOf: variable appears in denom"
+      inrootof(numer f, x)
+
+    operator op ==
+      is?(op,  "rootOf"::Symbol) => opalg
+      is?(op, "nthRoot"::Symbol) => oproot
+      error "Unknown operator"
+
+    if R has AlgebraicallyClosedField then
+      UP2R: UP -> Union(UPR, "failed")
+
+      inrootof(q, x) ==
+        monomial? q => 0
+
+        (d := degree q) <= 0 => error "rootOf: constant polynomial"
+        (d = 1) => - leadingCoefficient(reductum q) / leadingCoefficient q
+        ((rx := retractIfCan(x)@Union(SE, "failed")) case SE) and
+          ((r := UP2R q) case UPR) => rootOf(r::UPR, rx::SE)::F
+        kernel(opalg, [q x, x])
+
+      UP2R p ==
+        ans:UPR := 0
+        while p ^= 0 repeat
+          (r := retractIfCan(leadingCoefficient p)@Union(R, "failed"))
+            case "failed" => return "failed"
+          ans := ans + monomial(r::R, degree p)
+          p   := reductum p
+        ans
+
+    else
+
+      inrootof(q, x) ==
+        monomial? q => 0
+        (d := degree q) <= 0 => error "rootOf: constant polynomial"
+        (d = 1) => - leadingCoefficient(reductum q) /leadingCoefficient q
+        kernel(opalg, [q x, x])
+
+    evaluate(opalg, ialg)$BasicOperatorFunctions1(F)
+    setProperty(opalg, SPECIALDIFF,
+                              dvalg@((List F, SE) -> F) pretend None)
+    setProperty(opalg, SPECIALDISP,
+                              dalg@(List F -> OutputForm) pretend None)
+
+    if R has RetractableTo Integer then
+      import PolynomialRoots(IndexedExponents K, K, R, P, F)
+
+      dumvar := "%%var"::Symbol::F
+
+      lzero   : List F -> F
+      dvroot  : List F -> F
+      inroot  : List F -> F
+      hackroot: (F, Z) -> F
+      inroot0 : (F, Z, Boolean, Boolean) -> F
+
+      lzero l == 0
+
+      droot l ==
+        x := first(l)::OutputForm
+        (n := retract(second l)@Z) = 2 => root x
+        root(x, n::OutputForm)
+
+      dvroot l ==
+        n := retract(second l)@Z
+        (first(l) ** ((1 - n) / n)) / (n::F)
+
+      x ** q ==
+        qr := divide(numer q, denom q)
+        x ** qr.quotient * inroot([x, (denom q)::F]) ** qr.remainder
+
+      hackroot(x, n) ==
+        (n = 1) or (x = 1) => x
+        (((dx := denom x) ^= 1) and
+           ((rx := retractIfCan(dx)@Union(Integer,"failed")) case Integer) and
+           positive?(rx))
+           => hackroot((numer x)::F, n)/hackroot(rx::Integer::F, n)
+        (x = -1) and n = 4 =>
+          ((-1::F) ** (1::Q / 2::Q) + 1) / ((2::F) ** (1::Q / 2::Q))
+        kernel(oproot, [x, n::F])
+
+      inroot l ==
+        zero?(n := retract(second l)@Z) => error "root: exponent = 0"
+        ((x := first l) = 1) or (n = 1) => x
+        (r := retractIfCan(x)@Union(R,"failed")) case R => iroot(r::R,n)
+        (u := isExpt(x, oproot)) case Record(var:K, exponent:Z) =>
+          pr := u::Record(var:K, exponent:Z)
+          (first argument(pr.var)) **
+              (pr.exponent /$Fraction(Z)
+                   (n * retract(second argument(pr.var))@Z))
+        inroot0(x, n, false, false)
+
+      -- removes powers of positive integers from numer and denom
+      -- num? or den? is true if numer or denom already processed
+      inroot0(x, n, num?, den?) ==
+        rn:Union(Z, "failed") := (num? => "failed"; retractIfCan numer x)
+        rd:Union(Z, "failed") := (den? => "failed"; retractIfCan denom x)
+        (rn case Z) and (rd case Z) =>
+          rec := qroot(rn::Z / rd::Z, n::NonNegativeInteger)
+          rec.coef * hackroot(rec.radicand, rec.exponent)
+        rn case Z =>
+          rec := qroot(rn::Z::Fraction(Z), n::NonNegativeInteger)
+          rec.coef * inroot0((rec.radicand**(n exquo rec.exponent)::Z)
+                                / (denom(x)::F), n, true, den?)
+        rd case Z =>
+          rec := qroot(rd::Z::Fraction(Z), n::NonNegativeInteger)
+          inroot0((numer(x)::F) /
+                  (rec.radicand ** (n exquo rec.exponent)::Z),
+                   n, num?, true) / rec.coef
+        hackroot(x, n)
+
+      if R has AlgebraicallyClosedField then iroot(r, n) == nthRoot(r, n)::F
+      else
+
+        iroot0: (R, Z) -> F
+
+        if R has RadicalCategory then
+          if R has imaginary:() -> R then iroot(r, n) == nthRoot(r, n)::F
+          else
+
+            iroot(r, n) ==
+              odd? n or r >= 0 => nthRoot(r, n)::F
+              iroot0(r, n)
+
+        else 
+
+            iroot(r, n) == iroot0(r, n)
+
+        iroot0(r, n) ==
+          rec := rroot(r, n::NonNegativeInteger)
+          rec.coef * hackroot(rec.radicand, rec.exponent)
+
+      definingPolynomial x ==
+        (r := retractIfCan(x)@Union(K, "failed")) case K =>
+          is?(k := r::K, opalg) => first argument k
+          is?(k, oproot) =>
+            dumvar ** retract(second argument k)@Z - first argument k
+          dumvar - x
+        dumvar - x
+
+      minPoly k ==
+        is?(k, opalg)  =>
+           numer univariate(first argument k,
+                                           retract(second argument k)@K)
+        is?(k, oproot) =>
+           monomial(1,retract(second argument k)@Z :: NonNegativeInteger)
+             - first(argument k)::UP
+        monomial(1, 1) - k::F::UP
+
+      evaluate(oproot, inroot)$BasicOperatorFunctions1(F)
+      derivative(oproot, [dvroot, lzero])
+
+    else   -- R is not retractable to Integer
+
+      droot l ==
+        x := first(l)::OutputForm
+        (n := second l) = 2::F => root x
+        root(x, n::OutputForm)
+
+      minPoly k ==
+        is?(k, opalg)  =>
+           numer univariate(first argument k,
+                                           retract(second argument k)@K)
+        monomial(1, 1) - k::F::UP
+
+    setProperty(oproot, SPECIALDISP,
+                              droot@(List F -> OutputForm) pretend None)
+
 *)
 
 \end{chunk}
@@ -862,10 +1295,11 @@ AlgebraicHermiteIntegration(F,UP,UPUP,R):Exports == Implementation where
       ++ \spad{f = g' + h} and h has a only simple finite normal poles.
 
   Implementation ==> add
+
     localsolve: (Matrix UP, Vector UP, UP) -> Vector UP
 
--- the denominator of f should have no prime factor P s.t. P | P'
--- (which happens only for P = t in the exponential case)
+    -- the denominator of f should have no prime factor P s.t. P | P'
+    -- (which happens only for P = t in the exponential case)
     HermiteIntegrate(f, derivation) ==
       ratform:R := 0
       n    := rank()
@@ -919,6 +1353,59 @@ AlgebraicHermiteIntegration(F,UP,UPUP,R):Exports == Implementation where
 \begin{chunk}{COQ INTHERAL}
 (* package INTHERAL *)
 (*
+
+    localsolve: (Matrix UP, Vector UP, UP) -> Vector UP
+
+    -- the denominator of f should have no prime factor P s.t. P | P'
+    -- (which happens only for P = t in the exponential case)
+    HermiteIntegrate(f, derivation) ==
+      ratform:R := 0
+      n    := rank()
+      m    := transpose((mat:= integralDerivationMatrix derivation).num)
+      inum := (cform := integralCoordinates f).num
+      if ((iden := cform.den) exquo (e := mat.den)) case "failed" then
+        iden := (coef := (e exquo gcd(e, iden))::UP) * iden
+        inum := coef * inum
+      for trm in factors squareFree iden | (j:= trm.exponent) > 1 repeat
+        u':=(u:=(iden exquo (v:=trm.factor)**(j::N))::UP) * derivation v
+        sys := ((u * v) exquo e)::UP * m
+        nn := minRowIndex sys - minIndex inum
+        while j > 1 repeat
+          j := j - 1
+          p := - j * u'
+          sol := localsolve(sys + scalarMatrix(n, p), inum, v)
+          ratform := ratform + integralRepresents(sol, v ** (j::N))
+          inum    := [((qelt(inum, i) - p * qelt(sol, i) -
+                        dot(row(sys, i - nn), sol))
+                          exquo v)::UP - u * derivation qelt(sol, i)
+                             for i in minIndex inum .. maxIndex inum]
+        iden := u * v
+      [ratform, integralRepresents(inum, iden)]
+
+    localsolve(mat, vec, modulus) ==
+      ans:Vector(UP) := new(nrows mat, 0)
+      diagonal? mat =>
+        for i in minIndex ans .. maxIndex ans
+          for j in minRowIndex mat .. maxRowIndex mat
+            for k in minColIndex mat .. maxColIndex mat repeat
+              (bc := extendedEuclidean(qelt(mat, j, k), modulus,
+                qelt(vec, i))) case "failed" => return new(0, 0)
+              qsetelt_!(ans, i, bc.coef1)
+        ans
+      sol := particularSolution(
+                       map(x+->x::RF, mat)$MatrixCategoryFunctions2(UP,
+                         Vector UP, Vector UP, Matrix UP, RF,
+                           Vector RF, Vector RF, Matrix RF),
+                             map(x+->x::RF, vec)$VectorFunctions2(UP,
+                               RF))$LinearSystemMatrixPackage(RF,
+                                        Vector RF, Vector RF, Matrix RF)
+      sol case "failed" => new(0, 0)
+      for i in minIndex ans .. maxIndex ans repeat
+        (bc := extendedEuclidean(denom qelt(sol, i), modulus, 1))
+          case "failed" => return new(0, 0)
+        qsetelt_!(ans, i, (numer qelt(sol, i) * bc.coef1) rem modulus)
+      ans
+
 *)
 
 \end{chunk}
@@ -1028,6 +1515,7 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where
       ++ Argument f must be a pure algebraic function.
 
   Implementation ==> add
+
     import FD
     import DoubleResultantPackage(F, UP, UPUP, R)
     import PointsOfFiniteOrder(R0, F, UP, UPUP, R)
@@ -1061,9 +1549,11 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where
     dummy:R := 0
 
     dumx  := kernel(new()$SE)$K
+
     dumy  := kernel(new()$SE)$K
 
     F2UPR f == F2R(f)::UPR
+
     F2R f   == f::UP::QF::R
 
     algintexp(f, derivation) ==
@@ -1097,18 +1587,18 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where
     palglogint(f, derivation) ==
       rec := algSplitSimple(f, derivation)
       ground?(r := doubleResultant(f, derivation)) => "failed"
--- r(z) has roots which are the residues of f at all its poles
+      -- r(z) has roots which are the residues of f at all its poles
       (u  := qfactor r) case "failed" => nonQ(rec, r)
       (fc := nonLinear(lf := factors(u::FRQ))) case "failed" => FAIL2
--- at this point r(z) = fc(z) (z - b1)^e1 .. (z - bk)^ek
--- where the ri's are rational numbers, and fc(z) is arbitrary
--- (fc can be linear too)
--- la = [b1....,bk]  (all rational residues)
+      -- at this point r(z) = fc(z) (z - b1)^e1 .. (z - bk)^ek
+      -- where the ri's are rational numbers, and fc(z) is arbitrary
+      -- (fc can be linear too)
+      -- la = [b1....,bk]  (all rational residues)
       la := [- coefficient(q.factor, 0) for q in remove_!(fc::FAC, lf)]
--- ld = [D1,...,Dk] where Di is the sum of places where f has residue bi
-      ld  := [divisor(rec.num, rec.den, rec.derivden, rec.gd, b::F) for b in la]
+      -- ld = [D1,...,Dk] where Di is the sum of places where f has residue bi
+      ld := [divisor(rec.num, rec.den, rec.derivden, rec.gd, b::F) for b in la]
       pp  := UPQ2F(fc.factor)
--- bb = - sum of all the roots of fc (i.e. the other residues)
+      -- bb = - sum of all the roots of fc (i.e. the other residues)
       zero?(bb := coefficient(fc.factor,
            (degree(fc.factor) - 1)::NonNegativeInteger)) =>
               -- cd = [[a1,...,ak], d]  such that bi = ai/d
@@ -1122,7 +1612,6 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where
               trace0(rec, pp, g / cd.den, dv0)
       trace1(rec, pp, la, ld, bb)
 
-
     UPQ2F p ==
       map((x:Q):F+->x::F,p)$UnivariatePolynomialCategoryFunctions2(Q,UPQ,F,UP)
 
@@ -1140,7 +1629,6 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where
     pLogDeriv(log, derivation) ==
       map(derivation, log.coeff) ^= 0 =>
                  error "can only handle logs with constant coefficients"
---      one?(n := degree(log.coeff)) =>
       ((n := degree(log.coeff)) = 1) =>
         c := - (leadingCoefficient reductum log.coeff)
              / (leadingCoefficient log.coeff)
@@ -1178,8 +1666,8 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where
                        trace00(rec, first(lf).factor, empty()$List(LOG))
       FAIL1
 
--- case when the irreducible factor p has roots which sum to 0
--- p is assumed doubly transitive for now
+    -- case when the irreducible factor p has roots which sum to 0
+    -- p is assumed doubly transitive for now
     trace0(rec, q, r, dv0) ==
       lg:List(LOG) :=
         zero? dv0 => empty()
@@ -1198,29 +1686,30 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where
         NOTI
       concat(lg, mkLog(q, inv(rc.order::Q), rc.function, alpha))
 
--- case when the irreducible factor p has roots which sum <> 0
--- the residues of f are of the form [a1,...,ak] rational numbers
--- plus all the roots of q(z), which is squarefree
--- la is the list of residues la := [a1,...,ak]
--- ld is the list of divisors [D1,...Dk] where Di is the sum of all the
--- places where f has residue ai
--- q(z) is assumed doubly transitive for now.
--- let [alpha_1,...,alpha_m] be the roots of q(z)
--- in this function, b = - alpha_1 - ... - alpha_m is <> 0
--- which implies only one generic log term
+    -- case when the irreducible factor p has roots which sum <> 0
+    -- the residues of f are of the form [a1,...,ak] rational numbers
+    -- plus all the roots of q(z), which is squarefree
+    -- la is the list of residues la := [a1,...,ak]
+    -- ld is the list of divisors [D1,...Dk] where Di is the sum of all the
+    -- places where f has residue ai
+    -- q(z) is assumed doubly transitive for now.
+    -- let [alpha_1,...,alpha_m] be the roots of q(z)
+    -- in this function, b = - alpha_1 - ... - alpha_m is <> 0
+    -- which implies only one generic log term
     trace1(rec, q, la, ld, b) ==
--- cd = [[b1,...,bk], d]  such that ai / b = bi / d
+      -- cd = [[b1,...,bk], d]  such that ai / b = bi / d
       cd  := splitDenominator [a / b for a in la]
--- then, a basis for all the residues of f over the integers is
--- [beta_1 = - alpha_1 / d,..., beta_m = - alpha_m / d], since:
---      alpha_i = - d beta_i
---      ai = (ai / b) * b = (bi / d) * b = b1 * beta_1 + ... + bm * beta_m
--- linear independence is a consequence of the doubly transitive assumption
--- v0 is the divisor +/[bi Di] corresponding to the residues [a1,...,ak]
+      -- then, a basis for all the residues of f over the integers is
+      -- [beta_1 = - alpha_1 / d,..., beta_m = - alpha_m / d], since:
+      --      alpha_i = - d beta_i
+      --    ai = (ai / b) * b = (bi / d) * b = b1 * beta_1 + ... + bm * beta_m
+      -- linear independence is a consequence of the 
+      -- doubly transitive assumption
+      -- v0 is the divisor +/[bi Di] corresponding to the residues [a1,...,ak]
       v0 := +/[a * dv for a in cd.num for dv in ld]
--- alpha is a generic root of q(z)
+      -- alpha is a generic root of q(z)
       alpha := rootOf UP2SUP q
--- v is the divisor corresponding to all the residues
+      -- v is the divisor corresponding to all the residues
       v := v0 - cd.den * divisor(rec.num, rec.den, rec.derivden, rec.gd, alpha)
       (rc := torsionIfCan v) case "failed" =>   -- non-torsion case
         degree(q) <= 2 => "failed"       -- guaranteed doubly-transitive
@@ -1234,8 +1723,8 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where
          map(F2R, q)$UnivariatePolynomialCategoryFunctions2(F,UP,R,UPR),
                                            R2UP(lgd, retract(alpha)@K)]]
 
--- return the non-linear factor, if unique
--- or any linear factor if they are all linear
+    -- return the non-linear factor, if unique
+    -- or any linear factor if they are all linear
     nonLinear l ==
       found:Boolean := false
       ans := first l
@@ -1246,13 +1735,13 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where
           ans   := q
       ans
 
--- f dx must be locally integral at infinity
+    -- f dx must be locally integral at infinity
     palginfieldint(f, derivation) ==
       h := HermiteIntegrate(f, derivation)
       zero?(h.logpart) => h.answer
       "failed"
 
--- f dx must be locally integral at infinity
+    -- f dx must be locally integral at infinity
     palgintegrate(f, derivation) ==
       h := HermiteIntegrate(f, derivation)
       zero?(h.logpart) => h.answer::IR
@@ -1264,7 +1753,7 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where
                 mkAnswer(h.answer, u::List(LOG), empty())
       mkAnswer(h.answer, u::List(LOG), [[difFirstKind, dummy]])
 
--- for mixed functions. f dx not assumed locally integral at infinity
+    -- for mixed functions. f dx not assumed locally integral at infinity
     algintegrate(f, derivation) ==
       zero? degree(x' := derivation(x := monomial(1, 1)$UP)) =>
          algintprim(f, derivation)
@@ -1283,6 +1772,258 @@ AlgebraicIntegrate(R0, F, UP, UPUP, R): Exports == Implementation where
 \begin{chunk}{COQ INTALG}
 (* package INTALG *)
 (*
+
+    import FD
+    import DoubleResultantPackage(F, UP, UPUP, R)
+    import PointsOfFiniteOrder(R0, F, UP, UPUP, R)
+    import AlgebraicHermiteIntegration(F, UP, UPUP, R)
+    import InnerCommonDenominator(Z, Q, List Z, List Q)
+    import FunctionSpaceUnivariatePolynomialFactor(R0, F, UP)
+    import PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                         K, R0, SparseMultivariatePolynomial(R0, K), F)
+
+    F2R        : F  -> R
+    F2UPR      : F  -> UPR
+    UP2SUP     : UP -> SUP
+    SUP2UP     : SUP -> UP
+    UPQ2F      : UPQ -> UP
+    univ       : (F, K) -> QF
+    pLogDeriv  : (LOG, R -> R) -> R
+    nonLinear  : List FAC -> Union(FAC, "failed")
+    mkLog      : (UP, Q, R, F) -> List LOG
+    R2UP       : (R, K) -> UPR
+    alglogint  : (R, UP -> UP) -> Union(List LOG, "failed")
+    palglogint : (R, UP -> UP) -> Union(List LOG, "failed")
+    trace00    : (DIV, UP, List LOG) -> Union(List LOG,"failed")
+    trace0     : (DIV, UP, Q, FD)    -> Union(List LOG, "failed")
+    trace1     : (DIV, UP, List Q, List FD, Q) -> Union(List LOG, "failed")
+    nonQ       : (DIV, UP)           -> Union(List LOG, "failed")
+    rlift      : (F, K, K) -> R
+    varRoot?   : (UP, F -> F) -> Boolean
+    algintexp  : (R, UP -> UP) -> IR
+    algintprim : (R, UP -> UP) -> IR
+
+    dummy:R := 0
+
+    dumx  := kernel(new()$SE)$K
+
+    dumy  := kernel(new()$SE)$K
+
+    F2UPR f == F2R(f)::UPR
+
+    F2R f   == f::UP::QF::R
+
+    algintexp(f, derivation) ==
+      d := (c := integralCoordinates f).den
+      v := c.num
+      vp:Vector(GP) := new(n := #v, 0)
+      vf:Vector(QF) := new(n, 0)
+      for i in minIndex v .. maxIndex v repeat
+        r := separate(qelt(v, i) / d)$GP
+        qsetelt_!(vf, i, r.fracPart)
+        qsetelt_!(vp, i, r.polyPart)
+      ff := represents(vf, w := integralBasis())
+      h := HermiteIntegrate(ff, derivation)
+      p := represents(
+             map((x1:GP):QF+->convert(x1)@QF, vp)$VectorFunctions2(GP, QF), w)
+      zero?(h.logpart) and zero? p => h.answer::IR
+      (u := alglogint(h.logpart, derivation)) case "failed" =>
+                       mkAnswer(h.answer, empty(), [[p + h.logpart, dummy]])
+      zero? p => mkAnswer(h.answer, u::List(LOG), empty())
+      FAIL3
+
+    algintprim(f, derivation) ==
+      h := HermiteIntegrate(f, derivation)
+      zero?(h.logpart) => h.answer::IR
+      (u := alglogint(h.logpart, derivation)) case "failed" =>
+                       mkAnswer(h.answer, empty(), [[h.logpart, dummy]])
+      mkAnswer(h.answer, u::List(LOG), empty())
+
+    -- checks whether f = +/[ci (ui)'/(ui)]
+    -- f dx must have no pole at infinity
+    palglogint(f, derivation) ==
+      rec := algSplitSimple(f, derivation)
+      ground?(r := doubleResultant(f, derivation)) => "failed"
+      -- r(z) has roots which are the residues of f at all its poles
+      (u  := qfactor r) case "failed" => nonQ(rec, r)
+      (fc := nonLinear(lf := factors(u::FRQ))) case "failed" => FAIL2
+      -- at this point r(z) = fc(z) (z - b1)^e1 .. (z - bk)^ek
+      -- where the ri's are rational numbers, and fc(z) is arbitrary
+      -- (fc can be linear too)
+      -- la = [b1....,bk]  (all rational residues)
+      la := [- coefficient(q.factor, 0) for q in remove_!(fc::FAC, lf)]
+      -- ld = [D1,...,Dk] where Di is the sum of places where f has residue bi
+      ld := [divisor(rec.num, rec.den, rec.derivden, rec.gd, b::F) for b in la]
+      pp  := UPQ2F(fc.factor)
+      -- bb = - sum of all the roots of fc (i.e. the other residues)
+      zero?(bb := coefficient(fc.factor,
+           (degree(fc.factor) - 1)::NonNegativeInteger)) =>
+              -- cd = [[a1,...,ak], d]  such that bi = ai/d
+              cd  := splitDenominator la
+              -- g = gcd(a1,...,ak), so bi = (g/d) ci  with ci = bi / g
+              -- so [g/d] is a basis for [a1,...,ak] over the integers
+              g   := gcd(cd.num)
+              -- dv0 is the divisor +/[ci Di] corresponding to all the residues
+              -- of f except the ones which are root of fc(z)
+              dv0 := +/[(a quo g) * dv for a in cd.num for dv in ld]
+              trace0(rec, pp, g / cd.den, dv0)
+      trace1(rec, pp, la, ld, bb)
+
+    UPQ2F p ==
+      map((x:Q):F+->x::F,p)$UnivariatePolynomialCategoryFunctions2(Q,UPQ,F,UP)
+
+    UP2SUP p ==
+      map((x:F):F+->x,p)$UnivariatePolynomialCategoryFunctions2(F, UP, F, SUP)
+
+    SUP2UP p ==
+      map((x:F):F+->x,p)$UnivariatePolynomialCategoryFunctions2(F, SUP, F, UP)
+
+    varRoot?(p, derivation) ==
+      for c in coefficients primitivePart p repeat
+        derivation(c) ^= 0 => return true
+      false
+
+    pLogDeriv(log, derivation) ==
+      map(derivation, log.coeff) ^= 0 =>
+                 error "can only handle logs with constant coefficients"
+      ((n := degree(log.coeff)) = 1) =>
+        c := - (leadingCoefficient reductum log.coeff)
+             / (leadingCoefficient log.coeff)
+        ans := (log.logand) c
+        (log.scalar)::R * c * derivation(ans) / ans
+      numlog := map(derivation, log.logand)
+      (diflog := extendedEuclidean(log.logand, log.coeff, numlog)) case
+          "failed" => error "this shouldn't happen"
+      algans := diflog.coef1
+      ans:R := 0
+      for i in 0..n-1 repeat
+        algans := (algans * monomial(1, 1)) rem log.coeff
+        ans    := ans + coefficient(algans, i)
+      (log.scalar)::R * ans
+
+    R2UP(f, k) ==
+      x := dumx :: F
+      g := 
+       (map((f1:QF):F+->f1(x), lift f)_
+         $UnivariatePolynomialCategoryFunctions2(QF,UPUP,F,UP))
+           (y := dumy::F)
+      map((x1:F):R+->rlift(x1, dumx, dumy), univariate(g, k, minPoly k))_
+        $UnivariatePolynomialCategoryFunctions2(F,SUP,R,UPR)
+
+    univ(f, k) ==
+      g := univariate(f, k)
+      (SUP2UP numer g) / (SUP2UP denom g)
+
+    rlift(f, kx, ky) ==
+      reduce map(x1+->univ(x1, kx), retract(univariate(f, ky))@SUP)_
+        $UnivariatePolynomialCategoryFunctions2(F,SUP,QF,UPUP)
+
+    nonQ(rec, p) ==
+      empty? rest(lf := factors ffactor primitivePart p) =>
+                       trace00(rec, first(lf).factor, empty()$List(LOG))
+      FAIL1
+
+    -- case when the irreducible factor p has roots which sum to 0
+    -- p is assumed doubly transitive for now
+    trace0(rec, q, r, dv0) ==
+      lg:List(LOG) :=
+        zero? dv0 => empty()
+        (rc0 := torsionIfCan dv0) case "failed" => NOTI
+        mkLog(1, r / (rc0.order::Q), rc0.function, 1)
+      trace00(rec, q, lg)
+
+    trace00(rec, pp, lg) ==
+      p0 := divisor(rec.num, rec.den, rec.derivden, rec.gd,
+                    alpha0 := zeroOf UP2SUP pp)
+      q  := (pp exquo (monomial(1, 1)$UP - alpha0::UP))::UP
+      alpha := rootOf UP2SUP q
+      dvr := divisor(rec.num, rec.den, rec.derivden, rec.gd, alpha) - p0
+      (rc := torsionIfCan dvr) case "failed" =>
+        degree(pp) <= 2 => "failed"
+        NOTI
+      concat(lg, mkLog(q, inv(rc.order::Q), rc.function, alpha))
+
+    -- case when the irreducible factor p has roots which sum <> 0
+    -- the residues of f are of the form [a1,...,ak] rational numbers
+    -- plus all the roots of q(z), which is squarefree
+    -- la is the list of residues la := [a1,...,ak]
+    -- ld is the list of divisors [D1,...Dk] where Di is the sum of all the
+    -- places where f has residue ai
+    -- q(z) is assumed doubly transitive for now.
+    -- let [alpha_1,...,alpha_m] be the roots of q(z)
+    -- in this function, b = - alpha_1 - ... - alpha_m is <> 0
+    -- which implies only one generic log term
+    trace1(rec, q, la, ld, b) ==
+      -- cd = [[b1,...,bk], d]  such that ai / b = bi / d
+      cd  := splitDenominator [a / b for a in la]
+      -- then, a basis for all the residues of f over the integers is
+      -- [beta_1 = - alpha_1 / d,..., beta_m = - alpha_m / d], since:
+      --      alpha_i = - d beta_i
+      --    ai = (ai / b) * b = (bi / d) * b = b1 * beta_1 + ... + bm * beta_m
+      -- linear independence is a consequence of the 
+      -- doubly transitive assumption
+      -- v0 is the divisor +/[bi Di] corresponding to the residues [a1,...,ak]
+      v0 := +/[a * dv for a in cd.num for dv in ld]
+      -- alpha is a generic root of q(z)
+      alpha := rootOf UP2SUP q
+      -- v is the divisor corresponding to all the residues
+      v := v0 - cd.den * divisor(rec.num, rec.den, rec.derivden, rec.gd, alpha)
+      (rc := torsionIfCan v) case "failed" =>   -- non-torsion case
+        degree(q) <= 2 => "failed"       -- guaranteed doubly-transitive
+        NOTI                             -- maybe doubly-transitive
+      mkLog(q, inv((- rc.order * cd.den)::Q), rc.function, alpha)
+
+    mkLog(q, scalr, lgd, alpha) ==
+      degree(q) <= 1 =>
+        [[scalr, monomial(1, 1)$UPR - F2UPR alpha, lgd::UPR]]
+      [[scalr,
+         map(F2R, q)$UnivariatePolynomialCategoryFunctions2(F,UP,R,UPR),
+                                           R2UP(lgd, retract(alpha)@K)]]
+
+    -- return the non-linear factor, if unique
+    -- or any linear factor if they are all linear
+    nonLinear l ==
+      found:Boolean := false
+      ans := first l
+      for q in l repeat
+        if degree(q.factor) > 1 then
+          found => return "failed"
+          found := true
+          ans   := q
+      ans
+
+    -- f dx must be locally integral at infinity
+    palginfieldint(f, derivation) ==
+      h := HermiteIntegrate(f, derivation)
+      zero?(h.logpart) => h.answer
+      "failed"
+
+    -- f dx must be locally integral at infinity
+    palgintegrate(f, derivation) ==
+      h := HermiteIntegrate(f, derivation)
+      zero?(h.logpart) => h.answer::IR
+      (not integralAtInfinity?(h.logpart)) or
+        ((u := palglogint(h.logpart, derivation)) case "failed") =>
+                      mkAnswer(h.answer, empty(), [[h.logpart, dummy]])
+      zero?(difFirstKind := h.logpart - +/[pLogDeriv(lg,
+            x1+->differentiate(x1, derivation)) for lg in u::List(LOG)]) =>
+                mkAnswer(h.answer, u::List(LOG), empty())
+      mkAnswer(h.answer, u::List(LOG), [[difFirstKind, dummy]])
+
+    -- for mixed functions. f dx not assumed locally integral at infinity
+    algintegrate(f, derivation) ==
+      zero? degree(x' := derivation(x := monomial(1, 1)$UP)) =>
+         algintprim(f, derivation)
+      ((xx := x' exquo x) case UP) and
+        (retractIfCan(xx::UP)@Union(F, "failed") case F) =>
+          algintexp(f, derivation)
+      error "should not happen"
+
+    alglogint(f, derivation) ==
+      varRoot?(doubleResultant(f, derivation),
+                         x1+->retract(derivation(x1::UP))@F) => "failed"
+      FAIL0
+
 *)
 
 \end{chunk}
@@ -1373,6 +2114,7 @@ AlgebraicIntegration(R, F): Exports == Implementation where
       ++ d is the derivation to use on \spad{k[x]}.
 
   Implementation ==> add
+
     import ChangeOfVariable(F, UP, UPUP)
     import PolynomialCategoryQuotientFunctions(IndexedExponents K,
                                                         K, R, P, F)
@@ -1420,6 +2162,49 @@ AlgebraicIntegration(R, F): Exports == Implementation where
 \begin{chunk}{COQ INTAF}
 (* package INTAF *)
 (*
+
+    import ChangeOfVariable(F, UP, UPUP)
+    import PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                                                        K, R, P, F)
+
+    rootintegrate: (F, K, K, UP -> UP) -> IR
+    algintegrate : (F, K, K, UP -> UP) -> IR
+    UPUP2F       : (UPUP, RF, K, K) -> F
+    F2UPUP       : (F, K, K, UP) -> UPUP
+    UP2UPUP      : (UP, K) -> UPUP
+
+    F2UPUP(f, kx, k, p) == UP2UPUP(univariate(f, k, p), kx)
+
+    rootintegrate(f, t, k, derivation) ==
+      r1     := mkIntegral(modulus := UP2UPUP(p := minPoly k, t))
+      f1     := F2UPUP(f, t, k, p) monomial(inv(r1.coef), 1)
+      r      := radPoly(r1.poly)::Record(radicand:RF, deg:N)
+      q      := retract(r.radicand)
+      curve  := RadicalFunctionField(F, UP, UPUP, q::RF, r.deg)
+      map(x1+->UPUP2F(lift x1, r1.coef, t, k),
+                            algintegrate(reduce f1, derivation)$ALG)$IR2
+
+    algintegrate(f, t, k, derivation) ==
+      r1     := mkIntegral(modulus := UP2UPUP(p := minPoly k, t))
+      f1     := F2UPUP(f, t, k, p) monomial(inv(r1.coef), 1)
+      modulus:= UP2UPUP(p := minPoly k, t)
+      curve  := AlgebraicFunctionField(F, UP, UPUP, r1.poly)
+      map(x1+->UPUP2F(lift x1, r1.coef, t, k),
+                            algintegrate(reduce f1, derivation)$ALG)$IR2
+
+    UP2UPUP(p, k) ==
+      map(x1+->univariate(x1,k),p)$SparseUnivariatePolynomialFunctions2(F,RF)
+
+    UPUP2F(p, cf, t, k) ==
+      map((x1:RF):F+->multivariate(x1, t),
+         p)$SparseUnivariatePolynomialFunctions2(RF, F)
+                                            (multivariate(cf, t) * k::F)
+
+    algint(f, t, y, derivation) ==
+      is?(y, "nthRoot"::SY) => rootintegrate(f, t, y, derivation)
+      is?(y, "rootOf"::SY)  => algintegrate(f, t, y, derivation)
+      FAIL
+
 *)
 
 \end{chunk}
@@ -1567,6 +2352,7 @@ AlgebraicManipulations(R, F): Exports == Implementation where
           ++ rootKerSimp(op,f,n) should be local but conditional.
 
   Implementation ==> add
+
     import PolynomialCategoryQuotientFunctions(IndexedExponents K,K,R,P,F)
 
     innerRF    : (F, List K) -> F
@@ -1577,10 +2363,15 @@ AlgebraicManipulations(R, F): Exports == Implementation where
     dummy := kernel(new()$SY)$K
 
     ratDenom x                == innerRF(x, algkernels tower x)
+
     ratDenom(x:F, l:List K):F == innerRF(x, algkernels l)
+
     ratDenom(x:F, y:F)        == ratDenom(x, [y])
+
     ratDenom(x:F, l:List F)   == ratDenom(x, [retract(y)@K for y in l]$List(K))
+
     algkernels l  == select_!((z1:K):Boolean +-> has?(operator z1, ALGOP), l)
+
     rootkernels l == select_!((z1:K):Boolean +-> is?(operator z1, NTHR::SY), l)
 
     ratPoly x ==
@@ -1596,7 +2387,7 @@ AlgebraicManipulations(R, F): Exports == Implementation where
       op := operator k
       op(numer(x)::F, n) / op(denom(x)::F, n)
 
--- all the kernels in ll must be algebraic
+    -- all the kernels in ll must be algebraic
     innerRF(x, ll) ==
       empty?(l := sort_!((z1:K,z2:K):Boolean +-> z1 > z2,kernels x)$List(K)) or
         empty? setIntersection(ll, tower x) => x
@@ -1611,6 +2402,7 @@ AlgebraicManipulations(R, F): Exports == Implementation where
 
     if R has Join(OrderedSet, GcdDomain, RetractableTo Integer)
      and F has FunctionSpace(R) then
+
       import PolynomialRoots(IndexedExponents K, K, R, P, F)
 
       sroot  : K -> F
@@ -1619,16 +2411,19 @@ AlgebraicManipulations(R, F): Exports == Implementation where
       breakup: List K -> List REC
 
       if R has RadicalCategory then
+
         rootKerSimp(op, x, n) ==
           (r := retractIfCan(x)@Union(R, "failed")) case R =>
              nthRoot(r::R, n)::F
           inroot(op, x, n)
+
       else
+
         rootKerSimp(op, x, n) == inroot(op, x, n)
 
--- l is a list of nth-roots, returns a list of records of the form
--- [a**(1/n1),a**(1/n2),...], [n1,n2,...]]
--- such that the whole list covers l exactly
+      -- l is a list of nth-roots, returns a list of records of the form
+      -- [a**(1/n1),a**(1/n2),...], [n1,n2,...]]
+      -- such that the whole list covers l exactly
       breakup l ==
         empty? l => empty()
         k := first l
@@ -1661,8 +2456,8 @@ AlgebraicManipulations(R, F): Exports == Implementation where
           x := radeval(numer x, k) / radeval(denom x, k)
         x
 
--- replaces (a**(1/n))**m in p by a power of a simpler radical of a if
--- n and m have a common factor
+      -- replaces (a**(1/n))**m in p by a power of a simpler radical of a if
+      -- n and m have a common factor
       radeval(p, k) ==
         a := first(arg := argument k)
         n := (retract(second arg)@Integer)::NonNegativeInteger
@@ -1670,17 +2465,14 @@ AlgebraicManipulations(R, F): Exports == Implementation where
         q := univariate(p, k)
         while (d := degree q) > 0 repeat
           term :=
---            one?(g := gcd(d, n)) => monomial(1, k, d)
             ((g := gcd(d, n)) = 1) => monomial(1, k, d)
-            monomial(1, kernel(operator k, [a,(n quo g)::F], height k), d quo g)
+            monomial(1,kernel(operator k, [a,(n quo g)::F], height k), d quo g)
           ans := ans + leadingCoefficient(q)::F * term::F
           q := reductum q
         leadingCoefficient(q)::F + ans
 
       inroot(op, x, n) ==
---        one? x => x
         (x = 1) => x
---        (x ^= -1) and (one?(num := numer x) or (num = -1)) =>
         (x ^= -1) and (((num := numer x) = 1) or (num = -1)) =>
           inv inroot(op, (num * denom x)::F, n)
         (u := isExpt(x, op)) case "failed" => kernel(op, [x, n::F])
@@ -1704,6 +2496,145 @@ AlgebraicManipulations(R, F): Exports == Implementation where
 \begin{chunk}{COQ ALGMANIP}
 (* package ALGMANIP *)
 (*
+
+    import PolynomialCategoryQuotientFunctions(IndexedExponents K,K,R,P,F)
+
+    innerRF    : (F, List K) -> F
+    rootExpand : K -> F
+    algkernels : List K -> List K
+    rootkernels: List K -> List K
+
+    dummy := kernel(new()$SY)$K
+
+    ratDenom x                == innerRF(x, algkernels tower x)
+
+    ratDenom(x:F, l:List K):F == innerRF(x, algkernels l)
+
+    ratDenom(x:F, y:F)        == ratDenom(x, [y])
+
+    ratDenom(x:F, l:List F)   == ratDenom(x, [retract(y)@K for y in l]$List(K))
+
+    algkernels l  == select_!((z1:K):Boolean +-> has?(operator z1, ALGOP), l)
+
+    rootkernels l == select_!((z1:K):Boolean +-> is?(operator z1, NTHR::SY), l)
+
+    ratPoly x ==
+      numer univariate(denom(ratDenom inv(dummy::P::F - x))::F, dummy)
+
+    rootSplit x ==
+      lk := rootkernels tower x
+      eval(x, lk, [rootExpand k for k in lk])
+
+    rootExpand k ==
+      x  := first argument k
+      n  := second argument k
+      op := operator k
+      op(numer(x)::F, n) / op(denom(x)::F, n)
+
+    -- all the kernels in ll must be algebraic
+    innerRF(x, ll) ==
+      empty?(l := sort_!((z1:K,z2:K):Boolean +-> z1 > z2,kernels x)$List(K)) or
+        empty? setIntersection(ll, tower x) => x
+      lk := empty()$List(K)
+      while not member?(k := first l, ll) repeat
+        lk := concat(k, lk)
+        empty?(l := rest l) =>
+          return eval(x, lk, [map((z3:F):F+->innerRF(z3,ll), kk) for kk in lk])
+      q := univariate(eval(x, lk,
+             [map((z4:F):F+->innerRF(z4,ll),kk) for kk in lk]),k,minPoly k)
+      map((z5:F):F+->innerRF(z5, ll), q) (map((z6:F):F+->innerRF(z6, ll), k))
+
+    if R has Join(OrderedSet, GcdDomain, RetractableTo Integer)
+     and F has FunctionSpace(R) then
+
+      import PolynomialRoots(IndexedExponents K, K, R, P, F)
+
+      sroot  : K -> F
+      inroot : (OP, F, N) -> F
+      radeval: (P, K) -> F
+      breakup: List K -> List REC
+
+      if R has RadicalCategory then
+
+        rootKerSimp(op, x, n) ==
+          (r := retractIfCan(x)@Union(R, "failed")) case R =>
+             nthRoot(r::R, n)::F
+          inroot(op, x, n)
+
+      else
+
+        rootKerSimp(op, x, n) == inroot(op, x, n)
+
+      -- l is a list of nth-roots, returns a list of records of the form
+      -- [a**(1/n1),a**(1/n2),...], [n1,n2,...]]
+      -- such that the whole list covers l exactly
+      breakup l ==
+        empty? l => empty()
+        k := first l
+        a := first(arg := argument(k := first l))
+        n := retract(second arg)@Z
+        expo := empty()$List(Z)
+        others := same := empty()$List(K)
+        for kk in rest l repeat
+          if (a = first(arg := argument kk)) then
+            same := concat(kk, same)
+            expo := concat(retract(second arg)@Z, expo)
+          else others := concat(kk, others)
+        ll := breakup others
+        concat([concat(k, same), concat(n, expo)], ll)
+
+      rootProduct x ==
+        for rec in breakup rootkernels tower x repeat
+          k0 := first(l := rec.ker)
+          nx := numer x; dx := denom x
+          if empty? rest l then x := radeval(nx, k0) / radeval(dx, k0)
+          else
+            n  := lcm(rec.exponent)
+            k  := kernel(operator k0, [first argument k0, n::F], height k0)$K
+            lv := [monomial(1, k, (n quo m)::N) for m in rec.exponent]$List(P)
+            x  := radeval(eval(nx, l, lv), k) / radeval(eval(dx, l, lv), k)
+        x
+
+      rootPower x ==
+        for k in rootkernels tower x repeat
+          x := radeval(numer x, k) / radeval(denom x, k)
+        x
+
+      -- replaces (a**(1/n))**m in p by a power of a simpler radical of a if
+      -- n and m have a common factor
+      radeval(p, k) ==
+        a := first(arg := argument k)
+        n := (retract(second arg)@Integer)::NonNegativeInteger
+        ans:F := 0
+        q := univariate(p, k)
+        while (d := degree q) > 0 repeat
+          term :=
+            ((g := gcd(d, n)) = 1) => monomial(1, k, d)
+            monomial(1,kernel(operator k, [a,(n quo g)::F], height k), d quo g)
+          ans := ans + leadingCoefficient(q)::F * term::F
+          q := reductum q
+        leadingCoefficient(q)::F + ans
+
+      inroot(op, x, n) ==
+        (x = 1) => x
+        (x ^= -1) and (((num := numer x) = 1) or (num = -1)) =>
+          inv inroot(op, (num * denom x)::F, n)
+        (u := isExpt(x, op)) case "failed" => kernel(op, [x, n::F])
+        pr := u::Record(var:K, exponent:Integer)
+        q := pr.exponent /$Fraction(Z)
+                                (n * retract(second argument(pr.var))@Z)
+        qr := divide(numer q, denom q)
+        x  := first argument(pr.var)
+        x ** qr.quotient * rootKerSimp(op,x,denom(q)::N) ** qr.remainder
+
+      sroot k ==
+        pr := froot(first(arg := argument k),(retract(second arg)@Z)::N)
+        pr.coef * rootKerSimp(operator k, pr.radicand, pr.exponent)
+
+      rootSimp x ==
+        lk := rootkernels tower x
+        eval(x, lk, [sroot k for k in lk])
+
 *)
 
 \end{chunk}
@@ -1814,6 +2745,17 @@ AlgebraicMultFact(OV,E,P) : C == T
 \begin{chunk}{COQ ALGMFACT}
 (* package ALGMFACT *)
 (*
+
+    AF := AlgFactor(BP)
+
+    INNER ==> InnerMultFact(OV,E,AN,P)
+
+    factor(p:P,lalg:L AN) : Factored P ==
+      factor(p,(z1:BP):Factored(BP) +-> factor(z1,lalg)$AF)$INNER
+
+    factor(up:USP,lalg:L AN) : Factored USP ==
+      factor(up,(z1:BP):Factored(BP) +-> factor(z1,lalg)$AF)$INNER
+
 *)
 
 \end{chunk}
@@ -2019,13 +2961,14 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _
       n3 : PositiveInteger := n*n2
       gamma : Vector Matrix R  := structuralConstants()$A
 
-
       -- local functions
 
       convVM : Vector R -> Matrix R
         -- converts n2-vector to (n,n)-matrix row by row
+
       convMV : Matrix R -> Vector R
         -- converts n-square matrix to  n2-vector row by row
+
       convVM v  ==
         cond : Matrix(R) := new(n,n,0$R)$M(R)
         z : Integer := 0
@@ -2035,22 +2978,10 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _
             setelt(cond,i,j,v.z)
         cond
 
-
-      -- convMV m ==
-      --     vec : Vector(R) := new(n*n,0$R)
-      --     z : Integer := 0
-      --     for i in 1..n repeat
-      --       for j in 1..n  repeat
-      --         z := z+1
-      --         setelt(vec,z,elt(m,i,j))
-      --     vec
-
-
       radicalOfLeftTraceForm() ==
         ma : M R := leftTraceMatrix()$A
         map(represents, nullSpace ma)$ListFunctions2(Vector R, A)
 
-
       basisOfLeftAnnihilator a ==
         ca : M R := transpose (coordinates(a) :: M R)
         cond : M R := reduce(vertConcat$(M R),
@@ -2092,7 +3023,6 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _
         --  gammak := gammak - transpose gammak
         --  cond :=  vertConcat(cond, gammak :: Matrix(R))$Matrix(R)
         --map(represents, nullSpace cond)$ListFunctions2(Vector R, A)
-
         cond : M R := reduce(vertConcat$(M R),
           [(gam := gamma.i) - transpose gam for i in 1..#gamma])
         map(represents, nullSpace cond)$ListFunctions2(Vector R, A)
@@ -2142,7 +3072,6 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _
               setelt(conda,z,i,entry)$Matrix(R)
         map(represents, nullSpace conda)$ListFunctions2(Vector R,A)
 
-
       basisOfNucleus() ==
         condi: Matrix(R) := new(3*n3,n,0$R)$Matrix(R)
         z : Integer := 0
@@ -2245,7 +3174,6 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _
                 r2 := r2 + n
         [convVM(sol) for sol in nullSpace(cond+condo)]
 
-
       doubleRank x ==
         cond : Matrix(R) := new(2*n,n,0$R)
         for k in 1..n repeat
@@ -2328,6 +3256,7 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _
 
 
       if R has EuclideanDomain then
+
         basis va ==
           v : V A := remove(zero?, va)$(V A)
           v : V A := removeDuplicates v
@@ -2360,6 +3289,337 @@ AlgebraPackage(R:IntegralDomain, A: FramedNonAssociativeAlgebra(R)): _
 \begin{chunk}{COQ ALGPKG}
 (* package ALGPKG *)
 (*
+
+      -- constants
+
+      n  : PositiveInteger := rank()$A
+      n2 : PositiveInteger := n*n
+      n3 : PositiveInteger := n*n2
+      gamma : Vector Matrix R  := structuralConstants()$A
+
+      -- local functions
+
+      convVM : Vector R -> Matrix R
+        -- converts n2-vector to (n,n)-matrix row by row
+
+      convMV : Matrix R -> Vector R
+        -- converts n-square matrix to  n2-vector row by row
+
+      convVM v  ==
+        cond : Matrix(R) := new(n,n,0$R)$M(R)
+        z : Integer := 0
+        for i in 1..n repeat
+          for j in 1..n  repeat
+            z := z+1
+            setelt(cond,i,j,v.z)
+        cond
+
+      radicalOfLeftTraceForm() ==
+        ma : M R := leftTraceMatrix()$A
+        map(represents, nullSpace ma)$ListFunctions2(Vector R, A)
+
+      basisOfLeftAnnihilator a ==
+        ca : M R := transpose (coordinates(a) :: M R)
+        cond : M R := reduce(vertConcat$(M R),
+          [ca*transpose(gamma.i) for i in 1..#gamma])
+        map(represents, nullSpace cond)$ListFunctions2(Vector R, A)
+
+      basisOfRightAnnihilator a ==
+        ca : M R := transpose (coordinates(a) :: M R)
+        cond : M R := reduce(vertConcat$(M R),
+          [ca*(gamma.i) for i in 1..#gamma])
+        map(represents, nullSpace cond)$ListFunctions2(Vector R, A)
+
+      basisOfLeftNucloid() ==
+        cond : Matrix(R) := new(n3,n2,0$R)$M(R)
+        condo: Matrix(R) := new(n3,n2,0$R)$M(R)
+        z : Integer := 0
+        for i in 1..n repeat
+          for j in 1..n repeat
+            r1  : Integer := 0
+            for k in 1..n repeat
+              z := z + 1
+              -- z equals (i-1)*n*n+(j-1)*n+k (loop-invariant)
+              r2 : Integer := i
+              for r in 1..n repeat
+                r1 := r1 + 1
+                -- here r1 equals (k-1)*n+r (loop-invariant)
+                setelt(cond,z,r1,elt(gamma.r,i,j))
+                -- here r2 equals (r-1)*n+i (loop-invariant)
+                setelt(condo,z,r2,-elt(gamma.k,r,j))
+                r2 := r2 + n
+        [convVM(sol) for sol in nullSpace(cond+condo)]
+
+      basisOfCommutingElements() ==
+        --gamma1 := first gamma
+        --gamma1 := gamma1 - transpose gamma1
+        --cond : Matrix(R) := gamma1 :: Matrix(R)
+        --for  i in  2..n repeat
+        --  gammak := gamma.i
+        --  gammak := gammak - transpose gammak
+        --  cond :=  vertConcat(cond, gammak :: Matrix(R))$Matrix(R)
+        --map(represents, nullSpace cond)$ListFunctions2(Vector R, A)
+        cond : M R := reduce(vertConcat$(M R),
+          [(gam := gamma.i) - transpose gam for i in 1..#gamma])
+        map(represents, nullSpace cond)$ListFunctions2(Vector R, A)
+
+      basisOfLeftNucleus() ==
+        condi: Matrix(R) := new(n3,n,0$R)$Matrix(R)
+        z : Integer := 0
+        for k in 1..n repeat
+         for j in 1..n repeat
+          for s in 1..n repeat
+            z := z+1
+            for i in 1..n repeat
+              entry : R := 0
+              for l in 1..n repeat
+                entry :=  entry+elt(gamma.l,j,k)*elt(gamma.s,i,l)_
+                               -elt(gamma.l,i,j)*elt(gamma.s,l,k)
+              setelt(condi,z,i,entry)$Matrix(R)
+        map(represents, nullSpace condi)$ListFunctions2(Vector R,A)
+
+      basisOfRightNucleus() ==
+        condo : Matrix(R) := new(n3,n,0$R)$Matrix(R)
+        z : Integer := 0
+        for k in 1..n repeat
+         for j in 1..n repeat
+          for s in 1..n repeat
+            z := z+1
+            for i in 1..n repeat
+              entry : R := 0
+              for l in 1..n repeat
+                entry :=  entry+elt(gamma.l,k,i)*elt(gamma.s,j,l) _
+                               -elt(gamma.l,j,k)*elt(gamma.s,l,i)
+              setelt(condo,z,i,entry)$Matrix(R)
+        map(represents, nullSpace condo)$ListFunctions2(Vector R,A)
+
+      basisOfMiddleNucleus() ==
+        conda : Matrix(R) := new(n3,n,0$R)$Matrix(R)
+        z : Integer := 0
+        for k in 1..n repeat
+         for j in 1..n repeat
+          for s in 1..n repeat
+            z := z+1
+            for i in 1..n repeat
+              entry : R := 0
+              for l in 1..n repeat
+                entry :=  entry+elt(gamma.l,j,i)*elt(gamma.s,l,k)
+                               -elt(gamma.l,i,k)*elt(gamma.s,j,l)
+              setelt(conda,z,i,entry)$Matrix(R)
+        map(represents, nullSpace conda)$ListFunctions2(Vector R,A)
+
+      basisOfNucleus() ==
+        condi: Matrix(R) := new(3*n3,n,0$R)$Matrix(R)
+        z : Integer := 0
+        u : Integer := n3
+        w : Integer := 2*n3
+        for k in 1..n repeat
+         for j in 1..n repeat
+          for s in 1..n repeat
+            z := z+1
+            u := u+1
+            w := w+1
+            for i in 1..n repeat
+              entry : R := 0
+              enter : R := 0
+              ent   : R := 0
+              for l in 1..n repeat
+                entry :=  entry + elt(gamma.l,j,k)*elt(gamma.s,i,l) _
+                                - elt(gamma.l,i,j)*elt(gamma.s,l,k)
+                enter :=  enter + elt(gamma.l,k,i)*elt(gamma.s,j,l) _
+                                - elt(gamma.l,j,k)*elt(gamma.s,l,i)
+                ent :=  ent  +  elt(gamma.l,j,k)*elt(gamma.s,i,l) _
+                             -  elt(gamma.l,j,i)*elt(gamma.s,l,k)
+              setelt(condi,z,i,entry)$Matrix(R)
+              setelt(condi,u,i,enter)$Matrix(R)
+              setelt(condi,w,i,ent)$Matrix(R)
+        map(represents, nullSpace condi)$ListFunctions2(Vector R,A)
+
+      basisOfCenter() ==
+        gamma1 := first gamma
+        gamma1 := gamma1 - transpose gamma1
+        cond : Matrix(R) := gamma1 :: Matrix(R)
+        for  i in  2..n repeat
+          gammak := gamma.i
+          gammak := gammak - transpose gammak
+          cond :=  vertConcat(cond, gammak :: Matrix(R))$Matrix(R)
+        B := cond :: Matrix(R)
+        condi: Matrix(R) := new(2*n3,n,0$R)$Matrix(R)
+        z : Integer := 0
+        u : Integer := n3
+        for k in 1..n repeat
+         for j in 1..n repeat
+          for s in 1..n repeat
+            z := z+1
+            u := u+1
+            for i in 1..n repeat
+              entry : R := 0
+              enter : R := 0
+              for l in 1..n repeat
+                entry :=  entry + elt(gamma.l,j,k)*elt(gamma.s,i,l) _
+                                - elt(gamma.l,i,j)*elt(gamma.s,l,k)
+                enter :=  enter + elt(gamma.l,k,i)*elt(gamma.s,j,l) _
+                                - elt(gamma.l,j,k)*elt(gamma.s,l,i)
+              setelt(condi,z,i,entry)$Matrix(R)
+              setelt(condi,u,i,enter)$Matrix(R)
+        D := vertConcat(condi,B)$Matrix(R)
+        map(represents, nullSpace D)$ListFunctions2(Vector R, A)
+
+      basisOfRightNucloid() ==
+        cond : Matrix(R) := new(n3,n2,0$R)$M(R)
+        condo: Matrix(R) := new(n3,n2,0$R)$M(R)
+        z : Integer := 0
+        for i in 1..n repeat
+          for j in 1..n repeat
+            r1  : Integer := 0
+            for k in 1..n repeat
+              z := z + 1
+              -- z equals (i-1)*n*n+(j-1)*n+k (loop-invariant)
+              r2 : Integer := i
+              for r in 1..n repeat
+                r1 := r1 + 1
+                -- here r1 equals (k-1)*n+r (loop-invariant)
+                setelt(cond,z,r1,elt(gamma.r,j,i))
+                -- here r2 equals (r-1)*n+i (loop-invariant)
+                setelt(condo,z,r2,-elt(gamma.k,j,r))
+                r2 := r2 + n
+        [convVM(sol) for sol in nullSpace(cond+condo)]
+
+      basisOfCentroid() ==
+        cond : Matrix(R) := new(2*n3,n2,0$R)$M(R)
+        condo: Matrix(R) := new(2*n3,n2,0$R)$M(R)
+        z : Integer := 0
+        u : Integer := n3
+        for i in 1..n repeat
+          for j in 1..n repeat
+            r1  : Integer := 0
+            for k in 1..n repeat
+              z := z + 1
+              u := u + 1
+              -- z equals (i-1)*n*n+(j-1)*n+k (loop-invariant)
+              -- u equals n**3 + (i-1)*n*n+(j-1)*n+k (loop-invariant)
+              r2 : Integer := i
+              for r in 1..n repeat
+                r1 := r1 + 1
+                -- here r1 equals (k-1)*n+r (loop-invariant)
+                setelt(cond,z,r1,elt(gamma.r,i,j))
+                setelt(cond,u,r1,elt(gamma.r,j,i))
+                -- here r2 equals (r-1)*n+i (loop-invariant)
+                setelt(condo,z,r2,-elt(gamma.k,r,j))
+                setelt(condo,u,r2,-elt(gamma.k,j,r))
+                r2 := r2 + n
+        [convVM(sol) for sol in nullSpace(cond+condo)]
+
+      doubleRank x ==
+        cond : Matrix(R) := new(2*n,n,0$R)
+        for k in 1..n repeat
+         z : Integer := 0
+         u : Integer := n
+         for j in 1..n repeat
+           z := z+1
+           u := u+1
+           entry : R := 0
+           enter : R := 0
+           for i in 1..n repeat
+             entry := entry + elt(x,i)*elt(gamma.k,j,i)
+             enter := enter + elt(x,i)*elt(gamma.k,i,j)
+           setelt(cond,z,k,entry)$Matrix(R)
+           setelt(cond,u,k,enter)$Matrix(R)
+        rank(cond)$(M R)
+
+      weakBiRank(x) ==
+        cond : Matrix(R) := new(n2,n,0$R)$Matrix(R)
+        z : Integer := 0
+        for i in 1..n repeat
+          for j in 1..n repeat
+            z := z+1
+            for k in 1..n repeat
+              entry : R := 0
+              for l in 1..n repeat
+               for s in 1..n repeat
+                entry:=entry+elt(x,l)*elt(gamma.s,i,l)*elt(gamma.k,s,j)
+              setelt(cond,z,k,entry)$Matrix(R)
+        rank(cond)$(M R)
+
+      biRank(x) ==
+        cond : Matrix(R) := new(n2+2*n+1,n,0$R)$Matrix(R)
+        z : Integer := 0
+        for j in 1..n repeat
+          for i in 1..n repeat
+            z := z+1
+            for k in 1..n repeat
+              entry : R := 0
+              for l in 1..n repeat
+               for s in 1..n repeat
+                entry:=entry+elt(x,l)*elt(gamma.s,i,l)*elt(gamma.k,s,j)
+              setelt(cond,z,k,entry)$Matrix(R)
+        u : Integer := n*n
+        w : Integer := n*(n+1)
+        c := n2 + 2*n + 1
+        for j in 1..n repeat
+           u := u+1
+           w := w+1
+           for k in 1..n repeat
+             entry : R := 0
+             enter : R := 0
+             for i in 1..n repeat
+               entry := entry + elt(x,i)*elt(gamma.k,j,i)
+               enter := enter + elt(x,i)*elt(gamma.k,i,j)
+             setelt(cond,u,k,entry)$Matrix(R)
+             setelt(cond,w,k,enter)$Matrix(R)
+           setelt(cond,c,j, elt(x,j))
+        rank(cond)$(M R)
+
+      leftRank x ==
+        cond : Matrix(R) := new(n,n,0$R)
+        for k in 1..n repeat
+         for j in 1..n repeat
+           entry : R := 0
+           for i in 1..n repeat
+             entry := entry + elt(x,i)*elt(gamma.k,i,j)
+           setelt(cond,j,k,entry)$Matrix(R)
+        rank(cond)$(M R)
+
+      rightRank x ==
+        cond : Matrix(R) := new(n,n,0$R)
+        for k in 1..n repeat
+         for j in 1..n repeat
+           entry : R := 0
+           for i in 1..n repeat
+             entry := entry + elt(x,i)*elt(gamma.k,j,i)
+           setelt(cond,j,k,entry)$Matrix(R)
+        rank(cond)$(M R)
+
+
+      if R has EuclideanDomain then
+
+        basis va ==
+          v : V A := remove(zero?, va)$(V A)
+          v : V A := removeDuplicates v
+          empty? v =>  [0$A]
+          m : Matrix R := coerce(coordinates(v.1))$(Matrix R)
+          for i in 2..maxIndex v repeat
+            m := horizConcat(m,coerce(coordinates(v.i))$(Matrix R) )
+          m := rowEchelon m
+          lj : List Integer := []
+          h : Integer := 1
+          mRI : Integer := maxRowIndex m
+          mCI : Integer := maxColIndex m
+          finished? : Boolean := false
+          j : Integer := 1
+          while not finished? repeat
+            not zero? m(h,j) =>  -- corner found
+              lj := cons(j,lj)
+              h := mRI
+              while zero? m(h,j) repeat h := h-1
+              finished? := (h = mRI)
+              if not finished? then h := h+1
+            if j < mCI then
+              j := j + 1
+            else
+              finished? := true
+          [v.j for j in reverse lj]
+
 *)
 
 \end{chunk}
@@ -2455,6 +3715,7 @@ AlgFactor(UP): Exports == Implementation where
       ++ \spad{K(a)} where \spad{p(a) = 0}.
  
   Implementation ==> add
+
     import PolynomialCategoryQuotientFunctions(IndexedExponents K,
                            K, Z, SparseMultivariatePolynomial(Z, K), AN)
 
@@ -2469,9 +3730,13 @@ AlgFactor(UP): Exports == Implementation where
     irred?  : UP  -> Boolean
  
     allk l       == removeDuplicates concat [kernels x for x in l]
+
     liftpoly p   == map(x +-> x::AN,  p)$UPCF2(Q, UPQ, AN, UP)
+
     downpoly p   == map(x +-> retract(x)@Q, p)$UPCF2(AN, UP ,Q, UPQ)
+
     ifactor(p,l) == (fact(p pretend UP, l)) pretend Factored(SUP)
+
     factor p     == fact(p, allk coefficients p)
  
     factor(p, l) ==
@@ -2483,7 +3748,6 @@ AlgFactor(UP): Exports == Implementation where
             _*/[extend(fc.factor, fc.exponent) for fc in factors fp]
  
     extend(p, n) ==
---      one? degree p => primeFactor(p, n)
       (degree p = 1) => primeFactor(p, n)
       q := monomial(1, 1)$UP - zeroOf(p pretend SUP)::UP
       primeFactor(q, n) * split((p exquo q)::UP) ** (n::N)
@@ -2494,11 +3758,9 @@ AlgFactor(UP): Exports == Implementation where
  
     irred? p ==
       fp := factor p
---      one? numberOfFactors fp and one? nthExponent(fp, 1)
       (numberOfFactors fp = 1) and  (nthExponent(fp, 1) = 1)
  
     fact(p, l) ==
---      one? degree p => primeFactor(p, 1)
       (degree p = 1) => primeFactor(p, 1)
       empty? l =>
         dr := factor(downpoly p)$RationalFactorize(UPQ)
@@ -2524,6 +3786,72 @@ AlgFactor(UP): Exports == Implementation where
 \begin{chunk}{COQ ALGFACT}
 (* package ALGFACT *)
 (*
+
+    import PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                           K, Z, SparseMultivariatePolynomial(Z, K), AN)
+
+    UPCF2 ==> UnivariatePolynomialCategoryFunctions2
+
+    fact    : (UP,  List K) -> FR
+    ifactor : (SUP, List K) -> Factored SUP
+    extend  : (UP, Z) -> FR
+    allk    : List AN -> List K
+    downpoly: UP  -> UPQ
+    liftpoly: UPQ -> UP
+    irred?  : UP  -> Boolean
+ 
+    allk l       == removeDuplicates concat [kernels x for x in l]
+
+    liftpoly p   == map(x +-> x::AN,  p)$UPCF2(Q, UPQ, AN, UP)
+
+    downpoly p   == map(x +-> retract(x)@Q, p)$UPCF2(AN, UP ,Q, UPQ)
+
+    ifactor(p,l) == (fact(p pretend UP, l)) pretend Factored(SUP)
+
+    factor p     == fact(p, allk coefficients p)
+ 
+    factor(p, l) ==
+      fact(p, allk removeDuplicates concat(l, coefficients p))
+ 
+    split p ==
+      fp := factor p
+      unit(fp) *
+            _*/[extend(fc.factor, fc.exponent) for fc in factors fp]
+ 
+    extend(p, n) ==
+      (degree p = 1) => primeFactor(p, n)
+      q := monomial(1, 1)$UP - zeroOf(p pretend SUP)::UP
+      primeFactor(q, n) * split((p exquo q)::UP) ** (n::N)
+ 
+    doublyTransitive? p ==
+      irred? p and irred?((p exquo
+        (monomial(1, 1)$UP - zeroOf(p pretend SUP)::UP))::UP)
+ 
+    irred? p ==
+      fp := factor p
+      (numberOfFactors fp = 1) and  (nthExponent(fp, 1) = 1)
+ 
+    fact(p, l) ==
+      (degree p = 1) => primeFactor(p, 1)
+      empty? l =>
+        dr := factor(downpoly p)$RationalFactorize(UPQ)
+        (liftpoly unit dr) *
+          _*/[primeFactor(liftpoly dc.factor,dc.exponent)
+            for dc in factors dr]
+      q   := minPoly(alpha := "max"/l)$AN
+      newl  := remove((x:K):Boolean +-> alpha = x, l)
+      sae := SimpleAlgebraicExtension(AN, SUP, q)
+      ups := SparseUnivariatePolynomial sae
+      fr  := factor(map(x +-> reduce univariate(x, alpha, q),p)_
+               $UPCF2(AN, UP, sae, ups),_
+                 x +-> ifactor(x, newl))$InnerAlgFactor(AN, SUP, sae, ups)
+      newalpha := alpha::AN
+      map((x:sae):AN +-> (lift(x)$sae) newalpha, unit fr)_
+        $UPCF2(sae, ups, AN, UP) *
+         _*/[primeFactor(map((y:sae):AN +-> (lift(y)$sae) newalpha,fc.factor)_
+            $UPCF2(sae, ups, AN, UP),
+              fc.exponent) for fc in factors fr]
+
 *)
 
 \end{chunk}
@@ -2828,9 +4156,11 @@ AnnaNumericalIntegrationPackage(): EE == II where
   zeroMeasure: Measure -> Result
   scriptedVariables?: MDNIA -> Boolean
   preAnalysis:(Union(nia:NIA,mdnia:MDNIA),RT) -> RT
-  measureSpecific:(ST,RT,Union(nia:NIA,mdnia:MDNIA)) -> Record(measure:F,explanations:LST,extra:Result)
+  measureSpecific:(ST,RT,Union(nia:NIA,mdnia:MDNIA)) -> _
+      Record(measure:F,explanations:LST,extra:Result)
   changeName:(Result,ST) -> Result
-  recoverAfterFail:(Union(nia:NIA,mdnia:MDNIA),RT,Measure,INT,Result) -> Record(a:Result,b:Measure)
+  recoverAfterFail:(Union(nia:NIA,mdnia:MDNIA),RT,Measure,INT,Result) -> _
+      Record(a:Result,b:Measure)
   better?:(Result,Result) -> Boolean
   integrateConstant:(EF,SOCF) -> Result
   integrateConstantList: (EF,LSOCF) -> Result
@@ -3013,7 +4343,7 @@ AnnaNumericalIntegrationPackage(): EE == II where
     [r,m]
 
   integrateArgs(prob:NumericalIntegrationProblem,t:RT):Result ==
-    args:Union(nia:NIA,mdnia:MDNIA) := retract(prob)$NumericalIntegrationProblem
+    args:Union(nia:NIA,mdnia:MDNIA):= retract(prob)$NumericalIntegrationProblem
     routs := copy(t)$RT
     if args case mdnia then
       arg := args.mdnia
@@ -3056,7 +4386,7 @@ AnnaNumericalIntegrationPackage(): EE == II where
   integrate(exp:EF,ra:SOCF,epsabs:F,epsrel:F,r:RT):Result ==
     Var:LS := variables(exp)$EF
     empty?(Var)$LS => integrateConstant(exp,ra)
-    args:NIA := [first(Var)$LS,ef2edf exp,socf2socdf ra,f2df epsabs,f2df epsrel]
+    args:NIA:= [first(Var)$LS,ef2edf exp,socf2socdf ra,f2df epsabs,f2df epsrel]
     integrateArgs(args::NumericalIntegrationProblem,r)
 
   integrate(exp:EF,ra:SOCF,epsabs:F,epsrel:F):Result ==
@@ -3096,6 +4426,275 @@ AnnaNumericalIntegrationPackage(): EE == II where
 \begin{chunk}{COQ INTPACK}
 (* package INTPACK *)
 (*
+
+  zeroMeasure: Measure -> Result
+  scriptedVariables?: MDNIA -> Boolean
+  preAnalysis:(Union(nia:NIA,mdnia:MDNIA),RT) -> RT
+  measureSpecific:(ST,RT,Union(nia:NIA,mdnia:MDNIA)) -> _
+      Record(measure:F,explanations:LST,extra:Result)
+  changeName:(Result,ST) -> Result
+  recoverAfterFail:(Union(nia:NIA,mdnia:MDNIA),RT,Measure,INT,Result) -> _
+      Record(a:Result,b:Measure)
+  better?:(Result,Result) -> Boolean
+  integrateConstant:(EF,SOCF) -> Result
+  integrateConstantList: (EF,LSOCF) -> Result
+  integrateArgs:(NumericalIntegrationProblem,RT) -> Result
+  integrateSpecific:(Union(nia:NIA,mdnia:MDNIA),ST,Result) -> Result
+
+  import ExpertSystemToolsPackage
+
+  integrateConstantList(exp:EF,ras:LSOCF):Result ==
+    c:OCF := ((retract(exp)@F)$EF)::OCF
+    b := [hi(j)-lo(j) for j in ras]
+    c := c*reduce((x,y) +-> x*y,b)
+    a := coerce(c)$AnyFunctions1(OCF)
+    text := coerce("Constant Function")$AnyFunctions1(ST)
+    construct([[result@S,a],[method@S,text]])$Result
+    
+  integrateConstant(exp:EF,ra:SOCF):Result ==
+    c := (retract(exp)@F)$EF
+    r:OCF := (c::OCF)*(hi(ra)-lo(ra))
+    a := coerce(r)$AnyFunctions1(OCF)
+    text := coerce("Constant Function")$AnyFunctions1(ST)
+    construct([[result@S,a],[method@S,text]])$Result
+    
+  zeroMeasure(m:Measure):Result ==
+    a := coerce(0$DF)$AnyFunctions1(DF)
+    text := coerce("Constant Function")$AnyFunctions1(String)
+    r := construct([[result@Symbol,a],[method@Symbol,text]])$Result
+    concat(measure2Result m,r)$ExpertSystemToolsPackage
+
+  scriptedVariables?(mdnia:MDNIA):Boolean ==
+    vars:List Symbol := variables(mdnia.fn)$EDF
+    var1 := first(vars)$(List Symbol)
+    not scripted?(var1) => false
+    name1 := name(var1)$Symbol
+    for i in 2..# vars repeat
+      not ((scripted?(vars.i)$Symbol) and (name1 = name(vars.i)$Symbol)) => 
+         return false
+    true
+
+  preAnalysis(args:Union(nia:NIA,mdnia:MDNIA),t:RT):RT ==
+    import RT
+    r:RT := selectIntegrationRoutines t
+    args case nia => 
+      arg:NIA := args.nia
+      rangeIsFinite(arg)$d01AgentsPackage case finite => 
+        selectFiniteRoutines r
+      selectNonFiniteRoutines r
+    selectMultiDimensionalRoutines r
+    
+  changeName(ans:Result,name:ST):Result ==
+    sy:S := coerce(name "Answer")$S
+    anyAns:Any := coerce(ans)$AnyFunctions1(Result)
+    construct([[sy,anyAns]])$Result
+
+  measureSpecific(name:ST,R:RT,args:Union(nia:NIA,mdnia:MDNIA)):
+      Record(measure:F,explanations:ST,extra:Result) ==
+    args case nia => 
+      arg:NIA := args.nia
+      name = "d01ajfAnnaType" => measure(R,arg)$d01ajfAnnaType
+      name = "d01akfAnnaType" => measure(R,arg)$d01akfAnnaType
+      name = "d01alfAnnaType" => measure(R,arg)$d01alfAnnaType
+      name = "d01amfAnnaType" => measure(R,arg)$d01amfAnnaType
+      name = "d01anfAnnaType" => measure(R,arg)$d01anfAnnaType
+      name = "d01apfAnnaType" => measure(R,arg)$d01apfAnnaType
+      name = "d01aqfAnnaType" => measure(R,arg)$d01aqfAnnaType
+      name = "d01asfAnnaType" => measure(R,arg)$d01asfAnnaType
+      name = "d01TransformFunctionType" => 
+                     measure(R,arg)$d01TransformFunctionType
+      error("measureSpecific","invalid type name: " name)$ErrorFunctions
+    args case mdnia => 
+      arg2:MDNIA := args.mdnia
+      name = "d01gbfAnnaType" => measure(R,arg2)$d01gbfAnnaType
+      name = "d01fcfAnnaType" => measure(R,arg2)$d01fcfAnnaType
+      error("measureSpecific","invalid type name: " name)$ErrorFunctions
+    error("measureSpecific","invalid type name")$ErrorFunctions
+
+  measure(a:NumericalIntegrationProblem,R:RT):Measure ==
+    args:Union(nia:NIA,mdnia:MDNIA) := retract(a)$NumericalIntegrationProblem
+    sofar := 0$F
+    best := "none" :: ST
+    routs := copy R
+    routs := preAnalysis(args,routs)
+    empty?(routs)$RT => 
+      error("measure", "no routines found")$ErrorFunctions
+    rout := inspect(routs)$RT
+    e := retract(rout.entry)$AnyFunctions1(Entry)
+    meth:LST := ["Trying " e.type " integration routines"]
+    ext := empty()$Result
+    for i in 1..# routs repeat
+      rout := extract!(routs)$RT
+      e := retract(rout.entry)$AnyFunctions1(Entry)
+      n := e.domainName
+      if e.defaultMin > sofar then
+        m := measureSpecific(n,R,args)
+        if m.measure > sofar then
+          sofar := m.measure
+          best := n
+        ext := concat(m.extra,ext)$ExpertSystemToolsPackage
+        str:LST := [string(rout.key)$S "measure: " outputMeasure(m.measure) 
+                     " - " m.explanations]
+      else
+        str:LST :=  [string(rout.key)$S " is no better than other routines"]
+      meth := append(meth,str)$LST
+    [sofar,best,meth,ext]
+
+  measure(a:NumericalIntegrationProblem):Measure ==
+    measure(a,routines()$RT)
+
+  integrateSpecific(args:Union(nia:NIA,mdnia:MDNIA),n:ST,ex:Result):Result ==
+    args case nia => 
+      arg:NIA := args.nia
+      n = "d01ajfAnnaType" => numericalIntegration(arg,ex)$d01ajfAnnaType
+      n = "d01TransformFunctionType" =>
+        numericalIntegration(arg,ex)$d01TransformFunctionType
+      n = "d01amfAnnaType" => numericalIntegration(arg,ex)$d01amfAnnaType
+      n = "d01apfAnnaType" => numericalIntegration(arg,ex)$d01apfAnnaType
+      n = "d01aqfAnnaType" => numericalIntegration(arg,ex)$d01aqfAnnaType
+      n = "d01alfAnnaType" => numericalIntegration(arg,ex)$d01alfAnnaType
+      n = "d01akfAnnaType" => numericalIntegration(arg,ex)$d01akfAnnaType
+      n = "d01anfAnnaType" => numericalIntegration(arg,ex)$d01anfAnnaType
+      n = "d01asfAnnaType" => numericalIntegration(arg,ex)$d01asfAnnaType
+      error("integrateSpecific","invalid type name: " n)$ErrorFunctions
+    args case mdnia => 
+      arg2:MDNIA := args.mdnia
+      n = "d01gbfAnnaType" => numericalIntegration(arg2,ex)$d01gbfAnnaType
+      n = "d01fcfAnnaType" => numericalIntegration(arg2,ex)$d01fcfAnnaType
+      error("integrateSpecific","invalid type name: " n)$ErrorFunctions
+    error("integrateSpecific","invalid type name: " n)$ErrorFunctions
+
+  better?(r:Result,s:Result):Boolean ==
+    a1 := search("abserr"::S,r)$Result
+    a1 case "failed" => false
+    abserr1 := retract(a1)$AnyFunctions1(DF)
+    negative?(abserr1) => false
+    a2 := search("abserr"::S,s)$Result
+    a2 case "failed" => true
+    abserr2 := retract(a2)$AnyFunctions1(DF)
+    negative?(abserr2) => true
+    (abserr1 < abserr2) -- true if r.abserr better than s.abserr
+
+  recoverAfterFail(n:Union(nia:NIA,mdnia:MDNIA),routs:RT,m:Measure,iint:INT,
+                         r:Result):Record(a:Result,b:Measure) ==
+    bestName := m.name
+    while positive?(iint) repeat
+      routineName := m.name
+      s := recoverAfterFail(routs,routineName(1..6),iint)$RoutinesTable
+      s case "failed" => iint := 0
+      if s = "changeEps" then
+        nn := n.nia
+        zero?(nn.abserr) =>
+          nn.abserr := 1.0e-8 :: DF
+          m := measure(n::NumericalIntegrationProblem,routs)
+          zero?(m.measure) => iint := 0
+          r := integrateSpecific(n,m.name,m.extra)
+          iint := 0
+      rn := routineName(1..6)
+      buttVal := getButtonValue(rn,"functionEvaluations")$AttributeButtons
+      if (s = "incrFunEvals") and (buttVal < 0.8) then
+        increase(rn,"functionEvaluations")$AttributeButtons
+      if s = "increase tolerance" then
+        (n.nia).relerr := (n.nia).relerr*(10.0::DF)
+      if s = "decrease tolerance" then
+        (n.nia).relerr := (n.nia).relerr/(10.0::DF)
+      fl := coerce(s)$AnyFunctions1(ST)
+      flrec:Record(key:S,entry:Any):=[failure@S,fl]
+      m2 := measure(n::NumericalIntegrationProblem,routs)
+      zero?(m2.measure) => iint := 0
+      r2:Result := integrateSpecific(n,m2.name,m2.extra)
+      better?(r,r2) => 
+        m.name := m2.name
+        insert!(flrec,r)$Result
+      bestName := m2.name
+      m := m2
+      insert!(flrec,r2)$Result
+      r := concat(r2,changeName(r,routineName))$ExpertSystemToolsPackage
+      iany := search(ifail@S,r2)$Result
+      iany case "failed" => iint := 0
+      iint := retract(iany)$AnyFunctions1(INT)
+    m.name := bestName
+    [r,m]
+
+  integrateArgs(prob:NumericalIntegrationProblem,t:RT):Result ==
+    args:Union(nia:NIA,mdnia:MDNIA):= retract(prob)$NumericalIntegrationProblem
+    routs := copy(t)$RT
+    if args case mdnia then
+      arg := args.mdnia
+      v := (# variables(arg.fn))
+      not scriptedVariables?(arg) => 
+        error("MultiDimensionalNumericalIntegrationPackage",
+                "invalid variable names")$ErrorFunctions
+      (v ~= # arg.range)@Boolean =>
+        error("MultiDimensionalNumericalIntegrationPackage",
+          "number of variables do not match number of ranges")$ErrorFunctions
+    m := measure(prob,routs)
+    zero?(m.measure) => zeroMeasure m
+    r := integrateSpecific(args,m.name,m.extra)
+    iany := search(ifail@S,r)$Result
+    iint := 0$INT
+    if (iany case Any) then
+      iint := retract(iany)$AnyFunctions1(INT)
+    if positive?(iint) then
+      tu:Record(a:Result,b:Measure) := recoverAfterFail(args,routs,m,iint,r)
+      r := tu.a
+      m := tu.b
+    r := concat(measure2Result m,r)$ExpertSystemToolsPackage
+    n := m.name
+    nn:ST := 
+      (# n > 14) => "d01transform"
+      n(1..6)
+    expl := getExplanations(routs,nn)$RoutinesTable
+    expla := coerce(expl)$AnyFunctions1(LST)
+    explaa:Record(key:Symbol,entry:Any) := ["explanations"::Symbol,expla]
+    r := concat(construct([explaa]),r)
+    args case nia =>
+      att := showAttributes(args.nia)$IntegrationFunctionsTable
+      att case "failed" => r
+      concat(att2Result att,r)$ExpertSystemToolsPackage
+    r
+
+  integrate(args:NumericalIntegrationProblem):Result ==
+    integrateArgs(args,routines()$RT)
+
+  integrate(exp:EF,ra:SOCF,epsabs:F,epsrel:F,r:RT):Result ==
+    Var:LS := variables(exp)$EF
+    empty?(Var)$LS => integrateConstant(exp,ra)
+    args:NIA:= [first(Var)$LS,ef2edf exp,socf2socdf ra,f2df epsabs,f2df epsrel]
+    integrateArgs(args::NumericalIntegrationProblem,r)
+
+  integrate(exp:EF,ra:SOCF,epsabs:F,epsrel:F):Result ==
+    integrate(exp,ra,epsabs,epsrel,routines()$RT)
+
+  integrate(exp:EF,ra:SOCF,err:F):Result ==
+    positive?(err)$F => integrate(exp,ra,0$F,err)
+    integrate(exp,ra,1.0E-5,err)
+
+  integrate(exp:EF,ra:SOCF):Result == integrate(exp,ra,0$F,1.0E-5)
+
+  integrate(exp:EF,sb:SBOCF, st:ST) ==
+    st = "numerical" => integrate(exp,segment sb)
+    "failed"
+
+  integrate(exp:EF,sb:SBOCF, s:S) ==
+    s = (numerical::Symbol) => integrate(exp,segment sb)
+    "failed"
+
+  integrate(exp:EF,ra:LSOCF,epsabs:F,epsrel:F,r:RT):Result ==
+    vars := variables(exp)$EF
+    empty?(vars)$LS => integrateConstantList(exp,ra)
+    args:MDNIA := [ef2edf exp,convert ra,f2df epsabs,f2df epsrel]
+    integrateArgs(args::NumericalIntegrationProblem,r)
+
+  integrate(exp:EF,ra:LSOCF,epsabs:F,epsrel:F):Result ==
+    integrate(exp,ra,epsabs,epsrel,routines()$RT)
+
+  integrate(exp:EF,ra:LSOCF,epsrel:F):Result ==
+    zero? epsrel => integrate(exp,ra,1.0e-6,epsrel)
+    integrate(exp,ra,0$F,epsrel)
+
+  integrate(exp:EF,ra:LSOCF):Result == integrate(exp,ra,1.0e-4)
+
 *)
 
 \end{chunk}
@@ -3357,7 +4956,8 @@ AnnaNumericalOptimizationPackage(): EE == II where
   optimizeSpecific:(UNOALSA,String) -> Result
   measureSpecific:(String,RT,UNOALSA) -> Measure2
   changeName:(Result,String) -> Result
-  recoverAfterFail:(UNOALSA,RT,Measure,INT,Result) -> Record(a:Result,b:Measure)
+  recoverAfterFail:(UNOALSA,RT,Measure,INT,Result) -> _
+    Record(a:Result,b:Measure)
   constant:UNOALSA -> Union(DF, "failed")
   optimizeConstant:DF -> Result
 
@@ -3434,7 +5034,8 @@ AnnaNumericalOptimizationPackage(): EE == II where
       meth := append(meth,str)$(List String)
     [sofar,best,meth]
 
-  measure(args:NumericalOptimizationProblem):Measure == measure(args,routines()$RT)
+  measure(args:NumericalOptimizationProblem):Measure ==
+    measure(args,routines()$RT)
 
   optimizeSpecific(args:UNOALSA,name:String):Result ==
     args case noa =>
@@ -3506,7 +5107,8 @@ AnnaNumericalOptimizationPackage(): EE == II where
     attr:Record(key:Symbol,entry:Any) := [attributes@Symbol,atta]
     insert!(attr,r)$Result
 
-  optimize(args:NumericalOptimizationProblem):Result == optimize(args,routines()$RT)
+  optimize(args:NumericalOptimizationProblem):Result ==
+    optimize(args,routines()$RT)
 
   goodnessOfFit(Args:NumericalOptimizationProblem):Result ==
     r := optimize(Args)
@@ -3562,6 +5164,215 @@ AnnaNumericalOptimizationPackage(): EE == II where
 \begin{chunk}{COQ OPTPACK}
 (* package OPTPACK *)
 (*
+
+  preAnalysis:RT -> RT
+  zeroMeasure:Measure -> Result
+  optimizeSpecific:(UNOALSA,String) -> Result
+  measureSpecific:(String,RT,UNOALSA) -> Measure2
+  changeName:(Result,String) -> Result
+  recoverAfterFail:(UNOALSA,RT,Measure,INT,Result) -> _
+    Record(a:Result,b:Measure)
+  constant:UNOALSA -> Union(DF, "failed")
+  optimizeConstant:DF -> Result
+
+  import ExpertSystemToolsPackage,e04AgentsPackage,NumericalOptimizationProblem
+
+  constant(args:UNOALSA):Union(DF,"failed") ==
+    args case noa =>
+      Args := args.noa
+      f := Args.fn
+      retractIfCan(f)@Union(DoubleFloat,"failed")
+    "failed"
+
+  optimizeConstant(c:DF): Result ==
+    a := coerce(c)$AnyFunctions1(DF)
+    text := coerce("Constant Function")$AnyFunctions1(String)
+    construct([[objf@Symbol,a],[method@Symbol,text]])$Result
+
+  preAnalysis(args:UNOALSA,t:RT):RT == 
+    r := selectOptimizationRoutines(t)$RT
+    args case lsa =>
+      selectSumOfSquaresRoutines(r)$RT
+    r
+
+  zeroMeasure(m:Measure):Result ==
+    a := coerce(0$F)$AnyFunctions1(F)
+    text := coerce("Zero Measure")$AnyFunctions1(String)
+    r := construct([[objf@Symbol,a],[method@Symbol,text]])$Result
+    concat(measure2Result m,r)
+
+  measureSpecific(name:String,R:RT,args:UNOALSA): Measure2 ==
+    args case noa =>
+      arg:NOA := args.noa
+      name = "e04dgfAnnaType" => measure(R,arg)$e04dgfAnnaType
+      name = "e04fdfAnnaType" => measure(R,arg)$e04fdfAnnaType
+      name = "e04gcfAnnaType" => measure(R,arg)$e04gcfAnnaType
+      name = "e04jafAnnaType" => measure(R,arg)$e04jafAnnaType
+      name = "e04mbfAnnaType" => measure(R,arg)$e04mbfAnnaType
+      name = "e04nafAnnaType" => measure(R,arg)$e04nafAnnaType
+      name = "e04ucfAnnaType" => measure(R,arg)$e04ucfAnnaType
+      error("measureSpecific","invalid type name: " name)$ErrorFunctions
+    args case lsa =>
+      arg2:LSA := args.lsa
+      name = "e04fdfAnnaType" => measure(R,arg2)$e04fdfAnnaType
+      name = "e04gcfAnnaType" => measure(R,arg2)$e04gcfAnnaType
+      error("measureSpecific","invalid type name: " name)$ErrorFunctions
+    error("measureSpecific","invalid argument type")$ErrorFunctions
+
+  measure(Args:NumericalOptimizationProblem,R:RT):Measure ==
+    args:UNOALSA := retract(Args)$NumericalOptimizationProblem
+    sofar := 0$F
+    best := "none" :: String
+    routs := copy R
+    routs := preAnalysis(args,routs)
+    empty?(routs)$RT => 
+      error("measure", "no routines found")$ErrorFunctions
+    rout := inspect(routs)$RT
+    e := retract(rout.entry)$AnyFunctions1(Entry)
+    meth := empty()$(List String)
+    for i in 1..# routs repeat
+      rout := extract!(routs)$RT
+      e := retract(rout.entry)$AnyFunctions1(Entry)
+      n := e.domainName
+      if e.defaultMin > sofar then
+        m := measureSpecific(n,R,args)
+        if m.measure > sofar then
+          sofar := m.measure
+          best := n
+        str := [concat(concat([string(rout.key)$Symbol,"measure: ",
+                 outputMeasure(m.measure)," - "],
+                   m.explanations)$(List String))$String]
+      else 
+        str := [concat([string(rout.key)$Symbol
+                         ," is no better than other routines"])$String]
+      meth := append(meth,str)$(List String)
+    [sofar,best,meth]
+
+  measure(args:NumericalOptimizationProblem):Measure ==
+    measure(args,routines()$RT)
+
+  optimizeSpecific(args:UNOALSA,name:String):Result ==
+    args case noa =>
+      arg:NOA := args.noa
+      name = "e04dgfAnnaType" => numericalOptimization(arg)$e04dgfAnnaType
+      name = "e04fdfAnnaType" => numericalOptimization(arg)$e04fdfAnnaType
+      name = "e04gcfAnnaType" => numericalOptimization(arg)$e04gcfAnnaType
+      name = "e04jafAnnaType" => numericalOptimization(arg)$e04jafAnnaType
+      name = "e04mbfAnnaType" => numericalOptimization(arg)$e04mbfAnnaType
+      name = "e04nafAnnaType" => numericalOptimization(arg)$e04nafAnnaType
+      name = "e04ucfAnnaType" => numericalOptimization(arg)$e04ucfAnnaType
+      error("optimizeSpecific","invalid type name: " name)$ErrorFunctions
+    args case lsa =>
+      arg2:LSA := args.lsa
+      name = "e04fdfAnnaType" => numericalOptimization(arg2)$e04fdfAnnaType
+      name = "e04gcfAnnaType" => numericalOptimization(arg2)$e04gcfAnnaType
+      error("optimizeSpecific","invalid type name: " name)$ErrorFunctions
+    error("optimizeSpecific","invalid type name: " name)$ErrorFunctions
+
+  changeName(ans:Result,name:String):Result ==
+    st:String := concat([name,"Answer"])$String
+    sy:Symbol := coerce(st)$Symbol
+    anyAns:Any := coerce(ans)$AnyFunctions1(Result)
+    construct([[sy,anyAns]])$Result
+
+  recoverAfterFail(args:UNOALSA,routs:RT,m:Measure,
+                     iint:INT,r:Result):Record(a:Result,b:Measure) ==
+    while positive?(iint) repeat
+      routineName := m.name
+      s := recoverAfterFail(routs,routineName(1..6),iint)$RT
+      s case "failed" => iint := 0
+      (s = "no action")@Boolean => iint := 0
+      fl := coerce(s)$AnyFunctions1(String)
+      flrec:Record(key:Symbol,entry:Any):=[failure@Symbol,fl]
+      m2 := measure(args::NumericalOptimizationProblem,routs)
+      zero?(m2.measure) => iint := 0
+      r2:Result := optimizeSpecific(args,m2.name)
+      m := m2
+      insert!(flrec,r2)$Result
+      r := concat(r2,changeName(r,routineName))
+      iany := search(ifail@Symbol,r2)$Result
+      iany case "failed" => iint := 0
+      iint := retract(iany)$AnyFunctions1(INT)
+    [r,m]
+
+  optimize(Args:NumericalOptimizationProblem,t:RT):Result ==
+    args:UNOALSA := retract(Args)$NumericalOptimizationProblem
+    routs := copy(t)$RT
+    c:Union(DF,"failed") := constant(args)
+    c case DF => optimizeConstant(c)
+    m := measure(Args,routs)
+    zero?(m.measure) => zeroMeasure m
+    r := optimizeSpecific(args,n := m.name)
+    iany := search(ifail@Symbol,r)$Result
+    iint := 0$INT
+    if (iany case Any) then
+      iint := retract(iany)$AnyFunctions1(INT)
+    if positive?(iint) then
+      tu:Record(a:Result,b:Measure) := recoverAfterFail(args,routs,m,iint,r)
+      r := tu.a
+      m := tu.b
+    r := concat(measure2Result m,r)
+    expl := getExplanations(routs,n(1..6))$RoutinesTable
+    expla := coerce(expl)$AnyFunctions1(LST)
+    explaa:Record(key:Symbol,entry:Any) := ["explanations"::Symbol,expla]
+    r := concat(construct([explaa]),r)
+    att:List String := optAttributes(args)
+    atta := coerce(att)$AnyFunctions1(List String)
+    attr:Record(key:Symbol,entry:Any) := [attributes@Symbol,atta]
+    insert!(attr,r)$Result
+
+  optimize(args:NumericalOptimizationProblem):Result ==
+    optimize(args,routines()$RT)
+
+  goodnessOfFit(Args:NumericalOptimizationProblem):Result ==
+    r := optimize(Args)
+    args1:UNOALSA := retract(Args)$NumericalOptimizationProblem
+    args1 case noa => error("goodnessOfFit","Not an appropriate problem")
+    args:LSA := args1.lsa
+    lf := args.lfn
+    n:INT := #(variables(args))
+    m:INT := # lf
+    me := search(method,r)$Result
+    me case "failed" => r
+    meth := retract(me)$AnyFunctions1(Result)
+    na := search(nameOfRoutine,meth)$Result
+    na case "failed" => r
+    name := retract(na)$AnyFunctions1(String)
+    temp:INT := (n*(n-1)) quo 2
+    ns:INT :=
+      name = "e04fdfAnnaType" => 6*n+(2+n)*m+1+max(1,temp)
+      8*n+(n+2)*m+temp+1+max(1,temp)
+    nv:INT := ns+n
+    ww := search(w,r)$Result
+    ww case "failed" => r
+    ws:MDF := retract(ww)$AnyFunctions1(MDF)
+    fr := search(objf,r)$Result
+    fr case "failed" => r
+    f := retract(fr)$AnyFunctions1(DF)
+    s := subMatrix(ws,1,1,ns,nv-1)$MDF
+    v := subMatrix(ws,1,1,nv,nv+n*n-1)$MDF
+    r2 := e04ycf(0,m,n,f,s,n,v,-1)$NagOptimisationPackage
+    concat(r,r2)
+
+  optimize(f:EF,start:LF,lower:LOCF,cons:LEF,upper:LOCF):Result ==
+    args:NOA := [ef2edf(f),[f2df i for i in start],[ocf2ocdf j for j in lower],
+                 [ef2edf k for k in cons], [ocf2ocdf l for l in upper]]
+    optimize(args::NumericalOptimizationProblem)
+
+  optimize(f:EF,start:LF,lower:LOCF,upper:LOCF):Result ==
+    optimize(f,start,lower,empty()$LEF,upper)
+
+  optimize(f:EF,start:LF):Result ==
+    optimize(f,start,empty()$LOCF,empty()$LOCF)
+
+  optimize(lf:LEF,start:LF):Result ==
+    args:LSA := [[ef2edf i for i in lf],[f2df j for j in start]]
+    optimize(args::NumericalOptimizationProblem)
+
+  goodnessOfFit(lf:LEF,start:LF):Result ==
+    args:LSA := [[ef2edf i for i in lf],[f2df j for j in start]]
+    goodnessOfFit(args::NumericalOptimizationProblem)
+
 *)
 
 \end{chunk}
@@ -3893,7 +5704,8 @@ AnnaOrdinaryDifferentialEquationPackage(): EE == II where
   measureSpecific:(ST,RT,ODEA) -> Record(measure:F,explanations:ST)
   solveSpecific:(ODEA,ST) -> Result
   changeName:(Result,ST) -> Result 
-  recoverAfterFail:(ODEA,RT,Measure,Integer,Result) -> Record(a:Result,b:Measure)
+  recoverAfterFail:(ODEA,RT,Measure,Integer,Result) -> _
+    Record(a:Result,b:Measure)
 
   f2df(f:F):DF == (convert(f)@DF)$F
 
@@ -4013,8 +5825,9 @@ AnnaOrdinaryDifferentialEquationPackage(): EE == II where
 
   solve(ode:NumericalODEProblem):Result == solve(ode,routines()$RT)
 
-  solve(f:VEF,xStart:F,xEnd:F,yInitial:LF,G:EF,intVals:LF,epsabs:F,epsrel:F):Result ==
-    d:ODEA := [f2df xStart,f2df xEnd,vector([ef2edf e for e in members f])$VEDF,
+  solve(f:VEF,xStart:F,xEnd:F,yInitial:LF,G:EF,intVals:LF,epsabs:F,epsrel:F)_
+        :Result ==
+    d:ODEA:= [f2df xStart,f2df xEnd,vector([ef2edf e for e in members f])$VEDF,
                [f2df i for i in yInitial], [f2df j for j in intVals],
                 ef2edf G,f2df epsabs,f2df epsrel]
     solve(d::NumericalODEProblem,routines()$RT)
@@ -4031,13 +5844,167 @@ AnnaOrdinaryDifferentialEquationPackage(): EE == II where
   solve(f:VEF,xStart:F,xEnd:F,yInitial:LF,tol:F):Result ==
     solve(f,xStart,xEnd,yInitial,1$EF,empty()$LF,tol)
 
-  solve(f:VEF,xStart:F,xEnd:F,yInitial:LF):Result == solve(f,xStart,xEnd,yInitial,1.0e-4)
+  solve(f:VEF,xStart:F,xEnd:F,yInitial:LF):Result ==
+    solve(f,xStart,xEnd,yInitial,1.0e-4)
 
 \end{chunk}
 
 \begin{chunk}{COQ ODEPACK}
 (* package ODEPACK *)
 (*
+
+  import ODEA,NumericalODEProblem
+
+  f2df:F -> DF
+  ef2edf:EF -> EDF
+  preAnalysis:(ODEA,RT) -> RT
+  zeroMeasure:Measure -> Result
+  measureSpecific:(ST,RT,ODEA) -> Record(measure:F,explanations:ST)
+  solveSpecific:(ODEA,ST) -> Result
+  changeName:(Result,ST) -> Result 
+  recoverAfterFail:(ODEA,RT,Measure,Integer,Result) -> _
+    Record(a:Result,b:Measure)
+
+  f2df(f:F):DF == (convert(f)@DF)$F
+
+  ef2edf(f:EF):EDF == map(f2df,f)$ExpressionFunctions2(F,DF)
+
+  preAnalysis(args:ODEA,t:RT):RT ==
+    rt := selectODEIVPRoutines(t)$RT
+    if positive?(# variables(args.g)) then 
+      changeMeasure(rt,d02bbf@Symbol,getMeasure(rt,d02bbf@Symbol)*0.8)
+    if positive?(# args.intvals) then 
+      changeMeasure(rt,d02bhf@Symbol,getMeasure(rt,d02bhf@Symbol)*0.8)
+    rt
+
+  zeroMeasure(m:Measure):Result ==
+    a := coerce(0$F)$AnyFunctions1(F)
+    text := coerce("Zero Measure")$AnyFunctions1(ST)
+    r := construct([[result@Symbol,a],[method@Symbol,text]])$Result
+    concat(measure2Result m,r)$ExpertSystemToolsPackage
+
+  measureSpecific(name:ST,R:RT,ode:ODEA):Record(measure:F,explanations:ST) ==
+    name = "d02bbfAnnaType" => measure(R,ode)$d02bbfAnnaType
+    name = "d02bhfAnnaType" => measure(R,ode)$d02bhfAnnaType
+    name = "d02cjfAnnaType" => measure(R,ode)$d02cjfAnnaType
+    name = "d02ejfAnnaType" => measure(R,ode)$d02ejfAnnaType
+    error("measureSpecific","invalid type name: " name)$ErrorFunctions
+
+  measure(Ode:NumericalODEProblem,R:RT):Measure ==
+    ode:ODEA := retract(Ode)$NumericalODEProblem
+    sofar := 0$F
+    best := "none" :: ST
+    routs := copy R
+    routs := preAnalysis(ode,routs)
+    empty?(routs)$RT => 
+      error("measure", "no routines found")$ErrorFunctions
+    rout := inspect(routs)$RT
+    e := retract(rout.entry)$AnyFunctions1(Entry)
+    meth := empty()$LST
+    for i in 1..# routs repeat
+      rout := extract!(routs)$RT
+      e := retract(rout.entry)$AnyFunctions1(Entry)
+      n := e.domainName
+      if e.defaultMin > sofar then
+        m := measureSpecific(n,R,ode)
+        if m.measure > sofar then
+          sofar := m.measure
+          best := n
+        str:LST := [string(rout.key)$Symbol "measure: " 
+                    outputMeasure(m.measure)$ExpertSystemToolsPackage " - " 
+                     m.explanations]
+      else 
+        str := [string(rout.key)$Symbol " is no better than other routines"]
+      meth := append(meth,str)$LST
+    [sofar,best,meth]
+
+  measure(ode:NumericalODEProblem):Measure == measure(ode,routines()$RT)
+
+  solveSpecific(ode:ODEA,n:ST):Result ==
+    n = "d02bbfAnnaType" => ODESolve(ode)$d02bbfAnnaType
+    n = "d02bhfAnnaType" => ODESolve(ode)$d02bhfAnnaType
+    n = "d02cjfAnnaType" => ODESolve(ode)$d02cjfAnnaType
+    n = "d02ejfAnnaType" => ODESolve(ode)$d02ejfAnnaType
+    error("solveSpecific","invalid type name: " n)$ErrorFunctions
+
+  changeName(ans:Result,name:ST):Result ==
+    sy:Symbol := coerce(name "Answer")$Symbol
+    anyAns:Any := coerce(ans)$AnyFunctions1(Result)
+    construct([[sy,anyAns]])$Result
+
+  recoverAfterFail(ode:ODEA,routs:RT,m:Measure,iint:Integer,r:Result):
+                                            Record(a:Result,b:Measure) ==
+    while positive?(iint) repeat
+      routineName := m.name
+      s := recoverAfterFail(routs,routineName(1..6),iint)$RT
+      s case "failed" => iint := 0
+      if s = "increase tolerance" then
+        ode.relerr := ode.relerr*(10.0::DF)
+        ode.abserr := ode.abserr*(10.0::DF)
+      if s = "decrease tolerance" then
+        ode.relerr := ode.relerr/(10.0::DF)
+        ode.abserr := ode.abserr/(10.0::DF)
+      (s = "no action")@Boolean => iint := 0
+      fl := coerce(s)$AnyFunctions1(ST)
+      flrec:Record(key:Symbol,entry:Any):=[failure@Symbol,fl]
+      m2 := measure(ode::NumericalODEProblem,routs)
+      zero?(m2.measure) => iint := 0
+      r2:Result := solveSpecific(ode,m2.name)
+      m := m2
+      insert!(flrec,r2)$Result
+      r := concat(r2,changeName(r,routineName))$ExpertSystemToolsPackage
+      iany := search(ifail@Symbol,r2)$Result
+      iany case "failed" => iint := 0
+      iint := retract(iany)$AnyFunctions1(Integer)
+    [r,m]
+
+  solve(Ode:NumericalODEProblem,t:RT):Result ==
+    ode:ODEA := retract(Ode)$NumericalODEProblem
+    routs := copy(t)$RT
+    m := measure(Ode,routs)
+    zero?(m.measure) => zeroMeasure m
+    r := solveSpecific(ode,n := m.name)
+    iany := search(ifail@Symbol,r)$Result
+    iint := 0$Integer
+    if (iany case Any) then
+      iint := retract(iany)$AnyFunctions1(Integer)
+    if positive?(iint) then
+      tu:Record(a:Result,b:Measure) := recoverAfterFail(ode,routs,m,iint,r)
+      r := tu.a
+      m := tu.b
+    r := concat(measure2Result m,r)$ExpertSystemToolsPackage
+    expl := getExplanations(routs,n(1..6))$RoutinesTable
+    expla := coerce(expl)$AnyFunctions1(LST)
+    explaa:Record(key:Symbol,entry:Any) := ["explanations"::Symbol,expla]
+    r := concat(construct([explaa]),r)
+    iflist := showIntensityFunctions(ode)$ODEIntensityFunctionsTable
+    iflist case "failed" => r
+    concat(iflist2Result iflist, r)$ExpertSystemToolsPackage
+
+  solve(ode:NumericalODEProblem):Result == solve(ode,routines()$RT)
+
+  solve(f:VEF,xStart:F,xEnd:F,yInitial:LF,G:EF,intVals:LF,epsabs:F,epsrel:F)_
+        :Result ==
+    d:ODEA:= [f2df xStart,f2df xEnd,vector([ef2edf e for e in members f])$VEDF,
+               [f2df i for i in yInitial], [f2df j for j in intVals],
+                ef2edf G,f2df epsabs,f2df epsrel]
+    solve(d::NumericalODEProblem,routines()$RT)
+
+  solve(f:VEF,xStart:F,xEnd:F,yInitial:LF,G:EF,intVals:LF,tol:F):Result ==
+    solve(f,xStart,xEnd,yInitial,G,intVals,tol,tol)
+
+  solve(f:VEF,xStart:F,xEnd:F,yInitial:LF,intVals:LF,tol:F):Result ==
+    solve(f,xStart,xEnd,yInitial,1$EF,intVals,tol)
+
+  solve(f:VEF,xStart:F,xEnd:F,y:LF,G:EF,tol:F):Result ==
+    solve(f,xStart,xEnd,y,G,empty()$LF,tol)
+
+  solve(f:VEF,xStart:F,xEnd:F,yInitial:LF,tol:F):Result ==
+    solve(f,xStart,xEnd,yInitial,1$EF,empty()$LF,tol)
+
+  solve(f:VEF,xStart:F,xEnd:F,yInitial:LF):Result ==
+    solve(f,xStart,xEnd,yInitial,1.0e-4)
+
 *)
 
 \end{chunk}
@@ -4246,11 +6213,12 @@ AnnaPartialDifferentialEquationPackage(): EE == II where
   measureSpecific:(ST,RT,PDEB) -> Record(measure:F,explanations:ST)
   solveSpecific:(PDEB,ST) -> Result
   changeName:(Result,ST) -> Result
-  recoverAfterFail:(PDEB,RT,Measure,Integer,Result) -> Record(a:Result,b:Measure)
+  recoverAfterFail:(PDEB,RT,Measure,Integer,Result) -> _
+    Record(a:Result,b:Measure)
 
   zeroMeasure(m:Measure):Result ==
     a := coerce(0$F)$AnyFunctions1(F)
-    text := coerce("No available routine appears appropriate")$AnyFunctions1(ST)
+    text:= coerce("No available routine appears appropriate")$AnyFunctions1(ST)
     r := construct([[result@Symbol,a],[method@Symbol,text]])$Result
     concat(measure2Result m,r)$ExpertSystemToolsPackage
 
@@ -4358,6 +6326,121 @@ AnnaPartialDifferentialEquationPackage(): EE == II where
 \begin{chunk}{COQ PDEPACK}
 (* package PDEPACK *)
 (*
+
+  import PDEB, d03AgentsPackage, ExpertSystemToolsPackage, NumericalPDEProblem
+
+  zeroMeasure:Measure -> Result
+  measureSpecific:(ST,RT,PDEB) -> Record(measure:F,explanations:ST)
+  solveSpecific:(PDEB,ST) -> Result
+  changeName:(Result,ST) -> Result
+  recoverAfterFail:(PDEB,RT,Measure,Integer,Result) -> _
+    Record(a:Result,b:Measure)
+
+  zeroMeasure(m:Measure):Result ==
+    a := coerce(0$F)$AnyFunctions1(F)
+    text:= coerce("No available routine appears appropriate")$AnyFunctions1(ST)
+    r := construct([[result@Symbol,a],[method@Symbol,text]])$Result
+    concat(measure2Result m,r)$ExpertSystemToolsPackage
+
+  measureSpecific(name:ST,R:RT,p:PDEB):Record(measure:F,explanations:ST) ==
+    name = "d03eefAnnaType" => measure(R,p)$d03eefAnnaType
+    --name = "d03fafAnnaType" => measure(R,p)$d03fafAnnaType
+    error("measureSpecific","invalid type name: " name)$ErrorFunctions
+
+  measure(P:NumericalPDEProblem,R:RT):Measure ==
+    p:PDEB := retract(P)$NumericalPDEProblem
+    sofar := 0$F
+    best := "none" :: ST
+    routs := copy R
+    routs := selectPDERoutines(routs)$RT
+    empty?(routs)$RT => 
+      error("measure", "no routines found")$ErrorFunctions
+    rout := inspect(routs)$RT
+    e := retract(rout.entry)$AnyFunctions1(Entry)
+    meth := empty()$LST
+    for i in 1..# routs repeat
+      rout := extract!(routs)$RT
+      e := retract(rout.entry)$AnyFunctions1(Entry)
+      n := e.domainName
+      if e.defaultMin > sofar then
+        m := measureSpecific(n,R,p)
+        if m.measure > sofar then
+          sofar := m.measure
+          best := n
+        str:LST := [string(rout.key)$Symbol "measure: " 
+                    outputMeasure(m.measure)$ExpertSystemToolsPackage " - " 
+                     m.explanations]
+      else 
+        str := [string(rout.key)$Symbol " is no better than other routines"]
+      meth := append(meth,str)$LST
+    [sofar,best,meth]
+
+  measure(P:NumericalPDEProblem):Measure == measure(P,routines()$RT)
+
+  solveSpecific(p:PDEB,n:ST):Result ==
+    n = "d03eefAnnaType" => PDESolve(p)$d03eefAnnaType
+    --n = "d03fafAnnaType" => PDESolve(p)$d03fafAnnaType
+    error("solveSpecific","invalid type name: " n)$ErrorFunctions
+
+  changeName(ans:Result,name:ST):Result ==
+    sy:Symbol := coerce(name "Answer")$Symbol
+    anyAns:Any := coerce(ans)$AnyFunctions1(Result)
+    construct([[sy,anyAns]])$Result
+
+  recoverAfterFail(p:PDEB,routs:RT,m:Measure,iint:Integer,r:Result):
+                                            Record(a:Result,b:Measure) ==
+    while positive?(iint) repeat
+      routineName := m.name
+      s := recoverAfterFail(routs,routineName(1..6),iint)$RT
+      s case "failed" => iint := 0
+      (s = "no action")@Boolean => iint := 0
+      fl := coerce(s)$AnyFunctions1(ST)
+      flrec:Record(key:Symbol,entry:Any):=[failure@Symbol,fl]
+      m2 := measure(p::NumericalPDEProblem,routs)
+      zero?(m2.measure) => iint := 0
+      r2:Result := solveSpecific(p,m2.name)
+      m := m2
+      insert!(flrec,r2)$Result
+      r := concat(r2,changeName(r,routineName))$ExpertSystemToolsPackage
+      iany := search(ifail@Symbol,r2)$Result
+      iany case "failed" => iint := 0
+      iint := retract(iany)$AnyFunctions1(Integer)
+    [r,m]
+
+  solve(P:NumericalPDEProblem,t:RT):Result ==
+    routs := copy(t)$RT
+    m := measure(P,routs)
+    p:PDEB := retract(P)$NumericalPDEProblem
+    zero?(m.measure) => zeroMeasure m
+    r := solveSpecific(p,n := m.name)
+    iany := search(ifail@Symbol,r)$Result
+    iint := 0$Integer
+    if (iany case Any) then
+      iint := retract(iany)$AnyFunctions1(Integer)
+    if positive?(iint) then
+      tu:Record(a:Result,b:Measure) := recoverAfterFail(p,routs,m,iint,r)
+      r := tu.a
+      m := tu.b
+    expl := getExplanations(routs,n(1..6))$RoutinesTable
+    expla := coerce(expl)$AnyFunctions1(LST)
+    explaa:Record(key:Symbol,entry:Any) := ["explanations"::Symbol,expla]
+    r := concat(construct([explaa]),r)
+    concat(measure2Result m,r)$ExpertSystemToolsPackage
+
+  solve(P:NumericalPDEProblem):Result == solve(P,routines()$RT)
+
+  solve(xmi:F,xma:F,ymi:F,yma:F,nx:NNI,ny:NNI,pe:LEF,bo:List
+                LEF,s:ST,to:DF):Result ==
+    cx:PDEC := [f2df xmi, f2df xma, nx, 1, empty()$MDF, empty()$MDF]
+    cy:PDEC := [f2df ymi, f2df yma, ny, 1, empty()$MDF, empty()$MDF]
+    p:PDEB := [[ef2edf e for e in pe],[cx,cy],
+                [[ef2edf u for u in w] for w in bo],s,to]
+    solve(p::NumericalPDEProblem,routines()$RT)
+
+  solve(xmi:F,xma:F,ymi:F,yma:F,nx:NNI,ny:NNI,pe:LEF,bo:List
+                LEF,s:ST):Result ==
+    solve(xmi,xma,ymi,yma,nx,ny,pe,bo,s,0.0001::DF)
+
 *)
 
 \end{chunk}
@@ -4445,6 +6528,7 @@ AnyFunctions1(S:Type): with
           ++ Error: if no such retraction is possible.
 
     == add
+
         import NoneFunctions1(S)
 
         Sexpr:SExpression := devaluate(S)$Lisp
@@ -4465,6 +6549,22 @@ AnyFunctions1(S:Type): with
 \begin{chunk}{COQ ANY1}
 (* package ANY1 *)
 (*
+
+        import NoneFunctions1(S)
+
+        Sexpr:SExpression := devaluate(S)$Lisp
+
+        retractable? a  == dom(a) = Sexpr
+        coerce(s:S):Any == any(Sexpr, s::None)
+
+        retractIfCan a ==
+            retractable? a => obj(a) pretend S
+            "failed"
+
+        retract a ==
+            retractable? a => obj(a) pretend S
+            error "Cannot retract value."
+
 *)
 
 \end{chunk}
@@ -4849,6 +6949,7 @@ ApplicationProgramInterface(): Exports == Implementation where
       ++X reportInstantiations(false)
 
   Implementation ==> add
+
     getDomains(cat:Symbol):Set(Symbol) == 
       set [symbol car first destruct a _
         for a in (destruct domainsOf(cat,NIL$Lisp)$Lisp)::List(SExpression)]
@@ -4870,6 +6971,23 @@ ApplicationProgramInterface(): Exports == Implementation where
 \begin{chunk}{COQ API}
 (* package API *)
 (*
+
+    getDomains(cat:Symbol):Set(Symbol) == 
+      set [symbol car first destruct a _
+        for a in (destruct domainsOf(cat,NIL$Lisp)$Lisp)::List(SExpression)]
+
+    getAncestors(cat:Symbol):Set(Symbol) == 
+      set [symbol car first destruct a _
+        for a in (destruct ancestorsOf(cat,NIL$Lisp)$Lisp)::List(SExpression)]
+
+    credits() == ( credits()$Lisp ; void() )
+
+    summary() == ( summary()$Lisp ; void() )
+
+    reportInstantiations(b:Boolean): Void ==
+      REPORTINSTANTIATIONS(b)$Lisp
+      void
+
 *)
 
 \end{chunk}
@@ -4962,6 +7080,7 @@ ApplyRules(Base, R, F): Exports == Implementation where
       ++ localUnquote(f,ls) is a local function.
 
   Implementation ==> add
+
     import PatternFunctions1(Base, F)
 
     splitRules: List RR -> Record(lker: List K,lval: List F,rl: List RR)
@@ -5012,10 +7131,13 @@ ApplyRules(Base, R, F): Exports == Implementation where
       localUnquote(eval(f, lk, lv), l)
 
     if R has ConvertibleTo InputForm then
+
       localUnquote(f, l) ==
         empty? l => f
         eval(f, l)
+
     else
+
       localUnquote(f, l) == f
 
     isitwithpred(subject, pat, vars, bad) ==
@@ -5051,6 +7173,94 @@ ApplyRules(Base, R, F): Exports == Implementation where
 \begin{chunk}{COQ APPRULE}
 (* package APPRULE *)
 (*
+
+    import PatternFunctions1(Base, F)
+
+    splitRules: List RR -> Record(lker: List K,lval: List F,rl: List RR)
+    localApply  : (List K, List F, List RR, F, PositiveInteger) -> F
+    rewrite     : (F, PR, List Symbol) -> F
+    app         : (List RR, F) -> F
+    applist     : (List RR, List F) -> List F
+    isit        : (F, P) -> PR
+    isitwithpred: (F, P, List P, List PR) -> PR
+
+    applist(lrule, arglist)  == [app(lrule, arg) for arg in arglist]
+
+    splitRules l ==
+      ncr := empty()$List(RR)
+      lk  := empty()$List(K)
+      lv  := empty()$List(F)
+      for r in l repeat
+        if (u := retractIfCan(r)@Union(Equation F, "failed"))
+          case "failed" then ncr := concat(r, ncr)
+          else
+            lk := concat(retract(lhs(u::Equation F))@K, lk)
+            lv := concat(rhs(u::Equation F), lv)
+      [lk, lv, ncr]
+
+    applyRules(l, s) ==
+      rec := splitRules l
+      repeat
+        (new:= localApply(rec.lker,rec.lval,rec.rl,s,1)) = s => return s
+        s := new
+
+    applyRules(l, s, n) ==
+      rec := splitRules l
+      localApply(rec.lker, rec.lval, rec.rl, s, n)
+
+    localApply(lk, lv, lrule, subject, n) ==
+      for i in 1..n repeat
+        for k in lk for v in lv repeat
+          subject := eval(subject, k, v)
+        subject := app(lrule, subject)
+      subject
+
+    rewrite(f, res, l) ==
+      lk := empty()$List(K)
+      lv := empty()$List(F)
+      for rec in destruct res repeat
+        lk := concat(kernel(rec.key), lk)
+        lv := concat(rec.entry, lv)
+      localUnquote(eval(f, lk, lv), l)
+
+    if R has ConvertibleTo InputForm then
+
+      localUnquote(f, l) ==
+        empty? l => f
+        eval(f, l)
+
+    else
+
+      localUnquote(f, l) == f
+
+    isitwithpred(subject, pat, vars, bad) ==
+      failed?(u := patternMatch(subject, pat, new()$PR)) => u
+      satisfy?(u, pat)::Boolean => u
+      member?(u, bad) => failed()
+      for v in vars repeat addBadValue(v, getMatch(v, u)::F)
+      isitwithpred(subject, pat, vars, concat(u, bad))
+
+    isit(subject, pat) ==
+      hasTopPredicate? pat =>
+        for v in (l := variables pat) repeat resetBadValues v
+        isitwithpred(subject, pat, l, empty())
+      patternMatch(subject, pat, new()$PR)
+
+    app(lrule, subject) ==
+      for r in lrule repeat
+        not failed?(u := isit(subject, pattern r)) =>
+          return rewrite(rhs r, u, quotedOperators r)
+      (k := retractIfCan(subject)@Union(K, "failed")) case K =>
+        operator(k::K) applist(lrule, argument(k::K))
+      (l := isPlus  subject) case List(F) => +/applist(lrule,l::List(F))
+      (l := isTimes subject) case List(F) => */applist(lrule,l::List(F))
+      (e := isPower subject) case Record(val:F, exponent:Integer) =>
+        ee := e::Record(val:F, exponent:Integer)
+        f  := app(lrule, ee.val)
+        positive?(ee.exponent) => f ** (ee.exponent)::NonNegativeInteger
+        recip(f)::F ** (- ee.exponent)::NonNegativeInteger
+      subject
+
 *)
 
 \end{chunk}
@@ -5121,6 +7331,7 @@ ApplyUnivariateSkewPolynomial(R:Ring, M: LeftModule R,
         ++ by \spad{x m = f(m)}.
         ++ \spad{f} must be an R-pseudo linear map on M.
    == add
+
       apply(p, f, m) ==
         w:M  := 0
         mn:M := m
@@ -5134,6 +7345,15 @@ ApplyUnivariateSkewPolynomial(R:Ring, M: LeftModule R,
 \begin{chunk}{COQ APPLYORE}
 (* package APPLYORE *)
 (*
+
+      apply(p, f, m) ==
+        w:M  := 0
+        mn:M := m
+        for i in 0..degree p repeat
+          w  := w + coefficient(p, i) * mn
+          mn := f mn
+        w
+
 *)
 
 \end{chunk}
@@ -5227,6 +7447,7 @@ AssociatedEquations(R, L):Exports == Implementation where
           ++ \spad{lw_i = lop_i(w)} for all the other minors.
  
   Implementation ==> add
+
     makeMatrix: (Vector MAT, N) -> MAT
  
     diff:L := D()
@@ -5280,7 +7501,7 @@ AssociatedEquations(R, L):Exports == Implementation where
                                     [makeop row(m, j) for j in 1..n | j ^= i]]
  
         associatedEquations(op, m) ==
-          (u := firstUncouplingMatrix(op, m)) case "failed" => computeIt(op,m,1)
+          (u:= firstUncouplingMatrix(op, m)) case "failed" => computeIt(op,m,1)
           (v := inverse(u::MAT)) case "failed" => computeIt(op, m, 2)
           S := SetOfMIntegersInOneToN(m, degree(op)::PI)
           w := enumerate()$S
@@ -5307,6 +7528,82 @@ AssociatedEquations(R, L):Exports == Implementation where
 \begin{chunk}{COQ ASSOCEQ}
 (* package ASSOCEQ *)
 (*
+
+    makeMatrix: (Vector MAT, N) -> MAT
+ 
+    diff:L := D()
+ 
+    makeMatrix(v, n) == matrix [parts row(v.i, n) for i in 1..#v]
+ 
+    associatedSystem(op, m) ==
+      eq: Vector R
+      S := SetOfMIntegersInOneToN(m, n := degree(op)::PI)
+      w := enumerate()$S
+      s := size()$S
+      ww:Vector List PI := new(s, empty())
+      M:MAT := new(s, s, 0)
+      m1 := (m::Integer - 1)::PI
+      an := leadingCoefficient op
+      a:Vector(R) := [- (coefficient(op, j) exquo an)::R for j in 0..n - 1]
+      for i in 1..s repeat
+          eq := new(s, 0)
+          wi := w.i
+          ww.i := elements wi
+          for k in 1..m1 repeat
+              u := incrementKthElement(wi, k::PI)$S
+              if u case S then eq(lookup(u::S)) := 1
+          if member?(n, wi) then
+              for j in 1..n | a.j ^= 0 repeat
+                  u := replaceKthElement(wi, m, j::PI)
+                  if u case S then
+                    eq(lookup(u::S)) := (odd? delta(wi, m, j::PI) => -a.j; a.j)
+          else
+              u := incrementKthElement(wi, m)$S
+              if u case S then eq(lookup(u::S)) := 1
+          setRow_!(M, i, eq)
+      [M, ww]
+ 
+    uncouplingMatrices m ==
+      n := nrows m
+      v:Vector MAT := new(n, zero(1, 0)$MAT)
+      v.1 := mi := m
+      for i in 2..n repeat v.i := mi := map((z1:R):R +-> diff z1, mi) + mi * m
+      [makeMatrix(v, i) for i in 1..n]
+ 
+    if R has Field then
+        import PrecomputedAssociatedEquations(R, L)
+ 
+        makeop:    Vector R -> L
+        makeeq:    (Vector List PI, MAT, N, N) -> REC
+        computeIt: (L, PI, N) -> REC
+ 
+        makeeq(v, m, i, n) ==
+          [v.i, makeop row(m, i) - 1, [v.j for j in 1..n | j ^= i],
+                                    [makeop row(m, j) for j in 1..n | j ^= i]]
+ 
+        associatedEquations(op, m) ==
+          (u:= firstUncouplingMatrix(op, m)) case "failed" => computeIt(op,m,1)
+          (v := inverse(u::MAT)) case "failed" => computeIt(op, m, 2)
+          S := SetOfMIntegersInOneToN(m, degree(op)::PI)
+          w := enumerate()$S
+          s := size()$S
+          ww:Vector List PI := new(s, empty())
+          for i in 1..s repeat ww.i := elements(w.i)
+          makeeq(ww, v::MAT, 1, s)
+ 
+        computeIt(op, m, k) ==
+          rec := associatedSystem(op, m)
+          a := uncouplingMatrices(rec.mat)
+          n := #a
+          for i in k..n repeat
+            (u := inverse(a.i)) case MAT => return makeeq(rec.vec,u::MAT,i,n)
+          error "associatedEquations: full degenerate case"
+ 
+        makeop v ==
+          op:L := 0
+          for i in 1..#v repeat op := op + monomial(v i, i)
+          op
+
 *)
 
 \end{chunk}
@@ -5381,9 +7678,11 @@ AttachPredicates(D:Type): Exports == Implementation where
       ++ f1 and f2 and ... and fn to x.
 
   Implementation ==> add
+
     import FunctionSpaceAttachPredicates(Integer, FE, D)
 
     suchThat(p:Symbol, f:D -> Boolean)       == suchThat(p::FE, f)
+
     suchThat(p:Symbol, l:List(D -> Boolean)) == suchThat(p::FE, l)
 
 \end{chunk}
@@ -5391,6 +7690,13 @@ AttachPredicates(D:Type): Exports == Implementation where
 \begin{chunk}{COQ PMPRED}
 (* package PMPRED *)
 (*
+
+    import FunctionSpaceAttachPredicates(Integer, FE, D)
+
+    suchThat(p:Symbol, f:D -> Boolean)       == suchThat(p::FE, f)
+
+    suchThat(p:Symbol, l:List(D -> Boolean)) == suchThat(p::FE, l)
+
 *)
 
 \end{chunk}
@@ -5489,7 +7795,7 @@ AxiomServer: public == private where
 
    getDatabase(constructor:String, key:String):String ==
      answer:=string GETDATABASE(INTERN$Lisp constructor,INTERN$Lisp key)$Lisp
---     WriteLine$Lisp concat ["getDatabase: ",constructor," ",key," ",answer]
+     -- WriteLine$Lisp concat ["getDatabase: ",constructor," ",key," ",answer]
      answer
 
 \end{chunk}
@@ -5497,6 +7803,7 @@ The axServer function handles the socket connection on the given port.
 When it gets a input on the socket it calls the server
 function on the socket input.
 \begin{chunk}{package AXSERV AxiomServer}
+
    axServer(port:Integer,serverfunc:SExpression->Void):Void ==
      WriteLine$Lisp "listening on port 8085"
      s := SiSock(port,serverfunc)$Lisp
@@ -5507,7 +7814,6 @@ function on the socket input.
        if not null?(SiListen(s)$Lisp)$SExpression then
          w := SiAccept(s)$Lisp
          serverfunc(w)
---        i := 0
 
 \end{chunk}
 The multiServ function parses the socket input.
@@ -5524,7 +7830,7 @@ A POST request starts with
 \begin{chunk}{package AXSERV AxiomServer}
 
    multiServ(s:SExpression):Void ==
---     WriteLine("multiServ begin")$Lisp
+     -- WriteLine("multiServ begin")$Lisp
      headers:String := ""
      char:String
      -- read in the http headers
@@ -5532,13 +7838,13 @@ A POST request starts with
        STRING(READ_-CHAR_-NO_-HANG(s,NIL$Lisp,'EOF)$Lisp)$Lisp) ^= "EOF"_
         repeat
          headers := concat [headers,char]
---     sayTeX$Lisp headers
+     -- sayTeX$Lisp headers
      StringMatch("([^ ]*)", headers)$Lisp
      u:UniversalSegment(Integer)
      u := segment(MatchBeginning(1)$Lisp+1,_
                   MatchEnd(1)$Lisp)$UniversalSegment(Integer)
      reqtype:String := headers.u
---     sayTeX$Lisp  concat ["request type: ",reqtype]
+     -- sayTeX$Lisp  concat ["request type: ",reqtype]
      if  reqtype = "GET" then
          StringMatch("GET ([^ ]*)",headers)$Lisp
          u:UniversalSegment(Integer)
@@ -5569,8 +7875,8 @@ A POST request starts with
          u := segment(MatchBeginning(1)$Lisp+1,_
                       MatchEnd(1)$Lisp)$UniversalSegment(Integer)
          getShow(s,headers.u)
---     WriteLine("multiServ end")$Lisp
---     WriteLine("")$Lisp
+       -- WriteLine("multiServ end")$Lisp
+       -- WriteLine("")$Lisp
 
 \end{chunk}
 \subsubsection{getFile}
@@ -5579,8 +7885,9 @@ that contains the file. If the filename contains a question mark
 then we need to parse the parameters and dynamically construct the
 file contents.
 \begin{chunk}{package AXSERV AxiomServer}
+
    getFile(s:SExpression,pathvar:String):Void ==
---     WriteLine("")$Lisp
+     -- WriteLine("")$Lisp
      WriteLine$Lisp concat ["getFile: ",pathvar]
      params:=split(pathvar,char "?")
      if #params = 1 
@@ -5602,14 +7909,16 @@ file contents.
 \end{chunk}
 \subsubsection{makeErrorPage}
 \begin{chunk}{package AXSERV AxiomServer}
+
    makeErrorPage(msg:String):String ==
      page:String:="<!DOCTYPE html PUBLIC "
      page:=page "_"-//W3C//DTD XHTML 1.0 Strict//EN_" "
      page:=page "_"http://www.w3.org/TR/xthml1/DTD/xhtml1-strict.dtd_">"
      page:=page "<html xmlns=_"http://www.w3.org/1999/xhtml_">"
      page:=page "<head><title>Error</title></head><body>" msg "</body></html>"
---     WriteLine(page)$Lisp
+     -- WriteLine(page)$Lisp
      page
+
 \end{chunk}
 \subsubsection{getDescription}
 We need to fish around in the data structure to return the piece of 
@@ -5620,26 +7929,30 @@ need to get the lisp object and work with it in native form first.
 
 The doc string also contains spad markup which we need to replace with html.
 \begin{chunk}{package AXSERV AxiomServer}
+
    getDescription(dom:String):String ==
     d:=CADR(CADAR(GETDATABASE(INTERN(dom)$Lisp,'DOCUMENTATION)$Lisp)$Lisp)$Lisp
     string d
+
 \end{chunk}
 \subsubsection{getSourceFile}
 During build we construct a hash table that takes the chunk name as
 the key and returns the filename. We reconstruct the chunk name here
 and do a lookup for the source file.
 \begin{chunk}{package AXSERV AxiomServer}
+
    getSourceFile(constructorkind:String,_
                  abbreviation:String,_
                  dom:String):String ==
      sourcekey:="@<<" constructorkind " " abbreviation " " dom ">>"
---     WriteLine(sourcekey)$Lisp
+     -- WriteLine(sourcekey)$Lisp
      sourcefile:=lowerCase last split(getDatabase(dom,"SOURCEFILE"),char "/") 
      sourcefile:=sourcefile ".pamphlet"
 
 \end{chunk}
 \subsubsection{makeDBPage}
 \begin{chunk}{package AXSERV AxiomServer}
+
    makeDBPage(pathvar:String):String ==
      params:List(String):=split(pathvar,char "?")
      for i in 1..#params repeat WriteLine$Lisp concat ["params: ",params.i]
@@ -5770,22 +8083,24 @@ and do a lookup for the source file.
       page:=page "</td>"
       page:=page "</tr>"
       page:=page "</table>"
---     WriteLine(page)$Lisp
+     -- WriteLine(page)$Lisp
      page:=page "</body></html>"
      page
+
 \end{chunk}
 \subsubsection{readTheFile}
 We have q which is a stream which contains the file. We read the file
 into a string-stream to get it all into one string. We return the string.
 \begin{chunk}{package AXSERV AxiomServer}
+
    readTheFile(q:SExpression):String ==
---     WriteLine("begin reading file")$Lisp
+     -- WriteLine("begin reading file")$Lisp
      r := MAKE_-STRING_-OUTPUT_-STREAM()$Lisp
      SiCopyStream(q,r)$Lisp
      filestream:String := GET_-OUTPUT_-STREAM_-STRING(r)$Lisp
      CLOSE(r)$Lisp
      CLOSE(q)$Lisp
---     WriteLine("end reading file")$Lisp
+     -- WriteLine("end reading file")$Lisp
      filestream
 
 \end{chunk}
@@ -5795,6 +8110,7 @@ the file to output, and ``contentType'' which is the HTML Content-Type.
 We construct the HTML header information according to the standard and
 prepend it to the file. The resulting string is output to the socket.
 \begin{chunk}{package AXSERV AxiomServer}
+
    outputToSocket(s:SExpression,filestream:String,contentType:String):Void ==
      filelength:String := string(#filestream)
      file:String := ""
@@ -5804,7 +8120,7 @@ prepend it to the file. The resulting string is output to the socket.
      file := concat ["Content-Type: ",contentType,nl,file]
      file := concat ["HTTP/1.1 200 OK",nl,file]
      file := concat [file,filestream]
---     WriteLine(file)$Lisp
+     -- WriteLine(file)$Lisp
      f:=MAKE_-STRING_-INPUT_-STREAM(file)$Lisp
      SiCopyStream(f,s)$Lisp
      CLOSE(f)$Lisp
@@ -5828,6 +8144,7 @@ The HTML functions in the hyperdoc browser depend on the order
 of these variables so do not change this without changing the
 corresponding functions in the browser HTML.
 \begin{chunk}{package AXSERV AxiomServer}
+
    getCommand(s:SExpression,command:String):Void ==
        WriteLine$Lisp concat ["getCommand: ",command]
        SETQ(tmpmathml$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
@@ -5862,8 +8179,8 @@ corresponding functions in the browser HTML.
                   <div class=_"algebra_">",algebra,"</div>_
                   <div class=_"mathml_">",mathml,"</div>_
                   <div class=_"type_">",lastType(),"</div>"]       
---       WriteLine$Lisp concat ["mathml answer: ",mathml]
---       WriteLine$Lisp concat ["algebra answer: ",algebra]
+       -- WriteLine$Lisp concat ["mathml answer: ",mathml]
+       -- WriteLine$Lisp concat ["algebra answer: ",algebra]
        q:=MAKE_-STRING_-INPUT_-STREAM(axans)$Lisp
        SiCopyStream(q,s)$Lisp
        CLOSE(q)$Lisp
@@ -5888,6 +8205,7 @@ The HTML functions in the hyperdoc browser depend on the order
 of these variables so do not change this without changing the
 corresponding functions in the browser HTML.
 \begin{chunk}{package AXSERV AxiomServer}
+
    getInterp(s:SExpression,command:String):Void ==
        WriteLine$Lisp concat ["getInterp: ",command]
        SETQ(tmpmathml$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
@@ -5922,8 +8240,8 @@ corresponding functions in the browser HTML.
                   <div class=_"algebra_">",algebra,"</div>_
                   <div class=_"mathml_">",mathml,"</div>_
                   <div class=_"type_">",lastType(),"</div>"]       
---       WriteLine$Lisp concat ["mathml answer: ",mathml]
---       WriteLine$Lisp concat ["algebra answer: ",algebra]
+       -- WriteLine$Lisp concat ["mathml answer: ",mathml]
+       -- WriteLine$Lisp concat ["algebra answer: ",algebra]
        q:=MAKE_-STRING_-INPUT_-STREAM(axans)$Lisp
        SiCopyStream(q,s)$Lisp
        CLOSE(q)$Lisp
@@ -5935,12 +8253,13 @@ corresponding functions in the browser HTML.
 The getLisp function is invoked when the HTTP request is a POST
 and contains the string "lispcall".
 \begin{chunk}{package AXSERV AxiomServer}
+
    getLisp(s:SExpression,command:String):Void ==
        WriteLine$Lisp concat ["getLisp: ",command]
        evalresult:=EVAL(READ_-FROM_-STRING(command)$Lisp)$Lisp
        mathml:String:=string(evalresult)
---       WriteLine$Lisp concat ["getLisp: after ",mathml]
---       WriteLine$Lisp concat ["getLisp output: ",mathml]
+       -- WriteLine$Lisp concat ["getLisp: after ",mathml]
+       -- WriteLine$Lisp concat ["getLisp output: ",mathml]
        SETQ(tmpalgebra$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
        SETQ(savemathml$Lisp, _$texOutputStream$Lisp)$Lisp
        SETQ(savealgebra$Lisp, _$algebraOutputStream$Lisp)$Lisp
@@ -5967,8 +8286,8 @@ and contains the string "lispcall".
                  <div class=_"algebra_">",algebra,"</div>_
                  <div class=_"mathml_">",mathml,"</div>_
                  <div class=_"type_">",lastType(),"</div>"]       
---       WriteLine$Lisp concat ["mathml answer: ",mathml]
---       WriteLine$Lisp concat ["algebra answer: ",algebra]
+       -- WriteLine$Lisp concat ["mathml answer: ",mathml]
+       -- WriteLine$Lisp concat ["algebra answer: ",algebra]
        q:=MAKE_-STRING_-INPUT_-STREAM(axans)$Lisp
        SiCopyStream(q,s)$Lisp
        CLOSE(q)$Lisp
@@ -5982,12 +8301,13 @@ output to lisp's *standard-output* so we wrap that stream to capture it.
 The resulting string needs to be transformed into html-friendly form.
 This is done in the call to replace-entitites (see http.lisp)
 \begin{chunk}{package AXSERV AxiomServer}
+
    getShow(s:SExpression,showarg:String):Void ==
        WriteLine$Lisp concat ["getShow: ",showarg]
        realarg:=SUBSEQ(showarg,6)$Lisp
        show:=_
         "(progn (setq |$options| '((|operations|))) (|show| '|" realarg "|))"
---       WriteLine$Lisp concat ["getShow: ",show]
+       -- WriteLine$Lisp concat ["getShow: ",show]
        SETQ(SAVESTREAM$Lisp,_*STANDARD_-OUTPUT_*$Lisp)$Lisp
        SETQ(_*STANDARD_-OUTPUT_*$Lisp,_
              MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
@@ -6022,7 +8342,7 @@ This is done in the call to replace-entitites (see http.lisp)
                  <div class=_"algebra_">",algebra,"</div>_
                  <div class=_"mathml_">",mathml,"</div>_
                  <div class=_"type_">",lastType(),"</div>"]       
---       WriteLine$Lisp concat ["mathml answer: ",mathml]
+       -- WriteLine$Lisp concat ["mathml answer: ",mathml]
        q:=MAKE_-STRING_-INPUT_-STREAM(axans)$Lisp
        SiCopyStream(q,s)$Lisp
        CLOSE(q)$Lisp
@@ -6056,6 +8376,7 @@ We also need to check for input error in which case the \$internalHistoryTable
 is not changed and the type retrieved would be that for the last correct
 input.
 \begin{chunk}{package AXSERV AxiomServer}
+
    lastType():String ==
      SETQ(first$Lisp,FIRST(_$internalHistoryTable$Lisp)$Lisp)$Lisp
      count:Integer := 0
@@ -6079,16 +8400,15 @@ input.
          string SECOND(SECOND(FIRST(first$Lisp)$Lisp)$Lisp)$Lisp
      ""
 
-
    lastStep():String ==
        string car(car(_$internalHistoryTable$Lisp)$Lisp)$Lisp
 
    formatMessages(str:String):String ==
---       WriteLine("formatMessages")$Lisp
+       -- WriteLine("formatMessages")$Lisp
        -- I need to replace any ampersands with &amp; and may also need to
        -- replace < and > with &lt; and &gt;
        strlist:List String
---       WriteLine(str)$Lisp
+       -- WriteLine(str)$Lisp
        strlist := split(str,char "&")
        str := ""
        -- oops, if & is the last character in the string this method
@@ -6097,19 +8417,19 @@ input.
            str := concat [str,s,"&amp;"]
        strlen:Integer := #str
        str := str.(1..(#str - 5))
---       WriteLine(str)$Lisp
+       -- WriteLine(str)$Lisp
        -- Here I split the string into lines and put each line in a "div".
        strlist := split(str, char string NewlineChar$Lisp)
        str := ""
---       WriteLine("formatMessages1")$Lisp
---       WriteLine(concat strlist)$Lisp
+         -- WriteLine("formatMessages1")$Lisp
+         -- WriteLine(concat strlist)$Lisp
        for s in strlist repeat
---           WriteLine(s)$Lisp
+           -- WriteLine(s)$Lisp
            str := concat [str,"<div>",s,"</div>"]
        str
 
    getContentType(pathvar:String):String ==
---       WriteLine("getContentType begin")$Lisp
+       -- WriteLine("getContentType begin")$Lisp
        -- set default content type
        contentType:String := "text/plain"
        -- need to test for successful match?
@@ -6118,7 +8438,7 @@ input.
        u := segment(MatchBeginning(1)$Lisp+1,_
                     MatchEnd(1)$Lisp)$UniversalSegment(Integer)
        extension:String := pathvar.u
---       WriteLine$Lisp concat ["file extension: ",extension]
+       -- WriteLine$Lisp concat ["file extension: ",extension]
        -- test for extensions: html, htm, xml, xhtml, js, css
        if extension = "html" then
            contentType:String := "text/html"
@@ -6138,8 +8458,8 @@ input.
            contentType:String := "image/jpeg"
        else if extension = "jpeg" then
            contentType:String := "image/jpeg"
---       WriteLine$Lisp concat ["Content-Type: ",contentType]
---       WriteLine("getContentType end")$Lisp
+       -- WriteLine$Lisp concat ["Content-Type: ",contentType]
+       -- WriteLine("getContentType end")$Lisp
        contentType
 
 \end{chunk}
@@ -6147,6 +8467,540 @@ input.
 \begin{chunk}{COQ AXSERV}
 (* package AXSERV *)
 (*
+
+   getFile: (SExpression,String) -> Void
+   getCommand: (SExpression,String) -> Void
+   getDescription: String -> String
+   getInterp: (SExpression,String) -> Void
+   getLisp:   (SExpression,String) -> Void
+   getShow:   (SExpression,String) -> Void
+   lastStep: () -> String
+   lastType: () -> String
+   formatMessages: String -> String
+   makeErrorPage: String -> String
+   getSourceFile: (String,String,String) -> String
+   makeDBPage: String -> String
+   getContentType: String -> String
+   readTheFile: SExpression -> String 
+   outputToSocket: (SExpression,String,String) -> Void 
+
+   getDatabase(constructor:String, key:String):String ==
+     answer:=string GETDATABASE(INTERN$Lisp constructor,INTERN$Lisp key)$Lisp
+     -- WriteLine$Lisp concat ["getDatabase: ",constructor," ",key," ",answer]
+     answer
+
+   axServer(port:Integer,serverfunc:SExpression->Void):Void ==
+     WriteLine$Lisp "listening on port 8085"
+     s := SiSock(port,serverfunc)$Lisp
+     -- To listen for just one connection and then close the socket
+     -- uncomment i := 0.
+     i:Integer := 1
+     while (i > 0) repeat
+       if not null?(SiListen(s)$Lisp)$SExpression then
+         w := SiAccept(s)$Lisp
+         serverfunc(w)
+
+   multiServ(s:SExpression):Void ==
+     -- WriteLine("multiServ begin")$Lisp
+     headers:String := ""
+     char:String
+     -- read in the http headers
+     while (char := _
+       STRING(READ_-CHAR_-NO_-HANG(s,NIL$Lisp,'EOF)$Lisp)$Lisp) ^= "EOF"_
+        repeat
+         headers := concat [headers,char]
+     -- sayTeX$Lisp headers
+     StringMatch("([^ ]*)", headers)$Lisp
+     u:UniversalSegment(Integer)
+     u := segment(MatchBeginning(1)$Lisp+1,_
+                  MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+     reqtype:String := headers.u
+     -- sayTeX$Lisp  concat ["request type: ",reqtype]
+     if  reqtype = "GET" then
+         StringMatch("GET ([^ ]*)",headers)$Lisp
+         u:UniversalSegment(Integer)
+         u := segment(MatchBeginning(1)$Lisp+1,_
+                      MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+         getFile(s,headers.u)
+     if reqtype = "POST" and StringMatch("command=(.*)$",headers)$Lisp > 0
+      then
+         u:UniversalSegment(Integer)
+         u := segment(MatchBeginning(1)$Lisp+1,_
+                      MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+         getCommand(s,headers.u)
+     if reqtype = "POST" and StringMatch("interpcall=(.*)$",headers)$Lisp > 0
+      then
+         u:UniversalSegment(Integer)
+         u := segment(MatchBeginning(1)$Lisp+1,_
+                      MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+         getInterp(s,headers.u)
+     if reqtype = "POST" and StringMatch("lispcall=(.*)$",headers)$Lisp > 0
+      then
+         u:UniversalSegment(Integer)
+         u := segment(MatchBeginning(1)$Lisp+1,_
+                      MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+         getLisp(s,headers.u)
+     if reqtype = "POST" and StringMatch("showcall=(.*)$",headers)$Lisp > 0
+      then
+         u:UniversalSegment(Integer)
+         u := segment(MatchBeginning(1)$Lisp+1,_
+                      MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+         getShow(s,headers.u)
+       -- WriteLine("multiServ end")$Lisp
+       -- WriteLine("")$Lisp
+
+   getFile(s:SExpression,pathvar:String):Void ==
+     -- WriteLine("")$Lisp
+     WriteLine$Lisp concat ["getFile: ",pathvar]
+     params:=split(pathvar,char "?")
+     if #params = 1 
+      then if not null? PATHNAME_-NAME(PATHNAME(pathvar)$Lisp)$Lisp 
+       then
+         contentType:String := getContentType(pathvar)
+         q:=Open(pathvar)$Lisp
+         if null? q 
+           then
+             q := MAKE_-STRING_-INPUT_-STREAM(_
+                   makeErrorPage("File doesn't exist"))$Lisp
+       else
+         q:=MAKE_-STRING_-INPUT_-STREAM(_
+             makeErrorPage("Problem with file path"))$Lisp
+      else
+       q:=MAKE_-STRING_-INPUT_-STREAM(makeDBPage(pathvar))$Lisp
+     outputToSocket(s,readTheFile(q),contentType)     
+
+   makeErrorPage(msg:String):String ==
+     page:String:="<!DOCTYPE html PUBLIC "
+     page:=page "_"-//W3C//DTD XHTML 1.0 Strict//EN_" "
+     page:=page "_"http://www.w3.org/TR/xthml1/DTD/xhtml1-strict.dtd_">"
+     page:=page "<html xmlns=_"http://www.w3.org/1999/xhtml_">"
+     page:=page "<head><title>Error</title></head><body>" msg "</body></html>"
+     -- WriteLine(page)$Lisp
+     page
+
+   getDescription(dom:String):String ==
+    d:=CADR(CADAR(GETDATABASE(INTERN(dom)$Lisp,'DOCUMENTATION)$Lisp)$Lisp)$Lisp
+    string d
+
+   getSourceFile(constructorkind:String,_
+                 abbreviation:String,_
+                 dom:String):String ==
+     sourcekey:="@<<" constructorkind " " abbreviation " " dom ">>"
+     -- WriteLine(sourcekey)$Lisp
+     sourcefile:=lowerCase last split(getDatabase(dom,"SOURCEFILE"),char "/") 
+     sourcefile:=sourcefile ".pamphlet"
+
+   makeDBPage(pathvar:String):String ==
+     params:List(String):=split(pathvar,char "?")
+     for i in 1..#params repeat WriteLine$Lisp concat ["params: ",params.i]
+     pathparts:List(String):=split(params.1,char "/")
+     for i in 1..#pathparts repeat 
+       WriteLine$Lisp concat ["pathparts: ",pathparts.i]
+     pagename:=last pathparts
+     WriteLine$Lisp concat ["pagename: ",pagename]
+     cmd:=first split(pagename,char ".")
+     WriteLine$Lisp concat ["cmd: ",cmd]
+     args:List(String):=split(params.2, char "&")
+     for i in 1..#args repeat WriteLine$Lisp concat ["args: ",args.i]
+     page:String:="<!DOCTYPE html PUBLIC "
+     page:=page "_"-//W3C//DTD XHTML 1.0 Strict//EN_" "
+     page:=page "_"http://www.w3.org/TR/xthml1/DTD/xhtml1-strict.dtd_">"
+     page:=page "<html xmlns=_"http://www.w3.org/1999/xhtml_">"
+     page:=page "<head>"
+     page:=page "<meta http-equiv=_"Content-Type_" content=_"text/html_"" 
+     page:=page " charset=_"us-ascii_"/>"
+     page:=page "<title>" cmd " " args.1 "</title></head>"
+     page:=page "<style> html { background-color: #ECEA81; } </style>"
+     page:=page "<body>"
+     cmd = "db" =>
+      dom:=args.1
+      domi:=INTERN(dom)$Lisp
+      -- category, domain, or package?
+      constructorkind:=getDatabase(dom,"CONSTRUCTORKIND")
+      abbreviation:=getDatabase(dom, "ABBREVIATION")
+      sourcefile:=getDatabase(dom, "SOURCEFILE")
+      constructorkind.1:=upperCase constructorkind.1
+      description:=getDescription(dom)
+      page:=page "<div align=_"center_">"
+      page:=page "<img align=_"middle_" src=_"doctitle.png_"/></div><hr/>"
+      page:=page "<div align=_"center_">" constructorkind " " dom "</div><hr/>"
+      page:=page "<table>"
+      page:=page "<tr><td valign=_"top_">Description:  </td>"
+      page:=page "<td>" description  "</td></tr>"
+      page:=page "<tr><td>Abbreviation: </td><td>" abbreviation "</td></tr>"
+      page:=page "<tr><td>Source File:  </td><td>" sourcefile   "</td></tr>"
+      page:=page "</table><hr/>"
+      page:=page "<table>"
+      page:=page "<tr>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Ancestors_">Ancestors</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Dependents_">Dependents</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Exports_">Exports</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Parents_">Parents</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Users_">Users</a>"
+      page:=page "</td>"
+      page:=page "</tr>"
+      page:=page "<tr>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Attributes_">Attributes</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Examples_">Examples</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Operations_">Operations</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=SearchPath_">Search Path</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Uses_">Uses</a>"
+      page:=page "</td>"
+      page:=page "</tr>"
+      page:=page "</table>"
+     cmd = "op" =>
+      dom:=args.1
+      domi:=INTERN(dom)$Lisp
+      -- category, domain, or package?
+      constructorkind:=getDatabase(dom,"CONSTRUCTORKIND")
+      abbreviation:=getDatabase(dom, "ABBREVIATION")
+      sourcefile:=getDatabase(dom, "SOURCEFILE")
+      constructorkind.1:=upperCase constructorkind.1
+      description:=getDescription(dom)
+      page:=page "<div align=_"center_">"
+      page:=page "<img align=_"middle_" src=_"doctitle.png_"/></div><hr/>"
+      page:=page "<div align=_"center_">" constructorkind " " dom "</div><hr/>"
+      page:=page "<table>"
+      page:=page "<tr><td valign=_"top_">Description:  </td>"
+      page:=page "<td>" description  "</td></tr>"
+      page:=page "<tr><td>Abbreviation: </td><td>" abbreviation "</td></tr>"
+      page:=page "<tr><td>Source File:  </td><td>" sourcefile   "</td></tr>"
+      page:=page "</table><hr/>"
+      page:=page "<table>"
+      page:=page "<tr>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Ancestors_">Ancestors</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Dependents_">Dependents</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Exports_">Exports</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Parents_">Parents</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Users_">Users</a>"
+      page:=page "</td>"
+      page:=page "</tr>"
+      page:=page "<tr>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Attributes_">Attributes</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Examples_">Examples</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Operations_">Operations</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=SearchPath_">Search Path</a>"
+      page:=page "</td>"
+      page:=page "<td>"
+      page:=page "<a href=_"?" dom "&lookup=Uses_">Uses</a>"
+      page:=page "</td>"
+      page:=page "</tr>"
+      page:=page "</table>"
+     -- WriteLine(page)$Lisp
+     page:=page "</body></html>"
+     page
+
+   readTheFile(q:SExpression):String ==
+     -- WriteLine("begin reading file")$Lisp
+     r := MAKE_-STRING_-OUTPUT_-STREAM()$Lisp
+     SiCopyStream(q,r)$Lisp
+     filestream:String := GET_-OUTPUT_-STREAM_-STRING(r)$Lisp
+     CLOSE(r)$Lisp
+     CLOSE(q)$Lisp
+     -- WriteLine("end reading file")$Lisp
+     filestream
+
+   outputToSocket(s:SExpression,filestream:String,contentType:String):Void ==
+     filelength:String := string(#filestream)
+     file:String := ""
+     nl:String:=STRING(NewLine$Lisp)$Lisp
+     file := concat ["Content-Length: ",filelength,nl,nl,file]
+     file := concat ["Connection: close",nl,file]
+     file := concat ["Content-Type: ",contentType,nl,file]
+     file := concat ["HTTP/1.1 200 OK",nl,file]
+     file := concat [file,filestream]
+     -- WriteLine(file)$Lisp
+     f:=MAKE_-STRING_-INPUT_-STREAM(file)$Lisp
+     SiCopyStream(f,s)$Lisp
+     CLOSE(f)$Lisp
+     CLOSE(s)$Lisp
+
+   getCommand(s:SExpression,command:String):Void ==
+       WriteLine$Lisp concat ["getCommand: ",command]
+       SETQ(tmpmathml$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
+       SETQ(tmpalgebra$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
+       SETQ(savemathml$Lisp, _$texOutputStream$Lisp)$Lisp
+       SETQ(savealgebra$Lisp, _$algebraOutputStream$Lisp)$Lisp
+       SETQ(_$texOutputStream$Lisp,tmpmathml$Lisp)$Lisp
+       SETQ(_$algebraOutputStream$Lisp,tmpalgebra$Lisp)$Lisp
+       ans := string parseAndEvalToStringEqNum$Lisp command
+       SETQ(resultmathml$Lisp,_
+            GET_-OUTPUT_-STREAM_-STRING(_$texOutputStream$Lisp)$Lisp)$Lisp
+       SETQ(resultalgebra$Lisp,_
+            GET_-OUTPUT_-STREAM_-STRING(_$algebraOutputStream$Lisp)$Lisp)$Lisp
+       SETQ(_$texOutputStream$Lisp,savemathml$Lisp)$Lisp
+       SETQ(_$algebraOutputStream$Lisp,savealgebra$Lisp)$Lisp
+       CLOSE(tmpmathml$Lisp)$Lisp
+       CLOSE(tmpalgebra$Lisp)$Lisp
+       -- Since strings returned from axiom are going to be displayed in html I
+       -- should really check for the characters &,<,> and replace them with
+       -- &amp;,&lt;,&gt;.  
+       -- At present I only check for ampersands in formatMessages.
+       mathml:String := string(resultmathml$Lisp)
+       algebra:String := string(resultalgebra$Lisp)
+       algebra := formatMessages(algebra)
+       -- At this point mathml contains the mathml for the output but does not
+       -- include step number or type information.  
+       -- We should also save the command.
+       -- I get the type and step number from the $internalHistoryTable
+       axans:String := _
+         concat ["<div class=_"stepnum_">", lastStep(), "</div>_
+                  <div class=_"command_">", command, "</div>_
+                  <div class=_"algebra_">",algebra,"</div>_
+                  <div class=_"mathml_">",mathml,"</div>_
+                  <div class=_"type_">",lastType(),"</div>"]       
+       -- WriteLine$Lisp concat ["mathml answer: ",mathml]
+       -- WriteLine$Lisp concat ["algebra answer: ",algebra]
+       q:=MAKE_-STRING_-INPUT_-STREAM(axans)$Lisp
+       SiCopyStream(q,s)$Lisp
+       CLOSE(q)$Lisp
+       CLOSE(s)$Lisp
+
+   getInterp(s:SExpression,command:String):Void ==
+       WriteLine$Lisp concat ["getInterp: ",command]
+       SETQ(tmpmathml$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
+       SETQ(tmpalgebra$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
+       SETQ(savemathml$Lisp, _$texOutputStream$Lisp)$Lisp
+       SETQ(savealgebra$Lisp, _$algebraOutputStream$Lisp)$Lisp
+       SETQ(_$texOutputStream$Lisp,tmpmathml$Lisp)$Lisp
+       SETQ(_$algebraOutputStream$Lisp,tmpalgebra$Lisp)$Lisp
+       ans := string parseAndEvalToStringEqNum$Lisp command
+       SETQ(resultmathml$Lisp,_
+            GET_-OUTPUT_-STREAM_-STRING(_$texOutputStream$Lisp)$Lisp)$Lisp
+       SETQ(resultalgebra$Lisp,_
+            GET_-OUTPUT_-STREAM_-STRING(_$algebraOutputStream$Lisp)$Lisp)$Lisp
+       SETQ(_$texOutputStream$Lisp,savemathml$Lisp)$Lisp
+       SETQ(_$algebraOutputStream$Lisp,savealgebra$Lisp)$Lisp
+       CLOSE(tmpmathml$Lisp)$Lisp
+       CLOSE(tmpalgebra$Lisp)$Lisp
+       -- Since strings returned from axiom are going to be displayed in html I
+       -- should really check for the characters &,<,> and replace them with
+       -- &amp;,&lt;,&gt;.  
+       -- At present I only check for ampersands in formatMessages.
+       mathml:String := string(resultmathml$Lisp)
+       algebra:String := string(resultalgebra$Lisp)
+       algebra := formatMessages(algebra)
+       -- At this point mathml contains the mathml for the output but does not
+       -- include step number or type information.  
+       -- We should also save the command.
+       -- I get the type and step number from the $internalHistoryTable
+       axans:String := _
+         concat ["<div class=_"stepnum_">", lastStep(), "</div>_
+                  <div class=_"command_">", command, "</div>_
+                  <div class=_"algebra_">",algebra,"</div>_
+                  <div class=_"mathml_">",mathml,"</div>_
+                  <div class=_"type_">",lastType(),"</div>"]       
+       -- WriteLine$Lisp concat ["mathml answer: ",mathml]
+       -- WriteLine$Lisp concat ["algebra answer: ",algebra]
+       q:=MAKE_-STRING_-INPUT_-STREAM(axans)$Lisp
+       SiCopyStream(q,s)$Lisp
+       CLOSE(q)$Lisp
+       CLOSE(s)$Lisp
+
+   getLisp(s:SExpression,command:String):Void ==
+       WriteLine$Lisp concat ["getLisp: ",command]
+       evalresult:=EVAL(READ_-FROM_-STRING(command)$Lisp)$Lisp
+       mathml:String:=string(evalresult)
+       -- WriteLine$Lisp concat ["getLisp: after ",mathml]
+       -- WriteLine$Lisp concat ["getLisp output: ",mathml]
+       SETQ(tmpalgebra$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
+       SETQ(savemathml$Lisp, _$texOutputStream$Lisp)$Lisp
+       SETQ(savealgebra$Lisp, _$algebraOutputStream$Lisp)$Lisp
+       SETQ(_$texOutputStream$Lisp,tmpmathml$Lisp)$Lisp
+       SETQ(_$algebraOutputStream$Lisp,tmpalgebra$Lisp)$Lisp
+       SETQ(resultalgebra$Lisp,_
+            GET_-OUTPUT_-STREAM_-STRING(_$algebraOutputStream$Lisp)$Lisp)$Lisp
+       SETQ(_$texOutputStream$Lisp,savemathml$Lisp)$Lisp
+       SETQ(_$algebraOutputStream$Lisp,savealgebra$Lisp)$Lisp
+       CLOSE(tmpalgebra$Lisp)$Lisp
+       -- Since strings returned from axiom are going to be displayed in html I
+       -- should really check for the characters &,<,> and replace them with
+       -- &amp;,&lt;,&gt;.  
+       -- At present I only check for ampersands in formatMessages.
+       algebra:String := string(resultalgebra$Lisp)
+       algebra := formatMessages(algebra)
+       -- At this point mathml contains the mathml for the output but does not
+       -- include step number or type information.  
+       -- We should also save the command.
+       -- I get the type and step number from the $internalHistoryTable
+       axans:String := _
+        concat ["<div class=_"stepnum_">", lastStep(), "</div>_
+                 <div class=_"command_">", command, "</div>_
+                 <div class=_"algebra_">",algebra,"</div>_
+                 <div class=_"mathml_">",mathml,"</div>_
+                 <div class=_"type_">",lastType(),"</div>"]       
+       -- WriteLine$Lisp concat ["mathml answer: ",mathml]
+       -- WriteLine$Lisp concat ["algebra answer: ",algebra]
+       q:=MAKE_-STRING_-INPUT_-STREAM(axans)$Lisp
+       SiCopyStream(q,s)$Lisp
+       CLOSE(q)$Lisp
+       CLOSE(s)$Lisp
+
+   getShow(s:SExpression,showarg:String):Void ==
+       WriteLine$Lisp concat ["getShow: ",showarg]
+       realarg:=SUBSEQ(showarg,6)$Lisp
+       show:=_
+        "(progn (setq |$options| '((|operations|))) (|show| '|" realarg "|))"
+       -- WriteLine$Lisp concat ["getShow: ",show]
+       SETQ(SAVESTREAM$Lisp,_*STANDARD_-OUTPUT_*$Lisp)$Lisp
+       SETQ(_*STANDARD_-OUTPUT_*$Lisp,_
+             MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
+       evalresult:=EVAL(READ_-FROM_-STRING(show)$Lisp)$Lisp
+       SETQ(evalresult,_
+             GET_-OUTPUT_-STREAM_-STRING(_*STANDARD_-OUTPUT_*$Lisp)$Lisp)$Lisp
+       SETQ(_*STANDARD_-OUTPUT_*$Lisp,SAVESTREAM$Lisp)$Lisp
+       mathml:String:=string(REPLACE_-ENTITIES(evalresult)$Lisp)
+       SETQ(tmpalgebra$Lisp, MAKE_-STRING_-OUTPUT_-STREAM()$Lisp)$Lisp
+       SETQ(savemathml$Lisp, _$texOutputStream$Lisp)$Lisp
+       SETQ(savealgebra$Lisp, _$algebraOutputStream$Lisp)$Lisp
+       SETQ(_$texOutputStream$Lisp,tmpmathml$Lisp)$Lisp
+       SETQ(_$algebraOutputStream$Lisp,tmpalgebra$Lisp)$Lisp
+       SETQ(resultalgebra$Lisp,_
+            GET_-OUTPUT_-STREAM_-STRING(_$algebraOutputStream$Lisp)$Lisp)$Lisp
+       SETQ(_$texOutputStream$Lisp,savemathml$Lisp)$Lisp
+       SETQ(_$algebraOutputStream$Lisp,savealgebra$Lisp)$Lisp
+       CLOSE(tmpalgebra$Lisp)$Lisp
+       -- Since strings returned from axiom are going to be displayed in html I
+       -- should really check for the characters &,<,> and replace them with
+       -- &amp;,&lt;,&gt;.  
+       -- At present I only check for ampersands in formatMessages.
+       algebra:String := string(resultalgebra$Lisp)
+       algebra := formatMessages(algebra)
+       -- At this point mathml contains the mathml for the output but does not
+       -- include step number or type information.  
+       -- We should also save the command.
+       -- I get the type and step number from the $internalHistoryTable
+       axans:String := _
+        concat ["<div class=_"stepnum_">", lastStep(), "</div>_
+                 <div class=_"command_">", showarg, "</div>_
+                 <div class=_"algebra_">",algebra,"</div>_
+                 <div class=_"mathml_">",mathml,"</div>_
+                 <div class=_"type_">",lastType(),"</div>"]       
+       -- WriteLine$Lisp concat ["mathml answer: ",mathml]
+       q:=MAKE_-STRING_-INPUT_-STREAM(axans)$Lisp
+       SiCopyStream(q,s)$Lisp
+       CLOSE(q)$Lisp
+       CLOSE(s)$Lisp
+
+   lastType():String ==
+     SETQ(first$Lisp,FIRST(_$internalHistoryTable$Lisp)$Lisp)$Lisp
+     count:Integer := 0
+     hisLength:Integer := LIST_-LENGTH(_$internalHistoryTable$Lisp)$Lisp
+     length:Integer := LIST_-LENGTH(first$Lisp)$Lisp
+     -- This initializes stepSav.  The test is a bit of a hack, maybe I'll
+     -- figure out the right way to do it later.
+     if string stepSav$Lisp = "#<OBJNULL>" then SETQ(stepSav$Lisp, 0$Lisp)$Lisp
+     -- If hisLength = 0 then the history table has been reset to NIL
+     -- and we're starting numbering over
+     if hisLength = 0 then SETQ(stepSav$Lisp, 0$Lisp)$Lisp
+     if hisLength > 0 and 
+       car(car(_$internalHistoryTable$Lisp)$Lisp)$Lisp ^= stepSav$Lisp then
+        SETQ(stepSav$Lisp,car(car(_$internalHistoryTable$Lisp)$Lisp)$Lisp)$Lisp
+        while count < length  repeat
+         position(char "%",string FIRST(first$Lisp)$Lisp) = 2 => 
+           count := length+1
+         count := count +1
+         SETQ(first$Lisp,REST(first$Lisp)$Lisp)$Lisp
+     count = length + 1 => 
+         string SECOND(SECOND(FIRST(first$Lisp)$Lisp)$Lisp)$Lisp
+     ""
+
+   lastStep():String ==
+       string car(car(_$internalHistoryTable$Lisp)$Lisp)$Lisp
+
+   formatMessages(str:String):String ==
+       -- WriteLine("formatMessages")$Lisp
+       -- I need to replace any ampersands with &amp; and may also need to
+       -- replace < and > with &lt; and &gt;
+       strlist:List String
+       -- WriteLine(str)$Lisp
+       strlist := split(str,char "&")
+       str := ""
+       -- oops, if & is the last character in the string this method
+       -- will eliminate it.  Need to redo this.
+       for s in strlist repeat
+           str := concat [str,s,"&amp;"]
+       strlen:Integer := #str
+       str := str.(1..(#str - 5))
+       -- WriteLine(str)$Lisp
+       -- Here I split the string into lines and put each line in a "div".
+       strlist := split(str, char string NewlineChar$Lisp)
+       str := ""
+         -- WriteLine("formatMessages1")$Lisp
+         -- WriteLine(concat strlist)$Lisp
+       for s in strlist repeat
+           -- WriteLine(s)$Lisp
+           str := concat [str,"<div>",s,"</div>"]
+       str
+
+   getContentType(pathvar:String):String ==
+       -- WriteLine("getContentType begin")$Lisp
+       -- set default content type
+       contentType:String := "text/plain"
+       -- need to test for successful match?
+       StringMatch(".*\.(.*)$", pathvar)$Lisp
+       u:UniversalSegment(Integer)
+       u := segment(MatchBeginning(1)$Lisp+1,_
+                    MatchEnd(1)$Lisp)$UniversalSegment(Integer)
+       extension:String := pathvar.u
+       -- WriteLine$Lisp concat ["file extension: ",extension]
+       -- test for extensions: html, htm, xml, xhtml, js, css
+       if extension = "html" then
+           contentType:String := "text/html"
+       else if extension = "htm" then
+           contentType:String := "text/html"
+       else if extension = "xml" then
+           contentType:String := "text/xml"
+       else if extension = "xhtml" then
+           contentType:String := "application/xhtml+xml"
+       else if extension = "js" then
+           contentType:String := "text/javascript"
+       else if extension = "css" then
+           contentType:String := "text/css"
+       else if extension = "png" then
+           contentType:String := "image/png"
+       else if extension = "jpg" then
+           contentType:String := "image/jpeg"
+       else if extension = "jpeg" then
+           contentType:String := "image/jpeg"
+       -- WriteLine$Lisp concat ["Content-Type: ",contentType]
+       -- WriteLine("getContentType end")$Lisp
+       contentType
+
 *)
 
 \end{chunk}
@@ -6226,6 +9080,7 @@ BalancedFactorisation(R, UP): Exports == Implementation where
       ++ pi is balanced with respect to \spad{[b1,...,bm]}.
 
   Implementation ==> add
+
     balSqfr : (UP, Integer, List UP) -> Factored UP
     balSqfr1: (UP, Integer,      UP) -> Factored UP
 
@@ -6253,6 +9108,29 @@ BalancedFactorisation(R, UP): Exports == Implementation where
 \begin{chunk}{COQ BALFACT}
 (* package BALFACT *)
 (*
+
+    balSqfr : (UP, Integer, List UP) -> Factored UP
+    balSqfr1: (UP, Integer,      UP) -> Factored UP
+
+    balancedFactorisation(a:UP, b:UP) == balancedFactorisation(a, [b])
+
+    balSqfr1(a, n, b) ==
+      g := gcd(a, b)
+      fa := sqfrFactor((a exquo g)::UP, n)
+      ground? g => fa
+      fa * balSqfr1(g, n, (b exquo (g ** order(b, g)))::UP)
+
+    balSqfr(a, n, l) ==
+      b := first l
+      empty? rest l => balSqfr1(a, n, b)
+      */[balSqfr1(f.factor, n, b) for f in factors balSqfr(a,n,rest l)]
+
+    balancedFactorisation(a:UP, l:List UP) ==
+      empty?(ll := select(z1 +-> z1 ^= 0, l)) =>
+        error "balancedFactorisation: 2nd argument is empty or all 0"
+      sa := squareFree a
+      unit(sa) * */[balSqfr(f.factor,f.exponent,ll) for f in factors sa])
+
 *)
 
 \end{chunk}
@@ -6376,6 +9254,7 @@ BasicOperatorFunctions1(A:SetCategory): Exports == Implementation where
         ++ nullary operator always returning \spad{a}, "failed" otherwise.
 
   Implementation ==> add
+
     evaluate(op:OP, func:A -> A) == 
        evaluate(op, (ll:List(A)):A +-> func first ll)
 
@@ -6403,6 +9282,7 @@ BasicOperatorFunctions1(A:SetCategory): Exports == Implementation where
       error "Operator is not unary"
 
     if A has OrderedSet then
+
       cdisp   : (OUT, List OUT) -> OUT
       csex    : (IN,  List IN) -> IN
       eqconst?: (OP, OP) -> Boolean
@@ -6414,6 +9294,7 @@ BasicOperatorFunctions1(A:SetCategory): Exports == Implementation where
                                                                ltconst?)
 
       cdisp(a, l) == a
+
       csex(a, l)  == a
 
       eqconst?(a, b) ==
@@ -6437,9 +9318,12 @@ BasicOperatorFunctions1(A:SetCategory): Exports == Implementation where
         "failed"
 
       if A has ConvertibleTo IN then
+
         constantOperator a == 
           input(constOp a, (ll:List(IN)):IN +-> csex(convert a, ll))
+
       else
+
         constantOperator a == constOp a
 
 \end{chunk}
@@ -6447,6 +9331,78 @@ BasicOperatorFunctions1(A:SetCategory): Exports == Implementation where
 \begin{chunk}{COQ BOP1}
 (* package BOP1 *)
 (*
+
+    evaluate(op:OP, func:A -> A) == 
+       evaluate(op, (ll:List(A)):A +-> func first ll)
+
+    evaluate op ==
+      (func := property(op, EVAL)) case "failed" => "failed"
+      (func::None) pretend (List A -> A)
+
+    evaluate(op:OP, args:List A) ==
+      (func := property(op, EVAL)) case "failed" => "failed"
+      ((func::None) pretend (List A -> A)) args
+
+    evaluate(op:OP, func:List A -> A) ==
+      setProperty(op, EVAL, func pretend None)
+
+    derivative op ==
+      (func := property(op, DIFF)) case "failed" => "failed"
+      ((func::None) pretend List(List A -> A))
+
+    derivative(op:OP, grad:List(List A -> A)) ==
+      setProperty(op, DIFF, grad pretend None)
+
+    derivative(op:OP, f:A -> A) ==
+      unary? op or nary? op =>
+        derivative(op, [(ll:List(A)):A +-> f first ll]$List(List A -> A))
+      error "Operator is not unary"
+
+    if A has OrderedSet then
+
+      cdisp   : (OUT, List OUT) -> OUT
+      csex    : (IN,  List IN) -> IN
+      eqconst?: (OP, OP) -> Boolean
+      ltconst?: (OP, OP) -> Boolean
+      constOp : A -> OP
+
+      opconst:OP :=
+        comparison(equality(operator("constant"::Symbol, 0), eqconst?),
+                                                               ltconst?)
+
+      cdisp(a, l) == a
+
+      csex(a, l)  == a
+
+      eqconst?(a, b) ==
+        (va := property(a, CONST)) case "failed" => not has?(b, CONST)
+        ((vb := property(b, CONST)) case None) and
+           ((va::None) pretend A) = ((vb::None) pretend A)
+
+      ltconst?(a, b) ==
+        (va := property(a, CONST)) case "failed" => has?(b, CONST)
+        ((vb := property(b, CONST)) case None) and
+           ((va::None) pretend A) < ((vb::None) pretend A)
+
+      constOp a ==
+        setProperty(
+          display(copy opconst, (ll:List(OUT)):OUT +-> cdisp(a::OUT, ll)),
+            CONST, a pretend None)
+
+      constantOpIfCan op ==
+        is?(op, "constant"::Symbol) and
+          ((u := property(op, CONST)) case None) => (u::None) pretend A
+        "failed"
+
+      if A has ConvertibleTo IN then
+
+        constantOperator a == 
+          input(constOp a, (ll:List(IN)):IN +-> csex(convert a, ll))
+
+      else
+
+        constantOperator a == constOp a
+
 *)
 
 \end{chunk}
@@ -7363,6 +10319,7 @@ Bezier(R:Ring): with
     ++X n:=cubicBezier([2.0,2.0],[2.0,4.0],[6.0,4.0],[6.0,2.0])
     ++X [n(t/10.0) for t in 0..10 by 1]
  == add
+
    linearBezier(a,b) == 
     t +-> [(1-t)*(a.1) + t*(b.1), (1-t)*(a.2) + t*(b.2)]
 
@@ -7381,6 +10338,20 @@ Bezier(R:Ring): with
 \begin{chunk}{COQ BEZIER}
 (* package BEZIER *)
 (*
+
+   linearBezier(a,b) == 
+    t +-> [(1-t)*(a.1) + t*(b.1), (1-t)*(a.2) + t*(b.2)]
+
+   quadraticBezier(a,b,c) == 
+    t +-> [(1-t)**2*(a.1) + 2*t*(1-t)*(b.1) + t**2*(c.1),
+           (1-t)**2*(a.2) + 2*t*(1-t)*(b.2) + t**2*(c.2)]
+
+   cubicBezier(a,b,c,d) == 
+    t +-> [(1-t)**3*(a.1) + 3*t*(1-t)**2*(b.1) 
+             + 3*t**2*(1-t)*(c.1) + t**3*(d.1),
+           (1-t)**3*(a.2) + 3*t*(1-t)**2*(b.2)
+             + 3*t**2*(1-t)*(c.2) + t**3*(d.2)]
+     
 *)
 
 \end{chunk}
@@ -7514,6 +10485,7 @@ used to determine if two polynomials have common roots.
 In symbolic form the resultant can show the multiplicity of roots.
 
 \begin{chunk}{package BEZOUT BezoutMatrix}
+
     sylvesterMatrix(p,q) ==
       n1 := degree p; n2 := degree q; n := n1 + n2
       sylmat : M := new(n,n,0)
@@ -7624,6 +10596,112 @@ In symbolic form the resultant can show the multiplicity of roots.
 \begin{chunk}{COQ BEZOUT}
 (* package BEZOUT *)
 (*
+
+    sylvesterMatrix(p,q) ==
+      n1 := degree p; n2 := degree q; n := n1 + n2
+      sylmat : M := new(n,n,0)
+      minR := minRowIndex sylmat; minC := minColIndex sylmat
+      maxR := maxRowIndex sylmat; maxC := maxColIndex sylmat
+      p0 := p
+      -- fill in coefficients of 'p'
+      while not zero? p0 repeat
+        coef := lc p0; deg := degree p0; p0 := reductum p0
+        -- put bk = coef(p,k) in sylmat(minR + i,minC + i + (n1 - k))
+        for i in 0..n2 - 1 repeat
+          qsetelt_!(sylmat,minR + i,minC + n1 - deg + i,coef)
+      q0 := q
+      -- fill in coefficients of 'q'
+      while not zero? q0 repeat
+        coef := lc q0; deg := degree q0; q0 := reductum q0
+        for i in 0..n1-1 repeat
+          qsetelt_!(sylmat,minR + n2 + i,minC + n2 - deg + i,coef)
+      sylmat
+
+    bezoutMatrix(p,q) ==
+    -- This function computes the Bezout matrix for 'p' and 'q'.
+    -- See Knuth, The Art of Computer Programming, Vol. 2, p. 619, # 12.
+    -- One must have deg(p) >= deg(q), so the arguments are reversed
+    -- if this is not the case.
+      n1 := degree p; n2 := degree q; n := n1 + n2
+      n1 < n2 => bezoutMatrix(q,p)
+      m1 : I := n1 - 1; m2 : I := n2 - 1; m : I := n - 1
+      -- 'sylmat' will be a matrix consisting of the first n1 columns
+      -- of the standard Sylvester matrix for 'p' and 'q'
+      sylmat : M := new(n,n1,0)
+      minR := minRowIndex sylmat; minC := minColIndex sylmat
+      maxR := maxRowIndex sylmat; maxC := maxColIndex sylmat
+      p0 := p
+      -- fill in coefficients of 'p'
+      while not ground? p0 repeat
+        coef := lc p0; deg := degree p0; p0 := reductum p0
+        -- put bk = coef(p,k) in sylmat(minR + i,minC + i + (n1 - k))
+        -- for i = 0...
+        -- quit when i > m2 or when i + (n1 - k) > m1, whichever happens first
+        for i in 0..min(m2,deg - 1) repeat
+          qsetelt_!(sylmat,minR + i,minC + n1 - deg + i,coef)
+      q0 := q
+      -- fill in coefficients of 'q'
+      while not zero? q0 repeat
+        coef := lc q0; deg := degree q0; q0 := reductum q0
+        -- put ak = coef(q,k) in sylmat(minR + n1 + i,minC + i + (n2 - k))
+        -- for i = 0...
+        -- quit when i > m1 or when i + (n2 - k) > m1, whichever happens first
+        -- since n2 - k >= 0, we quit when i + (n2 - k) > m1
+        for i in 0..(deg + n1 - n2 - 1) repeat
+          qsetelt_!(sylmat,minR + n2 + i,minC + n2 - deg + i,coef)
+      -- 'bezmat' will be the 'Bezout matrix' as described in Knuth
+      bezmat : M := new(n1,n1,0)
+      for i in 0..m2 repeat
+        -- replace A_i by (b_0 A_i + ... + b_{n_2-1-i} A_{n_2 - 1}) -
+        -- (a_0 B_i + ... + a_{n_2-1-i} B_{n_2-1}), as in Knuth
+        bound : I := n2 - i; q0 := q
+        while not zero? q0 repeat
+          deg := degree q0
+          if (deg < bound) then
+            -- add b_deg A_{n_2 - deg} to the new A_i
+            coef := lc q0
+            for k in minC..maxC repeat
+              c := coef * qelt(sylmat,minR + m2 - i - deg,k) +
+                          qelt(bezmat,minR + m2 - i,k)
+              qsetelt_!(bezmat,minR + m2 - i,k,c)
+          q0 := reductum q0
+        p0 := p
+        while not zero? p0 repeat
+          deg := degree p0
+          if deg < bound then
+            coef := lc p0
+            -- subtract a_deg B_{n_2 - deg} from the new A_i
+            for k in minC..maxC repeat
+              c := -coef * qelt(sylmat,minR + m - i - deg,k) +
+                           qelt(bezmat,minR + m2 - i,k)
+              qsetelt_!(bezmat,minR + m2 - i,k,c)
+          p0 := reductum p0
+      for i in n2..m1 repeat for k in minC..maxC repeat
+        qsetelt_!(bezmat,minR + i,k,qelt(sylmat,minR + i,k))
+      bezmat
+
+    if R has commutative("*") then
+
+      bezoutResultant(f,g) == determinant bezoutMatrix(f,g)
+
+      if R has IntegralDomain then
+
+        bezoutDiscriminant f ==
+          degMod4 := (degree f) rem 4
+          (degMod4 = 0) or (degMod4 = 1) =>
+            (bezoutResultant(f,differentiate f) exquo (lc f)) :: R
+          -((bezoutResultant(f,differentiate f) exquo (lc f)) :: R)
+
+        else
+
+          bezoutDiscriminant f ==
+            lc f = 1 =>
+              degMod4 := (degree f) rem 4
+              (degMod4 = 0) or (degMod4 = 1) =>
+                bezoutResultant(f,differentiate f)
+              -bezoutResultant(f,differentiate f)
+            error "bezoutDiscriminant: leading coefficient must be 1"
+
 *)
 
 \end{chunk}
@@ -7940,6 +11018,196 @@ BlowUpPackage(K,symb,PolyRing,E,  BLMET):Exports == Implementation where
 \begin{chunk}{COQ BLUPPACK}
 (* package BLUPPACK *)
 (*
+
+    import BlUpRing
+    import AFP
+    import RFP(K)
+    import PackPoly
+    import NP
+
+    makeAff( l:List(K) , chart: BLMET ):AFP ==
+          (excepCoord chart) = 1 => affinePoint( l )$AFP
+          affinePoint( reverse l )$AFP
+
+    blowExp: (E2, NNI, BLMET ) -> E2
+
+    maxOf: (K,K) -> K
+
+    getStrTrans: ( BlUpRing , List BlUpRing , BLMET, K ) -> recStr
+
+    stepBlowUp(crb:BlUpRing,pt:AFP,chart:BLMET,actualExtension:K) == 
+      -- next is with Hamburger-Noether method
+      BLMET has HamburgerNoether =>       
+        nV:Integer:= chartCoord chart
+        crbTrans:BlUpRing:=translate(crb, list(pt))$PackPoly
+        newtPol:= newtonPolygon( crbTrans, quotValuation chart, _
+                                 ramifMult chart, type chart )$NP
+        multPt:= multiplicity(newtPol)$NP 
+        one?(multPt) =>
+          [multPt, 0 , empty() ]$blowUpReturn
+        listOfgetTr:List recStr:= _
+          [ getStrTrans( crbTrans , edge , chart , actualExtension ) _
+            for edge in newtPol ]
+        lsubM: List NNI :=  [ ll.sM for ll in listOfgetTr]
+        subM := reduce( "+" , lsubM )
+        llistOfRec: List List blowUpRec :=  [ ll.blRec for ll in listOfgetTr]
+        listOfRec:= concat llistOfRec
+        [ multPt, subM ,listOfRec]$blowUpReturn
+      -- next is with usual quadratic transform.
+
+      BLMET has QuadraticTransform =>	
+        nV:Integer:= chartCoord chart
+        lpt:List(K) := list(pt)$AFP
+        crbTrans:=translate(crb,lpt)
+        minForm:=minimalForm(crbTrans)
+        multPt:=totalDegree( minForm)$PackPoly 
+        listRec:List(blowUpRec):=empty()
+        one?(multPt) => [multPt, 0 , listRec]$blowUpReturn
+        -- now pt is singular !!!!
+        lstInd:=[i::PositiveInteger for i in 1..2 ] 
+        -- la ligne suivante fait un choix judicieux pour minimiser le 
+        -- degre' du transforme' stricte.
+        if degree( crbTrans , 2 )$PackPoly < degree( crbTrans , 1 )$PackPoly _
+           then  lstInd := reverse lstInd
+        ptInf:List(K):=[0$K,0$K]
+        laCarte:BLMET:=
+          ([last(lstInd), first(lstInd),nV] @  List Integer) :: BLMET
+        laCarteInf:BLMET:=
+          ([first(lstInd),last(lstInd),nV] @ List Integer ) :: BLMET
+        transStricte   :=quadTransform(crbTrans,multPt,laCarte)
+        transStricteInf:=quadTransform(crbTrans,multPt,laCarteInf)
+        listPtsSingEcl:List(AFP):=empty()
+        transStricteZero:BlUpRing:= replaceVarByOne(minForm,excepCoord laCarte)
+        recOfZeros:=_
+          distinguishedRootsOf(univariate(transStricteZero)$PackPoly ,_
+                                          actualExtension )$RFP(K)
+        degExt:=recOfZeros.extDegree
+        ^one?(degExt) =>
+          print(("You need an extension of degree")::OutputForm)
+          print(degExt::OutputForm)
+          error("Have a nice day")
+        listPtsSingEcl:=[makeAff([0$K,a]::List(K),laCarte) _ 
+                        for a in recOfZeros.zeros]
+        listRec:=[  
+                    [  transStricte,_
+                       ptS,laCarte,_
+  		     maxOf(a,actualExtension)]$blowUpRec_
+  		  for ptS in listPtsSingEcl_
+  	       for a in recOfZeros.zeros]
+        if zero?(constant(transStricteInf))$K then
+          listRec:= concat(listRec,[transStricteInf,_
+  	                          affinePoint(ptInf)$AFP,_
+  				  laCarteInf,_
+  				  actualExtension]$blowUpRec)
+        empty?(listRec) =>
+          error "Something is very wrong in blowing up!!!!!!"
+        [multPt, 0 ,listRec]$blowUpReturn
+      error "Desingularisation is not implemented for the blowing up method chosen, see BlowingUpMethodCategory."
+
+    getStrTrans( crb , inedge , actChart, actualExtension ) == 
+      edge:= copy inedge
+      s := slope(edge)$NP
+      sden:Integer
+      snum:Integer
+      i1:Integer
+      i2:Integer
+      if s.type case "right"  then 
+        sden:= s.base
+        snum:=s.height
+        i1:=1
+        i2:=2
+      else -- interchange les roles de X et Y .
+        sden:= s.height
+        snum:= s.base
+        i1:=2
+        i2:=1
+        edge := copy reverse inedge
+      ee := entries( degree first edge) pretend List Integer
+      euclq: Integer 
+      if one?(snum) then 
+        euclq:=1
+      else 
+        euclq   := s.quotient 
+      -- sMult est la somme des  multiplicite des  points infiniment 
+      -- voisin par une trans. quadratique 
+      sMult: NNI :=  ( ( euclq - 1 )   * ee.i2 ) pretend NNI
+      -- extMult est egal a la plus grande puissance de X que l'on peut 
+      --extraire de la transformee.
+      extMult := (ee.i1 + ee.i2 * euclq) pretend NonNegativeInteger
+      ch: BLMET
+      trStr:BlUpRing
+      listBlRec: List blowUpRec
+      ^zero?(s.reste ) =>  
+         ch:= createHN( i1 , i2 , chartCoord actChart, euclq , s.reste , _
+                       false , s.type)$BLMET
+         trStr:= quadTransform(crb, extMult , ch )
+         listBlRec:= [ [trStr,origin()$AFP,ch,actualExtension ]$blowUpRec ]
+         [ sMult , listBlRec  ]$recStr
+      polEdge := reduce( "+" , edge )
+      unipol:= univariate( replaceVarByOne( polEdge , i1 )$PackPoly )$PackPoly 
+      recOfZeros:= distinguishedRootsOf( unipol , actualExtension )$RFP(K)
+      degExt:=recOfZeros.extDegree
+      ^one?(degExt) =>
+          print(("You need an extension of degree")::OutputForm)
+          print(degExt::OutputForm)
+          error("Have a nice day")
+      listOfZeroes:List K:= [ z for z in recOfZeros.zeros | ^zero?(z) ]
+      empty? listOfZeroes => _
+        error " The curve is not absolutely irreducible since the Newton polygon has no sides "
+      ch:=_
+        createHN( i1 , i2, chartCoord actChart, euclq, 0, false, s.type)$BLMET
+      lsTr:BlUpRing:= quadTransform(crb, extMult , ch ) 
+      lAff:List AFP:=[makeAff([ 0$K, z]:: List K , ch) for z in listOfZeroes ]
+      listBlRec := [ [ lsTr,p,ch,maxOf( actualExtension , z) ]$blowUpRec_
+         for p in lAff for z in listOfZeroes ]
+      [sMult, listBlRec ]$recStr
+
+    blowExp(exp,mult,chart)== -- CHH
+      zero?( excepCoord chart) => exp
+      lexp:List NNI:=parts(exp)
+      ch1:Integer:= excepCoord chart
+      ch2:Integer:= transCoord chart
+      e1:Integer := lexp(ch1) pretend Integer
+      e2:Integer := lexp(ch2) pretend Integer
+      quotVal:Integer := quotValuation chart
+      lbexp:=[0,0] :: List(NNI)
+      lbexp(ch1):= ( e1 + quotVal * e2  - mult ) pretend NonNegativeInteger
+      lbexp(ch2):=lexp(ch2)
+      directProduct(vector(lbexp)$Vector(NNI))$E2
+
+    quadTransform(pol,mult,chart)==  -- CHH
+      mapExponents(blowExp(#1,mult,chart),pol)
+
+    polyRingToBlUpRing(pol,chart)==
+      zero? pol => 0
+      lc:= leadingCoefficient pol
+      d:=entries degree pol
+      ll:= [ d.i for i in 1..3 | ^( i = chartCoord(chart) ) ]
+      e:= directProduct( vector( ll)$Vector(NNI) )$E2
+      monomial(lc , e )$BlUpRing + polyRingToBlUpRing( reductum pol, chart )
+
+    biringToPolyRing(pol,chart)==
+      zero? pol => 0
+      lc:= leadingCoefficient pol
+      d:=entries degree pol
+      nV:= chartCoord chart
+      ll:List NNI:= 
+        nV = 1 => [ 0$NNI , d.1  , d.2 ]
+        nV = 2 => [ d.1  , 0$NNI , d.2 ]
+        [d.1 , d.2 , 0$NNI ]
+      e:= directProduct( vector( ll)$Vector(NNI) )$E
+      monomial(lc , e )$PolyRing  + biringToPolyRing( reductum pol, chart )
+
+    applyTransform(pol,chart)==
+      biringToPolyRing( quadTransform( polyRingToBlUpRing( pol, chart ) ,_
+                         0 , chart) , chart )
+  
+-- K has PseudoAlgebraicClosureOfFiniteFieldCategory => maxTower([a,b])$K
+-- K has PseudoAlgebraicClosureOfRationalNumberCategory  => maxTower([a,b])$K
+    maxOf(a:K,b:K):K ==
+      K has PseudoAlgebraicClosureOfPerfectFieldCategory  => maxTower([a,b])$K
+      1$K
+
 *)
 
 \end{chunk}
@@ -8021,6 +11289,7 @@ BoundIntegerRoots(F, UP): Exports == Implementation where
       ++ roots of p, and 0 if p has no negative integer roots.
 
   Implementation ==> add
+
     import RationalFactorize(UPQ)
     import UnivariatePolynomialCategoryFunctions2(F, UP, Q, UPQ)
 
@@ -8029,16 +11298,18 @@ BoundIntegerRoots(F, UP): Exports == Implementation where
     qzroot1: UPQ -> Z
     negint : Q -> Z
 
--- returns 0 if p has no integer root < 0, its negative integer root otherwise
-    qzroot1 p == negint(- leadingCoefficient(reductum p) / leadingCoefficient p)
+    -- returns 0 if p has no integer root < 0, 
+    -- its negative integer root otherwise
+    qzroot1 p == negint(- leadingCoefficient(reductum p)/leadingCoefficient p)
 
--- returns 0 if p has no integer root < 0, its negative integer root otherwise
+    -- returns 0 if p has no integer root < 0, 
+    -- its negative integer root otherwise
     zroot1 p ==
       z := - leadingCoefficient(reductum p) / leadingCoefficient p
       (r := retractIfCan(z)@Union(Q, "failed")) case Q => negint(r::Q)
       0
 
--- returns 0 if r is not a negative integer, r otherwise
+    -- returns 0 if r is not a negative integer, r otherwise
     negint r ==
       ((u := retractIfCan(r)@Union(Z, "failed")) case Z) and (u::Z < 0) => u::Z
       0
@@ -8058,23 +11329,21 @@ BoundIntegerRoots(F, UP): Exports == Implementation where
         retract eval(f, t, [random()$Q :: F for k in t])
 
       integerBound p ==
---        one? degree p => zroot1 p
         (degree p) = 1 => zroot1 p
         q1 := map(bringDown, p)
         q2 := map(bringDown, p)
         qbound(p, gcd(q1, q2))
 
     else
+
       integerBound p ==
---        one? degree p => zroot1 p
         (degree p) = 1 => zroot1 p
         qbound(p, map((z1:F):Q +-> retract(z1)@Q, p))
 
--- we can probably do better here (i.e. without factoring)
+    -- we can probably do better here (i.e. without factoring)
     qbound(p, q) ==
       bound:Z := 0
       for rec in factors factor q repeat
---        if one?(degree(rec.factor)) and ((r := qzroot1(rec.factor)) < bound)
         if ((degree(rec.factor)) = 1) and ((r := qzroot1(rec.factor)) < bound)
            and zero? p(r::Q::F) then bound := r
       bound
@@ -8084,6 +11353,65 @@ BoundIntegerRoots(F, UP): Exports == Implementation where
 \begin{chunk}{COQ BOUNDZRO}
 (* package BOUNDZRO *)
 (*
+
+    import RationalFactorize(UPQ)
+    import UnivariatePolynomialCategoryFunctions2(F, UP, Q, UPQ)
+
+    qbound : (UP, UPQ) -> Z
+    zroot1 : UP -> Z
+    qzroot1: UPQ -> Z
+    negint : Q -> Z
+
+    -- returns 0 if p has no integer root < 0, 
+    -- its negative integer root otherwise
+    qzroot1 p == negint(- leadingCoefficient(reductum p)/leadingCoefficient p)
+
+    -- returns 0 if p has no integer root < 0, 
+    -- its negative integer root otherwise
+    zroot1 p ==
+      z := - leadingCoefficient(reductum p) / leadingCoefficient p
+      (r := retractIfCan(z)@Union(Q, "failed")) case Q => negint(r::Q)
+      0
+
+    -- returns 0 if r is not a negative integer, r otherwise
+    negint r ==
+      ((u := retractIfCan(r)@Union(Z, "failed")) case Z) and (u::Z < 0) => u::Z
+      0
+
+    if F has ExpressionSpace then
+      bringDown: F -> Q
+
+-- the random substitution used by bringDown is NOT always a ring-homorphism
+-- (because of potential algebraic kernels), but is ALWAYS a Z-linear map.
+-- this guarantees that bringing down the coefficients of (x + n) q(x) for an
+-- integer n yields a polynomial h(x) which is divisible by x + n
+-- the only problem is that evaluating with random numbers can cause a
+-- division by 0. We should really be able to trap this error later and
+-- reevaluate with a new set of random numbers    MB 11/91
+      bringDown f ==
+        t := tower f
+        retract eval(f, t, [random()$Q :: F for k in t])
+
+      integerBound p ==
+        (degree p) = 1 => zroot1 p
+        q1 := map(bringDown, p)
+        q2 := map(bringDown, p)
+        qbound(p, gcd(q1, q2))
+
+    else
+
+      integerBound p ==
+        (degree p) = 1 => zroot1 p
+        qbound(p, map((z1:F):Q +-> retract(z1)@Q, p))
+
+    -- we can probably do better here (i.e. without factoring)
+    qbound(p, q) ==
+      bound:Z := 0
+      for rec in factors factor q repeat
+        if ((degree(rec.factor)) = 1) and ((r := qzroot1(rec.factor)) < bound)
+           and zero? p(r::Q::F) then bound := r
+      bound
+
 *)
 
 \end{chunk}
@@ -8214,6 +11542,7 @@ BrillhartTests(UP): Exports == Implementation where
        prime? n
 
     brillharttrials: N := 6
+
     brillhartTrials():N == brillharttrials
 
     brillhartTrials(n:N):N ==
@@ -8232,7 +11561,6 @@ BrillhartTests(UP): Exports == Implementation where
       polyx2 := squaredPolynomial(p)
       prime? p(largeEnough) => true
       not polyx2 and prime? p(-largeEnough) => true
---      one? brillharttrials => false
       (brillharttrials = 1) => false
       largeEnough := largeEnough+1
       primeEnough?(p(largeEnough),if noLinears then 4 else 2) => true
@@ -8257,6 +11585,67 @@ BrillhartTests(UP): Exports == Implementation where
 \begin{chunk}{COQ BRILL}
 (* package BRILL *)
 (*
+
+    import GaloisGroupFactorizationUtilities(Z,UP,Float)
+
+    squaredPolynomial(p:UP):Boolean ==
+      d := degree p
+      d = 0 => true
+      odd? d => false
+      squaredPolynomial reductum p
+
+    primeEnough?(n:Z,b:Z):Boolean ==
+       -- checks if n is prime, with the possible exception of 
+       -- factors whose product is at most b
+       import Float
+       bb: Float := b::Float
+       for i in 2..b repeat
+           while (d:= n exquo i) case Integer repeat
+                 n:=d::Integer
+                 bb:=bb / i::Float
+                 bb < 1$Float => return false
+                 --- we over-divided, so it can't be prime
+       prime? n
+
+    brillharttrials: N := 6
+
+    brillhartTrials():N == brillharttrials
+
+    brillhartTrials(n:N):N ==
+      (brillharttrials,n) := (n,brillharttrials)
+      n
+
+    brillhartIrreducible?(p:UP):Boolean ==
+      brillhartIrreducible?(p,noLinearFactor? p)
+
+    brillhartIrreducible?(p:UP,noLinears:Boolean):Boolean == -- See [1]
+      zero? brillharttrials => false
+      origBound := (largeEnough := rootBound(p)+1)
+      -- see remarks 2 and 4
+      even0 := even? coefficient(p,0)
+      even1 := even? p(1)
+      polyx2 := squaredPolynomial(p)
+      prime? p(largeEnough) => true
+      not polyx2 and prime? p(-largeEnough) => true
+      (brillharttrials = 1) => false
+      largeEnough := largeEnough+1
+      primeEnough?(p(largeEnough),if noLinears then 4 else 2) => true
+      not polyx2 and
+       primeEnough?(p(-largeEnough),if noLinears then 4 else 2) => true
+      if odd? largeEnough then 
+        if even0 then largeEnough := largeEnough+1
+      else 
+        if even1 then largeEnough := largeEnough+1
+      count :=(if polyx2 then 2 else 1)*(brillharttrials-2)+largeEnough
+      for i in (largeEnough+1)..count repeat
+        small := if noLinears then (i-origBound)**2 else (i-origBound)
+        primeEnough?(p(i),small) => return true
+        not polyx2 and primeEnough?(p(-i),small) => return true
+      false
+
+    noLinearFactor?(p:UP):Boolean ==
+      (odd? leadingCoefficient p) and (odd? coefficient(p,0)) and (odd? p(1)) 
+
 *)
 
 \end{chunk}
@@ -8341,7 +11730,9 @@ CartesianTensorFunctions2(minix, dim, S, T): CTPcat == CTPdef where
             ++ map(f,ts) does a componentwise conversion of the tensor ts
             ++ to a tensor with components of type T.
     CTPdef == add
+
         reshape(l, s) == unravel l
+
         map(f, s)     == unravel [f e for e in ravel s]
 
 \end{chunk}
@@ -8349,6 +11740,11 @@ CartesianTensorFunctions2(minix, dim, S, T): CTPcat == CTPdef where
 \begin{chunk}{COQ CARTEN2}
 (* package CARTEN2 *)
 (*
+
+        reshape(l, s) == unravel l
+
+        map(f, s)     == unravel [f e for e in ravel s]
+
 *)
 
 \end{chunk}
@@ -8461,6 +11857,7 @@ ChangeOfVariable(F, UP, UPUP): Exports == Implementation where
           ++ The algebraic relation between z and t is \spad{q(z, t) = 0}.
 
   Implementation ==> add
+
     import UnivariatePolynomialCommonDenominator(UP, RF, UPUP)
 
     algPoly     : UPUP           -> Record(coef:RF, poly:UPUP)
@@ -8469,6 +11866,7 @@ ChangeOfVariable(F, UP, UPUP): Exports == Implementation where
     infIntegral?: (UPUP, UPUP)   -> Boolean
 
     eval(p, x, y)  == map(s +-> s(x), p)  monomial(y, 1)
+
     good?(a, p, q) == p(a) ^= 0 and q(a) ^= 0
 
     algPoly p ==
@@ -8482,12 +11880,12 @@ ChangeOfVariable(F, UP, UPUP): Exports == Implementation where
       RPrim(c, a, q)
 
     RPrim(c, a, q) ==
---      one? a => [c::RF, q]
       (a = 1) => [c::RF, q]
       [(a * c)::RF, clearDenominator q monomial(inv(a::RF), 1)]
 
--- always makes the algebraic integral, but does not send a point to infinity
--- if the integrand does not have a pole there (in the case of an nth-root)
+    -- always makes the algebraic integral, but does not send a point 
+    -- to infinity
+    -- if the integrand does not have a pole there (in the case of an nth-root)
     chvar(f, modulus) ==
       r1 := mkIntegral modulus
       f1 := f monomial(r1inv := inv(r1.coef), 1)
@@ -8499,9 +11897,10 @@ ChangeOfVariable(F, UP, UPUP): Exports == Implementation where
       [- inv(monomial(1, 2)$UP :: RF) * eval(f1, x, inv(r2.coef)),
                                 r2.poly, t, r1.coef * r2c t, degree r2c]
 
--- returns true if y is an n-th root, and it can be guaranteed that p(x,y)dx
--- is integral at infinity
--- expects y to be integral.
+    -- returns true if y is an n-th root, 
+    -- and it can be guaranteed that p(x,y)dx
+    -- is integral at infinity
+    -- expects y to be integral.
     infIntegral?(p, modulus) ==
       (r := radPoly modulus) case "failed" => false
       ninv := inv(r.deg::Q)
@@ -8510,7 +11909,7 @@ ChangeOfVariable(F, UP, UPUP): Exports == Implementation where
       while p ^= 0 repeat
         c := leadingCoefficient p
         degp := max(degp,
-            (2 + degree(numer c)::Z - degree(denom c)::Z)::Q + degree(p) * degy)
+           (2 + degree(numer c)::Z - degree(denom c)::Z)::Q + degree(p) * degy)
         p := reductum p
       degp <= ninv
 
@@ -8534,9 +11933,9 @@ ChangeOfVariable(F, UP, UPUP): Exports == Implementation where
         => "failed"
       [- (r::RF), degree p]
 
--- we have y**m = g(x) = n(x)/d(x), so if we can write
--- (n(x) * d(x)**(m-1)) ** (1/m)  =  c(x) * P(x) ** (1/n)
--- then z**q = P(x) where z = (d(x) / c(x)) * y
+    -- we have y**m = g(x) = n(x)/d(x), so if we can write
+    -- (n(x) * d(x)**(m-1)) ** (1/m)  =  c(x) * P(x) ** (1/n)
+    -- then z**q = P(x) where z = (d(x) / c(x)) * y
     rootPoly(g, m) ==
       zero? g => error "Should not happen"
       pr := nthRoot(squareFree((numer g) * (d := denom g) ** (m-1)::N),
@@ -8548,6 +11947,91 @@ ChangeOfVariable(F, UP, UPUP): Exports == Implementation where
 \begin{chunk}{COQ CHVAR}
 (* package CHVAR *)
 (*
+
+    import UnivariatePolynomialCommonDenominator(UP, RF, UPUP)
+
+    algPoly     : UPUP           -> Record(coef:RF, poly:UPUP)
+    RPrim       : (UP, UP, UPUP) -> Record(coef:RF, poly:UPUP)
+    good?       : (F, UP, UP)    -> Boolean
+    infIntegral?: (UPUP, UPUP)   -> Boolean
+
+    eval(p, x, y)  == map(s +-> s(x), p)  monomial(y, 1)
+
+    good?(a, p, q) == p(a) ^= 0 and q(a) ^= 0
+
+    algPoly p ==
+      ground?(a:= retract(leadingCoefficient(q:=clearDenominator p))@UP)
+        => RPrim(1, a, q)
+      c := d := squareFreePart a
+      q := clearDenominator q monomial(inv(d::RF), 1)
+      while not ground?(a := retract(leadingCoefficient q)@UP) repeat
+        c := c * (d := gcd(a, d))
+        q := clearDenominator q monomial(inv(d::RF), 1)
+      RPrim(c, a, q)
+
+    RPrim(c, a, q) ==
+      (a = 1) => [c::RF, q]
+      [(a * c)::RF, clearDenominator q monomial(inv(a::RF), 1)]
+
+    -- always makes the algebraic integral, but does not send a point 
+    -- to infinity
+    -- if the integrand does not have a pole there (in the case of an nth-root)
+    chvar(f, modulus) ==
+      r1 := mkIntegral modulus
+      f1 := f monomial(r1inv := inv(r1.coef), 1)
+      infIntegral?(f1, r1.poly) =>
+        [f1, r1.poly, monomial(1,1)$UP :: RF,r1inv,degree(retract(r1.coef)@UP)]
+      x  := (a:= goodPoint(f1,r1.poly))::UP::RF + inv(monomial(1,1)::RF)
+      r2c:= retract((r2 := mkIntegral map(s+->s(x), r1.poly)).coef)@UP
+      t  := inv((monomial(1, 1)$UP - a::UP)::RF)
+      [- inv(monomial(1, 2)$UP :: RF) * eval(f1, x, inv(r2.coef)),
+                                r2.poly, t, r1.coef * r2c t, degree r2c]
+
+    -- returns true if y is an n-th root, 
+    -- and it can be guaranteed that p(x,y)dx
+    -- is integral at infinity
+    -- expects y to be integral.
+    infIntegral?(p, modulus) ==
+      (r := radPoly modulus) case "failed" => false
+      ninv := inv(r.deg::Q)
+      degy:Q := degree(retract(r.radicand)@UP) * ninv
+      degp:Q := 0
+      while p ^= 0 repeat
+        c := leadingCoefficient p
+        degp := max(degp,
+           (2 + degree(numer c)::Z - degree(denom c)::Z)::Q + degree(p) * degy)
+        p := reductum p
+      degp <= ninv
+
+    mkIntegral p ==
+      (r := radPoly p) case "failed" => algPoly p
+      rp := rootPoly(r.radicand, r.deg)
+      [rp.coef, monomial(1, rp.exponent)$UPUP - rp.radicand::RF::UPUP]
+
+    goodPoint(p, modulus) ==
+      q :=
+        (r := radPoly modulus) case "failed" =>
+                   retract(resultant(modulus, differentiate modulus))@UP
+        retract(r.radicand)@UP
+      d := commonDenominator p
+      for i in 0.. repeat
+        good?(a := i::F, q, d) => return a
+        good?(-a, q, d)        => return -a
+
+    radPoly p ==
+      (r := retractIfCan(reductum p)@Union(RF, "failed")) case "failed"
+        => "failed"
+      [- (r::RF), degree p]
+
+    -- we have y**m = g(x) = n(x)/d(x), so if we can write
+    -- (n(x) * d(x)**(m-1)) ** (1/m)  =  c(x) * P(x) ** (1/n)
+    -- then z**q = P(x) where z = (d(x) / c(x)) * y
+    rootPoly(g, m) ==
+      zero? g => error "Should not happen"
+      pr := nthRoot(squareFree((numer g) * (d := denom g) ** (m-1)::N),
+                                                m)$FactoredFunctions(UP)
+      [pr.exponent, d / pr.coef, */(pr.radicand)]
+
 *)
 
 \end{chunk}
@@ -8618,12 +12102,15 @@ CharacteristicPolynomialInMonogenicalAlgebra(R : CommutativeRing,
       ++ of e using resultants
 
   == add
+
     Pol ==> SparseUnivariatePolynomial
 
     import UnivariatePolynomialCategoryFunctions2(R, PolR, PolR, Pol(PolR))
+
     XtoY(Q : PolR) : Pol(PolR) == map(x+->monomial(x, 0), Q)
 
     P : Pol(PolR) := XtoY(definingPolynomial()$E)
+
     X : Pol(PolR) := monomial(monomial(1, 1)$PolR, 0)
 
     characteristicPolynomial(x : E) : PolR ==
@@ -8636,6 +12123,22 @@ CharacteristicPolynomialInMonogenicalAlgebra(R : CommutativeRing,
 \begin{chunk}{COQ CPIMA}
 (* package CPIMA *)
 (*
+
+    Pol ==> SparseUnivariatePolynomial
+
+    import UnivariatePolynomialCategoryFunctions2(R, PolR, PolR, Pol(PolR))
+
+    XtoY(Q : PolR) : Pol(PolR) == map(x+->monomial(x, 0), Q)
+
+    P : Pol(PolR) := XtoY(definingPolynomial()$E)
+
+    X : Pol(PolR) := monomial(monomial(1, 1)$PolR, 0)
+
+    characteristicPolynomial(x : E) : PolR ==
+       Qx : PolR := lift(x)
+       -- on utilise le fait que resultant_Y (P(Y), X - Qx(Y))
+       return resultant(P, X - XtoY(Qx))
+
 *)
 
 \end{chunk}
@@ -8723,6 +12226,17 @@ CharacteristicPolynomialPackage(R:CommutativeRing):C == T where
 \begin{chunk}{COQ CHARPOL}
 (* package CHARPOL *)
 (*
+
+           ---- characteristic polynomial  ----
+     characteristicPolynomial(A:M,v:R) : R ==
+       dimA :PI := (nrows A):PI
+       dimA ^= ncols A => error " The matrix is not square"
+       B:M:=zero(dimA,dimA)
+       for i in 1..dimA repeat
+         for j in 1..dimA repeat  B(i,j):=A(i,j)
+         B(i,i) := B(i,i) - v
+       determinant B
+
 *)
 
 \end{chunk}
@@ -9060,6 +12574,31 @@ CoerceVectorMatrixPackage(R : CommutativeRing): public == private where
 \begin{chunk}{COQ CVMP}
 (* package CVMP *)
 (*
+
+    imbedFP : R -> Fraction Polynomial R
+    imbedFP r == (r:: Polynomial R) :: Fraction Polynomial R
+
+    imbedP : R -> Polynomial R
+    imbedP r == (r:: Polynomial R)
+
+    coerceP(g:Vector Matrix R) : Vector Matrix Polynomial R ==
+      m2 : Matrix Polynomial R
+      lim : List Matrix R := entries g
+      l: List Matrix Polynomial R :=  []
+      for m in lim repeat
+        m2 :=  map(imbedP,m)$M2P
+        l := cons(m2,l)
+      vector reverse l
+
+    coerce(g:Vector Matrix R) : Vector Matrix Fraction Polynomial R ==
+      m3 : Matrix Fraction Polynomial R
+      lim : List Matrix R := entries g
+      l: List Matrix Fraction Polynomial R :=  []
+      for m in lim repeat
+        m3 :=  map(imbedFP,m)$M2FP
+        l := cons(m3,l)
+      vector reverse l
+
 *)
 
 \end{chunk}
@@ -9447,6 +12986,7 @@ CombinatorialFunction(R, F): Exports == Implementation where
       ++ ipow(l) should be local but conditional;
 
   Implementation ==> add
+
     ifact     : F -> F
     iiipow    : List F -> F
     iperm     : List F -> F
@@ -9482,16 +13022,25 @@ CombinatorialFunction(R, F): Exports == Implementation where
     dummy == new()$SE :: F
 
     opfact  := operator("factorial"::Symbol)$CommonOperators
+
     opperm  := operator("permutation"::Symbol)$CommonOperators
+
     opbinom := operator("binomial"::Symbol)$CommonOperators
+
     opsum   := operator("summation"::Symbol)$CommonOperators
+
     opdsum  := operator("%defsum"::Symbol)$CommonOperators
+
     opprod  := operator("product"::Symbol)$CommonOperators
+
     opdprod := operator("%defprod"::Symbol)$CommonOperators
+
     oppow   := operator(POWER::Symbol)$CommonOperators
 
     factorial x          == opfact x
+
     binomial(x, y)       == opbinom [x, y]
+
     permutation(x, y)    == opperm [x, y]
 
     import F
@@ -9520,11 +13069,17 @@ CombinatorialFunction(R, F): Exports == Implementation where
       oppow [x, y]
 
     belong? op           == has?(op, "comb")
+
     fourth l             == third rest l
+
     dvpow1 l             == second(l) * first(l) ** (second l - 1)
+
     factorials x         == facts(x, variables x)
+
     factorials(x, v)     == facts(x, [v])
+
     facts(x, l)          == smpfact(numer x, l) / smpfact(denom x, l)
+
     summand l            == eval(first l, retract(second l)@K, third l)
 
     product(x:F, i:SE) ==
@@ -9638,7 +13193,6 @@ CombinatorialFunction(R, F): Exports == Implementation where
 
     iprod l ==
       zero? first l => 0
---      one? first l => 1
       (first l = 1) => 1
       kernel(opprod, l)
 
@@ -9657,14 +13211,12 @@ CombinatorialFunction(R, F): Exports == Implementation where
       first(l) * (fourth rest l - fourth l + 1)
 
     ifact x ==
---      zero? x or one? x => 1
       zero? x or (x = 1) => 1
       kernel(opfact, x)
 
     ibinom l ==
       n := first l
       ((p := second l) = 0) or (p = n) => 1
---      one? p or (p = n - 1) => n
       (p = 1) or (p = n - 1) => n
       kernel(opbinom, l)
 
@@ -9673,6 +13225,7 @@ CombinatorialFunction(R, F): Exports == Implementation where
       kernel(opperm, l)
 
     if R has RetractableTo Z then
+
       iidsum l ==
         (r1:=retractIfCan(fourth l)@Union(Z,"failed"))
          case "failed" or
@@ -9700,33 +13253,35 @@ CombinatorialFunction(R, F): Exports == Implementation where
           (operator(rec.var)) (rec.exponent * y * second l)
 
       if F has RadicalCategory then
+
         ipow l ==
           (r := retractIfCan(second l)@Union(Fraction Z,"failed"))
             case "failed" => iiipow l
           first(l) ** (r::Fraction(Z))
+
       else
+
         ipow l ==
           (r := retractIfCan(second l)@Union(Z, "failed"))
             case "failed" => iiipow l
           first(l) ** (r::Z)
 
     else
+
       ipow l ==
         zero?(x := first l) =>
           zero? second l => error "0 ** 0"
           0
---        one? x or zero?(n := second l) => 1
         (x = 1) or zero?(n: F := second l) => 1
---        one? n => x
         (n = 1) => x
         (u := isExpt(x, OPEXP)) case "failed" => kernel(oppow, l)
         rec := u::Record(var: K, exponent: Z)
---        one?(y := first argument(rec.var)) or y = -1 =>
         ((y := first argument(rec.var))=1) or y = -1 =>
             (operator(rec.var)) (rec.exponent * y * n)
         kernel(oppow, l)
 
     if R has CombinatorialFunctionCategory then
+
       iifact x ==
         (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => ifact x
         factorial(r::R)::F
@@ -9738,6 +13293,7 @@ CombinatorialFunction(R, F): Exports == Implementation where
         permutation(r1::R, r2::R)::F
 
       if R has RetractableTo(Z) and F has Algebra(Fraction(Z)) then
+
          iibinom l ==
            (s:=retractIfCan(second l)@Union(R,"failed")) case R and
               (t:=retractIfCan(s)@Union(Z,"failed")) case Z and t>0 =>
@@ -9761,6 +13317,7 @@ CombinatorialFunction(R, F): Exports == Implementation where
 -- used to calculate the coefficient, there is room for improvement here.
 
       else
+
          iibinom l ==
            (r1 := retractIfCan(first l)@Union(R,"failed")) case "failed" or
              (r2 := retractIfCan(second l)@Union(R,"failed")) case "failed"
@@ -9768,20 +13325,27 @@ CombinatorialFunction(R, F): Exports == Implementation where
            binomial(r1::R, r2::R)::F
 
     else
+
       iifact x  == ifact x
+
       iibinom l == ibinom l
+
       iiperm l  == iperm l
 
     if R has ElementaryFunctionCategory then
+
       iipow l ==
         (r1:=retractIfCan(first l)@Union(R,"failed")) case "failed" or
           (r2:=retractIfCan(second l)@Union(R,"failed")) case "failed"
             => ipow l
         (r1::R ** r2::R)::F
+
     else
+
       iipow l == ipow l
 
     if F has ElementaryFunctionCategory then
+
       dvpow2 l == if zero?(first l) then
                     0
                   else
@@ -9812,16 +13376,419 @@ CombinatorialFunction(R, F): Exports == Implementation where
     setProperty(opdsum,  SPECIALDISP, ddsum@(List F -> O) pretend None)
     setProperty(opprod,  SPECIALDISP, dprod@(List F -> O) pretend None)
     setProperty(opdprod, SPECIALDISP, ddprod@(List F -> O) pretend None)
-    setProperty(opsum,   SPECIALEQUAL, equalsumprod@((K,K) -> Boolean) pretend None)
-    setProperty(opdsum,  SPECIALEQUAL, equaldsumprod@((K,K) -> Boolean) pretend None)
-    setProperty(opprod,  SPECIALEQUAL, equalsumprod@((K,K) -> Boolean) pretend None)
-    setProperty(opdprod, SPECIALEQUAL, equaldsumprod@((K,K) -> Boolean) pretend None)
+    setProperty(opsum,   SPECIALEQUAL, equalsumprod@((K,K) -> Boolean)_
+      pretend None)
+    setProperty(opdsum,  SPECIALEQUAL, equaldsumprod@((K,K) -> Boolean)_
+      pretend None)
+    setProperty(opprod,  SPECIALEQUAL, equalsumprod@((K,K) -> Boolean)_
+      pretend None)
+    setProperty(opdprod, SPECIALEQUAL, equaldsumprod@((K,K) -> Boolean)_
+      pretend None)
 
 \end{chunk} 
 
 \begin{chunk}{COQ COMBF}
 (* package COMBF *)
 (*
+
+    ifact     : F -> F
+    iiipow    : List F -> F
+    iperm     : List F -> F
+    ibinom    : List F -> F
+    isum      : List F -> F
+    idsum     : List F -> F
+    iprod     : List F -> F
+    idprod    : List F -> F
+    dsum      : List F -> O
+    ddsum     : List F -> O
+    dprod     : List F -> O
+    ddprod    : List F -> O
+    equalsumprod  : (K, K) -> Boolean 
+    equaldsumprod : (K, K) -> Boolean 
+    fourth    : List F -> F
+    dvpow1    : List F -> F
+    dvpow2    : List F -> F
+    summand   : List F -> F
+    dvsum     : (List F, SE) -> F
+    dvdsum    : (List F, SE) -> F
+    dvprod    : (List F, SE) -> F
+    dvdprod   : (List F, SE) -> F
+    facts     : (F, List SE) -> F
+    K2fact    : (K, List SE) -> F
+    smpfact   : (SMP, List SE) -> F
+
+-- This macro will be used in product and summation, both the 5 and 3
+-- argument forms. It is used to introduce a dummy variable in place of the
+-- summation index within the summands. This in turn is necessary to keep the
+-- indexing variable local, circumventing problems, for example, with
+-- differentiation.
+
+    dummy == new()$SE :: F
+
+    opfact  := operator("factorial"::Symbol)$CommonOperators
+
+    opperm  := operator("permutation"::Symbol)$CommonOperators
+
+    opbinom := operator("binomial"::Symbol)$CommonOperators
+
+    opsum   := operator("summation"::Symbol)$CommonOperators
+
+    opdsum  := operator("%defsum"::Symbol)$CommonOperators
+
+    opprod  := operator("product"::Symbol)$CommonOperators
+
+    opdprod := operator("%defprod"::Symbol)$CommonOperators
+
+    oppow   := operator(POWER::Symbol)$CommonOperators
+
+    factorial x          == opfact x
+
+    binomial(x, y)       == opbinom [x, y]
+
+    permutation(x, y)    == opperm [x, y]
+
+    import F
+    import Kernel F
+
+    number?(x:F):Boolean ==
+      if R has RetractableTo(Z) then
+        ground?(x) or
+         ((retractIfCan(x)@Union(Fraction(Z),"failed")) case Fraction(Z))
+      else
+        ground?(x)
+
+    x ** y               == 
+      -- Do some basic simplifications
+      is?(x,POWER) =>
+        args : List F := argument first kernels x
+        not(#args = 2) => error "Too many arguments to **"
+        number?(first args) and number?(y) =>
+          oppow [first(args)**y, second args]
+        oppow [first args, (second args)* y]
+      -- Generic case
+      exp : Union(Record(val:F,exponent:Z),"failed") := isPower x
+      exp case Record(val:F,exponent:Z) =>
+        expr := exp::Record(val:F,exponent:Z)
+        oppow [expr.val, (expr.exponent)*y]
+      oppow [x, y]
+
+    belong? op           == has?(op, "comb")
+
+    fourth l             == third rest l
+
+    dvpow1 l             == second(l) * first(l) ** (second l - 1)
+
+    factorials x         == facts(x, variables x)
+
+    factorials(x, v)     == facts(x, [v])
+
+    facts(x, l)          == smpfact(numer x, l) / smpfact(denom x, l)
+
+    summand l            == eval(first l, retract(second l)@K, third l)
+
+    product(x:F, i:SE) ==
+      dm := dummy
+      opprod [eval(x, k := kernel(i)$K, dm), dm, k::F]
+
+    summation(x:F, i:SE) ==
+      dm := dummy
+      opsum [eval(x, k := kernel(i)$K, dm), dm, k::F]
+
+-- These two operations return the product or the sum as unevaluated operators
+-- A dummy variable is introduced to make the indexing variable local.
+
+    dvsum(l, x) ==
+      opsum [differentiate(first l, x), second l, third l]
+
+    dvdsum(l, x) ==
+      x = retract(y := third l)@SE => 0
+      if member?(x, variables(h := third rest rest l)) or 
+         member?(x, variables(g := third rest l)) then
+        error "a sum cannot be differentiated with respect to a bound"
+      else
+        opdsum [differentiate(first l, x), second l, y, g, h]
+
+    dvprod(l, x) ==
+      dm := retract(dummy)@SE
+      f := eval(first l, retract(second l)@K, dm::F)
+      p := product(f, dm)
+
+      opsum [differentiate(first l, x)/first l * p, second l, third l]
+
+
+    dvdprod(l, x) ==
+      x = retract(y := third l)@SE => 0
+      if member?(x, variables(h := third rest rest l)) or 
+         member?(x, variables(g := third rest l)) then
+        error "a product cannot be differentiated with respect to a bound"
+      else
+        opdsum cons(differentiate(first l, x)/first l, rest l) * opdprod l 
+
+-- These four operations handle the conversion of sums and products to
+-- OutputForm
+
+    dprod l ==
+      prod(summand(l)::O, third(l)::O)
+
+    ddprod l ==
+      prod(summand(l)::O, third(l)::O = fourth(l)::O, fourth(rest l)::O)
+
+    dsum l ==
+      sum(summand(l)::O, third(l)::O)
+
+    ddsum l ==
+      sum(summand(l)::O, third(l)::O = fourth(l)::O, fourth(rest l)::O)
+
+-- The two operations handle the testing for equality of sums and products.
+-- The corresponding property \verb|%specialEqual| set below is checked in
+-- Kernel. Note that we can assume that the operators are equal, since this is
+-- checked in Kernel itself.
+
+    equalsumprod(s1, s2) ==
+      l1 := argument s1
+      l2 := argument s2
+      (eval(first l1, retract(second l1)@K, second l2) = first l2)
+
+    equaldsumprod(s1, s2) ==
+      l1 := argument s1
+      l2 := argument s2
+      ((third rest l1 = third rest l2) and
+       (third rest rest l1 = third rest rest l2) and
+       (eval(first l1, retract(second l1)@K, second l2) = first l2))
+
+-- These two operations return the product or the sum as unevaluated operators
+-- A dummy variable is introduced to make the indexing variable local.
+
+    product(x:F, s:SegmentBinding F) ==
+      k := kernel(variable s)$K
+      dm := dummy
+      opdprod [eval(x,k,dm), dm, k::F, lo segment s, hi segment s]
+
+    summation(x:F, s:SegmentBinding F) ==
+      k := kernel(variable s)$K
+      dm := dummy
+      opdsum [eval(x,k,dm), dm, k::F, lo segment s, hi segment s]
+
+    smpfact(p, l) ==
+      map(x +-> K2fact(x, l), y+->y::F, p)_
+        $PolynomialCategoryLifting(IndexedExponents K, K, R, SMP, F)
+
+    K2fact(k, l) ==
+      empty? [v for v in variables(kf := k::F) | member?(v, l)] => kf
+      empty?(args:List F := [facts(a, l) for a in argument k]) => kf
+      is?(k, opperm) =>
+        factorial(n := first args) / factorial(n - second args)
+      is?(k, opbinom) =>
+        n := first args
+        p := second args
+        factorial(n) / (factorial(p) * factorial(n-p))
+      (operator k) args
+
+    operator op ==
+      is?(op, "factorial"::Symbol)   => opfact
+      is?(op, "permutation"::Symbol) => opperm
+      is?(op, "binomial"::Symbol)    => opbinom
+      is?(op, "summation"::Symbol)   => opsum
+      is?(op, "%defsum"::Symbol)     => opdsum
+      is?(op, "product"::Symbol)     => opprod
+      is?(op, "%defprod"::Symbol)    => opdprod
+      is?(op, POWER)                 => oppow
+      error "Not a combinatorial operator"
+
+    iprod l ==
+      zero? first l => 0
+      (first l = 1) => 1
+      kernel(opprod, l)
+
+    isum l ==
+      zero? first l => 0
+      kernel(opsum, l)
+
+    idprod l ==
+      member?(retract(second l)@SE, variables first l) =>
+        kernel(opdprod, l)
+      first(l) ** (fourth rest l - fourth l + 1)
+
+    idsum l ==
+      member?(retract(second l)@SE, variables first l) =>
+        kernel(opdsum, l)
+      first(l) * (fourth rest l - fourth l + 1)
+
+    ifact x ==
+      zero? x or (x = 1) => 1
+      kernel(opfact, x)
+
+    ibinom l ==
+      n := first l
+      ((p := second l) = 0) or (p = n) => 1
+      (p = 1) or (p = n - 1) => n
+      kernel(opbinom, l)
+
+    iperm l ==
+      zero? second l => 1
+      kernel(opperm, l)
+
+    if R has RetractableTo Z then
+
+      iidsum l ==
+        (r1:=retractIfCan(fourth l)@Union(Z,"failed"))
+         case "failed" or
+          (r2:=retractIfCan(fourth rest l)@Union(Z,"failed"))
+            case "failed" or
+             (k:=retractIfCan(second l)@Union(K,"failed")) case "failed"
+               => idsum l
+        +/[eval(first l,k::K,i::F) for i in r1::Z .. r2::Z]
+
+      iidprod l ==
+        (r1:=retractIfCan(fourth l)@Union(Z,"failed"))
+         case "failed" or
+          (r2:=retractIfCan(fourth rest l)@Union(Z,"failed"))
+            case "failed" or
+             (k:=retractIfCan(second l)@Union(K,"failed")) case "failed"
+               => idprod l
+        */[eval(first l,k::K,i::F) for i in r1::Z .. r2::Z]
+
+      iiipow l ==
+          (u := isExpt(x := first l, OPEXP)) case "failed" => kernel(oppow, l)
+          rec := u::Record(var: K, exponent: Z)
+          y := first argument(rec.var)
+          (r := retractIfCan(y)@Union(Fraction Z, "failed")) case
+              "failed" => kernel(oppow, l)
+          (operator(rec.var)) (rec.exponent * y * second l)
+
+      if F has RadicalCategory then
+
+        ipow l ==
+          (r := retractIfCan(second l)@Union(Fraction Z,"failed"))
+            case "failed" => iiipow l
+          first(l) ** (r::Fraction(Z))
+
+      else
+
+        ipow l ==
+          (r := retractIfCan(second l)@Union(Z, "failed"))
+            case "failed" => iiipow l
+          first(l) ** (r::Z)
+
+    else
+
+      ipow l ==
+        zero?(x := first l) =>
+          zero? second l => error "0 ** 0"
+          0
+        (x = 1) or zero?(n: F := second l) => 1
+        (n = 1) => x
+        (u := isExpt(x, OPEXP)) case "failed" => kernel(oppow, l)
+        rec := u::Record(var: K, exponent: Z)
+        ((y := first argument(rec.var))=1) or y = -1 =>
+            (operator(rec.var)) (rec.exponent * y * n)
+        kernel(oppow, l)
+
+    if R has CombinatorialFunctionCategory then
+
+      iifact x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => ifact x
+        factorial(r::R)::F
+
+      iiperm l ==
+        (r1 := retractIfCan(first l)@Union(R,"failed")) case "failed" or
+          (r2 := retractIfCan(second l)@Union(R,"failed")) case "failed"
+            => iperm l
+        permutation(r1::R, r2::R)::F
+
+      if R has RetractableTo(Z) and F has Algebra(Fraction(Z)) then
+
+         iibinom l ==
+           (s:=retractIfCan(second l)@Union(R,"failed")) case R and
+              (t:=retractIfCan(s)@Union(Z,"failed")) case Z and t>0 =>
+                ans:=1::F
+                for i in 0..t-1 repeat
+                    ans:=ans*(first l - i::R::F)
+                (1/factorial t) * ans
+           (s:=retractIfCan(first l-second l)@Union(R,"failed")) case R and
+             (t:=retractIfCan(s)@Union(Z,"failed")) case Z and t>0 =>
+                ans:=1::F
+                for i in 1..t repeat
+                    ans:=ans*(second l+i::R::F)
+                (1/factorial t) * ans
+           (r1 := retractIfCan(first l)@Union(R,"failed")) case "failed" or
+             (r2 := retractIfCan(second l)@Union(R,"failed")) case "failed"
+               => ibinom l
+           binomial(r1::R, r2::R)::F
+
+-- iibinom checks those cases in which the binomial coefficient may
+-- be evaluated explicitly. Currently, the naive iterative algorithm is
+-- used to calculate the coefficient, there is room for improvement here.
+
+      else
+
+         iibinom l ==
+           (r1 := retractIfCan(first l)@Union(R,"failed")) case "failed" or
+             (r2 := retractIfCan(second l)@Union(R,"failed")) case "failed"
+               => ibinom l
+           binomial(r1::R, r2::R)::F
+
+    else
+
+      iifact x  == ifact x
+
+      iibinom l == ibinom l
+
+      iiperm l  == iperm l
+
+    if R has ElementaryFunctionCategory then
+
+      iipow l ==
+        (r1:=retractIfCan(first l)@Union(R,"failed")) case "failed" or
+          (r2:=retractIfCan(second l)@Union(R,"failed")) case "failed"
+            => ipow l
+        (r1::R ** r2::R)::F
+
+    else
+
+      iipow l == ipow l
+
+    if F has ElementaryFunctionCategory then
+
+      dvpow2 l == if zero?(first l) then
+                    0
+                  else
+                    log(first l) * first(l) ** second(l)
+
+    evaluate(opfact, iifact)$BasicOperatorFunctions1(F)
+    evaluate(oppow, iipow)
+    evaluate(opperm, iiperm)
+    evaluate(opbinom, iibinom)
+    evaluate(opsum, isum)
+    evaluate(opdsum, iidsum)
+    evaluate(opprod, iprod)
+    evaluate(opdprod, iidprod)
+    derivative(oppow, [dvpow1, dvpow2])
+
+-- These four properties define special differentiation rules for sums and 
+-- products. 
+
+    setProperty(opsum,   SPECIALDIFF, dvsum@((List F, SE) -> F) pretend None)
+    setProperty(opdsum,  SPECIALDIFF, dvdsum@((List F, SE)->F) pretend None)
+    setProperty(opprod,  SPECIALDIFF, dvprod@((List F, SE)->F) pretend None)
+    setProperty(opdprod, SPECIALDIFF, dvdprod@((List F, SE)->F) pretend None)
+
+-- Set the properties for displaying sums and products and testing for
+-- equality.
+
+    setProperty(opsum,   SPECIALDISP, dsum@(List F -> O) pretend None)
+    setProperty(opdsum,  SPECIALDISP, ddsum@(List F -> O) pretend None)
+    setProperty(opprod,  SPECIALDISP, dprod@(List F -> O) pretend None)
+    setProperty(opdprod, SPECIALDISP, ddprod@(List F -> O) pretend None)
+    setProperty(opsum,   SPECIALEQUAL, equalsumprod@((K,K) -> Boolean)_
+      pretend None)
+    setProperty(opdsum,  SPECIALEQUAL, equaldsumprod@((K,K) -> Boolean)_
+      pretend None)
+    setProperty(opprod,  SPECIALEQUAL, equalsumprod@((K,K) -> Boolean)_
+      pretend None)
+    setProperty(opdprod, SPECIALEQUAL, equaldsumprod@((K,K) -> Boolean)_
+      pretend None)
+
 *)
 
 \end{chunk}
@@ -9910,6 +13877,7 @@ CommonDenominator(R, Q, A): Exports == Implementation where
       ++ \spad{qi = pi/d} and d is a common denominator for the qi's.
  
   Implementation ==> add
+
     clearDenominator l ==
       d := commonDenominator l
       map(x+->numer(d*x)::Q, l)
@@ -9919,11 +13887,15 @@ CommonDenominator(R, Q, A): Exports == Implementation where
       [map(x+->numer(d*x)::Q, l), d]
  
     if R has GcdDomain then
+
       qlcm: (Q, Q) -> Q
  
       qlcm(a, b)          == lcm(numer a, numer b)::Q
+
       commonDenominator l == numer reduce(qlcm, map(x+->denom(x)::Q, l), 1)
+
     else
+
       commonDenominator l == numer reduce("*", map(x+->denom(x)::Q, l), 1)
 
 \end{chunk}
@@ -9931,6 +13903,27 @@ CommonDenominator(R, Q, A): Exports == Implementation where
 \begin{chunk}{COQ CDEN}
 (* package CDEN *)
 (*
+
+    clearDenominator l ==
+      d := commonDenominator l
+      map(x+->numer(d*x)::Q, l)
+ 
+    splitDenominator l ==
+      d := commonDenominator l
+      [map(x+->numer(d*x)::Q, l), d]
+ 
+    if R has GcdDomain then
+
+      qlcm: (Q, Q) -> Q
+ 
+      qlcm(a, b)          == lcm(numer a, numer b)::Q
+
+      commonDenominator l == numer reduce(qlcm, map(x+->denom(x)::Q, l), 1)
+
+    else
+
+      commonDenominator l == numer reduce("*", map(x+->denom(x)::Q, l), 1)
+
 *)
 
 \end{chunk}
@@ -10012,6 +14005,7 @@ CommonOperators(): Exports == Implementation where
         ++ the result has no semantics.
 
   Implementation ==> add
+
     dpi        : List O -> O
     dgamma     : List O -> O
     dquote     : List O -> O
@@ -10023,96 +14017,170 @@ CommonOperators(): Exports == Implementation where
     brandNew?:Reference(Boolean) := ref true
 
     opalg   := operator("rootOf"::Symbol, 2)$OP
+
     oproot  := operator("nthRoot"::Symbol, 2)
+
     oppi    := operator("pi"::Symbol, 0)
+
     oplog   := operator("log"::Symbol, 1)
+
     opexp   := operator("exp"::Symbol, 1)
+
     opabs   := operator("abs"::Symbol, 1)
+
     opsin   := operator("sin"::Symbol, 1)
+
     opcos   := operator("cos"::Symbol, 1)
+
     optan   := operator("tan"::Symbol, 1)
+
     opcot   := operator("cot"::Symbol, 1)
+
     opsec   := operator("sec"::Symbol, 1)
+
     opcsc   := operator("csc"::Symbol, 1)
+
     opasin  := operator("asin"::Symbol, 1)
+
     opacos  := operator("acos"::Symbol, 1)
+
     opatan  := operator("atan"::Symbol, 1)
+
     opacot  := operator("acot"::Symbol, 1)
+
     opasec  := operator("asec"::Symbol, 1)
+
     opacsc  := operator("acsc"::Symbol, 1)
+
     opsinh  := operator("sinh"::Symbol, 1)
+
     opcosh  := operator("cosh"::Symbol, 1)
+
     optanh  := operator("tanh"::Symbol, 1)
+
     opcoth  := operator("coth"::Symbol, 1)
+
     opsech  := operator("sech"::Symbol, 1)
+
     opcsch  := operator("csch"::Symbol, 1)
+
     opasinh := operator("asinh"::Symbol, 1)
+
     opacosh := operator("acosh"::Symbol, 1)
+
     opatanh := operator("atanh"::Symbol, 1)
+
     opacoth := operator("acoth"::Symbol, 1)
+
     opasech := operator("asech"::Symbol, 1)
+
     opacsch := operator("acsch"::Symbol, 1)
+
     opbox   := operator("%box"::Symbol)$OP
+
     oppren  := operator("%paren"::Symbol)$OP
+
     opquote := operator("applyQuote"::Symbol)$OP
+
     opdiff  := operator("%diff"::Symbol, 3)
+
     opsi    := operator("Si"::Symbol, 1)
+
     opci    := operator("Ci"::Symbol, 1)
+
     opei    := operator("Ei"::Symbol, 1)
+
     opli    := operator("li"::Symbol, 1)
+
     operf   := operator("erf"::Symbol, 1)
+
     opli2   := operator("dilog"::Symbol, 1)
+
     opfis   := operator("fresnelS"::Symbol, 1)
+
     opfic   := operator("fresnelC"::Symbol, 1)
+
     opGamma     := operator("Gamma"::Symbol, 1)
+
     opGamma2    := operator("Gamma2"::Symbol, 2)
+
     opBeta      := operator("Beta"::Symbol, 2)
+
     opdigamma   := operator("digamma"::Symbol, 1)
+
     oppolygamma := operator("polygamma"::Symbol, 2)
+
     opBesselJ   := operator("besselJ"::Symbol, 2)
+
     opBesselY   := operator("besselY"::Symbol, 2)
+
     opBesselI   := operator("besselI"::Symbol, 2)
+
     opBesselK   := operator("besselK"::Symbol, 2)
+
     opAiryAi    := operator("airyAi"::Symbol,  1)
+
     opAiryBi    := operator("airyBi"::Symbol , 1)
+
     opint   := operator("integral"::Symbol, 3)
+
     opdint  := operator("%defint"::Symbol, 5)
+
     opfact  := operator("factorial"::Symbol, 1)
+
     opperm  := operator("permutation"::Symbol, 2)
+
     opbinom := operator("binomial"::Symbol, 2)
+
     oppow   := operator(POWER, 2)
+
     opsum   := operator("summation"::Symbol, 3)
+
     opdsum  := operator("%defsum"::Symbol, 5)
+
     opprod  := operator("product"::Symbol, 3)
+
     opdprod := operator("%defprod"::Symbol, 5)
 
     algop   := [oproot, opalg]$List(OP)
+
     rtrigop := [opsin, opcos, optan, opcot, opsec, opcsc,
                          opasin, opacos, opatan, opacot, opasec, opacsc]
+
     htrigop := [opsinh, opcosh, optanh, opcoth, opsech, opcsch,
                    opasinh, opacosh, opatanh, opacoth, opasech, opacsch]
+
     trigop  := concat(rtrigop, htrigop)
+
     elemop  := concat(trigop, [oppi, oplog, opexp])
+
     primop  := [opei, opli, opsi, opci, operf, opli2, opint, opdint,
                 opfis, opfic]
+
     combop  := [opfact, opperm, opbinom, oppow,
                                          opsum, opdsum, opprod, opdprod]
+
     specop  := [opGamma, opGamma2, opBeta, opdigamma, oppolygamma, opabs,
                 opBesselJ, opBesselY, opBesselI, opBesselK, opAiryAi,
                  opAiryBi]
+
     anyop   := [oppren, opdiff, opbox, opquote]
+
     allop   := concat(concat(concat(concat(concat(
                             algop,elemop),primop),combop),specop),anyop)
 
--- odd and even operators, must be maintained current!
+    -- odd and even operators, must be maintained current!
+
     evenop := [opcos, opsec, opcosh, opsech, opabs]
+
     oddop  := [opsin, opcsc, optan, opcot, opasin, opacsc, opatan,
-               opsinh, opcsch, optanh, opcoth, opasinh, opacsch,opatanh,opacoth,
+               opsinh, opcsch, optanh, opcoth,opasinh, opacsch,opatanh,opacoth,
                 opsi, operf]
 
--- operators whose second argument is a dummy variable
+    -- operators whose second argument is a dummy variable
     dummyvarop1 := [opdiff,opalg, opint, opsum, opprod]
--- operators whose second and third arguments are dummy variables
+
+    -- operators whose second and third arguments are dummy variables
     dummyvarop2 := [opdint, opdsum, opdprod]
 
     operator s ==
@@ -10122,9 +14190,13 @@ CommonOperators(): Exports == Implementation where
       operator(s)$OP
 
     dpi l    == "%pi"::Symbol::O
+
     dfact x  == postfix("!"::Symbol::O, (ATOM(x)$Lisp => x; paren x))
+
     dquote l == prefix(quote(first(l)::O), rest l)
+
     dgamma l == prefix(hconcat("|"::Symbol::O, overbar(" "::Symbol::O)), l)
+
     setDummyVar(op, n) == setProperty(op, DUMMYVAR, n pretend None)
 
     dexp x ==
@@ -10133,9 +14205,13 @@ CommonOperators(): Exports == Implementation where
       e ** x
 
     fsupersub(x:List O):O == supersub("A"::Symbol::O, x)
+
     fbinomial(x:List O):O == binomial(first x, second x)
+
     fpower(x:List O):O    == first(x) ** second(x)
+
     fsum(x:List O):O      == sum(first x, second x, third x)
+
     fprod(x:List O):O     == prod(first x, second x, third x)
 
     fint(x:List O):O      ==
@@ -10191,6 +14267,263 @@ CommonOperators(): Exports == Implementation where
 \begin{chunk}{COQ COMMONOP}
 (* package COMMONOP *)
 (*
+
+    dpi        : List O -> O
+    dgamma     : List O -> O
+    dquote     : List O -> O
+    dexp       : O -> O
+    dfact      : O -> O
+    startUp    : Boolean -> Void
+    setDummyVar: (OP, NonNegativeInteger) -> OP
+
+    brandNew?:Reference(Boolean) := ref true
+
+    opalg   := operator("rootOf"::Symbol, 2)$OP
+
+    oproot  := operator("nthRoot"::Symbol, 2)
+
+    oppi    := operator("pi"::Symbol, 0)
+
+    oplog   := operator("log"::Symbol, 1)
+
+    opexp   := operator("exp"::Symbol, 1)
+
+    opabs   := operator("abs"::Symbol, 1)
+
+    opsin   := operator("sin"::Symbol, 1)
+
+    opcos   := operator("cos"::Symbol, 1)
+
+    optan   := operator("tan"::Symbol, 1)
+
+    opcot   := operator("cot"::Symbol, 1)
+
+    opsec   := operator("sec"::Symbol, 1)
+
+    opcsc   := operator("csc"::Symbol, 1)
+
+    opasin  := operator("asin"::Symbol, 1)
+
+    opacos  := operator("acos"::Symbol, 1)
+
+    opatan  := operator("atan"::Symbol, 1)
+
+    opacot  := operator("acot"::Symbol, 1)
+
+    opasec  := operator("asec"::Symbol, 1)
+
+    opacsc  := operator("acsc"::Symbol, 1)
+
+    opsinh  := operator("sinh"::Symbol, 1)
+
+    opcosh  := operator("cosh"::Symbol, 1)
+
+    optanh  := operator("tanh"::Symbol, 1)
+
+    opcoth  := operator("coth"::Symbol, 1)
+
+    opsech  := operator("sech"::Symbol, 1)
+
+    opcsch  := operator("csch"::Symbol, 1)
+
+    opasinh := operator("asinh"::Symbol, 1)
+
+    opacosh := operator("acosh"::Symbol, 1)
+
+    opatanh := operator("atanh"::Symbol, 1)
+
+    opacoth := operator("acoth"::Symbol, 1)
+
+    opasech := operator("asech"::Symbol, 1)
+
+    opacsch := operator("acsch"::Symbol, 1)
+
+    opbox   := operator("%box"::Symbol)$OP
+
+    oppren  := operator("%paren"::Symbol)$OP
+
+    opquote := operator("applyQuote"::Symbol)$OP
+
+    opdiff  := operator("%diff"::Symbol, 3)
+
+    opsi    := operator("Si"::Symbol, 1)
+
+    opci    := operator("Ci"::Symbol, 1)
+
+    opei    := operator("Ei"::Symbol, 1)
+
+    opli    := operator("li"::Symbol, 1)
+
+    operf   := operator("erf"::Symbol, 1)
+
+    opli2   := operator("dilog"::Symbol, 1)
+
+    opfis   := operator("fresnelS"::Symbol, 1)
+
+    opfic   := operator("fresnelC"::Symbol, 1)
+
+    opGamma     := operator("Gamma"::Symbol, 1)
+
+    opGamma2    := operator("Gamma2"::Symbol, 2)
+
+    opBeta      := operator("Beta"::Symbol, 2)
+
+    opdigamma   := operator("digamma"::Symbol, 1)
+
+    oppolygamma := operator("polygamma"::Symbol, 2)
+
+    opBesselJ   := operator("besselJ"::Symbol, 2)
+
+    opBesselY   := operator("besselY"::Symbol, 2)
+
+    opBesselI   := operator("besselI"::Symbol, 2)
+
+    opBesselK   := operator("besselK"::Symbol, 2)
+
+    opAiryAi    := operator("airyAi"::Symbol,  1)
+
+    opAiryBi    := operator("airyBi"::Symbol , 1)
+
+    opint   := operator("integral"::Symbol, 3)
+
+    opdint  := operator("%defint"::Symbol, 5)
+
+    opfact  := operator("factorial"::Symbol, 1)
+
+    opperm  := operator("permutation"::Symbol, 2)
+
+    opbinom := operator("binomial"::Symbol, 2)
+
+    oppow   := operator(POWER, 2)
+
+    opsum   := operator("summation"::Symbol, 3)
+
+    opdsum  := operator("%defsum"::Symbol, 5)
+
+    opprod  := operator("product"::Symbol, 3)
+
+    opdprod := operator("%defprod"::Symbol, 5)
+
+    algop   := [oproot, opalg]$List(OP)
+
+    rtrigop := [opsin, opcos, optan, opcot, opsec, opcsc,
+                         opasin, opacos, opatan, opacot, opasec, opacsc]
+
+    htrigop := [opsinh, opcosh, optanh, opcoth, opsech, opcsch,
+                   opasinh, opacosh, opatanh, opacoth, opasech, opacsch]
+
+    trigop  := concat(rtrigop, htrigop)
+
+    elemop  := concat(trigop, [oppi, oplog, opexp])
+
+    primop  := [opei, opli, opsi, opci, operf, opli2, opint, opdint,
+                opfis, opfic]
+
+    combop  := [opfact, opperm, opbinom, oppow,
+                                         opsum, opdsum, opprod, opdprod]
+
+    specop  := [opGamma, opGamma2, opBeta, opdigamma, oppolygamma, opabs,
+                opBesselJ, opBesselY, opBesselI, opBesselK, opAiryAi,
+                 opAiryBi]
+
+    anyop   := [oppren, opdiff, opbox, opquote]
+
+    allop   := concat(concat(concat(concat(concat(
+                            algop,elemop),primop),combop),specop),anyop)
+
+    -- odd and even operators, must be maintained current!
+
+    evenop := [opcos, opsec, opcosh, opsech, opabs]
+
+    oddop  := [opsin, opcsc, optan, opcot, opasin, opacsc, opatan,
+               opsinh, opcsch, optanh, opcoth,opasinh, opacsch,opatanh,opacoth,
+                opsi, operf]
+
+    -- operators whose second argument is a dummy variable
+    dummyvarop1 := [opdiff,opalg, opint, opsum, opprod]
+
+    -- operators whose second and third arguments are dummy variables
+    dummyvarop2 := [opdint, opdsum, opdprod]
+
+    operator s ==
+      if (deref brandNew?) then startUp false
+      for op in allop repeat
+        is?(op, s) => return copy op
+      operator(s)$OP
+
+    dpi l    == "%pi"::Symbol::O
+
+    dfact x  == postfix("!"::Symbol::O, (ATOM(x)$Lisp => x; paren x))
+
+    dquote l == prefix(quote(first(l)::O), rest l)
+
+    dgamma l == prefix(hconcat("|"::Symbol::O, overbar(" "::Symbol::O)), l)
+
+    setDummyVar(op, n) == setProperty(op, DUMMYVAR, n pretend None)
+
+    dexp x ==
+      e := "%e"::Symbol::O
+      x = 1::O => e
+      e ** x
+
+    fsupersub(x:List O):O == supersub("A"::Symbol::O, x)
+
+    fbinomial(x:List O):O == binomial(first x, second x)
+
+    fpower(x:List O):O    == first(x) ** second(x)
+
+    fsum(x:List O):O      == sum(first x, second x, third x)
+
+    fprod(x:List O):O     == prod(first x, second x, third x)
+
+    fint(x:List O):O      ==
+       int(first x * hconcat("d"::Symbol::O, second x),empty(), third x)
+
+    fpren(x:List InputForm):InputForm  ==
+       convert concat(convert("("::Symbol)@InputForm,
+                            concat(x, convert(")"::Symbol)@InputForm))
+
+    fpow(x:List InputForm):InputForm  ==
+       convert concat(convert("**"::Symbol)@InputForm, x)
+
+    froot(x:List InputForm):InputForm  ==
+       convert [convert("**"::Symbol)@InputForm, first x, 1 / second x]
+
+    startUp b ==
+      brandNew?() := b
+      display(oppren,   paren)
+      display(opbox,    commaSeparate)
+      display(oppi,     dpi)
+      display(opexp,    dexp)
+      display(opGamma,  dgamma)
+      display(opGamma2, dgamma)
+      display(opfact,   dfact)
+      display(opquote,  dquote)
+      display(opperm,   fsupersub)
+      display(opbinom,  fbinomial)
+      display(oppow,    fpower)
+      display(opsum,    fsum)
+      display(opprod,   fprod)
+      display(opint,    fint)
+      input(oppren,     fpren)
+      input(oppow,      fpow)
+      input(oproot,     froot)
+      for op in algop   repeat assert(op, ALGOP)
+      for op in rtrigop repeat assert(op, "rtrig")
+      for op in htrigop repeat assert(op, "htrig")
+      for op in trigop  repeat assert(op, "trig")
+      for op in elemop  repeat assert(op, "elem")
+      for op in primop  repeat assert(op, "prim")
+      for op in combop  repeat assert(op, "comb")
+      for op in specop  repeat assert(op, "special")
+      for op in anyop   repeat assert(op, "any")
+      for op in evenop  repeat assert(op, EVEN)
+      for op in oddop   repeat assert(op, ODD)
+      for op in dummyvarop1 repeat setDummyVar(op, 1)
+      for op in dummyvarop2 repeat setDummyVar(op, 2)
+      assert(oppren, "linear")
+      void
+
 *)
 
 \end{chunk}
@@ -10264,9 +14597,10 @@ CommuteUnivariatePolynomialCategory(R, UP, UPUP): Exports == Impl where
       ++ swap(p(x,y)) returns p(y,x).
 
   Impl ==> add
+
     makePoly: (UP, N) -> UPUP
 
--- converts P(x,y) to P(y,x)
+    -- converts P(x,y) to P(y,x)
     swap poly ==
       ans:UPUP := 0
       while poly ^= 0 repeat
@@ -10287,6 +14621,25 @@ CommuteUnivariatePolynomialCategory(R, UP, UPUP): Exports == Impl where
 \begin{chunk}{COQ COMMUPC}
 (* package COMMUPC *)
 (*
+
+    makePoly: (UP, N) -> UPUP
+
+    -- converts P(x,y) to P(y,x)
+    swap poly ==
+      ans:UPUP := 0
+      while poly ^= 0 repeat
+        ans  := ans + makePoly(leadingCoefficient poly, degree poly)
+        poly := reductum poly
+      ans
+
+    makePoly(poly, d) ==
+      ans:UPUP := 0
+      while poly ^= 0 repeat
+        ans  := ans +
+             monomial(monomial(leadingCoefficient poly, d), degree poly)
+        poly := reductum poly
+      ans
+
 *)
 
 \end{chunk}
@@ -10361,6 +14714,7 @@ ComplexFactorization(RR,PR) : C == T where
        ++ factor(p) factorizes the polynomial p with complex coefficients.
 
   T  == add
+
      SUP    ==> SparseUnivariatePolynomial
      fUnion ==> Union("nil", "sqfr", "irred", "prime")
      FF     ==> Record(flg:fUnion, fctr:PR, xpnt:Integer)
@@ -10426,6 +14780,67 @@ ComplexFactorization(RR,PR) : C == T where
 \begin{chunk}{COQ COMPFACT}
 (* package COMPFACT *)
 (*
+
+     SUP    ==> SparseUnivariatePolynomial
+     fUnion ==> Union("nil", "sqfr", "irred", "prime")
+     FF     ==> Record(flg:fUnion, fctr:PR, xpnt:Integer)
+     SAEF   :=  SimpleAlgebraicExtensionAlgFactor(SUP RN,GRN,SUP GRN)
+     UPCF2  :=  UnivariatePolynomialCategoryFunctions2(R,PR,GRN,SUP GRN)
+     UPCFB  :=  UnivariatePolynomialCategoryFunctions2(GRN,SUP GRN,R,PR)
+
+     myMap(r:R) : GRN ==
+       R is GI   =>
+         cr :GI := r pretend GI
+         complex((real cr)::RN,(imag cr)::RN)
+       R is GRN  => r pretend GRN
+
+     compND(cc:GRN):Record(cnum:GI,cden:Integer) ==
+       ccr:=real cc
+       cci:=imag cc
+       dccr:=denom ccr
+       dcci:=denom cci
+       ccd:=lcm(dccr,dcci)
+       [complex(((ccd exquo dccr)::Integer)*numer ccr,
+                ((ccd exquo dcci)::Integer)*numer cci),ccd]
+
+     conv(f:SUP GRN) :Record(convP:SUP GI, convD:RN) ==
+       pris:SUP GI :=0
+       dris:Integer:=1
+       dris1:Integer:=1
+       pdris:Integer:=1
+       for i in 0..(degree f) repeat
+         (cf:= coefficient(f,i)) = 0 => "next i"
+         cdf:=compND cf
+         dris:=lcm(cdf.cden,dris1)
+         pris:=((dris exquo dris1)::Integer)*pris +
+               ((dris exquo cdf.cden)::Integer)*
+                 monomial(cdf.cnum,i)$(SUP GI)
+         dris1:=dris
+       [pris,dris::RN]
+
+     backConv(ffr:Factored SUP GRN) : Factored PR ==
+       R is GRN =>
+         makeFR((unit ffr) pretend PR,[[f.flg,(f.fctr) pretend PR,f.xpnt]
+                                        for f in factorList ffr])
+       R is GI  =>
+         const:=unit ffr
+         ris: List FF :=[]
+         for ff in factorList ffr repeat
+           fact:=primitivePart(conv(ff.fctr).convP)
+           expf:=ff.xpnt
+           ris:=cons([ff.flg,fact pretend PR,expf],ris)
+           lc:GRN := myMap leadingCoefficient(fact pretend PR)
+           const:= const*(leadingCoefficient(ff.fctr)/lc)**expf
+         uconst:GI:= compND(coefficient(const,0)).cnum
+         makeFR((uconst pretend R)::PR,ris)
+
+
+     factor(pol : PR)  : Factored PR ==
+       ratPol:SUP GRN := 0
+       ratPol:=map(myMap,pol)$UPCF2
+       ffr:=factor ratPol
+       backConv ffr
+
 *)
 
 \end{chunk}
@@ -10490,6 +14905,7 @@ ComplexFunctions2(R:CommutativeRing, S:CommutativeRing): with
     map:     (R -> S, Complex R) -> Complex S
       ++ map(f,u) maps f onto real and imaginary parts of u.
  == add
+
     map(fn, gr) == complex(fn real gr, fn imag gr)
 
 \end{chunk}
@@ -10497,6 +14913,9 @@ ComplexFunctions2(R:CommutativeRing, S:CommutativeRing): with
 \begin{chunk}{COQ COMPLEX2}
 (* package COMPLEX2 *)
 (*
+
+    map(fn, gr) == complex(fn real gr, fn imag gr)
+
 *)
 
 \end{chunk}
@@ -10573,9 +14992,13 @@ ComplexIntegerSolveLinearPolynomialEquation(R,CR): C == T
                    ++ equivalently g/prod fj = sum (ai/fi)
                    ++ or returns "failed" if no such list exists
   T == add
+
       oldlp:List CP := []
+
       slpePrime:R:=(2::R)
+
       oldtable:Vector List CP := empty()
+
       solveLinearPolynomialEquation(lp,p) ==
          if (oldlp ^= lp) then
             -- we have to generate a new table
@@ -10599,6 +15022,31 @@ ComplexIntegerSolveLinearPolynomialEquation(R,CR): C == T
 \begin{chunk}{COQ CINTSLPE}
 (* package CINTSLPE *)
 (*
+
+      oldlp:List CP := []
+
+      slpePrime:R:=(2::R)
+
+      oldtable:Vector List CP := empty()
+
+      solveLinearPolynomialEquation(lp,p) ==
+         if (oldlp ^= lp) then
+            -- we have to generate a new table
+            deg:= _+/[degree u for u in lp]
+            ans:Union(Vector List CP,"failed"):="failed"
+            slpePrime:=67108859::R   -- 2**26 -5 : a prime
+                 -- a good test case for this package is
+                 --  (good question?)
+            while (ans case "failed") repeat
+              ans:=tablePow(deg,complex(slpePrime,0),lp)$GenExEuclid(CR,CP)
+              if (ans case "failed") then
+                 slpePrime:=  slpePrime-4::R
+                 while not prime?(slpePrime)$IntegerPrimesPackage(R) repeat
+                   slpePrime:= slpePrime-4::R
+            oldtable:=(ans:: Vector List CP)
+         answer:=solveid(p,complex(slpePrime,0),oldtable)
+         answer
+
 *)
 
 \end{chunk}
@@ -10680,6 +15128,13 @@ ComplexPattern(R, S, CS) : C == T where
 \begin{chunk}{COQ COMPLPAT}
 (* package COMPLPAT *)
 (*
+
+       ipat : Pattern R := patternVariable("%i"::Symbol, true, false, false)
+
+       convert(cs) ==
+          zero? imag cs => convert real cs
+          convert real cs + ipat * convert imag cs
+
 *)
 
 \end{chunk}
@@ -10771,6 +15226,7 @@ ComplexPatternMatch(R, S, CS) : C == T where
        makePoly(cs:CS):PS == real(cs)*ivar + imag(cs)::PS
 
        if PS has PatternMatchable(R) then
+
           patternMatch(cs, pat, result) ==
              zero? imag cs =>
                 patternMatch(real cs, pat, result)
@@ -10782,6 +15238,30 @@ ComplexPatternMatch(R, S, CS) : C == T where
 \begin{chunk}{COQ CPMATCH}
 (* package CPMATCH *)
 (*
+
+       import PatternMatchPushDown(R, S, CS)
+       import PatternMatchResultFunctions2(R, PS, CS)
+       import PatternMatchResultFunctions2(R, CS, PS)
+
+       ivar : PS := "%i"::Symbol::PS
+
+       makeComplex(p:PS):CS ==
+          up := univariate p
+          degree up > 1 => error "not linear in %i"
+          icoef:=leadingCoefficient(up)
+          rcoef:=leadingCoefficient(reductum p)
+          complex(rcoef,icoef)
+
+       makePoly(cs:CS):PS == real(cs)*ivar + imag(cs)::PS
+
+       if PS has PatternMatchable(R) then
+
+          patternMatch(cs, pat, result) ==
+             zero? imag cs =>
+                patternMatch(real cs, pat, result)
+             map(makeComplex,
+                patternMatch(makePoly cs, pat, map(makePoly, result)))
+
 *)
 
 \end{chunk}
@@ -11016,7 +15496,6 @@ ComplexRootFindingPackage(R, UP): public == private where
 
    private ==> add
 
-
      Rep := ModMonic(C, UP)
 
      -- constants
@@ -11029,8 +15508,8 @@ ComplexRootFindingPackage(R, UP): public == private where
        a : R := (1000 :: I) :: R
        1/a
      emptyLine : OF := "  "
-     dashes : OF := center "---------------------------------------------------"
-     dots : OF :=   center "..................................................."
+     dashes: OF := center "---------------------------------------------------"
+     dots : OF :=  center "..................................................."
      one : R := 1$R
      two : R := 2 * one
      ten : R := 10 * one
@@ -11068,7 +15547,6 @@ ComplexRootFindingPackage(R, UP): public == private where
 
      -- implementation of exported functions
 
-
      complexZeros(p,eps) ==
        --r1 : R := rootRadius(p,weakEps)
        --eps0 : R = r1 * nthRoot(eps, degree p)
@@ -11078,6 +15556,7 @@ ComplexRootFindingPackage(R, UP): public == private where
        [-coefficient(linfac.factor,0) for linfac in factors facs]
 
      complexZeros p == complexZeros(p,globalEps)
+
      setErrorBound r ==
        r <= 0 => error "setErrorBound: need error bound greater 0"
        globalEps := r
@@ -11098,9 +15577,8 @@ ComplexRootFindingPackage(R, UP): public == private where
          p := p quo monomial(1,md)$UP
        sP : Record(start: UP, factors: FR UP) := startPolynomial p
        fp : FR UP := sP.factors
---       if not one? fp then
        if not (fp = 1) then
-         qr: Record(quotient: UP, remainder: UP):= divide(p,makeMonic expand fp)
+         qr: Record(quotient: UP, remainder: UP):=divide(p,makeMonic expand fp)
          p := qr.quotient
        st := sP.start
        zero? degree st => fp
@@ -11133,7 +15611,6 @@ ComplexRootFindingPackage(R, UP): public == private where
 
        for fac in split.factors repeat
          fp :=
---           one? degree fac => fp * nilFactor(fac,1)$(FR UP)
            (degree fac = 1) => fp * nilFactor(fac,1)$(FR UP)
            fp * irreducibleFactor(fac,1)$(FR UP)
        fp
@@ -11141,7 +15618,6 @@ ComplexRootFindingPackage(R, UP): public == private where
      startPolynomial p == -- assume minimumDegree is 0
        --print (p :: OF)
        fp : FR UP := 1
---       one? degree p =>
        (degree p = 1) =>
          p := makeMonic p
          [p,irreducibleFactor(p,1)]
@@ -11149,7 +15625,8 @@ ComplexRootFindingPackage(R, UP): public == private where
        eps : R := weakEps   -- 10 per cent errors allowed
        r1 : R := rootRadius(p, eps)
        rd : R := 1/rootRadius(reciprocalPolynomial p, eps)
-       (r1 > (2::R)) and (rd < 1/(2::R)) => [startPoly,fp] -- unit circle splitting!
+       -- unit circle splitting!
+       (r1 > (2::R)) and (rd < 1/(2::R)) => [startPoly,fp] 
        -- otherwise the norms of the roots are too closed so we
        -- take the center of gravity as new origin:
        u  : C := schwerpunkt p
@@ -11235,8 +15712,6 @@ ComplexRootFindingPackage(R, UP): public == private where
          aBack := cons(ak, aBack)
        gp
 
-
-
      rootRadius(p,errorQuotient) ==
        errorQuotient <= 1$R =>
          error "rootRadius: second Parameter must be greater than 1"
@@ -11262,7 +15737,7 @@ ComplexRootFindingPackage(R, UP): public == private where
      schwerpunkt p ==
        zero? p => 0$C
        zero? (d := degree p) => error _
-       "schwerpunkt: non-zero const. polynomial has no roots and no schwerpunkt"
+        "schwerpunkt: non-zero const. poly has no roots and no schwerpunkt"
        -- coeffient of x**d and x**(d-1)
        lC : C :=  coefficient(p,d)  -- ^= 0
        nC : C :=  coefficient(p,(d-1) pretend NNI)
@@ -11306,6 +15781,7 @@ ComplexRootFindingPackage(R, UP): public == private where
      divisorCascade(p, tp) == divisorCascade(p, tp, false)
 
      factor(poly,eps) == factor(poly,eps,false)
+
      factor(p) == factor(p, globalEps)
 
      factor(poly,eps,info) ==
@@ -11316,12 +15792,11 @@ ComplexRootFindingPackage(R, UP): public == private where
        --eps0 : R := eps / den
        -- for now only
        eps0 : R := eps / (ten*ten)
---       one? d  => irreducibleFactor(poly,1)$(FR UP)
        (d = 1) => irreducibleFactor(poly,1)$(FR UP)
        listOfFactors : L Record(factor: UP,exponent: I) :=_
          list [makeMonic poly,1]
        if info then
-         lof : L OF := [dashes,dots,"list of Factors:",dots,listOfFactors::OF, _
+         lof: L OF := [dashes,dots,"list of Factors:",dots,listOfFactors::OF, _
            dashes, "list of Linear Factors:", dots, result::OF, _
            dots,dashes]
          print vconcat lof
@@ -11333,7 +15808,6 @@ ComplexRootFindingPackage(R, UP): public == private where
            lof : L OF := ["just now we try to split the polynomial:",p::OF]
            print vconcat lof
          split : FR UP  := pleskenSplit(p, eps0, info)
---         one? numberOfFactors split =>
          (numberOfFactors split = 1) =>
            -- in a later version we will change error bound and
            -- accuracy here to deal this case as well
@@ -11347,7 +15821,6 @@ ComplexRootFindingPackage(R, UP): public == private where
          for rec in factors(split)$(FR UP) repeat
            newFactor : UP := rec.factor
            expOfFactor := exponentOfp * rec.exponent
---           one? degree newFactor =>
            (degree newFactor = 1) =>
              result := result * nilFactor(newFactor,expOfFactor)
            listOfFactors:=cons([newFactor,expOfFactor],_
@@ -11357,12 +15830,15 @@ ComplexRootFindingPackage(R, UP): public == private where
      -- implementation of local functions
 
      absC c == nthRoot(norm(c)$C,2)
+
      absR r ==
        r < 0 => -r
        r
+
      min(fae1,fae2) ==
        fae2.error <  fae1.error => fae2
        fae1
+
      calculateScale p ==
        d  := degree p
        maxi :R := 0
@@ -11381,6 +15857,7 @@ ComplexRootFindingPackage(R, UP): public == private where
        while maxi < rho repeat rho := rho / ten
        rho = 0 => one
        rho
+
      makeMonic p  ==
        p = 0 => p
        monomial(1,degree p)$UP + (reductum p)/(leadingCoefficient p)
@@ -11427,6 +15904,7 @@ ComplexRootFindingPackage(R, UP): public == private where
           gp    := gp + monomial(coef,i)
           pp    := reductum pp
        gp
+
      shift2(p,c) ==
        d := degree p
        cc : C := 1
@@ -11440,6 +15918,7 @@ ComplexRootFindingPackage(R, UP): public == private where
            cc := cc + coef.i * (binomial(i,j)$ICF :: R)
          res := res + monomial(cc,j)$UP
        res
+
      scale2(p,c) ==
        d := degree p
        cc : C := 1
@@ -11449,8 +15928,11 @@ ComplexRootFindingPackage(R, UP): public == private where
        res : UP := 0
        for i in 0..d repeat  res := res + monomial(coef.(i+1),i)$UP
        res
+
      scale2: (UP,C) -> UP
+
      shift2: (UP,C) ->  UP
+
      graeffe2 : UP -> UP
        ++ graeffe2 p determines q such that \spad{q(-z**2) = p(z)*p(-z)}.
        ++ Note that the roots of q are the squares of the roots of p.
@@ -11460,6 +15942,448 @@ ComplexRootFindingPackage(R, UP): public == private where
 \begin{chunk}{COQ CRFP}
 (* package CRFP *)
 (*
+
+     Rep := ModMonic(C, UP)
+
+     -- constants
+     c : C
+     r : R
+     --globalDigits : I := 10 ** 41
+     globalDigits : I := 10 ** 7
+     globalEps : R :=
+       --a : R := (1000000000000000000000 :: I) :: R
+       a : R := (1000 :: I) :: R
+       1/a
+     emptyLine : OF := "  "
+     dashes: OF := center "---------------------------------------------------"
+     dots : OF :=  center "..................................................."
+     one : R := 1$R
+     two : R := 2 * one
+     ten : R := 10 * one
+     eleven : R := 11 * one
+     weakEps := eleven/ten
+     --invLog2 : R := 1/log10 (2*one)
+
+     -- signatures of local functions
+
+     absC : C -> R
+       --
+     absR : R -> R
+       --
+     calculateScale : UP -> R
+       --
+     makeMonic : UP -> UP
+       -- 'makeMonic p' divides 'p' by the leading coefficient,
+       -- to guarantee new leading coefficient to be 1$R  we cannot
+       -- simply divide the leading monomial by the leading coefficient
+       -- because of possible rounding errors
+     min: (FAE, FAE) -> FAE
+       -- takes factorization with smaller error
+     nthRoot : (R, NNI) -> R
+       -- nthRoot(r,n) determines an approximation to the n-th
+       -- root of r, if \spadtype{R} has ?**?: (R,Fraction Integer)->R
+       -- we use this, otherwise we use approxNthRoot via
+       -- \spadtype{Integer}
+     shift: (UP,C) ->  UP
+       -- shift(p,c) changes p(x) into p(x+c), thereby modifying the
+       -- roots u_j of p to the roots (u_j - c)  of shift(p,c)
+     scale: (UP,C) -> UP
+       -- scale(p,c) changes p(x) into p(cx), thereby modifying the
+       -- roots u_j of p to the roots ((1/c) u_j)  of scale(p,c)
+
+
+     -- implementation of exported functions
+
+     complexZeros(p,eps) ==
+       --r1 : R := rootRadius(p,weakEps)
+       --eps0 : R = r1 * nthRoot(eps, degree p)
+       -- right now we are content with
+       eps0 : R := eps/(ten ** degree p)
+       facs : FR UP := factor(p,eps0)
+       [-coefficient(linfac.factor,0) for linfac in factors facs]
+
+     complexZeros p == complexZeros(p,globalEps)
+
+     setErrorBound r ==
+       r <= 0 => error "setErrorBound: need error bound greater 0"
+       globalEps := r
+       if R has QuotientFieldCategory Integer then
+         rd : Integer := ceiling(1/r)
+         globalDigits := rd * rd * 10
+         lof : List OF := _
+           ["setErrorBound: internal digits set to",globalDigits::OF]
+         print hconcat lof
+       messagePrint  "setErrorBound: internal error bound set to"
+       globalEps
+
+     pleskenSplit(poly,eps,info) ==
+       p := makeMonic poly
+       fp : FR UP
+       if not zero? (md := minimumDegree p) then
+         fp : FR UP := irreducibleFactor(monomial(1,1)$UP,md)$(FR UP)
+         p := p quo monomial(1,md)$UP
+       sP : Record(start: UP, factors: FR UP) := startPolynomial p
+       fp : FR UP := sP.factors
+       if not (fp = 1) then
+         qr: Record(quotient: UP, remainder: UP):=divide(p,makeMonic expand fp)
+         p := qr.quotient
+       st := sP.start
+       zero? degree st => fp
+         -- we calculate in ModMonic(C, UP),
+         -- next line defines the polynomial, which is used for reducing
+       setPoly p
+       nm : R := eps
+       split : FAE
+       sR : Rep := st :: Rep
+       psR : Rep := sR ** (degree poly)
+
+       notFoundSplit : Boolean := true
+       while notFoundSplit repeat
+       --  if info then
+       --    lof : L OF := ["not successfull, new exponent:", nn::OF]
+       --    print hconcat lof
+         psR := psR * psR * sR   -- exponent (2*d +1)
+         -- be careful, too large exponent results in rounding errors
+         -- tp is the first approximation of a divisor of poly:
+         tp : UP  := lift psR
+         zero? degree tp  =>
+           if info then print "we leave as we got constant factor"
+           nilFactor(poly,1)$(FR UP)
+         -- this was the case where we don't find a non-trivial factorization
+         -- we refine tp by repeated polynomial division and hope that
+         -- the norm of the remainder gets small  from time to time
+         splits : L FAE :=  divisorCascade(p, makeMonic tp, info)
+         split := reduce(min,splits)
+         notFoundSplit := (eps <=  split.error)
+
+       for fac in split.factors repeat
+         fp :=
+           (degree fac = 1) => fp * nilFactor(fac,1)$(FR UP)
+           fp * irreducibleFactor(fac,1)$(FR UP)
+       fp
+
+     startPolynomial p == -- assume minimumDegree is 0
+       --print (p :: OF)
+       fp : FR UP := 1
+       (degree p = 1) =>
+         p := makeMonic p
+         [p,irreducibleFactor(p,1)]
+       startPoly : UP := monomial(1,1)$UP
+       eps : R := weakEps   -- 10 per cent errors allowed
+       r1 : R := rootRadius(p, eps)
+       rd : R := 1/rootRadius(reciprocalPolynomial p, eps)
+       -- unit circle splitting!
+       (r1 > (2::R)) and (rd < 1/(2::R)) => [startPoly,fp] 
+       -- otherwise the norms of the roots are too closed so we
+       -- take the center of gravity as new origin:
+       u  : C := schwerpunkt p
+       startPoly := startPoly-monomial(u,0)
+       p := shift(p,-u)
+       -- determine new rootRadius:
+       r1 : R := rootRadius(p, eps)
+       startPoly := startPoly/(r1::C)
+       -- use one of the 4 points r1*zeta, where zeta is a 4th root of unity
+       -- as new origin, this could be changed to an arbitrary list
+       -- of elements of norm 1.
+       listOfCenters : L C := [complex(r1,0), complex(0,r1), _
+         complex(-r1,0), complex(0,-r1)]
+       lp   : L UP := [shift(p,v) for v in listOfCenters]
+       -- next we check if one of these centers is a root
+       centerIsRoot : Boolean := false
+       for i in 1..maxIndex lp repeat
+         if (mD := minimumDegree lp.i) > 0 then
+           pp : UP := monomial(1,1)-monomial(listOfCenters.i-u,0)
+           centerIsRoot := true
+           fp := fp * irreducibleFactor(pp,mD)
+       centerIsRoot =>
+         p := shift(p,u) quo expand fp
+         --print (p::OF)
+         zero? degree p => [p,fp]
+         sP:= startPolynomial(p)
+         [sP.start,fp]
+       -- choose the best one w.r.t. maximal quotient of norm of largest
+       -- root and norm of smallest root
+       lpr1 : L R := [rootRadius(q,eps) for  q in lp]
+       lprd : L R := [1/rootRadius(reciprocalPolynomial q,eps) for  q in lp]
+       -- later we should check here of an rd is smaller than globalEps
+       lq : L R := []
+       for i in 1..maxIndex lpr1 repeat
+         lq := cons(lpr1.i/lprd.i, lq)
+       --lq : L R := [(l/s)::R for l in lpr1 for s in lprd])
+       lq := reverse lq
+       po := position(reduce(max,lq),lq)
+       --p := lp.po
+       --lrr : L R := [rootRadius(p,i,1+eps) for i in 2..(degree(p)-1)]
+       --lrr := concat(concat(lpr1.po,lrr),lprd.po)
+       --lu : L R := [(lrr.i + lrr.(i+1))/2 for i in 1..(maxIndex(lrr)-1)]
+       [startPoly - monomial(listOfCenters.po,0),fp]
+
+     norm p ==
+      -- reduce(_+$R,map(absC,coefficients p))
+      nm : R := 0
+      for c in  coefficients p repeat
+        nm := nm + absC c
+      nm
+
+     pleskenSplit(poly,eps) == pleskenSplit(poly,eps,false)
+
+     graeffe p ==
+       -- If  p = ao x**n + a1 x**(n-1) + ... + a<n-1> x + an
+       -- and q = bo x**n + b1 x**(n-1) + ... + b<n-1> x + bn
+       -- are such that q(-x**2) = p(x)p(-x), then
+       -- bk := ak**2 + 2 * ((-1) * a<k-1>*a<k+1> + ... +
+       --                    (-1)**l * a<l>*a<l>) where l = min(k, n-k).
+       -- graeffe(p) constructs q using these identities.
+       n   : NNI  := degree p
+       aForth : L C := []
+       for k in 0..n repeat  --  aForth = [a0, a1, ..., a<n-1>, an]
+         aForth := cons(coefficient(p, k::NNI), aForth)
+       aBack  : L C := [] --  after k steps
+                             --  aBack = [ak, a<k-1>, ..., a1, a0]
+       gp : UP := 0$UP
+       for k in 0..n repeat
+         ak : C := first aForth
+         aForth := rest aForth
+         aForthCopy : L C := aForth  -- we iterate over aForth and
+         aBackCopy  : L C := aBack   -- aBack but do not want to
+                                      -- destroy them
+         sum        :   C := 0
+         const : I  := -1  --  after i steps const = (-1)**i
+         for aminus in aBack for aplus in aForth repeat
+           -- after i steps aminus = a<k-i> and aplus = a<k+i>
+           sum := sum + const * aminus * aplus
+           aForthCopy := rest aForthCopy
+           aBackCopy  := rest aBackCopy
+           const := -const
+         gp := gp + monomial(ak*ak + 2 * sum, (n-k)::NNI)
+         aBack := cons(ak, aBack)
+       gp
+
+     rootRadius(p,errorQuotient) ==
+       errorQuotient <= 1$R =>
+         error "rootRadius: second Parameter must be greater than 1"
+       pp   : UP  := p
+       rho  : R   := calculateScale makeMonic pp
+       rR   : R   := rho
+       pp := makeMonic scale(pp,complex(rho,0$R))
+       expo : NNI := 1
+       d    : NNI := degree p
+       currentError:  R   := nthRoot(2::R, 2)
+       currentError     := d*20*currentError
+       while nthRoot(currentError, expo) >= errorQuotient repeat
+         -- if info then print (expo :: OF)
+         pp := graeffe pp
+         rho := calculateScale pp
+         expo := 2 * expo
+         rR := nthRoot(rho, expo) * rR
+         pp :=  makeMonic scale(pp,complex(rho,0$R))
+       rR
+
+     rootRadius(p) == rootRadius(p, 1+globalEps)
+
+     schwerpunkt p ==
+       zero? p => 0$C
+       zero? (d := degree p) => error _
+        "schwerpunkt: non-zero const. poly has no roots and no schwerpunkt"
+       -- coeffient of x**d and x**(d-1)
+       lC : C :=  coefficient(p,d)  -- ^= 0
+       nC : C :=  coefficient(p,(d-1) pretend NNI)
+       (denom := recip ((d::I::C)*lC)) case "failed" => error  "schwerpunkt: _
+         degree * leadingCoefficient not invertible in ring of coefficients"
+       - (nC*(denom::C))
+
+     reciprocalPolynomial p ==
+       zero? p => 0
+       d : NNI := degree p
+       md : NNI := d+minimumDegree p
+       lm : L UP := [monomial(coefficient(p,i),(md-i) :: NNI) for i in 0..d]
+       sol := reduce(_+, lm)
+
+     divisorCascade(p, tp, info) ==
+       lfae : L FAE :=  nil()
+       for i in 1..degree tp while (degree tp > 0)  repeat
+         -- USE monicDivide !!!
+         qr  : Record(quotient: UP, remainder: UP)  :=  divide(p,tp)
+         factor1 : UP := tp
+         factor2 : UP := makeMonic qr.quotient
+         -- refinement of tp:
+         tp := qr.remainder
+         nm : R := norm tp
+         listOfFactors  : L UP := cons(factor2,nil()$(L UP))
+         listOfFactors := cons(factor1,listOfFactors)
+         lfae := cons( [listOfFactors,nm], lfae)
+         if info then
+           --lof : L OF :=  [i :: OF,"-th division:"::OF]
+           --print center box hconcat lof
+           print emptyLine
+           lof : L OF :=  ["error polynomial has degree " ::OF,_
+             (degree tp)::OF, " and norm " :: OF, nm :: OF]
+           print center hconcat lof
+           lof : L OF := ["degrees of factors:" ::OF,_
+             (degree factor1)::OF,"  ", (degree factor2)::OF]
+           print center hconcat lof
+       if info then print emptyLine
+       reverse lfae
+
+     divisorCascade(p, tp) == divisorCascade(p, tp, false)
+
+     factor(poly,eps) == factor(poly,eps,false)
+
+     factor(p) == factor(p, globalEps)
+
+     factor(poly,eps,info) ==
+       result : FR  UP := coerce monomial(leadingCoefficient poly,0)
+       d : NNI := degree poly
+       --should be
+       --den : R := (d::I)::R * two**(d::Integer) * norm poly
+       --eps0 : R := eps / den
+       -- for now only
+       eps0 : R := eps / (ten*ten)
+       (d = 1) => irreducibleFactor(poly,1)$(FR UP)
+       listOfFactors : L Record(factor: UP,exponent: I) :=_
+         list [makeMonic poly,1]
+       if info then
+         lof: L OF := [dashes,dots,"list of Factors:",dots,listOfFactors::OF, _
+           dashes, "list of Linear Factors:", dots, result::OF, _
+           dots,dashes]
+         print vconcat lof
+       while not null listOfFactors  repeat
+         p : UP := (first listOfFactors).factor
+         exponentOfp : I := (first listOfFactors).exponent
+         listOfFactors := rest listOfFactors
+         if info then
+           lof : L OF := ["just now we try to split the polynomial:",p::OF]
+           print vconcat lof
+         split : FR UP  := pleskenSplit(p, eps0, info)
+         (numberOfFactors split = 1) =>
+           -- in a later version we will change error bound and
+           -- accuracy here to deal this case as well
+           lof : L OF := ["factor: couldn't split factor",_
+             center(p :: OF), "with required error bound"]
+           print vconcat lof
+           result := result * nilFactor(p, exponentOfp)
+         -- now we got 2 good factors of p, we drop p and continue
+         -- with the factors, if they are not linear, or put a
+         -- linear factor to the result
+         for rec in factors(split)$(FR UP) repeat
+           newFactor : UP := rec.factor
+           expOfFactor := exponentOfp * rec.exponent
+           (degree newFactor = 1) =>
+             result := result * nilFactor(newFactor,expOfFactor)
+           listOfFactors:=cons([newFactor,expOfFactor],_
+             listOfFactors)
+       result
+
+     -- implementation of local functions
+
+     absC c == nthRoot(norm(c)$C,2)
+
+     absR r ==
+       r < 0 => -r
+       r
+
+     min(fae1,fae2) ==
+       fae2.error <  fae1.error => fae2
+       fae1
+
+     calculateScale p ==
+       d  := degree p
+       maxi :R := 0
+       for j in 1..d for cof in rest coefficients p repeat
+         -- here we need abs: R -> R
+         rc :  R := absR real cof
+         ic :  R := absR imag cof
+         locmax: R := max(rc,ic)
+         maxi := max( nthRoot( locmax/(binomial(d,j)$ICF::R), j), maxi)
+       -- Maybe I should use some type of logarithm for the following:
+       maxi = 0$R => error("Internal Error: scale cannot be 0")
+       rho  :R := one
+       rho < maxi =>
+         while rho < maxi repeat rho := ten * rho
+         rho / ten
+       while maxi < rho repeat rho := rho / ten
+       rho = 0 => one
+       rho
+
+     makeMonic p  ==
+       p = 0 => p
+       monomial(1,degree p)$UP + (reductum p)/(leadingCoefficient p)
+
+     scale(p, c) ==
+       -- eval(p,cx) is missing !!
+       eq : Equation UP := equation(monomial(1,1), monomial(c,1))
+       eval(p,eq)
+       -- improvement?: direct calculation of the new coefficients
+
+     shift(p,c) ==
+       rhs : UP := monomial(1,1) + monomial(c,0)
+       eq : Equation UP := equation(monomial(1,1), rhs)
+       eval(p,eq)
+       -- improvement?: direct calculation of the new coefficients
+
+     nthRoot(r,n) ==
+       R has RealNumberSystem =>  r ** (1/n)
+       R has QuotientFieldCategory Integer =>
+         den : I := approxNthRoot(globalDigits * denom r ,n)$IntegerRoots(I)
+         num : I := approxNthRoot(globalDigits * numer r ,n)$IntegerRoots(I)
+         num/den
+       -- the following doesn't compile
+       --R has coerce: % -> Fraction Integer =>
+       --  q : Fraction Integer := coerce(r)@Fraction(Integer)
+       --  den : I := approxNthRoot(globalDigits * denom q ,n)$IntegerRoots(I)
+       --  num : I := approxNthRoot(globalDigits * numer q ,n)$IntegerRoots(I)
+       --  num/den
+       r -- this is nonsense, perhaps a Newton iteration for x**n-r here
+
+)fin
+     -- for late use:
+
+     graeffe2 p ==
+       -- substitute x by -x :
+       eq : Equation UP := equation(monomial(1,1), monomial(-1$C,1))
+       pp : UP := p*eval(p,eq)
+       gp : UP :=  0$UP
+       while pp ^= 0 repeat
+          i:NNI := (degree pp) quo (2::NNI)
+          coef:C:=
+            even? i => leadingCoefficient pp
+            - leadingCoefficient pp
+          gp    := gp + monomial(coef,i)
+          pp    := reductum pp
+       gp
+
+     shift2(p,c) ==
+       d := degree p
+       cc : C := 1
+       coef := List C := [cc := c * cc for i in 1..d]
+       coef := cons(1,coef)
+       coef := [coefficient(p,i)*coef.(1+i) for i in 0..d]
+       res : UP := 0
+       for j in 0..d repeat
+         cc := 0
+         for i in j..d repeat
+           cc := cc + coef.i * (binomial(i,j)$ICF :: R)
+         res := res + monomial(cc,j)$UP
+       res
+
+     scale2(p,c) ==
+       d := degree p
+       cc : C := 1
+       coef := List C := [cc := c * cc for i in 1..d]
+       coef := cons(1,coef)
+       coef := [coefficient(p,i)*coef.(i+1) for i in 0..d]
+       res : UP := 0
+       for i in 0..d repeat  res := res + monomial(coef.(i+1),i)$UP
+       res
+
+     scale2: (UP,C) -> UP
+
+     shift2: (UP,C) ->  UP
+
+     graeffe2 : UP -> UP
+       ++ graeffe2 p determines q such that \spad{q(-z**2) = p(z)*p(-z)}.
+       ++ Note that the roots of q are the squares of the roots of p.
+
 *)
 
 \end{chunk}
@@ -11548,6 +16472,7 @@ ComplexRootPackage(UP,Par) : T == C where
           ++ depending on the type of eps.
 
    C == add
+
     complexZeros(p:UP,eps:Par):List CP ==
       x1:Symbol():=new()
       x2:Symbol():=new()
@@ -11570,6 +16495,24 @@ ComplexRootPackage(UP,Par) : T == C where
 \begin{chunk}{COQ CMPLXRT}
 (* package CMPLXRT *)
 (*
+
+    complexZeros(p:UP,eps:Par):List CP ==
+      x1:Symbol():=new()
+      x2:Symbol():=new()
+      vv:Symbol():=new()
+      lpf:=factors factor(p)$ComplexFactorization(I,UP)
+      ris:List CP:=empty()
+      for pf in lpf repeat
+          pp:=pf.factor pretend SparseUnivariatePolynomial Complex Integer
+          q:PCI :=multivariate(pp,vv)
+          q:=eval(q,vv,x1::PCI+complex(0,1)*(x2::PCI))
+          p1:=map(real,q)$PolynomialFunctions2(Complex I,I)
+          p2:=map(imag,q)$PolynomialFunctions2(Complex I,I)
+          lz:=innerSolve([p1,p2],[],[x1,x2],
+                          eps)$InnerNumericFloatSolvePackage(I,Par,Par)
+          ris:=append([complex(first z,second z) for z in lz],ris)
+      ris
+
 *)
 
 \end{chunk}
@@ -11684,6 +16627,7 @@ ComplexTrigonometricManipulations(R, F): Exports == Implementation where
       ++ complexForm(f) returns \spad{[real f, imag f]}.
 
   Implementation ==> add
+
     import InnerTrigonometricManipulations(R, FR, F)
     import ElementaryFunctionStructurePackage(Complex R, F)
 
@@ -11692,9 +16636,13 @@ ComplexTrigonometricManipulations(R, F): Exports == Implementation where
     localexplogs  : (F, F, List SY) -> F
 
     real f        == real complexForm f
+
     imag f        == imag complexForm f
+
     rreal? r      == zero? imag r
+
     kreal? k      == every?(real?, argument k)$List(F)
+
     complexForm f == explogs2trigs f
 
     trigs f ==
@@ -11742,6 +16690,64 @@ ComplexTrigonometricManipulations(R, F): Exports == Implementation where
 \begin{chunk}{COQ CTRIGMNP}
 (* package CTRIGMNP *)
 (*
+
+    import InnerTrigonometricManipulations(R, FR, F)
+    import ElementaryFunctionStructurePackage(Complex R, F)
+
+    rreal?: Complex R -> Boolean
+    kreal?: Kernel F -> Boolean
+    localexplogs  : (F, F, List SY) -> F
+
+    real f        == real complexForm f
+
+    imag f        == imag complexForm f
+
+    rreal? r      == zero? imag r
+
+    kreal? k      == every?(real?, argument k)$List(F)
+
+    complexForm f == explogs2trigs f
+
+    trigs f ==
+      GF2FG explogs2trigs f
+
+    real? f ==
+      every?(rreal?, coefficients numer f)
+        and every?(rreal?, coefficients denom f) and every?(kreal?, kernels f)
+
+    localexplogs(f, g, lx) ==
+      trigs2explogs(g, [k for k in tower f
+                          | is?(k, "tan"::SY) or is?(k, "cot"::SY)], lx)
+
+    complexElementary f ==
+      any?(x +-> has?(x, "rtrig"),
+        operators(g := realElementary f))$List(BasicOperator) =>
+          localexplogs(f, g, variables g)
+      g
+
+    complexElementary(f, x) ==
+      any?(y +-> has?(operator y, "rtrig"),
+       [k for k in tower(g := realElementary(f, x))
+                 | member?(x, variables(k::F))]$List(K))$List(K) =>
+                     localexplogs(f, g, [x])
+      g
+
+    complexNormalize(f, x) ==
+      any?(y +-> has?(operator y, "rtrig"),
+       [k for k in tower(g := realElementary(f, x))
+               | member?(x, variables(k::F))]$List(K))$List(K) =>
+                   (rischNormalize(localexplogs(f, g, [x]), x).func)
+      rischNormalize(g, x).func
+
+    complexNormalize f ==
+      l := variables(g := realElementary f)
+      any?(y +-> has?(y, "rtrig"), operators g)$List(BasicOperator) =>
+        h := localexplogs(f, g, l)
+        for x in l repeat h := rischNormalize(h, x).func
+        h
+      for x in l repeat g := rischNormalize(g, x).func
+      g
+
 *)
 
 \end{chunk}
@@ -11829,6 +16835,7 @@ ConstantLODE(R, F, L): Exports == Implementation where
       ++ and the \spad{yi}'s form a basis for the solutions of \spad{op y = 0}.
 
   Implementation ==> add
+
     import ODETools(F, L)
     import ODEIntegration(R, F)
     import ElementaryFunctionSign(R, F)
@@ -11866,7 +16873,6 @@ ConstantLODE(R, F, L): Exports == Implementation where
       l
 
     basisSqfr(p, x) ==
---      one?(d := degree p) =>
       ((d := degree p) = 1) =>
         [exp(- coefficient(p, 0) * x / leadingCoefficient p)]
       d = 2 => quadSol(p, x)
@@ -11887,6 +16893,59 @@ ConstantLODE(R, F, L): Exports == Implementation where
 \begin{chunk}{COQ ODECONST}
 (* package ODECONST *)
 (*
+
+    import ODETools(F, L)
+    import ODEIntegration(R, F)
+    import ElementaryFunctionSign(R, F)
+    import AlgebraicManipulations(R, F)
+    import FunctionSpaceIntegration(R, F)
+    import FunctionSpaceUnivariatePolynomialFactor(R, F, SUP)
+
+    homoBasis: (L, F) -> List F
+    quadSol  : (SUP, F) -> List F
+    basisSqfr: (SUP, F) -> List F
+    basisSol : (SUP, Z, F) -> List F
+
+    constDsolve(op, g, x) ==
+      b := homoBasis(op, x::F)
+      [particularSolution(op, g, b, (f1:F):F +-> int(f1, x))::F, b]
+
+    homoBasis(op, x) ==
+      p:SUP := 0
+      while op ^= 0 repeat
+          p  := p + monomial(leadingCoefficient op, degree op)
+          op := reductum op
+      b:List(F) := empty()
+      for ff in factors ffactor p repeat
+        b := concat_!(b, basisSol(ff.factor, dec(ff.exponent), x))
+      b
+
+    basisSol(p, n, x) ==
+      l := basisSqfr(p, x)
+      zero? n => l
+      ll := copy l
+      xn := x::F
+      for i in 1..n repeat
+        l := concat_!(l, [xn * f for f in ll])
+        xn := x * xn
+      l
+
+    basisSqfr(p, x) ==
+      ((d := degree p) = 1) =>
+        [exp(- coefficient(p, 0) * x / leadingCoefficient p)]
+      d = 2 => quadSol(p, x)
+      [exp(a * x) for a in rootsOf p]
+
+    quadSol(p, x) ==
+      (u := sign(delta := (b := coefficient(p, 1))**2 - 4 *
+        (a := leadingCoefficient p) * (c := coefficient(p, 0))))
+          case Z and negative?(u::Z) =>
+            y := x / (2 * a)
+            r := - b * y
+            i := rootSimp(sqrt(-delta)) * y
+            [exp(r) * cos(i), exp(r) * sin(i)]
+      [exp(a * x) for a in zerosOf p]
+
 *)
 
 \end{chunk}
@@ -11987,74 +17046,103 @@ CoordinateSystems(R): Exports == Implementation where
   Pt ==> Point R
 
   Exports ==> with
+
     cartesian : Pt -> Pt
       ++ cartesian(pt) returns the Cartesian coordinates of point pt.
+
     polar: Pt -> Pt
       ++ polar(pt) transforms pt from polar coordinates to Cartesian 
       ++ coordinates: the function produced will map the point \spad{(r,theta)}
       ++ to \spad{x = r * cos(theta)} , \spad{y = r * sin(theta)}.
+
     cylindrical: Pt -> Pt
       ++ cylindrical(pt) transforms pt from polar coordinates to Cartesian 
       ++ coordinates: the function produced will map the point 
       ++ \spad{(r,theta,z)}
       ++ to \spad{x = r * cos(theta)}, \spad{y = r * sin(theta)}, \spad{z}.
+
     spherical: Pt -> Pt
       ++ spherical(pt) transforms pt from spherical coordinates to Cartesian 
       ++ coordinates: the function produced will map the point 
       ++ \spad{(r,theta,phi)}
       ++ to \spad{x = r*sin(phi)*cos(theta)}, \spad{y = r*sin(phi)*sin(theta)},
       ++ \spad{z = r*cos(phi)}.
+
     parabolic: Pt -> Pt
       ++ parabolic(pt) transforms pt from parabolic coordinates to Cartesian 
       ++ coordinates: the function produced will map the point \spad{(u,v)} to
       ++ \spad{x = 1/2*(u**2 - v**2)}, \spad{y = u*v}.
+
     parabolicCylindrical: Pt -> Pt
       ++ parabolicCylindrical(pt) transforms pt from parabolic cylindrical 
       ++ coordinates to Cartesian coordinates: the function produced will 
       ++ map the point \spad{(u,v,z)} to \spad{x = 1/2*(u**2 - v**2)}, 
       ++ \spad{y = u*v}, \spad{z}.
+
     paraboloidal: Pt -> Pt
       ++ paraboloidal(pt) transforms pt from paraboloidal coordinates to 
       ++ Cartesian coordinates: the function produced will map the point 
       ++ \spad{(u,v,phi)} to \spad{x = u*v*cos(phi)}, \spad{y = u*v*sin(phi)},
       ++ \spad{z = 1/2 * (u**2 - v**2)}.
+
     elliptic: R -> (Pt -> Pt)
       ++ elliptic(a) transforms from elliptic coordinates to Cartesian 
       ++ coordinates: \spad{elliptic(a)} is a function which will map the 
-      ++ point \spad{(u,v)} to \spad{x = a*cosh(u)*cos(v)}, \spad{y = a*sinh(u)*sin(v)}.
+      ++ point \spad{(u,v)} to \spad{x = a*cosh(u)*cos(v)},
+      ++  \spad{y = a*sinh(u)*sin(v)}.
+
     ellipticCylindrical: R -> (Pt -> Pt)
-      ++ ellipticCylindrical(a) transforms from elliptic cylindrical coordinates 
+      ++ ellipticCylindrical(a) transforms from elliptic 
+      ++ cylindrical coordinates 
       ++ to Cartesian coordinates: \spad{ellipticCylindrical(a)} is a function
-      ++ which will map the point \spad{(u,v,z)} to \spad{x = a*cosh(u)*cos(v)},
+      ++ which will map the point \spad{(u,v,z)} to
+      ++ \spad{x = a*cosh(u)*cos(v)},
       ++ \spad{y = a*sinh(u)*sin(v)}, \spad{z}.
+
     prolateSpheroidal: R -> (Pt -> Pt)
       ++ prolateSpheroidal(a) transforms from prolate spheroidal coordinates to 
       ++ Cartesian coordinates: \spad{prolateSpheroidal(a)} is a function 
       ++ which will map the point \spad{(xi,eta,phi)} to 
-      ++ \spad{x = a*sinh(xi)*sin(eta)*cos(phi)}, \spad{y = a*sinh(xi)*sin(eta)*sin(phi)}, 
+      ++ \spad{x = a*sinh(xi)*sin(eta)*cos(phi)},
+      ++  \spad{y = a*sinh(xi)*sin(eta)*sin(phi)}, 
       ++ \spad{z = a*cosh(xi)*cos(eta)}.
+
     oblateSpheroidal: R -> (Pt -> Pt)
       ++ oblateSpheroidal(a) transforms from oblate spheroidal coordinates to 
       ++ Cartesian coordinates: \spad{oblateSpheroidal(a)} is a function which
-      ++ will map the point \spad{(xi,eta,phi)} to \spad{x = a*sinh(xi)*sin(eta)*cos(phi)},
-      ++ \spad{y = a*sinh(xi)*sin(eta)*sin(phi)}, \spad{z = a*cosh(xi)*cos(eta)}.
+      ++ will map the point \spad{(xi,eta,phi)} to
+      ++  \spad{x = a*sinh(xi)*sin(eta)*cos(phi)},
+      ++ \spad{y = a*sinh(xi)*sin(eta)*sin(phi)},
+      ++  \spad{z = a*cosh(xi)*cos(eta)}.
+
     bipolar: R -> (Pt -> Pt)
-      ++ bipolar(a) transforms from bipolar coordinates to Cartesian coordinates:
-      ++ \spad{bipolar(a)} is a function which will map the point \spad{(u,v)} to
-      ++ \spad{x = a*sinh(v)/(cosh(v)-cos(u))}, \spad{y = a*sin(u)/(cosh(v)-cos(u))}.
+      ++ bipolar(a) transforms from bipolar coordinates 
+      ++ to Cartesian coordinates:
+      ++ \spad{bipolar(a)} is a function which will map 
+      ++ the point \spad{(u,v)} to
+      ++ \spad{x = a*sinh(v)/(cosh(v)-cos(u))}, 
+      ++ \spad{y = a*sin(u)/(cosh(v)-cos(u))}.
+
     bipolarCylindrical: R -> (Pt -> Pt)
       ++ bipolarCylindrical(a) transforms from bipolar cylindrical coordinates 
-      ++ to Cartesian coordinates: \spad{bipolarCylindrical(a)} is a function which 
-      ++ will map the point \spad{(u,v,z)} to \spad{x = a*sinh(v)/(cosh(v)-cos(u))},
+      ++ to Cartesian coordinates: \spad{bipolarCylindrical(a)} 
+      ++ is a function which 
+      ++ will map the point \spad{(u,v,z)} to 
+      ++ \spad{x = a*sinh(v)/(cosh(v)-cos(u))},
       ++ \spad{y = a*sin(u)/(cosh(v)-cos(u))}, \spad{z}.
+
     toroidal: R -> (Pt -> Pt)
       ++ toroidal(a) transforms from toroidal coordinates to Cartesian 
       ++ coordinates: \spad{toroidal(a)} is a function which will map the point 
       ++ \spad{(u,v,phi)} to \spad{x = a*sinh(v)*cos(phi)/(cosh(v)-cos(u))},
-      ++ \spad{y = a*sinh(v)*sin(phi)/(cosh(v)-cos(u))}, \spad{z = a*sin(u)/(cosh(v)-cos(u))}.
+      ++ \spad{y = a*sinh(v)*sin(phi)/(cosh(v)-cos(u))}, 
+      ++ \spad{z = a*sin(u)/(cosh(v)-cos(u))}.
+
     conical: (R,R) -> (Pt -> Pt)
-      ++ conical(a,b) transforms from conical coordinates to Cartesian coordinates:
-      ++ \spad{conical(a,b)} is a function which will map the point \spad{(lambda,mu,nu)} to
+      ++ conical(a,b) transforms from conical coordinates 
+      ++ to Cartesian coordinates:
+      ++ \spad{conical(a,b)} is a function which will map 
+      ++ the point \spad{(lambda,mu,nu)} to
       ++ \spad{x = lambda*mu*nu/(a*b)},
       ++ \spad{y = lambda/a*sqrt((mu**2-a**2)*(nu**2-a**2)/(a**2-b**2))},
       ++ \spad{z = lambda/b*sqrt((mu**2-b**2)*(nu**2-b**2)/(b**2-a**2))}.
@@ -12160,6 +17248,101 @@ CoordinateSystems(R): Exports == Implementation where
 \begin{chunk}{COQ COORDSYS}
 (* package COORDSYS *)
 (*
+
+    cartesian pt ==
+      -- we just want to interpret the cartesian coordinates
+      -- from the first N elements of the point - so the
+      -- identity function will do
+      pt
+
+    polar pt0 ==
+      pt := copy pt0
+      r := elt(pt0,1); theta := elt(pt0,2)
+      pt.1 := r * cos(theta); pt.2 := r * sin(theta)
+      pt
+
+    cylindrical pt0 == polar pt0 
+    -- apply polar transformation to first 2 coordinates
+
+    spherical pt0 ==
+      pt := copy pt0
+      r := elt(pt0,1); theta := elt(pt0,2); phi := elt(pt0,3)
+      pt.1 := r * sin(phi) * cos(theta); pt.2 := r * sin(phi) * sin(theta)
+      pt.3 := r * cos(phi)
+      pt
+
+    parabolic pt0 ==
+      pt := copy pt0
+      u := elt(pt0,1); v := elt(pt0,2)
+      pt.1 := (u*u - v*v)/(2::R) ; pt.2 := u*v
+      pt
+
+    parabolicCylindrical pt0 == parabolic pt0
+    -- apply parabolic transformation to first 2 coordinates
+
+    paraboloidal pt0 ==
+      pt := copy pt0
+      u := elt(pt0,1); v := elt(pt0,2); phi := elt(pt0,3)
+      pt.1 := u*v*cos(phi); pt.2 := u*v*sin(phi); pt.3 := (u*u - v*v)/(2::R)
+      pt
+
+    elliptic a ==
+     x+->
+      pt := copy(x)
+      u := elt(x,1); v := elt(x,2)
+      pt.1 := a*cosh(u)*cos(v); pt.2 := a*sinh(u)*sin(v)
+      pt
+
+    ellipticCylindrical a == elliptic a
+    -- apply elliptic transformation to first 2 coordinates
+
+    prolateSpheroidal a ==
+     x+->
+      pt := copy(x)
+      xi := elt(x,1); eta := elt(x,2); phi := elt(x,3)
+      pt.1 := a*sinh(xi)*sin(eta)*cos(phi)
+      pt.2 := a*sinh(xi)*sin(eta)*sin(phi)
+      pt.3 := a*cosh(xi)*cos(eta)
+      pt
+
+    oblateSpheroidal a ==
+     x+->
+      pt := copy(x)
+      xi := elt(x,1); eta := elt(x,2); phi := elt(x,3)
+      pt.1 := a*sinh(xi)*sin(eta)*cos(phi)
+      pt.2 := a*cosh(xi)*cos(eta)*sin(phi)
+      pt.3 := a*sinh(xi)*sin(eta)
+      pt
+
+    bipolar a ==
+     x+->
+      pt := copy(x)
+      u := elt(x,1); v := elt(x,2)
+      pt.1 := a*sinh(v)/(cosh(v)-cos(u))
+      pt.2 := a*sin(u)/(cosh(v)-cos(u))
+      pt
+
+    bipolarCylindrical a == bipolar a
+    -- apply bipolar transformation to first 2 coordinates
+
+    toroidal a ==
+     x+->
+      pt := copy(x)
+      u := elt(x,1); v := elt(x,2); phi := elt(x,3)
+      pt.1 := a*sinh(v)*cos(phi)/(cosh(v)-cos(u))
+      pt.2 := a*sinh(v)*sin(phi)/(cosh(v)-cos(u))
+      pt.3 := a*sin(u)/(cosh(v)-cos(u))
+      pt
+
+    conical(a,b) ==
+     x+->
+      pt := copy(x)
+      lambda := elt(x,1); mu := elt(x,2); nu := elt(x,3)
+      pt.1 := lambda*mu*nu/(a*b)
+      pt.2 := lambda/a*sqrt((mu**2-a**2)*(nu**2-a**2)/(a**2-b**2))
+      pt.3 := lambda/b*sqrt((mu**2-b**2)*(nu**2-b**2)/(b**2-a**2))
+      pt
+
 *)
 
 \end{chunk}
@@ -12302,6 +17485,62 @@ CRApackage(R:EuclideanDomain): Exports == Implementation where
 \begin{chunk}{COQ CRAPACK}
 (* package CRAPACK *)
 (*
+
+    BB:=BalancedBinaryTree(R)
+    x:BB
+
+    -- Definition for modular reduction mapping with several moduli
+    modTree(a,lm) ==
+      t := balancedBinaryTree(#lm, 0$R)
+      setleaves_!(t,lm)
+      mapUp_!(t,"*")
+      leaves mapDown_!(t, a, "rem")
+
+    chineseRemainder(lv:List(R), lm:List(R)):R ==
+      #lm ^= #lv => error "lists of moduli and values not of same length"
+      x := balancedBinaryTree(#lm, 0$R)
+      x := setleaves_!(x, lm)
+      mapUp_!(x,"*")
+      y := balancedBinaryTree(#lm, 1$R)
+      y := mapUp_!(copy y,x,(a,b,c,d)+->a*d + b*c)
+      (u := extendedEuclidean(value y, value x,1)) case "failed" =>
+        error "moduli not relatively prime"
+      inv := u . coef1
+      linv := modTree(inv, lm)
+      l := [(u*v) rem m for v in lv for u in linv for m in lm]
+      y := setleaves_!(y,l)
+      value(mapUp_!(y, x, (a,b,c,d)+->a*d + b*c)) rem value(x)
+
+    chineseRemainder(llv:List List(R), lm:List(R)):List(R) ==
+      x := balancedBinaryTree(#lm, 0$R)
+      x := setleaves_!(x, lm)
+      mapUp_!(x,"*")
+      y := balancedBinaryTree(#lm, 1$R)
+      y := mapUp_!(copy y,x,(a,b,c,d)+->a*d + b*c)
+      (u := extendedEuclidean(value y, value x,1)) case "failed" =>
+        error "moduli not relatively prime"
+      inv := u . coef1
+      linv := modTree(inv, lm)
+      retVal:List(R) := []
+      for lv in llv repeat
+        l := [(u3*v) rem m for v in lv for u3 in linv for m in lm]
+        y := setleaves!(y,l)
+        retVal := 
+          cons(value(mapUp!(y, x, (a,b,c,d)+->a*d+b*c)) rem value(x),retVal)
+      reverse retVal
+
+    extEuclidean: (R, R, R) -> List R
+    extEuclidean(a, b, c) ==
+      u := extendedEuclidean(a, b, c)
+      u case "failed" => error [c, " not spanned by ", a, " and ",b]
+      [u.coef2, u.coef1]
+
+    multiEuclideanTree(fl, rhs) ==
+      x := balancedBinaryTree(#fl, rhs)
+      x := setleaves_!(x, fl)
+      mapUp_!(x,"*")
+      leaves mapDown_!(x, rhs, extEuclidean)
+
 *)
 
 \end{chunk}
@@ -13361,6 +18600,7 @@ CycleIndicators: Exports == Implementation where
       ++ expressed in terms of power sum symmetric functions.
  
   Implementation ==> add
+
     import PartitionsAndPermutations
     import IntegerNumberTheoryFunctions
  
@@ -13462,6 +18702,7 @@ CycleIndicators: Exports == Implementation where
       monomial(leadingCoefficient spol,deg) + mtpol(n,reductum spol)
  
     fn2: I -> SPOL RN
+
     evspol: ((I -> SPOL RN),SPOL RN) -> SPOL RN
     evspol(fn2,spol) ==
       zero? spol => 0
@@ -13473,7 +18714,8 @@ CycleIndicators: Exports == Implementation where
  
     hh: I -> SPOL RN      --symmetric group
     hh n == if n=0 then 1 else if n<0 then 0 else h n
-    SFunction li==
+
+    SFunction li ==
       a:Matrix SPOL RN:=matrix [[hh(k -j+i) for k in li for j in 1..#li]
                     for i in 1..#li]
       determinant a
@@ -13496,6 +18738,139 @@ CycleIndicators: Exports == Implementation where
 \begin{chunk}{COQ CYCLES}
 (* package CYCLES *)
 (*
+
+    import PartitionsAndPermutations
+    import IntegerNumberTheoryFunctions
+ 
+    trm: PTN -> SPOL RN
+    trm pt == monomial(inv(pdct(pt) :: RN),pt)
+ 
+    list: Stream L I -> L L I
+    list st == entries complete st
+ 
+    complete i ==
+           if i=0
+           then 1
+           else if i<0
+                then 0
+                else
+                   _+/[trm(partition pt) for pt in list(partitions i)]
+ 
+ 
+    even?: L I -> B
+    even? li == even?( #([i for i in li | even? i]))
+ 
+    alt i ==
+      2 * _+/[trm(partition li) for li in list(partitions i) | even? li]
+    elementary i ==
+           if i=0
+           then 1
+           else if i<0
+                then 0
+                else
+                  _+/[(spol := trm(partition pt); even? pt => spol; -spol)
+                          for pt in list(partitions i)]
+ 
+    divisors: I -> L I
+    divisors n ==
+      b := factors(n :: FR)
+      c := concat(1,"append"/
+                 [[a.factor**j for j in 1..a.exponent] for a in b]);
+      if #(b) = 1 then c else concat(n,c)
+ 
+    ss: (I,I) -> SPOL RN
+    ss(n,m) ==
+      li : L I := [n for j in 1..m]
+      monomial(1,partition li)
+ 
+    s n == ss(n,1)
+ 
+    cyc n ==
+      n = 1 => s 1
+      _+/[(eulerPhi(i) / n) * ss(i,numer(n/i)) for i in divisors n]
+ 
+    dih n ==
+      k := n quo 2
+      odd? n => (1/2) * cyc n + (1/2) * ss(2,k) * s 1
+      (1/2) * cyc n + (1/4) * ss(2,k) + (1/4) * ss(2,k-1) * ss(1,2)
+ 
+    trm2: L I -> SPOL RN
+    trm2 li ==
+      lli := powers(li)$PTN
+      xx := 1/(pdct partition li)
+      prod : SPOL RN := 1
+      for ll in lli repeat
+        ll0 := first ll; ll1 := second ll
+        k := ll0 quo 2
+        c :=
+          odd? ll0 => ss(ll0,ll1 * k)
+          ss(k,ll1) * ss(ll0,ll1 * (k - 1))
+        c := c * ss(ll0,ll0 * ((ll1*(ll1 - 1)) quo 2))
+        prod2 : SPOL RN := 1
+        for r in lli | first(r) < ll0 repeat
+          r0 := first r; r1 := second r
+          prod2 := ss(lcm(r0,ll0),gcd(r0,ll0) * r1 * ll1) * prod2
+        prod := c * prod2 * prod
+      xx * prod
+ 
+    graphs n == _+/[trm2 li for li in list(partitions n)]
+ 
+    cupp: (PTN,SPOL RN) -> SPOL RN
+    cupp(pt,spol) ==
+      zero? spol => 0
+      (dg := degree spol) < pt => 0
+      dg = pt => (pdct pt) * monomial(leadingCoefficient spol,dg)
+      cupp(pt,reductum spol)
+ 
+    cup(spol1,spol2) ==
+      zero? spol1 => 0
+      p := leadingCoefficient(spol1) * cupp(degree spol1,spol2)
+      p + cup(reductum spol1,spol2)
+ 
+    ev spol ==
+      zero? spol => 0
+      leadingCoefficient(spol) + ev(reductum spol)
+ 
+    cap(spol1,spol2) == ev cup(spol1,spol2)
+ 
+    mtpol: (I,SPOL RN) -> SPOL RN
+    mtpol(n,spol)==
+      zero? spol => 0
+      deg := partition [n*k for k in (degree spol)::L(I)]
+      monomial(leadingCoefficient spol,deg) + mtpol(n,reductum spol)
+ 
+    fn2: I -> SPOL RN
+
+    evspol: ((I -> SPOL RN),SPOL RN) -> SPOL RN
+    evspol(fn2,spol) ==
+      zero? spol => 0
+      lc := leadingCoefficient spol
+      prod := _*/[fn2 i for i in (degree spol)::L(I)]
+      lc * prod + evspol(fn2,reductum spol)
+ 
+    wreath(spol1,spol2) == evspol(x+->mtpol(x,spol2),spol1)
+ 
+    hh: I -> SPOL RN      --symmetric group
+    hh n == if n=0 then 1 else if n<0 then 0 else h n
+
+    SFunction li ==
+      a:Matrix SPOL RN:=matrix [[hh(k -j+i) for k in li for j in 1..#li]
+                    for i in 1..#li]
+      determinant a
+ 
+    roundup:(L I,L I)-> L I
+    roundup(li1,li2)==
+              #li1 > #li2 => roundup(li1,concat(li2,0))
+              li2
+ 
+    skewSFunction(li1,li2)==
+      #li1 < #li2 =>
+        error "skewSFunction: partition1 does not include partition2"
+      li2:=roundup (li1,li2)
+      a:Matrix SPOL RN:=matrix [[hh(k-li2.i-j+i)
+               for k in li1 for j in 1..#li1]  for i in 1..#li1]
+      determinant a
+
 *)
 
 \end{chunk}
@@ -13624,6 +18999,28 @@ CyclicStreamTools(S,ST): Exports == Implementation where
 \begin{chunk}{COQ CSTTOOLS}
 (* package CSTTOOLS *)
 (*
+
+    cycleElt x ==
+      y := x
+      for i in 0.. repeat
+        (explicitlyEmpty? y) or (lazy? y) => return "failed"
+        y := rst y
+        if odd? i then x := rst x
+        eq?(x,y) => return y
+
+    computeCycleLength cycElt ==
+      i : NonNegativeInteger
+      y := cycElt
+      for i in 1.. repeat
+        y := rst y
+        eq?(y,cycElt) => return i
+
+    computeCycleEntry(x,cycElt) ==
+      y := rest(x, computeCycleLength cycElt)
+      repeat
+        eq?(x,y) => return x
+        x := rst x ; y := rst y
+
 *)
 
 \end{chunk}
@@ -13704,6 +19101,7 @@ CyclotomicPolynomialPackage: public == private where
       ++ cyclotomicFactorization(n) \undocumented{}
  
   private == add
+
     cyclotomic(n:Integer): SUP ==
       x,y,z,l: SUP
       g := factors factor(n)$IFP
@@ -13743,6 +19141,41 @@ CyclotomicPolynomialPackage: public == private where
 \begin{chunk}{COQ CYCLOTOM}
 (* package CYCLOTOM *)
 (*
+
+    cyclotomic(n:Integer): SUP ==
+      x,y,z,l: SUP
+      g := factors factor(n)$IFP
+      --Now, for each prime in the factorization apply recursion
+      l := monomial(1,1) - monomial(1,0)
+      for u in g repeat
+         l := (monicDivide(multiplyExponents(l,u.factor::NNI),l)).quotient
+         if u.exponent>1 then
+            l := multiplyExponents(l,((u.factor)**((u.exponent-1)::NNI))::NNI)
+      l
+ 
+    cyclotomicDecomposition(n:Integer):LSUP ==
+      x,y,z: SUP
+      l,ll,m: LSUP
+      rr: Integer
+      g := factors factor(n)$IFP
+      l := [monomial(1,1) - monomial(1,0)]
+      --Now, for each prime in the factorization apply recursion
+      for u in g repeat
+         m := [(monicDivide(
+            multiplyExponents(z,u.factor::NNI),z)).quotient for z in l]
+         for rr in 1..(u.exponent-1) repeat
+            l := append(l,m)
+            m := [multiplyExponents(z,u.factor::NNI) for z in m]
+         l := append(l,m)
+      l
+ 
+    cyclotomicFactorization(n:Integer):FR ==
+      f :  SUP
+      fr : FR := 1$FR
+      for f in cyclotomicDecomposition(n) repeat
+        fr := fr * primeFactor(f,1$Integer)
+      fr
+
 *)
 
 \end{chunk}
@@ -13945,6 +19378,99 @@ CylindricalAlgebraicDecompositionPackage(TheField) : PUB == PRIV where
 \begin{chunk}{COQ CAD}
 (* package CAD *)
 (*
+
+     cylindricalDecomposition(lpols) ==
+       lv : List(Symbol) := []
+       for pol in lpols repeat
+         ground?(pol) => "next pol"
+         lv := removeDuplicates(append(variables(pol),lv))
+       lv := reverse(sort(lv))
+       cylindricalDecomposition(lpols,lv)
+
+     cylindricalDecomposition(lpols,lvars) ==
+       lvars = [] => error("CAD: cylindricalDecomposition: empty list of vars")
+       mv := first(lvars)
+       lv := rest(lvars)
+       lv = [] =>
+         lp1 := [ univariate(pol) for pol in lpols ]
+         scells := allSimpleCells(lp1,mv)$SCELL
+         [ makeCell([scell]) for scell in scells ]
+       lpols1 := projectionSet [univariate(pol,mv) for pol in lpols]
+       previousCad := cylindricalDecomposition(lpols1,lv)
+       res : List(CELL) := []
+       for cell in previousCad repeat
+         lspec := specialise(lpols,cell)
+         scells := allSimpleCells(lspec,mv)
+         res := append(res,[makeCell(scell,cell) for scell in scells])
+       res
+
+     PACK1 ==> CylindricalAlgebraicDecompositionUtilities(ThePols,RUP)
+     PACK2 ==> CylindricalAlgebraicDecompositionUtilities(TheField,BUP)
+
+     specialise(lpols,cell) ==
+       lpols = [] => error("CAD: specialise: empty list of pols")
+       sp := samplePoint(cell)
+       vl := variablesOf(cell)
+       res : List(BUP) := []
+       for pol in lpols repeat
+         p1 := univariate(eval(pol,vl,sp))
+         degree(p1) = 0 => "next pol"
+         res := cons(p1,res)
+       res
+
+     coefficientSet(pol) ==
+       res : List(ThePols) := []
+       for c in coefficients(pol) repeat
+         ground?(c) => return(res)
+         res := cons(c,res)
+       res
+
+     SUBRES ==> SubResultantPackage(ThePols,RUP)
+     discriminantSet(lpols) ==
+       res : List(ThePols) := []
+       for p in lpols repeat
+         v := subresultantVector(p,differentiate(p))$SUBRES
+         not(zero?(degree(v.0))) => return(error "Bad discriminant")
+         d : ThePols :=  leadingCoefficient(v.0)
+         zero?(d) => return(error "Non Square Free polynomial")
+         if not(ground? d) then res := cons(d,res)
+       res
+
+     principalSubResultantSet(p,q) ==
+        if degree(p) < degree(q)
+        then (p,q) := (q,p)
+        if degree(p) = degree(q)
+        then (p,q) := (q,pseudoRemainder(p, q))
+        v := subresultantVector(p,q)$SUBRES
+        [coefficient(v.i,i) for i in 0..(((#v)-2)::N)]
+
+     resultantSet(lpols) ==
+       res : List(ThePols) := []
+       laux := lpols
+       for p in lpols repeat
+         laux := rest(laux)
+         for q in laux repeat
+           r : ThePols :=  first(principalSubResultantSet(p,q))
+           zero?(r) => return(error "Non relatively prime polynomials")
+           if not(ground? r) then res := cons(r,res)
+       res
+
+     projectionSet(lpols) ==
+       res : List(ThePols) := []
+       for p in lpols repeat
+         c := content(p)
+         ground?(c) => "next p"
+         res := cons(c,res)
+       lp1 := [primitivePart p for p in lpols]
+       f : ((RUP,RUP) -> Boolean) := (degree(#1) <= degree(#2))
+       lp1 := sort(f,lp1)
+       lsqfrb := squareFreeBasis(lp1)$PACK1
+       lsqfrb := sort(f,lsqfrb)
+       for p in lp1 repeat
+         res := append(res,coefficientSet(p))
+       res := append(res,discriminantSet(lsqfrb))
+       append(res,resultantSet(lsqfrb))
+
 *)
 
 \end{chunk}
@@ -14059,7 +19585,6 @@ CylindricalAlgebraicDecompositionUtilities(R,P) : PUB == PRIV where
        if degree(p1) > 0 then basis := cons(p1,basis)
        gcdBasisAdd(g,basis)
        
-
      gcdBasis(lpols) ==
        (#lpols <= 1) => lpols
        basis := gcdBasis(rest lpols)
@@ -14070,6 +19595,30 @@ CylindricalAlgebraicDecompositionUtilities(R,P) : PUB == PRIV where
 \begin{chunk}{COQ CADU}
 (* package CADU *)
 (*
+
+     squareFreeBasis(lpols) ==
+       lpols = [] => []
+       pol := first(lpols)
+       sqpol := unitCanonical(squareFreePart(pol))
+       gcdBasis(cons(sqpol,squareFreeBasis(rest(lpols))))
+         
+     gcdBasisAdd(p,lpols) ==
+       (degree(p) = 0) => lpols
+       null lpols => [unitCanonical p]
+       p1 := first(lpols)
+       g := gcd(p,p1)
+       (degree(g) = 0) => cons(p1,gcdBasisAdd(p,rest lpols))
+       p := (p exquo g)::P
+       p1 := (p1 exquo g)::P
+       basis := gcdBasisAdd(p,rest(lpols))
+       if degree(p1) > 0 then basis := cons(p1,basis)
+       gcdBasisAdd(g,basis)
+       
+     gcdBasis(lpols) ==
+       (#lpols <= 1) => lpols
+       basis := gcdBasis(rest lpols)
+       gcdBasisAdd(first(lpols),basis)
+
 *)
 
 \end{chunk}
@@ -14184,6 +19733,7 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where
       ++ Check for a and b inclusive if incl? is true, exclusive otherwise.
 
   Implementation ==> add
+
     import RealZeroPackage UPZ
     import InnerPolySign(F, UP)
     import ElementaryFunctionSign(R, F)
@@ -14209,6 +19759,7 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where
     findRealZero: (UPZ, U, B) -> List REC
 
     variation(p, a)      == var p(monomial(1, 1)$UP - a::UP)
+
     keeprec?(a, rec)     == (a > rec.right) or (a < rec.left)
 
     checkHalfAx(p, a, d, incl?) ==
@@ -14222,7 +19773,7 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where
       is?(f, "integral"::SE) => "failed"
       if not eval? then f := mkLogPos f
       ((ib := findLimit(f, k, b, "left", eval?)) case "failed") or
-          ((ia := findLimit(f, k, a, "right", eval?)) case "failed") => "failed"
+         ((ia := findLimit(f, k, a, "right", eval?)) case "failed") => "failed"
       infinite?(ia::OFE) and (ia::OFE = ib::OFE) => "failed"
       ib::OFE - ia::OFE
 
@@ -14324,11 +19875,9 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where
       if zb? then m := inc m
       odd?(v := va::Z - vb::Z) =>          -- p has an odd number of roots
         incl? or even? m => true
---        one? v => false
         (v = 1) => false
         "failed"
       zero? v => false                     -- p has no roots
---      one? m => true                    -- p has an even number > 0 of roots
       (m = 1) => true                     -- p has an even number > 0 of roots
       "failed"
 
@@ -14352,13 +19901,12 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where
       (s := sign(ea::F * eb::F)) case "failed" => "failed"
       s::Z > 0
 
--- returns true if p has a positive root. Include 0 is incl0? is true
+    -- returns true if p has a positive root. Include 0 is incl0? is true
     posRoot(p, incl0?) ==
       (z0? := zero?(coefficient(p, 0))) and incl0? => true
       (v := var p) case "failed" => "failed"
       odd?(v::Z) =>            -- p has an odd number of positive roots
         incl0? or not(z0?) => true
---        one?(v::Z) => false
         (v::Z) = 1 => false
         "failed"
       zero?(v::Z) => false     -- p has no positive roots
@@ -14387,6 +19935,203 @@ DefiniteIntegrationTools(R, F): Exports == Implementation where
 \begin{chunk}{COQ DFINTTLS}
 (* package DFINTTLS *)
 (*
+
+    import RealZeroPackage UPZ
+    import InnerPolySign(F, UP)
+    import ElementaryFunctionSign(R, F)
+    import PowerSeriesLimitPackage(R, F)
+    import UnivariatePolynomialCommonDenominator(Z, Q, UPQ)
+
+    mkLogPos    : F -> F
+    keeprec?    : (Q, REC) -> B
+    negative    : F -> Union(B, "failed")
+    mkKerPos    : K -> Union(F, "positive")
+    posRoot     : (UP, B) -> Union(B, "failed")
+    realRoot    : UP -> Union(B, "failed")
+    var         : UP -> Union(Z, "failed")
+    maprat      : UP -> Union(UPZ, "failed")
+    variation   : (UP, F) -> Union(Z, "failed")
+    infeval     : (UP, OFE) -> Union(F, "failed")
+    checkHalfAx : (UP, F, Z, B) -> Union(B, "failed")
+    findLimit   : (F, K, OFE, String, B) -> Union(OFE, "failed")
+    checkBudan  : (UP, OFE, OFE, B) -> Union(B, "failed")
+    checkDeriv  : (UP, OFE, OFE) -> Union(B, "failed")
+    sameSign    : (UP, OFE, OFE) -> Union(B, "failed")
+    intrat      : (OFE, OFE) -> U
+    findRealZero: (UPZ, U, B) -> List REC
+
+    variation(p, a)      == var p(monomial(1, 1)$UP - a::UP)
+
+    keeprec?(a, rec)     == (a > rec.right) or (a < rec.left)
+
+    checkHalfAx(p, a, d, incl?) ==
+      posRoot(p(d * (monomial(1, 1)$UP - a::UP)), incl?)
+
+    ignore? str ==
+      str = IGNOR => true
+      error "integrate: last argument must be 'noPole'"
+
+    computeInt(k, f, a, b, eval?) ==
+      is?(f, "integral"::SE) => "failed"
+      if not eval? then f := mkLogPos f
+      ((ib := findLimit(f, k, b, "left", eval?)) case "failed") or
+         ((ia := findLimit(f, k, a, "right", eval?)) case "failed") => "failed"
+      infinite?(ia::OFE) and (ia::OFE = ib::OFE) => "failed"
+      ib::OFE - ia::OFE
+
+    findLimit(f, k, a, dir, eval?) ==
+      r := retractIfCan(a)@Union(F, "failed")
+      r case F =>
+        eval? => mkLogPos(eval(f, k, r::F))::OFE
+        (u := limit(f, equation(k::F, r::F), dir)) case OFE => u::OFE
+        "failed"
+      (u := limit(f, equation(k::F::OFE, a))) case OFE => u::OFE
+      "failed"
+
+    mkLogPos f ==
+      lk := empty()$List(K)
+      lv := empty()$List(F)
+      for k in kernels f | is?(k, "log"::SE) repeat
+        if (v := mkKerPos k) case F then
+          lk := concat(k, lk)
+          lv := concat(v::F, lv)
+      eval(f, lk, lv)
+
+    mkKerPos k ==
+      (u := negative(f := first argument k)) case "failed" =>
+                                                     log(f**2) / (2::F)
+      u::B => log(-f)
+      "positive"
+
+    negative f ==
+      (u := sign f) case "failed" => "failed"
+      u::Z < 0
+
+    checkForZero(p, x, a, b, incl?) ==
+      checkForZero(
+        map(s+->s::F, univariate(p, x))_
+         $SparseUnivariatePolynomialFunctions2(P, F),
+            a, b, incl?)
+
+    checkForZero(q, a, b, incl?) ==
+      ground? q => false
+      (d := maprat q) case UPZ and not((i := intrat(a, b)) case failed) =>
+          not empty? findRealZero(d::UPZ, i, incl?)
+      (u := checkBudan(q, a, b, incl?)) case "failed" =>
+         incl? => checkDeriv(q, a, b)
+         "failed"
+      u::B
+
+    maprat p ==
+      ans:UPQ := 0
+      while p ^= 0 repeat
+        (r := retractIfCan(c := leadingCoefficient p)@Union(Q,"failed"))
+          case "failed"  => return "failed"
+        ans := ans + monomial(r::Q, degree p)
+        p   := reductum p
+      map(numer,(splitDenominator ans).num
+         )$SparseUnivariatePolynomialFunctions2(Q, Z)
+
+    intrat(a, b) ==
+      (n := whatInfinity a) ^= 0 =>
+        (r := retractIfCan(b)@Union(F,"failed")) case "failed" => ["all"]
+        (q := retractIfCan(r::F)@Union(Q, "failed")) case "failed" =>
+          ["failed"]
+        [[q::Q, n]]
+      (q := retractIfCan(retract(a)@F)@Union(Q,"failed")) case "failed"
+        => ["failed"]
+      (n := whatInfinity b) ^= 0 => [[q::Q, n]]
+      (t := retractIfCan(retract(b)@F)@Union(Q,"failed")) case "failed"
+        => ["failed"]
+      [[q::Q, t::Q]]
+
+    findRealZero(p, i, incl?) ==
+      i case fin =>
+        l := realZeros(p, r := i.fin)
+        incl? => l
+        select_!(s+->keeprec?(r.left, s) and keeprec?(r.right, s), l)
+      i case all => realZeros p
+      i case halfinf =>
+        empty?(l := realZeros p) => empty()
+        bounds:REC :=
+          i.halfinf.dir > 0 => [i.halfinf.endpoint, "max"/[t.right for t in l]]
+          ["min"/[t.left for t in l], i.halfinf.endpoint]
+        l := [u::REC for t in l | (u := refine(p, t, bounds)) case REC]
+        incl? => l
+        ep := i.halfinf.endpoint
+        select_!(s+->keeprec?(ep, s), l)
+      error "findRealZero: should not happpen"
+
+    checkBudan(p, a, b, incl?) ==
+      r := retractIfCan(b)@Union(F, "failed")
+      (n := whatInfinity a) ^= 0 =>
+        r case "failed" => realRoot p
+        checkHalfAx(p, r::F, n, incl?)
+      (za? := zero? p(aa := retract(a)@F)) and incl? => true
+      (n := whatInfinity b) ^= 0 => checkHalfAx(p, aa, n, incl?)
+      (zb? := zero? p(bb := r::F)) and incl? => true
+      (va := variation(p, aa)) case "failed" or
+                   (vb := variation(p, bb)) case "failed" => "failed"
+      m:Z := 0
+      if za? then m := inc m
+      if zb? then m := inc m
+      odd?(v := va::Z - vb::Z) =>          -- p has an odd number of roots
+        incl? or even? m => true
+        (v = 1) => false
+        "failed"
+      zero? v => false                     -- p has no roots
+      (m = 1) => true                     -- p has an even number > 0 of roots
+      "failed"
+
+    checkDeriv(p, a, b) ==
+      (r := retractIfCan(p)@Union(F, "failed")) case F => zero?(r::F)
+      (s := sameSign(p, a, b)) case "failed" => "failed"
+      s::B =>                  -- p has the same nonzero sign at a and b
+        (u := checkDeriv(differentiate p,a,b)) case "failed" => "failed"
+        u::B => "failed"
+        false
+      true
+
+    realRoot p ==
+      (b := posRoot(p, true)) case "failed" => "failed"
+      b::B => true
+      posRoot(p(p - monomial(1, 1)$UP), true)
+
+    sameSign(p, a, b) ==
+      (ea := infeval(p, a)) case "failed" => "failed"
+      (eb := infeval(p, b)) case "failed" => "failed"
+      (s := sign(ea::F * eb::F)) case "failed" => "failed"
+      s::Z > 0
+
+    -- returns true if p has a positive root. Include 0 is incl0? is true
+    posRoot(p, incl0?) ==
+      (z0? := zero?(coefficient(p, 0))) and incl0? => true
+      (v := var p) case "failed" => "failed"
+      odd?(v::Z) =>            -- p has an odd number of positive roots
+        incl0? or not(z0?) => true
+        (v::Z) = 1 => false
+        "failed"
+      zero?(v::Z) => false     -- p has no positive roots
+      z0? => true              -- p has an even number > 0 of positive roots
+      "failed"
+
+    infeval(p, a) ==
+      zero?(n := whatInfinity a) => p(retract(a)@F)
+      (u := signAround(p, n, sign)) case "failed" => "failed"
+      u::Z::F
+
+    var q ==
+      i:Z := 0
+      (lastCoef := negative leadingCoefficient q) case "failed" =>
+        "failed"
+      while ((q := reductum q) ^= 0) repeat
+        (next := negative leadingCoefficient q) case "failed" =>
+          return "failed"
+        if ((not(lastCoef::B)) and next::B) or
+                        ((not(next::B)) and lastCoef::B) then i := i + 1
+        lastCoef := next
+      i
+
 *)
 
 \end{chunk}
@@ -14466,7 +20211,6 @@ DegreeReductionPackage(R1, R2): Cat == Capsule where
  
     Capsule == add
  
- 
         degrees(u: UP R1): List Integer ==
             l: List Integer := []
             while u ^= 0 repeat
@@ -14494,6 +20238,29 @@ DegreeReductionPackage(R1, R2): Cat == Capsule where
 \begin{chunk}{COQ DEGRED}
 (* package DEGRED *)
 (*
+ 
+        degrees(u: UP R1): List Integer ==
+            l: List Integer := []
+            while u ^= 0 repeat
+              l := concat(degree u,l)
+              u := reductum u
+            l
+        reduce(u: UP R1) ==
+            g := "gcd"/[d for d in degrees u]
+            u := divideExponents(u, g:PI)::(UP R1)
+            [u, g:PI]
+ 
+        import Fraction Integer
+ 
+        rootOfUnity(j:I,n:I):RE ==
+            j = 0 => 1
+            arg:RE := 2*j*pi()/(n::RE)
+            cos arg + (-1)**(1/2) * sin arg
+ 
+        expand(s, g) ==
+            g = 1 => [s]
+            [rootOfUnity(i,g)*s**(1/g) for i in 0..g-1]
+
 *)
 
 \end{chunk}
@@ -14720,6 +20487,7 @@ DesingTreePackage(K,
       ++ the curve is reducible !!.
 
   Implementation ==>  add
+
     import PackPoly
     import PPFC1
     import PPFC2
@@ -15006,6 +20774,288 @@ DesingTreePackage(K,
 \begin{chunk}{COQ DTP}
 (* package DTP *)
 (*
+
+    import PackPoly
+    import PPFC1
+    import PPFC2
+    import PolyRing
+    import DesTree
+
+    divisorAtDesingTreeLocal: (BlUpRing , DesTree ) -> DIVISOR
+
+    polyRingToBlUpRing: (PolyRing, BLMET) -> BlUpRing
+
+    makeMono: DesTree -> BlUpRing
+      
+    inBetweenExcpDiv( tr )== 
+      -- trouve le diviseur excp. d'un pt inf voisin PRECEDENT !
+      -- qV est egal a : 1 +  nombre de fois que ce point est repete 
+      -- dans un chaine (le plus un correspond au point d'origine du
+      -- point dont il est question ici.
+      -- mp est la multiciplicite du point.
+      -- cette fonction n'est et ne peut etre qu'utiliser pour 
+      -- calculer le diviseur d'adjonction ( a cause du mp -1).      
+      noeud:= value tr
+      chart:= chartV noeud
+      qV:= quotValuation chart 
+      one? qV => 0$DIVISOR
+      expDiv := divisorAtDesingTreeLocal(makeMono(tr),tr)
+      mp:= degree expDiv
+      ((qV - 1) * (mp -1)) *$DIVISOR expDiv
+    
+    polyRingToBlUpRing(pol,chart)==
+      zero? pol => 0
+      lc:= leadingCoefficient pol
+      d:=entries degree pol
+      ll:= [ d.i for i in 1..3 | ^( i = chartCoord(chart) ) ]
+      e:= directProduct( vector( ll)$Vector(NNI) )$E2
+      monomial(lc , e )$BlUpRing + polyRingToBlUpRing( reductum pol, chart )
+
+    affToProj(pt:AFP, chart:BLMET ):ProjPt==
+      nV:= chartCoord chart
+      d:List(K) := list(pt)$AFP
+      ll:List K:= 
+        nV = 1 => [ 1$K , d.1  , d.2 ]
+        nV = 2 => [ d.1  , 01$K , d.2 ]
+        [d.1 , d.2 , 1 ]
+      projectivePoint( ll )$ProjPt
+
+    biringToPolyRing: (BlUpRing, BLMET) -> PolyRing
+
+    biringToPolyRing(pol,chart)==
+      zero? pol => 0
+      lc:= leadingCoefficient pol
+      d:=entries degree pol
+      nV:= chartCoord chart
+      ll:List NNI:= 
+        nV = 1 => [ 0$NNI , d.1  , d.2 ]
+        nV = 2 => [ d.1  , 0$NNI , d.2 ]
+        [d.1 , d.2 , 0$NNI ]
+      e:= directProduct( vector( ll)$Vector(NNI) )$E
+      monomial(lc , e )$PolyRing  + biringToPolyRing( reductum pol, chart )
+
+    minus  : (NNI,NNI) -> NNI
+
+    minus(a,b)==
+        d:=subtractIfCan(a,b)
+        d case "failed" => error "cannot substract a-b if b>a for NNI"
+        d
+      
+    -- returns the exceptional coordinate function
+
+    makeExcpDiv: List DesTree -> DIVISOR
+
+    desingTreeAtPointLocal: InfClsPoint  -> DesTree
+
+    subGenus: DesTree -> NNI
+    
+    lVar:List PolyRing := _
+      [monomial(1,index(i pretend PI)$OV,1)$PolyRing for i in 1..#symb]
+
+    divisorAtDesingTreeLocal(pol,tr)==
+      --  BLMET has QuadraticTransform ; marche aussi avec 
+      -- Hamburger-Noether mais surement moins efficace
+      noeud:=value(tr)
+      pt:=localPointV(noeud)
+      chart:= chartV noeud
+      -- ram:= ramifMult chart -- ???
+      -- new way to compute in order not to translate twice pol
+      polTrans:BlUpRing:=translate(pol,list(pt)$AFP)$PACKBL
+      multPol:=degreeOfMinimalForm(polTrans)
+      chtr:=children(tr)
+      parPol:PCS
+      ord:Integer
+      empty?(chtr) =>
+        parPol:=parametrize(biringToPolyRing(pol,chartV(noeud))_
+                            ,localParamV(noeud))$ParamPack
+        ord:=order(parPol)$PCS
+        ord * excpDivV(noeud)  -- Note: le div excp est une fois la place.
+      (multPol *$DIVISOR excpDivV(noeud)) +$DIVISOR _
+         reduce("+",[divisorAtDesingTreeLocal(_
+                      quadTransform(polTrans,multPol,(chartV(value(child)))),_
+                        child)_
+                          for child in chtr])
+
+    desingTreeAtPointLocal(ipt) ==
+      -- crb:PolyRing,pt:ProjPt,lstnV:List(INT),origPoint:ProjPt,actL:K)==
+      -- peut etre est-il preferable, avant d'eclater, de tester
+      -- si le point est simple avec les derives, et non
+      -- verifier si le point est simple ou non apres translation. 
+      -- ???? 
+      blbl:=blowUp ipt
+      multPt:=multV ipt
+      one?(multPt) =>
+        tree( ipt )$DesTree
+      subTree:List DesTree:= [desingTreeAtPointLocal( iipt )  for iipt in blbl]
+      tree( ipt, subTree )$DesTree
+
+    blowUp(ipt)==
+      crb:=curveV ipt
+      pt:= localPointV ipt
+      lstnV := chartV ipt   -- CHH  no modif needed
+      actL:= actualExtensionV ipt
+      origPoint:= pointV ipt
+      blbl:=stepBlowUp(crb,pt,lstnV,actL) -- CHH no modif needed
+      multPt:=blbl.mult
+      sm:= blbl.subMult
+      -- la multiplicite et la frontiere du polygone de Newton (ou la forme 
+      -- minimale selon BLMET) du point ipt est assigne par effet de bord !
+      setmult!(ipt,multPt)
+      setsubmult!(ipt, sm)
+      one?(multPt) => empty()
+      [create(origPoint,_
+              rec(recTransStr),_
+              rec(recPoint) ,_
+              0,_
+              rec(recChart),_
+              0,
+              0$DIVISOR,_
+              rec(definingExtension),_ 
+              new(I)$Symbol )$InfClsPoint  for rec in blbl.blUpRec] 
+            
+    makeMono(arb)==
+      monomial(1,index(excepCoord(chartV(value(arb))) pretend PI)$OV2,_
+                  1)$BlUpRing 
+
+    makeExcpDiv(lstSsArb)==
+      reduce("+", _
+         [divisorAtDesingTreeLocal(makeMono(arb),arb) for arb in lstSsArb],0)
+
+    adjunctionDivisorForQuadTrans: DesTree -> DIVISOR
+    adjunctionDivisorForHamburgeNoether: DesTree -> DIVISOR
+
+    adjunctionDivisor( tr )==
+      BLMET has QuadraticTransform => adjunctionDivisorForQuadTrans( tr )
+      BLMET has HamburgerNoether =>   adjunctionDivisorForHamburgeNoether( tr )
+      error _
+       " The algorithm to compute the adjunction divisor is not defined for the blowing method you have chosen"
+
+    adjunctionDivisorForHamburgeNoether( tr )==
+      noeud:=value tr
+      chtr:= children tr
+      empty?(chtr) => 0$DIVISOR  -- on suppose qu'un noeud sans feuille 
+                                 -- est une feulle, donc non singulier. !
+      multPt:= multV noeud
+      ( minus(multPt,1)  pretend INT)  *$DIVISOR excpDivV(noeud) +$DIVISOR _
+         reduce("+",[inBetweenExcpDiv( arb ) for arb in chtr ]) +$DIVISOR _ 
+         reduce("+",[adjunctionDivisorForHamburgeNoether(arb) for arb in chtr])
+
+    adjunctionDivisorForQuadTrans(tr)==
+      noeud:=value(tr)
+      chtr:=children(tr)
+      empty?(chtr) => 0$DIVISOR 
+      multPt:=multV(noeud)
+      ( minus(multPt,1)  pretend INT)  *$DIVISOR excpDivV(noeud) +$DIVISOR _
+          reduce("+",[adjunctionDivisorForQuadTrans(child) for child in chtr])
+
+    divisorAtDesingTree( pol , tr)==
+      chart:= chartV value(tr)
+      pp:= polyRingToBlUpRing( pol, chart )
+      divisorAtDesingTreeLocal( pp, tr ) 
+      
+    subGenus(tr)==
+      noeud:=value tr
+      mult:=multV(noeud)
+      chart := chartV noeud
+      empty?(chdr:=children(tr)) => 0     -- degree(noeud)* mult* minus(mult,1)
+      degree(noeud)* ( mult*minus( mult, 1 ) + subMultV( noeud ) ) + 
+          reduce("+",[subGenus(ch) for ch in chdr])
+      
+    initializeParamOfPlaces(tr,lpol)==
+      noeud:=value(tr)
+      pt:=localPointV(noeud)
+      crb:=curveV(noeud)
+      chart:=chartV(noeud) -- CHH
+      nV:INT:=chartCoord chart 
+      chtr:List DesTree:=children(tr)
+      plc:Plc
+      lParam:List PCS
+      dd:PositiveInteger:=degree noeud
+      lcoef:List K
+      lll:Integer
+      lParInf:List(PCS)
+      lpar:List PCS
+      empty?(chtr) =>
+        lPar:=localParamOfSimplePt( affToProj(pt, chart) , _
+                               biringToPolyRing(crb, chart),nV)$ParamPackFC
+        setlocalParam!(noeud,lPar)
+        lParam:=[parametrize( f , lPar)$ParamPack for f in lpol]
+        plc:= create( symbNameV(noeud) )$Plc
+        setParam!(plc,lParam)
+        setDegree!(plc,dd)
+        itsALeaf!(plc)
+        setexcpDiv!(noeud, plc :: DIVISOR )
+        void()
+      lpolTrans:List PolyRing:=_
+        [translateToOrigin( pol, affToProj(pt, chart) , nV) for pol in lpol]
+      lpolBlUp:List PolyRing
+      chartBl:BLMET
+      for arb in chtr repeat
+        chartBl:=chartV value arb  
+        lpolBlUp:=[applyTransform(pol,chartBl) for pol in lpolTrans]
+        initializeParamOfPlaces(arb,lpolBlUp)
+      void()
+      
+    blowUpWithExcpDiv(tr:DesTree)==
+      noeud:=value(tr)
+      pt:=localPointV(noeud)
+      crb:=curveV(noeud)
+      chtr:List DesTree:=children(tr)
+      empty?(chtr) => void() -- tr
+      for arb in chtr repeat 
+        blowUpWithExcpDiv(arb) 
+      setexcpDiv!(noeud,makeExcpDiv( chtr  ))
+      void()
+
+    fullParamInit(tr)==
+      initializeParamOfPlaces(tr)
+      blowUpWithExcpDiv(tr)
+      void()
+
+    initializeParamOfPlaces(tr)==initializeParamOfPlaces(tr,lVar)
+
+    desingTreeAtPoint(pt,crb)==
+      ipt:= create(pt,crb)$InfClsPoint
+      desingTreeAtPointLocal ipt
+
+    genus(crb)==
+      if BLMET has HamburgerNoether then _
+         print(("  BUG BUG corige le bug GH ---- ")::OutputForm)
+      degCrb:=totalDegree(crb)$PackPoly
+      genusTree(degCrb,desingTree(crb))
+
+    genusNeg(crb)==
+      degCrb:=totalDegree(crb)$PackPoly
+      genusTreeNeg(degCrb,desingTree(crb))
+
+    desingTree(crb)==
+      [desingTreeAtPoint(pt,crb) for pt in singularPoints(crb)$PrjAlgPack]
+
+    genusTree(degCrb,listArbDes)==
+      -- le test suivant est necessaire 
+      -- ( meme s'il n'y a pas de point singulier dans ce cas)
+      -- car avec sousNNI on ne peut retourner un entier negatif
+      (degCrb <$NNI 3::NNI) and ^empty?(listArbDes) =>
+        print(("Too many infinitly near points")::OutputForm)
+        print(("The curve may not be absolutely irreducible")::OutputForm)
+        error "Have a nice day"
+      (degCrb <$NNI 3::NNI)  => 0
+      ga:= ( minus(degCrb,1)*minus(degCrb ,2) ) quo$NNI 2
+      empty?(listArbDes) => ga
+      --calcul du nombre de double point
+      dp:= reduce("+",[subGenus(arbD) for arbD in listArbDes]) quo$NNI 2
+      (dp >$NNI ga) =>
+        print(("Too many infinitly near points")::OutputForm)
+        print(("The curve may not be absolutely irreducible")::OutputForm)
+        error "Have a nice day"
+      minus(ga,dp)
+
+    genusTreeNeg(degCrb,listArbDes)==
+      -- (degCrb <$NNI 3::NNI) => 0
+      ga:= (degCrb-1)*(degCrb-2) quo$INT 2
+      empty?(listArbDes) => ga 
+      ga-( reduce("+",[subGenus(arbD) for arbD in listArbDes]) quo$NNI 2)::INT
+
 *)
 
 \end{chunk}
@@ -15247,6 +21297,120 @@ DiophantineSolutionPackage(): Cat == Capsule where
 \begin{chunk}{COQ DIOSP}
 (* package DIOSP *)
 (*
+ 
+    import I
+    import POLI
+ 
+    -- local function specifications
+ 
+    initializeGraph: (LPOLI, I) -> Graph
+    createNode: (I, VI, NI, I) -> Node
+    findSolutions: (VNI, I, I, I, Graph, B) -> ListSol
+    verifyMinimality: (VNI, Graph, B) -> B
+    verifySolution: (VNI, I, I, I, Graph) -> B
+ 
+    -- exported functions
+ 
+    dioSolve(eq) ==
+      p := lhs(eq) - rhs(eq)
+      n := totalDegree(p)
+      n = 0 or n > 1 =>
+        error "a linear Diophantine equation is expected"
+      mon := empty()$LPOLI
+      c : I := 0
+      for x in monomials(p) repeat
+        ground?(x) =>
+          c := ground(x) :: I
+        mon := cons(x, mon)$LPOLI
+      graph := initializeGraph(mon, c)
+      sol := zero(graph.dim)$VNI
+      hs := findSolutions(sol, graph.zeroNode, 1, 1, graph, true)
+      ihs : ListSol :=
+        c = 0 => [sol]
+        findSolutions(sol, graph.zeroNode + c, 1, 1, graph, false)
+      vars := [first(variables(x))$LS for x in mon]
+      [vars, if empty?(ihs)$ListSol then "failed" else ihs, hs]
+ 
+    -- local functions
+ 
+    initializeGraph(mon, c) ==
+      coeffs := vector([first(coefficients(x))$LI for x in mon])$VI
+      k := #coeffs
+      m := min(c, reduce(min, coeffs)$VI)
+      n := max(c, reduce(max, coeffs)$VI)
+      [[createNode(i, coeffs, k, 1 - m) for i in m..n], k, 1 - m]
+ 
+    createNode(ind, coeffs, k, zeroNode) ==
+      -- create vertices from node ind to other nodes
+      v := zero(k)$VI
+      for i in 1..k repeat
+        ind > 0 =>
+          coeffs.i < 0 =>
+            v.i := zeroNode + ind + coeffs.i
+        coeffs.i > 0 =>
+          v.i := zeroNode + ind + coeffs.i
+      [v, true]
+ 
+    findSolutions(sol, ind, m, n, graph, flag) ==
+      -- return all solutions (paths) from node ind to node zeroNode
+      sols := empty()$ListSol
+      node := graph.vn.ind
+      node.free =>
+        node.free := false
+        v := node.vert
+        k := if ind < graph.zeroNode then m else n
+        for i in k..graph.dim repeat
+          x := sol.i
+          v.i > 0 =>  -- vertex exists to other node
+            sol.i := x + 1
+            v.i = graph.zeroNode =>  -- solution found
+              verifyMinimality(sol, graph, flag) =>
+                sols := cons(copy(sol)$VNI, sols)$ListSol
+                sol.i := x
+              sol.i := x
+            s :=
+              ind < graph.zeroNode =>
+                findSolutions(sol, v.i, i, n, graph, flag)
+              findSolutions(sol, v.i, m, i, graph, flag)
+            sols := append(s, sols)$ListSol
+            sol.i := x
+        node.free := true
+        sols
+      sols
+ 
+    verifyMinimality(sol, graph, flag) ==
+      -- test whether sol contains a minimal homogeneous solution
+      flag =>  -- sol is a homogeneous solution
+        i := 1
+        while sol.i = 0 repeat
+          i := i + 1
+        x := sol.i
+        sol.i := (x - 1) :: NI
+        flag := verifySolution(sol, graph.zeroNode, 1, 1, graph)
+        sol.i := x
+        flag
+      verifySolution(sol, graph.zeroNode, 1, 1, graph)
+ 
+    verifySolution(sol, ind, m, n, graph) ==
+      -- test whether sol contains a path from ind to zeroNode
+      flag := true
+      node := graph.vn.ind
+      v := node.vert
+      k := if ind < graph.zeroNode then m else n
+      for i in k..graph.dim while flag repeat
+        x := sol.i
+        x > 0 and v.i > 0 =>  -- vertex exists to other node
+          sol.i := (x - 1) :: NI
+          v.i = graph.zeroNode =>  -- solution found
+            flag := false
+            sol.i := x
+          flag :=
+            ind < graph.zeroNode =>
+              verifySolution(sol, v.i, i, n, graph)
+            verifySolution(sol, v.i, m, i, graph)
+          sol.i := x
+      flag
+
 *)
 
 \end{chunk}
@@ -15341,10 +21505,13 @@ DirectProductFunctions2(dim, A, B): Exports == Implementation where
       ++ producing a new vector containing the values.
  
   Implementation ==> add
+
     import FiniteLinearAggregateFunctions2(A, VA, B, VB)
  
     map(f, v)       == directProduct map(f, v::VA)
+
     scan(f, v, b)   == directProduct scan(f, v::VA, b)
+
     reduce(f, v, b) == reduce(f, v::VA, b)
 
 \end{chunk}
@@ -15352,6 +21519,15 @@ DirectProductFunctions2(dim, A, B): Exports == Implementation where
 \begin{chunk}{COQ DIRPROD2}
 (* package DIRPROD2 *)
 (*
+
+    import FiniteLinearAggregateFunctions2(A, VA, B, VB)
+ 
+    map(f, v)       == directProduct map(f, v::VA)
+
+    scan(f, v, b)   == directProduct scan(f, v::VA, b)
+
+    reduce(f, v, b) == reduce(f, v::VA, b)
+
 *)
 
 \end{chunk}
@@ -15438,6 +21614,7 @@ DiscreteLogarithmPackage(M): public == private where
   DLP ==> DiscreteLogarithmPackage
 
   private ==> add
+
     shanksDiscLogAlgorithm(logbase,c,p) ==
       limit:Integer:= 30
       -- for logarithms up to cyclic groups of order limit a full
@@ -15488,6 +21665,52 @@ DiscreteLogarithmPackage(M): public == private where
 \begin{chunk}{COQ DLP}
 (* package DLP *)
 (*
+
+    shanksDiscLogAlgorithm(logbase,c,p) ==
+      limit:Integer:= 30
+      -- for logarithms up to cyclic groups of order limit a full
+      -- logarithm table is computed
+      p < limit =>
+        a:M:=1
+        disclog:Integer:=0
+        found:Boolean:=false
+        for i in 0..p-1 while not found repeat
+          a = c =>
+            disclog:=i
+            found:=true
+          a:=a*logbase
+        not found =>
+          messagePrint("discreteLog: second argument not in cyclic group_
+ generated by first argument")$OutputForm
+          "failed"
+        disclog pretend NonNegativeInteger
+      l:Integer:=length(p)$Integer
+      if odd?(l)$Integer then n:Integer:= shift(p,-(l quo 2))
+                         else n:Integer:= shift(1,(l quo 2))
+      a:M:=1
+      exptable : Table(PI,NNI) :=table()$Table(PI,NNI)
+      for i in (0::NNI)..(n-1)::NNI repeat
+        insert_!([lookup(a),i::NNI]$Record(key:PI,entry:NNI),_
+                  exptable)$Table(PI,NNI)
+        a:=a*logbase
+      found := false
+      end := (p-1) quo n
+      disclog:Integer:=0
+      a := c
+      b := logbase ** (-n)
+      for i in 0..end while not found repeat
+        rho:= search(lookup(a),exptable)_
+              $Table(PositiveInteger,NNI)
+        rho case NNI =>
+          found := true
+          disclog:= n * i + rho pretend Integer
+        a := a * b
+      not found =>
+        messagePrint("discreteLog: second argument not in cyclic group_
+ generated by first argument")$OutputForm
+        "failed"
+      disclog pretend NonNegativeInteger
+
 *)
 
 \end{chunk}
@@ -15602,7 +21825,6 @@ DisplayPackage: public == private where
       ++ sayLength(l) returns the length of a list of strings l as an integer.
 
   private == add
-    --StringManipulations()
 
     center0:  (I,I,S) -> RECLR
 
@@ -15642,7 +21864,6 @@ DisplayPackage: public == private where
       wid < 1 => [""]$(L S)
       len : I := sayLength l
       len = wid => l
---    len > wid => s(1..wid)
       rec : RECLR := center0(len,wid,fill)
       cons(rec.lhs,append(l,list rec.rhs))
 
@@ -15670,6 +21891,67 @@ DisplayPackage: public == private where
 \begin{chunk}{COQ DISPLAY}
 (* package DISPLAY *)
 (*
+
+    center0:  (I,I,S) -> RECLR
+
+    s : S
+    l : L S
+
+    HION    : S := " "
+    HIOFF   : S := " "
+    NEWLINE : S := "%l"
+
+    bright s == [HION,s,HIOFF]$(L S)
+    bright l == cons(HION,append(l,list HIOFF))
+    newLine() == NEWLINE
+
+    copies(n : I, s : S) ==
+      n < 1 => ""
+      n = 1 => s
+      t : S := copies(n quo 2, s)
+      odd? n => concat [s,t,t]
+      concat [t,t]
+
+    center0(len : I, wid : I, fill : S) : RECLR ==
+      (wid < 1) or (len >= wid) => ["",""]$RECLR
+      m : I := (wid - len) quo 2
+      t : S := copies(1 + (m quo (sayLength fill)),fill)
+      [t(1..m),t(1..wid-len-m)]$RECLR
+
+    center(s, wid, fill) ==
+      wid < 1 => ""
+      len : I := sayLength s
+      len = wid => s
+      len > wid => s(1..wid)
+      rec : RECLR := center0(len,wid,fill)
+      concat [rec.lhs,s,rec.rhs]
+
+    center(l, wid, fill) ==
+      wid < 1 => [""]$(L S)
+      len : I := sayLength l
+      len = wid => l
+      rec : RECLR := center0(len,wid,fill)
+      cons(rec.lhs,append(l,list rec.rhs))
+
+    say s ==
+      sayBrightly$Lisp s
+      void()$Void
+
+    say l ==
+      sayBrightly$Lisp l
+      void()$Void
+
+    sayLength s == #s
+
+    sayLength l ==
+      sum : I := 0
+      for s in l repeat
+        s = HION      => sum := sum + 1
+        s = HIOFF     => sum := sum + 1
+        s = NEWLINE   => sum
+        sum := sum + sayLength s
+      sum
+
 *)
 
 \end{chunk}
@@ -15800,6 +22082,7 @@ DistinctDegreeFactorize(F,FP): C == T
  
  
    T == add
+
       --declarations
       D:=ModMonic(F,FP)
       import UnivariatePolynomialSquareFree(F,FP)
@@ -15994,6 +22277,196 @@ DistinctDegreeFactorize(F,FP): C == T
 \begin{chunk}{COQ DDFACT}
 (* package DDFACT *)
 (*
+
+      --declarations
+      D:=ModMonic(F,FP)
+      import UnivariatePolynomialSquareFree(F,FP)
+ 
+      --local functions
+      notSqFr : (FP,FP -> List(FP)) -> List(ParFact)
+      ddffact : FP -> List(FP)
+      ddffact1 : (FP,Boolean) -> List fact
+      ranpol :         NNI       -> FP
+      
+      charF : Boolean := characteristic()$F = 2
+
+      --construct a random polynomial of random degree < d
+      ranpol(d:NNI):FP ==
+        k1: NNI := 0
+        while k1 = 0 repeat k1 := random d
+        -- characteristic F = 2
+        charF =>
+           u:=0$FP
+           for j in 1..k1 repeat u:=u+monomial(random()$F,j)
+           u
+        u := monomial(1,k1)
+        for j in 0..k1-1 repeat u:=u+monomial(random()$F,j)
+        u
+ 
+      notSqFr(m:FP,appl: FP->List(FP)):List(ParFact) ==
+        factlist : List(ParFact) :=empty()
+        llf : List FFE
+        fln :List(FP) := empty()
+        if (lcm:=leadingCoefficient m)^=1 then m:=(inv lcm)*m
+        llf:= factorList(squareFree(m))
+        for lf in llf repeat
+          d1:= lf.xpnt
+          pol := lf.fctr
+          if (lcp:=leadingCoefficient pol)^=1 then pol := (inv lcp)*pol
+          degree pol=1 => factlist:=cons([pol,d1]$ParFact,factlist)
+          fln := appl(pol)
+          factlist :=append([[pf,d1]$ParFact for pf in fln],factlist)
+        factlist
+ 
+      -- compute u**k mod v (requires call to setPoly of multiple of v)
+      -- characteristic not equal 2
+      exptMod(u:FP,k:NNI,v:FP):FP == (reduce(u)$D**k):FP rem v
+ 
+      -- compute u**k mod v (requires call to setPoly of multiple of v)
+      -- characteristic equal 2
+      trace2PowMod(u:FP,k:NNI,v:FP):FP ==
+        uu:=u
+        for i in 1..k repeat uu:=(u+uu*uu) rem v
+        uu
+
+      -- compute u+u**q+..+u**(q**k) mod v 
+      -- (requires call to setPoly of multiple of v) where q=size< F
+      tracePowMod(u:FP,k:NNI,v:FP):FP ==
+        u1 :D :=reduce(u)$D
+        uu : D := u1
+        for i in 1..k repeat uu:=(u1+frobenius uu) 
+        (lift uu) rem v
+
+      -- compute u**(1+q+..+q**k) rem v where q=#F 
+      -- (requires call to setPoly of multiple of v)
+      -- frobenius map is used
+      normPowMod(u:FP,k:NNI,v:FP):FP ==
+        u1 :D :=reduce(u)$D
+        uu : D := u1
+        for i in 1..k repeat uu:=(u1*frobenius uu) 
+        (lift uu) rem v
+ 
+      --find the factorization of m as product of factors each containing
+      --terms of equal degree .
+      -- if testirr=true the function returns the first factor found
+      ddffact1(m:FP,testirr:Boolean):List(fact) ==
+        p:=size$F
+        dg:NNI :=0
+        ddfact:List(fact):=empty()
+        --evaluation of x**p mod m
+        k1:NNI
+        u:= m
+        du := degree u
+        setPoly u
+        mon: FP := monomial(1,1)
+        v := mon
+        for k1 in 1.. while k1 <= (du quo 2) repeat
+            v := lift frobenius reduce(v)$D
+            g := gcd(v-mon,u)
+            dg := degree g
+            dg =0  => "next k1"
+            if leadingCoefficient g ^=1 then g := (inv leadingCoefficient g)*g
+            ddfact := cons([k1,g]$fact,ddfact)
+            testirr => return ddfact
+            u := u quo g
+            du := degree u
+            du = 0 => return ddfact
+            setPoly u
+        cons([du,u]$fact,ddfact)
+ 
+      -- test irreducibility
+      irreducible?(m:FP):Boolean ==
+        mf:fact:=first ddffact1(m,true)
+        degree m = mf.deg
+ 
+      --export ddfact1
+      separateDegrees(m:FP):List(fact) == ddffact1(m,false)
+ 
+      --find the complete factorization of m, using the result of ddfact1
+      separateFactors(distf : List fact) :List FP ==
+        ddfact := distf
+        n1:Integer
+        p1:=size()$F
+        if charF then n1:=length(p1)-1
+        newaux,aux,ris : List FP
+        ris := empty()
+        t,fprod : FP
+        for ffprod in ddfact repeat
+          fprod := ffprod.prod
+          d := ffprod.deg
+          degree fprod = d => ris := cons(fprod,ris)
+          aux:=[fprod]
+          setPoly fprod
+          while ^(empty? aux) repeat
+            t := ranpol(2*d)
+            if charF then t:=trace2PowMod(t,(n1*d-1)::NNI,fprod)
+            else t:=exptMod(tracePowMod(t,(d-1)::NNI,fprod),
+                                     (p1 quo 2)::NNI,fprod)-1$FP
+            newaux:=empty()
+            for u in aux repeat
+                g := gcd(u,t)
+                dg:= degree g
+                dg=0 or dg = degree u => newaux:=cons(u,newaux)
+                v := u quo g
+                if dg=d then ris := cons(inv(leadingCoefficient g)*g,ris)
+                        else newaux := cons(g,newaux)
+                if degree v=d then ris := cons(inv(leadingCoefficient v)*v,ris)
+                              else newaux := cons(v,newaux)
+            aux:=newaux
+        ris
+ 
+      --distinct degree algorithm for monic ,square-free polynomial
+      ddffact(m:FP):List(FP)==
+        ddfact:=ddffact1(m,false)
+        empty? ddfact => [m]
+        separateFactors ddfact
+ 
+      --factorize a general polynomial with distinct degree algorithm
+      --if test=true no check is executed on square-free
+      distdfact(m:FP,test:Boolean):FinalFact ==
+        factlist: List(ParFact):= empty()
+        fln : List(FP) :=empty()
+ 
+        --make m monic
+        if (lcm := leadingCoefficient m) ^=1 then m := (inv lcm)*m
+ 
+        --is x**d factor of m?
+        if (d := minimumDegree m)>0 then
+          m := (monicDivide (m,monomial(1,d))).quotient
+          factlist := [[monomial(1,1),d]$ParFact]
+        d:=degree m
+ 
+        --is m constant?
+        d=0 => [lcm,factlist]$FinalFact
+ 
+        --is m linear?
+        d=1 => [lcm,cons([m,d]$ParFact,factlist)]$FinalFact
+ 
+        --m is square-free
+        test =>
+          fln := ddffact m
+          factlist := append([[pol,1]$ParFact for pol in fln],factlist)
+          [lcm,factlist]$FinalFact
+ 
+        --factorize the monic,square-free terms
+        factlist:= append(notSqFr(m,ddffact),factlist)
+        [lcm,factlist]$FinalFact
+ 
+      --factorize the polynomial m
+      factor(m:FP) ==
+        m = 0 => 0
+        flist := distdfact(m,false)
+        makeFR(flist.cont::FP,[["prime",u.irr,u.pow]$FFE 
+                                 for u in flist.factors])
+
+
+      --factorize the square free polynomial m
+      factorSquareFree(m:FP) ==
+        m = 0 => 0
+        flist := distdfact(m,true)
+        makeFR(flist.cont::FP,[["prime",u.irr,u.pow]$FFE 
+                                 for u in flist.factors])
+
 *)
 
 \end{chunk}
@@ -18893,26 +25366,33 @@ Axiom uses the power series at the zero point:
 \begin{chunk}{package DFSFUN DoubleFloatSpecialFunctions}
 
         polygamma(k,z)  == CPSI(k, z)$Lisp
+
         polygamma(k,x)  == RPSI(k, x)$Lisp
 
         logGamma z      == CLNGAMMA(z)$Lisp
+
         logGamma x      == RLNGAMMA(x)$Lisp
 
         besselJ(v,z)    == CBESSELJ(v,z)$Lisp
+
         besselJ(n,x)    == RBESSELJ(n,x)$Lisp
 
         besselI(v,z)    == CBESSELI(v,z)$Lisp
+
         besselI(n,x)    == RBESSELI(n,x)$Lisp
 
         hypergeometric0F1(a,z) == CHYPER0F1(a, z)$Lisp
+
         hypergeometric0F1(n,x) == retract hypergeometric0F1(n::C, x::C)
 
 
         -- All others are defined in terms of these.
         digamma x == polygamma(0, x)
+
         digamma z == polygamma(0, z)
 
         Beta(x,y) == Gamma(x)*Gamma(y)/Gamma(x+y)
+
         Beta(w,z) == Gamma(w)*Gamma(z)/Gamma(w+z)
 
         fuzz := (10::R)**(-7)
@@ -18924,6 +25404,7 @@ Axiom uses the power series at the zero point:
             if integer? n then n := n + fuzz
             vp := n * pi()$R
             (cos(vp) * besselJ(n,x) - besselJ(-n,x) )/sin(vp)
+
         besselY(v,z) ==
             if integer? v then v := v + fuzz::C
             vp := v * pi()$C
@@ -18935,6 +25416,7 @@ Axiom uses the power series at the zero point:
             vp   := n*p
             ahalf:= 1/(2::R)
             p * ahalf * ( besselI(-n,x) - besselI(n,x) )/sin(vp)
+
         besselK(v,z) ==
             if integer? v then v := v + fuzz::C
             p    := pi()$C
@@ -18947,6 +25429,7 @@ Axiom uses the power series at the zero point:
             athird := recip(3::R)::R
             eta := 2 * athird * (-x) ** (3*ahalf)
             (-x)**ahalf * athird * (besselJ(-athird,eta) + besselJ(athird,eta))
+
         airyAi z ==
             ahalf  := recip(2::C)::C
             athird := recip(3::C)::C
@@ -18970,6 +25453,90 @@ Axiom uses the power series at the zero point:
 \begin{chunk}{COQ DFSFUN}
 (* package DFSFUN *)
 (*
+
+        polygamma(k,z)  == CPSI(k, z)$Lisp
+
+        polygamma(k,x)  == RPSI(k, x)$Lisp
+
+        logGamma z      == CLNGAMMA(z)$Lisp
+
+        logGamma x      == RLNGAMMA(x)$Lisp
+
+        besselJ(v,z)    == CBESSELJ(v,z)$Lisp
+
+        besselJ(n,x)    == RBESSELJ(n,x)$Lisp
+
+        besselI(v,z)    == CBESSELI(v,z)$Lisp
+
+        besselI(n,x)    == RBESSELI(n,x)$Lisp
+
+        hypergeometric0F1(a,z) == CHYPER0F1(a, z)$Lisp
+
+        hypergeometric0F1(n,x) == retract hypergeometric0F1(n::C, x::C)
+
+
+        -- All others are defined in terms of these.
+        digamma x == polygamma(0, x)
+
+        digamma z == polygamma(0, z)
+
+        Beta(x,y) == Gamma(x)*Gamma(y)/Gamma(x+y)
+
+        Beta(w,z) == Gamma(w)*Gamma(z)/Gamma(w+z)
+
+        fuzz := (10::R)**(-7)
+
+        import IntegerRetractions(R)
+        import IntegerRetractions(C)
+
+        besselY(n,x) ==
+            if integer? n then n := n + fuzz
+            vp := n * pi()$R
+            (cos(vp) * besselJ(n,x) - besselJ(-n,x) )/sin(vp)
+
+        besselY(v,z) ==
+            if integer? v then v := v + fuzz::C
+            vp := v * pi()$C
+            (cos(vp) * besselJ(v,z) - besselJ(-v,z) )/sin(vp)
+
+        besselK(n,x) ==
+            if integer? n then n := n + fuzz
+            p    := pi()$R
+            vp   := n*p
+            ahalf:= 1/(2::R)
+            p * ahalf * ( besselI(-n,x) - besselI(n,x) )/sin(vp)
+
+        besselK(v,z) ==
+            if integer? v then v := v + fuzz::C
+            p    := pi()$C
+            vp   := v*p
+            ahalf:= 1/(2::C)
+            p * ahalf * ( besselI(-v,z) - besselI(v,z) )/sin(vp)
+
+        airyAi x ==
+            ahalf  := recip(2::R)::R
+            athird := recip(3::R)::R
+            eta := 2 * athird * (-x) ** (3*ahalf)
+            (-x)**ahalf * athird * (besselJ(-athird,eta) + besselJ(athird,eta))
+
+        airyAi z ==
+            ahalf  := recip(2::C)::C
+            athird := recip(3::C)::C
+            eta := 2 * athird * (-z) ** (3*ahalf)
+            (-z)**ahalf * athird * (besselJ(-athird,eta) + besselJ(athird,eta))
+
+        airyBi x ==
+            ahalf  := recip(2::R)::R
+            athird := recip(3::R)::R
+            eta := 2 * athird * (-x) ** (3*ahalf)
+            (-x*athird)**ahalf * ( besselJ(-athird,eta) - besselJ(athird,eta) )
+
+        airyBi z ==
+            ahalf  := recip(2::C)::C
+            athird := recip(3::C)::C
+            eta := 2 * athird * (-z) ** (3*ahalf)
+            (-z*athird)**ahalf * ( besselJ(-athird,eta) - besselJ(athird,eta) )
+
 *)
 
 \end{chunk}
@@ -19050,6 +25617,7 @@ DoubleResultantPackage(F, UP, UPUP, R): Exports == Implementation where
       ++ finite poles. Argument ' is the derivation to use.
 
   Implementation ==> add
+
     import CommuteUnivariatePolynomialCategory(F, UP, UP2)
     import UnivariatePolynomialCommonDenominator(UP, RF, UPUP)
 
@@ -19080,6 +25648,32 @@ DoubleResultantPackage(F, UP, UPUP, R): Exports == Implementation where
 \begin{chunk}{COQ DBLRESP}
 (* package DBLRESP *)
 (*
+
+    import CommuteUnivariatePolynomialCategory(F, UP, UP2)
+    import UnivariatePolynomialCommonDenominator(UP, RF, UPUP)
+
+    UP22   : UP   -> UP2
+    UP23   : UPUP -> UP3
+    remove0: UP   -> UP             -- removes the power of x dividing p
+
+    remove0 p ==
+      primitivePart((p exquo monomial(1, minimumDegree p))::UP)
+
+    UP22 p ==
+      map(x+->x::UP, p)$UnivariatePolynomialCategoryFunctions2(F,UP,UP,UP2)
+
+    UP23 p ==
+      map(x+->UP22(retract(x)@UP),p)_
+         $UnivariatePolynomialCategoryFunctions2(RF, UPUP, UP2, UP3)
+
+    doubleResultant(h, derivation) ==
+      cd := splitDenominator lift h
+      d  := (cd.den exquo (g := gcd(cd.den, derivation(cd.den))))::UP
+      r  := swap primitivePart swap resultant(UP23(cd.num)
+          - ((monomial(1, 1)$UP :: UP2) * UP22(g * derivation d))::UP3,
+                                              UP23 definingPolynomial())
+      remove0 resultant(r, UP22 d)
+
 *)
 
 \end{chunk}
@@ -19203,6 +25797,7 @@ DrawComplex(): Exports == Implementation where
       ++ setClipValue(x)
       ++ sets to x the maximum value to plot when drawing complex functions. Returns x.
   Implementation == add
+
     -- relative size of the arrow head compared to the length of the arrow
     arrowScale : SF := (0.125)::SF
     arrowAngle: SF := pi()-pi()/(20::SF)    -- angle of the arrow head
@@ -19319,6 +25914,118 @@ DrawComplex(): Exports == Implementation where
 \begin{chunk}{COQ DRAWCX}
 (* package DRAWCX *)
 (*
+
+    -- relative size of the arrow head compared to the length of the arrow
+    arrowScale : SF := (0.125)::SF
+    arrowAngle: SF := pi()-pi()/(20::SF)    -- angle of the arrow head
+    realSteps: INT  := 11     -- the number of steps in the real direction
+    imagSteps: INT  := 11     -- the number of steps in the imaginary direction
+    clipValue: SF  := 10::SF -- the maximum length of a vector to draw
+ 
+ 
+    -- Add an arrow head to a line segment, which starts at 'p1', ends at 'p2',
+    -- has length 'len', and and angle 'arg'.  We pass 'len' and 'arg' as
+    -- arguments since thet were already computed by the calling program
+    makeArrow(p1:Point SF, p2:Point SF, len: SF, arg:SF):List List Point SF ==
+      c1 := cos(arg + arrowAngle) 
+      s1 := sin(arg + arrowAngle)
+      c2 := cos(arg - arrowAngle) 
+      s2 := sin(arg - arrowAngle)
+      p3 := point [p2.1 + c1*arrowScale*len, p2.2 + s1*arrowScale*len, 
+                   p2.3, p2.4]
+      p4 := point [p2.1 + c2*arrowScale*len, p2.2 + s2*arrowScale*len, 
+                   p2.3, p2.4]
+      [[p1, p2, p3], [p2, p4]]
+     
+    -- clip a value in the interval (-clip...clip)
+    clipFun(x:SF):SF == 
+      min(max(x, -clipValue), clipValue)
+ 
+    drawComplex(f, realRange, imagRange, arrows?) ==
+      delReal := (hi(realRange) - lo(realRange))/realSteps::SF
+      delImag := (hi(imagRange) - lo(imagRange))/imagSteps::SF
+      funTable: ARRAY2(PC) := 
+         new((realSteps::NNI)+1, (imagSteps::NNI)+1, [0,0]$PC)
+      real := lo(realRange)
+      for i in 1..realSteps+1 repeat
+        imag := lo(imagRange)
+        for j in 1..imagSteps+1 repeat
+          z := f complex(real, imag)
+          funTable(i,j) := [clipFun(sqrt norm z), argument(z)]$PC
+          imag := imag + delImag
+        real := real + delReal
+      llp := empty()$(List List Point SF)
+      real := lo(realRange)
+      for i in 1..realSteps+1 repeat
+        imag := lo(imagRange)
+        lp := empty()$(List Point SF)
+        for j in 1..imagSteps+1 repeat
+          p := point [real, imag, funTable(i,j).rr, funTable(i,j).th]
+          lp := cons(p, lp)
+          imag := imag + delImag
+        real := real + delReal
+        llp := cons(lp, llp)
+      space := mesh(llp)$(ThreeSpace SF)
+      if arrows? then 
+        real := lo(realRange)
+        for i in 1..realSteps+1 repeat
+          imag := lo(imagRange)
+          for j in 1..imagSteps+1 repeat
+            arg := funTable(i,j).th
+            p1 := point [real,imag, funTable(i,j).rr, arg]
+            len := delReal*2.0::SF
+            p2 := point [p1.1 + len*cos(arg), p1.2 + len*sin(arg), 
+                         p1.3, p1.4]
+            arrow := makeArrow(p1, p2, len, arg)
+            for a in arrow repeat curve(space, a)$(ThreeSpace SF)
+            imag := imag + delImag
+          real := real + delReal
+      makeViewport3D(space, "Complex Function")$VIEW3D
+ 
+    drawComplexVectorField(f, realRange, imagRange): VIEW3D ==
+      -- compute the steps size of the grid
+      delReal := (hi(realRange) - lo(realRange))/realSteps::SF
+      delImag := (hi(imagRange) - lo(imagRange))/imagSteps::SF
+      -- create the space to hold the arrows
+      space := create3Space()$(ThreeSpace SF)
+      real := lo(realRange)
+      for i in 1..realSteps+1 repeat
+        imag := lo(imagRange)
+        for j in 1..imagSteps+1 repeat
+          -- compute the function
+          z := f complex(real, imag)
+          -- get the direction of the arrow
+          arg := argument z
+          -- get the length of the arrow
+          len := clipFun(sqrt norm z)
+          -- create point at the base of the arrow
+          p1 :=  point [real, imag, 0::SF, arg]
+          -- scale the arrow length so it isn't too long
+          scaleLen := delReal * len
+          -- create the point at the top of the arrow
+          p2 := point [p1.1 + scaleLen*cos(arg), p1.2 + scaleLen*sin(arg), 
+                       0::SF, arg]
+          -- make the pointer at the top of the arrow
+          arrow := makeArrow(p1, p2, scaleLen, arg)
+          -- add the line segments in the arrow to the space
+          for a in arrow repeat curve(space, a)$(ThreeSpace SF)
+          imag := imag + delImag
+        real := real + delReal
+      -- draw the vector feild
+      makeViewport3D(space, "Complex Vector Field")$VIEW3D
+ 
+    -- set the number of steps to use in the real direction
+    setRealSteps(n) ==
+      realSteps := n
+     
+    -- set the number of steps to use in the imaginary direction
+    setImagSteps(n) ==
+      imagSteps := n
+     
+    -- set the maximum value to plot 
+    setClipValue clip ==
+      clipValue := clip
+
 *)
 
 \end{chunk}
@@ -19400,6 +26107,7 @@ DrawNumericHack(R:Join(OrderedSet,IntegralDomain,ConvertibleTo Float)):
         ++ coerce(x = a..b) returns \spad{x = c..d} where c and d are the
         ++ numerical values of \spad{a} and b.
   == add
+
    coerce s ==
      map(numeric$Numeric(R),s)$SegmentBindingFunctions2(Expression R, Float)
 
@@ -19408,6 +26116,10 @@ DrawNumericHack(R:Join(OrderedSet,IntegralDomain,ConvertibleTo Float)):
 \begin{chunk}{COQ DRAWHACK}
 (* package DRAWHACK *)
 (*
+
+   coerce s ==
+     map(numeric$Numeric(R),s)$SegmentBindingFunctions2(Expression R, Float)
+
 *)
 
 \end{chunk}
@@ -19579,6 +26291,7 @@ DrawOptionFunctions0(): Exports == Implementation where
     ++ If the option does not exist the value, u is returned.
 
  Implementation ==> add
+
   adaptive(l,s) ==
     (u := option(l, "adaptive"::Symbol)$DrawOptionFunctions1(Boolean))
       case "failed" => s
@@ -19619,8 +26332,6 @@ DrawOptionFunctions0(): Exports == Implementation where
       case "failed" => s
     u::PAL
 
-
-
   ranges(l, s) ==
     (u := option(l, "ranges"::Symbol)$DrawOptionFunctions1(RANGE))
       case "failed" => s
@@ -19642,7 +26353,7 @@ DrawOptionFunctions0(): Exports == Implementation where
     u::PositiveInteger
 
   tubePoints(l,s) ==
-    (u := option(l, "tubePoints"::Symbol)$DrawOptionFunctions1(PositiveInteger))
+    (u:= option(l, "tubePoints"::Symbol)$DrawOptionFunctions1(PositiveInteger))
       case "failed" => s
     u::PositiveInteger
 
@@ -19666,6 +26377,87 @@ DrawOptionFunctions0(): Exports == Implementation where
 \begin{chunk}{COQ DROPT0}
 (* package DROPT0 *)
 (*
+
+  adaptive(l,s) ==
+    (u := option(l, "adaptive"::Symbol)$DrawOptionFunctions1(Boolean))
+      case "failed" => s
+    u::Boolean
+
+  clipBoolean(l,s) ==
+    (u := option(l, "clipBoolean"::Symbol)$DrawOptionFunctions1(Boolean))
+      case "failed" => s
+    u::Boolean
+
+  title(l, s) ==
+    (u := option(l, "title"::Symbol)$DrawOptionFunctions1(String))
+      case "failed" => s
+    u::String
+
+  viewpoint(l, vp) ==
+    (u := option(l, "viewpoint"::Symbol)$DrawOptionFunctions1(VIEWPT))
+      case "failed" => vp
+    u::VIEWPT
+
+  style(l, s) ==
+    (u := option(l, "style"::Symbol)$DrawOptionFunctions1(String))
+      case "failed" => s
+    u::String
+
+  toScale(l,s) ==
+    (u := option(l, "toScale"::Symbol)$DrawOptionFunctions1(Boolean))
+      case "failed" => s
+    u::Boolean
+
+  pointColorPalette(l,s) ==
+    (u := option(l, "pointColorPalette"::Symbol)$DrawOptionFunctions1(PAL))
+      case "failed" => s
+    u::PAL
+
+  curveColorPalette(l,s) ==
+    (u := option(l, "curveColorPalette"::Symbol)$DrawOptionFunctions1(PAL))
+      case "failed" => s
+    u::PAL
+
+  ranges(l, s) ==
+    (u := option(l, "ranges"::Symbol)$DrawOptionFunctions1(RANGE))
+      case "failed" => s
+    u::RANGE
+
+  space(l) ==
+    (u := option(l, "space"::Symbol)$DrawOptionFunctions1(SPACE3))
+      case "failed" => create3Space()$SPACE3
+    u::SPACE3
+
+  var1Steps(l,s) ==
+    (u := option(l, "var1Steps"::Symbol)$DrawOptionFunctions1(PositiveInteger))
+      case "failed" => s
+    u::PositiveInteger
+
+  var2Steps(l,s) ==
+    (u := option(l, "var2Steps"::Symbol)$DrawOptionFunctions1(PositiveInteger))
+      case "failed" => s
+    u::PositiveInteger
+
+  tubePoints(l,s) ==
+    (u:= option(l, "tubePoints"::Symbol)$DrawOptionFunctions1(PositiveInteger))
+      case "failed" => s
+    u::PositiveInteger
+
+  tubeRadius(l,s) ==
+    (u := option(l, "tubeRadius"::Symbol)$DrawOptionFunctions1(Float))
+      case "failed" => s
+    u::Float
+
+  coord(l,s) ==
+    (u := option(l, "coord"::Symbol)$DrawOptionFunctions1(POINT->POINT))
+      case "failed" => s
+    u::(POINT->POINT)
+
+  units(l,s) ==
+    (u := option(l, "unit"::Symbol)$DrawOptionFunctions1(UNIT))
+      case "failed" => s
+    u::UNIT
+
 *)
 
 \end{chunk}
@@ -19740,6 +26532,7 @@ DrawOptionFunctions1(S:Type): Exports == Implementation where
     ++ is contained in the list of drawing options, l, which is defined
     ++ by the draw command.
  Implementation ==> add
+
   option(l, s) ==
     (u := option(l, s)@Union(Any, "failed")) case "failed" => "failed"
     retract(u::Any)$AnyFunctions1(S)
@@ -19749,6 +26542,11 @@ DrawOptionFunctions1(S:Type): Exports == Implementation where
 \begin{chunk}{COQ DROPT1}
 (* package DROPT1 *)
 (*
+
+  option(l, s) ==
+    (u := option(l, s)@Union(Any, "failed")) case "failed" => "failed"
+    retract(u::Any)$AnyFunctions1(S)
+
 *)
 
 \end{chunk}
@@ -21058,7 +27856,6 @@ d01AgentsPackage(): E == I where
 
     commaSeparate(l:LST):ST ==
       empty?(l)$LST => ""
---      one?(#(l)) => concat(l)$ST
       (#(l) = 1) => concat(l)$ST
       f := first(l)$LST
       t := [concat([", ",l.i])$ST for i in 2..#(l)]
@@ -21148,7 +27945,6 @@ d01AgentsPackage(): E == I where
       e
 
     functionIsContinuousAtEndPointsFunction(args:NIA):CTYPE ==
-
       v := args.var :: EFI :: OCEFI
       high:OCEFI := ocdf2ocefi(hi(args.range))
       low:OCEFI := ocdf2ocefi(lo(args.range))
@@ -21178,7 +27974,6 @@ d01AgentsPackage(): E == I where
       e
 
     functionIsOscillatory(a:NIA):F ==
-
       args := copy a
       k := tower(numerator args.fn)$EDF
       p:F := pi()$F
@@ -21220,6 +28015,183 @@ d01AgentsPackage(): E == I where
 \begin{chunk}{COQ D01AGNT}
 (* package D01AGNT *)
 (*
+
+    import ExpertSystemToolsPackage
+    import ExpertSystemContinuityPackage
+
+    -- local functions
+    ocdf2ocefi : OCDF -> OCEFI
+    rangeOfArgument : (KEDF, NIA) -> DF
+    continuousAtPoint? : (EFI,EOCEFI) -> Boolean
+    rand:(SOCDF,INT) -> LDF 
+    eval:(EDF,Symbol,LDF) -> LDF
+    numberOfSignChanges:LDF -> INT
+    rangeIsFiniteFunction:NIA -> RTYPE
+    functionIsContinuousAtEndPointsFunction:NIA -> CTYPE
+ 
+    changeName(s:Symbol,t:Symbol,r:Result):Result ==
+      a := remove!(s,r)$Result
+      a case Any =>
+        insert!([t,a],r)$Result
+        r
+      r
+
+    commaSeparate(l:LST):ST ==
+      empty?(l)$LST => ""
+      (#(l) = 1) => concat(l)$ST
+      f := first(l)$LST
+      t := [concat([", ",l.i])$ST for i in 2..#(l)]
+      concat(f,concat(t)$ST)$ST
+
+    rand(seg:SOCDF,n:INT):LDF ==
+      -- produced a sorted list of random numbers in the given range
+      l:DF := getlo seg
+      s:DF := (gethi seg) - l
+      seed:INT := random()$INT
+      dseed:DF := seed :: DF
+      r:LDF := [(((random(seed)$INT) :: DF)*s/dseed + l) for i in 1..n]
+      sort(r)$LDF
+
+    eval(f:EDF,var:Symbol,l:LDF):LDF ==
+      empty?(l)$LDF => [0$DF]
+      ve := var::EDF
+      [retract(eval(f,equation(ve,u::EDF)$EEDF)$EDF)@DF for u in l]
+
+    numberOfSignChanges(l:LDF):INT ==
+      -- calculates the number of sign changes in a list
+      a := 0$INT
+      empty?(l)$LDF => 0
+      for i in 2..# l repeat
+        if negative?(l.i*l.(i-1))  then
+          a := a + 1
+      a
+
+    rangeOfArgument(k: KEDF, args:NIA): DF ==
+      Args := copy args
+      Args.fn := arg := first(argument(k)$KEDF)$LEDF
+      functionIsContinuousAtEndPoints(Args) case continuous =>
+        r:SOCDF := args.range
+        low:EDF := (getlo r) :: EDF
+        high:EDF := (gethi r) :: EDF
+        eql := equation(a := args.var :: EDF, low)$EEDF
+        eqh := equation(a, high)$EEDF
+        e1 := (numeric(eval(arg,eql)$EDF)$Numeric(DF)) :: DF
+        e2 := (numeric(eval(arg,eqh)$EDF)$Numeric(DF)) :: DF
+        e2-e1
+      0$DF
+
+    ocdf2ocefi(r:OCDF):OCEFI ==
+      finite?(r)$OCDF => (edf2efi(((retract(r)@DF)$OCDF)::EDF))::OCEFI
+      r pretend OCEFI
+
+    continuousAtPoint?(f:EFI,e:EOCEFI):Boolean ==
+      (l := limit(f,e)$PowerSeriesLimitPackage(FI,EFI)) case OCEFI =>
+                       finite?(l :: OCEFI)
+      -- if the left hand limit equals the right hand limit, or if neither
+      -- side has a limit at this point, the return type of  limit() is
+      -- Union(Ordered Completion Expression Fraction Integer,"failed")
+      false
+
+    -- exported functions
+    
+    rangeIsFiniteFunction(args:NIA): RTYPE ==
+      -- rangeIsFinite(x) tests the endpoints of x.range for infinite
+      -- end points. 
+      --             [-inf,  inf]  =>  4
+      --             [ x  ,  inf]  =>  3
+      --             [-inf,  x  ]  =>  1
+      --             [ x  ,  y  ]  =>  0
+      fr:SI := (3::SI * whatInfinity(hi(args.range))$OCDF 
+                      - whatInfinity(lo(args.range))$OCDF)
+      fr = 0 => ["The range is finite"]
+      fr = 1 => ["The bottom of range is infinite"]
+      fr = 3 => ["The top of range is infinite"]
+      fr = 4 => ["Both top and bottom points are infinite"]
+      error("rangeIsFinite",["this is not a valid range"])$ErrorFunctions
+
+    rangeIsFinite(args:NIA): RTYPE ==
+      nia := copy args
+      (t := showAttributes(nia)$IntegrationFunctionsTable) case ATT =>
+        s := coerce(t)@ATT
+        s.range case notEvaluated => 
+          s.range := rangeIsFiniteFunction(nia)
+          r:ROA := [nia,s]
+          insert!(r)$IntegrationFunctionsTable
+          s.range
+        s.range
+      a:ATT := [["End point continuity not yet evaluated"],
+                  ["Internal singularities not yet evaluated"],
+                      e:=rangeIsFiniteFunction(nia)]
+      r:ROA := [nia,a]
+      insert!(r)$IntegrationFunctionsTable
+      e
+
+    functionIsContinuousAtEndPointsFunction(args:NIA):CTYPE ==
+      v := args.var :: EFI :: OCEFI
+      high:OCEFI := ocdf2ocefi(hi(args.range))
+      low:OCEFI := ocdf2ocefi(lo(args.range))
+      f := edf2efi(args.fn)
+      l:Boolean := continuousAtPoint?(f,equation(v,low)$EOCEFI)
+      h:Boolean := continuousAtPoint?(f,equation(v,high)$EOCEFI)
+      l and h => ["Continuous at the end points"]
+      l => ["There is a singularity at the upper end point"]
+      h => ["There is a singularity at the lower end point"]
+      ["There are singularities at both end points"]
+
+    functionIsContinuousAtEndPoints(args:NIA): CTYPE ==
+      nia := copy args
+      (t := showAttributes(nia)$IntegrationFunctionsTable) case ATT =>
+        s := coerce(t)@ATT
+        s.endPointContinuity case notEvaluated => 
+          s.endPointContinuity := functionIsContinuousAtEndPointsFunction(nia)
+          r:ROA := [nia,s]
+          insert!(r)$IntegrationFunctionsTable
+          s.endPointContinuity
+        s.endPointContinuity
+      a:ATT := [e:=functionIsContinuousAtEndPointsFunction(nia),
+                 ["Internal singularities not yet evaluated"],
+                   ["Range not yet evaluated"]]
+      r:ROA := [nia,a]
+      insert!(r)$IntegrationFunctionsTable
+      e
+
+    functionIsOscillatory(a:NIA):F ==
+      args := copy a
+      k := tower(numerator args.fn)$EDF
+      p:F := pi()$F
+      for i in 1..# k repeat
+        is?(ker := k.i, sin :: Symbol) => 
+          ra := convert(rangeOfArgument(ker,args))@F
+          ra > 2*p => return (ra/p)
+        is?(ker, cos :: Symbol) => 
+          ra := convert(rangeOfArgument(ker,args))@F
+          ra > 2*p => return (ra/p)
+      l:LDF := rand(args.range,30)
+      l := eval(args.fn,args.var,l)
+      numberOfSignChanges(l) :: F   
+
+    singularitiesOf(args:NIA):SDF ==
+      nia := copy args
+      (t := showAttributes(nia)$IntegrationFunctionsTable) case ATT =>
+        s:ATT := coerce(t)@ATT
+        p:STYPE := s.singularitiesStream
+        p case str => p.str
+        e:SDF := singularitiesOf(nia.fn,[nia.var],nia.range)
+        if not empty?(e) then
+          if less?(e,10)$SDF then extend(e,10)$SDF
+        s.singularitiesStream := [e]
+        r:ROA := [nia,s]
+        insert!(r)$IntegrationFunctionsTable
+        e
+      e:=singularitiesOf(nia.fn,[nia.var],nia.range)
+      if not empty?(e) then
+        if less?(e,10)$SDF then extend(e,10)$SDF
+      a:ATT := [["End point continuity not yet evaluated"],[e],
+                          ["Range not yet evaluated"]]
+      r:ROA := [nia,a]
+      insert!(r)$IntegrationFunctionsTable
+      e
+
 *)
 
 \end{chunk}
@@ -21328,6 +28300,7 @@ d01WeightsPackage(): E == I where
  
     
   I ==> add
+
     score:(EDF,EDF) -> FI
     kernelIsLog:KEDF -> Boolean 
     functionIsPolynomial?:EDF -> Boolean
@@ -21396,7 +28369,6 @@ d01WeightsPackage(): E == I where
     functionIsQuotient(expr:EDF):Union(EDF,"failed") ==
       (k := mainKernel expr) case KEDF =>
         expr = inv(f := k :: KEDF :: EDF)$EDF => f
---        one?(numerator expr) => denominator expr
         (numerator expr = 1) => denominator expr
         "failed"
       "failed"
@@ -21406,7 +28378,6 @@ d01WeightsPackage(): E == I where
  
     functionIsNthRoot?(f:EDF,e:EDF):Boolean ==
       (m := mainKernel f) case "failed" => false
---      (one?(# (kernels f))) 
       ((# (kernels f)) = 1) 
         and (name operator m = (nthRoot :: Symbol))@Boolean
           and (((argument m).1 = e)@Boolean)
@@ -21472,7 +28443,6 @@ d01WeightsPackage(): E == I where
  
     exprOfFormCosWXorSinWX(f:EDF,var:Symbol): URBODF ==
       l:LKEDF := kernels(f)$EDF
---      one?((# l)$LKEDF)$INT => 
       # l = 1 => 
         a:LEDF := argument(e:KEDF := first(l)$LKEDF)$KEDF
         empty?(a) => "failed"
@@ -21542,6 +28512,213 @@ d01WeightsPackage(): E == I where
 \begin{chunk}{COQ D01WGTS}
 (* package D01WGTS *)
 (*
+
+    score:(EDF,EDF) -> FI
+    kernelIsLog:KEDF -> Boolean 
+    functionIsPolynomial?:EDF -> Boolean
+    functionIsNthRoot?:(EDF,EDF) -> Boolean 
+    functionIsQuotient:EDF -> Union(EDF,"failed")
+    findCommonFactor:LEDF -> Union(LEDF,"failed")
+    findAlgebraicWeight:(NIA,EDF) -> Union(DF,"failed")
+    exprHasListOfWeightsCosWXorSinWX:(EDF,Symbol) -> LURBODF
+    exprOfFormCosWXorSinWX:(EDF,Symbol) -> URBODF
+    bestWeight:LURBODF -> URBODF
+    weightIn?:(URBODF,LURBODF) -> Boolean
+    inRest?:(EDF,LEDF)->Boolean
+    factorIn?:(EDF,LEDF)->Boolean
+    voo?:(EDF,EDF)->Boolean
+   
+    kernelIsLog(k:KEDF):Boolean ==
+      (name k = (log :: Symbol))@Boolean
+ 
+    factorIn?(a:EDF,l:LEDF):Boolean ==
+      for i in 1..# l repeat
+        (a = l.i)@Boolean => return true
+      false
+ 
+    voo?(b:EDF,a:EDF):Boolean ==
+       (voo:=isTimes(b)) case LEDF and factorIn?(a,voo)
+ 
+    inRest?(a:EDF,l:LEDF):Boolean ==
+      every?(x+->voo?(x,a) ,l)
+ 
+    findCommonFactor(l:LEDF):Union(LEDF,"failed") ==
+      empty?(l)$LEDF => "failed"
+      f := first(l)$LEDF
+      r := rest(l)$LEDF
+      (t := isTimes(f)$EDF) case LEDF =>
+        pos:=select(x+->inRest?(x,r),t)
+        empty?(pos) => "failed"
+        pos
+      "failed"
+ 
+    exprIsLogarithmicWeight(f:EDF,Var:EDF,a:EDF,b:EDF):INT ==
+      ans := 0$INT
+      k := tower(f)$EDF
+      lf := select(kernelIsLog,k)$LKEDF
+      empty?(lf)$LKEDF => ans
+      for i in 1..# lf repeat
+        arg := argument lf.i
+        if (arg.1 = (Var - a)) then
+          ans := ans + 1
+        else if (arg.1 = (b - Var)) then
+          ans := ans + 2
+      ans      
+ 
+    exprHasLogarithmicWeights(args:NIA):INT ==
+      ans := 1$INT
+      a := getlo(args.range)$d01AgentsPackage :: EDF
+      b := gethi(args.range)$d01AgentsPackage :: EDF
+      Var := args.var :: EDF
+      (l := isPlus numerator args.fn) case LEDF =>
+        (cf := findCommonFactor l) case LEDF =>
+          for j in 1..# cf repeat
+            ans := ans + exprIsLogarithmicWeight(cf.j,Var,a,b)
+          ans
+        ans
+      ans := ans + exprIsLogarithmicWeight(args.fn,Var,a,b)
+ 
+    functionIsQuotient(expr:EDF):Union(EDF,"failed") ==
+      (k := mainKernel expr) case KEDF =>
+        expr = inv(f := k :: KEDF :: EDF)$EDF => f
+        (numerator expr = 1) => denominator expr
+        "failed"
+      "failed"
+ 
+    functionIsPolynomial?(f:EDF):Boolean ==
+      (retractIfCan(f)@Union(PDF,"failed"))$EDF case PDF
+ 
+    functionIsNthRoot?(f:EDF,e:EDF):Boolean ==
+      (m := mainKernel f) case "failed" => false
+      ((# (kernels f)) = 1) 
+        and (name operator m = (nthRoot :: Symbol))@Boolean
+          and (((argument m).1 = e)@Boolean)
+ 
+    score(f:EDF,e:EDF):FI ==
+      ans := 0$FI
+      (t := isTimes f) case LEDF =>
+        for i in 1..# t repeat
+          ans := ans + score(t.i,e)
+        ans
+      (q := functionIsQuotient f) case EDF =>
+        ans := ans - score(q,e)
+      functionIsPolynomial? f =>
+        g:EDF := f/e
+        if functionIsPolynomial? g then
+          ans := 1+score(g,e)
+        else
+          ans 
+      (l := isPlus f) case LEDF =>
+        (cf := findCommonFactor l) case LEDF =>
+          factor := 1$EDF
+          for i in 1..# cf repeat
+            factor := factor*cf.i
+          ans := ans + score(f/factor,e) + score(factor,e)
+        ans
+      functionIsNthRoot?(f,e) =>
+        (p := isPower f) case "failed" => ans
+        exp := p.exponent
+        m := mainKernel f
+        m case KEDF => 
+          arg := argument m
+          a:INT := (retract(arg.2)@INT)$EDF
+          exp / a
+        ans
+      ans
+ 
+    findAlgebraicWeight(args:NIA,e:EDF):Union(DF,"failed") == 
+      zero?(s := score(args.fn,e)) => "failed"
+      s :: DF
+ 
+    exprHasAlgebraicWeight(args:NIA):Union(LDF,"failed") ==
+      (f := functionIsContinuousAtEndPoints(args)$d01AgentsPackage) 
+                                          case continuous =>"failed"
+      Var := args.var :: EDF
+      a := getlo(args.range)$d01AgentsPackage :: EDF
+      b := gethi(args.range)$d01AgentsPackage :: EDF
+      A := Var - a
+      B := b - Var
+      f case lowerSingular => 
+        (h := findAlgebraicWeight(args,A)) case "failed" => "failed"
+        [h,0] 
+      f case upperSingular => 
+        (g := findAlgebraicWeight(args,B)) case "failed" => "failed"
+        [0,g] 
+      h := findAlgebraicWeight(args,A) 
+      g := findAlgebraicWeight(args,B)
+      r := (h case "failed")
+      s := (g case "failed")
+      (r) and (s) => "failed"
+      r => [0,coerce(g)@DF]
+      s => [coerce(h)@DF,0]  
+      [coerce(h)@DF,coerce(g)@DF]
+ 
+    exprOfFormCosWXorSinWX(f:EDF,var:Symbol): URBODF ==
+      l:LKEDF := kernels(f)$EDF
+      # l = 1 => 
+        a:LEDF := argument(e:KEDF := first(l)$LKEDF)$KEDF
+        empty?(a) => "failed"
+        m:Union(LEDF,"failed") := isTimes(first(a)$LEDF)$EDF 
+        m case LEDF => -- if it is a list, it will have at least two elements
+          is?(second(m)$LEDF,var)$EDF =>
+            omega:DF := retract(first(m)$LEDF)@DF
+            o:BOP := operator(n:Symbol:=name(e)$KEDF)$BOP
+            (n = cos@Symbol)@Boolean => [o,omega]
+            (n = sin@Symbol)@Boolean => [o,omega]
+            "failed"
+          "failed"
+        "failed"
+      "failed"
+ 
+    exprHasListOfWeightsCosWXorSinWX(f:EDF,var:Symbol): LURBODF ==
+      (e := isTimes(f)$EDF) case LEDF => 
+        [exprOfFormCosWXorSinWX(u,var) for u in e]
+      empty?(k := kernels f) => ["failed"]
+      ((first(k)::EDF) = f) => 
+        [exprOfFormCosWXorSinWX(f,var)]
+      ["failed"]
+ 
+    bestWeight(l:LURBODF): URBODF ==
+      empty?(l)$LURBODF => "failed"
+      best := first(l)$LURBODF        --  best is first in list
+      empty?(rest(l)$LURBODF) => best
+      for i in 2..# l repeat          --  unless next is better
+        r:URBODF := l.i
+        if r case "failed" then leave
+        else if best case "failed" then
+          best := r
+        else if r.w > best.w then
+          best := r
+      best
+ 
+    weightIn?(weight:URBODF,listOfWeights:LURBODF):Boolean ==
+      n := # listOfWeights
+      for i in 1..n repeat                               -- cycle through list
+        (weight = listOfWeights.i)@Boolean => return true -- return when found
+      false
+ 
+    exprHasWeightCosWXorSinWX(args:NIA):URBODF ==
+      ans := empty()$LURBODF
+      f:EDF := numerator(args.fn)$EDF
+      (t:Union(LEDF,"failed") := isPlus(f)) case "failed" => 
+        bestWeight(exprHasListOfWeightsCosWXorSinWX(f,args.var))
+      if t case LEDF then
+        e1 := first(t)$LEDF
+        le1:LURBODF := exprHasListOfWeightsCosWXorSinWX(e1,args.var)
+        le1 := [u for u in le1 | (not (u case "failed"))]
+        empty?(le1)$LURBODF => "failed"
+        test := true
+        for i in 1..# le1 repeat
+          le1i:URBODF := le1.i
+          for j in 2..# t repeat
+            if test then
+              tj:LURBODF := exprHasListOfWeightsCosWXorSinWX(t.j,args.var)
+              test := weightIn?(le1i,tj)
+          if test then
+            ans := concat([le1i],ans)
+        bestWeight ans
+      else "failed"
+
 *)
 
 \end{chunk}
@@ -22979,7 +30156,8 @@ d02AgentsPackage(): E == I where
       (1.0-exp((-n::F/75.0))$F)
 
     expenseOfEvaluation(o:ODEA):F ==
-      -- expense of evaluation of an ODE -- <0.3 inexpensive - 0.5 neutral - >0.7 very expensive
+      -- expense of evaluation of an ODE 
+      -- <0.3 inexpensive - 0.5 neutral - >0.7 very expensive
       -- 400 `operation units' -> 0.75 
       -- 200 `operation units' -> 0.5 
       -- 83 `operation units' -> 0.25
@@ -23003,15 +30181,16 @@ d02AgentsPackage(): E == I where
       e
 
     leastStabilityAngle(realPartsList:LDF,imagPartsList:LDF):F ==
-      complexList := [complex(u,v)$CDF for u in realPartsList for v in imagPartsList]
-      argumentList := [abs((abs(argument(u)$CDF)$DF)-(pi()$DF)/2)$DF for u in complexList]
+      complexList := _
+        [complex(u,v)$CDF for u in realPartsList for v in imagPartsList]
+      argumentList := _
+        [abs((abs(argument(u)$CDF)$DF)-(pi()$DF)/2)$DF for u in complexList]
       sortedArgumentList := sort(argumentList)$LDF
       list := [u for u in sortedArgumentList | not zero?(u) ]
       empty?(list)$LDF => 0$F
       convert(first(list)$LDF)@F
 
     stiffnessAndStabilityFactor(me:MEDF):RSS ==
-
       -- search first for real eigenvalues of the jacobian (symbolically)
       -- if the system isn't too big
       r:INT := ncols(me)$MEDF  
@@ -23027,23 +30206,23 @@ d02AgentsPackage(): E == I where
         ((n:=#e)>1)@Boolean => [coerce(e.1/e.n)@F,0$F] 
         -- otherwise stiffness not present
         [0$F,0$F]
-
       md:MDF := map(edf2df,me)$ExpertSystemToolsPackage2(EDF,DF)
-
       -- otherwise calculate numerically the complex eigenvalues
       -- using NAG routine f02aff.
-
       res:Result := f02aff(r,r,md,-1)$NagEigenPackage
       realParts:Union(Any,"failed") := search(rr::Symbol,res)$Result
       realParts case "failed" => [0$F,0$F]
-      realPartsMatrix:MDF := retract(realParts)$AnyFunctions1(MDF) -- array === matrix
+      -- array === matrix
+      realPartsMatrix:MDF := retract(realParts)$AnyFunctions1(MDF) 
       imagParts:Union(Any,"failed") := search(ri::Symbol,res)$Result
       imagParts case "failed" => [0$F,0$F]
-      imagPartsMatrix:MDF := retract(imagParts)$AnyFunctions1(MDF) -- array === matrix
+      -- array === matrix
+      imagPartsMatrix:MDF := retract(imagParts)$AnyFunctions1(MDF) 
       imagPartsList:LDF := members(imagPartsMatrix)$MDF
       realPartsList:LDF := members(realPartsMatrix)$MDF
       stabilityAngle := leastStabilityAngle(realPartsList,imagPartsList)
-      negRealPartsList := sort(neglist(realPartsList)$ExpertSystemToolsPackage1(DF))
+      negRealPartsList := _
+        sort(neglist(realPartsList)$ExpertSystemToolsPackage1(DF))
       empty?(negRealPartsList)$LDF => [0$F,stabilityAngle]
       ((n:=#negRealPartsList)>1)@Boolean => 
         out := convert(negRealPartsList.1/negRealPartsList.n)@F
@@ -23094,7 +30273,8 @@ d02AgentsPackage(): E == I where
       yv:VEDF := vector(yexpr)
       j1:MEDF := jacobian(odefns,ls)
       ej1:MEDF := eval(j1,ls,yv)
-      ej1 := eval(ej1,variables(reduce(sum,members(ej1)$MEDF)),vector([(ode.xinit)::EDF]))
+      ej1 := eval(ej1,variables(reduce(sum,members(ej1)$MEDF)),_
+                  vector([(ode.xinit)::EDF]))
       ssf := stiffnessAndStabilityFactor(ej1)
       stability := 1.0-sqrt((ssf.stabilityFactor)*(2.0)/(pi()$F))
       stiffness := (1.0)-exp(-(ssf.stiffnessFactor)/(500.0))
@@ -23102,7 +30282,7 @@ d02AgentsPackage(): E == I where
 
     stiffnessAndStabilityOfODEIF(ode:ODEA):RSS ==
       odefn := copy ode
-      (t := showIntensityFunctions(odefn)$ODEIntensityFunctionsTable) case ATT =>
+      (t:=showIntensityFunctions(odefn)$ODEIntensityFunctionsTable) case ATT =>
         s:ATT := coerce(t)@ATT
         negative?(s.stiffness)$F => 
           ssf:RSS := stiffnessAndStabilityOfODE(odefn)
@@ -23123,6 +30303,205 @@ d02AgentsPackage(): E == I where
 \begin{chunk}{COQ D02AGNT}
 (* package D02AGNT *)
 (*
+
+    import ExpertSystemToolsPackage
+
+    accuracyFactor:ODEA -> F
+    expenseOfEvaluation:ODEA -> F
+    eval1:(LEDF,LEEDF) -> LEDF
+    stiffnessAndStabilityOfODE:ODEA -> RSS
+    intermediateResultsFactor:ODEA -> F
+    leastStabilityAngle:(LDF,LDF) -> F
+
+    intermediateResultsFactor(ode:ODEA):F ==
+      resultsRequirement := #(ode.intvals)
+      (1.0-exp(-(resultsRequirement::F)/50.0)$F)
+
+    intermediateResultsIF(o:ODEA):F ==
+      ode := copy o
+      (t := showIntensityFunctions(ode)$ODEIntensityFunctionsTable) case ATT =>
+        s := coerce(t)@ATT
+        negative?(s.intermediateResults)$F => 
+          s.intermediateResults := intermediateResultsFactor(ode)
+          r:ROA := [ode,s]
+          insert!(r)$ODEIntensityFunctionsTable
+          s.intermediateResults
+        s.intermediateResults
+      a:ATT := [-1.0,-1.0,-1.0,-1.0,e:=intermediateResultsFactor(ode)]
+      r:ROA := [ode,a]
+      insert!(r)$ODEIntensityFunctionsTable
+      e
+
+    accuracyFactor(ode:ODEA):F ==
+      accuracyRequirements := convert(ode.abserr)@F
+      if zero?(accuracyRequirements) then
+        accuracyRequirements := convert(ode.relerr)@F
+      val := inv(accuracyRequirements)$F
+      n := log10(val)$F
+      (1.0-exp(-(n/(2.0))**2/(15.0))$F)
+
+    accuracyIF(o:ODEA):F ==
+      ode := copy o
+      (t := showIntensityFunctions(ode)$ODEIntensityFunctionsTable) case ATT =>
+        s := coerce(t)@ATT
+        negative?(s.accuracy)$F => 
+          s.accuracy := accuracyFactor(ode)
+          r:ROA := [ode,s]
+          insert!(r)$ODEIntensityFunctionsTable
+          s.accuracy
+        s.accuracy
+      a:ATT := [-1.0,-1.0,-1.0,e:=accuracyFactor(ode),-1.0]
+      r:ROA := [ode,a]
+      insert!(r)$ODEIntensityFunctionsTable
+      e
+
+    systemSizeIF(ode:ODEA):F ==
+      n := #(ode.fn)
+      (1.0-exp((-n::F/75.0))$F)
+
+    expenseOfEvaluation(o:ODEA):F ==
+      -- expense of evaluation of an ODE 
+      -- <0.3 inexpensive - 0.5 neutral - >0.7 very expensive
+      -- 400 `operation units' -> 0.75 
+      -- 200 `operation units' -> 0.5 
+      -- 83 `operation units' -> 0.25
+      -- ** = 4 units , function calls = 10 units.
+      ode := copy o.fn
+      expenseOfEvaluation(ode)
+
+    expenseOfEvaluationIF(o:ODEA):F ==
+      ode := copy o
+      (t := showIntensityFunctions(ode)$ODEIntensityFunctionsTable) case ATT =>
+        s := coerce(t)@ATT
+        negative?(s.expense)$F => 
+          s.expense := expenseOfEvaluation(ode)
+          r:ROA := [ode,s]
+          insert!(r)$ODEIntensityFunctionsTable
+          s.expense
+        s.expense
+      a:ATT := [-1.0,-1.0,e:=expenseOfEvaluation(ode),-1.0,-1.0]
+      r:ROA := [ode,a]
+      insert!(r)$ODEIntensityFunctionsTable
+      e
+
+    leastStabilityAngle(realPartsList:LDF,imagPartsList:LDF):F ==
+      complexList := _
+        [complex(u,v)$CDF for u in realPartsList for v in imagPartsList]
+      argumentList := _
+        [abs((abs(argument(u)$CDF)$DF)-(pi()$DF)/2)$DF for u in complexList]
+      sortedArgumentList := sort(argumentList)$LDF
+      list := [u for u in sortedArgumentList | not zero?(u) ]
+      empty?(list)$LDF => 0$F
+      convert(first(list)$LDF)@F
+
+    stiffnessAndStabilityFactor(me:MEDF):RSS ==
+      -- search first for real eigenvalues of the jacobian (symbolically)
+      -- if the system isn't too big
+      r:INT := ncols(me)$MEDF  
+      b:Boolean := ((# me) < 150)
+      if b then
+        mc:MFI := map(edf2fi,me)$ExpertSystemToolsPackage2(EDF,FI)
+        e:LFI := realEigenvalues(mc,1/100)$NumericRealEigenPackage(FI)
+        b := ((# e) >= r-1)@Boolean       
+      b =>
+        -- if all the eigenvalues are real, find negative ones
+        e := sort(neglist(e)$ExpertSystemToolsPackage1(FI))
+        -- if there are two or more, calculate stiffness ratio
+        ((n:=#e)>1)@Boolean => [coerce(e.1/e.n)@F,0$F] 
+        -- otherwise stiffness not present
+        [0$F,0$F]
+      md:MDF := map(edf2df,me)$ExpertSystemToolsPackage2(EDF,DF)
+      -- otherwise calculate numerically the complex eigenvalues
+      -- using NAG routine f02aff.
+      res:Result := f02aff(r,r,md,-1)$NagEigenPackage
+      realParts:Union(Any,"failed") := search(rr::Symbol,res)$Result
+      realParts case "failed" => [0$F,0$F]
+      -- array === matrix
+      realPartsMatrix:MDF := retract(realParts)$AnyFunctions1(MDF) 
+      imagParts:Union(Any,"failed") := search(ri::Symbol,res)$Result
+      imagParts case "failed" => [0$F,0$F]
+      -- array === matrix
+      imagPartsMatrix:MDF := retract(imagParts)$AnyFunctions1(MDF) 
+      imagPartsList:LDF := members(imagPartsMatrix)$MDF
+      realPartsList:LDF := members(realPartsMatrix)$MDF
+      stabilityAngle := leastStabilityAngle(realPartsList,imagPartsList)
+      negRealPartsList := _
+        sort(neglist(realPartsList)$ExpertSystemToolsPackage1(DF))
+      empty?(negRealPartsList)$LDF => [0$F,stabilityAngle]
+      ((n:=#negRealPartsList)>1)@Boolean => 
+        out := convert(negRealPartsList.1/negRealPartsList.n)@F
+        [out,stabilityAngle]    -- calculate stiffness ratio
+      [-convert(negRealPartsList.1)@F,stabilityAngle]
+      
+    eval1(l:LEDF,e:LEEDF):LEDF ==
+      [eval(u,e)$EDF for u in l]
+
+    eval(mat:MEDF,symbols:LS,values:VEDF):MEDF ==
+      l := listOfLists(mat)
+      ledf := entries(values)$VEDF
+      e := [equation(u::EDF,v)$EEDF for u in symbols for v in ledf]
+      l := [eval1(w,e) for w in l]
+      matrix l
+
+    combineFeatureCompatibility(C1:F,C2:F):F ==
+
+      --                        C1 C2
+      --    s(C1,C2) = -----------------------
+      --               C1 C2 + (1 - C1)(1 - C2)
+
+      C1*C2/((C1*C2)+(1$F-C1)*(1$F-C2))
+
+    combineFeatureCompatibility(C1:F,L:LF):F ==
+
+      empty?(L)$LF => C1
+      C2 := combineFeatureCompatibility(C1,first(L)$LF)
+      combineFeatureCompatibility(C2,rest(L)$LF)
+
+    jacobian(v:VEDF,w:LS):Matrix EDF ==
+      jacobian(v,w)$MultiVariableCalculusFunctions(S,EDF,VEDF,LS)
+
+    sparsityIF(m:Matrix EDF):F ==
+      l:LEDF :=parts m
+      z:LEDF := [u for u in l | zero?(u)$EDF]
+      ((#z)::F/(#l)::F)
+
+    sum(a:EDF,b:EDF):EDF == a+b
+
+    stiffnessAndStabilityOfODE(ode:ODEA):RSS ==
+      odefns := copy ode.fn
+      ls:LS := [subscript(Y,[coerce(n)])$Symbol for n in 1..# odefns]
+      yvals := copy ode.yinit
+      for i in 1..#yvals repeat
+        zero?(yvals.i) => yvals.i := 0.1::DF
+      yexpr := [coerce(v)@EDF for v in yvals]
+      yv:VEDF := vector(yexpr)
+      j1:MEDF := jacobian(odefns,ls)
+      ej1:MEDF := eval(j1,ls,yv)
+      ej1 := eval(ej1,variables(reduce(sum,members(ej1)$MEDF)),_
+                  vector([(ode.xinit)::EDF]))
+      ssf := stiffnessAndStabilityFactor(ej1)
+      stability := 1.0-sqrt((ssf.stabilityFactor)*(2.0)/(pi()$F))
+      stiffness := (1.0)-exp(-(ssf.stiffnessFactor)/(500.0))
+      [stiffness,stability]
+
+    stiffnessAndStabilityOfODEIF(ode:ODEA):RSS ==
+      odefn := copy ode
+      (t:=showIntensityFunctions(odefn)$ODEIntensityFunctionsTable) case ATT =>
+        s:ATT := coerce(t)@ATT
+        negative?(s.stiffness)$F => 
+          ssf:RSS := stiffnessAndStabilityOfODE(odefn)
+          s := [ssf.stiffnessFactor,ssf.stabilityFactor,s.expense,
+                  s.accuracy,s.intermediateResults]
+          r:ROA := [odefn,s]
+          insert!(r)$ODEIntensityFunctionsTable
+          ssf
+        [s.stiffness,s.stability]
+      ssf:RSS := stiffnessAndStabilityOfODE(odefn)
+      s:ATT := [ssf.stiffnessFactor,ssf.stabilityFactor,-1.0,-1.0,-1.0]
+      r:ROA := [odefn,s]
+      insert!(r)$ODEIntensityFunctionsTable
+      ssf
+
 *)
 
 \end{chunk}
@@ -24012,13 +31391,13 @@ d03AgentsPackage(): E == I where
       v := variables(e := 4*first(p)*third(p)-(second(p))**2)
       eq := subscriptedVariables(e)
       noa:NOA := 
---        one?(# v) =>
         (# v) = 1 =>
           ((first v) = X@Symbol) => 
             [eq,[xstart],[xs::OCDF],empty()$LEDF,[xf::OCDF]]
           [eq,[ystart],[ys::OCDF],empty()$LEDF,[yf::OCDF]]
         [eq,optStart,lower,empty()$LEDF,upper]
-      ell := optimize(noa::NumericalOptimizationProblem)$AnnaNumericalOptimizationPackage
+      ell := optimize(noa::NumericalOptimizationProblem)_
+        $AnnaNumericalOptimizationPackage
       o:Union(Any,"failed") := search(objf::Symbol,ell)$Result
       o case "failed" => false
       ob := o :: Any
@@ -24030,6 +31409,57 @@ d03AgentsPackage(): E == I where
 \begin{chunk}{COQ D03AGNT}
 (* package D03AGNT *)
 (*
+
+    import ExpertSystemToolsPackage
+
+    sum(a:EDF,b:EDF):EDF == a+b
+
+    varList(s:Symbol,n:NonNegativeInteger):LS ==
+      [subscript(s,[t::OutputForm]) for t in expand([1..n])$Segment(Integer)]
+
+    subscriptedVariables(e:EDF):EDF ==
+      oldVars:List Symbol := variables(e)
+      o := [a :: EDF for a in oldVars]
+      newVars := varList(X::Symbol,# oldVars)
+      n := [b :: EDF for b in newVars]
+      subst(e,[a=b for a in o for b in n])
+
+    central?(x:DF,y:DF,p:LEDF):Boolean ==
+      ls := variables(reduce(sum,p))
+      le := [equation(u::EDF,v)$EEDF for u in ls for v in [x::EDF,y::EDF]]
+      l := [eval(u,le)$EDF for u in p]
+      max(l.4,l.5) < 20 * max(l.1,max(l.2,l.3))
+
+    elliptic?(args:PDEB):Boolean ==
+      (args.st)="elliptic" => true
+      p := args.pde
+      xcon:PDEC := first(args.constraints)
+      ycon:PDEC := second(args.constraints)
+      xs := xcon.start
+      ys := ycon.start
+      xf := xcon.finish
+      yf := ycon.finish
+      xstart:DF := ((xf-xs)/2)$DF
+      ystart:DF := ((yf-ys)/2)$DF
+      optStart:LDF := [xstart,ystart]
+      lower:LOCDF := [xs::OCDF,ys::OCDF]
+      upper:LOCDF := [xf::OCDF,yf::OCDF]
+      v := variables(e := 4*first(p)*third(p)-(second(p))**2)
+      eq := subscriptedVariables(e)
+      noa:NOA := 
+        (# v) = 1 =>
+          ((first v) = X@Symbol) => 
+            [eq,[xstart],[xs::OCDF],empty()$LEDF,[xf::OCDF]]
+          [eq,[ystart],[ys::OCDF],empty()$LEDF,[yf::OCDF]]
+        [eq,optStart,lower,empty()$LEDF,upper]
+      ell := optimize(noa::NumericalOptimizationProblem)_
+        $AnnaNumericalOptimizationPackage
+      o:Union(Any,"failed") := search(objf::Symbol,ell)$Result
+      o case "failed" => false
+      ob := o :: Any
+      obj:DF := retract(ob)$AnyFunctions1(DF)
+      positive?(obj)
+
 *)
 
 \end{chunk}
@@ -24187,12 +31617,11 @@ EigenPackage(R) : C == T
        ++ such a polynomial.
 
    T == add
-     PI       ==> PositiveInteger
 
+     PI       ==> PositiveInteger
 
      MF  := GeneralizedMultivariateFactorize(SE,IndexedExponents SE,R,R,P)
      UPCF2:= UnivariatePolynomialCategoryFunctions2(P,SUP,F,SUF)
-    
 
                  ----  Local  Functions  ----
      tff              :  (SUF,SE)      ->  F
@@ -24348,6 +31777,161 @@ EigenPackage(R) : C == T
 \begin{chunk}{COQ EP}
 (* package EP *)
 (*
+
+     PI       ==> PositiveInteger
+
+     MF  := GeneralizedMultivariateFactorize(SE,IndexedExponents SE,R,R,P)
+     UPCF2:= UnivariatePolynomialCategoryFunctions2(P,SUP,F,SUF)
+
+                 ----  Local  Functions  ----
+     tff              :  (SUF,SE)      ->  F
+     fft              :  (SUF,SE)      ->  F
+     charpol          :   (M,SE)       ->   F
+     intRatEig        :  (F,M,NNI)    ->   List M
+     intAlgEig        :  (ST,M,NNI)    ->   List M 
+     genEigForm       : (EigenForm,M)  ->   GenEigen
+
+    ---- next functions needed for defining  ModularField ----
+     reduction(u:SUF,p:SUF):SUF == u rem p
+
+     merge(p:SUF,q:SUF):Union(SUF,"failed") ==
+         p = q => p
+         p = 0 => q
+         q = 0 => p
+         "failed"
+
+     exactquo(u:SUF,v:SUF,p:SUF):Union(SUF,"failed") ==
+        val:=extendedEuclidean(v,p,u)
+        val case "failed" => "failed"
+        val.coef1
+
+               ----  functions for conversions  ----
+     fft(t:SUF,x:SE):F ==
+       n:=degree(t)
+       cf:=monomial(1,x,n)$P :: F
+       cf * leadingCoefficient t
+
+     tff(p:SUF,x:SE) : F ==
+       degree p=0 => leadingCoefficient p
+       r:F:=0$F
+       while p^=0 repeat
+         r:=r+fft(p,x)
+         p := reductum p
+       r
+
+      ---- generalized eigenvectors associated to a given eigenvalue ---       
+     genEigForm(eigen : EigenForm,A:M) : GenEigen ==
+       alpha:=eigen.eigval
+       k:=eigen.eigmult
+       g:=#(eigen.eigvec)
+       k = g  => [alpha,eigen.eigvec]
+       [alpha,generalizedEigenvector(alpha,A,k,g)]
+
+           ---- characteristic polynomial  ----
+     charpol(A:M,x:SE) : F ==
+       dimA :PI := (nrows A):PI
+       dimA ^= ncols A => error " The matrix is not square"
+       B:M:=zero(dimA,dimA)
+       for i in 1..dimA repeat
+         for j in 1..dimA repeat  B(i,j):=A(i,j)
+         B(i,i) := B(i,i) - monomial(1$P,x,1)::F
+       determinant B
+
+          --------  EXPORTED  FUNCTIONS  --------
+   
+            ----  characteristic polynomial of a matrix A ----
+     characteristicPolynomial(A:M):P ==
+       x:SE:=new()$SE
+       numer charpol(A,x)
+
+            ----  characteristic polynomial of a matrix A ----
+     characteristicPolynomial(A:M,x:SE) : P == numer charpol(A,x)
+     
+                ----  Eigenvalues of the matrix A  ----
+     eigenvalues(A:M): List Eigenvalue  ==
+       x:=new()$SE
+       pol:= charpol(A,x)
+       lrat:List F :=empty()
+       lsym:List ST :=empty()
+       for eq in solve(pol,x)$SystemSolvePackage(R) repeat
+         alg:=numer lhs eq
+         degree(alg, x)=1 => lrat:=cons(rhs eq,lrat)
+         lsym:=cons([x,alg],lsym)
+       append([lr::Eigenvalue for lr in lrat],
+              [ls::Eigenvalue for ls in lsym])
+
+          ----  Eigenvectors belonging to a given eigenvalue  ----
+                ----  the eigenvalue must be exact  ----
+     eigenvector(alpha:Eigenvalue,A:M) : List M  ==
+       alpha case F => intRatEig(alpha::F,A,1$NNI)
+       intAlgEig(alpha::ST,A,1$NNI)
+
+   ----  Eigenvectors belonging to a given rational eigenvalue  ----
+                ---- Internal function -----
+     intRatEig(alpha:F,A:M,m:NNI) : List M  ==
+       n:=nrows A
+       B:M := zero(n,n)$M
+       for i in 1..n repeat
+         for j in 1..n repeat B(i,j):=A(i,j)
+         B(i,i):= B(i,i) - alpha
+       [v::M for v in nullSpace(B**m)]
+   
+   ----  Eigenvectors belonging to a given algebraic eigenvalue  ----
+         ------   Internal  Function  -----
+     intAlgEig(alpha:ST,A:M,m:NNI) : List M  ==
+       n:=nrows A
+       MM := ModularField(SUF,SUF,reduction,merge,exactquo)
+       AM:=Matrix MM
+       x:SE:=lhs alpha
+       pol:SUF:=unitCanonical map(coerce,univariate(rhs alpha,x))$UPCF2
+       alg:MM:=reduce(monomial(1,1),pol)
+       B:AM := zero(n,n)
+       for i in 1..n repeat
+         for j in 1..n repeat B(i,j):=reduce(A(i,j)::SUF,pol)
+         B(i,i):= B(i,i) - alg
+       sol: List M :=empty()
+       for vec in nullSpace(B**m) repeat
+         w:M:=zero(n,1)
+         for i in 1..n repeat w(i,1):=tff((vec.i)::SUF,x)
+         sol:=cons(w,sol)
+       sol
+
+     ----  Generalized Eigenvectors belonging to a given eigenvalue  ----
+     generalizedEigenvector(alpha:Eigenvalue,A:M,k:NNI,g:NNI) : List M  ==
+       alpha case F => intRatEig(alpha::F,A,(1+k-g)::NNI)
+       intAlgEig(alpha::ST,A,(1+k-g)::NNI)
+
+     ----  Generalized Eigenvectors belonging to a given eigenvalue  ----
+     generalizedEigenvector(eigen :EigenForm,A:M) : List M  ==
+       generalizedEigenvector(eigen.eigval,A,eigen.eigmult,# eigen.eigvec)
+
+          ----  Generalized Eigenvectors -----
+     generalizedEigenvectors(A:M) : List GenEigen  ==
+       n:= nrows A
+       leig:=eigenvectors A
+       [genEigForm(leg,A) for leg in leig]
+         
+                 ----  eigenvectors and eigenvalues  ----
+     eigenvectors(A:M):List(EigenForm) ==
+       n:=nrows A
+       x:=new()$SE
+       p:=numer charpol(A,x)
+       MM := ModularField(SUF,SUF,reduction,merge,exactquo)
+       AM:=Matrix(MM)
+       ratSol : List EigenForm := empty()
+       algSol : List EigenForm := empty()
+       lff:=factors factor  p
+       for fact in lff repeat
+         pol:=fact.factor   
+         degree(pol,x)=1 =>
+           vec:F :=-coefficient(pol,x,0)/coefficient(pol,x,degree(pol,x))
+           ratSol:=cons([vec,fact.exponent :: NNI,
+                         intRatEig(vec,A,1$NNI)]$EigenForm,ratSol)
+         alpha:ST:=[x,pol]     
+         algSol:=cons([alpha,fact.exponent :: NNI,
+                       intAlgEig(alpha,A,1$NNI)]$EigenForm,algSol)
+       append(ratSol,algSol)
+
 *)
 
 \end{chunk}
@@ -25154,6 +32738,7 @@ ElementaryFunction(R, F): Exports == Implementation where
       ++ localReal?(x) should be local but conditional
 
   Implementation ==> add
+
     ipi      : List F -> F
     iexp     : F -> F
     ilog     : F -> F
@@ -25223,65 +32808,115 @@ ElementaryFunction(R, F): Exports == Implementation where
     -- case user changes the precision
 
     if R has TranscendentalFunctionCategory then
+
       Pie := pi()$R :: F
+
     else
+
       Pie := kernel(oppi, nil()$List(F))
 
     if R has TranscendentalFunctionCategory and R has arbitraryPrecision then
+
       pi() == pi()$R :: F
+
     else
+
       pi() == Pie
 
     if R has imaginary: () -> R then
+
       isqrt1 := imaginary()$R :: F
-    else isqrt1 := sqrt(-1::F)
+
+    else 
+
+      isqrt1 := sqrt(-1::F)
 
     if R has RadicalCategory then
+
       isqrt2 := sqrt(2::R)::F
+
       isqrt3 := sqrt(3::R)::F
+
     else
+
       isqrt2 := sqrt(2::F)
+
       isqrt3 := sqrt(3::F)
 
     iisqrt1() == isqrt1
+
     if R has RadicalCategory and R has arbitraryPrecision then
+
       iisqrt2() == sqrt(2::R)::F
+
       iisqrt3() == sqrt(3::R)::F
+
     else
+
       iisqrt2() == isqrt2
+
       iisqrt3() == isqrt3
 
     ipi l == pi()
+
     log x == oplog x
+
     exp x == opexp x
+
     sin x == opsin x
+
     cos x == opcos x
+
     tan x == optan x
+
     cot x == opcot x
+
     sec x == opsec x
+
     csc x == opcsc x
+
     asin x == opasin x
+
     acos x == opacos x
+
     atan x == opatan x
+
     acot x == opacot x
+
     asec x == opasec x
+
     acsc x == opacsc x
+
     sinh x == opsinh x
+
     cosh x == opcosh x
+
     tanh x == optanh x
+
     coth x == opcoth x
+
     sech x == opsech x
+
     csch x == opcsch x
+
     asinh x == opasinh x
+
     acosh x == opacosh x
+
     atanh x == opatanh x
+
     acoth x == opacoth x
+
     asech x == opasech x
+
     acsch x == opacsch x
+
     kernel x == retract(x)@K
 
     posrem(n, m)    == ((r := n rem m) < 0 => r + m; r)
+
     valueOrPole rec == (rec.pole => INV; rec.func)
+
     belong? op      == has?(op, "elem")
 
     operator op ==
@@ -25320,6 +32955,7 @@ ElementaryFunction(R, F): Exports == Implementation where
       first argument(k::K)
 
     if R has RetractableTo Z then
+
       specialTrigs(x, values) ==
         (r := retractIfCan(y := x/pi())@Union(Fraction Z, "failed"))
           case "failed" => "failed"
@@ -25329,30 +32965,28 @@ ElementaryFunction(R, F): Exports == Implementation where
           even?(n::Z) => valueOrPole(values.m)
           valueOrPole(values.(m+1))
         (n := retractIfCan(2*q)@Union(Z, "failed")) case Z =>
---          one?(s := posrem(n::Z, 4)) => valueOrPole(values.(m+2))
           (s := posrem(n::Z, 4)) = 1 => valueOrPole(values.(m+2))
           valueOrPole(values.(m+3))
         (n := retractIfCan(3*q)@Union(Z, "failed")) case Z =>
---          one?(s := posrem(n::Z, 6)) => valueOrPole(values.(m+4))
           (s := posrem(n::Z, 6)) = 1 => valueOrPole(values.(m+4))
           s = 2 => valueOrPole(values.(m+5))
           s = 4 => valueOrPole(values.(m+6))
           valueOrPole(values.(m+7))
         (n := retractIfCan(4*q)@Union(Z, "failed")) case Z =>
---          one?(s := posrem(n::Z, 8)) => valueOrPole(values.(m+8))
           (s := posrem(n::Z, 8)) = 1 => valueOrPole(values.(m+8))
           s = 3 => valueOrPole(values.(m+9))
           s = 5 => valueOrPole(values.(m+10))
           valueOrPole(values.(m+11))
         (n := retractIfCan(6*q)@Union(Z, "failed")) case Z =>
---          one?(s := posrem(n::Z, 12)) => valueOrPole(values.(m+12))
           (s := posrem(n::Z, 12)) = 1 => valueOrPole(values.(m+12))
           s = 5 => valueOrPole(values.(m+13))
           s = 7 => valueOrPole(values.(m+14))
           valueOrPole(values.(m+15))
         "failed"
 
-    else specialTrigs(x, values) == "failed"
+    else 
+
+      specialTrigs(x, values) == "failed"
 
     isin x ==
       zero? x => 0
@@ -25405,7 +33039,7 @@ ElementaryFunction(R, F): Exports == Implementation where
       u := specialTrigs(x, [[0,false], [0,false], [0,true], [0,true],
                       [s3,false], [-s3,false], [s3,false], [-s3,false],
                        [1,false], [-1,false], [1,false], [-1,false],
-                        [s33,false], [-s33, false], [s33,false], [-s33, false]])
+                        [s33,false], [-s33, false],[s33,false], [-s33, false]])
       u case F => u :: F
       kernel(optan, x)
 
@@ -25466,7 +33100,6 @@ ElementaryFunction(R, F): Exports == Implementation where
 
     iasin x ==
       zero? x => 0
---      one? x =>   pi() / (2::F)
       (x = 1) =>   pi() / (2::F)
       x = -1 => - pi() / (2::F)
       y := dropfun x
@@ -25476,7 +33109,6 @@ ElementaryFunction(R, F): Exports == Implementation where
 
     iacos x ==
       zero? x => pi() / (2::F)
---      one? x => 0
       (x = 1) => 0
       x = -1 => pi()
       y := dropfun x
@@ -25486,11 +33118,9 @@ ElementaryFunction(R, F): Exports == Implementation where
 
     iatan x ==
       zero? x => 0
---      one? x =>   pi() / (4::F)
       (x = 1) =>   pi() / (4::F)
       x = -1 => - pi() / (4::F)
       x = (r3:=iisqrt3()) => pi() / (3::F)
---      one?(x*r3)          => pi() / (6::F)
       (x*r3) = 1          => pi() / (6::F)
       y := dropfun x
       is?(x, optan) => y
@@ -25499,12 +33129,10 @@ ElementaryFunction(R, F): Exports == Implementation where
 
     iacot x ==
       zero? x =>   pi() / (2::F)
---      one? x  =>   pi() / (4::F)
       (x = 1)  =>   pi() / (4::F)
       x = -1  =>   3 * pi() / (4::F)
       x = (r3:=iisqrt3())  =>  pi() / (6::F)
       x = -r3              =>  5 * pi() / (6::F)
---      one?(xx:=x*r3)       =>  pi() / (3::F)
       (xx:=x*r3) = 1      =>  pi() / (3::F)
       xx = -1           =>     2* pi() / (3::F)
       y := dropfun x
@@ -25514,7 +33142,6 @@ ElementaryFunction(R, F): Exports == Implementation where
 
     iasec x ==
       zero? x => INV
---      one? x => 0
       (x = 1) => 0
       x = -1 => pi()
       y := dropfun x
@@ -25524,7 +33151,6 @@ ElementaryFunction(R, F): Exports == Implementation where
 
     iacsc x ==
       zero? x => INV
---      one? x =>   pi() / (2::F)
       (x = 1) =>   pi() / (2::F)
       x = -1 => - pi() / (2::F)
       y := dropfun x
@@ -25634,7 +33260,7 @@ ElementaryFunction(R, F): Exports == Implementation where
             [h + i * s3,false], [-h + i * s3, false], [-h - i * s3, false],
              [h - i * s3, false], [s2 + i * s2, false], [-s2 + i * s2, false],
               [-s2 - i * s2, false], [s2 - i * s2, false], [s3 + i * h, false],
-               [-s3 + i * h, false], [-s3 - i * h, false], [s3 - i * h, false]])
+               [-s3 + i * h, false], [-s3 - i * h, false],[s3 - i * h, false]])
       u case F => u :: F
       kernel(opexp, x)
 
@@ -25645,15 +33271,17 @@ ElementaryFunction(R, F): Exports == Implementation where
 --     OTHERWISE (e.g. R = INT OR FRAC INT), ALL THE ELEMENTS ARE DEEMED REAL
 
     if (R has imaginary:() -> R) and (R has conjugate: R -> R) then
-         localReal? x ==
+
+      localReal? x ==
             (u := retractIfCan(x)@Union(R, "failed")) case R
                and (u::R) = conjugate(u::R)
 
-    else localReal? x == true
+    else 
+
+      localReal? x == true
 
     iiilog x ==
       zero? x => INV
---      one? x => 0
       (x = 1) => 0
       (u := isExpt(x, opexp)) case Record(var:K, exponent:Integer) =>
            rec := u::Record(var:K, exponent:Integer)
@@ -25663,12 +33291,12 @@ ElementaryFunction(R, F): Exports == Implementation where
       ilog x
 
     ilog x ==
---      ((num1 := one?(num := numer x)) or num = -1) and (den := denom x) ^= 1
       ((num1 := ((num := numer x) = 1)) or num = -1) and (den := denom x) ^= 1
         and empty? variables x => - kernel(oplog, (num1 => den; -den)::F)
       kernel(oplog, x)
 
     if R has ElementaryFunctionCategory then
+
       iilog x ==
         (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iiilog x
         log(r::R)::F
@@ -25678,7 +33306,9 @@ ElementaryFunction(R, F): Exports == Implementation where
         exp(r::R)::F
 
     else
+
       iilog x == iiilog x
+
       iiexp x == iexp x
 
     if R has TrigonometricFunctionCategory then
@@ -25707,11 +33337,17 @@ ElementaryFunction(R, F): Exports == Implementation where
         csc(r::R)::F
 
     else
+
       iisin x == isin x
+
       iicos x == icos x
+
       iitan x == itan x
+
       iicot x == icot x
+
       iisec x == isec x
+
       iicsc x == icsc x
 
     if R has ArcTrigonometricFunctionCategory then
@@ -25740,14 +33376,21 @@ ElementaryFunction(R, F): Exports == Implementation where
         acsc(r::R)::F
 
     else
+
       iiasin x == iasin x
+
       iiacos x == iacos x
+
       iiatan x == iatan x
+
       iiacot x == iacot x
+
       iiasec x == iasec x
+
       iiacsc x == iacsc x
 
     if R has HyperbolicFunctionCategory then
+
       iisinh x ==
         (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => isinh x
         sinh(r::R)::F
@@ -25773,14 +33416,21 @@ ElementaryFunction(R, F): Exports == Implementation where
         csch(r::R)::F
 
     else
+
       iisinh x == isinh x
+
       iicosh x == icosh x
+
       iitanh x == itanh x
+
       iicoth x == icoth x
+
       iisech x == isech x
+
       iicsch x == icsch x
 
     if R has ArcHyperbolicFunctionCategory then
+
       iiasinh x ==
         (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iasinh x
         asinh(r::R)::F
@@ -25806,67 +33456,125 @@ ElementaryFunction(R, F): Exports == Implementation where
         acsch(r::R)::F
 
     else
+
       iiasinh x == iasinh x
+
       iiacosh x == iacosh x
+
       iiatanh x == iatanh x
+
       iiacoth x == iacoth x
+
       iiasech x == iasech x
+
       iiacsch x == iacsch x
 
     import BasicOperatorFunctions1(F)
 
     evaluate(oppi, ipi)
+
     evaluate(oplog, iilog)
+
     evaluate(opexp, iiexp)
+
     evaluate(opsin, iisin)
+
     evaluate(opcos, iicos)
+
     evaluate(optan, iitan)
+
     evaluate(opcot, iicot)
+
     evaluate(opsec, iisec)
+
     evaluate(opcsc, iicsc)
+
     evaluate(opasin, iiasin)
+
     evaluate(opacos, iiacos)
+
     evaluate(opatan, iiatan)
+
     evaluate(opacot, iiacot)
+
     evaluate(opasec, iiasec)
+
     evaluate(opacsc, iiacsc)
+
     evaluate(opsinh, iisinh)
+
     evaluate(opcosh, iicosh)
+
     evaluate(optanh, iitanh)
+
     evaluate(opcoth, iicoth)
+
     evaluate(opsech, iisech)
+
     evaluate(opcsch, iicsch)
+
     evaluate(opasinh, iiasinh)
+
     evaluate(opacosh, iiacosh)
+
     evaluate(opatanh, iiatanh)
+
     evaluate(opacoth, iiacoth)
+
     evaluate(opasech, iiasech)
+
     evaluate(opacsch, iiacsch)
+
     derivative(opexp, exp)
+
     derivative(oplog, inv)
+
     derivative(opsin, cos)
+
     derivative(opcos,(x:F):F +-> - sin x)
+
     derivative(optan,(x:F):F +-> 1 + tan(x)**2)
+
     derivative(opcot,(x:F):F +-> - 1 - cot(x)**2)
+
     derivative(opsec,(x:F):F +-> tan(x) * sec(x))
+
     derivative(opcsc,(x:F):F +-> - cot(x) * csc(x))
+
     derivative(opasin,(x:F):F +-> inv sqrt(1 - x**2))
+
     derivative(opacos,(x:F):F +-> - inv sqrt(1 - x**2))
+
     derivative(opatan,(x:F):F +-> inv(1 + x**2))
+
     derivative(opacot,(x:F):F +-> - inv(1 + x**2))
+
     derivative(opasec,(x:F):F +-> inv(x * sqrt(x**2 - 1)))
+
     derivative(opacsc,(x:F):F +-> - inv(x * sqrt(x**2 - 1)))
+
     derivative(opsinh, cosh)
+
     derivative(opcosh, sinh)
+
     derivative(optanh,(x:F):F +-> 1 - tanh(x)**2)
+
     derivative(opcoth,(x:F):F +-> 1 - coth(x)**2)
+
     derivative(opsech,(x:F):F +-> - tanh(x) * sech(x))
+
     derivative(opcsch,(x:F):F +-> - coth(x) * csch(x))
+
     derivative(opasinh,(x:F):F +-> inv sqrt(1 + x**2))
+
     derivative(opacosh,(x:F):F +-> inv sqrt(x**2 - 1))
+
     derivative(opatanh,(x:F):F +-> inv(1 - x**2))
+
     derivative(opacoth,(x:F):F +-> inv(1 - x**2))
+
     derivative(opasech,(x:F):F +-> - inv(x * sqrt(1 - x**2)))
+
     derivative(opacsch,(x:F):F +-> - inv(x * sqrt(1 + x**2)))
 
 \end{chunk}
@@ -25874,6 +33582,845 @@ ElementaryFunction(R, F): Exports == Implementation where
 \begin{chunk}{COQ EF}
 (* package EF *)
 (*
+
+    ipi      : List F -> F
+    iexp     : F -> F
+    ilog     : F -> F
+    iiilog   : F -> F
+    isin     : F -> F
+    icos     : F -> F
+    itan     : F -> F
+    icot     : F -> F
+    isec     : F -> F
+    icsc     : F -> F
+    iasin    : F -> F
+    iacos    : F -> F
+    iatan    : F -> F
+    iacot    : F -> F
+    iasec    : F -> F
+    iacsc    : F -> F
+    isinh    : F -> F
+    icosh    : F -> F
+    itanh    : F -> F
+    icoth    : F -> F
+    isech    : F -> F
+    icsch    : F -> F
+    iasinh   : F -> F
+    iacosh   : F -> F
+    iatanh   : F -> F
+    iacoth   : F -> F
+    iasech   : F -> F
+    iacsch   : F -> F
+    dropfun  : F -> F
+    kernel   : F -> K
+    posrem   :(Z, Z) -> Z
+    iisqrt1  : () -> F
+    valueOrPole : Record(func:F, pole:B) -> F
+
+    oppi  := operator("pi"::Symbol)$CommonOperators
+    oplog := operator("log"::Symbol)$CommonOperators
+    opexp := operator("exp"::Symbol)$CommonOperators
+    opsin := operator("sin"::Symbol)$CommonOperators
+    opcos := operator("cos"::Symbol)$CommonOperators
+    optan := operator("tan"::Symbol)$CommonOperators
+    opcot := operator("cot"::Symbol)$CommonOperators
+    opsec := operator("sec"::Symbol)$CommonOperators
+    opcsc := operator("csc"::Symbol)$CommonOperators
+    opasin := operator("asin"::Symbol)$CommonOperators
+    opacos := operator("acos"::Symbol)$CommonOperators
+    opatan := operator("atan"::Symbol)$CommonOperators
+    opacot := operator("acot"::Symbol)$CommonOperators
+    opasec := operator("asec"::Symbol)$CommonOperators
+    opacsc := operator("acsc"::Symbol)$CommonOperators
+    opsinh := operator("sinh"::Symbol)$CommonOperators
+    opcosh := operator("cosh"::Symbol)$CommonOperators
+    optanh := operator("tanh"::Symbol)$CommonOperators
+    opcoth := operator("coth"::Symbol)$CommonOperators
+    opsech := operator("sech"::Symbol)$CommonOperators
+    opcsch := operator("csch"::Symbol)$CommonOperators
+    opasinh := operator("asinh"::Symbol)$CommonOperators
+    opacosh := operator("acosh"::Symbol)$CommonOperators
+    opatanh := operator("atanh"::Symbol)$CommonOperators
+    opacoth := operator("acoth"::Symbol)$CommonOperators
+    opasech := operator("asech"::Symbol)$CommonOperators
+    opacsch := operator("acsch"::Symbol)$CommonOperators
+
+    -- Pi is a domain...
+    Pie, isqrt1, isqrt2, isqrt3: F
+
+    -- following code is conditionalized on arbitraryPrecesion to recompute in
+    -- case user changes the precision
+
+    if R has TranscendentalFunctionCategory then
+
+      Pie := pi()$R :: F
+
+    else
+
+      Pie := kernel(oppi, nil()$List(F))
+
+    if R has TranscendentalFunctionCategory and R has arbitraryPrecision then
+
+      pi() == pi()$R :: F
+
+    else
+
+      pi() == Pie
+
+    if R has imaginary: () -> R then
+
+      isqrt1 := imaginary()$R :: F
+
+    else 
+
+      isqrt1 := sqrt(-1::F)
+
+    if R has RadicalCategory then
+
+      isqrt2 := sqrt(2::R)::F
+
+      isqrt3 := sqrt(3::R)::F
+
+    else
+
+      isqrt2 := sqrt(2::F)
+
+      isqrt3 := sqrt(3::F)
+
+    iisqrt1() == isqrt1
+
+    if R has RadicalCategory and R has arbitraryPrecision then
+
+      iisqrt2() == sqrt(2::R)::F
+
+      iisqrt3() == sqrt(3::R)::F
+
+    else
+
+      iisqrt2() == isqrt2
+
+      iisqrt3() == isqrt3
+
+    ipi l == pi()
+
+    log x == oplog x
+
+    exp x == opexp x
+
+    sin x == opsin x
+
+    cos x == opcos x
+
+    tan x == optan x
+
+    cot x == opcot x
+
+    sec x == opsec x
+
+    csc x == opcsc x
+
+    asin x == opasin x
+
+    acos x == opacos x
+
+    atan x == opatan x
+
+    acot x == opacot x
+
+    asec x == opasec x
+
+    acsc x == opacsc x
+
+    sinh x == opsinh x
+
+    cosh x == opcosh x
+
+    tanh x == optanh x
+
+    coth x == opcoth x
+
+    sech x == opsech x
+
+    csch x == opcsch x
+
+    asinh x == opasinh x
+
+    acosh x == opacosh x
+
+    atanh x == opatanh x
+
+    acoth x == opacoth x
+
+    asech x == opasech x
+
+    acsch x == opacsch x
+
+    kernel x == retract(x)@K
+
+    posrem(n, m)    == ((r := n rem m) < 0 => r + m; r)
+
+    valueOrPole rec == (rec.pole => INV; rec.func)
+
+    belong? op      == has?(op, "elem")
+
+    operator op ==
+      is?(op, "pi"::Symbol)    => oppi
+      is?(op, "log"::Symbol)   => oplog
+      is?(op, "exp"::Symbol)   => opexp
+      is?(op, "sin"::Symbol)   => opsin
+      is?(op, "cos"::Symbol)   => opcos
+      is?(op, "tan"::Symbol)   => optan
+      is?(op, "cot"::Symbol)   => opcot
+      is?(op, "sec"::Symbol)   => opsec
+      is?(op, "csc"::Symbol)   => opcsc
+      is?(op, "asin"::Symbol)  => opasin
+      is?(op, "acos"::Symbol)  => opacos
+      is?(op, "atan"::Symbol)  => opatan
+      is?(op, "acot"::Symbol)  => opacot
+      is?(op, "asec"::Symbol)  => opasec
+      is?(op, "acsc"::Symbol)  => opacsc
+      is?(op, "sinh"::Symbol)  => opsinh
+      is?(op, "cosh"::Symbol)  => opcosh
+      is?(op, "tanh"::Symbol)  => optanh
+      is?(op, "coth"::Symbol)  => opcoth
+      is?(op, "sech"::Symbol)  => opsech
+      is?(op, "csch"::Symbol)  => opcsch
+      is?(op, "asinh"::Symbol) => opasinh
+      is?(op, "acosh"::Symbol) => opacosh
+      is?(op, "atanh"::Symbol) => opatanh
+      is?(op, "acoth"::Symbol) => opacoth
+      is?(op, "asech"::Symbol) => opasech
+      is?(op, "acsch"::Symbol) => opacsch
+      error "Not an elementary operator"
+
+    dropfun x ==
+      ((k := retractIfCan(x)@Union(K, "failed")) case "failed") or
+        empty?(argument(k::K)) => 0
+      first argument(k::K)
+
+    if R has RetractableTo Z then
+
+      specialTrigs(x, values) ==
+        (r := retractIfCan(y := x/pi())@Union(Fraction Z, "failed"))
+          case "failed" => "failed"
+        q := r::Fraction(Integer)
+        m := minIndex values
+        (n := retractIfCan(q)@Union(Z, "failed")) case Z =>
+          even?(n::Z) => valueOrPole(values.m)
+          valueOrPole(values.(m+1))
+        (n := retractIfCan(2*q)@Union(Z, "failed")) case Z =>
+          (s := posrem(n::Z, 4)) = 1 => valueOrPole(values.(m+2))
+          valueOrPole(values.(m+3))
+        (n := retractIfCan(3*q)@Union(Z, "failed")) case Z =>
+          (s := posrem(n::Z, 6)) = 1 => valueOrPole(values.(m+4))
+          s = 2 => valueOrPole(values.(m+5))
+          s = 4 => valueOrPole(values.(m+6))
+          valueOrPole(values.(m+7))
+        (n := retractIfCan(4*q)@Union(Z, "failed")) case Z =>
+          (s := posrem(n::Z, 8)) = 1 => valueOrPole(values.(m+8))
+          s = 3 => valueOrPole(values.(m+9))
+          s = 5 => valueOrPole(values.(m+10))
+          valueOrPole(values.(m+11))
+        (n := retractIfCan(6*q)@Union(Z, "failed")) case Z =>
+          (s := posrem(n::Z, 12)) = 1 => valueOrPole(values.(m+12))
+          s = 5 => valueOrPole(values.(m+13))
+          s = 7 => valueOrPole(values.(m+14))
+          valueOrPole(values.(m+15))
+        "failed"
+
+    else 
+
+      specialTrigs(x, values) == "failed"
+
+    isin x ==
+      zero? x => 0
+      y := dropfun x
+      is?(x, opasin) => y
+      is?(x, opacos) => sqrt(1 - y**2)
+      is?(x, opatan) => y / sqrt(1 + y**2)
+      is?(x, opacot) => inv sqrt(1 + y**2)
+      is?(x, opasec) => sqrt(y**2 - 1) / y
+      is?(x, opacsc) => inv y
+      h  := inv(2::F)
+      s2 := h * iisqrt2()
+      s3 := h * iisqrt3()
+      u  := specialTrigs(x, [[0,false], [0,false], [1,false], [-1,false],
+                         [s3,false], [s3,false], [-s3,false], [-s3,false],
+                          [s2,false], [s2,false], [-s2,false], [-s2,false],
+                           [h,false], [h,false], [-h,false], [-h,false]])
+      u case F => u :: F
+      kernel(opsin, x)
+
+    icos x ==
+      zero? x => 1
+      y := dropfun x
+      is?(x, opasin) => sqrt(1 - y**2)
+      is?(x, opacos) => y
+      is?(x, opatan) => inv sqrt(1 + y**2)
+      is?(x, opacot) => y / sqrt(1 + y**2)
+      is?(x, opasec) => inv y
+      is?(x, opacsc) => sqrt(y**2 - 1) / y
+      h  := inv(2::F)
+      s2 := h * iisqrt2()
+      s3 := h * iisqrt3()
+      u  := specialTrigs(x, [[1,false],[-1,false], [0,false], [0,false],
+                             [h,false],[-h,false],[-h,false],[h,false],
+                              [s2,false],[-s2,false],[-s2,false],[s2,false],
+                               [s3,false], [-s3,false],[-s3,false],[s3,false]])
+      u case F => u :: F
+      kernel(opcos, x)
+
+    itan x ==
+      zero? x => 0
+      y := dropfun x
+      is?(x, opasin) => y / sqrt(1 - y**2)
+      is?(x, opacos) => sqrt(1 - y**2) / y
+      is?(x, opatan) => y
+      is?(x, opacot) => inv y
+      is?(x, opasec) => sqrt(y**2 - 1)
+      is?(x, opacsc) => inv sqrt(y**2 - 1)
+      s33 := (s3 := iisqrt3()) / (3::F)
+      u := specialTrigs(x, [[0,false], [0,false], [0,true], [0,true],
+                      [s3,false], [-s3,false], [s3,false], [-s3,false],
+                       [1,false], [-1,false], [1,false], [-1,false],
+                        [s33,false], [-s33, false],[s33,false], [-s33, false]])
+      u case F => u :: F
+      kernel(optan, x)
+
+    icot x ==
+      zero? x => INV
+      y := dropfun x
+      is?(x, opasin) => sqrt(1 - y**2) / y
+      is?(x, opacos) => y / sqrt(1 - y**2)
+      is?(x, opatan) => inv y
+      is?(x, opacot) => y
+      is?(x, opasec) => inv sqrt(y**2 - 1)
+      is?(x, opacsc) => sqrt(y**2 - 1)
+      s33 := (s3 := iisqrt3()) / (3::F)
+      u := specialTrigs(x, [[0,true], [0,true], [0,false], [0,false],
+                         [s33,false], [-s33,false], [s33,false], [-s33,false],
+                          [1,false], [-1,false], [1,false], [-1,false],
+                           [s3,false], [-s3, false], [s3,false], [-s3, false]])
+      u case F => u :: F
+      kernel(opcot, x)
+
+    isec x ==
+      zero? x => 1
+      y := dropfun x
+      is?(x, opasin) => inv sqrt(1 - y**2)
+      is?(x, opacos) => inv y
+      is?(x, opatan) => sqrt(1 + y**2)
+      is?(x, opacot) => sqrt(1 + y**2) / y
+      is?(x, opasec) => y
+      is?(x, opacsc) => y / sqrt(y**2 - 1)
+      s2 := iisqrt2()
+      s3 := 2 * iisqrt3() / (3::F)
+      h  := 2::F
+      u  := specialTrigs(x, [[1,false],[-1,false],[0,true],[0,true],
+                           [h,false], [-h,false], [-h,false], [h,false],
+                            [s2,false], [-s2,false], [-s2,false], [s2,false],
+                             [s3,false], [-s3,false], [-s3,false], [s3,false]])
+      u case F => u :: F
+      kernel(opsec, x)
+
+    icsc x ==
+      zero? x => INV
+      y := dropfun x
+      is?(x, opasin) => inv y
+      is?(x, opacos) => inv sqrt(1 - y**2)
+      is?(x, opatan) => sqrt(1 + y**2) / y
+      is?(x, opacot) => sqrt(1 + y**2)
+      is?(x, opasec) => y / sqrt(y**2 - 1)
+      is?(x, opacsc) => y
+      s2 := iisqrt2()
+      s3 := 2 * iisqrt3() / (3::F)
+      h  := 2::F
+      u  := specialTrigs(x, [[0,true], [0,true], [1,false], [-1,false],
+                            [s3,false], [s3,false], [-s3,false], [-s3,false],
+                              [s2,false], [s2,false], [-s2,false], [-s2,false],
+                                 [h,false], [h,false], [-h,false], [-h,false]])
+      u case F => u :: F
+      kernel(opcsc, x)
+
+    iasin x ==
+      zero? x => 0
+      (x = 1) =>   pi() / (2::F)
+      x = -1 => - pi() / (2::F)
+      y := dropfun x
+      is?(x, opsin) => y
+      is?(x, opcos) => pi() / (2::F) - y
+      kernel(opasin, x)
+
+    iacos x ==
+      zero? x => pi() / (2::F)
+      (x = 1) => 0
+      x = -1 => pi()
+      y := dropfun x
+      is?(x, opsin) => pi() / (2::F) - y
+      is?(x, opcos) => y
+      kernel(opacos, x)
+
+    iatan x ==
+      zero? x => 0
+      (x = 1) =>   pi() / (4::F)
+      x = -1 => - pi() / (4::F)
+      x = (r3:=iisqrt3()) => pi() / (3::F)
+      (x*r3) = 1          => pi() / (6::F)
+      y := dropfun x
+      is?(x, optan) => y
+      is?(x, opcot) => pi() / (2::F) - y
+      kernel(opatan, x)
+
+    iacot x ==
+      zero? x =>   pi() / (2::F)
+      (x = 1)  =>   pi() / (4::F)
+      x = -1  =>   3 * pi() / (4::F)
+      x = (r3:=iisqrt3())  =>  pi() / (6::F)
+      x = -r3              =>  5 * pi() / (6::F)
+      (xx:=x*r3) = 1      =>  pi() / (3::F)
+      xx = -1           =>     2* pi() / (3::F)
+      y := dropfun x
+      is?(x, optan) => pi() / (2::F) - y
+      is?(x, opcot) => y
+      kernel(opacot, x)
+
+    iasec x ==
+      zero? x => INV
+      (x = 1) => 0
+      x = -1 => pi()
+      y := dropfun x
+      is?(x, opsec) => y
+      is?(x, opcsc) => pi() / (2::F) - y
+      kernel(opasec, x)
+
+    iacsc x ==
+      zero? x => INV
+      (x = 1) =>   pi() / (2::F)
+      x = -1 => - pi() / (2::F)
+      y := dropfun x
+      is?(x, opsec) => pi() / (2::F) - y
+      is?(x, opcsc) => y
+      kernel(opacsc, x)
+
+    isinh x ==
+      zero? x => 0
+      y := dropfun x
+      is?(x, opasinh) => y
+      is?(x, opacosh) => sqrt(y**2 - 1)
+      is?(x, opatanh) => y / sqrt(1 - y**2)
+      is?(x, opacoth) => - inv sqrt(y**2 - 1)
+      is?(x, opasech) => sqrt(1 - y**2) / y
+      is?(x, opacsch) => inv y
+      kernel(opsinh, x)
+
+    icosh x ==
+      zero? x => 1
+      y := dropfun x
+      is?(x, opasinh) => sqrt(y**2 + 1)
+      is?(x, opacosh) => y
+      is?(x, opatanh) => inv sqrt(1 - y**2)
+      is?(x, opacoth) => y / sqrt(y**2 - 1)
+      is?(x, opasech) => inv y
+      is?(x, opacsch) => sqrt(y**2 + 1) / y
+      kernel(opcosh, x)
+
+    itanh x ==
+      zero? x => 0
+      y := dropfun x
+      is?(x, opasinh) => y / sqrt(y**2 + 1)
+      is?(x, opacosh) => sqrt(y**2 - 1) / y
+      is?(x, opatanh) => y
+      is?(x, opacoth) => inv y
+      is?(x, opasech) => sqrt(1 - y**2)
+      is?(x, opacsch) => inv sqrt(y**2 + 1)
+      kernel(optanh, x)
+
+    icoth x ==
+      zero? x => INV
+      y := dropfun x
+      is?(x, opasinh) => sqrt(y**2 + 1) / y
+      is?(x, opacosh) => y / sqrt(y**2 - 1)
+      is?(x, opatanh) => inv y
+      is?(x, opacoth) => y
+      is?(x, opasech) => inv sqrt(1 - y**2)
+      is?(x, opacsch) => sqrt(y**2 + 1)
+      kernel(opcoth, x)
+
+    isech x ==
+      zero? x => 1
+      y := dropfun x
+      is?(x, opasinh) => inv sqrt(y**2 + 1)
+      is?(x, opacosh) => inv y
+      is?(x, opatanh) => sqrt(1 - y**2)
+      is?(x, opacoth) => sqrt(y**2 - 1) / y
+      is?(x, opasech) => y
+      is?(x, opacsch) => y / sqrt(y**2 + 1)
+      kernel(opsech, x)
+
+    icsch x ==
+      zero? x => INV
+      y := dropfun x
+      is?(x, opasinh) => inv y
+      is?(x, opacosh) => inv sqrt(y**2 - 1)
+      is?(x, opatanh) => sqrt(1 - y**2) / y
+      is?(x, opacoth) => - sqrt(y**2 - 1)
+      is?(x, opasech) => y / sqrt(1 - y**2)
+      is?(x, opacsch) => y
+      kernel(opcsch, x)
+
+    iasinh x ==
+      is?(x, opsinh) => first argument kernel x
+      kernel(opasinh, x)
+
+    iacosh x ==
+      is?(x, opcosh) => first argument kernel x
+      kernel(opacosh, x)
+
+    iatanh x ==
+      is?(x, optanh) => first argument kernel x
+      kernel(opatanh, x)
+
+    iacoth x ==
+      is?(x, opcoth) => first argument kernel x
+      kernel(opacoth, x)
+
+    iasech x ==
+      is?(x, opsech) => first argument kernel x
+      kernel(opasech, x)
+
+    iacsch x ==
+      is?(x, opcsch) => first argument kernel x
+      kernel(opacsch, x)
+
+    iexp x ==
+      zero? x => 1
+      is?(x, oplog) => first argument kernel x
+      x < 0 and empty? variables x => inv iexp(-x)
+      h  := inv(2::F)
+      i  := iisqrt1()
+      s2 := h * iisqrt2()
+      s3 := h * iisqrt3()
+      u  := specialTrigs(x / i, [[1,false],[-1,false], [i,false], [-i,false],
+            [h + i * s3,false], [-h + i * s3, false], [-h - i * s3, false],
+             [h - i * s3, false], [s2 + i * s2, false], [-s2 + i * s2, false],
+              [-s2 - i * s2, false], [s2 - i * s2, false], [s3 + i * h, false],
+               [-s3 + i * h, false], [-s3 - i * h, false],[s3 - i * h, false]])
+      u case F => u :: F
+      kernel(opexp, x)
+
+-- THIS DETERMINES WHEN TO PERFORM THE log exp f -> f SIMPLIFICATION
+-- CURRENT BEHAVIOR:
+--     IF R IS COMPLEX(S) THEN ONLY ELEMENTS WHICH ARE RETRACTABLE TO R
+--     AND EQUAL TO THEIR CONJUGATES ARE DEEMED REAL (OVERRESTRICTIVE FOR NOW)
+--     OTHERWISE (e.g. R = INT OR FRAC INT), ALL THE ELEMENTS ARE DEEMED REAL
+
+    if (R has imaginary:() -> R) and (R has conjugate: R -> R) then
+
+      localReal? x ==
+            (u := retractIfCan(x)@Union(R, "failed")) case R
+               and (u::R) = conjugate(u::R)
+
+    else 
+
+      localReal? x == true
+
+    iiilog x ==
+      zero? x => INV
+      (x = 1) => 0
+      (u := isExpt(x, opexp)) case Record(var:K, exponent:Integer) =>
+           rec := u::Record(var:K, exponent:Integer)
+           arg := first argument(rec.var);
+           localReal? arg => rec.exponent * first argument(rec.var);
+           ilog x
+      ilog x
+
+    ilog x ==
+      ((num1 := ((num := numer x) = 1)) or num = -1) and (den := denom x) ^= 1
+        and empty? variables x => - kernel(oplog, (num1 => den; -den)::F)
+      kernel(oplog, x)
+
+    if R has ElementaryFunctionCategory then
+
+      iilog x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iiilog x
+        log(r::R)::F
+
+      iiexp x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iexp x
+        exp(r::R)::F
+
+    else
+
+      iilog x == iiilog x
+
+      iiexp x == iexp x
+
+    if R has TrigonometricFunctionCategory then
+      iisin x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => isin x
+        sin(r::R)::F
+
+      iicos x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => icos x
+        cos(r::R)::F
+
+      iitan x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => itan x
+        tan(r::R)::F
+
+      iicot x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => icot x
+        cot(r::R)::F
+
+      iisec x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => isec x
+        sec(r::R)::F
+
+      iicsc x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => icsc x
+        csc(r::R)::F
+
+    else
+
+      iisin x == isin x
+
+      iicos x == icos x
+
+      iitan x == itan x
+
+      iicot x == icot x
+
+      iisec x == isec x
+
+      iicsc x == icsc x
+
+    if R has ArcTrigonometricFunctionCategory then
+      iiasin x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iasin x
+        asin(r::R)::F
+
+      iiacos x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iacos x
+        acos(r::R)::F
+
+      iiatan x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iatan x
+        atan(r::R)::F
+
+      iiacot x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iacot x
+        acot(r::R)::F
+
+      iiasec x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iasec x
+        asec(r::R)::F
+
+      iiacsc x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iacsc x
+        acsc(r::R)::F
+
+    else
+
+      iiasin x == iasin x
+
+      iiacos x == iacos x
+
+      iiatan x == iatan x
+
+      iiacot x == iacot x
+
+      iiasec x == iasec x
+
+      iiacsc x == iacsc x
+
+    if R has HyperbolicFunctionCategory then
+
+      iisinh x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => isinh x
+        sinh(r::R)::F
+
+      iicosh x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => icosh x
+        cosh(r::R)::F
+
+      iitanh x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => itanh x
+        tanh(r::R)::F
+
+      iicoth x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => icoth x
+        coth(r::R)::F
+
+      iisech x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => isech x
+        sech(r::R)::F
+
+      iicsch x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => icsch x
+        csch(r::R)::F
+
+    else
+
+      iisinh x == isinh x
+
+      iicosh x == icosh x
+
+      iitanh x == itanh x
+
+      iicoth x == icoth x
+
+      iisech x == isech x
+
+      iicsch x == icsch x
+
+    if R has ArcHyperbolicFunctionCategory then
+
+      iiasinh x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iasinh x
+        asinh(r::R)::F
+
+      iiacosh x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iacosh x
+        acosh(r::R)::F
+
+      iiatanh x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iatanh x
+        atanh(r::R)::F
+
+      iiacoth x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iacoth x
+        acoth(r::R)::F
+
+      iiasech x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iasech x
+        asech(r::R)::F
+
+      iiacsch x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iacsch x
+        acsch(r::R)::F
+
+    else
+
+      iiasinh x == iasinh x
+
+      iiacosh x == iacosh x
+
+      iiatanh x == iatanh x
+
+      iiacoth x == iacoth x
+
+      iiasech x == iasech x
+
+      iiacsch x == iacsch x
+
+    import BasicOperatorFunctions1(F)
+
+    evaluate(oppi, ipi)
+
+    evaluate(oplog, iilog)
+
+    evaluate(opexp, iiexp)
+
+    evaluate(opsin, iisin)
+
+    evaluate(opcos, iicos)
+
+    evaluate(optan, iitan)
+
+    evaluate(opcot, iicot)
+
+    evaluate(opsec, iisec)
+
+    evaluate(opcsc, iicsc)
+
+    evaluate(opasin, iiasin)
+
+    evaluate(opacos, iiacos)
+
+    evaluate(opatan, iiatan)
+
+    evaluate(opacot, iiacot)
+
+    evaluate(opasec, iiasec)
+
+    evaluate(opacsc, iiacsc)
+
+    evaluate(opsinh, iisinh)
+
+    evaluate(opcosh, iicosh)
+
+    evaluate(optanh, iitanh)
+
+    evaluate(opcoth, iicoth)
+
+    evaluate(opsech, iisech)
+
+    evaluate(opcsch, iicsch)
+
+    evaluate(opasinh, iiasinh)
+
+    evaluate(opacosh, iiacosh)
+
+    evaluate(opatanh, iiatanh)
+
+    evaluate(opacoth, iiacoth)
+
+    evaluate(opasech, iiasech)
+
+    evaluate(opacsch, iiacsch)
+
+    derivative(opexp, exp)
+
+    derivative(oplog, inv)
+
+    derivative(opsin, cos)
+
+    derivative(opcos,(x:F):F +-> - sin x)
+
+    derivative(optan,(x:F):F +-> 1 + tan(x)**2)
+
+    derivative(opcot,(x:F):F +-> - 1 - cot(x)**2)
+
+    derivative(opsec,(x:F):F +-> tan(x) * sec(x))
+
+    derivative(opcsc,(x:F):F +-> - cot(x) * csc(x))
+
+    derivative(opasin,(x:F):F +-> inv sqrt(1 - x**2))
+
+    derivative(opacos,(x:F):F +-> - inv sqrt(1 - x**2))
+
+    derivative(opatan,(x:F):F +-> inv(1 + x**2))
+
+    derivative(opacot,(x:F):F +-> - inv(1 + x**2))
+
+    derivative(opasec,(x:F):F +-> inv(x * sqrt(x**2 - 1)))
+
+    derivative(opacsc,(x:F):F +-> - inv(x * sqrt(x**2 - 1)))
+
+    derivative(opsinh, cosh)
+
+    derivative(opcosh, sinh)
+
+    derivative(optanh,(x:F):F +-> 1 - tanh(x)**2)
+
+    derivative(opcoth,(x:F):F +-> 1 - coth(x)**2)
+
+    derivative(opsech,(x:F):F +-> - tanh(x) * sech(x))
+
+    derivative(opcsch,(x:F):F +-> - coth(x) * csch(x))
+
+    derivative(opasinh,(x:F):F +-> inv sqrt(1 + x**2))
+
+    derivative(opacosh,(x:F):F +-> inv sqrt(x**2 - 1))
+
+    derivative(opatanh,(x:F):F +-> inv(1 - x**2))
+
+    derivative(opacoth,(x:F):F +-> inv(1 - x**2))
+
+    derivative(opasech,(x:F):F +-> - inv(x * sqrt(1 - x**2)))
+
+    derivative(opacsch,(x:F):F +-> - inv(x * sqrt(1 + x**2)))
+
 *)
 
 \end{chunk}
@@ -25976,6 +34523,7 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where
       ++ innerint(f, x, a, b, ignore?) should be local but conditional
 
   Implementation ==> add
+
     import ElementaryFunctionSign(R, F)
     import DefiniteIntegrationTools(R, F)
     import FunctionSpaceIntegration(R, F)
@@ -25992,6 +34540,7 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where
 
     if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer)
       and F has SpecialFunctionCategory then
+
         import PatternMatchIntegration(R, F)
 
         innerint(f, x, a, b, ignor?) ==
@@ -26000,6 +34549,7 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where
           [v::F::OFE]
 
     else
+
       innerint(f, x, a, b, ignor?) == int(f, x, a, b, ignor?)
 
     integrate(f:F, s:SegmentBinding OFE) ==
@@ -26022,7 +34572,7 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where
       ((u := checkSMP(d, x, k, a, b)) case "failed") or (u::B) => u
       checkSMP(numer f, x, k, a, b)
 
--- true if p has a zero between a and b exclusive
+    -- true if p has a zero between a and b exclusive
     checkFor0(p, x, a, b) ==
       (u := polyIfCan(p, x)) case UP => checkForZero(u::UP, a, b, false)
       (v := isTimes p) case List(P) =>
@@ -26031,15 +34581,15 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where
          false
       (r := retractIfCan(p)@Union(K, "failed")) case "failed" => "failed"
       k := r::K
--- functions with no real zeros
+      -- functions with no real zeros
       is?(k, "exp"::SE) or is?(k, "acot"::SE) or is?(k, "cosh"::SE) => false
--- special case for log
+      -- special case for log
       is?(k, "log"::SE) =>
         (w := moreThan(b, 1)) case "failed" or not(w::B) => w
         moreThan(-a, -1)
       "failed"
 
--- returns true if a > b, false if a < b, "failed" if can't decide
+    -- returns true if a > b, false if a < b, "failed" if can't decide
     moreThan(a, b) ==
       (r := retractIfCan(a)@Union(F, "failed")) case "failed" =>  -- infinite
         whatInfinity(a) > 0
@@ -26047,7 +34597,7 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where
         "failed"
       u::Fraction(Z) > b
 
--- true if p has a pole between a and b
+    -- true if p has a pole between a and b
     checkSMP(p, x, k, a, b) ==
       (u := polyIfCan(p, k)) case UP => false
       (v := isTimes p) case List(P) =>
@@ -26060,7 +34610,6 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where
            (w := checkSMP(t, x, k, a, b)) case "failed" => return w
            if w::B then n := n + 1
          zero? n => false    -- no summand has a pole
---         one? n => true      -- only one summand has a pole
          (n = 1) => true      -- only one summand has a pole
          "failed"            -- at least 2 summands have a pole
       (r := retractIfCan(p)@Union(K, "failed")) case "failed" => "failed"
@@ -26094,15 +34643,15 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where
 -- f must be known to have no poles in (a,b)
     posit(f, x, k, a, b) ==
       z :=
-        (r := retractIfCan(a)@Union(F, "failed")) case "failed" => sign(f, x, a)
+        (r:= retractIfCan(a)@Union(F, "failed")) case "failed" => sign(f, x, a)
         sign(f, x, r::F, "right")
       (b1 := z case Z) and z::Z > 0 => true
       z :=
-        (r := retractIfCan(b)@Union(F, "failed")) case "failed" => sign(f, x, b)
+        (r:= retractIfCan(b)@Union(F, "failed")) case "failed" => sign(f, x, b)
         sign(f, x, r::F, "left")
       (b2 := z case Z) and z::Z > 0 => true
       b1 and b2 =>
-        ((w := checkFor0(numer f, k, a, b)) case "failed") or (w::B) => "failed"
+        ((w:= checkFor0(numer f, k, a, b)) case "failed") or (w::B) => "failed"
         false
       "failed"
 
@@ -26112,19 +34661,19 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where
 -- f must be known to have no poles in (a,b)
     negat(f, x, k, a, b) ==
       z :=
-        (r := retractIfCan(a)@Union(F, "failed")) case "failed" => sign(f, x, a)
+        (r:= retractIfCan(a)@Union(F, "failed")) case "failed" => sign(f, x, a)
         sign(f, x, r::F, "right")
       (b1 := z case Z) and z::Z < 0 => true
       z :=
-        (r := retractIfCan(b)@Union(F, "failed")) case "failed" => sign(f, x, b)
+        (r:= retractIfCan(b)@Union(F, "failed")) case "failed" => sign(f, x, b)
         sign(f, x, r::F, "left")
       (b2 := z case Z) and z::Z < 0 => true
       b1 and b2 =>
-        ((w := checkFor0(numer f, k, a, b)) case "failed") or (w::B) => "failed"
+        ((w:= checkFor0(numer f, k, a, b)) case "failed") or (w::B) => "failed"
         false
       "failed"
 
--- returns a UP if p is only a poly w.r.t. the kernel x
+    -- returns a UP if p is only a poly w.r.t. the kernel x
     polyIfCan(p, x) ==
       q := univariate(p, x)
       ans:UP := 0
@@ -26134,7 +34683,7 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where
         q := reductum q
       ans
 
--- integrate f for x between a and b assuming that f has no pole in between
+    -- integrate f for x between a and b assuming that f has no pole in between
     nopole(f, x, k, a, b) ==
       (u := integrate(f, x)) case F =>
         (v := computeInt(k, u::F, a, b, false)) case "failed" => ["failed"]
@@ -26150,46 +34699,217 @@ ElementaryFunctionDefiniteIntegration(R, F): Exports == Implementation where
 \begin{chunk}{COQ DEFINTEF}
 (* package DEFINTEF *)
 (*
-*)
 
-\end{chunk}
+    import ElementaryFunctionSign(R, F)
+    import DefiniteIntegrationTools(R, F)
+    import FunctionSpaceIntegration(R, F)
 
-\begin{chunk}{DEFINTEF.dotabb}
-"DEFINTEF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=DEFINTEF"]
-"ACFS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACFS"]
-"DEFINTEF" -> "ACFS"
+    polyIfCan   : (P, K) -> Union(UP, "failed")
+    int         : (F, SE, OFE, OFE, B) -> U
+    nopole      : (F, SE, K, OFE, OFE) -> U
+    checkFor0   : (P, K, OFE, OFE) -> Union(B, "failed")
+    checkSMP    : (P, SE, K, OFE, OFE) -> Union(B, "failed")
+    checkForPole: (F, SE, K, OFE, OFE) -> Union(B, "failed")
+    posit       : (F, SE, K, OFE, OFE) -> Union(B, "failed")
+    negat       : (F, SE, K, OFE, OFE) -> Union(B, "failed")
+    moreThan    : (OFE, Fraction Z) -> Union(B, "failed")
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{package LODEEF ElementaryFunctionLODESolver}
-\begin{chunk}{ElementaryFunctionLODESolver.input}
-)set break resume
-)sys rm -f ElementaryFunctionLODESolver.output
-)spool ElementaryFunctionLODESolver.output
-)set message test on
-)set message auto off
-)clear all
+    if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer)
+      and F has SpecialFunctionCategory then
 
---S 1 of 1
-)show ElementaryFunctionLODESolver
---R 
---R ElementaryFunctionLODESolver(R: Join(OrderedSet,EuclideanDomain,RetractableTo(Integer),LinearlyExplicitRingOver(Integer),CharacteristicZero),F: Join(AlgebraicallyClosedFunctionSpace(R),TranscendentalFunctionCategory,PrimitiveFunctionCategory),L: LinearOrdinaryDifferentialOperatorCategory(F))  is a package constructor
---R Abbreviation for ElementaryFunctionLODESolver is LODEEF 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.4.pamphlet to see algebra source code for LODEEF 
---R
---R------------------------------- Operations --------------------------------
---R solve : (L,F,Symbol) -> Union(Record(particular: F,basis: List(F)),"failed")
---R solve : (L,F,Symbol,F,List(F)) -> Union(F,"failed")
---R
---E 1
+        import PatternMatchIntegration(R, F)
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{ElementaryFunctionLODESolver.help}
-====================================================================
-ElementaryFunctionLODESolver examples
+        innerint(f, x, a, b, ignor?) ==
+          ((u := int(f, x, a, b, ignor?)) case f1) or (u case f2)
+            or ((v := pmintegrate(f, x, a, b)) case "failed") => u
+          [v::F::OFE]
+
+    else
+
+      innerint(f, x, a, b, ignor?) == int(f, x, a, b, ignor?)
+
+    integrate(f:F, s:SegmentBinding OFE) ==
+      innerint(f, variable s, lo segment s, hi segment s, false)
+
+    integrate(f:F, s:SegmentBinding OFE, str:String) ==
+      innerint(f, variable s, lo segment s, hi segment s, ignore? str)
+
+    int(f, x, a, b, ignor?) ==
+      a = b => [0::OFE]
+      k := kernel(x)@Kernel(F)
+      (z := checkForPole(f, x, k, a, b)) case "failed" =>
+        ignor? => nopole(f, x, k, a, b)
+        ["potentialPole"]
+      z::B => error "integrate: pole in path of integration"
+      nopole(f, x, k, a, b)
+
+    checkForPole(f, x, k, a, b) ==
+      ((u := checkFor0(d := denom f, k, a, b)) case "failed") or (u::B) => u
+      ((u := checkSMP(d, x, k, a, b)) case "failed") or (u::B) => u
+      checkSMP(numer f, x, k, a, b)
+
+    -- true if p has a zero between a and b exclusive
+    checkFor0(p, x, a, b) ==
+      (u := polyIfCan(p, x)) case UP => checkForZero(u::UP, a, b, false)
+      (v := isTimes p) case List(P) =>
+         for t in v::List(P) repeat
+           ((w := checkFor0(t, x, a, b)) case "failed") or (w::B) => return w
+         false
+      (r := retractIfCan(p)@Union(K, "failed")) case "failed" => "failed"
+      k := r::K
+      -- functions with no real zeros
+      is?(k, "exp"::SE) or is?(k, "acot"::SE) or is?(k, "cosh"::SE) => false
+      -- special case for log
+      is?(k, "log"::SE) =>
+        (w := moreThan(b, 1)) case "failed" or not(w::B) => w
+        moreThan(-a, -1)
+      "failed"
+
+    -- returns true if a > b, false if a < b, "failed" if can't decide
+    moreThan(a, b) ==
+      (r := retractIfCan(a)@Union(F, "failed")) case "failed" =>  -- infinite
+        whatInfinity(a) > 0
+      (u := retractIfCan(r::F)@Union(Fraction Z, "failed")) case "failed" =>
+        "failed"
+      u::Fraction(Z) > b
+
+    -- true if p has a pole between a and b
+    checkSMP(p, x, k, a, b) ==
+      (u := polyIfCan(p, k)) case UP => false
+      (v := isTimes p) case List(P) =>
+         for t in v::List(P) repeat
+           ((w := checkSMP(t, x, k, a, b)) case "failed") or (w::B) => return w
+         false
+      (v := isPlus p) case List(P) =>
+         n := 0              -- number of summand having a pole
+         for t in v::List(P) repeat
+           (w := checkSMP(t, x, k, a, b)) case "failed" => return w
+           if w::B then n := n + 1
+         zero? n => false    -- no summand has a pole
+         (n = 1) => true      -- only one summand has a pole
+         "failed"            -- at least 2 summands have a pole
+      (r := retractIfCan(p)@Union(K, "failed")) case "failed" => "failed"
+      kk := r::K
+      -- nullary operators have no poles
+      nullary? operator kk => false
+      f := first argument kk
+      -- functions which are defined over all the reals:
+      is?(kk, "exp"::SE) or is?(kk, "sin"::SE) or is?(kk, "cos"::SE)
+        or is?(kk, "sinh"::SE) or is?(kk, "cosh"::SE) or is?(kk, "tanh"::SE)
+          or is?(kk, "sech"::SE) or is?(kk, "atan"::SE) or is?(kk, "acot"::SE)
+            or is?(kk, "asinh"::SE) => checkForPole(f, x, k, a, b)
+      -- functions which are defined on (-1,+1):
+      is?(kk, "asin"::SE) or is?(kk, "acos"::SE) or is?(kk, "atanh"::SE) =>
+        ((w := checkForPole(f, x, k, a, b)) case "failed") or (w::B) => w
+        ((w := posit(f - 1, x, k, a, b)) case "failed") or (w::B) => w
+        negat(f + 1, x, k, a, b)
+      -- functions which are defined on (+1, +infty):
+      is?(kk, "acosh"::SE) =>
+        ((w := checkForPole(f, x, k, a, b)) case "failed") or (w::B) => w
+        negat(f - 1, x, k, a, b)
+      -- functions which are defined on (0, +infty):
+      is?(kk, "log"::SE) =>
+        ((w := checkForPole(f, x, k, a, b)) case "failed") or (w::B) => w
+        negat(f, x, k, a, b)
+      "failed"
+
+-- returns true if it is certain that f takes at least one strictly positive
+-- value for x in (a,b), false if it is certain that f takes no strictly
+-- positive value in (a,b), "failed" otherwise
+-- f must be known to have no poles in (a,b)
+    posit(f, x, k, a, b) ==
+      z :=
+        (r:= retractIfCan(a)@Union(F, "failed")) case "failed" => sign(f, x, a)
+        sign(f, x, r::F, "right")
+      (b1 := z case Z) and z::Z > 0 => true
+      z :=
+        (r:= retractIfCan(b)@Union(F, "failed")) case "failed" => sign(f, x, b)
+        sign(f, x, r::F, "left")
+      (b2 := z case Z) and z::Z > 0 => true
+      b1 and b2 =>
+        ((w:= checkFor0(numer f, k, a, b)) case "failed") or (w::B) => "failed"
+        false
+      "failed"
+
+-- returns true if it is certain that f takes at least one strictly negative
+-- value for x in (a,b), false if it is certain that f takes no strictly
+-- negative value in (a,b), "failed" otherwise
+-- f must be known to have no poles in (a,b)
+    negat(f, x, k, a, b) ==
+      z :=
+        (r:= retractIfCan(a)@Union(F, "failed")) case "failed" => sign(f, x, a)
+        sign(f, x, r::F, "right")
+      (b1 := z case Z) and z::Z < 0 => true
+      z :=
+        (r:= retractIfCan(b)@Union(F, "failed")) case "failed" => sign(f, x, b)
+        sign(f, x, r::F, "left")
+      (b2 := z case Z) and z::Z < 0 => true
+      b1 and b2 =>
+        ((w:= checkFor0(numer f, k, a, b)) case "failed") or (w::B) => "failed"
+        false
+      "failed"
+
+    -- returns a UP if p is only a poly w.r.t. the kernel x
+    polyIfCan(p, x) ==
+      q := univariate(p, x)
+      ans:UP := 0
+      while q ^= 0 repeat
+        member?(x, tower(c := leadingCoefficient(q)::F)) => return "failed"
+        ans := ans + monomial(c, degree q)
+        q := reductum q
+      ans
+
+    -- integrate f for x between a and b assuming that f has no pole in between
+    nopole(f, x, k, a, b) ==
+      (u := integrate(f, x)) case F =>
+        (v := computeInt(k, u::F, a, b, false)) case "failed" => ["failed"]
+        [v::OFE]
+      ans := empty()$List(OFE)
+      for g in u::List(F) repeat
+        (v := computeInt(k, g, a, b, false)) case "failed" => return ["failed"]
+        ans := concat_!(ans, [v::OFE])
+      [ans]
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{DEFINTEF.dotabb}
+"DEFINTEF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=DEFINTEF"]
+"ACFS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACFS"]
+"DEFINTEF" -> "ACFS"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{package LODEEF ElementaryFunctionLODESolver}
+\begin{chunk}{ElementaryFunctionLODESolver.input}
+)set break resume
+)sys rm -f ElementaryFunctionLODESolver.output
+)spool ElementaryFunctionLODESolver.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show ElementaryFunctionLODESolver
+--R 
+--R ElementaryFunctionLODESolver(R: Join(OrderedSet,EuclideanDomain,RetractableTo(Integer),LinearlyExplicitRingOver(Integer),CharacteristicZero),F: Join(AlgebraicallyClosedFunctionSpace(R),TranscendentalFunctionCategory,PrimitiveFunctionCategory),L: LinearOrdinaryDifferentialOperatorCategory(F))  is a package constructor
+--R Abbreviation for ElementaryFunctionLODESolver is LODEEF 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.4.pamphlet to see algebra source code for LODEEF 
+--R
+--R------------------------------- Operations --------------------------------
+--R solve : (L,F,Symbol) -> Union(Record(particular: F,basis: List(F)),"failed")
+--R solve : (L,F,Symbol,F,List(F)) -> Union(F,"failed")
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{ElementaryFunctionLODESolver.help}
+====================================================================
+ElementaryFunctionLODESolver examples
 ====================================================================
 
 ElementaryFunctionLODESolver provides the top-level functions for
@@ -26256,6 +34976,7 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where
       ++ \spad{x} is the dependent variable.
 
   Implementation ==> add
+
     import Kovacic(F, UP)
     import ODETools(F, L)
     import RationalLODE(F, UP)
@@ -26297,10 +35018,12 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where
     diff := D()$L
 
     smpxpart(p, x, l, lp) == downmp(primitivePart upmp(p, l), l, lp)
+
     downmp(p, l, lp)      == ground eval(p, l, lp)
+
     homosolve(lf, op, sols, k, x) == homosolve1(lf, ratlogsol(op,sols,k,x),k,x)
 
--- left hand side has algebraic (not necessarily pure) coefficients
+    -- left hand side has algebraic (not necessarily pure) coefficients
     algSolve(op, g, k, l, x) ==
       symbolIfCan(kx := ksec(k, l, x)) case SY => palgSolve(op, g, kx, k, x)
       has?(operator kx, ALGOP) =>
@@ -26323,18 +35046,17 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where
       [u::F, bas]
 
     lastChance(op, g, x) ==
---      one? degree op => firstOrder(coefficient(op,0), leadingCoefficient op,g,x)
-      (degree op) = 1 => firstOrder(coefficient(op,0), leadingCoefficient op,g,x)
+      (degree op)=1 => firstOrder(coefficient(op,0), leadingCoefficient op,g,x)
       "failed"
 
--- solves a0 y + a1 y' = g
--- does not check whether there is a solution in the field generated by
--- a0, a1 and g
+    -- solves a0 y + a1 y' = g
+    -- does not check whether there is a solution in the field generated by
+    -- a0, a1 and g
     firstOrder(a0, a1, g, x) ==
       h := xpart(expint(- a0 / a1, x), x)
       [h * int((g / h) / a1, x), [h]]
 
--- xpart(f,x) removes any constant not involving x from f
+    -- xpart(f,x) removes any constant not involving x from f
     xpart(f, x) ==
       l  := reverse_! varselect(tower f, x)
       lp := [k::P for k in l]
@@ -26350,19 +35072,19 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where
         up  := reductum up
       ans
 
--- multint(a, [g1,...,gk], x) returns gk \int(g(k-1) \int(....g1 \int(a))...)
+    -- multint(a, [g1,...,gk], x) returns gk 
+    -- \int(g(k-1) \int(....g1 \int(a))...)
     multint(a, l, x) ==
        for g in l repeat a := g * xpart(int(a, x), x)
        a
 
     expsols(op, k, x) ==
---      one? degree op =>
       (degree op) = 1 =>
           firstOrder(multivariate(coefficient(op, 0), k),
                      multivariate(leadingCoefficient op, k), 0, x).basis
       [xpart(expint(multivariate(h, k), x), x) for h in ricDsolve(op, ffactor)]
 
--- Finds solutions with rational logarithmic derivative
+    -- Finds solutions with rational logarithmic derivative
     ratlogsol(oper, sols, k, x) ==
       bas := [xpart(multivariate(h, k), x) for h in sols]
       degree(oper) = #bas => bas            -- all solutions are found already
@@ -26378,12 +35100,11 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where
       int:List(F) := [xpart(h, x) for h in rec.op]
       concat_!(sols, [multint(e, int, x) for e in norf1(rec.eq, k, x, n::N)])
 
--- if the coefficients are rational functions, then the equation does not
--- not have a proper 1st-order right factor over the rational functions
+    -- if the coefficients are rational functions, then the equation does not
+    -- not have a proper 1st-order right factor over the rational functions
     norf1(op, k, x, n) ==
---      one? n => firstOrder(coefficient(op, 0), leadingCoefficient op,0,x).basis
-      (n = 1) => firstOrder(coefficient(op, 0), leadingCoefficient op,0,x).basis
--- for order > 2, we check that the coeffs are still rational functions
+      (n = 1) => firstOrder(coefficient(op, 0),leadingCoefficient op,0,x).basis
+      -- for order > 2, we check that the coeffs are still rational functions
       symbolIfCan(kmax vark(coefficients op, x)) case SY =>
         eq := ulodo(op, k)
         n = 2 => kovode(eq, k, x)
@@ -26397,7 +35118,7 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where
     kovode(op, k, x) ==
       b := coefficient(op, 1)
       a := coefficient(op, 2)
-      (u := kovacic(coefficient(op, 0), b, a, ffactor)) case "failed" => empty()
+      (u:= kovacic(coefficient(op, 0), b, a, ffactor)) case "failed" => empty()
       p := map(z1+->multivariate(z1, k), u::UPUP)
       ba := multivariate(- b / a, k)
 -- if p has degree 2 (case 2), then it must be squarefree since the
@@ -26417,11 +35138,11 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where
     ulodo(eq, k) ==
         op:LQ := 0
         while eq ^= 0 repeat
-            op := op + monomial(univariate(leadingCoefficient eq, k), degree eq)
+            op:= op + monomial(univariate(leadingCoefficient eq, k), degree eq)
             eq := reductum eq
         op
 
--- left hand side has rational coefficients
+    -- left hand side has rational coefficients
     rfSolve(eq, g, k, x) ==
       op := ulodo(eq, k)
       empty? remove_!(k, varselect(kernels g, x)) =>  -- i.e. rhs is rational
@@ -26454,7 +35175,7 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where
             op  := reductum op
         ans
 
--- left hand side has pure algebraic coefficients
+    -- left hand side has pure algebraic coefficients
     palgSolve(op, g, kx, k, x) ==
       rec := palgLODE(op, g, kx, k, x)   -- finds solutions in the coef. field
       rec.particular case "failed" =>
@@ -26466,6 +35187,212 @@ ElementaryFunctionLODESolver(R, F, L): Exports == Implementation where
 \begin{chunk}{COQ LODEEF}
 (* package LODEEF *)
 (*
+
+    import Kovacic(F, UP)
+    import ODETools(F, L)
+    import RationalLODE(F, UP)
+    import RationalRicDE(F, UP)
+    import ODEIntegration(R, F)
+    import ConstantLODE(R, F, L)
+    import IntegrationTools(R, F)
+    import ReductionOfOrder(F, L)
+    import ReductionOfOrder(RF, LQ)
+    import PureAlgebraicIntegration(R, F, L)
+    import FunctionSpacePrimitiveElement(R, F)
+    import LinearSystemMatrixPackage(F, V, V, M)
+    import SparseUnivariatePolynomialFunctions2(RF, F)
+    import FunctionSpaceUnivariatePolynomialFactor(R, F, UP)
+    import LinearOrdinaryDifferentialOperatorFactorizer(F, UP)
+    import PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                                                             K, R, P, F)
+
+    upmp       : (P, List K) -> P2
+    downmp     : (P2, List K, List P) -> P
+    xpart      : (F, SY) -> F
+    smpxpart   : (P, SY, List K, List P) -> P
+    multint    : (F, List F, SY) -> F
+    ulodo      : (L, K) -> LQ
+    firstOrder : (F, F, F, SY) -> REC
+    rfSolve    : (L, F, K, SY) -> U
+    ratlogsol  : (LQ, List RF, K, SY) -> List F
+    expsols    : (LQ, K, SY) -> List F
+    homosolve  : (L, LQ, List RF, K, SY) -> List F
+    homosolve1 : (L, List F, K, SY) -> List F
+    norf1      : (L, K, SY, N) -> List F
+    kovode     : (LQ, K, SY) -> List F
+    doVarParams: (L, F, List F, SY) -> U
+    localmap   : (F -> F, L) -> L
+    algSolve   : (L, F, K, List K, SY) -> U
+    palgSolve  : (L, F, K, K, SY) -> U
+    lastChance : (L, F, SY) -> U
+
+    diff := D()$L
+
+    smpxpart(p, x, l, lp) == downmp(primitivePart upmp(p, l), l, lp)
+
+    downmp(p, l, lp)      == ground eval(p, l, lp)
+
+    homosolve(lf, op, sols, k, x) == homosolve1(lf, ratlogsol(op,sols,k,x),k,x)
+
+    -- left hand side has algebraic (not necessarily pure) coefficients
+    algSolve(op, g, k, l, x) ==
+      symbolIfCan(kx := ksec(k, l, x)) case SY => palgSolve(op, g, kx, k, x)
+      has?(operator kx, ALGOP) =>
+        rec := primitiveElement(kx::F, k::F)
+        z   := rootOf(rec.prim)
+        lk:List K := [kx, k]
+        lv:List F := [(rec.pol1) z, (rec.pol2) z]
+        (u := solve(localmap((f1:F):F +-> eval(f1, lk, lv), op), _
+                              eval(g, lk, lv), x))
+            case "failed" => "failed"
+        rc := u::REC
+        kz := retract(z)@K
+        [eval(rc.particular, kz, rec.primelt),
+            [eval(f, kz, rec.primelt) for f in rc.basis]]
+      lastChance(op, g, x)
+
+    doVarParams(eq, g, bas, x) ==
+      (u := particularSolution(eq, g, bas, (f1:F):F +-> int(f1, x)))
+         case "failed" => lastChance(eq, g, x)
+      [u::F, bas]
+
+    lastChance(op, g, x) ==
+      (degree op)=1 => firstOrder(coefficient(op,0), leadingCoefficient op,g,x)
+      "failed"
+
+    -- solves a0 y + a1 y' = g
+    -- does not check whether there is a solution in the field generated by
+    -- a0, a1 and g
+    firstOrder(a0, a1, g, x) ==
+      h := xpart(expint(- a0 / a1, x), x)
+      [h * int((g / h) / a1, x), [h]]
+
+    -- xpart(f,x) removes any constant not involving x from f
+    xpart(f, x) ==
+      l  := reverse_! varselect(tower f, x)
+      lp := [k::P for k in l]
+      smpxpart(numer f, x, l, lp) / smpxpart(denom f, x, l, lp)
+
+    upmp(p, l) ==
+      empty? l => p::P2
+      up := univariate(p, k := first l)
+      l := rest l
+      ans:P2 := 0
+      while up ^= 0 repeat
+        ans := ans + monomial(upmp(leadingCoefficient up, l), k, degree up)
+        up  := reductum up
+      ans
+
+    -- multint(a, [g1,...,gk], x) returns gk 
+    -- \int(g(k-1) \int(....g1 \int(a))...)
+    multint(a, l, x) ==
+       for g in l repeat a := g * xpart(int(a, x), x)
+       a
+
+    expsols(op, k, x) ==
+      (degree op) = 1 =>
+          firstOrder(multivariate(coefficient(op, 0), k),
+                     multivariate(leadingCoefficient op, k), 0, x).basis
+      [xpart(expint(multivariate(h, k), x), x) for h in ricDsolve(op, ffactor)]
+
+    -- Finds solutions with rational logarithmic derivative
+    ratlogsol(oper, sols, k, x) ==
+      bas := [xpart(multivariate(h, k), x) for h in sols]
+      degree(oper) = #bas => bas            -- all solutions are found already
+      rec := ReduceOrder(oper, sols)
+      le := expsols(rec.eq, k, x)
+      int:List(F) := [xpart(multivariate(h, k), x) for h in rec.op]
+      concat_!([xpart(multivariate(h, k), x) for h in sols],
+               [multint(e, int, x) for e in le])
+
+    homosolve1(oper, sols, k, x) ==
+      zero?(n := (degree(oper) - #sols)::N) => sols   -- all solutions found
+      rec := ReduceOrder(oper, sols)
+      int:List(F) := [xpart(h, x) for h in rec.op]
+      concat_!(sols, [multint(e, int, x) for e in norf1(rec.eq, k, x, n::N)])
+
+    -- if the coefficients are rational functions, then the equation does not
+    -- not have a proper 1st-order right factor over the rational functions
+    norf1(op, k, x, n) ==
+      (n = 1) => firstOrder(coefficient(op, 0),leadingCoefficient op,0,x).basis
+      -- for order > 2, we check that the coeffs are still rational functions
+      symbolIfCan(kmax vark(coefficients op, x)) case SY =>
+        eq := ulodo(op, k)
+        n = 2 => kovode(eq, k, x)
+        eq := last factor1 eq        -- eq cannot have order 1
+        degree(eq) = 2 =>
+          empty?(bas := kovode(eq, k, x)) => empty()
+          homosolve1(op, bas, k, x)
+        empty()
+      empty()
+
+    kovode(op, k, x) ==
+      b := coefficient(op, 1)
+      a := coefficient(op, 2)
+      (u:= kovacic(coefficient(op, 0), b, a, ffactor)) case "failed" => empty()
+      p := map(z1+->multivariate(z1, k), u::UPUP)
+      ba := multivariate(- b / a, k)
+-- if p has degree 2 (case 2), then it must be squarefree since the
+-- ode is irreducible over the rational functions, so the 2 roots of p
+-- are distinct and must yield 2 independent solutions.
+      degree(p) = 2 => [xpart(expint(ba/(2::F) + e, x), x) for e in zerosOf p]
+-- otherwise take 1 root of p and find the 2nd solution by reduction of order
+      y1 := xpart(expint(ba / (2::F) + zeroOf p, x), x)
+      [y1, y1 * xpart(int(expint(ba, x) / y1**2, x), x)]
+
+    solve(op:L, g:F, x:SY) ==
+      empty?(l := vark(coefficients op, x)) => constDsolve(op, g, x)
+      symbolIfCan(k := kmax l) case SY => rfSolve(op, g, k, x)
+      has?(operator k, ALGOP) => algSolve(op, g, k, l, x)
+      lastChance(op, g, x)
+
+    ulodo(eq, k) ==
+        op:LQ := 0
+        while eq ^= 0 repeat
+            op:= op + monomial(univariate(leadingCoefficient eq, k), degree eq)
+            eq := reductum eq
+        op
+
+    -- left hand side has rational coefficients
+    rfSolve(eq, g, k, x) ==
+      op := ulodo(eq, k)
+      empty? remove_!(k, varselect(kernels g, x)) =>  -- i.e. rhs is rational
+        rc := ratDsolve(op, univariate(g, k))
+        rc.particular case "failed" =>                -- this implies g ^= 0
+          doVarParams(eq, g, homosolve(eq, op, rc.basis, k, x), x)
+        [multivariate(rc.particular::RF, k), homosolve(eq, op, rc.basis, k, x)]
+      doVarParams(eq, g, homosolve(eq, op, ratDsolve(op, 0).basis, k, x), x)
+
+    solve(op, g, x, a, y0) ==
+      (u := solve(op, g, x)) case "failed" => "failed"
+      hp := h := (u::REC).particular
+      b := (u::REC).basis
+      v:V := new(n := #y0, 0)
+      kx:K := kernel x
+      for i in minIndex v .. maxIndex v for yy in y0 repeat
+        v.i := yy - eval(h, kx, a)
+        h := diff h
+      (sol := particularSolution(
+         map_!((f1:F):F+->eval(f1,kx,a),wronskianMatrix(b,n)), v))
+           case "failed" => "failed"
+      for f in b for i in minIndex(s := sol::V) .. repeat
+        hp := hp + s.i * f
+      hp
+
+    localmap(f, op) ==
+        ans:L := 0
+        while op ^= 0 repeat
+            ans := ans + monomial(f leadingCoefficient op, degree op)
+            op  := reductum op
+        ans
+
+    -- left hand side has pure algebraic coefficients
+    palgSolve(op, g, kx, k, x) ==
+      rec := palgLODE(op, g, kx, k, x)   -- finds solutions in the coef. field
+      rec.particular case "failed" =>
+        doVarParams(op, g, homosolve1(op, rec.basis, k, x), x)
+      [(rec.particular)::F, homosolve1(op, rec.basis, k, x)]
+
 *)
 
 \end{chunk}
@@ -26627,6 +35554,7 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where
       ++ \spad{dy/dx = f(x,y)};
 
   Implementation ==> add
+
     import ODEIntegration(R, F)
     import IntegrationTools(R, F)
     import NonLinearFirstOrderODESolver(R, F)
@@ -26664,7 +35592,6 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where
       a := rhs center
       kx:K := kernel(x := retract(lhs(center))@SY)
       (ur := parseODE(diffeq, y, x)) case NLQ =>
---        not one?(#y0) => error "solve: more than one initial condition!"
         not ((#y0) = 1) => error "solve: more than one initial condition!"
         rc := ur::NLQ
         (u := solve(rc.dx, rc.dy, y, x)) case "failed" => "failed"
@@ -26700,7 +35627,7 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where
          case "failed" => "failed"
       uuu::REC
 
--- returns [M, v] s.t. the equations are D x = M x + v
+    -- returns [M, v] s.t. the equations are D x = M x + v
     parseSYS(eqs, ly, x) ==
       (n := #eqs) ^= #ly => "failed"
       m:M := new(n, n, 0)
@@ -26729,8 +35656,9 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where
           eq := eq - ci * y::F
       [n, v, -eq]
 
--- returns either [p, g] where the equation (diffeq) is of the form p(D)(y) = g
--- or [p, q] such that the equation (diffeq) is of the form p dx + q dy = 0
+    -- returns either [p, g] where the equation (diffeq) is of the 
+    -- form p(D)(y) = g
+    -- or [p, q] such that the equation (diffeq) is of the form p dx + q dy = 0
     parseODE(diffeq, y, x) ==
       f := y(x::F)
       l:List(K) := [retract(f)@K]
@@ -26738,7 +35666,7 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where
       for k in varselect(kernels diffeq, x) | is?(k, OPDIFF) repeat
         if (m := height k) > n then n := m
       n := (n - 2)::N
--- build a list of kernels in the order [y^(n)(x),...,y''(x),y'(x),y(x)]
+      -- build a list of kernels in the order [y^(n)(x),...,y''(x),y'(x),y(x)]
       for i in 1..n repeat
         l := concat(retract(f := differentiate(f, x))@K, l)
       k:K   -- #$^#& compiler requires this line and the next one too...
@@ -26756,7 +35684,7 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where
         [monomial(c, 1) + d::UP, eqrhs]
       [diffeq, c]
 
--- returns [p, g] where the equation (diffeq) is of the form p(D)(y) = g
+    -- returns [p, g] where the equation (diffeq) is of the form p(D)(y) = g
     parseLODE(diffeq, l, p, y) ==
       not freeOf?(leadingCoefficient p, y) =>
         error "parseLODE: not a linear ordinary differential equation"
@@ -26794,6 +35722,169 @@ ElementaryFunctionODESolver(R, F): Exports == Implementation where
 \begin{chunk}{COQ ODEEF}
 (* package ODEEF *)
 (*
+
+    import ODEIntegration(R, F)
+    import IntegrationTools(R, F)
+    import NonLinearFirstOrderODESolver(R, F)
+
+    getfreelincoeff : (F, K, SY) -> F
+    getfreelincoeff1: (F, K, List F) -> F
+    getlincoeff     : (F, K) -> F
+    getcoeff        : (F, K) -> UU
+    parseODE        : (F, OP, SY) -> Union(LEQ, NLQ)
+    parseLODE       : (F, List K, UP, SY) -> LEQ
+    parseSYS        : (List F, List OP, SY) -> Union(SYS, "failed")
+    parseSYSeq      : (F, List K, List K, List F, SY) -> Union(ROW, "failed")
+
+    solve(diffeq:EQ, y:OP, x:SY) == solve(lhs diffeq - rhs diffeq, y, x)
+
+    solve(leq: List EQ, lop: List OP, x:SY) ==
+        solve([lhs eq - rhs eq for eq in leq], lop, x)
+
+    solve(diffeq:EQ, y:OP, center:EQ, y0:List F) ==
+      solve(lhs diffeq - rhs diffeq, y, center, y0)
+
+    solve(m:M, x:SY) ==
+        (u := solve(m, new(nrows m, 0), x)) case "failed" => "failed"
+        u.basis
+
+    solve(m:M, v:V, x:SY) ==
+        Lx := LinearOrdinaryDifferentialOperator(F, diff x)
+        uu := solve(m, v, (z1,z2) +-> solve(z1, z2, x)_
+          $ElementaryFunctionLODESolver(R, F, Lx))$SystemODESolver(F, Lx)
+        uu case "failed" => "failed"
+        rec := uu::Record(particular: V, basis: M)
+        [rec.particular, [column(rec.basis, i) for i in 1..ncols(rec.basis)]]
+
+    solve(diffeq:F, y:OP, center:EQ, y0:List F) ==
+      a := rhs center
+      kx:K := kernel(x := retract(lhs(center))@SY)
+      (ur := parseODE(diffeq, y, x)) case NLQ =>
+        not ((#y0) = 1) => error "solve: more than one initial condition!"
+        rc := ur::NLQ
+        (u := solve(rc.dx, rc.dy, y, x)) case "failed" => "failed"
+        u::F - eval(u::F,  [kx, retract(y(x::F))@K], [a, first y0])
+      rec := ur::LEQ
+      p := rec.left
+      Lx := LinearOrdinaryDifferentialOperator(F, diff x)
+      op:Lx := 0
+      while p ^= 0 repeat
+        op := op + monomial(leadingCoefficient p, degree p)
+        p  := reductum p
+      solve(op, rec.right, x, a, y0)$ElementaryFunctionLODESolver(R, F, Lx)
+
+    solve(leq: List F, lop: List OP, x:SY) ==
+        (u := parseSYS(leq, lop, x)) case SYS =>
+            rec := u::SYS
+            solve(rec.mat, rec.vec, x)
+        error "solve: not a first order linear system"
+
+    solve(diffeq:F, y:OP, x:SY) ==
+      (u := parseODE(diffeq, y, x)) case NLQ =>
+        rc := u::NLQ
+        (uu := solve(rc.dx, rc.dy, y, x)) case "failed" => "failed"
+        uu::F
+      rec := u::LEQ
+      p := rec.left
+      Lx := LinearOrdinaryDifferentialOperator(F, diff x)
+      op:Lx := 0
+      while p ^= 0 repeat
+        op := op + monomial(leadingCoefficient p, degree p)
+        p  := reductum p
+      (uuu := solve(op, rec.right, x)$ElementaryFunctionLODESolver(R, F, Lx))
+         case "failed" => "failed"
+      uuu::REC
+
+    -- returns [M, v] s.t. the equations are D x = M x + v
+    parseSYS(eqs, ly, x) ==
+      (n := #eqs) ^= #ly => "failed"
+      m:M := new(n, n, 0)
+      v:V := new(n, 0)
+      xx := x::F
+      lf := [y xx for y in ly]
+      lk0:List(K) := [retract(f)@K for f in lf]
+      lk1:List(K) := [retract(differentiate(f, x))@K for f in lf]
+      for eq in eqs repeat
+          (u := parseSYSeq(eq,lk0,lk1,lf,x)) case "failed" => return "failed"
+          rec := u::ROW
+          setRow_!(m, rec.index, rec.row)
+          v(rec.index) := rec.rh
+      [m, v]
+
+    parseSYSeq(eq, l0, l1, lf, x) ==
+      l := [k for k in varselect(kernels eq, x) | is?(k, OPDIFF)]
+      empty? l or not empty? rest l or zero?(n := position(k := first l,l1)) =>
+         "failed"
+      c := getfreelincoeff1(eq, k, lf)
+      eq := eq - c * k::F
+      v:V := new(#l0, 0)
+      for y in l0 for i in 1.. repeat
+          ci := getfreelincoeff1(eq, y, lf)
+          v.i := - ci / c
+          eq := eq - ci * y::F
+      [n, v, -eq]
+
+    -- returns either [p, g] where the equation (diffeq) is of the 
+    -- form p(D)(y) = g
+    -- or [p, q] such that the equation (diffeq) is of the form p dx + q dy = 0
+    parseODE(diffeq, y, x) ==
+      f := y(x::F)
+      l:List(K) := [retract(f)@K]
+      n:N := 2
+      for k in varselect(kernels diffeq, x) | is?(k, OPDIFF) repeat
+        if (m := height k) > n then n := m
+      n := (n - 2)::N
+      -- build a list of kernels in the order [y^(n)(x),...,y''(x),y'(x),y(x)]
+      for i in 1..n repeat
+        l := concat(retract(f := differentiate(f, x))@K, l)
+      k:K   -- #$^#& compiler requires this line and the next one too...
+      c:F
+      while not(empty? l) and zero?(c := getlincoeff(diffeq, k := first l))
+        repeat l := rest l
+      empty? l or empty? rest l => error "parseODE: equation has order 0"
+      diffeq := diffeq - c * (k::F)
+      ny := name y
+      l := rest l
+      height(k) > 3 => parseLODE(diffeq, l, monomial(c, #l), ny)
+      (u := getcoeff(diffeq, k := first l)) case "failed" => [diffeq, c]
+      eqrhs := (d := u::F) * (k::F) - diffeq
+      freeOf?(eqrhs, ny) and freeOf?(c, ny) and freeOf?(d, ny) =>
+        [monomial(c, 1) + d::UP, eqrhs]
+      [diffeq, c]
+
+    -- returns [p, g] where the equation (diffeq) is of the form p(D)(y) = g
+    parseLODE(diffeq, l, p, y) ==
+      not freeOf?(leadingCoefficient p, y) =>
+        error "parseLODE: not a linear ordinary differential equation"
+      d := degree(p)::Integer - 1
+      for k in l repeat
+        p := p + monomial(c := getfreelincoeff(diffeq, k, y), d::N)
+        d := d - 1
+        diffeq := diffeq - c * (k::F)
+      freeOf?(diffeq, y) => [p, - diffeq]
+      error "parseLODE: not a linear ordinary differential equation"
+
+    getfreelincoeff(f, k, y) ==
+      freeOf?(c := getlincoeff(f, k), y) => c
+      error "getfreelincoeff: not a linear ordinary differential equation"
+
+    getfreelincoeff1(f, k, ly) ==
+      c := getlincoeff(f, k)
+      for y in ly repeat
+         not freeOf?(c, y) =>
+           error "getfreelincoeff: not a linear ordinary differential equation"
+      c
+
+    getlincoeff(f, k) ==
+      (u := getcoeff(f, k)) case "failed" =>
+        error "getlincoeff: not an appropriate ordinary differential equation"
+      u::F
+
+    getcoeff(f, k) ==
+      (r := retractIfCan(univariate(denom f, k))@Union(P, "failed"))
+        case "failed" or degree(p := univariate(numer f, k)) > 1 => "failed"
+      coefficient(p, 1) / (r::P)
+
 *)
 
 \end{chunk}
@@ -26889,6 +35980,7 @@ ElementaryFunctionSign(R,F): Exports == Implementation where
       ++ if s is "left", or above if s is "right".
 
   Implementation ==> add
+
     import ToolsForSign R
     import RationalFunctionSign(R)
     import PowerSeriesLimitPackage(R, F)
@@ -27040,6 +36132,153 @@ ElementaryFunctionSign(R,F): Exports == Implementation where
 \begin{chunk}{COQ SIGNEF}
 (* package SIGNEF *)
 (*
+
+    import ToolsForSign R
+    import RationalFunctionSign(R)
+    import PowerSeriesLimitPackage(R, F)
+    import TrigonometricManipulations(R, F)
+
+    smpsign : P -> U
+    sqfrSign: P -> U
+    termSign: P -> U
+    kerSign : K -> U
+    listSign: (List P,Z) -> U
+    insign  : (F,SY,OFE, N) -> U
+    psign   : (F,SY,F,String, N) -> U
+    ofesign : OFE -> U
+    overRF  : OFE -> Union(ORF, "failed")
+
+    sign(f, x, a) ==
+      not real? f => "failed"
+      insign(f, x, a, 0)
+
+    sign(f, x, a, st) ==
+      not real? f => "failed"
+      psign(f, x, a, st, 0)
+
+    sign f ==
+      not real? f => "failed"
+      (u := retractIfCan(f)@Union(RF,"failed")) case RF => sign(u::RF)
+      (un := smpsign numer f) case Z and (ud := smpsign denom f) case Z =>
+        un::Z * ud::Z
+      --abort if there are any variables
+      not empty? variables f => "failed"
+      -- abort in the presence of algebraic numbers
+      member?(coerce("rootOf")::Symbol,
+        map(name,operators f)$ListFunctions2(BasicOperator,Symbol)) => "failed"
+      -- In the last resort try interval evaluation where feasible.
+      if R has ConvertibleTo Float then
+        import Interval(Float)
+        import Expression(Interval Float)
+        mapfun : (R -> Interval(Float)) := z +-> interval(convert(z)$R)
+        f2 : Expression(Interval Float) := 
+            map(mapfun,f)$FS2(R,F,Interval(Float),Expression(Interval Float))
+        r : Union(Interval(Float),"failed") := retractIfCan f2
+        if r case "failed" then  return "failed"
+        negative? r => return(-1)
+        positive? r => return 1
+        zero? r => return 0
+        "failed"
+      "failed"
+
+    overRF a ==
+      (n := whatInfinity a) = 0 =>
+        (u := retractIfCan(retract(a)@F)@Union(RF,"failed")) _
+               case "failed" => "failed"
+        u::RF::ORF
+      n * plusInfinity()$ORF
+
+    ofesign a ==
+      (n := whatInfinity a) ^= 0 => convert(n)@Z
+      sign(retract(a)@F)
+
+    insign(f, x, a, m) ==
+      m > 10 => "failed"                 -- avoid infinite loops for now
+      (uf := retractIfCan(f)@Union(RF,"failed")) case RF and
+                   (ua := overRF a) case ORF => sign(uf::RF, x, ua::ORF)
+      eq : Equation OFE := equation(x :: F :: OFE,a)
+      (u := limit(f,eq)) case "failed" => "failed"
+      u case OFE =>
+        (n := whatInfinity(u::OFE)) ^= 0 => convert(n)@Z
+        (v := retract(u::OFE)@F) = 0 =>
+          (s := insign(differentiate(f, x), x, a, m + 1)) case "failed"
+                                                             => "failed"
+          - s::Z * n
+        sign v
+      (u.leftHandLimit case "failed") or
+         (u.rightHandLimit case "failed") => "failed"
+      (ul := ofesign(u.leftHandLimit::OFE))  case "failed" => "failed"
+      (ur := ofesign(u.rightHandLimit::OFE)) case "failed" => "failed"
+      (ul::Z) = (ur::Z) => ul
+      "failed"
+
+    psign(f, x, a, st, m) ==
+      m > 10 => "failed"                 -- avoid infinite loops for now
+      f = 0 => 0
+      (uf := retractIfCan(f)@Union(RF,"failed")) case RF and
+           (ua := retractIfCan(a)@Union(RF,"failed")) case RF =>
+            sign(uf::RF, x, ua::RF, st)
+      eq : Equation F := equation(x :: F,a)
+      (u := limit(f,eq,st)) case "failed" => "failed"
+      u case OFE =>
+        (n := whatInfinity(u::OFE)) ^= 0 => convert(n)@Z
+        (v := retract(u::OFE)@F) = 0 =>
+          (s := psign(differentiate(f,x),x,a,st,m + 1)) case "failed"=>
+            "failed"
+          direction(st) * s::Z
+        sign v
+
+    smpsign p ==
+      (r := retractIfCan(p)@Union(R,"failed")) case R => sign(r::R)
+      (u := sign(retract(unit(s := squareFree p))@R)) case "failed" =>
+        "failed"
+      ans := u::Z
+      for term in factorList s | odd?(term.xpnt) repeat
+        (u := sqfrSign(term.fctr)) case "failed" => return "failed"
+        ans := ans * u::Z
+      ans
+
+    sqfrSign p ==
+      (u := termSign first(l := monomials p)) case "failed" => "failed"
+      listSign(rest l, u::Z)
+
+    listSign(l, s) ==
+      for term in l repeat
+        (u := termSign term) case "failed" => return "failed"
+        not(s = u::Z) => return "failed"
+      s
+
+    termSign term ==
+      (us := sign leadingCoefficient term) case "failed" => "failed"
+      for var in (lv := variables term) repeat
+        odd? degree(term, var) =>
+          empty? rest lv and (vs := kerSign first lv) case Z =>
+                                                   return(us::Z * vs::Z)
+          return "failed"
+      us::Z
+
+    kerSign k ==
+      has?(op := operator k, "NEGAT") => -1
+      has?(op, "POSIT") or is?(op,  "pi"::SY) or is?(op,"exp"::SY) or
+                           is?(op,"cosh"::SY) or is?(op,"sech"::SY) => 1
+      empty?(arg := argument k) => "failed"
+      (s := sign first arg) case "failed" =>
+        is?(op,"nthRoot" :: SY) =>
+          even?(retract(second arg)@Z) => 1
+          "failed"
+        "failed"
+      is?(op,"log" :: SY) =>
+        s::Z < 0 => "failed"
+        sign(first arg - 1)
+      is?(op,"tanh" :: SY) or is?(op,"sinh" :: SY) or
+                     is?(op,"csch" :: SY) or is?(op,"coth" :: SY) => s
+      is?(op,"nthRoot" :: SY) =>
+        even?(retract(second arg)@Z) =>
+          s::Z < 0 => "failed"
+          s
+        s
+      "failed"
+
 *)
 
 \end{chunk}
@@ -27168,6 +36407,7 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where
       ++ tanQ(q,a) is a local function with a conditional implementation.
 
   Implementation ==> add
+
     import TangentExpansions F
     import IntegrationTools(R, F)
     import IntegerLinearDependence F
@@ -27212,19 +36452,30 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where
     mpiover2:F := pi()$F / (-2::F)
 
     realElem(f, l)       == smpElem(numer f, l) / smpElem(denom f, l)
+
     realElementary(f, x) == realElem(f, [x])
+
     realElementary f     == realElem(f, variables f)
+
     toY ker              == [func for k in ker | (func := ktoY k) ^= 0]
+
     toZ ker              == [func for k in ker | (func := ktoZ k) ^= 0]
+
     toU ker              == [func for k in ker | (func := ktoU k) ^= 0]
+
     toV ker              == [func for k in ker | (func := ktoV k) ^= 0]
+
     rtNormalize f        == rootNormalize0(f).func
+
     toR(ker, x) == select(s+->is?(s, NTHR) and first argument(s) = x, ker)
 
     if R has GcdDomain then
+
       tanQ(c, x) ==
         tanNa(rootSimp zeroOf tanAn(x, denom(c)::PositiveInteger), numer c)
+
     else
+
       tanQ(c, x) ==
         tanNa(zeroOf tanAn(x, denom(c)::PositiveInteger), numer c)
 
@@ -27322,7 +36573,8 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where
       is?(k, "csc"::SY)   => (1 + tz2**2) / (2 * tz2)
       op args
 
---The next 5 functions are used by normalize, once a relation is found
+    --The next 5 functions are used by normalize, once a relation is found
+
     depeval(f, lk, k, v) ==
       is?(k, "log"::SY)  => logeval(f, lk, k, v)
       is?(k, "exp"::SY)  => expeval(f, lk, k, v)
@@ -27409,7 +36661,8 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where
       z := first argument k
       c := z / (*/[x**qelt(v, i)
                    for x in toZ lk for i in minIndex v .. maxIndex v])
--- CHANGED log ktoZ x TO ktoY x SINCE WE WANT log exp f TO BE REPLACED BY f.
+      -- CHANGED log ktoZ x TO ktoY x 
+      -- SINCE WE WANT log exp f TO BE REPLACED BY f.
       g := +/[qelt(v, i) * x
               for i in minIndex v .. maxIndex v for x in toY lk] + log c
       [eval(f, [k], [g]), [k], [g]]
@@ -27470,7 +36723,7 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where
     expeval(f, lk, k, v) ==
       y   := first argument k
       fns := toY lk
-      g := y - +/[qelt(v, i) * z for i in minIndex v .. maxIndex v for z in fns]
+      g:= y - +/[qelt(v, i) * z for i in minIndex v .. maxIndex v for z in fns]
       (rec := goodCoef(v, lk, "exp"::SY)) case "failed" =>
         expnosimp(f, lk, k, v, fns, exp g)
       v0 := retract(inv qelt(v, rec.index))@Z
@@ -27482,6 +36735,7 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where
       [eval(f, [rec.ker], [h]), [rec.ker], [h]]
 
     if F has CombinatorialOpsCategory then
+
       normalize f == rtNormalize localnorm factorials realElementary f
 
       normalize(f, x) ==
@@ -27497,270 +36751,627 @@ ElementaryFunctionStructurePackage(R,F): Exports == Implementation where
         [true]
 
     else
+
       normalize f     == rtNormalize localnorm realElementary f
-      normalize(f, x) == rtNormalize(rischNormalize(realElementary(f,x),x).func)
+
+      normalize(f, x)== rtNormalize(rischNormalize(realElementary(f,x),x).func)
 
 \end{chunk}
 
 \begin{chunk}{COQ EFSTRUC}
 (* package EFSTRUC *)
 (*
-*)
-
-\end{chunk}
-
-\begin{chunk}{EFSTRUC.dotabb}
-"EFSTRUC" [color="#FF4488",href="bookvol10.4.pdf#nameddest=EFSTRUC"]
-"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"]
-"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
-"EFSTRUC" -> "ACF"
-"EFSTRUC" -> "FS"
-
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{package INTEF ElementaryIntegration}
-\begin{chunk}{ElementaryIntegration.input}
-)set break resume
-)sys rm -f ElementaryIntegration.output
-)spool ElementaryIntegration.output
-)set message test on
-)set message auto off
-)clear all
 
---S 1 of 1
-)show ElementaryIntegration
---R 
---R ElementaryIntegration(R: Join(GcdDomain,OrderedSet,CharacteristicZero,RetractableTo(Integer),LinearlyExplicitRingOver(Integer)),F: Join(AlgebraicallyClosedField,TranscendentalFunctionCategory,FunctionSpace(R)))  is a package constructor
---R Abbreviation for ElementaryIntegration is INTEF 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.4.pamphlet to see algebra source code for INTEF 
---R
---R------------------------------- Operations --------------------------------
---R lfextendedint : (F,Symbol,F) -> Union(Record(ratpart: F,coeff: F),"failed")
---R lfextlimint : (F,Symbol,Kernel(F),List(Kernel(F))) -> Union(Record(ratpart: F,coeff: F),"failed")
---R lfinfieldint : (F,Symbol) -> Union(F,"failed")
---R lfintegrate : (F,Symbol) -> IntegrationResult(F)
---R lflimitedint : (F,Symbol,List(F)) -> Union(Record(mainpart: F,limitedlogs: List(Record(coeff: F,logand: F))),"failed")
---R
---E 1
+    import TangentExpansions F
+    import IntegrationTools(R, F)
+    import IntegerLinearDependence F
+    import AlgebraicManipulations(R, F)
+    import InnerCommonDenominator(Z, Q, Vector Z, Vector Q)
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{ElementaryIntegration.help}
-====================================================================
-ElementaryIntegration examples
-====================================================================
+    k2Elem             : (K, List SY) -> F
+    realElem           : (F, List SY) -> F
+    smpElem            : (SMP, List SY) -> F
+    deprel             : (List K, K, SY) -> U
+    rootDep            : (List K, K)     -> U
+    qdeprel            : (List F, F)     -> U
+    factdeprel         : (List K, K)     -> U
+    toR                : (List K, F) -> List K
+    toY                : List K -> List F
+    toZ                : List K -> List F
+    toU                : List K -> List F
+    toV                : List K -> List F
+    ktoY               : K  -> F
+    ktoZ               : K  -> F
+    ktoU               : K  -> F
+    ktoV               : K  -> F
+    gdCoef?            : (Q, Vector Q) -> Boolean
+    goodCoef           : (Vector Q, List K, SY) ->
+                                 Union(Record(index:Z, ker:K), "failed")
+    tanRN              : (Q, K) -> F
+    localnorm          : F -> F
+    rooteval           : (F, List K, K, Q) -> REC
+    logeval            : (F, List K, K, Vector Q) -> REC
+    expeval            : (F, List K, K, Vector Q) -> REC
+    taneval            : (F, List K, K, Vector Q) -> REC
+    ataneval           : (F, List K, K, Vector Q) -> REC
+    depeval            : (F, List K, K, Vector Q) -> REC
+    expnosimp          : (F, List K, K, Vector Q, List F, F) -> REC
+    tannosimp          : (F, List K, K, Vector Q, List F, F) -> REC
+    rtNormalize        : F -> F
+    rootNormalize0     : F -> REC
+    rootKernelNormalize: (F, List K, K) -> Union(REC, "failed")
+    tanSum             : (F, List F) -> F
 
-This package provides functions for integration, limited integration,
-extended integration and the risch differential equation for
-elementary functions.
+    comb?     := F has CombinatorialOpsCategory
+    mpiover2:F := pi()$F / (-2::F)
 
-See Also:
-o )show ElementaryIntegration
+    realElem(f, l)       == smpElem(numer f, l) / smpElem(denom f, l)
 
-\end{chunk}
-\pagehead{ElementaryIntegration}{INTEF}
-\pagepic{ps/v104elementaryintegration.ps}{INTEF}{1.00}
+    realElementary(f, x) == realElem(f, [x])
 
-{\bf Exports:}\\
-\begin{tabular}{lllll}
-\cross{INTEF}{lfextendedint} &
-\cross{INTEF}{lfextlimint} &
-\cross{INTEF}{lfinfieldint} &
-\cross{INTEF}{lfintegrate} &
-\cross{INTEF}{lflimitedint} 
-\end{tabular}
+    realElementary f     == realElem(f, variables f)
 
-\begin{chunk}{package INTEF ElementaryIntegration}
-)abbrev package INTEF ElementaryIntegration
-++ Author: Manuel Bronstein
-++ Date Created: 1 February 1988
-++ Date Last Updated: 24 October 1995
-++ Description:
-++ This package provides functions for integration, limited integration,
-++ extended integration and the risch differential equation for
-++ elementary functions.
+    toY ker              == [func for k in ker | (func := ktoY k) ^= 0]
 
-ElementaryIntegration(R, F): Exports == Implementation where
-  R : Join(GcdDomain, OrderedSet, CharacteristicZero,
-           RetractableTo Integer, LinearlyExplicitRingOver Integer)
-  F : Join(AlgebraicallyClosedField, TranscendentalFunctionCategory,
-           FunctionSpace R)
+    toZ ker              == [func for k in ker | (func := ktoZ k) ^= 0]
 
-  SE     ==> Symbol
-  K      ==> Kernel F
-  P      ==> SparseMultivariatePolynomial(R, K)
-  UP     ==> SparseUnivariatePolynomial F
-  RF     ==> Fraction UP
-  IR     ==> IntegrationResult F
-  FF     ==> Record(ratpart:RF, coeff:RF)
-  LLG    ==> List Record(coeff:F, logand:F)
-  U2     ==> Union(Record(ratpart:F, coeff:F), "failed")
-  U3     ==> Union(Record(mainpart:F, limitedlogs:LLG), "failed")
-  ANS    ==> Record(special:F, integrand:F)
-  PSOL   ==> Record(ans:F, right:F, sol?:Boolean)
-  FAIL   ==> error "failed - cannot handle that integrand"
-  ALGOP  ==> "%alg"
-  OPDIFF ==> "%diff"::SE
+    toU ker              == [func for k in ker | (func := ktoU k) ^= 0]
 
-  Exports ==> with
-    lfextendedint: (F, SE, F) -> U2
-       ++ lfextendedint(f, x, g) returns functions \spad{[h, c]} such that
-       ++ \spad{dh/dx = f - cg}, if (h, c) exist, "failed" otherwise.
-    lflimitedint : (F, SE, List F) -> U3
-       ++ lflimitedint(f,x,[g1,...,gn]) returns functions \spad{[h,[[ci, gi]]]}
-       ++ such that the gi's are among \spad{[g1,...,gn]}, and
-       ++ \spad{d(h+sum(ci log(gi)))/dx = f}, if possible, "failed" otherwise.
-    lfinfieldint : (F, SE) -> Union(F, "failed")
-       ++ lfinfieldint(f, x) returns a function g such that \spad{dg/dx = f}
-       ++ if g exists, "failed" otherwise.
-    lfintegrate  : (F, SE) -> IR
-       ++ lfintegrate(f, x) = g such that \spad{dg/dx = f}.
-    lfextlimint  : (F, SE, K, List K) -> U2
-       ++ lfextlimint(f,x,k,[k1,...,kn]) returns functions \spad{[h, c]}
-       ++ such that \spad{dh/dx = f - c dk/dx}. Value h is looked for in a field
-       ++ containing f and k1,...,kn (the ki's must be logs).
+    toV ker              == [func for k in ker | (func := ktoV k) ^= 0]
 
-  Implementation ==> add
-    import IntegrationTools(R, F)
-    import ElementaryRischDE(R, F)
-    import RationalIntegration(F, UP)
-    import AlgebraicIntegration(R, F)
-    import AlgebraicManipulations(R, F)
-    import ElementaryRischDESystem(R, F)
-    import TranscendentalIntegration(F, UP)
-    import PureAlgebraicIntegration(R, F, F)
-    import IntegrationResultFunctions2(F, F)
-    import IntegrationResultFunctions2(RF, F)
-    import FunctionSpacePrimitiveElement(R, F)
-    import PolynomialCategoryQuotientFunctions(IndexedExponents K,
-                                                             K, R, P, F)
+    rtNormalize f        == rootNormalize0(f).func
 
-    alglfint    : (F, K, List K, SE) -> IR
-    alglfextint : (F, K, List K, SE, F) -> U2
-    alglflimint : (F, K, List K, SE, List F) -> U3
-    primextint  : (F, SE, K, F) -> U2
-    expextint   : (F, SE, K, F) -> U2
-    primlimint  : (F, SE, K, List F) -> U3
-    explimint   : (F, SE, K, List F) -> U3
-    algprimint  : (F, K, K, SE) -> IR
-    algexpint   : (F, K, K, SE) -> IR
-    primint     : (F, SE, K) -> IR
-    expint      : (F, SE, K) -> IR
-    tanint      : (F, SE, K) -> IR
-    prim?       : (K, SE)  -> Boolean
-    isx?        : (F, SE)  -> Boolean
-    addx        : (IR, F) -> IR
-    cfind       : (F, LLG) -> F
-    lfintegrate0: (F, SE) -> IR
-    unknownint  : (F, SE) -> IR
-    unkextint   : (F, SE, F) -> U2
-    unklimint   : (F, SE, List F) -> U3
-    tryChangeVar: (F, K, SE) -> Union(IR, "failed")
-    droponex    : (F, F, K, F) -> Union(F, "failed")
+    toR(ker, x) == select(s+->is?(s, NTHR) and first argument(s) = x, ker)
 
-    prim?(k, x)      == is?(k, "log"::SE) or has?(operator k, "prim")
+    if R has GcdDomain then
 
-    tanint(f, x, k) ==
-      eta' := differentiate(eta := first argument k, x)
-      r1  := 
-       tanintegrate(univariate(f, k), 
-        (x1:UP):UP +-> differentiate(x1,
-         (x2:F):F +-> differentiate(x2, x), 
-          monomial(eta', 2) + eta'::UP),
-           (x3:Integer,x4:F,x5:F):Union(List F,"failed") +->
-             rischDEsys(x3, 2 * eta, x4, x5, x, 
-              (x6:F,x7:List F):U3 +-> lflimitedint(x6, x, x7),
-               (x8:F,x9:F):U2 +-> lfextendedint(x8, x, x9)))
-      map((x1:RF):F+->multivariate(x1, k), r1.answer) + lfintegrate(r1.a0, x)
+      tanQ(c, x) ==
+        tanNa(rootSimp zeroOf tanAn(x, denom(c)::PositiveInteger), numer c)
 
--- tries various tricks since the integrand contains something not elementary
-    unknownint(f, x) ==
-      ((r := retractIfCan(f)@Union(K, "failed")) case K) and
-        is?(k := r::K, OPDIFF) and
-         ((ka:=retractIfCan(a:=second(l:=argument k))@Union(K,"failed"))case K)
-           and ((z := retractIfCan(zz := third l)@Union(SE, "failed")) case SE)
-              and (z::SE = x)
-                and ((u := droponex(first l, a, ka, zz)) case F) => u::F::IR
-      (da := differentiate(a := denom(f)::F, x)) ^= 0 and
-        zero? differentiate(c := numer(f)::F / da, x) => (c * log a)::IR
-      mkAnswer(0, empty(), [[f, x::F]])
+    else
 
-    droponex(f, a, ka, x) ==
-      (r := retractIfCan(f)@Union(K, "failed")) case "failed" => "failed"
-      is?(op := operator(k := r::K), OPDIFF) =>
-        (z := third(arg := argument k)) = a => op [first arg, second arg, x]
-        (u := droponex(first arg, a, ka, x)) case "failed" => "failed"
-        op [u::F, second arg, z]
-      eval(f, [ka], [x])
+      tanQ(c, x) ==
+        tanNa(zeroOf tanAn(x, denom(c)::PositiveInteger), numer c)
 
-    unklimint(f, x, lu) ==
-      for u in lu | u ^= 0 repeat
-        zero? differentiate(c := f * u / differentiate(u, x), x) => [0,[[c,u]]]
-      "failed"
+    -- tanSum(c, [a1,...,an]) returns f(c, a1,...,an) such that
+    -- if ai = tan(ui) then f(c, a1,...,an) = tan(c + u1 + ... + un).
+    -- MUST BE CAREFUL FOR WHEN c IS AN ODD MULTIPLE of pi/2
+    tanSum(c, l) ==
+      k := c / mpiover2        -- k = - 2 c / pi, check for odd integer
+                               -- tan((2n+1) pi/2 x) = - 1 / tan x
+      (r := retractIfCan(k)@Union(Z, "failed")) case Z and odd?(r::Z) =>
+           - inv tanSum l
+      tanSum concat(tan c, l)
 
-    unkextint(f, x, g) ==
-      zero?(g' := differentiate(g, x)) => "failed"
-      zero? differentiate(c := f / g', x) => [0, c]
-      "failed"
+    rootNormalize0 f ==
+      ker := select_!(s+->is?(s, NTHR) and empty? variables first argument s,
+                      tower f)$List(K)
+      empty? ker => [f, empty(), empty()]
+      (n := (#ker)::Z - 1) < 1 => [f, empty(), empty()]
+      for i in 1..n for kk in rest ker repeat
+        (u := rootKernelNormalize(f, first(ker, i), kk)) case REC =>
+          rec := u::REC
+          rn  := rootNormalize0(rec.func)
+          return [rn.func, concat(rec.kers,rn.kers), concat(rec.vals, rn.vals)]
+      [f, empty(), empty()]
 
-    isx?(f, x) ==
-      (k := retractIfCan(f)@Union(K, "failed")) case "failed" => false
-      (r := symbolIfCan(k::K)) case "failed" => false
-      r::SE = x
+    deprel(ker, k, x) ==
+      is?(k, "log"::SY) or is?(k, "exp"::SY) =>
+        qdeprel([differentiate(g, x) for g in toY ker],
+                 differentiate(ktoY k, x))
+      is?(k, "atan"::SY) or is?(k, "tan"::SY) =>
+        qdeprel([differentiate(g, x) for g in toU ker],
+                 differentiate(ktoU k, x))
+      is?(k, NTHR) => rootDep(ker, k)
+      comb? and is?(k, "factorial"::SY) =>
+        factdeprel([x for x in ker | is?(x,"factorial"::SY) and x^=k],k)
+      [true]
 
-    alglfint(f, k, l, x) ==
-      xf := x::F
-      symbolIfCan(kx := ksec(k,l,x)) case SE => addx(palgint(f, kx, k), xf)
-      is?(kx, "exp"::SE) => addx(algexpint(f, kx, k, x), xf)
-      prim?(kx, x)       => addx(algprimint(f, kx, k, x), xf)
-      has?(operator kx, ALGOP) =>
-        rec := primitiveElement(kx::F, k::F)
-        y   := rootOf(rec.prim)
-        map((x1:F):F +-> eval(x1, retract(y)@K, rec.primelt),
-          lfintegrate(eval(f, [kx,k], [(rec.pol1) y, (rec.pol2) y]), x))
-      unknownint(f, x)
+    ktoY k ==
+      is?(k, "log"::SY) => k::F
+      is?(k, "exp"::SY) => first argument k
+      0
 
-    alglfextint(f, k, l, x, g) ==
-      symbolIfCan(kx := ksec(k,l,x)) case SE => palgextint(f, kx, k, g)
-      has?(operator kx, ALGOP) =>
-        rec := primitiveElement(kx::F, k::F)
-        y   := rootOf(rec.prim)
-        lrhs := [(rec.pol1) y, (rec.pol2) y]$List(F)
-        (u := lfextendedint(eval(f, [kx, k], lrhs), x,
-                    eval(g, [kx, k], lrhs))) case "failed" => "failed"
-        ky := retract(y)@K
-        r := u::Record(ratpart:F, coeff:F)
-        [eval(r.ratpart,ky,rec.primelt), eval(r.coeff,ky,rec.primelt)]
-      is?(kx, "exp"::SE) or is?(kx, "log"::SE) => FAIL
-      unkextint(f, x, g)
+    ktoZ k ==
+      is?(k, "log"::SY) => first argument k
+      is?(k, "exp"::SY) => k::F
+      0
 
-    alglflimint(f, k, l, x, lu) ==
-      symbolIfCan(kx := ksec(k,l,x)) case SE => palglimint(f, kx, k, lu)
-      has?(operator kx, ALGOP) =>
-        rec := primitiveElement(kx::F, k::F)
-        y   := rootOf(rec.prim)
-        lrhs := [(rec.pol1) y, (rec.pol2) y]$List(F)
-        (u := lflimitedint(eval(f, [kx, k], lrhs), x,
-          map((x1:F):F+->eval(x1,[kx, k],lrhs), lu))) case "failed" => "failed"
-        ky := retract(y)@K
-        r := u::Record(mainpart:F, limitedlogs:LLG)
-        [eval(r.mainpart, ky, rec.primelt),
-          [[eval(rc.coeff, ky, rec.primelt),
-            eval(rc.logand,ky, rec.primelt)] for rc in r.limitedlogs]]
-      is?(kx, "exp"::SE) or is?(kx, "log"::SE) => FAIL
-      unklimint(f, x, lu)
+    ktoU k ==
+      is?(k, "atan"::SY) => k::F
+      is?(k,  "tan"::SY) => first argument k
+      0
 
-    if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer)
-      and F has Join(LiouvillianFunctionCategory, RetractableTo SE) then
-        import PatternMatchIntegration(R, F)
-        lfintegrate(f, x) == intPatternMatch(f, x, lfintegrate0, pmintegrate)
+    ktoV k ==
+      is?(k,  "tan"::SY) => k::F
+      is?(k, "atan"::SY) => first argument k
+      0
 
-    else lfintegrate(f, x) == lfintegrate0(f, x)
+    smpElem(p, l) ==
+      map(x+->k2Elem(x, l), y+->y::F, p)_
+       $PolynomialCategoryLifting(IndexedExponents K, K, R, SMP, F)
 
-    lfintegrate0(f, x) ==
-      zero? f => 0
+    k2Elem(k, l) ==
+      ez, iez, tz2: F
+      kf := k::F
+      not(empty? l) and empty? [v for v in variables kf | member?(v, l)] => kf
+      empty?(args :List F := [realElem(a, l) for a in argument k]) => kf
+      z := first args
+      is?(k, POWER)       => (zero? z => 0; exp(last(args) * log z))
+      is?(k, "cot"::SY)   => inv tan z
+      is?(k, "acot"::SY)  => atan inv z
+      is?(k, "asin"::SY)  => atan(z / sqrt(1 - z**2))
+      is?(k, "acos"::SY)  => atan(sqrt(1 - z**2) / z)
+      is?(k, "asec"::SY)  => atan sqrt(1 - z**2)
+      is?(k, "acsc"::SY)  => atan inv sqrt(1 - z**2)
+      is?(k, "asinh"::SY) => log(sqrt(1 + z**2) + z)
+      is?(k, "acosh"::SY) => log(sqrt(z**2 - 1) + z)
+      is?(k, "atanh"::SY) => log((z + 1) / (1 - z)) / (2::F)
+      is?(k, "acoth"::SY) => log((z + 1) / (z - 1)) / (2::F)
+      is?(k, "asech"::SY) => log((inv z) + sqrt(inv(z**2) - 1))
+      is?(k, "acsch"::SY) => log((inv z) + sqrt(1 + inv(z**2)))
+      is?(k, "%paren"::SY) or is?(k, "%box"::SY) =>
+        empty? rest args => z
+        kf
+      if has?(op := operator k, "htrig") then iez  := inv(ez  := exp z)
+      is?(k, "sinh"::SY)  => (ez - iez) / (2::F)
+      is?(k, "cosh"::SY)  => (ez + iez) / (2::F)
+      is?(k, "tanh"::SY)  => (ez - iez) / (ez + iez)
+      is?(k, "coth"::SY)  => (ez + iez) / (ez - iez)
+      is?(k, "sech"::SY)  => 2 * inv(ez + iez)
+      is?(k, "csch"::SY)  => 2 * inv(ez - iez)
+      if has?(op, "trig") then tz2  := tan(z / (2::F))
+      is?(k, "sin"::SY)   => 2 * tz2 / (1 + tz2**2)
+      is?(k, "cos"::SY)   => (1 - tz2**2) / (1 + tz2**2)
+      is?(k, "sec"::SY)   => (1 + tz2**2) / (1 - tz2**2)
+      is?(k, "csc"::SY)   => (1 + tz2**2) / (2 * tz2)
+      op args
+
+    --The next 5 functions are used by normalize, once a relation is found
+
+    depeval(f, lk, k, v) ==
+      is?(k, "log"::SY)  => logeval(f, lk, k, v)
+      is?(k, "exp"::SY)  => expeval(f, lk, k, v)
+      is?(k, "tan"::SY)  => taneval(f, lk, k, v)
+      is?(k, "atan"::SY) => ataneval(f, lk, k, v)
+      is?(k, NTHR) => rooteval(f, lk, k, v(minIndex v))
+      [f, empty(), empty()]
+
+    rooteval(f, lk, k, n) ==
+      nv := nthRoot(x := first argument k, m := retract(n)@Z)
+      l  := [r for r in concat(k, toR(lk, x)) |
+             retract(second argument r)@Z ^= m]
+      lv := [nv ** (n / (retract(second argument r)@Z::Q)) for r in l]
+      [eval(f, l, lv), l, lv]
+
+    ataneval(f, lk, k, v) ==
+      w := first argument k
+      s := tanSum [tanQ(qelt(v,i), x)
+                   for i in minIndex v .. maxIndex v for x in toV lk]
+      g := +/[qelt(v, i) * x for i in minIndex v .. maxIndex v for x in toU lk]
+      h:F :=
+        zero?(d := 1 + s * w) => mpiover2
+        atan((w - s) / d)
+      g := g + h
+      [eval(f, [k], [g]), [k], [g]]
+
+    gdCoef?(c, v) ==
+      for i in minIndex v .. maxIndex v repeat
+        retractIfCan(qelt(v, i) / c)@Union(Z, "failed") case "failed" =>
+          return false
+      true
+
+    goodCoef(v, l, s) ==
+      for i in minIndex v .. maxIndex v for k in l repeat
+        is?(k, s) and
+           ((r:=recip(qelt(v,i))) case Q) and
+            (retractIfCan(r::Q)@Union(Z, "failed") case Z)
+              and gdCoef?(qelt(v, i), v) => return([i, k])
+      "failed"
+
+    taneval(f, lk, k, v) ==
+      u := first argument k
+      fns := toU lk
+      c := u - +/[qelt(v, i)*x for i in minIndex v .. maxIndex v for x in fns]
+      (rec := goodCoef(v, lk, "tan"::SY)) case "failed" =>
+          tannosimp(f, lk, k, v, fns, c)
+      v0 := retract(inv qelt(v, rec.index))@Z
+      lv := [qelt(v, i) for i in minIndex v .. maxIndex v |
+                                                 i ^= rec.index]$List(Q)
+      l  := [kk for kk in lk | kk ^= rec.ker]
+      g := tanSum(-v0 * c, concat(tanNa(k::F, v0),
+           [tanNa(x, - retract(a * v0)@Z) for a in lv for x in toV l]))
+      [eval(f, [rec.ker], [g]), [rec.ker], [g]]
+
+    tannosimp(f, lk, k, v, fns, c) ==
+      every?(x+->is?(x, "tan"::SY), lk) =>
+        dd := (d := (cd := splitDenominator v).den)::F
+        newt := [tan(u / dd) for u in fns]$List(F)
+        newtan := [tanNa(t, d) for t in newt]$List(F)
+        h := tanSum(c, [tanNa(t, qelt(cd.num, i))
+                        for i in minIndex v .. maxIndex v for t in newt])
+        lk := concat(k, lk)
+        newtan := concat(h, newtan)
+        [eval(f, lk, newtan), lk, newtan]
+      h := tanSum(c, [tanQ(qelt(v, i), x)
+                      for i in minIndex v .. maxIndex v for x in toV lk])
+      [eval(f, [k], [h]), [k], [h]]
+
+    expnosimp(f, lk, k, v, fns, g) ==
+      every?(x+->is?(x, "exp"::SY), lk) =>
+        dd := (d := (cd := splitDenominator v).den)::F
+        newe := [exp(y / dd) for y in fns]$List(F)
+        newexp := [e ** d for e in newe]$List(F)
+        h := */[e ** qelt(cd.num, i)
+                for i in minIndex v .. maxIndex v for e in newe] * g
+        lk := concat(k, lk)
+        newexp := concat(h, newexp)
+        [eval(f, lk, newexp), lk, newexp]
+      h := */[exp(y) ** qelt(v, i)
+                for i in minIndex v .. maxIndex v for y in fns] * g
+      [eval(f, [k], [h]), [k], [h]]
+
+    logeval(f, lk, k, v) ==
+      z := first argument k
+      c := z / (*/[x**qelt(v, i)
+                   for x in toZ lk for i in minIndex v .. maxIndex v])
+      -- CHANGED log ktoZ x TO ktoY x 
+      -- SINCE WE WANT log exp f TO BE REPLACED BY f.
+      g := +/[qelt(v, i) * x
+              for i in minIndex v .. maxIndex v for x in toY lk] + log c
+      [eval(f, [k], [g]), [k], [g]]
+
+    rischNormalize(f, v) ==
+      empty?(ker := varselect(tower f, v)) => [f, empty(), empty()]
+      first(ker) ^= kernel(v)@K => error "Cannot happen"
+      ker := rest ker
+      (n := (#ker)::Z - 1) < 1 => [f, empty(), empty()]
+      for i in 1..n for kk in rest ker repeat
+        klist := first(ker, i)
+        -- NO EVALUATION ON AN EMPTY VECTOR, WILL CAUSE INFINITE LOOP
+        (c := deprel(klist, kk, v)) case vec and not empty?(c.vec) =>
+          rec := depeval(f, klist, kk, c.vec)
+          rn  := rischNormalize(rec.func, v)
+          return [rn.func,
+                   concat(rec.kers, rn.kers), concat(rec.vals, rn.vals)]
+        c case func =>
+          rn := rischNormalize(eval(f, [kk], [c.func]), v)
+          return [rn.func, concat(kk, rn.kers), concat(c.func, rn.vals)]
+      [f, empty(), empty()]
+
+    rootNormalize(f, k) ==
+      (u := rootKernelNormalize(f, toR(tower f, first argument k), k))
+         case "failed" => f
+      (u::REC).func
+
+    rootKernelNormalize(f, l, k) ==
+      (c := rootDep(l, k)) case vec =>
+        rooteval(f, l, k, (c.vec)(minIndex(c.vec)))
+      "failed"
+
+    localnorm f ==
+      for x in variables f repeat
+        f := rischNormalize(f, x).func
+      f
+
+    validExponential(twr, eta, x) ==
+      (c := solveLinearlyOverQ(construct([differentiate(g, x)
+         for g in (fns := toY twr)]$List(F))@Vector(F),
+           differentiate(eta, x))) case "failed" => "failed"
+      v := c::Vector(Q)
+      g := eta - +/[qelt(v, i) * yy
+                        for i in minIndex v .. maxIndex v for yy in fns]
+      */[exp(yy) ** qelt(v, i)
+                for i in minIndex v .. maxIndex v for yy in fns] * exp g
+
+    rootDep(ker, k) ==
+      empty?(ker := toR(ker, first argument k)) => [true]
+      [new(1,lcm(retract(second argument k)@Z,
+       "lcm"/[retract(second argument r)@Z for r in ker])::Q)$Vector(Q)]
+
+    qdeprel(l, v) ==
+      (u := solveLinearlyOverQ(construct(l)@Vector(F), v))
+        case Vector(Q) => [u::Vector(Q)]
+      [true]
+
+    expeval(f, lk, k, v) ==
+      y   := first argument k
+      fns := toY lk
+      g:= y - +/[qelt(v, i) * z for i in minIndex v .. maxIndex v for z in fns]
+      (rec := goodCoef(v, lk, "exp"::SY)) case "failed" =>
+        expnosimp(f, lk, k, v, fns, exp g)
+      v0 := retract(inv qelt(v, rec.index))@Z
+      lv := [qelt(v, i) for i in minIndex v .. maxIndex v |
+                                                 i ^= rec.index]$List(Q)
+      l  := [kk for kk in lk | kk ^= rec.ker]
+      h :F := */[exp(z) ** (- retract(a * v0)@Z) for a in lv for z in toY l]
+      h := h * exp(-v0 * g) * (k::F) ** v0
+      [eval(f, [rec.ker], [h]), [rec.ker], [h]]
+
+    if F has CombinatorialOpsCategory then
+
+      normalize f == rtNormalize localnorm factorials realElementary f
+
+      normalize(f, x) ==
+        rtNormalize(rischNormalize(factorials(realElementary(f,x),x),x).func)
+
+      factdeprel(l, k) ==
+        ((r := retractIfCan(n := first argument k)@Union(Z, "failed"))
+          case Z) and (r::Z > 0) => [factorial(r::Z)::F]
+        for x in l repeat
+          m := first argument x
+          ((r := retractIfCan(n - m)@Union(Z, "failed")) case Z) and
+            (r::Z > 0) => return([*/[(m + i::F) for i in 1..r] * x::F])
+        [true]
+
+    else
+
+      normalize f     == rtNormalize localnorm realElementary f
+
+      normalize(f, x)== rtNormalize(rischNormalize(realElementary(f,x),x).func)
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{EFSTRUC.dotabb}
+"EFSTRUC" [color="#FF4488",href="bookvol10.4.pdf#nameddest=EFSTRUC"]
+"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"]
+"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
+"EFSTRUC" -> "ACF"
+"EFSTRUC" -> "FS"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{package INTEF ElementaryIntegration}
+\begin{chunk}{ElementaryIntegration.input}
+)set break resume
+)sys rm -f ElementaryIntegration.output
+)spool ElementaryIntegration.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show ElementaryIntegration
+--R 
+--R ElementaryIntegration(R: Join(GcdDomain,OrderedSet,CharacteristicZero,RetractableTo(Integer),LinearlyExplicitRingOver(Integer)),F: Join(AlgebraicallyClosedField,TranscendentalFunctionCategory,FunctionSpace(R)))  is a package constructor
+--R Abbreviation for ElementaryIntegration is INTEF 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.4.pamphlet to see algebra source code for INTEF 
+--R
+--R------------------------------- Operations --------------------------------
+--R lfextendedint : (F,Symbol,F) -> Union(Record(ratpart: F,coeff: F),"failed")
+--R lfextlimint : (F,Symbol,Kernel(F),List(Kernel(F))) -> Union(Record(ratpart: F,coeff: F),"failed")
+--R lfinfieldint : (F,Symbol) -> Union(F,"failed")
+--R lfintegrate : (F,Symbol) -> IntegrationResult(F)
+--R lflimitedint : (F,Symbol,List(F)) -> Union(Record(mainpart: F,limitedlogs: List(Record(coeff: F,logand: F))),"failed")
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{ElementaryIntegration.help}
+====================================================================
+ElementaryIntegration examples
+====================================================================
+
+This package provides functions for integration, limited integration,
+extended integration and the risch differential equation for
+elementary functions.
+
+See Also:
+o )show ElementaryIntegration
+
+\end{chunk}
+\pagehead{ElementaryIntegration}{INTEF}
+\pagepic{ps/v104elementaryintegration.ps}{INTEF}{1.00}
+
+{\bf Exports:}\\
+\begin{tabular}{lllll}
+\cross{INTEF}{lfextendedint} &
+\cross{INTEF}{lfextlimint} &
+\cross{INTEF}{lfinfieldint} &
+\cross{INTEF}{lfintegrate} &
+\cross{INTEF}{lflimitedint} 
+\end{tabular}
+
+\begin{chunk}{package INTEF ElementaryIntegration}
+)abbrev package INTEF ElementaryIntegration
+++ Author: Manuel Bronstein
+++ Date Created: 1 February 1988
+++ Date Last Updated: 24 October 1995
+++ Description:
+++ This package provides functions for integration, limited integration,
+++ extended integration and the risch differential equation for
+++ elementary functions.
+
+ElementaryIntegration(R, F): Exports == Implementation where
+  R : Join(GcdDomain, OrderedSet, CharacteristicZero,
+           RetractableTo Integer, LinearlyExplicitRingOver Integer)
+  F : Join(AlgebraicallyClosedField, TranscendentalFunctionCategory,
+           FunctionSpace R)
+
+  SE     ==> Symbol
+  K      ==> Kernel F
+  P      ==> SparseMultivariatePolynomial(R, K)
+  UP     ==> SparseUnivariatePolynomial F
+  RF     ==> Fraction UP
+  IR     ==> IntegrationResult F
+  FF     ==> Record(ratpart:RF, coeff:RF)
+  LLG    ==> List Record(coeff:F, logand:F)
+  U2     ==> Union(Record(ratpart:F, coeff:F), "failed")
+  U3     ==> Union(Record(mainpart:F, limitedlogs:LLG), "failed")
+  ANS    ==> Record(special:F, integrand:F)
+  PSOL   ==> Record(ans:F, right:F, sol?:Boolean)
+  FAIL   ==> error "failed - cannot handle that integrand"
+  ALGOP  ==> "%alg"
+  OPDIFF ==> "%diff"::SE
+
+  Exports ==> with
+    lfextendedint: (F, SE, F) -> U2
+       ++ lfextendedint(f, x, g) returns functions \spad{[h, c]} such that
+       ++ \spad{dh/dx = f - cg}, if (h, c) exist, "failed" otherwise.
+    lflimitedint : (F, SE, List F) -> U3
+       ++ lflimitedint(f,x,[g1,...,gn]) returns functions \spad{[h,[[ci, gi]]]}
+       ++ such that the gi's are among \spad{[g1,...,gn]}, and
+       ++ \spad{d(h+sum(ci log(gi)))/dx = f}, if possible, "failed" otherwise.
+    lfinfieldint : (F, SE) -> Union(F, "failed")
+       ++ lfinfieldint(f, x) returns a function g such that \spad{dg/dx = f}
+       ++ if g exists, "failed" otherwise.
+    lfintegrate  : (F, SE) -> IR
+       ++ lfintegrate(f, x) = g such that \spad{dg/dx = f}.
+    lfextlimint  : (F, SE, K, List K) -> U2
+       ++ lfextlimint(f,x,k,[k1,...,kn]) returns functions \spad{[h, c]}
+       ++ such that \spad{dh/dx = f - c dk/dx}. Value h is looked for in a
+       ++ field containing f and k1,...,kn (the ki's must be logs).
+
+  Implementation ==> add
+
+    import IntegrationTools(R, F)
+    import ElementaryRischDE(R, F)
+    import RationalIntegration(F, UP)
+    import AlgebraicIntegration(R, F)
+    import AlgebraicManipulations(R, F)
+    import ElementaryRischDESystem(R, F)
+    import TranscendentalIntegration(F, UP)
+    import PureAlgebraicIntegration(R, F, F)
+    import IntegrationResultFunctions2(F, F)
+    import IntegrationResultFunctions2(RF, F)
+    import FunctionSpacePrimitiveElement(R, F)
+    import PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                                                             K, R, P, F)
+
+    alglfint    : (F, K, List K, SE) -> IR
+    alglfextint : (F, K, List K, SE, F) -> U2
+    alglflimint : (F, K, List K, SE, List F) -> U3
+    primextint  : (F, SE, K, F) -> U2
+    expextint   : (F, SE, K, F) -> U2
+    primlimint  : (F, SE, K, List F) -> U3
+    explimint   : (F, SE, K, List F) -> U3
+    algprimint  : (F, K, K, SE) -> IR
+    algexpint   : (F, K, K, SE) -> IR
+    primint     : (F, SE, K) -> IR
+    expint      : (F, SE, K) -> IR
+    tanint      : (F, SE, K) -> IR
+    prim?       : (K, SE)  -> Boolean
+    isx?        : (F, SE)  -> Boolean
+    addx        : (IR, F) -> IR
+    cfind       : (F, LLG) -> F
+    lfintegrate0: (F, SE) -> IR
+    unknownint  : (F, SE) -> IR
+    unkextint   : (F, SE, F) -> U2
+    unklimint   : (F, SE, List F) -> U3
+    tryChangeVar: (F, K, SE) -> Union(IR, "failed")
+    droponex    : (F, F, K, F) -> Union(F, "failed")
+
+    prim?(k, x)      == is?(k, "log"::SE) or has?(operator k, "prim")
+
+    tanint(f, x, k) ==
+      eta' := differentiate(eta := first argument k, x)
+      r1  := 
+       tanintegrate(univariate(f, k), 
+        (x1:UP):UP +-> differentiate(x1,
+         (x2:F):F +-> differentiate(x2, x), 
+          monomial(eta', 2) + eta'::UP),
+           (x3:Integer,x4:F,x5:F):Union(List F,"failed") +->
+             rischDEsys(x3, 2 * eta, x4, x5, x, 
+              (x6:F,x7:List F):U3 +-> lflimitedint(x6, x, x7),
+               (x8:F,x9:F):U2 +-> lfextendedint(x8, x, x9)))
+      map((x1:RF):F+->multivariate(x1, k), r1.answer) + lfintegrate(r1.a0, x)
+
+    -- tries various tricks since the integrand contains 
+    -- something not elementary
+    unknownint(f, x) ==
+      ((r := retractIfCan(f)@Union(K, "failed")) case K) and
+        is?(k := r::K, OPDIFF) and
+         ((ka:=retractIfCan(a:=second(l:=argument k))@Union(K,"failed"))case K)
+           and ((z := retractIfCan(zz := third l)@Union(SE, "failed")) case SE)
+              and (z::SE = x)
+                and ((u := droponex(first l, a, ka, zz)) case F) => u::F::IR
+      (da := differentiate(a := denom(f)::F, x)) ^= 0 and
+        zero? differentiate(c := numer(f)::F / da, x) => (c * log a)::IR
+      mkAnswer(0, empty(), [[f, x::F]])
+
+    droponex(f, a, ka, x) ==
+      (r := retractIfCan(f)@Union(K, "failed")) case "failed" => "failed"
+      is?(op := operator(k := r::K), OPDIFF) =>
+        (z := third(arg := argument k)) = a => op [first arg, second arg, x]
+        (u := droponex(first arg, a, ka, x)) case "failed" => "failed"
+        op [u::F, second arg, z]
+      eval(f, [ka], [x])
+
+    unklimint(f, x, lu) ==
+      for u in lu | u ^= 0 repeat
+        zero? differentiate(c := f * u / differentiate(u, x), x) => [0,[[c,u]]]
+      "failed"
+
+    unkextint(f, x, g) ==
+      zero?(g' := differentiate(g, x)) => "failed"
+      zero? differentiate(c := f / g', x) => [0, c]
+      "failed"
+
+    isx?(f, x) ==
+      (k := retractIfCan(f)@Union(K, "failed")) case "failed" => false
+      (r := symbolIfCan(k::K)) case "failed" => false
+      r::SE = x
+
+    alglfint(f, k, l, x) ==
+      xf := x::F
+      symbolIfCan(kx := ksec(k,l,x)) case SE => addx(palgint(f, kx, k), xf)
+      is?(kx, "exp"::SE) => addx(algexpint(f, kx, k, x), xf)
+      prim?(kx, x)       => addx(algprimint(f, kx, k, x), xf)
+      has?(operator kx, ALGOP) =>
+        rec := primitiveElement(kx::F, k::F)
+        y   := rootOf(rec.prim)
+        map((x1:F):F +-> eval(x1, retract(y)@K, rec.primelt),
+          lfintegrate(eval(f, [kx,k], [(rec.pol1) y, (rec.pol2) y]), x))
+      unknownint(f, x)
+
+    alglfextint(f, k, l, x, g) ==
+      symbolIfCan(kx := ksec(k,l,x)) case SE => palgextint(f, kx, k, g)
+      has?(operator kx, ALGOP) =>
+        rec := primitiveElement(kx::F, k::F)
+        y   := rootOf(rec.prim)
+        lrhs := [(rec.pol1) y, (rec.pol2) y]$List(F)
+        (u := lfextendedint(eval(f, [kx, k], lrhs), x,
+                    eval(g, [kx, k], lrhs))) case "failed" => "failed"
+        ky := retract(y)@K
+        r := u::Record(ratpart:F, coeff:F)
+        [eval(r.ratpart,ky,rec.primelt), eval(r.coeff,ky,rec.primelt)]
+      is?(kx, "exp"::SE) or is?(kx, "log"::SE) => FAIL
+      unkextint(f, x, g)
+
+    alglflimint(f, k, l, x, lu) ==
+      symbolIfCan(kx := ksec(k,l,x)) case SE => palglimint(f, kx, k, lu)
+      has?(operator kx, ALGOP) =>
+        rec := primitiveElement(kx::F, k::F)
+        y   := rootOf(rec.prim)
+        lrhs := [(rec.pol1) y, (rec.pol2) y]$List(F)
+        (u := lflimitedint(eval(f, [kx, k], lrhs), x,
+          map((x1:F):F+->eval(x1,[kx, k],lrhs), lu))) case "failed" => "failed"
+        ky := retract(y)@K
+        r := u::Record(mainpart:F, limitedlogs:LLG)
+        [eval(r.mainpart, ky, rec.primelt),
+          [[eval(rc.coeff, ky, rec.primelt),
+            eval(rc.logand,ky, rec.primelt)] for rc in r.limitedlogs]]
+      is?(kx, "exp"::SE) or is?(kx, "log"::SE) => FAIL
+      unklimint(f, x, lu)
+
+    if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer)
+      and F has Join(LiouvillianFunctionCategory, RetractableTo SE) then
+
+        import PatternMatchIntegration(R, F)
+
+        lfintegrate(f, x) == intPatternMatch(f, x, lfintegrate0, pmintegrate)
+
+    else
+
+        lfintegrate(f, x) == lfintegrate0(f, x)
+
+    lfintegrate0(f, x) ==
+      zero? f => 0
       xf := x::F
       empty?(l := varselect(kernels f, x)) => (xf * f)::IR
       symbolIfCan(k := kmax l) case SE =>
@@ -27839,6 +37450,7 @@ when integrating rational functions.  It is unclear whether this is
 the correct fix.
 
 \begin{chunk}{package INTEF ElementaryIntegration}
+
     lfextendedint(f, x, g) ==
       empty?(l := varselect(kernels f, x)) => [x::F * f, 0]
       symbolIfCan(k := kmax(l))
@@ -27862,6 +37474,7 @@ This is part of the fix for bug 100. Line 2 of this function used to read:
 \end{verbatim}
 See the above discussion for why this causes an infinite loop.
 \begin{chunk}{package INTEF ElementaryIntegration}
+
     lflimitedint(f, x, lu) ==
       empty?(l := varselect(kernels f, x)) => [x::F * f, empty()]
       symbolIfCan(k := kmax(l)) case SE =>
@@ -27978,6 +37591,314 @@ See the above discussion for why this causes an infinite loop.
 \begin{chunk}{COQ INTEF}
 (* package INTEF *)
 (*
+
+    import IntegrationTools(R, F)
+    import ElementaryRischDE(R, F)
+    import RationalIntegration(F, UP)
+    import AlgebraicIntegration(R, F)
+    import AlgebraicManipulations(R, F)
+    import ElementaryRischDESystem(R, F)
+    import TranscendentalIntegration(F, UP)
+    import PureAlgebraicIntegration(R, F, F)
+    import IntegrationResultFunctions2(F, F)
+    import IntegrationResultFunctions2(RF, F)
+    import FunctionSpacePrimitiveElement(R, F)
+    import PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                                                             K, R, P, F)
+
+    alglfint    : (F, K, List K, SE) -> IR
+    alglfextint : (F, K, List K, SE, F) -> U2
+    alglflimint : (F, K, List K, SE, List F) -> U3
+    primextint  : (F, SE, K, F) -> U2
+    expextint   : (F, SE, K, F) -> U2
+    primlimint  : (F, SE, K, List F) -> U3
+    explimint   : (F, SE, K, List F) -> U3
+    algprimint  : (F, K, K, SE) -> IR
+    algexpint   : (F, K, K, SE) -> IR
+    primint     : (F, SE, K) -> IR
+    expint      : (F, SE, K) -> IR
+    tanint      : (F, SE, K) -> IR
+    prim?       : (K, SE)  -> Boolean
+    isx?        : (F, SE)  -> Boolean
+    addx        : (IR, F) -> IR
+    cfind       : (F, LLG) -> F
+    lfintegrate0: (F, SE) -> IR
+    unknownint  : (F, SE) -> IR
+    unkextint   : (F, SE, F) -> U2
+    unklimint   : (F, SE, List F) -> U3
+    tryChangeVar: (F, K, SE) -> Union(IR, "failed")
+    droponex    : (F, F, K, F) -> Union(F, "failed")
+
+    prim?(k, x)      == is?(k, "log"::SE) or has?(operator k, "prim")
+
+    tanint(f, x, k) ==
+      eta' := differentiate(eta := first argument k, x)
+      r1  := 
+       tanintegrate(univariate(f, k), 
+        (x1:UP):UP +-> differentiate(x1,
+         (x2:F):F +-> differentiate(x2, x), 
+          monomial(eta', 2) + eta'::UP),
+           (x3:Integer,x4:F,x5:F):Union(List F,"failed") +->
+             rischDEsys(x3, 2 * eta, x4, x5, x, 
+              (x6:F,x7:List F):U3 +-> lflimitedint(x6, x, x7),
+               (x8:F,x9:F):U2 +-> lfextendedint(x8, x, x9)))
+      map((x1:RF):F+->multivariate(x1, k), r1.answer) + lfintegrate(r1.a0, x)
+
+    -- tries various tricks since the integrand contains 
+    -- something not elementary
+    unknownint(f, x) ==
+      ((r := retractIfCan(f)@Union(K, "failed")) case K) and
+        is?(k := r::K, OPDIFF) and
+         ((ka:=retractIfCan(a:=second(l:=argument k))@Union(K,"failed"))case K)
+           and ((z := retractIfCan(zz := third l)@Union(SE, "failed")) case SE)
+              and (z::SE = x)
+                and ((u := droponex(first l, a, ka, zz)) case F) => u::F::IR
+      (da := differentiate(a := denom(f)::F, x)) ^= 0 and
+        zero? differentiate(c := numer(f)::F / da, x) => (c * log a)::IR
+      mkAnswer(0, empty(), [[f, x::F]])
+
+    droponex(f, a, ka, x) ==
+      (r := retractIfCan(f)@Union(K, "failed")) case "failed" => "failed"
+      is?(op := operator(k := r::K), OPDIFF) =>
+        (z := third(arg := argument k)) = a => op [first arg, second arg, x]
+        (u := droponex(first arg, a, ka, x)) case "failed" => "failed"
+        op [u::F, second arg, z]
+      eval(f, [ka], [x])
+
+    unklimint(f, x, lu) ==
+      for u in lu | u ^= 0 repeat
+        zero? differentiate(c := f * u / differentiate(u, x), x) => [0,[[c,u]]]
+      "failed"
+
+    unkextint(f, x, g) ==
+      zero?(g' := differentiate(g, x)) => "failed"
+      zero? differentiate(c := f / g', x) => [0, c]
+      "failed"
+
+    isx?(f, x) ==
+      (k := retractIfCan(f)@Union(K, "failed")) case "failed" => false
+      (r := symbolIfCan(k::K)) case "failed" => false
+      r::SE = x
+
+    alglfint(f, k, l, x) ==
+      xf := x::F
+      symbolIfCan(kx := ksec(k,l,x)) case SE => addx(palgint(f, kx, k), xf)
+      is?(kx, "exp"::SE) => addx(algexpint(f, kx, k, x), xf)
+      prim?(kx, x)       => addx(algprimint(f, kx, k, x), xf)
+      has?(operator kx, ALGOP) =>
+        rec := primitiveElement(kx::F, k::F)
+        y   := rootOf(rec.prim)
+        map((x1:F):F +-> eval(x1, retract(y)@K, rec.primelt),
+          lfintegrate(eval(f, [kx,k], [(rec.pol1) y, (rec.pol2) y]), x))
+      unknownint(f, x)
+
+    alglfextint(f, k, l, x, g) ==
+      symbolIfCan(kx := ksec(k,l,x)) case SE => palgextint(f, kx, k, g)
+      has?(operator kx, ALGOP) =>
+        rec := primitiveElement(kx::F, k::F)
+        y   := rootOf(rec.prim)
+        lrhs := [(rec.pol1) y, (rec.pol2) y]$List(F)
+        (u := lfextendedint(eval(f, [kx, k], lrhs), x,
+                    eval(g, [kx, k], lrhs))) case "failed" => "failed"
+        ky := retract(y)@K
+        r := u::Record(ratpart:F, coeff:F)
+        [eval(r.ratpart,ky,rec.primelt), eval(r.coeff,ky,rec.primelt)]
+      is?(kx, "exp"::SE) or is?(kx, "log"::SE) => FAIL
+      unkextint(f, x, g)
+
+    alglflimint(f, k, l, x, lu) ==
+      symbolIfCan(kx := ksec(k,l,x)) case SE => palglimint(f, kx, k, lu)
+      has?(operator kx, ALGOP) =>
+        rec := primitiveElement(kx::F, k::F)
+        y   := rootOf(rec.prim)
+        lrhs := [(rec.pol1) y, (rec.pol2) y]$List(F)
+        (u := lflimitedint(eval(f, [kx, k], lrhs), x,
+          map((x1:F):F+->eval(x1,[kx, k],lrhs), lu))) case "failed" => "failed"
+        ky := retract(y)@K
+        r := u::Record(mainpart:F, limitedlogs:LLG)
+        [eval(r.mainpart, ky, rec.primelt),
+          [[eval(rc.coeff, ky, rec.primelt),
+            eval(rc.logand,ky, rec.primelt)] for rc in r.limitedlogs]]
+      is?(kx, "exp"::SE) or is?(kx, "log"::SE) => FAIL
+      unklimint(f, x, lu)
+
+    if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer)
+      and F has Join(LiouvillianFunctionCategory, RetractableTo SE) then
+
+        import PatternMatchIntegration(R, F)
+
+        lfintegrate(f, x) == intPatternMatch(f, x, lfintegrate0, pmintegrate)
+
+    else
+
+        lfintegrate(f, x) == lfintegrate0(f, x)
+
+    lfintegrate0(f, x) ==
+      zero? f => 0
+      xf := x::F
+      empty?(l := varselect(kernels f, x)) => (xf * f)::IR
+      symbolIfCan(k := kmax l) case SE =>
+        map((x1:RF):F +-> multivariate(x1, k), integrate univariate(f, k))
+      is?(k, "tan"::SE)  => addx(tanint(f, x, k), xf)
+      is?(k, "exp"::SE)  => addx(expint(f, x, k), xf)
+      prim?(k, x)        => addx(primint(f, x, k), xf)
+      has?(operator k, ALGOP) => alglfint(f, k, l, x)
+      unknownint(f, x)
+
+    addx(i, x) ==
+      elem? i => i
+      mkAnswer(ratpart i, logpart i,
+                                [[ne.integrand, x] for ne in notelem i])
+
+    tryChangeVar(f, t, x) ==
+        z := new()$Symbol
+        g := subst(f / differentiate(t::F, x), [t], [z::F])
+        freeOf?(g, x) =>               -- can we do change of variables?
+            map((x1:F):F+->eval(x1, kernel z, t::F), lfintegrate(g, z))
+        "failed"
+
+    algexpint(f, t, y, x) ==
+        (u := tryChangeVar(f, t, x)) case IR => u::IR
+        algint(f, t, y,  
+               (x1:UP):UP +-> differentiate(x1, 
+                (x2:F):F +-> differentiate(x2, x),
+                 monomial(differentiate(first argument t, x), 1)))
+
+    algprimint(f, t, y, x) ==
+        (u := tryChangeVar(f, t, x)) case IR => u::IR
+        algint(f, t, y, 
+               (x1:UP):UP +-> differentiate(x1, 
+                (x2:F):F +-> differentiate(x2, x),
+                 differentiate(t::F, x)::UP))
+
+
+    lfextendedint(f, x, g) ==
+      empty?(l := varselect(kernels f, x)) => [x::F * f, 0]
+      symbolIfCan(k := kmax(l))
+        case SE =>
+         g1 :=
+           empty?(l1 := varselect(kernels g,x)) => 0::F
+           kmax(l1) = k => g
+           0::F
+         map((x1:RF):F +-> multivariate(x1, k),
+               extendedint(univariate(f, k),
+                 univariate(g1, k)))
+      is?(k, "exp"::SE) => expextint(f, x, k, g)
+      prim?(k, x)       => primextint(f, x, k, g)
+      has?(operator k, ALGOP) => alglfextint(f, k, l, x, g)
+      unkextint(f, x, g)
+
+    lflimitedint(f, x, lu) ==
+      empty?(l := varselect(kernels f, x)) => [x::F * f, empty()]
+      symbolIfCan(k := kmax(l)) case SE =>
+       map((x1:RF):F +-> multivariate(x1, k), 
+            limitedint(univariate(f, k),
+              [univariate(u, k) for u in lu]))
+      is?(k, "exp"::SE) => explimint(f, x, k, lu)
+      prim?(k, x)       => primlimint(f, x, k, lu)
+      has?(operator k, ALGOP) => alglflimint(f, k, l, x, lu)
+      unklimint(f, x, lu)
+
+    lfinfieldint(f, x) ==
+      (u := lfextendedint(f, x, 0)) case "failed" => "failed"
+      u.ratpart
+
+    primextint(f, x, k, g) ==
+      lk := varselect([a for a in tower f | k ^= a and is?(a, "log"::SE)], x)
+      (u1 := primextendedint(univariate(f, k), 
+       (x1:UP):UP +-> differentiate(x1,
+        (x2:F):F +-> differentiate(x2, x), differentiate(k::F, x)::UP),
+         (x3:F):U2+->lfextlimint(x3,x,k,lk), univariate(g, k))) case "failed"
+                => "failed"
+      u1 case FF =>
+        [multivariate(u1.ratpart, k), multivariate(u1.coeff, k)]
+      (u2 := lfextendedint(u1.a0, x, g)) case "failed" => "failed"
+      [multivariate(u1.answer, k) + u2.ratpart, u2.coeff]
+
+    expextint(f, x, k, g) ==
+      (u1 := expextendedint(univariate(f, k), 
+       (x1:UP):UP +-> differentiate(x1,
+        (x2:F):F +->  differentiate(x2, x),
+         monomial(differentiate(first argument k, x), 1)),
+          (x3:Integer,x4:F):PSOL+->rischDE(x3, first argument k, x4, x, 
+           (x5:F,x6:List F):U3 +-> lflimitedint(x5, x, x6),
+            (x7:F,x8:F):U2+->lfextendedint(x7, x, x8)), univariate(g, k)))
+               case "failed" => "failed"
+      u1 case FF =>
+        [multivariate(u1.ratpart, k), multivariate(u1.coeff, k)]
+      (u2 := lfextendedint(u1.a0, x, g)) case "failed" => "failed"
+      [multivariate(u1.answer, k) + u2.ratpart, u2.coeff]
+
+    primint(f, x, k) ==
+      lk := varselect([a for a in tower f | k ^= a and is?(a, "log"::SE)], x)
+      r1 := primintegrate(univariate(f, k), 
+             (x1:UP):UP +-> differentiate(x1,
+              (x2:F):F +-> differentiate(x2, x), differentiate(k::F, x)::UP),
+               (x3:F):U2 +-> lfextlimint(x3, x, k, lk))
+      map((x1:RF):F+->multivariate(x1, k), r1.answer) + lfintegrate(r1.a0, x)
+
+    lfextlimint(f, x, k, lk) ==
+      not((u1 := lfextendedint(f, x, differentiate(k::F, x)))
+        case "failed") => u1
+      twr := tower f
+      empty?(lg := [kk for kk in lk | not member?(kk, twr)]) => "failed"
+      is?(k, "log"::SE) =>
+        (u2 := lflimitedint(f, x,
+          [first argument u for u in union(lg, [k])])) case "failed"
+                                                             => "failed"
+        cf := cfind(first argument k, u2.limitedlogs)
+        [u2.mainpart - cf * k::F +
+                +/[c.coeff * log(c.logand) for c in u2.limitedlogs], cf]
+      "failed"
+
+    cfind(f, l) ==
+      for u in l repeat
+        f = u.logand => return u.coeff
+      0
+
+    expint(f, x, k) ==
+      eta := first argument k
+      r1  := 
+       expintegrate(univariate(f, k), 
+        (x1:UP):UP +-> differentiate(x1,
+         (x2:F):F +-> differentiate(x2, x), 
+          monomial(differentiate(eta, x), 1)),
+           (x3:Integer,x4:F):PSOL+->rischDE(x3, eta, x4, x, 
+            (x5:F,x6:List F):U3 +-> lflimitedint(x5, x, x6),
+             (x7:F,x8:F):U2+->lfextendedint(x7, x, x8)))
+      map((x1:RF):F+->multivariate(x1, k), r1.answer) + lfintegrate(r1.a0, x)
+
+    primlimint(f, x, k, lu) ==
+      lk := varselect([a for a in tower f | k ^= a and is?(a, "log"::SE)], x)
+      (u1 := 
+        primlimitedint(univariate(f, k), 
+         (x1:UP):UP+->differentiate(x1,
+           (x2:F):F+->differentiate(x2, x), differentiate(k::F, x)::UP),
+            (x3:F):U2+->lfextlimint(x3,x,k,lk), 
+             [univariate(u, k) for u in lu]))
+               case "failed" => "failed"
+      l := [[multivariate(lg.coeff, k),multivariate(lg.logand, k)]
+                                    for lg in u1.answer.limitedlogs]$LLG
+      (u2 := lflimitedint(u1.a0, x, lu)) case "failed" => "failed"
+      [multivariate(u1.answer.mainpart, k) + u2.mainpart,
+                                              concat(u2.limitedlogs, l)]
+
+    explimint(f, x, k, lu) ==
+      eta := first argument k
+      (u1 := 
+        explimitedint(univariate(f, k), 
+         (x1:UP):UP+->differentiate(x1,
+          (x2:F):F+->differentiate(x2,x), monomial(differentiate(eta,x), 1)),
+           (x3:Integer,x4:F):PSOL+->rischDE(x3, eta, x4, x,
+             (x5:F,x6:List F):U3+->lflimitedint(x5, x, x6), 
+              (x7:F,x8:F):U2+->lfextendedint(x7, x, x8)),
+               [univariate(u, k) for u in lu])) case "failed" => "failed"
+      l := [[multivariate(lg.coeff, k),multivariate(lg.logand, k)]
+                                    for lg in u1.answer.limitedlogs]$LLG
+      (u2 := lflimitedint(u1.a0, x, lu)) case "failed" => "failed"
+      [multivariate(u1.answer.mainpart, k) + u2.mainpart,
+                                              concat(u2.limitedlogs, l)]
+
 *)
 
 \end{chunk}
@@ -28080,6 +38001,7 @@ ElementaryRischDE(R, F): Exports == Implementation where
          ++ ext is an extended integration function.
 
   Implementation ==> add
+
     import IntegrationTools(R, F)
     import TranscendentalRischDE(F, UP)
     import TranscendentalIntegration(F, UP)
@@ -28133,7 +38055,7 @@ ElementaryRischDE(R, F): Exports == Implementation where
         [0, 0, false]
       FAIL
 
--- solve y' + n f'y = g for a rational function y
+    -- solve y' + n f'y = g for a rational function y
     rischDE(n, f, g, x, limitedint, extendedint) ==
       zero? g => [0, g, true]
       zero?(nfp := n * differentiate(f, x)) =>
@@ -28153,8 +38075,8 @@ ElementaryRischDE(R, F): Exports == Implementation where
       rec.sol? => rec.ans
       "failed"
 
--- solve y' + n f' y = g
--- when f' and g are rational functions over a constant field
+    -- solve y' + n f' y = g
+    -- when f' and g are rational functions over a constant field
     normalise0(n, f, g, x) ==
       k := kernel(x)@K
       if (data1 := search(f, tab)) case "failed" then
@@ -28170,7 +38092,7 @@ ElementaryRischDE(R, F): Exports == Implementation where
       rec.nosol => [y, differentiate(y, x) + nfprime * y, false]
       [y, g, true]
 
--- make f weakly normalized, and solve y' + n f' y = g
+    -- make f weakly normalized, and solve y' + n f' y = g
     normalise(n, nfp, f, g, x, k, limitedint, extendedint) ==
       if (data1:= search(f, tab)) case "failed" then
         tab.f := data := makeData(f, x, k)
@@ -28197,7 +38119,7 @@ ElementaryRischDE(R, F): Exports == Implementation where
       ans1 case "failed" => [0, 0, false]
       [multivariate(ans1::RF, k) / p::F, g, true]
 
--- find the n * log(P) appearing in f, where P is in P, n in Z
+    -- find the n * log(P) appearing in f, where P is in P, n in Z
     makeData(f, x, k) ==
       disasters := empty()$Data
       fnum := numer f
@@ -28205,7 +38127,6 @@ ElementaryRischDE(R, F): Exports == Implementation where
       for u in varselect(kernels f, x) | is?(u, "log"::SE) repeat
         logand := first argument u
         if zero?(degree univariate(fden, u)) and
---           one?(degree(num := univariate(fnum, u))) then
            (degree(num := univariate(fnum, u)) = 1) then
             cf := (leadingCoefficient num) / fden
             if (n := retractIfCan(cf)@Union(Z, "failed")) case Z then
@@ -28338,8 +38259,8 @@ ElementaryRischDE(R, F): Exports == Implementation where
         min(0, nc)
       min(0, nc)
 
--- case a = 1, deg(B) = 0, B <> 0
--- cancellation at infinity is possible
+    -- case a = 1, deg(B) = 0, B <> 0
+    -- cancellation at infinity is possible
     logdegrad(twr, b, c, n, x, t, limitedint, extint) ==
       t'  := differentiate(t::F, x)
       lk1 := logdiff(twr, lk0 := tower(f0 := - b))
@@ -28354,8 +38275,8 @@ ElementaryRischDE(R, F): Exports == Implementation where
                +/[v.coeff * log(v.logand) for v in if0.limitedlogs],
                                            n, x, t', limitedint, extint)
 
--- case a = 1, degree(b) = 0, and (exp integrate b) is not in F
--- this implies no cancellation at infinity
+    -- case a = 1, degree(b) = 0, and (exp integrate b) is not in F
+    -- this implies no cancellation at infinity
     logdeg(c, f, n, x, t', limitedint, extint) ==
       answr:UP := 0
       repeat
@@ -28368,8 +38289,8 @@ ElementaryRischDE(R, F): Exports == Implementation where
         c   := (reductum c) - monomial(m::Z * t' * u.ans, (m - 1)::N)
         answr := answr + monomial(u.ans, m)
 
--- case a = 1, deg(B) = 0, B <> 0
--- cancellation at infinity is possible
+    -- case a = 1, deg(B) = 0, B <> 0
+    -- cancellation at infinity is possible
     expdegrad(twr, b, c, n, x, t, limint, extint) ==
       lk1 := logdiff(twr, lk0 := tower(f0 := - b))
       (if0 := limint(f0, [first argument u for u in lk1]))
@@ -28389,8 +38310,8 @@ ElementaryRischDE(R, F): Exports == Implementation where
         expdeg(c, intf0, n, x, first argument t, limint,extint)
       expdeg(c, intf0, n, x, first argument t, limint, extint)
 
--- case a = 1, degree(b) = 0, and (exp integrate b) is not a monomial
--- this implies no cancellation at infinity
+    -- case a = 1, degree(b) = 0, and (exp integrate b) is not a monomial
+    -- this implies no cancellation at infinity
     expdeg(c, f, n, x, eta, limitedint, extint) ==
       answr:UP := 0
       repeat
@@ -28411,166 +38332,491 @@ ElementaryRischDE(R, F): Exports == Implementation where
 \begin{chunk}{COQ RDEEF}
 (* package RDEEF *)
 (*
-*)
-
-\end{chunk}
 
-\begin{chunk}{RDEEF.dotabb}
-"RDEEF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RDEEF"]
-"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"]
-"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
-"RDEEF" -> "ACF"
-"RDEEF" -> "FS"
+    import IntegrationTools(R, F)
+    import TranscendentalRischDE(F, UP)
+    import TranscendentalIntegration(F, UP)
+    import PureAlgebraicIntegration(R, F, F)
+    import FunctionSpacePrimitiveElement(R, F)
+    import ElementaryFunctionStructurePackage(R, F)
+    import PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                                                             K, R, P, F)
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{package RDEEFS ElementaryRischDESystem}
-\begin{chunk}{ElementaryRischDESystem.input}
-)set break resume
-)sys rm -f ElementaryRischDESystem.output
-)spool ElementaryRischDESystem.output
-)set message test on
-)set message auto off
-)clear all
+    RF2GP:     RF -> GP
+    makeData  : (F, SE, K)    -> Data
+    normal0   : (Z, F, F, SE) -> UF
+    normalise0: (Z, F, F, SE) -> PSOL
+    normalise : (Z, F, F, F, SE, K, (F, LF) -> U, (F, F) -> UEX) -> PSOL
+    rischDEalg: (Z, F, F, F, K, LK, SE, (F, LF) -> U, (F, F) -> UEX) -> PSOL
+    rischDElog: (LK, RF, RF, SE, K, UP->UP,(F,LF)->U,(F,F)->UEX) -> URF
+    rischDEexp: (LK, RF, RF, SE, K, UP->UP,(F,LF)->U,(F,F)->UEX) -> URF
+    polyDElog : (LK, UP, UP,UP,SE,K,UP->UP,(F,LF)->U,(F,F)->UEX) -> UUP
+    polyDEexp : (LK, UP, UP,UP,SE,K,UP->UP,(F,LF)->U,(F,F)->UEX) -> UUP
+    gpolDEexp : (LK, UP, GP,GP,SE,K,UP->UP,(F,LF)->U,(F,F)->UEX) -> UGP
+    boundAt0  : (LK, F, Z,  Z,    SE, K, (F, LF) -> U) -> Z
+    boundInf  : (LK, F, Z,  Z, Z, SE, K, (F, LF) -> U) -> Z
+    logdegrad : (LK, F, UP, Z, SE, K,(F,LF)->U, (F,F) -> UEX) -> UUP
+    expdegrad : (LK, F, UP, Z, SE, K,(F,LF)->U, (F,F) -> UEX) -> UUP
+    logdeg    : (UP, F, Z, SE, F, (F, LF) -> U, (F, F) -> UEX) -> UUP
+    expdeg    : (UP, F, Z, SE, F, (F, LF) -> U, (F, F) -> UEX) -> UUP
+    exppolyint: (UP, (Z, F) -> PSOL) -> UUP
+    RRF2F     : RRF -> F
+    logdiff   : (List K, List K) -> List K
 
---S 1 of 1
-)show ElementaryRischDESystem
---R 
---R ElementaryRischDESystem(R: Join(GcdDomain,OrderedSet,CharacteristicZero,RetractableTo(Integer),LinearlyExplicitRingOver(Integer)),F: Join(TranscendentalFunctionCategory,AlgebraicallyClosedField,FunctionSpace(R)))  is a package constructor
---R Abbreviation for ElementaryRischDESystem is RDEEFS 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.4.pamphlet to see algebra source code for RDEEFS 
---R
---R------------------------------- Operations --------------------------------
---R rischDEsys : (Integer,F,F,F,Symbol,((F,List(F)) -> Union(Record(mainpart: F,limitedlogs: List(Record(coeff: F,logand: F))),"failed")),((F,F) -> Union(Record(ratpart: F,coeff: F),"failed"))) -> Union(List(F),"failed")
---R
---E 1
+    tab:AssociationList(F, Data) := table()
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{ElementaryRischDESystem.help}
-====================================================================
-ElementaryRischDESystem examples
-====================================================================
+    RF2GP f == (numer(f)::GP exquo denom(f)::GP)::GP
 
-Risch differential equation, elementary case.
+    logdiff(twr, bad) ==
+      [u for u in twr | is?(u, "log"::SE) and not member?(u, bad)]
 
-See Also:
-o )show ElementaryRischDESystem
+    rischDEalg(n, nfp, f, g, k, l, x, limint, extint) ==
+      symbolIfCan(kx := ksec(k, l, x)) case SE =>
+        (u := palgRDE(nfp, f, g, kx, k, 
+          (z1,z2,z3) +-> normal0(n, z1, z2, z3))) case "failed"
+             => [0, 0, false]
+        [u::F, g, true]
+      has?(operator kx, ALGOP) =>
+        rec := primitiveElement(kx::F, k::F)
+        y   := rootOf(rec.prim)
+        lk:LK := [kx, k]
+        lv:LF := [(rec.pol1) y, (rec.pol2) y]
+        rc := rischDE(n, eval(f, lk, lv), eval(g, lk, lv), x, limint, extint)
+        rc.sol? => [eval(rc.ans, retract(y)@K, rec.primelt), rc.right, true]
+        [0, 0, false]
+      FAIL
 
-\end{chunk}
-\pagehead{ElementaryRischDESystem}{RDEEFS}
-\pagepic{ps/v104elementaryrischdesystem.ps}{RDEEFS}{1.00}
+    -- solve y' + n f'y = g for a rational function y
+    rischDE(n, f, g, x, limitedint, extendedint) ==
+      zero? g => [0, g, true]
+      zero?(nfp := n * differentiate(f, x)) =>
+        (u := limitedint(g, empty())) case "failed" => [0, 0, false]
+        [u.mainpart, g, true]
+      freeOf?(y := g / nfp, x) => [y, g, true]
+      vl := varselect(union(kernels nfp, kernels g), x)
+      symbolIfCan(k := kmax vl) case SE => normalise0(n, f, g, x)
+      is?(k, "log"::SE) or is?(k, "exp"::SE) =>
+        normalise(n, nfp, f, g, x, k, limitedint, extendedint)
+      has?(operator k, ALGOP) =>
+        rischDEalg(n, nfp, f, g, k, vl, x, limitedint, extendedint)
+      FAIL
 
-{\bf Exports:}\\
-\cross{RDEEFS}{rischDEsys} 
+    normal0(n, f, g, x) ==
+      rec := normalise0(n, f, g, x)
+      rec.sol? => rec.ans
+      "failed"
 
-\begin{chunk}{package RDEEFS ElementaryRischDESystem}
-)abbrev package RDEEFS ElementaryRischDESystem
-++ Author: Manuel Bronstein
-++ Date Created: 12 August 1992
-++ Date Last Updated: 17 August 1992
-++ Description:
-++ Risch differential equation, elementary case.
+    -- solve y' + n f' y = g
+    -- when f' and g are rational functions over a constant field
+    normalise0(n, f, g, x) ==
+      k := kernel(x)@K
+      if (data1 := search(f, tab)) case "failed" then
+        tab.f := data := makeData(f, x, k)
+      else data := data1::Data
+      f'  := nfprime := n * differentiate(f, x)
+      p:P := 1
+      for v in data | (m := n * v.coeff) > 0 repeat
+        p  := p * v.argument ** (m::N)
+        f' := f' - m * differentiate(v.argument::F, x) / (v.argument::F)
+      rec := baseRDE(univariate(f', k), univariate(p::F * g, k))
+      y := multivariate(rec.ans, k) / p::F
+      rec.nosol => [y, differentiate(y, x) + nfprime * y, false]
+      [y, g, true]
 
-ElementaryRischDESystem(R, F): Exports == Implementation where
-  R : Join(GcdDomain, OrderedSet, CharacteristicZero,
-           RetractableTo Integer, LinearlyExplicitRingOver Integer)
-  F : Join(TranscendentalFunctionCategory, AlgebraicallyClosedField,
-           FunctionSpace R)
- 
-  Z   ==> Integer
-  SE  ==> Symbol
-  K   ==> Kernel F
-  P   ==> SparseMultivariatePolynomial(R, K)
-  UP  ==> SparseUnivariatePolynomial F
-  RF  ==> Fraction UP
-  NL  ==> Record(coeff:F,logand:F)
-  RRF ==> Record(mainpart:F,limitedlogs:List NL)
-  U   ==> Union(RRF, "failed")
-  ULF ==> Union(List F, "failed")
-  UEX ==> Union(Record(ratpart:F, coeff:F), "failed")
- 
-  Exports ==> with
-    rischDEsys: (Z, F, F, F, SE, (F, List F) -> U, (F, F) -> UEX) -> ULF
-      ++ rischDEsys(n, f, g_1, g_2, x,lim,ext) returns \spad{y_1.y_2} such that
-      ++ \spad{(dy1/dx,dy2/dx) + ((0, - n df/dx),(n df/dx,0)) (y1,y2) = (g1,g2)}
-      ++ if \spad{y_1,y_2} exist, "failed" otherwise.
-      ++ lim is a limited integration function,
-      ++ ext is an extended integration function.
- 
-  Implementation ==> add
-    import IntegrationTools(R, F)
-    import ElementaryRischDE(R, F)
-    import TranscendentalRischDESystem(F, UP)
-    import PolynomialCategoryQuotientFunctions(IndexedExponents K,
-                                                             K, R, P, F)
- 
---  sm1 := sqrt(-1::F)
---  ks1 := retract(sm1)@K
- 
---  gcoeffs    : P -> ULF
---  gets1coeffs: F -> ULF
---  cheat      : (Z, F, F, F, SE, (F, List F) -> U, (F, F) -> UEX) -> ULF
-    basecase   : (F, F, F, K) -> ULF
- 
--- solve (y1',y2') + ((0, -nfp), (nfp, 0)) (y1,y2) = (g1, g2), base case
-    basecase(nfp, g1, g2, k) ==
-      (ans := baseRDEsys(univariate(nfp, k), univariate(g1, k),
-                         univariate(g2, k))) case "failed" => "failed"
-      l := ans::List(RF)
-      [multivariate(first l, k), multivariate(second l, k)]
- 
--- returns [x,y] s.t. f = x + y %i
--- f can be of the form (a + b %i) / (c + d %i)
---  gets1coeffs f ==
---    (lnum := gcoeffs(numer f)) case "failed" => "failed"
---    (lden := gcoeffs(denom f)) case "failed" => "failed"
---    a := first(lnum::List F)
---    b := second(lnum::List F)
---    c := first(lden::List F)
---    zero?(d := second(lden::List F)) => [a/c, b/c]
---    cd := c * c + d * d
---    [(a * c + b * d) / cd, (b * c - a * d) / cd]
- 
---  gcoeffs p ==
---    degree(q := univariate(p, ks1)) > 1 => "failed"
---    [coefficient(q, 0)::F, coefficient(q, 1)::F]
- 
---  cheat(n, f, g1, g2, x, limint, extint) ==
---    (u := rischDE(n, sm1 * f, g1 + sm1 * g2, x, limint, extint))
---      case "failed" => "failed"
---    (l := gets1coeffs(u::F)) case "failed" =>
---      error "rischDEsys: expect linear result in sqrt(-1)"
---    l::List F
- 
--- solve (y1',y2') + ((0, -n f'), (n f', 0)) (y1,y2) = (g1, g2)
-    rischDEsys(n, f, g1, g2, x, limint, extint) ==
-      zero? g1 and zero? g2 => [0, 0]
-      zero?(nfp := n * differentiate(f, x)) =>
-        ((u1 := limint(g1, empty())) case "failed") or
-          ((u2 := limint(g1, empty())) case "failed") => "failed"
-        [u1.mainpart, u2.mainpart]
-      freeOf?(y1 := g2 / nfp, x) and freeOf?(y2 := - g1 / nfp, x) => [y1, y2]
-      vl := varselect(union(kernels nfp, union(kernels g1, kernels g2)), x)
-      symbolIfCan(k := kmax vl) case SE => basecase(nfp, g1, g2, k)
---    cheat(n, f, g1, g2, x, limint, extint)
-      error "rischDEsys: can only handle rational functions for now"
+    -- make f weakly normalized, and solve y' + n f' y = g
+    normalise(n, nfp, f, g, x, k, limitedint, extendedint) ==
+      if (data1:= search(f, tab)) case "failed" then
+        tab.f := data := makeData(f, x, k)
+      else data := data1::Data
+      p:P := 1
+      for v in data | (m := n * v.coeff) > 0 repeat
+        p  := p * v.argument ** (m::N)
+        f  := f - v.coeff * log(v.argument::F)
+        nfp := nfp - m * differentiate(v.argument::F, x) / (v.argument::F)
+      newf := univariate(nfp, k)
+      newg := univariate(p::F * g, k)
+      twr := union(logdiff(tower f, empty()), logdiff(tower g, empty()))
+      ans1 :=
+        is?(k, "log"::SE) =>
+          rischDElog(twr, newf, newg, x, k,
+            z1 +-> differentiate(z1,(z2:F):F +-> differentiate(z2, x),
+                             differentiate(k::F, x)::UP),
+                                            limitedint, extendedint)
+        is?(k, "exp"::SE) =>
+          rischDEexp(twr, newf, newg, x, k,
+            z1 +-> differentiate(z1, (z2:F):F +-> differentiate(z2, x),
+                      monomial(differentiate(first argument k, x), 1)),
+                                                limitedint, extendedint)
+      ans1 case "failed" => [0, 0, false]
+      [multivariate(ans1::RF, k) / p::F, g, true]
 
-\end{chunk}
+    -- find the n * log(P) appearing in f, where P is in P, n in Z
+    makeData(f, x, k) ==
+      disasters := empty()$Data
+      fnum := numer f
+      fden := denom f
+      for u in varselect(kernels f, x) | is?(u, "log"::SE) repeat
+        logand := first argument u
+        if zero?(degree univariate(fden, u)) and
+           (degree(num := univariate(fnum, u)) = 1) then
+            cf := (leadingCoefficient num) / fden
+            if (n := retractIfCan(cf)@Union(Z, "failed")) case Z then
+              if degree(numer logand, k) > 0 then
+                disasters := concat([n::Z, numer logand], disasters)
+              if degree(denom logand, k) > 0 then
+                disasters := concat([-(n::Z), denom logand], disasters)
+      disasters
 
-\begin{chunk}{COQ RDEEFS}
-(* package RDEEFS *)
-(*
-*)
+    rischDElog(twr, f, g, x, theta, driv, limint, extint) ==
+      (u := monomRDE(f, g, driv)) case "failed" => "failed"
+      (v := polyDElog(twr, u.a, retract(u.b), retract(u.c), x, theta, driv,
+                      limint, extint)) case "failed" => "failed"
+      v::UP / u.t
 
-\end{chunk}
+    rischDEexp(twr, f, g, x, theta, driv, limint, extint) ==
+      (u := monomRDE(f, g, driv)) case "failed" => "failed"
+      (v := gpolDEexp(twr, u.a, RF2GP(u.b), RF2GP(u.c), x, theta, driv,
+                      limint, extint)) case "failed" => "failed"
+      convert(v::GP)@RF / u.t::RF
 
-\begin{chunk}{RDEEFS.dotabb}
-"RDEEFS" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RDEEFS"]
-"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"]
-"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
+    polyDElog(twr, aa, bb, cc, x, t, driv, limint, extint) ==
+      zero? cc => 0
+      t' := differentiate(t::F, x)
+      zero? bb =>
+        (u := cc exquo aa) case "failed" => "failed"
+        primintfldpoly(u::UP, z1 +-> extint(z1, t'), t')
+      n := degree(cc)::Z - (db := degree(bb)::Z)
+      if ((da := degree(aa)::Z) = db) and (da > 0) then
+        lk0 := tower(f0 :=
+                      - (leadingCoefficient bb) / (leadingCoefficient aa))
+        lk1 := logdiff(twr, lk0)
+        (if0 := limint(f0, [first argument u for u in lk1]))
+                       case "failed" => error "Risch's theorem violated"
+        (alph := validExponential(lk0, RRF2F(if0::RRF), x)) case F =>
+          return
+            (ans := polyDElog(twr, alph::F * aa,
+              differentiate(alph::F, x) * aa + alph::F * bb,
+               cc, x, t, driv, limint, extint)) case "failed" => "failed"
+            alph::F * ans::UP
+      if (da > db + 1) then n := max(0, degree(cc)::Z - da + 1)
+      if (da = db + 1) then
+        i := limint(- (leadingCoefficient bb) / (leadingCoefficient aa),
+                    [first argument t])
+        if not(i case "failed") then
+          r :=
+            null(i.limitedlogs) => 0$F
+            i.limitedlogs.first.coeff
+          if (nn := retractIfCan(r)@Union(Z, "failed")) case Z then
+            n := max(nn::Z, n)
+      (v := polyRDE(aa, bb, cc, n, driv)) case ans =>
+           v.ans.nosol => "failed"
+           v.ans.ans
+      w := v.eq
+      zero?(w.b) =>
+        degree(w.c) > w.m => "failed"
+        (u := primintfldpoly(w.c, z1+->extint(1,t'), t')) 
+           case "failed" => "failed"
+        degree(u::UP) > w.m => "failed"
+        w.alpha * u::UP + w.beta
+      (u := logdegrad(twr, retract(w.b), w.c, w.m, x, t, limint, extint))
+        case "failed" => "failed"
+      w.alpha * u::UP + w.beta
+
+    gpolDEexp(twr, a, b, c, x, t, driv, limint, extint) ==
+      zero? c => 0
+      zero? b =>
+        (u := c exquo (a::GP)) case "failed" => "failed"
+        expintfldpoly(u::GP,
+           (z1,z2) +-> rischDE(z1, first argument t, z2, x, limint, extint))
+      lb := boundAt0(twr, - coefficient(b, 0) / coefficient(a, 0),
+                     nb := order b, nc := order c, x, t, limint)
+      tm := monomial(1, (m := max(0, max(-nb, lb - nc)))::N)$UP
+      (v := polyDEexp(twr,a * tm,lb * differentiate(first argument t, x)
+           * a * tm + retract(b * tm::GP)@UP,
+               retract(c * monomial(1, m - lb))@UP,
+                  x, t, driv, limint, extint)) case "failed" => "failed"
+      v::UP::GP * monomial(1, lb)
+
+    polyDEexp(twr, aa, bb, cc, x, t, driv, limint, extint) ==
+      zero? cc => 0
+      zero? bb =>
+        (u := cc exquo aa) case "failed" => "failed"
+        exppolyint(u::UP, 
+          (z1,z2) +-> rischDE(z1, first argument t, z2, x, limint, extint))
+      n := boundInf(twr,-leadingCoefficient(bb) / (leadingCoefficient aa),
+                 degree(aa)::Z, degree(bb)::Z, degree(cc)::Z, x, t, limint)
+      (v := polyRDE(aa, bb, cc, n, driv)) case ans =>
+           v.ans.nosol => "failed"
+           v.ans.ans
+      w := v.eq
+      zero?(w.b) =>
+        degree(w.c) > w.m => "failed"
+        (u := exppolyint(w.c,
+          (z1,z2) +-> rischDE(z1, first argument t, z2, x, limint, extint)))
+                         case "failed" => "failed"
+        w.alpha * u::UP + w.beta
+      (u := expdegrad(twr, retract(w.b), w.c, w.m, x, t, limint, extint))
+        case "failed" => "failed"
+      w.alpha * u::UP + w.beta
+
+    exppolyint(p, rischdiffeq) ==
+      (u := expintfldpoly(p::GP, rischdiffeq)) case "failed" => "failed"
+      retractIfCan(u::GP)@Union(UP, "failed")
+
+    boundInf(twr, f0, da, db, dc, x, t, limitedint) ==
+      da < db => dc - db
+      da > db => max(0, dc - da)
+      l1 := logdiff(twr, l0 := tower f0)
+      (if0 := limitedint(f0, [first argument u for u in l1]))
+                       case "failed" => error "Risch's theorem violated"
+      (alpha := validExponential(concat(t, l0), RRF2F(if0::RRF), x))
+       case F =>
+        al := separate(univariate(alpha::F, t))$GP
+        zero?(al.fracPart) and monomial?(al.polyPart) =>
+                               max(0, max(degree(al.polyPart), dc - db))
+        dc - db
+      dc - db
+
+    boundAt0(twr, f0, nb, nc, x, t, limitedint) ==
+      nb ^= 0 => min(0, nc - min(0, nb))
+      l1 := logdiff(twr, l0 := tower f0)
+      (if0 := limitedint(f0, [first argument u for u in l1]))
+                       case "failed" => error "Risch's theorem violated"
+      (alpha := validExponential(concat(t, l0), RRF2F(if0::RRF), x))
+       case F =>
+        al := separate(univariate(alpha::F, t))$GP
+        zero?(al.fracPart) and monomial?(al.polyPart) =>
+                                    min(0, min(degree(al.polyPart), nc))
+        min(0, nc)
+      min(0, nc)
+
+    -- case a = 1, deg(B) = 0, B <> 0
+    -- cancellation at infinity is possible
+    logdegrad(twr, b, c, n, x, t, limitedint, extint) ==
+      t'  := differentiate(t::F, x)
+      lk1 := logdiff(twr, lk0 := tower(f0 := - b))
+      (if0 := limitedint(f0, [first argument u for u in lk1]))
+                       case "failed" => error "Risch's theorem violated"
+      (alpha := validExponential(lk0, RRF2F(if0::RRF), x)) case F =>
+        (u1 := primintfldpoly(inv(alpha::F) * c, z1+->extint(z1, t'), t'))
+                                               case "failed" => "failed"
+        degree(u1::UP)::Z > n => "failed"
+        alpha::F * u1::UP
+      logdeg(c, - if0.mainpart -
+               +/[v.coeff * log(v.logand) for v in if0.limitedlogs],
+                                           n, x, t', limitedint, extint)
+
+    -- case a = 1, degree(b) = 0, and (exp integrate b) is not in F
+    -- this implies no cancellation at infinity
+    logdeg(c, f, n, x, t', limitedint, extint) ==
+      answr:UP := 0
+      repeat
+        zero? c => return answr
+        (n < 0) or ((m := degree c)::Z > n) => return "failed"
+        u := rischDE(1, f, leadingCoefficient c, x, limitedint, extint)
+        ~u.sol? => return "failed"
+        zero? m => return(answr + u.ans::UP)
+        n   := m::Z - 1
+        c   := (reductum c) - monomial(m::Z * t' * u.ans, (m - 1)::N)
+        answr := answr + monomial(u.ans, m)
+
+    -- case a = 1, deg(B) = 0, B <> 0
+    -- cancellation at infinity is possible
+    expdegrad(twr, b, c, n, x, t, limint, extint) ==
+      lk1 := logdiff(twr, lk0 := tower(f0 := - b))
+      (if0 := limint(f0, [first argument u for u in lk1]))
+                       case "failed" => error "Risch's theorem violated"
+      intf0 := - if0.mainpart -
+                    +/[v.coeff * log(v.logand) for v in if0.limitedlogs]
+      (alpha := validExponential(concat(t, lk0), RRF2F(if0::RRF), x))
+       case F =>
+        al := separate(univariate(alpha::F, t))$GP
+        zero?(al.fracPart) and monomial?(al.polyPart) and
+         (degree(al.polyPart) >= 0) =>
+          (u1 := expintfldpoly(c::GP * recip(al.polyPart)::GP,
+            (z1,z2) +-> rischDE(z1, first argument t, z2, x, limint, extint)))
+                                               case "failed" => "failed"
+          degree(u1::GP) > n => "failed"
+          retractIfCan(al.polyPart * u1::GP)@Union(UP, "failed")
+        expdeg(c, intf0, n, x, first argument t, limint,extint)
+      expdeg(c, intf0, n, x, first argument t, limint, extint)
+
+    -- case a = 1, degree(b) = 0, and (exp integrate b) is not a monomial
+    -- this implies no cancellation at infinity
+    expdeg(c, f, n, x, eta, limitedint, extint) ==
+      answr:UP := 0
+      repeat
+        zero? c => return answr
+        (n < 0) or ((m := degree c)::Z > n) => return "failed"
+        u := rischDE(1, f + m * eta, leadingCoefficient c, x,limitedint,extint)
+        ~u.sol? => return "failed"
+        zero? m => return(answr + u.ans::UP)
+        n   := m::Z - 1
+        c   := reductum c
+        answr := answr + monomial(u.ans, m)
+
+    RRF2F rrf ==
+      rrf.mainpart + +/[v.coeff*log(v.logand) for v in rrf.limitedlogs]
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{RDEEF.dotabb}
+"RDEEF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RDEEF"]
+"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"]
+"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
+"RDEEF" -> "ACF"
+"RDEEF" -> "FS"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{package RDEEFS ElementaryRischDESystem}
+\begin{chunk}{ElementaryRischDESystem.input}
+)set break resume
+)sys rm -f ElementaryRischDESystem.output
+)spool ElementaryRischDESystem.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show ElementaryRischDESystem
+--R 
+--R ElementaryRischDESystem(R: Join(GcdDomain,OrderedSet,CharacteristicZero,RetractableTo(Integer),LinearlyExplicitRingOver(Integer)),F: Join(TranscendentalFunctionCategory,AlgebraicallyClosedField,FunctionSpace(R)))  is a package constructor
+--R Abbreviation for ElementaryRischDESystem is RDEEFS 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.4.pamphlet to see algebra source code for RDEEFS 
+--R
+--R------------------------------- Operations --------------------------------
+--R rischDEsys : (Integer,F,F,F,Symbol,((F,List(F)) -> Union(Record(mainpart: F,limitedlogs: List(Record(coeff: F,logand: F))),"failed")),((F,F) -> Union(Record(ratpart: F,coeff: F),"failed"))) -> Union(List(F),"failed")
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{ElementaryRischDESystem.help}
+====================================================================
+ElementaryRischDESystem examples
+====================================================================
+
+Risch differential equation, elementary case.
+
+See Also:
+o )show ElementaryRischDESystem
+
+\end{chunk}
+\pagehead{ElementaryRischDESystem}{RDEEFS}
+\pagepic{ps/v104elementaryrischdesystem.ps}{RDEEFS}{1.00}
+
+{\bf Exports:}\\
+\cross{RDEEFS}{rischDEsys} 
+
+\begin{chunk}{package RDEEFS ElementaryRischDESystem}
+)abbrev package RDEEFS ElementaryRischDESystem
+++ Author: Manuel Bronstein
+++ Date Created: 12 August 1992
+++ Date Last Updated: 17 August 1992
+++ Description:
+++ Risch differential equation, elementary case.
+
+ElementaryRischDESystem(R, F): Exports == Implementation where
+  R : Join(GcdDomain, OrderedSet, CharacteristicZero,
+           RetractableTo Integer, LinearlyExplicitRingOver Integer)
+  F : Join(TranscendentalFunctionCategory, AlgebraicallyClosedField,
+           FunctionSpace R)
+ 
+  Z   ==> Integer
+  SE  ==> Symbol
+  K   ==> Kernel F
+  P   ==> SparseMultivariatePolynomial(R, K)
+  UP  ==> SparseUnivariatePolynomial F
+  RF  ==> Fraction UP
+  NL  ==> Record(coeff:F,logand:F)
+  RRF ==> Record(mainpart:F,limitedlogs:List NL)
+  U   ==> Union(RRF, "failed")
+  ULF ==> Union(List F, "failed")
+  UEX ==> Union(Record(ratpart:F, coeff:F), "failed")
+ 
+  Exports ==> with
+    rischDEsys: (Z, F, F, F, SE, (F, List F) -> U, (F, F) -> UEX) -> ULF
+      ++ rischDEsys(n, f, g_1, g_2, x,lim,ext) returns \spad{y_1.y_2} such that
+      ++ \spad{(dy1/dx,dy2/dx) + ((0, - n df/dx),(n df/dx,0)) (y1,y2) = (g1,g2)}
+      ++ if \spad{y_1,y_2} exist, "failed" otherwise.
+      ++ lim is a limited integration function,
+      ++ ext is an extended integration function.
+ 
+  Implementation ==> add
+
+    import IntegrationTools(R, F)
+    import ElementaryRischDE(R, F)
+    import TranscendentalRischDESystem(F, UP)
+    import PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                                                             K, R, P, F)
+ 
+    basecase   : (F, F, F, K) -> ULF
+ 
+    -- solve (y1',y2') + ((0, -nfp), (nfp, 0)) (y1,y2) = (g1, g2), base case
+    basecase(nfp, g1, g2, k) ==
+      (ans := baseRDEsys(univariate(nfp, k), univariate(g1, k),
+                         univariate(g2, k))) case "failed" => "failed"
+      l := ans::List(RF)
+      [multivariate(first l, k), multivariate(second l, k)]
+ 
+    -- solve (y1',y2') + ((0, -n f'), (n f', 0)) (y1,y2) = (g1, g2)
+    rischDEsys(n, f, g1, g2, x, limint, extint) ==
+      zero? g1 and zero? g2 => [0, 0]
+      zero?(nfp := n * differentiate(f, x)) =>
+        ((u1 := limint(g1, empty())) case "failed") or
+          ((u2 := limint(g1, empty())) case "failed") => "failed"
+        [u1.mainpart, u2.mainpart]
+      freeOf?(y1 := g2 / nfp, x) and freeOf?(y2 := - g1 / nfp, x) => [y1, y2]
+      vl := varselect(union(kernels nfp, union(kernels g1, kernels g2)), x)
+      symbolIfCan(k := kmax vl) case SE => basecase(nfp, g1, g2, k)
+      error "rischDEsys: can only handle rational functions for now"
+
+\end{chunk}
+
+\begin{chunk}{COQ RDEEFS}
+(* package RDEEFS *)
+(*
+
+    import IntegrationTools(R, F)
+    import ElementaryRischDE(R, F)
+    import TranscendentalRischDESystem(F, UP)
+    import PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                                                             K, R, P, F)
+ 
+    basecase   : (F, F, F, K) -> ULF
+ 
+    -- solve (y1',y2') + ((0, -nfp), (nfp, 0)) (y1,y2) = (g1, g2), base case
+    basecase(nfp, g1, g2, k) ==
+      (ans := baseRDEsys(univariate(nfp, k), univariate(g1, k),
+                         univariate(g2, k))) case "failed" => "failed"
+      l := ans::List(RF)
+      [multivariate(first l, k), multivariate(second l, k)]
+ 
+    -- solve (y1',y2') + ((0, -n f'), (n f', 0)) (y1,y2) = (g1, g2)
+    rischDEsys(n, f, g1, g2, x, limint, extint) ==
+      zero? g1 and zero? g2 => [0, 0]
+      zero?(nfp := n * differentiate(f, x)) =>
+        ((u1 := limint(g1, empty())) case "failed") or
+          ((u2 := limint(g1, empty())) case "failed") => "failed"
+        [u1.mainpart, u2.mainpart]
+      freeOf?(y1 := g2 / nfp, x) and freeOf?(y2 := - g1 / nfp, x) => [y1, y2]
+      vl := varselect(union(kernels nfp, union(kernels g1, kernels g2)), x)
+      symbolIfCan(k := kmax vl) case SE => basecase(nfp, g1, g2, k)
+      error "rischDEsys: can only handle rational functions for now"
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{RDEEFS.dotabb}
+"RDEEFS" [color="#FF4488",href="bookvol10.4.pdf#nameddest=RDEEFS"]
+"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"]
+"FS" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FS"]
 "RDEEFS" -> "ACF"
 "RDEEFS" -> "FS"
 
@@ -28659,10 +38905,12 @@ EllipticFunctionsUnivariateTaylorSeries(Coef,UTS):
        ++\spad{sncndn(s,c)} is used internally.
  
   Implementation ==> add
+
     import StreamTaylorSeriesOperations Coef
     UPS==> StreamTaylorSeriesOperations Coef
     integrate ==> lazyIntegrate
     sncndnre:(Coef,L ST,ST,Coef) -> L ST
+
     sncndnre(k,scd,dx,sign) ==
             [integrate(0,      scd.2*$UPS scd.3*$UPS dx),  _
              integrate(1,  sign*scd.1*$UPS scd.3*$UPS dx),  _
@@ -28672,8 +38920,11 @@ EllipticFunctionsUnivariateTaylorSeries(Coef,UTS):
       empty? z => [0 :: ST,1 :: ST,1::ST]
       frst z = 0 => YS(x +-> sncndnre(k,x,deriv z,-1),3)
       error "ELFUTS:sncndn: constant coefficient should be 0"
+
     sn(x,k)  == series sncndn.(coefficients x,k).1
+
     cn(x,k)  == series sncndn.(coefficients x,k).2
+
     dn(x,k)  == series sncndn.(coefficients x,k).3
 
 \end{chunk}
@@ -28681,6 +38932,28 @@ EllipticFunctionsUnivariateTaylorSeries(Coef,UTS):
 \begin{chunk}{COQ ELFUTS}
 (* package ELFUTS *)
 (*
+
+    import StreamTaylorSeriesOperations Coef
+    UPS==> StreamTaylorSeriesOperations Coef
+    integrate ==> lazyIntegrate
+    sncndnre:(Coef,L ST,ST,Coef) -> L ST
+
+    sncndnre(k,scd,dx,sign) ==
+            [integrate(0,      scd.2*$UPS scd.3*$UPS dx),  _
+             integrate(1,  sign*scd.1*$UPS scd.3*$UPS dx),  _
+             integrate(1,sign*k**2*$UPS scd.1*$UPS scd.2*$UPS dx)]
+ 
+    sncndn(z,k) ==
+      empty? z => [0 :: ST,1 :: ST,1::ST]
+      frst z = 0 => YS(x +-> sncndnre(k,x,deriv z,-1),3)
+      error "ELFUTS:sncndn: constant coefficient should be 0"
+
+    sn(x,k)  == series sncndn.(coefficients x,k).1
+
+    cn(x,k)  == series sncndn.(coefficients x,k).2
+
+    dn(x,k)  == series sncndn.(coefficients x,k).3
+
 *)
 
 \end{chunk}
@@ -28744,6 +39017,7 @@ EquationFunctions2(S: Type, R: Type): with
     map: (S ->R ,Equation S) -> Equation R
       ++ map(f,eq) returns an equation where f is applied to the sides of eq
  == add
+
     map(fn, eqn) == equation(fn lhs eqn, fn rhs eqn)
 
 \end{chunk}
@@ -28751,6 +39025,9 @@ EquationFunctions2(S: Type, R: Type): with
 \begin{chunk}{COQ EQ2}
 (* package EQ2 *)
 (*
+
+    map(fn, eqn) == equation(fn lhs eqn, fn rhs eqn)
+
 *)
 
 \end{chunk}
@@ -28900,6 +39177,7 @@ ErrorFunctions() : Exports == Implementation where
   Implementation ==> add
  
     prefix1 : String := "Error signalled from user code: %l "
+
     prefix2 : String := "Error signalled from user code in function  "
  
     doit(s : String) : Exit ==
@@ -28929,6 +39207,33 @@ ErrorFunctions() : Exports == Implementation where
 \begin{chunk}{COQ ERROR}
 (* package ERROR *)
 (*
+ 
+    prefix1 : String := "Error signalled from user code: %l "
+
+    prefix2 : String := "Error signalled from user code in function  "
+ 
+    doit(s : String) : Exit ==
+      throwKeyedMsg(s,nil$(List String))$Lisp
+      -- there are no objects of type Exit, so we'll fake one,
+      -- knowing we will never get to this step anyway.
+      "exit" pretend Exit
+ 
+    error(s : String) : Exit ==
+      doit concat [prefix1,s]
+ 
+    error(l : List String) : Exit ==
+      s : String := prefix1
+      for x in l repeat s := concat [s," ",x]
+      doit s
+ 
+    error(fn : String,s : String) : Exit ==
+      doit concat [prefix2,fn,":  %l ",s]
+ 
+    error(fn : String, l : List String) : Exit ==
+      s : String := concat [prefix2,fn,":  %l"]
+      for x in l repeat s := concat [s," ",x]
+      doit s
+
 *)
 
 \end{chunk}
@@ -30180,6 +40485,7 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where
        ++X euclideanGroebner(an,"info","redcrit")
 
  C== add
+
    Ex ==> OutputForm
    lc ==> leadingCoefficient
    red ==> reductum
@@ -30480,7 +40786,8 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where
      lf1:= leadingCoefficient(f1)
      ls:= leadingCoefficient(s)
      e: Union(Expon, "failed")
-     (((e:= subtractIfCan(ds, degree f1))  case "failed" ) or sizeLess?(ls, lf1) ) =>
+     (((e:= subtractIfCan(ds, degree f1))  case "failed" ) _
+           or sizeLess?(ls, lf1) ) =>
         eRed(s, rest(H), Hh)
      sdf1:= divide(ls, lf1)
      q1:= sdf1.quotient
@@ -30645,6 +40952,468 @@ EuclideanGroebnerBasisPackage(Dom, Expon, VarSet, Dpol): T == C where
 \begin{chunk}{COQ GBEUCLID}
 (* package GBEUCLID *)
 (*
+
+   Ex ==> OutputForm
+   lc ==> leadingCoefficient
+   red ==> reductum
+
+   import OutputForm
+ 
+   ------  Definition list of critPair
+   ------  lcmfij is now lcm of headterm of poli and polj
+   ------  lcmcij is now lcm of of lc poli and lc polj
+ 
+   critPair ==>Record(lcmfij: Expon, lcmcij: Dom, poli:Dpol, polj: Dpol )
+   Prinp    ==> Record( ci:Dpol,tci:Integer,cj:Dpol,tcj:Integer,c:Dpol,
+                tc:Integer,rc:Dpol,trc:Integer,tH:Integer,tD:Integer)
+ 
+   ------  Definition of intermediate functions
+ 
+   strongGbasis: (List(Dpol), Integer, Integer) -> List(Dpol)
+   eminGbasis: List(Dpol) -> List(Dpol)
+   ecritT: (critPair ) -> Boolean
+   ecritM: (Expon, Dom, Expon, Dom) -> Boolean
+   ecritB: (Expon, Dom, Expon, Dom, Expon, Dom) -> Boolean
+   ecrithinH: (Dpol, List(Dpol)) -> Boolean
+   ecritBonD: (Dpol, List(critPair)) -> List(critPair)
+   ecritMTondd1:(List(critPair)) -> List(critPair)
+   ecritMondd1:(Expon, Dom, List(critPair)) -> List(critPair)
+   crithdelH: (Dpol, List(Dpol)) -> List(Dpol)
+   eupdatF: (Dpol, List(Dpol) ) -> List(Dpol)
+   updatH: (Dpol, List(Dpol), List(Dpol), List(Dpol) ) -> List(Dpol)
+   sortin: (Dpol, List(Dpol) ) -> List(Dpol)
+   eRed: (Dpol, List(Dpol), List(Dpol) )  ->  Dpol
+   ecredPol: (Dpol, List(Dpol) ) -> Dpol
+   esPol: (critPair) -> Dpol
+   updatD: (List(critPair), List(critPair)) -> List(critPair)
+   lepol: Dpol -> Integer
+   prinshINFO : Dpol -> Void
+   prindINFO: (critPair, Dpol, Dpol,Integer,Integer,Integer) -> Integer
+   prinpolINFO: List(Dpol) -> Void
+   prinb: Integer -> Void
+ 
+   ------    MAIN ALGORITHM GROEBNER ------------------------
+   euclideanGroebner( Pol: List(Dpol) ) ==
+     eminGbasis(strongGbasis(Pol,0,0))
+ 
+   euclideanGroebner( Pol: List(Dpol), xx1: String) ==
+     xx1 = "redcrit" =>
+       eminGbasis(strongGbasis(Pol,1,0))
+     xx1 = "info" =>
+       eminGbasis(strongGbasis(Pol,2,1))
+     print("   "::Ex)
+     print("WARNING: options are - redcrit and/or info - "::Ex)
+     print("         you didn't type them correct"::Ex)
+     print("         please try again"::Ex)
+     print("   "::Ex)
+     []
+ 
+   euclideanGroebner( Pol: List(Dpol), xx1: String, xx2: String) ==
+     (xx1 = "redcrit" and xx2 = "info") or
+      (xx1 = "info" and xx2 = "redcrit")   =>
+       eminGbasis(strongGbasis(Pol,1,1))
+     xx1 = "redcrit" and xx2 = "redcrit" =>
+       eminGbasis(strongGbasis(Pol,1,0))
+     xx1 = "info" and xx2 = "info" =>
+       eminGbasis(strongGbasis(Pol,2,1))
+     print("   "::Ex)
+     print("WARNING:  options are - redcrit and/or info - "::Ex)
+     print("          you didn't type them correct"::Ex)
+     print("          please try again "::Ex)
+     print("   "::Ex)
+     []
+ 
+   ------    calculate basis
+ 
+   strongGbasis(Pol: List(Dpol),xx1: Integer, xx2: Integer ) ==
+     dd1, D : List(critPair)
+ 
+     ---------   create D and Pol
+ 
+     Pol1:= sort((z1:Dpol,z2:Dpol):Boolean +-> (degree z1 > degree z2) or
+                    ((degree z1 = degree z2 ) and
+                       sizeLess?(leadingCoefficient z2,leadingCoefficient z1)),
+                 Pol)
+     Pol:= [first(Pol1)]
+     H:= Pol
+     Pol1:= rest(Pol1)
+     D:= nil
+     while ^null Pol1 repeat
+        h:= first(Pol1)
+        Pol1:= rest(Pol1)
+        en:= degree(h)
+        lch:= lc h
+        dd1:= 
+         [[sup(degree(x), en), lcm(leadingCoefficient x, lch), x, h]$critPair
+            for x in Pol]
+        D:= updatD(
+             ecritMTondd1(
+              sort(
+               (z1:critPair,z2:critPair):Boolean+->
+                (z1.lcmfij < z2.lcmfij) or
+                 (( z1.lcmfij = z2.lcmfij ) and
+                   ( sizeLess?(z1.lcmcij,z2.lcmcij)) ), dd1)), 
+                    ecritBonD(h,D))
+        Pol:= cons(h, eupdatF(h, Pol))
+        ((en = degree(first(H))) and 
+          (leadingCoefficient(h) = leadingCoefficient(first(H)) ) ) =>
+              " go to top of while "
+        H:= updatH(h,H,crithdelH(h,H),[h])
+        H:= sort((z1,z2) +-> (degree z1 > degree z2) or
+                 ((degree z1 = degree z2 ) and
+                  sizeLess?(leadingCoefficient z2,leadingCoefficient z1)), H)
+     D:= sort((z1,z2) +-> (z1.lcmfij < z2.lcmfij) or
+              (( z1.lcmfij = z2.lcmfij ) and
+               ( sizeLess?(z1.lcmcij,z2.lcmcij)) ) ,D)
+     xx:= xx2
+ 
+     --------  loop
+ 
+     while ^null D repeat
+         D0:= first D
+         ep:=esPol(D0)
+         D:= rest(D)
+         eh:= ecredPol(eRed(ep,H,H),H)
+         if xx1 = 1 then
+               prinshINFO(eh)
+         eh = 0 =>
+              if xx2 = 1 then
+                  ala:= prindINFO(D0,ep,eh,#H, #D, xx)
+                  xx:= 2
+              " go to top of while "
+         eh := unitCanonical eh
+         e:= degree(eh)
+         leh:= lc eh
+         dd1:= 
+          [[sup(degree(x), e), lcm(leadingCoefficient x, leh), x, eh]$critPair
+            for x in Pol]
+         D:= updatD(
+              ecritMTondd1(
+               sort((z1,z2) +-> (z1.lcmfij < z2.lcmfij) or 
+                    (( z1.lcmfij = z2.lcmfij ) and
+                     ( sizeLess?(z1.lcmcij,z2.lcmcij)) ), dd1)),
+                       ecritBonD(eh,D))
+         Pol:= cons(eh,eupdatF(eh,Pol))
+         ^ecrithinH(eh,H) or
+           ((e = degree(first(H))) and 
+             (leadingCoefficient(eh) = leadingCoefficient(first(H)) ) ) =>
+              if xx2 = 1 then
+                  ala:= prindINFO(D0,ep,eh,#H, #D, xx)
+                  xx:= 2
+              " go to top of while "
+         H:= updatH(eh,H,crithdelH(eh,H),[eh])
+         H:= sort((z1,z2)+-> (degree z1 > degree z2) or
+             ((degree z1 = degree z2 ) and
+                 sizeLess?(leadingCoefficient z2,leadingCoefficient z1)), H)
+         if xx2 = 1 then
+           ala:= prindINFO(D0,ep,eh,#H, #D, xx)
+           xx:= 2
+           " go to top of while "
+     if xx2 = 1 then
+       prinpolINFO(Pol)
+       print("    THE GROEBNER BASIS over EUCLIDEAN DOMAIN"::Ex)
+     if xx1 = 1 and xx2 ^= 1 then
+       print("    THE GROEBNER BASIS over EUCLIDEAN DOMAIN"::Ex)
+     H
+ 
+             --------------------------------------
+ 
+             --- erase multiple of e in D2 using crit M
+ 
+   ecritMondd1(e: Expon, c: Dom, D2: List(critPair))==
+      null D2 => nil
+      x:= first(D2)
+      ecritM(e,c, x.lcmfij, lcm(leadingCoefficient(x.poli), 
+             leadingCoefficient(x.polj)))
+         => ecritMondd1(e, c, rest(D2))
+      cons(x, ecritMondd1(e, c, rest(D2)))
+ 
+            -------------------------------
+ 
+   ecredPol(h: Dpol, F: List(Dpol) ) ==
+        h0:Dpol:= 0
+        null F => h
+        while h ^= 0 repeat
+           h0:= h0 + monomial(leadingCoefficient(h),degree(h))
+           h:= eRed(red(h), F, F)
+        h0
+             ----------------------------
+ 
+             --- reduce dd1 using crit T and crit M
+ 
+   ecritMTondd1(dd1: List(critPair))==
+           null dd1 => nil
+           f1:= first(dd1)
+           s1:= #(dd1)
+           cT1:= ecritT(f1)
+           s1= 1 and cT1 => nil
+           s1= 1 => dd1
+           e1:= f1.lcmfij
+           r1:= rest(dd1)
+           f2:= first(r1)
+           e1 = f2.lcmfij and f1.lcmcij = f2.lcmcij =>
+              cT1 =>   ecritMTondd1(cons(f1, rest(r1)))
+              ecritMTondd1(r1)
+           dd1 := ecritMondd1(e1, f1.lcmcij, r1)
+           cT1 => ecritMTondd1(dd1)
+           cons(f1, ecritMTondd1(dd1))
+ 
+             -----------------------------
+ 
+             --- erase elements in D fullfilling crit B
+ 
+   ecritBonD(h:Dpol, D: List(critPair))==
+         null D => nil
+         x:= first(D)
+         x1:= x.poli
+         x2:= x.polj
+         ecritB(degree(h), leadingCoefficient(h), 
+                degree(x1),leadingCoefficient(x1),
+                degree(x2),leadingCoefficient(x2)) =>
+           ecritBonD(h, rest(D))
+         cons(x, ecritBonD(h, rest(D)))
+ 
+             -----------------------------
+ 
+             --- concat F and h and erase multiples of h in F
+ 
+   eupdatF(h: Dpol, F: List(Dpol)) ==
+       null F => nil
+       f1:= first(F)
+       ecritM(degree h,leadingCoefficient(h), degree f1,leadingCoefficient(f1))
+           => eupdatF(h, rest(F))
+       cons(f1, eupdatF(h, rest(F)))
+ 
+             -----------------------------
+             --- concat H and h and erase multiples of h in H
+ 
+   updatH(h: Dpol, H: List(Dpol), Hh: List(Dpol), Hhh: List(Dpol)) ==
+       null H => append(Hh,Hhh)
+       h1:= first(H)
+       hlcm:= sup(degree(h1), degree(h))
+       plc:= extendedEuclidean(leadingCoefficient(h), leadingCoefficient(h1))
+       hp:= monomial(plc.coef1,subtractIfCan(hlcm, degree(h))::Expon)*h +
+            monomial(plc.coef2,subtractIfCan(hlcm, degree(h1))::Expon)*h1
+       (ecrithinH(hp, Hh) and ecrithinH(hp, Hhh)) =>
+         hpp:= append(rest(H),Hh)
+         hp:= ecredPol(eRed(hp,hpp,hpp),hpp)
+         updatH(h, rest(H), crithdelH(hp,Hh),cons(hp,crithdelH(hp,Hhh)))
+       updatH(h, rest(H), Hh,Hhh)
+ 
+             --------------------------------------------------
+             ---- delete elements in cons(h,H)
+ 
+   crithdelH(h: Dpol, H: List(Dpol))==
+        null H => nil
+        h1:= first(H)
+        dh1:= degree h1
+        dh:= degree h
+        ecritM(dh, lc h, dh1, lc h1) => crithdelH(h, rest(H))
+        dh1 = sup(dh,dh1) =>
+         plc:= extendedEuclidean( lc h1, lc h)
+         cons(plc.coef1*h1+monomial(plc.coef2,subtractIfCan(dh1,dh)::Expon)*h,
+               crithdelH(h,rest(H)))
+        cons(h1, crithdelH(h,rest(H)))
+ 
+   eminGbasis(F: List(Dpol)) ==
+        null F => nil
+        newbas := eminGbasis rest F
+        cons(ecredPol( first(F), newbas),newbas)
+ 
+             ------------------------------------------------
+             --- does h belong to H
+ 
+   ecrithinH(h: Dpol, H: List(Dpol))==
+        null H  => true
+        h1:= first(H)
+        ecritM(degree h1, lc h1, degree h, lc h) => false
+        ecrithinH(h, rest(H))
+ 
+            -----------------------------
+            --- calculate  euclidean S-polynomial of a critical pair
+ 
+   esPol(p:critPair)==
+      Tij := p.lcmfij
+      fi := p.poli
+      fj := p.polj
+      lij:= lcm(leadingCoefficient(fi), leadingCoefficient(fj))
+      red(fi)*monomial((lij exquo leadingCoefficient(fi))::Dom,
+                        subtractIfCan(Tij, degree fi)::Expon) -
+        red(fj)*monomial((lij exquo leadingCoefficient(fj))::Dom,
+                         subtractIfCan(Tij, degree fj)::Expon)
+ 
+            ----------------------------
+ 
+            --- euclidean reduction mod F
+ 
+   eRed(s: Dpol, H: List(Dpol), Hh: List(Dpol)) ==
+     ( s = 0 or null H ) => s
+     f1:= first(H)
+     ds:= degree s
+     lf1:= leadingCoefficient(f1)
+     ls:= leadingCoefficient(s)
+     e: Union(Expon, "failed")
+     (((e:= subtractIfCan(ds, degree f1))  case "failed" ) _
+           or sizeLess?(ls, lf1) ) =>
+        eRed(s, rest(H), Hh)
+     sdf1:= divide(ls, lf1)
+     q1:= sdf1.quotient
+     sdf1.remainder = 0 =>
+        eRed(red(s) - monomial(q1,e)*reductum(f1), Hh, Hh)
+     eRed(s -(monomial(q1, e)*f1), rest(H), Hh)
+ 
+            ----------------------------
+ 
+            --- crit T  true, if e1 and e2 are disjoint
+ 
+   ecritT(p: critPair) ==
+          pi:= p.poli
+          pj:= p.polj
+          ci:= lc pi
+          cj:= lc pj
+          (p.lcmfij = degree pi + degree pj) and  (p.lcmcij = ci*cj)
+ 
+            ----------------------------
+ 
+            --- crit M - true, if lcm#2 multiple of lcm#1
+ 
+   ecritM(e1: Expon, c1: Dom, e2: Expon, c2: Dom) ==
+     en: Union(Expon, "failed")
+     ((en:=subtractIfCan(e2, e1)) case "failed") or
+       ((c2 exquo c1) case "failed") => false
+     true
+            ----------------------------
+ 
+            --- crit B - true, if eik is a multiple of eh and eik ^equal
+            ---          lcm(eh,ei) and eik ^equal lcm(eh,ek)
+ 
+   ecritB(eh:Expon, ch: Dom, ei:Expon, ci: Dom, ek:Expon, ck: Dom) ==
+       eik:= sup(ei, ek)
+       cik:= lcm(ci, ck)
+       ecritM(eh, ch, eik, cik) and
+             ^ecritM(eik, cik, sup(ei, eh), lcm(ci, ch)) and
+                ^ecritM(eik, cik, sup(ek, eh), lcm(ck, ch))
+ 
+            -------------------------------
+ 
+            --- reduce p1 mod lp
+ 
+   euclideanNormalForm(p1: Dpol, lp: List(Dpol))==
+       eRed(p1, lp, lp)
+ 
+            ---------------------------------
+ 
+            ---  insert element in sorted list
+ 
+   sortin(p1: Dpol, lp: List(Dpol))==
+      null lp => [p1]
+      f1:= first(lp)
+      elf1:= degree(f1)
+      ep1:= degree(p1)
+      ((elf1 < ep1) or ((elf1 = ep1) and
+        sizeLess?(leadingCoefficient(f1),leadingCoefficient(p1)))) =>
+         cons(f1,sortin(p1, rest(lp)))
+      cons(p1,lp)
+ 
+   updatD(D1: List(critPair), D2: List(critPair)) ==
+      null D1 => D2
+      null D2 => D1
+      dl1:= first(D1)
+      dl2:= first(D2)
+      (dl1.lcmfij  <  dl2.lcmfij) => cons(dl1, updatD(D1.rest, D2))
+      cons(dl2, updatD(D1, D2.rest))
+ 
+            ----  calculate number of terms of polynomial
+ 
+   lepol(p1:Dpol)==
+      n: Integer
+      n:= 0
+      while p1 ^= 0 repeat
+         n:= n + 1
+         p1:= red(p1)
+      n
+ 
+            ----  print blanc lines
+ 
+   prinb(n: Integer)==
+        for i in 1..n repeat messagePrint("    ")
+ 
+            ----  print reduced critpair polynom
+ 
+   prinshINFO(h: Dpol)==
+           prinb(2)
+           messagePrint(" reduced Critpair - Polynom :")
+           prinb(2)
+           print(h::Ex)
+           prinb(2)
+ 
+            -------------------------------
+ 
+            ----  print info string
+ 
+   prindINFO(cp: critPair, ps: Dpol, ph: Dpol, i1:Integer,
+             i2:Integer, n:Integer) ==
+       ll: List Prinp
+       a: Dom
+       cpi:= cp.poli
+       cpj:= cp.polj
+       if n = 1 then
+        prinb(1)
+        messagePrint("you choose option  -info-  ")
+        messagePrint("abbrev. for the following information strings are")
+        messagePrint("  ci  =>  Leading monomial  for critpair calculation")
+        messagePrint("  tci =>  Number of terms of polynomial i")
+        messagePrint("  cj  =>  Leading monomial  for critpair calculation")
+        messagePrint("  tcj =>  Number of terms of polynomial j")
+        messagePrint("  c   =>  Leading monomial of critpair polynomial")
+        messagePrint("  tc  =>  Number of terms of critpair polynomial")
+        messagePrint("  rc  =>  Leading monomial of redcritpair polynomial")
+        messagePrint("  trc =>  Number of terms of redcritpair polynomial")
+        messagePrint("  tF  =>  Number of polynomials in reduction list F")
+        messagePrint("  tD  =>  Number of critpairs still to do")
+        prinb(4)
+        n:= 2
+       prinb(1)
+       a:= 1
+       ph = 0  =>
+          ps = 0 =>
+            ll:= [[monomial(a,degree(cpi)),lepol(cpi),monomial(a,degree(cpj)),
+             lepol(cpj),ps,0,ph,0,i1,i2]$Prinp]
+            print(ll::Ex)
+            prinb(1)
+            n
+          ll:= [[monomial(a,degree(cpi)),lepol(cpi),
+            monomial(a,degree(cpj)),lepol(cpj),monomial(a,degree(ps)),
+             lepol(ps), ph,0,i1,i2]$Prinp]
+          print(ll::Ex)
+          prinb(1)
+          n
+       ll:= [[monomial(a,degree(cpi)),lepol(cpi),
+            monomial(a,degree(cpj)),lepol(cpj),monomial(a,degree(ps)),
+             lepol(ps),monomial(a,degree(ph)),lepol(ph),i1,i2]$Prinp]
+       print(ll::Ex)
+       prinb(1)
+       n
+ 
+            -------------------------------
+ 
+            ----  print the groebner basis polynomials
+ 
+   prinpolINFO(pl: List(Dpol))==
+       n:Integer
+       n:= #pl
+       prinb(1)
+       n = 1 =>
+         print("  There is 1  Groebner Basis Polynomial "::Ex)
+         prinb(2)
+       print("  There are "::Ex)
+       prinb(1)
+       print(n::Ex)
+       prinb(1)
+       print("  Groebner Basis Polynomials. "::Ex)
+       prinb(2)
+ 
+
 *)
 
 \end{chunk}
@@ -30726,11 +41495,13 @@ EvaluateCycleIndicators(F):T==C where
          ++ the function f to each integer in a monomial partition,
          ++ forms their product and sums the results over all monomials.
     C== add
+
        evp:((I->F),PTN)->F
        fn:I->F
        pt:PTN
        spol:SPOL RN
        i:I
+
        evp(fn, pt)== _*/[fn i for i in pt::(L I)]
  
        eval(fn,spol)==
@@ -30743,6 +41514,20 @@ EvaluateCycleIndicators(F):T==C where
 \begin{chunk}{COQ EVALCYC}
 (* package EVALCYC *)
 (*
+
+       evp:((I->F),PTN)->F
+       fn:I->F
+       pt:PTN
+       spol:SPOL RN
+       i:I
+
+       evp(fn, pt)== _*/[fn i for i in pt::(L I)]
+ 
+       eval(fn,spol)==
+        if spol=0
+        then 0
+        else ((lc spol)* evp(fn,degree spol)) + eval(fn,red spol)
+
 *)
 
 \end{chunk}
@@ -30908,7 +41693,7 @@ ExpertSystemContinuityPackage(): E == I where
       (retractIfCan(f)@Union(PDF,"failed"))$EDF case PDF
 
     isConstant?(f:EDF):Boolean ==
-      -- tests whether the function can be retracted to a constant (DoubleFloat)
+      -- tests whether the fn can be retracted to a constant (DoubleFloat)
       (retractIfCan(f)@Union(DF,"failed"))$EDF case DF
 
     denominatorIsPolynomial?(args:NIA):Boolean ==
@@ -30996,7 +41781,6 @@ ExpertSystemContinuityPackage(): E == I where
           var:Symbol := first(variables(a))
           c:EDF := w.2
           c1:EDF := w.1
---          entry?(c1,[b::EDF for b in vars]) and (one?(# vars)) =>
           entry?(c1,[b::EDF for b in vars]) and ((# vars) = 1) =>
             c2:DF := edf2df c
             c3 := c2 :: OCDF
@@ -31012,7 +41796,6 @@ ExpertSystemContinuityPackage(): E == I where
           entry?(a,[b::EDF for b in vars]) =>   -- finds entries like sqrt(x)
             st := getStream(n,"ones")
             o := edf2df(second(t)$LEDF)
---            one?(o) or one?(-o) =>           -- is it like (f(x) -/+ 1)
             (o = 1) or (-o = 1) =>           -- is it like (f(x) -/+ 1)
               st := map(t2 +-> -t2/o,st)$StreamFunctions2(DF,DF)
               streamInRange(st,range)
@@ -31046,7 +41829,6 @@ ExpertSystemContinuityPackage(): E == I where
           var:Symbol := first(variables(a))
           c:EDF := w.2
           c1:EDF := w.1
---          entry?(c1,[b::EDF for b in vars]) and (one?(# vars)) =>
           entry?(c1,[b::EDF for b in vars]) and ((# vars) = 1) =>
             c2:DF := edf2df c
             c3 := c2 :: OCDF
@@ -31074,6 +41856,176 @@ ExpertSystemContinuityPackage(): E == I where
 \begin{chunk}{COQ ESCONT}
 (* package ESCONT *)
 (*
+
+    import ExpertSystemToolsPackage
+
+    functionIsPolynomial?(args:NIA):Boolean ==
+      -- tests whether the function can be retracted to a polynomial
+      (retractIfCan(args.fn)@Union(PDF,"failed"))$EDF case PDF
+
+    isPolynomial?(f:EDF):Boolean ==
+      -- tests whether the function can be retracted to a polynomial
+      (retractIfCan(f)@Union(PDF,"failed"))$EDF case PDF
+
+    isConstant?(f:EDF):Boolean ==
+      -- tests whether the fn can be retracted to a constant (DoubleFloat)
+      (retractIfCan(f)@Union(DF,"failed"))$EDF case DF
+
+    denominatorIsPolynomial?(args:NIA):Boolean ==
+      -- tests if the denominator can be retracted to polynomial
+      a:= copy args
+      a.fn:=denominator(args.fn)
+      (functionIsPolynomial?(a))@Boolean
+
+    denIsPolynomial?(f:EDF):Boolean ==
+      -- tests if the denominator can be retracted to polynomial
+      (isPolynomial?(denominator f))@Boolean
+
+    listInRange(l:LDF,range:SOCDF):LDF ==
+      -- returns a list with only those elements internal to the range range
+      [t for t in l | in?(t,range)]
+
+    loseUntil(l:SDF,a:DF):SDF ==
+      empty?(l)$SDF => l
+      f := first(l)$SDF
+      (abs(f) <= abs(a)) => loseUntil(rest(l)$SDF,a)
+      l
+
+    retainUntil(l:SDF,a:DF,b:DF,flag:Boolean):SDF ==
+      empty?(l)$SDF => l
+      f := first(l)$SDF
+      (in?(f)$ExpertSystemContinuityPackage1(a,b)) =>
+        concat(f,retainUntil(rest(l),a,b,false)) 
+      flag => empty()$SDF
+      retainUntil(rest(l),a,b,true)
+
+    streamInRange(l:SDF,range:SOCDF):SDF ==
+      -- returns a stream with only those elements internal to the range range
+      a := getlo(range := dfRange(range))
+      b := gethi(range)
+      explicitlyFinite?(l) =>
+        select(in?$ExpertSystemContinuityPackage1(a,b),l)$SDF
+      negative?(a*b) => retainUntil(l,a,b,false)                
+      negative?(a) => 
+        l := loseUntil(l,b)
+        retainUntil(l,a,b,false)
+      l := loseUntil(l,a)
+      retainUntil(l,a,b,false)
+
+    getStream(n:Symbol,s:String):SDF ==
+      import RS
+      entry?(n,bfKeys()$BasicFunctions)$(List(Symbol)) =>
+        c := bfEntry(n)$BasicFunctions
+        (s = "zeros")@Boolean => c.zeros
+        (s = "singularities")@Boolean => c.singularities
+        (s = "ones")@Boolean => c.ones
+      empty()$SDF
+
+    polynomialZeros(fn:PFI,var:Symbol,range:SOCDF):LDF ==
+      up := unmakeSUP(univariate(fn)$PFI)$UP(var,FI)
+      range := dfRange(range)
+      r:Record(left:FI,right:FI) := [df2fi(getlo(range)), df2fi(gethi(range))]
+      ans:List(Record(left:FI,right:FI)) := 
+          realZeros(up,r,1/1000000000000000000)$RealZeroPackageQ(UP(var,FI))
+      listInRange(dflist(ans),range)
+
+    functionIsFracPolynomial?(args:NIA):Boolean ==
+      -- tests whether the function can be retracted to a fraction
+      -- where both numerator and denominator are polynomial
+      (retractIfCan(args.fn)@Union(FPDF,"failed"))$EDF case FPDF
+
+    problemPoints(f:EDF,var:Symbol,range:SOCDF):LDF ==
+      (denIsPolynomial?(f))@Boolean =>
+        c := retract(edf2efi(denominator(f)))@PFI
+        polynomialZeros(c,var,range)
+      empty()$LDF
+
+    zerosOf(e:EDF,vars:List Symbol,range:SOCDF):SDF ==
+      (u := isQuotient(e)) case EDF =>
+        singularitiesOf(u,vars,range)
+      k := kernels(e)$EDF
+      ((nk := # k) = 0)@Boolean => empty()$SDF -- constant found.
+      (nk = 1)@Boolean =>                      -- single expression found.
+        ker := first(k)$LKEDF
+        n := name(operator(ker)$KEDF)$BO
+        entry?(n,vars) =>                   -- polynomial found.
+          c := retract(edf2efi(e))@PFI
+          coerce(polynomialZeros(c,n,range))$SDF
+        a := first(argument(ker)$KEDF)$LEDF
+        (not (n = log :: Symbol)@Boolean) and ((w := isPlus a) case LEDF) =>
+          var:Symbol := first(variables(a))
+          c:EDF := w.2
+          c1:EDF := w.1
+          entry?(c1,[b::EDF for b in vars]) and ((# vars) = 1) =>
+            c2:DF := edf2df c
+            c3 := c2 :: OCDF
+            varEdf := var :: EDF
+            varEqn := equation(varEdf,c1-c)$EEDF
+            range2 := (lo(range)+c3)..(hi(range)+c3)
+            s := zerosOf(subst(e,varEqn)$EDF,vars,range2)
+            st := map(t1 +-> t1-c2,s)$StreamFunctions2(DF,DF)
+            streamInRange(st,range)
+          zerosOf(a,vars,range)
+        (t := isPlus(e)$EDF) case LEDF =>    -- constant + expression
+          # t > 2 => empty()$SDF
+          entry?(a,[b::EDF for b in vars]) =>   -- finds entries like sqrt(x)
+            st := getStream(n,"ones")
+            o := edf2df(second(t)$LEDF)
+            (o = 1) or (-o = 1) =>           -- is it like (f(x) -/+ 1)
+              st := map(t2 +-> -t2/o,st)$StreamFunctions2(DF,DF)
+              streamInRange(st,range)
+            empty()$SDF
+          empty()$SDF
+        entry?(a,[b::EDF for b in vars]) =>     -- finds entries like sqrt(x)
+          st := getStream(n,"zeros")
+          streamInRange(st,range)
+        (n = tan :: Symbol)@Boolean => 
+          concat([zerosOf(a,vars,range),singularitiesOf(a,vars,range)])
+        (n = sin :: Symbol)@Boolean => 
+          concat([zerosOf(a,vars,range),singularitiesOf(a,vars,range)])
+        empty()$SDF
+      (t := isPlus(e)$EDF) case LEDF => empty()$SDF  -- INCOMPLETE!!!
+      (v := isTimes(e)$EDF) case LEDF =>
+        concat([zerosOf(u,vars,range) for u in v])
+      empty()$SDF
+
+    singularitiesOf(e:EDF,vars:List Symbol,range:SOCDF):SDF ==
+      (u := isQuotient(e)) case EDF =>
+        zerosOf(u,vars,range)
+      (t := isPlus e) case LEDF =>
+        concat([singularitiesOf(u,vars,range) for u in t])
+      (v := isTimes e) case LEDF =>
+        concat([singularitiesOf(u,vars,range) for u in v])
+      (k := mainKernel e) case KEDF => 
+        n := name(operator k)
+        entry?(n,vars) => coerce(problemPoints(e,n,range))$SDF
+        a:EDF := (argument k).1
+        (not (n = log :: Symbol)@Boolean) and ((w := isPlus a) case LEDF) =>
+          var:Symbol := first(variables(a))
+          c:EDF := w.2
+          c1:EDF := w.1
+          entry?(c1,[b::EDF for b in vars]) and ((# vars) = 1) =>
+            c2:DF := edf2df c
+            c3 := c2 :: OCDF
+            varEdf := var :: EDF
+            varEqn := equation(varEdf,c1-c)$EEDF
+            range2 := (lo(range)+c3)..(hi(range)+c3)
+            s := singularitiesOf(subst(e,varEqn)$EDF,vars,range2)
+            st := map(t3 +-> t3-c2,s)$StreamFunctions2(DF,DF)
+            streamInRange(st,range)
+          singularitiesOf(a,vars,range)
+        entry?(a,[b::EDF for b in vars]) =>
+          st := getStream(n,"singularities")
+          streamInRange(st,range)
+        (n = log :: Symbol)@Boolean =>
+          concat([zerosOf(a,vars,range),singularitiesOf(a,vars,range)])
+        singularitiesOf(a,vars,range)
+      empty()$SDF
+
+    singularitiesOf(v:VEDF,vars:List Symbol,range:SOCDF):SDF ==
+      ls := [singularitiesOf(u,vars,range) for u in entries(v)$VEDF]
+      concat(ls)$SDF
+
 *)
 
 \end{chunk}
@@ -31176,6 +42128,12 @@ ExpertSystemContinuityPackage1(A:DF,B:DF): E == I where
 \begin{chunk}{COQ ESCONT1}
 (* package ESCONT1 *)
 (*
+
+    in?(p:DF):Boolean ==
+      a:Boolean := (p < B)$DF
+      b:Boolean := (A < p)$DF
+      (a and b)@Boolean
+
 *)
 
 \end{chunk}
@@ -31454,7 +42412,7 @@ ExpertSystemToolsPackage():E == I where
     att2Result:ATT -> Result
       ++ att2Result(m) converts a attributes record into a \axiomType{Result}
     iflist2Result:IFV -> Result
-      ++ iflist2Result(m) converts a attributes record into a \axiomType{Result}
+      ++ iflist2Result(m) converts attributes record into a \axiomType{Result}
     pdf2ef:PDF -> EF
       ++ pdf2ef(p) coerces a \axiomType{Polynomial DoubleFloat} to 
       ++ \axiomType{Expression Float}
@@ -31463,9 +42421,11 @@ ExpertSystemToolsPackage():E == I where
       ++ \axiomType{DoubleFloat}. It is an error if \axiom{p} is not
       ++ retractable to DoubleFloat.
     df2ef:DF -> EF
-      ++ df2ef(a) coerces a \axiomType{DoubleFloat} to \axiomType{Expression Float}
+      ++ df2ef(a) coerces a \axiomType{DoubleFloat} to 
+      ++ \axiomType{Expression Float}
     fi2df:FI -> DF
-      ++ fi2df(f) coerces a \axiomType{Fraction Integer} to \axiomType{DoubleFloat}
+      ++ fi2df(f) coerces a \axiomType{Fraction Integer} to 
+      ++ \axiomType{DoubleFloat}
     mat:(LDF,NNI) -> MDF
       ++ mat(a,n) constructs a one-dimensional matrix of a.
 
@@ -31553,7 +42513,6 @@ ExpertSystemToolsPackage():E == I where
     isQuotient(expr:EDF):Union(EDF,"failed") ==
       (k := mainKernel expr) case KEDF =>
         (expr = inv(f := k :: KEDF :: EDF)$EDF)$EDF => f
---        one?(numerator expr) => denominator expr
         (numerator expr) = 1 => denominator expr
         "failed"
       "failed"
@@ -31666,7 +42625,8 @@ ExpertSystemToolsPackage():E == I where
           concat(["stability: ",outputMeasure(ifv.stability)]),
            concat(["expense: ",outputMeasure(ifv.expense)]),
             concat(["accuracy: ",outputMeasure(ifv.accuracy)]),
-             concat(["intermediateResults: ",outputMeasure(ifv.intermediateResults)])]
+             concat(["intermediateResults: ",_
+                     outputMeasure(ifv.intermediateResults)])]
       ifa:= coerce(ifvs)$AnyFunctions1(List String)
       ifr:Record(key:Symbol,entry:Any) := [intensityFunctions@Symbol,ifa]
       construct([ifr])$Result
@@ -31676,6 +42636,207 @@ ExpertSystemToolsPackage():E == I where
 \begin{chunk}{COQ ESTOOLS}
 (* package ESTOOLS *)
 (*
+
+    mat(a:LDF,n:NNI):MDF ==
+      empty?(a)$LDF => zero(1,n)$MDF
+      matrix(list([i for i in a for j in 1..n])$(List LDF))$MDF
+
+    f2df(f:F):DF == (convert(f)@DF)$F
+
+    ef2edf(f:EF):EDF == map(f2df,f)$EF2(F,DF)
+
+    fi2df(f:FI):DF == coerce(f)$DF
+
+    ocf2ocdf(a:OCF):OCDF ==
+      finite? a => (f2df(retract(a)@F))::OCDF
+      a pretend OCDF
+
+    socf2socdf(a:SOCF):SOCDF ==
+      segment(ocf2ocdf(lo a),ocf2ocdf(hi a))
+
+    convert(l:List SOCF):List SOCDF == [socf2socdf a for a in l]
+
+    pdf2df(p:PDF):DF == retract(p)@DF
+
+    df2ef(a:DF):EF ==
+      b := convert(a)@Float
+      coerce(b)$EF
+
+    pdf2ef(p:PDF):EF == df2ef(pdf2df(p))
+
+    edf2fi(m:EDF):FI == retract(retract(m)@DF)@FI
+
+    edf2df(m:EDF):DF == retract(m)@DF
+
+    df2fi(r:DF):FI == (retract(r)@FI)$DF
+
+    dfRange(r:SOCDF):SOCDF ==
+      if infinite?(lo(r))$OCDF then r := -(max()$DF :: OCDF)..hi(r)$SOCDF
+      if infinite?(hi(r))$OCDF then r := lo(r)$SOCDF..(max()$DF :: OCDF)
+      r
+
+    dflist(l:List(Record(left:FI,right:FI))):LDF == [u.left :: DF for u in l]
+
+    edf2efi(f:EDF):EFI == map(df2fi,f)$EF2(DF,FI)
+
+    df2st(n:DF):String == (convert((convert(n)@Float)$DF)@ST)$Float
+
+    f2st(n:F):String == (convert(n)@ST)$Float
+
+    ldf2lst(ln:LDF):LST == [df2st f for f in ln]
+
+    sdf2lst(ln:SDF):LST ==
+      explicitlyFinite? ln => 
+        m := map(df2st,ln)$StreamFunctions2(DF,ST)
+        if index?(20,m)$SS then
+          split!(m,20)
+          m := concat(m,".......")
+        m := complete(m)$SS 
+        entries(m)$SS
+      empty()$LST
+
+    df2mf(n:DF):MF == (df2fi(n))::MF
+
+    ldf2vmf(l:LDF):VMF ==
+      m := [df2mf(n) for n in l]
+      vector(m)$VMF
+
+    edf2ef(e:EDF):EF == map(convert$DF,e)$EF2(DF,Float)
+
+    vedf2vef(vedf:VEDF):VEF == vector([edf2ef e for e in members(vedf)])
+
+    getlo(u:SOCDF):DF == retract(lo(u))@DF
+
+    gethi(u:SOCDF):DF == retract(hi(u))@DF
+  
+    in?(p:DF,range:SOCDF):Boolean ==
+      top := gethi(range)
+      bottom := getlo(range)
+      a:Boolean := (p < top)$DF
+      b:Boolean := (p > bottom)$DF
+      (a and b)@Boolean
+
+    isQuotient(expr:EDF):Union(EDF,"failed") ==
+      (k := mainKernel expr) case KEDF =>
+        (expr = inv(f := k :: KEDF :: EDF)$EDF)$EDF => f
+        (numerator expr) = 1 => denominator expr
+        "failed"
+      "failed"
+
+    numberOfOperations1(fn:EDF,numbersSoFar:ON):ON ==
+      (u := isQuotient(fn)) case EDF =>
+        numbersSoFar := numberOfOperations1(u,numbersSoFar)
+      (p := isPlus(fn)) case LEDF =>
+        p := coerce(p)@LEDF
+        np := #p
+        numbersSoFar.additions := (numbersSoFar.additions)+np-1
+        for i in 1..np repeat
+          numbersSoFar := numberOfOperations1(p.i,numbersSoFar)
+        numbersSoFar
+      (t:=isTimes(fn)) case LEDF => 
+        t := coerce(t)@LEDF
+        nt := #t
+        numbersSoFar.multiplications := (numbersSoFar.multiplications)+nt-1
+        for i in 1..nt repeat
+          numbersSoFar := numberOfOperations1(t.i,numbersSoFar)
+        numbersSoFar
+      if (e:=isPower(fn)) case RVE then
+        e := coerce(e)@RVE
+        e.exponent>1 =>  
+          numbersSoFar.exponentiations := inc(numbersSoFar.exponentiations)
+          numbersSoFar := numberOfOperations1(e.val,numbersSoFar)
+      lk := kernels(fn)
+      #lk = 1 =>        -- #lk = 0 => constant found (no further action)
+        k := first(lk)$LKEDF
+        n := name(operator(k)$KEDF)$BO
+        entry?(n,variables(fn)$EDF)$LS => numbersSoFar  -- solo variable found
+        a := first(argument(k)$KEDF)$LEDF
+        numbersSoFar.functionCalls := inc(numbersSoFar.functionCalls)$INT
+        numbersSoFar := numberOfOperations1(a,numbersSoFar)
+      numbersSoFar
+      
+    numberOfOperations(ode:VEDF):ON ==
+      n:ON := [0,0,0,0]
+      for i in 1..#ode repeat
+        n:ON := numberOfOperations1(ode.i,n)
+      n
+
+    expenseOfEvaluation(o:VEDF):F ==
+      ln:ON := numberOfOperations(o)
+      a := ln.additions
+      m := ln.multiplications
+      e := ln.exponentiations
+      f := 10*ln.functionCalls
+      n := (a + m + 4*e + 10*e)
+      (1.0-exp((-n::F/288.0))$F)
+
+    concat(a:Result,b:Result):Result ==
+      membersOfa := (members(a)@List(Record(key:Symbol,entry:Any)))
+      membersOfb := (members(b)@List(Record(key:Symbol,entry:Any)))
+      allMembers:=
+        concat(membersOfa,membersOfb)$List(Record(key:Symbol,entry:Any))
+      construct(allMembers)
+
+    concat(l:List Result):Result ==
+      import List Result
+      empty? l => empty()$Result
+      f := first l
+      if empty?(r := rest l) then
+        f
+      else
+        concat(f,concat r)
+
+    outputMeasure(m:F):ST ==
+      fl:Float := round(m*(f:= 1000.0))/f
+      convert(fl)@ST
+
+    measure2Result(m:Measure):Result ==
+      mm := coerce(m.measure)$AnyFunctions1(Float)
+      mmr:Record(key:Symbol,entry:Any) := [bestMeasure@Symbol,mm]
+      mn := coerce(m.name)$AnyFunctions1(ST)
+      mnr:Record(key:Symbol,entry:Any) := [nameOfRoutine@Symbol,mn]
+      me := coerce(m.explanations)$AnyFunctions1(List String)
+      mer:Record(key:Symbol,entry:Any) := [allMeasures@Symbol,me]
+      mr := construct([mmr,mnr,mer])$Result
+      met := coerce(mr)$AnyFunctions1(Result)
+      meth:Record(key:Symbol,entry:Any):=[method@Symbol,met]
+      construct([meth])$Result
+
+    measure2Result(m:Measure2):Result ==
+      mm := coerce(m.measure)$AnyFunctions1(Float)
+      mmr:Record(key:Symbol,entry:Any) := [bestMeasure@Symbol,mm]
+      mn := coerce(m.name)$AnyFunctions1(ST)
+      mnr:Record(key:Symbol,entry:Any) := [nameOfRoutine@Symbol,mn]
+      me := coerce(m.explanations)$AnyFunctions1(List String)
+      mer:Record(key:Symbol,entry:Any) := [allMeasures@Symbol,me]
+      mx := coerce(m.extra)$AnyFunctions1(Result)
+      mxr:Record(key:Symbol,entry:Any) := [other@Symbol,mx]
+      mr := construct([mmr,mnr,mer,mxr])$Result
+      met := coerce(mr)$AnyFunctions1(Result)
+      meth:Record(key:Symbol,entry:Any):=[method@Symbol,met]
+      construct([meth])$Result
+
+    att2Result(att:ATT):Result ==
+      aepc := coerce(att.endPointContinuity)$AnyFunctions1(CTYPE)
+      ar := coerce(att.range)$AnyFunctions1(RTYPE)
+      as := coerce(att.singularitiesStream)$AnyFunctions1(STYPE)
+      aa:List Any := [aepc,ar,as]
+      aaa := coerce(aa)$AnyFunctions1(List Any)
+      aar:Record(key:Symbol,entry:Any) := [attributes@Symbol,aaa]
+      construct([aar])$Result
+
+    iflist2Result(ifv:IFV):Result ==
+      ifvs:List String := 
+        [concat(["stiffness: ",outputMeasure(ifv.stiffness)]),
+          concat(["stability: ",outputMeasure(ifv.stability)]),
+           concat(["expense: ",outputMeasure(ifv.expense)]),
+            concat(["accuracy: ",outputMeasure(ifv.accuracy)]),
+             concat(["intermediateResults: ",_
+                     outputMeasure(ifv.intermediateResults)])]
+      ifa:= coerce(ifvs)$AnyFunctions1(List String)
+      ifr:Record(key:Symbol,entry:Any) := [intensityFunctions@Symbol,ifa]
+      construct([ifr])$Result
+
 *)
 
 \end{chunk}
@@ -31745,6 +42906,7 @@ ExpertSystemToolsPackage1(R1:OR): E == I where
     neglist:List R1 -> List R1
       ++ neglist(l) returns only the negative elements of the list \spad{l}
   I ==> add
+
     neglist(l:List R1):List R1 == [u for u in l | negative?(u)$R1]
 
 \end{chunk}
@@ -31752,6 +42914,9 @@ ExpertSystemToolsPackage1(R1:OR): E == I where
 \begin{chunk}{COQ ESTOOLS1}
 (* package ESTOOLS1 *)
 (*
+
+    neglist(l:List R1):List R1 == [u for u in l | negative?(u)$R1]
+
 *)
 
 \end{chunk}
@@ -31822,14 +42987,21 @@ ExpertSystemToolsPackage2(R1:R,R2:R): E == I where
       ++ map(f,m) applies a mapping f:R1 -> R2 onto a matrix
       ++ \spad{m} in R1 returning a matrix in R2
   I ==> add
+
     map(f:R1->R2,m:Matrix R1):Matrix R2 ==
-      matrix([[f u for u in v] for v in listOfLists(m)$(Matrix R1)])$(Matrix R2)
+      matrix([[f u for u in v] for v in listOfLists(m)$(Matrix R1)])_
+       $(Matrix R2)
 
 \end{chunk}
 
 \begin{chunk}{COQ ESTOOLS2}
 (* package ESTOOLS2 *)
 (*
+
+    map(f:R1->R2,m:Matrix R1):Matrix R2 ==
+      matrix([[f u for u in v] for v in listOfLists(m)$(Matrix R1)])_
+       $(Matrix R2)
+
 *)
 
 \end{chunk}
@@ -31905,9 +43077,13 @@ ExpressionFunctions2(R:OrderedSet, S:OrderedSet):
       ++ map(f, e) applies f to all the constants appearing in e.
 
   Implementation == add
+
     if S has Ring and R has Ring then
+
       map(f, r) == map(f, r)$F2
+
     else
+
       map(f, r) == map(x1 +-> map(f, x1), retract r)$E2
 
 \end{chunk}
@@ -31915,6 +43091,15 @@ ExpressionFunctions2(R:OrderedSet, S:OrderedSet):
 \begin{chunk}{COQ EXPR2}
 (* package EXPR2 *)
 (*
+
+    if S has Ring and R has Ring then
+
+      map(f, r) == map(f, r)$F2
+
+    else
+
+      map(f, r) == map(x1 +-> map(f, x1), retract r)$E2
+
 *)
 
 \end{chunk}
@@ -32045,16 +43230,16 @@ coefficient ring, since it will complain otherwise.
 
 \begin{chunk}{package EXPRSOL ExpressionSolve}
 \getchunk{implementation: EXPRSOL ExpressionSolve}
+
         opelt := operator("elt"::Symbol)$OP
+
         opdiff := operator("D"::Symbol)$OP
+
         opcoerce := operator("coerce"::Symbol)$OP
 
---        replaceDiffs: (F, OP, Symbol) -> F
         replaceDiffs (expr, op, sy) ==
             lk := kernels expr
             for k in lk repeat
---                if freeOf?(coerce k, sy) then
---                    expr := subst(expr, [k], [opcoerce [coerce k]])
 
                 if is?(k, op) then
                     arg := first argument k
@@ -32063,14 +43248,12 @@ coefficient ring, since it will complain otherwise.
                     else expr := subst(expr, [k], [opelt [(name op)::F, 
                                                           replaceDiffs(arg, op,
                                                           sy)]])
---                    => "iterate"
 
                 if is?(k, %diff) then
                     args := argument k
                     differentiand := 
                      replaceDiffs(subst(args.1, args.2 = args.3), op, sy)
                     expr := subst(expr, [k], [opdiff differentiand])
---                    => "iterate"
             expr
 
 
@@ -32084,6 +43267,38 @@ coefficient ring, since it will complain otherwise.
 \begin{chunk}{COQ EXPRSOL}
 (* package EXPRSOL *)
 (*
+
+        opelt := operator("elt"::Symbol)$OP
+
+        opdiff := operator("D"::Symbol)$OP
+
+        opcoerce := operator("coerce"::Symbol)$OP
+
+        replaceDiffs (expr, op, sy) ==
+            lk := kernels expr
+            for k in lk repeat
+
+                if is?(k, op) then
+                    arg := first argument k
+                    if arg = sy::F 
+                    then expr := subst(expr, [k], [(name op)::F])
+                    else expr := subst(expr, [k], [opelt [(name op)::F, 
+                                                          replaceDiffs(arg, op,
+                                                          sy)]])
+
+                if is?(k, %diff) then
+                    args := argument k
+                    differentiand := 
+                     replaceDiffs(subst(args.1, args.2 = args.3), op, sy)
+                    expr := subst(expr, [k], [opdiff differentiand])
+            expr
+
+
+        seriesSolve(expr, op, sy, l) ==
+            ex := replaceDiffs(expr, op, sy) 
+            f := compiledFunction(ex, name op, sy)$MKF
+            seriesSolve(x+->f(x, monomial(1,1)$UTSSUPF), l)_
+              $TaylorSolve(F, UTSF, UTSSUPF)
 *)
 
 \end{chunk}
@@ -32156,6 +43371,7 @@ ExpressionSpaceFunctions1(F:ExpressionSpace, S:Type): with
       ++ of k, in order to lift f and apply it to k.
 
   == add
+
     --  prop  contains an evaluation function List S -> S
     map(F2S, prop, k) ==
       args := [F2S x for x in argument k]$List(S)
@@ -32168,6 +43384,14 @@ ExpressionSpaceFunctions1(F:ExpressionSpace, S:Type): with
 \begin{chunk}{COQ ES1}
 (* package ES1 *)
 (*
+
+    --  prop  contains an evaluation function List S -> S
+    map(F2S, prop, k) ==
+      args := [F2S x for x in argument k]$List(S)
+      (p := property(operator k, prop)) case None =>
+                                  ((p::None) pretend (List S -> S)) args
+      error "Operator does not have required property"
+
 *)
 
 \end{chunk}
@@ -32240,6 +43464,7 @@ ExpressionSpaceFunctions2(E:ExpressionSpace, F:ExpressionSpace): with
       ++ map(f, k) returns \spad{g = op(f(a1),...,f(an))} where
       ++ \spad{k = op(a1,...,an)}.
   == add
+
     map(f, k) ==
       (operator(operator k)$F) [f x for x in argument k]$List(F)
 
@@ -32248,6 +43473,10 @@ ExpressionSpaceFunctions2(E:ExpressionSpace, F:ExpressionSpace): with
 \begin{chunk}{COQ ES2}
 (* package ES2 *)
 (*
+
+    map(f, k) ==
+      (operator(operator k)$F) [f x for x in argument k]$List(F)
+
 *)
 
 \end{chunk}
@@ -32384,6 +43613,7 @@ ExpressionSpaceODESolver(R, F): Exports == Implementation where
       ++ \spad{seriesSolve(eq = 0, y, x = a, [b0,...,b(n-1)])}.
 
   Implementation ==> add
+
     checkCompat: (OP, EQ, EQ) -> F
     checkOrder1: (F, OP, K, SY, F) -> F
     checkOrderN: (F, OP, K, SY, F, NonNegativeInteger) -> F
@@ -32398,13 +43628,13 @@ ExpressionSpaceODESolver(R, F): Exports == Implementation where
     localInteger: F -> F
 
     opelt := operator("elt"::Symbol)$OP
-    --opex  := operator("exquo"::Symbol)$OP
     opex  := operator("fixedPointExquo"::Symbol)$OP
     opint := operator("integer"::Symbol)$OP
 
     Rint? := R has IntegerNumberSystem
 
     localInteger n == (Rint? => n; opint n)
+
     diffRhs(f, g) == diffRhsK(retract(f)@K, g)
 
     k2exquo k ==
@@ -32417,11 +43647,10 @@ ExpressionSpaceODESolver(R, F): Exports == Implementation where
        $PolynomialCategoryLifting(IndexedExponents K,K, R, P, F)
 
     div2exquo f ==
---      one?(d := denom f) => f
       ((d := denom f) = 1) => f
       opex(smp2exquo numer f, smp2exquo d)
 
--- if g is of the form a * k + b, then return -b/a
+    -- if g is of the form a * k + b, then return -b/a
     diffRhsK(k, g) ==
       h := univariate(g, k)
       (degree(numer h) <= 1) and ground? denom h =>
@@ -32515,6 +43744,132 @@ ExpressionSpaceODESolver(R, F): Exports == Implementation where
 \begin{chunk}{COQ EXPRODE}
 (* package EXPRODE *)
 (*
+
+    checkCompat: (OP, EQ, EQ) -> F
+    checkOrder1: (F, OP, K, SY, F) -> F
+    checkOrderN: (F, OP, K, SY, F, NonNegativeInteger) -> F
+    checkSystem: (F, List K, List F) -> F
+    div2exquo  : F -> F
+    smp2exquo  : P -> F
+    k2exquo    : K -> F
+    diffRhs    : (F, F) -> F
+    diffRhsK   : (K, F) -> F
+    findCompat : (F, List EQ) -> F
+    findEq     : (K, SY, List F) -> F
+    localInteger: F -> F
+
+    opelt := operator("elt"::Symbol)$OP
+    opex  := operator("fixedPointExquo"::Symbol)$OP
+    opint := operator("integer"::Symbol)$OP
+
+    Rint? := R has IntegerNumberSystem
+
+    localInteger n == (Rint? => n; opint n)
+
+    diffRhs(f, g) == diffRhsK(retract(f)@K, g)
+
+    k2exquo k ==
+      is?(op := operator k, "%diff"::Symbol) =>
+        error "Improper differential equation"
+      kernel(op, [div2exquo f for f in argument k]$List(F))
+
+    smp2exquo p ==
+      map(k2exquo,x+->x::F,p)_
+       $PolynomialCategoryLifting(IndexedExponents K,K, R, P, F)
+
+    div2exquo f ==
+      ((d := denom f) = 1) => f
+      opex(smp2exquo numer f, smp2exquo d)
+
+    -- if g is of the form a * k + b, then return -b/a
+    diffRhsK(k, g) ==
+      h := univariate(g, k)
+      (degree(numer h) <= 1) and ground? denom h =>
+        - coefficient(numer h, 0) / coefficient(numer h, 1)
+      error "Improper differential equation"
+
+    checkCompat(y, eqx, eqy) ==
+      lhs(eqy) =$F y(rhs eqx) => rhs eqy
+      error "Improper initial value"
+
+    findCompat(yx, l) ==
+      for eq in l repeat
+        yx =$F lhs eq => return rhs eq
+      error "Improper initial value"
+
+    findEq(k, x, sys) ==
+      k := retract(differentiate(k::F, x))@K
+      for eq in sys repeat
+        member?(k, kernels eq) => return eq
+      error "Improper differential equation"
+
+    checkOrder1(diffeq, y, yx, x, sy) ==
+      div2exquo subst(diffRhs(differentiate(yx::F,x),diffeq),[yx],[sy])
+
+    checkOrderN(diffeq, y, yx, x, sy, n) ==
+      zero? n => error "No initial value(s) given"
+      m     := (minIndex(l := [retract(f := yx::F)@K]$List(K)))::F
+      lv    := [opelt(sy, localInteger m)]$List(F)
+      for i in 2..n repeat
+        l  := concat(retract(f := differentiate(f, x))@K, l)
+        lv := concat(opelt(sy, localInteger(m := m + 1)), lv)
+      div2exquo subst(diffRhs(differentiate(f, x), diffeq), l, lv)
+
+    checkSystem(diffeq, yx, lv) ==
+      for k in kernels diffeq repeat
+        is?(k, "%diff"::SY) =>
+          return div2exquo subst(diffRhsK(k, diffeq), yx, lv)
+      0
+
+    seriesSolve(l:List EQ, y:List OP, eqx:EQ, eqy:List EQ) ==
+      seriesSolve([lhs deq - rhs deq for deq in l]$List(F), y, eqx, eqy)
+
+    seriesSolve(l:List EQ, y:List OP, eqx:EQ, y0:List F) ==
+      seriesSolve([lhs deq - rhs deq for deq in l]$List(F), y, eqx, y0)
+
+    seriesSolve(l:List F, ly:List OP, eqx:EQ, eqy:List EQ) ==
+      seriesSolve(l, ly, eqx,
+                  [findCompat(y rhs eqx, eqy) for y in ly]$List(F))
+
+    seriesSolve(diffeq:EQ, y:OP, eqx:EQ, eqy:EQ) ==
+      seriesSolve(lhs diffeq - rhs diffeq, y, eqx, eqy)
+
+    seriesSolve(diffeq:EQ, y:OP, eqx:EQ, y0:F) ==
+      seriesSolve(lhs diffeq - rhs diffeq, y, eqx, y0)
+
+    seriesSolve(diffeq:EQ, y:OP, eqx:EQ, y0:List F) ==
+      seriesSolve(lhs diffeq - rhs diffeq, y, eqx, y0)
+
+    seriesSolve(diffeq:F, y:OP, eqx:EQ, eqy:EQ) ==
+      seriesSolve(diffeq, y, eqx, checkCompat(y, eqx, eqy))
+
+    seriesSolve(diffeq:F, y:OP, eqx:EQ, y0:F) ==
+      x      := symbolIfCan(retract(lhs eqx)@K)::SY
+      sy     := name y
+      yx     := retract(y lhs eqx)@K
+      f      := checkOrder1(diffeq, y, yx, x, sy::F)
+      center := rhs eqx
+      coerce(ode1(compiledFunction(f, sy)$MKF, y0)$ODE)$A1
+
+    seriesSolve(diffeq:F, y:OP, eqx:EQ, y0:List F) ==
+      x      := symbolIfCan(retract(lhs eqx)@K)::SY
+      sy     := new()$SY
+      yx     := retract(y lhs eqx)@K
+      f      := checkOrderN(diffeq, y, yx, x, sy::F, #y0)
+      center := rhs eqx
+      coerce(ode(compiledFunction(f, sy)$MKL, y0)$ODE)$A1
+
+    seriesSolve(sys:List F, ly:List OP, eqx:EQ, l0:List F) ==
+      x      := symbolIfCan(kx := retract(lhs eqx)@K)::SY
+      fsy    := (sy := new()$SY)::F
+      m      := (minIndex(l0) - 1)::F
+      yx     := concat(kx, [retract(y lhs eqx)@K for y in ly]$List(K))
+      lelt   := [opelt(fsy, localInteger(m := m+1)) for k in yx]$List(F)
+      sys    := [findEq(k, x, sys) for k in rest yx]
+      l      := [checkSystem(eq, yx, lelt) for eq in sys]$List(F)
+      center := rhs eqx
+      coerce(mpsode(l0,[compiledFunction(f,sy)$MKL for f in l])$ODE)$AL1
+
 *)
 
 \end{chunk}
@@ -32585,6 +43940,7 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with
   OMwrite  : (OpenMathDevice, Expression R) -> Void
   OMwrite  : (OpenMathDevice, Expression R, Boolean) -> Void
  == add
+
   import Expression R
   SymInfo ==> Record(cd:String, name:String)
   import SymInfo
@@ -32663,14 +44019,16 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with
   -- Local helper functions
   -------------------------
 
-  outputOMArith1(dev: OpenMathDevice, sym: String, args: List Expression R): Void ==
+  outputOMArith1(dev: OpenMathDevice, sym: String, _
+                 args: List Expression R): Void ==
     OMputApp(dev)
     OMputSymbol(dev, "arith1", sym)
     for arg in args repeat
       OMwrite(dev, arg, false)
     OMputEndApp(dev)
 
-  outputOMLambda(dev: OpenMathDevice, ex: Expression R, var: Expression R): Void ==
+  outputOMLambda(dev: OpenMathDevice, ex: Expression R, _
+                 var: Expression R): Void ==
     OMputBind(dev)
     OMputSymbol(dev, "fns1", "lambda")
     OMputBVar(dev)
@@ -32679,14 +44037,16 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with
     OMwrite(dev, ex, false)
     OMputEndBind(dev)
 
-  outputOMInterval(dev: OpenMathDevice, lo: Expression R, hi: Expression R): Void ==
+  outputOMInterval(dev: OpenMathDevice, _
+                   lo: Expression R, hi: Expression R): Void ==
     OMputApp(dev)
     OMputSymbol(dev, "interval1", "interval")
     OMwrite(dev, lo, false)
     OMwrite(dev, hi, false)
     OMputEndApp(dev)
 
-  outputOMIntInterval(dev: OpenMathDevice, lo: Expression R, hi: Expression R): Void ==
+  outputOMIntInterval(dev: OpenMathDevice, lo: Expression R, hi: Expression R)_
+      :Void ==
     OMputApp(dev)
     OMputSymbol(dev, "interval1", "integer__interval")
     OMwrite(dev, lo, false)
@@ -32736,14 +44096,14 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with
     outputOMLambda(dev, eval(args.1, args.2, args.3), args.3)
     OMputEndApp(dev)
 
-  outputOMFunction(dev: OpenMathDevice, op: Symbol, args: List Expression R): Void ==
+  outputOMFunction(dev: OpenMathDevice, op: Symbol, _
+                   args: List Expression R): Void ==
     nargs := #args
     zero? nargs =>
       omOp: Union(SymInfo, "failed") := search(op, nullaryFunctionAList)
       omOp case "failed" =>
-        error concat ["No OpenMath definition for nullary function ", coerce op]
+        error concat ["No OpenMath definition for nullary function ",coerce op]
       OMputSymbol(dev, omOp.cd, omOp.name)
---    one? nargs =>
     (nargs = 1) =>
       omOp: Union(SymInfo, "failed") := search(op, unaryFunctionAList)
       omOp case "failed" =>
@@ -32778,7 +44138,6 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with
     -- here but they may be relevent when we integrate this stuff into
     -- the main Expression code.  Note that if we don't check that
     -- the exponent is non-trivial we get thrown into an infinite recursion.
---    not (((x := isExpt ex) case "failed") or one? x.exponent) =>
     not (((x := isExpt ex) case "failed") or (x.exponent = 1)) =>
       not((s := symbolIfCan(x.var)@Union(Symbol,"failed")) case "failed") =>
         --outputOMPower(dev, [s::Expression(R), (x.exponent)::Expression(R)])
@@ -32788,7 +44147,6 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with
         OMputInteger(dev, x.exponent)
         OMputEndApp(dev)
       -- TODO: add error handling code here...
---    not (((z := isPower ex) case "failed") or one? z.exponent) =>
     not (((z := isPower ex) case "failed") or (z.exponent = 1)) =>
       outputOMPower(dev, [ z.val, z.exponent::Expression R ])
       --OMputApp(dev)
@@ -32846,6 +44204,265 @@ ExpressionToOpenMath(R: Join(OpenMath, OrderedSet, Ring)): with
 \begin{chunk}{COQ OMEXPR}
 (* package OMEXPR *)
 (*
+
+  import Expression R
+  SymInfo ==> Record(cd:String, name:String)
+  import SymInfo
+  import Record(key: Symbol, entry: SymInfo)
+  import AssociationList(Symbol, SymInfo)
+  import OMENC
+
+  ----------------------------
+  -- Local translation tables.
+  ----------------------------
+
+  nullaryFunctionAList : AssociationList(Symbol, SymInfo) := construct [_
+    [pi, ["nums1", "pi"]] ]
+
+  unaryFunctionAList : AssociationList(Symbol, SymInfo) := construct [_
+    [exp,  ["transc1", "exp"]],_
+    [log,  ["transc1", "ln"]],_
+    [sin,  ["transc1", "sin"]],_
+    [cos,  ["transc1", "cos"]],_
+    [tan,  ["transc1", "tan"]],_
+    [cot,  ["transc1", "cot"]],_
+    [sec,  ["transc1", "sec"]],_
+    [csc,  ["transc1", "csc"]],_
+    [asin, ["transc1", "arcsin"]],_
+    [acos, ["transc1", "arccos"]],_
+    [atan, ["transc1", "arctan"]],_
+    [acot, ["transc1", "arccot"]],_
+    [asec, ["transc1", "arcsec"]],_
+    [acsc, ["transc1", "arccsc"]],_
+    [sinh, ["transc1", "sinh"]],_
+    [cosh, ["transc1", "cosh"]],_
+    [tanh, ["transc1", "tanh"]],_
+    [coth, ["transc1", "coth"]],_
+    [sech, ["transc1", "sech"]],_
+    [csch, ["transc1", "csch"]],_
+    [asinh, ["transc1", "arcsinh"]],_
+    [acosh, ["transc1", "arccosh"]],_
+    [atanh, ["transc1", "arctanh"]],_
+    [acoth, ["transc1", "arccoth"]],_
+    [asech, ["transc1", "arcsech"]],_
+    [acsch, ["transc1", "arccsch"]],_
+    [factorial, ["integer1", "factorial"]],_
+    [abs, ["arith1", "abs"]] ]
+
+    -- Still need the following unary functions:
+    --  digamma
+    --  Gamma
+    --  airyAi
+    --  airyBi
+    --  erf
+    --  Ei
+    --  Si
+    --  Ci
+    --  li
+    --  dilog
+
+    -- Still need the following binary functions:
+    --      Gamma(a, x)
+    --      Beta(x,y) 
+    --      polygamma(k,x)
+    --      besselJ(v,x)
+    --      besselY(v,x)
+    --      besselI(v,x)
+    --      besselK(v,x)
+    --      permutation(n, m)
+    --      summation(x:%, n:Symbol) : as opposed to "definite" sum
+    --      product(x:%, n:Symbol)   : ditto
+
+  ------------------------
+  -- Forward declarations.
+  ------------------------
+
+  outputOMExpr  : (OpenMathDevice, Expression R) -> Void
+
+  -------------------------
+  -- Local helper functions
+  -------------------------
+
+  outputOMArith1(dev: OpenMathDevice, sym: String, _
+                 args: List Expression R): Void ==
+    OMputApp(dev)
+    OMputSymbol(dev, "arith1", sym)
+    for arg in args repeat
+      OMwrite(dev, arg, false)
+    OMputEndApp(dev)
+
+  outputOMLambda(dev: OpenMathDevice, ex: Expression R, _
+                 var: Expression R): Void ==
+    OMputBind(dev)
+    OMputSymbol(dev, "fns1", "lambda")
+    OMputBVar(dev)
+    OMwrite(dev, var, false)
+    OMputEndBVar(dev)
+    OMwrite(dev, ex, false)
+    OMputEndBind(dev)
+
+  outputOMInterval(dev: OpenMathDevice, _
+                   lo: Expression R, hi: Expression R): Void ==
+    OMputApp(dev)
+    OMputSymbol(dev, "interval1", "interval")
+    OMwrite(dev, lo, false)
+    OMwrite(dev, hi, false)
+    OMputEndApp(dev)
+
+  outputOMIntInterval(dev: OpenMathDevice, lo: Expression R, hi: Expression R)_
+      :Void ==
+    OMputApp(dev)
+    OMputSymbol(dev, "interval1", "integer__interval")
+    OMwrite(dev, lo, false)
+    OMwrite(dev, hi, false)
+    OMputEndApp(dev)
+
+  outputOMBinomial(dev: OpenMathDevice, args: List Expression R): Void ==
+    not #args=2 => error "Wrong number of arguments to binomial"
+    OMputApp(dev)
+    OMputSymbol(dev, "combinat1", "binomial")
+    for arg in args repeat
+      OMwrite(dev, arg, false)
+    OMputEndApp(dev)
+
+  outputOMPower(dev: OpenMathDevice, args: List Expression R): Void ==
+    not #args=2 => error "Wrong number of arguments to power"
+    outputOMArith1(dev, "power", args)
+
+  outputOMDefsum(dev: OpenMathDevice, args: List Expression R): Void ==
+    #args ^= 5 => error "Unexpected number of arguments to a defsum"
+    OMputApp(dev)
+    OMputSymbol(dev, "arith1", "sum")
+    outputOMIntInterval(dev, args.4, args.5)
+    outputOMLambda(dev, eval(args.1, args.2, args.3), args.3)
+    OMputEndApp(dev)
+
+  outputOMDefprod(dev: OpenMathDevice, args: List Expression R): Void ==
+    #args ^= 5 => error "Unexpected number of arguments to a defprod"
+    OMputApp(dev)
+    OMputSymbol(dev, "arith1", "product")
+    outputOMIntInterval(dev, args.4, args.5)
+    outputOMLambda(dev, eval(args.1, args.2, args.3), args.3)
+    OMputEndApp(dev)
+
+  outputOMDefint(dev: OpenMathDevice, args: List Expression R): Void ==
+    #args ^= 5 => error "Unexpected number of arguments to a defint"
+    OMputApp(dev)
+    OMputSymbol(dev, "calculus1", "defint")
+    outputOMInterval(dev, args.4, args.5)
+    outputOMLambda(dev, eval(args.1, args.2, args.3), args.3)
+    OMputEndApp(dev)
+
+  outputOMInt(dev: OpenMathDevice, args: List Expression R): Void ==
+    #args ^= 3 => error "Unexpected number of arguments to a defint"
+    OMputApp(dev)
+    OMputSymbol(dev, "calculus1", "int")
+    outputOMLambda(dev, eval(args.1, args.2, args.3), args.3)
+    OMputEndApp(dev)
+
+  outputOMFunction(dev: OpenMathDevice, op: Symbol, _
+                   args: List Expression R): Void ==
+    nargs := #args
+    zero? nargs =>
+      omOp: Union(SymInfo, "failed") := search(op, nullaryFunctionAList)
+      omOp case "failed" =>
+        error concat ["No OpenMath definition for nullary function ",coerce op]
+      OMputSymbol(dev, omOp.cd, omOp.name)
+    (nargs = 1) =>
+      omOp: Union(SymInfo, "failed") := search(op, unaryFunctionAList)
+      omOp case "failed" =>
+        error concat ["No OpenMath definition for unary function ", coerce op]
+      OMputApp(dev)
+      OMputSymbol(dev, omOp.cd, omOp.name)
+      for arg in args repeat
+        OMwrite(dev, arg, false)
+      OMputEndApp(dev)
+    -- Most of the binary operators cannot be handled trivialy like the
+    -- unary ones since they have bound variables of one kind or another.
+    -- The special functions should be straightforward, but we don't have
+    -- a CD for them yet :-)
+    op = %defint  => outputOMDefint(dev, args)
+    op = integral => outputOMInt(dev, args)
+    op = %defsum  => outputOMDefsum(dev, args)
+    op = %defprod => outputOMDefprod(dev, args)
+    op = %power   => outputOMPower(dev, args)
+    op = binomial => outputOMBinomial(dev, args)
+    error concat ["No OpenMath definition for function ", string op]
+ 
+  outputOMExpr(dev: OpenMathDevice, ex: Expression R): Void ==
+    ground? ex => OMwrite(dev, ground ex, false)
+    not((v := retractIfCan(ex)@Union(Symbol,"failed")) case "failed") =>
+      OMputVariable(dev, v)
+    not((w := isPlus ex) case "failed") => outputOMArith1(dev, "plus", w)
+    not((w := isTimes ex) case "failed") => outputOMArith1(dev, "times", w)
+    --not((y := isMult ex) case "failed") =>
+    --  outputOMArith("times", [OMwrite(y.coef)$Integer,
+    --          OMwrite(coerce y.var)])
+    -- At the time of writing we don't need both isExpt and isPower
+    -- here but they may be relevent when we integrate this stuff into
+    -- the main Expression code.  Note that if we don't check that
+    -- the exponent is non-trivial we get thrown into an infinite recursion.
+    not (((x := isExpt ex) case "failed") or (x.exponent = 1)) =>
+      not((s := symbolIfCan(x.var)@Union(Symbol,"failed")) case "failed") =>
+        --outputOMPower(dev, [s::Expression(R), (x.exponent)::Expression(R)])
+        OMputApp(dev)
+        OMputSymbol(dev, "arith1", "power")
+        OMputVariable(dev, s)
+        OMputInteger(dev, x.exponent)
+        OMputEndApp(dev)
+      -- TODO: add error handling code here...
+    not (((z := isPower ex) case "failed") or (z.exponent = 1)) =>
+      outputOMPower(dev, [ z.val, z.exponent::Expression R ])
+      --OMputApp(dev)
+      --OMputSymbol(dev, "arith1", "power")
+      --outputOMExpr(dev, z.val)
+      --OMputInteger(dev, z.exponent)
+      --OMputEndApp(dev)
+    -- Must only be one top-level Kernel by this point
+    k : Kernel Expression R := first kernels ex
+    outputOMFunction(dev, name operator k, argument k)
+
+
+  ----------
+  -- Exports
+  ----------
+
+  OMwrite(ex: Expression R): String ==
+    s: String := ""
+    sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+    dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML())
+    OMputObject(dev)
+    outputOMExpr(dev, ex)
+    OMputEndObject(dev)
+    OMclose(dev)
+    s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+    s
+
+  OMwrite(ex: Expression R, wholeObj: Boolean): String ==
+    s: String := ""
+    sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+    dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML())
+    if wholeObj then
+      OMputObject(dev)
+    outputOMExpr(dev, ex)
+    if wholeObj then
+      OMputEndObject(dev)
+    OMclose(dev)
+    s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+    s
+
+  OMwrite(dev: OpenMathDevice, ex: Expression R): Void ==
+    OMputObject(dev)
+    outputOMExpr(dev, ex)
+    OMputEndObject(dev)
+
+  OMwrite(dev: OpenMathDevice, ex: Expression R, wholeObj: Boolean): Void ==
+    if wholeObj then
+      OMputObject(dev)
+    outputOMExpr(dev, ex)
+    if wholeObj then
+      OMputEndObject(dev)
+
 *)
 
 \end{chunk}
@@ -33025,6 +44642,7 @@ ExpressionToUnivariatePowerSeries(R,FE): Exports == Implementation where
       ++ at least n.
 
   Implementation ==> add
+
     performSubstitution: (FE,SY,FE) -> FE
     performSubstitution(fcn,x,a) ==
       zero? a => fcn
@@ -33243,6 +44861,220 @@ ExpressionToUnivariatePowerSeries(R,FE): Exports == Implementation where
 \begin{chunk}{COQ EXPR2UPS}
 (* package EXPR2UPS *)
 (*
+
+    performSubstitution: (FE,SY,FE) -> FE
+    performSubstitution(fcn,x,a) ==
+      zero? a => fcn
+      xFE := x :: FE
+      eval(fcn,xFE = xFE + a)
+
+    iTaylor: (FE,SY,FE) -> Any
+    iTaylor(fcn,x,a) ==
+      pack := FS2UPS(R,FE,I,ULS(FE,x,a),_
+                     EFULS(FE,UTS(FE,x,a),ULS(FE,x,a)),x)
+      ans := exprToUPS(fcn,false,"just do it")$pack
+      ans case %problem =>
+        ans.%problem.prob = "essential singularity" =>
+          error "No Taylor expansion: essential singularity"
+        ans.%problem.func = "log" =>
+          error "No Taylor expansion: logarithmic singularity"
+        ans.%problem.func = "nth root" =>
+          error "No Taylor expansion: fractional powers in expansion"
+        error "No Taylor expansion"
+      uls := ans.%series
+      (uts := taylorIfCan uls) case "failed" =>
+        error "No Taylor expansion: pole"
+      any1 := ANY1(UTS(FE,x,a))
+      coerce(uts :: UTS(FE,x,a))$any1
+
+    taylor(x:SY) ==
+      uts := UTS(FE,x,0$FE); any1 := ANY1(uts)
+      coerce(monomial(1,1)$uts)$any1
+
+    taylor(fcn:FE) ==
+      null(vars := variables fcn) =>
+        error "taylor: expression has no variables"
+      not null rest vars =>
+        error "taylor: expression has more than one variable"
+      taylor(fcn,(first(vars) :: FE) = 0)
+
+    taylor(fcn:FE,n:NNI) ==
+      null(vars := variables fcn) =>
+        error "taylor: expression has no variables"
+      not null rest vars =>
+        error "taylor: expression has more than one variable"
+      x := first vars
+      uts := UTS(FE,x,0$FE); any1 := ANY1(uts)
+      series := retract(taylor(fcn,(x :: FE) = 0))$any1
+      coerce(extend(series,n))$any1
+
+    taylor(fcn:FE,eq:EQ FE) ==
+      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
+        error "taylor: left hand side must be a variable"
+      x := xx :: SY; a := rhs eq
+      iTaylor(performSubstitution(fcn,x,a),x,a)
+
+    taylor(fcn,eq,n) ==
+      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
+        error "taylor: left hand side must be a variable"
+      x := xx :: SY; a := rhs eq
+      any1 := ANY1(UTS(FE,x,a))
+      series := retract(iTaylor(performSubstitution(fcn,x,a),x,a))$any1
+      coerce(extend(series,n))$any1
+
+    iLaurent: (FE,SY,FE) -> Any
+    iLaurent(fcn,x,a) ==
+      pack := FS2UPS(R,FE,I,ULS(FE,x,a),_
+                     EFULS(FE,UTS(FE,x,a),ULS(FE,x,a)),x)
+      ans := exprToUPS(fcn,false,"just do it")$pack
+      ans case %problem =>
+        ans.%problem.prob = "essential singularity" =>
+          error "No Laurent expansion: essential singularity"
+        ans.%problem.func = "log" =>
+          error "No Laurent expansion: logarithmic singularity"
+        ans.%problem.func = "nth root" =>
+          error "No Laurent expansion: fractional powers in expansion"
+        error "No Laurent expansion"
+      any1 := ANY1(ULS(FE,x,a))
+      coerce(ans.%series)$any1
+
+    laurent(x:SY) ==
+      uls := ULS(FE,x,0$FE); any1 := ANY1(uls)
+      coerce(monomial(1,1)$uls)$any1
+
+    laurent(fcn:FE) ==
+      null(vars := variables fcn) =>
+        error "laurent: expression has no variables"
+      not null rest vars =>
+        error "laurent: expression has more than one variable"
+      laurent(fcn,(first(vars) :: FE) = 0)
+
+    laurent(fcn:FE,n:I) ==
+      null(vars := variables fcn) =>
+        error "laurent: expression has no variables"
+      not null rest vars =>
+        error "laurent: expression has more than one variable"
+      x := first vars
+      uls := ULS(FE,x,0$FE); any1 := ANY1(uls)
+      series := retract(laurent(fcn,(x :: FE) = 0))$any1
+      coerce(extend(series,n))$any1
+
+    laurent(fcn:FE,eq:EQ FE) ==
+      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
+        error "taylor: left hand side must be a variable"
+      x := xx :: SY; a := rhs eq
+      iLaurent(performSubstitution(fcn,x,a),x,a)
+
+    laurent(fcn,eq,n) ==
+      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
+        error "taylor: left hand side must be a variable"
+      x := xx :: SY; a := rhs eq
+      any1 := ANY1(ULS(FE,x,a))
+      series := retract(iLaurent(performSubstitution(fcn,x,a),x,a))$any1
+      coerce(extend(series,n))$any1
+
+    iPuiseux: (FE,SY,FE) -> Any
+    iPuiseux(fcn,x,a) ==
+      pack := FS2UPS(R,FE,RN,UPXS(FE,x,a),_
+                     EFUPXS(FE,ULS(FE,x,a),UPXS(FE,x,a),_
+                     EFULS(FE,UTS(FE,x,a),ULS(FE,x,a))),x)
+      ans := exprToUPS(fcn,false,"just do it")$pack
+      ans case %problem =>
+        ans.%problem.prob = "essential singularity" =>
+          error "No Puiseux expansion: essential singularity"
+        ans.%problem.func = "log" =>
+          error "No Puiseux expansion: logarithmic singularity"
+        error "No Puiseux expansion"
+      any1 := ANY1(UPXS(FE,x,a))
+      coerce(ans.%series)$any1
+
+    puiseux(x:SY) ==
+      upxs := UPXS(FE,x,0$FE); any1 := ANY1(upxs)
+      coerce(monomial(1,1)$upxs)$any1
+
+    puiseux(fcn:FE) ==
+      null(vars := variables fcn) =>
+        error "puiseux: expression has no variables"
+      not null rest vars =>
+        error "puiseux: expression has more than one variable"
+      puiseux(fcn,(first(vars) :: FE) = 0)
+
+    puiseux(fcn:FE,n:RN) ==
+      null(vars := variables fcn) =>
+        error "puiseux: expression has no variables"
+      not null rest vars =>
+        error "puiseux: expression has more than one variable"
+      x := first vars
+      upxs := UPXS(FE,x,0$FE); any1 := ANY1(upxs)
+      series := retract(puiseux(fcn,(x :: FE) = 0))$any1
+      coerce(extend(series,n))$any1
+
+    puiseux(fcn:FE,eq:EQ FE) ==
+      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
+        error "taylor: left hand side must be a variable"
+      x := xx :: SY; a := rhs eq
+      iPuiseux(performSubstitution(fcn,x,a),x,a)
+
+    puiseux(fcn,eq,n) ==
+      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
+        error "taylor: left hand side must be a variable"
+      x := xx :: SY; a := rhs eq
+      any1 := ANY1(UPXS(FE,x,a))
+      series := retract(iPuiseux(performSubstitution(fcn,x,a),x,a))$any1
+      coerce(extend(series,n))$any1
+
+    iSeries: (FE,SY,FE) -> Any
+    iSeries(fcn,x,a) ==
+      pack := FS2UPS(R,FE,RN,UPXS(FE,x,a), _
+                     EFUPXS(FE,ULS(FE,x,a),UPXS(FE,x,a), _
+                     EFULS(FE,UTS(FE,x,a),ULS(FE,x,a))),x)
+      ans := exprToUPS(fcn,false,"just do it")$pack
+      ans case %problem =>
+        ansG := exprToGenUPS(fcn,false,"just do it")$pack
+        ansG case %problem =>
+          ansG.%problem.prob = "essential singularity" =>
+            error "No series expansion: essential singularity"
+          error "No series expansion"
+        anyone := ANY1(GSER(FE,x,a))
+        coerce((ansG.%series) :: GSER(FE,x,a))$anyone
+      any1 := ANY1(UPXS(FE,x,a))
+      coerce(ans.%series)$any1
+
+    series(x:SY) ==
+      upxs := UPXS(FE,x,0$FE); any1 := ANY1(upxs)
+      coerce(monomial(1,1)$upxs)$any1
+
+    series(fcn:FE) ==
+      null(vars := variables fcn) =>
+        error "series: expression has no variables"
+      not null rest vars =>
+        error "series: expression has more than one variable"
+      series(fcn,(first(vars) :: FE) = 0)
+
+    series(fcn:FE,n:RN) ==
+      null(vars := variables fcn) =>
+        error "series: expression has no variables"
+      not null rest vars =>
+        error "series: expression has more than one variable"
+      x := first vars
+      upxs := UPXS(FE,x,0$FE); any1 := ANY1(upxs)
+      series := retract(series(fcn,(x :: FE) = 0))$any1
+      coerce(extend(series,n))$any1
+
+    series(fcn:FE,eq:EQ FE) ==
+      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
+        error "taylor: left hand side must be a variable"
+      x := xx :: SY; a := rhs eq
+      iSeries(performSubstitution(fcn,x,a),x,a)
+
+    series(fcn,eq,n) ==
+      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
+        error "taylor: left hand side must be a variable"
+      x := xx :: SY; a := rhs eq
+      any1 := ANY1(UPXS(FE,x,a))
+      series := retract(iSeries(performSubstitution(fcn,x,a),x,a))$any1
+      coerce(extend(series,n))$any1
+
 *)
 
 \end{chunk}
@@ -33356,6 +45188,7 @@ ExpressionTubePlot(): Exports == Implementation where
       ++ to be open.
  
   Implementation ==> add
+
     import Plot3D
     import F2F
     import TubePlotTools
@@ -33483,6 +45316,129 @@ ExpressionTubePlot(): Exports == Implementation where
 \begin{chunk}{COQ EXPRTUBE}
 (* package EXPRTUBE *)
 (*
+
+    import Plot3D
+    import F2F
+    import TubePlotTools
+ 
+--% variables
+ 
+    getVariable: (FE,FE,FE) -> SY
+    getVariable(x,y,z) ==
+      varList1 := variables x
+      varList2 := variables y
+      varList3 := variables z
+      (not (# varList1 <= 1)) or (not (# varList2 <= 1)) or _
+       (not (# varList3 <= 1)) =>
+        error "tubePlot: only one variable may be used"
+      null varList1 =>
+        null varList2 =>
+          null varList3 =>
+            error "tubePlot: a variable must appear in functions"
+          first varList3
+        t2 := first varList2
+        null varList3 => t2
+        not (first varList3 = t2) =>
+          error "tubePlot: only one variable may be used"
+      t1 := first varList1
+      null varList2 =>
+        null varList3 => t1
+        not (first varList3 = t1) =>
+          error "tubePlot: only one variable may be used"
+        t1
+      t2 := first varList2
+      null varList3 =>
+        not (t1 = t2) =>
+          error "tubePlot: only one variable may be used"
+        t1
+      not (first varList3 = t1) or not (t2 = t1) =>
+        error "tubePlot: only one variable may be used"
+      t1
+ 
+--% tubes: variable radius
+ 
+    tubePlot(x:FE,y:FE,z:FE,colorFcn:SF -> SF,_
+             tRange:SEG SF,radFcn:SF -> SF,n:I,string:S) ==
+      -- check value of n
+      n < 3 => error "tubePlot: n should be at least 3"
+      -- check string
+      flag : B :=
+        string = "closed" => true
+        string = "open" => false
+        error "tubePlot: last argument should be open or closed"
+      -- check variables
+      t := getVariable(x,y,z)
+      -- coordinate functions
+      xFunc := makeFloatFunction(x,t)
+      yFunc := makeFloatFunction(y,t)
+      zFunc := makeFloatFunction(z,t)
+      -- derivatives of coordinate functions
+      xp := differentiate(x,t)
+      yp := differentiate(y,t)
+      zp := differentiate(z,t)
+      -- derivative of arc length
+      sp := sqrt(xp ** 2 + yp ** 2 + zp ** 2)
+      -- coordinates of unit tangent vector
+      Tx := xp/sp; Ty := yp/sp; Tz := zp/sp
+      -- derivatives of coordinates of unit tangent vector
+      Txp := differentiate(Tx,t)
+      Typ := differentiate(Ty,t)
+      Tzp := differentiate(Tz,t)
+      -- K = curvature = length of curvature vector
+      K := sqrt(Txp ** 2 + Typ ** 2 + Tzp ** 2)
+      -- coordinates of principal normal vector
+      Nx := Txp / K; Ny := Typ / K; Nz := Tzp / K
+      -- functions SF->SF giving coordinates of principal normal vector
+      NxFunc := makeFloatFunction(Nx,t);
+      NyFunc := makeFloatFunction(Ny,t);
+      NzFunc := makeFloatFunction(Nz,t);
+      -- coordinates of binormal vector
+      Bx := Ty * Nz - Tz * Ny
+      By := Tz * Nx - Tx * Nz
+      Bz := Tx * Ny - Ty * Nx
+      -- functions SF -> SF giving coordinates of binormal vector
+      BxFunc := makeFloatFunction(Bx,t);
+      ByFunc := makeFloatFunction(By,t);
+      BzFunc := makeFloatFunction(Bz,t);
+      -- create Plot3D
+      parPlot := plot(xFunc,yFunc,zFunc,colorFcn,tRange)
+      tvals := first tValues parPlot
+      curvePts := first listBranches parPlot
+      cosSin := cosSinInfo n
+      loopList : L L Pt := nil()
+      while not null tvals repeat
+        -- note that tvals and curvePts have the same number of elements
+        tval := first tvals; tvals := rest tvals
+        ctr := first curvePts; curvePts := rest curvePts
+        pNormList : L SF :=
+          [NxFunc tval,NyFunc tval,NzFunc tval,colorFcn tval]
+        pNorm : Pt := point pNormList
+        bNormList : L SF :=
+          [BxFunc tval,ByFunc tval,BzFunc tval,colorFcn tval]
+        bNorm : Pt := point bNormList
+        lps := loopPoints(ctr,pNorm,bNorm,radFcn tval,cosSin)
+        loopList := cons(lps,loopList)
+      tube(parPlot,reverse_! loopList,flag)
+ 
+    tubePlot(x:FE,y:FE,z:FE,colorFcn:SF -> SF,_
+             tRange:SEG SF,radFcn:SF -> SF,n:I) ==
+      tubePlot(x,y,z,colorFcn,tRange,radFcn,n,"open")
+ 
+--% tubes: constant radius
+ 
+    project: (SF,SF) -> SF
+    project(x,y) == x
+ 
+    constantToUnaryFunction x == s +-> project(x,s)
+ 
+    tubePlot(x:FE,y:FE,z:FE,colorFcn:SF -> SF,_
+             tRange:SEG SF,rad:SF,n:I,s:S) ==
+      tubePlot(x,y,z,colorFcn,tRange,constantToUnaryFunction rad,n,s)
+ 
+    tubePlot(x:FE,y:FE,z:FE,colorFcn:SF -> SF,_
+             tRange:SEG SF,rad:SF,n:I) ==
+      tubePlot(x,y,z,colorFcn,tRange,rad,n,"open")
+
 *)
 
 \end{chunk}
@@ -33559,6 +45515,7 @@ Export3D(): with
     ++ writes 3D SubSpace to a file in Wavefront (.OBJ) format
 
  == add
+
   import List List NNI
 
   -- return list of indexes
@@ -33640,6 +45597,83 @@ Export3D(): with
 \begin{chunk}{COQ EXP3D}
 (* package EXP3D *)
 (*
+
+  import List List NNI
+
+  -- return list of indexes
+  -- assumes subnodes are leaves containing index
+  faceIndex(subSp: SubSpace(3,DoubleFloat)):List NNI ==
+    faceIndexList:List NNI := []
+    for poly in children(subSp) repeat
+      faceIndexList := cons(extractIndex(poly),faceIndexList)
+    reverse faceIndexList
+
+  -- called if this component contains a single polygon
+  -- write out face information for Wavefront (.OBJ) 3D file format
+  -- one face per line, represented by list of vertex indexes
+  writePolygon(f1:TextFile,curves: List SubSpace(3,DoubleFloat)):Void ==
+    faceIndexList:List NNI := []
+    for curve in curves repeat
+      faceIndexList := append(faceIndexList,faceIndex(curve))
+    -- write out face information for Wavefront (.OBJ) 3D file format
+    -- one face per line, represented by list of vertex indexes
+    s:String := "f "
+    for i in faceIndexList repeat
+      s:=concat(s,string(i))$String
+      s:=concat(s," ")$String
+    writeLine!(f1,s)
+
+  -- called if this component contains a mesh, the mesh will be rendered
+  -- as quad polygons.
+  -- write out face information for Wavefront (.OBJ) 3D file format
+  -- one face per line, represented by list of vertex indexes
+  writeMesh(f1:TextFile,curves: List SubSpace(3,DoubleFloat)):Void ==
+    meshIndexArray:List List NNI := []
+    for curve in curves repeat
+      -- write out face information for Wavefront (.OBJ) 3D file format
+      -- one face per line, represented by list of vertex indexes
+      meshIndexArray := cons(faceIndex(curve),meshIndexArray)
+    meshIndexArray := reverse meshIndexArray
+    rowLength := #meshIndexArray
+    colLength := #(meshIndexArray.1)
+    for i in 1..(rowLength-1) repeat
+      for j in 1..(colLength-1) repeat
+        --s1:String := concat["row ",string(i)," col ",string(j)]
+        --writeLine!(f1,s1)
+        s:String := concat ["f ",string((meshIndexArray.i).j)," ",_
+          string((meshIndexArray.(i+1)).j)," ",_
+            string((meshIndexArray.(i+1)).(j+1))," ",_
+              string((meshIndexArray.i).(j+1))]
+        writeLine!(f1,s)
+
+  toString(d : DoubleFloat) : String ==
+      unparse(convert(d)@InputForm)
+
+  -- this writes SubSpace geometry to Wavefront (.OBJ) 3D file format
+  -- reqires SubSpace to contain 3 or 4 dimensional points over DoubleFloat
+  -- to export a function plot try:
+  -- writeObj(subspace(makeObject(x*x-y*y,x=-1..1,y=-1..1)),"myfile.obj")
+  -- colour dimension is ignored
+  -- no normals or texture data is generated
+  writeObj(subSp: SubSpace(3,DoubleFloat), filename:String):Void ==
+    f1:TextFile:=open(filename::FileName,"output")
+    writeLine!(f1,"# mesh generated by axiom")
+    -- write vertex data
+    verts := pointData(subSp)
+    for v in verts repeat
+      #v < 3  => error "Can't write OBJ file from 2D points"
+      writeLine!(f1,concat(["v ", toString(v.1), " ",_
+                 toString(v.2), " ", toString(v.3)])$String)
+    for component in children(subSp) repeat
+      curves := children(component)
+      if #curves < 2 then
+        sayTeX$Lisp "Can't write point or curve to OBJ file"
+      --writeLine!(f1,"new component")
+      if #curves > 1 then 
+        if numberOfChildren(curves.1) = 1 then writePolygon(f1,curves)
+        if numberOfChildren(curves.1) > 1 then writeMesh(f1,curves)
+    close! f1
+
 *)
 
 \end{chunk}
@@ -33900,9 +45934,7 @@ e04AgentsPackage(): E == I where
       p := (retractIfCan(f)@Union(PDF,"failed"))$EDF
       p case PDF =>
         d := totalDegree(p)$PDF
---        one?(n*d) => "simple"
         (n*d) = 1 => "simple"
---        one?(d) => "linear"
         (d = 1) => "linear"
         (d=2)@Boolean => "quadratic"
         "non-linear"
@@ -33988,6 +46020,180 @@ e04AgentsPackage(): E == I where
 \begin{chunk}{COQ E04AGNT}
 (* package E04AGNT *)
 (*
+
+    import ExpertSystemToolsPackage, ExpertSystemContinuityPackage
+
+    sumOfSquares2:EFI -> Union(EFI,"failed")
+    nonLinear?:EDF -> Boolean
+    finiteBound2:(OCDF,DF) -> DF 
+    functionType:EDF -> String
+
+    finiteBound2(a:OCDF,b:DF):DF ==
+      not finite?(a) =>
+        positive?(a) => b
+        -b
+      retract(a)@DF
+
+    finiteBound(l:LOCDF,b:DF):LDF == [finiteBound2(i,b) for i in l]
+
+    sortConstraints(args:NOA):NOA ==
+      Args := copy args
+      c:LEDF := Args.cf
+      l:LOCDF := Args.lb
+      u:LOCDF := Args.ub
+      m:INT := (# c) - 1      
+      n:INT := (# l) - m
+      for j in m..1 by -1 repeat
+        for i in 1..j repeat
+          s:EDF := c.i
+          t:EDF := c.(i+1)
+          if linear?(t) and (nonLinear?(s) or quadratic?(s)) then
+            swap!(c,i,i+1)$LEDF
+            swap!(l,n+i-1,n+i)$LOCDF
+            swap!(u,n+i-1,n+i)$LOCDF
+      Args
+        
+    changeNameToObjf(s:Symbol,r:Result):Result ==
+      a := remove!(s,r)$Result
+      a case Any =>
+        insert!([objf@Symbol,a],r)$Result
+        r
+      r
+
+    sum(a:EDF,b:EDF):EDF == a+b
+
+    variables(args:LSA): LS == variables(reduce(sum,(args.lfn)))
+
+    sumOfSquares(f:EDF):Union(EDF,"failed") ==
+      e := edf2efi(f)
+      s:Union(EFI,"failed") := sumOfSquares2(e)
+      s case EFI =>
+        map(fi2df,s)$EF2(FI,DF)
+      "failed"
+
+    sumOfSquares2(f:EFI):Union(EFI,"failed") ==
+      p := retractIfCan(f)@Union(PFI,"failed")
+      p case PFI => 
+        r := squareFreePart(p)$PFI
+        (p=r)@Boolean => "failed"
+        tp := totalDegree(p)$PFI
+        tr := totalDegree(r)$PFI
+        t := tp quo tr
+        found := false
+        q := r
+        for i in 2..t by 2 repeat
+          s := q**2
+          (s=p)@Boolean => 
+            found := true
+            leave
+          q := r**i
+        if found then 
+          q :: EFI
+        else
+          "failed"
+      "failed"
+
+    splitLinear(f:EDF):EDF ==
+      out := 0$EDF
+      (l := isPlus(f)$EDF) case LEDF =>
+        for i in l repeat
+          if not quadratic? i then
+            out := out + i
+        out
+      out
+
+    edf2pdf(f:EDF):PDF == (retract(f)@PDF)$EDF
+
+    varList(e:EDF,n:NNI):LS ==
+      s := name(first(variables(edf2pdf(e))$PDF)$LS)$Symbol
+      [subscript(s,[t::OutputForm]) for t in expand([1..n])$Segment(Integer)]
+
+    functionType(f:EDF):String ==
+      n := #(variables(f))$EDF
+      p := (retractIfCan(f)@Union(PDF,"failed"))$EDF
+      p case PDF =>
+        d := totalDegree(p)$PDF
+        (n*d) = 1 => "simple"
+        (d = 1) => "linear"
+        (d=2)@Boolean => "quadratic"
+        "non-linear"
+      "non-linear"
+     
+    simpleBounds?(l: LEDF):Boolean ==
+      a := true
+      for e in l repeat
+        not (functionType(e) = "simple")@Boolean => 
+          a := false
+          leave
+      a
+
+    simple?(e:EDF):Boolean == (functionType(e) = "simple")@Boolean
+
+    linear?(e:EDF):Boolean == (functionType(e) = "linear")@Boolean
+
+    quadratic?(e:EDF):Boolean == (functionType(e) = "quadratic")@Boolean
+
+    nonLinear?(e:EDF):Boolean == (functionType(e) = "non-linear")@Boolean
+
+    linear?(l: LEDF):Boolean ==
+      a := true
+      for e in l repeat
+        s := functionType(e)
+        (s = "quadratic")@Boolean or (s = "non-linear")@Boolean => 
+          a := false
+          leave
+      a
+
+    simplePart(l:LEDF):LEDF == [i for i in l | simple?(i)]
+
+    linearPart(l:LEDF):LEDF == [i for i in l | linear?(i)]
+
+    nonLinearPart(l:LEDF):LEDF ==
+      [i for i in l | not linear?(i) and not simple?(i)]
+
+    linearMatrix(l:LEDF, n:NNI):MDF ==
+      empty?(l) => mat([],n)
+      L := linearPart l
+      M := zero(max(1,# L)$NNI,n)$MDF
+      vars := varList(first(l)$LEDF,n)
+      row:INT := 1
+      for a in L repeat
+        for j in monomials(edf2pdf(a))$PDF repeat
+          col:INT := 1
+          for c in vars repeat
+            if ((first(variables(j)$PDF)$LS)=c)@Boolean then
+              M(row,col):= first(coefficients(j)$PDF)$LDF
+            col := col+1
+        row := row + 1
+      M
+
+    expenseOfEvaluation(o:LSA):F ==
+      expenseOfEvaluation(vector(copy o.lfn)$VEDF)
+
+    optAttributes(o:Union(noa:NOA,lsa:LSA)):List String ==
+      o case noa =>
+        n := o.noa
+        s1:String := "The object function is " functionType(n.fn)
+        if empty?(n.lb) then
+          s2:String := "There are no bounds on the variables" 
+        else
+          s2:String := "There are simple bounds on the variables"
+        c := n.cf
+        if empty?(c) then
+          s3:String := "There are no constraint functions"
+        else
+          t := #(c)
+          lin := #(linearPart(c))
+          nonlin := #(nonLinearPart(c))
+          s3:String := "There are " string(lin)$String " linear and "_
+                          string(nonlin)$String " non-linear constraints"
+        [s1,s2,s3]
+      l := o.lsa
+      s:String := "non-linear"
+      if linear?(l.lfn) then
+        s := "linear"
+      ["The object functions are " s]
+
 *)
 
 \end{chunk}
@@ -34070,9 +46276,9 @@ FactoredFunctions(M:IntegralDomain): Exports == Implementation where
       ++ the logarithm of f is equal to \spad{a1*log(b1) + ... + am*log(bm)}.
 
   Implementation ==> add
+
     nthRoot(ff, n) ==
       coeff:M       := 1
---      radi:List(M)  := (one? unit ff => empty(); [unit ff])
       radi:List(M)  := (((unit ff) = 1) => empty(); [unit ff])
       lf            := factors ff
       d:N :=
@@ -34096,6 +46302,27 @@ FactoredFunctions(M:IntegralDomain): Exports == Implementation where
 \begin{chunk}{COQ FACTFUNC}
 (* package FACTFUNC *)
 (*
+
+    nthRoot(ff, n) ==
+      coeff:M       := 1
+      radi:List(M)  := (((unit ff) = 1) => empty(); [unit ff])
+      lf            := factors ff
+      d:N :=
+        empty? radi => gcd(concat(n, [t.exponent::N for t in lf]))::N
+        1
+      n             := n quo d
+      for term in lf repeat
+        qr    := divide(term.exponent::N quo d, n)
+        coeff := coeff * term.factor ** qr.quotient
+        not zero?(qr.remainder) =>
+          radi := concat_!(radi, term.factor ** qr.remainder)
+      [n, coeff, radi]
+
+    log ff ==
+      ans := unit ff
+      concat([1, unit ff],
+             [[term.exponent::N, term.factor] for term in factors ff])
+
 *)
 
 \end{chunk}
@@ -34270,6 +46497,7 @@ FactoredFunctions2(R, S): Exports == Implementation where
       ++ example, to coerce every factor base to another type.
 
   Implementation ==> add
+
     map(func, f) ==
       func(unit f) *
              _*/[nilFactor(func(g.factor), g.exponent) for g in factors f]
@@ -34279,6 +46507,11 @@ FactoredFunctions2(R, S): Exports == Implementation where
 \begin{chunk}{COQ FR2}
 (* package FR2 *)
 (*
+
+    map(func, f) ==
+      func(unit f) *
+             _*/[nilFactor(func(g.factor), g.exponent) for g in factors f]
+
 *)
 
 \end{chunk}
@@ -34365,6 +46598,7 @@ FactoredFunctionUtilities(R): Exports == Implementation where
       ++ the lists of factors.
 
   Implementation ==> add
+
     fg: FR
     func: R -> FR
     fUnion ==> Union("nil", "sqfr", "irred", "prime")
@@ -34390,6 +46624,27 @@ FactoredFunctionUtilities(R): Exports == Implementation where
 \begin{chunk}{COQ FRUTIL}
 (* package FRUTIL *)
 (*
+
+    fg: FR
+    func: R -> FR
+    fUnion ==> Union("nil", "sqfr", "irred", "prime")
+    FF     ==> Record(flg: fUnion, fctr: R, xpnt: Integer)
+
+    mergeFactors(f,g) ==
+      makeFR(unit(f)*unit(g),append(factorList f,factorList g))
+
+    refine(f, func) ==
+       u := unit(f)
+       l: List FF := empty()
+       for item in factorList f repeat
+         fitem := func item.fctr
+         u := u*unit(fitem) ** (item.xpnt :: NonNegativeInteger)
+         if item.xpnt = 1 then
+            l := concat(factorList fitem,l)
+         else l := concat([[v.flg,v.fctr,v.xpnt*item.xpnt]
+                          for v in factorList fitem],l)
+       makeFR(u,l)
+
 *)
 
 \end{chunk}
@@ -34500,7 +46755,7 @@ FactoringUtilities(E,OV,R,P) : C == T where
           ++ normalDeriv(poly,i) computes the ith derivative of poly divided
           ++ by i!.
         ran        :                Z                       -> R
-          ++ ran(k) computes a random integer between -k and k as a member of R.
+          ++ ran(k) computes a random integer between -k and k as member of R.
 
    T == add
 
@@ -34527,8 +46782,11 @@ FactoringUtilities(E,OV,R,P) : C == T where
        "setUnion"/[variables cf for cf in coefficients f]
 
      if R has FiniteFieldCategory then
+
         ran(k:Z):R == random()$R
+
      else
+
         ran(k:Z):R == (random(2*k+1)$Z -k)::R
 
   -- Compute the normalized m derivative
@@ -34552,6 +46810,53 @@ FactoringUtilities(E,OV,R,P) : C == T where
 \begin{chunk}{COQ FACUTIL}
 (* package FACUTIL *)
 (*
+
+     lowerPolynomial(f:SUP P) : SUP R ==
+       zero? f => 0$SUP(R)
+       monomial(ground leadingCoefficient f, degree f)$SUP(R) +
+           lowerPolynomial(reductum f)
+
+     raisePolynomial(u:SUP R) : SUP P ==
+       zero? u => 0$SUP(P)
+       monomial(leadingCoefficient(u)::P, degree u)$SUP(P) +
+           raisePolynomial(reductum u)
+
+     completeEval(f:SUP P,lvar:List OV,lval:List R) : SUP R ==
+       zero? f => 0$SUP(R)
+       monomial(ground eval(leadingCoefficient f,lvar,lval),degree f)$SUP(R) +
+              completeEval(reductum f,lvar,lval)
+
+     degree(f:SUP P,lvar:List OV) : List NNI ==
+       coefs := coefficients f
+       ldeg:= ["max"/[degree(fc,xx) for fc in coefs] for xx in lvar]
+
+     variables(f:SUP P) : List OV ==
+       "setUnion"/[variables cf for cf in coefficients f]
+
+     if R has FiniteFieldCategory then
+
+        ran(k:Z):R == random()$R
+
+     else
+
+        ran(k:Z):R == (random(2*k+1)$Z -k)::R
+
+  -- Compute the normalized m derivative
+     normalDeriv(f:SUP P,m:Z) : SUP P==
+       (n1:Z:=degree f) < m => 0$SUP(P)
+       n1=m => (leadingCoefficient f)::SUP(P)
+       k:=binomial(n1,m)
+       ris:SUP:=0$SUP(P)
+       n:Z:=n1
+       while n>= m repeat
+         while n1>n repeat
+           k:=(k*(n1-m)) quo n1
+           n1:=n1-1
+         ris:=ris+monomial(k*leadingCoefficient f,(n-m)::NNI)
+         f:=reductum f
+         n:=degree f
+       ris
+
 *)
 
 \end{chunk}
@@ -34630,6 +46935,7 @@ FactorisationOverPseudoAlgebraicClosureOfAlgExtOfRationalNumber(K):Exports == Im
     factorSqFree: (UP,K) -> Factored UP
 
   Implementation ==> add
+
     up2Rat: UP -> SUP(Q)
     rat2up: SUP(Q) -> UP
 
@@ -34742,6 +47048,114 @@ FactorisationOverPseudoAlgebraicClosureOfAlgExtOfRationalNumber(K):Exports == Im
 \begin{chunk}{COQ FACTEXT}
 (* package FACTEXT *)
 (*
+
+    up2Rat: UP -> SUP(Q)
+    rat2up: SUP(Q) -> UP
+
+    factRat: UP -> Factored UP
+    liftPoly: (UP, K) -> UPUP
+
+    liftDefPoly:  UP -> UPUP
+
+    norm: (UP, K) -> UP
+
+    factParPert: ( UP,K,K) -> Factored UP
+
+    trans: (UP, K) -> UP
+
+    swapCoefWithVar: ( UP , NNI) -> UPUP
+
+    frRat2frUP: Factored SUP(Q) -> Factored UP
+
+    factor(pol,a)==
+      polSF:= squareFree pol
+      reduce("*" , [ factorSqFree(fr.fctr,a)**(fr.xpnt pretend NNI) _
+                     for fr in factorList polSF] , 1)
+
+    factorSqFree(pol,a)==
+      ratPol:SUP(Q)
+      aa:Q
+      ground? a => 
+        aa:= retract(a)@Q
+        ratPol:= up2Rat pol 
+        frRat2frUP factor(ratPol,aa)$FACTRNQ::Factored UP 
+      nPol:= norm(pol,a)
+      ta:=previousTower a
+      factN := factor( nPol , ta )
+      lfactnPol:= factorList factN 
+      G:UP:=1
+      L: Factored UP:= 1
+      for fr in lfactnPol repeat
+        G:= gcd( [ pol , fr.fctr ] )
+        pol:= pol quo$UP G
+        if one? fr.xpnt then 
+          L := L *  flagFactor( G, 1 ,"prime")$Factored(UP) 
+        else
+          L := L *   factParPert( G, a, a ) 
+      L
+
+    factParPert(pol, a, b)==
+      polt:=trans(pol,b)
+      frpol:= factorList  factor(polt,a) 
+      sl:= [ fr.fctr for fr in frpol ]
+      slt:= [ trans(p , -b) for p in sl ]
+      nfrpol:= [ flagFactor( p, fr.xpnt , fr.flg )$Factored(UP) _
+                      for p in slt for fr in frpol ]
+      reduce("*" , nfrpol)
+
+    frRat2frUP(fr)==
+      frpol:= factorList fr
+      sl:= [ fr.fctr for fr in frpol ]
+      slt:= [ rat2up p  for p in sl ]
+      nfrpol:= [ flagFactor( p, fr.xpnt , fr.flg )$Factored(UP) _
+                     for p in slt for fr in frpol ]
+      reduce("*" , nfrpol)
+
+    up2Rat(pol)== 
+      zero?(pol) => 0
+      d:=degree pol
+      a:Q:= retract(leadingCoefficient pol)@Q
+      monomial(a,d)$SUP(Q) + up2Rat(reductum pol)
+
+    rat2up(pol)==
+      zero?(pol) => 0
+      d:=degree pol
+      a:K:=(leadingCoefficient pol) :: K
+      monomial(a,d)$UP + rat2up(reductum pol)
+
+    trans(pol,a)==
+      zero? pol => 0
+      lc:=leadingCoefficient pol
+      d:=degree pol
+      lc*(monomial(1,1)$UP + monomial(-a ,0)$UP)**d + trans(reductum pol ,a) 
+
+    liftDefPoly(pol)==
+      zero?(pol) => 0
+      lc:= leadingCoefficient pol
+      d:= degree pol
+      monomial( monomial(lc,0)$UP , d )$UPUP + liftDefPoly reductum pol
+
+    norm(pol,a)==
+      lpol:=liftPoly(pol,a)
+      defPol:=definingPolynomial a
+      ldefPol:=liftDefPoly defPol
+      resultant(ldefPol,lpol)
+
+    swapCoefWithVar(coef,n)==
+      ground? coef => 
+        monomial( monomial( retract coef , n)$SUP(K) , 0)$UPUP
+      lcoef:=leadingCoefficient(coef)
+      d:=degree(coef)
+      monomial(monomial(lcoef,n)$SUP(K),d)$UPUP+_
+                 swapCoefWithVar(reductum coef,n )
+
+    liftPoly(pol,a)==
+      zero? pol => 0
+      lcoef:=leadingCoefficient pol
+      n:=degree pol
+      liftCoef:= lift(lcoef,a)$K
+      swapCoefWithVar(liftCoef , n) + liftPoly( reductum pol , a )
+
 *)
 
 \end{chunk}
@@ -34820,6 +47234,7 @@ FactorisationOverPseudoAlgebraicClosureOfRationalNumber(K):Exports ==
     factorSqFree: (UP,K) -> Factored UP
 
   Implementation ==> add
+
     up2Rat: UP -> SUP(Q)
     rat2up: SUP(Q) -> UP
 
@@ -34932,6 +47347,114 @@ FactorisationOverPseudoAlgebraicClosureOfRationalNumber(K):Exports ==
 \begin{chunk}{COQ FACTRN}
 (* package FACTRN *)
 (*
+
+    up2Rat: UP -> SUP(Q)
+    rat2up: SUP(Q) -> UP
+
+    factRat: UP -> Factored UP
+    liftPoly: (UP, K) -> UPUP
+
+    liftDefPoly:  UP -> UPUP
+
+    norm: (UP, K) -> UP
+
+    factParPert: ( UP,K,K) -> Factored UP
+
+    trans: (UP, K) -> UP
+
+    swapCoefWithVar: ( UP , NNI) -> UPUP
+
+    frRat2frUP: Factored SUP(Q) -> Factored UP
+
+    factor(pol,a)==
+      polSF:= squareFree pol
+      reduce("*" , _
+       [ factorSqFree(fr.fctr,a)**(fr.xpnt pretend NNI) _
+           for fr in factorList polSF] , 1)
+
+    factorSqFree(pol,a)==
+      ratPol:SUP(Q)
+      ground? a => 
+        ratPol:= up2Rat pol 
+        frRat2frUP factor( ratPol )$RationalFactorize( SUP(Q) ) :: Factored UP 
+      nPol:= norm(pol,a)
+      ta:=previousTower a
+      factN := factor( nPol , ta )
+      lfactnPol:= factorList factN 
+      G:UP:=1
+      L: Factored UP:= 1
+      for fr in lfactnPol repeat
+        G:= gcd( [ pol , fr.fctr ] )
+        pol:= pol quo$UP G
+        if one? fr.xpnt then 
+          L := L *  flagFactor( G, 1 ,"prime")$Factored(UP) 
+        else
+          L := L *   factParPert( G, a, a ) 
+      L
+      
+    factParPert(pol, a, b)==
+      polt:=trans(pol,b)
+      frpol:= factorList  factor(polt,a) 
+      sl:= [ fr.fctr for fr in frpol ]
+      slt:= [ trans(p , -b) for p in sl ]
+      nfrpol:= [ flagFactor( p, fr.xpnt , fr.flg )$Factored(UP) _
+                   for p in slt for fr in frpol ]
+      reduce("*" , nfrpol)
+
+    frRat2frUP(fr)==
+      frpol:= factorList fr
+      sl:= [ fr.fctr for fr in frpol ]
+      slt:= [ rat2up p  for p in sl ]
+      nfrpol:= [ flagFactor( p, fr.xpnt , fr.flg )$Factored(UP) _
+                   for p in slt for fr in frpol ]
+      reduce("*" , nfrpol)
+
+    up2Rat(pol)== 
+      zero?(pol) => 0
+      d:=degree pol
+      a:Q:= retract(leadingCoefficient pol)@Q
+      monomial(a,d)$SUP(Q) + up2Rat(reductum pol)
+
+    rat2up(pol)==
+      zero?(pol) => 0
+      d:=degree pol
+      a:K:=(leadingCoefficient pol) :: K
+      monomial(a,d)$UP + rat2up(reductum pol)
+      
+    trans(pol,a)==
+      zero? pol => 0
+      lc:=leadingCoefficient pol
+      d:=degree pol
+
+      lc*( monomial(1,1)$UP + monomial(-a,0)$UP )**d + trans(reductum pol , a) 
+ 
+    liftDefPoly(pol)==
+      zero?(pol) => 0
+      lc:= leadingCoefficient pol
+      d:= degree pol
+      monomial( monomial(lc,0)$UP , d )$UPUP + liftDefPoly reductum pol
+
+    norm(pol,a)==
+      lpol:=liftPoly(pol,a)
+      defPol:=definingPolynomial a
+      ldefPol:=liftDefPoly defPol
+      resultant(ldefPol,lpol)
+      
+    swapCoefWithVar(coef,n)==
+      ground? coef => 
+        monomial( monomial( retract coef , n)$SUP(K) , 0)$UPUP
+      lcoef:=leadingCoefficient(coef)
+      d:=degree(coef)
+      monomial( monomial(lcoef,  n )$SUP(K) , d)$UPUP + _
+                 swapCoefWithVar( reductum coef, n )
+
+    liftPoly(pol,a)==
+      zero? pol => 0
+      lcoef:=leadingCoefficient pol
+      n:=degree pol
+      liftCoef:= lift(lcoef,a)$K
+      swapCoefWithVar(liftCoef , n) + liftPoly( reductum pol , a )
+
 *)
 
 \end{chunk}
@@ -35080,6 +47603,41 @@ FGLMIfCanPackage(R,ls): Exports == Implementation where
 \begin{chunk}{COQ FGLMICPK}
 (* package FGLMICPK *)
 (*
+
+     zeroDim?(lq2: List Q2): Boolean ==
+       lq2 := groebner(lq2)$groebnerpack2
+       empty? lq2 => false
+       #lq2 < #ls => false
+       lv: List(V) := [(variable(s)$V)::V for s in ls]
+       for q2 in lq2 while not empty?(lv) repeat
+          m := leadingMonomial(q2)
+          x := mainVariable(m)::V
+          if ground?(leadingCoefficient(univariate(m,x))) then
+               lv := remove(x, lv)
+       empty? lv
+
+     zeroDimensional?(lq1: List(Q1)): Boolean ==
+       lq2: List(Q2) := [pToHdmp(q1)$poltopol for q1 in lq1]
+       zeroDim?(lq2)
+
+     fglmIfCan(lq1:List(Q1)): Union(List(Q1),"failed") == 
+       lq2: List(Q2) := [pToHdmp(q1)$poltopol for q1 in lq1]
+       lq2 := groebner(lq2)$groebnerpack2
+       not zeroDim?(lq2) => "failed"::Union(List(Q1),"failed")
+       lq3: List(Q3) := totolex(lq2)$lingrobpack
+       lq1 := [dmpToP(q3)$poltopol for q3 in lq3]
+       lq1::Union(List(Q1),"failed")
+
+     groebner(lq1:List(Q1)): List(Q1) ==
+       lq2: List(Q2) := [pToHdmp(q1)$poltopol for q1 in lq1]
+       lq2 := groebner(lq2)$groebnerpack2
+       not zeroDim?(lq2) => 
+         lq3: List(Q3) := [pToDmp(q1)$poltopol for q1 in lq1]
+         lq3 := groebner(lq3)$groebnerpack3
+         [dmpToP(q3)$poltopol for q3 in lq3]
+       lq3: List(Q3) := totolex(lq2)$lingrobpack
+       [dmpToP(q3)$poltopol for q3 in lq3]
+
 *)
 
 \end{chunk}
@@ -35153,6 +47711,7 @@ FindOrderFinite(F, UP, UPUP, R): Exports == Implementation where
     order: FiniteDivisor(F, UP, UPUP, R) -> NonNegativeInteger
       ++ order(x) \undocumented
   Implementation ==> add
+
     order d ==
       dd := d := reduce d
       for i in 1.. repeat
@@ -35164,6 +47723,13 @@ FindOrderFinite(F, UP, UPUP, R): Exports == Implementation where
 \begin{chunk}{COQ FORDER}
 (* package FORDER *)
 (*
+
+    order d ==
+      dd := d := reduce d
+      for i in 1.. repeat
+        principal? dd => return(i::NonNegativeInteger)
+        dd := reduce(d + dd)
+
 *)
 
 \end{chunk}
@@ -35252,6 +47818,12 @@ FiniteAbelianMonoidRingFunctions2(E: OrderedAbelianMonoid,
 \begin{chunk}{COQ FAMR2}
 (* package FAMR2 *)
 (*
+
+    map(f: R1 -> R2, a: A1): A2 ==
+      if zero? a then 0$A2
+      else
+        monomial(f leadingCoefficient a, degree a)$A2 + map(f, reductum a)
+
 *)
 
 \end{chunk}
@@ -35330,6 +47902,7 @@ FiniteDivisorFunctions2(R1, UP1, UPUP1, F1, R2, UP2, UPUP2, F2):
       ++ map(f,d) \undocumented{} 
 
   Implementation ==> add
+
     import UnivariatePolynomialCategoryFunctions2(R1,UP1,R2,UP2)
     import FunctionFieldCategoryFunctions2(R1,UP1,UPUP1,F1,R2,UP2,UPUP2,F2)
     import FractionalIdealFunctions2(UP1, Fraction UP1, UPUP1, F1,
@@ -35345,6 +47918,17 @@ FiniteDivisorFunctions2(R1, UP1, UPUP1, F1, R2, UP2, UPUP2, F2):
 \begin{chunk}{COQ FDIV2}
 (* package FDIV2 *)
 (*
+
+    import UnivariatePolynomialCategoryFunctions2(R1,UP1,R2,UP2)
+    import FunctionFieldCategoryFunctions2(R1,UP1,UPUP1,F1,R2,UP2,UPUP2,F2)
+    import FractionalIdealFunctions2(UP1, Fraction UP1, UPUP1, F1,
+                                     UP2, Fraction UP2, UPUP2, F2)
+
+    map(f, d) ==
+      rec := decompose d
+      divisor map(f, rec.principalPart) + 
+        divisor map((s:UP1):UP2 +-> map(f,s), rec.id)
+
 *)
 
 \end{chunk}
@@ -35631,6 +48215,197 @@ FiniteFieldFactorization(K : FiniteFieldCategory,
 \begin{chunk}{COQ FFFACTOR}
 (* package FFFACTOR *)
 (*
+
+     import FiniteFieldSquareFreeDecomposition(K, PolK)
+
+     p : NonNegativeInteger := characteristic()$K
+
+     p' : NonNegativeInteger := p quo 2      -- used for odd p : (p-1)/2
+
+     q : NonNegativeInteger := size()$K
+
+     q' : NonNegativeInteger := q quo 2	-- used for odd q : (q-1)/2
+
+     X : PolK := monomial(1, 1)
+
+     primeKdim : NonNegativeInteger :=
+         q_quo_p : NonNegativeInteger := q quo p ;  e : NonNegativeInteger := 1
+         while q_quo_p > 1 repeat (e := e + 1 ; q_quo_p := q_quo_p quo p)
+         e
+     
+     exp(P : PolK, n : NonNegativeInteger, R : PolK) : PolK ==
+        PP : PolK := P rem R ;  Q : PolK := 1
+        repeat
+           if odd?(n) then Q := Q * PP rem R
+           (n := n quo 2) = 0 => leave
+           PP := PP * PP rem  R
+        return Q
+     
+     pPowers(P : PolK) : PrimitiveArray(PolK) ==  -- P is monic
+        n := degree(P)
+        result : PrimitiveArray(PolK) := new(n, 1)
+        result(1) := Qi := Q := exp(X, p, P)
+        for i in 2 .. n-1 repeat (Qi := Qi*Q rem P ; result(i) := Qi)
+        return result
+     
+     pExp(Q : PolK, Xpowers : PrimitiveArray(PolK)) : PolK ==
+         Q' : PolK := 0
+         while Q ^= 0 repeat
+             Q' := Q' +primeFrobenius(leadingCoefficient(Q))*Xpowers(degree(Q))
+             Q := reductum(Q)
+         return Q'
+     
+     pTrace(Q : PolK, d : NonNegativeInteger, P : PolK,
+            Xpowers : PrimitiveArray(PolK)) : PolK ==
+         Q : PolK := Q rem P
+         result : PolK := Q
+         for i in 1 .. d-1 repeat result := Q + pExp(result, Xpowers)
+         return result rem P
+     
+     random(n : NonNegativeInteger) : PolK ==
+        repeat
+           if (deg := (random(n)$Integer)::NonNegativeInteger) > 0 then leave
+        repeat
+           if (x : K := random()$K) ^= 0 then leave
+        result : PolK :=
+           monomial(x, deg) + +/[monomial(random()$K, i) for i in 0 .. deg-1]
+        return result
+     
+     internalFactorCZ(P : PolK,          -- P monic-squarefree
+           d:NonNegativeInteger, Xpowers:PrimitiveArray(PolK)) : List(PolK) ==
+     
+         listOfFactors : List(PolK) := [P]
+         degree(P) = d => return listOfFactors
+         result : List(PolK) := []
+         pDim : NonNegativeInteger := d * primeKdim
+         Q : PolK := P
+     
+         repeat
+             G := pTrace(random(degree(Q)), pDim, Q, Xpowers)
+             if p > 2 then G := exp(G, p', Q) - 1
+             Q1 := gcd(G, Q) ;  d1 := degree(Q1)
+             if d1 > 0 and d1 < degree(Q) then
+                 listOfFactors := rest(listOfFactors)
+                 if d1 = d then result := cons(Q1, result)
+                          else listOfFactors := cons(Q1, listOfFactors)
+                 Q1 := Q quo Q1 ;  d1 := degree(Q1)
+                 if d1 = d then result := cons(Q1, result)
+                          else listOfFactors := cons(Q1, listOfFactors)
+                 if empty?(listOfFactors) then leave
+                 Q := first(listOfFactors)
+         return result
+
+     internalFactorSquareFree(P : PolK):List(PolK) == -- P is monic-squareFree
+         degree(P) = 1 => [P]
+         result : List(PolK) := []
+         Xpowers : PrimitiveArray(PolK) := pPowers(P)
+         S : PolK := Xpowers(1)
+         for j in 1..primeKdim-1 repeat S := pExp(S, Xpowers)
+         for i in 1 .. repeat  -- S = X**(q**i) mod P
+             if degree(R := gcd(S - X, P)) > 0 then
+                 result := concat(internalFactorCZ(R, i, Xpowers), result)
+                 if degree (P) = degree (R) then return result
+                 P := P quo R
+                 if i >= degree(P) quo 2 then return cons(P, result)
+                 for j in 0 .. degree(P)-1 repeat Xpowers(j):=Xpowers(j) rem P
+                 S := S rem P
+             else if i >= degree(P) quo 2 then return cons(P, result)
+             for j in 1 .. primeKdim repeat S := pExp(S, Xpowers)
+     
+     internalFactor(P:PolK, sqrfree:PolK -> Factored(PolK)) : Factored(PolK) ==
+         result : Factored(PolK)
+         if (d := minimumDegree(P)) > 0 then
+             P := P quo monomial(1, d)
+             result := primeFactor(X, d)
+         else
+             result := 1
+         degree(P) = 0 => P * result
+         if (lcP := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P
+         degree(P) = 1 => lcP::PolK * primeFactor(P, 1) * result
+         sqfP : Factored(PolK) := sqrfree(P)
+         for x in factors(sqfP) repeat
+             xFactors : List(PolK) := internalFactorSquareFree(x.factor)
+             result:= result * */[primeFactor(Q, x.exponent) for Q in xFactors]
+         return lcP::PolK * result
+     
+     factorUsingYun(P : PolK) : Factored(PolK) == internalFactor(P, Yun)
+
+     factorUsingMusser(P : PolK) : Factored(PolK) == internalFactor(P, Musser)
+
+     factor(P : PolK) : Factored(PolK) == factorUsingYun(P)
+     
+     factorSquareFree(P : PolK) : List(PolK) ==
+        degree(P) = 0 => []
+        discriminant(P) = 0 => error("factorSquareFree : non quadratfrei")
+        if (lcP := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P
+        return internalFactorSquareFree(P)
+     
+     factorCantorZassenhaus(P : PolK, d : NonNegativeInteger) : List(PolK) ==
+        if (lcP := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P
+        degree(P) = 1 => [P]
+        return internalFactorCZ(P, d, pPowers(P))
+     
+     qExp(Q : PolK, XqPowers : PrimitiveArray(PolK)) : PolK ==
+        Q' : PolK := 0
+        while Q ^= 0 repeat
+           Q' := Q' + leadingCoefficient(Q) * XqPowers(degree(Q))
+           Q := reductum(Q)
+        return Q'
+
+     qPowers (Xq : PolK, P : PolK) : PrimitiveArray(PolK) == -- Xq = X**q mod P
+        n := degree(P)
+        result : PrimitiveArray(PolK) := new(n, 1)
+        result(1) := Q := Xq
+        for i in 2 .. n-1 repeat (Q := Q*Xq rem P ; result(i) := Q)
+        return result
+
+     discriminantTest?(P : PolK) : Boolean ==
+         (delta : K := discriminant(P)) = 0 => true
+         StickelbergerTest : Boolean := (delta ** q' = 1) = even?(degree(P))
+         return StickelbergerTest
+
+     evenCharacteristicIrreducible?(P : PolK) : Boolean ==
+         (n := degree(P)) = 0 => false
+         n = 1 => true
+         degree(gcd(P, D(P))) > 0 => false
+         if (lcP := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P
+         S : PolK := exp(X, q, P)
+         if degree(gcd(S - X, P)) > 0 then
+            return false
+         if n < 4 then return true
+         maxDegreeToTest : NonNegativeInteger := n quo 2
+         XqPowers : PrimitiveArray(PolK) := qPowers(S, P)
+         for i in 2 .. maxDegreeToTest repeat
+            S := qExp(S, XqPowers)
+            if degree(gcd(S - X, P)) > 0 then
+               return false
+         return true
+
+     oddCharacteristicIrreducible?(P : PolK) : Boolean ==
+         (n := degree(P)) = 0 => false
+         n = 1 => true
+         discriminantTest?(P) => false
+         if (lcP := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P
+         S : PolK := exp(X, q, P)
+         if degree(gcd(S - X, P)) > 0 then
+            return false
+         if n < 6  then return true
+         maxDegreeToTest : NonNegativeInteger := n quo 3
+         XqPowers : PrimitiveArray(PolK) := qPowers(S, P)
+         for i in 2 .. maxDegreeToTest repeat
+            S := qExp(S, XqPowers)
+            if degree(gcd(S - X, P)) > 0 then
+               return false
+         return true
+
+     if p = 2 then
+
+         irreducible?(P : PolK) : Boolean == evenCharacteristicIrreducible?(P)
+
+     else
+
+         irreducible?(P : PolK) : Boolean == oddCharacteristicIrreducible?(P)
+
 *)
 
 \end{chunk}
@@ -35732,11 +48507,17 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory,
   == add
 
      import FiniteFieldSquareFreeDecomposition(K, PolK)
+
      p : NonNegativeInteger := characteristic()$K
+
      p' : NonNegativeInteger := p quo 2      -- used for odd p : (p-1)/2
+
      q : NonNegativeInteger := size()$K
+
      q' : NonNegativeInteger := q quo 2	-- used for odd q : (q-1)/2
+
      X : PolK := monomial(1, 1)
+
      primeKdim : NonNegativeInteger :=
          q_quo_p : NonNegativeInteger := q quo p ;  e : NonNegativeInteger := 1
          while q_quo_p > 1 repeat (e := e + 1 ; q_quo_p := q_quo_p quo p)
@@ -35916,9 +48697,13 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory,
             if degree(gcd(S - X, P)) > 0 then
                return false
          return true
+
      if p = 2 then
+
          irreducible?(P : PolK) : Boolean == evenCharacteristicIrreducible?(P)
+
      else
+
          irreducible?(P : PolK) : Boolean == oddCharacteristicIrreducible?(P)
 
 \end{chunk}
@@ -35926,6 +48711,207 @@ FiniteFieldFactorizationWithSizeParseBySideEffect(K : FiniteFieldCategory,
 \begin{chunk}{COQ FFFACTSE}
 (* package FFFACTSE *)
 (*
+
+     import FiniteFieldSquareFreeDecomposition(K, PolK)
+
+     p : NonNegativeInteger := characteristic()$K
+
+     p' : NonNegativeInteger := p quo 2      -- used for odd p : (p-1)/2
+
+     q : NonNegativeInteger := size()$K
+
+     q' : NonNegativeInteger := q quo 2	-- used for odd q : (q-1)/2
+
+     X : PolK := monomial(1, 1)
+
+     primeKdim : NonNegativeInteger :=
+         q_quo_p : NonNegativeInteger := q quo p ;  e : NonNegativeInteger := 1
+         while q_quo_p > 1 repeat (e := e + 1 ; q_quo_p := q_quo_p quo p)
+         e
+     
+     initialize(): Void() ==
+        q : NonNegativeInteger := size()$K
+        q' : NonNegativeInteger := q quo 2	-- used for odd q : (q-1)/2
+	primeKdim : NonNegativeInteger :=
+          q_quo_p : NonNegativeInteger := q quo p ;  e:NonNegativeInteger := 1
+          while q_quo_p > 1 repeat (e := e + 1 ; q_quo_p := q_quo_p quo p)
+          e
+	  
+     exp(P : PolK, n : NonNegativeInteger, R : PolK) : PolK ==
+        PP : PolK := P rem R ;  Q : PolK := 1
+        repeat
+           if odd?(n) then Q := Q * PP rem R
+           (n := n quo 2) = 0 => leave
+           PP := PP * PP rem  R
+        return Q
+     
+     pPowers(P : PolK) : PrimitiveArray(PolK) ==  -- P is monic
+        n := degree(P)
+        result : PrimitiveArray(PolK) := new(n, 1)
+        result(1) := Qi := Q := exp(X, p, P)
+        for i in 2 .. n-1 repeat (Qi := Qi*Q rem P ; result(i) := Qi)
+        return result
+     
+     pExp(Q : PolK, Xpowers : PrimitiveArray(PolK)) : PolK ==
+         Q' : PolK := 0
+         while Q ^= 0 repeat
+             Q':=Q' +primeFrobenius(leadingCoefficient(Q)) * Xpowers(degree(Q))
+             Q := reductum(Q)
+         return Q'
+     
+     pTrace(Q : PolK, d : NonNegativeInteger, P : PolK,
+            Xpowers : PrimitiveArray(PolK)) : PolK ==
+         Q : PolK := Q rem P
+         result : PolK := Q
+         for i in 1 .. d-1 repeat result := Q + pExp(result, Xpowers)
+         return result rem P
+     
+     random(n : NonNegativeInteger) : PolK ==
+        repeat
+           if (deg := (random(n)$Integer)::NonNegativeInteger) > 0 then leave
+        repeat
+           if (x : K := random()$K) ^= 0 then leave
+        result : PolK :=
+           monomial(x, deg) + +/[monomial(random()$K, i) for i in 0 .. deg-1]
+        return result
+     
+     internalFactorCZ(P : PolK,          -- P monic-squarefree
+           d:NonNegativeInteger, Xpowers:PrimitiveArray(PolK)) : List(PolK) ==
+     
+         listOfFactors : List(PolK) := [P]
+         degree(P) = d => return listOfFactors
+         result : List(PolK) := []
+         pDim : NonNegativeInteger := d * primeKdim
+         Q : PolK := P
+     
+         repeat
+             G := pTrace(random(degree(Q)), pDim, Q, Xpowers)
+             if p > 2 then G := exp(G, p', Q) - 1
+             Q1 := gcd(G, Q) ;  d1 := degree(Q1)
+             if d1 > 0 and d1 < degree(Q) then
+                 listOfFactors := rest(listOfFactors)
+                 if d1 = d then result := cons(Q1, result)
+                          else listOfFactors := cons(Q1, listOfFactors)
+                 Q1 := Q quo Q1 ;  d1 := degree(Q1)
+                 if d1 = d then result := cons(Q1, result)
+                          else listOfFactors := cons(Q1, listOfFactors)
+                 if empty?(listOfFactors) then leave
+                 Q := first(listOfFactors)
+         return result
+
+     internalFactorSquareFree(P:PolK):List(PolK) ==   -- P is monic-squareFree
+         degree(P) = 1 => [P]
+         result : List(PolK) := []
+         Xpowers : PrimitiveArray(PolK) := pPowers(P)
+         S : PolK := Xpowers(1)
+         for j in 1..primeKdim-1 repeat S := pExp(S, Xpowers)
+         for i in 1 .. repeat  -- S = X**(q**i) mod P
+             if degree(R := gcd(S - X, P)) > 0 then
+                 result := concat(internalFactorCZ(R, i, Xpowers), result)
+                 if degree (P) = degree (R) then return result
+                 P := P quo R
+                 if i >= degree(P) quo 2 then return cons(P, result)
+                 for j in 0 .. degree(P)-1 repeat Xpowers(j):=Xpowers(j) rem P
+                 S := S rem P
+             else if i >= degree(P) quo 2 then return cons(P, result)
+             for j in 1 .. primeKdim repeat S := pExp(S, Xpowers)
+     
+     internalFactor(P:PolK, sqrfree:PolK -> Factored(PolK)) : Factored(PolK) ==
+         result : Factored(PolK)
+         if (d := minimumDegree(P)) > 0 then
+             P := P quo monomial(1, d)
+             result := primeFactor(X, d)
+         else
+             result := 1
+         degree(P) = 0 => P * result
+         if (lcP := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P
+         degree(P) = 1 => lcP::PolK * primeFactor(P, 1) * result
+         sqfP : Factored(PolK) := sqrfree(P)
+         for x in factors(sqfP) repeat
+             xFactors : List(PolK) := internalFactorSquareFree(x.factor)
+             result:=result * */[primeFactor(Q, x.exponent) for Q in xFactors]
+         return lcP::PolK * result
+     
+     factorUsingYun(P : PolK) : Factored(PolK) == internalFactor(P, Yun)
+
+     factorUsingMusser(P : PolK) : Factored(PolK) == internalFactor(P, Musser)
+
+     factor(P : PolK) : Factored(PolK) == 
+        initialize()
+        factorUsingYun(P)
+     
+     factorSquareFree(P : PolK) : List(PolK) ==
+        degree(P) = 0 => []
+        discriminant(P) = 0 => error("factorSquareFree : non quadratfrei")
+        if (lcP := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P
+        return internalFactorSquareFree(P)
+     
+     factorCantorZassenhaus(P : PolK, d : NonNegativeInteger) : List(PolK) ==
+        if (lcP := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P
+        degree(P) = 1 => [P]
+        return internalFactorCZ(P, d, pPowers(P))
+     
+     qExp(Q : PolK, XqPowers : PrimitiveArray(PolK)) : PolK ==
+        Q' : PolK := 0
+        while Q ^= 0 repeat
+           Q' := Q' + leadingCoefficient(Q) * XqPowers(degree(Q))
+           Q := reductum(Q)
+        return Q'
+
+     qPowers (Xq:PolK, P:PolK) : PrimitiveArray(PolK) ==  -- Xq = X**q mod P
+        n := degree(P)
+        result : PrimitiveArray(PolK) := new(n, 1)
+        result(1) := Q := Xq
+        for i in 2 .. n-1 repeat (Q := Q*Xq rem P ; result(i) := Q)
+        return result
+
+     discriminantTest?(P : PolK) : Boolean ==
+         (delta : K := discriminant(P)) = 0 => true
+         StickelbergerTest : Boolean := (delta ** q' = 1) = even?(degree(P))
+         return StickelbergerTest
+
+     evenCharacteristicIrreducible?(P : PolK) : Boolean ==
+         (n := degree(P)) = 0 => false
+         n = 1 => true
+         degree(gcd(P, D(P))) > 0 => false
+         if (lcP := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P
+         S : PolK := exp(X, q, P)
+         if degree(gcd(S - X, P)) > 0 then
+            return false
+         if n < 4 then return true
+         maxDegreeToTest : NonNegativeInteger := n quo 2
+         XqPowers : PrimitiveArray(PolK) := qPowers(S, P)
+         for i in 2 .. maxDegreeToTest repeat
+            S := qExp(S, XqPowers)
+            if degree(gcd(S - X, P)) > 0 then
+               return false
+         return true
+
+     oddCharacteristicIrreducible?(P : PolK) : Boolean ==
+         (n := degree(P)) = 0 => false
+         n = 1 => true
+         discriminantTest?(P) => false
+         if (lcP := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P
+         S : PolK := exp(X, q, P)
+         if degree(gcd(S - X, P)) > 0 then
+            return false
+         if n < 6  then return true
+         maxDegreeToTest : NonNegativeInteger := n quo 3
+         XqPowers : PrimitiveArray(PolK) := qPowers(S, P)
+         for i in 2 .. maxDegreeToTest repeat
+            S := qExp(S, XqPowers)
+            if degree(gcd(S - X, P)) > 0 then
+               return false
+         return true
+
+     if p = 2 then
+
+         irreducible?(P : PolK) : Boolean == evenCharacteristicIrreducible?(P)
+
+     else
+
+         irreducible?(P : PolK) : Boolean == oddCharacteristicIrreducible?(P)
+
 *)
 
 \end{chunk}
@@ -36068,7 +49054,6 @@ FiniteFieldFunctions(GF): Exports == Implementation where
 
   Implementation ==> add
 
-
     createLowComplexityNormalBasis(n) ==
       (u:=createLowComplexityTable(n)) case "failed" =>
         createNormalPoly(n)$FiniteFieldPolynomialPackage(GF)
@@ -36234,6 +49219,167 @@ FiniteFieldFunctions(GF): Exports == Implementation where
 \begin{chunk}{COQ FFF}
 (* package FFF *)
 (*
+
+    createLowComplexityNormalBasis(n) ==
+      (u:=createLowComplexityTable(n)) case "failed" =>
+        createNormalPoly(n)$FiniteFieldPolynomialPackage(GF)
+      u::(V L TERM)
+
+-- try to find a low complexity normal basis multiplication table
+-- of the field of extension degree n
+-- the algorithm is from:
+-- Wassermann A., Konstruktion von Normalbasen,
+-- Bayreuther Mathematische Schriften 31 (1989),1-9.
+
+    createLowComplexityTable(n) ==
+      q:=size()$GF
+      -- this algorithm works only for prime fields
+      p:=characteristic()$GF
+      -- search of a suitable parameter k
+      k:NNI:=0
+      for i in 1..n-1  while (k=0) repeat
+        if prime?(i*n+1) and not(p = (i*n+1)) then
+          primitive?(q::PF(i*n+1))$PF(i*n+1) =>
+              a:NNI:=1
+              k:=i
+              t1:PF(k*n+1):=(q::PF(k*n+1))**n
+          gcd(n,a:=discreteLog(q::PF(n*i+1))$PF(n*i+1))$I = 1 =>
+              k:=i
+              t1:=primitiveElement()$PF(k*n+1)**n
+      k = 0 => "failed"
+      -- initialize some start values
+      multmat:M PF(p):=zero(n,n)
+      p1:=(k*n+1)
+      pkn:=q::PF(p1)
+      t:=t1 pretend PF(p1)
+      if odd?(k) then
+          jt:I:=(n quo 2)+1
+          vt:I:=positiveRemainder((k-a) quo 2,k)+1
+        else
+          jt:I:=1
+          vt:I:=(k quo 2)+1
+      -- compute matrix
+      vec:Vector I:=zero(p1 pretend NNI)
+      for x in 1..k repeat
+        for l in 1..n repeat
+          vec.((t**(x-1) * pkn**(l-1)) pretend Integer+1):=_
+                                            positiveRemainder(l,p1)
+      lvj:M I:=zero(k::NNI,n)
+      for v in 1..k repeat
+        for j in 1..n repeat
+          if (j^=jt) or (v^=vt) then
+            help:PF(p1):=t**(v-1)*pkn**(j-1)+1@PF(p1)
+            setelt(lvj,v,j,vec.(help pretend I +1))
+      for j in 1..n repeat
+        if j^=jt then
+          for v in 1..k repeat
+            lvjh:=elt(lvj,v,j)
+            setelt(multmat,j,lvjh,elt(multmat,j,lvjh)+1)
+      for i in 1..n repeat
+        setelt(multmat,jt,i,positiveRemainder(-k,p)::PF(p))
+      for v in 1..k repeat
+        if v^=vt then
+          lvjh:=elt(lvj,v,jt)
+          setelt(multmat,jt,lvjh,elt(multmat,jt,lvjh)+1)
+      -- multmat
+      m:=nrows(multmat)$(M PF(p))
+      multtable:V L TERM:=new(m,nil()$(L TERM))$(V L TERM)
+      for i in 1..m repeat
+        l:L TERM:=nil()$(L TERM)
+        v:V PF(p):=row(multmat,i)
+        for j in (1::I)..(m::I) repeat
+          if (v.j ^= 0) then
+            -- take -v.j to get trace 1 instead of -1
+            term:TERM:=[(convert(-v.j)@I)::GF,(j-2) pretend SI]$TERM
+            l:=cons(term,l)$(L TERM)
+        qsetelt_!(multtable,i,copy l)$(V L TERM)
+      multtable
+
+    sizeMultiplication(m) ==
+      s:NNI:=0
+      for i in 1..#m repeat
+        s := s + #(m.i)
+      s
+
+    createMultiplicationTable(f:SUP) ==
+      sizeGF:NNI:=size()$GF -- the size of the ground field
+      m:PI:=degree(f)$SUP pretend PI
+      m=1 =>
+        [[[-coefficient(f,0)$SUP,(-1)::SI]$TERM]$(L TERM)]::(V L TERM)
+      m1:I:=m-1
+      -- initialize basis change matrices
+      setPoly(f)$MM
+      e:=reduce(monomial(1,1)$SUP)$MM ** sizeGF
+      w:=1$MM
+      qpow:PrimitiveArray(MM):=new(m,0)
+      qpow.0:=1$MM
+      for i in 1..m1 repeat
+        qpow.i:=(w:=w*e)
+      -- qpow.i = x**(i*q)
+      qexp:PrimitiveArray(MM):=new(m,0)
+      qexp.0:=reduce(monomial(1,1)$SUP)$MM
+      mat:M GF:=zero(m,m)$(M GF)
+      qsetelt_!(mat,2,1,1$GF)$(M GF)
+      h:=qpow.1
+      qexp.1:=h
+      setColumn_!(mat,2,Vectorise(h)$MM)$(M GF)
+      for i in 2..m1 repeat
+        g:=0$MM
+        while h ^= 0 repeat
+          g:=g + leadingCoefficient(h) * qpow.degree(h)$MM
+          h:=reductum(h)$MM
+        qexp.i:=g
+        setColumn_!(mat,i+1,Vectorise(h:=g)$MM)$(M GF)
+      -- loop invariant: qexp.i = x**(q**i)
+      mat1:=inverse(mat)$(M GF)
+      mat1 = "failed" =>
+        error "createMultiplicationTable: polynomial must be normal"
+      mat:=mat1 :: (M GF)
+      -- initialize multiplication table
+      multtable:V L TERM:=new(m,nil()$(L TERM))$(V L TERM)
+      for i in 1..m repeat
+        l:L TERM:=nil()$(L TERM)
+        v:V GF:=mat *$(M GF) Vectorise(qexp.(i-1) *$MM qexp.0)$MM
+        for j in (1::SI)..(m::SI) repeat
+          if (v.j ^= 0$GF) then
+            term:TERM:=[(v.j),j-(2::SI)]$TERM
+            l:=cons(term,l)$(L TERM)
+        qsetelt_!(multtable,i,copy l)$(V L TERM)
+      multtable
+
+
+    createZechTable(f:SUP) ==
+      sizeGF:NNI:=size()$GF -- the size of the ground field
+      m:=degree(f)$SUP::PI
+      qm1:SI:=(sizeGF ** m -1) pretend SI
+      zechlog:ARR:=new(((sizeGF ** m + 1) quo 2)::NNI,-1::SI)$ARR
+      helparr:ARR:=new(sizeGF ** m::NNI,0$SI)$ARR
+      primElement:=reduce(monomial(1,1)$SUP)$SAE(GF,SUP,f)
+      a:=primElement
+      for i in 1..qm1-1 repeat
+        helparr.(lookup(a -$SAE(GF,SUP,f) 1$SAE(GF,SUP,f)_
+           )$SAE(GF,SUP,f)):=i::SI
+        a:=a * primElement
+      characteristic() = 2 =>
+        a:=primElement
+        for i in 1..(qm1 quo 2) repeat
+          zechlog.i:=helparr.lookup(a)$SAE(GF,SUP,f)
+          a:=a * primElement
+        zechlog
+      a:=1$SAE(GF,SUP,f)
+      for i in 0..((qm1-2) quo 2) repeat
+        zechlog.i:=helparr.lookup(a)$SAE(GF,SUP,f)
+        a:=a * primElement
+      zechlog
+
+    createMultiplicationMatrix(m) ==
+      n:NNI:=#m
+      mat:M GF:=zero(n,n)$(M GF)
+      for i in 1..n repeat
+        for t in m.i repeat
+          qsetelt_!(mat,i,t.index+2,t.value)
+      mat
+
 *)
 
 \end{chunk}
@@ -36379,10 +49525,8 @@ FiniteFieldHomomorphisms(F1,GF,F2): Exports == Implementation where
     defPol2:=definingPolynomial()$F2
     -- the defining polynomials of the fields
  
- 
 -- functions ==========================================================
  
- 
     compare: (SUP GF,SUP GF) -> Boolean
     -- compares two polynomials
  
@@ -36416,7 +49560,7 @@ FiniteFieldHomomorphisms(F1,GF,F2): Exports == Implementation where
  
     initialize() ==
       -- 1) in the case of equal def. polynomials initialize is called only
-      --  if one of the rep. types is "normal" and the other one is "polynomial"
+      -- if one of the rep. types is "normal" and the other one is "polynomial"
       --  we have to compute the basis change matrix 'mat', which i-th
       --  column are the coordinates of a**(q**i), the i-th component of
       --  the normal basis ('a' the root of the def. polynomial and q the
@@ -36442,7 +49586,7 @@ FiniteFieldHomomorphisms(F1,GF,F2): Exports == Implementation where
         repType1 = "normal" =>  -- repType2 = "polynomial"
           conMat1to2:=copy(mat)
           conMat2to1:=copy(inverse(mat)$M :: M)
-          --we finish the function for one case, hence reset initialization flag
+          --finish the function for one case, hence reset initialization flag
           init? := false
           void()$Void
           -- print("'normal' <=> 'polynomial' matrices initialized"::OUT)
@@ -36578,7 +49722,6 @@ FiniteFieldHomomorphisms(F1,GF,F2): Exports == Implementation where
       init? := false
       void()$Void
       
- 
     coerce(x:F1) ==
       inGroundField?(x)$F1 => retract(x)$F1 :: F2
       -- if x is already in GF then we can use a simple coercion
@@ -36618,7 +49761,6 @@ FiniteFieldHomomorphisms(F1,GF,F2): Exports == Implementation where
 -- the three functions below equal the three functions above up to
 -- '1' exchanged by '2' in all domain and variable names
  
- 
     coerce(x:F2) ==
       inGroundField?(x)$F2 => retract(x)$F2 :: F1
       -- if x is already in GF then we can use a simple coercion
@@ -36652,6 +49794,299 @@ FiniteFieldHomomorphisms(F1,GF,F2): Exports == Implementation where
 \begin{chunk}{COQ FFHOM}
 (* package FFHOM *)
 (*
+ 
+-- global variables ===================================================
+ 
+    degree1:NNI:= extensionDegree()$F1
+    degree2:NNI:= extensionDegree()$F2
+    -- the degrees of the last extension
+ 
+    -- a necessary condition for the one field being an subfield of
+    -- the other one is, that the respective extension degrees are
+    -- multiples
+    if max(degree1,degree2) rem min(degree1,degree2) ^= 0 then
+      error "FFHOM: one extension degree must divide the other one"
+ 
+    conMat1to2:M:= zero(degree2,degree1)$M
+    -- conversion Matix for the conversion direction F1 -> F2
+    conMat2to1:M:= zero(degree1,degree2)$M
+    -- conversion Matix for the conversion direction F2 -> F1
+ 
+    repType1:=representationType()$F1
+    repType2:=representationType()$F2
+    -- the representation types of the fields
+ 
+    init?:Boolean:=true
+    -- gets false after initialization
+ 
+    defPol1:=definingPolynomial()$F1
+    defPol2:=definingPolynomial()$F2
+    -- the defining polynomials of the fields
+ 
+-- functions ==========================================================
+ 
+    compare: (SUP GF,SUP GF) -> Boolean
+    -- compares two polynomials
+ 
+    convertWRTsameDefPol12: F1  ->  F2
+    convertWRTsameDefPol21: F2  ->  F1
+    -- homomorphism if the last extension of F1 and F2 was build up
+    -- using the same defining polynomials
+ 
+    convertWRTdifferentDefPol12: F1  ->  F2
+    convertWRTdifferentDefPol21: F2  ->  F1
+    -- homomorphism if the last extension of F1 and F2 was build up
+    -- with different defining polynomials
+ 
+    initialize: () -> Void
+    -- computes the conversion matrices
+ 
+    compare(g:(SUP GF),f:(SUP GF)) ==
+      degree(f)$(SUP GF)  >$NNI degree(g)$(SUP GF) => true
+      degree(f)$(SUP GF) <$NNI degree(g)$(SUP GF) => false
+      equal:Integer:=0
+      for i in degree(f)$(SUP GF)..0 by -1 while equal=0 repeat
+        not zero?(coefficient(f,i)$(SUP GF))$GF and _
+             zero?(coefficient(g,i)$(SUP GF))$GF => equal:=1
+        not zero?(coefficient(g,i)$(SUP GF))$GF and _
+             zero?(coefficient(f,i)$(SUP GF))$GF => equal:=(-1)
+        (f1:=lookup(coefficient(f,i)$(SUP GF))$GF) >$PositiveInteger _
+         (g1:=lookup(coefficient(g,i)$(SUP GF))$GF) =>  equal:=1
+        f1 <$PositiveInteger g1 => equal:=(-1)
+      equal=1 => true
+      false
+ 
+    initialize() ==
+      -- 1) in the case of equal def. polynomials initialize is called only
+      -- if one of the rep. types is "normal" and the other one is "polynomial"
+      --  we have to compute the basis change matrix 'mat', which i-th
+      --  column are the coordinates of a**(q**i), the i-th component of
+      --  the normal basis ('a' the root of the def. polynomial and q the
+      --  size of the groundfield)
+      defPol1 =$(SUP GF) defPol2 =>
+        -- new code using reducedQPowers
+        mat:=zero(degree1,degree1)$M
+        arr:=reducedQPowers(defPol1)$FFPOLY(GF)
+        for i in 1..degree1 repeat
+          setColumn_!(mat,i,vectorise(arr.(i-1),degree1)$SUP(GF))$M
+          -- old code
+          -- here one of the representation types must be "normal"
+          --a:=basis()$FFP(GF,defPol1).2  -- the root of the def. polynomial
+          --setColumn_!(mat,1,coordinates(a)$FFP(GF,defPol1))$M
+          --for i in 2..degree1 repeat
+          --  a:= a **$FFP(GF,defPol1) size()$GF
+          --  setColumn_!(mat,i,coordinates(a)$FFP(GF,defPol1))$M
+          --for the direction "normal" -> "polynomial" we have to multiply the
+          -- coordinate vector of an element of the normal basis field with
+          -- the matrix 'mat'. In this case 'mat' is the correct conversion
+          -- matrix for the conversion of F1 to F2, its inverse the correct
+          -- inversion matrix for the conversion of F2 to F1
+        repType1 = "normal" =>  -- repType2 = "polynomial"
+          conMat1to2:=copy(mat)
+          conMat2to1:=copy(inverse(mat)$M :: M)
+          --finish the function for one case, hence reset initialization flag
+          init? := false
+          void()$Void
+          -- print("'normal' <=> 'polynomial' matrices initialized"::OUT)
+        -- in the other case we have to change the matrices
+        -- repType2 = "normal" and repType1 = "polynomial"
+        conMat2to1:=copy(mat)
+        conMat1to2:=copy(inverse(mat)$M :: M)
+        -- print("'normal' <=> 'polynomial' matrices initialized"::OUT)
+        --we finish the function for one case, hence reset initialization flag
+        init? := false
+        void()$Void
+      -- 2) in the case of different def. polynomials we have to order the
+      --    fields to get the same isomorphism, if the package is called with
+      --    the fields F1 and F2 swapped.
+      dPbig:= defPol2
+      rTbig:= repType2
+      dPsmall:= defPol1
+      rTsmall:= repType1
+      degbig:=degree2
+      degsmall:=degree1
+      if compare(defPol2,defPol1) then
+        degsmall:=degree2
+        degbig:=degree1
+        dPbig:= defPol1
+        rTbig:= repType1
+        dPsmall:= defPol2
+        rTsmall:= repType2
+      -- 3) in every case we need a conversion between the polynomial
+      --  represented fields. Therefore we compute 'root' as a root of the
+      --  'smaller' def. polynomial in the 'bigger' field.
+      --  We compute the matrix 'matsb', which i-th column are the coordinates
+      --  of the (i-1)-th power of root, i=1..degsmall. Multiplying a
+      --  coordinate vector of an element of the 'smaller' field by this
+      --  matrix, we got the coordinates of the corresponding element in the
+      --  'bigger' field.
+      -- compute the root of dPsmall in the 'big' field
+      root:=rootOfIrreduciblePoly(dPsmall)$FFPOL2(FFP(GF,dPbig),GF)
+      -- set up matrix for polynomial conversion
+      matsb:=zero(degbig,degsmall)$M
+      qsetelt_!(matsb,1,1,1$GF)$M
+      a:=root
+      for i in 2..degsmall repeat
+        setColumn_!(matsb,i,coordinates(a)$FFP(GF,dPbig))$M
+        a := a *$FFP(GF,dPbig) root
+      --  the conversion from 'big' to 'small': we can't invert matsb
+      --  directly, because it has degbig rows and degsmall columns and
+      --  may be no square matrix. Therfore we construct a square matrix
+      --  mat from degsmall linear independent rows of matsb and invert it.
+      --  Now we get the conversion matrix 'matbs' for the conversion from
+      --  'big' to 'small' by putting the columns of mat at the indices
+      --  of the linear independent rows of matsb to columns of matbs.
+      ra:I:=1   -- the rank
+      mat:M:=transpose(row(matsb,1))$M -- has already rank 1
+      rowind:I:=2
+      iVec:Vector I:=new(degsmall,1$I)$(Vector I)
+      while ra < degsmall repeat
+        if rank(vertConcat(mat,transpose(row(matsb,rowind))$M)$M)$M > ra then
+          mat:=vertConcat(mat,transpose(row(matsb,rowind))$M)$M
+          ra:=ra+1
+          iVec.ra := rowind
+        rowind:=rowind + 1
+      mat:=inverse(mat)$M :: M
+      matbs:=zero(degsmall,degbig)$M
+      for i in 1..degsmall repeat
+        setColumn_!(matbs,iVec.i,column(mat,i)$M)$M
+      -- print(matsb::OUT)
+      -- print(matbs::OUT)
+      -- 4) if the 'bigger' field is "normal" we have to compose the
+      --  polynomial conversion with a conversion from polynomial to normal
+      --  between the FFP(GF,dPbig) and FFNBP(GF,dPbig) the 'bigger'
+      --  field. Therefore we compute a conversion matrix 'mat' as in 1)
+      --  Multiplying with the inverse of 'mat' yields the desired
+      --  conversion from polynomial to normal. Multiplying this matrix by
+      --  the above computed 'matsb' we got the matrix for converting form
+      --  'small polynomial' to 'big normal'.
+      -- set up matrix 'mat' for polynomial to normal
+      if rTbig = "normal" then
+        arr:=reducedQPowers(dPbig)$FFPOLY(GF)
+        mat:=zero(degbig,degbig)$M
+        for i in 1..degbig repeat
+          setColumn_!(mat,i,vectorise(arr.(i-1),degbig)$SUP(GF))$M
+        -- old code
+        --a:=basis()$FFP(GF,dPbig).2  -- the root of the def.Polynomial
+        --setColumn_!(mat,1,coordinates(a)$FFP(GF,dPbig))$M
+        --for i in 2..degbig repeat
+        --  a:= a **$FFP(GF,dPbig) size()$GF
+        --  setColumn_!(mat,i,coordinates(a)$FFP(GF,dPbig))$M
+        -- print(inverse(mat)$M::OUT)
+        matsb:= (inverse(mat)$M :: M) * matsb
+        -- print("inv *.."::OUT)
+        matbs:=matbs * mat
+        -- 5) if the 'smaller' field is "normal" we have first to convert
+        --    from 'small normal' to 'small polynomial', that is from
+        --    FFNBP(GF,dPsmall) to FFP(GF,dPsmall). Therefore we compute a
+        --    conversion matrix 'mat' as in 1). Multiplying with  'mat'
+        --    yields the desired conversion from normal to polynomial.
+        --    Multiplying the above computed 'matsb' with 'mat' we got the
+        --    matrix for converting form 'small normal' to 'big normal'.
+      -- set up matrix 'mat' for normal to polynomial
+      if rTsmall = "normal" then
+        arr:=reducedQPowers(dPsmall)$FFPOLY(GF)
+        mat:=zero(degsmall,degsmall)$M
+        for i in 1..degsmall repeat
+          setColumn_!(mat,i,vectorise(arr.(i-1),degsmall)$SUP(GF))$M
+      -- old code
+      --b:FFP(GF,dPsmall):=basis()$FFP(GF,dPsmall).2
+      --setColumn_!(mat,1,coordinates(b)$FFP(GF,dPsmall))$M
+      --for i in 2..degsmall repeat
+      --  b:= b **$FFP(GF,dPsmall) size()$GF
+      --  setColumn_!(mat,i,coordinates(b)$FFP(GF,dPsmall))$M
+        -- print(mat::OUT)
+        matsb:= matsb * mat
+        matbs:= (inverse(mat) :: M) * matbs
+      -- now 'matsb' is the corret conversion matrix for 'small' to 'big'
+      -- and 'matbs' the corret one for 'big' to 'small'.
+      -- depending on the above ordering the conversion matrices are
+      -- initialized
+      dPbig =$(SUP GF) defPol2 =>
+        conMat1to2 :=matsb
+        conMat2to1 :=matbs
+        -- print(conMat1to2::OUT)
+        -- print(conMat2to1::OUT)
+        -- print("conversion matrices initialized"::OUT)
+        --we finish the function for one case, hence reset initialization flag
+        init? := false
+        void()$Void
+      conMat1to2 :=matbs
+      conMat2to1 :=matsb
+      -- print(conMat1to2::OUT)
+      -- print(conMat2to1::OUT)
+      -- print("conversion matrices initialized"::OUT)
+      --we finish the function for one case, hence reset initialization flag
+      init? := false
+      void()$Void
+      
+    coerce(x:F1) ==
+      inGroundField?(x)$F1 => retract(x)$F1 :: F2
+      -- if x is already in GF then we can use a simple coercion
+      defPol1 =$(SUP GF) defPol2 => convertWRTsameDefPol12(x)
+      convertWRTdifferentDefPol12(x)
+ 
+    convertWRTsameDefPol12(x:F1)  ==
+      repType1 = repType2 => x pretend F2
+      -- same groundfields, same defining polynomials, same
+      -- representation types --> F1 = F2, x is already in F2
+      repType1 = "cyclic" =>
+        x = 0$F1 => 0$F2
+      -- the SI corresponding to the cyclic representation is the exponent of
+      -- the primitiveElement, therefore we exponentiate the primitiveElement
+      -- of F2 by it.
+        primitiveElement()$F2 **$F2 (x pretend SI)
+      repType2 = "cyclic" =>
+        x = 0$F1 => 0$F2
+      -- to get the exponent, we have to take the discrete logarithm of the
+      -- element in the given field.
+        (discreteLog(x)$F1 pretend SI) pretend F2
+      -- here one of the representation types is "normal"
+      if init? then initialize()
+      -- here a conversion matrix is necessary, (see initialize())
+      represents(conMat1to2 *$(Matrix GF) coordinates(x)$F1)$F2
+ 
+    convertWRTdifferentDefPol12(x:F1) ==
+      if init? then initialize()
+      -- if we want to convert into a 'smaller' field, we have to test,
+      -- whether the element is in the subfield of the 'bigger' field, which
+      -- corresponds to the 'smaller' field
+      if degree1 > degree2 then
+        if positiveRemainder(degree2,degree(x)$F1)^= 0 then
+          error "coerce: element doesn't belong to smaller field"
+      represents(conMat1to2 *$(Matrix GF) coordinates(x)$F1)$F2
+ 
+-- the three functions below equal the three functions above up to
+-- '1' exchanged by '2' in all domain and variable names
+ 
+    coerce(x:F2) ==
+      inGroundField?(x)$F2 => retract(x)$F2 :: F1
+      -- if x is already in GF then we can use a simple coercion
+      defPol1 =$(SUP GF) defPol2 => convertWRTsameDefPol21(x)
+      convertWRTdifferentDefPol21(x)
+ 
+    convertWRTsameDefPol21(x:F2)  ==
+      repType1 = repType2 => x pretend F1
+      -- same groundfields, same defining polynomials,
+      -- same representation types --> F1 = F2, that is:
+      -- x is already in F1
+      repType2 = "cyclic" =>
+        x = 0$F2 => 0$F1
+        primitiveElement()$F1 **$F1 (x pretend SI)
+      repType1 = "cyclic" =>
+        x = 0$F2 => 0$F1
+        (discreteLog(x)$F2 pretend SI) pretend F1
+      -- here one of the representation types is "normal"
+      if init? then initialize()
+      represents(conMat2to1 *$(Matrix GF) coordinates(x)$F2)$F1
+ 
+    convertWRTdifferentDefPol21(x:F2) ==
+      if init? then initialize()
+      if degree2 > degree1 then
+        if positiveRemainder(degree1,degree(x)$F2)^= 0 then
+          error "coerce: element doesn't belong to smaller field"
+      represents(conMat2to1 *$(Matrix GF) coordinates(x)$F2)$F1
+
 *)
 
 \end{chunk}
@@ -36925,7 +50360,6 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where
     import IntegerNumberTheoryFunctions
     import DistinctDegreeFactorize(GF, SUP)
 
-
     MM := ModMonic(GF, SUP)
 
     sizeGF : PI := size()$GF :: PI
@@ -36975,7 +50409,7 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where
       qexp
 
     leastAffineMultiple(f) ==
-    -- [LS] p.112
+      -- [LS] p.112
       qexp:=reducedQPowers(f)
       n:=degree(f)$SUP
       b:Matrix GF:= transpose matrix [entries vectorise
@@ -37001,20 +50435,6 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where
       (coeffVector(1)::SUP) +(+/[monomial(coeffVector.k, _
                sizeGF**((k-2)::NNI))$SUP for k in 2..dim])
 
---    qEulerPhiCyclotomic n ==
---      n = 1 => (sizeGF - 1) pretend PI
---      p : PI := characteristic()$GF :: PI
---      (n rem p) = 0 => error
---        "cyclotomic polynomial not defined for this argument value"
---      q  : PI := sizeGF
---      -- determine the multiplicative order of q modulo n
---      e  : PI := 1
---      qe : PI := q
---      while (qe rem n) ^= 1 repeat
---        e  := e + 1
---        qe := qe * q
---      ((qe - 1) ** ((eulerPhi(n) quo e) pretend PI) ) pretend PI
-
     numberOfIrreduciblePoly n ==
       -- we compute the number Nq(n) of monic irreducible polynomials
       -- of degree n over the field GF of order q by the formula
@@ -37680,25 +51100,6 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where
 
     createPrimitiveNormalPoly n == createNormalPrimitivePoly n
 
---    qAdicExpansion m ==
---      ragits : List I := wholeRagits(m :: (RadixExpansion sizeGF))
---      pol  : SUP := 0
---      expt : NNI := #ragits
---      for i in ragits repeat
---        expt := (expt - 1) :: NNI
---        if i ^= 0 then pol := pol + monomial(index(i::PI)$GF, expt)
---      pol
-
---    random == qAdicExpansion(random()$I)
-
---    random n ==
---      pol := monomial(1,n)$SUP
---      n1 : NNI := (n - 1) :: NNI
---      for i in 0..n1 repeat
---        if (c := random()$GF) ^= 0 then
---          pol := pol + monomial(c, i)$SUP
---      pol
-
     random n ==
       polRepr : Repr := []
       n1 : NNI := (n - 1) :: NNI
@@ -37718,6 +51119,764 @@ FiniteFieldPolynomialPackage GF : Exports == Implementation where
 \begin{chunk}{COQ FFPOLY}
 (* package FFPOLY *)
 (*
+
+    import IntegerNumberTheoryFunctions
+    import DistinctDegreeFactorize(GF, SUP)
+
+    MM := ModMonic(GF, SUP)
+
+    sizeGF : PI := size()$GF :: PI
+
+    revListToSUP(l:Repr):SUP ==
+        newl:Repr := empty()
+        -- cannot use map since copy for Record is an XLAM
+        for t in l repeat newl := cons(copy t, newl)
+        newl pretend SUP
+
+    listToSUP(l:Repr):SUP ==
+        newl:Repr := [copy t for t in l]
+        newl pretend SUP
+
+    nextSubset : (L NNI, NNI) -> Union(L NNI, "failed")
+      -- for a list s of length m with 1 <= s.1 < ... < s.m <= bound,
+      -- nextSubset(s, bound) yields the immediate successor of s
+      -- (resp. "failed" if s = [1,...,bound])
+      -- where s < t if and only if:
+      -- (i)  #s < #t; or
+      -- (ii) #s = #t and s < t in the lexicographical order;
+      -- (we have chosen to fix the signature with NNI instead of PI
+      --  to avoid coercions in the main functions)
+
+    reducedQPowers(f) ==
+      m:PI:=degree(f)$SUP pretend PI
+      m1:I:=m-1
+      setPoly(f)$MM
+      e:=reduce(monomial(1,1)$SUP)$MM ** sizeGF
+      w:=1$MM
+      qpow:PrimitiveArray SUP:=new(m,0)
+      qpow.0:=1$SUP
+      for i in 1..m1 repeat  qpow.i:=lift(w:=w*e)$MM
+      qexp:PrimitiveArray SUP:=new(m,0)
+      m = 1 =>
+        qexp.(0$I):= (-coefficient(f,0$NNI)$SUP)::SUP
+        qexp
+      qexp.0$I:=monomial(1,1)$SUP
+      h:=qpow.1
+      qexp.1:=h
+      for i in 2..m1 repeat
+        g:=0$SUP
+        while h ^= 0 repeat
+          g:=g + leadingCoefficient(h) * qpow.degree(h)
+          h:=reductum(h)
+        qexp.i:=(h:=g)
+      qexp
+
+    leastAffineMultiple(f) ==
+      -- [LS] p.112
+      qexp:=reducedQPowers(f)
+      n:=degree(f)$SUP
+      b:Matrix GF:= transpose matrix [entries vectorise
+           (qexp.i,n) for i in 0..n-1]
+      col1:Matrix GF:= new(n,1,0)
+      col1(1,1)  := 1
+      ns : List Vector GF := nullSpace (horizConcat(col1,b) )
+      ----------------------------------------------------------------
+      -- perhaps one should use that the first vector in ns is already
+      -- the right one
+      ----------------------------------------------------------------
+      dim:=n+2
+      coeffVector : Vector GF
+      until empty? ns repeat
+        newCoeffVector := ns.1
+        i : PI :=(n+1) pretend PI
+        while newCoeffVector(i) = 0 repeat
+          i := (i - 1) pretend PI
+        if i < dim then
+          dim := i
+          coeffVector := newCoeffVector
+        ns := rest ns
+      (coeffVector(1)::SUP) +(+/[monomial(coeffVector.k, _
+               sizeGF**((k-2)::NNI))$SUP for k in 2..dim])
+
+    numberOfIrreduciblePoly n ==
+      -- we compute the number Nq(n) of monic irreducible polynomials
+      -- of degree n over the field GF of order q by the formula
+      -- Nq(n) = (1/n)* sum(moebiusMu(n/d)*q**d) where the sum extends
+      -- over all divisors d of n (cf. [LN] p.93, Th. 3.25)
+      n = 1 => sizeGF
+      -- the contribution of d = 1 :
+      lastd : PI  := 1
+      qd    : PI  := sizeGF
+      sum   :  I  := moebiusMu(n) * qd
+      -- the divisors d > 1 of n :
+      divisorsOfn : L PI := rest(divisors n) pretend L PI
+      for d in divisorsOfn repeat
+        qd := qd * (sizeGF) ** ((d - lastd) pretend PI)
+        sum := sum + moebiusMu(n quo d) * qd
+        lastd := d
+      (sum quo n) :: PI
+
+    numberOfPrimitivePoly n == (eulerPhi((sizeGF ** n) - 1) quo n) :: PI
+      -- [each root of a primitive polynomial of degree n over a field
+      --  with q elements is a generator of the multiplicative group
+      --  of a field of order q**n (definition), and the number of such
+      --  generators is precisely eulerPhi(q**n - 1)]
+
+    numberOfNormalPoly n ==
+      -- we compute the number Nq(n) of normal polynomials of degree n
+      -- in GF[X], with GF of order q, by the formula
+      -- Nq(n) = (1/n) * qPhi(X**n - 1) (cf. [LN] p.124) where,
+      -- for any polynomial f in GF[X] of positive degree n,
+      -- qPhi(f) = q**n * (1 - q**(-n1)) *...* (1 - q**(-nr)) =
+      -- q**n * ((q**(n1)-1) / q**(n1)) *...* ((q**(nr)-1) / q**(n_r)),
+      -- the ni being the degrees of the distinct irreducible factors
+      -- of f in its canonical factorization over GF
+      -- ([LN] p.122, Lemma 3.69).
+      -- hence, if n = m * p**r where p is the characteristic of GF
+      -- and gcd(m,p) = 1, we get
+      -- Nq(n) = (1/n)* q**(n-m) * qPhi(X**m - 1)
+      -- now X**m - 1 is the product of the (pairwise relatively prime)
+      -- cyclotomic polynomials Qd(X) for which d divides m
+      -- ([LN] p.64, Th. 2.45), and each Qd(X) factors into
+      -- eulerPhi(d)/e (distinct) monic irreducible polynomials in GF[X]
+      -- of the same degree e, where e is the least positive integer k
+      -- such that d divides q**k - 1 ([LN] p.65, Th. 2.47)
+      n = 1 => (sizeGF - 1) :: NNI :: PI
+      m : PI := n
+      p : PI := characteristic()$GF :: PI
+      q : PI := sizeGF
+      while (m rem p) = 0 repeat   -- find m such that
+        m := (m quo p) :: PI       -- n = m * p**r and gcd(m,p) = 1
+      m = 1 =>
+         -- know that n is a power of p
+        (((q ** ((n-1)::NNI) )  * (q - 1) ) quo n) :: PI
+      prod : I := q - 1
+      divisorsOfm : L PI := rest(divisors m) pretend L PI
+      for d in divisorsOfm repeat
+        -- determine the multiplicative order of q modulo d
+        e  : PI := 1
+        qe : PI := q
+        while (qe rem d) ^= 1 repeat
+          e  := e + 1
+          qe := qe * q
+        prod := prod * _
+          ((qe - 1) ** ((eulerPhi(d) quo e) pretend PI) ) pretend PI
+      (q**((n-m) pretend PI) * prod quo n) pretend PI
+
+    primitive? f ==
+      -- let GF be a field of order q; a monic polynomial f in GF[X]
+      -- of degree n is primitive over GF if and only if its constant
+      -- term is non-zero, f divides X**(q**n - 1) - 1 and,
+      -- for each prime divisor d of q**n - 1,
+      -- f does not divide X**((q**n - 1) / d) - 1
+      -- (cf. [LN] p.89, Th. 3.16, and p.87, following Th. 3.11)
+      n : NNI := degree f
+      n = 0 => false
+      leadingCoefficient f ^= 1 => false
+      coefficient(f, 0) = 0 => false
+      q  : PI := sizeGF
+      qn1: PI := (q**n - 1) :: NNI :: PI
+      setPoly f
+      x := reduce(monomial(1,1)$SUP)$MM -- X rem f represented in MM
+      --
+      -- may be improved by tabulating the residues x**(i*q)
+      -- for i = 0,...,n-1 :
+      --
+      lift(x ** qn1)$MM ^= 1 => false -- X**(q**n - 1) rem f in GF[X]
+      lrec  : L Record(factor:I, exponent:I) := factors(factor qn1)
+      lfact : L PI := []              -- collect the prime factors
+      for rec in lrec repeat          -- of q**n - 1
+        lfact := cons((rec.factor) :: PI, lfact)
+      for d in lfact repeat
+        if (expt := (qn1 quo d)) >= n then
+          lift(x ** expt)$MM = 1 => return false
+      true
+
+    normal? f ==
+      -- let GF be a field with q elements; a monic irreducible
+      -- polynomial f in GF[X] of degree n is normal if its roots
+      -- x, x**q, ... , x**(q**(n-1)) are linearly independent over GF
+      n : NNI := degree f
+      n = 0 => false
+      leadingCoefficient f ^= 1 => false
+      coefficient(f, 0) = 0 => false
+      n = 1 => true
+      not irreducible? f => false
+      g:=reducedQPowers(f)
+      l:=[entries vectorise(g.i,n)$SUP for i in 0..(n-1)::NNI]
+      rank(matrix(l)$Matrix(GF)) = n => true
+      false
+
+    nextSubset(s, bound) ==
+      m : NNI := #(s)
+      m = 0 => [1]
+      -- find the first element s(i) of s such that s(i) + 1 < s(i+1) :
+      noGap : Boolean := true
+      i : NNI := 0
+      restOfs : L NNI
+      while noGap and not empty?(restOfs := rest s) repeat
+      -- after i steps (0 <= i <= m-1) we have s = [s(i), ... , s(m)]
+      -- and restOfs = [s(i+1), ... , s(m)]
+        secondOfs := first restOfs    -- s(i+1)
+        firstOfsPlus1 := first s + 1  -- s(i) + 1
+        secondOfs = firstOfsPlus1 =>
+          s := restOfs
+          i := i + 1
+        setfirst_!(s, firstOfsPlus1)  -- s := [s(i)+1, s(i+1),..., s(m)]
+        noGap := false
+      if noGap then                   -- here s = [s(m)]
+        firstOfs := first s
+        firstOfs < bound => setfirst_!(s, firstOfs + 1) -- s := [s(m)+1]
+        m < bound =>
+            setfirst_!(s, m + 1)      -- s := [m+1]
+            i := m
+        return "failed"               -- (here m = s(m) = bound)
+      for j in i..1 by -1 repeat  -- reconstruct the destroyed
+        s := cons(j, s)           -- initial part of s
+      s
+
+    nextIrreduciblePoly f ==
+      n : NNI := degree f
+      n = 0 => error "polynomial must have positive degree"
+      -- make f monic
+      if (lcf := leadingCoefficient f) ^= 1 then f := (inv lcf) * f
+      -- if f = fn*X**n + ... + f{i0}*X**{i0} with the fi non-zero
+      -- then fRepr := [[n,fn], ... , [i0,f{i0}]]
+      fRepr : Repr := f pretend Repr
+      fcopy : Repr := []
+      -- we can not simply write fcopy := copy fRepr because
+      -- the input(!) f would be modified by assigning
+      -- a new value to one of its records
+      for term in fRepr repeat
+        fcopy := cons(copy term, fcopy)
+      if term.expnt ^= 0 then
+        fcopy := cons([0,0]$Rec, fcopy)
+      tailpol : Repr := []
+      headpol : Repr := fcopy  -- [[0,f0], ... , [n,fn]] where
+                               -- fi is non-zero for i > 0
+      fcopy   := reverse fcopy
+      weight  : NNI := (#(fcopy) - 1) :: NNI -- #s(f) as explained above
+      taillookuplist : L NNI := []
+      -- the zeroes in the headlookuplist stand for the fi
+      -- whose lookup's were not yet computed :
+      headlookuplist : L NNI := new(weight, 0)
+      s  : L NNI := [] -- we will compute s(f) only if necessary
+      n1 : NNI := (n - 1) :: NNI
+      repeat
+        -- (run through the possible weights)
+        while not empty? headlookuplist repeat
+          -- find next polynomial in the above order with fixed weight;
+          -- assume at this point we have
+          -- headpol = [[i1,f{i1}], [i2,f{i2}], ... , [n,1]]
+          -- and tailpol = [[k,fk], ... , [0,f0]] (with k < i1)
+          term := first headpol
+          j := first headlookuplist
+          if j = 0 then j := lookup(term.coeff)$GF
+          j := j + 1 -- lookup(f{i1})$GF + 1
+          j rem sizeGF = 0 =>
+            -- in this case one has to increase f{i2}
+            tailpol := cons(term, tailpol) -- [[i1,f{i1}],...,[0,f0]]
+            headpol := rest headpol        -- [[i2,f{i2}],...,[n,1]]
+            taillookuplist := cons(j, taillookuplist)
+            headlookuplist := rest headlookuplist
+          -- otherwise set f{i1} := index(j)$GF
+          setelt(first headpol, coeff, index(j :: PI)$GF)
+          setfirst_!(headlookuplist, j)
+          if empty? taillookuplist then
+            pol := revListToSUP(headpol)
+            --
+            -- may be improved by excluding reciprocal polynomials
+            --
+            irreducible? pol => return pol
+          else
+            -- go back to fk
+            headpol := cons(first tailpol, headpol) -- [[k,fk],...,[n,1]]
+            tailpol := rest tailpol
+            headlookuplist := cons(first taillookuplist, headlookuplist)
+            taillookuplist := rest taillookuplist
+        -- must search for polynomial with greater weight
+        if empty? s then -- compute s(f)
+          restfcopy := rest fcopy
+          for entry in restfcopy repeat s := cons(entry.expnt, s)
+        weight = n => return "failed"
+        s1 := nextSubset(rest s, n1) :: L NNI
+        s := cons(0, s1)
+        weight := #s
+        taillookuplist := []
+        headlookuplist := cons(sizeGF, new((weight-1) :: NNI, 1))
+        tailpol := []
+        headpol := [] -- [[0,0], [s.2,1], ... , [s.weight,1], [n,1]] :
+        s1 := cons(n, reverse s1)
+        while not empty? s1 repeat
+          headpol := cons([first s1, 1]$Rec, headpol)
+          s1 := rest s1
+        headpol := cons([0, 0]$Rec, headpol)
+
+    nextPrimitivePoly f ==
+      n : NNI := degree f
+      n = 0 => error "polynomial must have positive degree"
+      -- make f monic
+      if (lcf := leadingCoefficient f) ^= 1 then f := (inv lcf) * f
+      -- if f = fn*X**n + ... + f{i0}*X**{i0} with the fi non-zero
+      -- then fRepr := [[n,fn], ... , [i0,f{i0}]]
+      fRepr : Repr := f pretend Repr
+      fcopy : Repr := []
+      -- we can not simply write fcopy := copy fRepr because
+      -- the input(!) f would be modified by assigning
+      -- a new value to one of its records
+      for term in fRepr repeat
+        fcopy := cons(copy term, fcopy)
+      if term.expnt ^= 0 then
+        term  := [0,0]$Rec
+        fcopy := cons(term, fcopy)
+      fcopy   := reverse fcopy
+      xn : Rec := first fcopy
+      c0 : GF  := term.coeff
+      l  : NNI := lookup(c0)$GF rem sizeGF
+      n = 1 =>
+        -- the polynomial X + c is primitive if and only if -c
+        -- is a primitive element of GF
+        q1 : NNI  := (sizeGF - 1) :: NNI
+        while l < q1 repeat -- find next c such that -c is primitive
+          l := l + 1
+          c := index(l :: PI)$GF
+          primitive?(-c)$GF =>
+            return [xn, [0,c]$Rec] pretend SUP
+        "failed"
+      weight : NNI := (#(fcopy) - 1) :: NNI -- #s(f)+1 as explained above
+      s  : L NNI := [] -- we will compute s(f) only if necessary
+      n1 : NNI := (n - 1) :: NNI
+      -- a necessary condition for a monic polynomial f of degree n
+      -- over GF to be primitive is that (-1)**n * f(0) be a
+      -- primitive element of GF (cf. [LN] p.90, Th. 3.18)
+      c  : GF  := c0
+      while l < sizeGF repeat
+        -- (run through the possible values of the constant term)
+        noGenerator : Boolean := true
+        while noGenerator and l < sizeGF repeat
+          -- find least c >= c0 such that (-1)^n c0 is primitive
+          primitive?((-1)**n * c)$GF => noGenerator := false
+          l := l + 1
+          c := index(l :: PI)$GF
+        noGenerator => return "failed"
+        constterm : Rec := [0, c]$Rec
+        if c = c0 and weight > 1 then
+          headpol : Repr := rest reverse fcopy -- [[i0,f{i0}],...,[n,1]]
+                                               -- fi is non-zero for i>0
+          -- the zeroes in the headlookuplist stand for the fi
+          -- whose lookup's were not yet computed :
+          headlookuplist : L NNI := new(weight, 0)
+        else
+          -- X**n + c can not be primitive for n > 1 (cf. [LN] p.90,
+          -- Th. 3.18); next possible polynomial is X**n + X + c
+          headpol : Repr := [[1,0]$Rec, xn] -- 0*X + X**n
+          headlookuplist : L NNI := [sizeGF]
+          s := [0,1]
+          weight := 2
+        tailpol : Repr := []
+        taillookuplist : L NNI := []
+        notReady : Boolean := true
+        while notReady repeat
+          -- (run through the possible weights)
+          while not empty? headlookuplist repeat
+            -- find next polynomial in the above order with fixed
+            -- constant term and weight; assume at this point we have
+            -- headpol = [[i1,f{i1}], [i2,f{i2}], ... , [n,1]] and
+            -- tailpol = [[k,fk],...,[k0,fk0]] (k0<...<k<i1<i2<...<n)
+            term := first headpol
+            j := first headlookuplist
+            if j = 0 then j := lookup(term.coeff)$GF
+            j := j + 1 -- lookup(f{i1})$GF + 1
+            j rem sizeGF = 0 =>
+              -- in this case one has to increase f{i2}
+              tailpol := cons(term, tailpol) -- [[i1,f{i1}],...,[k0,f{k0}]]
+              headpol := rest headpol        -- [[i2,f{i2}],...,[n,1]]
+              taillookuplist := cons(j, taillookuplist)
+              headlookuplist := rest headlookuplist
+            -- otherwise set f{i1} := index(j)$GF
+            setelt(first headpol, coeff, index(j :: PI)$GF)
+            setfirst_!(headlookuplist, j)
+            if empty? taillookuplist then
+              pol := revListToSUP cons(constterm, headpol)
+              --
+              -- may be improved by excluding reciprocal polynomials
+              --
+              primitive? pol => return pol
+            else
+              -- go back to fk
+              headpol := cons(first tailpol, headpol) -- [[k,fk],...,[n,1]]
+              tailpol := rest tailpol
+              headlookuplist := cons(first taillookuplist,
+                                              headlookuplist)
+              taillookuplist := rest taillookuplist
+          if weight = n then notReady := false
+          else
+            -- must search for polynomial with greater weight
+            if empty? s then -- compute s(f)
+              restfcopy := rest fcopy
+              for entry in restfcopy repeat s := cons(entry.expnt, s)
+            s1 := nextSubset(rest s, n1) :: L NNI
+            s  := cons(0, s1)
+            weight := #s
+            taillookuplist := []
+            headlookuplist := cons(sizeGF, new((weight-2) :: NNI, 1))
+            tailpol := []
+            -- headpol = [[s.2,0], [s.3,1], ... , [s.weight,1], [n,1]] :
+            headpol := [[first s1, 0]$Rec]
+            while not empty? (s1 := rest s1) repeat
+              headpol := cons([first s1, 1]$Rec, headpol)
+            headpol := reverse cons([n, 1]$Rec, headpol)
+        -- next polynomial must have greater constant term
+        l := l + 1
+        c := index(l :: PI)$GF
+      "failed"
+
+    nextNormalPoly f ==
+      n : NNI := degree f
+      n = 0 => error "polynomial must have positive degree"
+      -- make f monic
+      if (lcf := leadingCoefficient f) ^= 1 then f := (inv lcf) * f
+      -- if f = fn*X**n + ... + f{i0}*X**{i0} with the fi non-zero
+      -- then fRepr := [[n,fn], ... , [i0,f{i0}]]
+      fRepr : Repr := f pretend Repr
+      fcopy : Repr := []
+      -- we can not simply write fcopy := copy fRepr because
+      -- the input(!) f would be modified by assigning
+      -- a new value to one of its records
+      for term in fRepr repeat
+        fcopy := cons(copy term, fcopy)
+      if term.expnt ^= 0 then
+        term  := [0,0]$Rec
+        fcopy := cons(term, fcopy)
+      fcopy     := reverse fcopy -- [[n,1], [r,fr], ... , [0,f0]]
+      xn : Rec  := first fcopy
+      middlepol : Repr := rest fcopy -- [[r,fr], ... , [0,f0]]
+      a0 : GF  := (first middlepol).coeff -- fr
+      l  : NNI := lookup(a0)$GF rem sizeGF
+      n = 1 =>
+        -- the polynomial X + a is normal if and only if a is not zero
+        l = sizeGF - 1 => "failed"
+        [xn, [0, index((l+1) :: PI)$GF]$Rec] pretend SUP
+      n1 : NNI := (n  - 1) :: NNI
+      n2 : NNI := (n1 - 1) :: NNI
+      -- if the polynomial X**n + a * X**(n-1) + ... is normal then
+      -- a = -(x + x**q +...+ x**(q**n)) can not be zero (where q = #GF)
+      a  : GF  := a0
+      -- if a = 0 then set a := 1
+      if l = 0 then
+        l := 1
+        a := 1$GF
+      while l < sizeGF repeat
+        -- (run through the possible values of a)
+        if a = a0 then
+          -- middlepol = [[0,f0], ... , [m,fm]] with m < n-1
+          middlepol := reverse rest middlepol
+          weight : NNI := #middlepol -- #s(f) as explained above
+          -- the zeroes in the middlelookuplist stand for the fi
+          -- whose lookup's were not yet computed :
+          middlelookuplist : L NNI := new(weight, 0)
+          s : L NNI := [] -- we will compute s(f) only if necessary
+        else
+          middlepol := [[0,0]$Rec]
+          middlelookuplist : L NNI := [sizeGF]
+          s : L NNI := [0]
+          weight : NNI := 1
+        headpol : Repr := [xn, [n1, a]$Rec] -- X**n + a * X**(n-1)
+        tailpol : Repr := []
+        taillookuplist : L NNI := []
+        notReady : Boolean := true
+        while notReady repeat
+          -- (run through the possible weights)
+          while not empty? middlelookuplist repeat
+            -- find next polynomial in the above order with fixed
+            -- a and weight; assume at this point we have
+            -- middlepol = [[i1,f{i1}], [i2,f{i2}], ... , [m,fm]] and
+            -- tailpol = [[k,fk],...,[0,f0]] ( with k<i1<i2<...<m)
+            term := first middlepol
+            j := first middlelookuplist
+            if j = 0 then j := lookup(term.coeff)$GF
+            j := j + 1 -- lookup(f{i1})$GF + 1
+            j rem sizeGF = 0 =>
+              -- in this case one has to increase f{i2}
+              -- tailpol = [[i1,f{i1}],...,[0,f0]]
+              tailpol   := cons(term, tailpol)
+              middlepol := rest middlepol -- [[i2,f{i2}],...,[m,fm]]
+              taillookuplist   := cons(j, taillookuplist)
+              middlelookuplist := rest middlelookuplist
+            -- otherwise set f{i1} := index(j)$GF
+            setelt(first middlepol, coeff, index(j :: PI)$GF)
+            setfirst_!(middlelookuplist, j)
+            if empty? taillookuplist then
+              pol := listToSUP append(headpol, reverse middlepol)
+              --
+              -- may be improved by excluding reciprocal polynomials
+              --
+              normal? pol => return pol
+            else
+              -- go back to fk
+              -- middlepol = [[k,fk],...,[m,fm]]
+              middlepol := cons(first tailpol, middlepol)
+              tailpol := rest tailpol
+              middlelookuplist := cons(first taillookuplist,
+                                               middlelookuplist)
+              taillookuplist := rest taillookuplist
+          if weight = n1 then notReady := false
+          else
+            -- must search for polynomial with greater weight
+            if empty? s then -- compute s(f)
+              restfcopy := rest rest fcopy
+              for entry in restfcopy repeat s := cons(entry.expnt, s)
+            s1 := nextSubset(rest s, n2) :: L NNI
+            s  := cons(0, s1)
+            weight := #s
+            taillookuplist := []
+            middlelookuplist := cons(sizeGF, new((weight-1) :: NNI, 1))
+            tailpol   := []
+            -- middlepol = [[0,0], [s.2,1], ... , [s.weight,1]] :
+            middlepol := []
+            s1 := reverse s1
+            while not empty? s1 repeat
+              middlepol := cons([first s1, 1]$Rec, middlepol)
+              s1 := rest s1
+            middlepol := cons([0,0]$Rec, middlepol)
+        -- next polynomial must have greater a
+        l := l + 1
+        a := index(l :: PI)$GF
+      "failed"
+
+    nextNormalPrimitivePoly f ==
+      n : NNI := degree f
+      n = 0 => error "polynomial must have positive degree"
+      -- make f monic
+      if (lcf := leadingCoefficient f) ^= 1 then f := (inv lcf) * f
+      -- if f = fn*X**n + ... + f{i0}*X**{i0} with the fi non-zero
+      -- then fRepr := [[n,fn], ... , [i0,f{i0}]]
+      fRepr : Repr := f pretend Repr
+      fcopy : Repr := []
+      -- we can not simply write fcopy := copy fRepr because
+      -- the input(!) f would be modified by assigning
+      -- a new value to one of its records
+      for term in fRepr repeat
+        fcopy := cons(copy term, fcopy)
+      if term.expnt ^= 0 then
+        term  := [0,0]$Rec
+        fcopy := cons(term, fcopy)
+      fcopy   := reverse fcopy -- [[n,1], [r,fr], ... , [0,f0]]
+      xn : Rec := first fcopy
+      c0 : GF  := term.coeff
+      lc : NNI := lookup(c0)$GF rem sizeGF
+      n = 1 =>
+        -- the polynomial X + c is primitive if and only if -c
+        -- is a primitive element of GF
+        q1 : NNI  := (sizeGF - 1) :: NNI
+        while lc < q1 repeat -- find next c such that -c is primitive
+          lc := lc + 1
+          c  := index(lc :: PI)$GF
+          primitive?(-c)$GF =>
+            return [xn, [0,c]$Rec] pretend SUP
+        "failed"
+      n1 : NNI := (n  - 1) :: NNI
+      n2 : NNI := (n1 - 1) :: NNI
+      middlepol : Repr := rest fcopy -- [[r,fr],...,[i0,f{i0}],[0,f0]]
+      a0 : GF  := (first middlepol).coeff
+      la : NNI := lookup(a0)$GF rem sizeGF
+      -- if the polynomial X**n + a * X**(n-1) +...+ c is primitive and
+      -- normal over GF then (-1)**n * c is a primitive element of GF
+      -- (cf. [LN] p.90, Th. 3.18), and a = -(x + x**q +...+ x**(q**n))
+      -- is not zero (where q = #GF)
+      c : GF  := c0
+      a : GF  := a0
+      -- if a = 0 then set a := 1
+      if la = 0 then
+        la := 1
+        a  := 1$GF
+      while lc < sizeGF repeat
+        -- (run through the possible values of the constant term)
+        noGenerator : Boolean := true
+        while noGenerator and lc < sizeGF repeat
+          -- find least c >= c0 such that (-1)**n * c0 is primitive
+          primitive?((-1)**n * c)$GF => noGenerator := false
+          lc := lc + 1
+          c  := index(lc :: PI)$GF
+        noGenerator => return "failed"
+        constterm : Rec := [0, c]$Rec
+        while la < sizeGF repeat
+        -- (run through the possible values of a)
+          headpol : Repr := [xn, [n1, a]$Rec] -- X**n + a X**(n-1)
+          if c = c0 and a = a0 then
+            -- middlepol = [[i0,f{i0}], ... , [m,fm]] with m < n-1
+            middlepol := rest reverse rest middlepol
+            weight : NNI := #middlepol + 1 -- #s(f)+1 as explained above
+            -- the zeroes in the middlelookuplist stand for the fi
+            -- whose lookup's were not yet computed :
+            middlelookuplist : L NNI := new((weight-1) :: NNI, 0)
+            s : L NNI := [] -- we will compute s(f) only if necessary
+          else
+            pol := listToSUP append(headpol, [constterm])
+            normal? pol and primitive? pol => return pol
+            middlepol := [[1,0]$Rec]
+            middlelookuplist : L NNI := [sizeGF]
+            s : L NNI := [0,1]
+            weight : NNI := 2
+          tailpol : Repr := []
+          taillookuplist : L NNI := []
+          notReady : Boolean := true
+          while notReady repeat
+          -- (run through the possible weights)
+            while not empty? middlelookuplist repeat
+              -- find next polynomial in the above order with fixed
+              -- c, a and weight; assume at this point we have
+              -- middlepol = [[i1,f{i1}], [i2,f{i2}], ... , [m,fm]]
+              -- tailpol = [[k,fk],...,[k0,fk0]] (k0<...<k<i1<...<m)
+              term := first middlepol
+              j := first middlelookuplist
+              if j = 0 then j := lookup(term.coeff)$GF
+              j := j + 1 -- lookup(f{i1})$GF + 1
+              j rem sizeGF = 0 =>
+                -- in this case one has to increase f{i2}
+                -- tailpol = [[i1,f{i1}],...,[k0,f{k0}]]
+                tailpol   := cons(term, tailpol)
+                middlepol := rest middlepol -- [[i2,f{i2}],...,[m,fm]]
+                taillookuplist   := cons(j, taillookuplist)
+                middlelookuplist := rest middlelookuplist
+              -- otherwise set f{i1} := index(j)$GF
+              setelt(first middlepol, coeff, index(j :: PI)$GF)
+              setfirst_!(middlelookuplist, j)
+              if empty? taillookuplist then
+                pol := listToSUP append(headpol, reverse
+                                cons(constterm, middlepol))
+                --
+                -- may be improved by excluding reciprocal polynomials
+                --
+                normal? pol and primitive? pol => return pol
+              else
+                -- go back to fk
+                -- middlepol = [[k,fk],...,[m,fm]]
+                middlepol := cons(first tailpol, middlepol)
+                tailpol := rest tailpol
+                middlelookuplist := cons(first taillookuplist,
+                                                 middlelookuplist)
+                taillookuplist := rest taillookuplist
+            if weight = n1 then notReady := false
+            else
+              -- must search for polynomial with greater weight
+              if empty? s then -- compute s(f)
+                restfcopy := rest rest fcopy
+                for entry in restfcopy repeat s := cons(entry.expnt, s)
+              s1 := nextSubset(rest s, n2) :: L NNI
+              s  := cons(0, s1)
+              weight := #s
+              taillookuplist := []
+              middlelookuplist := cons(sizeGF, new((weight-2)::NNI, 1))
+              tailpol   := []
+              -- middlepol = [[s.2,0], [s.3,1], ... , [s.weight,1] :
+              middlepol := [[first s1, 0]$Rec]
+              while not empty? (s1 := rest s1) repeat
+                middlepol := cons([first s1, 1]$Rec, middlepol)
+              middlepol := reverse middlepol
+          -- next polynomial must have greater a
+          la := la + 1
+          a  := index(la :: PI)$GF
+        -- next polynomial must have greater constant term
+        lc := lc + 1
+        c  := index(lc :: PI)$GF
+        la := 1
+        a  := 1$GF
+      "failed"
+
+    nextPrimitiveNormalPoly f == nextNormalPrimitivePoly f
+
+    createIrreduciblePoly n ==
+      x := monomial(1,1)$SUP
+      n = 1 => x
+      xn := monomial(1,n)$SUP
+      n >= sizeGF => nextIrreduciblePoly(xn + x) :: SUP
+      -- (since in this case there is most no irreducible binomial X+a)
+      odd? n => nextIrreduciblePoly(xn + 1) :: SUP
+      nextIrreduciblePoly(xn) :: SUP
+
+    createPrimitivePoly n ==
+    -- (see also the comments in the code of nextPrimitivePoly)
+      xn := monomial(1,n)$SUP
+      n = 1 => xn + monomial(-primitiveElement()$GF, 0)$SUP
+      c0 : GF := (-1)**n * primitiveElement()$GF
+      constterm : Rec := [0, c0]$Rec
+      -- try first (probably faster) the polynomials
+      -- f = X**n + f{n-1}*X**(n-1) +...+ f1*X + c0 for which
+      -- fi is 0 or 1 for i=1,...,n-1,
+      -- and this in the order used to define nextPrimitivePoly
+      s  : L NNI := [0,1]
+      weight : NNI := 2
+      s1 : L NNI := [1]
+      n1 : NNI := (n - 1) :: NNI
+      notReady : Boolean := true
+      while notReady repeat
+        polRepr : Repr := [constterm]
+        while not empty? s1 repeat
+          polRepr := cons([first s1, 1]$Rec, polRepr)
+          s1 := rest s1
+        polRepr := cons([n, 1]$Rec, polRepr)
+        --
+        -- may be improved by excluding reciprocal polynomials
+        --
+        primitive? (pol := listToSUP polRepr) => return pol
+        if weight = n then notReady := false
+        else
+          s1 := nextSubset(rest s, n1) :: L NNI
+          s  := cons(0, s1)
+          weight := #s
+      -- if there is no primitive f of the above form
+      -- search now from the beginning, allowing arbitrary
+      -- coefficients f_i, i = 1,...,n-1
+      nextPrimitivePoly(xn + monomial(c0, 0)$SUP) :: SUP
+
+    createNormalPoly n  ==
+      n = 1 => monomial(1,1)$SUP + monomial(-1,0)$SUP
+      -- get a normal polynomial f = X**n + a * X**(n-1) + ...
+      -- with a = -1
+      -- [recall that if f is normal over the field GF of order q
+      -- then a = -(x + x**q +...+ x**(q**n)) can not be zero;
+      -- hence the existence of such an f follows from the
+      -- normal basis theorem ([LN] p.60, Th. 2.35) and the
+      -- surjectivity of the trace ([LN] p.55, Th. 2.23 (iii))]
+      nextNormalPoly(monomial(1,n)$SUP
+                       + monomial(-1, (n-1) :: NNI)$SUP) :: SUP
+
+    createNormalPrimitivePoly n ==
+      xn := monomial(1,n)$SUP
+      n = 1 => xn + monomial(-primitiveElement()$GF, 0)$SUP
+      n1  : NNI := (n - 1) :: NNI
+      c0  : GF  := (-1)**n * primitiveElement()$GF
+      constterm  := monomial(c0, 0)$SUP
+      -- try first the polynomials f = X**n + a *  X**(n-1) + ...
+      -- with a = -1
+      pol := xn + monomial(-1, n1)$SUP + constterm
+      normal? pol and primitive? pol => pol
+      res := nextNormalPrimitivePoly(pol)
+      res case SUP => res
+      -- if there is no normal primitive f with a = -1
+      -- get now one with arbitrary (non-zero) a
+      -- (the existence is proved in [LS])
+      pol := xn + monomial(1, n1)$SUP + constterm
+      normal? pol and primitive? pol => pol
+      nextNormalPrimitivePoly(pol) :: SUP
+
+    createPrimitiveNormalPoly n == createNormalPrimitivePoly n
+
+    random n ==
+      polRepr : Repr := []
+      n1 : NNI := (n - 1) :: NNI
+      for i in 0..n1 repeat
+        if (c := random()$GF) ^= 0 then
+          polRepr := cons([i, c]$Rec, polRepr)
+      cons([n, 1$GF]$Rec, polRepr) pretend SUP
+
+    random(m,n) ==
+      if m > n then (m,n) := (n,m)
+      d : NNI := (n - m) :: NNI
+      if d > 1 then n := ((random()$I rem (d::PI)) + m) :: PI
+      random(n)
+
 *)
 
 \end{chunk}
@@ -37830,11 +51989,9 @@ FiniteFieldPolynomialPackage2(F,GF):Exports == Implementation where
 
   Implementation ==> add
 
--- we use berlekamps trace algorithm
--- it is not checked whether the polynomial is irreducible over GF]]
+    -- we use berlekamps trace algorithm
+    -- it is not checked whether the polynomial is irreducible over GF]]
     rootOfIrreduciblePoly(pf) ==
---    not irreducible(pf)$FFPOLY =>
---      error("polynomial has to be irreducible")
       sizeGF:=size()$GF
       -- if the polynomial is of degree one, we're ready
       deg:=degree(pf)$(SUP GF)::PI
@@ -37894,6 +52051,64 @@ FiniteFieldPolynomialPackage2(F,GF):Exports == Implementation where
 \begin{chunk}{COQ FFPOLY2}
 (* package FFPOLY2 *)
 (*
+
+    -- we use berlekamps trace algorithm
+    -- it is not checked whether the polynomial is irreducible over GF]]
+    rootOfIrreduciblePoly(pf) ==
+      sizeGF:=size()$GF
+      -- if the polynomial is of degree one, we're ready
+      deg:=degree(pf)$(SUP GF)::PI
+      deg = 0 => error("no roots")
+      deg = 1 => -coefficient(pf,0)$(SUP GF)::F
+      p : SUP F := map(coerce,pf)$SUPF2
+      -- compute qexp, qexp(i) = x **(size()GF ** i) mod p
+      -- with this list it's easier to compute the gcd(p(x),trace(x))
+      qexp:=reducedQPowers(pf)$FFPOLY
+      stillToFactor:=p
+      -- take linear independent elements, the basis of F over GF
+      basis:Vector F:=basis(deg)$F
+      basispointer:I:=1
+      -- as p is irreducible over GF, 0 can't be a root of p
+      -- therefore we can use the predicate zero?(root) for indicating
+      -- whether a root is found
+      root:=0$F
+      while zero?(root)$F repeat
+        beta:F:=basis.basispointer
+        -- gcd(trace(x)+gf,p(x)) has degree 0,that's why we skip beta=1
+        if beta = 1$F then
+          basispointer:=basispointer + 1
+          beta:= basis.basispointer
+        basispointer:=basispointer+1
+        -- compute the polynomial trace(beta * x) mod p(x) using explist
+        trModp:SUP F:= map(coerce,qexp.0)$SUPF2 * beta
+        for i in 1..deg-1 repeat
+          beta:=Frobenius(beta)
+          trModp:=trModp +$(SUP F) beta *$(SUP F) map(coerce,qexp.i)$SUPF2
+        -- if it is of degree 0, it doesn't help us finding a root
+        if degree(trModp)$(SUP F) > 0 then
+          -- for all elements gf of GF do
+          for j in 1..sizeGF repeat
+            -- compute gcd(trace(beta * x) + gf,stillToFactor)
+            h:=gcd(stillToFactor,trModp +$(SUP F) _
+             (index(j pretend PI)$GF::F::(SUP F)))$(SUP F)
+            -- make the gcd polynomial monic
+            if leadingCoefficient(h)$(SUP F) ^= 1$F then
+              h:= (inv leadingCoefficient(h)) * h
+            degh:=degree(h)$(SUP F)
+            degSTF:=degree(stillToFactor)$(SUP F)
+            -- if the gcd has degree one we are ready
+            degh = 1 => root:=-coefficient(h,0)$(SUP F)
+            -- if the quotient of stillToFactor and the gcd has
+            -- degree one, we're also ready
+            degSTF - degh = 1 =>
+              root:= -coefficient(stillToFactor quo h,0)$(SUP F)
+            -- otherwise the gcd helps us finding a root, only if its
+            -- degree is between 2 and degree(stillToFactor)-2
+            if degh > 1 and degh < degSTF then
+              2*degh > degSTF => stillToFactor := stillToFactor quo h
+              stillToFactor := h
+      root
+
 *)
 
 \end{chunk}
@@ -37966,12 +52181,14 @@ FiniteFieldSolveLinearPolynomialEquation(F:FiniteFieldCategory,
               ++ \spad{g/prod fi = sum ai/fi}
               ++ or returns "failed" if no such list of ai's exists.
   == add
+
      oldlp:List FPP := []
      slpePrime: FP := monomial(1,1)
      oldtable:Vector List FPP := []
      lp: List FPP
      p: FPP
      import DistinctDegreeFactorize(F,FP)
+
      solveLinearPolynomialEquation(lp,p) ==
        if (oldlp ^= lp) then
           -- we have to generate a new table
@@ -37994,6 +52211,31 @@ FiniteFieldSolveLinearPolynomialEquation(F:FiniteFieldCategory,
 \begin{chunk}{COQ FFSLPE}
 (* package FFSLPE *)
 (*
+
+     oldlp:List FPP := []
+     slpePrime: FP := monomial(1,1)
+     oldtable:Vector List FPP := []
+     lp: List FPP
+     p: FPP
+     import DistinctDegreeFactorize(F,FP)
+
+     solveLinearPolynomialEquation(lp,p) ==
+       if (oldlp ^= lp) then
+          -- we have to generate a new table
+          deg:= +/[degree u for u in lp]
+          ans:Union(Vector List FPP,"failed"):="failed"
+          slpePrime:=monomial(1,1)+monomial(1,0)   -- x+1: our starting guess
+          while (ans case "failed") repeat
+            ans:=tablePow(deg,slpePrime,lp)$GenExEuclid(FP,FPP)
+            if (ans case "failed") then
+               slpePrime:= nextItem(slpePrime)::FP
+               while (degree slpePrime > 1) and
+                     not irreducible? slpePrime repeat
+                 slpePrime := nextItem(slpePrime)::FP
+          oldtable:=(ans:: Vector List FPP)
+       answer:=solveid(p,slpePrime,oldtable)
+       answer
+
 *)
 
 \end{chunk}
@@ -38154,6 +52396,94 @@ FiniteFieldSquareFreeDecomposition (K : FiniteFieldCategory,
 \begin{chunk}{COQ FFSQFR}
 (* package FFSQFR *)
 (*
+    
+    p : NonNegativeInteger := characteristic()$K
+    tableOfSquareFreePolynomials := Table (Integer, PolK)
+    oneYunStep2uple := Record (
+       simpleDecomposition : tableOfSquareFreePolynomials,
+        gcdOfArgumentAndDerivative : PolK
+         )
+    
+    rawMusser (P : PolK) : Factored(PolK) ==
+        Q : PolK := gcd(P, D(P))
+        A : PolK := P quo Q
+        decomposition : Factored(PolK) := 1
+        B : PolK
+    
+        for i in 1 .. repeat
+            if i rem p ^= 0 then
+                B := gcd(A, Q)
+                decomposition := sqfrFactor(A quo B, i) * decomposition
+                if B = 1 then leave
+                A := B
+            Q := Q quo A
+        if Q ^= 1 then
+           decomposition:=decomposition * rawMusser (charthRoot(Q)::PolK) ** p
+        return decomposition
+    
+    Musser (P : PolK) : Factored(PolK) ==
+        degree (P) = 0 => return P::Factored(PolK)
+        if (lcP : K := leadingCoefficient(P)) ^= 1 then P := inv(lcP) * P
+        return lcP::PolK * rawMusser (P)
+    
+    oneYunStep (P : PolK) : oneYunStep2uple ==
+        C : PolK := D (P) ;  A : PolK := gcd(P, C)
+        gcd_P_P' : PolK := A ;  B : PolK := P quo A
+        result : tableOfSquareFreePolynomials := empty ()
+        i : Integer := 1
+    
+        repeat
+            C := (C quo A) - D(B)
+            if C = 0 then leave
+            A := gcd(B, C)
+            if A ^= 1 then
+                result (i) := A
+                B := B quo A
+            i := i + 1
+        result (i) := B
+        return [result, gcd_P_P']
+    
+    rawYun (P : PolK) : tableOfSquareFreePolynomials ==
+        u : oneYunStep2uple := oneYunStep (P)
+        gcd_P_P' : PolK := u.gcdOfArgumentAndDerivative
+        U : tableOfSquareFreePolynomials := u.simpleDecomposition
+    
+        R : PolK := gcd_P_P'
+        for j in indices (U) repeat
+            for k in 1 .. j-1 repeat
+                R := R quo U(j)
+        if R = 1 then return U
+        V : tableOfSquareFreePolynomials := rawYun (charthRoot (R)::PolK)
+    
+        result : tableOfSquareFreePolynomials := empty ()
+        gcd_Uj_Vk : PolK ;
+        for k in indices (V) repeat    -- boucle 1
+        
+            for j in  indices (U) | not (U(j) = 1)  repeat    -- boucle 2
+                gcd_Uj_Vk := gcd (U(j), V(k))
+                if not (gcd_Uj_Vk = 1) then
+                    result (j+p*k) := gcd_Uj_Vk
+                    V (k) := V(k) quo gcd_Uj_Vk
+                    U (j) := U(j) quo gcd_Uj_Vk
+                if V(k) = 1 then leave
+        
+            if not (V(k) = 1) then
+                result (p*k):= V (k)
+        
+        for j in  indices (U) | not (U(j) = 1)  repeat    -- boucle 3
+            result (j) := U (j)
+        
+        return result
+    
+    Yun(P : PolK) : Factored(PolK) ==
+        degree (P) = 0  => P::Factored(PolK)
+        if (lcP := leadingCoefficient (P)) ^= 1 then P := inv (lcP)*P
+        U : tableOfSquareFreePolynomials := rawYun (P)
+        PFactored : Factored(PolK) := 1
+        for i in indices (U) repeat
+            PFactored := PFactored * sqfrFactor (U (i), i)
+        return (lcP::PolK) * PFactored
+    
 *)
 
 \end{chunk}
@@ -38253,12 +52583,15 @@ FiniteLinearAggregateFunctions2(S, A, R, B):
      ++ \spad{scan(f,a,r)} returns
      ++ \spad{[reduce(f,[a1],r),reduce(f,[a1,a2],r),...]}.
   Implementation ==> add
+
     if A has ListAggregate(S) then         -- A is a list-oid
+
       reduce(fn, l, ident) ==
         empty? l => ident
         reduce(fn, rest l, fn(first l, ident))
 
       if B has ListAggregate(R) or not(B has shallowlyMutable) then
+
         -- A is a list-oid, and B is either list-oids or not mutable
         map(f, l) == construct [f s for s in entries l]
 
@@ -38268,6 +52601,7 @@ FiniteLinearAggregateFunctions2(S, A, R, B):
           concat(val, scan(fn, rest l, val))
 
       else                      -- A is a list-oid, B a mutable array-oid
+
         map(f, l) ==
           i := minIndex(w := new(#l,NIL$Lisp)$B)
           for a in entries l repeat (qsetelt_!(w, i, f a); i := inc i)
@@ -38282,6 +52616,7 @@ FiniteLinearAggregateFunctions2(S, A, R, B):
           w
 
     else                              -- A is an array-oid
+
       reduce(fn, v, ident) ==
         val := ident
         for i in minIndex v .. maxIndex v repeat
@@ -38289,6 +52624,7 @@ FiniteLinearAggregateFunctions2(S, A, R, B):
         val
 
       if B has ListAggregate(R) then   -- A is an array-oid, B a list-oid
+
         map(f, v) ==
           construct [f qelt(v, i) for i in minIndex v .. maxIndex v]
 
@@ -38300,7 +52636,9 @@ FiniteLinearAggregateFunctions2(S, A, R, B):
           reverse_! w
 
       else                             -- A and B are array-oid's
+
         if B has shallowlyMutable then -- B is also mutable
+
           map(f, v) ==
             w := new(#v,NIL$Lisp)$B
             for i in minIndex w .. maxIndex w repeat
@@ -38315,6 +52653,7 @@ FiniteLinearAggregateFunctions2(S, A, R, B):
             w
 
         else                                   -- B non mutable array-oid
+
           map(f, v) ==
             construct [f qelt(v, i) for i in minIndex v .. maxIndex v]
 
@@ -38330,6 +52669,87 @@ FiniteLinearAggregateFunctions2(S, A, R, B):
 \begin{chunk}{COQ FLAGG2}
 (* package FLAGG2 *)
 (*
+
+    if A has ListAggregate(S) then         -- A is a list-oid
+
+      reduce(fn, l, ident) ==
+        empty? l => ident
+        reduce(fn, rest l, fn(first l, ident))
+
+      if B has ListAggregate(R) or not(B has shallowlyMutable) then
+
+        -- A is a list-oid, and B is either list-oids or not mutable
+        map(f, l) == construct [f s for s in entries l]
+
+        scan(fn, l, ident) ==
+          empty? l => empty()
+          val := fn(first l, ident)
+          concat(val, scan(fn, rest l, val))
+
+      else                      -- A is a list-oid, B a mutable array-oid
+
+        map(f, l) ==
+          i := minIndex(w := new(#l,NIL$Lisp)$B)
+          for a in entries l repeat (qsetelt_!(w, i, f a); i := inc i)
+          w
+
+        scan(fn, l, ident) ==
+          i := minIndex(w := new(#l,NIL$Lisp)$B)
+          vl := ident
+          for a in entries l repeat
+            vl := qsetelt_!(w, i, fn(a, vl))
+            i := inc i
+          w
+
+    else                              -- A is an array-oid
+
+      reduce(fn, v, ident) ==
+        val := ident
+        for i in minIndex v .. maxIndex v repeat
+          val := fn(qelt(v, i), val)
+        val
+
+      if B has ListAggregate(R) then   -- A is an array-oid, B a list-oid
+
+        map(f, v) ==
+          construct [f qelt(v, i) for i in minIndex v .. maxIndex v]
+
+        scan(fn, v, ident) ==
+          w := empty()$B
+          for i in minIndex v .. maxIndex v repeat
+            ident := fn(qelt(v, i), ident)
+            w := concat(ident, w)
+          reverse_! w
+
+      else                             -- A and B are array-oid's
+
+        if B has shallowlyMutable then -- B is also mutable
+
+          map(f, v) ==
+            w := new(#v,NIL$Lisp)$B
+            for i in minIndex w .. maxIndex w repeat
+              qsetelt_!(w, i, f qelt(v, i))
+            w
+
+          scan(fn, v, ident) ==
+            w   := new(#v,NIL$Lisp)$B
+            vl := ident
+            for i in minIndex v .. maxIndex v repeat
+              vl := qsetelt_!(w, i, fn(qelt(v, i), vl))
+            w
+
+        else                                   -- B non mutable array-oid
+
+          map(f, v) ==
+            construct [f qelt(v, i) for i in minIndex v .. maxIndex v]
+
+          scan(fn, v, ident) ==
+            w := empty()$B
+            for i in minIndex v .. maxIndex v repeat
+              ident := fn(qelt(v, i), ident)
+              w := concat(w, ident)
+            w
+
 *)
 
 \end{chunk}
@@ -38425,6 +52845,7 @@ FiniteLinearAggregateSort(S, V): Exports == Implementation where
       ++ f using the shellSort algorithm.
  
   Implementation ==> add
+
     siftUp   : ((S, S) -> B, V, I, I) -> Void
     partition: ((S, S) -> B, V, I, I, I) -> I
     QuickSort: ((S, S) -> B, V, I, I) -> V
@@ -38466,7 +52887,6 @@ FiniteLinearAggregateSort(S, V): Exports == Implementation where
  
     QuickSort(l, r, i, j) ==
       n := j - i
---      if one? n and l(qelt(r, j), qelt(r, i)) then swap_!(r, i, j)
       if (n = 1) and l(qelt(r, j), qelt(r, i)) then swap_!(r, i, j)
       n < 2 => return r
       -- for the moment split at the middle item
@@ -38495,11 +52915,76 @@ FiniteLinearAggregateSort(S, V): Exports == Implementation where
 \begin{chunk}{COQ FLASORT}
 (* package FLASORT *)
 (*
-*)
-
-\end{chunk}
 
-\begin{chunk}{FLASORT.dotabb}
+    siftUp   : ((S, S) -> B, V, I, I) -> Void
+    partition: ((S, S) -> B, V, I, I, I) -> I
+    QuickSort: ((S, S) -> B, V, I, I) -> V
+ 
+    quickSort(l, r) == QuickSort(l, r, minIndex r, maxIndex r)
+ 
+    siftUp(l, r, i, n) ==
+      t := qelt(r, i)
+      while (j := 2*i+1) < n repeat
+        if (k := j+1) < n and l(qelt(r, j), qelt(r, k)) then j := k
+        if l(t,qelt(r,j)) then
+           qsetelt_!(r, i, qelt(r, j))
+           qsetelt_!(r, j, t)
+           i := j
+        else leave
+ 
+    heapSort(l, r) ==
+      not zero? minIndex r => error "not implemented"
+      n := (#r)::I
+      for k in shift(n,-1) - 1 .. 0 by -1 repeat siftUp(l, r, k, n)
+      for k in n-1 .. 1 by -1 repeat
+         swap_!(r, 0, k)
+         siftUp(l, r, 0, k)
+      r
+ 
+    partition(l, r, i, j, k) ==
+      -- partition r[i..j] such that r.s <= r.k <= r.t
+      x := qelt(r, k)
+      t := qelt(r, i)
+      qsetelt_!(r, k, qelt(r, j))
+      while i < j repeat
+         if l(x,t) then
+           qsetelt_!(r, j, t)
+           j := j-1
+           t := qsetelt_!(r, i, qelt(r, j))
+         else (i := i+1; t := qelt(r, i))
+      qsetelt_!(r, j, x)
+      j
+ 
+    QuickSort(l, r, i, j) ==
+      n := j - i
+      if (n = 1) and l(qelt(r, j), qelt(r, i)) then swap_!(r, i, j)
+      n < 2 => return r
+      -- for the moment split at the middle item
+      k := partition(l, r, i, j, i + shift(n,-1))
+      QuickSort(l, r, i, k - 1)
+      QuickSort(l, r, k + 1, j)
+ 
+    shellSort(l, r) ==
+      m := minIndex r
+      n := maxIndex r
+      -- use Knuths gap sequence: 1,4,13,40,121,...
+      g := 1
+      while g <= (n-m) repeat g := 3*g+1
+      g := g quo 3
+      while g > 0 repeat
+         for i in m+g..n repeat
+            j := i-g
+            while j >= m and l(qelt(r, j+g), qelt(r, j)) repeat
+               swap_!(r,j,j+g)
+               j := j-g
+         g := g quo 3
+      r
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{FLASORT.dotabb}
 "FLASORT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=FLASORT"]
 "FLAGG" [color="#4488FF",href="bookvol10.2.pdf#nameddest=FLAGG"]
 "FLASORT" -> "FLAGG"
@@ -38596,10 +53081,13 @@ FiniteSetAggregateFunctions2(S, A, R, B): Exports == Implementation where
       ++ \spad{scan(f,a,r)} returns
       ++ \spad {[reduce(f,[a1],r),reduce(f,[a1,a2],r),...]}.
    Implementation ==> add
+
      map(fn, a) ==
        set(map(fn, parts a)$ListFunctions2(S, R))$B
+
      reduce(fn, a, ident) ==
        reduce(fn, parts a, ident)$ListFunctions2(S, R)
+
      scan(fn, a, ident) ==
        set(scan(fn, parts a, ident)$ListFunctions2(S, R))$B
 
@@ -38608,6 +53096,16 @@ FiniteSetAggregateFunctions2(S, A, R, B): Exports == Implementation where
 \begin{chunk}{COQ FSAGG2}
 (* package FSAGG2 *)
 (*
+
+     map(fn, a) ==
+       set(map(fn, parts a)$ListFunctions2(S, R))$B
+
+     reduce(fn, a, ident) ==
+       reduce(fn, parts a, ident)$ListFunctions2(S, R)
+
+     scan(fn, a, ident) ==
+       set(scan(fn, parts a, ident)$ListFunctions2(S, R))$B
+
 *)
 
 \end{chunk}
@@ -38789,6 +53287,46 @@ FloatingComplexPackage(Par): Cat == Cap where
 \begin{chunk}{COQ FLOATCP}
 (* package FLOATCP *)
 (*
+
+       -- find the complex zeros of an univariate polynomial --
+       complexRoots(q:FPK,eps:Par) : L C Par ==
+         p:=numer q
+         complexZeros(univariate p,eps)$ComplexRootPackage(SUP GI, Par)
+
+       -- find the complex zeros of an univariate polynomial --
+       complexRoots(lp:L FPK,lv:L SE,eps:Par) : L L C Par ==
+         lnum:=[numer p for p in lp]
+         lden:=[dp for p in lp |(dp:=denom p)^=1]
+         innerSolve(lnum,lden,lv,eps)$INFSP(K,C Par,Par)
+
+       complexSolve(lp:L FPK,eps : Par) : L L EQ  P C Par ==
+         lnum:=[numer p for p in lp]
+         lden:=[dp for p in lp |(dp:=denom p)^=1]
+         lv:="setUnion"/[variables np for np in lnum]
+         if lden^=[] then
+          lv:=setUnion(lv,"setUnion"/[variables dp for dp in lden])
+         [[equation(x::(P C Par),r::(P C Par)) for x in lv for r in nres]
+           for nres in innerSolve(lnum,lden,lv,eps)$INFSP(K,C Par,Par)]
+
+       complexSolve(le:L EQ FPK,eps : Par) : L L EQ  P C Par ==
+         lp:=[lhs ep - rhs ep for ep in le]
+         lnum:=[numer p for p in lp]
+         lden:=[dp for p in lp |(dp:=denom p)^=1]
+         lv:="setUnion"/[variables np for np in lnum]
+         if lden^=[] then
+          lv:=setUnion(lv,"setUnion"/[variables dp for dp in lden])
+         [[equation(x::(P C Par),r::(P C Par)) for x in lv for r in nres]
+           for nres in innerSolve(lnum,lden,lv,eps)$INFSP(K,C Par,Par)]
+
+       complexSolve(p : FPK,eps : Par) : L EQ  P C Par ==
+         (mvar := mainVariable numer p ) case "failed" =>
+                 error "no variable found"
+         x:P C Par:=mvar::SE::(P C Par)
+         [equation(x,val::(P C Par)) for val in complexRoots(p,eps)]
+
+       complexSolve(eq : EQ FPK,eps : Par) : L EQ  P C Par ==
+         complexSolve(lhs eq - rhs eq,eps)
+
 *)
 
 \end{chunk}
@@ -38968,6 +53506,48 @@ FloatingRealPackage(Par): Cat == Cap where
 \begin{chunk}{COQ FLOATRP}
 (* package FLOATRP *)
 (*
+
+       makeEq(nres:L Par,lv:L SE) : L EQ P Par ==
+           [equation(x::(P Par),r::(P Par)) for x in lv for r in nres]
+
+       -- find the real zeros of an univariate rational polynomial --
+       realRoots(p:RFI,eps:Par) : L Par ==
+         innerSolve1(numer p,eps)$INFSP(I,Par,Par)
+
+       -- real zeros of the system of polynomial lp --
+       realRoots(lp:L RFI,lv:L SE,eps: Par) : L L Par ==
+         lnum:=[numer p for p in lp]
+         lden:=[dp for p in lp |(dp:=denom p)^=1]
+         innerSolve(lnum,lden,lv,eps)$INFSP(I,Par,Par)
+
+       solve(lp:L RFI,eps : Par) : L L EQ  P Par ==
+         lnum:=[numer p for p in lp]
+         lden:=[dp for p in lp |(dp:=denom p)^=1]
+         lv:="setUnion"/[variables np for np in lnum]
+         if lden^=[] then
+          lv:=setUnion(lv,"setUnion"/[variables dp for dp in lden])
+         [makeEq(numres,lv) for numres
+            in innerSolve(lnum,lden,lv,eps)$INFSP(I,Par,Par)]
+
+       solve(le:L EQ RFI,eps : Par) : L L EQ  P Par ==
+         lp:=[lhs ep - rhs ep for ep in le]
+         lnum:=[numer p for p in lp]
+         lden:=[dp for p in lp |(dp:=denom p)^=1]
+         lv:="setUnion"/[variables np for np in lnum]
+         if lden^=[] then
+          lv:=setUnion(lv,"setUnion"/[variables dp for dp in lden])
+         [makeEq(numres,lv) for numres
+           in innerSolve(lnum,lden,lv,eps)$INFSP(I,Par,Par)]
+
+       solve(p : RFI,eps : Par) :  L EQ  P Par ==
+         (mvar := mainVariable numer p ) case "failed" =>
+              error "no variable found"
+         x:P Par:=mvar::SE::(P Par)
+         [equation(x,val::(P Par)) for val in realRoots(p,eps)]
+
+       solve(eq : EQ RFI,eps : Par) :  L EQ  P Par ==
+         solve(lhs eq - rhs eq,eps)
+
 *)
 
 \end{chunk}
@@ -39100,6 +53680,7 @@ FortranCodePackage1: Exports  == Implementation where
       ++ identitySquareMatrix(s,p) \undocumented{}
 
   Implementation ==> add
+
     import FC
 
     zeroVector(fname:Symbol,n:PIN):FC ==
@@ -39181,6 +53762,83 @@ FortranCodePackage1: Exports  == Implementation where
 \begin{chunk}{COQ FCPAK1}
 (* package FCPAK1 *)
 (*
+
+    import FC
+
+    zeroVector(fname:Symbol,n:PIN):FC ==
+      ue:Expression(Integer) := 0
+      i1:Symbol := "I1"::Symbol
+      lp1:PIN := 1::PIN
+      hp1:PIN := n
+      segp1:SEGPIN:= segment(lp1,hp1)$SEGPIN
+      segbp1:SBPIN := equation(i1,segp1)$SBPIN
+      ip1:PIN := i1::PIN
+      indices:List(PIN) := [ip1]
+      fa:FC := forLoop(segbp1,assign(fname,indices,ue)$FC)$FC
+      fa
+
+    zeroMatrix(fname:Symbol,m:PIN,n:PIN):FC ==
+      ue:Expression(Integer) := 0
+      i1:Symbol := "I1"::Symbol
+      lp1:PIN := 1::PIN
+      hp1:PIN := m
+      segp1:SEGPIN:= segment(lp1,hp1)$SEGPIN
+      segbp1:SBPIN := equation(i1,segp1)$SBPIN
+      i2:Symbol := "I2"::Symbol
+      hp2:PIN := n
+      segp2:SEGPIN:= segment(lp1,hp2)$SEGPIN
+      segbp2:SBPIN := equation(i2,segp2)$SBPIN
+      ip1:PIN := i1::PIN
+      ip2:PIN := i2::PIN
+      indices:List(PIN) := [ip1,ip2]
+      fa:FC :=forLoop(segbp1,forLoop(segbp2,assign(fname,indices,ue)$FC)$FC)$FC
+      fa
+
+    zeroMatrix(fname:Symbol,segbp1:SBPIN,segbp2:SBPIN):FC ==
+      ue:Expression(Integer) := 0
+      i1:Symbol := variable(segbp1)$SBPIN
+      i2:Symbol := variable(segbp2)$SBPIN
+      ip1:PIN := i1::PIN
+      ip2:PIN := i2::PIN
+      indices:List(PIN) := [ip1,ip2]
+      fa:FC :=forLoop(segbp1,forLoop(segbp2,assign(fname,indices,ue)$FC)$FC)$FC
+      fa
+
+    zeroSquareMatrix(fname:Symbol,n:PIN):FC ==
+      ue:Expression(Integer) := 0
+      i1:Symbol := "I1"::Symbol
+      lp1:PIN := 1::PIN
+      hp1:PIN := n
+      segp1:SEGPIN:= segment(lp1,hp1)$SEGPIN
+      segbp1:SBPIN := equation(i1,segp1)$SBPIN
+      i2:Symbol := "I2"::Symbol
+      segbp2:SBPIN := equation(i2,segp1)$SBPIN
+      ip1:PIN := i1::PIN
+      ip2:PIN := i2::PIN
+      indices:List(PIN) := [ip1,ip2]
+      fa:FC :=forLoop(segbp1,forLoop(segbp2,assign(fname,indices,ue)$FC)$FC)$FC
+      fa
+
+    identitySquareMatrix(fname:Symbol,n:PIN):FC ==
+      ue:Expression(Integer) := 0
+      u1:Expression(Integer) := 1
+      i1:Symbol := "I1"::Symbol
+      lp1:PIN := 1::PIN
+      hp1:PIN := n
+      segp1:SEGPIN:= segment(lp1,hp1)$SEGPIN
+      segbp1:SBPIN := equation(i1,segp1)$SBPIN
+      i2:Symbol := "I2"::Symbol
+      segbp2:SBPIN := equation(i2,segp1)$SBPIN
+      ip1:PIN := i1::PIN
+      ip2:PIN := i2::PIN
+      indice1:List(PIN) := [ip1,ip1]
+      indices:List(PIN) := [ip1,ip2]
+      fc:FC := forLoop(segbp2,assign(fname,indices,ue)$FC)$FC
+      f1:FC := assign(fname,indice1,u1)$FC
+      fl:List(FC) := [fc,f1]
+      fa:FC := forLoop(segbp1,block(fl)$FC)$FC
+      fa
+
 *)
 
 \end{chunk}
@@ -39288,24 +53946,24 @@ FortranOutputStackPackage() : specification == implementation where
     topFortranOutputStack():String == string(_$fortranOutputFile$Lisp)
 
     pushFortranOutputStack(fn:FileName):Void ==
-      if empty? fortranOutputStack then
-        push!(string(_$fortranOutputFile$Lisp),fortranOutputStack)
-      else if not(top(fortranOutputStack)=string(_$fortranOutputFile$Lisp)) then
-        pop! fortranOutputStack
-        push!(string(_$fortranOutputFile$Lisp),fortranOutputStack)
-      push!( fn::String,fortranOutputStack)
-      systemCommand concat(["set output fortran quiet ", fn::String])$String
-      void()
+     if empty? fortranOutputStack then
+       push!(string(_$fortranOutputFile$Lisp),fortranOutputStack)
+     else if not(top(fortranOutputStack)=string(_$fortranOutputFile$Lisp)) then
+       pop! fortranOutputStack
+       push!(string(_$fortranOutputFile$Lisp),fortranOutputStack)
+     push!( fn::String,fortranOutputStack)
+     systemCommand concat(["set output fortran quiet ", fn::String])$String
+     void()
 
     pushFortranOutputStack(fn:String):Void ==
-      if empty? fortranOutputStack then
-        push!(string(_$fortranOutputFile$Lisp),fortranOutputStack)
-      else if not(top(fortranOutputStack)=string(_$fortranOutputFile$Lisp)) then
-        pop! fortranOutputStack
-        push!(string(_$fortranOutputFile$Lisp),fortranOutputStack)
-      push!( fn,fortranOutputStack)
-      systemCommand concat(["set output fortran quiet ", fn])$String
-      void()
+     if empty? fortranOutputStack then
+       push!(string(_$fortranOutputFile$Lisp),fortranOutputStack)
+     else if not(top(fortranOutputStack)=string(_$fortranOutputFile$Lisp)) then
+       pop! fortranOutputStack
+       push!(string(_$fortranOutputFile$Lisp),fortranOutputStack)
+     push!( fn,fortranOutputStack)
+     systemCommand concat(["set output fortran quiet ", fn])$String
+     void()
 
     popFortranOutputStack():Void ==
       if not empty? fortranOutputStack then pop! fortranOutputStack
@@ -39325,6 +53983,52 @@ FortranOutputStackPackage() : specification == implementation where
 \begin{chunk}{COQ FOP}
 (* package FOP *)
 (*
+
+    import MoreSystemCommands
+
+    -- A stack of filenames for Fortran output.  We are sharing this with
+    -- the standard Fortran output code, so want to be a bit careful about
+    -- how we interact with what the user does independently.  We get round
+    -- potential problems by always examining the top element of the stack 
+    -- before we push.  If the user has redirected output then we alter our
+    -- top value accordingly.
+    fortranOutputStack : Stack String := empty()@(Stack String)
+
+    topFortranOutputStack():String == string(_$fortranOutputFile$Lisp)
+
+    pushFortranOutputStack(fn:FileName):Void ==
+     if empty? fortranOutputStack then
+       push!(string(_$fortranOutputFile$Lisp),fortranOutputStack)
+     else if not(top(fortranOutputStack)=string(_$fortranOutputFile$Lisp)) then
+       pop! fortranOutputStack
+       push!(string(_$fortranOutputFile$Lisp),fortranOutputStack)
+     push!( fn::String,fortranOutputStack)
+     systemCommand concat(["set output fortran quiet ", fn::String])$String
+     void()
+
+    pushFortranOutputStack(fn:String):Void ==
+     if empty? fortranOutputStack then
+       push!(string(_$fortranOutputFile$Lisp),fortranOutputStack)
+     else if not(top(fortranOutputStack)=string(_$fortranOutputFile$Lisp)) then
+       pop! fortranOutputStack
+       push!(string(_$fortranOutputFile$Lisp),fortranOutputStack)
+     push!( fn,fortranOutputStack)
+     systemCommand concat(["set output fortran quiet ", fn])$String
+     void()
+
+    popFortranOutputStack():Void ==
+      if not empty? fortranOutputStack then pop! fortranOutputStack
+      if empty? fortranOutputStack then push!("CONSOLE",fortranOutputStack)
+      systemCommand concat(["set output fortran quiet append ",_
+                           top fortranOutputStack])$String
+      void()
+
+    clearFortranOutputStack():Stack String ==
+      fortranOutputStack := empty()@(Stack String)
+
+    showFortranOutputStack():Stack String ==
+      fortranOutputStack
+
 *)
 
 \end{chunk}
@@ -39432,7 +54136,6 @@ FortranPackage(): Exports == Implementation where
     stringFn
 
   outputAsFortran(fn:FileName):Void ==
---    source : String := checkExtension fn
     source : String := fn::String
     not readable? fn => 
       popFortranOutputStack()$FOP
@@ -39470,8 +54173,12 @@ FortranPackage(): Exports == Implementation where
 
     -- Look for arguments which are subprograms
     asps :=[makeAspList(u,syms) for u in externalList(symbolTable)$SymbolTable]
+
     rt case fst =>
-      makeFort1(name,arguments,aArgs,dummies,symbolList,res,(rt.fst)::S,asps)$Lisp
+
+      makeFort1(name,arguments,aArgs,dummies,symbolList,_
+                res,(rt.fst)::S,asps)$Lisp
+
     makeFort1(name,arguments,aArgs,dummies,symbolList,res,NIL$Lisp,asps)$Lisp
 
 \end{chunk}
@@ -39479,6 +54186,65 @@ FortranPackage(): Exports == Implementation where
 \begin{chunk}{COQ FORT}
 (* package FORT *)
 (*
+
+  legalFortranSourceExtensions : List String := ["f"]
+
+  setLegalFortranSourceExtensions(l:List String):List String ==
+    legalFortranSourceExtensions := l
+    
+  checkExtension(fn : FileName) : String ==
+    -- Does it end in a legal extension ?
+    stringFn := fn::String
+    not member?(extension fn,legalFortranSourceExtensions) =>
+      error [stringFn,"is not a legal Fortran Source File."]
+    stringFn
+
+  outputAsFortran(fn:FileName):Void ==
+    source : String := fn::String
+    not readable? fn => 
+      popFortranOutputStack()$FOP
+      error([source,"is not readable"]@List(String))
+    target : String := topFortranOutputStack()$FOP
+    command : String := 
+      concat(["sys rm -f ",target," ; cp ",source," ",target])$String
+    systemCommand(command)$MoreSystemCommands
+    void()$Void
+
+  linkToFortran(name:S,args:L U, decls:L L U, res:L(S)):SEX == 
+    makeFort(name,args,decls,res,NIL$Lisp,NIL$Lisp)$Lisp
+
+  linkToFortran(name:S,args:L U, decls:L L U, res:L(S),returnType:S):SEX == 
+    makeFort(name,args,decls,res,returnType,NIL$Lisp)$Lisp
+
+  dimensions(type:FortranType):SEX ==
+    convert([convert(convert(u)@InputForm)@SEX _
+      for u in dimensionsOf(type)])@SEX
+
+  ftype(name:S,type:FortranType):SEX ==
+    [name,scalarTypeOf(type),dimensions(type),external? type]$Lisp
+
+  makeAspList(asp:S,syms:TheSymbolTable):SExpression==
+    symtab : SymbolTable := symbolTableOf(asp,syms)
+    [asp,returnTypeOf(asp,syms),argumentListOf(asp,syms), _
+     [ftype(u,fortranTypeOf(u,symtab)) for u in parametersOf symtab]]$Lisp
+
+  linkToFortran(name:S,aArgs:L S,syms:TheSymbolTable,res:L S):SEX ==
+    arguments : L S := argumentListOf(name,syms)$TheSymbolTable
+    dummies : L S := setDifference(arguments,aArgs)
+    symbolTable:SymbolTable := symbolTableOf(name,syms)
+    symbolList := newTypeLists(symbolTable)
+    rt:Union(fst: FST,void: "void") := returnTypeOf(name,syms)$TheSymbolTable
+
+    -- Look for arguments which are subprograms
+    asps :=[makeAspList(u,syms) for u in externalList(symbolTable)$SymbolTable]
+
+    rt case fst =>
+
+      makeFort1(name,arguments,aArgs,dummies,symbolList,_
+                res,(rt.fst)::S,asps)$Lisp
+
+    makeFort1(name,arguments,aArgs,dummies,symbolList,res,NIL$Lisp,asps)$Lisp
+
 *)
 
 \end{chunk}
@@ -39556,6 +54322,7 @@ FractionalIdealFunctions2(R1, F1, U1, A1, R2, F2, U2, A2):
       ++ map(f,i) \undocumented{}
 
   Implementation ==> add
+
     fmap: (F1 -> F2, A1) -> A2
 
     fmap(f, a) ==
@@ -39573,6 +54340,19 @@ FractionalIdealFunctions2(R1, F1, U1, A1, R2, F2, U2, A2):
 \begin{chunk}{COQ FRIDEAL2}
 (* package FRIDEAL2 *)
 (*
+
+    fmap: (F1 -> F2, A1) -> A2
+
+    fmap(f, a) ==
+      v := coordinates a
+      represents
+        [f qelt(v, i) for i in minIndex v .. maxIndex v]$Vector(F2)
+
+    map(f, i) ==
+      b := basis i
+      ideal [fmap(s +-> f(numer s) / f(denom s), qelt(b, j))
+             for j in minIndex b .. maxIndex b]$Vector(A2)
+
 *)
 
 \end{chunk}
@@ -39875,6 +54655,7 @@ The following function returns the lexicographically next vector with
 non-negative components smaller than p with the same sum as v.
 
 \begin{chunk}{package FFFG FractionFreeFastGaussian}
+
     nextVector!(p: NonNegativeInteger, v: List NonNegativeInteger)
                : Union("failed", List NonNegativeInteger) ==
       n := #v
@@ -39910,6 +54691,7 @@ and their sum equals the sum of the entries of v. We assume that the
 entries of v are also all less or equal to p.
 
 \begin{chunk}{package FFFG FractionFreeFastGaussian}
+
     vectorStream(p: NonNegativeInteger, v: List NonNegativeInteger)
                 : Stream List NonNegativeInteger == delay
       next := nextVector!(p, copy v)
@@ -39920,6 +54702,7 @@ entries of v are also all less or equal to p.
 vectorStream2 skips every second entry of vectorStream.
 
 \begin{chunk}{package FFFG FractionFreeFastGaussian}
+
     vectorStream2(p: NonNegativeInteger, v: List NonNegativeInteger)
                  : Stream List NonNegativeInteger == delay
       next := nextVector!(p, copy v)
@@ -39973,6 +54756,7 @@ is maxEta and $k$ is the remainder of sumEta divided by
 maxEta. This is done by the following code:
 
 \begin{chunk}{generate an initial degree vector}
+
       sum: Integer := sumEta
       entry: Integer
       eta: List NonNegativeInteger
@@ -39989,6 +54773,7 @@ sumEta. Therefore the following is incorrect.
 \end{chunk}
 
 \begin{chunk}{package FFFG FractionFreeFastGaussian}
+
 -------------------------------------------------------------------------------
 -- rational interpolation
 -------------------------------------------------------------------------------
@@ -40002,19 +54787,18 @@ sumEta. Therefore the following is incorrect.
                                                        List D, _
                                                        List Fraction D)
       r := interpolate(gx.num, gy.num, d)
-      elt(numer r, monomial(gx.den,1))/(gy.den*elt(denom r, monomial(gx.den,1)))
-
+      elt(numer r,monomial(gx.den,1))/(gy.den*elt(denom r, monomial(gx.den,1)))
 
     interpolate(x: List D, y: List D, d: NonNegativeInteger): Fraction SUP D ==
--- berechne Interpolante mit Graden d und N-d-1
+      -- berechne Interpolante mit Graden d und N-d-1
       if (N := #x) ~= #y then
         error "interpolate: number of points and values must match"
       if N <= d then
-        error "interpolate: numerator degree must be smaller than number of data points"
+        error _
+   "interpolate: numerator degree must be smaller than number of data points"
       c: cFunction := (s,u) +-> y.s * elt(u.2, x.s) - elt(u.1, x.s)
       eta: List NonNegativeInteger := [d, (N-d)::NonNegativeInteger]
       M := fffg(x, c, eta)
-
       if zero?(M.(2,1)) then M.(1,2)/M.(2,2)
                         else M.(1,1)/M.(2,1)
 
@@ -40057,36 +54841,32 @@ and update the matrix destructively.  In the following, we write Ck for
 $c_{\sigma,\sigma}$.
 
 \begin{chunk}{package FFFG FractionFreeFastGaussian}
--- a major part of the time is spent here
-    recurrence(M: Matrix SUP D, pi: NonNegativeInteger, m: NonNegativeInteger,
-               r: Vector D, d: D, z: SUP D, Ck: D, p: Vector D): Matrix SUP D ==
 
+    -- a major part of the time is spent here
+    recurrence(M: Matrix SUP D, pi: NonNegativeInteger, m: NonNegativeInteger,_
+            r: Vector D, d: D, z: SUP D, Ck: D, p: Vector D): Matrix SUP D ==
         rPi: D := qelt(r, pi)
         polyf: SUP D := rPi * (z - Ck::SUP D)
-
         for i in 1..m repeat
             MiPi: SUP D    := qelt(M, i, pi)
             newMiPi: SUP D := polyf * MiPi
-
--- update columns ~= pi and calculate their sum
+            -- update columns ~= pi and calculate their sum
             for l in 1..m | l ~= pi repeat
                 rl: D  := qelt(r, l)
--- I need the coercion to SUP D, since exquo returns an element of
--- Union("failed", SUP D)...
-                Mil: SUP D := ((qelt(M, i, l) * rPi - MiPi * rl) exquo d)::SUP D
+            -- I need the coercion to SUP D, since exquo returns an element of
+            -- Union("failed", SUP D)...
+                Mil:SUP D := ((qelt(M, i, l) * rPi - MiPi * rl) exquo d)::SUP D
                 qsetelt!(M, i, l, Mil)
-
                 pl: D  := qelt(p, l)
                 newMiPi := newMiPi - pl * Mil
-
--- update column pi
+            -- update column pi
             qsetelt!(M, i, pi, (newMiPi exquo d)::SUP D)
-
         M
 
 
-    fffg(C: List D, c: cFunction, eta: List NonNegativeInteger): Matrix SUP D ==
--- eta is the vector of degrees. We compute M with degrees eta+e_i-1, i=1..m 
+    fffg(C: List D,c: cFunction, eta: List NonNegativeInteger): Matrix SUP D ==
+        -- eta is the vector of degrees. 
+        -- We compute M with degrees eta+e_i-1, i=1..m 
         z: SUP D := monomial(1, 1)
         m: NonNegativeInteger := #eta
         M: Matrix SUP D := scalarMatrix(m, 1)
@@ -40098,37 +54878,25 @@ $c_{\sigma,\sigma}$.
         Lambda: List Integer
         lambdaMax: Integer
         lambda: NonNegativeInteger
-
         for k in 1..K repeat
--- k = sigma+1
-
             for l in 1..m repeat r.l := c(k, column(M, l))
-
             Lambda := [eta.l-etak.l for l in 1..m | r.l ~= 0]
-
--- if Lambda is empty, then M, d and etak remain unchanged. Otherwise, we look
--- for the next closest para-normal point.
-
+            -- if Lambda is empty, then M, d and etak remain unchanged. 
+            -- Otherwise, we look for the next closest para-normal point.
             (empty? Lambda) => "iterate"
-
             lambdaMax := reduce(max, Lambda)
             lambda := 1
             while eta.lambda-etak.lambda < lambdaMax or r.lambda = 0 repeat 
                 lambda := lambda + 1
-
--- Calculate leading coefficients
-
+            -- Calculate leading coefficients
             for l in 1..m | l ~= lambda repeat
                 if etak.l > 0 then
                     p.l := coefficient(M.(l, lambda), 
                                        (etak.l-1)::NonNegativeInteger)
                 else 
                     p.l := 0
-
--- increase order and adjust degree constraints
-
+            -- increase order and adjust degree constraints
             M := recurrence(M, lambda, m, r, d, z, C.k, p)
-
             d := r.lambda
             etak.lambda := etak.lambda + 1
 
@@ -40139,6 +54907,236 @@ $c_{\sigma,\sigma}$.
 \begin{chunk}{COQ FFFG}
 (* package FFFG *)
 (*
+
+-------------------------------------------------------------------------------
+-- Shift Operator
+-------------------------------------------------------------------------------
+
+-- ShiftAction(k, l, f) is the CoeffAction appropriate for the shift operator.
+
+    ShiftAction(k: NonNegativeInteger, l: NonNegativeInteger, f: V): D ==
+      k**l*coefficient(f, k)
+
+
+    ShiftC(total: NonNegativeInteger): List D == 
+      [i::D for i in 0..total-1]
+
+-------------------------------------------------------------------------------
+-- q-Shift Operator
+-------------------------------------------------------------------------------
+
+-- q-ShiftAction(k, l, f) is the CoeffAction appropriate for the q-shift operator.
+
+    qShiftAction(q:D, k: NonNegativeInteger, l: NonNegativeInteger, f: V): D ==
+      q**(k*l)*coefficient(f, k)
+
+
+    qShiftC(q: D, total: NonNegativeInteger): List D == 
+      [q**i for i in 0..total-1]
+
+-------------------------------------------------------------------------------
+-- Differentiation Operator
+-------------------------------------------------------------------------------
+
+-- DiffAction(k, l, f) is the CoeffAction appropriate for the differentiation
+-- operator.
+
+    DiffAction(k: NonNegativeInteger, l: NonNegativeInteger, f: V): D ==
+      coefficient(f, (k-l)::NonNegativeInteger)
+
+
+    DiffC(total: NonNegativeInteger): List D == 
+      [0 for i in 1..total]
+
+-------------------------------------------------------------------------------
+-- general - suitable for functions f
+-------------------------------------------------------------------------------
+
+-- get the coefficient of z^k in the scalar product of p and f, the action
+-- being defined by coeffAction
+
+    generalCoefficient(coeffAction: CoeffAction, f: Vector V, 
+                       k: NonNegativeInteger, p: Vector SUP D): D == 
+      res: D := 0
+      for i in 1..#f repeat
+        -- Defining a and b and summing only over those coefficients that 
+        -- might be nonzero makes a huge difference in speed
+        a := f.i
+        b := p.i
+        for l in minimumDegree b..degree b repeat
+            if not zero? coefficient(b, l)
+            then res := res + coefficient(b, l) * coeffAction(k, l, a)
+      res
+
+
+    generalInterpolation(C: List D, coeffAction: CoeffAction, 
+                         f: Vector V, 
+                         eta: List NonNegativeInteger): Matrix SUP D == 
+
+      c: cFunction := (x,y) +-> generalCoefficient(coeffAction, f,
+                                         (x-1)::NonNegativeInteger, y)
+      fffg(C, c, eta)
+
+
+
+-------------------------------------------------------------------------------
+-- general - suitable for functions f - trying all possible degree combinations
+-------------------------------------------------------------------------------
+
+    nextVector!(p: NonNegativeInteger, v: List NonNegativeInteger)
+               : Union("failed", List NonNegativeInteger) ==
+      n := #v
+      pos := position(x +-> x < p, v)
+      zero? pos => return "failed"
+      if pos = 1 then
+        sum: Integer := v.1
+        for i in 2..n repeat    
+          if v.i < p and sum > 0 then
+            v.i := v.i + 1
+            sum := sum - 1
+            for j in 1..i-1 repeat
+              if sum > p then
+                v.j := p
+                sum := sum - p
+              else
+                v.j := sum::NonNegativeInteger
+                sum := 0
+            return v
+          else sum := sum + v.i
+        return "failed" 
+      else
+        v.pos     := v.pos + 1    
+        v.(pos-1) := (v.(pos-1) - 1)::NonNegativeInteger
+
+      v
+
+    vectorStream(p: NonNegativeInteger, v: List NonNegativeInteger)
+                : Stream List NonNegativeInteger == delay
+      next := nextVector!(p, copy v)
+      (next case "failed") => empty()$Stream(List NonNegativeInteger)
+      cons(next, vectorStream(p, next))
+
+    vectorStream2(p: NonNegativeInteger, v: List NonNegativeInteger)
+                 : Stream List NonNegativeInteger == delay
+      next := nextVector!(p, copy v)
+      (next case "failed") => empty()$Stream(List NonNegativeInteger)
+      next2 := nextVector!(p, copy next)
+      (next2 case "failed") => cons(next, empty())
+      cons(next2, vectorStream2(p, next2))
+
+    generalInterpolation(C: List D, coeffAction: CoeffAction, 
+                         f: Vector V, 
+                         sumEta: NonNegativeInteger,
+                         maxEta: NonNegativeInteger)
+                        : Stream Matrix SUP D ==
+\getchunk{generate an initial degree vector}
+      if #f = 2 then
+        map(x +-> generalInterpolation(C, coeffAction, f, x), 
+            cons(eta, vectorStream2(maxEta, eta)))
+           $StreamFunctions2(List NonNegativeInteger,
+                             Matrix SUP D)
+      else
+        map(x +-> generalInterpolation(C, coeffAction, f, x), 
+            cons(eta, vectorStream(maxEta, eta)))
+           $StreamFunctions2(List NonNegativeInteger,
+                           Matrix SUP D)
+      sum: Integer := sumEta
+      entry: Integer
+      eta: List NonNegativeInteger
+          := [(if sum < maxEta _
+               then (entry := sum; sum := 0) _
+               else (entry := maxEta; sum := sum - maxEta); _
+               entry::NonNegativeInteger) for i in 1..#f]
+
+-------------------------------------------------------------------------------
+-- rational interpolation
+-------------------------------------------------------------------------------
+
+    interpolate(x: List Fraction D, y: List Fraction D, d: NonNegativeInteger) 
+               : Fraction SUP D ==
+      gx := splitDenominator(x)$InnerCommonDenominator(D, Fraction D, _
+                                                       List D, _
+                                                       List Fraction D)
+      gy := splitDenominator(y)$InnerCommonDenominator(D, Fraction D, _
+                                                       List D, _
+                                                       List Fraction D)
+      r := interpolate(gx.num, gy.num, d)
+      elt(numer r,monomial(gx.den,1))/(gy.den*elt(denom r, monomial(gx.den,1)))
+
+    interpolate(x: List D, y: List D, d: NonNegativeInteger): Fraction SUP D ==
+      -- berechne Interpolante mit Graden d und N-d-1
+      if (N := #x) ~= #y then
+        error "interpolate: number of points and values must match"
+      if N <= d then
+        error _
+   "interpolate: numerator degree must be smaller than number of data points"
+      c: cFunction := (s,u) +-> y.s * elt(u.2, x.s) - elt(u.1, x.s)
+      eta: List NonNegativeInteger := [d, (N-d)::NonNegativeInteger]
+      M := fffg(x, c, eta)
+      if zero?(M.(2,1)) then M.(1,2)/M.(2,2)
+                        else M.(1,1)/M.(2,1)
+
+
+    -- a major part of the time is spent here
+    recurrence(M: Matrix SUP D, pi: NonNegativeInteger, m: NonNegativeInteger,_
+            r: Vector D, d: D, z: SUP D, Ck: D, p: Vector D): Matrix SUP D ==
+        rPi: D := qelt(r, pi)
+        polyf: SUP D := rPi * (z - Ck::SUP D)
+        for i in 1..m repeat
+            MiPi: SUP D    := qelt(M, i, pi)
+            newMiPi: SUP D := polyf * MiPi
+            -- update columns ~= pi and calculate their sum
+            for l in 1..m | l ~= pi repeat
+                rl: D  := qelt(r, l)
+            -- I need the coercion to SUP D, since exquo returns an element of
+            -- Union("failed", SUP D)...
+                Mil:SUP D := ((qelt(M, i, l) * rPi - MiPi * rl) exquo d)::SUP D
+                qsetelt!(M, i, l, Mil)
+                pl: D  := qelt(p, l)
+                newMiPi := newMiPi - pl * Mil
+            -- update column pi
+            qsetelt!(M, i, pi, (newMiPi exquo d)::SUP D)
+        M
+
+
+    fffg(C: List D,c: cFunction, eta: List NonNegativeInteger): Matrix SUP D ==
+        -- eta is the vector of degrees. 
+        -- We compute M with degrees eta+e_i-1, i=1..m 
+        z: SUP D := monomial(1, 1)
+        m: NonNegativeInteger := #eta
+        M: Matrix SUP D := scalarMatrix(m, 1)
+        d: D := 1
+        K: NonNegativeInteger := reduce(_+, eta)
+        etak: Vector NonNegativeInteger := zero(m)
+        r: Vector D := zero(m)
+        p: Vector D := zero(m)
+        Lambda: List Integer
+        lambdaMax: Integer
+        lambda: NonNegativeInteger
+        for k in 1..K repeat
+            for l in 1..m repeat r.l := c(k, column(M, l))
+            Lambda := [eta.l-etak.l for l in 1..m | r.l ~= 0]
+            -- if Lambda is empty, then M, d and etak remain unchanged. 
+            -- Otherwise, we look for the next closest para-normal point.
+            (empty? Lambda) => "iterate"
+            lambdaMax := reduce(max, Lambda)
+            lambda := 1
+            while eta.lambda-etak.lambda < lambdaMax or r.lambda = 0 repeat 
+                lambda := lambda + 1
+            -- Calculate leading coefficients
+            for l in 1..m | l ~= lambda repeat
+                if etak.l > 0 then
+                    p.l := coefficient(M.(l, lambda), 
+                                       (etak.l-1)::NonNegativeInteger)
+                else 
+                    p.l := 0
+            -- increase order and adjust degree constraints
+            M := recurrence(M, lambda, m, r, d, z, C.k, p)
+            d := r.lambda
+            etak.lambda := etak.lambda + 1
+
+        M
+
 *)
 
 \end{chunk}
@@ -40301,6 +55299,62 @@ FractionFreeFastGaussianFractions(D, V, VF): Exports == Implementation where
 \begin{chunk}{COQ FFFGF}
 (* package FFFGF *)
 (*
+
+    multiplyRows!(v: Vector D, M: Matrix SUP D): Matrix SUP D ==
+      n := #v
+      for i in 1..n repeat
+        for j in 1..n repeat
+          M.(i,j) := v.i*M.(i,j)
+
+      M
+
+    generalInterpolation(C: List D, coeffAction: CoeffAction, 
+                         f: Vector VF, eta: List NNI): Matrix SUP D == 
+      n := #f
+      g: Vector V   := new(n, 0)
+      den: Vector D := new(n, 0)
+
+      for i in 1..n repeat
+        c := coefficients(f.i)
+        den.i := commonDenominator(c)$CommonDenominator(D, F, List F)
+        g.i := 
+          map(x +-> retract(x*den.i)@D, f.i)$FAMR2(NNI, Fraction D, VF, D, V)
+
+      M := generalInterpolation(C, coeffAction, g, eta)$FFFG(D, V)
+
+-- The following is necessary since I'm multiplying each row with a factor, not
+-- each column. Possibly I could factor out gcd den, but I'm not sure whether
+-- this is efficient.
+
+      multiplyRows!(den, M)
+
+    generalInterpolation(C: List D, coeffAction: CoeffAction, 
+                         f: Vector VF, sumEta: NNI, maxEta: NNI)
+                          : Stream Matrix SUP D == 
+
+      n := #f
+      g: Vector V   := new(n, 0)
+      den: Vector D := new(n, 0)
+
+      for i in 1..n repeat
+        c := coefficients(f.i)
+        den.i := commonDenominator(c)$CommonDenominator(D, F, List F)
+        g.i := 
+          map(x +-> retract(x*den.i)@D, f.i)$FAMR2(NNI, Fraction D, VF, D, V)
+
+      c: cFunction := 
+       (x,y) +-> generalCoefficient(coeffAction, g, (x-1)::NNI, y)$FFFG(D, V)
+
+
+      MS: Stream Matrix SUP D 
+         := generalInterpolation(C, coeffAction, g, sumEta, maxEta)$FFFG(D, V)
+
+-- The following is necessary since I'm multiplying each row with a factor, not
+-- each column. Possibly I could factor out gcd den, but I'm not sure whether
+-- this is efficient.
+
+      map(x +-> multiplyRows!(den, x), MS)$Stream(Matrix SUP D)
+
 *)
 
 \end{chunk}
@@ -40375,6 +55429,7 @@ FractionFunctions2(A, B): Exports == Impl where
       ++ and denominator of the fraction frac.
 
   Impl ==> add
+
     map(f, r) == map(f, r)$QuotientFieldCategoryFunctions2(A, B, R, S)
 
 \end{chunk}
@@ -40382,6 +55437,9 @@ FractionFunctions2(A, B): Exports == Impl where
 \begin{chunk}{COQ FRAC2}
 (* package FRAC2 *)
 (*
+
+    map(f, r) == map(f, r)$QuotientFieldCategoryFunctions2(A, B, R, S)
+
 *)
 
 \end{chunk}
@@ -40462,18 +55520,11 @@ FramedNonAssociativeAlgebraFunctions2(AR,R,AS,S) : Exports ==
         ++ in \spad{AS} via identification of the basis of \spad{AR}
         ++ as beginning part of the basis of \spad{AS}.
     Implementation ==> add
+
       map(fn : R -> S, u : AR): AS ==
         rank()$AR > rank()$AS => error("map: ranks of algebras do not fit")
         vr : V R := coordinates u
         vs : V S := map(fn,vr)$VectorFunctions2(R,S)
-\end{chunk}
-This line used to read:
-\begin{verbatim}
-        rank()$AR = rank()$AR => represents(vs)$AS
-\end{verbatim}
-but the test is clearly always true and cannot be what was intended.
-Gregory Vanuxem supplied the fix below.
-\begin{chunk}{package FRNAAF2 FramedNonAssociativeAlgebraFunctions2}
         rank()$AR = rank()$AS => represents(vs)$AS
         ba := basis()$AS
         represents(vs,[ba.i for i in 1..rank()$AR])
@@ -40483,6 +55534,15 @@ Gregory Vanuxem supplied the fix below.
 \begin{chunk}{COQ FRNAAF2}
 (* package FRNAAF2 *)
 (*
+
+      map(fn : R -> S, u : AR): AS ==
+        rank()$AR > rank()$AS => error("map: ranks of algebras do not fit")
+        vr : V R := coordinates u
+        vs : V S := map(fn,vr)$VectorFunctions2(R,S)
+        rank()$AR = rank()$AS => represents(vs)$AS
+        ba := basis()$AS
+        represents(vs,[ba.i for i in 1..rank()$AR])
+
 *)
 
 \end{chunk}
@@ -40658,6 +55718,7 @@ might not re-evaluate the operator.
       ++ iiAiryBi(x) should be local but conditional;
 
   Implementation ==> add
+
     iabs      : F -> F
     iGamma    : F -> F
     iBeta     : (F, F) -> F
@@ -40684,16 +55745,27 @@ might not re-evaluate the operator.
     opAiryBi    := operator("airyBi"::Symbol)$CommonOperators
 
     abs x         == opabs x
+
     Gamma(x)      == opGamma(x)
+
     Gamma(a,x)    == opGamma2(a,x)
+
     Beta(x,y)     == opBeta(x,y)
+
     digamma x     == opdigamma(x)
+
     polygamma(k,x)== oppolygamma(k,x)
+
     besselJ(a,x)  == opBesselJ(a,x)
+
     besselY(a,x)  == opBesselY(a,x)
+
     besselI(a,x)  == opBesselI(a,x)
+
     besselK(a,x)  == opBesselK(a,x)
+
     airyAi(x)     == opAiryAi(x)
+
     airyBi(x)     == opAiryBi(x)
 
     belong? op == has?(op, "special")
@@ -40716,7 +55788,6 @@ might not re-evaluate the operator.
 
     -- Could put more unconditional special rules for other functions here
     iGamma x ==
---      one? x => x
       (x = 1) => x
       kernel(opGamma, x)
 
@@ -40740,17 +55811,21 @@ might not re-evaluate the operator.
     -- Could put more conditional special rules for other functions here
 
     if R has abs : R -> R then
+
       iiabs x ==
         (r := retractIfCan(x)@Union(Fraction Polynomial R, "failed"))
           case "failed" => iabs x
         f := r::Fraction Polynomial R
         (a := retractIfCan(numer f)@Union(R, "failed")) case "failed" or
-          (b := retractIfCan(denom f)@Union(R,"failed")) case "failed" => iabs x
+          (b:= retractIfCan(denom f)@Union(R,"failed")) case "failed" => iabs x
         abs(a::R)::F / abs(b::R)::F
 
-    else iiabs x == iabs x
+    else 
+
+      iiabs x == iabs x
 
     if R has SpecialFunctionCategory then
+
       iiGamma x ==
         (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iGamma x
         Gamma(r::R)::F
@@ -40805,36 +55880,58 @@ might not re-evaluate the operator.
 
     else
       if R has RetractableTo Integer then
+
         iiGamma x ==
           (r := retractIfCan(x)@Union(Integer, "failed")) case Integer
             and (r::Integer >= 1) => factorial(r::Integer - 1)::F
           iGamma x
+
       else
+
         iiGamma x == iGamma x
 
       iiBeta l == iBeta(first l, second l)
+
       iidigamma x == idigamma x 
+
       iipolygamma l == iiipolygamma(first l, second l)
+
       iiBesselJ l == iiiBesselJ(first l, second l) 
+
       iiBesselY l == iiiBesselY(first l, second l)
+
       iiBesselI l == iiiBesselI(first l, second l)
+
       iiBesselK l == iiiBesselK(first l, second l)
+
       iiAiryAi x == iAiryAi x
+
       iiAiryBi x == iAiryBi x
 
     -- Default behaviour is to build a kernel
+
     evaluate(opGamma, iiGamma)$BasicOperatorFunctions1(F)
+
     evaluate(opabs, iiabs)$BasicOperatorFunctions1(F)
---    evaluate(opGamma2    ,iiGamma2   )$BasicOperatorFunctions1(F)
+
     evaluate(opBeta      ,iiBeta     )$BasicOperatorFunctions1(F)
+
     evaluate(opdigamma   ,iidigamma  )$BasicOperatorFunctions1(F)
+
     evaluate(oppolygamma ,iipolygamma)$BasicOperatorFunctions1(F)
+
     evaluate(opBesselJ   ,iiBesselJ  )$BasicOperatorFunctions1(F)
+
     evaluate(opBesselY   ,iiBesselY  )$BasicOperatorFunctions1(F)
+
     evaluate(opBesselI   ,iiBesselI  )$BasicOperatorFunctions1(F)
+
     evaluate(opBesselK   ,iiBesselK  )$BasicOperatorFunctions1(F)
+
     evaluate(opAiryAi    ,iiAiryAi   )$BasicOperatorFunctions1(F)
+
     evaluate(opAiryBi    ,iiAiryBi   )$BasicOperatorFunctions1(F)
+
 \end{chunk}
 
 \subsection{differentiation of special functions}
@@ -40963,6 +56060,301 @@ integrate(D(besselJ(a,x),a),a).
 \begin{chunk}{COQ FSPECF}
 (* package FSPECF *)
 (*
+
+    iabs      : F -> F
+    iGamma    : F -> F
+    iBeta     : (F, F) -> F
+    idigamma  : F -> F
+    iiipolygamma: (F, F) -> F
+    iiiBesselJ  : (F, F) -> F
+    iiiBesselY  : (F, F) -> F
+    iiiBesselI  : (F, F) -> F
+    iiiBesselK  : (F, F) -> F
+    iAiryAi   : F -> F
+    iAiryBi   : F -> F
+
+    opabs       := operator("abs"::Symbol)$CommonOperators
+    opGamma     := operator("Gamma"::Symbol)$CommonOperators
+    opGamma2    := operator("Gamma2"::Symbol)$CommonOperators
+    opBeta      := operator("Beta"::Symbol)$CommonOperators
+    opdigamma   := operator("digamma"::Symbol)$CommonOperators
+    oppolygamma := operator("polygamma"::Symbol)$CommonOperators
+    opBesselJ   := operator("besselJ"::Symbol)$CommonOperators
+    opBesselY   := operator("besselY"::Symbol)$CommonOperators
+    opBesselI   := operator("besselI"::Symbol)$CommonOperators
+    opBesselK   := operator("besselK"::Symbol)$CommonOperators
+    opAiryAi    := operator("airyAi"::Symbol)$CommonOperators
+    opAiryBi    := operator("airyBi"::Symbol)$CommonOperators
+
+    abs x         == opabs x
+
+    Gamma(x)      == opGamma(x)
+
+    Gamma(a,x)    == opGamma2(a,x)
+
+    Beta(x,y)     == opBeta(x,y)
+
+    digamma x     == opdigamma(x)
+
+    polygamma(k,x)== oppolygamma(k,x)
+
+    besselJ(a,x)  == opBesselJ(a,x)
+
+    besselY(a,x)  == opBesselY(a,x)
+
+    besselI(a,x)  == opBesselI(a,x)
+
+    besselK(a,x)  == opBesselK(a,x)
+
+    airyAi(x)     == opAiryAi(x)
+
+    airyBi(x)     == opAiryBi(x)
+
+    belong? op == has?(op, "special")
+
+    operator op ==
+      is?(op, "abs"::Symbol)      => opabs
+      is?(op, "Gamma"::Symbol)    => opGamma
+      is?(op, "Gamma2"::Symbol)   => opGamma2
+      is?(op, "Beta"::Symbol)     => opBeta
+      is?(op, "digamma"::Symbol)  => opdigamma
+      is?(op, "polygamma"::Symbol)=> oppolygamma
+      is?(op, "besselJ"::Symbol)  => opBesselJ
+      is?(op, "besselY"::Symbol)  => opBesselY
+      is?(op, "besselI"::Symbol)  => opBesselI
+      is?(op, "besselK"::Symbol)  => opBesselK
+      is?(op, "airyAi"::Symbol)   => opAiryAi
+      is?(op, "airyBi"::Symbol)   => opAiryBi
+
+      error "Not a special operator"
+
+    -- Could put more unconditional special rules for other functions here
+    iGamma x ==
+      (x = 1) => x
+      kernel(opGamma, x)
+
+    iabs x ==
+      zero? x => 0
+      is?(x, opabs) => x
+      x < 0 => kernel(opabs, -x)
+      kernel(opabs, x)
+
+    iBeta(x, y) == kernel(opBeta, [x, y])
+
+    idigamma x == kernel(opdigamma, x)
+
+    iiipolygamma(n, x) == kernel(oppolygamma, [n, x])
+
+    iiiBesselJ(x, y) == kernel(opBesselJ, [x, y])
+
+    iiiBesselY(x, y) == kernel(opBesselY, [x, y])
+
+    iiiBesselI(x, y) == kernel(opBesselI, [x, y])
+
+    iiiBesselK(x, y) == kernel(opBesselK, [x, y])
+
+    iAiryAi x == kernel(opAiryAi, x)
+
+    iAiryBi x == kernel(opAiryBi, x)
+
+
+    -- Could put more conditional special rules for other functions here
+
+    if R has abs : R -> R then
+
+      iiabs x ==
+        (r := retractIfCan(x)@Union(Fraction Polynomial R, "failed"))
+          case "failed" => iabs x
+        f := r::Fraction Polynomial R
+        (a := retractIfCan(numer f)@Union(R, "failed")) case "failed" or
+          (b:= retractIfCan(denom f)@Union(R,"failed")) case "failed" => iabs x
+        abs(a::R)::F / abs(b::R)::F
+
+    else 
+
+      iiabs x == iabs x
+
+    if R has SpecialFunctionCategory then
+
+      iiGamma x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iGamma x
+        Gamma(r::R)::F
+
+      iiBeta l ==
+        (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _
+        (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _
+            => iBeta(first l, second l)
+        Beta(r::R, s::R)::F
+
+      iidigamma x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => idigamma x
+        digamma(r::R)::F
+
+      iipolygamma l ==
+        (s:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _
+        (r:=retractIfCan(second l)@Union(R,"failed")) case "failed" _
+            => iiipolygamma(first l, second l)
+        polygamma(s::R, r::R)::F
+
+      iiBesselJ l ==
+        (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _
+        (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _
+            => iiiBesselJ(first l, second l)
+        besselJ(r::R, s::R)::F
+
+      iiBesselY l ==
+        (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _
+        (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _
+            => iiiBesselY(first l, second l)
+        besselY(r::R, s::R)::F
+
+      iiBesselI l ==
+        (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _
+        (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _
+            => iiiBesselI(first l, second l)
+        besselI(r::R, s::R)::F
+
+      iiBesselK l ==
+        (r:=retractIfCan(first l)@Union(R,"failed")) case "failed" or _
+        (s:=retractIfCan(second l)@Union(R,"failed")) case "failed" _
+            => iiiBesselK(first l, second l)
+        besselK(r::R, s::R)::F
+
+      iiAiryAi x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iAiryAi x
+        airyAi(r::R)::F
+
+      iiAiryBi x ==
+        (r:=retractIfCan(x)@Union(R,"failed")) case "failed" => iAiryBi x
+        airyBi(r::R)::F
+
+    else
+      if R has RetractableTo Integer then
+
+        iiGamma x ==
+          (r := retractIfCan(x)@Union(Integer, "failed")) case Integer
+            and (r::Integer >= 1) => factorial(r::Integer - 1)::F
+          iGamma x
+
+      else
+
+        iiGamma x == iGamma x
+
+      iiBeta l == iBeta(first l, second l)
+
+      iidigamma x == idigamma x 
+
+      iipolygamma l == iiipolygamma(first l, second l)
+
+      iiBesselJ l == iiiBesselJ(first l, second l) 
+
+      iiBesselY l == iiiBesselY(first l, second l)
+
+      iiBesselI l == iiiBesselI(first l, second l)
+
+      iiBesselK l == iiiBesselK(first l, second l)
+
+      iiAiryAi x == iAiryAi x
+
+      iiAiryBi x == iAiryBi x
+
+    -- Default behaviour is to build a kernel
+
+    evaluate(opGamma, iiGamma)$BasicOperatorFunctions1(F)
+
+    evaluate(opabs, iiabs)$BasicOperatorFunctions1(F)
+
+    evaluate(opBeta      ,iiBeta     )$BasicOperatorFunctions1(F)
+
+    evaluate(opdigamma   ,iidigamma  )$BasicOperatorFunctions1(F)
+
+    evaluate(oppolygamma ,iipolygamma)$BasicOperatorFunctions1(F)
+
+    evaluate(opBesselJ   ,iiBesselJ  )$BasicOperatorFunctions1(F)
+
+    evaluate(opBesselY   ,iiBesselY  )$BasicOperatorFunctions1(F)
+
+    evaluate(opBesselI   ,iiBesselI  )$BasicOperatorFunctions1(F)
+
+    evaluate(opBesselK   ,iiBesselK  )$BasicOperatorFunctions1(F)
+
+    evaluate(opAiryAi    ,iiAiryAi   )$BasicOperatorFunctions1(F)
+
+    evaluate(opAiryBi    ,iiAiryBi   )$BasicOperatorFunctions1(F)
+
+    import Fraction Integer
+    ahalf:  F    := recip(2::F)::F
+    athird: F    := recip(2::F)::F
+    twothirds: F := 2*recip(3::F)::F
+    dummyArg: SE := new()$SE
+    opdiff := operator first kernels D((operator(new()$SE)$BasicOperator)
+                                            (dummyArg::F), dummyArg)
+
+    dm := new()$SE :: F
+
+    iBesselJ(l: List F, t: SE): F ==
+        n := first l; x := second l
+        differentiate(n, t)*kernel(opdiff, [opBesselJ [dm, x], dm, n])
+          + differentiate(x, t) * ahalf * (besselJ (n-1,x) - besselJ (n+1,x))
+
+    iBesselY(l: List F, t: SE): F ==
+        n := first l; x := second l
+        differentiate(n, t)*kernel(opdiff, [opBesselY [dm, x], dm, n])
+          + differentiate(x, t) * ahalf * (besselY (n-1,x) - besselY (n+1,x))
+
+    iBesselI(l: List F, t: SE): F ==
+        n := first l; x := second l
+        differentiate(n, t)*kernel(opdiff, [opBesselI [dm, x], dm, n])
+          + differentiate(x, t)* ahalf * (besselI (n-1,x) + besselI (n+1,x))
+
+    iBesselK(l: List F, t: SE): F ==
+        n := first l; x := second l
+        differentiate(n, t)*kernel(opdiff, [opBesselK [dm, x], dm, n])
+          - differentiate(x, t)* ahalf * (besselK (n-1,x) + besselK (n+1,x))
+
+    ipolygamma(l: List F, x: SE): F ==
+        member?(x, variables first l) =>
+            error _
+          "cannot differentiate polygamma with respect to the first argument"
+        n := first l; y := second l
+        differentiate(y, x)*polygamma(n+1, y)
+
+    iBetaGrad1(l: List F): F ==
+        x := first l; y := second l
+        Beta(x,y)*(digamma x - digamma(x+y))
+
+    iBetaGrad2(l: List F): F ==
+        x := first l; y := second l
+        Beta(x,y)*(digamma y - digamma(x+y))
+
+    if F has ElementaryFunctionCategory then
+
+      iGamma2(l: List F, t: SE): F ==
+        a := first l; x := second l
+        differentiate(a, t)*kernel(opdiff, [opGamma2 [dm, x], dm, a])
+          - differentiate(x, t)* x ** (a - 1) * exp(-x)
+      setProperty(opGamma2, SPECIALDIFF, iGamma2@((List F, SE)->F) 
+                                                 pretend None)
+
+    derivative(opabs,       (x:F):F +-> abs(x) * inv(x))
+
+    derivative(opGamma,     (x:F):F +-> digamma x * Gamma x)
+
+    derivative(opBeta,      [iBetaGrad1, iBetaGrad2])
+
+    derivative(opdigamma,   (x:F):F +-> polygamma(1, x))
+
+    setProperty(oppolygamma, SPECIALDIFF, ipolygamma@((List F, SE)->F)
+                                                     pretend None)
+    setProperty(opBesselJ, SPECIALDIFF, iBesselJ@((List F, SE)->F) 
+                                                 pretend None)
+    setProperty(opBesselY, SPECIALDIFF, iBesselY@((List F, SE)->F) 
+                                                 pretend None)
+    setProperty(opBesselI, SPECIALDIFF, iBesselI@((List F, SE)->F) 
+                                                 pretend None)
+    setProperty(opBesselK, SPECIALDIFF, iBesselK@((List F, SE)->F) 
+                                                 pretend None)
+
 *)
 
 \end{chunk}
@@ -41040,6 +56432,7 @@ FunctionFieldCategoryFunctions2(R1, UP1, UPUP1, F1, R2, UP2, UPUP2, F2):
       ++ map(f, p) lifts f to F1 and applies it to p.
 
   Implementation ==> add
+
     map(f, f1) ==
       reduce(map(f, lift f1)$MultipleMap(R1, UP1, UPUP1, R2, UP2, UPUP2))
 
@@ -41048,6 +56441,10 @@ FunctionFieldCategoryFunctions2(R1, UP1, UPUP1, F1, R2, UP2, UPUP2, F2):
 \begin{chunk}{COQ FFCAT2}
 (* package FFCAT2 *)
 (*
+
+    map(f, f1) ==
+      reduce(map(f, lift f1)$MultipleMap(R1, UP1, UPUP1, R2, UP2, UPUP2))
+
 *)
 
 \end{chunk}
@@ -41168,6 +56565,7 @@ FunctionFieldIntegralBasis(R,UP,F): Exports == Implementation where
       ++ \spad{wi = sum(bij * vj, j = 1..n)}.
 
   Implementation ==> add
+
     import IntegralBasisTools(R, UP, F)
     import ModularHermitianRowReduction(R)
     import TriangularMatrixOperations(R, Vector R, Vector R, Matrix R)
@@ -41234,6 +56632,68 @@ FunctionFieldIntegralBasis(R,UP,F): Exports == Implementation where
 \begin{chunk}{COQ FFINTBAS}
 (* package FFINTBAS *)
 (*
+
+    import IntegralBasisTools(R, UP, F)
+    import ModularHermitianRowReduction(R)
+    import TriangularMatrixOperations(R, Vector R, Vector R, Matrix R)
+
+    squaredFactors: R -> R
+    squaredFactors px ==
+           */[(if ffe.exponent > 1 then ffe.factor else 1$R)
+                for ffe in factors squareFree px]
+
+    iIntegralBasis: (Mat,R,R) -> Record(basis: Mat, basisDen: R, basisInv:Mat)
+    iIntegralBasis(tfm,disc,sing) ==
+      -- tfm = trace matrix of current order
+      n := rank()$F; tfm0 := copy tfm; disc0 := disc
+      rb := scalarMatrix(n, 1); rbinv := scalarMatrix(n, 1)
+      -- rb    = basis matrix of current order
+      -- rbinv = inverse basis matrix of current order
+      -- these are wrt the original basis for F
+      rbden : R := 1; index : R := 1; oldIndex : R := 1
+      -- rbden = denominator for current basis matrix
+      -- index = index of original order in current order
+      not sizeLess?(1, sing) => [rb, rbden, rbinv]
+      repeat
+        -- compute the p-radical
+        idinv := transpose squareTop rowEchelon(tfm, sing)
+        -- [u1,..,un] are the coordinates of an element of the p-radical
+        -- iff [u1,..,un] * idinv is in sing * R^n
+        id := rowEchelon LowTriBddDenomInv(idinv, sing)
+        -- id = basis matrix of the p-radical
+        idinv := UpTriBddDenomInv(id, sing)
+        -- id * idinv = sing * identity
+        -- no need to check for inseparability in this case
+        rbinv := idealiser(id * rb, rbinv * idinv, sing * rbden)
+        index := diagonalProduct rbinv
+        rb := rowEchelon LowTriBddDenomInv(rbinv, rbden * sing)
+        g := matrixGcd(rb,sing,n)
+        if sizeLess?(1,g) then rb := (rb exquo g) :: Mat
+        rbden := rbden * (sing quo g)
+        rbinv := UpTriBddDenomInv(rb, rbden)
+        disc := disc0 quo (index * index)
+        indexChange := index quo oldIndex; oldIndex := index
+        sing := gcd(indexChange, squaredFactors disc)
+        not sizeLess?(1, sing) => return [rb, rbden, rbinv]
+        tfm := ((rb * tfm0 * transpose rb) exquo (rbden * rbden)) :: Mat
+
+    integralBasis() ==
+      n := rank()$F; p := characteristic()$F
+      (not zero? p) and (n >= p) =>
+        error "integralBasis: possible wild ramification"
+      tfm := traceMatrix()$F; disc := determinant tfm
+      sing := squaredFactors disc    -- singularities of relative Spec
+      iIntegralBasis(tfm,disc,sing)
+
+    localIntegralBasis prime ==
+      n := rank()$F; p := characteristic()$F
+      (not zero? p) and (n >= p) =>
+        error "integralBasis: possible wild ramification"
+      tfm := traceMatrix()$F; disc := determinant tfm
+      (disc exquo (prime * prime)) case "failed" =>
+        [scalarMatrix(n,1),1,scalarMatrix(n,1)]
+      iIntegralBasis(tfm,disc,prime)
+
 *)
 
 \end{chunk}
@@ -41330,6 +56790,7 @@ FunctionSpaceAssertions(R, F): Exports == Implementation where
       ++ Error: if x is not a symbol.
 
   Implementation ==> add
+
     ass  : (K, String) -> F
     asst : (K, String) -> F
     mkk  : BasicOperator -> F
@@ -41369,6 +56830,41 @@ FunctionSpaceAssertions(R, F): Exports == Implementation where
 \begin{chunk}{COQ PMASSFS}
 (* package PMASSFS *)
 (*
+
+    ass  : (K, String) -> F
+    asst : (K, String) -> F
+    mkk  : BasicOperator -> F
+
+    mkk op == kernel(op, empty()$List(F))
+
+    ass(k, s) ==
+      has?(op := operator k, s) => k::F
+      mkk assert(copy op, s)
+
+    asst(k, s) ==
+      has?(op := operator k, s) => k::F
+      mkk assert(op, s)
+
+    assert(x, s) ==
+      retractIfCan(x)@Union(Symbol, "failed") case Symbol =>
+        asst(retract(x)@K, s)
+      error "assert must be applied to symbols only"
+
+    constant x ==
+      retractIfCan(x)@Union(Symbol, "failed") case Symbol =>
+        ass(retract(x)@K, PMCONST)
+      error "constant must be applied to symbols only"
+
+    optional x ==
+      retractIfCan(x)@Union(Symbol, "failed") case Symbol =>
+        ass(retract(x)@K, PMOPT)
+      error "optional must be applied to symbols only"
+
+    multiple x ==
+      retractIfCan(x)@Union(Symbol, "failed") case Symbol =>
+        ass(retract(x)@K, PMMULT)
+      error "multiple must be applied to symbols only"
+
 *)
 
 \end{chunk}
@@ -41449,6 +56945,7 @@ FunctionSpaceAttachPredicates(R, F, D): Exports == Implementation where
       ++ Error: if x is not a symbol.
 
   Implementation ==> add
+
     import AnyFunctions1(D -> Boolean)
 
     st   : (K, List Any) -> F
@@ -41456,6 +56953,7 @@ FunctionSpaceAttachPredicates(R, F, D): Exports == Implementation where
     mkk  : BasicOperator -> F
 
     suchThat(p:F, f:D -> Boolean) == suchThat(p, [f])
+
     mkk op                        == kernel(op, empty()$List(F))
 
     preds k ==
@@ -41476,6 +56974,30 @@ FunctionSpaceAttachPredicates(R, F, D): Exports == Implementation where
 \begin{chunk}{COQ PMPREDFS}
 (* package PMPREDFS *)
 (*
+
+    import AnyFunctions1(D -> Boolean)
+
+    st   : (K, List Any) -> F
+    preds: K -> List Any
+    mkk  : BasicOperator -> F
+
+    suchThat(p:F, f:D -> Boolean) == suchThat(p, [f])
+
+    mkk op                        == kernel(op, empty()$List(F))
+
+    preds k ==
+      (u := property(operator k, PMPRED)) case "failed" => empty()
+      (u::None) pretend List(Any)
+
+    st(k, l) ==
+      mkk assert(setProperty(copy operator k, PMPRED,
+                 concat(preds k, l) pretend None), string(new()$Symbol))
+
+    suchThat(p:F, l:List(D -> Boolean)) ==
+      retractIfCan(p)@Union(Symbol, "failed") case Symbol =>
+        st(retract(p)@K, [f::Any for f in l])
+      error "suchThat must be applied to symbols only"
+
 *)
 
 \end{chunk}
@@ -41569,6 +57091,7 @@ FunctionSpaceComplexIntegration(R, F): Exports == Implementation where
         ++ where x is viewed as a complex variable.
  
   Implementation ==> add
+
     import IntegrationTools(R, F)
     import ElementaryIntegration(R, F)
     import ElementaryIntegration(G, FG)
@@ -41583,7 +57106,7 @@ FunctionSpaceComplexIntegration(R, F): Exports == Implementation where
  
     K2KG: Kernel F -> Kernel FG
  
-    K2KG k                 == retract(tan F2FG first argument k)@Kernel(FG)
+    K2KG k == retract(tan F2FG first argument k)@Kernel(FG)
  
     complexIntegrate(f, x) ==
       removeConstantTerm(complexExpand internalIntegrate(f, x), x)
@@ -41591,6 +57114,7 @@ FunctionSpaceComplexIntegration(R, F): Exports == Implementation where
     if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer)
       and F has Join(LiouvillianFunctionCategory, RetractableTo SE) then
         import PatternMatchIntegration(R, F)
+
         internalIntegrate0(f, x) ==
           intPatternMatch(f, x, lfintegrate, pmComplexintegrate)
  
@@ -41615,6 +57139,49 @@ FunctionSpaceComplexIntegration(R, F): Exports == Implementation where
 \begin{chunk}{COQ FSCINT}
 (* package FSCINT *)
 (*
+
+    import IntegrationTools(R, F)
+    import ElementaryIntegration(R, F)
+    import ElementaryIntegration(G, FG)
+    import AlgebraicManipulations(R, F)
+    import AlgebraicManipulations(G, FG)
+    import TrigonometricManipulations(R, F)
+    import IntegrationResultToFunction(R, F)
+    import IntegrationResultFunctions2(FG, F)
+    import ElementaryFunctionStructurePackage(R, F)
+    import ElementaryFunctionStructurePackage(G, FG)
+    import InnerTrigonometricManipulations(R, F, FG)
+ 
+    K2KG: Kernel F -> Kernel FG
+ 
+    K2KG k == retract(tan F2FG first argument k)@Kernel(FG)
+ 
+    complexIntegrate(f, x) ==
+      removeConstantTerm(complexExpand internalIntegrate(f, x), x)
+ 
+    if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer)
+      and F has Join(LiouvillianFunctionCategory, RetractableTo SE) then
+        import PatternMatchIntegration(R, F)
+
+        internalIntegrate0(f, x) ==
+          intPatternMatch(f, x, lfintegrate, pmComplexintegrate)
+ 
+    else internalIntegrate0(f, x) == lfintegrate(f, x)
+ 
+    internalIntegrate(f, x) ==
+      f := distribute(f, x::F)
+      any?(x1+->has?(operator x1, "rtrig"),
+       [k for k in tower(g := realElementary(f, x))
+        | member?(x, variables(k::F))]$List(Kernel F))$List(Kernel F) =>
+          h := trigs2explogs(F2FG g, [K2KG k for k in tower f
+                         | is?(k, "tan"::SE) or is?(k, "cot"::SE)], [x])
+          real?(g := FG2F h) =>
+            internalIntegrate0(rootSimp(rischNormalize(g, x).func), x)
+          real?(g := FG2F(h := rootSimp(rischNormalize(h, x).func))) =>
+                                                       internalIntegrate0(g, x)
+          map(FG2F, lfintegrate(h, x))
+      internalIntegrate0(rootSimp(rischNormalize(g, x).func), x)
+
 *)
 
 \end{chunk}
@@ -41693,6 +57260,7 @@ FunctionSpaceFunctions2(R, A, S, B): Exports == Implementation where
       ++ map(f, a) applies f to all the constants in R appearing in \spad{a}.
 
   Implementation ==> add
+
     smpmap: (R -> S, P) -> B
 
     smpmap(fn, p) ==
@@ -41702,10 +57270,15 @@ FunctionSpaceFunctions2(R, A, S, B): Exports == Implementation where
 
     if R has IntegralDomain then
       if S has IntegralDomain then
+
         map(f, x) == smpmap(f, numer x) / smpmap(f, denom x)
+
       else
+
         map(f, x) == smpmap(f, numer x) * (recip(smpmap(f, denom x))::B)
+
     else
+
       map(f, x) == smpmap(f, numer x)
 
 \end{chunk}
@@ -41713,6 +57286,27 @@ FunctionSpaceFunctions2(R, A, S, B): Exports == Implementation where
 \begin{chunk}{COQ FS2}
 (* package FS2 *)
 (*
+
+    smpmap: (R -> S, P) -> B
+
+    smpmap(fn, p) ==
+      map(x+->map(z+->map(fn, z),x)$ExpressionSpaceFunctions2(A,B),
+          y+->fn(y)::B,p)_
+           $PolynomialCategoryLifting(IndexedExponents K, K, R, P, B)
+
+    if R has IntegralDomain then
+      if S has IntegralDomain then
+
+        map(f, x) == smpmap(f, numer x) / smpmap(f, denom x)
+
+      else
+
+        map(f, x) == smpmap(f, numer x) * (recip(smpmap(f, denom x))::B)
+
+    else
+
+      map(f, x) == smpmap(f, numer x)
+
 *)
 
 \end{chunk}
@@ -41799,6 +57393,7 @@ FunctionSpaceIntegration(R, F): Exports == Implementation where
         ++ where x is viewed as a real variable.
  
   Implementation ==> add
+
     import IntegrationTools(R, F)
     import ElementaryIntegration(R, F)
     import ElementaryIntegration(G, FG)
@@ -41826,6 +57421,7 @@ FunctionSpaceIntegration(R, F): Exports == Implementation where
     optemp:BasicOperator := operator(TANTEMP, 1)
  
     K2KG k     == retract(tan F2FG first argument k)@Kernel(FG)
+
     tan2temp k == kernel(optemp, argument k, height k)$K
  
     trans? f ==
@@ -41844,7 +57440,7 @@ FunctionSpaceIntegration(R, F): Exports == Implementation where
       empty? rest(l := [mkPrimh(f, x, h, comp) for f in expand i]) => first l
       l
  
--- replace tan(a/2)**2 by (1-cos a)/(1+cos a) if tan(a/2) is in ltan
+    -- replace tan(a/2)**2 by (1-cos a)/(1+cos a) if tan(a/2) is in ltan
     halfangle a ==
       a := 2 * a
       (1 - cos a) / (1 + cos a)
@@ -41853,7 +57449,7 @@ FunctionSpaceIntegration(R, F): Exports == Implementation where
       a := 2 * first argument k
       sin(a) / (1 + cos a)
  
--- ltan = list of tangents in the integrand after real normalization
+    -- ltan = list of tangents in the integrand after real normalization
     postSubst(f, lv, lk, comp, ltan, x) ==
       for v in lv for k in lk repeat
         if ((u := retractIfCan(v)@Union(K, "failed")) case K) then
@@ -41867,9 +57463,10 @@ FunctionSpaceIntegration(R, F): Exports == Implementation where
         f := eval(f, ltemp, [Khalf k for k in ltemp])
       removeConstantTerm(f, x)
  
--- can handle a single unnested tangent directly, otherwise go complex for now
--- l is the list of all the kernels containing x
--- ltan is the list of all the tangents in l
+    -- can handle a single unnested tangent directly, otherwise go 
+    -- complex for now
+    -- l is the list of all the kernels containing x
+    -- ltan is the list of all the tangents in l
     goComplex?(rt, l, ltan) ==
       empty? ltan => rt
       not empty? rest rest l
@@ -41902,6 +57499,107 @@ FunctionSpaceIntegration(R, F): Exports == Implementation where
 \begin{chunk}{COQ FSINT}
 (* package FSINT *)
 (*
+
+    import IntegrationTools(R, F)
+    import ElementaryIntegration(R, F)
+    import ElementaryIntegration(G, FG)
+    import AlgebraicManipulations(R, F)
+    import TrigonometricManipulations(R, F)
+    import IntegrationResultToFunction(R, F)
+    import TranscendentalManipulations(R, F)
+    import IntegrationResultFunctions2(FG, F)
+    import FunctionSpaceComplexIntegration(R, F)
+    import ElementaryFunctionStructurePackage(R, F)
+    import InnerTrigonometricManipulations(R, F, FG)
+    import PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                      K, R, SparseMultivariatePolynomial(R, K), F)
+ 
+    K2KG      : K -> Kernel FG
+    postSubst : (F, List F, List K, B, List K, SE) -> F
+    rinteg    : (IR, F, SE, B, B) -> Union(F, List F)
+    mkPrimh   : (F, SE, B, B) -> F
+    trans?    : F -> B
+    goComplex?: (B, List K, List K) -> B
+    halfangle : F -> F
+    Khalf     : K -> F
+    tan2temp  : K -> K
+ 
+    optemp:BasicOperator := operator(TANTEMP, 1)
+ 
+    K2KG k     == retract(tan F2FG first argument k)@Kernel(FG)
+
+    tan2temp k == kernel(optemp, argument k, height k)$K
+ 
+    trans? f ==
+      any?(x1+->is?(x1,"log"::SE) or is?(x1,"exp"::SE) or is?(x1,"atan"::SE),
+           operators f)$List(BasicOperator)
+ 
+    mkPrimh(f, x, h, comp) ==
+      f := real f
+      if comp then f := removeSinSq f
+      g := mkPrim(f, x)
+      h and trans? g => htrigs g
+      g
+ 
+    rinteg(i, f, x, h, comp) ==
+      not elem? i => integral(f, x)$F
+      empty? rest(l := [mkPrimh(f, x, h, comp) for f in expand i]) => first l
+      l
+ 
+    -- replace tan(a/2)**2 by (1-cos a)/(1+cos a) if tan(a/2) is in ltan
+    halfangle a ==
+      a := 2 * a
+      (1 - cos a) / (1 + cos a)
+ 
+    Khalf k ==
+      a := 2 * first argument k
+      sin(a) / (1 + cos a)
+ 
+    -- ltan = list of tangents in the integrand after real normalization
+    postSubst(f, lv, lk, comp, ltan, x) ==
+      for v in lv for k in lk repeat
+        if ((u := retractIfCan(v)@Union(K, "failed")) case K) then
+           if has?(operator(kk := u::K), ALGOP) then
+             f := univariate(f, kk, minPoly kk) (kk::F)
+           f := eval(f, [u::K], [k::F])
+      if not(comp or empty? ltan) then
+        ltemp := [tan2temp k for k in ltan]
+        f := eval(f, ltan, [k::F for k in ltemp])
+        f := eval(f, TANTEMP, 2, halfangle)
+        f := eval(f, ltemp, [Khalf k for k in ltemp])
+      removeConstantTerm(f, x)
+ 
+    -- can handle a single unnested tangent directly, otherwise go 
+    -- complex for now
+    -- l is the list of all the kernels containing x
+    -- ltan is the list of all the tangents in l
+    goComplex?(rt, l, ltan) ==
+      empty? ltan => rt
+      not empty? rest rest l
+ 
+    integrate(f, x) ==
+      not real? f => complexIntegrate(f, x)
+      f   := distribute(f, x::F)
+      tf  := [k for k in tower f | member?(x,variables(k::F)@List(SE))]$List(K)
+      ltf := select(x1+->is?(operator x1, "tan"::SE), tf)
+      ht  := any?(x1+->has?(operator x1, "htrig"), tf)
+      rec := rischNormalize(realElementary(f, x), x)
+      g   := rootSimp(rec.func)
+      tg  := [k for k in tower g | member?(x, variables(k::F))]$List(K)
+      ltg := select(x1+->is?(operator x1, "tan"::SE), tg)
+      rtg := any?(x1+->has?(operator x1, "rtrig"), tg)
+      el  := any?(x1+->has?(operator x1, "elem"), tg)
+      i:IR
+      if (comp := goComplex?(rtg, tg, ltg)) then
+        i := map(FG2F, lfintegrate(trigs2explogs(F2FG g,
+                       [K2KG k for k in tf | is?(k, "tan"::SE) or
+                            is?(k, "cot"::SE)], [x]), x))
+      else i := lfintegrate(g, x)
+      ltg := setDifference(ltg, ltf)   -- tan's added by normalization
+      (u := rinteg(i, f, x, el and ht, comp)) case F =>
+        postSubst(u::F, rec.vals, rec.kers, comp, ltg, x)
+      [postSubst(h, rec.vals, rec.kers, comp, ltg, x) for h in u::List(F)]
+
 *)
 
 \end{chunk}
@@ -41993,6 +57691,7 @@ FunctionSpacePrimitiveElement(R, F): Exports == Implementation where
         ++ This operations uses \spadfun{resultant}.
 
   Implementation ==> add
+
     import PrimitiveElement(F)
     import AlgebraicManipulations(R, F)
     import PolynomialCategoryLifting(IndexedExponents K,
@@ -42057,7 +57756,6 @@ FunctionSpacePrimitiveElement(R, F): Exports == Implementation where
         [w, monomial(ic1, 1)$UP - rec.coef2 * ic1 * q, q, rec.prim]
 
       getpoly(r, g) ==
---        one? degree r =>
         (degree r = 1) =>
           k := retract(g)@K
           univariate(-coefficient(r,0)/leadingCoefficient r,k,minPoly k)
@@ -42068,6 +57766,76 @@ FunctionSpacePrimitiveElement(R, F): Exports == Implementation where
 \begin{chunk}{COQ FSPRMELT}
 (* package FSPRMELT *)
 (*
+
+    import PrimitiveElement(F)
+    import AlgebraicManipulations(R, F)
+    import PolynomialCategoryLifting(IndexedExponents K,
+                            K, R, SparseMultivariatePolynomial(R, K), P)
+
+    F2P: (F, List SY) -> P
+    K2P: (K, List SY) -> P
+
+    F2P(f, l) == 
+     inv(denom(f)::F)*map((k1:K):P+->K2P(k1,l),(r1:R):P+->r1::F::P, numer f)
+
+    K2P(k, l) ==
+      ((v := symbolIfCan k) case SY) and member?(v::SY, l) => v::SY::P
+      k::F::P
+
+    primitiveElement l ==
+      u    := string(uu := new()$SY)
+      vars := [concat(u, string i)::SY for i in 1..#l]
+      vv   := [kernel(v)$K :: F for v in vars]
+      kers := [retract(a)@K for a in l]
+      pols := [F2P(subst(ratDenom((minPoly k) v, kers), kers, vv), vars)
+                                              for k in kers for v in vv]
+      rec := primitiveElement(pols, vars, uu)
+      [+/[c * a for c in rec.coef for a in l], rec.poly, rec.prim]
+
+    if F has AlgebraicallyClosedField then
+      import PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                            K, R, SparseMultivariatePolynomial(R, K), F)
+
+      F2UP: (UP, K, UP) -> UP
+      getpoly: (UP, F) -> UP
+
+      F2UP(p, k, q) ==
+        ans:UP := 0
+        while not zero? p repeat
+          f   := univariate(leadingCoefficient p, k)
+          ans := ans + ((numer f) q)
+                       * monomial(inv(retract(denom f)@F), degree p)
+          p   := reductum p
+        ans
+
+      primitiveElement(a1, a2) ==
+        a   := (aa := new()$SY)::F
+        b   := (bb := new()$SY)::F
+        l   := [aa, bb]$List(SY)
+        p1  := minPoly(k1 := retract(a1)@K)
+        p2  := map((z1:F):F+->subst(ratDenom(z1, [k1]), [k1], [a]),
+                                                 minPoly(retract(a2)@K))
+        rec := primitiveElement(F2P(p1 a, l), aa, F2P(p2 b, l), bb)
+        w   := rec.coef1 * a1 + rec.coef2 * a2
+        g   := rootOf(rec.prim)
+        zero?(rec.coef1) =>
+          c2g := inv(rec.coef2 :: F) * g
+          r := gcd(p1, univariate(p2 c2g, retract(a)@K, p1))
+          q := getpoly(r, g)
+          [w, q, rec.coef2 * monomial(1, 1)$UP, rec.prim]
+        ic1 := inv(rec.coef1 :: F)
+        gg  := (ic1 * g)::UP - monomial(rec.coef2 * ic1, 1)$UP
+        kg  := retract(g)@K
+        r   := gcd(p1 gg, F2UP(p2, retract(a)@K, gg))
+        q   := getpoly(r, g)
+        [w, monomial(ic1, 1)$UP - rec.coef2 * ic1 * q, q, rec.prim]
+
+      getpoly(r, g) ==
+        (degree r = 1) =>
+          k := retract(g)@K
+          univariate(-coefficient(r,0)/leadingCoefficient r,k,minPoly k)
+        error "GCD not of degree 1"
+
 *)
 
 \end{chunk}
@@ -42158,6 +57926,7 @@ FunctionSpaceReduce(R, F): Exports == Implementation where
       ++ newReduc() \undocumented
 
   Implementation ==> add
+
     import SparseUnivariatePolynomialFunctions2(F, Q)
     import PolynomialCategoryQuotientFunctions(IndexedExponents K,
                          K, R, SparseMultivariatePolynomial(R, K), F)
@@ -42191,6 +57960,35 @@ FunctionSpaceReduce(R, F): Exports == Implementation where
 \begin{chunk}{COQ FSRED}
 (* package FSRED *)
 (*
+
+    import SparseUnivariatePolynomialFunctions2(F, Q)
+    import PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                         K, R, SparseMultivariatePolynomial(R, K), F)
+
+    K2Z : K -> F
+
+    redmap := table()$AssociationList(K, Z)
+
+    newReduc() ==
+      for k in keys redmap repeat remove_!(k, redmap)
+      void
+
+    bringDown(f, k) ==
+      ff := univariate(f, k)
+      (bc := extendedEuclidean(map(bringDown, denom ff),
+                m := map(bringDown, minPoly k), 1)) case "failed" =>
+                     error "denominator is 0"
+      (map(bringDown, numer ff) * bc.coef1) rem m
+
+    bringDown f ==
+      retract(eval(f, lk := kernels f, [K2Z k for k in lk]))@Q
+
+    K2Z k ==
+      has?(operator k, ALGOP) => error "Cannot reduce constant field"
+      (u := search(k, redmap)) case "failed" =>
+                                      setelt(redmap, k, random()$Z)::F
+      u::Z::F
+
 *)
 
 \end{chunk}
@@ -42267,6 +58065,7 @@ FunctionSpaceSum(R, F): Exports == Implementation where
       ++ sum(f(n), n = a..b) returns f(a) + f(a+1) + ... + f(b);
 
   Implementation ==> add
+
     import ElementaryFunctionStructurePackage(R, F)
     import GosperSummationMethod(IndexedExponents K, K, R,
                                  SparseMultivariatePolynomial(R, K), F)
@@ -42304,6 +58103,39 @@ FunctionSpaceSum(R, F): Exports == Implementation where
 \begin{chunk}{COQ SUMFS}
 (* package SUMFS *)
 (*
+
+    import ElementaryFunctionStructurePackage(R, F)
+    import GosperSummationMethod(IndexedExponents K, K, R,
+                                 SparseMultivariatePolynomial(R, K), F)
+
+    innersum: (F, K) -> Union(F, "failed")
+    notRF?  : (F, K) -> Boolean
+    newk    : () -> K
+
+    newk() == kernel(new()$SE)
+
+    sum(x:F, s:SegmentBinding F) ==
+      k := kernel(variable s)@K
+      (u := innersum(x, k)) case "failed" => summation(x, s)
+      eval(u::F, k, 1 + hi segment s) - eval(u::F, k, lo segment s)
+
+    sum(x:F, v:SE) ==
+      (u := innersum(x, kernel(v)@K)) case "failed" => summation(x,v)
+      u::F
+
+    notRF?(f, k) ==
+      for kk in tower f repeat
+        member?(k, tower(kk::F)) and (symbolIfCan(kk) case "failed") =>
+          return true
+      false
+
+    innersum(x, k) ==
+      zero? x => 0
+      notRF?(f := normalize(x / (x1 := eval(x, k, k::F - 1))), k) =>
+        "failed"
+      (u := GospersMethod(f, k, newk)) case "failed" => "failed"
+      x1 * eval(u::F, k, k::F - 1)
+
 *)
 
 \end{chunk}
@@ -42557,7 +58389,6 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_
       -- is the function a power with exponent other than 0 or 1?
       (expt := isPower fcn) case "failed" => "failed"
       power := expt :: Record(val:FE,exponent:I)
---      one? power.exponent => "failed"
       (power.exponent = 1) => "failed"
       power
 
@@ -42804,6 +58635,7 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_
     -- functions which are bounded on the reals
 
     contOnReals? fcn == member?(fcn,CONTFCNS)
+
     bddOnReals? fcn  == member?(fcn,BDDFCNS)
 
     opsInvolvingX fcn ==
@@ -42860,8 +58692,11 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_
       stateProblem(string name ker,"unknown kernel")
 
     if FE has abs: FE -> FE then
+
       localAbs fcn == abs fcn
+
     else
+
       localAbs fcn == sqrt(fcn * fcn)
 
     signOfExpression: FE -> FE
@@ -42905,6 +58740,487 @@ FunctionSpaceToExponentialExpansion(R,FE,x,cen):_
 \begin{chunk}{COQ FS2EXPXP}
 (* package FS2EXPXP *)
 (*
+
+    import FS2UPS  -- conversion of functional expressions to Puiseux series
+    import EFUPXS  -- partial transcendental funtions on UPXS
+
+    ratIfCan            : FE -> Union(RN,"failed")
+    stateSeriesProblem  : (S,S) -> Result
+    stateProblem        : (S,S) -> XResult
+    newElem             : FE -> FE
+    smpElem             : SMP -> FE
+    k2Elem              : K -> FE
+    iExprToXXP          : (FE,B) -> XResult
+    listToXXP           : (L FE,B,XXP,(XXP,XXP) -> XXP) -> XResult
+    isNonTrivPower      : FE -> Union(Record(val:FE,exponent:I),"failed")
+    negativePowerOK?    : UPXS -> Boolean
+    powerToXXP          : (FE,I,B) -> XResult
+    carefulNthRootIfCan : (UPXS,NNI,B) -> Result
+    nthRootXXPIfCan     : (XXP,NNI,B) -> XResult
+    nthRootToXXP        : (FE,NNI,B) -> XResult
+    genPowerToXXP       : (L FE,B) -> XResult
+    kernelToXXP         : (K,B) -> XResult
+    genExp              : (UPXS,B) -> Result
+    exponential         : (UPXS,B) -> XResult
+    expToXXP            : (FE,B) -> XResult
+    genLog              : (UPXS,B) -> Result
+    logToXXP            : (FE,B) -> XResult
+    applyIfCan          : (UPXS -> Union(UPXS,"failed"),FE,S,B) -> XResult
+    applyBddIfCan       : (FE,UPXS -> Union(UPXS,"failed"),FE,S,B) -> XResult
+    tranToXXP           : (K,FE,B) -> XResult
+    contOnReals?        : S -> B
+    bddOnReals?         : S -> B
+    opsInvolvingX       : FE -> L BOP
+    opInOpList?         : (SY,L BOP) -> B
+    exponential?        : FE -> B
+    productOfNonZeroes? : FE -> B
+    atancotToXXP        : (FE,FE,B,I) -> XResult
+
+    ZEROCOUNT : RN := 1000/1
+    -- number of zeroes to be removed when taking logs or nth roots
+
+--% retractions
+
+    ratIfCan fcn == retractIfCan(fcn)@Union(RN,"failed")
+
+--% 'problems' with conversion
+
+    stateSeriesProblem(function,problem) ==
+      -- records the problem which occured in converting an expression
+      -- to a power series
+      [[function,problem]]
+
+    stateProblem(function,problem) ==
+      -- records the problem which occured in converting an expression
+      -- to an exponential expansion
+      [[function,problem]]
+
+--% normalizations
+
+    newElem f ==
+      -- rewrites a functional expression; all trig functions are
+      -- expressed in terms of sin and cos; all hyperbolic trig
+      -- functions are expressed in terms of exp; all inverse
+      -- hyperbolic trig functions are expressed in terms of exp
+      -- and log
+      smpElem(numer f) / smpElem(denom f)
+
+    smpElem p == map(k2Elem,(x1:R):FE+->x1::FE,p)$PCL
+
+    k2Elem k ==
+    -- rewrites a kernel; all trig functions are
+    -- expressed in terms of sin and cos; all hyperbolic trig
+    -- functions are expressed in terms of exp
+      null(args := [newElem a for a in argument k]) => k :: FE
+      iez  := inv(ez  := exp(z := first args))
+      sinz := sin z; cosz := cos z
+      is?(k,"tan" :: SY)  => sinz / cosz
+      is?(k,"cot" :: SY)  => cosz / sinz
+      is?(k,"sec" :: SY)  => inv cosz
+      is?(k,"csc" :: SY)  => inv sinz
+      is?(k,"sinh" :: SY) => (ez - iez) / (2 :: FE)
+      is?(k,"cosh" :: SY) => (ez + iez) / (2 :: FE)
+      is?(k,"tanh" :: SY) => (ez - iez) / (ez + iez)
+      is?(k,"coth" :: SY) => (ez + iez) / (ez - iez)
+      is?(k,"sech" :: SY) => 2 * inv(ez + iez)
+      is?(k,"csch" :: SY) => 2 * inv(ez - iez)
+      is?(k,"acosh" :: SY) => log(sqrt(z**2 - 1) + z)
+      is?(k,"atanh" :: SY) => log((z + 1) / (1 - z)) / (2 :: FE)
+      is?(k,"acoth" :: SY) => log((z + 1) / (z - 1)) / (2 :: FE)
+      is?(k,"asech" :: SY) => log((inv z) + sqrt(inv(z**2) - 1))
+      is?(k,"acsch" :: SY) => log((inv z) + sqrt(1 + inv(z**2)))
+      (operator k) args
+
+--% general conversion function
+
+    exprToXXP(fcn,posCheck?) == iExprToXXP(newElem fcn,posCheck?)
+
+    iExprToXXP(fcn,posCheck?) ==
+      -- converts a functional expression to an exponential expansion
+      --!! The following line is commented out so that expressions of
+      --!! the form a**b will be normalized to exp(b * log(a)) even if
+      --!! 'a' and 'b' do not involve the limiting variable 'x'.
+      --!!                         - cjw 1 Dec 94
+      --not member?(x,variables fcn) => [monomial(fcn,0)$UPXS :: XXP]
+      (poly := retractIfCan(fcn)@Union(POL,"failed")) case POL =>
+        [exprToUPS(fcn,false,"real:two sides").%series :: XXP]
+      (sum := isPlus fcn) case L(FE) =>
+        listToXXP(sum::L(FE),posCheck?,0,(y1:XXP,y2:XXP):XXP +-> y1+y2)
+      (prod := isTimes fcn) case L(FE) =>
+        listToXXP(prod :: L(FE),posCheck?,1,(y1:XXP,y2:XXP):XXP +-> y1*y2)
+      (expt := isNonTrivPower fcn) case Record(val:FE,exponent:I) =>
+        power := expt :: Record(val:FE,exponent:I)
+        powerToXXP(power.val,power.exponent,posCheck?)
+      (ker := retractIfCan(fcn)@Union(K,"failed")) case K =>
+        kernelToXXP(ker :: K,posCheck?)
+      error "exprToXXP: neither a sum, product, power, nor kernel"
+
+--% sums and products
+
+    listToXXP(list,posCheck?,ans,op) ==
+      -- converts each element of a list of expressions to an exponential
+      -- expansion and returns the sum of these expansions, when 'op' is +
+      -- and 'ans' is 0, or the product of these expansions, when 'op' is *
+      -- and 'ans' is 1
+      while not null list repeat
+        (term := iExprToXXP(first list,posCheck?)) case %problem =>
+          return term
+        ans := op(ans,term.%expansion)
+        list := rest list
+      [ans]
+
+--% nth roots and integral powers
+
+    isNonTrivPower fcn ==
+      -- is the function a power with exponent other than 0 or 1?
+      (expt := isPower fcn) case "failed" => "failed"
+      power := expt :: Record(val:FE,exponent:I)
+      (power.exponent = 1) => "failed"
+      power
+
+    negativePowerOK? upxs ==
+      -- checks the lower order coefficient of a Puiseux series;
+      -- the coefficient may be inverted only if
+      -- (a) the only function involving x is 'log', or
+      -- (b) the lowest order coefficient is a product of exponentials
+      --     and functions not involving x
+      deg := degree upxs
+      if (coef := coefficient(upxs,deg)) = 0 then
+        deg := order(upxs,deg + ZEROCOUNT :: Expon)
+        (coef := coefficient(upxs,deg)) = 0 =>
+          error "inverse of series with many leading zero coefficients"
+      xOpList := opsInvolvingX coef
+      -- only function involving x is 'log'
+      (null xOpList) => true
+      (null rest xOpList and is?(first xOpList,"log" :: SY)) => true
+      -- lowest order coefficient is a product of exponentials and
+      -- functions not involving x
+      productOfNonZeroes? coef => true
+      false
+
+    powerToXXP(fcn,n,posCheck?) ==
+      -- converts an integral power to an exponential expansion
+      (b := iExprToXXP(fcn,posCheck?)) case %problem => b
+      xxp := b.%expansion
+      n > 0 => [xxp ** n]
+      -- a Puiseux series will be reciprocated only if n < 0 and
+      -- numerator of 'xxp' has exactly one monomial
+      numberOfMonomials(num := numer xxp) > 1 => [xxp ** n]
+      negativePowerOK? leadingCoefficient num =>
+        (rec := recip num) case "failed" => error "FS2EXPXP: can't happen"
+        nn := (-n) :: NNI
+        [(((denom xxp) ** nn) * ((rec :: UPXSSING) ** nn)) :: XXP]
+      --!! we may want to create a fraction instead of trying to
+      --!! reciprocate the numerator
+      stateProblem("inv","lowest order coefficient involves x")
+
+    carefulNthRootIfCan(ups,n,posCheck?) ==
+      -- similar to 'nthRootIfCan', but it is fussy about the series
+      -- it takes as an argument.  If 'n' is EVEN and 'posCheck?'
+      -- is truem then the leading coefficient of the series must
+      -- be POSITIVE.  In this case, if 'rightOnly?' is false, the
+      -- order of the series must be zero.  The idea is that the
+      -- series represents a real function of a real variable, and
+      -- we want a unique real nth root defined on a neighborhood
+      -- of zero.
+      n < 1 => error "nthRoot: n must be positive"
+      deg := degree ups
+      if (coef := coefficient(ups,deg)) = 0 then
+        deg := order(ups,deg + ZEROCOUNT :: Expon)
+        (coef := coefficient(ups,deg)) = 0 =>
+          error "log of series with many leading zero coefficients"
+      -- if 'posCheck?' is true, we do not allow nth roots of negative
+      -- numbers when n in even
+      if even?(n :: I) then
+        if posCheck? and ((signum := sign(coef)$SIGNEF) case I) then
+          (signum :: I) = -1 =>
+            return stateSeriesProblem("nth root","root of negative number")
+      (ans := nthRootIfCan(ups,n)) case "failed" =>
+        stateSeriesProblem("nth root","no nth root")
+      [ans :: UPXS]
+
+    nthRootXXPIfCan(xxp,n,posCheck?) ==
+      num := numer xxp; den := denom xxp
+      not zero?(reductum num) or not zero?(reductum den) =>
+       stateProblem("nth root","several monomials in numerator or denominator")
+      nInv : RN := 1/n
+      newNum :=
+        coef : UPXS :=
+          root := carefulNthRootIfCan(leadingCoefficient num,n,posCheck?)
+          root case %problem => return [root.%problem]
+          root.%series
+        deg := (nInv :: FE) * (degree num)
+        monomial(coef,deg)
+      newDen :=
+        coef : UPXS :=
+          root := carefulNthRootIfCan(leadingCoefficient den,n,posCheck?)
+          root case %problem => return [root.%problem]
+          root.%series
+        deg := (nInv :: FE) * (degree den)
+        monomial(coef,deg)
+      [newNum/newDen]
+
+    nthRootToXXP(arg,n,posCheck?) ==
+      -- converts an nth root to a power series
+      -- this is not used in the limit package, so the series may
+      -- have non-zero order, in which case nth roots may not be unique
+      (result := iExprToXXP(arg,posCheck?)) case %problem => [result.%problem]
+      ans := nthRootXXPIfCan(result.%expansion,n,posCheck?)
+      ans case %problem => [ans.%problem]
+      [ans.%expansion]
+
+--% general powers f(x) ** g(x)
+
+    genPowerToXXP(args,posCheck?) ==
+      -- converts a power f(x) ** g(x) to an exponential expansion
+      (logBase := logToXXP(first args,posCheck?)) case %problem =>
+        logBase
+      (expon := iExprToXXP(second args,posCheck?)) case %problem =>
+        expon
+      xxp := (expon.%expansion) * (logBase.%expansion)
+      (f := retractIfCan(xxp)@Union(UPXS,"failed")) case "failed" =>
+        stateProblem("exp","multiply nested exponential")
+      exponential(f,posCheck?)
+
+--% kernels
+
+    kernelToXXP(ker,posCheck?) ==
+      -- converts a kernel to a power series
+      (sym := symbolIfCan(ker)) case Symbol =>
+        (sym :: Symbol) = x => [monomial(1,1)$UPXS :: XXP]
+        [monomial(ker :: FE,0)$UPXS :: XXP]
+      empty?(args := argument ker) => [monomial(ker :: FE,0)$UPXS :: XXP]
+      empty? rest args =>
+        arg := first args
+        is?(ker,"%paren" :: Symbol) => iExprToXXP(arg,posCheck?)
+        is?(ker,"log" :: Symbol) => logToXXP(arg,posCheck?)
+        is?(ker,"exp" :: Symbol) => expToXXP(arg,posCheck?)
+        tranToXXP(ker,arg,posCheck?)
+      is?(ker,"%power" :: Symbol) => genPowerToXXP(args,posCheck?)
+      is?(ker,"nthRoot" :: Symbol) =>
+        n := retract(second args)@I
+        nthRootToXXP(first args,n :: NNI,posCheck?)
+      stateProblem(string name ker,"unknown kernel")
+
+--% exponentials and logarithms
+
+    genExp(ups,posCheck?) ==
+      -- If the series has order zero and the constant term a0 of the
+      -- series involves x, the function tries to expand exp(a0) as
+      -- a power series.
+      (deg := order(ups,1)) < 0 =>
+        -- this "can't happen"
+        error "exp of function with sigularity"
+      deg > 0 => [exp(ups)]
+      lc := coefficient(ups,0); varOpList := opsInvolvingX lc
+      not opInOpList?("log" :: Symbol,varOpList) => [exp(ups)]
+      -- try to fix exp(lc) if necessary
+      expCoef := normalize(exp lc,x)$ElementaryFunctionStructurePackage(R,FE)
+      result := exprToGenUPS(expCoef,posCheck?,"real:right side")$FS2UPS
+      --!! will deal with problems in limitPlus in EXPEXPAN
+      --result case %problem => result
+      result case %problem => [exp(ups)]
+      [(result.%series) * exp(ups - monomial(lc,0))]
+
+    exponential(f,posCheck?) ==
+      singPart := truncate(f,0) - (coefficient(f,0) :: UPXS)
+      taylorPart := f - singPart
+      expon := exponential(singPart)$EXPUPXS
+      (coef := genExp(taylorPart,posCheck?)) case %problem => [coef.%problem]
+      [monomial(coef.%series,expon)$UPXSSING :: XXP]
+
+    expToXXP(arg,posCheck?) ==
+      (result := iExprToXXP(arg,posCheck?)) case %problem => result
+      xxp := result.%expansion
+      (f := retractIfCan(xxp)@Union(UPXS,"failed")) case "failed" =>
+        stateProblem("exp","multiply nested exponential")
+      exponential(f,posCheck?)
+
+    genLog(ups,posCheck?) ==
+      deg := degree ups
+      if (coef := coefficient(ups,deg)) = 0 then
+        deg := order(ups,deg + ZEROCOUNT)
+        (coef := coefficient(ups,deg)) = 0 =>
+          error "log of series with many leading zero coefficients"
+      -- if 'posCheck?' is true, we do not allow logs of negative numbers
+      if posCheck? then
+        if ((signum := sign(coef)$SIGNEF) case I) then
+          (signum :: I) = -1 =>
+            return stateSeriesProblem("log","negative leading coefficient")
+      lt := monomial(coef,deg)$UPXS
+      -- check to see if lowest order coefficient is a negative rational
+      negRat? : Boolean :=
+        ((rat := ratIfCan coef) case RN) =>
+          (rat :: RN) < 0 => true
+          false
+        false
+      logTerm : FE :=
+        mon : FE := (x :: FE) - (cen :: FE)
+        pow : FE := mon ** (deg :: FE)
+        negRat? => log(coef * pow)
+        term1 : FE := (deg :: FE) * log(mon)
+        log(coef) + term1
+      [monomial(logTerm,0)$UPXS + log(ups/lt)]
+
+    logToXXP(arg,posCheck?) ==
+      (result := iExprToXXP(arg,posCheck?)) case %problem => result
+      xxp := result.%expansion
+      num := numer xxp; den := denom xxp
+      not zero?(reductum num) or not zero?(reductum den) =>
+        stateProblem("log","several monomials in numerator or denominator")
+      numCoefLog : UPXS :=
+        (res := genLog(leadingCoefficient num,posCheck?)) case %problem =>
+          return [res.%problem]
+        res.%series
+      denCoefLog : UPXS :=
+        (res := genLog(leadingCoefficient den,posCheck?)) case %problem =>
+          return [res.%problem]
+        res.%series
+      numLog := (exponent degree num) + numCoefLog
+      denLog := (exponent degree den) + denCoefLog  --?? num?
+      [(numLog - denLog) :: XXP]
+
+--% other transcendental functions
+
+    applyIfCan(fcn,arg,fcnName,posCheck?) ==
+      -- converts fcn(arg) to an exponential expansion
+      (xxpArg := iExprToXXP(arg,posCheck?)) case %problem => xxpArg
+      xxp := xxpArg.%expansion
+      (f := retractIfCan(xxp)@Union(UPXS,"failed")) case "failed" =>
+        stateProblem(fcnName,"multiply nested exponential")
+      upxs := f :: UPXS
+      (deg := order(upxs,1)) < 0 =>
+        stateProblem(fcnName,"essential singularity")
+      deg > 0 => [fcn(upxs) :: UPXS :: XXP]
+      lc := coefficient(upxs,0); xOpList := opsInvolvingX lc
+      null xOpList => [fcn(upxs) :: UPXS :: XXP]
+      opInOpList?("log" :: SY,xOpList) =>
+        stateProblem(fcnName,"logs in constant coefficient")
+      contOnReals? fcnName => [fcn(upxs) :: UPXS :: XXP]
+      stateProblem(fcnName,"x in constant coefficient")
+
+    applyBddIfCan(fe,fcn,arg,fcnName,posCheck?) ==
+      -- converts fcn(arg) to a generalized power series, where the
+      -- function fcn is bounded for real values
+      -- if fcn(arg) has an essential singularity as a complex
+      -- function, we return fcn(arg) as a monomial of degree 0
+      (xxpArg := iExprToXXP(arg,posCheck?)) case %problem =>
+        trouble := xxpArg.%problem
+        trouble.prob = "essential singularity" => [monomial(fe,0)$UPXS :: XXP]
+        xxpArg
+      xxp := xxpArg.%expansion
+      (f := retractIfCan(xxp)@Union(UPXS,"failed")) case "failed" =>
+        stateProblem("exp","multiply nested exponential")
+      (ans := fcn(f :: UPXS)) case "failed" => [monomial(fe,0)$UPXS :: XXP]
+      [ans :: UPXS :: XXP]
+
+    CONTFCNS : L S := ["sin","cos","atan","acot","exp","asinh"]
+    -- functions which are defined and continuous at all real numbers
+
+    BDDFCNS : L S := ["sin","cos","atan","acot"]
+    -- functions which are bounded on the reals
+
+    contOnReals? fcn == member?(fcn,CONTFCNS)
+
+    bddOnReals? fcn  == member?(fcn,BDDFCNS)
+
+    opsInvolvingX fcn ==
+      opList := [op for k in tower fcn | unary?(op := operator k) _
+                 and member?(x,variables first argument k)]
+      removeDuplicates opList
+
+    opInOpList?(name,opList) ==
+      for op in opList repeat
+        is?(op,name) => return true
+      false
+
+    exponential? fcn ==
+      -- is 'fcn' of the form exp(f)?
+      (ker := retractIfCan(fcn)@Union(K,"failed")) case K =>
+        is?(ker :: K,"exp" :: Symbol)
+      false
+
+    productOfNonZeroes? fcn ==
+      -- is 'fcn' a product of non-zero terms, where 'non-zero'
+      -- means an exponential or a function not involving x
+      exponential? fcn => true
+      (prod := isTimes fcn) case "failed" => false
+      for term in (prod :: L(FE)) repeat
+        (not exponential? term) and member?(x,variables term) =>
+          return false
+      true
+
+    tranToXXP(ker,arg,posCheck?) ==
+      -- converts op(arg) to a power series for certain functions
+      -- op in trig or hyperbolic trig categories
+      -- N.B. when this function is called, 'k2elem' will have been
+      -- applied, so the following functions cannot appear:
+      -- tan, cot, sec, csc, sinh, cosh, tanh, coth, sech, csch
+      -- acosh, atanh, acoth, asech, acsch
+      is?(ker,"sin" :: SY) =>
+        applyBddIfCan(ker :: FE,sinIfCan,arg,"sin",posCheck?)
+      is?(ker,"cos" :: SY) =>
+        applyBddIfCan(ker :: FE,cosIfCan,arg,"cos",posCheck?)
+      is?(ker,"asin" :: SY) =>
+        applyIfCan(asinIfCan,arg,"asin",posCheck?)
+      is?(ker,"acos" :: SY) =>
+        applyIfCan(acosIfCan,arg,"acos",posCheck?)
+      is?(ker,"atan" :: SY) =>
+        atancotToXXP(ker :: FE,arg,posCheck?,1)
+      is?(ker,"acot" :: SY) =>
+        atancotToXXP(ker :: FE,arg,posCheck?,-1)
+      is?(ker,"asec" :: SY) =>
+        applyIfCan(asecIfCan,arg,"asec",posCheck?)
+      is?(ker,"acsc" :: SY) =>
+        applyIfCan(acscIfCan,arg,"acsc",posCheck?)
+      is?(ker,"asinh" :: SY) =>
+        applyIfCan(asinhIfCan,arg,"asinh",posCheck?)
+      stateProblem(string name ker,"unknown kernel")
+
+    if FE has abs: FE -> FE then
+
+      localAbs fcn == abs fcn
+
+    else
+
+      localAbs fcn == sqrt(fcn * fcn)
+
+    signOfExpression: FE -> FE
+    signOfExpression arg == localAbs(arg)/arg
+
+    atancotToXXP(fe,arg,posCheck?,plusMinus) ==
+      -- converts atan(f(x)) to a generalized power series
+      atanFlag : String := "real: right side"; posCheck? : Boolean := true
+      (result := exprToGenUPS(arg,posCheck?,atanFlag)$FS2UPS) case %problem =>
+        trouble := result.%problem
+        trouble.prob = "essential singularity" => [monomial(fe,0)$UPXS :: XXP]
+        [result.%problem]
+      ups := result.%series; coef := coefficient(ups,0)
+      -- series involves complex numbers
+      (ord := order(ups,0)) = 0 and coef * coef = -1 =>
+        y := differentiate(ups)/(1 + ups*ups)
+        yCoef := coefficient(y,-1)
+        [(monomial(log yCoef,0)+integrate(y - monomial(yCoef,-1)$UPXS)) :: XXP]
+      cc : FE :=
+        ord < 0 =>
+          (rn := ratIfCan(ord :: FE)) case "failed" =>
+            -- this condition usually won't occur because exponents will
+            -- be integers or rational numbers
+            return stateProblem("atan","branch problem")
+          lc := coefficient(ups,ord)
+          (signum := sign(lc)$SIGNEF) case "failed" =>
+            -- can't determine sign
+            posNegPi2 := signOfExpression(lc) * pi()/(2 :: FE)
+            plusMinus = 1 => posNegPi2
+            pi()/(2 :: FE) - posNegPi2
+          (n := signum :: Integer) = -1 =>
+            plusMinus = 1 => -pi()/(2 :: FE)
+            pi()
+          plusMinus = 1 => pi()/(2 :: FE)
+          0
+        atan coef
+      [((cc :: UPXS) + integrate(differentiate(ups)/(1 + ups*ups))) :: XXP]
+
 *)
 
 \end{chunk}
@@ -43230,7 +59546,6 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_
       -- is the function a power with exponent other than 0 or 1?
       (expt := isPower fcn) case "failed" => "failed"
       power := expt :: Record(val:FE,exponent:I)
---      one? power.exponent => "failed"
       (power.exponent = 1) => "failed"
       power
 
@@ -43294,8 +59609,11 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_
       [logIfCan(ups) :: UPS]
 
     if FE has abs: FE -> FE then
+
       localAbs fcn == abs fcn
+
     else
+
       localAbs fcn == sqrt(fcn * fcn)
 
     signOfExpression: FE -> FE
@@ -43445,6 +59763,7 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_
     -- functions which are bounded on the reals
 
     contOnReals? fcn == member?(fcn,CONTFCNS)
+
     bddOnReals? fcn  == member?(fcn,BDDFCNS)
 
     exprToGenUPS(fcn,posCheck?,atanFlag) ==
@@ -43733,6 +60052,636 @@ FunctionSpaceToUnivariatePowerSeries(R,FE,Expon,UPS,TRAN,x):_
 \begin{chunk}{COQ FS2UPS}
 (* package FS2UPS *)
 (*
+
+    ratIfCan            : FE -> Union(RN,"failed")
+    carefulNthRootIfCan : (UPS,NNI,B,B) -> Result
+    stateProblem        : (S,S) -> Result
+    polyToUPS           : SUP -> UPS
+    listToUPS           : (L FE,(FE,B,S) -> Result,B,S,UPS,(UPS,UPS) -> UPS)_
+                                            -> Result
+    isNonTrivPower      : FE -> Union(Record(val:FE,exponent:I),"failed")
+    powerToUPS          : (FE,I,B,S) -> Result
+    kernelToUPS         : (K,B,S) -> Result
+    nthRootToUPS        : (FE,NNI,B,S) -> Result
+    logToUPS            : (FE,B,S) -> Result
+    atancotToUPS        : (FE,B,S,I) -> Result
+    applyIfCan          : (UPS -> Union(UPS,"failed"),FE,S,B,S) -> Result
+    tranToUPS           : (K,FE,B,S) -> Result
+    powToUPS            : (L FE,B,S) -> Result
+    newElem             : FE -> FE
+    smpElem             : SMP -> FE
+    k2Elem              : K -> FE
+    contOnReals?        : S -> B
+    bddOnReals?         : S -> B
+    iExprToGenUPS       : (FE,B,S) -> Result
+    opsInvolvingX       : FE -> L BOP
+    opInOpList?         : (SY,L BOP) -> B
+    exponential?        : FE -> B
+    productOfNonZeroes? : FE -> B
+    powerToGenUPS       : (FE,I,B,S) -> Result
+    kernelToGenUPS      : (K,B,S) -> Result
+    nthRootToGenUPS     : (FE,NNI,B,S) -> Result
+    logToGenUPS         : (FE,B,S) -> Result
+    expToGenUPS         : (FE,B,S) -> Result
+    expGenUPS           : (UPS,B,S) -> Result
+    atancotToGenUPS     : (FE,FE,B,S,I) -> Result
+    genUPSApplyIfCan    : (UPS -> Union(UPS,"failed"),FE,S,B,S) -> Result
+    applyBddIfCan       : (FE,UPS -> Union(UPS,"failed"),FE,S,B,S) -> Result
+    tranToGenUPS        : (K,FE,B,S) -> Result
+    powToGenUPS         : (L FE,B,S) -> Result
+
+    ZEROCOUNT : I := 1000
+    -- number of zeroes to be removed when taking logs or nth roots
+
+    ratIfCan fcn == retractIfCan(fcn)@Union(RN,"failed")
+
+    carefulNthRootIfCan(ups,n,posCheck?,rightOnly?) ==
+      -- similar to 'nthRootIfCan', but it is fussy about the series
+      -- it takes as an argument.  If 'n' is EVEN and 'posCheck?'
+      -- is truem then the leading coefficient of the series must
+      -- be POSITIVE.  In this case, if 'rightOnly?' is false, the
+      -- order of the series must be zero.  The idea is that the
+      -- series represents a real function of a real variable, and
+      -- we want a unique real nth root defined on a neighborhood
+      -- of zero.
+      n < 1 => error "nthRoot: n must be positive"
+      deg := degree ups
+      if (coef := coefficient(ups,deg)) = 0 then
+        deg := order(ups,deg + ZEROCOUNT :: Expon)
+        (coef := coefficient(ups,deg)) = 0 =>
+          error "log of series with many leading zero coefficients"
+      -- if 'posCheck?' is true, we do not allow nth roots of negative
+      -- numbers when n in even
+      if even?(n :: I) then
+        if posCheck? and ((signum := sign(coef)$SIGNEF) case I) then
+          (signum :: I) = -1 =>
+            return stateProblem("nth root","negative leading coefficient")
+          not rightOnly? and not zero? deg => -- nth root not unique
+            return stateProblem("nth root","series of non-zero order")
+      (ans := nthRootIfCan(ups,n)) case "failed" =>
+        stateProblem("nth root","no nth root")
+      [ans :: UPS]
+
+    stateProblem(function,problem) ==
+      -- records the problem which occured in converting an expression
+      -- to a power series
+      [[function,problem]]
+
+    exprToUPS(fcn,posCheck?,atanFlag) ==
+      -- converts a functional expression to a power series
+      --!! The following line is commented out so that expressions of
+      --!! the form a**b will be normalized to exp(b * log(a)) even if
+      --!! 'a' and 'b' do not involve the limiting variable 'x'.
+      --!!                         - cjw 1 Dec 94
+      --not member?(x,variables fcn) => [monomial(fcn,0)]
+      (poly := retractIfCan(fcn)@Union(POL,"failed")) case POL =>
+        [polyToUPS univariate(poly :: POL,x)]
+      (sum := isPlus fcn) case L(FE) =>
+        listToUPS(sum :: L(FE),exprToUPS,posCheck?,atanFlag,0,
+           (y1,y2) +-> y1 + y2)
+      (prod := isTimes fcn) case L(FE) =>
+        listToUPS(prod :: L(FE),exprToUPS,posCheck?,atanFlag,1,
+           (y1,y2) +-> y1 * y2)
+      (expt := isNonTrivPower fcn) case Record(val:FE,exponent:I) =>
+        power := expt :: Record(val:FE,exponent:I)
+        powerToUPS(power.val,power.exponent,posCheck?,atanFlag)
+      (ker := retractIfCan(fcn)@Union(K,"failed")) case K =>
+        kernelToUPS(ker :: K,posCheck?,atanFlag)
+      error "exprToUPS: neither a sum, product, power, nor kernel"
+
+    polyToUPS poly ==
+      -- converts a polynomial to a power series
+      zero? poly => 0
+      -- we don't start with 'ans := 0' as this may lead to an
+      -- enormous number of leading zeroes in the power series
+      deg  := degree poly
+      coef := leadingCoefficient(poly) :: FE
+      ans  := monomial(coef,deg :: Expon)$UPS
+      poly := reductum poly
+      while not zero? poly repeat
+        deg  := degree poly
+        coef := leadingCoefficient(poly) :: FE
+        ans  := ans + monomial(coef,deg :: Expon)$UPS
+        poly := reductum poly
+      ans
+
+    listToUPS(list,feToUPS,posCheck?,atanFlag,ans,op) ==
+      -- converts each element of a list of expressions to a power
+      -- series and returns the sum of these series, when 'op' is +
+      -- and 'ans' is 0, or the product of these series, when 'op' is *
+      -- and 'ans' is 1
+      while not null list repeat
+        (term := feToUPS(first list,posCheck?,atanFlag)) case %problem =>
+          return term
+        ans := op(ans,term.%series)
+        list := rest list
+      [ans]
+
+    isNonTrivPower fcn ==
+      -- is the function a power with exponent other than 0 or 1?
+      (expt := isPower fcn) case "failed" => "failed"
+      power := expt :: Record(val:FE,exponent:I)
+      (power.exponent = 1) => "failed"
+      power
+
+    powerToUPS(fcn,n,posCheck?,atanFlag) ==
+      -- converts an integral power to a power series
+      (b := exprToUPS(fcn,posCheck?,atanFlag)) case %problem => b
+      n > 0 => [(b.%series) ** n]
+      -- check lowest order coefficient when n < 0
+      ups := b.%series; deg := degree ups
+      if (coef := coefficient(ups,deg)) = 0 then
+        deg := order(ups,deg + ZEROCOUNT :: Expon)
+        (coef := coefficient(ups,deg)) = 0 =>
+          error "inverse of series with many leading zero coefficients"
+      [ups ** n]
+
+    kernelToUPS(ker,posCheck?,atanFlag) ==
+      -- converts a kernel to a power series
+      (sym := symbolIfCan(ker)) case Symbol =>
+        (sym :: Symbol) = x => [monomial(1,1)]
+        [monomial(ker :: FE,0)]
+      empty?(args := argument ker) => [monomial(ker :: FE,0)]
+      not member?(x, variables(ker :: FE)) => [monomial(ker :: FE,0)]
+      empty? rest args =>
+        arg := first args
+        is?(ker,"abs" :: Symbol) =>
+          nthRootToUPS(arg*arg,2,posCheck?,atanFlag)
+        is?(ker,"%paren" :: Symbol) => exprToUPS(arg,posCheck?,atanFlag)
+        is?(ker,"log" :: Symbol) => logToUPS(arg,posCheck?,atanFlag)
+        is?(ker,"exp" :: Symbol) =>
+          applyIfCan(expIfCan,arg,"exp",posCheck?,atanFlag)
+        tranToUPS(ker,arg,posCheck?,atanFlag)
+      is?(ker,"%power" :: Symbol) => powToUPS(args,posCheck?,atanFlag)
+      is?(ker,"nthRoot" :: Symbol) =>
+        n := retract(second args)@I
+        nthRootToUPS(first args,n :: NNI,posCheck?,atanFlag)
+      stateProblem(string name ker,"unknown kernel")
+
+    nthRootToUPS(arg,n,posCheck?,atanFlag) ==
+      -- converts an nth root to a power series
+      -- this is not used in the limit package, so the series may
+      -- have non-zero order, in which case nth roots may not be unique
+      (result := exprToUPS(arg,posCheck?,atanFlag)) case %problem => result
+      ans := carefulNthRootIfCan(result.%series,n,posCheck?,false)
+      ans case %problem => ans
+      [ans.%series]
+
+    logToUPS(arg,posCheck?,atanFlag) ==
+      -- converts a logarithm log(f(x)) to a power series
+      -- f(x) must have order 0 and if 'posCheck?' is true,
+      -- then f(x) must have a non-negative leading coefficient
+      (result := exprToUPS(arg,posCheck?,atanFlag)) case %problem => result
+      ups := result.%series
+      not zero? order(ups,1) =>
+        stateProblem("log","series of non-zero order")
+      coef := coefficient(ups,0)
+      -- if 'posCheck?' is true, we do not allow logs of negative numbers
+      if posCheck? then
+        if ((signum := sign(coef)$SIGNEF) case I) then
+          (signum :: I) = -1 =>
+            return stateProblem("log","negative leading coefficient")
+      [logIfCan(ups) :: UPS]
+
+    if FE has abs: FE -> FE then
+
+      localAbs fcn == abs fcn
+
+    else
+
+      localAbs fcn == sqrt(fcn * fcn)
+
+    signOfExpression: FE -> FE
+    signOfExpression arg == localAbs(arg)/arg
+
+    atancotToUPS(arg,posCheck?,atanFlag,plusMinus) ==
+      -- converts atan(f(x)) to a power series
+      (result := exprToUPS(arg,posCheck?,atanFlag)) case %problem => result
+      ups := result.%series; coef := coefficient(ups,0)
+      (ord := order(ups,0)) = 0 and coef * coef = -1 =>
+        -- series involves complex numbers
+        return stateProblem("atan","logarithmic singularity")
+      cc : FE :=
+        ord < 0 =>
+          atanFlag = "complex" =>
+            return stateProblem("atan","essential singularity")
+          (rn := ratIfCan(ord :: FE)) case "failed" =>
+            -- this condition usually won't occur because exponents will
+            -- be integers or rational numbers
+            return stateProblem("atan","branch problem")
+          if (atanFlag = "real: two sides") and (odd? numer(rn :: RN)) then
+            -- expansions to the left and right of zero have different
+            -- constant coefficients
+            return stateProblem("atan","branch problem")
+          lc := coefficient(ups,ord)
+          (signum := sign(lc)$SIGNEF) case "failed" =>
+            -- can't determine sign
+            atanFlag = "just do it" =>
+              plusMinus = 1 => pi()/(2 :: FE)
+              0
+            posNegPi2 := signOfExpression(lc) * pi()/(2 :: FE)
+            plusMinus = 1 => posNegPi2
+            pi()/(2 :: FE) - posNegPi2
+            --return stateProblem("atan","branch problem")
+          left? : B := atanFlag = "real: left side"; n := signum :: Integer
+          (left? and n = 1) or (not left? and n = -1) =>
+            plusMinus = 1 => -pi()/(2 :: FE)
+            pi()
+          plusMinus = 1 => pi()/(2 :: FE)
+          0
+        atan coef
+      [(cc :: UPS) + integrate(plusMinus * differentiate(ups)/(1 + ups*ups))]
+
+    applyIfCan(fcn,arg,fcnName,posCheck?,atanFlag) ==
+      -- converts fcn(arg) to a power series
+      (ups := exprToUPS(arg,posCheck?,atanFlag)) case %problem => ups
+      ans := fcn(ups.%series)
+      ans case "failed" => stateProblem(fcnName,"essential singularity")
+      [ans :: UPS]
+
+    tranToUPS(ker,arg,posCheck?,atanFlag) ==
+      -- converts ker to a power series for certain functions
+      -- in trig or hyperbolic trig categories
+      is?(ker,"sin" :: SY) =>
+        applyIfCan(sinIfCan,arg,"sin",posCheck?,atanFlag)
+      is?(ker,"cos" :: SY) =>
+        applyIfCan(cosIfCan,arg,"cos",posCheck?,atanFlag)
+      is?(ker,"tan" :: SY) =>
+        applyIfCan(tanIfCan,arg,"tan",posCheck?,atanFlag)
+      is?(ker,"cot" :: SY) =>
+        applyIfCan(cotIfCan,arg,"cot",posCheck?,atanFlag)
+      is?(ker,"sec" :: SY) =>
+        applyIfCan(secIfCan,arg,"sec",posCheck?,atanFlag)
+      is?(ker,"csc" :: SY) =>
+        applyIfCan(cscIfCan,arg,"csc",posCheck?,atanFlag)
+      is?(ker,"asin" :: SY) =>
+        applyIfCan(asinIfCan,arg,"asin",posCheck?,atanFlag)
+      is?(ker,"acos" :: SY) =>
+        applyIfCan(acosIfCan,arg,"acos",posCheck?,atanFlag)
+      is?(ker,"atan" :: SY) => atancotToUPS(arg,posCheck?,atanFlag,1)
+      is?(ker,"acot" :: SY) => atancotToUPS(arg,posCheck?,atanFlag,-1)
+      is?(ker,"asec" :: SY) =>
+        applyIfCan(asecIfCan,arg,"asec",posCheck?,atanFlag)
+      is?(ker,"acsc" :: SY) =>
+        applyIfCan(acscIfCan,arg,"acsc",posCheck?,atanFlag)
+      is?(ker,"sinh" :: SY) =>
+        applyIfCan(sinhIfCan,arg,"sinh",posCheck?,atanFlag)
+      is?(ker,"cosh" :: SY) =>
+        applyIfCan(coshIfCan,arg,"cosh",posCheck?,atanFlag)
+      is?(ker,"tanh" :: SY) =>
+        applyIfCan(tanhIfCan,arg,"tanh",posCheck?,atanFlag)
+      is?(ker,"coth" :: SY) =>
+        applyIfCan(cothIfCan,arg,"coth",posCheck?,atanFlag)
+      is?(ker,"sech" :: SY) =>
+        applyIfCan(sechIfCan,arg,"sech",posCheck?,atanFlag)
+      is?(ker,"csch" :: SY) =>
+        applyIfCan(cschIfCan,arg,"csch",posCheck?,atanFlag)
+      is?(ker,"asinh" :: SY) =>
+        applyIfCan(asinhIfCan,arg,"asinh",posCheck?,atanFlag)
+      is?(ker,"acosh" :: SY) =>
+        applyIfCan(acoshIfCan,arg,"acosh",posCheck?,atanFlag)
+      is?(ker,"atanh" :: SY) =>
+        applyIfCan(atanhIfCan,arg,"atanh",posCheck?,atanFlag)
+      is?(ker,"acoth" :: SY) =>
+        applyIfCan(acothIfCan,arg,"acoth",posCheck?,atanFlag)
+      is?(ker,"asech" :: SY) =>
+        applyIfCan(asechIfCan,arg,"asech",posCheck?,atanFlag)
+      is?(ker,"acsch" :: SY) =>
+        applyIfCan(acschIfCan,arg,"acsch",posCheck?,atanFlag)
+      stateProblem(string name ker,"unknown kernel")
+
+    powToUPS(args,posCheck?,atanFlag) ==
+      -- converts a power f(x) ** g(x) to a power series
+      (logBase := logToUPS(first args,posCheck?,atanFlag)) case %problem =>
+        logBase
+      (expon := exprToUPS(second args,posCheck?,atanFlag)) case %problem =>
+        expon
+      ans := expIfCan((expon.%series) * (logBase.%series))
+      ans case "failed" => stateProblem("exp","essential singularity")
+      [ans :: UPS]
+
+-- Generalized power series: power series in x, where log(x) and
+-- bounded functions of x are allowed to appear in the coefficients
+-- of the series.  Used for evaluating REAL limits at x = 0.
+
+    newElem f ==
+    -- rewrites a functional expression; all trig functions are
+    -- expressed in terms of sin and cos; all hyperbolic trig
+    -- functions are expressed in terms of exp
+      smpElem(numer f) / smpElem(denom f)
+
+    smpElem p == map(k2Elem,(x1:R):FE +-> x1::FE,p)$PCL
+
+    k2Elem k ==
+    -- rewrites a kernel; all trig functions are
+    -- expressed in terms of sin and cos; all hyperbolic trig
+    -- functions are expressed in terms of exp
+      null(args := [newElem a for a in argument k]) => k::FE
+      iez  := inv(ez  := exp(z := first args))
+      sinz := sin z; cosz := cos z
+      is?(k,"tan" :: Symbol)  => sinz / cosz
+      is?(k,"cot" :: Symbol)  => cosz / sinz
+      is?(k,"sec" :: Symbol)  => inv cosz
+      is?(k,"csc" :: Symbol)  => inv sinz
+      is?(k,"sinh" :: Symbol) => (ez - iez) / (2 :: FE)
+      is?(k,"cosh" :: Symbol) => (ez + iez) / (2 :: FE)
+      is?(k,"tanh" :: Symbol) => (ez - iez) / (ez + iez)
+      is?(k,"coth" :: Symbol) => (ez + iez) / (ez - iez)
+      is?(k,"sech" :: Symbol) => 2 * inv(ez + iez)
+      is?(k,"csch" :: Symbol) => 2 * inv(ez - iez)
+      (operator k) args
+
+    CONTFCNS : L S := ["sin","cos","atan","acot","exp","asinh"]
+    -- functions which are defined and continuous at all real numbers
+
+    BDDFCNS : L S := ["sin","cos","atan","acot"]
+    -- functions which are bounded on the reals
+
+    contOnReals? fcn == member?(fcn,CONTFCNS)
+
+    bddOnReals? fcn  == member?(fcn,BDDFCNS)
+
+    exprToGenUPS(fcn,posCheck?,atanFlag) ==
+      -- converts a functional expression to a generalized power
+      -- series; "generalized" means that log(x) and bounded functions
+      -- of x are allowed to appear in the coefficients of the series
+      iExprToGenUPS(newElem fcn,posCheck?,atanFlag)
+
+    iExprToGenUPS(fcn,posCheck?,atanFlag) ==
+      -- converts a functional expression to a generalized power
+      -- series without first normalizing the expression
+      --!! The following line is commented out so that expressions of
+      --!! the form a**b will be normalized to exp(b * log(a)) even if
+      --!! 'a' and 'b' do not involve the limiting variable 'x'.
+      --!!                         - cjw 1 Dec 94
+      --not member?(x,variables fcn) => [monomial(fcn,0)]
+      (poly := retractIfCan(fcn)@Union(POL,"failed")) case POL =>
+        [polyToUPS univariate(poly :: POL,x)]
+      (sum := isPlus fcn) case L(FE) =>
+        listToUPS(sum :: L(FE),iExprToGenUPS,posCheck?,atanFlag,0,
+           (y1,y2) +-> y1 + y2)
+      (prod := isTimes fcn) case L(FE) =>
+        listToUPS(prod :: L(FE),iExprToGenUPS,posCheck?,atanFlag,1,
+           (y1,y2) +-> y1 * y2)
+      (expt := isNonTrivPower fcn) case Record(val:FE,exponent:I) =>
+        power := expt :: Record(val:FE,exponent:I)
+        powerToGenUPS(power.val,power.exponent,posCheck?,atanFlag)
+      (ker := retractIfCan(fcn)@Union(K,"failed")) case K =>
+        kernelToGenUPS(ker :: K,posCheck?,atanFlag)
+      error "exprToGenUPS: neither a sum, product, power, nor kernel"
+
+    opsInvolvingX fcn ==
+      opList := [op for k in tower fcn | unary?(op := operator k) _
+                 and member?(x,variables first argument k)]
+      removeDuplicates opList
+
+    opInOpList?(name,opList) ==
+      for op in opList repeat
+        is?(op,name) => return true
+      false
+
+    exponential? fcn ==
+      -- is 'fcn' of the form exp(f)?
+      (ker := retractIfCan(fcn)@Union(K,"failed")) case K =>
+        is?(ker :: K,"exp" :: Symbol)
+      false
+
+    productOfNonZeroes? fcn ==
+      -- is 'fcn' a product of non-zero terms, where 'non-zero'
+      -- means an exponential or a function not involving x
+      exponential? fcn => true
+      (prod := isTimes fcn) case "failed" => false
+      for term in (prod :: L(FE)) repeat
+        (not exponential? term) and member?(x,variables term) =>
+          return false
+      true
+
+    powerToGenUPS(fcn,n,posCheck?,atanFlag) ==
+      -- converts an integral power to a generalized power series
+      -- if n < 0 and the lowest order coefficient of the series
+      -- involves x, we are careful about inverting this coefficient
+      -- the coefficient is inverted only if
+      -- (a) the only function involving x is 'log', or
+      -- (b) the lowest order coefficient is a product of exponentials
+      --     and functions not involving x
+      (b := exprToGenUPS(fcn,posCheck?,atanFlag)) case %problem => b
+      n > 0 => [(b.%series) ** n]
+      -- check lowest order coefficient when n < 0
+      ups := b.%series; deg := degree ups
+      if (coef := coefficient(ups,deg)) = 0 then
+        deg := order(ups,deg + ZEROCOUNT :: Expon)
+        (coef := coefficient(ups,deg)) = 0 =>
+          error "inverse of series with many leading zero coefficients"
+      xOpList := opsInvolvingX coef
+      -- only function involving x is 'log'
+      (null xOpList) => [ups ** n]
+      (null rest xOpList and is?(first xOpList,"log" :: SY)) =>
+        [ups ** n]
+      -- lowest order coefficient is a product of exponentials and
+      -- functions not involving x
+      productOfNonZeroes? coef => [ups ** n]
+      stateProblem("inv","lowest order coefficient involves x")
+
+    kernelToGenUPS(ker,posCheck?,atanFlag) ==
+      -- converts a kernel to a generalized power series
+      (sym := symbolIfCan(ker)) case Symbol =>
+        (sym :: Symbol) = x => [monomial(1,1)]
+        [monomial(ker :: FE,0)]
+      empty?(args := argument ker) => [monomial(ker :: FE,0)]
+      empty? rest args =>
+        arg := first args
+        is?(ker,"abs" :: Symbol) =>
+          nthRootToGenUPS(arg*arg,2,posCheck?,atanFlag)
+        is?(ker,"%paren" :: Symbol) => iExprToGenUPS(arg,posCheck?,atanFlag)
+        is?(ker,"log" :: Symbol) => logToGenUPS(arg,posCheck?,atanFlag)
+        is?(ker,"exp" :: Symbol) => expToGenUPS(arg,posCheck?,atanFlag)
+        tranToGenUPS(ker,arg,posCheck?,atanFlag)
+      is?(ker,"%power" :: Symbol) => powToGenUPS(args,posCheck?,atanFlag)
+      is?(ker,"nthRoot" :: Symbol) =>
+        n := retract(second args)@I
+        nthRootToGenUPS(first args,n :: NNI,posCheck?,atanFlag)
+      stateProblem(string name ker,"unknown kernel")
+
+    nthRootToGenUPS(arg,n,posCheck?,atanFlag) ==
+      -- convert an nth root to a power series
+      -- used for computing right hand limits, so the series may have
+      -- non-zero order, but may not have a negative leading coefficient
+      -- when n is even
+      (result := iExprToGenUPS(arg,posCheck?,atanFlag)) case %problem =>
+        result
+      ans := carefulNthRootIfCan(result.%series,n,posCheck?,true)
+      ans case %problem => ans
+      [ans.%series]
+
+    logToGenUPS(arg,posCheck?,atanFlag) ==
+      -- converts a logarithm log(f(x)) to a generalized power series
+      (result := iExprToGenUPS(arg,posCheck?,atanFlag)) case %problem =>
+        result
+      ups := result.%series; deg := degree ups
+      if (coef := coefficient(ups,deg)) = 0 then
+        deg := order(ups,deg + ZEROCOUNT :: Expon)
+        (coef := coefficient(ups,deg)) = 0 =>
+          error "log of series with many leading zero coefficients"
+      -- if 'posCheck?' is true, we do not allow logs of negative numbers
+      if posCheck? then
+        if ((signum := sign(coef)$SIGNEF) case I) then
+          (signum :: I) = -1 =>
+            return stateProblem("log","negative leading coefficient")
+      -- create logarithmic term, avoiding log's of negative rationals
+      lt := monomial(coef,deg)$UPS; cen := center lt
+      -- check to see if lowest order coefficient is a negative rational
+      negRat? : Boolean :=
+        ((rat := ratIfCan coef) case RN) =>
+          (rat :: RN) < 0 => true
+          false
+        false
+      logTerm : FE :=
+        mon : FE := (x :: FE) - (cen :: FE)
+        pow : FE := mon ** (deg :: FE)
+        negRat? => log(coef * pow)
+        term1 : FE := (deg :: FE) * log(mon)
+        log(coef) + term1
+      [monomial(logTerm,0) + log(ups/lt)]
+
+    expToGenUPS(arg,posCheck?,atanFlag) ==
+      -- converts an exponential exp(f(x)) to a generalized
+      -- power series
+      (ups := iExprToGenUPS(arg,posCheck?,atanFlag)) case %problem => ups
+      expGenUPS(ups.%series,posCheck?,atanFlag)
+
+    expGenUPS(ups,posCheck?,atanFlag) ==
+      -- computes the exponential of a generalized power series.
+      -- If the series has order zero and the constant term a0 of the
+      -- series involves x, the function tries to expand exp(a0) as
+      -- a power series.
+      (deg := order(ups,1)) < 0 =>
+        stateProblem("exp","essential singularity")
+      deg > 0 => [exp ups]
+      lc := coefficient(ups,0); xOpList := opsInvolvingX lc
+      not opInOpList?("log" :: SY,xOpList) => [exp ups]
+      -- try to fix exp(lc) if necessary
+      expCoef :=
+        normalize(exp lc,x)$ElementaryFunctionStructurePackage(R,FE)
+      opInOpList?("log" :: SY,opsInvolvingX expCoef) =>
+        stateProblem("exp","logs in constant coefficient")
+      result := exprToGenUPS(expCoef,posCheck?,atanFlag)
+      result case %problem => result
+      [(result.%series) * exp(ups - monomial(lc,0))]
+
+    atancotToGenUPS(fe,arg,posCheck?,atanFlag,plusMinus) ==
+      -- converts atan(f(x)) to a generalized power series
+      (result := exprToGenUPS(arg,posCheck?,atanFlag)) case %problem =>
+        trouble := result.%problem
+        trouble.prob = "essential singularity" => [monomial(fe,0)$UPS]
+        result
+      ups := result.%series; coef := coefficient(ups,0)
+      -- series involves complex numbers
+      (ord := order(ups,0)) = 0 and coef * coef = -1 =>
+        y := differentiate(ups)/(1 + ups*ups)
+        yCoef := coefficient(y,-1)
+        [monomial(log yCoef,0) + integrate(y - monomial(yCoef,-1)$UPS)]
+      cc : FE :=
+        ord < 0 =>
+          atanFlag = "complex" =>
+            return stateProblem("atan","essential singularity")
+          (rn := ratIfCan(ord :: FE)) case "failed" =>
+            -- this condition usually won't occur because exponents will
+            -- be integers or rational numbers
+            return stateProblem("atan","branch problem")
+          if (atanFlag = "real: two sides") and (odd? numer(rn :: RN)) then
+            -- expansions to the left and right of zero have different
+            -- constant coefficients
+            return stateProblem("atan","branch problem")
+          lc := coefficient(ups,ord)
+          (signum := sign(lc)$SIGNEF) case "failed" =>
+            -- can't determine sign
+            atanFlag = "just do it" =>
+              plusMinus = 1 => pi()/(2 :: FE)
+              0
+            posNegPi2 := signOfExpression(lc) * pi()/(2 :: FE)
+            plusMinus = 1 => posNegPi2
+            pi()/(2 :: FE) - posNegPi2
+            --return stateProblem("atan","branch problem")
+          left? : B := atanFlag = "real: left side"; n := signum :: Integer
+          (left? and n = 1) or (not left? and n = -1) =>
+            plusMinus = 1 => -pi()/(2 :: FE)
+            pi()
+          plusMinus = 1 => pi()/(2 :: FE)
+          0
+        atan coef
+      [(cc :: UPS) + integrate(differentiate(ups)/(1 + ups*ups))]
+
+    genUPSApplyIfCan(fcn,arg,fcnName,posCheck?,atanFlag) ==
+      -- converts fcn(arg) to a generalized power series
+      (series := iExprToGenUPS(arg,posCheck?,atanFlag)) case %problem =>
+        series
+      ups := series.%series
+      (deg := order(ups,1)) < 0 =>
+        stateProblem(fcnName,"essential singularity")
+      deg > 0 => [fcn(ups) :: UPS]
+      lc := coefficient(ups,0); xOpList := opsInvolvingX lc
+      null xOpList => [fcn(ups) :: UPS]
+      opInOpList?("log" :: SY,xOpList) =>
+        stateProblem(fcnName,"logs in constant coefficient")
+      contOnReals? fcnName => [fcn(ups) :: UPS]
+      stateProblem(fcnName,"x in constant coefficient")
+
+    applyBddIfCan(fe,fcn,arg,fcnName,posCheck?,atanFlag) ==
+      -- converts fcn(arg) to a generalized power series, where the
+      -- function fcn is bounded for real values
+      -- if fcn(arg) has an essential singularity as a complex
+      -- function, we return fcn(arg) as a monomial of degree 0
+      (ups := iExprToGenUPS(arg,posCheck?,atanFlag)) case %problem =>
+        trouble := ups.%problem
+        trouble.prob = "essential singularity" => [monomial(fe,0)$UPS]
+        ups
+      (ans := fcn(ups.%series)) case "failed" => [monomial(fe,0)$UPS]
+      [ans :: UPS]
+
+    tranToGenUPS(ker,arg,posCheck?,atanFlag) ==
+      -- converts op(arg) to a power series for certain functions
+      -- op in trig or hyperbolic trig categories
+      -- N.B. when this function is called, 'k2elem' will have been
+      -- applied, so the following functions cannot appear:
+      -- tan, cot, sec, csc, sinh, cosh, tanh, coth, sech, csch
+      is?(ker,"sin" :: SY) =>
+        applyBddIfCan(ker :: FE,sinIfCan,arg,"sin",posCheck?,atanFlag)
+      is?(ker,"cos" :: SY) =>
+        applyBddIfCan(ker :: FE,cosIfCan,arg,"cos",posCheck?,atanFlag)
+      is?(ker,"asin" :: SY) =>
+        genUPSApplyIfCan(asinIfCan,arg,"asin",posCheck?,atanFlag)
+      is?(ker,"acos" :: SY) =>
+        genUPSApplyIfCan(acosIfCan,arg,"acos",posCheck?,atanFlag)
+      is?(ker,"atan" :: SY) =>
+        atancotToGenUPS(ker :: FE,arg,posCheck?,atanFlag,1)
+      is?(ker,"acot" :: SY) =>
+        atancotToGenUPS(ker :: FE,arg,posCheck?,atanFlag,-1)
+      is?(ker,"asec" :: SY) =>
+        genUPSApplyIfCan(asecIfCan,arg,"asec",posCheck?,atanFlag)
+      is?(ker,"acsc" :: SY) =>
+        genUPSApplyIfCan(acscIfCan,arg,"acsc",posCheck?,atanFlag)
+      is?(ker,"asinh" :: SY) =>
+        genUPSApplyIfCan(asinhIfCan,arg,"asinh",posCheck?,atanFlag)
+      is?(ker,"acosh" :: SY) =>
+        genUPSApplyIfCan(acoshIfCan,arg,"acosh",posCheck?,atanFlag)
+      is?(ker,"atanh" :: SY) =>
+        genUPSApplyIfCan(atanhIfCan,arg,"atanh",posCheck?,atanFlag)
+      is?(ker,"acoth" :: SY) =>
+        genUPSApplyIfCan(acothIfCan,arg,"acoth",posCheck?,atanFlag)
+      is?(ker,"asech" :: SY) =>
+        genUPSApplyIfCan(asechIfCan,arg,"asech",posCheck?,atanFlag)
+      is?(ker,"acsch" :: SY) =>
+        genUPSApplyIfCan(acschIfCan,arg,"acsch",posCheck?,atanFlag)
+      stateProblem(string name ker,"unknown kernel")
+
+    powToGenUPS(args,posCheck?,atanFlag) ==
+      -- converts a power f(x) ** g(x) to a generalized power series
+      (logBase := logToGenUPS(first args,posCheck?,atanFlag)) case %problem =>
+        logBase
+      expon := iExprToGenUPS(second args,posCheck?,atanFlag)
+      expon case %problem => expon
+      expGenUPS((expon.%series) * (logBase.%series),posCheck?,atanFlag)
+
 *)
 
 \end{chunk}
@@ -43835,6 +60784,7 @@ FunctionSpaceUnivariatePolynomialFactor(R, F, UP):
         ++ returning "failed" if it cannot
 
   Implementation ==> add
+
     import AlgFactor(UPA)
     import RationalFactorize(UPQ)
 
@@ -43846,6 +60796,7 @@ FunctionSpaceUnivariatePolynomialFactor(R, F, UP):
     dummy := kernel(new()$Symbol)$K
 
     if F has RetractableTo AN then
+
       UPAN2F: UPA -> UP
       UPQ2AN: UPQ -> UPA
 
@@ -43889,8 +60840,8 @@ FunctionSpaceUnivariatePolynomialFactor(R, F, UP):
         [ansa]
 
     else
-      UPQ2F: UPQ -> UP
 
+      UPQ2F: UPQ -> UP
       UPQ2F p ==
         map(x+->x::F, p)$UnivariatePolynomialCategoryFunctions2(Q,UPQ,F,UP)
 
@@ -43939,6 +60890,107 @@ FunctionSpaceUnivariatePolynomialFactor(R, F, UP):
 \begin{chunk}{COQ FSUPFACT}
 (* package FSUPFACT *)
 (*
+
+    import AlgFactor(UPA)
+    import RationalFactorize(UPQ)
+
+    P2QifCan : PR  -> Union(PQ, "failed")
+    UPQ2UP   : (SparseUnivariatePolynomial PQ, F) -> UP
+    PQ2F     : (PQ, F) -> F
+    ffactor0 : UP -> FR
+
+    dummy := kernel(new()$Symbol)$K
+
+    if F has RetractableTo AN then
+
+      UPAN2F: UPA -> UP
+      UPQ2AN: UPQ -> UPA
+
+      UPAN2F p ==
+        map(x+->x::F, p)$UnivariatePolynomialCategoryFunctions2(AN,UPA,F,UP)
+
+      UPQ2AN p ==
+        map(x+->x::AN, p)$UnivariatePolynomialCategoryFunctions2(Q,UPQ,AN,UPA)
+
+      ffactor p ==
+        (pq := anfactor p) case FRA =>
+                         map(UPAN2F, pq::FRA)$FactoredFunctions2(UPA, UP)
+        ffactor0 p
+
+      anfactor p ==
+        (q := UP2ifCan p) case overq =>
+                     map(UPQ2AN, factor(q.overq))$FactoredFunctions2(UPQ, UPA)
+        q case overan => factor(q.overan)
+        "failed"
+
+      UP2ifCan p ==
+        ansq := 0$UPQ ; ansa := 0$UPA
+        goforq? := true
+        while p ^= 0 repeat
+          if goforq? then
+            rq := retractIfCan(leadingCoefficient p)@Union(Q, "failed")
+            if rq case Q then
+              ansq := ansq + monomial(rq::Q, degree p)
+              ansa := ansa + monomial(rq::Q::AN, degree p)
+            else
+              goforq? := false
+              ra := retractIfCan(leadingCoefficient p)@Union(AN, "failed")
+              if ra case AN then ansa := ansa + monomial(ra::AN, degree p)
+                            else return [true]
+          else
+            ra := retractIfCan(leadingCoefficient p)@Union(AN, "failed")
+            if ra case AN then ansa := ansa + monomial(ra::AN, degree p)
+                          else return [true]
+          p := reductum p
+        goforq? => [ansq]
+        [ansa]
+
+    else
+
+      UPQ2F: UPQ -> UP
+      UPQ2F p ==
+        map(x+->x::F, p)$UnivariatePolynomialCategoryFunctions2(Q,UPQ,F,UP)
+
+      ffactor p ==
+        (pq := qfactor p) case FRQ =>
+                         map(UPQ2F, pq::FRQ)$FactoredFunctions2(UPQ, UP)
+        ffactor0 p
+
+      UP2ifCan p ==
+        ansq := 0$UPQ
+        while p ^= 0 repeat
+          rq := retractIfCan(leadingCoefficient p)@Union(Q, "failed")
+          if rq case Q then ansq := ansq + monomial(rq::Q, degree p)
+                       else return [true]
+          p := reductum p
+        [ansq]
+
+    ffactor0 p ==
+      smp := numer(ep := p(dummy::F))
+      (q := P2QifCan smp) case "failed" => p::FR
+      map(x+->UPQ2UP(univariate(x, dummy), denom(ep)::F), factor(q::PQ
+             )$MRationalFactorize(IndexedExponents K, K, Integer,
+                  PQ))$FactoredFunctions2(PQ, UP)
+
+    UPQ2UP(p, d) ==
+      map(x+->PQ2F(x, d), p)$UnivariatePolynomialCategoryFunctions2(PQ,
+                                   SparseUnivariatePolynomial PQ, F, UP)
+
+    PQ2F(p, d) ==
+      map((x:K):F+->x::F, (y:Q):F+->y::F, p)_
+        $PolynomialCategoryLifting(IndexedExponents K, K, Q, PQ, F) / d
+
+    qfactor p ==
+      (q := UP2ifCan p) case overq => factor(q.overq)
+      "failed"
+
+    P2QifCan p ==
+      and/[retractIfCan(c::F)@Union(Q, "failed") case Q
+           for c in coefficients p] =>
+            map(x+->x::PQ, y+->retract(y::F)@Q :: PQ, p)_
+              $PolynomialCategoryLifting(IndexedExponents K,K,R,PR,PQ)
+      "failed"
+
 *)
 
 \end{chunk}
@@ -44171,6 +61223,86 @@ GaloisGroupFactorizationUtilities(R,UP,F): Exports == Implementation where
 \begin{chunk}{COQ GALFACTU}
 (* package GALFACTU *)
 (*
+
+    import GaloisGroupUtilities(F)
+
+    height(p:UP):F == infinityNorm(p)
+
+    length(p:UP):F == norm(p,1)
+
+    norm(f:UP,p:P):F ==
+      n : F := 0
+      for c in coefficients f repeat
+        n := n+abs(c::F)**p
+      nthRoot(n,p::N)
+
+    quadraticNorm(f:UP):F == norm(f,2)
+
+    infinityNorm(f:UP):F ==
+      n : F := 0
+      for c in coefficients f repeat
+        n := max(n,c::F)
+      n
+
+    singleFactorBound(p:UP,r:N):Z == -- See [6]
+      n : N := degree p
+      r := max(2,r)
+      n < r => error "singleFactorBound: Bad arguments."
+      nf : F := n :: F
+      num : F := nthRoot(bombieriNorm(p),r)
+      if F has Gamma: F -> F then
+        num := num*nthRoot(Gamma(nf+1$F),2*r)
+        den : F := Gamma(nf/((2*r)::F)+1$F)
+      else
+        num := num*(2::F)**(5/8+n/2)*exp(1$F/(4*nf))
+        den : F := (pi()$F*nf)**(3/8)
+      safeFloor( num/den )
+
+    singleFactorBound(p:UP):Z == singleFactorBound(p,2) -- See [6]
+
+    rootBound(p:UP):Z == -- See [4] and [5]
+      n := degree p
+      zero? n => 0
+      lc := abs(leadingCoefficient(p)::F)
+      b1 : F := 0 -- Mignotte
+      b2 : F := 0 -- Knuth
+      b3 : F := 0 -- Zassenhaus in [5]
+      b4 : F := 0 -- Cauchy in [7]
+      c : F := 0
+      cl : F := 0
+      for i in 1..n repeat
+        c := abs(coefficient(p,(n-i)::N)::F)
+        b1 := max(b1,c)
+        cl := c/lc
+        b2 := max(b2,nthRoot(cl,i))
+        b3 := max(b3,nthRoot(cl/pascalTriangle(n,i),i))
+        b4 := max(b4,nthRoot(n*cl,i))
+      min(1+safeCeiling(b1/lc),min(safeCeiling(2*b2),min(safeCeiling(b3/
+       (nthRoot(2::F,n)-1)),safeCeiling(b4))))
+
+    beauzamyBound(f:UP):Z == -- See [1]
+      d := degree f
+      zero? d => safeFloor bombieriNorm f
+      safeFloor( (bombieriNorm(f)*(3::F)**(3/4+d/2))/
+       (2*sqrt(pi()$F*(d::F))) )
+
+    bombieriNorm(f:UP,p:P):F == -- See [2] and [3]
+      d := degree f
+      b := abs(coefficient(f,0)::F)
+      if zero? d then return b
+       else b := b**p
+      b := b+abs(leadingCoefficient(f)::F)**p
+      dd := (d-1) quo 2
+      for i in 1..dd repeat
+        b := b+(abs(coefficient(f,i)::F)**p+abs(coefficient(f,(d-i)::N)::F)**p)
+         /pascalTriangle(d,i)
+      if even? d then
+        dd := dd+1
+        b := b+abs(coefficient(f, dd::N)::F)**p/pascalTriangle(d,dd)
+      nthRoot(b,p::N)
+
+    bombieriNorm(f:UP):F == bombieriNorm(f,2) -- See [1]
+
 *)
 
 \end{chunk}
@@ -44514,7 +61646,6 @@ GaloisGroupFactorizer(UP): Exports == Implementation where
         tc := leadingCoefficient rf
         rf := reductum rf
       for p in factors(factor c)$Factored(Z) repeat
---        if (one? p.exponent) and (not zero? (lc rem p.factor)) and
         if (p.exponent = 1) and (not zero? (lc rem p.factor)) and
          (not zero? (tc rem ((p.factor)**2))) then return true
       false
@@ -44551,11 +61682,9 @@ GaloisGroupFactorizer(UP): Exports == Implementation where
     fullSet(n:N):Set N == set [ i for i in 0..n ]
 
     modularFactor(p:UP):MFact ==
---      not one? abs(content(p)) => 
       not (abs(content(p)) = 1) => 
        error "modularFactor: the polynomial is not primitive."
       zero? (n := degree p) => [0,[p]]
-
       -- declarations --
       cprime: Z := 2
       trials: List DDFact := empty()
@@ -44566,7 +61695,6 @@ GaloisGroupFactorizer(UP): Exports == Implementation where
       degfact: N := 0
       nf: N := stopmussertrials+1
       i: Z
-
       -- Musser, see [3] --
       diffp := differentiate p
       for i in 1..mussertrials | nf>stopmussertrials repeat
@@ -44715,7 +61843,6 @@ GaloisGroupFactorizer(UP): Exports == Implementation where
               degf := degree f
               d := select(x+->x <= degf,d)
               if degf<=1 then -- lf exhausted
---                if one? degf then
                 if (degf = 1) then
                   ltrue := cons(f,ltrue)
                 return ltrue -- 1st exit, all factors found
@@ -44754,7 +61881,6 @@ GaloisGroupFactorizer(UP): Exports == Implementation where
       not (max(d) = df) => error "btwFact: Bad arguments"
       reverse?: Boolean := false
       negativelc?: Boolean := false
-
       (d = set [0,df]) => [ f ]
       if abs(coefficient(f,0))<abs(leadingCoefficient(f)) then
         f := reverse f
@@ -44829,7 +61955,6 @@ GaloisGroupFactorizer(UP): Exports == Implementation where
       b := b+(r::Z)
       a := 2*a
       d := gcd(a,b)
---      if not one? d then
       if not (d = 1) then
         a := a quo d
         b := b quo d
@@ -44848,39 +61973,29 @@ GaloisGroupFactorizer(UP): Exports == Implementation where
 
     henselFact(f:UP, sqf:Boolean):FinalFact ==
       factorlist: List(ParFact) := empty()
-
       -- make m primitive
       c: Z := content f
       f := (f exquo c)::UP
-
       -- make the leading coefficient positive
       if leadingCoefficient f < 0 then
         c := -c
         f := -f
-
       -- is x**d factor of f
       if (d := minimumDegree f) > 0 then
         f := monicDivide(f,monomial(1,d)).quotient
         factorlist := [[monomial(1,1),d]$ParFact]
-
       d := degree f
-
       -- is f constant?
       zero? d => [c,factorlist]$FinalFact
-
       -- is f linear?
---      one? d => [c,cons([f,1]$ParFact,factorlist)]$FinalFact
       (d = 1) => [c,cons([f,1]$ParFact,factorlist)]$FinalFact
-
       lcPol: UP := leadingCoefficient(f) :: UP
-
       -- is f cyclotomic (x**n - 1)?
       -lcPol = reductum(f) =>    -- if true, both will = 1
         for fac in map(z+->unmakeSUP(z)$UP,
          cyclotomicDecomposition(d)$CYC)$ListFunctions2(SUPZ,UP) repeat 
           factorlist := cons([fac,1]$ParFact,factorlist)
         [c,factorlist]$FinalFact
-
       -- is f odd cyclotomic (x**(2*n+1) + 1)?
       odd?(d) and (lcPol = reductum(f)) =>
         for sfac in cyclotomicDecomposition(d)$CYC repeat
@@ -44888,26 +62003,21 @@ GaloisGroupFactorizer(UP): Exports == Implementation where
            if leadingCoefficient fac < 0 then fac := -fac
            factorlist := cons([fac,1]$ParFact,factorlist)
         [c,factorlist]$FinalFact
-
       -- is the poly of the form x**n + 1 with n a power of 2?
       -- if so, then irreducible
       isPowerOf2(d) and (lcPol = reductum(f)) =>
         factorlist := cons([f,1]$ParFact,factorlist)
         [c,factorlist]$FinalFact
-
       -- other special cases to implement...
-
       -- f is square-free :
       sqf => [c, append([[pf,1]$ParFact for pf in henselfact(f,true)],
        factorlist)]$FinalFact
-
       -- f is not square-free :
       sqfflist := factors squareFree f
       for sqfr in sqfflist repeat
         mult := sqfr.exponent
         sqff := sqfr.factor
         d := degree sqff
---        one? d => factorlist := cons([sqff,mult]$ParFact,factorlist)
         (d = 1) => factorlist := cons([sqff,mult]$ParFact,factorlist)
         d=2 =>
           factorlist := append([[pf,mult]$ParFact for pf in quadratic(sqff)],
@@ -44920,16 +62030,13 @@ GaloisGroupFactorizer(UP): Exports == Implementation where
       d := degree f
       not(max(fd)=d) => error "btwFact: Bad arguments"
       factorlist: List(ParFact) := empty()
-
       -- make m primitive
       c: Z := content f
       f := (f exquo c)::UP
-
       -- make the leading coefficient positive
       if leadingCoefficient f < 0 then
         c := -c
         f := -f
-
       -- is x**d factor of f
       if (maxd := minimumDegree f) > 0 then
         f := monicDivide(f,monomial(1,maxd)).quotient
@@ -44937,23 +62044,17 @@ GaloisGroupFactorizer(UP): Exports == Implementation where
         r := max(2,r-maxd)::N
         d := subtractIfCan(d,maxd)::N
         fd := select(x+->x <= d,fd)
-
       -- is f constant?
       zero? d => [c,factorlist]$FinalFact
-
       -- is f linear?
---      one? d => [c,cons([f,1]$ParFact,factorlist)]$FinalFact
       (d = 1) => [c,cons([f,1]$ParFact,factorlist)]$FinalFact
-
       lcPol: UP := leadingCoefficient(f) :: UP
-
       -- is f cyclotomic (x**n - 1)?
       -lcPol = reductum(f) =>    -- if true, both will = 1
         for fac in map(z+->unmakeSUP(z)$UP,
          cyclotomicDecomposition(d)$CYC)$ListFunctions2(SUPZ,UP) repeat 
           factorlist := cons([fac,1]$ParFact,factorlist)
         [c,factorlist]$FinalFact
-
       -- is f odd cyclotomic (x**(2*n+1) + 1)?
       odd?(d) and (lcPol = reductum(f)) =>
         for sfac in cyclotomicDecomposition(d)$CYC repeat
@@ -44961,22 +62062,17 @@ GaloisGroupFactorizer(UP): Exports == Implementation where
            if leadingCoefficient fac < 0 then fac := -fac
            factorlist := cons([fac,1]$ParFact,factorlist)
         [c,factorlist]$FinalFact
-
       -- is the poly of the form x**n + 1 with n a power of 2?
       -- if so, then irreducible
       isPowerOf2(d) and (lcPol = reductum(f)) =>
         factorlist := cons([f,1]$ParFact,factorlist)
         [c,factorlist]$FinalFact
-
       -- other special cases to implement...
-
       -- f is square-free :
       sqf => [c, append([[pf,1]$ParFact for pf in btwFactor(f,fd,r,true)],
        factorlist)]$FinalFact
-
       -- f is not square-free :
       sqfflist := factors squareFree(f)
---      if one?(#(sqfflist)) then -- indeed f was a power of a square-free 
       if ((#(sqfflist)) = 1) then -- indeed f was a power of a square-free 
         r := max(r quo ((first sqfflist).exponent),2)::N
       else
@@ -44985,7 +62081,6 @@ GaloisGroupFactorizer(UP): Exports == Implementation where
         mult := sqfr.exponent
         sqff := sqfr.factor
         d := degree sqff
---        one? d => 
         (d = 1) => 
           factorlist := cons([sqff,mult]$ParFact,factorlist)
           maxd := (max(fd)-mult)::N
@@ -45051,7 +62146,6 @@ GaloisGroupFactorizer(UP): Exports == Implementation where
     factorOfDegree(d:P,p:UP,ld:List N,r:N,sqf:Boolean):Union(UP,"failed") ==
       dp := degree p
       errorsum?(dp,ld) => error "factorOfDegree: Bad arguments"
---      (one? (d::N)) and noLinearFactor?(p) => "failed"
       ((d::N) = 1) and noLinearFactor?(p) => "failed"
       lf := btwFact(p,sqf,makeSet(ld),r).factors
       for f in lf repeat
@@ -45075,6 +62169,586 @@ GaloisGroupFactorizer(UP): Exports == Implementation where
 \begin{chunk}{COQ GALFACT}
 (* package GALFACT *)
 (*
+
+    fUnion ==> Union("nil", "sqfr", "irred", "prime")
+    FFE ==> Record(flg:fUnion, fctr:UP, xpnt:Z) -- Flag-Factor-Exponent
+    DDFact ==> Record(prime:Z, ddfactors:DDList) -- Distinct Degree Factors
+    HLR ==> Record(plist:List UP, modulo:Z) -- HenselLift Record
+
+    mussertrials: P := 5
+    stopmussertrials: P := 8
+    usesinglefactorbound: Boolean := true
+    tryfunctionaldecomposition: Boolean := true
+    useeisensteincriterion: Boolean := true
+
+    useEisensteinCriterion?():Boolean == useeisensteincriterion
+
+    useEisensteinCriterion(b:Boolean):Boolean ==
+      (useeisensteincriterion,b) := (b,useeisensteincriterion)
+      b
+
+    tryFunctionalDecomposition?():Boolean == tryfunctionaldecomposition
+
+    tryFunctionalDecomposition(b:Boolean):Boolean ==
+      (tryfunctionaldecomposition,b) := (b,tryfunctionaldecomposition)
+      b
+
+    useSingleFactorBound?():Boolean == usesinglefactorbound
+
+    useSingleFactorBound(b:Boolean):Boolean ==
+      (usesinglefactorbound,b) := (b,usesinglefactorbound)
+      b
+
+    stopMusserTrials():P == stopmussertrials
+
+    stopMusserTrials(n:P):P ==
+      (stopmussertrials,n) := (n,stopmussertrials)
+      n
+
+    musserTrials():P == mussertrials
+
+    musserTrials(n:P):P ==
+      (mussertrials,n) := (n,mussertrials)
+      n
+
+    import GaloisGroupFactorizationUtilities(Z,UP,Float)
+
+    import GaloisGroupPolynomialUtilities(Z,UP)
+
+    import IntegerPrimesPackage(Z)
+    import IntegerFactorizationPackage(Z)
+
+    import ModularDistinctDegreeFactorizer(UP)
+
+    eisensteinIrreducible?(f:UP):Boolean ==
+      rf := reductum f
+      c: Z := content rf
+      zero? c => false
+      unit? c => false
+      lc := leadingCoefficient f
+      tc := lc
+      while not zero? rf repeat
+        tc := leadingCoefficient rf
+        rf := reductum rf
+      for p in factors(factor c)$Factored(Z) repeat
+        if (p.exponent = 1) and (not zero? (lc rem p.factor)) and
+         (not zero? (tc rem ((p.factor)**2))) then return true
+      false
+
+    numberOfFactors(ddlist:DDList):N ==
+      n: N := 0
+      d: Z := 0
+      for dd in ddlist repeat
+        n := n +
+          zero? (d := degree(dd.factor)::Z) => 1
+          (d quo dd.degree)::N
+      n
+
+    -- local function, returns the a Set of shifted elements
+    shiftSet(s:Set N,shift:N):Set N == set [ e+shift for e in parts s ]
+
+    -- local function, returns the "reductum" of an Integer (as chain of bits)
+    reductum(n:Z):Z == n-shift(1,length(n)-1)
+
+    -- local function, returns an integer with level lowest bits set to 1
+    seed(level:Z):Z == shift(1,level)-1
+
+    -- local function, returns the next number (as a chain of bit) for
+    -- factor reconciliation of a given level (which is the number of
+    -- extraneaous factors involved) or "End of level" if not any
+    nextRecNum(levels:N,level:Z,n:Z):Union("End of level",Z) ==
+      if (l := length n)<levels then return(n+shift(1,l-1))
+      (n=shift(seed(level),levels-level)) => "End of level"
+      b: Z := 1
+      while ((l-b) = (lr := length(n := reductum n)))@Boolean repeat b := b+1
+      reductum(n)+shift(seed(b+1),lr)
+
+    -- local function, return the set of N, 0..n
+    fullSet(n:N):Set N == set [ i for i in 0..n ]
+
+    modularFactor(p:UP):MFact ==
+      not (abs(content(p)) = 1) => 
+       error "modularFactor: the polynomial is not primitive."
+      zero? (n := degree p) => [0,[p]]
+      -- declarations --
+      cprime: Z := 2
+      trials: List DDFact := empty()
+      d: Set N := fullSet(n)
+      dirred: Set N := set [0,n]
+      s: Set N := empty()
+      ddlist: DDList := empty()
+      degfact: N := 0
+      nf: N := stopmussertrials+1
+      i: Z
+      -- Musser, see [3] --
+      diffp := differentiate p
+      for i in 1..mussertrials | nf>stopmussertrials repeat
+        -- test 1: cprime divides leading coefficient
+        -- test 2: "bad" primes: (in future: use Dedekind's Criterion)
+        while (zero? ((leadingCoefficient p) rem cprime)) or
+         (not zero? degree gcd(p,diffp,cprime)) repeat
+          cprime := nextPrime(cprime)
+        ddlist := ddFact(p,cprime)
+        -- degree compatibility: See [3] --
+        s := set [0]
+        for f in ddlist repeat
+          degfact := f.degree::N
+          if not zero? degfact then 
+            for j in 1..(degree(f.factor) quo degfact) repeat
+              s := union(s, shiftSet(s,degfact))
+        trials := cons([cprime,ddlist]$DDFact,trials)
+        d := intersect(d, s)
+        d = dirred => return [0,[p]] -- p is irreducible
+        cprime := nextPrime(cprime)
+        nf := numberOfFactors ddlist
+
+      -- choose the one with the smallest number of factors
+      choice := first trials
+      nfc := numberOfFactors(choice.ddfactors)
+      for t in rest trials repeat
+        nf := numberOfFactors(t.ddfactors)
+        if nf<nfc or ((nf=nfc) and (t.prime>choice.prime)) then
+          nfc := nf
+          choice := t
+      cprime := choice.prime
+      -- HenselLift$GHENSEL expects the degree 0 factor first 
+      [cprime,separateFactors(choice.ddfactors,cprime)]
+
+    degreePartition(ddlist:DDList):Multiset N ==
+      dp: Multiset N := empty()
+      d: N := 0
+      dd: N := 0
+      for f in ddlist repeat
+        zero? (d := degree(f.factor)) => dp := insert!(0,dp)
+        dd := f.degree::N
+        dp := insert!(dd,dp,d quo dd)
+      dp
+
+    import GeneralHenselPackage(Z,UP)
+    import UnivariatePolynomialDecompositionPackage(Z,UP)
+    import BrillhartTests(UP) -- See [2]
+
+    -- local function, finds the factors of f primitive, square-free, with
+    -- positive leading coefficient and non zero trailing coefficient,
+    -- using the overall bound technique. If pdecomp is true then look
+    -- for a functional decomposition of f.
+    henselfact(f:UP,pdecomp:Boolean):List UP ==
+      if brillhartIrreducible? f or
+       (useeisensteincriterion => eisensteinIrreducible? f ; false)
+      then return [f]
+      cf: Union(LR,"failed")
+      if pdecomp and tryfunctionaldecomposition then
+        cf := monicDecomposeIfCan f
+      else
+        cf := "failed"
+      cf case "failed" =>
+        m := modularFactor f
+        zero? (cprime := m.prime) => m.factors
+        b: P := (2*leadingCoefficient(f)*beauzamyBound(f)) :: P
+        completeHensel(f,m.factors,cprime,b)
+      lrf := cf::LR
+      "append"/[ henselfact(g(lrf.right),false) for g in
+       henselfact(lrf.left,true) ]
+
+    -- local function, returns the complete factorization of its arguments,
+    -- using the single-factor bound technique 
+    completeFactor(f:UP,lf:List UP,cprime:Z,pk:P,r:N,d:Set N):List UP ==
+      lc := leadingCoefficient f
+      f0 := coefficient(f,0)
+      ltrue: List UP := empty()
+      found? := true
+      degf: N := 0
+      degg: N := 0
+      g0: Z := 0
+      g: UP := 0
+      rg: N := 0
+      nb: Z := 0
+      lg: List UP := empty()
+      b: P := 1
+      dg: Set N := empty()
+      llg: HLR := [empty(),0]
+      levels: N := #lf
+      level: Z := 1
+      ic: Union(Z,"End of level") := 0
+      i: Z := 0
+      while level<levels repeat
+        -- try all possible factors with degree in d
+        ic := seed(level)
+        while ((not found?) and (ic case Z)) repeat
+          i := ic::Z
+          degg := 0
+          g0 := 1 -- LC algorithm
+          for j in 1..levels repeat
+            if bit?(i,j-1) then
+              degg := degg+degree lf.j
+              g0 := g0*coefficient(lf.j,0) -- LC algorithm
+          g0 := symmetricRemainder(lc*g0,pk) -- LC algorithm
+          if member?(degg,d) and (((lc*f0) exquo g0) case Z) then 
+            --                       LC algorithm
+            g := lc::UP -- build the possible factor -- LC algorithm
+            for j in 1..levels repeat if bit?(i,j-1) then g := g*lf.j
+            g := primitivePart reduction(g,pk)
+            f1 := f exquo g
+            if f1 case UP then -- g is a true factor
+              found? := true
+              -- remove the factors of g from lf
+              nb := 1
+              for j in 1..levels repeat
+                if bit?(i,j-1) then 
+                  swap!(lf,j,nb)
+                  nb := nb+1
+              lg := lf
+              lf := rest(lf,level::N)
+              setrest!(rest(lg,(level-1)::N),empty()$List(UP))
+              f := f1::UP
+              lc := leadingCoefficient f
+              f0 := coefficient(f,0)
+              -- is g irreducible?
+              dg := select(x+->x <= degg,d)
+              if not(dg=set [0,degg]) then -- implies degg >= 2
+                rg := max(2,r+level-levels)::N
+                b := (2*leadingCoefficient(g)*singleFactorBound(g,rg)) :: P
+                if b>pk and (not brillhartIrreducible?(g)) and
+                  (useeisensteincriterion => not eisensteinIrreducible?(g) ;
+                  true)
+                then
+                  -- g may be reducible
+                  llg := HenselLift(g,lg,cprime,b)
+                  gpk: P := (llg.modulo)::P 
+                  -- In case exact factorisation has been reached by
+                  -- HenselLift before coefficient bound.
+                  if gpk<b then
+                    lg := llg.plist
+                  else
+                    lg := completeFactor(g,llg.plist,cprime,gpk,rg,dg)
+                else lg := [ g ] -- g irreducible
+              else lg := [ g ] -- g irreducible
+              ltrue := append(ltrue,lg)
+              r := max(2,(r-#lg))::N
+              degf := degree f
+              d := select(x+->x <= degf,d)
+              if degf<=1 then -- lf exhausted
+                if (degf = 1) then
+                  ltrue := cons(f,ltrue)
+                return ltrue -- 1st exit, all factors found
+              else -- can we go on with the same pk?
+                b := (2*lc*singleFactorBound(f,r)) :: P
+                if b>pk then -- unlucky: no we can't
+                  llg := HenselLift(f,lf,cprime,b) -- I should reformulate
+                   -- the lifting probleme, but hadn't time for that.
+                   -- In any case, such case should be quite exceptional.
+                  lf := llg.plist
+                  pk := (llg.modulo)::P
+                  -- In case exact factorisation has been reached by
+                  -- HenselLift before coefficient bound.
+                  if pk<b then return append(lf,ltrue) -- 2nd exit
+                  level := 1
+          ic := nextRecNum(levels,level,i)
+        if found? then
+          levels := #lf
+          found? := false
+        if not (ic case Z) then level := level+1
+      cons(f,ltrue) -- 3rd exit, the last factor was irreducible but not "true"
+
+    -- local function, returns the set of elements "divided" by an integer
+    divideSet(s:Set N, n:N):Set N ==
+      l: List N := [ 0 ]
+      for e in parts s repeat
+        if (ee := (e exquo n)$N) case N then l := cons(ee::N,l)
+      set(l)
+
+    -- Beauzamy-Trevisan-Wang FACTOR, see [1] with some refinements
+    -- and some differences. f is assumed to be primitive, square-free
+    -- and with positive leading coefficient. If pdecomp is true then
+    -- look for a functional decomposition of f. 
+    btwFactor(f:UP,d:Set N,r:N,pdecomp:Boolean):List UP ==
+      df := degree f
+      not (max(d) = df) => error "btwFact: Bad arguments"
+      reverse?: Boolean := false
+      negativelc?: Boolean := false
+      (d = set [0,df]) => [ f ]
+      if abs(coefficient(f,0))<abs(leadingCoefficient(f)) then
+        f := reverse f
+        reverse? := true
+      brillhartIrreducible? f or 
+       (useeisensteincriterion => eisensteinIrreducible?(f) ; false) =>
+        if reverse? then [ reverse f ] else [ f ]
+      if leadingCoefficient(f)<0 then
+        f := -f
+        negativelc? := true
+      cf: Union(LR,"failed")
+      if pdecomp and tryfunctionaldecomposition then
+        cf := monicDecomposeIfCan f
+      else
+        cf := "failed"
+      if cf case "failed" then
+        m := modularFactor f
+        zero? (cprime := m.prime) => 
+          if reverse? then
+            if negativelc? then return [ -reverse f ]
+            else return [ reverse f ]
+          else if negativelc? then return [ -f ]
+               else return [ f ]
+        if noLinearFactor? f then d := remove(1,d)
+        lc := leadingCoefficient f
+        f0 := coefficient(f,0)
+        b: P := (2*lc*singleFactorBound(f,r)) :: P -- LC algorithm
+        lm := HenselLift(f,m.factors,cprime,b)
+        lf := lm.plist
+        pk: P := (lm.modulo)::P
+        if ground? first lf then lf := rest lf
+        -- in case exact factorisation has been reached by HenselLift
+        -- before coefficient bound
+        if not pk < b then lf := completeFactor(f,lf,cprime,pk,r,d)
+      else
+        lrf := cf::LR
+        dh := degree lrf.right
+        lg := btwFactor(lrf.left,divideSet(d,dh),2,true)
+        lf: List UP := empty()
+        for i in 1..#lg repeat
+          g := lg.i
+          dgh := (degree g)*dh
+          df := subtractIfCan(df,dgh)::N
+          lfg := btwFactor(g(lrf.right),
+           select(x+->x <= dgh,d),max(2,r-df)::N,false)
+          lf := append(lf,lfg)
+          r := max(2,r-#lfg)::N
+      if reverse? then lf := [ reverse(fact) for fact in lf ]
+      for i in 1..#lf repeat
+        if leadingCoefficient(lf.i)<0 then lf.i := -lf.i
+        -- because we assume f with positive leading coefficient
+      lf
+
+    makeFR(flist:FinalFact):Factored UP ==
+      ctp := factor flist.contp
+      fflist: List FFE := empty()
+      for ff in flist.factors repeat
+        fflist := cons(["prime", ff.irr, ff.pow]$FFE, fflist)
+      for fc in factorList ctp repeat
+        fflist := cons([fc.flg, fc.fctr::UP, fc.xpnt]$FFE, fflist)
+      makeFR(unit(ctp)::UP, fflist)
+
+    import IntegerRoots(Z)
+
+    -- local function, factorizes a quadratic polynomial
+    quadratic(p:UP):List UP ==
+      a := leadingCoefficient p
+      b := coefficient(p,1)
+      d := b**2-4*a*coefficient(p,0)
+      r := perfectSqrt(d)
+      r case "failed" => [p]
+      b := b+(r::Z)
+      a := 2*a
+      d := gcd(a,b)
+      if not (d = 1) then
+        a := a quo d
+        b := b quo d
+      f: UP := monomial(a,1)+monomial(b,0)
+      cons(f,[(p exquo f)::UP])
+
+    isPowerOf2(n:Z): Boolean ==
+       n = 1 => true
+       qr: Record(quotient: Z, remainder: Z) := divide(n,2)
+       qr.remainder = 1 => false
+       isPowerOf2 qr.quotient
+
+    subMinusX(supPol: SUPZ): UP ==
+       minusX: SUPZ := monomial(-1,1)$SUPZ
+       unmakeSUP(elt(supPol,minusX)$SUPZ)
+
+    henselFact(f:UP, sqf:Boolean):FinalFact ==
+      factorlist: List(ParFact) := empty()
+      -- make m primitive
+      c: Z := content f
+      f := (f exquo c)::UP
+      -- make the leading coefficient positive
+      if leadingCoefficient f < 0 then
+        c := -c
+        f := -f
+      -- is x**d factor of f
+      if (d := minimumDegree f) > 0 then
+        f := monicDivide(f,monomial(1,d)).quotient
+        factorlist := [[monomial(1,1),d]$ParFact]
+      d := degree f
+      -- is f constant?
+      zero? d => [c,factorlist]$FinalFact
+      -- is f linear?
+      (d = 1) => [c,cons([f,1]$ParFact,factorlist)]$FinalFact
+      lcPol: UP := leadingCoefficient(f) :: UP
+      -- is f cyclotomic (x**n - 1)?
+      -lcPol = reductum(f) =>    -- if true, both will = 1
+        for fac in map(z+->unmakeSUP(z)$UP,
+         cyclotomicDecomposition(d)$CYC)$ListFunctions2(SUPZ,UP) repeat 
+          factorlist := cons([fac,1]$ParFact,factorlist)
+        [c,factorlist]$FinalFact
+      -- is f odd cyclotomic (x**(2*n+1) + 1)?
+      odd?(d) and (lcPol = reductum(f)) =>
+        for sfac in cyclotomicDecomposition(d)$CYC repeat
+           fac := subMinusX sfac
+           if leadingCoefficient fac < 0 then fac := -fac
+           factorlist := cons([fac,1]$ParFact,factorlist)
+        [c,factorlist]$FinalFact
+      -- is the poly of the form x**n + 1 with n a power of 2?
+      -- if so, then irreducible
+      isPowerOf2(d) and (lcPol = reductum(f)) =>
+        factorlist := cons([f,1]$ParFact,factorlist)
+        [c,factorlist]$FinalFact
+      -- other special cases to implement...
+      -- f is square-free :
+      sqf => [c, append([[pf,1]$ParFact for pf in henselfact(f,true)],
+       factorlist)]$FinalFact
+      -- f is not square-free :
+      sqfflist := factors squareFree f
+      for sqfr in sqfflist repeat
+        mult := sqfr.exponent
+        sqff := sqfr.factor
+        d := degree sqff
+        (d = 1) => factorlist := cons([sqff,mult]$ParFact,factorlist)
+        d=2 =>
+          factorlist := append([[pf,mult]$ParFact for pf in quadratic(sqff)],
+           factorlist)
+        factorlist := append([[pf,mult]$ParFact for pf in
+         henselfact(sqff,true)],factorlist) 
+      [c,factorlist]$FinalFact
+
+    btwFact(f:UP, sqf:Boolean, fd:Set N, r:N):FinalFact ==
+      d := degree f
+      not(max(fd)=d) => error "btwFact: Bad arguments"
+      factorlist: List(ParFact) := empty()
+      -- make m primitive
+      c: Z := content f
+      f := (f exquo c)::UP
+      -- make the leading coefficient positive
+      if leadingCoefficient f < 0 then
+        c := -c
+        f := -f
+      -- is x**d factor of f
+      if (maxd := minimumDegree f) > 0 then
+        f := monicDivide(f,monomial(1,maxd)).quotient
+        factorlist := [[monomial(1,1),maxd]$ParFact]
+        r := max(2,r-maxd)::N
+        d := subtractIfCan(d,maxd)::N
+        fd := select(x+->x <= d,fd)
+      -- is f constant?
+      zero? d => [c,factorlist]$FinalFact
+      -- is f linear?
+      (d = 1) => [c,cons([f,1]$ParFact,factorlist)]$FinalFact
+      lcPol: UP := leadingCoefficient(f) :: UP
+      -- is f cyclotomic (x**n - 1)?
+      -lcPol = reductum(f) =>    -- if true, both will = 1
+        for fac in map(z+->unmakeSUP(z)$UP,
+         cyclotomicDecomposition(d)$CYC)$ListFunctions2(SUPZ,UP) repeat 
+          factorlist := cons([fac,1]$ParFact,factorlist)
+        [c,factorlist]$FinalFact
+      -- is f odd cyclotomic (x**(2*n+1) + 1)?
+      odd?(d) and (lcPol = reductum(f)) =>
+        for sfac in cyclotomicDecomposition(d)$CYC repeat
+           fac := subMinusX sfac
+           if leadingCoefficient fac < 0 then fac := -fac
+           factorlist := cons([fac,1]$ParFact,factorlist)
+        [c,factorlist]$FinalFact
+      -- is the poly of the form x**n + 1 with n a power of 2?
+      -- if so, then irreducible
+      isPowerOf2(d) and (lcPol = reductum(f)) =>
+        factorlist := cons([f,1]$ParFact,factorlist)
+        [c,factorlist]$FinalFact
+      -- other special cases to implement...
+      -- f is square-free :
+      sqf => [c, append([[pf,1]$ParFact for pf in btwFactor(f,fd,r,true)],
+       factorlist)]$FinalFact
+      -- f is not square-free :
+      sqfflist := factors squareFree(f)
+      if ((#(sqfflist)) = 1) then -- indeed f was a power of a square-free 
+        r := max(r quo ((first sqfflist).exponent),2)::N
+      else
+        r := 2
+      for sqfr in sqfflist repeat
+        mult := sqfr.exponent
+        sqff := sqfr.factor
+        d := degree sqff
+        (d = 1) => 
+          factorlist := cons([sqff,mult]$ParFact,factorlist)
+          maxd := (max(fd)-mult)::N
+          fd := select(x+->x <= maxd,fd)
+        d=2 =>
+          factorlist := append([[pf,mult]$ParFact for pf in quadratic(sqff)],
+           factorlist)
+          maxd := (max(fd)-2*mult)::N
+          fd := select(x+->x <= maxd,fd)
+        factorlist := append([[pf,mult]$ParFact for pf in 
+         btwFactor(sqff,select(x+->x <= d,fd),r,true)],factorlist)
+        maxd := (max(fd)-d*mult)::N
+        fd := select(x+->x <= maxd,fd)
+      [c,factorlist]$FinalFact
+
+    factor(f:UP):Factored UP ==
+      makeFR
+        usesinglefactorbound => btwFact(f,false,fullSet(degree f),2)
+        henselFact(f,false)
+
+    -- local function, returns true if the sum of the elements of the list
+    -- is not the degree.
+    errorsum?(d:N,ld:List N):Boolean == not (d = +/ld)
+
+    -- local function, turns list of degrees into a Set
+    makeSet(ld:List N):Set N ==
+      s := set [0]
+      for d in ld repeat s := union(s,shiftSet(s,d))
+      s
+      
+    factor(f:UP,ld:List N,r:N):Factored UP ==
+      errorsum?(degree f,ld) => error "factor: Bad arguments"
+      makeFR btwFact(f,false,makeSet(ld),r)
+
+    factor(f:UP,r:N):Factored UP == makeFR btwFact(f,false,fullSet(degree f),r)
+    
+    factor(f:UP,ld:List N):Factored UP == factor(f,ld,2)
+
+    factor(f:UP,d:N,r:N):Factored UP ==
+      n := (degree f) exquo d
+      n case "failed" => error "factor: Bad arguments"
+      factor(f,new(n::N,d)$List(N),r)
+
+    factorSquareFree(f:UP):Factored UP ==
+      makeFR
+        usesinglefactorbound => btwFact(f,true,fullSet(degree f),2)
+        henselFact(f,true)
+
+    factorSquareFree(f:UP,ld:List(N),r:N):Factored UP ==
+      errorsum?(degree f,ld) => error "factorSquareFree: Bad arguments"
+      makeFR btwFact(f,true,makeSet(ld),r)
+
+    factorSquareFree(f:UP,r:N):Factored UP ==
+      makeFR btwFact(f,true,fullSet(degree f),r)
+    
+    factorSquareFree(f:UP,ld:List N):Factored UP == factorSquareFree(f,ld,2)
+
+    factorSquareFree(f:UP,d:N,r:N):Factored UP ==
+      n := (degree f) exquo d
+      n case "failed" => error "factorSquareFree: Bad arguments"
+      factorSquareFree(f,new(n::N,d)$List(N),r)
+
+    factorOfDegree(d:P,p:UP,ld:List N,r:N,sqf:Boolean):Union(UP,"failed") ==
+      dp := degree p
+      errorsum?(dp,ld) => error "factorOfDegree: Bad arguments"
+      ((d::N) = 1) and noLinearFactor?(p) => "failed"
+      lf := btwFact(p,sqf,makeSet(ld),r).factors
+      for f in lf repeat
+        degree(f.irr)=d => return f.irr
+      "failed"
+
+    factorOfDegree(d:P,p:UP,ld:List N,r:N):Union(UP,"failed") ==
+      factorOfDegree(d,p,ld,r,false)
+
+    factorOfDegree(d:P,p:UP,r:N):Union(UP,"failed") ==
+      factorOfDegree(d,p,new(degree p,1)$List(N),r,false)
+
+    factorOfDegree(d:P,p:UP,ld:List N):Union(UP,"failed") ==
+      factorOfDegree(d,p,ld,2,false)
+
+    factorOfDegree(d:P,p:UP):Union(UP,"failed") ==
+      factorOfDegree(d,p,new(degree p,1)$List(N),2,false)
+
 *)
 
 \end{chunk}
@@ -45206,7 +62880,6 @@ GaloisGroupPolynomialUtilities(R,UP): Exports == Implementation where
     degreePartition(r:Factored UP):Multiset N ==
       multiset([ degree(nthFactor(r,i)) for i in 1..numberOfFactors r ])
 
---    monic?(p:UP):Boolean == one? leadingCoefficient p
     monic?(p:UP):Boolean == (leadingCoefficient p) = 1
 
     unvectorise(v:Vector R):UP ==
@@ -45221,7 +62894,6 @@ GaloisGroupPolynomialUtilities(R,UP): Exports == Implementation where
       r
 
     scaleRoots(p:UP,c:R):UP ==
---      one? c => p
       (c = 1) => p
       n := degree p
       zero? c => monomial(leadingCoefficient p,n)
@@ -45242,6 +62914,55 @@ GaloisGroupPolynomialUtilities(R,UP): Exports == Implementation where
 \begin{chunk}{COQ GALPOLYU}
 (* package GALPOLYU *)
 (*
+
+    import Factored UP
+
+    factorsOfDegree(d:P,r:Factored UP):List UP ==
+      lfact : List UP := empty()
+      for fr in factors r | degree(fr.factor)=(d::N) repeat
+        for i in 1..fr.exponent repeat
+          lfact := cons(fr.factor,lfact)
+      lfact
+
+    factorOfDegree(d:P,r:Factored UP):UP ==
+      factor : UP := 0
+      for i in 1..numberOfFactors r repeat
+        factor := nthFactor(r,i)
+        if degree(factor)=(d::N) then return factor
+      error "factorOfDegree: Bad arguments"
+
+    degreePartition(r:Factored UP):Multiset N ==
+      multiset([ degree(nthFactor(r,i)) for i in 1..numberOfFactors r ])
+
+    monic?(p:UP):Boolean == (leadingCoefficient p) = 1
+
+    unvectorise(v:Vector R):UP ==
+      p : UP := 0
+      for i in 1..#v repeat p := p + monomial(v(i),(i-1)::N)
+      p
+
+    reverse(p:UP):UP ==
+      r : UP := 0
+      n := degree(p)
+      for i in 0..n repeat r := r + monomial(coefficient(p,(n-i)::N),i)
+      r
+
+    scaleRoots(p:UP,c:R):UP ==
+      (c = 1) => p
+      n := degree p
+      zero? c => monomial(leadingCoefficient p,n)
+      r : UP := 0
+      mc : R := 1
+      for i in n..0 by -1 repeat
+        r := r + monomial(mc*coefficient(p,i),i)
+        mc := mc*c
+      r
+
+    import UnivariatePolynomialCategoryFunctions2(R,UP,UP,
+     SparseUnivariatePolynomial UP)
+
+    shiftRoots(p:UP,c:R):UP == elt(map(coerce,p),monomial(1,1)$UP-c::UP)::UP
+
 *)
 
 \end{chunk}
@@ -45360,6 +63081,7 @@ GaloisGroupUtilities(R): Exports == Implementation where
   Implementation ==> add
 
     if R has FloatingPointSystem then
+
       safetymargin : N := 6
       
       safeFloor(x:R):Z ==
@@ -45386,7 +63108,6 @@ GaloisGroupUtilities(R): Exports == Implementation where
       negative? r => 0
       (d := n-r) < r => pascalTriangle(n,d)
       zero? r => 1$R
---      one? r => n :: R
       (r = 1) => n :: R
       n > rangepascaltriangle => 
        binomial(n,r)$IntegerCombinatoricFunctions(Z) :: R
@@ -45427,6 +63148,70 @@ GaloisGroupUtilities(R): Exports == Implementation where
 \begin{chunk}{COQ GALUTIL}
 (* package GALUTIL *)
 (*
+
+    if R has FloatingPointSystem then
+
+      safetymargin : N := 6
+      
+      safeFloor(x:R):Z ==
+        if (shift := order(x)-precision()$R+safetymargin) >= 0 then
+          x := x+float(1,shift)
+        retract(floor(x))@Z
+
+      safeCeiling(x:R):Z ==
+        if (shift := order(x)-precision()$R+safetymargin) >= 0 then
+          x := x+float(1,shift)
+        retract(ceiling(x))@Z
+
+      safetyMargin(n:N):N == 
+        (safetymargin,n) := (n,safetymargin)
+        n
+
+      safetyMargin():N == safetymargin
+
+    pascaltriangle : FlexibleArray(R) := empty()
+    ncomputed : N := 3
+    rangepascaltriangle : N := 216
+
+    pascalTriangle(n:N, r:Z):R ==
+      negative? r => 0
+      (d := n-r) < r => pascalTriangle(n,d)
+      zero? r => 1$R
+      (r = 1) => n :: R
+      n > rangepascaltriangle => 
+       binomial(n,r)$IntegerCombinatoricFunctions(Z) :: R
+      n <= ncomputed =>
+        m := divide(n-4,2)
+        mq := m.quotient
+        pascaltriangle((mq+1)*(mq+m.remainder)+r-1)
+      -- compute the missing lines
+      for i in (ncomputed+1)..n repeat
+        for j in 2..(i quo 2) repeat
+          pascaltriangle := concat!(pascaltriangle,pascalTriangle((i-1) 
+           :: N, j-1)+pascalTriangle((i-1) :: N,j))
+        ncomputed := i
+      pascalTriangle(n,r)
+
+    rangePascalTriangle(n:N):N ==
+      if n<ncomputed then
+        if n<3 then
+          pascaltriangle := delete!(pascaltriangle,1..#pascaltriangle)
+          ncomputed := 3
+        else
+          d := divide(n-3,2)
+          dq := d.quotient
+          pascaltriangle := delete!(pascaltriangle,((dq+1)*(dq+d.remainder)
+           +1)..#pascaltriangle)
+          ncomputed := n
+      (rangepascaltriangle,n) := (n,rangepascaltriangle)
+      n
+
+    rangePascalTriangle():N == rangepascaltriangle
+
+    sizePascalTriangle():N == #pascaltriangle
+
+    fillPascalTriangle():Void == pascalTriangle(rangepascaltriangle,2)
+
 *)
 
 \end{chunk}
@@ -45516,6 +63301,7 @@ GaussianFactorizationPackage() : C == T
        ++ prime?(zi) tests if the complex integer zi is prime.
 
   T  == add
+
      import IntegerFactorizationPackage Z
 
      reduction(u:Z,p:Z):Z ==
@@ -45531,7 +63317,8 @@ GaussianFactorizationPackage() : C == T
      exactquo(u:Z,v:Z,p:Z):Union(Z,"failed") ==
         p=0 => u exquo v
         v rem p = 0 => "failed"
-        positiveRemainder((extendedEuclidean(v,p,u)::Record(coef1:Z,coef2:Z)).coef1,p)
+        positiveRemainder(_
+          (extendedEuclidean(v,p,u)::Record(coef1:Z,coef2:Z)).coef1,p)
 
      FMod := ModularRing(Z,Z,reduction,merge,exactquo)
 
@@ -45555,7 +63342,6 @@ GaussianFactorizationPackage() : C == T
          t:=t**2
        s::Z
 
-
      ---- write p, congruent to 1 mod 4, as a sum of two squares ----
      sumsq1(p:Z) : List Z ==
        s:= findelt(p)
@@ -45577,9 +63363,7 @@ GaussianFactorizationPackage() : C == T
          n=2 =>
            r :=concat(["prime",fact2,2*exp]$FFE,r)
            unity:=unity*complex(0,-1)**(exp rem 4)::NNI
-
          (n rem 4) = 3 => r:=concat(["prime",complex(n,0),exp]$FFE,r)
-
          sz:=sumsq1(n)
          z:=complex(sz.1,sz.2)
          r:=concat(["prime",z,exp]$FFE,
@@ -45590,18 +63374,14 @@ GaussianFactorizationPackage() : C == T
      factor(m:ZI) : FRZ ==
        m=0 => primeFactor(0,1)
        a:= real m
-
        (b:= imag m)=0 => intfactor(a) :: FRZ
-
        a=0 =>
          ris:=intfactor(b)
          unity:= unit(ris)*complex(0,1)
          makeFR(unity,factorList ris)
-
        d:=gcd(a,b)
        result : List FFE :=[]
        unity:ZI:=1$ZI
-
        if d^=1 then
          a:=(a exquo d)::Z
          b:=(b exquo d)::Z
@@ -45609,7 +63389,6 @@ GaussianFactorizationPackage() : C == T
          result:=factorList r
          unity:=unit r
          m:=complex(a,b)
-
        n:Z:=a**2+b**2
        factn:= factorList(factor n)
        part:FFE:=["prime",0$ZI,0]
@@ -45620,19 +63399,16 @@ GaussianFactorizationPackage() : C == T
            part:= ["prime",fact2,exp]$FFE
            m:=m quo (fact2**exp:NNI)
            result:=concat(part,result)
-
          (n rem 4) = 3 =>
            g0:=complex(n,0)
            part:= ["prime",g0,exp quo 2]$FFE
            m:=m quo g0
            result:=concat(part,result)
-
          z:=gcd(m,complex(n,0))
          part:= ["prime",z,exp]$FFE
          z:=z**(exp:NNI)
          m:=m quo z
          result:=concat(part,result)
-
        if m^=1 then unity:=unity * m
        makeFR(unity,result)
 
@@ -45642,7 +63418,6 @@ GaussianFactorizationPackage() : C == T
        p rem 4 ^= 1 => error "no solutions"
        sumsq1(p)
 
-
      prime?(a:ZI) : Boolean ==
         n : Z := norm a
         n=0 => false            -- zero
@@ -45662,6 +63437,137 @@ GaussianFactorizationPackage() : C == T
 \begin{chunk}{COQ GAUSSFAC}
 (* package GAUSSFAC *)
 (*
+
+     import IntegerFactorizationPackage Z
+
+     reduction(u:Z,p:Z):Z ==
+       p=0 => u
+       positiveRemainder(u,p)
+
+     merge(p:Z,q:Z):Union(Z,"failed") ==
+       p = q => p
+       p = 0 => q
+       q = 0 => p
+       "failed"
+
+     exactquo(u:Z,v:Z,p:Z):Union(Z,"failed") ==
+        p=0 => u exquo v
+        v rem p = 0 => "failed"
+        positiveRemainder(_
+          (extendedEuclidean(v,p,u)::Record(coef1:Z,coef2:Z)).coef1,p)
+
+     FMod := ModularRing(Z,Z,reduction,merge,exactquo)
+
+     fact2:ZI:= complex(1,1)
+
+             ----  find the solution of x**2+1 mod q  ----
+     findelt(q:Z) : Z ==
+       q1:=q-1
+       r:=q1
+       r1:=r exquo 4
+       while ^(r1 case "failed") repeat
+         r:=r1::Z
+         r1:=r exquo 2
+       s : FMod := reduce(1,q)
+       qq1:FMod :=reduce(q1,q)
+       for i in 2.. while (s=1 or s=qq1) repeat
+         s:=reduce(i,q)**(r::NNI)
+       t:=s
+       while t^=qq1 repeat
+         s:=t
+         t:=t**2
+       s::Z
+
+     ---- write p, congruent to 1 mod 4, as a sum of two squares ----
+     sumsq1(p:Z) : List Z ==
+       s:= findelt(p)
+       u:=p
+       while u**2>p repeat
+         w:=u rem s
+         u:=s
+         s:=w
+       [u,s]
+
+            ---- factorization of an integer  ----
+     intfactor(n:Z) : Factored ZI ==
+       lfn:= factor n
+       r : List FFE :=[]
+       unity:ZI:=complex(unit lfn,0)
+       for term in (factorList lfn) repeat
+         n:=term.fctr
+         exp:=term.xpnt
+         n=2 =>
+           r :=concat(["prime",fact2,2*exp]$FFE,r)
+           unity:=unity*complex(0,-1)**(exp rem 4)::NNI
+         (n rem 4) = 3 => r:=concat(["prime",complex(n,0),exp]$FFE,r)
+         sz:=sumsq1(n)
+         z:=complex(sz.1,sz.2)
+         r:=concat(["prime",z,exp]$FFE,
+                 concat(["prime",conjugate(z),exp]$FFE,r))
+       makeFR(unity,r)
+
+           ---- factorization of a gaussian number  ----
+     factor(m:ZI) : FRZ ==
+       m=0 => primeFactor(0,1)
+       a:= real m
+       (b:= imag m)=0 => intfactor(a) :: FRZ
+       a=0 =>
+         ris:=intfactor(b)
+         unity:= unit(ris)*complex(0,1)
+         makeFR(unity,factorList ris)
+       d:=gcd(a,b)
+       result : List FFE :=[]
+       unity:ZI:=1$ZI
+       if d^=1 then
+         a:=(a exquo d)::Z
+         b:=(b exquo d)::Z
+         r:= intfactor(d)
+         result:=factorList r
+         unity:=unit r
+         m:=complex(a,b)
+       n:Z:=a**2+b**2
+       factn:= factorList(factor n)
+       part:FFE:=["prime",0$ZI,0]
+       for term in factn repeat
+         n:=term.fctr
+         exp:=term.xpnt
+         n=2 =>
+           part:= ["prime",fact2,exp]$FFE
+           m:=m quo (fact2**exp:NNI)
+           result:=concat(part,result)
+         (n rem 4) = 3 =>
+           g0:=complex(n,0)
+           part:= ["prime",g0,exp quo 2]$FFE
+           m:=m quo g0
+           result:=concat(part,result)
+         z:=gcd(m,complex(n,0))
+         part:= ["prime",z,exp]$FFE
+         z:=z**(exp:NNI)
+         m:=m quo z
+         result:=concat(part,result)
+       if m^=1 then unity:=unity * m
+       makeFR(unity,result)
+
+           ----  write p prime like sum of two squares  ----
+     sumSquares(p:Z) : List Z ==
+       p=2 => [1,1]
+       p rem 4 ^= 1 => error "no solutions"
+       sumsq1(p)
+
+     prime?(a:ZI) : Boolean ==
+        n : Z := norm a
+        n=0 => false            -- zero
+        n=1 => false            -- units
+        prime?(n)$IntegerPrimesPackage(Z)  => true
+        re : Z := real a
+        im : Z := imag a
+        re^=0 and im^=0 => false
+        p : Z := abs(re+im)     -- a is of the form p, -p, %i*p or -%i*p
+        p rem 4 ^= 3 => false
+        -- return-value true, if p is a rational prime,
+        -- and false, otherwise
+        prime?(p)$IntegerPrimesPackage(Z)
+
 *)
 
 \end{chunk}
@@ -45750,6 +63656,7 @@ GeneralHenselPackage(RP,TP):C == T where
         ++ reduction(u,pol) computes the symmetric reduction of u mod pol
 
    T == add
+
      GenExEuclid: (List(FP),List(FP),FP) -> List(FP)
      HenselLift1: (TP,List(TP),List(FP),List(FP),RP,RP,F) -> List(TP)
      mQuo: (TP,RP) -> TP
@@ -45874,6 +63781,126 @@ GeneralHenselPackage(RP,TP):C == T where
 \begin{chunk}{COQ GHENSEL}
 (* package GHENSEL *)
 (*
+
+     GenExEuclid: (List(FP),List(FP),FP) -> List(FP)
+     HenselLift1: (TP,List(TP),List(FP),List(FP),RP,RP,F) -> List(TP)
+     mQuo: (TP,RP) -> TP
+
+     reduceCoef(c:RP,p:RP):RP ==
+        zero? p => c
+        RP is Integer => symmetricRemainder(c,p)
+        c rem p
+
+     reduction(u:TP,p:RP):TP ==
+        zero? p => u
+        RP is Integer => map(x+->symmetricRemainder(x,p),u)
+        map(x+->x rem p,u)
+
+     merge(p:RP,q:RP):Union(RP,"failed") ==
+         p = q => p
+         p = 0 => q
+         q = 0 => p
+         "failed"
+
+     modInverse(c:RP,p:RP):RP ==
+        (extendedEuclidean(c,p,1)::Record(coef1:RP,coef2:RP)).coef1
+
+     exactquo(u:TP,v:TP,p:RP):Union(TP,"failed") ==
+        invlcv:=modInverse(leadingCoefficient v,p)
+        r:=monicDivide(u,reduction(invlcv*v,p))
+        reduction(r.remainder,p) ^=0 => "failed"
+        reduction(invlcv*r.quotient,p)
+
+     FP:=EuclideanModularRing(RP,TP,RP,reduction,merge,exactquo)
+
+     mQuo(poly:TP,n:RP) : TP == map(x+->x quo n,poly)
+
+     GenExEuclid(fl:List FP,cl:List FP,rhs:FP) :List FP ==
+        [clp*rhs rem flp for clp in cl for flp in fl]
+
+     -- generate the possible factors
+     genFact(fln:List TP,factlist:List List TP) : List List TP ==
+       factlist=[] => [[pol] for pol in fln]
+       maxd := +/[degree f for f in fln] quo 2
+       auxfl:List List TP := []
+       for poly in fln while factlist^=[] repeat
+         factlist := [term for term in factlist | ^member?(poly,term)]
+         dp := degree poly
+         for term in factlist repeat
+           (+/[degree f for f in term]) + dp > maxd => "next term"
+           auxfl := cons(cons(poly,term),auxfl)
+       auxfl
+
+     HenselLift1(poly:TP,fln:List TP,fl1:List FP,cl1:List FP,
+                 prime:RP,Modulus:RP,cinv:RP):List TP ==
+        lcp := leadingCoefficient poly
+        rhs := reduce(mQuo(poly - lcp * */fln,Modulus),prime)
+        zero? rhs => fln
+        lcinv:=reduce(cinv::TP,prime)
+        vl := GenExEuclid(fl1,cl1,lcinv*rhs)
+        [flp + Modulus*(vlp::TP) for flp in fln for vlp in vl]
+
+     HenselLift(poly:TP,tl1:List TP,prime:RP,bound:PI) ==
+        -- convert tl1
+        constp:TP:=0
+        if degree first tl1 = 0 then
+           constp:=tl1.first
+           tl1 := rest tl1
+        fl1:=[reduce(ttl,prime) for ttl in tl1]
+        cl1 := multiEuclidean(fl1,1)::List FP
+        Modulus:=prime
+        fln :List TP := [ffl1::TP for ffl1 in fl1]
+        lcinv:RP:=retract((inv
+                  (reduce((leadingCoefficient poly)::TP,prime)))::TP)
+        while euclideanSize(Modulus)<bound repeat
+           nfln:=HenselLift1(poly,fln,fl1,cl1,prime,Modulus,lcinv)
+           fln = nfln and zero?(err:=poly-*/fln) => leave "finished"
+           fln := nfln
+           Modulus := prime*Modulus
+        if constp^=0 then fln:=cons(constp,fln)
+        [fln,Modulus]
+
+     completeHensel(m:TP,tl1:List TP,prime:RP,bound:PI) ==
+      hlift:=HenselLift(m,tl1,prime,bound)
+      Modulus:RP:=hlift.modulo
+      fln:List TP:=hlift.plist
+      nm := degree m
+      u:Union(TP,"failed")
+      aux,auxl,finallist:List TP
+      auxfl,factlist:List List TP
+      factlist := []
+      dfn :NonNegativeInteger := nm
+      lcm1 := leadingCoefficient m
+      mm := lcm1*m
+      while dfn>0 and (factlist := genFact(fln,factlist))^=[] repeat
+        auxfl := []
+        while factlist^=[] repeat
+          auxl := factlist.first
+          factlist := factlist.rest
+          tc := reduceCoef((lcm1 * */[coefficient(poly,0)
+                          for poly in auxl]), Modulus)
+          coefficient(mm,0) exquo tc case "failed" =>
+            auxfl := cons(auxl,auxfl)
+          pol := */[poly for poly in auxl]
+          poly :=reduction(lcm1*pol,Modulus)
+          u := mm exquo poly
+          u case "failed"  => auxfl := cons(auxl,auxfl)
+          poly1: TP := primitivePart poly
+          m := mQuo((u::TP),leadingCoefficient poly1)
+          lcm1 := leadingCoefficient(m)
+          mm := lcm1*m
+          finallist := cons(poly1,finallist)
+          dfn := degree m
+          aux := []
+          for poly in fln repeat
+            ^member?(poly,auxl) => aux := cons(poly,aux)
+            auxfl := [term for term in auxfl | ^member?(poly,term)]
+            factlist := [term for term in factlist |^member?(poly,term)]
+          fln := aux
+        factlist := auxfl
+      if dfn > 0 then finallist := cons(m,finallist)
+      finallist
+
 *)
 
 \end{chunk}
@@ -45959,6 +63986,7 @@ GeneralizedMultivariateFactorize(OV,E,S,R,P) : C == T
       ++ domain
 
   T == add
+
     factor(p:P) : Factored P ==
       R has FiniteFieldCategory => factor(p)$MultFiniteFactorize(OV,E,R,P)
       R is Polynomial(S) and S has EuclideanDomain =>
@@ -45977,6 +64005,20 @@ GeneralizedMultivariateFactorize(OV,E,S,R,P) : C == T
 \begin{chunk}{COQ GENMFACT}
 (* package GENMFACT *)
 (*
+
+    factor(p:P) : Factored P ==
+      R has FiniteFieldCategory => factor(p)$MultFiniteFactorize(OV,E,R,P)
+      R is Polynomial(S) and S has EuclideanDomain =>
+         factor(p)$MPolyCatPolyFactorizer(E,OV,S,P)
+      R is Fraction(S) and S has CharacteristicZero and 
+        S has EuclideanDomain =>
+            factor(p)$MRationalFactorize(E,OV,S,P)
+      R is Fraction Polynomial S =>
+         factor(p)$MPolyCatRationalFunctionFactorizer(E,OV,S,P)
+      R has CharacteristicZero and R has EuclideanDomain =>
+               factor(p)$MultivariateFactorize(OV,E,R,P)
+      squareFree p
+
 *)
 
 \end{chunk}
@@ -46293,6 +64335,7 @@ GeneralPackageForAlgebraicFunctionField( K,
         ++ extension. Calculated by using the L-Polynomial
         
   Implementation ==>  add
+
     import PPFC1
     import PPFC2
     import DesTrPack
@@ -46762,49 +64805,514 @@ GeneralPackageForAlgebraicFunctionField( K,
 \begin{chunk}{COQ GPAFF}
 (* package GPAFF *)
 (*
-*)
 
-\end{chunk}
+    import PPFC1
+    import PPFC2
+    import DesTrPack
+    import IntFrmPack
+    import IntDivPack
+    import RatSingPack
+    import ParamPack
+    import ParamPackFC
+    import PackPoly
 
-\begin{chunk}{GPAFF.dotabb}
-"GPAFF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=GPAFF"]
-"DTP" [color="#FF4488",href="bookvol10.4.pdf#nameddest=DTP"]
-"INTDIVP" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTDIVP"]
-"GPAFF" -> "INTDIVP"
-"GPAFF" -> "DTP"
+    crvLocal:PolyRing:=1$PolyRing
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{package GENPGCD GeneralPolynomialGcdPackage}
-\begin{chunk}{GeneralPolynomialGcdPackage.input}
-)set break resume
-)sys rm -f GeneralPolynomialGcdPackage.output
-)spool GeneralPolynomialGcdPackage.output
-)set message test on
-)set message auto off
-)clear all
+    -- flags telling such and such is already computed.
 
---S 1 of 1
-)show GeneralPolynomialGcdPackage
---R 
---R GeneralPolynomialGcdPackage(E: OrderedAbelianMonoidSup,OV: OrderedSet,R: PolynomialFactorizationExplicit,P: PolynomialCategory(R,E,OV))  is a package constructor
---R Abbreviation for GeneralPolynomialGcdPackage is GENPGCD 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.4.pamphlet to see algebra source code for GENPGCD 
---R
---R------------------------------- Operations --------------------------------
---R randomR : () -> R                    
---R gcdPolynomial : (SparseUnivariatePolynomial(P),SparseUnivariatePolynomial(P)) -> SparseUnivariatePolynomial(P)
---R
---E 1
+    genusCalc?:Boolean:= false()$Boolean
+    theGenus:INT:=0
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{GeneralPolynomialGcdPackage.help}
-====================================================================
-GeneralPolynomialGcdPackage examples
-====================================================================
+    desingTreeCalc?:Boolean:=false()$Boolean
+    theTree:List DesTree := empty()
+
+    desingTreeWoFullParamCalc?:Boolean:=false()$Boolean
+
+    adjDivCalc?:Boolean:=false()$Boolean
+    theAdjDiv:DIVISOR:=0
+
+    singularPointsCalc?:Boolean:=false()$Boolean
+    lesPtsSing:List(ProjPt):=empty()
+
+    rationalPointsCalc?:Boolean:=false()$Boolean
+    lesRatPts:List(ProjPt):=empty()
+
+    rationalPlacesCalc?:Boolean:=false()$Boolean
+    lesRatPlcs:List(Plc):=empty()
+
+    zf:UTSZ:=1$UTSZ
+    zfCalc : Boolean := false()$Boolean
+
+    DegOfPlacesFound: List Integer := empty()
+
+    -- see package IntersectionDivisorPackage
+    intersectionDivisor(pol)==
+      if ^(pol =$PolyRing homogenize(pol,1)) then _
+        error _
+         "From intersectionDivisor: the input is NOT a homogeneous polynomial"
+      intersectionDivisor(pol,theCurve(),desingTree(),singularPoints())
+
+    lBasis(divis)==
+      d:=degree divis
+      d < 0 => [[0$PolyRing],1$PolyRing]
+      A:=adjunctionDivisor()
+      -- modifie le 08/05/97: avant c'etait formToInterp:=divOfZero(divis) + A
+      formToInterp:=  divOfZero(divis + A)
+      degDpA:=degree  formToInterp
+      degCrb:=totalDegree(theCurve())$PackPoly
+      dd:=divide(degDpA,degCrb pretend Integer)
+      dmin:NNI:=
+        if ^zero?(dd.remainder) then (dd.quotient+1) pretend NNI
+        else dd.quotient pretend NNI
+      print("Trying to interpolate with forms of degree:"::OF)
+      print(dmin::OF)
+      lg0:List PolyRing:=interpolateForms(formToInterp,dmin)
+      while zero?(first lg0) repeat
+        dmin:=dmin+1
+        print("Trying to interpolate with forms of degree:"::OF)
+        print(dmin::OF)
+        lg0:=interpolateForms(formToInterp,dmin)
+      print("Denominator found"::OF)
+      g0:PolyRing:=first lg0
+      dg0:=intersectionDivisor(g0)
+      print("Intersection Divisor of Denominator found"::OF)
+      lnumer:List PolyRing:=interpolateForms(dg0-divis,dmin)
+      [lnumer,g0]
+
+    genus==
+      if ^(genusCalc?) then
+        degCrb:=totalDegree(theCurve())$PackPoly
+        theGenus:=genusTreeNeg(degCrb,desingTreeWoFullParam())
+        genusCalc?:=true()$Boolean
+      theGenus < 0 => 
+        print(("Too many infinitly near points")::OF)
+        print(("The curve may not be absolutely irreducible")::OF)
+        error "Have a nice day"
+      theGenus pretend NNI
+
+    genusNeg==
+      if ^(genusCalc?) then
+        degCrb:=totalDegree(theCurve())$PackPoly
+        theGenus:=genusTreeNeg(degCrb,desingTreeWoFullParam())
+        genusCalc?:=true()$Boolean
+      theGenus 
+
+    homogenize(pol,n)== homogenize(pol,n)$PackPoly
+
+    fPl(pt:ProjPt,desTr:DesTree):Boolean ==
+      nd:=value desTr
+      lpt:=pointV nd
+      pt = lpt
+
+
+    placesAbove(pt)==
+      -- verifie si le point est simple, si c'est le cas, 
+      -- on retourne la place correpondante
+      -- avec pointToPlace qui cre' la place si necessaire.
+      ^member?(pt,singularPoints()) => _
+        [pointToPlace(pt,theCurve())$ParamPackFC]
+      -- les quatres lignes suivantes trouvent les feuilles qui 
+      -- sont au-dessus du point.
+      theTree:= desingTree()
+      cTree:= find(fPl(pt,#1),theTree)
+      cTree case "failed" => error "Big error in placesAbove"
+        -- G. Hache, gaetan.hache@inria.fr"
+      lvs:=leaves cTree
+      -- retourne les places correspondant aux feuilles en "consultant" 
+      -- les diviseurs exceptionnels.
+      concat [supp excpDivV(l) for l in lvs]
+
+    pointDominateBy(pl)== pointDominateBy(pl)$ParamPackFC
+
+    reduceForm(p1:PolyRing,p2:PolyRing):PolyRing==
+      normalForm(p1,[p2])$GroebnerPackage(K,E,OV,PolyRing)
+
+    evalIfCan(f:PolyRing,pl:Plc)==
+      u:=reduceForm(f, theCurve() ) 
+      zero?(u) => 0
+      pf:= parametrize(f,pl)
+      ord:INT:=order pf 
+      ord < 0 => "failed"
+      ord > 0 => 0
+      coefOfFirstNonZeroTerm pf
+
+    eval(f:PolyRing,pl:Plc)==
+      eic:=evalIfCan(f,pl)
+      eic case "failed" => _
+        error "From eval (function at place): its a pole !!!"
+      eic    
+
+    setCurve(pol)==
+      crvLocal:=pol
+      ^(crvLocal =$PolyRing homogenize(crvLocal,1)) =>
+        print(("the defining polynomial is not homogeneous")::OF)
+        error "Have a nice day"
+      reset()
+      theCurve()
+      
+    reset == 
+      setFoundPlacesToEmpty()$Plc
+      genusCalc?:Boolean:= false()$Boolean
+      theGenus:INT:=0
+      desingTreeCalc?:Boolean:=false()$Boolean
+      desingTreeWoFullParamCalc?:Boolean:=false()$Boolean
+      theTree:List DesTree := empty()
+      adjDivCalc?:Boolean:=false()$Boolean
+      theAdjDiv:DIVISOR:=0
+      singularPointsCalc?:Boolean:=false()$Boolean
+      lesPtsSing:List(ProjPt):=empty()
+      rationalPointsCalc?:Boolean:=false()$Boolean
+      lesRatPts:List(ProjPt):=empty()
+      rationalPlacesCalc?:Boolean:=false()$Boolean
+      lesRatPlcs:List(Plc):=empty()
+      DegOfPlacesFound: List Integer := empty()
+      zf:UTSZ:=1$UTSZ
+      zfCalc:Boolean := false$Boolean
+
+    foundPlacesOfDeg?(i:PositiveInteger):Boolean ==
+      ld: List Boolean := [zero?(a rem i) for a in DegOfPlacesFound]
+      entry?(true$Boolean,ld)
+
+    findOrderOfDivisor(divis,lb,hb) ==
+      ^zero?(degree divis) => error("The divisor is NOT of degre zero !!!!")
+      A:=adjunctionDivisor()
+      formToInterp:=divOfZero ( hb*divis + A )
+      degDpA:=degree formToInterp
+      degCrb:=totalDegree( theCurve())$PackPoly
+      dd:=divide(degDpA,degCrb pretend Integer)
+      dmin:NNI:=
+        if ^zero?(dd.remainder) then (dd.quotient+1) pretend NNI
+        else dd.quotient pretend NNI
+      lg0:List PolyRing:=interpolateForms(formToInterp,dmin)
+      while zero?(first lg0) repeat
+        dmin:=dmin+1
+        lg0:=interpolateForms(formToInterp,dmin)
+      g0:PolyRing:=first lg0
+      dg0:=intersectionDivisor(g0)
+      nhb:=hb
+      while effective?(dg0 - nhb*divis - A) repeat
+        nhb:=nhb+1
+      nhb:=nhb-1
+      ftry:=lb
+      lnumer:List PolyRing:=interpolateForms(dg0-ftry*divis,dmin)
+      while zero?(first lnumer) and ftry < nhb repeat
+        ftry:=ftry + 1
+        lnumer:List PolyRing:=interpolateForms(dg0-ftry*divis,dmin)
+      [ftry,first lnumer,g0,nhb]
+
+    theCurve==
+      one?(crvLocal) => error "The defining polynomial has not been set yet!"
+      crvLocal
+
+    printInfo(lbool)==
+      printInfo(lbool.2)$ParamPackFC
+      printInfo(lbool.3)$PCS
+      void()
+
+    desingTree==
+      theTree:= desingTreeWoFullParam()
+      if ^(desingTreeCalc?) then
+        for arb in theTree repeat
+          fullParamInit(arb)
+        desingTreeCalc?:=true()$Boolean
+      theTree
+
+    desingTreeWoFullParam==
+      if ^(desingTreeWoFullParamCalc?) then
+        theTree:=[desingTreeAtPoint(pt,theCurve())  for pt in singularPoints()]
+        desingTreeWoFullParamCalc?:=true()$Boolean
+      theTree
+
+    -- compute the adjunction divisor of the curve using adjunctionDivisor 
+    -- from DesingTreePackage
+    adjunctionDivisor()==
+      if ^(adjDivCalc?) then
+        theAdjDiv:=_
+          reduce("+",[adjunctionDivisor(tr) for tr in desingTree()],0$DIVISOR)
+        adjDivCalc?:=true()$Boolean
+      theAdjDiv
+
+    -- returns the singular points using the function singularPoints 
+    -- from ProjectiveAlgebraicSetPackage
+    singularPoints==
+      if ^(singularPointsCalc?) then
+        lesPtsSing:=singularPoints(theCurve())
+        singularPointsCalc?:=true()$Boolean
+      lesPtsSing
+
+    setSingularPoints(lspt)==
+      singularPointsCalc?:=true()$Boolean
+      lesPtsSing:= lspt
+ 
+    -- returns the rational points using the function rationalPoints 
+    -- from ProjectiveAlgebraicSetPackage
+
+    -- compute the local parametrization of f at the place pl 
+    -- (from package ParametrizationPackage)
+    parametrize(f,pl)==parametrize(f,pl)$ParamPack
+
+    -- compute the interpolating forms (see package InterpolateFormsPackage)
+    interpolateForms(d,n)==
+      lm:List PolyRing:=listAllMono(n)$PackPoly
+      interpolateForms(d,n,theCurve(),lm)
+
+    interpolateFormsForFact(d,lm)==
+      interpolateFormsForFact(d,lm)$IntFrmPack
+
+    evalIfCan(f:PolyRing,g:PolyRing,pl:Plc)==
+      fu:=reduceForm(f,theCurve())
+      gu:=reduceForm(g,theCurve())
+      zero?(fu) and ^zero?(gu) => 0
+      ^zero?(fu) and zero?(gu) => "failed"
+      pf:= parametrize(fu,pl)
+      pg:= parametrize(gu,pl)
+      ordf:INT:=order pf
+      ordg:INT:=order pg
+      cf:=coefOfFirstNonZeroTerm pf
+      cg:=coefOfFirstNonZeroTerm pg
+      (ordf - ordg) < 0 => "failed"
+      (ordf - ordg) > 0 => 0
+      cf * inv cg
+
+    eval(f:PolyRing,g:PolyRing,pl:Plc)==
+      eic:=evalIfCan(f,g,pl)
+      eic case "failed" => error "From eval (function at place): its a pole"
+      eic
+
+    evalIfCan(u:FRACPOLY,pl:Plc)==
+      f:PolyRing := numer u
+      g:PolyRing := denom u
+      evalIfCan(f,g,pl)
+      
+    eval(u:FRACPOLY,pl:Plc)==
+      f:PolyRing := numer u
+      g:PolyRing := denom u
+      eval(f,g,pl)
+    
+    thedeg:PI := 1
+    
+    crap(p:Plc):Boolean ==
+      degree(p)$Plc = thedeg
+    
+    if K has Finite then 
+      rationalPlaces == 
+        K has PseudoAlgebraicClosureOfFiniteFieldCategory => _
+           placesOfDegree(1$PI)
+        --non good pour LACF !!!!
+        rationalPlacesCalc? => lesRatPlcs
+        ltr:List(DesTree):=desingTree()
+        ratP:List(ProjPt):=rationalPoints()
+        singP:List(ProjPt):=singularPoints()
+        simRatP:List(ProjPt):=setDifference(ratP,singP)
+        for pt in simRatP repeat
+          pointToPlace(pt,theCurve())$ParamPackFC
+        rationalPlacesCalc? := true()$Boolean
+        lesRatPlcs:=foundPlaces()$Plc
+        lesRatPlcs
+
+      rationalPoints==
+        if ^(rationalPointsCalc?) then
+          if K has Finite then
+            lesRatPts:= rationalPoints(theCurve(),1)$RatSingPack
+            rationalPointsCalc?:=true()$Boolean
+          else
+            error "Can't find rationalPoints when the field is not finite"
+        lesRatPts
+    
+      ZetaFunction() ==
+        if not zfCalc then
+	  zf:= ZetaFunction(1)
+          zfCalc:= true$Boolean
+	zf
+                  
+      ZetaFunction(d) ==
+	  lp:= LPolynomial(d)
+	  if K has PseudoAlgebraicClosureOfFiniteFieldCategory then
+	    setTower!(1$K)
+	  q:INT := size()$K ** d
+	  lpt:UPZ := unmakeSUP(lp)$UPZ
+	  lps:UTSZ := coerce(lpt)$UTSZ
+	  x:= monomial(1,1)$UTSZ
+	  mul: UTSZ := (1-x)*(1 - q * x)
+	  invmul:Union(UTSZ,"failed") := recip(mul)$UTSZ
+	  ivm: UTSZ
+	  if not (invmul case "failed") then 
+	    ivm := invmul pretend UTSZ
+	  else
+	    ivm := 1
+          lps * ivm
+      
+      calculatedSer: List UTSZ:= [1]
+        --in index i is the "almost ZetaFunction" summed to i-1. 
+	--Except calculatedSer.1 which is 1
+      
+      numberOfPlacesOfDegreeUsingZeta(degree:PI): Integer  == 
+        --is at most called once for each degree. Will calculate the
+	--entries in calculatdSer. 
+        ser:UTSZ := 1
+	x:= monomial(1,1)$UTSZ
+	pol:UTSZ
+	polser:Union(UTSZ,"failed")
+	serdel:UTSZ
+	i:PI := maxIndex(calculatedSer) pretend PI
+	while i < degree repeat
+	  serdel:= 1
+	  if (n:= numberOfPlacesOfDegree(i)) > 0 then 
+	    pol:= (1-x**i) ** (n pretend PI)
+	    polser:= recip(pol)$UTSZ -- coerce(pol)$UTSZ)$UTSZ
+	    if not (polser case "failed") then
+	      serdel:= (polser pretend UTSZ)
+	    else
+	      error "In numberOfPlacesOfDegreeUsingZeta. This shouldn't happen"
+	  ser:= serdel * calculatedSer.i
+	  calculatedSer:= concat(calculatedSer, ser)
+	  i:= i + 1
+	if degree = 1 then 
+	  coefficient(ZetaFunction(),degree)
+        else
+	  coefficient(ZetaFunction(),degree) - _
+           coefficient(calculatedSer.degree, degree)
+
+      calculatedNP: List Integer := empty()
+        --local variable, in index i is number of places of degree i.
+      
+      numberOfPlacesOfDegree(i:PI): Integer ==
+         if zfCalc then
+	   if (m := maxIndex(calculatedNP)) < i then
+	     calculatedNP:= _
+               concat(calculatedNP, _
+                 [numberOfPlacesOfDegreeUsingZeta(j pretend PI) _
+                   for j in ((m+1) pretend PI)..i])
+	   calculatedNP.i
+	 else
+	   # placesOfDegree(i) --maybe we should make an improvement in this
+	         	         
+      placesOfDegree(i) ==
+        if (not foundPlacesOfDeg?(i)) then
+	   if characteristic()$K**i > (2**16 - 1) then
+	     print("If you are using a prime field and"::OF)
+             print("GB this will not work."::OF)
+	   desingTree()
+	   placesOfDegree(i,theCurve(),singularPoints())
+	   DegOfPlacesFound:= concat(DegOfPlacesFound, i)
+	thedeg:= i
+	select(crap(#1), foundPlaces()$Plc)
+	
+      numberRatPlacesExtDeg(extDegree:PI): Integer ==
+        numberPlacesDegExtDeg(1,extDegree)
+	
+      numberPlacesDegExtDeg(degree:PI, extDegree:PI): Integer ==
+        res:Integer:=0
+	m:PI := degree * extDegree
+	d: PI
+	while m > 0 repeat
+	  d:= gcd(m, extDegree)
+	  if (m quo d) = degree then
+	    res:= res + (numberOfPlacesOfDegree(m) * d)
+	  m:= (m - 1) pretend PI
+	res
+	
+      calculateS(extDeg:PI): List Integer ==
+        g := genus()
+	sizeK:NNI := size()$K ** extDeg
+	i:PositiveInteger := g pretend PI
+	S: List Integer := [0 for j in 1..g]
+	good:Boolean := true()$Boolean
+	while good repeat
+	  S.i := numberRatPlacesExtDeg(i*extDeg) - ((sizeK **$NNI i) + 1)
+	  j:Integer := i - 1
+	  if (not (j = 0))  then
+	    i:= (j pretend PI)
+	  else good:= false()$Boolean
+	S
+      
+      LPolynomial(): SparseUnivariatePolynomial Integer ==
+        LPolynomial(1)
+      
+      LPolynomial(extDeg:PI): SparseUnivariatePolynomial Integer ==
+        --when translating to AxiomXL rewrite this function!
+	g := genus()
+	zero?(g) => 1
+	coef: List Integer := [1]
+	if K has PseudoAlgebraicClosureOfFiniteFieldCategory then
+	  setTower!(1$K)
+        sizeK:Integer := size()$K ** extDeg  --need to do a setExtension before
+        coef:= concat(coef,[0 for j in 1..(2*g)])
+	S: List Integer := calculateS(extDeg)
+	i:PI := 1
+	tmp:Integer
+        while i < g + 1 repeat
+          j:PI := 1
+	  tmp:= 0
+	  while j < i + 1 repeat
+	    tmp:= tmp + S.j * coef((i + 1 - j) pretend PI)
+	    j:= j + 1
+	  coef.(i+1) := tmp quo i
+	  i:= i + 1
+	i:= 1
+	while i < g + 1 repeat
+          ss: Integer := sizeK **$Integer ((g + 1 - i) pretend PI)
+          val:Integer := ss * coef.i
+          coef.((2*g+2 - i) pretend PI) := val
+	  i:= i + 1
+	x:= monomial(1,1)$SUP(INT)
+        result: SparseUnivariatePolynomial(Integer):= _
+          1$SparseUnivariatePolynomial(Integer)
+	coef:= rest(coef)	
+	i:= 1
+	while i < 2 * g + 1 repeat
+	  pol: SUP(INT) := (first(coef) :: Integer) * (x ** i)
+          result:= result + pol --(first(coef) :: Integer) * (x ** i)
+          coef:= rest(coef)
+          i:= i + 1
+        result
+        	
+      classNumber():Integer ==
+        LPolynomial()(1)      
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{GPAFF.dotabb}
+"GPAFF" [color="#FF4488",href="bookvol10.4.pdf#nameddest=GPAFF"]
+"DTP" [color="#FF4488",href="bookvol10.4.pdf#nameddest=DTP"]
+"INTDIVP" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INTDIVP"]
+"GPAFF" -> "INTDIVP"
+"GPAFF" -> "DTP"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{package GENPGCD GeneralPolynomialGcdPackage}
+\begin{chunk}{GeneralPolynomialGcdPackage.input}
+)set break resume
+)sys rm -f GeneralPolynomialGcdPackage.output
+)spool GeneralPolynomialGcdPackage.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show GeneralPolynomialGcdPackage
+--R 
+--R GeneralPolynomialGcdPackage(E: OrderedAbelianMonoidSup,OV: OrderedSet,R: PolynomialFactorizationExplicit,P: PolynomialCategory(R,E,OV))  is a package constructor
+--R Abbreviation for GeneralPolynomialGcdPackage is GENPGCD 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.4.pamphlet to see algebra source code for GENPGCD 
+--R
+--R------------------------------- Operations --------------------------------
+--R randomR : () -> R                    
+--R gcdPolynomial : (SparseUnivariatePolynomial(P),SparseUnivariatePolynomial(P)) -> SparseUnivariatePolynomial(P)
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{GeneralPolynomialGcdPackage.help}
+====================================================================
+GeneralPolynomialGcdPackage examples
+====================================================================
 
 This package provides operations for GCD computations on polynomials 
 
@@ -47460,6 +65968,234 @@ GeneralPolynomialGcdPackage(E,OV,R,P):C == T where
 \begin{chunk}{COQ GENPGCD}
 (* package GENPGCD *)
 (*
+ 
+      SUPR     ==> SparseUnivariatePolynomial R
+      import UnivariatePolynomialCategoryFunctions2(R,SUPR,P,SUPP)
+      import UnivariatePolynomialCategoryFunctions2(P,SUPP,R,SUPR)
+                 --------  Local  Functions  --------
+ 
+      better          :    (P,P)     -> Boolean
+
+      lift  :  (SUPR,SUPP,SUPR,List OV,List R) -> Union(SUPP,"failed")
+         -- lifts first and third arguments as factors of the second
+         -- fourth is number of variables.
+      monomContentSup   :    SUPP    -> SUPP
+ 
+      gcdTrivial      :  (SUPP,SUPP)   -> SUPP
+      gcdSameVariables:  (SUPP,SUPP,List OV)    -> SUPP
+      recursivelyGCDCoefficients: (SUPP,List OV,SUPP,List OV) -> SUPP
+      flatten         : (SUPP,List OV) -> SUPP
+                        -- evaluates out all variables in the second
+                        -- argument, leaving a polynomial of the same
+                        -- degree
+      variables       :  SUPP          -> List OV
+                     ---- JHD's exported functions ---
+
+      gcdPolynomial(p1:SUPP,p2:SUPP) ==
+        zero? p1 => p2
+        zero? p2 => p1
+        0=degree p1  => gcdTrivial(p1,p2)
+        0=degree p2  => gcdTrivial(p2,p1)
+        if degree p1 < degree p2 then (p1,p2):=(p2,p1)
+        p1 exquo p2 case SUPP  => (unitNormal p2).canonical
+        c1:= monomContentSup(p1)
+        c2:= monomContentSup(p2)
+        p1:= (p1 exquo c1)::SUPP
+        p2:= (p2 exquo c2)::SUPP
+        (p1 exquo p2) case SUPP => (unitNormal p2).canonical * gcd(c1,c2)
+        vp1:=variables p1
+        vp2:=variables p2
+        v1:=setDifference(vp1,vp2)
+        v2:=setDifference(vp2,vp1)
+        #v1 = 0 and #v2 = 0 => gcdSameVariables(p1,p2,vp1)*gcd(c1,c2)
+                 -- all variables are in common
+        v:=setDifference(vp1,v1)
+        pp1:=flatten(p1,v1)
+        pp2:=flatten(p2,v2)
+        g:=gcdSameVariables(pp1,pp2,v)
+        (g = 1) => gcd(c1,c2)::SUPP
+        (#v1 = 0 or not (p1 exquo g) case "failed") and
+                     -- if #vi = 0 then pp1 = p1, so we know g divides
+              (#v2 = 0 or not (p2 exquo g) case "failed")
+            => g*gcd(c1,c2)  -- divdes them both, so is the gcd
+        -- OK, so it's not the gcd: try again
+        v:=variables g -- there can be at most these variables in answer
+        v1:=setDifference(vp1,v)
+        v2:=setDifference(vp2,v)
+        if (#v1 = 0) then g:= gcdSameVariables(g,flatten(p2,v2),v)
+        else if (#v2=0) then g:=gcdSameVariables(g,flatten(p1,v1),v)
+        else g:=gcdSameVariables(g,flatten(p1,v1)-flatten(p2,v2),v)
+        (g = 1) => gcd(c1,c2)::SUPP
+        (#v1 = 0 or not (p1 exquo g) case "failed") and
+              (#v2 = 0 or not (p2 exquo g) case "failed")
+            => g*gcd(c1,c2)::SUPP  -- divdes them both, so is the gcd
+        v:=variables g -- there can be at most these variables in answer
+        v1:=setDifference(vp1,v)
+        if #v1 ^= 0 then
+           g:=recursivelyGCDCoefficients(g,v,p1,v1)
+           (g = 1) => return gcd(c1,c2)::SUPP
+           v:=variables g -- there can be at most these variables in answer
+        v2:=setDifference(vp2,v)
+        recursivelyGCDCoefficients(g,v,p2,v2)*gcd(c1,c2)
+
+      if R has StepThrough then
+
+         randomCount:R := init()
+         randomR() ==
+            (v:=nextItem(randomCount)) case R =>
+                randomCount:=v
+                v
+            SAY(_
+          "Taking next stepthrough range in GeneralPolynomialGcdPackage")$Lisp
+            randomCount:=init()
+            randomCount
+
+      else
+
+            randomR() == (random$Integer() rem 100)::R
+
+                     ---- JHD's local functions ---
+      gcdSameVariables(p1:SUPP,p2:SUPP,lv:List OV) ==
+            -- two non-trivial primitive (or, at least, we don't care
+            -- about content)
+            -- polynomials with precisely the same degree
+          #lv = 0 => map((x:R):P+->x::P,gcdPolynomial(map(ground,p1),
+                                             map(ground,p2)))
+          degree p2 = 1 =>
+            p1 exquo p2 case SUPP => p2
+            1
+          gcdLC:=gcd(leadingCoefficient p1,leadingCoefficient p2)
+          lr:=[randomR() for vv in lv]
+          count:NonNegativeInteger:=0
+          while count<10 repeat
+            while zero? eval(gcdLC,lv,lr) and count<10 repeat
+              lr:=[randomR() for vv in lv]
+              count:=count+1
+            count = 10 => error "too many evaluations in GCD code"
+            up1:SUPR:=map(y+->ground eval(y,lv,lr),p1)
+            up2:SUPR:=map(z+->ground eval(z,lv,lr),p2)
+            u:=gcdPolynomial(up1,up2)
+            degree u = 0 => return 1
+            -- let's pick a second one, just to check
+            lrr:=[randomR() for vv in lv]
+            while zero? eval(gcdLC,lv,lrr) and count<10 repeat
+              lrr:=[randomR() for vv in lv]
+              count:=count+1
+            count = 10 => error "too many evaluations in GCD code"
+            vp1:SUPR:=map(x1+->ground eval(x1,lv,lrr),p1)
+            vp2:SUPR:=map(y1+->ground eval(y1,lv,lrr),p2)
+            v:=gcdPolynomial(vp1,vp2)
+            degree v = 0 => return 1
+            if degree v < degree u then
+               u:=v
+               up1:=vp1
+               up2:=vp2
+               lr:=lrr
+            up1:=(up1 exquo u)::SUPR
+            degree gcd(u,up1) = 0 =>
+                ans:=lift(u,p1,up1,lv,lr)
+                ans case SUPP => return ans
+                "next"
+            up2:=(up2 exquo u)::SUPR
+            degree gcd(u,up2) = 0 =>
+                ans:=lift(u,p2,up2,lv,lr)
+                ans case SUPP => return ans
+                "next"
+            -- so neither cofactor is relatively prime
+            count:=0
+            while count < 10 repeat
+               r:=randomR()
+               uu:=up1+r*up2
+               degree gcd(u,uu)=0 =>
+                 ans:= lift(u,p1+r::P *p2,uu,lv,lr)
+                 ans case SUPP => return ans
+                 "next"
+            error "too many evaluations in GCD code"
+          count >= 10 => error "too many evaluations in GCD code"
+
+      lift(gR:SUPR,p:SUPP,cfR:SUPR,lv:List OV,lr:List R) ==
+        -- lift the coprime factorisation gR*cfR = (univariate of p)
+        -- where the variables lv have been evaluated at lr
+        lcp:=leadingCoefficient p
+        g:=monomial(lcp,degree gR)+map(x+->x::P,reductum gR)
+        cf:=monomial(lcp,degree cfR)+map(y+->y::P,reductum cfR)
+        p:=lcp*p       -- impose leaidng coefficient of p on each factor
+        while lv ^= [] repeat
+           v:=first lv
+           r:=first lr
+           lv:=rest lv
+           lr:=rest lr
+           thisp:=map(x1+->eval(x1,lv,lr),p)
+           d:="max"/[degree(c,v) for c in coefficients p]
+           prime:=v::P - r::P
+           pn:=prime
+           origFactors:=[g,cf]::List SUPP
+           for n in 1..d repeat
+              Ecart:=(thisp- g*cf) exquo pn
+              Ecart case "failed" =>
+                 error "failed lifting in hensel in Complex Polynomial GCD"
+              zero? Ecart => leave
+              step:=solveLinearPolynomialEquation(origFactors,
+                        map(x2+->eval(x2,v,r),Ecart::SUPP))
+              step case "failed" => return "failed"
+              g:=g+pn*first step
+              cf:=cf+pn*second step
+              pn:=pn*prime
+           thisp ^= g*cf => return "failed"
+        g
+
+      recursivelyGCDCoefficients(g:SUPP,v:List OV,p:SUPP,pv:List OV) ==
+         mv:=first pv   -- take each coefficient w.r.t. mv
+         pv:=rest pv    -- and recurse on pv as necessary
+         d:="max"/[degree(u,mv) for u in coefficients p]
+         for i in 0..d repeat
+             p1:=map(x+->coefficient(x,mv,i),p)
+             oldg:=g
+             if pv = [] then g:=gcdSameVariables(g,p1,v)
+             else g:=recursivelyGCDCoefficients(p,v,p1,pv)
+             (g = 1) => return 1
+             g^=oldg =>
+                oldv:=v
+                v:=variables g
+                pv:=setUnion(pv,setDifference(v,oldv))
+         g
+
+      flatten(p1:SUPP,lv:List OV) ==
+         #lv = 0 => p1
+         lr:=[ randomR() for vv in lv]
+         dg:=degree p1
+         while dg ^= degree (ans:= map(x+->eval(x,lv,lr),p1)) repeat
+           lr:=[ randomR() for vv in lv]
+         ans
+
+      variables(p1:SUPP) ==
+        removeDuplicates ("concat"/[variables u for u in coefficients p1])
+
+      gcdTrivial(p1:SUPP,p2:SUPP) ==
+        -- p1 is non-zero, but has degree zero
+        -- p2 is non-zero
+        cp1:=leadingCoefficient p1
+        (cp1 = 1) => 1
+        degree p2 = 0 => gcd(cp1,leadingCoefficient p2)::SUPP
+        un?:=unit? cp1
+        while not zero? p2 and not un? repeat
+           cp1:=gcd(leadingCoefficient p2,cp1)
+           un?:=unit? cp1
+           p2:=reductum p2
+        un? => 1
+        cp1::SUPP
+ 
+      monomContentSup(u:SUPP):SUPP ==
+        degree(u) = 0$NonNegativeInteger => 1$SUPP
+        md:= minimumDegree u
+        gcd(sort(better,coefficients u)) * monomial(1$P,md)$SUPP
+ 
+  -- Ordering for gcd purposes
+      better(p1:P,p2:P):Boolean ==
+        ground? p1 => true
+        ground? p2 => false
+        degree(p1,mainVariable(p1)::OV) < degree(p2,mainVariable(p2)::OV)
+ 
 *)
 
 \end{chunk}
@@ -47726,6 +66462,107 @@ GenerateUnivariatePowerSeries(R,FE): Exports == Implementation where
 \begin{chunk}{COQ GENUPS}
 (* package GENUPS *)
 (*
+ 
+    genStream: (I -> FE,I) -> ST FE
+    genStream(f,n) == delay concat(f(n),genStream(f,n + 1))
+ 
+    genFiniteStream: (I -> FE,I,I) -> ST FE
+    genFiniteStream(f,n,m) == delay
+      n > m => empty()
+      concat(f(n),genFiniteStream(f,n + 1,m))
+ 
+    taylor(f,eq) ==
+      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
+        error "taylor: left hand side must be a variable"
+      x := xx :: SY; a := rhs eq
+      coerce(series(genStream(f,0))$UTS(FE,x,a))$ANY1(UTS(FE,x,a))
+ 
+    taylor(an:FE,n:SY,eq:EQ FE) ==
+      taylor((i:I):FE +-> eval(an,(n::FE) = (i::FE)),eq)
+ 
+    taylor(f:I -> FE,eq:EQ FE,seg:SEG NNI) ==
+      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
+        error "taylor: left hand side must be a variable"
+      x := xx :: SY; a := rhs eq
+      hasHi seg =>
+        n0 := lo seg; n1 := hi seg
+        if n1 < n0 then (n0,n1) := (n1,n0)
+        uts := series(genFiniteStream(f,n0,n1))$UTS(FE,x,a)
+        uts := uts * monomial(1,n0)$UTS(FE,x,a)
+        coerce(uts)$ANY1(UTS(FE,x,a))
+      n0 := lo seg
+      uts := series(genStream(f,n0))$UTS(FE,x,a)
+      uts := uts * monomial(1,n0)$UTS(FE,x,a)
+      coerce(uts)$ANY1(UTS(FE,x,a))
+ 
+    taylor(an,n,eq,seg) ==
+      taylor((i:I):FE +-> eval(an,(n::FE) = (i::FE)),eq,seg)
+ 
+    laurent(f,eq,seg) ==
+      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
+        error "taylor: left hand side must be a variable"
+      x := xx :: SY; a := rhs eq
+      hasHi seg =>
+        n0 := lo seg; n1 := hi seg
+        if n1 < n0 then (n0,n1) := (n1,n0)
+        uts := series(genFiniteStream(f,n0,n1))$UTS(FE,x,a)
+        coerce(laurent(n0,uts)$ULS(FE,x,a))$ANY1(ULS(FE,x,a))
+      n0 := lo seg
+      uts := series(genStream(f,n0))$UTS(FE,x,a)
+      coerce(laurent(n0,uts)$ULS(FE,x,a))$ANY1(ULS(FE,x,a))
+ 
+    laurent(an,n,eq,seg) ==
+      laurent((i:I):FE +-> eval(an,(n::FE) = (i::FE)),eq,seg)
+ 
+    modifyFcn:(RN -> FE,I,I,I,I) -> FE
+    modifyFcn(f,n0,nn,q,m) == (zero?((m - n0) rem nn) => f(m/q); 0)
+ 
+    puiseux(f,eq,seg,r) ==
+      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
+        error "puiseux: left hand side must be a variable"
+      x := xx :: SY; a := rhs eq
+      not positive? r => error "puiseux: last argument must be positive"
+      hasHi seg =>
+        r0 := lo seg; r1 := hi seg
+        if r1 < r0 then (r0,r1) := (r1,r0)
+        p0 := numer r0; q0 := denom r0
+        p1 := numer r1; q1 := denom r1
+        p2 := numer r; q2 := denom r
+        q := lcm(lcm(q0,q1),q2)
+        n0 := p0 * (q quo q0); n1 := p1 * (q quo q1)
+        nn := p2 * (q quo q2)
+        ulsUnion := 
+          laurent((i:I):FE+->modifyFcn(f,n0,nn,q,i),eq,segment(n0,n1))
+        uls := retract(ulsUnion)$ANY1(ULS(FE,x,a))
+        coerce(puiseux(1/q,uls)$UPXS(FE,x,a))$ANY1(UPXS(FE,x,a))
+      p0 := numer(r0 := lo seg); q0 := denom r0
+      p2 := numer r; q2 := denom r
+      q := lcm(q0,q2)
+      n0 := p0 * (q quo q0); nn := p2 * (q quo q2)
+      ulsUnion := 
+        laurent((i:I):FE+->modifyFcn(f,n0,nn,q,i),eq,segment n0)
+      uls := retract(ulsUnion)$ANY1(ULS(FE,x,a))
+      coerce(puiseux(1/q,uls)$UPXS(FE,x,a))$ANY1(UPXS(FE,x,a))
+ 
+    puiseux(an,n,eq,r0,m) ==
+      puiseux((r:RN):FE+->eval(an,(n::FE) = (r::FE)),eq,r0,m)
+ 
+    series(f:I -> FE,eq:EQ FE) == puiseux(r+->f(numer r),eq,segment 0,1)
+
+    series(an:FE,n:SY,eq:EQ FE) == puiseux(an,n,eq,segment 0,1)
+
+    series(f:I -> FE,eq:EQ FE,seg:SEG I) ==
+      ratSeg : SEG RN := map(x+->x::RN,seg)$UniversalSegmentFunctions2(I,RN)
+      puiseux((r:RN):FE+->f(numer r),eq,ratSeg,1)
+
+    series(an:FE,n:SY,eq:EQ FE,seg:SEG I) ==
+      ratSeg : SEG RN := map(i+->i::RN,seg)$UniversalSegmentFunctions2(I,RN)
+      puiseux(an,n,eq,ratSeg,1)
+
+    series(f:RN -> FE,eq:EQ FE,seg:SEG RN,r:RN) == puiseux(f,eq,seg,r)
+
+    series(an:FE,n:SY,eq:EQ FE,seg:SEG RN,r:RN) == puiseux(an,n,eq,seg,r)
+
 *)
 
 \end{chunk}
@@ -47842,7 +66679,9 @@ GenExEuclid(R,BP) : C == T
          ++ the degree and they remain relatively prime.
 
   T == add
+
     if R has multiplicativeValuation then
+
       compBound(m:BP,listpolys:L BP) : NNI ==
         ldeg:=[degree f for f in listpolys]
         n:NNI:= (+/[df for df in ldeg])
@@ -47851,7 +66690,9 @@ GenExEuclid(R,BP) : C == T
         nm:= +/[euclideanSize(u)**2 for u in coefficients m]
         normprod := */[g**((n-df)::NNI) for g in normlist for df in ldeg]
         2*(approxSqrt(normprod * nm)$IntegerRoots(Integer))::NNI
+
     else if R has additiveValuation then
+
       -- a fairly crude Hadamard-style bound for the solution
       -- based on regarding the problem as a system of linear equations.
       compBound(m:BP,listpolys:L BP) : NNI ==
@@ -47859,13 +66700,19 @@ GenExEuclid(R,BP) : C == T
           +/["max"/[euclideanSize u for u in coefficients p]
              for p in listpolys]
     else
+
       compBound(m:BP,listpolys:L BP) : NNI ==
         error "attempt to use compBound without a well-understood valuation"
+
     if R has IntegerNumberSystem then
+
       reduction(u:BP,p:R):BP ==
         p = 0 => u
         map(x +-> symmetricRemainder(x,p),u)
-    else reduction(u:BP,p:R):BP ==
+
+    else 
+
+      reduction(u:BP,p:R):BP ==
         p = 0 => u
         map(x +-> x rem p,u)
 
@@ -47935,6 +66782,7 @@ GenExEuclid(R,BP) : C == T
          true
 
     if R has Field then
+
       tablePow(mdeg:NNI,pmod:R,listPol:L BP) ==
         multiE:=multiEuclidean(listPol,1$BP)
         multiE case "failed" => "failed"
@@ -47992,6 +66840,162 @@ GenExEuclid(R,BP) : C == T
 \begin{chunk}{COQ GENEEZ}
 (* package GENEEZ *)
 (*
+
+    if R has multiplicativeValuation then
+
+      compBound(m:BP,listpolys:L BP) : NNI ==
+        ldeg:=[degree f for f in listpolys]
+        n:NNI:= (+/[df for df in ldeg])
+        normlist:=[ +/[euclideanSize(u)**2 for u in coefficients f]
+                         for f in listpolys]
+        nm:= +/[euclideanSize(u)**2 for u in coefficients m]
+        normprod := */[g**((n-df)::NNI) for g in normlist for df in ldeg]
+        2*(approxSqrt(normprod * nm)$IntegerRoots(Integer))::NNI
+
+    else if R has additiveValuation then
+
+      -- a fairly crude Hadamard-style bound for the solution
+      -- based on regarding the problem as a system of linear equations.
+      compBound(m:BP,listpolys:L BP) : NNI ==
+        "max"/[euclideanSize u for u in coefficients m] +
+          +/["max"/[euclideanSize u for u in coefficients p]
+             for p in listpolys]
+    else
+
+      compBound(m:BP,listpolys:L BP) : NNI ==
+        error "attempt to use compBound without a well-understood valuation"
+
+    if R has IntegerNumberSystem then
+
+      reduction(u:BP,p:R):BP ==
+        p = 0 => u
+        map(x +-> symmetricRemainder(x,p),u)
+
+    else 
+
+      reduction(u:BP,p:R):BP ==
+        p = 0 => u
+        map(x +-> x rem p,u)
+
+    merge(p:R,q:R):Union(R,"failed") ==
+         p = q => p
+         p = 0 => q
+         q = 0 => p
+         "failed"
+
+    modInverse(c:R,p:R):R ==
+        (extendedEuclidean(c,p,1)::Record(coef1:R,coef2:R)).coef1
+
+    exactquo(u:BP,v:BP,p:R):Union(BP,"failed") ==
+        invlcv:=modInverse(leadingCoefficient v,p)
+        r:=monicDivide(u,reduction(invlcv*v,p))
+        reduction(r.remainder,p) ^=0 => "failed"
+        reduction(invlcv*r.quotient,p)
+
+    FP:=EuclideanModularRing(R,BP,R,reduction,merge,exactquo)
+
+    --make table global variable!
+    table:Vector L BP
+    import GeneralHenselPackage(R,BP)
+
+                       --local  functions
+    makeProducts :    L BP   -> L BP
+    liftSol: (L BP,BP,R,R,Vector L BP,BP,NNI) -> Union(L BP,"failed")
+
+    reduceList(lp:L BP,lmod:R): L FP ==[reduce(ff,lmod) for ff in lp]
+
+    coerceLFP(lf:L FP):L BP == [fm::BP for fm in lf]
+
+    liftSol(oldsol:L BP,err:BP,lmod:R,lmodk:R,
+           table:Vector L BP,m:BP,bound:NNI):Union(L BP,"failed") ==
+      euclideanSize(lmodk) > bound => "failed"
+      d:=degree err
+      ftab:Vector L FP :=
+        map(x +-> reduceList(x,lmod),table)$VectorFunctions2(List BP,List FP)
+      sln:L FP:=[0$FP for xx in ftab.1 ]
+      for i in 0 .. d |(cc:=coefficient(err,i)) ^=0 repeat
+        sln:=[slp+reduce(cc::BP,lmod)*pp
+              for pp in ftab.(i+1) for slp in sln]
+      nsol:=[f-lmodk*reduction(g::BP,lmod) for f in oldsol for g in sln]
+      lmodk1:=lmod*lmodk
+      nsol:=[reduction(slp,lmodk1) for slp in nsol]
+      lpolys:L BP:=table.(#table)
+      (fs:=+/[f*g for f in lpolys for g in nsol]) = m => nsol
+      a:BP:=((fs-m) exquo lmodk1)::BP
+      liftSol(nsol,a,lmod,lmodk1,table,m,bound)
+
+    makeProducts(listPol:L BP):L BP ==
+      #listPol < 2 => listPol
+      #listPol = 2 => reverse listPol
+      f:= first listPol
+      ll := rest listPol
+      [*/ll,:[f*g for g in makeProducts ll]]
+
+    testModulus(pmod, listPol) ==
+         redListPol := reduceList(listPol, pmod)
+         for pol in listPol for rpol in redListPol repeat
+              degree(pol) ^= degree(rpol::BP) => return false
+         while not empty? redListPol repeat
+             rpol := first redListPol
+             redListPol := rest redListPol
+             for rpol2 in redListPol repeat
+                gcd(rpol, rpol2) ^= 1 => return false
+         true
+
+    if R has Field then
+
+      tablePow(mdeg:NNI,pmod:R,listPol:L BP) ==
+        multiE:=multiEuclidean(listPol,1$BP)
+        multiE case "failed" => "failed"
+        ptable:Vector L BP :=new(mdeg+1,[])
+        ptable.1:=multiE
+        x:BP:=monomial(1,1)
+        for i in 2..mdeg repeat ptable.i:=
+            [tpol*x rem fpol for tpol in ptable.(i-1) for fpol in listPol]
+        ptable.(mdeg+1):=makeProducts listPol
+        ptable
+
+      solveid(m:BP,pmod:R,table:Vector L BP) : Union(L BP,"failed") ==
+            -- Actually, there's no possibility of failure
+        d:=degree m
+        sln:L BP:=[0$BP for xx in table.1]
+        for i in 0 .. d | coefficient(m,i)^=0 repeat
+          sln:=[slp+coefficient(m,i)*pp
+                for pp in table.(i+1) for slp in sln]
+        sln
+
+    else
+
+      tablePow(mdeg:NNI,pmod:R,listPol:L BP) ==
+        listP:L FP:= [reduce(pol,pmod) for pol in listPol]
+        multiE:=multiEuclidean(listP,1$FP)
+        multiE case "failed" => "failed"
+        ftable:Vector L FP :=new(mdeg+1,[])
+        fl:L FP:= [ff::FP for ff in multiE]
+        ftable.1:=[fpol for fpol in fl]
+        x:FP:=reduce(monomial(1,1),pmod)
+        for i in 2..mdeg repeat ftable.i:=
+            [tpol*x rem fpol for tpol in ftable.(i-1) for fpol in listP]
+        ptable:= map(coerceLFP,ftable)$VectorFunctions2(List FP,List BP)
+        ptable.(mdeg+1):=makeProducts listPol
+        ptable
+
+      solveid(m:BP,pmod:R,table:Vector L BP) : Union(L BP,"failed") ==
+        d:=degree m
+        ftab:Vector L FP:=
+          map(x+->reduceList(x,pmod),table)$VectorFunctions2(List BP,List FP)
+        lpolys:L BP:=table.(#table)
+        sln:L FP:=[0$FP for xx in ftab.1]
+        for i in 0 .. d | coefficient(m,i)^=0 repeat
+          sln:=[slp+reduce(coefficient(m,i)::BP,pmod)*pp
+                for pp in ftab.(i+1) for slp in sln]
+        soln:=[slp::BP for slp in sln]
+        (fs:=+/[f*g for f in lpolys for g in soln]) = m=> soln
+        -- Compute bound
+        bound:=compBound(m,lpolys)
+        a:BP:=((fs-m) exquo pmod)::BP
+        liftSol(soln,a,pmod,pmod,table,m,bound)
+
 *)
 
 \end{chunk}
@@ -48080,21 +67084,14 @@ GenUFactorize(R) : public == private where
  
     factor(f:PR) : Factored PR ==
       R is Integer => (factor f)$GaloisGroupFactorizer(PR)
- 
       R is Fraction Integer  =>
                                 (factor f)$RationalFactorize(PR)
- 
---      R has Field and R has Finite =>
       R has FiniteFieldCategory =>
                                 (factor f)$DistinctDegreeFactorize(R,PR)
- 
       R is (Complex Integer) => (factor f)$ComplexFactorization(Integer,PR)
- 
       R is (Complex Fraction Integer) =>
                            (factor f)$ComplexFactorization(Fraction Integer,PR)
- 
       R is AlgebraicNumber =>   (factor f)$AlgFactor(PR)
- 
    -- following is to handle SAE
       R has generator : () -> R =>
         var := symbol(convert(generator()::OutputForm)@InputForm)
@@ -48114,40 +67111,74 @@ GenUFactorize(R) : public == private where
 \begin{chunk}{COQ GENUFACT}
 (* package GENUFACT *)
 (*
-*)
 
-\end{chunk}
-
-\begin{chunk}{GENUFACT.dotabb}
-"GENUFACT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=GENUFACT"]
-"COMPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=COMPCAT"]
-"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"]
-"GENUFACT" -> "COMPCAT"
-"GENUFACT" -> "ACF"
-
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{package INTG0 GenusZeroIntegration}
-\begin{chunk}{GenusZeroIntegration.input}
-)set break resume
-)sys rm -f GenusZeroIntegration.output
-)spool GenusZeroIntegration.output
-)set message test on
-)set message auto off
-)clear all
-
---S 1 of 1
-)show GenusZeroIntegration
---R 
---R GenusZeroIntegration(R: Join(GcdDomain,RetractableTo(Integer),OrderedSet,CharacteristicZero,LinearlyExplicitRingOver(Integer)),F: Join(FunctionSpace(R),AlgebraicallyClosedField,TranscendentalFunctionCategory),L: SetCategory)  is a package constructor
---R Abbreviation for GenusZeroIntegration is INTG0 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.4.pamphlet to see algebra source code for INTG0 
---R
---R------------------------------- Operations --------------------------------
---R lift : (SparseUnivariatePolynomial(F),Kernel(F)) -> SparseUnivariatePolynomial(Fraction(SparseUnivariatePolynomial(F)))
---R multivariate : (SparseUnivariatePolynomial(Fraction(SparseUnivariatePolynomial(F))),Kernel(F),F) -> F
---R palgLODE0 : (L,F,Kernel(F),Kernel(F),F,SparseUnivariatePolynomial(F)) -> Record(particular: Union(F,"failed"),basis: List(F)) if L has LODOCAT(F)
+    -- Factorisation currently fails when algebraic extensions have multiple
+    -- generators.
+    factorWarning(f:OutputForm):Void ==
+      import AnyFunctions1(String)
+      import AnyFunctions1(OutputForm)
+      outputList(["WARNING (genufact): No known algorithm to factor "::Any, _
+              f::Any, _
+              ", trying square-free."::Any])$OutputPackage
+ 
+    factor(f:PR) : Factored PR ==
+      R is Integer => (factor f)$GaloisGroupFactorizer(PR)
+      R is Fraction Integer  =>
+                                (factor f)$RationalFactorize(PR)
+      R has FiniteFieldCategory =>
+                                (factor f)$DistinctDegreeFactorize(R,PR)
+      R is (Complex Integer) => (factor f)$ComplexFactorization(Integer,PR)
+      R is (Complex Fraction Integer) =>
+                           (factor f)$ComplexFactorization(Fraction Integer,PR)
+      R is AlgebraicNumber =>   (factor f)$AlgFactor(PR)
+   -- following is to handle SAE
+      R has generator : () -> R =>
+        var := symbol(convert(generator()::OutputForm)@InputForm)
+        up:=UnivariatePolynomial(var,Fraction Integer)
+        R has MonogenicAlgebra(Fraction Integer, up) =>
+           factor(f)$SimpleAlgebraicExtensionAlgFactor(up, R, PR)
+        upp:=UnivariatePolynomial(var,Fraction Polynomial Integer)
+        R has MonogenicAlgebra(Fraction Polynomial Integer, upp) =>
+           factor(f)$SAERationalFunctionAlgFactor(upp, R, PR)
+        factorWarning(f::OutputForm)
+        squareFree f            
+      factorWarning(f::OutputForm)
+      squareFree f
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{GENUFACT.dotabb}
+"GENUFACT" [color="#FF4488",href="bookvol10.4.pdf#nameddest=GENUFACT"]
+"COMPCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=COMPCAT"]
+"ACF" [color="#4488FF",href="bookvol10.2.pdf#nameddest=ACF"]
+"GENUFACT" -> "COMPCAT"
+"GENUFACT" -> "ACF"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{package INTG0 GenusZeroIntegration}
+\begin{chunk}{GenusZeroIntegration.input}
+)set break resume
+)sys rm -f GenusZeroIntegration.output
+)spool GenusZeroIntegration.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show GenusZeroIntegration
+--R 
+--R GenusZeroIntegration(R: Join(GcdDomain,RetractableTo(Integer),OrderedSet,CharacteristicZero,LinearlyExplicitRingOver(Integer)),F: Join(FunctionSpace(R),AlgebraicallyClosedField,TranscendentalFunctionCategory),L: SetCategory)  is a package constructor
+--R Abbreviation for GenusZeroIntegration is INTG0 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.4.pamphlet to see algebra source code for INTG0 
+--R
+--R------------------------------- Operations --------------------------------
+--R lift : (SparseUnivariatePolynomial(F),Kernel(F)) -> SparseUnivariatePolynomial(Fraction(SparseUnivariatePolynomial(F)))
+--R multivariate : (SparseUnivariatePolynomial(Fraction(SparseUnivariatePolynomial(F))),Kernel(F),F) -> F
+--R palgLODE0 : (L,F,Kernel(F),Kernel(F),F,SparseUnivariatePolynomial(F)) -> Record(particular: Union(F,"failed"),basis: List(F)) if L has LODOCAT(F)
 --R palgLODE0 : (L,F,Kernel(F),Kernel(F),Kernel(F),F,Fraction(SparseUnivariatePolynomial(F))) -> Record(particular: Union(F,"failed"),basis: List(F)) if L has LODOCAT(F)
 --R palgRDE0 : (F,F,Kernel(F),Kernel(F),((F,F,Symbol) -> Union(F,"failed")),F,SparseUnivariatePolynomial(F)) -> Union(F,"failed")
 --R palgRDE0 : (F,F,Kernel(F),Kernel(F),((F,F,Symbol) -> Union(F,"failed")),Kernel(F),F,Fraction(SparseUnivariatePolynomial(F))) -> Union(F,"failed")
@@ -48306,6 +67337,7 @@ GenusZeroIntegration(R, F, L): Exports == Implementation where
         ++ \spad{f(x,y)dx = c f(t,y) dy}; c and t are rational functions of y.
 
   Implementation ==> add
+
     import RationalIntegration(F, UP)
     import AlgebraicManipulations(R, F)
     import IntegrationResultFunctions2(RF, F)
@@ -48324,9 +67356,13 @@ GenusZeroIntegration(R, F, L): Exports == Implementation where
     dummy := kernel(new()$SY)@K
 
     kerdiff(sa, a)         == setDifference(kernels sa, kernels a)
+
     checkroot(f, l)        == (empty? l => f; rootNormalize(f, first l))
+
     univ(c, l, x)          == univariate(checkroot(c, l), x)
+
     univariate(f, x, y, p) == lift(univariate(f, y, p), x)
+
     lift(p, k)             == map(x1+->univariate(x1, k), p)
 
     palgint0(f, x, y, den, radi) ==
@@ -48402,7 +67438,7 @@ GenusZeroIntegration(R, F, L): Exports == Implementation where
                           symbolIfCan(z)::SY)) case "failed" => "failed"
       eval(u::F, z, y::F)
 
--- given p = sum_i a_i(X) Y^i, returns  sum_i a_i(x) y^i
+    -- given p = sum_i a_i(X) Y^i, returns  sum_i a_i(x) y^i
     multivariate(p, x, y) ==
       (map((x1:RF):F+->multivariate(x1, x),
            p)$SparseUnivariatePolynomialFunctions2(RF, F))
@@ -48428,6 +67464,7 @@ GenusZeroIntegration(R, F, L): Exports == Implementation where
       eval(u::F, dummy, pr.diff)
 
     if L has LinearOrdinaryDifferentialOperatorCategory F then
+
       import RationalLODE(F, UP)
 
       palgLODE0(eq, g, x, y, den, radi) ==
@@ -48439,7 +67476,7 @@ GenusZeroIntegration(R, F, L): Exports == Implementation where
           op := op + univ(eval(coefficient(eq, i), pr.subs.var, pr.subs.val),
                         pr.newk, dummy) * di
           di := d * di
-        rec := ratDsolve(op,univ(eval(g,pr.subs.var,pr.subs.val),pr.newk,dummy))
+        rec:= ratDsolve(op,univ(eval(g,pr.subs.var,pr.subs.val),pr.newk,dummy))
         bas:List(F) := [b(pr.diff) for b in rec.basis]
         rec.particular case "failed" => ["failed", bas]
         [((rec.particular)::RF) (pr.diff), bas]
@@ -48463,6 +67500,164 @@ GenusZeroIntegration(R, F, L): Exports == Implementation where
 \begin{chunk}{COQ INTG0}
 (* package INTG0 *)
 (*
+
+    import RationalIntegration(F, UP)
+    import AlgebraicManipulations(R, F)
+    import IntegrationResultFunctions2(RF, F)
+    import ElementaryFunctionStructurePackage(R, F)
+    import SparseUnivariatePolynomialFunctions2(F, RF)
+    import PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                                                        K, R, P, F)
+
+    mkRat    : (F, REC, List K) -> RF
+    mkRatlx  : (F, K, K, F, K, RF) -> RF
+    quadsubst: (K, K, F, UP) -> Record(diff:F, subs:REC, newk:List K)
+    kerdiff  : (F, F) -> List K
+    checkroot: (F, List K) -> F
+    univ     : (F, List K, K) -> RF
+
+    dummy := kernel(new()$SY)@K
+
+    kerdiff(sa, a)         == setDifference(kernels sa, kernels a)
+
+    checkroot(f, l)        == (empty? l => f; rootNormalize(f, first l))
+
+    univ(c, l, x)          == univariate(checkroot(c, l), x)
+
+    univariate(f, x, y, p) == lift(univariate(f, y, p), x)
+
+    lift(p, k)             == map(x1+->univariate(x1, k), p)
+
+    palgint0(f, x, y, den, radi) ==
+      -- y is a square root so write f as f1 y + f0 and integrate separately
+      ff := univariate(f, x, y, minPoly y)
+      f0 := reductum ff
+      pr := quadsubst(x, y, den, radi)
+      map(f1+->f1(x::F), integrate(retract(f0)@RF)) +
+        map(f1+->f1(pr.diff),
+            integrate
+              mkRat(multivariate(leadingMonomial ff,x,y::F), pr.subs, pr.newk))
+
+-- the algebraic relation is (den * y)**2 = p  where p is a * x**2 + b * x + c
+-- if p is squarefree, then parametrize in the following form:
+--     u  = y - x \sqrt{a}
+--     x  = (u^2 - c) / (b - 2 u \sqrt{a}) = h(u)
+--     dx = h'(u) du
+--     y  = (u + a h(u)) / den = g(u)
+-- if a is a perfect square,
+--     u  = (y - \sqrt{c}) / x
+--     x  = (b - 2 u \sqrt{c}) / (u^2 - a) = h(u)
+--     dx = h'(u) du
+--     y  = (u h(u) + \sqrt{c}) / den = g(u)
+-- otherwise.
+-- if p is a square p = a t^2, then we choose only one branch for now:
+--     u  = x
+--     x  = u = h(u)
+--     dx = du
+--     y  = t \sqrt{a} / den = g(u)
+-- returns [u(x,y), [h'(u), [x,y], [h(u), g(u)], l] in both cases,
+-- where l is empty if no new square root was needed,
+-- l := [k] if k is the new square root kernel that was created.
+    quadsubst(x, y, den, p) ==
+      u   := dummy::F
+      b   := coefficient(p, 1)
+      c   := coefficient(p, 0)
+      sa  := rootSimp sqrt(a := coefficient(p, 2))
+      zero?(b * b - 4 * a * c) =>    -- case where p = a (x + b/(2a))^2
+        [x::F, [1, [x, y], [u, sa * (u + b / (2*a)) / eval(den,x,u)]], empty()]
+      empty? kerdiff(sa, a) =>
+        bm2u := b - 2 * u * sa
+        q    := eval(den, x, xx := (u**2 - c) / bm2u)
+        yy   := (ua := u + xx * sa) / q
+        [y::F - x::F * sa, [2 * ua / bm2u, [x, y], [xx, yy]], empty()]
+      u2ma:= u**2 - a
+      sc  := rootSimp sqrt c
+      q   := eval(den, x, xx := (b - 2 * u * sc) / u2ma)
+      yy  := (ux := xx * u + sc) / q
+      [(y::F - sc) / x::F, [- 2 * ux / u2ma, [x ,y], [xx, yy]], kerdiff(sc, c)]
+
+    mkRatlx(f,x,y,t,z,dx) ==
+      rat := univariate(eval(f, [x, y], [t, z::F]), z) * dx
+      numer(rat) / denom(rat)
+
+    mkRat(f, rec, l) ==
+      rat:=univariate(checkroot(rec.coeff * eval(f,rec.var,rec.val), l), dummy)
+      numer(rat) / denom(rat)
+
+    palgint0(f, x, y, z, xx, dx) ==
+      map(x1+->multivariate(x1, y), integrate mkRatlx(f, x, y, xx, z, dx))
+
+    palgextint0(f, x, y, g, z, xx, dx) ==
+      map(x1+->multivariate(x1, y),
+            extendedint(mkRatlx(f,x,y,xx,z,dx), mkRatlx(g,x,y,xx,z,dx)))
+
+    palglimint0(f, x, y, lu, z, xx, dx) ==
+      map(x1+->multivariate(x1, y), limitedint(mkRatlx(f, x, y, xx, z, dx),
+                             [mkRatlx(u, x, y, xx, z, dx) for u in lu]))
+
+    palgRDE0(f, g, x, y, rischde, z, xx, dx) ==
+      (u := rischde(eval(f, [x, y], [xx, z::F]),
+                      multivariate(dx, z) * eval(g, [x, y], [xx, z::F]),
+                          symbolIfCan(z)::SY)) case "failed" => "failed"
+      eval(u::F, z, y::F)
+
+    -- given p = sum_i a_i(X) Y^i, returns  sum_i a_i(x) y^i
+    multivariate(p, x, y) ==
+      (map((x1:RF):F+->multivariate(x1, x),
+           p)$SparseUnivariatePolynomialFunctions2(RF, F))
+              (y)
+
+    palgextint0(f, x, y, g, den, radi) ==
+      pr := quadsubst(x, y, den, radi)
+      map(f1+->f1(pr.diff),
+          extendedint(mkRat(f, pr.subs, pr.newk), mkRat(g, pr.subs, pr.newk)))
+
+    palglimint0(f, x, y, lu, den, radi) ==
+      pr := quadsubst(x, y, den, radi)
+      map(f1+->f1(pr.diff),
+         limitedint(mkRat(f, pr.subs, pr.newk),
+                    [mkRat(u, pr.subs, pr.newk) for u in lu]))
+
+    palgRDE0(f, g, x, y, rischde, den, radi) ==
+      pr := quadsubst(x, y, den, radi)
+      (u := rischde(checkroot(eval(f, pr.subs.var, pr.subs.val), pr.newk),
+                   checkroot(pr.subs.coeff * eval(g, pr.subs.var, pr.subs.val),
+                             pr.newk), symbolIfCan(dummy)::SY)) case "failed"
+                                    => "failed"
+      eval(u::F, dummy, pr.diff)
+
+    if L has LinearOrdinaryDifferentialOperatorCategory F then
+
+      import RationalLODE(F, UP)
+
+      palgLODE0(eq, g, x, y, den, radi) ==
+        pr := quadsubst(x, y, den, radi)
+        d := monomial(univ(inv(pr.subs.coeff), pr.newk, dummy), 1)$LODO
+        di:LODO := 1                  -- will accumulate the powers of d
+        op:LODO := 0                  -- will accumulate the new LODO
+        for i in 0..degree eq repeat
+          op := op + univ(eval(coefficient(eq, i), pr.subs.var, pr.subs.val),
+                        pr.newk, dummy) * di
+          di := d * di
+        rec:= ratDsolve(op,univ(eval(g,pr.subs.var,pr.subs.val),pr.newk,dummy))
+        bas:List(F) := [b(pr.diff) for b in rec.basis]
+        rec.particular case "failed" => ["failed", bas]
+        [((rec.particular)::RF) (pr.diff), bas]
+
+      palgLODE0(eq, g, x, y, kz, xx, dx) ==
+        d := monomial(univariate(inv multivariate(dx, kz), kz), 1)$LODO
+        di:LODO := 1                  -- will accumulate the powers of d
+        op:LODO := 0                  -- will accumulate the new LODO
+        lk:List(K) := [x, y]
+        lv:List(F) := [xx, kz::F]
+        for i in 0..degree eq repeat
+          op := op + univariate(eval(coefficient(eq, i), lk, lv), kz) * di
+          di := d * di
+        rec := ratDsolve(op, univariate(eval(g, lk, lv), kz))
+        bas:List(F) := [multivariate(b, y) for b in rec.basis]
+        rec.particular case "failed" => ["failed", bas]
+        [multivariate((rec.particular)::RF, y), bas]
+
 *)
 
 \end{chunk}
@@ -48570,6 +67765,7 @@ GnuDraw(): Exports == Implementation where
     ++X )sys gnuplot -persist out3d.dat
 
  Implementation ==> add
+
   -- 2-d plotting
   gnuDraw(f:EF,segbind:SBF,filename:STR,opts:List DROP):Void ==
     import TwoDimensionalViewport, GraphImage, TopLevelDrawFunctions EF
@@ -48610,11 +67806,53 @@ GnuDraw(): Exports == Implementation where
   -- default title is ""
   gnuDraw(f:EF,segbind1:SBF, segbind2:SBF, filename:STR):Void ==
     gnuDraw(f,segbind1,segbind2,filename,[title("")$DROP])
+
 \end{chunk}
 
 \begin{chunk}{COQ GDRAW}
 (* package GDRAW *)
 (*
+
+  -- 2-d plotting
+  gnuDraw(f:EF,segbind:SBF,filename:STR,opts:List DROP):Void ==
+    import TwoDimensionalViewport, GraphImage, TopLevelDrawFunctions EF
+    f1:TextFile:=open(filename::FileName,"output")
+    -- handle optional parameters
+    writeLine!(f1,concat(["set title _"",title(opts,"")$DROP0,"_""]))
+    writeLine!(f1,"plot '-' title '' lw 3 with lines")
+    -- extract data as List List Point DoubleFloat
+    p2:=pointLists(getGraph(draw(f, segbind),1));
+    for p1 in p2 repeat
+      for p in p1 repeat
+        writeLine!(f1,concat([unparse(convert(p.1)@InputForm)," ",
+                              unparse(convert(p.2)@InputForm)]))
+      writeLine!(f1); -- blank line need to mark a "branch"
+    close! f1
+
+  -- default title is ""
+  gnuDraw(f:EF,segbind:SBF,filename:STR):Void ==
+    gnuDraw(f,segbind,filename,[title("")$DROP])
+
+  -- 3-d plotting
+  gnuDraw(f:EF,segbind1:SBF,segbind2:SBF,filename:STR,opts:List DROP):Void ==
+    import SubSpace, ThreeSpace DoubleFloat, TopLevelDrawFunctions EF
+    f1:TextFile:=open(filename::FileName,"output")
+    -- process optional parameters
+    writeLine!(f1,concat(["set title _"",title(opts,"")$DROP0,"_""]))
+    writeLine!(f1,"splot '-' title '' with pm3d")
+    -- extract data as List List Point DoubleFloat
+    p2:=mesh(subspace(draw(f, segbind1, segbind2)));
+    for p1 in p2 repeat
+      for p in p1 repeat
+        writeLine!(f1,concat([unparse(convert(p.1)@InputForm)," ",
+                              unparse(convert(p.2)@InputForm)," ",
+                              unparse(convert(p.3)@InputForm)]))
+      writeLine!(f1); -- blank line need to mark a "branch"
+    close! f1
+
+  -- default title is ""
+  gnuDraw(f:EF,segbind1:SBF, segbind2:SBF, filename:STR):Void ==
+    gnuDraw(f,segbind1,segbind2,filename,[title("")$DROP])
 *)
 
 \end{chunk}
@@ -48709,6 +67947,7 @@ GosperSummationMethod(E, V, R, P, Q): Exports == Impl where
             --++  \spad{sum(a(n), n) = rf(n) * a(n)}.
 
     Impl ==> add
+
       import PolynomialCategoryQuotientFunctions(E, V, R, P, Q)
       import LinearSystemMatrixPackage(RQ,Vector RQ,Vector RQ,Matrix RQ)
 
@@ -48726,7 +67965,9 @@ GosperSummationMethod(E, V, R, P, Q): Exports == Impl where
       rat?     : R  -> Boolean
 
       deg0(p, v) == (zero? p => -1; degree(p, v))
+
       rat? x     == retractIfCan(x::P::Q)@Union(RN, "failed") case RN
+
       RFQ2R f    == PQ2R(numer f) / PQ2R(denom f)
 
       PQ2R p ==
@@ -48889,6 +68130,184 @@ GosperSummationMethod(E, V, R, P, Q): Exports == Impl where
 \begin{chunk}{COQ GOSPER}
 (* package GOSPER *)
 (*
+
+      import PolynomialCategoryQuotientFunctions(E, V, R, P, Q)
+      import LinearSystemMatrixPackage(RQ,Vector RQ,Vector RQ,Matrix RQ)
+
+      InnerGospersMethod: (RQ, V, () -> V) -> Union(RQ, "failed")
+      GosperPQR:   (PQ, PQ, V, () -> V)       -> List PQ
+      GosperDegBd: (PQ, PQ, PQ, V, () -> V)    -> I
+      GosperF:     (I, PQ, PQ, PQ, V, () -> V) -> Union(RQ, "failed")
+      linearAndNNIntRoot: (PQ, V) -> Union(I, "failed")
+      deg0:    (PQ, V) -> I       -- degree with deg 0 = -1.
+      pCoef:   (PQ, PQ) -> PQ  -- pCoef(p, a*b**2)
+      RF2QIfCan: Q -> Union(RQ, "failed")
+      UP2QIfCan: P -> Union(PQ,"failed")
+      RFQ2R    : RQ -> Q
+      PQ2R     : PQ -> Q
+      rat?     : R  -> Boolean
+
+      deg0(p, v) == (zero? p => -1; degree(p, v))
+
+      rat? x     == retractIfCan(x::P::Q)@Union(RN, "failed") case RN
+
+      RFQ2R f    == PQ2R(numer f) / PQ2R(denom f)
+
+      PQ2R p ==
+        map(x+->x::P::Q, y+->y::Q, p)$PolynomialCategoryLifting(
+                                       IndexedExponents V, V, RN, PQ, Q)
+
+      GospersMethod(aquo, n, newV) ==
+        ((q := RF2QIfCan aquo) case "failed") or
+          ((u := InnerGospersMethod(q::RQ, n, newV)) case "failed") =>
+             "failed"
+        RFQ2R(u::RQ)
+
+      RF2QIfCan f ==
+        (n := UP2QIfCan numer f) case "failed" => "failed"
+        (d := UP2QIfCan denom f) case "failed" => "failed"
+        n::PQ / d::PQ
+
+      UP2QIfCan p ==
+        every?(rat?, coefficients p) =>
+          map(x +-> x::PQ, 
+              y +-> (retractIfCan(y::P::Q)@Union(RN, "failed"))::RN::PQ,p)_
+               $PolynomialCategoryLifting(E, V, R, P, PQ)
+        "failed"
+
+      InnerGospersMethod(aquo, n, newV) ==
+            -- 1. Define coprime polys an,anm1 such that
+            --      an/anm1=a(n)/a(n-1)
+            an   := numer aquo
+            anm1 := denom aquo
+
+            -- 2. Define p,q,r such that
+            --      a(n)/a(n-1) = (p(n)/p(n-1)) * (q(n)/r(n))
+            --    and
+            --      gcd(q(n), r(n+j)) = 1, for all j: NNI.
+            pqr:= GosperPQR(an, anm1, n, newV)
+            pn := first pqr; qn := second pqr; rn := third pqr
+
+            -- 3. If the sum is a rational fn, there is a poly f with
+            --      sum(a(n), n) = q(n+1)/p(n) * a(n) * f(n).
+
+            -- 4. Bound the degree of f(n).
+            (k := GosperDegBd(pn, qn, rn, n, newV)) < 0 => "failed"
+
+            -- 5. Find a polynomial f of degree at most k, satisfying
+            --      p(n) = q(n+1)*f(n) - r(n)*f(n-1)
+            (ufn := GosperF(k, pn, qn, rn, n, newV)) case "failed" =>
+              "failed"
+            fn  := ufn::RQ
+
+            -- 6. The sum is q(n-1)/p(n)*f(n) * a(n). We leave out a(n).
+            --qnm1 := eval(qn,n,n::PQ - 1)
+            --qnm1/pn * fn
+            qn1 := eval(qn,n,n::PQ + 1)
+            qn1/pn * fn
+
+      GosperF(k, pn, qn, rn, n, newV) ==
+            mv := newV(); mp := mv::PQ; np := n::PQ
+            fn:       PQ := +/[mp**(i+1) * np**i for i in 0..k]
+            fnminus1: PQ := eval(fn, n, np-1)
+            qnplus1        := eval(qn, n, np+1)
+            zro  := qnplus1 * fn - rn * fnminus1 - pn
+            zron := univariate(zro, n)
+            dz  := degree zron
+            mat: Matrix RQ := zero(dz+1, (k+1)::NonNegativeInteger)
+            vec: Vector RQ := new(dz+1, 0)
+            while zron ^= 0 repeat
+                cz := leadingCoefficient zron
+                dz := degree zron
+                zron := reductum zron
+                mz := univariate(cz, mv)
+                while mz ^= 0 repeat
+                    cmz := leadingCoefficient(mz)::RQ
+                    dmz := degree mz
+                    mz := reductum mz
+                    dmz = 0 => vec(dz + minIndex vec) := -cmz
+                    qsetelt_!(mat, dz + minRowIndex mat,
+                                 dmz + minColIndex(mat) - 1, cmz)
+            (soln := particularSolution(mat, vec)) case "failed" => "failed"
+            vec := soln::Vector RQ
+            (+/[np**i * vec(i + minIndex vec) for i in 0..k])@RQ
+
+      GosperPQR(an, anm1, n, newV) ==
+            np := n::PQ   -- polynomial version of n
+            -- Initial guess.
+            pn: PQ := 1
+            qn: PQ := an
+            rn: PQ := anm1
+            -- Find all j: NNI giving common factors to q(n) and r(n+j).
+            j     := newV()
+            rnj   := eval(rn, n, np + j::PQ)
+            res   := resultant(qn, rnj, n)
+            fres  := factor(res)$MRationalFactorize(IndexedExponents V,
+                                                    V, I, PQ)
+            js    := [rt::I for fe in factors fres
+                       | (rt := linearAndNNIntRoot(fe.factor,j)) case I]
+            -- For each such j, change variables to remove the gcd.
+            for rt in js repeat
+                rtp:= rt::PQ  -- polynomial version of rt
+                gn := gcd(qn, eval(rn,n,np+rtp))
+                qn := (qn exquo gn)::PQ
+                rn := (rn exquo eval(gn, n, np-rtp))::PQ
+                pn := pn * */[eval(gn, n, np-i::PQ) for i in 0..rt-1]
+            [pn, qn, rn]
+
+        -- Find a degree bound for the polynomial f(n) which satisfies
+        --   p(n) = q(n+1)*f(n) - r(n)*f(n-1).
+      GosperDegBd(pn, qn, rn, n, newV) ==
+            np := n::PQ
+            qnplus1  := eval(qn, n, np+1)
+            lplus  := deg0(qnplus1 + rn,  n)
+            lminus := deg0(qnplus1 - rn, n)
+            degp   := deg0(pn, n)
+            k := degp - max(lplus-1, lminus)
+            lplus <= lminus => k
+            -- Find L(k), such that
+            --   p(n) = L(k)*c[k]*n**(k + lplus - 1) + ...
+            -- To do this, write f(n) and f(n-1) symbolically.
+            --   f(n)  = c[k]*n**k + c[k-1]*n**(k-1) +O(n**(k-2))
+            --   f(n-1)=c[k]*n**k + (c[k-1]-k*c[k])*n**(k-1)+O(n**(k-2))
+            kk := newV()::PQ
+            ck := newV()::PQ
+            ckm1 := newV()::PQ
+            nkm1:= newV()::PQ
+            nk := np*nkm1
+            headfn   := ck*nk +         ckm1*nkm1
+            headfnm1 := ck*nk + (ckm1-kk*ck)*nkm1
+            -- Then p(n) = q(n+1)*f(n) - r(n)*f(n-1) gives L(k).
+            pk   := qnplus1 * headfn - rn * headfnm1
+            lcpk := pCoef(pk, ck*np*nkm1)
+            -- The degree bd is now given by k, and the root of L.
+            k0 := linearAndNNIntRoot(lcpk, mainVariable(kk)::V)
+            k0 case "failed" => k
+            max(k0::I, k)
+
+      pCoef(p, nom) ==
+            not monomial? nom =>
+              error "pCoef requires a monomial 2nd arg"
+            vlist := variables nom
+            for v in vlist while p ^= 0 repeat
+                unom:= univariate(nom,v)
+                pow:=degree unom
+                nom:=leadingCoefficient unom
+                up  := univariate(p, v)
+                p   := coefficient(up, pow)
+            p
+
+      linearAndNNIntRoot(mp, v) ==
+            p := univariate(mp, v)
+            degree p ^= 1 => "failed"
+            (p1 := retractIfCan(coefficient(p, 1))@Union(RN,"failed"))
+             case "failed" or
+              (p0 := retractIfCan(coefficient(p, 0))@Union(RN,"failed"))
+               case "failed" => "failed"
+            rt := -(p0::RN)/(p1::RN)
+            rt < 0 or denom rt ^= 1 => "failed"
+            numer rt
+
 *)
 
 \end{chunk}
@@ -49020,21 +68439,29 @@ GraphicsDefaults(): Exports == Implementation where
 --% functions
 
     clipPointsDefault()     == CLIPPOINTSDEFAULT
+
     drawToScale()  == TOSCALE
 
     clipPointsDefault b    == CLIPPOINTSDEFAULT := b
+
     drawToScale b == TOSCALE := b
 
 --% settings from the two-dimensional plot package
 
     adaptive() == adaptive?()$Plot
+
     minPoints() == minPoints()$Plot
+
     maxPoints() == maxPoints()$Plot
+
     screenResolution() == screenResolution()$Plot
 
     adaptive b == setAdaptive(b)$Plot
+
     minPoints n == setMinPoints(n)$Plot
+
     maxPoints n == setMaxPoints(n)$Plot
+
     screenResolution n == setScreenResolution(n)$Plot
 
 \end{chunk}
@@ -49042,6 +68469,40 @@ GraphicsDefaults(): Exports == Implementation where
 \begin{chunk}{COQ GRDEF}
 (* package GRDEF *)
 (*
+
+--% global flags and constants
+
+    CLIPPOINTSDEFAULT : B := true
+    TOSCALE  : B := false
+
+--% functions
+
+    clipPointsDefault()     == CLIPPOINTSDEFAULT
+
+    drawToScale()  == TOSCALE
+
+    clipPointsDefault b    == CLIPPOINTSDEFAULT := b
+
+    drawToScale b == TOSCALE := b
+
+--% settings from the two-dimensional plot package
+
+    adaptive() == adaptive?()$Plot
+
+    minPoints() == minPoints()$Plot
+
+    maxPoints() == maxPoints()$Plot
+
+    screenResolution() == screenResolution()$Plot
+
+    adaptive b == setAdaptive(b)$Plot
+
+    minPoints n == setMinPoints(n)$Plot
+
+    maxPoints n == setMaxPoints(n)$Plot
+
+    screenResolution n == setScreenResolution(n)$Plot
+
 *)
 
 \end{chunk}
@@ -49315,6 +68776,72 @@ Graphviz(): Exports == Implementation where
 \begin{chunk}{COQ GRAY}
 (* package GRAY *)
 (*
+
+  standardDotHeader() ==
+    ["digraph graphname {",_
+     "graph [rankdir=_"LR_" ranksep=_"3.0_"]",_
+     "node [style=filled];",_
+     "edge [penwidth=_"0.5_" color=_"blue_"];"_
+    ]
+
+  sampleDotGraph() ==
+    ["I1 [fillcolor=_"white_"];",_
+     "I2 [fillcolor=_"white_"];",_
+     "N1 [fillcolor=_"cadetblue_"];",_
+     "N2 [fillcolor=_"coral_"];",_
+     "N3 [fillcolor=_"green_"];",_
+     "N4 [fillcolor=_"gold_"];",_
+     "N5 [fillcolor=_"cyan_"];",_
+     "N6 [fillcolor=_"red_"];",_
+     "N7 [fillcolor=_"yellow_"];",_
+     "N8 [fillcolor=_"orange_"];",_
+     "O1 [fillcolor=_"white_"];",_
+     "O2 [fillcolor=_"white_"];",_
+     "I1 -> N1;",_
+     "I1 -> N2;",_
+     "I1 -> N3;",_
+     "I2 -> N1;",_
+     "I2 -> N2;",_
+     "I2 -> N3;",_
+     "N1 -> N4;",_
+     "N1 -> N5;",_
+     "N1 -> N6;",_
+     "N2 -> N4;",_
+     "N2 -> N5;",_
+     "N2 -> N6;",_
+     "N3 -> N4;",_
+     "N3 -> N5;",_
+     "N3 -> N6 [color=_"red_" penwidth=_"3_"];",_
+     "N4 -> N7;",_
+     "N4 -> N8;",_
+     "N5 -> N7;",_
+     "N5 -> N8;",_
+     "N6 -> N7;",_
+     "N6 -> N8;",_
+     "N7 -> O1;",_
+     "N8 -> O2;"_
+    ]
+
+  writeDotGraph(header:HEADER, graph:GRAPH, name:FILENAME):Void ==
+    file:TextFile:=open(concat(name,".dot")::FileName,"output")
+    for line in header repeat writeLine!(file,line)
+    for line in graph repeat writeLine!(file,line)
+    write!(file,"}")
+    close!(file)
+    void()
+
+  dot2eps(file) ==
+    instr:String:=concat(file,".dot >")
+    outstr:String:=concat(file,".eps")
+    command:=concat("dot -T eps ",concat(instr,outstr))
+    SYSTEM(command)$Lisp
+    void()
+
+  dotview(viewr,file) ==
+    outstr:String:=concat(file,".eps")
+    SYSTEM(concat(viewr,concat(" ",outstr)))$Lisp
+    void()
+ 
 *)
 
 \end{chunk}
@@ -50011,7 +69538,9 @@ GroebnerFactorizationPackage(Dom, Expon, VarSet, Dpol): T == C where
        -- we use fact that polynomials have content 1
        foundAReducible := 1 < #[el.fctr for el in factorList factor(p)$MF]
      not foundAReducible =>
-       if info then  messagePrint("factorGroebnerBasis: no reducible polynomials in this basis")$OUT
+       if info then 
+         messagePrint(_
+          "factorGroebnerBasis: no reducible polynomials in this basis")$OUT
        [basis]
      -- improve! Use the fact that the irreducible ones already
      -- build part of the basis, use the done factorizations, etc.
@@ -50033,6 +69562,7 @@ GroebnerFactorizationPackage(Dom, Expon, VarSet, Dpol): T == C where
      createGroebnerBases([],[],nonZeroRestrictions,basis,[],[],info)
 
    groebnerFactorize(basis) == groebnerFactorize(basis, [], false)
+
    groebnerFactorize(basis,info) == groebnerFactorize(basis, [], info)
 
 \end{chunk}
@@ -50040,6 +69570,237 @@ GroebnerFactorizationPackage(Dom, Expon, VarSet, Dpol): T == C where
 \begin{chunk}{COQ GBF}
 (* package GBF *)
 (*
+
+   import GroebnerInternalPackage(Dom,Expon,VarSet,Dpol)
+   -- next to help compiler to choose correct signatures:
+   info: Boolean
+   -- signatures of local functions
+
+   newPairs : (L sugarPol, Dpol) -> L critPair
+     ++ newPairs(lp, p) constructs list of critical pairs from the list of
+     ++ lp of input polynomials and a given further one p.
+     ++ It uses criteria M and T to reduce the list.
+   updateCritPairs : (L critPair, L critPair, Dpol) -> L critPair
+     ++ updateCritPairs(lcP1,lcP2,p) applies criterion B to lcP1 using
+     ++ p. Then this list is merged with lcP2.
+   updateBasis : (L sugarPol, Dpol, NNI) -> L sugarPol
+     ++ updateBasis(li,p,deg) every polynomial in li is dropped if
+     ++ its leading term is a multiple of the leading term of p.
+     ++ The result is this list enlarged by p.
+   createGroebnerBases : (L sugarPol, L Dpol, L Dpol, L Dpol, L critPair,_
+                          L L Dpol, Boolean) -> L L Dpol
+     ++ createGroebnerBases(basis, redPols, nonZeroRestrictions, inputPolys,
+     ++   lcP,listOfBases): This function is used to be called from
+     ++ groebnerFactorize.
+     ++ basis: part of a Groebner basis, computed so far
+     ++ redPols: Polynomials from the ideal to be used for reducing,
+     ++   we don't throw away polynomials
+     ++ nonZeroRestrictions: polynomials not zero in the common zeros
+     ++   of the polynomials in the final (Groebner) basis
+     ++ inputPolys: assumed to be in descending order
+     ++ lcP: list of critical pairs built from polynomials of the
+     ++   actual basis
+     ++ listOfBases: Collects the (Groebner) bases constructed by this
+     ++   recursive algorithm at different stages.
+     ++   we print info messages if info is true
+   createAllFactors: Dpol -> L Dpol
+     ++ factor reduced critpair polynomial
+
+   -- implementation of local functions
+
+
+   createGroebnerBases(basis, redPols, nonZeroRestrictions, inputPolys,_
+       lcP, listOfBases, info) ==
+     doSplitting? : B := false
+     terminateWithBasis : B := false
+     allReducedFactors : L Dpol := []
+     nP : Dpol  -- actual polynomial under consideration
+     p :  Dpol  -- next polynomial from input list
+     h :  Dpol  -- next polynomial from critical pairs
+     stopDividing : Boolean
+     --    STEP 1   do the next polynomials until a splitting is possible
+     -- In the first step we take the first polynomial of "inputPolys"
+     -- if empty, from list of critical pairs "lcP" and do the following:
+     -- Divide it, if possible, by the polynomials from "nonZeroRestrictions".
+     -- We factorize it and reduce each irreducible  factor with respect to
+     -- "basis". If 0$Dpol occurs in the list we update the list and continue
+     -- with next polynomial.
+     -- If there are at least two (irreducible) factors
+     -- in the list of factors we finish STEP 1 and set a boolean variable
+     -- to continue with STEP 2, the splitting step.
+     -- If there is just one of it, we do the following:
+     -- If it is 1$Dpol we stop the whole calculation and put
+     -- [1$Dpol] into the listOfBases
+     -- Otherwise we update the "basis" and the other lists and continue
+     -- with next polynomial.
+
+     while (not doSplitting?) and (not terminateWithBasis) repeat
+       terminateWithBasis := (null inputPolys and null lcP)
+       not terminateWithBasis =>  -- still polynomials left
+         -- determine next polynomial "nP"
+         nP :=
+           not null inputPolys =>
+             p := first inputPolys
+             inputPolys := rest inputPolys
+             -- we know that p is not equal to 0 or 1, but, although,
+             -- the inputPolys and the basis are ordered, we cannot assume
+             -- that p is reduced w.r.t. basis, as the ordering is only quasi
+             -- and we could have equal leading terms, and due to factorization
+             -- polynomials of smaller leading terms, hence reduce p first:
+             hMonic redPol(p,redPols)
+           -- now we have inputPolys empty and hence lcP is not empty:
+           -- create S-Polynomial from first critical pair:
+           h := sPol first lcP
+           lcP := rest lcP
+           hMonic redPol(h,redPols)
+
+         nP = 1$Dpol =>
+           basis := [[0,1$Dpol]$sugarPol]
+           terminateWithBasis := true
+
+         -- if "nP" ^= 0, then  we continue, otherwise we determine next "nP"
+         nP ^= 0$Dpol =>
+           -- now we divide "nP", if possible, by the polynomials
+           -- from "nonZeroRestrictions"
+           for q in nonZeroRestrictions repeat
+             stopDividing := false
+             until stopDividing repeat
+               nPq := nP exquo q
+               stopDividing := (nPq case "failed")
+               if not stopDividing then nP := autoCoerce nPq
+               stopDividing := stopDividing or zero? degree nP
+
+           zero? degree nP =>
+             basis := [[0,1$Dpol]$sugarPol]
+             terminateWithBasis := true  -- doSplitting? is still false
+
+           -- a careful analysis has to be done, when and whether the
+           -- following reduction and case nP=1 is necessary
+
+           nP := hMonic redPol(nP,redPols)
+           zero? degree nP =>
+             basis := [[0,1$Dpol]$sugarPol]
+             terminateWithBasis := true  -- doSplitting? is still false
+
+           -- if "nP" ^= 0, then  we continue, otherwise we determine next "nP"
+           nP ^= 0$Dpol =>
+             -- now we factorize "nP", which is not constant
+             irreducibleFactors : L Dpol := createAllFactors(nP)
+             -- if there are more than 1 factors we reduce them and split
+             (doSplitting? := not null rest irreducibleFactors) =>
+               -- and reduce and normalize the factors
+               for fnP in irreducibleFactors repeat
+                 fnP := hMonic redPol(fnP,redPols)
+                 -- no factor reduces to 0, as then "fP" would have been
+                 -- reduced to zero,
+                 -- but 1 may occur, which we will drop in a later version.
+                 allReducedFactors := cons(fnP, allReducedFactors)
+               -- end of "for fnP in irreducibleFactors repeat"
+
+               -- we want that the smaller factors are dealt with first
+               allReducedFactors := reverse allReducedFactors
+             -- now the case of exactly 1 factor, but certainly not
+             -- further reducible with respect to "redPols"
+             nP := first irreducibleFactors
+             -- put "nP" into "basis" and update "lcP" and "redPols":
+             lcP : L critPair := updateCritPairs(lcP,newPairs(basis,nP),nP)
+             basis := updateBasis(basis,nP,virtualDegree nP)
+             redPols := concat(redPols,nP)
+     -- end of "while not doSplitting? and not terminateWithBasis repeat"
+
+     --    STEP 2  splitting step
+
+     doSplitting? =>
+       for fnP in allReducedFactors repeat
+         if fnP ^= 1$Dpol
+           then
+             newInputPolys : L Dpol  := _
+               sort((x,y) +-> degree x > degree y ,cons(fnP,inputPolys))
+             listOfBases := createGroebnerBases(basis, redPols, _
+               nonZeroRestrictions,newInputPolys,lcP,listOfBases,info)
+             -- update "nonZeroRestrictions"
+             nonZeroRestrictions := cons(fnP,nonZeroRestrictions)
+           else
+             if info then
+               messagePrint("we terminated with [1]")$OUT
+             listOfBases := cons([1$Dpol],listOfBases)
+
+       -- we finished with all the branches on one level and hence
+       -- finished this call of createGroebnerBasis. Therefore
+       -- we terminate with the actual "listOfBasis" as
+       -- everything is done in the recursions
+       listOfBases
+     -- end of "doSplitting? =>"
+
+     --    STEP 3 termination step
+
+     --  we found a groebner basis and put it into the list "listOfBases"
+     --  (auto)reduce each basis element modulo the others
+     newBasis := 
+       minGbasis(sort((x,y)+->degree x > degree y,[p.pol for p in basis]))
+     -- now check whether the normalized basis again has reducible
+     -- polynomials, in this case continue splitting!
+     if info then
+       messagePrint("we found a groebner basis and check whether it ")$OUT
+       messagePrint("contains reducible polynomials")$OUT
+       print(newBasis::OUT)$OUT
+       -- here we should create an output form which is reusable by the system
+       -- print(convert(newBasis::OUT)$InputForm :: OUT)$OUT
+     removeDuplicates append(factorGroebnerBasis(newBasis, info), listOfBases)
+
+   createAllFactors(p: Dpol) ==
+     loF : L Dpol := [el.fctr for el in factorList factor(p)$MF]
+     sort((x,y) +-> degree x < degree y, loF)
+   newPairs(lp : L sugarPol,p : Dpol) ==
+     totdegreeOfp : NNI := virtualDegree p
+     -- next list lcP contains all critPair constructed from
+     -- p and and the polynomials q in lp
+     lcP: L critPair := _
+       --[[sup(degree q, degreeOfp), q, p]$critPair for q in lp]
+       [makeCrit(q, p, totdegreeOfp) for q in lp]
+     -- application of the criteria to reduce the list lcP
+     critMTonD1 sort(critpOrder,lcP)
+   updateCritPairs(oldListOfcritPairs, newListOfcritPairs, p)==
+     updatD (newListOfcritPairs, critBonD(p,oldListOfcritPairs))
+   updateBasis(lp, p, deg) == updatF(p,deg,lp)
+
+   -- exported functions
+
+   factorGroebnerBasis basis == factorGroebnerBasis(basis, false)
+
+   factorGroebnerBasis (basis, info) ==
+     foundAReducible : Boolean := false
+     for p in basis while not foundAReducible repeat
+       -- we use fact that polynomials have content 1
+       foundAReducible := 1 < #[el.fctr for el in factorList factor(p)$MF]
+     not foundAReducible =>
+       if info then 
+         messagePrint(_
+          "factorGroebnerBasis: no reducible polynomials in this basis")$OUT
+       [basis]
+     -- improve! Use the fact that the irreducible ones already
+     -- build part of the basis, use the done factorizations, etc.
+     if info then  messagePrint("factorGroebnerBasis:_
+        we found reducible polynomials and continue splitting")$OUT
+     createGroebnerBases([],[],[],basis,[],[],info)
+
+   groebnerFactorize(basis, nonZeroRestrictions) ==
+     groebnerFactorize(basis, nonZeroRestrictions, false)
+
+   groebnerFactorize(basis, nonZeroRestrictions, info) ==
+     basis = [] => [basis]
+     basis := remove((x:Dpol):Boolean +->(x = 0$Dpol),basis)
+     basis = [] => [[0$Dpol]]
+     -- normalize all input polynomial
+     basis := [hMonic p for p in basis]
+     member?(1$Dpol,basis) => [[1$Dpol]]
+     basis :=  sort((x,y) +-> degree x > degree y, basis)
+     createGroebnerBases([],[],nonZeroRestrictions,basis,[],[],info)
+
+   groebnerFactorize(basis) == groebnerFactorize(basis, [], false)
+
+   groebnerFactorize(basis,info) == groebnerFactorize(basis, [], info)
+
 *)
 
 \end{chunk}
@@ -50211,13 +69972,17 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where
         ++ virtualDegree \undocumented
 
  C== add
+
    Ex ==> OutputForm
    import OutputForm
 
    ------  Definition of intermediate functions
    if Dpol has totalDegree: Dpol -> NonNegativeInteger then
+
      virtualDegree p == totalDegree p
+
    else
+
      virtualDegree p == 0
 
    ------  ordering of critpairs
@@ -50597,6 +70362,391 @@ GroebnerInternalPackage(Dom, Expon, VarSet, Dpol): T == C where
 \begin{chunk}{COQ GBINTERN}
 (* package GBINTERN *)
 (*
+
+   Ex ==> OutputForm
+   import OutputForm
+
+   ------  Definition of intermediate functions
+   if Dpol has totalDegree: Dpol -> NonNegativeInteger then
+
+     virtualDegree p == totalDegree p
+
+   else
+
+     virtualDegree p == 0
+
+   ------  ordering of critpairs
+
+   critpOrder(cp1,cp2) ==
+     cp1.totdeg < cp2.totdeg => true
+     cp2.totdeg < cp1.totdeg => false
+     cp1.lcmfij < cp2.lcmfij
+
+   ------    creating a critical pair
+
+   makeCrit(sp1, p2, totdeg2) ==
+     p1 := sp1.pol
+     deg := sup(degree(p1), degree(p2))
+     e1 := subtractIfCan(deg, degree(p1))::Expon
+     e2 := subtractIfCan(deg, degree(p2))::Expon
+     tdeg := max(sp1.totdeg + virtualDegree(monomial(1,e1)),
+                 totdeg2 + virtualDegree(monomial(1,e2)))
+     [deg, tdeg, p1, p2]$critPair
+
+   ------    calculate basis
+
+   gbasis(Pol: List(Dpol), xx1: Integer, xx2: Integer ) ==
+     D, D1: List(critPair)
+     ---------   create D and Pol
+
+     Pol1:= sort((z1,z2) +-> degree z1 > degree z2, Pol)
+     basPols:= updatF(hMonic(first Pol1),virtualDegree(first Pol1),[])
+     Pol1:= rest(Pol1)
+     D:= nil
+     while _^ null Pol1 repeat
+        h:= hMonic(first(Pol1))
+        Pol1:= rest(Pol1)
+        toth := virtualDegree h
+        D1:= [makeCrit(x,h,toth) for x in basPols]
+        D:= updatD(critMTonD1(sort(critpOrder, D1)),
+                   critBonD(h,D))
+        basPols:= updatF(h,toth,basPols)
+     D:= sort(critpOrder, D)
+     xx:= xx2
+     --------  loop
+
+     redPols := [x.pol for x in basPols]
+     while _^ null D repeat
+         D0:= first D
+         s:= hMonic(sPol(D0))
+         D:= rest(D)
+         h:= hMonic(redPol(s,redPols))
+         if xx1 = 1  then
+              prinshINFO(h)
+         h = 0  =>
+          if xx2 = 1 then
+           prindINFO(D0,s,h,# basPols, # D,xx)
+           xx:= 2
+          " go to top of while "
+         degree(h) = 0 =>
+           D:= nil
+           if xx2 = 1 then
+            prindINFO(D0,s,h,# basPols, # D,xx)
+            xx:= 2
+           basPols:= updatF(h,0,[])
+           leave "out of while"
+         D1:= [makeCrit(x,h,D0.totdeg) for x in basPols]
+         D:= updatD(critMTonD1(sort(critpOrder, D1)),
+                   critBonD(h,D))
+         basPols:= updatF(h,D0.totdeg,basPols)
+         redPols := concat(redPols,h)
+         if xx2 = 1 then
+            prindINFO(D0,s,h,# basPols, # D,xx)
+            xx:= 2
+     Pol := [x.pol for x in basPols]
+     if xx2 = 1 then
+       prinpolINFO(Pol)
+       messagePrint("    THE GROEBNER BASIS POLYNOMIALS")
+     if xx1 = 1 and xx2 ^= 1 then
+       messagePrint("    THE GROEBNER BASIS POLYNOMIALS")
+     Pol
+
+             --------------------------------------
+
+             --- erase multiple of e in D2 using crit M
+
+   critMonD1(e: Expon, D2: List(critPair))==
+      null D2 => nil
+      x:= first(D2)
+      critM(e, x.lcmfij) => critMonD1(e, rest(D2))
+      cons(x, critMonD1(e, rest(D2)))
+
+             ----------------------------
+
+             --- reduce D1 using crit T and crit M
+
+   critMTonD1(D1: List(critPair))==
+           null D1 => nil
+           f1:= first(D1)
+           s1:= #(D1)
+           cT1:= critT(f1)
+           s1= 1 and cT1 => nil
+           s1= 1 => D1
+           e1:= f1.lcmfij
+           r1:= rest(D1)
+           e1 = (first r1).lcmfij  =>
+              cT1 =>   critMTonD1(cons(f1, rest(r1)))
+              critMTonD1(r1)
+           D1 := critMonD1(e1, r1)
+           cT1 => critMTonD1(D1)
+           cons(f1, critMTonD1(D1))
+
+             -----------------------------
+
+             --- erase elements in D fullfilling crit B
+
+   critBonD(h:Dpol, D: List(critPair))==
+         null D => nil
+         x:= first(D)
+         critB(degree(h), x.lcmfij, degree(x.poli), degree(x.polj)) =>
+           critBonD(h, rest(D))
+         cons(x, critBonD(h, rest(D)))
+
+             -----------------------------
+
+             --- concat F and h and erase multiples of h in F
+
+   updatF(h: Dpol, deg:NNI, F: List(sugarPol)) ==
+       null F => [[deg,h]]
+       f1:= first(F)
+       critM(degree(h), degree(f1.pol))  => updatF(h, deg, rest(F))
+       cons(f1, updatF(h, deg, rest(F)))
+
+             -----------------------------
+
+             --- concat ordered critical pair lists D1 and D2
+
+   updatD(D1: List(critPair), D2: List(critPair)) ==
+      null D1 => D2
+      null D2 => D1
+      dl1:= first(D1)
+      dl2:= first(D2)
+      critpOrder(dl1,dl2) => cons(dl1, updatD(D1.rest, D2))
+      cons(dl2, updatD(D1, D2.rest))
+
+            -----------------------------
+
+            --- remove gcd from pair of coefficients
+
+   gcdCo(c1:Dom, c2:Dom):Record(co1:Dom,co2:Dom) ==
+      d:=gcd(c1,c2)
+      [(c1 exquo d)::Dom, (c2 exquo d)::Dom]
+
+            --- calculate S-polynomial of a critical pair
+
+   sPol(p:critPair)==
+      Tij := p.lcmfij
+      fi := p.poli
+      fj := p.polj
+      cc := gcdCo(leadingCoefficient fi, leadingCoefficient fj)
+      reductum(fi)*monomial(cc.co2,subtractIfCan(Tij, degree fi)::Expon) -
+        reductum(fj)*monomial(cc.co1,subtractIfCan(Tij, degree fj)::Expon)
+
+            ----------------------------
+
+            --- reduce critpair polynomial mod F
+            --- iterative version
+
+   redPo(s: Dpol, F: List(Dpol)) ==
+      m:Dom := 1
+      Fh := F
+      while _^ ( s = 0 or null F ) repeat
+        f1:= first(F)
+        s1:= degree(s)
+        e: Union(Expon, "failed")
+        (e:= subtractIfCan(s1, degree(f1))) case Expon  =>
+           cc:=gcdCo(leadingCoefficient f1, leadingCoefficient s)
+           s:=cc.co1*reductum(s) - monomial(cc.co2,e)*reductum(f1)
+           m := m*cc.co1
+           F:= Fh
+        F:= rest F
+      [s,m]
+
+   redPol(s: Dpol, F: List(Dpol)) ==  credPol(redPo(s,F).poly,F)
+
+            ----------------------------
+
+            --- crit T  true, if e1 and e2 are disjoint
+
+   critT(p: critPair) == p.lcmfij =  (degree(p.poli) + degree(p.polj))
+
+            ----------------------------
+
+            --- crit M - true, if lcm#2 multiple of lcm#1
+
+   critM(e1: Expon, e2: Expon) ==
+         en: Union(Expon, "failed")
+         (en:=subtractIfCan(e2, e1)) case Expon
+
+            ----------------------------
+
+            --- crit B - true, if eik is a multiple of eh and eik ^equal
+            ---          lcm(eh,ei) and eik ^equal lcm(eh,ek)
+
+   critB(eh:Expon, eik:Expon, ei:Expon, ek:Expon) ==
+       critM(eh, eik) and (eik ^= sup(eh, ei)) and (eik ^= sup(eh, ek))
+
+            ----------------------------
+
+            ---  make polynomial monic case Domain a Field
+
+   hMonic(p: Dpol) ==
+        p= 0 => p
+        -- inv(leadingCoefficient(p))*p
+        primitivePart p
+
+            -----------------------------
+
+            ---  reduce all terms of h mod F  (iterative version )
+
+   credPol(h: Dpol, F: List(Dpol) ) ==
+        null F => h
+        h0:Dpol:= monomial(leadingCoefficient h, degree h)
+        while (h:=reductum h) ^= 0 repeat
+           hred:= redPo(h, F)
+           h := hred.poly
+           h0:=(hred.mult)*h0 + monomial(leadingCoefficient(h),degree h)
+        h0
+
+            -------------------------------
+
+            ----  calculate minimal basis for ordered F
+
+   minGbasis(F: List(Dpol)) ==
+        null F => nil
+        newbas := minGbasis rest F
+        cons(hMonic credPol( first(F), newbas),newbas)
+
+            -------------------------------
+
+            ----  calculate number of terms of polynomial
+
+   lepol(p1:Dpol)==
+      n: Integer
+      n:= 0
+      while p1 ^= 0 repeat
+         n:= n + 1
+         p1:= reductum(p1)
+      n
+
+            ----  print blanc lines
+
+   prinb(n: Integer)==
+      for x in 1..n repeat
+         messagePrint("    ")
+
+            ----  print reduced critpair polynom
+
+   prinshINFO(h: Dpol)==
+           prinb(2)
+           messagePrint(" reduced Critpair - Polynom :")
+           prinb(2)
+           print(h::Ex)
+           prinb(2)
+
+            -------------------------------
+
+            ----  print info string
+
+   prindINFO(cp: critPair, ps: Dpol, ph: Dpol, i1:Integer,
+             i2:Integer, n:Integer) ==
+       ll: List Prinp
+       a: Dom
+       cpi:= cp.poli
+       cpj:= cp.polj
+       if n = 1 then
+        prinb(1)
+        messagePrint("you choose option  -info-  ")
+        messagePrint("abbrev. for the following information strings are")
+        messagePrint("  ci  =>  Leading monomial  for critpair calculation")
+        messagePrint("  tci =>  Number of terms of polynomial i")
+        messagePrint("  cj  =>  Leading monomial  for critpair calculation")
+        messagePrint("  tcj =>  Number of terms of polynomial j")
+        messagePrint("  c   =>  Leading monomial of critpair polynomial")
+        messagePrint("  tc  =>  Number of terms of critpair polynomial")
+        messagePrint("  rc  =>  Leading monomial of redcritpair polynomial")
+        messagePrint("  trc =>  Number of terms of redcritpair polynomial")
+        messagePrint("  tF  =>  Number of polynomials in reduction list F")
+        messagePrint("  tD  =>  Number of critpairs still to do")
+        prinb(4)
+        n:= 2
+       prinb(1)
+       a:= 1
+       ph = 0  =>
+          ps = 0 =>
+            ll:= [[monomial(a,degree(cpi)),lepol(cpi),
+                  monomial(a,degree(cpj)),
+                   lepol(cpj),ps,0,ph,0,i1,i2]$Prinp]
+            print(ll::Ex)
+            prinb(1)
+            n
+          ll:= [[monomial(a,degree(cpi)),lepol(cpi),
+             monomial(a,degree(cpj)),lepol(cpj),monomial(a,degree(ps)),
+              lepol(ps), ph,0,i1,i2]$Prinp]
+          print(ll::Ex)
+          prinb(1)
+          n
+       ll:= [[monomial(a,degree(cpi)),lepol(cpi),
+            monomial(a,degree(cpj)),lepol(cpj),monomial(a,degree(ps)),
+             lepol(ps),monomial(a,degree(ph)),lepol(ph),i1,i2]$Prinp]
+       print(ll::Ex)
+       prinb(1)
+       n
+
+            -------------------------------
+
+            ----  print the groebner basis polynomials
+
+   prinpolINFO(pl: List(Dpol))==
+       n:Integer
+       n:= # pl
+       prinb(1)
+       n = 1 =>
+         messagePrint("  There is 1  Groebner Basis Polynomial ")
+         prinb(2)
+       messagePrint("  There are ")
+       prinb(1)
+       print(n::Ex)
+       prinb(1)
+       messagePrint("  Groebner Basis Polynomials. ")
+       prinb(2)
+
+   fprindINFO(cp: critPair, ps: Dpol, ph: Dpol, i1:Integer,
+             i2:Integer, i3:Integer, n: Integer) ==
+       ll: List Prinpp
+       a: Dom
+       cpi:= cp.poli
+       cpj:= cp.polj
+       if n = 1 then
+        prinb(1)
+        messagePrint("you choose option  -info-  ")
+        messagePrint("abbrev. for the following information strings are")
+        messagePrint("  ci  =>  Leading monomial  for critpair calculation")
+        messagePrint("  tci =>  Number of terms of polynomial i")
+        messagePrint("  cj  =>  Leading monomial  for critpair calculation")
+        messagePrint("  tcj =>  Number of terms of polynomial j")
+        messagePrint("  c   =>  Leading monomial of critpair polynomial")
+        messagePrint("  tc  =>  Number of terms of critpair polynomial")
+        messagePrint("  rc  =>  Leading monomial of redcritpair polynomial")
+        messagePrint("  trc =>  Number of terms of redcritpair polynomial")
+        messagePrint("  tF  =>  Number of polynomials in reduction list F")
+        messagePrint("  tD  =>  Number of critpairs still to do")
+        messagePrint("  tDF =>  Number of subproblems still to do")
+        prinb(4)
+        n:= 2
+       prinb(1)
+       a:= 1
+       ph = 0  =>
+          ps = 0 =>
+            ll:= [[monomial(a,degree(cpi)),lepol(cpi),
+              monomial(a,degree(cpj)),
+               lepol(cpj),ps,0,ph,0,i1,i2,i3]$Prinpp]
+            print(ll::Ex)
+            prinb(1)
+            n
+          ll:= [[monomial(a,degree(cpi)),lepol(cpi),
+            monomial(a,degree(cpj)),lepol(cpj),monomial(a,degree(ps)),
+             lepol(ps), ph,0,i1,i2,i3]$Prinpp]
+          print(ll::Ex)
+          prinb(1)
+          n
+       ll:= [[monomial(a,degree(cpi)),lepol(cpi),
+            monomial(a,degree(cpj)),lepol(cpj),monomial(a,degree(ps)),
+             lepol(ps),monomial(a,degree(ph)),lepol(ph),i1,i2,i3]$Prinpp]
+       print(ll::Ex)
+       prinb(1)
+       n
+
 *)
 
 \end{chunk}
@@ -52040,12 +72190,13 @@ GroebnerPackage(Dom, Expon, VarSet, Dpol): T == C where
       ++ precomputed groebner basis gb giving a canonical representative
       ++ of the residue class.
  C== add
+
    import OutputForm
    import GroebnerInternalPackage(Dom,Expon,VarSet,Dpol)
  
    if Dom has Field then
+
      monicize(p: Dpol):Dpol ==
---       one?(lc := leadingCoefficient p) => p
        ((lc := leadingCoefficient p) = 1) => p
        inv(lc)*p
 
@@ -52098,6 +72249,60 @@ GroebnerPackage(Dom, Expon, VarSet, Dpol): T == C where
 \begin{chunk}{COQ GB}
 (* package GB *)
 (*
+
+   import OutputForm
+   import GroebnerInternalPackage(Dom,Expon,VarSet,Dpol)
+ 
+   if Dom has Field then
+
+     monicize(p: Dpol):Dpol ==
+       ((lc := leadingCoefficient p) = 1) => p
+       inv(lc)*p
+
+     normalForm(p : Dpol, l : List(Dpol)) : Dpol ==
+       redPol(p,map(monicize,l))
+ 
+   ------    MAIN ALGORITHM GROEBNER ------------------------
+ 
+   groebner( Pol: List(Dpol) ) ==
+     Pol=[] => Pol
+     Pol:=[x for x in Pol | x ^= 0]
+     Pol=[] => [0]
+     minGbasis(sort((x,y) +->  degree x > degree y, gbasis(Pol,0,0)))
+ 
+   groebner( Pol: List(Dpol), xx1: String) ==
+     Pol=[] => Pol
+     Pol:=[x for x in Pol | x ^= 0]
+     Pol=[] => [0]
+     xx1 = "redcrit" =>
+       minGbasis(sort((x,y) +->  degree x > degree y, gbasis(Pol,1,0)))
+     xx1 = "info" =>
+       minGbasis(sort((x,y) +-> degree x > degree y, gbasis(Pol,2,1)))
+     messagePrint("   ")
+     messagePrint("WARNING: options are - redcrit and/or info - ")
+     messagePrint("         you didn't type them correct")
+     messagePrint("         please try again")
+     messagePrint("   ")
+     []
+ 
+   groebner( Pol: List(Dpol), xx1: String, xx2: String) ==
+     Pol=[] => Pol
+     Pol:=[x for x in Pol | x ^= 0]
+     Pol=[] => [0]
+     (xx1 = "redcrit" and xx2 = "info") or
+      (xx1 = "info" and xx2 = "redcrit")   =>
+       minGbasis(sort((x,y) +-> degree x > degree y, gbasis(Pol,1,1)))
+     xx1 = "redcrit" and xx2 = "redcrit" =>
+       minGbasis(sort((x,y) +-> degree x > degree y, gbasis(Pol,1,0)))
+     xx1 = "info" and xx2 = "info" =>
+       minGbasis(sort((x,y) +-> degree x > degree y, gbasis(Pol,2,1)))
+     messagePrint("   ")
+     messagePrint("WARNING:  options are - redcrit and/or info - ")
+     messagePrint("          you didn't type them correctly")
+     messagePrint("          please try again ")
+     messagePrint("   ")
+     []
+
 *)
 
 \end{chunk}
@@ -52210,6 +72415,7 @@ GroebnerSolve(lv,F,R) : C == T
         ++ in general position, for system lp in variables lv.
 
    T == add
+
      import PolToPol(lv,F)
      import GroebnerPackage(F,DP,OV,DPoly)
      import GroebnerInternalPackage(F,DP,OV,DPoly)
@@ -52357,6 +72563,149 @@ GroebnerSolve(lv,F,R) : C == T
 \begin{chunk}{COQ GROEBSOL}
 (* package GROEBSOL *)
 (*
+
+     import PolToPol(lv,F)
+     import GroebnerPackage(F,DP,OV,DPoly)
+     import GroebnerInternalPackage(F,DP,OV,DPoly)
+     import GroebnerPackage(F,HDP,OV,HDPoly)
+     import LinGroebnerPackage(lv,F)
+
+     nv:NNI:=#lv
+
+          ---- test if f is power of a linear mod (rad lpol) ----
+                     ----  f is monic  ----
+     testPower(uf:SUP,x:OV,lpol:L DPoly) : Union(DPoly,"failed") ==
+       df:=degree(uf)
+       trailp:DPoly := coefficient(uf,(df-1)::NNI)
+       (testquo := trailp exquo (df::F)) case "failed" => "failed"
+       trailp := testquo::DPoly
+       gg:=gcd(lc:=leadingCoefficient(uf),trailp)
+       trailp := (trailp exquo gg)::DPoly
+       lc := (lc exquo gg)::DPoly
+       linp:SUP:=monomial(lc,1$NNI)$SUP + monomial(trailp,0$NNI)$SUP
+       g:DPoly:=multivariate(uf-linp**df,x)
+       redPol(g,lpol) ^= 0 => "failed"
+       multivariate(linp,x)
+
+            -- is the 0-dimensional ideal I in general position ?  --
+                     ----  internal function  ----
+     testGenPos(lpol:L DPoly,lvar:L OV):Union(L DPoly,"failed") ==
+       rlpol:=reverse lpol
+       f:=rlpol.first
+       #lvar=1 => [f]
+       rlvar:=rest reverse lvar
+       newlpol:List(DPoly):=[f]
+       for f in rlpol.rest repeat
+         x:=first rlvar
+         fi:= univariate(f,x)
+         if (mainVariable leadingCoefficient fi case "failed") then
+           if ((g:= testPower(fi,x,newlpol)) case "failed")
+           then return "failed"
+           newlpol :=concat(redPol(g::DPoly,newlpol),newlpol)
+           rlvar:=rest rlvar
+         else if redPol(f,newlpol)^=0 then return"failed"
+       newlpol
+
+
+        -- change coordinates and out the ideal in general position  ----
+     genPos(lp:L DPoly,lvar:L OV): Record(polys:L HDPoly, lpolys:L DPoly,
+                                           coord:L I, univp:HDPoly) ==
+           rlvar:=reverse lvar
+           lnp:=[dmpToHdmp(f) for f in lp]
+           x := first rlvar;rlvar:=rest rlvar
+           testfail:=true
+           for count in 1.. while testfail repeat
+             ranvals:L I:=[1+(random()$I rem (count*(# lvar))) for vv in rlvar]
+             val:=+/[rv*(vv::HDPoly)
+                        for vv in rlvar for rv in ranvals]
+             val:=val+x::HDPoly
+             gb:L HDPoly:= [elt(univariate(p,x),val) for p in lnp]
+             gb:=groebner gb
+             gbt:=totolex gb
+             (gb1:=testGenPos(gbt,lvar)) case "failed"=>"try again"
+             testfail:=false
+           [gb,gbt,ranvals,dmpToHdmp(last (gb1::L DPoly))]
+
+     genericPosition(lp:L DPoly,lvar:L OV) ==
+        nans:=genPos(lp,lvar)
+        [nans.lpolys, nans.coord]
+
+        ---- select  the univariate factors
+     select(lup:L L HDPoly) : L L HDPoly ==
+       lup=[] => list []
+       [:[cons(f,lsel) for lsel in select lup.rest] for f in lup.first]
+
+        ---- in the non generic case, we compute the prime ideals ----
+           ---- associated to leq, basis is the algebra basis  ----
+     findCompon(leq:L HDPoly,lvar:L OV):L L DPoly ==
+       teq:=totolex(leq)
+       #teq = #lvar => [teq]
+      -- ^((teq1:=testGenPos(teq,lvar)) case "failed") => [teq1::L DPoly]
+       gp:=genPos(teq,lvar)
+       lgp:= gp.polys
+       g:HDPoly:=gp.univp
+       fg:=(factor g)$GeneralizedMultivariateFactorize(OV,HDP,R,F,HDPoly)
+       lfact:=[ff.factor for ff in factors(fg::Factored(HDPoly))]
+       result: L L HDPoly := []
+       #lfact=1 => [teq]
+       for tfact in lfact repeat
+         tlfact:=concat(tfact,lgp)
+         result:=concat(tlfact,result)
+       ranvals:L I:=gp.coord
+       rlvar:=reverse lvar
+       x:=first rlvar
+       rlvar:=rest rlvar
+       val:=+/[rv*(vv::HDPoly) for vv in rlvar for rv in ranvals]
+       val:=(x::HDPoly)-val
+       ans:=[totolex groebner [elt(univariate(p,x),val) for p in lp]
+                           for lp in result]
+       [ll for ll in ans | ll^=[1]]
+
+     zeroDim?(lp: List HDPoly,lvar:L OV) : Boolean ==
+       empty? lp => false
+       n:NNI := #lvar
+       #lp < n => false
+       lvint1 := lvar
+       for f in lp while not empty?(lvint1) repeat
+          g:= f - reductum f
+          x:=mainVariable(g)::OV
+          if ground?(leadingCoefficient(univariate(g,x))) then
+               lvint1 := remove(x, lvint1)
+       empty? lvint1
+
+     -- general solve, gives an error if the system not 0-dimensional
+     groebSolve(leq: L DPoly,lvar:L OV) : L L DPoly ==
+       lnp:=[dmpToHdmp(f) for f in leq]
+       leq1:=groebner lnp
+       #(leq1) = 1 and first(leq1) = 1 => list empty()
+       ^(zeroDim?(leq1,lvar)) =>
+         error "system does not have a finite number of solutions"
+       -- add computation of dimension, for a more useful error
+       basis:=computeBasis(leq1)
+       lup:L HDPoly:=[]
+       llfact:L Factored(HDPoly):=[]
+       for x in lvar repeat
+         g:=minPol(leq1,basis,x)
+         fg:=(factor g)$GeneralizedMultivariateFactorize(OV,HDP,R,F,HDPoly)
+         llfact:=concat(fg::Factored(HDPoly),llfact)
+         if degree(g,x) = #basis then leave "stop factoring"
+       result: L L DPoly := []
+       -- selecting a factor from the lists of the univariate factors
+       lfact:=select [[ff.factor for ff in factors llf]
+                       for llf in llfact]
+       for tfact in lfact repeat
+         tfact:=groebner concat(tfact,leq1)
+         tfact=[1] => "next value"
+         result:=concat(result,findCompon(tfact,lvar))
+       result
+
+     -- test if the system is zero dimensional
+     testDim(leq : L HDPoly,lvar : L OV) : Union(L HDPoly,"failed") ==
+       leq1:=groebner leq
+       #(leq1) = 1 and first(leq1) = 1 => empty()
+       ^(zeroDim?(leq1,lvar)) => "failed"
+       leq1
+
 *)
 
 \end{chunk}
@@ -53388,11 +73737,11 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
                                    output("numerator and denominator vanish!")
                                          $OutputPackage
       
-      -- If we are only interested in one solution, we do not try other degrees if we
-      -- have found already some solutions. I.e., the indentation here is correct.
-      
+      -- If we are only interested in one solution, 
+      -- we do not try other degrees if we
+      -- have found already some solutions. I.e., 
+      -- the indentation here is correct.
               if not null(res) and one(options)$GOPT0 then return res
-      
           res
       
       guessBinRatAux0(list: List F,
@@ -53437,11 +73786,11 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
       
           res: List EXPRR 
               := [eval(zeros * f, xx::EXPRR, xx::EXPRR) _
-                  for f in guessBinRatAux(xx, newlist, basis, ext, extEXPR, xValues, _
+               for f in guessBinRatAux(xx,newlist,basis,ext,extEXPR,xValues, _
                                           options)]
       
-          reslist := map([#1, checkResult(#1, xx, len, list, options)], res)
-                        $ListFunctions2(EXPRR, Record(function: EXPRR, order: NNI))
+          reslist := map([#1, checkResult(#1, xx, len, list, options)], res)_
+                   $ListFunctions2(EXPRR, Record(function: EXPRR, order: NNI))
       
           select(#1.order < len-safety(options)$GOPT0, reslist)
       
@@ -53513,7 +73862,7 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
                                  ** second(part)::NNI for part in ll]
               reduce(_*, fl)
       
-      termAsUFPSF(f: UFPSF, l: List Integer, DS: DIFFSPECS, D1: DIFFSPEC1): UFPSF ==
+      termAsUFPSF(f:UFPSF,l:List Integer,DS:DIFFSPECS, D1: DIFFSPEC1): UFPSF ==
           if empty? l then D1
           else
               ll: List List Integer := powers(l)$Partition
@@ -53535,7 +73884,7 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
       -- first of each element of ll is the derivative, second is the power
       
               fl: List UFPSF 
-                  := [map(#1** second(part)::NNI, DS(f, (first part -1)::NNI)) _
+                 := [map(#1** second(part)::NNI, DS(f, (first part -1)::NNI)) _
                       for part in ll]
       
               reduce(hadamard$UFPS1(F), fl)
@@ -53566,7 +73915,7 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
       -- first of each element of ll is the derivative, second is the power
       
               fl: List UFPSSUPF 
-                 := [map(#1 ** second(part)::NNI, DSF(f, (first part -1)::NNI)) _
+                 := [map(#1**second(part)::NNI, DSF(f, (first part -1)::NNI)) _
                      for part in ll]
       
               reduce(hadamard$UFPS1(SUP F), fl)
@@ -53586,10 +73935,6 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
               s3: Stream List Integer 
                  := concat(s2)$StreamFunctions1(List Integer)
       
-      --        s := cons([],
-      --                  select(((maxD = 0) or (first #1 <= maxD)) _
-      --                     and ((maxP = -1) or (# #1 <= maxP)), s3))
-      
               s := cons([],
                         select(((maxD = 0) or (# #1 <= maxD)) _
                            and ((maxP = -1) or (first #1 <= maxP)), s3))
@@ -53638,7 +73983,7 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
       
       diffDSF: DIFFSPECSF
       diffDSF(s, n) == 
-      -- I have to help the compiler here a little to choose the right signature...
+      --  help the compiler here a little to choose the right signature...
           if SUP F has _*: (NonNegativeInteger, SUP F) -> SUP F
           then D(s, n)
 
@@ -53673,22 +74018,25 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
 
       if F has RetractableTo Symbol and S has RetractableTo Symbol then
       
-          qDiffDX(q: Symbol, expr: EXPRR, x: Symbol, n: NonNegativeInteger): EXPRR ==
+          qDiffDX(q:Symbol,expr:EXPRR,x:Symbol,n:NonNegativeInteger): EXPRR ==
               eval(expr, x::EXPRR, (q::EXPRR)**n*x::EXPRR)
       
           qDiffDS(q: Symbol, s: UFPSF, n: NonNegativeInteger): UFPSF ==
               multiplyCoefficients((q::F)**((n*#1)::NonNegativeInteger), s)
       
           qDiffDSF(q: Symbol, s: UFPSSUPF, n: NonNegativeInteger): UFPSSUPF ==
-              multiplyCoefficients((q::F::SUP F)**((n*#1)::NonNegativeInteger), s)
+              multiplyCoefficients((q::F::SUP F)**_
+                ((n*#1)::NonNegativeInteger), s)
       
           diffHP(q: Symbol): (LGOPT -> HPSPEC) == 
               if displayAsGF(#1)$GOPT0 then
                   partitions := FilteredPartitionStream #1
-                  [ADEguessStream(#1, partitions, qDiffDS(q, #1, #2), 1$UFPSF), _
+                  [ADEguessStream(#1,partitions,qDiffDS(q, #1, #2), 1$UFPSF), _
                    repeating([0$NNI])$Stream(NNI), _
-                   ADEtestStream(#1, partitions, qDiffDSF(q, #1, #2), 1$UFPSSUPF), _
-                   ADEEXPRRStream(#1, #2, partitions, qDiffDX(q, #1, #2, #3), diff1X), _
+                   ADEtestStream(#1, partitions, qDiffDSF(q, #1, #2), _
+                      1$UFPSSUPF), _
+                   ADEEXPRRStream(#1, #2, partitions, _
+                      qDiffDX(q, #1, #2, #3), diff1X), _
                    diffA, diffAF, diffAX, diffC]$HPSPEC
               else
                   error "Guess: guessADE supports only displayAsGF"
@@ -53716,9 +74064,10 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
       -- I need to help the compiler here, unfortunately
             if zero? l then f
             else
-                s := [stirling2(l, i)$IntegerCombinatoricFunctions(Integer)::EXPRR _
+               s := _
+                [stirling2(l, i)$IntegerCombinatoricFunctions(Integer)::EXPRR _
                       * (x::EXPRR)**i*D(f, x, i) for i in 1..l]
-                reduce(_+, s)
+               reduce(_+, s)
       
       ShiftA(k: NNI, l: NNI, f: SUP S): S == 
           ShiftAction(k, l, f)$FFFG(S, SUP S)
@@ -53733,18 +74082,22 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
           partitions := FilteredPartitionStream options
           if displayAsGF(options)$GOPT0 then
               if maxPower(options)$GOPT0 = 1 then
-                  [ADEguessStream(#1, partitions, ShiftSS, (1-monomial(1,1))**(-1)),_
+                  [ADEguessStream(#1, partitions, ShiftSS, _
+                   (1-monomial(1,1))**(-1)),_
                    ADEdegreeStream partitions, _
-                   ADEtestStream(#1, partitions, ShiftSF, (1-monomial(1,1))**(-1)), _
-                   ADEEXPRRStream(#1, #2, partitions, ShiftSXGF, 1/(1-#1::EXPRR)), _
+                   ADEtestStream(#1, partitions, ShiftSF, _
+                   (1-monomial(1,1))**(-1)), _
+                   ADEEXPRRStream(#1, #2, partitions, ShiftSXGF, _
+                   1/(1-#1::EXPRR)), _
                    ShiftA, ShiftAF, ShiftAXGF, ShiftC]$HPSPEC
              else
-                  error "Guess: no support for the Shift operator with displayAsGF _
+                  error _
+                   "Guess: no support for the Shift operator with displayAsGF _
                          and maxPower>1"
           else
-              [ADEguessStream2(#1, partitions, ShiftSS, (1-monomial(1,1))**(-1)), _
+              [ADEguessStream2(#1,partitions,ShiftSS,(1-monomial(1,1))**(-1)),_
                ADEdegreeStream partitions, _
-               ADEtestStream2(#1, partitions, ShiftSF, (1-monomial(1,1))**(-1)), _
+               ADEtestStream2(#1,partitions,ShiftSF,(1-monomial(1,1))**(-1)), _
                ADEEXPRRStream(#1, #2, partitions, ShiftSX, diff1X), _
                ShiftA, ShiftAF, ShiftAX, ShiftC]$HPSPEC
 
@@ -53765,7 +74118,8 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
           shiftHP(q: Symbol): (LGOPT -> HPSPEC) == 
               partitions := FilteredPartitionStream #1
               if displayAsGF(#1)$GOPT0 then
-                  error "Guess: no support for the qShift operator with displayAsGF"
+                  error _
+                   "Guess: no support for the qShift operator with displayAsGF"
               else
                   [ADEguessStream2(#1, partitions, ShiftSS, _
                                    (1-monomial(1,1))**(-1)), _
@@ -53809,7 +74163,7 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
       guessInterpolate(guessList: List SUP F, eta: List NNI, D: HPSPEC)
                       : Matrix SUP S ==
           if F is S then 
-              vguessList: Vector SUP S := vector(guessList pretend List(SUP(S)))
+              vguessList:Vector SUP S := vector(guessList pretend List(SUP(S)))
               generalInterpolation((D.C)(reduce(_+, eta)), D.A, 
                                    vguessList, eta)$FFFG(S, SUP S)
           else if F is Fraction S then
@@ -53824,7 +74178,7 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
                         sumEta: NNI, maxEta: NNI, 
                         D: HPSPEC): Stream Matrix SUP S ==
           if F is S then 
-              vguessList: Vector SUP S := vector(guessList pretend List(SUP(S)))
+              vguessList:Vector SUP S := vector(guessList pretend List(SUP(S)))
               generalInterpolation((D.C)(sumEta), D.A, 
                                    vguessList, sumEta, maxEta)
                                   $FFFG(S, SUP S)
@@ -53836,6 +74190,7 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
       
           else error "Type parameter F should be either equal to S or equal _
                       to Fraction S"
+
       testInterpolant(resi: List SUP S, 
                       list: List F,
                       testList: List UFPSSUPF, 
@@ -53851,7 +74206,6 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
            zero?(last resi)) 
            => return "failed"
           nonZeroCoefficient: Integer := 0
-      
           for i in 1..#resi repeat
               if not zero? resi.i then
                   if zero? nonZeroCoefficient then
@@ -53860,44 +74214,35 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
                       nonZeroCoefficient := 0
                       break
           if not zero? nonZeroCoefficient then
-              (freeOf?(exprList.nonZeroCoefficient, name op)) => return "failed"
-      
-              for e in list repeat
-                  if not zero? e then return "failed"
+             (freeOf?(exprList.nonZeroCoefficient, name op)) => return "failed"
+             for e in list repeat
+                 if not zero? e then return "failed"
           else
-              resiSUPF := map(SUPF2SUPSUPF SUPS2SUPF #1, resi)
-                             $ListFunctions2(SUP S, SUP SUP F)
-      
-              iterate? := true;
-              for d in guessDegree+1.. repeat
-                  c: SUP F := generalCoefficient(D.AF, vector testList, 
-                                                 d, vector resiSUPF)
-                                                $FFFG(SUP F, UFPSSUPF)
-      
-                  if not zero? c then 
-                      iterate? := ground? c
-                      break
-      
-              iterate? => return "failed"
+             resiSUPF := map(SUPF2SUPSUPF SUPS2SUPF #1, resi)
+                            $ListFunctions2(SUP S, SUP SUP F)
+             iterate? := true;
+             for d in guessDegree+1.. repeat
+                 c: SUP F := generalCoefficient(D.AF, vector testList, 
+                                                d, vector resiSUPF)
+                                               $FFFG(SUP F, UFPSSUPF)
+                 if not zero? c then 
+                     iterate? := ground? c
+                     break
+             iterate? => return "failed"
           g: SUP S
           if S has Field 
-          then g := leadingCoefficient(find(not zero? #1, reverse resi)::SUP(S))::SUP(S)
+          then g := _
+           leadingCoefficient(find(not zero? #1, reverse resi)::SUP(S))::SUP(S)
           else g := gcd resi
           resiF := map(SUPS2SUPF((#1 exquo g)::SUP(S)), resi)
                       $ListFunctions2(SUP S, SUP F)
-      
-      
           if debug(options)$GOPT0 then 
               output(hconcat("trying possible solution ", resiF::OutputForm))
                     $OutputPackage
-      
       -- transform each term into an expression
-      
           ex: List EXPRR := [makeEXPRR(D.AX, dummy, p, e) _
                              for p in resiF for e in exprList]
-      
       -- transform the list of expressions into a sum of expressions
-      
           res: EXPRR
           if displayAsGF(options)$GOPT0 then 
               res := evalADE(op, dummy, variableName(options)$GOPT0::EXPRR, 
@@ -53921,24 +74266,21 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
 
       guessHPaux(list: List F, D: HPSPEC, options: LGOPT): GUESSRESULT ==
           reslist: GUESSRESULT := []
-      
           listDegree := #list-1-safety(options)$GOPT0
           if listDegree < 0 then return reslist
           a := functionName(options)$GOPT0
           op := operator a
           x := variableName(options)$GOPT0
           dummy := new$Symbol
-      
           initials: List EXPRR := [coerce(e)@EXPRR for e in list]
-
           guessS  := (D.guessStream)(list2UFPSF list)
           degreeS := D.degreeStream
           testS   := (D.testStream)(list2UFPSSUPF list)
           exprS   := (D.exprStream)(op(dummy::EXPRR)::EXPRR, dummy)
           iterate?: Boolean := false -- this is necessary because the compiler
-                                     -- doesn't understand => "iterate" properly
-                                     -- the latter just leaves the current block, it
-                                     -- seems 
+                              -- doesn't understand => "iterate" properly
+                              -- the latter just leaves the current block, it
+                              -- seems 
           for o in 2.. repeat
               empty? rest(guessS, (o-1)::NNI) => break
               guessDegree: Integer := listDegree-(degreeS.o)::Integer
@@ -53962,46 +74304,49 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
                   then return reslist
             --tpd: maxDegree is defined to be nonnegative
             --      if ((maxDegree(options)$GOPT0 ~= -1) and
-                  if ((maxDegree(options)$GOPT0::NNI::Integer < maxParams.quotient)) and
+                  if ((maxDegree(options)$GOPT0::NNI::Integer < _
+                       maxParams.quotient)) and
                       not (empty? rest(guessS, o) or
-                           ((newGuessDegree := listDegree-(degreeS.(o+1))::Integer)
-                                < 0) or
-                            (((newMaxParams := divide(newGuessDegree::NNI+1, o+1))
-                                .quotient = 0) and
-                             (newMaxParams.remainder < o)))
+                         ((newGuessDegree:=listDegree-(degreeS.(o+1))::Integer)
+                              < 0) or
+                          (((newMaxParams:=divide(newGuessDegree::NNI+1,o+1))
+                              .quotient = 0) and
+                           (newMaxParams.remainder < o)))
                   then iterate? := true
                --tpd:maxDegree is defined to be nonnegative
                -- else if ((maxDegree(options)$GOPT0 ~= -1) and
-                  if (maxParams.quotient > maxDegree(options)$GOPT0::NNI::Integer)
+                  if (maxParams.quotient > _
+                      maxDegree(options)$GOPT0::NNI::Integer)
                        then
                --tpd:maxDegree is defined to be nonnegative
-                           guessDegree := o*(1+maxDegree(options)$GOPT0::NNI::Integer)-2
+                           guessDegree := _
+                             o*(1+maxDegree(options)$GOPT0::NNI::Integer)-2
                            eta: List NNI
                                := [(if i < o    _
                                      then maxDegree(options)$GOPT0::NNI + 1   _
                                      else maxDegree(options)$GOPT0::NNI) _
                                    for i in 1..o]
                        else eta: List NNI
-                                := [(if i <= maxParams.remainder   _
-                                     then maxParams.quotient + 1   _
-                                     else maxParams.quotient)::NNI for i in 1..o]
+                               := [(if i <= maxParams.remainder   _
+                                   then maxParams.quotient + 1   _
+                                   else maxParams.quotient)::NNI for i in 1..o]
               if iterate? 
               then 
                   iterate? := false
-                  if debug(options)$GOPT0 then output("iterating")$OutputPackage
+                  if debug(options)$GOPT0 then _
+                    output("iterating")$OutputPackage
               else 
-                  guessList: List SUP F    := getListSUPF(guessS, o, guessDegree::NNI)
+                  guessList:List SUP F:=getListSUPF(guessS,o,guessDegree::NNI)
                   testList:  List UFPSSUPF := entries complete first(testS, o)
                   exprList:  List EXPRR    := entries complete first(exprS, o)
       
                   if debug(options)$GOPT0 then 
                       output("The list of expressions is")$OutputPackage
                       output(exprList::OutputForm)$OutputPackage
-      
                   if allDegrees(options)$GOPT0 then
                       MS: Stream Matrix SUP S := guessInterpolate2(guessList, 
-                                                                   guessDegree::NNI+1,
-                                                                   maxEta::NNI, D)
+                                                            guessDegree::NNI+1,
+                                                                maxEta::NNI, D)
                       repeat
                           (empty? MS) => break
                           M := first MS
@@ -54014,18 +74359,13 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
                                                      initials,
                                                      guessDegree::NNI, 
                                                      D, dummy, op, options)
-      
                               (res case "failed") => "iterate"
-      
                               if not member?(res, reslist) 
                               then reslist := cons(res, reslist)
-      
                               if one(options)$GOPT0 then return reslist 
-      
                           MS := rest MS
                   else
                       M: Matrix SUP S := guessInterpolate(guessList, eta, D)
-      
                       for i in 1..o repeat
                           res := testInterpolant(entries column(M, i), 
                                                  list,
@@ -54035,10 +74375,8 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
                                                  guessDegree::NNI, 
                                                  D, dummy, op, options)
                           (res case "failed") => "iterate"
-      
                           if not member?(res, reslist) 
                           then reslist := cons(res, reslist)
-      
                           if one(options)$GOPT0 then return reslist 
       
           reslist
@@ -54047,7 +74385,6 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
       
 --tpd comment out the call to displayAsGF. it won't type check
       guessADE(list: List F, options: LGOPT): GUESSRESULT == 
---tpd          opts: LGOPT := cons(displayAsGF(true)$GuessOption, options)
           opts := options
           guessHPaux(list, diffHP opts, opts)
       
@@ -54075,13 +74412,11 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
       
 --tpd comment out the call to displayAsGF. it won't type check
           guessADE(q: Symbol): GUESSER ==
---tpd              opts: LGOPT := cons(displayAsGF(true)$GuessOption, #2)
               opts := #2
               guessHPaux(#1, (diffHP q)(opts), opts)
 
 --tpd comment out the call to displayAsGF. it won't type check
       guessRec(list: List F, options: LGOPT): GUESSRESULT == 
---tpd            opts: LGOPT := cons(displayAsGF(false)$GuessOption, options)
             opts := options
             guessHPaux(list, shiftHP opts, opts)
       
@@ -54101,26 +74436,15 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
       guessRat(list: List F): GUESSRESULT == guessRat(list, [])
 
       if F has RetractableTo Symbol and S has RetractableTo Symbol then
-      
---tpd comment out the call to displayAsGF. it won't type check
+
           guessRec(q: Symbol): GUESSER ==
---tpd              opts: LGOPT := cons(displayAsGF(false)$GuessOption, #2)
               opts := #2
               guessHPaux(#1, (shiftHP q)(opts), opts)
       
 --tpd comment out the call to displayAsGF. it won't type check
           guessPRec(q: Symbol): GUESSER ==
---              opts: LGOPT := append([displayAsGF(false)$GuessOption, 
---                                     maxPower(1)$GuessOption], #2)
               opts := #2
               guessHPaux(#1, (shiftHP q)(opts), opts)
-      
---tpd comment out the call to displayAsGF. it won't type check
-          guessRat(q: Symbol): GUESSER ==
---tpd              opts := append(#2, [displayAsGF(false)$GuessOption, 
---tpd                                  maxShift(0)$GuessOption, 
---tpd                                  maxPower(1)$GuessOption, 
---tpd                                  allDegrees(true)$GuessOption])
               opts := #2
               guessHPaux(#1, (shiftHP q)(opts), opts)
       
@@ -54135,7 +74459,6 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
           res: GUESSRESULT := []
           len := #list :: PositiveInteger
           if len <= 1 then return res
-      
           for guesser in guessers repeat
               res := append(guesser(list, options), res)
       
@@ -54143,12 +74466,9 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
                   output(hconcat("res ", res::OutputForm))$OutputPackage
       
               if one(options)$GOPT0 and not empty? res then return res
-      
           if (maxLevel = 0) then return res
-      
           if member?('guessProduct, ops) and not member?(0$F, list) then
               prodList: List F := [(list.(i+1))/(list.i) for i in 1..(len-1)]
-      
           -- tpd: maxLevel is NNI
               if not every?(one?, prodList) then
                   var: Symbol := subscript('p, [len::OutputForm])
@@ -54156,25 +74476,17 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
                       [[coerce(list.(guess.order+1)) 
                         * product(guess.function, _
                                   equation(var, _
-                                           (guess.order)::EXPRR..xx::EXPRR-1)), _
+                                         (guess.order)::EXPRR..xx::EXPRR-1)), _
                         guess.order] _
                        for guess in guess(prodList, guessers, ops,  options)$%]
--- tpd: this is broken
---                             append([(indexName(var)$GuessOption)::Symbol,_
---                                     (maxLevel(maxLevel-1)$GuessOption)::NNI],_
---                                    options))$%]
-      
                   if debug(options)$GOPT0 then
                       output(hconcat("prodGuess "::OutputForm, 
                                      prodGuess::OutputForm))
                             $OutputPackage
-      
                   for guess in prodGuess 
                           | not any?(guess.function = #1.function, res) repeat
                       res := cons(guess, res)
-      
           if one(options)$GOPT0 and not empty? res then return res
-      
           if member?('guessSum, ops) then
               sumList: List F := [(list.(i+1))-(list.i) for i in 1..(len-1)]
           -- tpd:maxLevel is NNI
@@ -54184,14 +74496,9 @@ Guess(F, S, EXPRR, R, retract, coerce): Exports == Implementation where
                       [[coerce(list.(guess.order+1)) _
                         + summation(guess.function, _
                                     equation(var, _
-                                             (guess.order)::EXPRR..xx::EXPRR-1)),_
+                                          (guess.order)::EXPRR..xx::EXPRR-1)),_
                         guess.order] _
                        for guess in guess(sumList, guessers, ops,  options)$%]
---tpd: this is broken
---                       for guess in guess(sumList, guessers, ops,_
---                            append([(indexName(var)$GuessOption)::Symbol,_
---                                    (maxLevel(maxLevel-1)$GuessOption)::NNI],_
---                                                 options))$%]
       
                   for guess in sumGuess 
                           | not any?(guess.function = #1.function, res) repeat
@@ -55227,6 +75534,55 @@ HallBasis() : Export == Implement where
 \begin{chunk}{COQ HB}
 (* package HB *)
 (*
+
+     lfunc(d,n) ==
+        n < 0 => 0
+        n = 0 => 1
+        n = 1 => d
+        sum:I := 0
+        m:I
+        for m in 1..(n-1) repeat
+          if n rem m = 0 then
+            sum := sum + m * lfunc(d,m)
+        res := (d**(n::NNI) - sum) quo n
+
+     inHallBasis?(n,i,j,l) ==
+        i >= j => false
+        j <= n => true
+        l <= i => true
+        false
+
+     generate(n:NNI,c:NNI) ==
+        gens:=n
+        maxweight:=c
+        siz:I := 0
+        for i in 1 .. maxweight repeat siz := siz + lfunc(gens,i)
+        v:VLI:= new(siz::NNI,[])
+        for i in 1..gens repeat v(i) := [0, 1, i]
+        firstindex:VI := new(maxweight::NNI,0)
+        wt:I := 1
+        firstindex(1) := 1
+        numComms:I := gens
+        newNumComms:I := numComms
+        done:B := false
+        while not done repeat
+          wt := wt + 1
+          if wt > maxweight then done := true
+          else
+            firstindex(wt) := newNumComms + 1
+            leftIndex := 1
+            -- cW == complimentaryWeight
+            cW:I := wt - 1
+            while (leftIndex <= numComms) and (v(leftIndex).2 <= cW) repeat
+              for rightIndex in firstindex(cW)..(firstindex(cW+1) - 1) repeat
+                if inHallBasis?(gens,leftIndex,rightIndex,v(rightIndex).1) then
+                  newNumComms := newNumComms + 1
+                  v(newNumComms) := [leftIndex,wt,rightIndex]
+              leftIndex := leftIndex + 1
+              cW := wt - v(leftIndex).2
+            numComms := newNumComms
+        v
+
 *)
 
 \end{chunk}
@@ -55509,6 +75865,185 @@ HeuGcd (BP):C == T
 \begin{chunk}{COQ HEUGCD}
 (* package HEUGCD *)
 (*
+
+    PI    ==> PositiveInteger
+    NNI   ==> NonNegativeInteger
+    Cases ==> Union("gcdprim","gcd","gcdcofactprim","gcdcofact")
+    import ModularDistinctDegreeFactorizer BP
+
+    --local functions
+    localgcd     :        List BP       -> List BP
+    constNotZero :           BP         -> Boolean
+    height       :           BP         -> PI
+    genpoly      :         (Z,PI)       -> BP
+    negShiftz    :         (Z,PI)       -> Z
+    internal     :     (Cases,List BP ) -> List BP
+    constcase    : (List NNI ,List BP ) -> List BP
+    lincase      : (List NNI ,List BP ) -> List BP
+    myNextPrime  :        ( Z , NNI )   -> Z
+
+    bigPrime:= prevPrime(2**26)$IntegerPrimesPackage(Integer)
+
+    myNextPrime(val:Z,bound:NNI) : Z == nextPrime(val)$IntegerPrimesPackage(Z)
+
+    constNotZero(f : BP ) : Boolean == (degree f = 0) and ^(zero? f)
+
+    negShiftz(n:Z,Modulus:PI):Z ==
+      n < 0 => n:= n+Modulus
+      n > (Modulus quo 2) => n-Modulus
+      n
+
+    --compute the height of a polynomial
+    height(f:BP):PI ==
+      k:PI:=1
+      while f^=0 repeat
+           k:=max(k,abs(leadingCoefficient(f)@Z)::PI)
+           f:=reductum f
+      k
+
+    --reconstruct the polynomial from the value-adic representation of
+    --dval.
+    genpoly(dval:Z,value:PI):BP ==
+      d:=0$BP
+      val:=dval
+      for i in 0..  while (val^=0) repeat
+        val1:=negShiftz(val rem value,value)
+        d:= d+monomial(val1,i)
+        val:=(val-val1) quo value
+      d
+
+    --gcd of a list of integers
+    lintgcd(lval:List(Z)):Z ==
+      empty? lval => 0$Z
+      member?(1,lval) => 1$Z
+      lval:=sort((z1,z2) +-> z1<z2,lval)
+      val:=lval.first
+      for val1 in lval.rest while ^(val=1) repeat val:=gcd(val,val1)
+      val
+
+    --content for a list of univariate polynomials
+    content(listf:List BP ):List(Z) ==
+      [lintgcd coefficients f for f in listf]
+
+    --content of a list of polynomials with the relative primitive parts
+    contprim(listf:List BP ):List(ContPrim) ==
+       [[c:=lintgcd coefficients f,(f exquo c)::BP]$ContPrim  for f in listf]
+
+    -- one polynomial is constant, remark that they are primitive
+    -- but listf can contain the zero polynomial
+    constcase(listdeg:List NNI ,listf:List BP ): List BP  ==
+      lind:=select(constNotZero,listf)
+      empty? lind =>
+        member?(1,listdeg) => lincase(listdeg,listf)
+        localgcd listf
+      or/[n>0 for n in listdeg] => cons(1$BP,listf)
+      lclistf:List(Z):= [leadingCoefficient f for f in listf]
+      d:=lintgcd(lclistf)
+      d=1 =>  cons(1$BP,listf)
+      cons(d::BP,[(lcf quo d)::BP for lcf in lclistf])
+
+    testDivide(listf: List BP, g:BP):Union(List BP, "failed") ==
+      result:List BP := []
+      for f in listf repeat
+        if (f1:=f exquo g) case "failed" then return "failed"
+        result := cons(f1::BP,result)
+      reverse!(result)
+
+    --one polynomial is linear, remark that they are primitive
+    lincase(listdeg:List NNI ,listf:List BP ):List BP  ==
+      n:= position(1,listdeg)
+      g:=listf.n
+      result:=[g]
+      for f in listf repeat
+        if (f1:=f exquo g) case "failed" then return cons(1$BP,listf)
+        result := cons(f1::BP,result)
+      reverse(result)
+
+    IMG := InnerModularGcd(Z,BP,67108859,myNextPrime)
+
+    mindegpol(f:BP, g:BP):BP ==
+      degree(g) < degree (f) => g
+      f
+
+    --local function for the gcd among n PRIMITIVE univariate polynomials
+    localgcd(listf:List BP ):List BP  ==
+      hgt:="min"/[height(f) for f in listf|^zero? f]
+      answr:=2+2*hgt
+      minf := "mindegpol"/[f for f in listf|^zero? f]
+      (result := testDivide(listf, minf)) case List(BP) =>
+           cons(minf, result::List BP)
+      if degree minf < 100 then for k in 1..10 repeat
+        listval:=[f answr for f in listf]
+        dval:=lintgcd(listval)
+        dd:=genpoly(dval,answr)
+        contd:=content(dd)
+        d:=(dd exquo contd)::BP
+        result:List BP :=[d]
+        flag : Boolean := true
+        for f in listf while flag repeat
+          (f1:=f exquo d) case "failed" => flag:=false
+          result := cons (f1::BP,result)
+        if flag then return reverse(result)
+        nvalue:= answr*832040 quo 317811
+        if ((nvalue + answr) rem 2) = 0 then nvalue:=nvalue+1
+        answr:=nvalue::PI
+      gg:=modularGcdPrimitive(listf)$IMG
+      cons(gg,[(f exquo gg) :: BP for f in listf])
+
+    --internal function:it evaluates the gcd and avoids duplication of
+    --code.
+    internal(flag:Cases,listf:List BP ):List BP  ==
+      --special cases
+      listf=[] => [1$BP]
+      (nlf:=#listf)=1 => [first listf,1$BP]
+      minpol:=1$BP
+      -- extract a monomial gcd
+      mdeg:= "min"/[minimumDegree f for f in listf]
+      if mdeg>0 then
+        minpol1:= monomial(1,mdeg)
+        listf:= [(f exquo minpol1)::BP for f in listf]
+        minpol:=minpol*minpol1
+      -- make the polynomials primitive
+      Cgcd:List(Z):=[]
+      contgcd : Z := 1
+      if (flag case "gcd") or (flag case "gcdcofact") then
+        contlistf:List(ContPrim):=contprim(listf)
+        Cgcd:= [term.cont for term in contlistf]
+        contgcd:=lintgcd(Cgcd)
+        listf:List BP :=[term.prim for term in contlistf]
+        minpol:=contgcd*minpol
+      listdeg:=[degree f for f in listf ]
+      f:= first listf
+      if positiveRemainder(leadingCoefficient(f), bigPrime) ~= 0 then
+        for g in rest listf repeat
+          lcg := leadingCoefficient(g)
+          if positiveRemainder(lcg, bigPrime) = 0 then
+            leave
+          f:=gcd(f,g,bigPrime)
+          if degree f = 0 then return cons(minpol,listf)
+      ans:List BP :=
+         --one polynomial is constant
+         member?(0,listdeg) => constcase(listdeg,listf)
+         --one polynomial is linear
+         member?(1,listdeg) => lincase(listdeg,listf)
+         localgcd(listf)
+      (result,ans):=(first ans*minpol,rest ans)
+      if (flag case "gcdcofact") then
+        ans:= [(p quo contgcd)*q for p in Cgcd for q in ans]
+      cons(result,ans)
+
+    --gcd among n PRIMITIVE univariate polynomials
+    gcdprim (listf:List BP ):BP == first internal("gcdprim",listf)
+
+    --gcd and cofactors for n PRIMITIVE univariate polynomials
+    gcdcofactprim(listf:List BP ):List BP  == internal("gcdcofactprim",listf)
+
+    --gcd for n generic univariate polynomials.
+    gcd(listf:List BP ): BP  ==  first internal("gcd",listf)
+
+    --gcd and cofactors for n generic univariate polynomials.
+    gcdcofact (listf:List BP ):List BP == internal("gcdcofact",listf)
+
 *)
 
 \end{chunk}
@@ -55963,6 +76498,330 @@ IdealDecompositionPackage(vl,nv) : C == T -- take away nv, now doesn't
 \begin{chunk}{COQ IDECOMP}
 (* package IDECOMP *)
 (*
+
+     import MPolyCatRationalFunctionFactorizer(Expon,OV,Z,DPoly)
+     import GroebnerPackage(F,Expon,OV,DPoly)
+     import GroebnerPackage(Q,Expon,OV,DPoly1)
+
+                  ----  Local  Functions  -----
+     genPosLastVar       :    (FIdeal,List OV)     -> GenPos
+     zeroPrimDecomp      :    (FIdeal,List OV)     -> List(FIdeal)
+     zeroRadComp         :    (FIdeal,List OV)     -> FIdeal
+     zerodimcase         :    (FIdeal,List OV)     -> Boolean
+     is0dimprimary       :    (FIdeal,List OV)     -> Boolean
+     backGenPos          : (FIdeal,List Z,List OV) -> FIdeal
+     reduceDim           : (Fun0,FIdeal,List OV)   -> List FIdeal
+     findvar             :   (FIdeal,List OV)      -> OV
+     testPower           :    (SUP,OV,FIdeal)      -> Boolean
+     goodPower           :     (DPoly,FIdeal)  -> Record(spol:DPoly,id:FIdeal)
+     pushdown            :      (DPoly,OV)        -> DPoly
+     pushdterm           :     (DPoly,OV,Z)       -> DPoly
+     pushup              :      (DPoly,OV)        -> DPoly
+     pushuterm           :    (DPoly,SE,OV)       -> DPoly
+     pushucoef           :       (UP,OV)          -> DPoly
+     trueden             :        (P,SE)          -> P
+     rearrange           :       (List OV)        -> List OV
+     deleteunit          :      List FIdeal        -> List FIdeal
+     ismonic             :      (DPoly,OV)        -> Boolean
+
+
+     MPCFQF ==> MPolyCatFunctions2(OV,Expon,Expon,Q,F,DPoly1,DPoly)
+     MPCFFQ ==> MPolyCatFunctions2(OV,Expon,Expon,F,Q,DPoly,DPoly1)
+
+     convertQF(a:Q) : F == ((numer a):: F)/((denom a)::F)
+     convertFQ(a:F) : Q == (ground numer a)/(ground denom a)
+
+     internalForm(I:Ideal) : FIdeal ==
+       Id:=generators I
+       nId:=[map(convertQF,poly)$MPCFQF for poly in Id]
+       groebner? I => groebnerIdeal nId
+       ideal nId
+
+     externalForm(I:FIdeal) : Ideal ==
+       Id:=generators I
+       nId:=[map(convertFQ,poly)$MPCFFQ for poly in Id]
+       groebner? I => groebnerIdeal nId
+       ideal nId
+
+     lvint:=[variable(xx)::OV for xx in vl]
+     nvint1:=(#lvint-1)::NNI
+
+     deleteunit(lI: List FIdeal) : List FIdeal ==
+       [I for I in lI | _^ element?(1$DPoly,I)]
+
+     rearrange(vlist:List OV) :List OV ==
+       vlist=[] => vlist
+       sort((z1,z2)+->z1>z2,setDifference(lvint,setDifference(lvint,vlist)))
+
+            ---- radical of a 0-dimensional ideal  ----
+     zeroRadComp(I:FIdeal,truelist:List OV) : FIdeal ==
+       truelist=[] => I
+       Id:=generators I
+       x:OV:=truelist.last
+       #Id=1 =>
+         f:=Id.first
+         g:= (f exquo (gcd (f,differentiate(f,x))))::DPoly
+         groebnerIdeal([g])
+       y:=truelist.first
+       px:DPoly:=x::DPoly
+       py:DPoly:=y::DPoly
+       f:=Id.last
+       g:= (f exquo (gcd (f,differentiate(f,x))))::DPoly
+       Id:=groebner(cons(g,remove(f,Id)))
+       lf:=Id.first
+       pv:DPoly:=0
+       pw:DPoly:=0
+       while degree(lf,y)^=1 repeat
+         val:=random()$Z rem 23
+         pv:=px+val*py
+         pw:=px-val*py
+         Id:=groebner([(univariate(h,x)).pv for h in Id])
+         lf:=Id.first
+       ris:= generators(zeroRadComp(groebnerIdeal(Id.rest),truelist.rest))
+       ris:=cons(lf,ris)
+       if pv^=0 then
+         ris:=[(univariate(h,x)).pw for h in ris]
+       groebnerIdeal(groebner ris)
+
+          ----  find the power that stabilizes (I:s)  ----
+     goodPower(s:DPoly,I:FIdeal) : Record(spol:DPoly,id:FIdeal) ==
+       f:DPoly:=s
+       I:=groebner I
+       J:=generators(JJ:= (saturate(I,s)))
+       while _^ in?(ideal([f*g for g in J]),I) repeat f:=s*f
+       [f,JJ]
+
+              ----  is the ideal zerodimensional?  ----
+       ----     the "true variables" are  in truelist         ----
+     zerodimcase(J:FIdeal,truelist:List OV) : Boolean ==
+       element?(1,J) => true
+       truelist=[] => true
+       n:=#truelist
+       Jd:=groebner generators J
+       for x in truelist while Jd^=[] repeat
+         f := Jd.first
+         Jd:=Jd.rest
+         if ((y:=mainVariable f) case "failed") or (y::OV ^=x )
+              or _^ (ismonic (f,x)) then return false
+         while Jd^=[] and (mainVariable Jd.first)::OV=x repeat Jd:=Jd.rest
+         if Jd=[] and position(x,truelist)<n then return false
+       true
+
+         ----  choose the variable for the reduction step  ----
+                    --- J groebnerner in gen pos  ---
+     findvar(J:FIdeal,truelist:List OV) : OV ==
+       lmonicvar:List OV :=[]
+       for f in generators J repeat
+         t:=f - reductum f
+         vt:List OV :=variables t
+         if #vt=1 then lmonicvar:=setUnion(vt,lmonicvar)
+       badvar:=setDifference(truelist,lmonicvar)
+       badvar.first
+
+            ---- function for the "reduction step  ----
+     reduceDim(flag:Fun0,J:FIdeal,truelist:List OV) : List(FIdeal) ==
+       element?(1,J) => [J]
+       zerodimcase(J,truelist) =>
+         (flag case "zeroPrimDecomp") => zeroPrimDecomp(J,truelist)
+         (flag case "zeroRadComp") => [zeroRadComp(J,truelist)]
+       x:OV:=findvar(J,truelist)
+       Jnew:=[pushdown(f,x) for f in generators J]
+       Jc: List FIdeal :=[]
+       Jc:=reduceDim(flag,groebnerIdeal Jnew,remove(x,truelist))
+       res1:=[ideal([pushup(f,x) for f in generators idp]) for idp in Jc]
+       s:=pushup((_*/[leadingCoefficient f for f in Jnew])::DPoly,x)
+       degree(s,x)=0 => res1
+       res1:=[saturate(II,s) for II in res1]
+       good:=goodPower(s,J)
+       sideal := groebnerIdeal(groebner(cons(good.spol,generators J)))
+       in?(good.id, sideal) => res1
+       sresult:=reduceDim(flag,sideal,truelist)
+       for JJ in sresult repeat
+          if not(in?(good.id,JJ)) then res1:=cons(JJ,res1)
+       res1
+
+      ----  Primary Decomposition for 0-dimensional ideals  ----
+     zeroPrimDecomp(I:FIdeal,truelist:List OV): List(FIdeal) ==
+       truelist=[] => list I
+       newJ:=genPosLastVar(I,truelist);lval:=newJ.changeval;
+       J:=groebner newJ.genideal
+       x:=truelist.last
+       Jd:=generators J
+       g:=Jd.last
+       lfact:= factors factor(g)
+       ris:List FIdeal:=[]
+       for ef in lfact repeat
+         g:DPoly:=(ef.factor)**(ef.exponent::NNI)
+         J1:= groebnerIdeal(groebner cons(g,Jd))
+         if _^ (is0dimprimary (J1,truelist)) then
+                                   return zeroPrimDecomp(I,truelist)
+         ris:=cons(groebner backGenPos(J1,lval,truelist),ris)
+       ris
+
+             ----  radical of an Ideal  ----
+     radical(I:Ideal) : Ideal ==
+       J:=groebner(internalForm I)
+       truelist:=rearrange("setUnion"/[variables f for f in generators J])
+       truelist=[] => externalForm J
+       externalForm("intersect"/reduceDim("zeroRadComp",J,truelist))
+
+
+-- the following functions are used to "push" x in the coefficient ring -
+
+        ----  push x in the coefficient domain for a polynomial ----
+     pushdown(g:DPoly,x:OV) : DPoly ==
+       rf:DPoly:=0$DPoly
+       i:=position(x,lvint)
+       while g^=0 repeat
+         g1:=reductum g
+         rf:=rf+pushdterm(g-g1,x,i)
+         g := g1
+       rf
+
+      ----  push x in the coefficient domain for a term ----
+     pushdterm(t:DPoly,x:OV,i:Z):DPoly ==
+       n:=degree(t,x)
+       xp:=convert(x)@SE
+       cf:=monomial(1,xp,n)$P :: F
+       newt := t exquo monomial(1,x,n)$DPoly
+       cf * newt::DPoly
+
+               ----  push back the variable  ----
+     pushup(f:DPoly,x:OV) :DPoly ==
+       h:=1$P
+       rf:DPoly:=0$DPoly
+       g := f
+       xp := convert(x)@SE
+       while g^=0 repeat
+         h:=lcm(trueden(denom leadingCoefficient g,xp),h)
+         g:=reductum g
+       f:=(h::F)*f
+       while f^=0 repeat
+         g:=reductum f
+         rf:=rf+pushuterm(f-g,xp,x)
+         f:=g
+       rf
+
+     trueden(c:P,x:SE) : P ==
+       degree(c,x) = 0 => 1
+       c
+
+      ----  push x back from the coefficient domain for a term ----
+     pushuterm(t:DPoly,xp:SE,x:OV):DPoly ==
+       pushucoef((univariate(numer leadingCoefficient t,xp)$P), x)*
+         monomial(inv((denom leadingCoefficient t)::F),degree t)$DPoly
+
+
+     pushucoef(c:UP,x:OV):DPoly ==
+       c = 0 => 0
+       monomial((leadingCoefficient c)::F::DPoly,x,degree c) +
+          pushucoef(reductum c,x)
+
+           -- is the 0-dimensional ideal I primary ?  --
+               ----  internal function  ----
+     is0dimprimary(J:FIdeal,truelist:List OV) : Boolean ==
+       element?(1,J) => true
+       Jd:=generators(groebner J)
+       #(factors factor Jd.last)^=1 => return false
+       i:=subtractIfCan(#truelist,1)
+       (i case "failed") => return true
+       JR:=(reverse Jd);JM:=groebnerIdeal([JR.first]);JP:List(DPoly):=[]
+       for f in JR.rest repeat
+         if _^ ismonic(f,truelist.i) then
+           if _^ inRadical?(f,JM) then return false
+           JP:=cons(f,JP)
+          else
+           x:=truelist.i
+           i:=(i-1)::NNI
+           if _^ testPower(univariate(f,x),x,JM) then return false
+           JM :=groebnerIdeal(append(cons(f,JP),generators JM))
+       true
+
+         ---- Functions for the General Position step  ----
+
+       ----  put the ideal in general position  ----
+     genPosLastVar(J:FIdeal,truelist:List OV):GenPos ==
+       x := last truelist ;lv1:List OV :=remove(x,truelist)
+       ranvals:List(Z):=[(random()$Z rem 23) for vv in lv1]
+       val:=_+/[rv*(vv::DPoly)  for vv in lv1 for rv in ranvals]
+       val:=val+(x::DPoly)
+       [ranvals,groebnerIdeal(groebner([(univariate(p,x)).val
+                             for p in generators J]))]$GenPos
+
+
+             ----  convert back the ideal  ----
+     backGenPos(I:FIdeal,lval:List Z,truelist:List OV) : FIdeal ==
+       lval=[] => I
+       x := last truelist ;lv1:List OV:=remove(x,truelist)
+       val:=-(_+/[rv*(vv::DPoly) for vv in lv1 for rv in lval])
+       val:=val+(x::DPoly)
+       groebnerIdeal
+         (groebner([(univariate(p,x)).val for p in generators I ]))
+
+     ismonic(f:DPoly,x:OV) : Boolean == 
+       ground? leadingCoefficient(univariate(f,x))
+
+         ---- test if f is power of a linear mod (rad J) ----
+                    ----  f is monic  ----
+     testPower(uf:SUP,x:OV,J:FIdeal) : Boolean ==
+       df:=degree(uf)
+       trailp:DPoly := inv(df:Z ::F) *coefficient(uf,(df-1)::NNI)
+       linp:SUP:=(monomial(1$DPoly,1$NNI)$SUP +
+                  monomial(trailp,0$NNI)$SUP)**df
+       g:DPoly:=multivariate(uf-linp,x)
+       inRadical?(g,J)
+
+
+                    ----  Exported Functions  ----
+
+           -- is the 0-dimensional ideal I prime ?  --
+     zeroDimPrime?(I:Ideal) : Boolean ==
+       J:=groebner((genPosLastVar(internalForm I,lvint)).genideal)
+       element?(1,J) => true
+       n:NNI:=#vl;i:NNI:=1
+       Jd:=generators J
+       #Jd^=n => false
+       for f in Jd repeat
+         if _^ ismonic(f,lvint.i) then return false
+         if i<n and (degree univariate(f,lvint.i))^=1 then return false
+         i:=i+1
+       g:=Jd.n
+       #(lfact:=factors(factor g)) >1 => false
+       lfact.1.exponent =1
+
+
+           -- is the 0-dimensional ideal I primary ?  --
+     zeroDimPrimary?(J:Ideal):Boolean ==
+       is0dimprimary(internalForm J,lvint)
+
+             ----  Primary Decomposition of I  -----
+
+     primaryDecomp(I:Ideal) : List(Ideal) ==
+       J:=groebner(internalForm I)
+       truelist:=rearrange("setUnion"/[variables f for f in generators J])
+       truelist=[] => [externalForm J]
+       [externalForm II for II in reduceDim("zeroPrimDecomp",J,truelist)]
+
+          ----  contract I to the ring with lvar variables  ----
+     contract(I:Ideal,lvar: List OV) : Ideal ==
+       Id:= generators(groebner I)
+       empty?(Id) => I
+       fullVars:= "setUnion"/[variables g for g in Id]
+       fullVars = lvar => I
+       n:= # lvar
+       #fullVars < n  => error "wrong vars"
+       n=0 => I
+       newVars:=
+         append([vv for vv in fullVars| ^member?(vv,lvar)]$List(OV),lvar)
+       subsVars := [monomial(1,vv,1)$DPoly1 for vv in newVars]
+       lJ:= [eval(g,fullVars,subsVars) for g in Id]
+       J := groebner(lJ)
+       J=[1] => groebnerIdeal J
+       J=[0] => groebnerIdeal empty()
+       J:=[f for f in J| member?(mainVariable(f)::OV,newVars)]
+       fullPol :=[monomial(1,vv,1)$DPoly1 for vv in fullVars]
+       groebnerIdeal([eval(gg,newVars,fullPol) for gg in J])
+
 *)
 
 \end{chunk}
@@ -56037,7 +76896,9 @@ IncrementingMaps(R:Join(Monoid, AbelianSemiGroup)): with
         ++ argument it is given.  For example, if {f := increment(n)} then
         ++ \spad{f x} is \spad{x+n}.
   == add
+
     increment()   == x +-> 1 + x
+
     incrementBy n == x +-> n + x
 
 \end{chunk}
@@ -56045,6 +76906,11 @@ IncrementingMaps(R:Join(Monoid, AbelianSemiGroup)): with
 \begin{chunk}{COQ INCRMAPS}
 (* package INCRMAPS *)
 (*
+
+    increment()   == x +-> 1 + x
+
+    incrementBy n == x +-> n + x
+
 *)
 
 \end{chunk}
@@ -56142,7 +77008,9 @@ InfiniteProductCharacteristicZero(Coef,UTS):_
     import StreamInfiniteProduct Coef
  
     infiniteProduct x     == series infiniteProduct coefficients x
+
     evenInfiniteProduct x == series evenInfiniteProduct coefficients x
+
     oddInfiniteProduct x  == series oddInfiniteProduct coefficients x
  
     generalInfiniteProduct(x,a,d) ==
@@ -56153,6 +77021,18 @@ InfiniteProductCharacteristicZero(Coef,UTS):_
 \begin{chunk}{COQ INFPROD0}
 (* package INFPROD0 *)
 (*
+ 
+    import StreamInfiniteProduct Coef
+ 
+    infiniteProduct x     == series infiniteProduct coefficients x
+
+    evenInfiniteProduct x == series evenInfiniteProduct coefficients x
+
+    oddInfiniteProduct x  == series oddInfiniteProduct coefficients x
+ 
+    generalInfiniteProduct(x,a,d) ==
+      series generalInfiniteProduct(coefficients x,a,d)
+
 *)
 
 \end{chunk}
@@ -56321,6 +77201,67 @@ InfiniteProductFiniteField(K,UP,Coef,UTS):_
 \begin{chunk}{COQ INPRODFF}
 (* package INPRODFF *)
 (*
+ 
+    liftPoly: UP -> SUP RN
+    liftPoly poly ==
+      -- lift coefficients of 'poly' to integers
+      ans : SUP RN := 0
+      while not zero? poly repeat
+        coef := convert(leadingCoefficient poly)@I :: RN
+        ans := ans + monomial(coef,degree poly)
+        poly := reductum poly
+      ans
+ 
+    reducePoly: SUP RN -> UP
+    reducePoly poly ==
+      -- reduce coefficients of 'poly' to elements of K
+      ans : UP := 0
+      while not zero? poly repeat
+        coef := numer(leadingCoefficient(poly)) :: K
+        ans := ans + monomial(coef,degree poly)
+        poly := reductum poly
+      ans
+ 
+    POLY := liftPoly definingPolynomial()$Coef
+    ALG  := SAE(RN,SUP RN,POLY)
+ 
+    infiniteProduct x ==
+      stUP := map(lift,coefficients x)$ST2(Coef,UP)
+      stSUP := map(liftPoly,stUP)$ST2(UP,SUP RN)
+      stALG := map(reduce,stSUP)$ST2(SUP RN,ALG)
+      stALG := exp(lambert(log(stALG)$STF(ALG))$STT(ALG))$STF(ALG)
+      stSUP := map(lift,stALG)$ST2(ALG,SUP RN)
+      stUP := map(reducePoly,stSUP)$ST2(SUP RN,UP)
+      series map(reduce,stUP)$ST2(UP,Coef)
+ 
+    evenInfiniteProduct x ==
+      stUP := map(lift,coefficients x)$ST2(Coef,UP)
+      stSUP := map(liftPoly,stUP)$ST2(UP,SUP RN)
+      stALG := map(reduce,stSUP)$ST2(SUP RN,ALG)
+      stALG := exp(evenlambert(log(stALG)$STF(ALG))$STT(ALG))$STF(ALG)
+      stSUP := map(lift,stALG)$ST2(ALG,SUP RN)
+      stUP := map(reducePoly,stSUP)$ST2(SUP RN,UP)
+      series map(reduce,stUP)$ST2(UP,Coef)
+ 
+    oddInfiniteProduct x ==
+      stUP := map(lift,coefficients x)$ST2(Coef,UP)
+      stSUP := map(liftPoly,stUP)$ST2(UP,SUP RN)
+      stALG := map(reduce,stSUP)$ST2(SUP RN,ALG)
+      stALG := exp(oddlambert(log(stALG)$STF(ALG))$STT(ALG))$STF(ALG)
+      stSUP := map(lift,stALG)$ST2(ALG,SUP RN)
+      stUP := map(reducePoly,stSUP)$ST2(SUP RN,UP)
+      series map(reduce,stUP)$ST2(UP,Coef)
+ 
+    generalInfiniteProduct(x,a,d) ==
+      stUP := map(lift,coefficients x)$ST2(Coef,UP)
+      stSUP := map(liftPoly,stUP)$ST2(UP,SUP RN)
+      stALG := map(reduce,stSUP)$ST2(SUP RN,ALG)
+      stALG := generalLambert(log(stALG)$STF(ALG),a,d)$STT(ALG)
+      stALG := exp(stALG)$STF(ALG)
+      stSUP := map(lift,stALG)$ST2(ALG,SUP RN)
+      stUP := map(reducePoly,stSUP)$ST2(SUP RN,UP)
+      series map(reduce,stUP)$ST2(UP,Coef)
+
 *)
 
 \end{chunk}
@@ -56424,10 +77365,13 @@ InfiniteProductPrimeField(Coef,UTS): Exports == Implementation where
  
     infiniteProduct x ==
       series applyOverZ(infiniteProduct,coefficients x)
+
     evenInfiniteProduct x ==
       series applyOverZ(evenInfiniteProduct,coefficients x)
+
     oddInfiniteProduct x ==
       series applyOverZ(oddInfiniteProduct,coefficients x)
+
     generalInfiniteProduct(x,a,d) ==
       series 
        applyOverZ(
@@ -56438,6 +77382,28 @@ InfiniteProductPrimeField(Coef,UTS): Exports == Implementation where
 \begin{chunk}{COQ INPRODPF}
 (* package INPRODPF *)
 (*
+ 
+    import StreamInfiniteProduct Integer
+ 
+    applyOverZ:(ST I -> ST I,ST Coef) -> ST Coef
+    applyOverZ(f,st) ==
+      stZ := map(z1 +-> convert(z1)@Integer,st)$StreamFunctions2(Coef,I)
+      map(z1 +-> z1 :: Coef,f stZ)$StreamFunctions2(I,Coef)
+ 
+    infiniteProduct x ==
+      series applyOverZ(infiniteProduct,coefficients x)
+
+    evenInfiniteProduct x ==
+      series applyOverZ(evenInfiniteProduct,coefficients x)
+
+    oddInfiniteProduct x ==
+      series applyOverZ(oddInfiniteProduct,coefficients x)
+
+    generalInfiniteProduct(x,a,d) ==
+      series 
+       applyOverZ(
+        (z1:ST(I)):ST(I) +-> generalInfiniteProduct(z1,a,d),coefficients x)
+
 *)
 
 \end{chunk}
@@ -56513,6 +77479,10 @@ InfiniteTupleFunctions2(A:Type,B:Type): Exports == Implementation where
 \begin{chunk}{COQ ITFUN2}
 (* package ITFUN2 *)
 (*
+
+    map(f,x) ==
+      map(f,x pretend Stream(A))$StreamFunctions2(A,B) pretend IT(B)
+
 *)
 
 \end{chunk}
@@ -56591,8 +77561,10 @@ InfiniteTupleFunctions3(A:Type, B:Type,C:Type): Exports
 
      map(f:FUN, s1:IT A, s2:IT B):IT C ==
        map(f, s1 pretend Stream(A), s2 pretend Stream(B))$SF3 pretend IT(C)
+
      map(f:FUN, s1:ST A, s2:IT B):ST C ==
        map(f, s1, s2 pretend Stream(B))$SF3
+
      map(f:FUN, s1:IT A, s2:ST B):ST C ==
        map(f, s1 pretend Stream(A), s2)$SF3
 
@@ -56601,6 +77573,16 @@ InfiniteTupleFunctions3(A:Type, B:Type,C:Type): Exports
 \begin{chunk}{COQ ITFUN3}
 (* package ITFUN3 *)
 (*
+
+     map(f:FUN, s1:IT A, s2:IT B):IT C ==
+       map(f, s1 pretend Stream(A), s2 pretend Stream(B))$SF3 pretend IT(C)
+
+     map(f:FUN, s1:ST A, s2:IT B):ST C ==
+       map(f, s1, s2 pretend Stream(B))$SF3
+
+     map(f:FUN, s1:IT A, s2:ST B):ST C ==
+       map(f, s1 pretend Stream(A), s2)$SF3
+
 *)
 
 \end{chunk}
@@ -56677,8 +77659,11 @@ Infinity(): with
   minusInfinity: () -> OrderedCompletion  Integer
     ++ minusInfinity() returns minusInfinity.
  == add
+
   infinity()      == infinity()$OnePointCompletion(Integer)
+
   plusInfinity()  == plusInfinity()$OrderedCompletion(Integer)
+
   minusInfinity() == minusInfinity()$OrderedCompletion(Integer)
 
 \end{chunk}
@@ -56686,6 +77671,13 @@ Infinity(): with
 \begin{chunk}{COQ INFINITY}
 (* package INFINITY *)
 (*
+
+  infinity()      == infinity()$OnePointCompletion(Integer)
+
+  plusInfinity()  == plusInfinity()$OrderedCompletion(Integer)
+
+  minusInfinity() == minusInfinity()$OrderedCompletion(Integer)
+
 *)
 
 \end{chunk}
@@ -56770,6 +77762,7 @@ InnerAlgFactor(F, UP, AlExt, AlPol): Exports == Implementation where
       ++ f is a factorisation map for elements of UP;
  
   Implementation ==> add
+
     pnorm        : AlPol -> UP
     convrt       : AlPol -> NUP
     change       : UP    -> AlPol
@@ -56819,9 +77812,11 @@ InnerAlgFactor(F, UP, AlExt, AlPol): Exports == Implementation where
                                             for sqterm in factors sqf]
  
     p := definingPolynomial()$AlExt
+
     newp := map(x +-> x::UP, p)$UPCF2(F, UP, UP, NUP)
  
     pnorm  q == resultant(convrt q, newp)
+
     change q == map(coerce, q)$UPCF2(F,UP,AlExt,AlPol)
  
     convrt q ==
@@ -56833,6 +77828,67 @@ InnerAlgFactor(F, UP, AlExt, AlPol): Exports == Implementation where
 \begin{chunk}{COQ IALGFACT}
 (* package IALGFACT *)
 (*
+
+    pnorm        : AlPol -> UP
+    convrt       : AlPol -> NUP
+    change       : UP    -> AlPol
+    perturbfactor: (AlPol, Z, UP -> FR) -> List AlPol
+    irrfactor    : (AlPol, Z, UP -> FR) -> List AlPol
+ 
+ 
+    perturbfactor(f, k, fact) ==
+      pol   := monomial(1$AlExt,1)-
+               monomial(reduce monomial(k::F,1)$UP ,0)
+      newf  := elt(f, pol)
+      lsols := irrfactor(newf, k, fact)
+      pol   := monomial(1, 1) +
+               monomial(reduce monomial(k::F,1)$UP,0)
+      [elt(pp, pol) for pp in lsols]
+ 
+    ---  factorize the square-free parts of f  ---
+    irrfactor(f, k, fact) ==
+      degree(f) =$N 1 => [f]
+      newf := f
+      nn   := pnorm f
+      --newval:RN:=1
+      --pert:=false
+      --if ^ SqFr? nn then
+      --  pert:=true
+      --  newterm:=perturb(f)
+      --  newf:=newterm.ppol
+      --  newval:=newterm.pval
+      --  nn:=newterm.nnorm
+      listfact := factors fact nn
+      #listfact =$N 1 =>
+        first(listfact).exponent =$Z 1 => [f]
+        perturbfactor(f, k + 1, fact)
+      listerm:List(AlPol):= []
+      for pelt in listfact repeat
+        g    := gcd(change(pelt.factor), newf)
+        newf := (newf exquo g)::AlPol
+        listerm :=
+          pelt.exponent =$Z 1 => cons(g, listerm)
+          append(perturbfactor(g, k + 1, fact), listerm)
+      listerm
+ 
+    factor(f, fact) ==
+      sqf := squareFree f
+      unit(sqf) * _*/[_*/[primeFactor(pol, sqterm.exponent)
+                          for pol in irrfactor(sqterm.factor, 0, fact)]
+                                            for sqterm in factors sqf]
+ 
+    p := definingPolynomial()$AlExt
+
+    newp := map(x +-> x::UP, p)$UPCF2(F, UP, UP, NUP)
+ 
+    pnorm  q == resultant(convrt q, newp)
+
+    change q == map(coerce, q)$UPCF2(F,UP,AlExt,AlPol)
+ 
+    convrt q ==
+      swap(map(lift, q)$UPCF2(AlExt, AlPol,
+           UP, NUP))$CommuteUnivariatePolynomialCategory(F, UP, NUP)
+
 *)
 
 \end{chunk}
@@ -56922,6 +77978,7 @@ InnerCommonDenominator(R, Q, A, B): Exports == Implementation where
       ++ \spad{qi = pi/d} and d is a common denominator for the qi's.
  
   Implementation ==> add
+
     import FiniteLinearAggregateFunctions2(Q, B, R, A)
  
     clearDenominator l ==
@@ -56933,8 +77990,11 @@ InnerCommonDenominator(R, Q, A, B): Exports == Implementation where
       [map(x +-> numer(d*x), l), d]
  
     if R has GcdDomain then
+
       commonDenominator l == reduce(lcm, map(denom, l),1)
+
     else
+
       commonDenominator l == reduce("*", map(denom, l), 1)
 
 \end{chunk}
@@ -56942,6 +78002,25 @@ InnerCommonDenominator(R, Q, A, B): Exports == Implementation where
 \begin{chunk}{COQ ICDEN}
 (* package ICDEN *)
 (*
+
+    import FiniteLinearAggregateFunctions2(Q, B, R, A)
+ 
+    clearDenominator l ==
+      d := commonDenominator l
+      map(x +-> numer(d*x), l)
+ 
+    splitDenominator l ==
+      d := commonDenominator l
+      [map(x +-> numer(d*x), l), d]
+ 
+    if R has GcdDomain then
+
+      commonDenominator l == reduce(lcm, map(denom, l),1)
+
+    else
+
+      commonDenominator l == reduce("*", map(denom, l), 1)
+
 *)
 
 \end{chunk}
@@ -57221,6 +78300,178 @@ InnerMatrixLinearAlgebraFunctions(R,Row,Col,M):_
 \begin{chunk}{COQ IMATLIN}
 (* package IMATLIN *)
 (*
+
+    rowAllZeroes?: (M,I) -> Boolean
+    rowAllZeroes?(x,i) ==
+      -- determines if the ith row of x consists only of zeroes
+      -- internal function: no check on index i
+      for j in minColIndex(x)..maxColIndex(x) repeat
+        qelt(x,i,j) ^= 0 => return false
+      true
+
+    colAllZeroes?: (M,I) -> Boolean
+    colAllZeroes?(x,j) ==
+      -- determines if the ith column of x consists only of zeroes
+      -- internal function: no check on index j
+      for i in minRowIndex(x)..maxRowIndex(x) repeat
+        qelt(x,i,j) ^= 0 => return false
+      true
+
+    rowEchelon y ==
+      -- row echelon form via Gaussian elimination
+      x := copy y
+      minR := minRowIndex x; maxR := maxRowIndex x
+      minC := minColIndex x; maxC := maxColIndex x
+      i := minR
+      n: I := minR - 1
+      for j in minC..maxC repeat
+        i > maxR => return x
+        n := minR - 1
+        -- n = smallest k such that k >= i and x(k,j) ^= 0
+        for k in i..maxR repeat
+          if qelt(x,k,j) ^= 0 then leave (n := k)
+        n = minR - 1 => "no non-zeroes"
+        -- put nth row in ith position
+        if i ^= n then swapRows_!(x,i,n)
+        -- divide ith row by its first non-zero entry
+        b := inv qelt(x,i,j)
+        qsetelt_!(x,i,j,1)
+        for k in (j+1)..maxC repeat qsetelt_!(x,i,k,b * qelt(x,i,k))
+        -- perform row operations so that jth column has only one 1
+        for k in minR..maxR repeat
+          if k ^= i and qelt(x,k,j) ^= 0 then
+            for k1 in (j+1)..maxC repeat
+              qsetelt_!(x,k,k1,qelt(x,k,k1) - qelt(x,k,j) * qelt(x,i,k1))
+            qsetelt_!(x,k,j,0)
+        -- increment i
+        i := i + 1
+      x
+
+    rank x ==
+      y :=
+        (rk := nrows x) > (rh := ncols x) =>
+          rk := rh
+          transpose x
+        copy x
+      y := rowEchelon y; i := maxRowIndex y
+      while rk > 0 and rowAllZeroes?(y,i) repeat
+        i := i - 1
+        rk := (rk - 1) :: NonNegativeInteger
+      rk :: NonNegativeInteger
+
+    nullity x == (ncols x - rank x) :: NonNegativeInteger
+
+    if Col has shallowlyMutable then
+
+      nullSpace y ==
+        x := rowEchelon y
+        minR := minRowIndex x; maxR := maxRowIndex x
+        minC := minColIndex x; maxC := maxColIndex x
+        nrow := nrows x; ncol := ncols x
+        basis : List Col := nil()
+        rk := nrow; row := maxR
+        -- compute rank = # rows - # rows of all zeroes
+        while rk > 0 and rowAllZeroes?(x,row) repeat
+          rk := (rk - 1) :: NonNegativeInteger
+          row := (row - 1) :: NonNegativeInteger
+        -- if maximal rank, return zero vector
+        ncol <= nrow and rk = ncol => [new(ncol,0)]
+        -- if rank = 0, return standard basis vectors
+        rk = 0 =>
+          for j in minC..maxC repeat
+            w : Col := new(ncol,0)
+            qsetelt_!(w,j,1)
+            basis := cons(w,basis)
+          basis
+        -- v contains information about initial 1's in the rows of x
+        -- if the ith row has an initial 1 in the jth column, then
+        -- v.j = i; v.j = minR - 1, otherwise
+        v : IndexedOneDimensionalArray(I,minC) := new(ncol,minR - 1)
+        for i in minR..(minR + rk - 1) repeat
+          for j in minC.. while qelt(x,i,j) = 0 repeat j
+          qsetelt_!(v,j,i)
+        j := maxC; l := minR + ncol - 1
+        while j >= minC repeat
+          w : Col := new(ncol,0)
+          -- if there is no row with an initial 1 in the jth column,
+          -- create a basis vector with a 1 in the jth row
+          if qelt(v,j) = minR - 1 then
+            colAllZeroes?(x,j) =>
+              qsetelt_!(w,l,1)
+              basis := cons(w,basis)
+            for k in minC..(j-1) for ll in minR..(l-1) repeat
+              if qelt(v,k) ^= minR - 1 then
+                qsetelt_!(w,ll,-qelt(x,qelt(v,k),j))
+            qsetelt_!(w,l,1)
+            basis := cons(w,basis)
+          j := j - 1; l := l - 1
+        basis
+
+    determinant y ==
+      (ndim := nrows y) ^= (ncols y) =>
+        error "determinant: matrix must be square"
+      -- Gaussian Elimination
+      ndim = 1 => qelt(y,minRowIndex y,minColIndex y)
+      x := copy y
+      minR := minRowIndex x; maxR := maxRowIndex x
+      minC := minColIndex x; maxC := maxColIndex x
+      ans : R := 1
+      for i in minR..(maxR - 1) for j in minC..(maxC - 1) repeat
+        if qelt(x,i,j) = 0 then
+          rown := minR - 1
+          for k in (i+1)..maxR repeat
+            qelt(x,k,j) ^= 0 => leave (rown := k)
+          if rown = minR - 1 then return 0
+          swapRows_!(x,i,rown); ans := -ans
+        ans := qelt(x,i,j) * ans; b := -inv qelt(x,i,j)
+        for l in (j+1)..maxC repeat qsetelt_!(x,i,l,b * qelt(x,i,l))
+        for k in (i+1)..maxR repeat
+          if (b := qelt(x,k,j)) ^= 0 then
+            for l in (j+1)..maxC repeat
+              qsetelt_!(x,k,l,qelt(x,k,l) + b * qelt(x,i,l))
+      qelt(x,maxR,maxC) * ans
+
+    generalizedInverse(x) ==
+      SUP:=SparseUnivariatePolynomial R
+      FSUP := Fraction SUP
+      VFSUP := Vector FSUP
+      MATCAT2 := MatrixCategoryFunctions2(R, Row, Col, M,
+                   FSUP, VFSUP, VFSUP, Matrix FSUP)
+      MATCAT22 := MatrixCategoryFunctions2(FSUP, VFSUP, VFSUP, Matrix FSUP,
+                   R, Row, Col, M)
+      y:= map((r1:R):FSUP +-> coerce(coerce(r1)$SUP)$(Fraction SUP),x)$MATCAT2
+      ty:=transpose y
+      yy:=ty*y
+      nc:=ncols yy
+      var:=monomial(1,1)$SUP ::(Fraction SUP)
+      yy:=inverse(yy+scalarMatrix(ncols yy,var))::Matrix(FSUP)*ty
+      map((z1:FSUP):R +-> elt(z1,0),yy)$MATCAT22
+
+    inverse x ==
+      (ndim := nrows x) ^= (ncols x) =>
+        error "inverse: matrix must be square"
+      ndim = 2 =>
+         ans2 : M := zero(ndim, ndim)
+         zero?(det :=  x(1,1)*x(2,2)-x(1,2)*x(2,1)) => "failed"
+         detinv := inv det
+         ans2(1,1) := x(2,2)*detinv
+         ans2(1,2) := -x(1,2)*detinv
+         ans2(2,1) := -x(2,1)*detinv
+         ans2(2,2) := x(1,1)*detinv
+         ans2
+      AB : M := zero(ndim,ndim + ndim)
+      minR := minRowIndex x; maxR := maxRowIndex x
+      minC := minColIndex x; maxC := maxColIndex x
+      kmin := minRowIndex AB; kmax := kmin + ndim - 1
+      lmin := minColIndex AB; lmax := lmin + ndim - 1
+      for i in minR..maxR for k in kmin..kmax repeat
+        for j in minC..maxC for l in lmin..lmax repeat
+          qsetelt_!(AB,k,l,qelt(x,i,j))
+        qsetelt_!(AB,k,lmin + ndim + k - kmin,1)
+      AB := rowEchelon AB
+      elt(AB,kmax,lmax) = 0 => "failed"
+      subMatrix(AB,kmin,kmax,lmin + ndim,lmax + ndim)
+
 *)
 
 \end{chunk}
@@ -57326,11 +78577,13 @@ InnerMatrixQuotientFieldFunctions(R,Row,Col,M,QF,Row2,Col2,M2):_
     qfMat m == map((r1:R):QF +-> r1::QF,m)$MATCAT2
 
     rowEchelon m == rowEchelon(qfMat m)$IMATLIN
+
     inverse m ==
       (inv := inverse(qfMat m)$IMATLIN) case "failed" => "failed"
       inv :: M2
 
     if Col2 has shallowlyMutable then
+
       nullSpace m ==
         [clearDenominator(v)$CDEN for v in nullSpace(qfMat m)$IMATLIN]
 
@@ -57339,6 +78592,21 @@ InnerMatrixQuotientFieldFunctions(R,Row,Col,M,QF,Row2,Col2,M2):_
 \begin{chunk}{COQ IMATQF}
 (* package IMATQF *)
 (*
+
+    qfMat: M -> M2
+    qfMat m == map((r1:R):QF +-> r1::QF,m)$MATCAT2
+
+    rowEchelon m == rowEchelon(qfMat m)$IMATLIN
+
+    inverse m ==
+      (inv := inverse(qfMat m)$IMATLIN) case "failed" => "failed"
+      inv :: M2
+
+    if Col2 has shallowlyMutable then
+
+      nullSpace m ==
+        [clearDenominator(v)$CDEN for v in nullSpace(qfMat m)$IMATLIN]
+
 *)
 
 \end{chunk}
@@ -58033,8 +79301,6 @@ InnerMultFact(OV,E,R,P) : C == T
         dd := dist.correct
         unifact:=dist.corrfact
       if dd^=1 then
---        if polcase then lpol := [unitCanonical lp for lp in lpol]
---        dd:=unitCanonical(dd)
         unifact := [dd * unif for unif in unifact]
         umd := unitNormal(dd).unit * ((dd**(nfact-1)::NNI)::P)*um
       else umd := um
@@ -58088,23 +79354,16 @@ InnerMultFact(OV,E,R,P) : C == T
       lf:L USP
       flead : MFinalFact:=[0,empty()]$MFinalFact
       factorlist:L MParFact :=empty()
-
       lmdeg :=minimumDegree(m,lvar)     ---- is the Mindeg > 0? ----
       or/[n>0 for n in lmdeg] => simplify(m,lvar,lmdeg,ufactor)
-
       sqfacs := squareFree m
       lcont := unit sqfacs
-
                                   ----  Factorize the content  ----
       if ground? lcont then flead.contp:=retract lcont
       else flead:=mFactor(lcont,ufactor)
       factorlist:=flead.factors
-
-
-
                               ----  Make the polynomial square-free  ----
       sqqfact:=factors sqfacs
-
                        ---  Factorize the primitive square-free terms ---
       for fact in sqqfact repeat
         ffactor:P:=fact.factor
@@ -58120,10 +79379,8 @@ InnerMultFact(OV,E,R,P) : C == T
           factorlist:=cons([ffactor,ffexp]$MParFact,factorlist)
           for lcterm in mFactor(lcont,ufactor).factors repeat
            factorlist:=cons([lcterm.irr,lcterm.pow * ffexp], factorlist)
-
         varch:=varChoose(ffactor,lvar,ldeg)
         um:=varch.npol
-
         x:=lvar.first
         ldeg:=ldeg.rest
         lvar := lvar.rest
@@ -58142,9 +79399,10 @@ InnerMultFact(OV,E,R,P) : C == T
         if ground?(leadingCoefficient um) then
            lf:= mfconst(um,lvar,ldeg,ufactor)
         else lf:=mfpol(um,lvar,ldeg,ufactor)
-        auxfl:=[[unitCanonical multivariate(lfp,x),ffexp]$MParFact  for lfp in lf]
+        auxfl:=[[unitCanonical multivariate(lfp,x),ffexp]$MParFact_
+            for lfp in lf]
         factorlist:=append(factorlist,auxfl)
-      lcfacs := */[leadingCoefficient(f.irr)**((f.pow)::NNI) for f in factorlist]
+      lcfacs:=*/[leadingCoefficient(f.irr)**((f.pow)::NNI) for f in factorlist]
       [(leadingCoefficient(m) exquo lcfacs):: R,factorlist]$MFinalFact
 
     factor(m:P,ufactor:UFactor):Factored P ==
@@ -58157,6 +79415,374 @@ InnerMultFact(OV,E,R,P) : C == T
 \begin{chunk}{COQ INNMFACT}
 (* package INNMFACT *)
 (*
+
+    NNI       ==> NonNegativeInteger
+
+    LeadFact  ==> Record(polfac:L P,correct:R,corrfact:L BP)
+    ContPrim  ==> Record(cont:P,prim:P)
+    ParFact   ==> Record(irr:BP,pow:Z)
+    FinalFact ==> Record(contp:R,factors:L ParFact)
+    NewOrd    ==> Record(npol:USP,nvar:L OV,newdeg:L NNI)
+    pmod:R   :=  (prevPrime(2**26)$IntegerPrimesPackage(Integer))::R
+
+    import GenExEuclid(R,BP)
+    import MultivariateLifting(E,OV,R,P)
+    import FactoringUtilities(E,OV,R,P)
+    import LeadingCoefDetermination(OV,E,R,P)
+    Valuf ==> Record(inval:L L R,unvfact:L BP,lu:R,complead:L R)
+    UPCF2 ==> UnivariatePolynomialCategoryFunctions2
+
+                   ----  Local Functions  ----
+    mFactor   :            (P,UFactor)           ->  MFinalFact
+    supFactor :           (USP,UFactor)          ->  SUPFinalFact
+    mfconst   :      (USP,L OV,L NNI,UFactor)    -> L USP
+    mfpol     :      (USP,L OV,L NNI,UFactor)    -> L USP
+    monicMfpol:      (USP,L OV,L NNI,UFactor)    -> L USP
+    varChoose :           (P,L OV,L NNI)         -> NewOrd
+    simplify  :       (P,L OV,L NNI,UFactor)     -> MFinalFact
+    intChoose :  (USP,L OV,R,L P,L L R,UFactor)  -> Union(Valuf,"failed")
+    intfact   : (USP,L OV,L NNI,MFinalFact,L L R,UFactor) -> L USP
+    pretest   :         (P,NNI,L OV,L R)         -> FinalFact
+    checkzero :            (USP,BP)              -> Boolean
+    localNorm :               L BP               -> Z
+
+    convertPUP(lfg:MFinalFact): SUPFinalFact ==
+      [lfg.contp,[[lff.irr ::USP,lff.pow]$SUParFact
+                    for lff in lfg.factors]]$SUPFinalFact
+
+    -- intermediate routine if an SUP was passed in.
+    supFactor(um:USP,ufactor:UFactor) : SUPFinalFact ==
+      ground?(um) => convertPUP(mFactor(ground um,ufactor))
+      lvar:L OV:= "setUnion"/[variables cf for cf in coefficients um]
+      empty? lvar => -- the polynomial is univariate
+        umv:= map(ground,um)$UPCF2(P,USP,R,BP)
+        lfact:=ufactor umv
+        [retract unit lfact,[[map(coerce,ff.factor)$UPCF2(R,BP,P,USP),
+           ff.exponent] for ff in factors lfact]]$SUPFinalFact
+      lcont:P
+      lf:L USP
+      flead : SUPFinalFact:=[0,empty()]$SUPFinalFact
+      factorlist:L SUParFact :=empty()
+
+      mdeg :=minimumDegree um     ---- is the Mindeg > 0? ----
+      if mdeg>0 then
+        f1:USP:=monomial(1,mdeg)
+        um:=(um exquo f1)::USP
+        factorlist:=cons([monomial(1,1),mdeg],factorlist)
+        if degree um=0 then return
+          lfg:=convertPUP mFactor(ground um, ufactor)
+          [lfg.contp,append(factorlist,lfg.factors)]
+      uum:=unitNormal um
+      um :=uum.canonical
+      sqfacs := squareFree(um)$MultivariateSquareFree(E,OV,R,P)
+      lcont :=  ground(uum.unit * unit sqfacs)
+                                   ----  Factorize the content  ----
+      flead:=convertPUP mFactor(lcont,ufactor)
+      factorlist:=append(flead.factors,factorlist)
+                               ----  Make the polynomial square-free  ----
+      sqqfact:=factors sqfacs
+                        ---  Factorize the primitive square-free terms ---
+      for fact in sqqfact repeat
+        ffactor:USP:=fact.factor
+        ffexp:=fact.exponent
+        zero? degree ffactor =>
+          lfg:=mFactor(ground ffactor,ufactor)
+          lcont:=lfg.contp * lcont
+          factorlist := append(factorlist,
+             [[lff.irr ::USP,lff.pow * ffexp]$SUParFact
+                       for lff in lfg.factors])
+        coefs := coefficients ffactor
+        ldeg:= ["max"/[degree(fc,xx) for fc in coefs] for xx in lvar]
+        lf :=
+          ground?(leadingCoefficient ffactor) =>
+             mfconst(ffactor,lvar,ldeg,ufactor)
+          mfpol(ffactor,lvar,ldeg,ufactor)
+        auxfl:=[[lfp,ffexp]$SUParFact  for lfp in lf]
+        factorlist:=append(factorlist,auxfl)
+      lcfacs := */[leadingCoefficient leadingCoefficient(f.irr)**((f.pow)::NNI)
+                           for f in factorlist]
+      [(leadingCoefficient leadingCoefficient(um) exquo lcfacs)::R,
+                     factorlist]$SUPFinalFact
+
+    factor(um:USP,ufactor:UFactor):Factored USP ==
+      flist := supFactor(um,ufactor)
+      (flist.contp):: P :: USP *
+        (*/[primeFactor(u.irr,u.pow) for u in flist.factors])
+
+    checkzero(u:USP,um:BP) : Boolean ==
+      u=0 => um =0
+      um = 0 => false
+      degree u = degree um => checkzero(reductum u, reductum um)
+      false
+              ---  Choose the variable of less degree  ---
+    varChoose(m:P,lvar:L OV,ldeg:L NNI) : NewOrd ==
+      k:="min"/[d for d in ldeg]
+      k=degree(m,first lvar) =>
+                             [univariate(m,first lvar),lvar,ldeg]$NewOrd
+      i:=position(k,ldeg)
+      x:OV:=lvar.i
+      ldeg:=cons(k,delete(ldeg,i))
+      lvar:=cons(x,delete(lvar,i))
+      [univariate(m,x),lvar,ldeg]$NewOrd
+
+    localNorm(lum: L BP): Z ==
+      R is AlgebraicNumber =>
+        "max"/[numberOfMonomials ff for ff in lum]
+
+      "max"/[+/[euclideanSize cc for i in 0..degree ff|
+                (cc:= coefficient(ff,i))^=0] for ff in lum]
+
+          ---  Choose the integer to reduce to univariate case  ---
+    intChoose(um:USP,lvar:L OV,clc:R,plist:L P,ltry:L L R,
+                                 ufactor:UFactor) : Union(Valuf,"failed") ==
+      -- declarations
+      degum:NNI := degree um
+      nvar1:=#lvar
+      range:NNI:=5
+      unifact:L BP
+      ctf1 : R := 1
+      testp:Boolean :=             -- polynomial leading coefficient
+        empty? plist => false
+        true
+      leadcomp,leadcomp1 : L R
+      leadcomp:=leadcomp1:=empty()
+      nfatt:NNI := degum+1
+      lffc:R:=1
+      lffc1:=lffc
+      newunifact : L BP:=empty()
+      leadtest:=true --- the lc test with polCase has to be performed
+      int:L R:=empty()
+
+   --  New sets of integers are chosen to reduce the multivariate problem to
+   --  a univariate one, until we find twice the
+   --  same (and minimal) number of "univariate" factors:
+   --  the set smaller in modulo is chosen.
+   --  Note that there is no guarantee that this is the truth:
+   --  merely the closest approximation we have found!
+
+      while true repeat
+       testp and #ltry>10 => return "failed"
+       lval := [ ran(range) for i in 1..nvar1]
+       member?(lval,ltry) => range:=2*range
+       ltry := cons(lval,ltry)
+       leadcomp1:=[retract eval(pol,lvar,lval) for pol in plist]
+       testp and or/[unit? epl for epl in leadcomp1] => range:=2*range
+       newm:BP:=completeEval(um,lvar,lval)
+       degum ^= degree newm or minimumDegree newm ^=0 => range:=2*range
+       lffc1:=content newm
+       newm:=(newm exquo lffc1)::BP
+       testp and leadtest and ^ polCase(lffc1*clc,#plist,leadcomp1)
+                             => range:=2*range
+       degree(gcd [newm,differentiate(newm)])^=0 => range:=2*range
+       luniv:=ufactor(newm)
+       lunivf:= factors luniv
+       lffc1:R:=retract(unit luniv)@R * lffc1
+       nf:= #lunivf
+
+       nf=0 or nf>nfatt => "next values"      ---  pretest failed ---
+
+                        --- the univariate polynomial is irreducible ---
+       if nf=1 then leave (unifact:=[newm])
+
+   --  the new integer give the same number of factors
+       nfatt = nf =>
+       -- if this is the first univariate factorization with polCase=true
+       -- or if the last factorization has smaller norm and satisfies
+       -- polCase
+         if leadtest or
+           ((localNorm unifact > localNorm [ff.factor for ff in lunivf])
+             and (^testp or polCase(lffc1*clc,#plist,leadcomp1))) then
+                unifact:=[uf.factor for uf in lunivf]
+                int:=lval
+                lffc:=lffc1
+                if testp then leadcomp:=leadcomp1
+         leave "foundit"
+
+   --  the first univariate factorization, inizialize
+       nfatt > degum =>
+         unifact:=[uf.factor for uf in lunivf]
+         lffc:=lffc1
+         if testp then leadcomp:=leadcomp1
+         int:=lval
+         leadtest := false
+         nfatt := nf
+
+       nfatt>nf =>  -- for the previous values there were more factors
+         if testp then leadtest:=^polCase(lffc*clc,#plist,leadcomp)
+         else leadtest:= false
+         -- if polCase=true we can consider the univariate decomposition
+         if ^leadtest then
+           unifact:=[uf.factor for uf in lunivf]
+           lffc:=lffc1
+           if testp then leadcomp:=leadcomp1
+           int:=lval
+         nfatt := nf
+      [cons(int,ltry),unifact,lffc,leadcomp]$Valuf
+
+
+                ----  The polynomial has mindeg>0   ----
+
+    simplify(m:P,lvar:L OV,lmdeg:L NNI,ufactor:UFactor):MFinalFact ==
+      factorlist:L MParFact:=[]
+      pol1:P:= 1$P
+      for x in lvar repeat
+        i := lmdeg.(position(x,lvar))
+        i=0 => "next value"
+        pol1:=pol1*monomial(1$P,x,i)
+        factorlist:=cons([x::P,i]$MParFact,factorlist)
+      m := (m exquo pol1)::P
+      ground? m => [retract m,factorlist]$MFinalFact
+      flead:=mFactor(m,ufactor)
+      flead.factors:=append(factorlist,flead.factors)
+      flead
+
+    -- This is the key internal function
+    -- We now know that the polynomial is square-free etc.,
+    -- We use intChoose to find a set of integer values to reduce the
+    -- problem to univariate (and for efficiency, intChoose returns
+    -- the univariate factors).
+    -- In the case of a polynomial leading coefficient, we check that this 
+    -- is consistent with leading coefficient determination (else try again)
+    -- We then lift the univariate factors to multivariate factors, and
+    -- return the result
+    intfact(um:USP,lvar: L OV,ldeg:L NNI,tleadpol:MFinalFact,
+                                   ltry:L L R,ufactor:UFactor) :  L USP ==
+      polcase:Boolean:=(not empty? tleadpol.factors)
+      vfchoo:Valuf:=
+        polcase =>
+          leadpol:L P:=[ff.irr for ff in tleadpol.factors]
+          check:=intChoose(um,lvar,tleadpol.contp,leadpol,ltry,ufactor)
+          check case "failed" => return monicMfpol(um,lvar,ldeg,ufactor)
+          check::Valuf
+        intChoose(um,lvar,1,empty(),empty(),ufactor)::Valuf
+      unifact:List BP := vfchoo.unvfact
+      nfact:NNI := #unifact
+      nfact=1 => [um]
+      ltry:L L R:= vfchoo.inval
+      lval:L R:=first ltry
+      dd:= vfchoo.lu
+      leadval:L R:=empty()
+      lpol:List P:=empty()
+      if polcase then
+        leadval := vfchoo.complead
+        distf := distFact(vfchoo.lu,unifact,tleadpol,leadval,lvar,lval)
+        distf case "failed" =>
+             return intfact(um,lvar,ldeg,tleadpol,ltry,ufactor)
+        dist := distf :: LeadFact
+          -- check the factorization of leading coefficient
+        lpol:= dist.polfac
+        dd := dist.correct
+        unifact:=dist.corrfact
+      if dd^=1 then
+        unifact := [dd * unif for unif in unifact]
+        umd := unitNormal(dd).unit * ((dd**(nfact-1)::NNI)::P)*um
+      else umd := um
+      (ffin:=lifting(umd,lvar,unifact,lval,lpol,ldeg,pmod))
+        case "failed" => intfact(um,lvar,ldeg,tleadpol,ltry,ufactor)
+      factfin: L USP:=ffin :: L USP
+      if dd^=1 then
+        factfin:=[primitivePart ff for ff in factfin]
+      factfin
+
+                ----  m square-free,primitive,lc constant  ----
+    mfconst(um:USP,lvar:L OV,ldeg:L NNI,ufactor:UFactor):L USP ==
+      factfin:L USP:=empty()
+      empty? lvar =>
+        lum:=factors ufactor(map(ground,um)$UPCF2(P,USP,R,BP))
+        [map(coerce,uf.factor)$UPCF2(R,BP,P,USP) for uf in lum]
+      intfact(um,lvar,ldeg,[0,empty()]$MFinalFact,empty(),ufactor)
+
+    monicize(um:USP,c:P):USP ==
+      n:=degree(um)
+      ans:USP := monomial(1,n)
+      n:=(n-1)::NonNegativeInteger
+      prod:P:=1
+      while (um:=reductum(um)) ^= 0 repeat
+        i := degree um
+        lc := leadingCoefficient um
+        prod := prod * c ** (n-(n:=i))::NonNegativeInteger
+        ans := ans + monomial(prod*lc, i)
+      ans
+
+    unmonicize(m:USP,c:P):USP == primitivePart m(monomial(c,1))
+
+              --- m is square-free,primitive,lc is a polynomial  ---
+    monicMfpol(um:USP,lvar:L OV,ldeg:L NNI,ufactor:UFactor):L USP ==
+      l := leadingCoefficient um
+      monpol := monicize(um,l)
+      nldeg := degree(monpol,lvar)
+      map((z1:USP):USP +-> unmonicize(z1,l),
+                mfconst(monpol,lvar,nldeg,ufactor))
+
+    mfpol(um:USP,lvar:L OV,ldeg:L NNI,ufactor:UFactor):L USP ==
+      R has Field =>
+        monicMfpol(um,lvar,ldeg,ufactor)
+      tleadpol:=mFactor(leadingCoefficient um,ufactor)
+      intfact(um,lvar,ldeg,tleadpol,[],ufactor)
+
+    mFactor(m:P,ufactor:UFactor) : MFinalFact ==
+      ground?(m) => [retract(m),empty()]$MFinalFact
+      lvar:L OV:= variables m
+      lcont:P
+      lf:L USP
+      flead : MFinalFact:=[0,empty()]$MFinalFact
+      factorlist:L MParFact :=empty()
+      lmdeg :=minimumDegree(m,lvar)     ---- is the Mindeg > 0? ----
+      or/[n>0 for n in lmdeg] => simplify(m,lvar,lmdeg,ufactor)
+      sqfacs := squareFree m
+      lcont := unit sqfacs
+                                  ----  Factorize the content  ----
+      if ground? lcont then flead.contp:=retract lcont
+      else flead:=mFactor(lcont,ufactor)
+      factorlist:=flead.factors
+                              ----  Make the polynomial square-free  ----
+      sqqfact:=factors sqfacs
+                       ---  Factorize the primitive square-free terms ---
+      for fact in sqqfact repeat
+        ffactor:P:=fact.factor
+        ffexp := fact.exponent
+        lvar := variables ffactor
+        x:OV :=lvar.first
+        ldeg:=degree(ffactor,lvar)
+             ---  Is the polynomial linear in one of the variables ? ---
+        member?(1,ldeg) =>
+          x:OV:=lvar.position(1,ldeg)
+          lcont:= gcd coefficients(univariate(ffactor,x))
+          ffactor:=(ffactor exquo lcont)::P
+          factorlist:=cons([ffactor,ffexp]$MParFact,factorlist)
+          for lcterm in mFactor(lcont,ufactor).factors repeat
+           factorlist:=cons([lcterm.irr,lcterm.pow * ffexp], factorlist)
+        varch:=varChoose(ffactor,lvar,ldeg)
+        um:=varch.npol
+        x:=lvar.first
+        ldeg:=ldeg.rest
+        lvar := lvar.rest
+        if varch.nvar.first ^= x then
+          lvar:= varch.nvar
+          x := lvar.first
+          lvar := lvar.rest
+        pc:= gcd coefficients um
+        if pc^=1 then
+            um:=(um exquo pc)::USP
+            ffactor:=multivariate(um,x)
+            for lcterm in mFactor(pc,ufactor).factors repeat
+              factorlist:=cons([lcterm.irr,lcterm.pow*ffexp],factorlist)
+        ldeg:=degree(ffactor,lvar)
+        um := unitCanonical um
+        if ground?(leadingCoefficient um) then
+           lf:= mfconst(um,lvar,ldeg,ufactor)
+        else lf:=mfpol(um,lvar,ldeg,ufactor)
+        auxfl:=[[unitCanonical multivariate(lfp,x),ffexp]$MParFact_
+            for lfp in lf]
+        factorlist:=append(factorlist,auxfl)
+      lcfacs:=*/[leadingCoefficient(f.irr)**((f.pow)::NNI) for f in factorlist]
+      [(leadingCoefficient(m) exquo lcfacs):: R,factorlist]$MFinalFact
+
+    factor(m:P,ufactor:UFactor):Factored P ==
+      flist := mFactor(m,ufactor)
+      (flist.contp):: P *
+        (*/[primeFactor(u.irr,u.pow) for u in flist.factors])
+
 *)
 
 \end{chunk}
@@ -58392,29 +80018,25 @@ InnerNormalBasisFieldFunctions(GF): Exports == Implementation where
 
 -- functions ===========================================================
 
---  computes a**(-1) = a**((q**extDeg)-2)
---  see reference of function expPot
+    --  computes a**(-1) = a**((q**extDeg)-2)
+    --  see reference of function expPot
     inv(a) ==
       b:VGF:=qPot(expPot(a,(#a-1)::NNI::SI,1::SI)$$,1)$$
       erg:VGF:=inv((a *$$ b).1 *$GF trGen)$GF *$VGF b
 
--- "**" decides which exponentiation algorithm will be used, in order to
--- get the fastest computation. If dAndcExp is used, it chooses the
--- optimal parameter k for that algorithm.
+    -- "**" decides which exponentiation algorithm will be used, in order to
+    -- get the fastest computation. If dAndcExp is used, it chooses the
+    -- optimal parameter k for that algorithm.
     a ** ex  ==
       e:NNI:=positiveRemainder(ex,sizeGF**((#a)::PI)-1)$I :: NNI
       zero?(e)$NNI => new(#a,trGen)$VGF
---      one?(e)$NNI  => copy(a)$VGF
       (e = 1)$NNI  => copy(a)$VGF
---    inGroundField?(a) => new(#a,((a.1*trGen) **$GF e))$VGF
       e1:SI:=(length(e)$I)::SI
       sizeGF >$I 11 =>
         q1:SI:=(length(sizeGF)$I)::SI
         logqe:SI:=(e1 quo$SI q1) +$SI 1$SI
         10::SI * (logqe + sizeGF-2) > 15::SI * e1 =>
---        print("repeatedSquaring"::OUT)
           repSq(a,e)
---      print("divAndConquer(a,e,1)"::OUT)
         dAndcExp(a,e,1)
       logqe:SI:=((10::SI *$SI e1) quo$SI (logq.sizeGF)) +$SI 1$SI
       k:SI:=1$SI
@@ -58423,23 +80045,20 @@ InnerNormalBasisFieldFunctions(GF): Exports == Implementation where
       mult:I:=(sizeGF-1) *$I sizeGF **$I ((k-1)pretend NNI) +$I_
               ((logqe +$SI k -$SI 1$SI) quo$SI k)::I -$I 2
       (10*mult) >= (15 * (e1::I)) =>
---      print("repeatedSquaring(a,e)"::OUT)
         repSq(a,e)
---    print(hconcat(["divAndConquer(a,e,"::OUT,k::OUT,")"::OUT])$OUT)
       dAndcExp(a,e,k)
 
--- computes a**e by repeated squaring
+    -- computes a**e by repeated squaring
     repSq(b,e) ==
       a:=copy(b)$VGF
---      one? e => a
       (e = 1) => a
       odd?(e)$I => a * repSq(a*a,(e quo 2) @ NNI)
       repSq(a*a,(e quo 2) @ NNI)
 
--- computes a**e using the divide and conquer algorithm similar to the
--- one from D.R.Stinson,
--- "Some observations on parallel Algorithms for fast exponentiation in
--- GF(2^n)", Siam J. Computation, Vol.19, No.4, pp.711-717, August 1990
+    -- computes a**e using the divide and conquer algorithm similar to the
+    -- one from D.R.Stinson,
+    -- "Some observations on parallel Algorithms for fast exponentiation in
+    -- GF(2^n)", Siam J. Computation, Vol.19, No.4, pp.711-717, August 1990
     dAndcExp(a,e,k) ==
       plist:List VGF:=[copy(a)$VGF]
       qk:I:=sizeGF**(k pretend NNI)
@@ -58485,19 +80104,19 @@ InnerNormalBasisFieldFunctions(GF): Exports == Implementation where
       erg=0 => (sizeGF**(#x)) :: PI
       erg :: PI
 
---  computes the norm of a over GF**d, d must devide extdeg
---  see reference of function expPot below
+    --  computes the norm of a over GF**d, d must devide extdeg
+    --  see reference of function expPot below
     norm(a,d) ==
       dSI:=d::SI
       r:=divide((#a)::SI,dSI)
       not(r.remainder = 0) => error "norm: 2.arg must divide extdeg"
       expPot(a,r.quotient,dSI)$$
 
---  computes expPot(a,e,d) = sum form i=0 to e-1 over a**(q**id))
---  see T.Itoh and S.Tsujii,
---  "A fast algorithm for computing multiplicative inverses in GF(2^m)
---   using normal bases",
---  Information and Computation 78, pp.171-177, 1988
+    --  computes expPot(a,e,d) = sum form i=0 to e-1 over a**(q**id))
+    --  see T.Itoh and S.Tsujii,
+    --  "A fast algorithm for computing multiplicative inverses in GF(2^m)
+    --   using normal bases",
+    --  Information and Computation 78, pp.171-177, 1988
     expPot(a,e,d) ==
       deg:SI:=(#a)::SI
       e=1 => copy(a)$VGF
@@ -58552,7 +80171,6 @@ InnerNormalBasisFieldFunctions(GF): Exports == Implementation where
 
     x:VGF / y:VGF == x *$$ inv(y)$$
 
-
     setFieldInfo(m,n) ==
       multTable:=m
       trGen:=n
@@ -58583,7 +80201,6 @@ InnerNormalBasisFieldFunctions(GF): Exports == Implementation where
        v:=zero(n)$VGF
        qsetelt_!(v,1,1$GF)
        v
---    normalElement(n) == index(n,1)$$
 
     index(degm,n) ==
       m:I:=n rem$I (sizeGF ** degm)
@@ -58601,6 +80218,229 @@ InnerNormalBasisFieldFunctions(GF): Exports == Implementation where
 \begin{chunk}{COQ INBFF}
 (* package INBFF *)
 (*
+
+-- global variables ===================================================
+
+    sizeGF:NNI:=size()$GF
+    -- the size of the ground field
+
+    multTable:V L TERM:=new(1,nil()$(L TERM))$(V L TERM)
+    -- global variable containing the multiplication table
+
+    trGen:GF:=1$GF
+    -- controls the imbedding of the ground field
+
+    logq:List SI:=[0,10::SI,16::SI,20::SI,23::SI,0,28::SI,_
+                             30::SI,32::SI,0,35::SI]
+    -- logq.i is about 10*log2(i) for the values <12 which
+    -- can match sizeGF. It's used by "**"
+
+    expTable:L L SI:=[[],_
+        [4::SI,12::SI,48::SI,160::SI,480::SI,0],_
+        [8::SI,72::SI,432::SI,0],_
+        [18::SI,216::SI,0],_
+        [32::SI,480::SI,0],[],_
+        [72::SI,0],[98::SI,0],[128::SI,0],[],[200::SI,0]]
+    -- expT is used by "**" to optimize the parameter k
+    -- before calling dAndcExp(..,..,k)
+
+-- functions ===========================================================
+
+    --  computes a**(-1) = a**((q**extDeg)-2)
+    --  see reference of function expPot
+    inv(a) ==
+      b:VGF:=qPot(expPot(a,(#a-1)::NNI::SI,1::SI)$$,1)$$
+      erg:VGF:=inv((a *$$ b).1 *$GF trGen)$GF *$VGF b
+
+    -- "**" decides which exponentiation algorithm will be used, in order to
+    -- get the fastest computation. If dAndcExp is used, it chooses the
+    -- optimal parameter k for that algorithm.
+    a ** ex  ==
+      e:NNI:=positiveRemainder(ex,sizeGF**((#a)::PI)-1)$I :: NNI
+      zero?(e)$NNI => new(#a,trGen)$VGF
+      (e = 1)$NNI  => copy(a)$VGF
+      e1:SI:=(length(e)$I)::SI
+      sizeGF >$I 11 =>
+        q1:SI:=(length(sizeGF)$I)::SI
+        logqe:SI:=(e1 quo$SI q1) +$SI 1$SI
+        10::SI * (logqe + sizeGF-2) > 15::SI * e1 =>
+          repSq(a,e)
+        dAndcExp(a,e,1)
+      logqe:SI:=((10::SI *$SI e1) quo$SI (logq.sizeGF)) +$SI 1$SI
+      k:SI:=1$SI
+      expT:List SI:=expTable.sizeGF
+      while (logqe >= expT.k) and not zero? expT.k repeat k:=k +$SI 1$SI
+      mult:I:=(sizeGF-1) *$I sizeGF **$I ((k-1)pretend NNI) +$I_
+              ((logqe +$SI k -$SI 1$SI) quo$SI k)::I -$I 2
+      (10*mult) >= (15 * (e1::I)) =>
+        repSq(a,e)
+      dAndcExp(a,e,k)
+
+    -- computes a**e by repeated squaring
+    repSq(b,e) ==
+      a:=copy(b)$VGF
+      (e = 1) => a
+      odd?(e)$I => a * repSq(a*a,(e quo 2) @ NNI)
+      repSq(a*a,(e quo 2) @ NNI)
+
+    -- computes a**e using the divide and conquer algorithm similar to the
+    -- one from D.R.Stinson,
+    -- "Some observations on parallel Algorithms for fast exponentiation in
+    -- GF(2^n)", Siam J. Computation, Vol.19, No.4, pp.711-717, August 1990
+    dAndcExp(a,e,k) ==
+      plist:List VGF:=[copy(a)$VGF]
+      qk:I:=sizeGF**(k pretend NNI)
+      for j in 2..(qk-1) repeat
+        if positiveRemainder(j,sizeGF)=0 then b:=qPot(plist.(j quo sizeGF),1)$$
+                            else b:=a *$$ last(plist)$(List VGF)
+        plist:=concat(plist,b)
+      l:List NNI:=nil()
+      ex:I:=e
+      while not(ex = 0) repeat
+        l:=concat(l,positiveRemainder(ex,qk) pretend NNI)
+        ex:=ex quo qk
+      if first(l)=0 then erg:VGF:=new(#a,trGen)$VGF
+                    else erg:VGF:=plist.(first(l))
+      i:SI:=k
+      for j in rest(l) repeat
+        if j^=0 then erg:=erg *$$ qPot(plist.j,i)$$
+        i:=i+k
+      erg
+
+    a * b ==
+      e:SI:=(#a)::SI
+      erg:=zero(#a)$VGF
+      for t in multTable.1 repeat
+        for j in 1..e repeat
+          y:=t.value  -- didn't work without defining x and y
+          x:=t.index
+          k:SI:=addmod(x,j::SI,e)$SI +$SI 1$SI
+          erg.k:=erg.k +$GF a.j *$GF b.j *$GF y
+      for i in 1..e-1 repeat
+        for j in i+1..e repeat
+          for t in multTable.(j-i+1) repeat
+            y:=t.value   -- didn't work without defining x and y
+            x:=t.index
+            k:SI:=addmod(x,i::SI,e)$SI +$SI 1$SI
+            erg.k:GF:=erg.k +$GF (a.i *$GF b.j +$GF a.j *$GF b.i) *$GF y
+      erg
+
+    lookup(x) ==
+      erg:I:=0
+      for j in (#x)..1 by -1 repeat
+        erg:=(erg * sizeGF) + (lookup(x.j)$GF rem sizeGF)
+      erg=0 => (sizeGF**(#x)) :: PI
+      erg :: PI
+
+    --  computes the norm of a over GF**d, d must devide extdeg
+    --  see reference of function expPot below
+    norm(a,d) ==
+      dSI:=d::SI
+      r:=divide((#a)::SI,dSI)
+      not(r.remainder = 0) => error "norm: 2.arg must divide extdeg"
+      expPot(a,r.quotient,dSI)$$
+
+    --  computes expPot(a,e,d) = sum form i=0 to e-1 over a**(q**id))
+    --  see T.Itoh and S.Tsujii,
+    --  "A fast algorithm for computing multiplicative inverses in GF(2^m)
+    --   using normal bases",
+    --  Information and Computation 78, pp.171-177, 1988
+    expPot(a,e,d) ==
+      deg:SI:=(#a)::SI
+      e=1 => copy(a)$VGF
+      k2:SI:=d
+      y:=copy(a)
+      if bit?(e,0) then
+        erg:=copy(y)
+        qpot:SI:=k2
+      else
+        erg:=new(#a,inv(trGen)$GF)$VGF
+        qpot:SI:=0
+      for k in 1..length(e) repeat
+        y:= y *$$ qPot(y,k2)
+        k2:=addmod(k2,k2,deg)$SI
+        if bit?(e,k) then
+          erg:=erg *$$ qPot(y,qpot)
+          qpot:=addmod(qpot,k2,deg)$SI
+      erg
+
+-- computes qPot(a,n) = a**(q**n), q=size of GF
+    qPot(e,n) ==
+      ei:=(#e)::SI
+      m:SI:= positiveRemainder(n::SI,ei)$SI
+      zero?(m) => e
+      e1:=zero(#e)$VGF
+      for i in m+1..ei repeat e1.i:=e.(i-m)
+      for i in 1..m    repeat e1.i:=e.(ei+i-m)
+      e1
+
+    trace(a,d) ==
+      dSI:=d::SI
+      r:=divide((#a)::SI,dSI)$SI
+      not(r.remainder = 0) => error "trace: 2.arg must divide extdeg"
+      v:=copy(a.(1..dSI))$VGF
+      sSI:SI:=r.quotient
+      for i in 1..dSI repeat
+        for j in 1..sSI-1 repeat
+          v.i:=v.i+a.(i+j::SI*dSI)
+      v
+
+    random(n) ==
+      v:=zero(n)$VGF
+      for i in 1..n repeat v.i:=random()$GF
+      v
+
+
+    xn(m) == monomial(1,m)$(SUP GF) - 1$(SUP GF)
+
+    normal?(x) ==
+      gcd(xn(#x),pol(x))$(SUP GF) = 1 => true
+      false
+
+    x:VGF / y:VGF == x *$$ inv(y)$$
+
+    setFieldInfo(m,n) ==
+      multTable:=m
+      trGen:=n
+      void()$Void
+
+    minimalPolynomial(x) ==
+      dx:=#x
+      y:=new(#x,inv(trGen)$GF)$VGF
+      m:=zero(dx,dx+1)$(M GF)
+      for i in 1..dx+1 repeat
+        dy:=#y
+        for j in 1..dy repeat
+          for k in 0..((dx quo dy)-1) repeat
+            qsetelt_!(m,j+k*dy,i,y.j)$(M GF)
+        y:=y *$$ x
+      v:=first nullSpace(m)$(M GF)
+      pol(v)$$
+
+    basis(n) ==
+      bas:(V VGF):=new(n,zero(n)$VGF)$(V VGF)
+      for i in 1..n repeat
+        uniti:=zero(n)$VGF
+        qsetelt_!(uniti,i,1$GF)$VGF
+        qsetelt_!(bas,i,uniti)$(V VGF)
+      bas
+
+    normalElement(n) ==
+       v:=zero(n)$VGF
+       qsetelt_!(v,1,1$GF)
+       v
+
+    index(degm,n) ==
+      m:I:=n rem$I (sizeGF ** degm)
+      erg:=zero(degm)$VGF
+      for j in 1..degm repeat
+        erg.j:=index((sizeGF+(m rem sizeGF)) pretend PI)$GF
+        m:=m quo sizeGF
+      erg
+
+    pol(x) ==
+      +/[monomial(x.i,(i-1)::NNI)$(SUP GF) for i in 1..(#x)::I]
+
 *)
 
 \end{chunk}
@@ -58810,13 +80650,16 @@ InnerNumericEigenPackage(K,F,Par) : C == T
        res
 
      if K is RN then
+
          solve1(up:SUK, eps:Par) : List(F) ==
            denom := "lcm"/[denom(c::RN) for c in coefficients up]
            up:=denom*up
            upi:=map(numer,up)_
              $UnivariatePolynomialCategoryFunctions2(RN,SUP RN,I,SUP I)
            innerSolve1(upi, eps)$InnerNumericFloatSolvePackage(I,F,Par)
+
      else if K is GRN then
+
          solve1(up:SUK, eps:Par) : List(F) ==
            denom := "lcm"/[lcm(denom real(c::GRN), denom imag(c::GRN))
                                 for c in coefficients up]
@@ -58824,6 +80667,7 @@ InnerNumericEigenPackage(K,F,Par) : C == T
            upgi := map((c:GRN):GI+->complex(numer(real c), numer(imag c)),up)_
              $UnivariatePolynomialCategoryFunctions2(GRN,SUP GRN,GI,SUP GI)
            innerSolve1(upgi, eps)$InnerNumericFloatSolvePackage(GI,F,Par)
+
      else error "unsupported matrix type"
 
           ----  the real eigenvectors expressed as floats  ----
@@ -58853,12 +80697,141 @@ InnerNumericEigenPackage(K,F,Par) : C == T
          B(i,i) := B(i,i) - monomial(1,1)$SUK
        determinant B
 
-
 \end{chunk}
 
 \begin{chunk}{COQ INEP}
 (* package INEP *)
 (*
+
+     numeric(r:K):F ==
+       K is RN =>
+         F is NF => convert(r)$RN
+         F is RN    => r
+         F is CF    => r :: RN :: CF
+         F is GRN   => r::RN::GRN
+       K is GRN =>
+         F is GRN => r
+         F is CF  => convert(convert r)
+       error "unsupported coefficient type"
+
+    ---- next functions neeeded for defining  ModularField ----
+
+     monicize(f:SUK) : SUK ==
+       (a:=leadingCoefficient f) =1 => f
+       inv(a)*f
+
+     reduction(u:SUK,p:SUK):SUK == u rem p
+
+     merge(p:SUK,q:SUK):Union(SUK,"failed") ==
+         p = q => p
+         p = 0 => q
+         q = 0 => p
+         "failed"
+
+     exactquo(u:SUK,v:SUK,p:SUK):Union(SUK,"failed") ==
+        val:=extendedEuclidean(v,p,u)
+        val case "failed" => "failed"
+        val.coef1
+
+         ----  eval a vector of F in a radical expression  ----
+     evalvect(vect:MSUK,alg:F) : MF ==
+       n:=nrows vect
+       w:MF:=zero(n,1)$MF
+       for i in 1..n repeat
+         polf:=map(numeric,
+           vect(i,1))$UnivariatePolynomialCategoryFunctions2(K,SUK,F,SUF)
+         v:F:=elt(polf,alg)
+         setelt(w,i,1,v)
+       w
+
+       ---- internal function for the computation of eigenvectors  ----
+     inteigen(A:MK,p:SUK,fact:UFactor) : List(IntForm) ==
+       dimA:NNI:=  nrows A
+       MM:=ModularField(SUK,SUK,reduction,merge,exactquo)
+       AM:=Matrix(MM)
+       lff:=factors fact(p)
+       res: List IntForm  :=[]
+       lr : List MF:=[]
+       for ff in lff repeat
+         pol:SUK:= ff.factor
+         if (degree pol)=1 then
+           alpha:K:=-coefficient(pol,0)/leadingCoefficient pol
+           -- compute the eigenvectors, rational case
+           B1:MK := zero(dimA,dimA)$MK
+           for i in 1..dimA repeat
+             for j in 1..dimA repeat B1(i,j):=A(i,j)
+             B1(i,i):= B1(i,i) - alpha
+           lr:=[]
+           for vecr in nullSpace B1 repeat
+             wf:MF:=zero(dimA,1)
+             for i in 1..dimA repeat wf(i,1):=numeric vecr.i
+             lr:=cons(wf,lr)
+           res:=cons([numeric alpha,ff.exponent,lr]$outForm,res)
+         else
+           ppol:=monicize pol
+           alg:MM:= reduce(monomial(1,1),ppol)
+           B:AM:= zero(dimA,dimA)$AM
+           for i in 1..dimA  repeat
+             for j in 1..dimA repeat B(i,j):=reduce(A(i,j) ::SUK,ppol)
+             B(i,i):=B(i,i) - alg
+           sln2:=nullSpace B
+           soln:List MSUK :=[]
+           for vec in sln2 repeat
+             wk:MSUK:=zero(dimA,1)
+             for i in 1..dimA repeat wk(i,1):=(vec.i)::SUK
+             soln:=cons(wk,soln)
+           res:=cons([ff.factor,ff.exponent,soln]$PEigenForm,
+                            res)
+       res
+
+     if K is RN then
+
+         solve1(up:SUK, eps:Par) : List(F) ==
+           denom := "lcm"/[denom(c::RN) for c in coefficients up]
+           up:=denom*up
+           upi:=map(numer,up)_
+             $UnivariatePolynomialCategoryFunctions2(RN,SUP RN,I,SUP I)
+           innerSolve1(upi, eps)$InnerNumericFloatSolvePackage(I,F,Par)
+
+     else if K is GRN then
+
+         solve1(up:SUK, eps:Par) : List(F) ==
+           denom := "lcm"/[lcm(denom real(c::GRN), denom imag(c::GRN))
+                                for c in coefficients up]
+           up:=denom*up
+           upgi := map((c:GRN):GI+->complex(numer(real c), numer(imag c)),up)_
+             $UnivariatePolynomialCategoryFunctions2(GRN,SUP GRN,GI,SUP GI)
+           innerSolve1(upgi, eps)$InnerNumericFloatSolvePackage(GI,F,Par)
+
+     else error "unsupported matrix type"
+
+          ----  the real eigenvectors expressed as floats  ----
+
+     innerEigenvectors(A:MK,eps:Par,fact:UFactor) : List outForm ==
+       pol:= charpol A
+       sln1:List(IntForm):=inteigen(A,pol,fact)
+       n:=nrows A
+       sln:List(outForm):=[]
+       for lev in sln1 repeat
+         lev case outForm => sln:=cons(lev,sln)
+         leva:=lev::PEigenForm
+         lval:List(F):= solve1(leva.algpol,eps)
+         lvect:=leva.poleigen
+         lmult:=leva.almult
+         for alg in lval repeat
+           nsl:=[alg,lmult,[evalvect(ep,alg) for ep in lvect]]$outForm
+           sln:=cons(nsl,sln)
+       sln
+
+     charpol(A:MK) : SUK ==
+       dimA :PI := (nrows A):PI
+       dimA ^= ncols A => error " The matrix is not square"
+       B:Matrix SUK :=zero(dimA,dimA)
+       for i in 1..dimA repeat
+         for j in 1..dimA repeat  B(i,j):=A(i,j)::SUK
+         B(i,i) := B(i,i) - monomial(1,1)$SUK
+       determinant B
+
 *)
 
 \end{chunk}
@@ -59069,7 +81042,6 @@ InnerNumericFloatSolvePackage(K,F,Par): Cat == Cap where
 
        -- real zeros of the system of polynomial lp --
        innerSolve(lp:L P K,ld:L P K,lv:L SE,eps: Par) : L L F ==
-          -- empty?(ld) and (#lv = 2) and (# lp = 2) => innerSolve2(lp, lv, eps)
            lnp:= [pToDmp(p)$PolToPol(lv,K) for p in lp]
            OV:=OrderedVariableList(lv)
            lvv:L OV:= [variable(vv)::OV for vv in lv]
@@ -59119,6 +81091,135 @@ InnerNumericFloatSolvePackage(K,F,Par): Cat == Cap where
 \begin{chunk}{COQ INFSP}
 (* package INFSP *)
 (*
+
+                  ------  Local Functions  ------
+       isGeneric? : (L P K,L SE) -> Boolean
+       evaluate  : (P K,SE,SE,F) ->  F
+       numeric   :     K          -> F
+       oldCoord      : (L F,L I) -> L F
+       findGenZeros  : (L P K,L SE,Par) -> L L F
+       failPolSolve  : (L P K,L SE)  -> Union(L L P K,"failed")
+
+       numeric(r:K):F ==
+         K is I =>
+           F is Float => r::I::Float
+           F is RN    => r::I::RN
+           F is CF    => r::I::CF
+           F is GRN   => r::I::GRN
+         K is GI =>
+           gr:GI := r::GI
+           F is GRN => complex(real(gr)::RN,imag(gr)::RN)$GRN
+           F is CF  => convert(gr)
+         error "case not handled"
+
+       -- construct the equation
+       makeEq(nres:L F,lv:L SE) : L EQ P F ==
+           [equation(x::(P F),r::(P F)) for x in lv for r in nres]
+
+       evaluate(pol:P K,xvar:SE,zvar:SE,z:F):F ==
+         rpp:=map(numeric,pol)$PolynomialFunctions2(K,F)
+         rpp := eval(rpp,zvar,z)
+         upol:=univariate(rpp,xvar)
+         retract(-coefficient(upol,0))/retract(leadingCoefficient upol)
+
+       myConvert(eps:Par) : RN ==
+         Par is RN => eps
+         Par is NF => retract(eps)$NF
+
+       innerSolve1(pol:P K,eps:Par) : L F == innerSolve1(univariate pol,eps)
+
+       innerSolve1(upol:SUP K,eps:Par) : L F ==
+         K is GI and (Par is RN or Par is NF) =>
+             (complexZeros(upol,
+                        eps)$ComplexRootPackage(SUP K,Par)) pretend L(F)
+         K is I =>
+           F is Float =>
+             z:= realZeros(upol,myConvert eps)$RealZeroPackage(SUP I)
+             [convert((1/2)*(x.left+x.right))@Float for x in z] pretend L(F)
+
+           F is RN =>
+             z:= realZeros(upol,myConvert eps)$RealZeroPackage(SUP I)
+             [(1/2)*(x.left + x.right) for x in z] pretend L(F)
+           error "improper arguments to INFSP"
+         error "improper arguments to INFSP"
+
+
+       -- find the zeros of components in "generic" position --
+       findGenZeros(lp:L P K,rlvar:L SE,eps:Par) : L L F ==
+         rlp:=reverse lp
+         f:=rlp.first
+         zvar:= rlvar.first
+         rlp:=rlp.rest
+         lz:=innerSolve1(f,eps)
+         [reverse cons(z,[evaluate(pol,xvar,zvar,z) for pol in rlp
+                         for xvar in rlvar.rest]) for z in lz]
+
+       -- convert to the old coordinates --
+       oldCoord(numres:L F,lval:L I) : L F ==
+         rnumres:=reverse numres
+         rnumres.first:= rnumres.first +
+            (+/[n*nr for n in lval for nr in rnumres.rest])
+         reverse rnumres
+
+       -- real zeros of a system of 2 polynomials lp (incomplete)
+       innerSolve2(lp:L P K,lv:L SE,eps: Par):L L F ==
+          mainvar := first lv
+          up1:=univariate(lp.1, mainvar)
+          up2:=univariate(lp.2, mainvar)
+          vec := subresultantVector(up1,up2)$SubResultantPackage(P K,SUP P K)
+          p0 := primitivePart multivariate(vec.0, mainvar)
+          p1 := primitivePart(multivariate(vec.1, mainvar),mainvar)
+          zero? p1 or
+            gcd(p0, leadingCoefficient(univariate(p1,mainvar))) ^=1 =>
+              innerSolve(cons(0,lp),empty(),lv,eps)
+          findGenZeros([p1, p0], reverse lv, eps)
+
+       -- real zeros of the system of polynomial lp --
+       innerSolve(lp:L P K,ld:L P K,lv:L SE,eps: Par) : L L F ==
+           lnp:= [pToDmp(p)$PolToPol(lv,K) for p in lp]
+           OV:=OrderedVariableList(lv)
+           lvv:L OV:= [variable(vv)::OV for vv in lv]
+           DP:=DirectProduct(#lv,NonNegativeInteger)
+           dmp:=DistributedMultivariatePolynomial(lv,K)
+           lq:L dmp:=[]
+           if ld^=[] then
+             lq:= [(pToDmp(q1)$PolToPol(lv,K)) pretend dmp for q1 in ld]
+           partRes:=groebSolve(lnp,lvv)$GroebnerSolve(lv,K,K) pretend (L L dmp)
+           partRes=list [] => []
+           -- remove components where denominators vanish
+           if lq^=[] then
+             gb:=GroebnerInternalPackage(K,DirectProduct(#lv,NNI),OV,dmp)
+             partRes:=[pr for pr in partRes|
+                       and/[(redPol(fq,pr pretend List(dmp))$gb) ^=0
+                         for fq in lq]]
+
+           -- select the components in "generic" form
+           rlv:=reverse lv
+           rrlvv:= rest reverse lvv
+
+           listGen:L L dmp:=[]
+           for res in partRes repeat
+             res1:=rest reverse res
+             "and"/[("max"/degree(f,rrlvv))=1  for f in res1] =>
+                      listGen:=concat(res pretend (L dmp),listGen)
+           result:L L F := []
+           if listGen^=[] then
+             listG :L L P K:=
+               [[dmpToP(pf)$PolToPol(lv,K) for pf in pr] for pr in listGen]
+             result:=
+               "append"/[findGenZeros(res,rlv,eps) for res in listG]
+             for gres in listGen repeat
+                partRes:=delete(partRes,position(gres,partRes))
+           -- adjust the non-generic components
+           for gres in partRes repeat
+               genRecord := genericPosition(gres,lvv)$GroebnerSolve(lv,K,K)
+               lgen := genRecord.dpolys
+               lval := genRecord.coords
+               lgen1:=[dmpToP(pf)$PolToPol(lv,K) for pf in lgen]
+               lris:=findGenZeros(lgen1,rlv,eps)
+               result:= append([oldCoord(r,lval) for r in lris],result)
+           result
+
 *)
 
 \end{chunk}
@@ -59197,6 +81298,7 @@ InnerPolySign(R, UP): Exports == Implementation where
       ++ signAround(u,r,f) \undocumented
  
   Implementation ==> add
+
     signAround(p:UP, x:R, rsign:R -> U) ==
       (ur := signAround(p, x,  1, rsign)) case "failed" => "failed"
       (ul := signAround(p, x, -1, rsign)) case "failed" => "failed"
@@ -59222,6 +81324,27 @@ InnerPolySign(R, UP): Exports == Implementation where
 \begin{chunk}{COQ INPSIGN}
 (* package INPSIGN *)
 (*
+
+    signAround(p:UP, x:R, rsign:R -> U) ==
+      (ur := signAround(p, x,  1, rsign)) case "failed" => "failed"
+      (ul := signAround(p, x, -1, rsign)) case "failed" => "failed"
+      (ur::Integer) = (ul::Integer) => ur
+      "failed"
+ 
+    signAround(p, x, dir, rsign) ==
+      zero? p => 0
+      zero?(r := p x) =>
+        (u := signAround(differentiate p, x, dir, rsign)) case "failed"
+          => "failed"
+        dir * u::Integer
+      rsign r
+ 
+    signAround(p:UP, dir:Integer, rsign:R -> U) ==
+      zero? p => 0
+      (u := rsign leadingCoefficient p) case "failed" => "failed"
+      (dir > 0) or (even? degree p) => u::Integer
+      - (u::Integer)
+
 *)
 
 \end{chunk}
@@ -59302,6 +81425,7 @@ InnerPolySum(E, V, R, P): Exports == Impl where
             ++ upward difference on n, i.e. \spad{P(n+1) - P(n) = a(n)};
 
     Impl ==> add
+
         import PolynomialNumberTheoryFunctions()
         import UnivariatePolynomialCommonDenominator(Z, Q, SUP Q)
 
@@ -59336,6 +81460,36 @@ InnerPolySum(E, V, R, P): Exports == Impl where
 \begin{chunk}{COQ ISUMP}
 (* package ISUMP *)
 (*
+
+        import PolynomialNumberTheoryFunctions()
+        import UnivariatePolynomialCommonDenominator(Z, Q, SUP Q)
+
+        pmul: (P, SUP Q) -> Record(num:SUP P, den:Z)
+
+        pmul(c, p) ==
+            pn := (rec := splitDenominator p).num
+            [map(x +-> numer(x) * c, pn)_
+               $SparseUnivariatePolynomialFunctions2(Q, P), rec.den]
+
+        sum(p, v, s) ==
+          indef := sum(p, v)
+          [eval(indef.num, v, 1 + hi s) - eval(indef.num, v, lo s),
+           indef.den]
+
+        sum(p, v) ==
+            up := univariate(p, v)
+            lp := nil()$List(SUP P)
+            ld := nil()$List(Z)
+            while up ^= 0 repeat
+                ud  := degree up; uc := leadingCoefficient up
+                up  := reductum up
+                rec := pmul(uc, 1 / (ud+1) * bernoulli(ud+1))
+                lp  := concat(rec.num, lp)
+                ld  := concat(rec.den, ld)
+            d := lcm ld
+            vp := +/[(d exquo di)::Z * pi for di in ld for pi in lp]
+            [multivariate(vp, v), d]
+
 *)
 
 \end{chunk}
@@ -59448,6 +81602,7 @@ InnerTrigonometricManipulations(R,F,FG): Exports == Implementation where
       ++ \spad{exp(2*u)} otherwise.
 
   Implementation ==> add
+
     ker2explogs: (KG, List KG, List SY) -> FG
     smp2explogs: (PG, List KG, List SY) -> FG
     supexp     : (UP, GF, GF, Z) -> GF
@@ -59568,6 +81723,122 @@ InnerTrigonometricManipulations(R,F,FG): Exports == Implementation where
 \begin{chunk}{COQ ITRIGMNP}
 (* package ITRIGMNP *)
 (*
+
+    ker2explogs: (KG, List KG, List SY) -> FG
+    smp2explogs: (PG, List KG, List SY) -> FG
+    supexp     : (UP, GF, GF, Z) -> GF
+    GR2GF      : GR -> GF
+    GR2F       : GR -> F
+    KG2F       : KG -> F
+    PG2F       : PG -> F
+    ker2trigs  : (OP, List GF) -> GF
+    smp2trigs  : PG -> GF
+    sup2trigs  : (UP, GF) -> GF
+
+    nth := R has RetractableTo(Integer) and F has RadicalCategory
+
+    GR2F g        == real(g)::F + sqrt(-(1::F)) * imag(g)::F
+    KG2F k        == map(FG2F, k)$ExpressionSpaceFunctions2(FG, F)
+    FG2F f        == (PG2F numer f) / (PG2F denom f)
+    F2FG f        == map(x +-> x::GR, f)$FunctionSpaceFunctions2(R,F,GR,FG)
+    GF2FG f       == (F2FG real f) + complex(0, 1)$GR ::FG * F2FG imag f
+    GR2GF gr      == complex(real(gr)::F, imag(gr)::F)
+
+-- This expects the argument to have only tan and atans left.
+-- Does a half-angle correction if k is not in the initial kernel list.
+    ker2explogs(k, l, lx) ==
+      empty?([v for v in variables(kf := k::FG) |
+                                         member?(v, lx)]$List(SY)) => kf
+      empty?(args := [trigs2explogs(a, l, lx)
+                                    for a in argument k]$List(FG)) => kf
+      im := complex(0, 1)$GR :: FG
+      z  := first args
+      is?(k, "tan"::Symbol)  =>
+        e := (member?(k, l) => exp(im * z) ** 2;  exp(2 * im * z))
+        - im * (e - 1) /$FG (e + 1)
+      is?(k, "atan"::Symbol) =>
+        im * log((1 -$FG im *$FG z)/$FG (1 +$FG im *$FG z))$FG / (2::FG)
+      (operator k) args
+
+    trigs2explogs(f, l, lx) ==
+      smp2explogs(numer f, l, lx) / smp2explogs(denom f, l, lx)
+
+    -- return op(arg) as f + %i g
+    -- op is already an operator with semantics over R, not GR
+    ker2trigs(op, arg) ==
+      "and"/[zero? imag x for x in arg] =>
+        complex(op [real x for x in arg]$List(F), 0)
+      a := first arg
+      is?(op, "exp"::Symbol)  => exp a
+      is?(op, "log"::Symbol)  => log a
+      is?(op, "sin"::Symbol)  => sin a
+      is?(op, "cos"::Symbol)  => cos a
+      is?(op, "tan"::Symbol)  => tan a
+      is?(op, "cot"::Symbol)  => cot a
+      is?(op, "sec"::Symbol)  => sec a
+      is?(op, "csc"::Symbol)  => csc a
+      is?(op, "asin"::Symbol)  => asin a
+      is?(op, "acos"::Symbol)  => acos a
+      is?(op, "atan"::Symbol)  => atan a
+      is?(op, "acot"::Symbol)  => acot a
+      is?(op, "asec"::Symbol)  => asec a
+      is?(op, "acsc"::Symbol)  => acsc a
+      is?(op, "sinh"::Symbol)  => sinh a
+      is?(op, "cosh"::Symbol)  => cosh a
+      is?(op, "tanh"::Symbol)  => tanh a
+      is?(op, "coth"::Symbol)  => coth a
+      is?(op, "sech"::Symbol)  => sech a
+      is?(op, "csch"::Symbol)  => csch a
+      is?(op, "asinh"::Symbol)  => asinh a
+      is?(op, "acosh"::Symbol)  => acosh a
+      is?(op, "atanh"::Symbol)  => atanh a
+      is?(op, "acoth"::Symbol)  => acoth a
+      is?(op, "asech"::Symbol)  => asech a
+      is?(op, "acsch"::Symbol)  => acsch a
+      is?(op, "abs"::Symbol)    => sqrt(norm a)::GF
+      nth and is?(op, NTHR) => nthRoot(a, retract(second arg)@Z)
+      error "ker2trigs: cannot convert kernel to gaussian function"
+
+    sup2trigs(p, f) ==
+      map(smp2trigs, p)$SparseUnivariatePolynomialFunctions2(PG, GF) f
+
+    smp2trigs p ==
+      map(x +-> explogs2trigs(x::FG),GR2GF, p)_
+         $PolynomialCategoryLifting(IndexedExponents KG, KG, GR, PG, GF)
+
+    explogs2trigs f ==
+      (m := mainKernel f) case "failed" =>
+        GR2GF(retract(numer f)@GR) / GR2GF(retract(denom f)@GR)
+      op  := operator(operator(k := m::KG))$F
+      arg := [explogs2trigs x for x in argument k]
+      num := univariate(numer f, k)
+      den := univariate(denom f, k)
+      is?(op, "exp"::Symbol) =>
+        e  := exp real first arg
+        y  := imag first arg
+        g  := complex(e *  cos y, e * sin y)$GF
+        gi := complex(cos(y) / e, - sin(y) / e)$GF
+        supexp(num,g,gi,b := (degree num)::Z quo 2)/supexp(den,g,gi,b)
+      sup2trigs(num, g := ker2trigs(op, arg)) / sup2trigs(den, g)
+
+    supexp(p, f1, f2, bse) ==
+      ans:GF := 0
+      while p ^= 0 repeat
+        g := explogs2trigs(leadingCoefficient(p)::FG)
+        if ((d := degree(p)::Z - bse) >= 0) then
+             ans := ans + g * f1 ** d
+        else ans := ans + g * f2 ** (-d)
+        p := reductum p
+      ans
+
+    PG2F p ==
+      map(KG2F, GR2F, p)$PolynomialCategoryLifting(IndexedExponents KG,
+                                                          KG, GR, PG, F)
+
+    smp2explogs(p, l, lx) ==
+      map(x +-> ker2explogs(x, l, lx), y +-> y::FG, p)_
+       $PolynomialCategoryLifting(IndexedExponents KG, KG, GR, PG, FG)
+
 *)
 
 \end{chunk}
@@ -59642,6 +81913,7 @@ InputFormFunctions1(R:Type):with
     ++ interpret(f) passes f to the interpreter, and transforms
     ++ the result into an object of type R.
  == add
+
   Rname := devaluate(R)$Lisp :: InputForm
 
   packageCall name ==
@@ -59657,14 +81929,25 @@ InputFormFunctions1(R:Type):with
 \begin{chunk}{COQ INFORM1}
 (* package INFORM1 *)
 (*
-*)
-
-\end{chunk}
 
-\begin{chunk}{INFORM1.dotabb}
-"INFORM1" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INFORM1"]
-"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
-"INFORM1" -> "ALIST"
+  Rname := devaluate(R)$Lisp :: InputForm
+
+  packageCall name ==
+    convert([convert("$elt"::Symbol), Rname,
+                                convert name]$List(InputForm))@InputForm
+
+  interpret form ==
+    retract(interpret(convert([convert("@"::Symbol), form,
+          Rname]$List(InputForm))@InputForm)$InputForm)$AnyFunctions1(R)
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{INFORM1.dotabb}
+"INFORM1" [color="#FF4488",href="bookvol10.4.pdf#nameddest=INFORM1"]
+"ALIST" [color="#88FF44",href="bookvol10.3.pdf#nameddest=ALIST"]
+"INFORM1" -> "ALIST"
 
 \end{chunk}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -59728,6 +82011,7 @@ InterfaceGroebnerPackage(K,symb,E,OV,R):Exports == Implementation where
     groebner: List R -> List R
       
   Implementation ==>  add
+
     if ^(K has FiniteFieldCategory) then
 
       GBPackR ==> GroebnerPackage(K,E,OV,R)  
@@ -59766,12 +82050,16 @@ InterfaceGroebnerPackage(K,symb,E,OV,R):Exports == Implementation where
       coerceDtoR(pol) == map(#1,pol)$MPolyCatFunctions2(OV,E,E,K,K,D,R)
 
       gs:= size()$K
+
       if gs = q and (representationType()$K case "prime")  then 
+
         groebner(l)==
 	  ldmp:List DPF:= [coerceRtoDwithPF(pol) for pol in l]
           gg:=groebner(ldmp)$JCFGBPack
           [coerceDtoRwithPF(pol) for pol in gg]
+
       else
+
         groebner(l)==
 	  ldmp:List D:= [coerceRtoD(pol) for pol in l]
           gg:=groebner(ldmp)$GBPack
@@ -59782,6 +82070,60 @@ InterfaceGroebnerPackage(K,symb,E,OV,R):Exports == Implementation where
 \begin{chunk}{COQ INTERGB}
 (* package INTERGB *)
 (*
+
+    if ^(K has FiniteFieldCategory) then
+
+      GBPackR ==> GroebnerPackage(K,E,OV,R)  
+      groebner(l)==groebner(l)$GBPackR
+
+    else 
+
+      q:PositiveInteger:=(characteristic()$K pretend PositiveInteger)
+  
+      PF ==> PrimeField(q)
+      DPF ==> DistributedMultivariatePolynomial(symb,PF)
+      D ==> DistributedMultivariatePolynomial(symb,K)
+      JCFGBPack ==> GroebnerPackage(PF,E,OV,DPF)
+      GBPack ==> GroebnerPackage(K,E,OV,D)  
+
+      coerceKtoPF: K -> PF
+      coerceKtoPF(a:K):PF==
+        index(lookup(a)$K)$PF
+
+      coercePFtoK: PF -> K  
+      coercePFtoK(a:PF):K==
+        index(lookup(a)$PF)$K
+  
+      coerceRtoDwithPF: R -> DPF
+      coerceRtoDwithPF(pol) ==
+        map(coerceKtoPF(#1),pol)$MPolyCatFunctions2(OV,E,E,K,PF,R,DPF)
+  
+      coerceDtoRwithPF: DPF->R 
+      coerceDtoRwithPF(pol) ==
+        map(coercePFtoK(#1),pol)$MPolyCatFunctions2(OV,E,E,PF,K,DPF,R)
+
+      coerceRtoD: R -> D
+      coerceRtoD(pol) == map(#1,pol)$MPolyCatFunctions2(OV,E,E,K,K,R,D)
+  
+      coerceDtoR: D->R 
+      coerceDtoR(pol) == map(#1,pol)$MPolyCatFunctions2(OV,E,E,K,K,D,R)
+
+      gs:= size()$K
+
+      if gs = q and (representationType()$K case "prime")  then 
+
+        groebner(l)==
+	  ldmp:List DPF:= [coerceRtoDwithPF(pol) for pol in l]
+          gg:=groebner(ldmp)$JCFGBPack
+          [coerceDtoRwithPF(pol) for pol in gg]
+
+      else
+
+        groebner(l)==
+	  ldmp:List D:= [coerceRtoD(pol) for pol in l]
+          gg:=groebner(ldmp)$GBPack
+          [coerceDtoR(pol) for pol in gg]
+
 *)
 
 \end{chunk}
@@ -59865,8 +82207,11 @@ IntegerBits: with
           ++ bitTruth(n,m) returns true if coefficient of 2**m in abs(n) is 1
  
     == add
+
         bitLength n   == INTEGER_-LENGTH(n)$Lisp
+
         bitCoef (n,i) == if INTEGER_-BIT(n,i)$Lisp then 1 else 0
+
         bitTruth(n,i) == INTEGER_-BIT(n,i)$Lisp
 
 \end{chunk}
@@ -59874,6 +82219,13 @@ IntegerBits: with
 \begin{chunk}{COQ INTBIT}
 (* package INTBIT *)
 (*
+
+        bitLength n   == INTEGER_-LENGTH(n)$Lisp
+
+        bitCoef (n,i) == if INTEGER_-BIT(n,i)$Lisp then 1 else 0
+
+        bitTruth(n,i) == INTEGER_-BIT(n,i)$Lisp
+
 *)
 
 \end{chunk}
@@ -60063,6 +82415,7 @@ IntegerCombinatoricFunctions(I:IntegerNumberSystem): EE == II where
       ++ denoted \spad{SS[n,m]}.
  II ==>
   add
+
    F : Record(Fn:I, Fv:I) := [0,1]
    B : Record(Bn:I, Bm:I, Bv:I) := [0,0,0]
    S : Record(Sn:I, Sp:SUP I) := [0,0]
@@ -60168,6 +82521,107 @@ IntegerCombinatoricFunctions(I:IntegerNumberSystem): EE == II where
 \begin{chunk}{COQ COMBINAT}
 (* package COMBINAT *)
 (*
+
+   F : Record(Fn:I, Fv:I) := [0,1]
+   B : Record(Bn:I, Bm:I, Bv:I) := [0,0,0]
+   S : Record(Sn:I, Sp:SUP I) := [0,0]
+   P : IndexedFlexibleArray(I,0) := new(1,1)$IndexedFlexibleArray(I,0)
+ 
+   partition n ==
+      -- This is the number of ways of expressing n as a sum of positive
+      -- integers, without regard to order.  For example partition 5 = 7
+      -- since 5 = 1+1+1+1+1 = 1+1+1+2 = 1+2+2 = 1+1+3 = 1+4 = 2+3 = 5 .
+      -- Uses O(sqrt n) term recurrence from Abramowitz & Stegun pp. 825
+      -- p(n) = sum (-1)**k p(n-j) where 0 < j := (3*k**2+-k) quo 2 <= n
+      minIndex(P) ^= 0 => error "Partition: must have minIndex of 0"
+      m := #P
+      n < 0 => error "partition is not defined for negative integers"
+      n < m::I => P(convert(n)@Z)
+      concat_!(P, new((convert(n+1)@Z - m)::N,0)$IndexedFlexibleArray(I,0))
+      for i in m..convert(n)@Z repeat
+         s:I := 1
+         t:I := 0
+         for k in 1.. repeat
+            l := (3*k*k-k) quo 2
+            l > i => leave
+            u := l+k
+            t := t + s * P(convert(i-l)@Z)
+            u > i => leave
+            t := t + s * P(convert(i-u)@Z)
+            s := -s
+         P.i := t
+      P(convert(n)@Z)
+ 
+   factorial n ==
+      s,f,t : I
+      n < 0 => error "factorial not defined for negative integers"
+      if n <= F.Fn then s := f := 1 else (s, f) := F
+      for k in convert(s+1)@Z .. convert(n)@Z by 2 repeat
+         if k::I = n then t := n else t := k::I * (k+1)::I
+         f := t * f
+      F.Fn := n
+      F.Fv := f
+ 
+   binomial(n, m) ==
+      s,b:I
+      n < 0 or m < 0 or m > n => 0
+      m = 0 => 1
+      n < 2*m => binomial(n, n-m)
+      (s,b) := (0,1)
+      if B.Bn = n then
+         B.Bm = m+1 =>
+            b := (B.Bv * (m+1)) quo (n-m)
+            B.Bn := n
+            B.Bm := m
+            return(B.Bv := b)
+         if m >= B.Bm then (s := B.Bm; b := B.Bv) else (s,b) := (0,1)
+      for k in convert(s+1)@Z .. convert(m)@Z repeat
+        b := (b*(n-k::I+1)) quo k::I
+      B.Bn := n
+      B.Bm := m
+      B.Bv := b
+ 
+   multinomial(n, m) ==
+      for t in m repeat t < 0 => return 0
+      n < _+/m => 0
+      s:I := 1
+      for t in m repeat s := s * factorial t
+      factorial n quo s
+ 
+   permutation(n, m) ==
+      t:I
+      m < 0 or n < m => 0
+      m := n-m
+      p:I := 1
+      for k in convert(m+1)@Z .. convert(n)@Z by 2 repeat
+         if k::I = n then t := n else t := (k*(k+1))::I
+         p := p * t
+      p
+ 
+   stirling1(n, m) ==
+      -- Definition: (-1)**(n-m) S[n,m] is the number of
+      -- permutations of n symbols which have m cycles.
+      n < 0 or m < 1 or m > n => 0
+      m = n => 1
+      S.Sn = n => coefficient(S.Sp, convert(m)@Z :: N)
+      x := monomial(1, 1)$SUP(I)
+      S.Sn := n
+      S.Sp := x
+      for k in 1 .. convert(n-1)@Z repeat S.Sp := S.Sp * (x - k::SUP(I))
+      coefficient(S.Sp, convert(m)@Z :: N)
+ 
+   stirling2(n, m) ==
+      -- definition: SS[n,m] is the number of ways of partitioning
+      -- a set of n elements into m non-empty subsets
+      n < 0 or m < 1 or m > n => 0
+      m = 1 or n = m => 1
+      s:I := if odd? m then -1 else 1
+      t:I := 0
+      for k in 1..convert(m)@Z repeat
+         s := -s
+         t := t + s * binomial(m, k::I) * k::I ** (convert(n)@Z :: N)
+      t quo factorial m
+
 *)
 
 \end{chunk}
@@ -60266,6 +82720,7 @@ IntegerFactorizationPackage(I): Exports == Implementation where
        ++ of n or "failed" if no one is found
 
   Implementation ==> add
+
     import IntegerRoots(I)
     
     BasicSieve: (I, I) -> FF
@@ -60395,6 +82850,7 @@ to generate the numbers has a long, hopefully complete, period. It
 is not clear that the recommended function has that property.
 
 \begin{chunk}{package INTFACT IntegerFactorizationPackage}
+
     PollardSmallFactor(n:I):Union(I,"failed") ==
        -- Use the Brent variation
        x0 := random()$I
@@ -60457,6 +82913,7 @@ Basically we just loop thru the prime factors checking to see if
 they are a component of the number, n. If so, we remove the factor from
 the number n (possibly m times) and continue thru the list of primes.
 \begin{chunk}{package INTFACT IntegerFactorizationPackage}
+
     BasicSieve(n, lim) ==
        p:=primes(1::I,lim::I)$IntegerPrimesPackage(I)
        l:List(I) := append([first p],reverse rest p)
@@ -60472,6 +82929,7 @@ the number n (possibly m times) and continue thru the list of primes.
 \end{chunk}
 \subsection{BasicMethod}
 \begin{chunk}{package INTFACT IntegerFactorizationPackage}
+
     BasicMethod n ==
        u:I
        if n<0 then (m := -n; u := -1)
@@ -60511,6 +82969,7 @@ t6:=t5*a7
 factor t6
 \end{verbatim}
 \begin{chunk}{package INTFACT IntegerFactorizationPackage}
+
     factor m ==
        u:I
        zero? m => 0
@@ -60556,6 +83015,119 @@ factor t6
 \begin{chunk}{COQ INTFACT}
 (* package INTFACT *)
 (*
+
+    import IntegerRoots(I)
+    
+    BasicSieve: (I, I) -> FF
+
+    squareFree(n:I):FF ==
+       u:I
+       if n<0 then (m := -n; u := -1)
+              else (m := n; u := 1)
+       (m > 1) and ((v := perfectSqrt m) case I) =>
+          for rec in (l := factorList(sv := squareFree(v::I))) repeat
+            rec.xpnt := 2 * rec.xpnt
+          makeFR(u * unit sv, l)
+    -- avoid using basic sieve when the lim is too big
+    -- we know the sieve constants up to sqrt(100000000)
+       lim := 1 + approxSqrt(m)
+       lim > (100000000::I) => makeFR(u, factorList factor m)
+       x := BasicSieve(m, lim)
+       y :=
+         ((m:= unit x) = 1) => factorList x
+         (v := perfectSqrt m) case I => 
+            concat_!(factorList x, ["sqfr",v,2]$FFE)
+         concat_!(factorList x, ["sqfr",m,1]$FFE)
+       makeFR(u, y)
+
+
+    PollardSmallFactor(n:I):Union(I,"failed") ==
+       -- Use the Brent variation
+       x0 := random()$I
+       m := 100::I
+       y := x0 rem n
+       r:I := 1
+       q:I := 1
+       G:I := 1
+       until G > 1 repeat
+          x := y
+          for i in 1..convert(r)@Integer repeat
+             y := (y*y+5::I) rem n
+             k:I := 0
+          until (k>=r) or (G>1) repeat
+             ys := y
+             for i in 1..convert(min(m,r-k))@Integer repeat
+                y := (y*y+5::I) rem n
+                q := q*abs(x-y) rem n
+             G := gcd(q,n)
+             k := k+m
+          r := 2*r
+       if G=n then
+          until G>1 repeat
+             ys := (ys*ys+5::I) rem n
+             G := gcd(abs(x-ys),n)
+       G=n => "failed"
+       G
+
+    BasicSieve(n, lim) ==
+       p:=primes(1::I,lim::I)$IntegerPrimesPackage(I)
+       l:List(I) := append([first p],reverse rest p)
+       ls := empty()$List(FFE)
+       for d in l repeat
+          if n<d*d then
+             if n>1 then ls := concat_!(ls, ["prime",n,1]$FFE)
+             return makeFR(1, ls)
+          for m in 0.. while zero?(n rem d) repeat n := n quo d
+          if m>0 then ls := concat_!(ls, ["prime",d,convert m]$FFE)
+       makeFR(n,ls)
+
+    BasicMethod n ==
+       u:I
+       if n<0 then (m := -n; u := -1)
+              else (m := n; u := 1)
+       x := BasicSieve(m, 1 + approxSqrt m)
+       makeFR(u, factorList x)
+
+
+    factor m ==
+       u:I
+       zero? m => 0
+       if negative? m then (n := -m; u := -1)
+                      else (n := m; u := 1)
+       b := BasicSieve(n, 10000::I)
+       flb := factorList b
+       ((n := unit b) = 1) => makeFR(u, flb)
+       a:LMI := dictionary() -- numbers yet to be factored
+       b:LMI := dictionary() -- prime factors found
+       f:LMI := dictionary() -- number which could not be factored
+       insert_!(n, a)
+       while not empty? a repeat
+          n := inspect a; c := count(n, a); remove_!(n, a)
+          prime?(n)$IntegerPrimesPackage(I) => insert_!(n, b, c)
+          -- test for a perfect power
+          (s := perfectNthRoot n).exponent > 1 =>
+            insert_!(s.base, a, c * s.exponent)
+          -- test for a difference of square
+          x:=approxSqrt n
+          if (x**2<n) then x:=x+1
+          (y:=perfectSqrt (x**2-n)) case I =>
+                insert_!(x+y,a,c)
+                insert_!(x-y,a,c)
+          (d := PollardSmallFactor n) case I =>
+             for m in 0.. while zero?(n rem d) repeat n := n quo d
+             insert_!(d, a, m * c)
+             if n > 1 then insert_!(n, a, c)
+          -- an elliptic curve factorization attempt should be made here
+          insert_!(n, f, c)
+       -- insert prime factors found
+       while not empty? b repeat
+          n := inspect b; c := count(n, b); remove_!(n, b)
+          flb := concat_!(flb, ["prime",n,convert c]$FFE)
+       -- insert non-prime factors found
+       while not empty? f repeat
+          n := inspect f; c := count(n, f); remove_!(n, f)
+          flb := concat_!(flb, ["nil",n,convert c]$FFE)
+       makeFR(u, flb)
 *)
 
 \end{chunk}
@@ -60785,10 +83357,13 @@ IntegerLinearDependence(R): Exports == Implementation where
       ++ "failed" if no such rational numbers ci's exist.
 
   Implementation ==> add
+
     import LinearDependence(Z, R)
 
     linearlyDependentOverZ? v == linearlyDependent? v
+
     linearDependenceOverZ   v == linearDependence v
+
     solveLinearlyOverQ(v, c)  == solveLinear(v, c)
 
 \end{chunk}
@@ -60796,6 +83371,15 @@ IntegerLinearDependence(R): Exports == Implementation where
 \begin{chunk}{COQ ZLINDEP}
 (* package ZLINDEP *)
 (*
+
+    import LinearDependence(Z, R)
+
+    linearlyDependentOverZ? v == linearlyDependent? v
+
+    linearDependenceOverZ   v == linearDependence v
+
+    solveLinearlyOverQ(v, c)  == solveLinear(v, c)
+
 *)
 
 \end{chunk}
@@ -61585,6 +84169,7 @@ IntegerNumberTheoryFunctions(): Exports == Implementation where
     ++ the sum of the \spad{k}th powers of the divisors of n is often denoted
     ++ by \spad{sigma_k(n)}.
  Implementation ==> add
+
   import IntegerPrimesPackage(I)
 
   -- we store the euler and bernoulli numbers computed so far in
@@ -61758,6 +84343,175 @@ IntegerNumberTheoryFunctions(): Exports == Implementation where
 \begin{chunk}{COQ INTHEORY}
 (* package INTHEORY *)
 (*
+
+  import IntegerPrimesPackage(I)
+
+  -- we store the euler and bernoulli numbers computed so far in
+  -- a Vector because they are computed from an n-term recurrence
+  E: IndexedFlexibleArray(I,0)   := new(1, 1)
+  B: IndexedFlexibleArray(RN,0)  := new(1, 1)
+  H: Record(Hn:I,Hv:RN) := [1, 1]
+
+  harmonic n ==
+    s:I; h:RN
+    n < 0 => error("harmonic not defined for negative integers")
+    if n >= H.Hn then (s,h) := H else (s := 0; h := 0)
+    for k in s+1..n repeat h := h + 1/k
+    H.Hn := n
+    H.Hv := h
+    h
+
+  fibonacci n ==
+    n = 0 => 0
+    n < 0 => (odd? n => 1; -1) * fibonacci(-n)
+    f1, f2 : I
+    (f1,f2) := (0,1)
+    for k in length(n)-2 .. 0 by -1 repeat
+      t := f2**2
+      (f1,f2) := (t+f1**2,t+2*f1*f2)
+      if bit?(n,k) then (f1,f2) := (f2,f1+f2)
+    f2
+
+  euler n ==
+    n < 0 => error "euler not defined for negative integers"
+    odd? n => 0
+    l := (#E) :: I
+    n < l => E(n)
+    concat_!(E, new((n+1-l)::NNI, 0)$IndexedFlexibleArray(I,0))
+    for i in 1 .. l by 2 repeat E(i) := 0
+    -- compute E(i) i = l+2,l+4,...,n given E(j) j = 0,2,...,i-2
+    t,e : I
+    for i in l+1 .. n by 2 repeat
+      t := e := 1
+      for j in 2 .. i-2 by 2 repeat
+        t := (t*(i-j+1)*(i-j+2)) quo (j*(j-1))
+        e := e + t*E(j)
+      E(i) := -e
+    E(n)
+
+  bernoulli n ==
+    n < 0 => error "bernoulli not defined for negative integers"
+    odd? n =>
+      n = 1 => -1/2
+      0
+    l := (#B) :: I
+    n < l => B(n)
+    concat_!(B, new((n+1-l)::NNI, 0)$IndexedFlexibleArray(RN,0))
+    -- compute B(i) i = l+2,l+4,...,n given B(j) j = 0,2,...,i-2
+    for i in l+1 .. n by 2 repeat
+      t:I := 1
+      b := (1-i)/2
+      for j in 2 .. i-2 by 2 repeat
+        t := (t*(i-j+2)*(i-j+3)) quo (j*(j-1))
+        b := b + (t::RN) * B(j)
+      B(i) := -b/((i+1)::RN)
+    B(n)
+
+  inverse : (I,I) -> I
+
+  inverse(a,b) ==
+    borg:I:=b
+    c1:I := 1
+    d1:I := 0
+    while b ^= 0 repeat
+      q:I := a quo b
+      r:I := a-q*b
+      (a,b):=(b,r)
+      (c1,d1):=(d1,c1-q*d1)
+    a ^= 1 => error("moduli are not relatively prime")
+    positiveRemainder(c1,borg)
+
+  chineseRemainder(x1,m1,x2,m2) ==
+    m1 < 0 or m2 < 0 => error "moduli must be positive"
+    x1 := positiveRemainder(x1,m1)
+    x2 := positiveRemainder(x2,m2)
+    x1 + m1 * positiveRemainder(((x2-x1) * inverse(m1,m2)),m2)
+
+  jacobi(a,b) ==
+    -- Revised by Clifton Williamson January 1989.
+    -- Previous version returned incorrect answers when b was even.
+    -- The formula J(a/b) = product ( L(a/p) for p in factor b) is only
+    -- valid when b is odd (the Legendre symbol L(a/p) is not defined
+    -- for p = 2).  When b is even, the Jacobi symbol J(a/b) is only
+    -- defined for a = 0 or 1 (mod 4).  When a = 1 (mod 8),
+    -- J(a/2) = +1 and when a = 5 (mod 8), we define J(a/2) = -1.
+    -- Extending by multiplicativity, we have J(a/b) for even b and
+    -- appropriate a.
+    -- We also define J(a/1) = 1.
+    -- The point of this is the following: if d is the discriminant of
+    -- a quadratic field K and chi is the quadratic character for K,
+    -- then J(d/n) = chi(n) for n > 0.
+    -- Reference: Hecke, Vorlesungen ueber die Theorie der Algebraischen
+    -- Zahlen.
+    if b < 0 then b := -b
+    b = 0 => error "second argument of jacobi may not be 0"
+    b = 1 => 1
+    even? b and positiveRemainder(a,4) > 1 =>
+      error "J(a/b) not defined for b even and a = 2 or 3 (mod 4)"
+    even? b and even? a => 0
+    for k in 0.. while even? b repeat b := b quo 2
+    j:I := (odd? k and positiveRemainder(a,8) = 5 => -1; 1)
+    b = 1 => j
+    a := positiveRemainder(a,b)
+    -- assertion: 0 < a < b and odd? b
+    while a > 1 repeat
+      if odd? a then
+        -- J(a/b) = J(b/a) (-1) ** (a-1)/2 (b-1)/2
+        if a rem 4 = 3 and b rem 4 = 3 then j := -j
+        (a,b) := (b rem a,a)
+      else
+        -- J(2*a/b) = J(a/b) (-1) (b**2-1)/8
+        for k in 0.. until odd? a repeat a := a quo 2
+        if odd? k and (b+2) rem 8 > 4 then j := -j
+    a = 0 => 0
+    j
+
+  legendre(a,p) ==
+    prime? p => jacobi(a,p)
+    error "characteristic of legendre must be prime"
+
+  eulerPhi n ==
+    n = 0 => 0
+    r : RN := 1
+    for entry in factors factor n repeat
+      r := ((entry.factor - 1) /$RN entry.factor) * r
+    numer(n * r)
+
+  divisors n ==
+    oldList : List Integer := [1]
+    for f in factors factor n repeat
+      newList : List Integer := oldList
+      for k in 1..f.exponent repeat
+        pow := f.factor ** k
+        for m in oldList repeat
+          newList := concat(pow * m,newList)
+      oldList := newList
+    sort((i1:Integer,i2:Integer):Boolean +-> i1 < i2,oldList)
+
+  numberOfDivisors n ==
+    n = 0 => 0
+    */[1+entry.exponent for entry in factors factor n]
+
+  sumOfDivisors n ==
+    n = 0 => 0
+    r : RN := */[(entry.factor**(entry.exponent::NNI + 1)-1)/
+      (entry.factor-1) for entry in factors factor n]
+    numer r
+
+  sumOfKthPowerDivisors(n,k) ==
+    n = 0 => 0
+    r : RN := */[(entry.factor**(k*entry.exponent::NNI+k)-1)/
+      (entry.factor**k-1) for entry in factors factor n]
+    numer r
+
+  moebiusMu n ==
+    n = 1 => 1
+    t := factor n
+    for k in factors t repeat
+      k.exponent > 1 => return 0
+    odd? numberOfFactors t => -1
+    1
+
 *)
 
 \end{chunk}
@@ -61873,6 +84627,7 @@ There is a constant in the function squareFree from IntegerFactorizationPackage
 that is the square of the upper bound of the table range, in this case
 10000000. 
 \begin{chunk}{package PRIMES IntegerPrimesPackage}
+
    smallPrimes: List I := 
      [2::I, 3::I, 5::I, 7::I, 11::I, 13::I, 17::I, 19::I,_
       23::I, 29::I, 31::I, 37::I, 41::I, 43::I, 47::I, 53::I,_
@@ -62102,6 +84857,7 @@ that is the square of the upper bound of the table range, in this case
 \end{chunk}
 \subsection{primes}
 \begin{chunk}{package PRIMES IntegerPrimesPackage}
+
    primes(m, n) ==
       -- computes primes from m to n inclusive using prime?
       l:List(I) :=
@@ -62120,6 +84876,7 @@ that is the square of the upper bound of the table range, in this case
 \end{chunk}
 \subsection{rabinProvesCompositeSmall}
 \begin{chunk}{package PRIMES IntegerPrimesPackage}
+
    rabinProvesCompositeSmall(p,n,nm1,q,k) ==
          -- probability n prime is > 3/4 for each iteration
          -- for most n this probability is much greater than 3/4
@@ -62139,6 +84896,7 @@ that is the square of the upper bound of the table range, in this case
 \end{chunk}
 \subsection{rabinProvesComposite}
 \begin{chunk}{package PRIMES IntegerPrimesPackage}
+
    rabinProvesComposite(p,n,nm1,q,k) ==
          -- probability n prime is > 3/4 for each iteration
          -- for most n this probability is much greater than 3/4
@@ -62162,6 +84920,7 @@ that is the square of the upper bound of the table range, in this case
 \end{chunk}
 \subsection{prime?}
 \begin{chunk}{package PRIMES IntegerPrimesPackage}
+
    prime? n ==
       n < two => false
       n < nextSmallPrime => member?(n, smallPrimes)
@@ -62219,6 +84978,7 @@ that is the square of the upper bound of the table range, in this case
 \end{chunk}
 \subsection{nextPrime}
 \begin{chunk}{package PRIMES IntegerPrimesPackage}
+
    nextPrime n ==
       -- computes the first prime after n
       n < two => two
@@ -62229,6 +84989,7 @@ that is the square of the upper bound of the table range, in this case
 \end{chunk}
 \subsection{prevPrime}
 \begin{chunk}{package PRIMES IntegerPrimesPackage}
+
    prevPrime n ==
       -- computes the first prime before n
       n < 3::I => error "no primes less than 2"
@@ -62242,6 +85003,357 @@ that is the square of the upper bound of the table range, in this case
 \begin{chunk}{COQ PRIMES}
 (* package PRIMES *)
 (*
+
+   smallPrimes: List I := 
+     [2::I, 3::I, 5::I, 7::I, 11::I, 13::I, 17::I, 19::I,_
+      23::I, 29::I, 31::I, 37::I, 41::I, 43::I, 47::I, 53::I,_
+      59::I, 61::I, 67::I, 71::I, 73::I, 79::I, 83::I, 89::I,_
+      97::I, 101::I, 103::I, 107::I, 109::I, 113::I, 127::I,_
+      131::I, 137::I, 139::I, 149::I, 151::I, 157::I, 163::I,_
+      167::I, 173::I, 179::I, 181::I, 191::I, 193::I, 197::I,_
+      199::I, 211::I, 223::I, 227::I, 229::I, 233::I, 239::I,_
+      241::I, 251::I, 257::I, 263::I, 269::I, 271::I, 277::I,_
+      281::I, 283::I, 293::I, 307::I, 311::I, 313::I, 317::I,_
+      331::I, 337::I, 347::I, 349::I, 353::I, 359::I, 367::I,_
+      373::I, 379::I, 383::I, 389::I, 397::I, 401::I, 409::I,_
+      419::I, 421::I, 431::I, 433::I, 439::I, 443::I, 449::I,_
+      457::I, 461::I, 463::I, 467::I, 479::I, 487::I, 491::I,_
+      499::I, 503::I, 509::I, 521::I, 523::I, 541::I, 547::I,_
+      557::I, 563::I, 569::I, 571::I, 577::I, 587::I, 593::I,_
+      599::I, 601::I, 607::I, 613::I, 617::I, 619::I, 631::I,_
+      641::I, 643::I, 647::I, 653::I, 659::I, 661::I, 673::I,_
+      677::I, 683::I, 691::I, 701::I, 709::I, 719::I, 727::I,_
+      733::I, 739::I, 743::I, 751::I, 757::I, 761::I, 769::I,_
+      773::I, 787::I, 797::I, 809::I, 811::I, 821::I, 823::I,_
+      827::I, 829::I, 839::I, 853::I, 857::I, 859::I, 863::I,_
+      877::I, 881::I, 883::I, 887::I, 907::I, 911::I, 919::I,_
+      929::I, 937::I, 941::I, 947::I, 953::I, 967::I, 971::I,_
+      977::I, 983::I, 991::I, 997::I, 1009::I, 1013::I,_
+      1019::I, 1021::I, 1031::I, 1033::I, 1039::I, 1049::I,_
+      1051::I, 1061::I, 1063::I, 1069::I, 1087::I, 1091::I,_
+      1093::I, 1097::I, 1103::I, 1109::I, 1117::I, 1123::I,_
+      1129::I, 1151::I, 1153::I, 1163::I, 1171::I, 1181::I,_
+      1187::I, 1193::I, 1201::I, 1213::I, 1217::I, 1223::I,_
+      1229::I, 1231::I, 1237::I, 1249::I, 1259::I, 1277::I,_
+      1279::I, 1283::I, 1289::I, 1291::I, 1297::I, 1301::I,_
+      1303::I, 1307::I, 1319::I, 1321::I, 1327::I, 1361::I,_
+      1367::I, 1373::I, 1381::I, 1399::I, 1409::I, 1423::I,_
+      1427::I, 1429::I, 1433::I, 1439::I, 1447::I, 1451::I,_
+      1453::I, 1459::I, 1471::I, 1481::I, 1483::I, 1487::I,_
+      1489::I, 1493::I, 1499::I, 1511::I, 1523::I, 1531::I,_
+      1543::I, 1549::I, 1553::I, 1559::I, 1567::I, 1571::I,_
+      1579::I, 1583::I, 1597::I, 1601::I, 1607::I, 1609::I,_
+      1613::I, 1619::I, 1621::I, 1627::I, 1637::I, 1657::I,_
+      1663::I, 1667::I, 1669::I, 1693::I, 1697::I, 1699::I,_
+      1709::I, 1721::I, 1723::I, 1733::I, 1741::I, 1747::I,_
+      1753::I, 1759::I, 1777::I, 1783::I, 1787::I, 1789::I,_
+      1801::I, 1811::I, 1823::I, 1831::I, 1847::I, 1861::I,_
+      1867::I, 1871::I, 1873::I, 1877::I, 1879::I, 1889::I,_
+      1901::I, 1907::I, 1913::I, 1931::I, 1933::I, 1949::I,_
+      1951::I, 1973::I, 1979::I, 1987::I, 1993::I, 1997::I,_
+      1999::I, 2003::I, 2011::I, 2017::I, 2027::I, 2029::I,_
+      2039::I, 2053::I, 2063::I, 2069::I, 2081::I, 2083::I,_
+      2087::I, 2089::I, 2099::I, 2111::I, 2113::I, 2129::I,_
+      2131::I, 2137::I, 2141::I, 2143::I, 2153::I, 2161::I,_
+      2179::I, 2203::I, 2207::I, 2213::I, 2221::I, 2237::I,_
+      2239::I, 2243::I, 2251::I, 2267::I, 2269::I, 2273::I,_
+      2281::I, 2287::I, 2293::I, 2297::I, 2309::I, 2311::I,_
+      2333::I, 2339::I, 2341::I, 2347::I, 2351::I, 2357::I,_
+      2371::I, 2377::I, 2381::I, 2383::I, 2389::I, 2393::I,_
+      2399::I, 2411::I, 2417::I, 2423::I, 2437::I, 2441::I,_
+      2447::I, 2459::I, 2467::I, 2473::I, 2477::I, 2503::I,_
+      2521::I, 2531::I, 2539::I, 2543::I, 2549::I, 2551::I,_
+      2557::I, 2579::I, 2591::I, 2593::I, 2609::I, 2617::I,_
+      2621::I, 2633::I, 2647::I, 2657::I, 2659::I, 2663::I,_
+      2671::I, 2677::I, 2683::I, 2687::I, 2689::I, 2693::I,_
+      2699::I, 2707::I, 2711::I, 2713::I, 2719::I, 2729::I,_
+      2731::I, 2741::I, 2749::I, 2753::I, 2767::I, 2777::I,_
+      2789::I, 2791::I, 2797::I, 2801::I, 2803::I, 2819::I,_
+      2833::I, 2837::I, 2843::I, 2851::I, 2857::I, 2861::I,_
+      2879::I, 2887::I, 2897::I, 2903::I, 2909::I, 2917::I,_
+      2927::I, 2939::I, 2953::I, 2957::I, 2963::I, 2969::I,_
+      2971::I, 2999::I, 3001::I, 3011::I, 3019::I, 3023::I,_
+      3037::I, 3041::I, 3049::I, 3061::I, 3067::I, 3079::I,_
+      3083::I, 3089::I, 3109::I, 3119::I, 3121::I, 3137::I,_
+      3163::I, 3167::I, 3169::I, 3181::I, 3187::I, 3191::I,_
+      3203::I, 3209::I, 3217::I, 3221::I, 3229::I, 3251::I,_
+      3253::I, 3257::I, 3259::I, 3271::I, 3299::I, 3301::I,_
+      3307::I, 3313::I, 3319::I, 3323::I, 3329::I, 3331::I,_
+      3343::I, 3347::I, 3359::I, 3361::I, 3371::I, 3373::I,_
+      3389::I, 3391::I, 3407::I, 3413::I, 3433::I, 3449::I,_
+      3457::I, 3461::I, 3463::I, 3467::I, 3469::I, 3491::I,_
+      3499::I, 3511::I, 3517::I, 3527::I, 3529::I, 3533::I,_
+      3539::I, 3541::I, 3547::I, 3557::I, 3559::I, 3571::I,_
+      3581::I, 3583::I, 3593::I, 3607::I, 3613::I, 3617::I,_
+      3623::I, 3631::I, 3637::I, 3643::I, 3659::I, 3671::I,_
+      3673::I, 3677::I, 3691::I, 3697::I, 3701::I, 3709::I,_
+      3719::I, 3727::I, 3733::I, 3739::I, 3761::I, 3767::I,_
+      3769::I, 3779::I, 3793::I, 3797::I, 3803::I, 3821::I,_
+      3823::I, 3833::I, 3847::I, 3851::I, 3853::I, 3863::I,_
+      3877::I, 3881::I, 3889::I, 3907::I, 3911::I, 3917::I,_
+      3919::I, 3923::I, 3929::I, 3931::I, 3943::I, 3947::I,_
+      3967::I, 3989::I, 4001::I, 4003::I, 4007::I, 4013::I,_
+      4019::I, 4021::I, 4027::I, 4049::I, 4051::I, 4057::I,_
+      4073::I, 4079::I, 4091::I, 4093::I, 4099::I, 4111::I,_
+      4127::I, 4129::I, 4133::I, 4139::I, 4153::I, 4157::I,_
+      4159::I, 4177::I, 4201::I, 4211::I, 4217::I, 4219::I,_
+      4229::I, 4231::I, 4241::I, 4243::I, 4253::I, 4259::I,_
+      4261::I, 4271::I, 4273::I, 4283::I, 4289::I, 4297::I,_
+      4327::I, 4337::I, 4339::I, 4349::I, 4357::I, 4363::I,_
+      4373::I, 4391::I, 4397::I, 4409::I, 4421::I, 4423::I,_
+      4441::I, 4447::I, 4451::I, 4457::I, 4463::I, 4481::I,_
+      4483::I, 4493::I, 4507::I, 4513::I, 4517::I, 4519::I,_
+      4523::I, 4547::I, 4549::I, 4561::I, 4567::I, 4583::I,_
+      4591::I, 4597::I, 4603::I, 4621::I, 4637::I, 4639::I,_
+      4643::I, 4649::I, 4651::I, 4657::I, 4663::I, 4673::I,_
+      4679::I, 4691::I, 4703::I, 4721::I, 4723::I, 4729::I,_
+      4733::I, 4751::I, 4759::I, 4783::I, 4787::I, 4789::I,_
+      4793::I, 4799::I, 4801::I, 4813::I, 4817::I, 4831::I,_
+      4861::I, 4871::I, 4877::I, 4889::I, 4903::I, 4909::I,_
+      4919::I, 4931::I, 4933::I, 4937::I, 4943::I, 4951::I,_
+      4957::I, 4967::I, 4969::I, 4973::I, 4987::I, 4993::I,_
+      4999::I, 5003::I, 5009::I, 5011::I, 5021::I, 5023::I,_
+      5039::I, 5051::I, 5059::I, 5077::I, 5081::I, 5087::I,_
+      5099::I, 5101::I, 5107::I, 5113::I, 5119::I, 5147::I,_
+      5153::I, 5167::I, 5171::I, 5179::I, 5189::I, 5197::I,_
+      5209::I, 5227::I, 5231::I, 5233::I, 5237::I, 5261::I,_
+      5273::I, 5279::I, 5281::I, 5297::I, 5303::I, 5309::I,_
+      5323::I, 5333::I, 5347::I, 5351::I, 5381::I, 5387::I,_
+      5393::I, 5399::I, 5407::I, 5413::I, 5417::I, 5419::I,_
+      5431::I, 5437::I, 5441::I, 5443::I, 5449::I, 5471::I,_
+      5477::I, 5479::I, 5483::I, 5501::I, 5503::I, 5507::I,_
+      5519::I, 5521::I, 5527::I, 5531::I, 5557::I, 5563::I,_
+      5569::I, 5573::I, 5581::I, 5591::I, 5623::I, 5639::I,_
+      5641::I, 5647::I, 5651::I, 5653::I, 5657::I, 5659::I,_
+      5669::I, 5683::I, 5689::I, 5693::I, 5701::I, 5711::I,_
+      5717::I, 5737::I, 5741::I, 5743::I, 5749::I, 5779::I,_
+      5783::I, 5791::I, 5801::I, 5807::I, 5813::I, 5821::I,_
+      5827::I, 5839::I, 5843::I, 5849::I, 5851::I, 5857::I,_
+      5861::I, 5867::I, 5869::I, 5879::I, 5881::I, 5897::I,_
+      5903::I, 5923::I, 5927::I, 5939::I, 5953::I, 5981::I,_
+      5987::I, 6007::I, 6011::I, 6029::I, 6037::I, 6043::I,_
+      6047::I, 6053::I, 6067::I, 6073::I, 6079::I, 6089::I,_
+      6091::I, 6101::I, 6113::I, 6121::I, 6131::I, 6133::I,_
+      6143::I, 6151::I, 6163::I, 6173::I, 6197::I, 6199::I,_
+      6203::I, 6211::I, 6217::I, 6221::I, 6229::I, 6247::I,_
+      6257::I, 6263::I, 6269::I, 6271::I, 6277::I, 6287::I,_
+      6299::I, 6301::I, 6311::I, 6317::I, 6323::I, 6329::I,_
+      6337::I, 6343::I, 6353::I, 6359::I, 6361::I, 6367::I,_
+      6373::I, 6379::I, 6389::I, 6397::I, 6421::I, 6427::I,_
+      6449::I, 6451::I, 6469::I, 6473::I, 6481::I, 6491::I,_
+      6521::I, 6529::I, 6547::I, 6551::I, 6553::I, 6563::I,_
+      6569::I, 6571::I, 6577::I, 6581::I, 6599::I, 6607::I,_
+      6619::I, 6637::I, 6653::I, 6659::I, 6661::I, 6673::I,_
+      6679::I, 6689::I, 6691::I, 6701::I, 6703::I, 6709::I,_
+      6719::I, 6733::I, 6737::I, 6761::I, 6763::I, 6779::I,_
+      6781::I, 6791::I, 6793::I, 6803::I, 6823::I, 6827::I,_
+      6829::I, 6833::I, 6841::I, 6857::I, 6863::I, 6869::I,_
+      6871::I, 6883::I, 6899::I, 6907::I, 6911::I, 6917::I,_
+      6947::I, 6949::I, 6959::I, 6961::I, 6967::I, 6971::I,_
+      6977::I, 6983::I, 6991::I, 6997::I, 7001::I, 7013::I,_
+      7019::I, 7027::I, 7039::I, 7043::I, 7057::I, 7069::I,_
+      7079::I, 7103::I, 7109::I, 7121::I, 7127::I, 7129::I,_
+      7151::I, 7159::I, 7177::I, 7187::I, 7193::I, 7207::I,_
+      7211::I, 7213::I, 7219::I, 7229::I, 7237::I, 7243::I,_
+      7247::I, 7253::I, 7283::I, 7297::I, 7307::I, 7309::I,_
+      7321::I, 7331::I, 7333::I, 7349::I, 7351::I, 7369::I,_
+      7393::I, 7411::I, 7417::I, 7433::I, 7451::I, 7457::I,_
+      7459::I, 7477::I, 7481::I, 7487::I, 7489::I, 7499::I,_
+      7507::I, 7517::I, 7523::I, 7529::I, 7537::I, 7541::I,_
+      7547::I, 7549::I, 7559::I, 7561::I, 7573::I, 7577::I,_
+      7583::I, 7589::I, 7591::I, 7603::I, 7607::I, 7621::I,_
+      7639::I, 7643::I, 7649::I, 7669::I, 7673::I, 7681::I,_
+      7687::I, 7691::I, 7699::I, 7703::I, 7717::I, 7723::I,_
+      7727::I, 7741::I, 7753::I, 7757::I, 7759::I, 7789::I,_
+      7793::I, 7817::I, 7823::I, 7829::I, 7841::I, 7853::I,_
+      7867::I, 7873::I, 7877::I, 7879::I, 7883::I, 7901::I,_
+      7907::I, 7919::I, 7927::I, 7933::I, 7937::I, 7949::I,_
+      7951::I, 7963::I, 7993::I, 8009::I, 8011::I, 8017::I,_
+      8039::I, 8053::I, 8059::I, 8069::I, 8081::I, 8087::I,_
+      8089::I, 8093::I, 8101::I, 8111::I, 8117::I, 8123::I,_
+      8147::I, 8161::I, 8167::I, 8171::I, 8179::I, 8191::I,_
+      8209::I, 8219::I, 8221::I, 8231::I, 8233::I, 8237::I,_
+      8243::I, 8263::I, 8269::I, 8273::I, 8287::I, 8291::I,_
+      8293::I, 8297::I, 8311::I, 8317::I, 8329::I, 8353::I,_
+      8363::I, 8369::I, 8377::I, 8387::I, 8389::I, 8419::I,_
+      8423::I, 8429::I, 8431::I, 8443::I, 8447::I, 8461::I,_
+      8467::I, 8501::I, 8513::I, 8521::I, 8527::I, 8537::I,_
+      8539::I, 8543::I, 8563::I, 8573::I, 8581::I, 8597::I,_
+      8599::I, 8609::I, 8623::I, 8627::I, 8629::I, 8641::I,_
+      8647::I, 8663::I, 8669::I, 8677::I, 8681::I, 8689::I,_
+      8693::I, 8699::I, 8707::I, 8713::I, 8719::I, 8731::I,_
+      8737::I, 8741::I, 8747::I, 8753::I, 8761::I, 8779::I,_
+      8783::I, 8803::I, 8807::I, 8819::I, 8821::I, 8831::I,_
+      8837::I, 8839::I, 8849::I, 8861::I, 8863::I, 8867::I,_
+      8887::I, 8893::I, 8923::I, 8929::I, 8933::I, 8941::I,_
+      8951::I, 8963::I, 8969::I, 8971::I, 8999::I, 9001::I,_
+      9007::I, 9011::I, 9013::I, 9029::I, 9041::I, 9043::I,_
+      9049::I, 9059::I, 9067::I, 9091::I, 9103::I, 9109::I,_
+      9127::I, 9133::I, 9137::I, 9151::I, 9157::I, 9161::I,_
+      9173::I, 9181::I, 9187::I, 9199::I, 9203::I, 9209::I,_
+      9221::I, 9227::I, 9239::I, 9241::I, 9257::I, 9277::I,_
+      9281::I, 9283::I, 9293::I, 9311::I, 9319::I, 9323::I,_
+      9337::I, 9341::I, 9343::I, 9349::I, 9371::I, 9377::I,_
+      9391::I, 9397::I, 9403::I, 9413::I, 9419::I, 9421::I,_
+      9431::I, 9433::I, 9437::I, 9439::I, 9461::I, 9463::I,_
+      9467::I, 9473::I, 9479::I, 9491::I, 9497::I, 9511::I,_
+      9521::I, 9533::I, 9539::I, 9547::I, 9551::I, 9587::I,_
+      9601::I, 9613::I, 9619::I, 9623::I, 9629::I, 9631::I,_
+      9643::I, 9649::I, 9661::I, 9677::I, 9679::I, 9689::I,_
+      9697::I, 9719::I, 9721::I, 9733::I, 9739::I, 9743::I,_
+      9749::I, 9767::I, 9769::I, 9781::I, 9787::I, 9791::I,_
+      9803::I, 9811::I, 9817::I, 9829::I, 9833::I, 9839::I,_
+      9851::I, 9857::I, 9859::I, 9871::I, 9883::I, 9887::I,_
+      9901::I, 9907::I, 9923::I, 9929::I, 9931::I, 9941::I,_
+      9949::I, 9967::I, 9973::I]
+
+   productSmallPrimes    := */smallPrimes
+   nextSmallPrime        := 10007::I
+   nextSmallPrimeSquared := nextSmallPrime**2
+   two                   := 2::I
+   tenPowerTwenty:=(10::I)**20
+   PomeranceList:= [25326001::I, 161304001::I, 960946321::I, 1157839381::I,
+                     -- 3215031751::I, -- has a factor of 151
+                     3697278427::I, 5764643587::I, 6770862367::I,
+                      14386156093::I, 15579919981::I, 18459366157::I,
+                       19887974881::I, 21276028621::I ]::(List I)
+   PomeranceLimit:=27716349961::I  -- replaces (25*10**9) due to Pinch
+   PinchList:= _
+     [3215031751::I, 118670087467::I, 128282461501::I, 354864744877::I,
+      546348519181::I, 602248359169::I, 669094855201::I ]
+   PinchLimit:= (10**12)::I
+   PinchList2:= [2152302898747::I, 3474749660383::I]
+   PinchLimit2:= (10**13)::I
+   JaeschkeLimit:=341550071728321::I
+   rootsMinus1:Set I := empty()
+   -- used to check whether we detect too many roots of -1
+   count2Order:Vector NonNegativeInteger := new(1,0)
+   -- used to check whether we observe an element of maximal two-order
+
+
+   primes(m, n) ==
+      -- computes primes from m to n inclusive using prime?
+      l:List(I) :=
+        m <= two => [two]
+        empty()
+      n < two or n < m => empty()
+      if even? m then m := m + 1
+      ll:List(I) := [k::I for k in
+             convert(m)@Integer..convert(n)@Integer by 2 | prime?(k::I)]
+      reverse_! concat_!(ll, l)
+
+   rabinProvesComposite : (I,I,I,I,NonNegativeInteger) -> Boolean
+   rabinProvesCompositeSmall : (I,I,I,I,NonNegativeInteger) -> Boolean
+
+   rabinProvesCompositeSmall(p,n,nm1,q,k) ==
+         -- probability n prime is > 3/4 for each iteration
+         -- for most n this probability is much greater than 3/4
+         t := powmod(p, q, n)
+         -- neither of these cases tells us anything
+         if not ((t = 1) or t = nm1) then
+            for j in 1..k-1 repeat
+               oldt := t
+               t := mulmod(t, t, n)
+               (t = 1) => return true
+               -- we have squared someting not -1 and got 1
+               t = nm1 =>
+                   leave
+            not (t = nm1) => return true
+         false
+
+
+   rabinProvesComposite(p,n,nm1,q,k) ==
+         -- probability n prime is > 3/4 for each iteration
+         -- for most n this probability is much greater than 3/4
+         t := powmod(p, q, n)
+         -- neither of these cases tells us anything
+         if t=nm1 then count2Order(1):=count2Order(1)+1
+         if not ((t = 1) or t = nm1) then
+            for j in 1..k-1 repeat
+               oldt := t
+               t := mulmod(t, t, n)
+               (t = 1) => return true
+               -- we have squared someting not -1 and got 1
+               t = nm1 =>
+                   rootsMinus1:=union(rootsMinus1,oldt)
+                   count2Order(j+1):=count2Order(j+1)+1
+                   leave
+            not (t = nm1) => return true
+         # rootsMinus1 > 2 => true  -- Z/nZ can't be a field
+         false
+
+
+   prime? n ==
+      n < two => false
+      n < nextSmallPrime => member?(n, smallPrimes)
+      not (gcd(n, productSmallPrimes) = 1) => false
+      n < nextSmallPrimeSquared => true
+
+      nm1 := n-1
+      q := (nm1) quo two
+      for k in 1.. while not odd? q repeat q := q quo two
+      -- q = (n-1) quo 2**k for largest possible k
+
+      n < JaeschkeLimit =>
+          rabinProvesCompositeSmall(2::I,n,nm1,q,k) => return false
+          rabinProvesCompositeSmall(3::I,n,nm1,q,k) => return false
+
+          n < PomeranceLimit =>
+              rabinProvesCompositeSmall(5::I,n,nm1,q,k) => return false
+              member?(n,PomeranceList) => return false
+              true
+
+          rabinProvesCompositeSmall(7::I,n,nm1,q,k) => return false
+          n < PinchLimit =>
+              rabinProvesCompositeSmall(10::I,n,nm1,q,k) => return false
+              member?(n,PinchList) => return false
+              true
+
+          rabinProvesCompositeSmall(5::I,n,nm1,q,k) => return false
+          rabinProvesCompositeSmall(11::I,n,nm1,q,k) => return false
+          n < PinchLimit2 =>
+              member?(n,PinchList2) => return false
+              true
+
+          rabinProvesCompositeSmall(13::I,n,nm1,q,k) => return false
+          rabinProvesCompositeSmall(17::I,n,nm1,q,k) => return false
+          true
+
+      rootsMinus1:= empty()
+      count2Order := new(k,0) -- vector of k zeroes
+
+      mn := minIndex smallPrimes
+      for i in mn+1..mn+10 repeat
+          rabinProvesComposite(smallPrimes i,n,nm1,q,k) => return false
+      import IntegerRoots(I)
+      q > 1 and perfectSquare?(3*n+1) => false
+      ((n9:=n rem (9::I))=1 or n9 = -1) and perfectSquare?(8*n+1) => false
+      -- Both previous tests from Damgard & Landrock
+      currPrime:=smallPrimes(mn+10)
+      probablySafe:=tenPowerTwenty
+      while count2Order(k) = 0 or n > probablySafe repeat
+          currPrime := nextPrime currPrime
+          probablySafe:=probablySafe*(100::I)
+          rabinProvesComposite(currPrime,n,nm1,q,k) => return false
+      true
+
+
+   nextPrime n ==
+      -- computes the first prime after n
+      n < two => two
+      if odd? n then n := n + two else n := n + 1
+      while not prime? n repeat n := n + two
+      n
+
+
+   prevPrime n ==
+      -- computes the first prime before n
+      n < 3::I => error "no primes less than 2"
+      n = 3::I => two
+      if odd? n then n := n - two else n := n - 1
+      while not prime? n repeat n := n - two
+      n
+
 *)
 
 \end{chunk}
@@ -62318,8 +85430,11 @@ IntegerRetractions(S:RetractableTo(Integer)): with
       ++ integerIfCan(x) returns x as an integer,
       ++ "failed" if x is not an integer;
   == add
+
     integer s      == retract s
+
     integer? s     == retractIfCan(s) case Integer
+
     integerIfCan s == retractIfCan s
 
 \end{chunk}
@@ -62327,6 +85442,13 @@ IntegerRetractions(S:RetractableTo(Integer)): with
 \begin{chunk}{COQ INTRET}
 (* package INTRET *)
 (*
+
+    integer s      == retract s
+
+    integer? s     == retractIfCan(s) case Integer
+
+    integerIfCan s == retractIfCan s
+
 *)
 
 \end{chunk}
@@ -62432,6 +85554,7 @@ IntegerRoots(I:IntegerNumberSystem): Exports == Implementation where
       ++ The running time is \spad{O( log(n)**2 )}.
 
   Implementation ==> add
+
     import IntegerPrimesPackage(I)
 
     resMod144: List I := [0::I,1::I,4::I,9::I,16::I,25::I,36::I,49::I,_
@@ -62525,6 +85648,74 @@ IntegerRoots(I:IntegerNumberSystem): Exports == Implementation where
 \begin{chunk}{COQ IROOT}
 (* package IROOT *)
 (*
+
+    import IntegerPrimesPackage(I)
+
+    resMod144: List I := [0::I,1::I,4::I,9::I,16::I,25::I,36::I,49::I,_
+                     52::I,64::I,73::I,81::I,97::I,100::I,112::I,121::I]
+    two := 2::I
+
+    perfectSquare? a       == (perfectSqrt a) case I
+
+    perfectNthPower?(b, n) == perfectNthRoot(b, n) case I
+
+    perfectNthRoot n ==  -- complexity (log log n)**2 (log n)**2
+      m:NNI
+      (n = 1) or zero? n or n = -1 => [n, 1]
+      e:NNI := 1
+      p:NNI := 2
+      while p::I <= length(n) + 1 repeat
+         for m in 0.. while (r := perfectNthRoot(n, p)) case I repeat
+            n := r::I
+         e := e * p ** m
+         p := convert(nextPrime(p::I))@Integer :: NNI
+      [n, e]
+
+    approxNthRoot(a, n) ==   -- complexity (log log n) (log n)**2
+      zero? n => error "invalid arguments"
+      (n = 1) => a
+      n=2 => approxSqrt a
+      negative? a =>
+        odd? n => - approxNthRoot(-a, n)
+        0
+      zero? a => 0
+      (a = 1) => 1
+      -- quick check for case of large n
+      ((3*n) quo 2)::I >= (l := length a) => two
+      -- the initial approximation must be >= the root
+      y := max(two, shift(1, (n::I+l-1) quo (n::I)))
+      z:I := 1
+      n1:= (n-1)::NNI
+      while z > 0 repeat
+        x := y
+        xn:= x**n1
+        y := (n1*x*xn+a) quo (n*xn)
+        z := x-y
+      x
+
+    perfectNthRoot(b, n) ==
+      (r := approxNthRoot(b, n)) ** n = b => r
+      "failed"
+
+    perfectSqrt a ==
+      a < 0 or not member?(a rem (144::I), resMod144) => "failed"
+      (s := approxSqrt a) * s = a => s
+      "failed"
+
+    approxSqrt a ==
+      a < 1 => 0
+      if (n := length a) > (100::I) then
+         -- variable precision newton iteration
+         n := n quo (4::I)
+         s := approxSqrt shift(a, -2 * n)
+         s := shift(s, n)
+         return ((1 + s + a quo s) quo two)
+      -- initial approximation for the root is within a factor of 2
+      (new, old) := (shift(1, n quo two), 1)
+      while new ^= old repeat
+         (new, old) := ((1 + new + a quo new) quo two, new)
+      new
+
 *)
 
 \end{chunk}
@@ -62601,9 +85792,13 @@ IntegerSolveLinearPolynomialEquation(): C ==T
            ++ \spad{g/prod fi = sum ai/fi}
            ++ or returns "failed" if no such list of ai's exists.
   T == add
+
       oldlp:List ZP := []
+
       slpePrime:Integer:=(2::Integer)
+
       oldtable:Vector List ZP := empty()
+
       solveLinearPolynomialEquation(lp,p) ==
          if (oldlp ^= lp) then
             -- we have to generate a new table
@@ -62625,6 +85820,29 @@ IntegerSolveLinearPolynomialEquation(): C ==T
 \begin{chunk}{COQ INTSLPE}
 (* package INTSLPE *)
 (*
+
+      oldlp:List ZP := []
+
+      slpePrime:Integer:=(2::Integer)
+
+      oldtable:Vector List ZP := empty()
+
+      solveLinearPolynomialEquation(lp,p) ==
+         if (oldlp ^= lp) then
+            -- we have to generate a new table
+            deg:= _+/[degree u for u in lp]
+            ans:Union(Vector List ZP,"failed"):="failed"
+            slpePrime:=2147483647::Integer   -- 2**31 -1 : a prime
+                 -- a good test case for this package is
+                 --  ([x**31-1,x-2],2)
+            while (ans case "failed") repeat
+              ans:=tablePow(deg,slpePrime,lp)$GenExEuclid(Integer,ZP)
+              if (ans case "failed") then
+                 slpePrime:= prevPrime(slpePrime)$IntegerPrimesPackage(Integer)
+            oldtable:=(ans:: Vector List ZP)
+         answer:=solveid(p,slpePrime,oldtable)
+         answer
+
 *)
 
 \end{chunk}
@@ -62757,6 +85975,7 @@ IntegralBasisTools(R,UP,F): Exports == Implementation where
       ++ \spad{wi = sum(bij * vj, j = 1..n)}.
 
   Implementation ==> add
+
     import ModularHermitianRowReduction(R)
     import TriangularMatrixOperations(R, Vector R, Vector R, Matrix R)
 
@@ -62774,7 +85993,6 @@ IntegralBasisTools(R,UP,F): Exports == Implementation where
       for i in 1..n repeat
         for j in i..n repeat
           if not zero?(mij := qelt(mat,i,j)) then d := gcd(d,mij)
---          one? d => return d
           (d = 1) => return d
       d
 
@@ -62837,6 +86055,81 @@ IntegralBasisTools(R,UP,F): Exports == Implementation where
 \begin{chunk}{COQ IBATOOL}
 (* package IBATOOL *)
 (*
+
+    import ModularHermitianRowReduction(R)
+    import TriangularMatrixOperations(R, Vector R, Vector R, Matrix R)
+
+    diagonalProduct m ==
+      ans : R := 1
+      for i in minRowIndex m .. maxRowIndex m
+        for j in minColIndex m .. maxColIndex m repeat
+          ans := ans * qelt(m, i, j)
+      ans
+
+    matrixGcd(mat,sing,n) ==
+      -- note that 'matrix' is upper triangular;
+      -- no need to do anything below the diagonal
+      d := sing
+      for i in 1..n repeat
+        for j in i..n repeat
+          if not zero?(mij := qelt(mat,i,j)) then d := gcd(d,mij)
+          (d = 1) => return d
+      d
+
+    divideIfCan_!(matrix,matrixOut,prime,n) ==
+    -- note that both 'matrix' and 'matrixOut' will be upper triangular;
+    -- no need to do anything below the diagonal
+      for i in 1..n repeat
+        for j in i..n repeat
+          (a := (qelt(matrix,i,j) exquo prime)) case "failed" => return prime
+          qsetelt_!(matrixOut,i,j,a :: R)
+      1
+
+    leastPower(p,n) ==
+      -- efficiency is not an issue here
+      e : NNI := 1; q := p
+      while q < n repeat (e := e + 1; q := q * p)
+      e
+
+    idealiserMatrix(ideal,idealinv) ==
+      -- computes the Order of the ideal
+      n  := rank()$F
+      bigm := zero(n * n,n)$Mat
+      mr := minRowIndex bigm; mc := minColIndex bigm
+      v := basis()$F
+      for i in 0..n-1 repeat
+        r := regularRepresentation qelt(v,i + minIndex v)
+        m := ideal * r * idealinv
+        for j in 0..n-1 repeat
+          for k in 0..n-1 repeat
+            bigm(j * n + k + mr,i + mc) := qelt(m,j + mr,k + mc)
+      bigm
+
+    idealiser(ideal,idealinv) ==
+      bigm := idealiserMatrix(ideal, idealinv)
+      transpose squareTop rowEch bigm
+
+    idealiser(ideal,idealinv,denom) ==
+      bigm := (idealiserMatrix(ideal, idealinv) exquo denom)::Mat
+      transpose squareTop rowEchelon(bigm,denom)
+
+    moduleSum(mod1,mod2) ==
+      rb1 := mod1.basis; rbden1 := mod1.basisDen; rbinv1 := mod1.basisInv
+      rb2 := mod2.basis; rbden2 := mod2.basisDen; rbinv2 := mod2.basisInv
+      -- compatibility check: doesn't take much computation time
+      (not square? rb1) or (not square? rbinv1) or (not square? rb2) _
+        or (not square? rbinv2) =>
+        error "moduleSum: matrices must be square"
+      ((n := nrows rb1) ^= (nrows rbinv1)) or (n ^= (nrows rb2)) _
+        or (n ^= (nrows rbinv2)) =>
+        error "moduleSum: matrices of imcompatible dimensions"
+      (zero? rbden1) or (zero? rbden2) =>
+        error "moduleSum: denominator must be non-zero"
+      den := lcm(rbden1,rbden2); c1 := den quo rbden1; c2 := den quo rbden2
+      rb := squareTop rowEchelon(vertConcat(c1 * rb1,c2 * rb2),den)
+      rbinv := UpTriBddDenomInv(rb,den)
+      [rb,den,rbinv]
+
 *)
 
 \end{chunk}
@@ -62987,6 +86280,46 @@ IntegralBasisPolynomialTools(K,R,UP,L): Exports == Implementation where
 \begin{chunk}{COQ IBPTOOLS}
 (* package IBPTOOLS *)
 (*
+
+    mapUnivariate(f:L -> K,poly:SUP L) ==
+      ans : R := 0
+      while not zero? poly repeat
+        ans := ans + monomial(f leadingCoefficient poly,degree poly)
+        poly := reductum poly
+      ans
+
+    mapUnivariate(f:K -> L,poly:R) ==
+      ans : SUP L := 0
+      while not zero? poly repeat
+        ans := ans + monomial(f leadingCoefficient poly,degree poly)
+        poly := reductum poly
+      ans
+
+    mapUnivariateIfCan(f,poly) ==
+      ans : R := 0
+      while not zero? poly repeat
+        (lc := f leadingCoefficient poly) case "failed" => return "failed"
+        ans := ans + monomial(lc :: K,degree poly)
+        poly := reductum poly
+      ans
+
+    mapMatrixIfCan(f,mat) ==
+      m := nrows mat; n := ncols mat
+      matOut : MAT R := new(m,n,0)
+      for i in 1..m repeat for j in 1..n repeat
+        (poly := mapUnivariateIfCan(f,qelt(mat,i,j))) case "failed" =>
+          return "failed"
+        qsetelt_!(matOut,i,j,poly :: R)
+      matOut
+
+    mapBivariate(f,poly) ==
+      ans : SUP SUP L := 0
+      while not zero? poly repeat
+        ans :=
+          ans + monomial(mapUnivariate(f,leadingCoefficient poly),degree poly)
+        poly := reductum poly
+      ans
+
 *)
 
 \end{chunk}
@@ -63083,6 +86416,7 @@ IntegrationResultFunctions2(E, F): Exports == Implementation where
       ++ map(f,ufe) \undocumented
 
   Implementation ==> add
+
     import SparseUnivariatePolynomialFunctions2(E, F)
 
     NEE2F: (E -> F, NEE) -> NEF
@@ -63090,7 +86424,9 @@ IntegrationResultFunctions2(E, F): Exports == Implementation where
     NLE2F: (E -> F, NLE) -> NLF
 
     NLE2F(func, r)         == [func(r.coeff), func(r.logand)]
+
     NEE2F(func, n)         == [func(n.integrand), func(n.intvar)]
+
     map(func:E -> F, u:UE) == (u case "failed" => "failed"; func(u::E))
 
     map(func:E -> F, ir:IRE) ==
@@ -63113,6 +86449,34 @@ IntegrationResultFunctions2(E, F): Exports == Implementation where
 \begin{chunk}{COQ IR2}
 (* package IR2 *)
 (*
+
+    import SparseUnivariatePolynomialFunctions2(E, F)
+
+    NEE2F: (E -> F, NEE) -> NEF
+    LGE2F: (E -> F, LGE) -> LGF
+    NLE2F: (E -> F, NLE) -> NLF
+
+    NLE2F(func, r)         == [func(r.coeff), func(r.logand)]
+
+    NEE2F(func, n)         == [func(n.integrand), func(n.intvar)]
+
+    map(func:E -> F, u:UE) == (u case "failed" => "failed"; func(u::E))
+
+    map(func:E -> F, ir:IRE) ==
+      mkAnswer(func ratpart ir, [LGE2F(func, f) for f in logpart ir],
+                                   [NEE2F(func, g) for g in notelem ir])
+
+    map(func:E -> F, u:URE) ==
+      u case "failed" => "failed"
+      [func(u.ratpart), func(u.coeff)]
+
+    map(func:E -> F, u:UFE) ==
+      u case "failed" => "failed"
+      [func(u.mainpart), [NLE2F(func, f) for f in u.limitedlogs]]
+
+    LGE2F(func, lg) ==
+      [lg.scalar, map(func, lg.coeff), map(func, lg.logand)]
+
 *)
 
 \end{chunk}
@@ -63218,6 +86582,7 @@ IntegrationResultRFToFunction(R): Exports == Implementation where
         ++ where x is viewed as a complex variable.
 
   Implementation ==> add
+
     import IntegrationTools(R, F)
     import TrigonometricManipulations(R, F)
     import IntegrationResultToFunction(R, F)
@@ -63225,20 +86590,27 @@ IntegrationResultRFToFunction(R): Exports == Implementation where
     toEF: IR -> IntegrationResult F
 
     toEF i          == map(z1+->z1::F, i)$IntegrationResultFunctions2(RF, F)
+
     expand i        == expand toEF i
+
     complexExpand i == complexExpand toEF i
 
     split i ==
       map(retract, split toEF i)$IntegrationResultFunctions2(F, RF)
 
     if R has CharacteristicZero then
+
       import RationalFunctionIntegration(R)
 
       complexIntegrate(f, x) == complexExpand internalIntegrate(f, x)
 
--- do not use real integration if R is complex
-      if R has imaginary: () -> R then integrate(f, x) == complexIntegrate(f, x)
+      -- do not use real integration if R is complex
+      if R has imaginary: () -> R then 
+
+        integrate(f, x) == complexIntegrate(f, x)
+
       else
+
         integrate(f, x) ==
           l := [mkPrim(real g, x) for g in expand internalIntegrate(f, x)]
           empty? rest l => first l
@@ -63249,6 +86621,40 @@ IntegrationResultRFToFunction(R): Exports == Implementation where
 \begin{chunk}{COQ IRRF2F}
 (* package IRRF2F *)
 (*
+
+    import IntegrationTools(R, F)
+    import TrigonometricManipulations(R, F)
+    import IntegrationResultToFunction(R, F)
+
+    toEF: IR -> IntegrationResult F
+
+    toEF i          == map(z1+->z1::F, i)$IntegrationResultFunctions2(RF, F)
+
+    expand i        == expand toEF i
+
+    complexExpand i == complexExpand toEF i
+
+    split i ==
+      map(retract, split toEF i)$IntegrationResultFunctions2(F, RF)
+
+    if R has CharacteristicZero then
+
+      import RationalFunctionIntegration(R)
+
+      complexIntegrate(f, x) == complexExpand internalIntegrate(f, x)
+
+      -- do not use real integration if R is complex
+      if R has imaginary: () -> R then 
+
+        integrate(f, x) == complexIntegrate(f, x)
+
+      else
+
+        integrate(f, x) ==
+          l := [mkPrim(real g, x) for g in expand internalIntegrate(f, x)]
+          empty? rest l => first l
+          l
+
 *)
 
 \end{chunk}
@@ -63351,6 +86757,7 @@ IntegrationResultToFunction(R, F): Exports == Implementation where
        ++ corresponding to i.
 
   Implementation ==> add
+
     import AlgebraicManipulations(R, F)
     import ElementaryFunctionSign(R, F)
 
@@ -63374,7 +86781,9 @@ IntegrationResultToFunction(R, F): Exports == Implementation where
     compatible?: (List F, List F) -> Boolean
 
     cmplex(alpha, p) == alpha * log p alpha
+
     IR2F i           == retract mkAnswer(ratpart i, empty(), notelem i)
+
     pairprod(x, l)   == [x * y for y in l]
 
     evenRoots x ==
@@ -63393,8 +86802,8 @@ IntegrationResultToFunction(R, F): Exports == Implementation where
       j := split i
       IR2F j + +/[lg.scalar::F * lg2cfunc lg for lg in logpart j]
 
--- p = a t^2 + b t + c
--- Expands sum_{p(t) = 0} t log(lg(t))
+    -- p = a t^2 + b t + c
+    -- Expands sum_{p(t) = 0} t log(lg(t))
     quadratic(p, lg) ==
       zero?(delta := (b := coefficient(p, 1))**2 - 4 *
        (a := coefficient(p,2)) * (p0 := coefficient(p, 0))) =>
@@ -63415,15 +86824,15 @@ IntegrationResultToFunction(R, F): Exports == Implementation where
       sqr.sgn < 0 => [nn]
       [pp, nn]
 
--- returns 2 atan(a/b) or 2 atan(-b/a) whichever looks better
--- they differ by a constant so it's ok to do it from an IR
+    -- returns 2 atan(a/b) or 2 atan(-b/a) whichever looks better
+    -- they differ by a constant so it's ok to do it from an IR
     tantrick(a, b) ==
       retractIfCan(a)@Union(Q, "failed") case Q => 2 * atan(-b/a)
       2 * atan(a/b)
 
--- transforms i log((a + i b) / (a - i b)) into a sum of real
--- arc-tangents using Rioboo's algorithm
--- lk is a list of kernels which are parameters for the integral
+    -- transforms i log((a + i b) / (a - i b)) into a sum of real
+    -- arc-tangents using Rioboo's algorithm
+    -- lk is a list of kernels which are parameters for the integral
     ilog(a, b, lk) ==
       l := setDifference(setUnion(variables numer a, variables numer b),
            setUnion(lk, setUnion(variables denom a, variables denom b)))
@@ -63431,10 +86840,10 @@ IntegrationResultToFunction(R, F): Exports == Implementation where
       k := "max"/l
       ilog0(a, b, numer univariate(a, k), numer univariate(b, k), k::F)
 
--- transforms i log((a + i b) / (a - i b)) into a sum of real
--- arc-tangents using Rioboo's algorithm
--- the arc-tangents will not have k in the denominator
--- we always keep upa(k) = a  and upb(k) = b
+    -- transforms i log((a + i b) / (a - i b)) into a sum of real
+    -- arc-tangents using Rioboo's algorithm
+    -- the arc-tangents will not have k in the denominator
+    -- we always keep upa(k) = a  and upb(k) = b
     ilog0(a, b, upa, upb, k) ==
       if degree(upa) < degree(upb) then
         (upa, upb) := (-upb, upa)
@@ -63453,7 +86862,6 @@ IntegrationResultToFunction(R, F): Exports == Implementation where
 
     lg2func lg ==
       zero?(d := degree(p := lg.coeff)) => error "poly has degree 0"
---      one? d => [linear(p, lg.logand)]
       (d = 1) => [linear(p, lg.logand)]
       d = 2  => quadratic(p, lg.logand)
       odd? d and
@@ -63473,12 +86881,12 @@ IntegrationResultToFunction(R, F): Exports == Implementation where
         ans := pairsum(ans, pairprod(lg.scalar::F, lg2func lg))
       ans
 
--- returns a log(b)
+    -- returns a log(b)
     linear(p, lg) ==
       alpha := - coefficient(p, 0) / coefficient(p, 1)
       alpha * log lg alpha
 
--- returns (c, d) s.t. p(a + b t) = c + d t, where t^2 = delta
+    -- returns (c, d) s.t. p(a + b t) = c + d t, where t^2 = delta
     quadeval(p, a, b, delta) ==
       zero? p => [0, 0]
       bi := c := d := 0$F
@@ -63510,11 +86918,10 @@ IntegrationResultToFunction(R, F): Exports == Implementation where
             l := removeDuplicates concat(l, ln)
       l
 
--- returns [[a, b], s] where sqrt(y) = a sqrt(b) and
--- s = 1 if b > 0, -1 if b < 0, 0 if the sign of b cannot be determined
+    -- returns [[a, b], s] where sqrt(y) = a sqrt(b) and
+    -- s = 1 if b > 0, -1 if b < 0, 0 if the sign of b cannot be determined
     insqrt y ==
       rec := froot(y, 2)$PolynomialRoots(IndexedExponents K, K, R, P, F)
---      one?(rec.exponent) => [[rec.coef * rec.radicand, 1], 1]
       ((rec.exponent) = 1) => [[rec.coef * rec.radicand, 1], 1]
       rec.exponent ^=2 => error "Should not happen"
       [[rec.coef, rec.radicand],
@@ -63530,6 +86937,181 @@ IntegrationResultToFunction(R, F): Exports == Implementation where
 \begin{chunk}{COQ IR2F}
 (* package IR2F *)
 (*
+
+    import AlgebraicManipulations(R, F)
+    import ElementaryFunctionSign(R, F)
+
+    IR2F       : IR -> F
+    insqrt     : F  -> Record(sqrt:REC, sgn:Z)
+    pairsum    : (List F, List F) -> List F
+    pairprod   : (F, List F) -> List F
+    quadeval   : (UP, F, F, F) -> REC
+    linear     : (UP, UP) -> F
+    tantrick   : (F, F) -> F
+    ilog       : (F, F, List K) -> F
+    ilog0      : (F, F, UP, UP, F) -> F
+    nlogs      : LOG -> List LOG
+    lg2func    : LOG -> List F
+    quadratic  : (UP, UP) -> List F
+    mkRealFunc : List LOG -> List F
+    lg2cfunc   : LOG -> F
+    loglist    : (Q, UP, UP) -> List LOG
+    cmplex     : (F, UP) -> F
+    evenRoots  : F -> List F
+    compatible?: (List F, List F) -> Boolean
+
+    cmplex(alpha, p) == alpha * log p alpha
+
+    IR2F i           == retract mkAnswer(ratpart i, empty(), notelem i)
+
+    pairprod(x, l)   == [x * y for y in l]
+
+    evenRoots x ==
+      [first argument k for k in tower x |
+       is?(k,"nthRoot"::Symbol) and even?(retract(second argument k)@Z)
+         and (not empty? variables first argument k)]
+
+    expand i ==
+      j := split i
+      pairsum([IR2F j], mkRealFunc logpart j)
+
+    split i ==
+      mkAnswer(ratpart i,concat [nlogs l for l in logpart i],notelem i)
+
+    complexExpand i ==
+      j := split i
+      IR2F j + +/[lg.scalar::F * lg2cfunc lg for lg in logpart j]
+
+    -- p = a t^2 + b t + c
+    -- Expands sum_{p(t) = 0} t log(lg(t))
+    quadratic(p, lg) ==
+      zero?(delta := (b := coefficient(p, 1))**2 - 4 *
+       (a := coefficient(p,2)) * (p0 := coefficient(p, 0))) =>
+         [linear(monomial(1, 1) + (b / a)::UP, lg)]
+      e := (q := quadeval(lg, c := - b * (d := inv(2*a)),d, delta)).ans1
+      lgp  := c * log(nrm := (e**2 - delta * (f := q.ans2)**2))
+      s    := (sqr := insqrt delta).sqrt
+      pp := nn := 0$F
+      if sqr.sgn >= 0 then
+        sqrp := s.ans1 * rootSimp sqrt(s.ans2)
+        pp := lgp + d * sqrp * log(((2 * e * f) / nrm) * sqrp
+                                          + (e**2 + delta * f**2) / nrm)
+      if sqr.sgn <= 0 then
+        sqrn := s.ans1 * rootSimp sqrt(-s.ans2)
+        nn := lgp + d * sqrn * ilog(e, f * sqrn,
+                   setUnion(setUnion(kernels a, kernels b), kernels p0))
+      sqr.sgn > 0 => [pp]
+      sqr.sgn < 0 => [nn]
+      [pp, nn]
+
+    -- returns 2 atan(a/b) or 2 atan(-b/a) whichever looks better
+    -- they differ by a constant so it's ok to do it from an IR
+    tantrick(a, b) ==
+      retractIfCan(a)@Union(Q, "failed") case Q => 2 * atan(-b/a)
+      2 * atan(a/b)
+
+    -- transforms i log((a + i b) / (a - i b)) into a sum of real
+    -- arc-tangents using Rioboo's algorithm
+    -- lk is a list of kernels which are parameters for the integral
+    ilog(a, b, lk) ==
+      l := setDifference(setUnion(variables numer a, variables numer b),
+           setUnion(lk, setUnion(variables denom a, variables denom b)))
+      empty? l => tantrick(a, b)
+      k := "max"/l
+      ilog0(a, b, numer univariate(a, k), numer univariate(b, k), k::F)
+
+    -- transforms i log((a + i b) / (a - i b)) into a sum of real
+    -- arc-tangents using Rioboo's algorithm
+    -- the arc-tangents will not have k in the denominator
+    -- we always keep upa(k) = a  and upb(k) = b
+    ilog0(a, b, upa, upb, k) ==
+      if degree(upa) < degree(upb) then
+        (upa, upb) := (-upb, upa)
+        (a, b) := (-b, a)
+      zero? degree upb => tantrick(a, b)
+      r := extendedEuclidean(upa, upb)
+      (g:= retractIfCan(r.generator)@Union(F,"failed")) case "failed" =>
+        tantrick(a, b)
+      if degree(r.coef1) >= degree upb then
+        qr := divide(r.coef1, upb)
+        r.coef1 := qr.remainder
+        r.coef2 := r.coef2 + qr.quotient * upa
+      aa := (r.coef2) k
+      bb := -(r.coef1) k
+      tantrick(aa * a + bb * b, g::F) + ilog0(aa,bb,r.coef2,-r.coef1,k)
+
+    lg2func lg ==
+      zero?(d := degree(p := lg.coeff)) => error "poly has degree 0"
+      (d = 1) => [linear(p, lg.logand)]
+      d = 2  => quadratic(p, lg.logand)
+      odd? d and
+        ((r := retractIfCan(reductum p)@Union(F, "failed")) case F) =>
+            pairsum([cmplex(alpha := rootSimp zeroOf p, lg.logand)],
+                    lg2func [lg.scalar,
+                     (p exquo (monomial(1, 1)$UP - alpha::UP))::UP,
+                      lg.logand])
+      [lg2cfunc lg]
+
+    lg2cfunc lg ==
+      +/[cmplex(alpha, lg.logand) for alpha in zerosOf(lg.coeff)]
+
+    mkRealFunc l ==
+      ans := empty()$List(F)
+      for lg in l repeat
+        ans := pairsum(ans, pairprod(lg.scalar::F, lg2func lg))
+      ans
+
+    -- returns a log(b)
+    linear(p, lg) ==
+      alpha := - coefficient(p, 0) / coefficient(p, 1)
+      alpha * log lg alpha
+
+    -- returns (c, d) s.t. p(a + b t) = c + d t, where t^2 = delta
+    quadeval(p, a, b, delta) ==
+      zero? p => [0, 0]
+      bi := c := d := 0$F
+      ai := 1$F
+      v  := vectorise(p, 1 + degree p)
+      for i in minIndex v .. maxIndex v repeat
+        c    := c + qelt(v, i) * ai
+        d    := d + qelt(v, i) * bi
+        temp := a * ai + b * bi * delta
+        bi   := a * bi + b * ai
+        ai   := temp
+      [c, d]
+
+    compatible?(lx, ly) ==
+      empty? ly => true
+      for x in lx repeat
+        for y in ly repeat
+          ((s := sign(x*y)) case Z) and (s::Z < 0) => return false
+      true
+
+    pairsum(lx, ly) ==
+      empty? lx => ly
+      empty? ly => lx
+      l := empty()$List(F)
+      for x in lx repeat
+        ls := evenRoots x
+        if not empty?(ln :=
+          [x + y for y in ly | compatible?(ls, evenRoots y)]) then
+            l := removeDuplicates concat(l, ln)
+      l
+
+    -- returns [[a, b], s] where sqrt(y) = a sqrt(b) and
+    -- s = 1 if b > 0, -1 if b < 0, 0 if the sign of b cannot be determined
+    insqrt y ==
+      rec := froot(y, 2)$PolynomialRoots(IndexedExponents K, K, R, P, F)
+      ((rec.exponent) = 1) => [[rec.coef * rec.radicand, 1], 1]
+      rec.exponent ^=2 => error "Should not happen"
+      [[rec.coef, rec.radicand],
+          ((s := sign(rec.radicand)) case "failed" => 0; s::Z)]
+
+    nlogs lg ==
+      [[f.exponent * lg.scalar, f.factor, lg.logand] for f in factors
+         ffactor(primitivePart(lg.coeff)
+                    )$FunctionSpaceUnivariatePolynomialFactor(R, F, UP)]
+
 *)
 
 \end{chunk}
@@ -63647,10 +87229,13 @@ IntegrationTools(R:OrderedSet, F:FunctionSpace R): Exp == Impl where
             ++ on any remaining unintegrable part.
 
   Impl ==> add
+
     better?: (K, K) -> Boolean
 
     union(l1, l2)   == setUnion(l1, l2)
+
     varselect(l, x) == [k for k in l | member?(x, variables(k::F))]
+
     ksec(k, l, x)   == kmax setUnion(remove(k, l), vark(argument k, x))
 
     vark(l, x) ==
@@ -63662,7 +87247,7 @@ IntegrationTools(R:OrderedSet, F:FunctionSpace R): Exp == Impl where
         if better?(k, ans) then ans := k
       ans
 
--- true if x should be considered before y in the tower
+    -- true if x should be considered before y in the tower
     better?(x, y) ==
       height(y) ^= height(x) => height(y) < height(x)
       has?(operator y, ALGOP) or
@@ -63700,7 +87285,6 @@ IntegrationTools(R:OrderedSet, F:FunctionSpace R): Exp == Impl where
       linearLog?(k, f, x) ==
         is?(k, "log"::SE) and
          ((u := retractIfCan(univariate(f,k))@Union(UP,"failed")) case UP)
---             and one?(degree(u::UP))
              and (degree(u::UP) = 1)
                 and not member?(x, variables leadingCoefficient(u::UP))
 
@@ -63715,6 +87299,7 @@ IntegrationTools(R:OrderedSet, F:FunctionSpace R): Exp == Impl where
 
       if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer)
         and F has Join(LiouvillianFunctionCategory, RetractableTo SE) then
+
           intPatternMatch(f, x, int, pmint) ==
             ir := int(f, x)
             empty?(l := notelem ir) => ir
@@ -63739,6 +87324,96 @@ IntegrationTools(R:OrderedSet, F:FunctionSpace R): Exp == Impl where
 \begin{chunk}{COQ INTTOOLS}
 (* package INTTOOLS *)
 (*
+
+    better?: (K, K) -> Boolean
+
+    union(l1, l2)   == setUnion(l1, l2)
+
+    varselect(l, x) == [k for k in l | member?(x, variables(k::F))]
+
+    ksec(k, l, x)   == kmax setUnion(remove(k, l), vark(argument k, x))
+
+    vark(l, x) ==
+      varselect(reduce("setUnion",[kernels f for f in l],empty()$List(K)), x)
+
+    kmax l ==
+      ans := first l
+      for k in rest l repeat
+        if better?(k, ans) then ans := k
+      ans
+
+    -- true if x should be considered before y in the tower
+    better?(x, y) ==
+      height(y) ^= height(x) => height(y) < height(x)
+      has?(operator y, ALGOP) or
+              (is?(y, "exp"::SE) and not is?(x, "exp"::SE)
+                                 and not has?(operator x, ALGOP))
+
+    if R has IntegralDomain then
+      removeConstantTerm(f, x) ==
+        not freeOf?((den := denom f)::F, x) => f
+        (u := isPlus(num := numer f)) case "failed" =>
+          freeOf?(num::F, x) => 0
+          f
+        ans:P := 0
+        for term in u::List(P) repeat
+          if not freeOf?(term::F, x) then ans := ans + term
+        ans / den
+
+    if R has GcdDomain and F has ElementaryFunctionCategory then
+      psimp     : (P, SE) -> Record(coef:Integer, logand:F)
+      cont      : (P, List K) -> P
+      logsimp   : (F, SE) -> F
+      linearLog?: (K, F, SE)  -> Boolean
+
+      logsimp(f, x) ==
+        r1 := psimp(numer f, x)
+        r2 := psimp(denom f, x)
+        g := gcd(r1.coef, r2.coef)
+        g * log(r1.logand ** (r1.coef quo g) / r2.logand ** (r2.coef quo g))
+
+      cont(p, l) ==
+        empty? l => p
+        q := univariate(p, first l)
+        cont(unitNormal(leadingCoefficient q).unit * content q, rest l)
+
+      linearLog?(k, f, x) ==
+        is?(k, "log"::SE) and
+         ((u := retractIfCan(univariate(f,k))@Union(UP,"failed")) case UP)
+             and (degree(u::UP) = 1)
+                and not member?(x, variables leadingCoefficient(u::UP))
+
+      mkPrim(f, x) ==
+        lg := [k for k in kernels f | linearLog?(k, f, x)]
+        eval(f, lg, [logsimp(first argument k, x) for k in lg])
+
+      psimp(p, x) ==
+        (u := isExpt(p := ((p exquo cont(p, varselect(variables p, x)))::P)))
+          case "failed" => [1, p::F]
+        [u.exponent, u.var::F]
+
+      if R has Join(ConvertibleTo Pattern Integer, PatternMatchable Integer)
+        and F has Join(LiouvillianFunctionCategory, RetractableTo SE) then
+
+          intPatternMatch(f, x, int, pmint) ==
+            ir := int(f, x)
+            empty?(l := notelem ir) => ir
+            ans := ratpart ir
+            nl:List(Record(integrand:F, intvar:F)) := empty()
+            lg := logpart ir
+            for rec in l repeat
+              u := pmint(rec.integrand, retract(rec.intvar))
+              if u case ANS then
+                 rc := u::ANS
+                 ans := ans + rc.special
+                 if rc.integrand ^= 0 then
+                   ir0 := intPatternMatch(rc.integrand, x, int, pmint)
+                   ans := ans + ratpart ir0
+                   lg  := concat(logpart ir0, lg)
+                   nl  := concat(notelem ir0, nl)
+              else nl := concat(rec, nl)
+            mkAnswer(ans, lg, nl)
+
 *)
 
 \end{chunk}
@@ -63808,6 +87483,7 @@ InternalPrintPackage(): Exports == Implementation where
        ++ of the cursor.
 
   Implementation == add
+
      iprint(s:String) == 
           PRINC(coerce(s)@Symbol)$Lisp
           FORCE_-OUTPUT()$Lisp
@@ -63817,6 +87493,11 @@ InternalPrintPackage(): Exports == Implementation where
 \begin{chunk}{COQ IPRNTPK}
 (* package IPRNTPK *)
 (*
+
+     iprint(s:String) == 
+          PRINC(coerce(s)@Symbol)$Lisp
+          FORCE_-OUTPUT()$Lisp
+
 *)
 
 \end{chunk}
@@ -63950,7 +87631,6 @@ InternalRationalUnivariateRepresentationPackage(R,E,V,P,TS): Exports == Implemen
        empty? lp =>
          error "rur$IRURPK: #1 is empty"
        f0 := first lp; lp := rest lp
---       not (one?(init(f0)) and one?(mdeg(f0)) and zero?(tail(f0))) =>
        not ((init(f0) = 1) and (mdeg(f0) = 1) and zero?(tail(f0))) =>
          error "rur$IRURPK: #1 has no generating root."
        empty? lp =>
@@ -63988,7 +87668,8 @@ InternalRationalUnivariateRepresentationPackage(R,E,V,P,TS): Exports == Implemen
      next(lambda:Z):Z == 
        if lambda < 0 then lambda := - lambda + 1 else lambda := - lambda
 
-     makeLinearAndMonic(p: P, xi: V, ts: TS, univ?:B, check?: B, info?: B): List TS ==
+     makeLinearAndMonic(p: P, xi: V, ts: TS, univ?:B, check?: B, info?: B): _
+           List TS ==
        -- if check? THEN some VERIFICATIONS are performed
        -- if info? THEN some INFORMATION is displayed
        f0 := last(ts)::P
@@ -64014,7 +87695,6 @@ InternalRationalUnivariateRepresentationPackage(R,E,V,P,TS): Exports == Implemen
          check? and (zero? degree(s,xi)) and (empty? prs) =>
            error "rur$IRURPK: should never happen !!"
          if zero? degree(s,xi) then s := first prs
---         not one? degree(s,xi) =>            
          not (degree(s,xi) = 1) =>            
            toSee := cons([f0,next(lambda),ts]$WIP,toSee)
          h := init(s)
@@ -64047,7 +87727,6 @@ InternalRationalUnivariateRepresentationPackage(R,E,V,P,TS): Exports == Implemen
              p := primitivePart stronglyReduce(p,ts)
          ground?(p) or (mvar(p) < xi) =>
            error "rur$IRUROK: should never happen"
---         (one? mdeg(p)) and (ground? init(p)) =>
          (mdeg(p) = 1) and (ground? init(p)) =>
            ts := internalAugment(p,ts)
            wip := [lp,ts]
@@ -64063,6 +87742,143 @@ InternalRationalUnivariateRepresentationPackage(R,E,V,P,TS): Exports == Implemen
 \begin{chunk}{COQ IRURPK}
 (* package IRURPK *)
 (*
+
+     checkRur(ts: TS, lts: List TS): Boolean ==
+       f0 := last(ts)::P
+       z := mvar(f0)
+       ts := collectUpper(ts,z)
+       dts: N := degree(ts)
+       lp := parts(ts)
+       dlts: N := 0
+       for us in lts repeat
+         dlts := dlts + degree(us)
+         rems := [removeZero(p,us) for p in lp]
+         not every?(zero?,rems) => 
+           output(us::OutputForm)$OutputPackage
+           return false
+       (dts =$N dlts)@Boolean
+
+     convert(p:P,sqfr?:B):TS ==
+       -- if sqfr? ASSUME p is square-free
+       newts: TS := empty()
+       sqfr? => internalAugment(p,newts) 
+       p := squareFreePart(p)
+       internalAugment(p,newts) 
+
+     prepareRur(ts: TS): List LPWT ==
+       not purelyAlgebraic?(ts)$TS => 
+         error "rur$IRURPK: #1 is not zero-dimensional"
+       lp: LP := parts(ts)$TS
+       lp := sort(infRittWu?,lp)
+       empty? lp =>
+         error "rur$IRURPK: #1 is empty"
+       f0 := first lp; lp := rest lp
+       not ((init(f0) = 1) and (mdeg(f0) = 1) and zero?(tail(f0))) =>
+         error "rur$IRURPK: #1 has no generating root."
+       empty? lp =>
+         error "rur$IRURPK: #1 has a generating root but no indeterminates"
+       z: V :=  mvar(f0)
+       f1 := first lp; lp := rest lp
+       x1: V := mvar(f1)
+       newf1 := x1::P - z::P
+       toSave: List LPWT := []
+       for ff1 in irreducibleFactors([f1])$polsetpack repeat
+         newf0 := eval(ff1,mvar(f1),f0)
+         ts := internalAugment(newf1,convert(newf0,true)@TS)
+         toSave := cons([lp,ts],toSave)
+       toSave
+
+     makeMonic(z:V,c:P,r:P,ts:TS,s:P,univ?:B): TS ==
+       --ASSUME r is a irreducible univariate polynomial in z
+       --ASSUME c and s only depends on z and mvar(s)
+       --ASSUME c and a have main degree 1
+       --ASSUME c and s have a constant initial
+       --ASSUME mvar(ts) < mvar(s)
+       lp: LP := parts(ts)
+       lp := sort(infRittWu?,lp)
+       newts: TS := convert(r,true)@TS
+       s := remainder(s,newts).polnum
+       if univ? 
+         then 
+           s := normalizedAssociate(s,newts)$normpack
+       for p in lp repeat
+         p := lazyPrem(eval(p,z,c),s)
+         p := remainder(p,newts).polnum
+         newts := internalAugment(p,newts)
+       internalAugment(s,newts)
+
+     next(lambda:Z):Z == 
+       if lambda < 0 then lambda := - lambda + 1 else lambda := - lambda
+
+     makeLinearAndMonic(p: P, xi: V, ts: TS, univ?:B, check?: B, info?: B): _
+           List TS ==
+       -- if check? THEN some VERIFICATIONS are performed
+       -- if info? THEN some INFORMATION is displayed
+       f0 := last(ts)::P
+       z: V := mvar(f0)
+       lambda: Z := 1
+       ts := collectUpper(ts,z)
+       toSee: List WIP := [[f0,lambda,ts]$WIP]
+       toSave: List TS := []
+       while not empty? toSee repeat
+         wip := first toSee; toSee := rest toSee
+         (f0, lambda, ts) := (wip.pol, wip.gap, wip.tower)
+         if check? and ((not univariate?(f0)$polsetpack) or (mvar(f0) ~= z))
+           then
+               output("Bad f0: ")$OutputPackage
+               output(f0::OutputForm)$OutputPackage
+         c: P := lambda * xi::P + z::P 
+         f := eval(f0,z,c); q := eval(p,z,c)
+         prs := subResultantChain(q,f)
+         r := first prs; prs := rest prs
+         check? and ((not zero? degree(r,xi)) or (empty? prs)) =>
+           error "rur$IRURPK: should never happen !"
+         s := first prs; prs := rest prs
+         check? and (zero? degree(s,xi)) and (empty? prs) =>
+           error "rur$IRURPK: should never happen !!"
+         if zero? degree(s,xi) then s := first prs
+         not (degree(s,xi) = 1) =>            
+           toSee := cons([f0,next(lambda),ts]$WIP,toSee)
+         h := init(s)
+         r := squareFreePart(r)
+         ground?(h) or ground?(gcd(h,r)) =>
+           for fr in irreducibleFactors([r])$polsetpack repeat
+             ground? fr => "leave"
+             toSave := cons(makeMonic(z,c,fr,ts,s,univ?),toSave)
+         if info?
+           then 
+             output("Unlucky lambda")$OutputPackage
+             output(h::OutputForm)$OutputPackage
+             output(r::OutputForm)$OutputPackage
+         toSee := cons([f0,next(lambda),ts]$WIP,toSee)
+       toSave
+
+     rur (ts: TS,univ?:Boolean): List TS ==
+       toSee: List LPWT := prepareRur(ts)
+       toSave: List TS := []
+       while not empty? toSee repeat
+         wip := first toSee; toSee := rest toSee
+         ts: TS := wip.tower
+         lp: LP := wip.val
+         empty? lp => toSave := cons(ts,toSave)
+         p := first lp; lp := rest lp
+         xi: V := mvar(p)
+         p := remainder(p,ts).polnum
+         if not univ?
+           then 
+             p := primitivePart stronglyReduce(p,ts)
+         ground?(p) or (mvar(p) < xi) =>
+           error "rur$IRUROK: should never happen"
+         (mdeg(p) = 1) and (ground? init(p)) =>
+           ts := internalAugment(p,ts)
+           wip := [lp,ts]
+           toSee := cons(wip,toSee)
+         lts := makeLinearAndMonic(p,xi,ts,univ?,false,false)
+         for ts in lts repeat
+           wip := [lp,ts]
+           toSee := cons(wip,toSee)
+       toSave
+
 *)
 
 \end{chunk}
@@ -64269,83 +88085,6 @@ InterpolateFormsPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR):_
       zeroMat:Matrix(K):=zero(1,#lm)$Matrix(K)
       nullSpace zeroMat
 
-     
---    interpolateForms(divis,d,laCrb,lm)==
---      lstOfPlc:= supp divis
---      lstOfv:= [coefficient(pl,divis)  for pl in lstOfPlc]
---      
---      lpls : List(List(PCS))
---      lplsT: List(List(PCS))
---      
---      -- ppsol contiendra la base des formes interpolant ke diviseur divis
---      ppsol:List(Vector(K))
---      linSys:Matrix(K)
---      if ^empty?(lstOfPlc) then
---        linSys:=createLinSys(lstOfPlc,lstOfv,lm)
---			  
---        -- ppsol contient la base des formes passant par le diviseur divv
---        ppsol:=nullSpace(linSys)
---      else
---        zeroMat:Matrix(K):=zero(1,#lm)$Matrix(K)
---        ppsol:=nullSpace zeroMat
---      mpsol:=psol:List(List(K)):=[entries(vec) for vec in ppsol]
---      
---      if ^(totalDegree(laCrb) > d) then
---        -- retourne une base des formes de degres d 
---	-- qui sont un multiple de la courbe
---        sbspc:=sbSpcOfCurve(d,laCrb)
---        mpsol:=quotVecSpaceBasis(psol,sbspc)$LinesOpPack(K)
---	
---      empty?(mpsol) => [0]
---      
---      rowEchmpsol:=rowEchelon(matrix(mpsol))
---      npsol:=listOfLists(rowEchmpsol) 
---      [reduce("+",[a*f  for a in ll for f in lm]) for ll in npsol]
---
-
---    interpolateForms(divis,d,laCrb,lm)==
---      lstOfPlc:= supp divis
---      lstOfv:= [coefficient(pl,divis)  for pl in lstOfPlc]
---      
---      lpls : List(List(PCS))
---      lplsT: List(List(PCS))
---      
---      -- ppsol contiendra la base des formes interpolant ke diviseur divis
---      ppsol:List(Vector(K))
---      linSys:Matrix(K)
---      if ^empty?(lstOfPlc) then
---      
---        lplsT:=[ [parametrize(f,pl)$ParamPack  for f in lm]_
---	           for pl in lstOfPlc]
---		   
---        lpls:=[[filterUpTo(s,v) for s in souslplsT] _
---	          for souslplsT in lplsT_
---		  for v in lstOfv]
---		  
---        linSys:=reduce("vertConcat",_
---	           [finiteSeries2LinSys(souslplsT,v)$LINPACK_
---		          for souslplsT in lpls_
---			  for v in lstOfv])
---			  
---        -- ppsol contient la base des formes passant par le diviseur divv
---        ppsol:=nullSpace(linSys)
---      else
---        zeroMat:Matrix(K):=zero(1,#lm)$Matrix(K)
---        ppsol:=nullSpace zeroMat
---      mpsol:=psol:List(List(K)):=[entries(vec) for vec in ppsol]
---      
---      if ^(totalDegree(laCrb) > d) then
---        -- retourne une base des formes de degres d 
---	-- qui sont un multiple de la courbe
---        sbspc:=sbSpcOfCurve(d,laCrb)
---        mpsol:=quotVecSpaceBasis(psol,sbspc)$LinesOpPack(K)
---	
---      empty?(mpsol) => [0]
---      
---      rowEchmpsol:=rowEchelon(matrix(mpsol))
---      npsol:=listOfLists(rowEchmpsol) 
---      [reduce("+",[a*f  for a in ll for f in lm]) for ll in npsol]
-
     listVar:List(OV):= [index(i::PositiveInteger)$OV for i in 1..#symb]
 
     listMonoPols:List(PolyRing):=[monomial(1,vv,1) for vv in listVar]
@@ -64380,51 +88119,144 @@ InterpolateFormsPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc,DIVISOR):_
     exponant2monomial(lexp)==
       reduce("*",[m**e for m in listMonoPols for e in lexp])
 
---    interpolateFunctions(lstOfPlc,lstOfv,lmnumer)==
-----      lstOfPlc:= supp divis
-----      lstOfv:= [coef(divis,pl) for pl in lstOfPlc]
---      
---      lpls:List(List(PCS))
---      lplsT:List(List(PCS))
---      llll:List(List(Integer))
---      lOrd:List(Integer)
---      ordMin:Integer
---      ppsol:List(Vector(K))
---      linSys:Matrix(K)
---      if ^empty?(lstOfPlc) then
---        lplsT:=[[parametrize(f,pl)$ParamPack  for f in lmnumer ] _
---          for pl in lstOfPlc]
---	lplsT:=[[removeFirstZeroes(s) for s in l] for l in lplsT]
---	
---	-- series must be shift if somme of them has negetive order
---	llll:= [[order(s)$PCS for s in l] for l in lplsT]
---	lOrd:=  concat llll
---	lOrd:=cons(0,lOrd)
---	ordMin:Integer:= "min"/lOrd
---	lplsT:=[[shift(s,-ordMin) for s in l] for l in lplsT]
---	
---        lpls:=[[filterUpTo(s,v-ordMin) for s in souslplsT] _
---          for souslplsT in lplsT  for v in lstOfv]
---        linSys:=reduce("vertConcat",_
---          [finiteSeries2LinSys(souslplsT,v-ordMin)$LINPACK _
---            for souslplsT in lpls for v in lstOfv])
---        -- ppsol contient la base des formes passant par le diviseur divv
---        ppsol:=nullSpace(linSys)
---      else
---        zeroMat:Matrix(K):=zero(1,#lmnumer)$Matrix(K)
---        ppsol:=nullSpace zeroMat
---      mpsol:=psol:List(List(K)):=[entries(vec) for vec in ppsol]
---      -- inserer ici le code pour calculer la base modulo l'ideal ...
---      empty?(mpsol) => [0]
---      rowEchmpsol:=rowEchelon(matrix(mpsol))
---      npsol:=listOfLists(rowEchmpsol) 
---      [reduce("+",[a*f  for a in ll for f in lmnumer]) for ll in npsol]
-
 \end{chunk}
 
 \begin{chunk}{COQ INTFRSP}
 (* package INTFRSP *)
 (*
+
+    import PolyRing
+    import PCS
+
+    sbSpcOfCurve: (NNI,PolyRing) -> List(List(K))
+    
+    exponant2monomial: List(NNI) -> PolyRing
+
+    crtV: (List(K),List(INT),NNI) -> List(K)
+
+    createLinSys: (List Plc, List INT,List PolyRing) -> Matrix(K)
+
+    createLinSysWOVectorise: (List Plc, List INT,List PolyRing) -> Matrix(K)
+
+    basisOfInterpolateFormsForFact(divis,lm)==
+      -- permet d'intepoler un diviseur qui n'est pas rationnel. 
+      -- La partie non rationel
+      -- est dans sptdiv (note: une place de sptdiv est une place qui identidie
+      -- l'ensemble des places qui lui sont conjuguees.
+      -- Note: On utilise ici la fonction createLinSysWOVectorise
+      -- qui ne vectorise pas les elements du corps de base.
+      lstOfPlc:= supp divis
+      lstOfv:= [coefficient(pl,divis)  for pl in lstOfPlc]
+      -- ppsol contiendra la base des formes interpolant ke diviseur divis
+      linSys:Matrix(K)
+      linSysT:Matrix(K)
+      ll:List Matrix K
+      ^empty?(lstOfPlc) => 
+        linSys:=createLinSysWOVectorise(lstOfPlc,lstOfv,lm)
+        nullSpace linSys
+      zeroMat:Matrix(K):=zero(1,#lm)$Matrix(K)
+      nullSpace zeroMat
+      
+    interpolateForms(divis,d,laCrb,lm)==
+      -- ppsol contiendra la base des formes interpolant le diviseur divis
+      -- mieux vaut prendre  divOfZero de divis ?
+      ppsol:= basisOfInterpolateForms(divis,lm)
+      
+      psol:List(List(K)):=[entries(vec) for vec in ppsol]
+      mpsol:=psol
+      sbspc:List(List(K))
+      if ^(totalDegree(laCrb)$PackPoly > d) then
+        -- retourne une base des formes de degres d 
+	-- qui sont un multiple de la courbe
+        sbspc:=sbSpcOfCurve(d,laCrb)
+        mpsol:=quotVecSpaceBasis(psol,sbspc)$LinesOpPack(K)
+	
+      empty?(mpsol) => [0]
+      
+      rowEchmpsol:=rowEchelon(matrix(mpsol)$Matrix(K))
+      npsol:=listOfLists(rowEchmpsol) 
+      [reduce("+",[a*f  for a in ll for f in lm]) for ll in npsol]
+
+    interpolateFormsForFact(divis,lm)==
+      -- ppsol contiendra la base des formes interpolant le diviseur divis
+      ppsol:= basisOfInterpolateFormsForFact(divis,lm)
+      psol:List(List(K)):=[entries(vec) for vec in ppsol]
+      mpsol:=psol
+      empty?(mpsol) => [0]
+      rowEchmpsol:=rowEchelon matrix(mpsol)$Matrix(K) 
+      npsol:=listOfLists(rowEchmpsol) 
+      [reduce("+",[a*f  for a in ll for f in lm]) for ll in npsol]
+
+    createLinSys(lstOfPlc,lstOfv,lm)==
+        lplsT:=[ [parametrize(f,pl)$ParamPack  for f in lm]_
+	           for pl in lstOfPlc]
+        lpls:=[[filterUpTo(s,v) for s in souslplsT] _
+	          for souslplsT in lplsT_
+		  for v in lstOfv]
+        linSys:=reduce("vertConcat",_
+	           [finiteSeries2LinSys(souslplsT,v)$LINPACK_
+		          for souslplsT in lpls_
+			  for v in lstOfv])
+        linSys
+
+    createLinSysWOVectorise(lstOfPlc,lstOfv,lm)==
+        lplsT:=[ [parametrize(f,pl)$ParamPack  for f in lm]_
+	           for pl in lstOfPlc]
+        lpls:=[[filterUpTo(s,v) for s in souslplsT] _
+	          for souslplsT in lplsT_
+		  for v in lstOfv]
+        linSys:=reduce("vertConcat",_
+	           [finiteSeries2LinSysWOVectorise(souslplsT,v)$LINPACK_
+		          for souslplsT in lpls_
+			  for v in lstOfv])
+        linSys
+      
+    basisOfInterpolateForms(divis,lm)==
+      lstOfPlc:= supp divis
+      lstOfv:= [coefficient(pl,divis)  for pl in lstOfPlc]
+      -- ppsol contiendra la base des formes interpolant ke diviseur divis
+      linSys:Matrix(K)
+      ^empty?(lstOfPlc) => 
+        linSys:=createLinSys(lstOfPlc,lstOfv,lm)
+        -- ppsol contient la base des formes passant par le diviseur divv
+        nullSpace(linSys)
+      zeroMat:Matrix(K):=zero(1,#lm)$Matrix(K)
+      nullSpace zeroMat
+
+    listVar:List(OV):= [index(i::PositiveInteger)$OV for i in 1..#symb]
+
+    listMonoPols:List(PolyRing):=[monomial(1,vv,1) for vv in listVar]
+
+    crtV(lcoef,lpos,l)==
+      vvv:List(K):=[0 for i in 1..l]
+      for c in lcoef for p in lpos repeat
+        setelt(vvv,p,c)
+      vvv
+
+    sbSpcOfCurve(m,laCrb)==
+      d:=totalDegree(laCrb)$PackPoly
+      lm:List(PolyRing):=listAllMono(m)$PackPoly
+      m<d => [[0$K for i in 1..#lm]]
+      sd:NNI:=((m pretend INT)-(d pretend INT)) pretend NNI
+      slm:List(PolyRing):=listAllMono(sd)$PackPoly
+      allPol:=[laCrb*f for f in slm]
+      lpos:=[[position(m,lm) for m in primitiveMonomials(f)] for f in allPol]
+      lcoef:=[coefficients(f) for f in allPol]
+      clm:=#lm
+      [crtV(lc,lp,clm) for lc in lcoef for lp in lpos]
+
+    inVecSpace?: (List(K),List(List(K))) -> Boolean
+    inVecSpace?(line,basis)==
+      mat:Matrix(K):=matrix(basis)
+      rmat:=rank(mat)
+      augmat:Matrix(K):=matrix(concat(line,basis))
+      raugmat:=rank(augmat)
+      rmat=raugmat
+
+
+    exponant2monomial(lexp)==
+      reduce("*",[m**e for m in listMonoPols for e in lexp])
+
 *)
 
 \end{chunk}
@@ -64593,6 +88425,56 @@ IntersectionDivisorPackage(K,symb,PolyRing,E,ProjPt, PCS,Plc,DIVISOR,_
 \begin{chunk}{COQ INTDIVP}
 (* package INTDIVP *)
 (*
+      
+    intersectionDivisor(pol,curve,ltr,listOfSingPt)==
+       intDeg:Integer:=  (totalDegree(pol)$PackPoly * _
+                          totalDegree(curve)$PackPoly) pretend Integer
+       -- compute at places over singular Points 
+       lDivAtSingPt:DIVISOR:=_
+         reduce("+",[divisorAtDesingTree(pol,tr)$DesingPack for tr in ltr],0)
+       -- By Bezout Thorem, if all intersection points with mult. 
+       -- have been found then return the divisor
+       degD:Integer:=degree lDivAtSingPt
+       degD = intDeg  => lDivAtSingPt
+       setOfFdPlc:List Plc:=foundPlaces()$Plc
+       plcFrSplPts:List Plc:=[pl for pl in setOfFdPlc | ^leaf?(pl)]
+       ordAtPlcFrSplPts:List Integer:=_
+         [order(parametrize(pol,pl)$ParamPack)$PCS for pl in plcFrSplPts]
+       divAtSplPts:DIVISOR:=_
+         reduce("+",[o * (pl :: DIVISOR) _
+           for o in ordAtPlcFrSplPts _
+             for pl in plcFrSplPts],0)
+       tDiv:=lDivAtSingPt+divAtSplPts
+       -- By Bezout Thorem, if all intersection points with mult. 
+       -- have been found then return the divisor
+       degD:Integer:=degree tDiv
+       degD = intDeg  => tDiv
+       intPts:List ProjPt:=algebraicSet([pol,curve])$RatSingPack
+       intPtsNotSing:=setDifference(intPts,listOfSingPt)
+       intPls:List(Plc):=_
+         [pointToPlace(pt,curve)$ParamPackFC for pt in intPtsNotSing]
+       remPlc:=setDifference(intPls , plcFrSplPts)   
+       ordAtPlcRem:List Integer:=_
+         [order(parametrize(pol,pl)$ParamPack)$PCS for pl in remPlc]
+       divAtRem:DIVISOR:=_
+        reduce("+",[o*(pl :: DIVISOR) for o in ordAtPlcRem for pl in remPlc],0)
+       theDivisor:= lDivAtSingPt +  divAtSplPts + divAtRem
+       degD:Integer:=degree theDivisor
+       if ^(degD = intDeg) then 
+         print("error while computing the intersection divisor" :: OF )
+	 print("Otherwise the Bezout Theoreme is not true !!!! " :: OF)
+	 print("Of course its the machine that make the mistake !!!!!" :: OF)
+       theDivisor
+
+    placesOfDegree(d, curve, singPts) ==
+      --Return the number of places of degree i of the functionfield, no 
+      --constant field extension
+      allPoints: List ProjPt:= rationalPoints(curve, d)$RatSingPack
+      remindingSimplePts: List ProjPt :=setDifference(allPoints,singPts)
+      for tpt in remindingSimplePts repeat
+         pointToPlace(tpt,curve)$ParamPackFC
+      Void()
+
 *)
 
 \end{chunk}
@@ -64667,6 +88549,7 @@ IrredPolyOverFiniteField(GF:FiniteFieldCategory): Exports == Impl where
       ++ polynomial of the given degree n over the finite field.
 
   Impl ==> add
+
     import DistinctDegreeFactorize(GF, SUP)
 
     getIrredPoly  : (Z, N) -> SUP
@@ -64702,9 +88585,7 @@ IrredPolyOverFiniteField(GF:FiniteFieldCategory): Exports == Impl where
 
     generateIrredPoly(n : N) : SUP ==
       -- want same poly every time
---      one?(n) => monomial(1, 1)$SUP
       (n = 1) => monomial(1, 1)$SUP
---      one?(gcd(p, n)) or (n < q) =>
       (gcd(p, n) = 1) or (n < q) =>
         odd?(n) => getIrredPoly(2, n)
         getIrredPoly(1, n)
@@ -64715,6 +88596,48 @@ IrredPolyOverFiniteField(GF:FiniteFieldCategory): Exports == Impl where
 \begin{chunk}{COQ IRREDFFX}
 (* package IRREDFFX *)
 (*
+
+    import DistinctDegreeFactorize(GF, SUP)
+
+    getIrredPoly  : (Z, N) -> SUP
+    qAdicExpansion: Z -> SUP
+
+    p := characteristic()$GF :: N
+    q := size()$GF :: N
+
+    qAdicExpansion(z : Z): SUP ==
+      -- expands z as a sum of powers of q, with coefficients in GF
+      -- z = HornerEval(qAdicExpansion z,q)
+      qr := divide(z, q)
+      zero?(qr.remainder) => monomial(1, 1) * qAdicExpansion(qr.quotient)
+      r := index(qr.remainder pretend N)$GF :: SUP
+      zero?(qr.quotient) => r
+      r + monomial(1, 1) * qAdicExpansion(qr.quotient)
+
+    getIrredPoly(start : Z, n : N) : SUP ==
+      -- idea is to iterate over possibly irreducible monic polynomials
+      -- until we find an irreducible one. The obviously reducible ones
+      -- are avoided.
+      mon := monomial(1, n)$SUP
+      pol: SUP := 0
+      found: Boolean := false
+      end: Z := q**n - 1
+      while not ((end < start) or found) repeat
+        if gcd(start, p) = 1 then
+          if irreducible?(pol := mon + qAdicExpansion(start)) then
+            found := true
+        start := start + 1
+      zero? pol => error "no irreducible poly found"
+      pol
+
+    generateIrredPoly(n : N) : SUP ==
+      -- want same poly every time
+      (n = 1) => monomial(1, 1)$SUP
+      (gcd(p, n) = 1) or (n < q) =>
+        odd?(n) => getIrredPoly(2, n)
+        getIrredPoly(1, n)
+      getIrredPoly(q + 1, n)
+
 *)
 
 \end{chunk}
@@ -64894,24 +88817,20 @@ IrrRepSymNatPackage(): public == private where
       -- the set of permutations of the set {1,2,...,n}.
       -- If not, an error message will occur, if yes it replies n.
 
-
     -- definition of local functions
 
 
     aIdInverse() ==
-
       aId := new(flambda,flambda,0)
       for k in 1..flambda repeat
         aId(k,k) := 1
       if n < 5 then return aId
-
       idperm      : L I  := nil$(L I)
       for k in n..1 by -1 repeat
         idperm := cons(k,idperm)
       for k in 1..(flambda-1) repeat
         for l in (k+1)..flambda repeat
           aId(k::NNI,l::NNI) := signum(k::NNI,l::NNI,idperm)
-
       -- invert the upper triangular matrix aId
       for j in flambda..2 by -1 repeat
         for i in (j-1)..1 by -1 repeat
@@ -64921,7 +88840,6 @@ IrrRepSymNatPackage(): public == private where
             aId(i::NNI,k:NNI) := aId(i::NNI,k::NNI) +
                 aId(i::NNI,j:NNI) * aId(j::NNI,k::NNI)
 
-
     alreadyComputed?(lambda) ==
       if not(lambda = oldlambda) then
         oldlambda := lambda
@@ -64940,7 +88858,6 @@ IrrRepSymNatPackage(): public == private where
       li
 
     signum(numberOfRowTableau, numberOfColumnTableau,pi) ==
-
       rowtab : M I  := copy younglist numberOfRowTableau
       columntab : M I  := copy younglist numberOfColumnTableau
       swap : I
@@ -64999,10 +88916,8 @@ IrrRepSymNatPackage(): public == private where
         -- end of l-loop
         k := k + 1
       -- end of k-loop
-
       sign
 
-
     sumPartition(lambda) ==
       ok   : B := true
       prev : I := first lambda
@@ -65015,7 +88930,6 @@ IrrRepSymNatPackage(): public == private where
         error("No proper partition ")
       sum::NNI
 
-
     testPermutation(pi : L I) : NNI ==
       ok : B := true
       n  : I := 0
@@ -65032,10 +88946,8 @@ IrrRepSymNatPackage(): public == private where
       if member?(false,test) then error("No permutation")  -- pi not surjective
       n::NNI
 
-
     -- definitions of exported functions
 
-
     dimensionOfIrreducibleRepresentation(lambda) ==
       nn : I :=  sumPartition(lambda)::I --also checks whether lambda
       dd : I := 1                        --is a partition
@@ -65049,7 +88961,6 @@ IrrRepSymNatPackage(): public == private where
             dd := dd * (lambda.i + lambdaprime.j - i - j + 1)
       (factorial(nn)$ICF quo dd)::NNI
 
-
     irreducibleRepresentation(lambda:(L I),pi:(PERM I)) ==
       nn : NNI := sumPartition(lambda)
       alreadyComputed?(lambda)
@@ -65062,7 +88973,6 @@ IrrRepSymNatPackage(): public == private where
           aPi(k,l) := signum(k,l,piList)
       aId * aPi
 
-
     irreducibleRepresentation(lambda) ==
       listperm : L PERM I := nil$(L PERM I)
       li       : L I  := nil$(L I)
@@ -65079,7 +88989,6 @@ IrrRepSymNatPackage(): public == private where
         cons(cycle([1,2])$(PERM I),listperm)
       irreducibleRepresentation(lambda,listperm)
 
-
     irreducibleRepresentation(lambda:(L I),listperm:(L PERM I)) ==
       sumPartition(lambda)
       alreadyComputed?(lambda)
@@ -65090,6 +88999,229 @@ IrrRepSymNatPackage(): public == private where
 \begin{chunk}{COQ IRSN}
 (* package IRSN *)
 (*
+
+    -- local variables
+    oldlambda : L I  := nil$(L I)
+    flambda   : NNI := 0           -- dimension of the irreducible repr.
+    younglist : L M I := nil$(L M I)     -- list of all standard tableaus
+    lprime    : L I  := nil$(L I)      -- conjugated partition of lambda
+    n         : NNI := 0           -- concerning symmetric group S_n
+    rows      : NNI := 0           -- # of rows of standard tableau
+    columns   : NNI := 0           -- # of columns of standard tableau
+    aId       : M I  := new(1,1,0)
+
+    -- declaration of local functions
+
+    aIdInverse : () -> Void
+      -- computes aId, the inverse of the matrix
+      -- (signum(k,l,id))_1 <= k,l <= flambda, where id
+      -- denotes the identity permutation
+
+    alreadyComputed? : L I -> Void
+      -- test if the last calling of an exported function concerns
+      -- the same partition lambda as the previous call
+
+    listPermutation : PERM I -> L I   -- should be in Permutation
+      -- converts a permutation pi into the list
+      -- [pi(1),pi(2),..,pi(n)]
+
+    signum : (NNI, NNI, L I) -> I
+      -- if there exists a vertical permutation v of the tableau
+      -- tl := pi o younglist(l) (l-th standard tableau)
+      -- and a horizontal permutation h of the tableau
+      -- tk := younglist(k) (k-th standard tableau)  such that
+      --                v o tl = h o tk,
+      -- then
+      --            signum(k,l,pi) = sign(v),
+      -- otherwise
+      --            signum(k,l,pi) = 0.
+
+    sumPartition : L I -> NNI
+      -- checks if lambda is a proper partition and results in
+      -- the sum of the entries
+
+    testPermutation : L I -> NNI
+      -- testPermutation(pi) checks if pi is an element of S_n,
+      -- the set of permutations of the set {1,2,...,n}.
+      -- If not, an error message will occur, if yes it replies n.
+
+    -- definition of local functions
+
+
+    aIdInverse() ==
+      aId := new(flambda,flambda,0)
+      for k in 1..flambda repeat
+        aId(k,k) := 1
+      if n < 5 then return aId
+      idperm      : L I  := nil$(L I)
+      for k in n..1 by -1 repeat
+        idperm := cons(k,idperm)
+      for k in 1..(flambda-1) repeat
+        for l in (k+1)..flambda repeat
+          aId(k::NNI,l::NNI) := signum(k::NNI,l::NNI,idperm)
+      -- invert the upper triangular matrix aId
+      for j in flambda..2 by -1 repeat
+        for i in (j-1)..1 by -1 repeat
+          aId(i::NNI,j:NNI) := -aId(i::NNI,j::NNI)
+        for k in (j+1)..flambda repeat
+          for i in (j-1)..1 by -1 repeat
+            aId(i::NNI,k:NNI) := aId(i::NNI,k::NNI) +
+                aId(i::NNI,j:NNI) * aId(j::NNI,k::NNI)
+
+    alreadyComputed?(lambda) ==
+      if not(lambda = oldlambda) then
+        oldlambda := lambda
+        lprime    := conjugate(lambda)$PP
+        rows      := (first(lprime)$(L I))::NNI
+        columns   := (first(lambda)$(L I))::NNI
+        n         := (+/lambda)::NNI
+        younglist := listYoungTableaus(lambda)$SGCF
+        flambda   := #younglist
+        aIdInverse()        -- side effect: creates actual aId
+
+    listPermutation(pi) ==
+      li : L I := nil$(L I)
+      for k in n..1 by -1 repeat
+        li := cons(eval(pi,k)$(PERM I),li)
+      li
+
+    signum(numberOfRowTableau, numberOfColumnTableau,pi) ==
+      rowtab : M I  := copy younglist numberOfRowTableau
+      columntab : M I  := copy younglist numberOfColumnTableau
+      swap : I
+      sign : I   := 1
+      end  : B   := false
+      endk : B
+      ctrl : B
+
+      -- k-loop for all rows of tableau rowtab
+      k    : NNI := 1
+      while (k <= rows) and (not end) repeat
+        -- l-loop along the k-th row of rowtab
+        l : NNI := 1
+        while (l <= oldlambda(k)) and (not end) repeat
+          z : NNI := l
+          endk := false
+          -- z-loop for k-th row of rowtab beginning at column l.
+          -- test wether the entry rowtab(k,z) occurs in the l-th column
+          -- beginning at row k of pi o columntab
+          while (z <= oldlambda(k)) and (not endk) repeat
+            s : NNI := k
+            ctrl := true
+            while ctrl repeat
+              if (s <= lprime(l))
+                then
+                  if (1+rowtab(k,z) = pi(1+columntab(s,l)))
+                  -- if entries in the tableaus were from 1,..,n, then
+                  -- it should be ..columntab(s,l)... .
+                    then ctrl := false
+                    else s := s + 1
+                else ctrl := false
+            -- end of ctrl-loop
+            endk := (s <= lprime(l)) -- same entry found ?
+            if not endk
+              then       -- try next entry
+                z := z + 1
+              else
+                if k < s
+                  then     -- verticalpermutation
+                    sign := -sign
+                    swap := columntab(s,l)
+                    columntab(s,l) := columntab(k,l)
+                    columntab(k,l) := swap
+                if l < z
+                  then     -- horizontalpermutation
+                    swap := rowtab(k,z)
+                    rowtab(k,z) := rowtab(k,l)
+                    rowtab(k,l) := swap
+              -- end of else
+          -- end of z-loop
+          if (z > oldlambda(k))  -- no coresponding entry found
+            then
+              sign := 0
+              end := true
+          l := l + 1
+        -- end of l-loop
+        k := k + 1
+      -- end of k-loop
+      sign
+
+    sumPartition(lambda) ==
+      ok   : B := true
+      prev : I := first lambda
+      sum  : I := 0
+      for x in lambda repeat
+        sum := sum + x
+        ok := ok and (prev >= x)
+        prev := x
+      if not ok then
+        error("No proper partition ")
+      sum::NNI
+
+    testPermutation(pi : L I) : NNI ==
+      ok : B := true
+      n  : I := 0
+      for i in pi repeat
+        if i > n then n  := i     -- find the largest entry n in pi
+        if i < 1 then ok := false -- check whether there are entries < 1
+      -- now n should be the number of permuted objects
+      if (not (n=#pi)) or (not ok) then
+        error("No permutation of 1,2,..,n")
+      -- now we know that pi has n Elements ranging from 1 to n
+      test : Vector(B) := new((n)::NNI,false)
+      for i in pi repeat
+        test(i) := true   -- this means that i occurs in pi
+      if member?(false,test) then error("No permutation")  -- pi not surjective
+      n::NNI
+
+    -- definitions of exported functions
+
+    dimensionOfIrreducibleRepresentation(lambda) ==
+      nn : I :=  sumPartition(lambda)::I --also checks whether lambda
+      dd : I := 1                        --is a partition
+      lambdaprime : L I := conjugate(lambda)$PP
+      -- run through all rows of the Youngtableau corr. to lambda
+      for i in 1..lambdaprime.1 repeat
+        -- run through all nodes in row i of the Youngtableau
+        for j in 1..lambda.i repeat
+            -- the hooklength of node (i,j) of the Youngtableau
+            -- is the new factor, remember counting starts with 1
+            dd := dd * (lambda.i + lambdaprime.j - i - j + 1)
+      (factorial(nn)$ICF quo dd)::NNI
+
+    irreducibleRepresentation(lambda:(L I),pi:(PERM I)) ==
+      nn : NNI := sumPartition(lambda)
+      alreadyComputed?(lambda)
+      piList : L I := listPermutation pi
+      if not (nn = testPermutation(piList)) then
+        error("Partition and permutation are not consistent")
+      aPi : M I := new(flambda,flambda,0)
+      for k in 1..flambda repeat
+        for l in 1..flambda repeat
+          aPi(k,l) := signum(k,l,piList)
+      aId * aPi
+
+    irreducibleRepresentation(lambda) ==
+      listperm : L PERM I := nil$(L PERM I)
+      li       : L I  := nil$(L I)
+      sumPartition(lambda)
+      alreadyComputed?(lambda)
+      listperm :=
+        n = 1 =>  cons(1$(PERM I),listperm)
+        n = 2 =>  cons(cycle([1,2])$(PERM I),listperm)
+        -- the n-cycle (1,2,..,n) and the 2-cycle (1,2) generate S_n
+        for k in n..1 by -1 repeat
+          li := cons(k,li)  -- becomes n-cycle (1,2,..,n)
+        listperm := cons(cycle(li)$(PERM I),listperm)
+        -- 2-cycle (1,2)
+        cons(cycle([1,2])$(PERM I),listperm)
+      irreducibleRepresentation(lambda,listperm)
+
+    irreducibleRepresentation(lambda:(L I),listperm:(L PERM I)) ==
+      sumPartition(lambda)
+      alreadyComputed?(lambda)
+      [irreducibleRepresentation(lambda, pi) for pi in listperm]
+
 *)
 
 \end{chunk}
@@ -65242,6 +89374,70 @@ InverseLaplaceTransform(R, F): Exports == Implementation where
 \begin{chunk}{COQ INVLAPLA}
 (* package INVLAPLA *)
 (*
+
+    -- local ops --
+    ilt : (F,Symbol,Symbol) -> Union(F,"failed")
+    ilt1 : (RF,F) -> F
+    iltsqfr : (RF,F) -> F
+    iltirred: (UP,UP,F) -> F
+    freeOf?: (UP,Symbol) -> Boolean
+
+    inverseLaplace(expr,ivar,ovar) == ilt(expr,ivar,ovar)
+
+    freeOf?(p:UP,v:Symbol) ==
+      "and"/[freeOf?(c,v) for c in coefficients p]
+
+    ilt(expr,var,t) ==
+      expr = 0 => 0
+      r := univariate(expr,kernel(var))
+
+      -- Check that r is a rational function such that degree of
+      -- the numarator is lower that degree of denominator
+      not(numer(r) quo denom(r) = 0) => "failed"
+      not( freeOf?(numer r,var) and freeOf?(denom r,var)) => "failed"
+
+      ilt1(r,t::F)
+
+    hintpac := TranscendentalHermiteIntegration(F, UP)
+
+    ilt1(r,t) ==
+      r = 0 => 0
+      rsplit := HermiteIntegrate(r, differentiate)$hintpac
+      -t*ilt1(rsplit.answer,t) + iltsqfr(rsplit.logpart,t)
+
+    iltsqfr(r,t) ==
+       r = 0 => 0
+       p:=numer r
+       q:=denom r
+     --  ql := [qq.factor for qq in factors factor q]
+       ql := [qq.factor for qq in factors squareFree q]
+       # ql = 1 => iltirred(p,q,t)
+       nl := multiEuclidean(ql,p)::List(UP)
+       +/[iltirred(a,b,t) for a in nl for b in ql]
+
+    -- q is irreducible, monic, degree p < degree q
+    iltirred(p,q,t) ==
+      degree q = 1 =>
+        cp := coefficient(p,0)
+        (c:=coefficient(q,0))=0 => cp
+        cp*exp(-c*t)
+      degree q = 2 =>
+        a := coefficient(p,1)
+        b := coefficient(p,0)
+        c:=(-1/2)*coefficient(q,1)
+        d:= coefficient(q,0)
+        e := exp(c*t)
+        b := b+a*c
+        d := d-c**2
+        d > 0 =>
+            alpha:F := sqrt d
+            e*(a*cos(t*alpha) + b*sin(t*alpha)/alpha)
+        alpha :F := sqrt(-d)
+        e*(a*cosh(t*alpha) + b*sinh(t*alpha)/alpha)
+      roots:List F := zerosOf q
+      q1 := differentiate q
+      +/[p(root)/q1(root)*exp(root*t) for root in roots]
+
 *)
 
 \end{chunk}
@@ -65316,9 +89512,11 @@ KernelFunctions2(R:OrderedSet, S:OrderedSet): with
     ++ constantIfCan(k) \undocumented
 
  == add
+
   import BasicOperatorFunctions1(R)
 
   constantKernel r == kernel(constantOperator r, nil(), 1)
+
   constantIfCan k  == constantOpIfCan operator k
 
 \end{chunk}
@@ -65326,6 +89524,13 @@ KernelFunctions2(R:OrderedSet, S:OrderedSet): with
 \begin{chunk}{COQ KERNEL2}
 (* package KERNEL2 *)
 (*
+
+  import BasicOperatorFunctions1(R)
+
+  constantKernel r == kernel(constantOperator r, nil(), 1)
+
+  constantIfCan k  == constantOpIfCan operator k
+
 *)
 
 \end{chunk}
@@ -65419,6 +89624,7 @@ Kovacic(F, UP): Exports == Impl where
       ++ not necessarily into irreducibles.
  
   Impl ==> add
+
     import RationalRicDE(F, UP)
  
     case2       : (RF, LF, UP -> Factored UP) -> Union(SUP, "failed")
@@ -65479,6 +89685,62 @@ Kovacic(F, UP): Exports == Impl where
 \begin{chunk}{COQ KOVACIC}
 (* package KOVACIC *)
 (*
+
+    import RationalRicDE(F, UP)
+ 
+    case2       : (RF, LF, UP -> Factored UP) -> Union(SUP, "failed")
+    cannotCase2?: LF -> Boolean
+ 
+    kovacic(a0, a1, a2) == kovacic(a0, a1, a2, squareFree)
+ 
+    -- it is assumed here that a2 y'' + a1 y' + a0 y is already irreducible
+    -- over the rational functions, i.e. that the associated Riccati equation
+    -- does NOT have rational solutions (so we don't check case 1 of Kovacic's
+    -- algorithm)
+    -- currently only check case 2, not 3
+    kovacic(a0, a1, a2, ezfactor) ==
+      -- transform first the equation to the form y'' = r y
+      -- which makes the Galois group unimodular
+      -- this does not change irreducibility over the rational functions
+    -- the following is split into 5 lines in order to save a couple of
+    -- hours of compile time.
+      r:RF := a1**2 
+      r := r + 2 * a2 * differentiate a1
+      r := r - 2 * a1 * differentiate a2
+      r := r - 4 * a0 * a2
+      r := r  / (4 * a2**2)
+      lf := factors squareFree denom r
+      case2(r, lf, ezfactor)
+ 
+    -- this is case 2 of Kovacic's algorithm, i.e. look for a solution
+    -- of the associated Riccati equation in a quadratic extension
+    -- lf is the squarefree factorisation of denom(r) and is used to
+    -- check the necessary condition
+    case2(r, lf, ezfactor) ==
+      cannotCase2? lf => "failed"
+      -- build the symmetric square of the operator L = y'' - r y
+      -- which is L2 = y''' - 4 r y' - 2 r' y
+      l2:LODO := monomial(1, 3) - monomial(4*r, 1) - 2 * differentiate(r)::LODO
+      -- no solution in this case if L2 has no rational solution
+      empty?(sol := ricDsolve(l2, ezfactor)) => "failed"
+      -- otherwise the defining polynomial for an algebraic solution
+      -- of the Ricatti equation associated with L is
+      -- u^2 - b u + (1/2 b' + 1/2 b^2 - r) = 0
+      -- where b is a rational solution of the Ricatti of L2
+      b := first sol
+      monomial(1, 2)$SUP - monomial(b, 1)$SUP
+                         + ((differentiate(b) + b**2 - 2 * r) / (2::RF))::SUP
+ 
+    -- checks the necessary condition for case 2
+    -- returns true if case 2 cannot have solutions
+    -- the necessary condition is that there is either a factor with
+    -- exponent 2 or odd exponent > 2
+    cannotCase2? lf ==
+      for rec in lf repeat
+        rec.exponent = 2 or (odd?(rec.exponent) and rec.exponent > 2) =>
+          return false
+      true
+
 *)
 
 \end{chunk}
@@ -65567,6 +89829,7 @@ LaplaceTransform(R, F): Exports == Implementation where
       ++ compute the transform.
 
   Implementation ==> add
+
     import IntegrationTools(R, F)
     import ElementaryIntegration(R, F)
     import PatternMatchIntegration(R, F)
@@ -65589,7 +89852,7 @@ LaplaceTransform(R, F): Exports == Implementation where
 
     laplace(f,t,s) == locallaplace(complexElementary(f,t),t,t::F,s,s::F)
 
--- returns true if the highest kernel of f is algebraic over something
+    -- returns true if the highest kernel of f is algebraic over something
     algebraic?(f, t) ==
       l := varselect(kernels f, t)
       m:N := reduce(max, [height k for k in l], 0)$List(N)
@@ -65597,10 +89860,10 @@ LaplaceTransform(R, F): Exports == Implementation where
          height k = m and has?(operator k, ALGOP) => return true
       false
 
--- differentiate a kernel of the form  laplace(l.1,l.2,l.3) w.r.t x.
--- note that x is not necessarily l.3
--- if x = l.3, then there is no use recomputing the laplace transform,
--- it will remain formal anyways
+    -- differentiate a kernel of the form  laplace(l.1,l.2,l.3) w.r.t x.
+    -- note that x is not necessarily l.3
+    -- if x = l.3, then there is no use recomputing the laplace transform,
+    -- it will remain formal anyways
     dvlap(l, x) ==
       l1 := first l
       l2 := second l
@@ -65608,8 +89871,8 @@ LaplaceTransform(R, F): Exports == Implementation where
       e := exp(- l3 * l2)
       locallaplace(differentiate(e * l1, x) / e, retract(l2)@SE, l2, v, l3)
 
--- returns [b, c] iff f = c * t + b
--- and b and c do not involve t
+    -- returns [b, c] iff f = c * t + b
+    -- and b and c do not involve t
     isLinear(f, t) ==
       ff := univariate(f, kernel(t)@K)
       ((d := retractIfCan(denom ff)@Union(F, "failed")) case "failed")
@@ -65618,7 +89881,7 @@ LaplaceTransform(R, F): Exports == Implementation where
         freeOf?(c := coefficient(numer ff, 1) / d, t) => [b, c]
       "failed"
 
--- returns [a, n] iff f = a * t**n
+    -- returns [a, n] iff f = a * t**n
     atn(f, t) ==
       if ((v := isExpt f) case Record(var:K, exponent:Integer)) then
         w := v::Record(var:K, exponent:Integer)
@@ -65638,8 +89901,8 @@ LaplaceTransform(R, F): Exports == Implementation where
         [c, d::PI]
       "failed"
 
--- returns [a, c, b] iff f = a * exp(c * t + b)
--- and b and c do not involve t
+    -- returns [a, c, b] iff f = a * exp(c * t + b)
+    -- and b and c do not involve t
     aexp(f, t) ==
       is?(f, "exp"::SE) =>
         (v := isLinear(first argument(retract(f)@K),t)) case "failed" =>
@@ -65671,7 +89934,7 @@ LaplaceTransform(R, F): Exports == Implementation where
       d := denom f
       [p / d for p in u::List(SparseMultivariatePolynomial(R, K))]
 
--- returns g if f = g/t
+    -- returns g if f = g/t
     tdenom(f, t) ==
       (denom f exquo numer t) case "failed" => "failed"
       t * f
@@ -65708,7 +89971,6 @@ LaplaceTransform(R, F): Exports == Implementation where
     -- or using one of known base cases
     locallaplace(f, t, tt, s, ss) ==
       zero? f => 0
---      one? f  => inv ss
       (f = 1)  => inv ss
 
       -- laplace(f(t)/t,t,s) 
@@ -65738,18 +90000,6 @@ LaplaceTransform(R, F): Exports == Implementation where
       -- Try base cases
       (x := lapkernel(f, t, tt, ss)) case F => x::F
 
---    -- The following does not seem to help computing transforms, but
---    -- quite frequently leads to loops, so I (wh) disabled it for now
---    -- last chance option: try to use the fact that
---    --    laplace(f(t),t,s) = s laplace(g(t),t,s) - g(0)  where dg/dt = f(t)
---    elem?(int := lfintegrate(f, t)) and (rint := retractIfCan int) case F =>
---        fint := rint :: F
---        -- to avoid infinite loops, we don't call laplace recursively
---        -- if the integral has no new logs and f is an algebraic function
---        empty?(logpart int) and algebraic?(f, t) => oplap(fint, tt, ss)
---        ss * locallaplace(fint, t, tt, s, ss) - eval(fint, tt = 0)
-      oplap(f, tt, ss)
-
     setProperty(oplap,SPECIALDIFF,dvlap@((List F,SE)->F) pretend None)
 
 \end{chunk}
@@ -65757,6 +90007,179 @@ LaplaceTransform(R, F): Exports == Implementation where
 \begin{chunk}{COQ LAPLACE}
 (* package LAPLACE *)
 (*
+
+    import IntegrationTools(R, F)
+    import ElementaryIntegration(R, F)
+    import PatternMatchIntegration(R, F)
+    import PowerSeriesLimitPackage(R, F)
+    import FunctionSpaceIntegration(R, F)
+    import TrigonometricManipulations(R, F)
+
+    locallaplace : (F, SE, F, SE, F) -> F
+    lapkernel    : (F, SE, F, F) -> Union(F, "failed")
+    intlaplace   : (F, F, F, SE, F) -> Union(F, "failed")
+    isLinear     : (F, SE) -> Union(Record(const:F, nconst:F), "failed")
+    mkPlus       : F -> Union(List F, "failed")
+    dvlap        : (List F, SE) -> F
+    tdenom       : (F, F) -> Union(F, "failed")
+    atn          : (F, SE) -> Union(Record(coef:F, deg:PI), "failed")
+    aexp         : (F, SE) -> Union(Record(coef:F, coef1:F, coef0:F), "failed")
+    algebraic?   : (F, SE) -> Boolean
+
+    oplap := operator("laplace"::Symbol, 3)$BasicOperator
+
+    laplace(f,t,s) == locallaplace(complexElementary(f,t),t,t::F,s,s::F)
+
+    -- returns true if the highest kernel of f is algebraic over something
+    algebraic?(f, t) ==
+      l := varselect(kernels f, t)
+      m:N := reduce(max, [height k for k in l], 0)$List(N)
+      for k in l repeat
+         height k = m and has?(operator k, ALGOP) => return true
+      false
+
+    -- differentiate a kernel of the form  laplace(l.1,l.2,l.3) w.r.t x.
+    -- note that x is not necessarily l.3
+    -- if x = l.3, then there is no use recomputing the laplace transform,
+    -- it will remain formal anyways
+    dvlap(l, x) ==
+      l1 := first l
+      l2 := second l
+      x = (v := retract(l3 := third l)@SE) => - oplap(l2 * l1, l2, l3)
+      e := exp(- l3 * l2)
+      locallaplace(differentiate(e * l1, x) / e, retract(l2)@SE, l2, v, l3)
+
+    -- returns [b, c] iff f = c * t + b
+    -- and b and c do not involve t
+    isLinear(f, t) ==
+      ff := univariate(f, kernel(t)@K)
+      ((d := retractIfCan(denom ff)@Union(F, "failed")) case "failed")
+        or (degree(numer ff) > 1) => "failed"
+      freeOf?(b := coefficient(numer ff, 0) / d, t) and
+        freeOf?(c := coefficient(numer ff, 1) / d, t) => [b, c]
+      "failed"
+
+    -- returns [a, n] iff f = a * t**n
+    atn(f, t) ==
+      if ((v := isExpt f) case Record(var:K, exponent:Integer)) then
+        w := v::Record(var:K, exponent:Integer)
+        (w.exponent > 0) and
+          ((vv := symbolIfCan(w.var)) case SE) and (vv::SE = t) =>
+            return [1, w.exponent::PI]
+      (u := isTimes f) case List(F) =>
+        c:F  := 1
+        d:N  := 0
+        for g in u::List(F) repeat
+          if (rec := atn(g, t)) case Record(coef:F, deg:PI) then
+            r := rec::Record(coef:F, deg:PI)
+            c := c * r.coef
+            d := d + r.deg
+          else c := c * g
+        zero? d => "failed"
+        [c, d::PI]
+      "failed"
+
+    -- returns [a, c, b] iff f = a * exp(c * t + b)
+    -- and b and c do not involve t
+    aexp(f, t) ==
+      is?(f, "exp"::SE) =>
+        (v := isLinear(first argument(retract(f)@K),t)) case "failed" =>
+           "failed"
+        [1, v.nconst, v.const]
+      (u := isTimes f) case List(F) =>
+        c:F := 1
+        c1 := c0 := 0$F
+        for g in u::List(F) repeat
+          if (r := aexp(g,t)) case Record(coef:F,coef1:F,coef0:F) then
+            rec := r::Record(coef:F, coef1:F, coef0:F)
+            c   := c * rec.coef
+            c0  := c0 + rec.coef0
+            c1  := c1 + rec.coef1
+          else c := c * g
+        zero? c0 and zero? c1 => "failed"
+        [c, c1, c0]
+      if (v := isPower f) case Record(val:F, exponent:Integer) then
+        w := v::Record(val:F, exponent:Integer)
+        (w.exponent ^= 1) and
+          ((r := aexp(w.val, t)) case Record(coef:F,coef1:F,coef0:F)) =>
+            rec := r::Record(coef:F, coef1:F, coef0:F)
+            return [rec.coef ** w.exponent, w.exponent * rec.coef1,
+                                            w.exponent * rec.coef0]
+      "failed"
+
+    mkPlus f ==
+      (u := isPlus numer f) case "failed" => "failed"
+      d := denom f
+      [p / d for p in u::List(SparseMultivariatePolynomial(R, K))]
+
+    -- returns g if f = g/t
+    tdenom(f, t) ==
+      (denom f exquo numer t) case "failed" => "failed"
+      t * f
+
+    intlaplace(f, ss, g, v, vv) ==
+      is?(g, oplap) or ((i := integrate(g, v)) case List(F)) => "failed"
+      (u:=limit(i::F,equation(vv::OFE,plusInfinity()$OFE)$EQ)) case OFE =>
+        (l := limit(i::F, equation(vv::OFE, ss::OFE)$EQ)) case OFE =>
+          retractIfCan(u::OFE - l::OFE)@Union(F, "failed")
+        "failed"
+      "failed"
+
+    lapkernel(f, t, tt, ss) ==
+      (k := retractIfCan(f)@Union(K, "failed")) case "failed" => "failed"
+      empty?(arg := argument(k::K)) => "failed"
+      is?(op := operator k, "%diff"::SE) =>
+        not( #arg = 3) => "failed"
+        not(is?(arg.3, t)) => "failed"
+        fint := eval(arg.1, arg.2, tt)
+        s := name operator (kernels(ss).1)
+        ss * locallaplace(fint, t, tt, s, ss) - eval(fint, tt = 0)
+      not (empty?(rest arg)) => "failed"
+      member?(t, variables(a := first(arg) / tt)) => "failed"
+      is?(op := operator k, "Si"::SE) => atan(a / ss) / ss
+      is?(op, "Ci"::SE) => log((ss**2 + a**2) / a**2) / (2 * ss)
+      is?(op, "Ei"::SE) => log((ss + a) / a) / ss
+      -- digamma (or Gamma) needs SpecialFunctionCategory
+      -- which we do not have here
+      -- is?(op, "log"::SE) => (digamma(1) - log(a) - log(ss)) / ss
+      "failed"
+
+    -- Below we try to apply one of the texbook rules for computing
+    -- Laplace transforms, either reducing problem to simpler cases
+    -- or using one of known base cases
+    locallaplace(f, t, tt, s, ss) ==
+      zero? f => 0
+      (f = 1)  => inv ss
+
+      -- laplace(f(t)/t,t,s) 
+      --              = integrate(laplace(f(t),t,v), v = s..%plusInfinity)
+      (x := tdenom(f, tt)) case F =>
+        g := locallaplace(x::F, t, tt, vv := new()$SE, vvv := vv::F)
+        (x := intlaplace(f, ss, g, vv, vvv)) case F => x::F
+        oplap(f, tt, ss)
+
+      -- Use linearity
+      (u := mkPlus f) case List(F) =>
+        +/[locallaplace(g, t, tt, s, ss) for g in u::List(F)]
+      (rec := splitConstant(f, t)).const ^= 1 =>
+        rec.const * locallaplace(rec.nconst, t, tt, s, ss)
+
+      -- laplace(t^n*f(t),t,s) = (-1)^n*D(laplace(f(t),t,s), s, n))
+      (v := atn(f, t)) case Record(coef:F, deg:PI) =>
+        vv := v::Record(coef:F, deg:PI)
+        is?(la := locallaplace(vv.coef, t, tt, s, ss), oplap) => oplap(f,tt,ss)
+        (-1$Integer)**(vv.deg) * differentiate(la, s, vv.deg)
+
+      -- Complex shift rule
+      (w := aexp(f, t)) case Record(coef:F, coef1:F, coef0:F) =>
+        ww := w::Record(coef:F, coef1:F, coef0:F)
+        exp(ww.coef0) * locallaplace(ww.coef,t,tt,s,ss - ww.coef1)
+
+      -- Try base cases
+      (x := lapkernel(f, t, tt, ss)) case F => x::F
+
+    setProperty(oplap,SPECIALDIFF,dvlap@((List F,SE)->F) pretend None)
+
 *)
 
 \end{chunk}
@@ -66923,6 +91346,62 @@ LazardSetSolvingPackage(R,E,V,P,TS,ST): Exports == Implementation where
 \begin{chunk}{COQ LAZM3PK}
 (* package LAZM3PK *)
 (*
+
+     convert(st: ST): TS ==
+       ts: TS := empty()
+       lp: LP := members(st)$ST
+       lp := sort(infRittWu?,lp)
+       for p in lp repeat
+         ts := internalAugment(p,ts)$TS
+       ts
+
+     squareFree(ts: TS): List ST ==
+       empty? ts => [empty()$ST]
+       lp: LP := members(ts)$TS
+       lp := sort(infRittWu?,lp)
+       newts: ST := empty()$ST
+       toSee: List ST := [newts]
+       toSave: List ST
+       for p in lp repeat
+         toSave := []
+         while (not empty? toSee) repeat
+           us := first toSee; toSee := rest toSee
+           lpwt := stoseSquareFreePart(p,us)$regsetgcdpack
+           for pwt in lpwt repeat
+             newus := internalAugment(pwt.val,pwt.tower)$ST
+             toSave := cons(newus,toSave)
+         toSee := toSave
+       toSave
+
+     normalizeIfCan(ts: ST): ST ==
+       empty? ts => ts
+       lp: LP := members(ts)$ST
+       lp := sort(infRittWu?,lp)
+       p: P := first lp
+       not univariate?(p)$polsetpack => ts
+       lp := rest lp
+       newts: ST := empty()$ST
+       newts := internalAugment(p,newts)$ST
+       while (not empty? lp) repeat
+         p := first lp
+         lv := variables(p)
+         for v in lv repeat
+           v = mvar(p) => "leave"
+           not algebraic?(v,newts) => return internalAugment(lp,newts)$ST
+         lp := rest lp
+         p := normalizedAssociate(p,newts)$normalizpack
+         newts := internalAugment(p,newts)$ST
+       newts
+
+     zeroSetSplit(lp:List(P), clos?:B): List ST ==
+       -- if clos? then SOLVE in the closure sense 
+       toSee: Split := zeroSetSplit(lp, clos?)$TS
+       toSave: List ST := []
+       for ts in toSee repeat 
+         toSave := concat(squareFree(ts),toSave)
+       toSave := removeSuperfluousQuasiComponents(toSave)$quasicomppack
+       [normalizeIfCan(ts) for ts in toSave]
+
 *)
 
 \end{chunk}
@@ -67022,6 +91501,7 @@ LeadingCoefDetermination(OV,E,Z,P) : C == T
      ++ factors, 
  
   T == add
+
     distribute: (Z,List(BP),List(P),List(Z),List(OV),List(Z)) -> LeadFact
     checkpow  : (Z,Z) -> NNI
  
@@ -67098,6 +91578,78 @@ LeadingCoefDetermination(OV,E,Z,P) : C == T
 \begin{chunk}{COQ LEADCDET}
 (* package LEADCDET *)
 (*
+
+    distribute: (Z,List(BP),List(P),List(Z),List(OV),List(Z)) -> LeadFact
+    checkpow  : (Z,Z) -> NNI
+ 
+    polCase(d:Z,nk:NNI,lval:List(Z)):Boolean ==
+      -- d is the product of the content lc m (case polynomial)
+      -- and the cont of the polynomial evaluated
+      q:Z
+      distlist:List(Z) := [d]
+      for i in 1..nk repeat
+        q := unitNormal(lval.i).canonical
+        for j in 0..(i-1)::NNI repeat
+          y := distlist.((i-j)::NNI)
+          while y^=1  repeat
+            y := gcd(y,q)
+            q := q quo y
+          if q=1 then return false
+        distlist := append(distlist,[q])
+      true
+ 
+    checkpow(a:Z,b:Z) : NonNegativeInteger ==
+      qt: Union(Z,"failed")
+      for i in 0.. repeat
+        qt:= b exquo a
+        if qt case "failed" then return i
+        b:=qt::Z
+ 
+    distribute(contm:Z,unilist:List(BP),pl:List(P),vl:List(Z),
+                              lvar:List(OV),lval:List(Z)): LeadFact ==
+      d,lcp : Z
+      nf:NNI:=#unilist
+      for i in 1..nf repeat
+          lcp := leadingCoefficient (unilist.i)
+          d:= gcd(lcp,vl.i)
+          pl.i := (lcp quo d)*pl.i
+          d := vl.i quo d
+          unilist.i := d*unilist.i
+          contm := contm quo d
+      if contm ^=1 then for i in 1..nf repeat pl.i := contm*pl.i
+      [pl,contm,unilist]$LeadFact
+ 
+    distFact(contm:Z,unilist:List(BP),plead:FinalFact,
+             vl:List(Z),lvar:List(OV),lval:List(Z)):Union(LeadFact,"failed") ==
+      h:NonNegativeInteger
+      c,d : Z
+      lpol:List(P):=[]
+      lexp:List(Integer):=[]
+      nf:NNI := #unilist
+      vl := reverse vl --lpol and vl reversed so test from right to left
+      for fpl in plead.factors repeat
+       lpol:=[fpl.irr,:lpol]
+       lexp:=[fpl.pow,:lexp]
+      vlp:List(Z):= [1$Z for i in 1..nf]
+      aux : List(P) := [1$P for i in 1..nf]
+      for i in 1..nf repeat
+        c := contm*leadingCoefficient unilist.i
+        c=1 or c=-1  => "next i"
+        for k in 1..(# lpol) repeat
+          lexp.k=0 => "next factor"
+          h:= checkpow(vl.k,c)
+          if h ^=0 then
+           if h>lexp.k then return "failed"
+           lexp.k:=lexp.k-h
+           aux.i := aux.i*(lpol.k ** h)
+           d:= vl.k**h
+           vlp.i:= vlp.i*d
+           c:= c quo d
+        if contm=1 then vlp.i:=c
+      for k in 1..(# lpol) repeat if lexp.k ^= 0 then return "failed"
+      contm =1 => [[vlp.i*aux.i for i in 1..nf],1,unilist]$LeadFact
+      distribute(contm,unilist,aux,vlp,lvar,lval)
+
 *)
 
 \end{chunk}
@@ -70694,14 +95246,16 @@ LexTriangularPackage(R,ls): Exports == Implementation where
          ++ Thus a point belongs to this variety iff it is a regular
          ++ zero of a regular set in in the output.
          ++ Note that \axiom{lp} needs to generate a zero-dimensional ideal.
-         ++ If \axiom{norm?} is \axiom{true} then the regular sets are normalized.
+         ++ If \axiom{norm?} is \axiom{true} then the regular sets 
+         ++ are normalized.
      zeroSetSplit: (LP, B) -> List ST
          ++ \axiom{zeroSetSplit(lp, norm?)} decomposes the variety
          ++ associated with \axiom{lp} into square-free regular chains.
          ++ Thus a point belongs to this variety iff it is a regular
          ++ zero of a regular set in in the output.
          ++ Note that \axiom{lp} needs to generate a zero-dimensional ideal.
-         ++ If \axiom{norm?} is \axiom{true} then the regular sets are normalized.
+         ++ If \axiom{norm?} is \axiom{true} then the regular sets 
+         ++ are normalized.
 
   Implementation == add
 
@@ -70826,6 +95380,123 @@ LexTriangularPackage(R,ls): Exports == Implementation where
 \begin{chunk}{COQ LEXTRIPK}
 (* package LEXTRIPK *)
 (*
+
+     trueVariables(lp: List(P)): List Symbol ==
+       lv: List V := variables([lp]$PS)
+       truels: List Symbol := []
+       for s in ls repeat
+         if member?(variable(s)::V, lv) then truels := cons(s,truels)
+       reverse truels
+
+     zeroDimensional?(lp:List(P)): Boolean ==
+       truels: List Symbol := trueVariables(lp)
+       fglmpack := FGLMIfCanPackage(R,truels)
+       lq1: List(Q1) := [p::Q1 for p in lp]
+       zeroDimensional?(lq1)$fglmpack
+
+     fglmIfCan(lp:List(P)): Union(List(P), "failed") ==
+       truels: List Symbol := trueVariables(lp)
+       fglmpack := FGLMIfCanPackage(R,truels)
+       lq1: List(Q1) := [p::Q1 for p in lp]
+       foo := fglmIfCan(lq1)$fglmpack
+       foo case "failed" => return("failed" :: Union(List(P), "failed"))
+       lp := [retract(q1)$P for q1 in (foo :: List(Q1))]
+       lp::Union(List(P), "failed")
+
+     groebner(lp:List(P)): List(P) ==
+       truels: List Symbol := trueVariables(lp)
+       fglmpack := FGLMIfCanPackage(R,truels)
+       lq1: List(Q1) := [p::Q1 for p in lp]
+       lq1 := groebner(lq1)$fglmpack
+       lp := [retract(q1)$P for q1 in lq1]
+
+     lexTriangular(base: List(P), norm?: Boolean): List(TS) ==
+       base := sort(infRittWu?,base)
+       base := remove(zero?, base)
+       any?(ground?, base) => []
+       ts: TS := empty()
+       toSee: List LpWTS := [[base,ts]$LpWTS]
+       toSave: List TS := []
+       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; v := mvar(p)
+         algebraic?(v,ts) =>
+           error "lexTriangular$LEXTRIPK: should never happen !"
+         norm? and zero? remainder(init(p),ts).polnum => 
+           toSee := cons([lp, ts]$LpWTS, toSee)
+         (not norm?) and zero? (initiallyReduce(init(p),ts)) => 
+           toSee := cons([lp, ts]$LpWTS, toSee)
+         lbwt: List BWTS := invertible?(init(p),ts)$TS
+         while (not empty? lbwt) repeat
+           bwt := first lbwt; lbwt := rest lbwt
+           b := bwt.val; us := bwt.tower
+           (not b) => toSee := cons([lp, us], toSee)
+           lus: List TS
+           if norm?
+             then 
+               newp := normalizedAssociate(p,us)$normalizpackTS
+               lus := [internalAugment(newp,us)$TS]
+             else 
+               newp := p
+               lus := augment(newp,us)$TS
+           newlp := lp 
+           while (not empty? newlp) and (mvar(first newlp) = v) repeat
+             newlp := rest newlp
+           for us in lus repeat
+             toSee := cons([newlp, us]$LpWTS, toSee)
+       algebraicSort(toSave)$quasicomppackTS
+
+     zeroSetSplit(lp:List(P), norm?:B): List TS ==
+       bar := fglmIfCan(lp)
+       bar case "failed" =>
+         error "zeroSetSplit$LEXTRIPK: #1 not zero-dimensional"
+       lexTriangular(bar::(List P),norm?)
+
+     squareFreeLexTriangular(base: List(P), norm?: Boolean): List(ST) ==
+       base := sort(infRittWu?,base)
+       base := remove(zero?, base)
+       any?(ground?, base) => []
+       ts: ST := empty()
+       toSee: List LpWST := [[base,ts]$LpWST]
+       toSave: List ST := []
+       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; v := mvar(p)
+         algebraic?(v,ts) =>
+           error "lexTriangular$LEXTRIPK: should never happen !"
+         norm? and zero? remainder(init(p),ts).polnum => 
+           toSee := cons([lp, ts]$LpWST, toSee)
+         (not norm?) and zero? (initiallyReduce(init(p),ts)) => 
+           toSee := cons([lp, ts]$LpWST, toSee)
+         lbwt: List BWST := invertible?(init(p),ts)$ST
+         while (not empty? lbwt) repeat
+           bwt := first lbwt; lbwt := rest lbwt
+           b := bwt.val; us := bwt.tower
+           (not b) => toSee := cons([lp, us], toSee)
+           lus: List ST
+           if norm?
+             then 
+               newp := normalizedAssociate(p,us)$normalizpackST
+               lus := augment(newp,us)$ST
+             else
+               lus := augment(p,us)$ST
+           newlp := lp 
+           while (not empty? newlp) and (mvar(first newlp) = v) repeat
+             newlp := rest newlp
+           for us in lus repeat
+             toSee := cons([newlp, us]$LpWST, toSee)
+       algebraicSort(toSave)$quasicomppackST
+
+     zeroSetSplit(lp:List(P), norm?:B): List ST ==
+       bar := fglmIfCan(lp)
+       bar case "failed" =>
+         error "zeroSetSplit$LEXTRIPK: #1 not zero-dimensional"
+       squareFreeLexTriangular(bar::(List P),norm?)
+
 *)
 
 \end{chunk}
@@ -70919,6 +95590,7 @@ LinearDependence(S, R): Exports == Implementation where
         ++ "failed" if no such ci's exist in the quotient field of S.
 
   Implementation ==> add
+
     aNonZeroSolution: Matrix S -> Union(Vector S, "failed")
 
     aNonZeroSolution m ==
@@ -70927,19 +95599,18 @@ LinearDependence(S, R): Exports == Implementation where
 
     linearlyDependent? v ==
       zero?(n := #v) => true
---      one? n => zero?(v(minIndex v))
       (n = 1) => zero?(v(minIndex v))
       positive? nullity reducedSystem transpose v
 
     linearDependence v ==
       zero?(n := #v) => empty()
---      one? n =>
       (n = 1) =>
         zero?(v(minIndex v)) => new(1, 1)
         "failed"
       aNonZeroSolution reducedSystem transpose v
 
     if S has Field then
+
       solveLinear(v:Vector R, c:R):Union(Vector S, "failed") ==
         zero? c => new(#v, 0)
         empty? v => "failed"
@@ -70948,6 +95619,7 @@ LinearDependence(S, R): Exports == Implementation where
                                            Vector S, Vector S, Matrix S)
 
     else
+
       solveLinear(v:Vector R, c:R):Union(Vector Q, "failed") ==
         zero? c => new(#v, 0)
         empty? v => "failed"
@@ -70964,6 +95636,47 @@ LinearDependence(S, R): Exports == Implementation where
 \begin{chunk}{COQ LINDEP}
 (* package LINDEP *)
 (*
+
+    aNonZeroSolution: Matrix S -> Union(Vector S, "failed")
+
+    aNonZeroSolution m ==
+      every?(zero?, v := first nullSpace m) => "failed"
+      v
+
+    linearlyDependent? v ==
+      zero?(n := #v) => true
+      (n = 1) => zero?(v(minIndex v))
+      positive? nullity reducedSystem transpose v
+
+    linearDependence v ==
+      zero?(n := #v) => empty()
+      (n = 1) =>
+        zero?(v(minIndex v)) => new(1, 1)
+        "failed"
+      aNonZeroSolution reducedSystem transpose v
+
+    if S has Field then
+
+      solveLinear(v:Vector R, c:R):Union(Vector S, "failed") ==
+        zero? c => new(#v, 0)
+        empty? v => "failed"
+        sys := reducedSystem(transpose v, new(1, c))
+        particularSolution(sys.mat, sys.vec)$LinearSystemMatrixPackage(S,
+                                           Vector S, Vector S, Matrix S)
+
+    else
+
+      solveLinear(v:Vector R, c:R):Union(Vector Q, "failed") ==
+        zero? c => new(#v, 0)
+        empty? v => "failed"
+        sys := reducedSystem(transpose v, new(1, c))
+        particularSolution(map((z:S):Q+->z::Q, sys.mat)_
+          $MatrixCategoryFunctions2(S,
+               Vector S,Vector S,Matrix S,Q,Vector Q,Vector Q,Matrix Q),
+                  map((z1:S):Q+->z1::Q, sys.vec)$VectorFunctions2(S, Q)
+                                    )$LinearSystemMatrixPackage(Q,
+                                           Vector Q, Vector Q, Matrix Q)
+
 *)
 
 \end{chunk}
@@ -71054,9 +95767,9 @@ LinearOrdinaryDifferentialOperatorFactorizer(F, UP): Exports == Impl where
         ++ assuming that a has no first-order right factor.
  
   Impl ==> add
+
     import RationalLODE(F, UP)
     import RationalRicDE(F, UP)
---  import AssociatedEquations RF
  
     dd := D()$L
  
@@ -71080,7 +95793,7 @@ LinearOrdinaryDifferentialOperatorFactorizer(F, UP): Exports == Impl where
       not(all? or empty? sol) => sol
       concat(sol, ricDsolve(l, zeros, ezfactor))
  
--- opeval(l1, l2) returns l1(l2)
+    -- opeval(l1, l2) returns l1(l2)
     opeval(l1, l2) ==
       ans:L := 0
       l2n:L := 1
@@ -71095,13 +95808,12 @@ LinearOrdinaryDifferentialOperatorFactorizer(F, UP): Exports == Impl where
       innerFactor(q, zeros, ezfactor, true)
  
     rfactor(op, r, zeros, ezfactor, adj?) ==
---      degree r > 1 or not one? leadingCoefficient r =>
       degree r > 1 or not ((leadingCoefficient r) = 1) =>
         recurfactor(op, r, zeros, ezfactor, adj?)
       op1 := opeval(op, dd - coefficient(r, 0)::L)
       map_!((z:L):L+->opeval(z,r), recurfactor(op1, dd, zeros, ezfactor, adj?))
  
--- r1? is true means look for 1st-order right-factor also
+    -- r1? is true means look for 1st-order right-factor also
     innerFactor(l, zeros, ezfactor, r1?) ==
       (n := degree l) <= 1 => [l]
       ll := adjoint l
@@ -71113,12 +95825,9 @@ LinearOrdinaryDifferentialOperatorFactorizer(F, UP): Exports == Impl where
       [l]
  
     rightFactor(l, n, zeros, ezfactor) ==
---      one? n =>
       (n = 1) =>
         (u := expsol(l, zeros, ezfactor)) case "failed" => "failed"
         D() - u::RF::L
---    rec := associatedEquations(l, n::PositiveInteger)
---    empty?(sol := expsols(rec.eq, zeros, ezfactor, true)) => "failed"
       "failed"
  
     if F has AlgebraicallyClosedField then
@@ -71134,16 +95843,20 @@ LinearOrdinaryDifferentialOperatorFactorizer(F, UP): Exports == Impl where
                                              F, SparseUnivariatePolynomial F))]
  
       if F is AlgebraicNumber then
+
         import AlgFactor UP
  
         factor l  == 
           innerFactor(l,(p:UP):List(F)+->zro(p,factor),factor,true)
+
         factor1 l == 
           innerFactor(l,(p:UP):List(F)+->zro(p,factor),factor,false)
  
       else
+
         factor l  == 
           innerFactor(l,(p:UP):List(F)+->zro(p,squareFree),squareFree,true)
+
         factor1 l == 
           innerFactor(l,(p:UP):List(F)+->zro(p,squareFree),squareFree,false)
 
@@ -71152,6 +95865,99 @@ LinearOrdinaryDifferentialOperatorFactorizer(F, UP): Exports == Impl where
 \begin{chunk}{COQ LODOF}
 (* package LODOF *)
 (*
+
+    import RationalLODE(F, UP)
+    import RationalRicDE(F, UP)
+ 
+    dd := D()$L
+ 
+    expsol     : (L, UP -> List F, UP -> Factored UP) -> Union(RF, "failed")
+    expsols    : (L, UP -> List F, UP -> Factored UP, Boolean) -> List RF
+    opeval     : (L, L) -> L
+    recurfactor: (L, L, UP -> List F, UP -> Factored UP, Boolean) -> List L
+    rfactor    : (L, L, UP -> List F, UP -> Factored UP, Boolean) -> List L
+    rightFactor: (L, NonNegativeInteger, UP -> List F, UP -> Factored UP)
+                                                          -> Union(L, "failed")
+    innerFactor: (L, UP -> List F, UP -> Factored UP, Boolean) -> List L
+ 
+    factor(l, zeros) == innerFactor(l, zeros, squareFree, true)
+ 
+    expsol(l, zeros, ezfactor) ==
+      empty?(sol := expsols(l, zeros, ezfactor, false)) => "failed"
+      first sol
+ 
+    expsols(l, zeros, ezfactor, all?) ==
+      sol := [differentiate(f)/f for f in ratDsolve(l, 0).basis | f ^= 0]
+      not(all? or empty? sol) => sol
+      concat(sol, ricDsolve(l, zeros, ezfactor))
+ 
+    -- opeval(l1, l2) returns l1(l2)
+    opeval(l1, l2) ==
+      ans:L := 0
+      l2n:L := 1
+      for i in 0..degree l1 repeat
+        ans := ans + coefficient(l1, i) * l2n
+        l2n := l2 * l2n
+      ans
+      
+    recurfactor(l, r, zeros, ezfactor, adj?) ==
+      q := rightExactQuotient(l, r)::L
+      if adj? then q := adjoint q
+      innerFactor(q, zeros, ezfactor, true)
+ 
+    rfactor(op, r, zeros, ezfactor, adj?) ==
+      degree r > 1 or not ((leadingCoefficient r) = 1) =>
+        recurfactor(op, r, zeros, ezfactor, adj?)
+      op1 := opeval(op, dd - coefficient(r, 0)::L)
+      map_!((z:L):L+->opeval(z,r), recurfactor(op1, dd, zeros, ezfactor, adj?))
+ 
+    -- r1? is true means look for 1st-order right-factor also
+    innerFactor(l, zeros, ezfactor, r1?) ==
+      (n := degree l) <= 1 => [l]
+      ll := adjoint l
+      for i in 1..(n quo 2) repeat
+        (r1? or (i > 1)) and ((u := rightFactor(l,i,zeros,ezfactor)) case L) =>
+           return concat_!(rfactor(l, u::L, zeros, ezfactor, false), u::L)
+        (2 * i < n) and ((u := rightFactor(ll, i, zeros, ezfactor)) case L) =>
+           return concat(adjoint(u::L), rfactor(ll, u::L, zeros,ezfactor,true))
+      [l]
+ 
+    rightFactor(l, n, zeros, ezfactor) ==
+      (n = 1) =>
+        (u := expsol(l, zeros, ezfactor)) case "failed" => "failed"
+        D() - u::RF::L
+      "failed"
+ 
+    if F has AlgebraicallyClosedField then
+      zro1: UP -> List F
+      zro : (UP, UP -> Factored UP) -> List F
+ 
+      zro(p, ezfactor) ==
+        concat [zro1(r.factor) for r in factors ezfactor p]
+ 
+      zro1 p ==
+        [zeroOf(map((z1:F):F+->z1,p)_
+          $UnivariatePolynomialCategoryFunctions2(F, UP,
+                                             F, SparseUnivariatePolynomial F))]
+ 
+      if F is AlgebraicNumber then
+
+        import AlgFactor UP
+ 
+        factor l  == 
+          innerFactor(l,(p:UP):List(F)+->zro(p,factor),factor,true)
+
+        factor1 l == 
+          innerFactor(l,(p:UP):List(F)+->zro(p,factor),factor,false)
+ 
+      else
+
+        factor l  == 
+          innerFactor(l,(p:UP):List(F)+->zro(p,squareFree),squareFree,true)
+
+        factor1 l == 
+          innerFactor(l,(p:UP):List(F)+->zro(p,squareFree),squareFree,false)
+
 *)
 
 \end{chunk}
@@ -71253,6 +96059,7 @@ LinearOrdinaryDifferentialOperatorsOps(A, L): Exports == Implementation where
             ++ D is the derivation to use.
 
     Implementation ==> add
+
           import IntegerCombinatoricFunctions
 
           var1 := new()$Symbol
@@ -71264,6 +96071,7 @@ LinearOrdinaryDifferentialOperatorsOps(A, L): Exports == Implementation where
           vec2LODO   : Vector A -> L
 
           nonTrivial? v == any?((x1:A):Boolean +-> x1 ^= 0, v)$Vector(A)
+
           vec2LODO v    == +/[monomial(v.i, (i-1)::N) for i in 1..#v]
 
           symmetricPower(l, m, diff) ==
@@ -71320,6 +96128,70 @@ LinearOrdinaryDifferentialOperatorsOps(A, L): Exports == Implementation where
 \begin{chunk}{COQ LODOOPS}
 (* package LODOOPS *)
 (*
+
+          import IntegerCombinatoricFunctions
+
+          var1 := new()$Symbol
+          var2 := new()$Symbol
+
+          nonTrivial?: Vector A -> Boolean
+          applyLODO  : (L, V) -> P
+          killer     : (P, N, List V, List P, A -> A) -> L
+          vec2LODO   : Vector A -> L
+
+          nonTrivial? v == any?((x1:A):Boolean +-> x1 ^= 0, v)$Vector(A)
+
+          vec2LODO v    == +/[monomial(v.i, (i-1)::N) for i in 1..#v]
+
+          symmetricPower(l, m, diff) ==
+            u := var1::V; n := degree l
+            un := differentiate(u, n)
+            a  := applyLODO(inv(- leadingCoefficient l) * reductum l, u)
+            killer(u::P ** m, binomial(n + m - 1, n - 1)::N, [un], [a], diff)
+
+-- returns an operator L such that L(u) = 0, for a given differential
+-- polynomial u, given that the differential variables appearing in u
+-- satisfy some linear ode's
+-- m is a bound on the order of the operator searched.
+-- lvar, lval describe the substitution(s) to perform when differentiating
+--     the expression u (they encode the fact the the differential variables
+--     satisfy some differential equations, which can be seen as the rewrite
+--     rules   lvar --> lval)
+-- diff is the derivation to use
+          killer(u, m, lvar, lval, diff) ==
+            lu:List P := [u]
+            for q in 0..m repeat
+              mat := reducedSystem(matrix([lu])@Matrix(P))@Matrix(A)
+              (sol := find(nonTrivial?, l := nullSpace mat)) case Vector(A) =>
+                return vec2LODO(sol::Vector(A))
+              u := eval(differentiate(u, diff), lvar, lval)
+              lu := concat_!(lu, [u])
+            error "killer: no linear dependence found"
+
+          symmetricProduct(l1, l2, diff) ==
+            u  := var1::V;   v  := var2::V
+            n1 := degree l1; n2 := degree l2
+            un := differentiate(u, n1); vn := differentiate(v, n2)
+            a  := applyLODO(inv(- leadingCoefficient l1) * reductum l1, u)
+            b  := applyLODO(inv(- leadingCoefficient l2) * reductum l2, v)
+            killer(u::P * v::P, n1 * n2, [un, vn], [a, b], diff)
+
+          directSum(l1, l2, diff) ==
+            u  := var1::V;   v  := var2::V
+            n1 := degree l1; n2 := degree l2
+            un := differentiate(u, n1); vn := differentiate(v, n2)
+            a  := applyLODO(inv(- leadingCoefficient l1) * reductum l1, u)
+            b  := applyLODO(inv(- leadingCoefficient l2) * reductum l2, v)
+            killer(u::P + v::P, n1 + n2, [un, vn], [a, b], diff)
+
+          applyLODO(l, v) ==
+            p:P := 0
+            while l ^= 0 repeat
+              p := p + monomial(leadingCoefficient(l)::P,
+                                  differentiate(v, degree l), 1)
+              l := reductum l
+            p
+
 *)
 
 \end{chunk}
@@ -71396,6 +96268,7 @@ LinearPolynomialEquationByFractions(R:PolynomialFactorizationExplicit): with
         ++ \spad{g/prod fi = sum ai/fi}
         ++ or returns "failed" if no such exists.
  == add
+
   SupR ==> SparseUnivariatePolynomial R
   F ==> Fraction R
   SupF ==> SparseUnivariatePolynomial F
@@ -71403,6 +96276,7 @@ LinearPolynomialEquationByFractions(R:PolynomialFactorizationExplicit): with
   lp : List SupR
   pp: SupR
   pF: SupF
+
   pullback : SupF -> Union(SupR,"failed")
   pullback(pF) ==
     pF = 0 => 0
@@ -71411,6 +96285,7 @@ LinearPolynomialEquationByFractions(R:PolynomialFactorizationExplicit): with
     r:=pullback reductum pF
     r case "failed" => "failed"
     monomial(c,degree pF) + r
+
   solveLinearPolynomialEquationByFractions(lp,pp) ==
     lpF:List SupF:=[map((x:R):F +-> x@R::F,u) for u in lp]
     pF:SupF:=map((x:R):F +-> x::F,pp)
@@ -71426,6 +96301,34 @@ LinearPolynomialEquationByFractions(R:PolynomialFactorizationExplicit): with
 \begin{chunk}{COQ LPEFRAC}
 (* package LPEFRAC *)
 (*
+
+  SupR ==> SparseUnivariatePolynomial R
+  F ==> Fraction R
+  SupF ==> SparseUnivariatePolynomial F
+  import UnivariatePolynomialCategoryFunctions2(R,SupR,F,SupF)
+  lp : List SupR
+  pp: SupR
+  pF: SupF
+
+  pullback : SupF -> Union(SupR,"failed")
+  pullback(pF) ==
+    pF = 0 => 0
+    c:=retractIfCan leadingCoefficient pF
+    c case "failed" => "failed"
+    r:=pullback reductum pF
+    r case "failed" => "failed"
+    monomial(c,degree pF) + r
+
+  solveLinearPolynomialEquationByFractions(lp,pp) ==
+    lpF:List SupF:=[map((x:R):F +-> x@R::F,u) for u in lp]
+    pF:SupF:=map((x:R):F +-> x::F,pp)
+    ans:= solveLinearPolynomialEquation(lpF,pF)$F
+    ans case "failed" => "failed"
+    [(vv:= pullback v;
+      vv case "failed" => return "failed";
+       vv)
+        for v in ans]
+
 *)
 
 \end{chunk}
@@ -71517,6 +96420,7 @@ LinearSystemFromPowerSeriesPackage(K,PCS):P==T where
     finiteSeries2Vector: (PCS, INT) -> List K
     
   T==> add
+
     finiteSeries2ListOfTerms: PCS -> List TERM
 
     finiteSeries2ListOfTermsStream: SER -> List TERM
@@ -71550,12 +96454,45 @@ LinearSystemFromPowerSeriesPackage(K,PCS):P==T where
       for t in lOfTerm repeat lZero.((t.k)+1):= t.c
       lZero
    
-  
 \end{chunk}
 
 \begin{chunk}{COQ LISYSER}
 (* package LISYSER *)
 (*
+
+    finiteSeries2ListOfTerms: PCS -> List TERM
+
+    finiteSeries2ListOfTermsStream: SER -> List TERM
+      
+    finiteSeries2ListOfTermsStream(s)==     
+      empty?(s) => empty()
+      cons(frst s , finiteSeries2ListOfTermsStream(rst(s)))
+      
+    finiteSeries2LinSys(ls,n)==
+      ll:List K:=  [0$K]
+      lZero:=new(#ls pretend NonNegativeInteger,ll)$List(List(K))
+      n <= 0  => transpose matrix lZero
+      tMat:=transpose matrix [finiteSeries2Vector(s,n) for s in ls]
+      rowEchWoZeroLines(tMat)$LOpPack
+
+    finiteSeries2LinSysWOVectorise(ls,n)==
+      ll:List K:=  [0$K]
+      lZero:=new(#ls pretend NonNegativeInteger,ll)$List(List(K))
+      n <= 0  => transpose matrix lZero
+      tMat:=transpose matrix [finiteSeries2Vector(s,n) for s in ls]
+      rowEchWoZeroLinesWOVectorise(tMat)$LOpPack
+           
+    finiteSeries2ListOfTerms(s)==
+      ss:SER:= s :: SER
+      finiteSeries2ListOfTermsStream(ss)
+  
+    finiteSeries2Vector(ins,n)==
+      lZero:=new((n pretend NonNegativeInteger),0)$List(K)
+      s:= removeFirstZeroes ins
+      lOfTerm:=finiteSeries2ListOfTerms(s)
+      for t in lOfTerm repeat lZero.((t.k)+1):= t.c
+      lZero
+   
 *)
 
 \end{chunk}
@@ -71659,6 +96596,7 @@ LinearSystemMatrixPackage(F, Row, Col, M): Cat == Capsule where
           ++ of the linear system \spad{AX = B}.
 
     Capsule ==> add
+
       systemMatrix      : (M, Col) -> M
       aSolution         :  M -> PartialV
 
@@ -71712,6 +96650,55 @@ LinearSystemMatrixPackage(F, Row, Col, M): Cat == Capsule where
 \begin{chunk}{COQ LSMP}
 (* package LSMP *)
 (*
+
+      systemMatrix      : (M, Col) -> M
+      aSolution         :  M -> PartialV
+
+      -- rank theorem
+      hasSolution?(A, b) == rank A = rank systemMatrix(A, b)
+      systemMatrix(m, v) == horizConcat(m, -(v::M))
+      rank(A, b)         == rank systemMatrix(A, b)
+      particularSolution(A, b) == aSolution rowEchelon systemMatrix(A,b)
+
+      -- m should be in row-echelon form.
+      -- last column of m is -(right-hand-side of system)
+      aSolution m ==
+         nvar := (ncols m - 1)::N
+         rk := maxRowIndex m
+         while (rk >= minRowIndex m) and every?(zero?, row(m, rk))
+           repeat rk := dec rk
+         rk < minRowIndex m => new(nvar, 0)
+         ck := minColIndex m
+         while (ck < maxColIndex m) and zero? qelt(m, rk, ck) repeat
+           ck := inc ck
+         ck = maxColIndex m => "failed"
+         sol := new(nvar, 0)$Col
+         -- find leading elements of diagonal
+         v := new(nvar, minRowIndex m - 1)$PrimitiveArray(Integer)
+         for i in minRowIndex m .. rk repeat
+           for j in 0.. while zero? qelt(m, i, j+minColIndex m) repeat 0
+           v.j := i
+         for j in 0..nvar-1 repeat
+           if v.j >= minRowIndex m then
+             qsetelt_!(sol, j+minIndex sol, - qelt(m, v.j, maxColIndex m))
+         sol
+
+      solve(A:M, b:Col) ==
+          -- Special case for homogeneous systems.
+          every?(zero?, b) => [new(ncols A, 0), nullSpace A]
+          -- General case.
+          m   := rowEchelon systemMatrix(A, b)
+          [aSolution m,
+           nullSpace subMatrix(m, minRowIndex m, maxRowIndex m,
+                                      minColIndex m, maxColIndex m - 1)]
+
+      solve(A:M, l:List Col) ==
+          null l => [[new(ncols A, 0), nullSpace A]]
+          nl := (sol0 := solve(A, first l)).basis
+          cons(sol0,
+                 [[aSolution rowEchelon systemMatrix(A, b), nl]
+                                                       for b in rest l])
+
 *)
 
 \end{chunk}
@@ -71829,12 +96816,20 @@ LinearSystemMatrixPackage1(F): Cat == Capsule where
           ++ of the linear system \spad{AX = B}.
 
     Capsule ==> add
+
         solve(m : M, c: Col): Both == solve(m,c)$LSMP
+
         solve(ll : LL, c: Col): Both == solve(matrix(ll)$M,c)$LSMP
+
         solve(m : M, l : List Col): List Both == solve(m, l)$LSMP
+
         solve(ll : LL, l : List Col): List Both == solve(matrix(ll)$M, l)$LSMP
-        particularSolution (m : M, c : Col): PartialV == particularSolution(m, c)$LSMP
+
+        particularSolution (m : M, c : Col): PartialV == 
+          particularSolution(m, c)$LSMP
+
         hasSolution?(m :M, c : Col): Boolean == hasSolution?(m, c)$LSMP
+
         rank(m : M, c : Col): N == rank(m, c)$LSMP
 
 \end{chunk}
@@ -71842,6 +96837,22 @@ LinearSystemMatrixPackage1(F): Cat == Capsule where
 \begin{chunk}{COQ LSMP1}
 (* package LSMP1 *)
 (*
+
+        solve(m : M, c: Col): Both == solve(m,c)$LSMP
+
+        solve(ll : LL, c: Col): Both == solve(matrix(ll)$M,c)$LSMP
+
+        solve(m : M, l : List Col): List Both == solve(m, l)$LSMP
+
+        solve(ll : LL, l : List Col): List Both == solve(matrix(ll)$M, l)$LSMP
+
+        particularSolution (m : M, c : Col): PartialV == 
+          particularSolution(m, c)$LSMP
+
+        hasSolution?(m :M, c : Col): Boolean == hasSolution?(m, c)$LSMP
+
+        rank(m : M, c : Col): N == rank(m, c)$LSMP
+
 *)
 
 \end{chunk}
@@ -71958,6 +96969,36 @@ LinearSystemPolynomialPackage(R, E, OV, P): Cat == Capsule where
 \begin{chunk}{COQ LSPP}
 (* package LSPP *)
 (*
+
+                        ---- Local Functions ----
+
+        poly2vect:    (P,     List OV)    -> Record(coefvec: V F, reductum: F)
+        intoMatrix:   (List P,   List OV) -> Record(mat: M F, vec: V F)
+
+
+        poly2vect(p : P, vs : List OV) : Record(coefvec: V F, reductum: F) ==
+            coefs := new(#vs, 0)$(V F)
+            for v in vs for i in 1.. while p ^= 0 repeat
+              u := univariate(p, v)
+              degree u = 0 => "next v"
+              coefs.i := (c := leadingCoefficient u)::F
+              p := p - monomial(c,v, 1)
+            [coefs, p :: F]
+
+        intoMatrix(ps : List P, vs : List OV ) : Record(mat: M F, vec: V F) ==
+            m := zero(#ps, #vs)$M(F)
+            v := new(#ps, 0)$V(F)
+            for p in ps for i in 1.. repeat
+                totalDegree(p,vs) > 1 => error "The system is not linear"
+                r   := poly2vect(p,vs)
+                m:=setRow_!(m,i,r.coefvec)
+                v.i := - r.reductum
+            [m, v]
+
+        linSolve(ps, vs) ==
+            r := intoMatrix(ps, vs)
+            solve(r.mat, r.vec)$LinearSystemMatrixPackage(F,V F,V F,M F)
+
 *)
 
 \end{chunk}
@@ -72329,9 +97370,9 @@ LinGroebnerPackage(lv,F) : C == T
           nBasis:=concat(firstmon,nBasis)
       [result,rval]$LVals
 
------ given a basis of a zero-dimensional ideal,
------ performs a random change of coordinates
------ computes a Groebner basis for the lex ordering
+    ----- given a basis of a zero-dimensional ideal,
+    ----- performs a random change of coordinates
+    ----- computes a Groebner basis for the lex ordering
     groebgen(L:List DPoly) : cLVars ==
       xn:=lvar.last
       val := xn::DPoly
@@ -72347,6 +97388,256 @@ LinGroebnerPackage(lv,F) : C == T
 \begin{chunk}{COQ LGROBP}
 (* package LGROBP *)
 (*
+
+    import GroebnerPackage(F,DP,OV,DPoly)
+    import GroebnerPackage(F,HDP,OV,HDPoly)
+    import GroebnerInternalPackage(F,HDP,OV,HDPoly)
+    import GroebnerInternalPackage(F,DP,OV,DPoly)
+
+    lvar :=[variable(yx)::OV for yx in lv]
+
+    reduceRow(M:MF, v : VF, lastRow: Integer, pivots: Vector(Integer)) : VF ==
+      a1:F := 1
+      b:F := 0
+      dim := #v
+      for j in 1..lastRow repeat -- scan over rows
+         mj := row(M,j)
+         k:=pivots(j)
+         b:=mj.k
+         vk := v.k
+         for kk in 1..(k-1) repeat
+            v(kk) := ((-b*v(kk)) exquo a1) :: F
+         for kk in k..dim repeat
+            v(kk) := ((vk*mj(kk)-b*v(kk)) exquo a1)::F
+         a1 := b
+      v
+
+    rRedPol(f:HDPoly, B:List HDPoly):Record(poly:HDPoly, mult:F) ==
+      gm := redPo(f,B)
+      gm.poly = 0 => gm
+      gg := reductum(gm.poly)
+      ggm := rRedPol(gg,B)
+      [ggm.mult*(gm.poly - gg) + ggm.poly, ggm.mult*gm.mult]
+
+----- transform the total basis B in lex basis -----
+    totolex(B : List HDPoly) : List DPoly ==
+      result:List DPoly :=[]
+      ltresult:List DPoly :=[]
+      vBasis:= computeBasis B
+      nBasis:List DPoly :=[1$DPoly]
+      ndim:=(#vBasis)::PositiveInteger
+      ndim1:NNI:=ndim+1
+      lm:VF
+      linmat:MF:=zero(ndim,2*ndim+1)
+      linmat(1,1):=1$F
+      linmat(1,ndim1):=1
+      pivots:Vector Integer := new(ndim,0)
+      pivots(1) := 1
+      firstmon:DPoly:=1$DPoly
+      ofirstmon:DPoly:=1$DPoly
+      orecfmon:Record(poly:HDPoly, mult:F) := [1,1]
+      i:NNI:=2
+      while (firstmon:=choosemon(firstmon,ltresult))^=1 repeat
+        if (v:=firstmon exquo ofirstmon) case "failed" then
+          recfmon:=rRedPol(transform firstmon,B)
+        else
+          recfmon:=rRedPol(transform(v::DPoly) *orecfmon.poly,B)
+          recfmon.mult := recfmon.mult * orecfmon.mult
+        cc := gcd(content recfmon.poly, recfmon.mult)
+        recfmon.poly := (recfmon.poly exquo cc)::HDPoly
+        recfmon.mult := (recfmon.mult exquo cc)::F
+        veccoef:VF:=coord(recfmon.poly,vBasis)
+        ofirstmon:=firstmon
+        orecfmon := recfmon
+        lm:=zero(2*ndim+1)
+        for j in 1..ndim repeat lm(j):=veccoef(j)
+        lm(ndim+i):=recfmon.mult
+        lm := reduceRow(linmat, lm, i-1, pivots)
+        if i=ndim1 then j:=ndim1
+        else
+          j:=1
+          while lm(j) = 0 and j< ndim1 repeat j:=j+1
+        if j=ndim1 then
+          cordlist:List F:=[lm(k) for k in ndim1..ndim1+(#nBasis)]
+          antc:=+/[c*b for c in reverse cordlist
+                       for b in concat(firstmon,nBasis)]
+          antc:=primitivePart antc
+          result:=concat(antc,result)
+          ltresult:=concat(antc-reductum antc,ltresult)
+        else
+          pivots(i) := j
+          setRow_!(linmat,i,lm)
+          i:=i+1
+          nBasis:=cons(firstmon,nBasis)
+      result
+
+---- Compute the univariate polynomial for x
+----oldBasis is a total degree Groebner basis
+    minPol(oldBasis:List HDPoly,x:OV) :HDPoly ==
+      algBasis:= computeBasis oldBasis
+      minPol(oldBasis,algBasis,x)
+
+---- Compute the univariate polynomial for x
+---- oldBasis is total Groebner, algBasis is the basis as algebra
+    minPol(oldBasis:List HDPoly,algBasis:List HDPoly,x:OV) :HDPoly ==
+      nvp:HDPoly:=x::HDPoly
+      f:=1$HDPoly
+      omult:F :=1
+      ndim:=(#algBasis)::PositiveInteger
+      ndim1:NNI:=ndim+1
+      lm:VF
+      linmat:MF:=zero(ndim,2*ndim+1)
+      linmat(1,1):=1$F
+      linmat(1,ndim1):=1
+      pivots:Vector Integer := new(ndim,0)
+      pivots(1) := 1
+      for i in 2..ndim1 repeat
+        recf:=rRedPol(f*nvp,oldBasis)
+        omult := recf.mult * omult
+        f := recf.poly
+        cc := gcd(content f, omult)
+        f := (f exquo cc)::HDPoly
+        omult := (omult exquo cc)::F
+        veccoef:VF:=coord(f,algBasis)
+        lm:=zero(2*ndim+1)
+        for j in 1..ndim repeat lm(j) := veccoef(j)
+        lm(ndim+i):=omult
+        lm := reduceRow(linmat, lm, i-1, pivots)
+        j:=1
+        while lm(j)=0 and j<ndim1 repeat j:=j+1
+        if j=ndim1 then return
+          g:HDPoly:=0
+          for k in ndim1..2*ndim+1 repeat
+            g:=g+lm(k) * nvp**((k-ndim1):NNI)
+          primitivePart g
+        pivots(i) := j
+        setRow_!(linmat,i,lm)
+
+----- transform a DPoly in a HDPoly -----
+    transform(dpol:DPoly) : HDPoly ==
+      dpol=0 => 0$HDPoly
+      monomial(leadingCoefficient dpol,
+               directProduct(degree(dpol)::VV)$HDP)$HDPoly +
+                                      transform(reductum dpol)
+
+----- compute the basis for the vector space determined by B -----
+    computeBasis(B:List HDPoly) : List HDPoly ==
+      mB:List HDPoly:=[monomial(1$F,degree f)$HDPoly for f in B]
+      result:List HDPoly := [1$HDPoly]
+      for var in lvar repeat
+        part:=intcompBasis(var,result,mB)
+        result:=concat(result,part)
+      result
+
+----- internal function for computeBasis -----
+    intcompBasis(x:OV,lr:List HDPoly,mB : List HDPoly):List HDPoly ==
+      lr=[] => lr
+      part:List HDPoly :=[]
+      for f in lr repeat
+        g:=x::HDPoly * f
+        if redPo(g,mB).poly^=0 then part:=concat(g,part)
+      concat(part,intcompBasis(x,part,mB))
+
+----- coordinate of f with respect to the basis B -----
+----- f is a reduced polynomial -----
+    coord(f:HDPoly,B:List HDPoly) : VF ==
+      ndim := #B
+      vv:VF:=new(ndim,0$F)$VF
+      while f^=0 repeat
+        rf := reductum f
+        lf := f-rf
+        lcf := leadingCoefficient f
+        i:Z:=position(monomial(1$F,degree lf),B)
+        vv.i:=lcf
+        f := rf
+      vv
+
+----- reconstruct the polynomial from its coordinate -----
+    anticoord(vv:List F,mf:DPoly,B:List DPoly) : DPoly ==
+      for f in B for c in vv repeat (mf:=mf-c*f)
+      mf
+
+----- choose the next monom -----
+    choosemon(mf:DPoly,nB:List DPoly) : DPoly ==
+      nB = [] => ((lvar.last)::DPoly)*mf
+      for x in reverse lvar repeat
+        xx:=x ::DPoly
+        mf:=xx*mf
+        if redPo(mf,nB).poly ^= 0 then return mf
+        dx := degree(mf,x)
+        mf := (mf exquo (xx ** dx))::DPoly
+      mf
+
+----- put B in general position, B is Groebner -----
+    linGenPos(B : List HDPoly) : LVals ==
+      result:List DPoly :=[]
+      ltresult:List DPoly :=[]
+      vBasis:= computeBasis B
+      nBasis:List DPoly :=[1$DPoly]
+      ndim:=#vBasis : PositiveInteger
+      ndim1:NNI:=ndim+1
+      lm:VF
+      linmat:MF:=zero(ndim,2*ndim+1)
+      linmat(1,1):=1$F
+      linmat(1,ndim1):=1
+      pivots:Vector Integer := new(ndim,0)
+      pivots(1) := 1
+      i:NNI:=2
+      rval:List Z :=[]
+      for ii in 1..(#lvar-1) repeat
+        c:Z:=0
+        while c=0 repeat c:=random()$Z rem 11
+        rval:=concat(c,rval)
+      nval:DPoly := (last.lvar)::DPoly -
+                (+/[r*(vv)::DPoly for r in rval for vv in lvar])
+      firstmon:DPoly:=1$DPoly
+      ofirstmon:DPoly:=1$DPoly
+      orecfmon:Record(poly:HDPoly, mult:F) := [1,1]
+      lx:= lvar.last
+      while (firstmon:=choosemon(firstmon,ltresult))^=1 repeat
+        if (v:=firstmon exquo ofirstmon) case "failed" then
+          recfmon:=rRedPol(transform(eval(firstmon,lx,nval)),B)
+        else
+          recfmon:=rRedPol(transform(eval(v,lx,nval))*orecfmon.poly,B)
+          recfmon.mult := recfmon.mult * orecfmon.mult
+        cc := gcd(content recfmon.poly, recfmon.mult)
+        recfmon.poly := (recfmon.poly exquo cc)::HDPoly
+        recfmon.mult := (recfmon.mult exquo cc)::F
+        veccoef:VF:=coord(recfmon.poly,vBasis)
+        ofirstmon:=firstmon
+        orecfmon := recfmon
+        lm:=zero(2*ndim+1)
+        for j in 1..ndim repeat lm(j):=veccoef(j)
+        lm(ndim+i):=recfmon.mult
+        lm := reduceRow(linmat, lm, i-1, pivots)
+        j:=1
+        while lm(j) = 0 and j<ndim1 repeat j:=j+1
+        if j=ndim1 then
+          cordlist:List F:=[lm(j) for j in ndim1..ndim1+(#nBasis)]
+          antc:=+/[c*b for c in reverse cordlist
+                       for b in concat(firstmon,nBasis)]
+          result:=concat(primitivePart antc,result)
+          ltresult:=concat(antc-reductum antc,ltresult)
+        else
+          pivots(i) := j
+          setRow_!(linmat,i,lm)
+          i:=i+1
+          nBasis:=concat(firstmon,nBasis)
+      [result,rval]$LVals
+
+    ----- given a basis of a zero-dimensional ideal,
+    ----- performs a random change of coordinates
+    ----- computes a Groebner basis for the lex ordering
+    groebgen(L:List DPoly) : cLVars ==
+      xn:=lvar.last
+      val := xn::DPoly
+      nvar1:NNI:=(#lvar-1):NNI
+      ll: List Z :=[random()$Z rem 11 for i in 1..nvar1]
+      val:=val+ +/[ll.i*(lvar.i)::DPoly for i in 1..nvar1]
+      LL:=[elt(univariate(f,xn),val) for f in L]
+      LL:=  groebner(LL)
+      [LL,ll]$cLVars
+
 *)
 
 \end{chunk}
@@ -72449,6 +97740,7 @@ LinesOpPack(K):P==T where
       ++ be the first non nul element in v.
 
   T==> add
+
     localRowEchelon: Matrix(K) -> Matrix(K)
     localRowEchelon(m)==
       ^(K has PseudoAlgebraicClosureOfPerfectFieldCategory )  => rowEchelon m
@@ -72514,6 +97806,67 @@ LinesOpPack(K):P==T where
 \begin{chunk}{COQ LOP}
 (* package LOP *)
 (*
+
+    localRowEchelon: Matrix(K) -> Matrix(K)
+    localRowEchelon(m)==
+      ^(K has PseudoAlgebraicClosureOfPerfectFieldCategory )  => rowEchelon m
+      llm:List(List(K)):= listOfLists m
+      l:= first llm
+      maxT:= maxTower l
+      lv := [vectorise(a,maxT)$K for a in l]
+      subMatl := transpose  matrix [entries(v) for v in lv]
+      matl:= subMatl
+      for l in rest llm repeat
+        maxT:= maxTower l
+        lv := [vectorise(a,maxT)$K for a in l]
+        subMatl := transpose  matrix [entries(v) for v in lv]
+        matl:=vertConcat(matl,subMatl)
+      rowEchelon  matl
+
+    rowEchWoZeroLines(m)==
+      mm:=localRowEchelon m
+      ll:=listOfLists mm
+      n:= # first ll
+      lZero:=new(n pretend NonNegativeInteger,0)$List(K)
+      llll:= [ l for l in ll | ^(lZero = l) ]
+      empty?(llll) => matrix [lZero]
+      matrix llll
+
+    rowEchWoZeroLinesWOVectorise(m)==
+      mm:=rowEchelon  m
+      ll:=listOfLists mm
+      n:= # first ll
+      lZero:=new(n pretend NonNegativeInteger,0)$List(K)
+      llll:= [ l for l in ll | ^(lZero = l) ]
+      empty?(llll) => matrix [lZero]
+      matrix llll
+
+    quotVecSpaceBasis(l2,l1)==
+      redBasis:=reduceRow(concat(l1,l2))
+      tempRes:=rest(redBasis,#l1)
+      allZero:=new(#l1.1,0$K)
+      [l for l in tempRes | ^(l=allZero)]
+
+    reduceRowOnList(line,listOfLine)==
+      frsNonNul:Integer:=position(^zero?(#1),line)
+      ^(frsNonNul > 0) => listOfLine
+      a:= line.frsNonNul
+      inva:= inv a
+      newLine:=[inva*c for c in line]
+      [reduceLineOverLine(newLine,l,l.frsNonNul) for l in listOfLine]
+
+    reduceLineOverLine(l1,l2,b)==
+      [c2 - b*c1 for c2 in l2 for c1 in l1]
+
+    reduceRow(m:List(List(K)))==
+      n:=#m
+      mcopy:List(List(K)):=copy m
+      newBottom:List(List(K))
+      for i in 1..(n-1) repeat
+        newBottom:=reduceRowOnList(mcopy.i,[mcopy.j for j in (i+1)..n])
+        mcopy:=concat([mcopy.k for k in 1..i] :: List(List(K)),newBottom)
+      mcopy
+
 *)
 
 \end{chunk}
@@ -72637,6 +97990,7 @@ LiouvillianFunction(R, F): Exports == Implementation where
       ++ respect to x from \spad{a} to b.
 
   Implementation ==> add
+
     iei        : F  -> F
     isi        : F  -> F
     ici        : F  -> F
@@ -72676,7 +98030,6 @@ LiouvillianFunction(R, F): Exports == Implementation where
     isi x          == kernel(opsi, x)
     ici x          == kernel(opci, x)
     ierf x         == (zero? x => 0; kernel(operf, x))
---    ili2 x         == (one? x => INV; kernel(opli2, x))
     ili2 x         == ((x = 1) => INV; kernel(opli2, x))
     ifis(x:F):F    == (zero? x => 0; kernel(opfis,x))
     ific(x:F):F    == (zero? x => 0; kernel(opfic,x))
@@ -72763,12 +98116,13 @@ LiouvillianFunction(R, F): Exports == Implementation where
     setProperty(opdint, SPECIALDISP, ddint@(List F -> O) pretend None)
 
     if R has ConvertibleTo INP then
+
       inint : List F -> INP
       indint: List F -> INP
-      pint  : List INP -> INP
-
 
+      pint  : List INP -> INP
       pint l  == convert concat(convert("integral"::SE)@INP, l)
+
       inint l == 
         r2:= convert(
               [convert("::"::SE)@INP,
@@ -72792,6 +98146,157 @@ LiouvillianFunction(R, F): Exports == Implementation where
 \begin{chunk}{COQ LF}
 (* package LF *)
 (*
+
+    iei        : F  -> F
+    isi        : F  -> F
+    ici        : F  -> F
+    ierf       : F  -> F
+    ili        : F  -> F
+    ili2       : F  -> F
+    iint       : List F -> F
+    eqint      : (K,K) -> Boolean
+    dvint      : (List F, SE) -> F
+    dvdint     : (List F, SE) -> F
+    ddint      : List F -> O
+    integrand  : List F -> F
+
+    dummy := new()$SE :: F
+
+    opint  := operator("integral"::Symbol)$CommonOperators
+    opdint := operator("%defint"::Symbol)$CommonOperators
+    opei   := operator("Ei"::Symbol)$CommonOperators
+    opli   := operator("li"::Symbol)$CommonOperators
+    opsi   := operator("Si"::Symbol)$CommonOperators
+    opci   := operator("Ci"::Symbol)$CommonOperators
+    opli2  := operator("dilog"::Symbol)$CommonOperators
+    operf  := operator("erf"::Symbol)$CommonOperators
+    opfis  := operator("fresnelS"::Symbol)$CommonOperators
+    opfic  := operator("fresnelC"::Symbol)$CommonOperators
+
+    Si x                == opsi x
+    Ci x                == opci x
+    Ei x                == opei x
+    erf x               == operf x
+    li  x               == opli x
+    dilog x             == opli2 x
+    fresnelS x          == opfis x
+    fresnelC x          == opfic x
+
+    belong? op     == has?(op, "prim")
+    isi x          == kernel(opsi, x)
+    ici x          == kernel(opci, x)
+    ierf x         == (zero? x => 0; kernel(operf, x))
+    ili2 x         == ((x = 1) => INV; kernel(opli2, x))
+    ifis(x:F):F    == (zero? x => 0; kernel(opfis,x))
+    ific(x:F):F    == (zero? x => 0; kernel(opfic,x))
+    integrand l    == eval(first l, retract(second l)@K, third l)
+    integral(f:F, x:SE) == opint [eval(f, k:=kernel(x)$K, dummy), dummy, k::F]
+
+    iint l ==
+      zero? first l => 0
+      kernel(opint, l)
+
+    ddint l ==
+      int(integrand(l)::O * hconcat("d"::SE::O, third(l)::O),
+                                    third(rest l)::O, third(rest rest l)::O)
+
+    eqint(k1,k2) == 
+      a1:=argument k1
+      a2:=argument k2
+      res:=operator k1 = operator k2
+      if not res then return res
+      res:= a1 = a2
+      if res then return res
+      res:= (a1.3 = a2.3) and (subst(a1.1,[retract(a1.2)@K],[a2.2]) = a2.1)
+
+    dvint(l, x) ==
+      k  := retract(second l)@K
+      differentiate(third l, x) * integrand l
+          + opint [differentiate(first l, x), second l, third l]
+
+
+    dvdint(l, x) ==
+      x = retract(y := third l)@SE => 0
+      k := retract(d := second l)@K
+      differentiate(h := third rest rest l,x) * eval(f := first l, k, h)
+        - differentiate(g := third rest l, x) * eval(f, k, g)
+             + opdint [differentiate(f, x), d, y, g, h]
+
+    integral(f:F, s: SegmentBinding F) ==
+      x := kernel(variable s)$K
+      opdint [eval(f,x,dummy), dummy, x::F, lo segment s, hi segment s]
+
+    ili x ==
+      x = 1 => INV
+      is?(x, "exp"::Symbol) => Ei first argument(retract(x)@K)
+      kernel(opli, x)
+
+    iei x ==
+      x = 0 => INV
+      is?(x, "log"::Symbol) => li first argument(retract(x)@K)
+      kernel(opei, x)
+
+    operator op ==
+      is?(op, "integral"::Symbol)   => opint
+      is?(op, "%defint"::Symbol)    => opdint
+      is?(op, "Ei"::Symbol)         => opei
+      is?(op, "Si"::Symbol)         => opsi
+      is?(op, "Ci"::Symbol)         => opci
+      is?(op, "li"::Symbol)         => opli
+      is?(op, "erf"::Symbol)        => operf
+      is?(op, "dilog"::Symbol)      => opli2
+      is?(op, "fresnelC"::Symbol)   => opfis
+      is?(op, "fresnelS"::Symbol)   => opfic
+      error "Not a Liouvillian operator"
+
+    evaluate(opei,    iei)$BasicOperatorFunctions1(F)
+    evaluate(opli,    ili)
+    evaluate(opsi,    isi)
+    evaluate(opci,    ici)
+    evaluate(operf,   ierf)
+    evaluate(opli2,   ili2)
+    evaluate(opfis,   ifis)
+    evaluate(opfic,   ific)
+    evaluate(opint,   iint)
+    derivative(opsi,  (z1:F):F +-> sin(z1) / z1)
+    derivative(opci,  (z1:F):F +-> cos(z1) / z1)
+    derivative(opei,  (z1:F):F +-> exp(z1) / z1)
+    derivative(opli,  (z1:F):F +-> inv log(z1))
+    derivative(operf, (z1:F):F +-> 2 * exp(-(z1**2)) / sqrt(pi()))
+    derivative(opli2, (z1:F):F +-> log(z1) / (1 - z1))
+    derivative(opfis, (z1:F):F +-> sin(z1**2))
+    derivative(opfic, (z1:F):F +-> cos(z1**2))
+    setProperty(opint,SPECIALEQUAL,eqint@((K,K) -> Boolean) pretend None)
+    setProperty(opint,SPECIALDIFF,dvint@((List F,SE) -> F) pretend None)
+    setProperty(opdint,SPECIALDIFF,dvdint@((List F,SE)->F) pretend None)
+    setProperty(opdint, SPECIALDISP, ddint@(List F -> O) pretend None)
+
+    if R has ConvertibleTo INP then
+
+      inint : List F -> INP
+      indint: List F -> INP
+
+      pint  : List INP -> INP
+      pint l  == convert concat(convert("integral"::SE)@INP, l)
+
+      inint l == 
+        r2:= convert(
+              [convert("::"::SE)@INP,
+               convert(third l)@INP,
+               convert("Symbol"::SE)@INP]@List INP)@INP
+        pint [convert(integrand l)@INP, r2]
+
+      indint l ==
+        pint [convert(integrand l)@INP,
+              convert concat(convert("="::SE)@INP,
+                            [convert(third l)@INP,
+                             convert concat(convert("SEGMENT"::SE)@INP,
+                                           [convert(third rest l)@INP,
+                                            convert(third rest rest l)@INP])])]
+
+      setProperty(opint, SPECIALINPUT, inint@(List F -> INP) pretend None)
+      setProperty(opdint, SPECIALINPUT, indint@(List F -> INP) pretend None)
+
 *)
 
 \end{chunk}
@@ -72887,8 +98392,11 @@ ListFunctions2(A:Type, B:Type): public == private where
       ++ For example \spad{map(square,[1,2,3]) = [1,4,9]}.
 
   private ==> add
+
     map(f, l)       == map(f, l)$O2
+
     scan(f, l, b)   == scan(f, l, b)$O2
+
     reduce(f, l, b) == reduce(f, l, b)$O2
 
 \end{chunk}
@@ -72896,6 +98404,13 @@ ListFunctions2(A:Type, B:Type): public == private where
 \begin{chunk}{COQ LIST2}
 (* package LIST2 *)
 (*
+
+    map(f, l)       == map(f, l)$O2
+
+    scan(f, l, b)   == scan(f, l, b)$O2
+
+    reduce(f, l, b) == reduce(f, l, b)$O2
+
 *)
 
 \end{chunk}
@@ -72973,6 +98488,7 @@ ListFunctions3(A:Type, B:Type, C:Type): public == private where
       ++ lengths of \spad{u1} and \spad{u2}.
 
   private ==> add
+
     map(fn : (A,B) -> C, la : LA, lb : LB): LC ==
       empty?(la) or empty?(lb) => empty()$LC
       concat(fn(first la, first lb), map(fn, rest la, rest lb))
@@ -72982,6 +98498,11 @@ ListFunctions3(A:Type, B:Type, C:Type): public == private where
 \begin{chunk}{COQ LIST3}
 (* package LIST3 *)
 (*
+
+    map(fn : (A,B) -> C, la : LA, lb : LB): LC ==
+      empty?(la) or empty?(lb) => empty()$LC
+      concat(fn(first la, first lb), map(fn, rest la, rest lb))
+
 *)
 
 \end{chunk}
@@ -73114,9 +98635,13 @@ ListToMap(A:SetCategory, B:Type): Exports == Implementation where
       ++ The value returned is then obtained by applying f to argument a.
 
   Implementation ==> add
+
     match(la, lb)             == (z1:A):B +-> match(la, lb, z1)
+
     match(la:LA, lb:LB, a:A)  == lb.position(a, la)
+
     match(la:LA, lb:LB, b:B)  == (z1:A):B +-> match(la, lb, z1, b)
+
     match(la:LA, lb:LB, f:AB) == (z1:A):B +-> match(la, lb, z1, f)
 
     match(la:LA, lb:LB, a:A, b:B) ==
@@ -73132,6 +98657,23 @@ ListToMap(A:SetCategory, B:Type): Exports == Implementation where
 \begin{chunk}{COQ LIST2MAP}
 (* package LIST2MAP *)
 (*
+
+    match(la, lb)             == (z1:A):B +-> match(la, lb, z1)
+
+    match(la:LA, lb:LB, a:A)  == lb.position(a, la)
+
+    match(la:LA, lb:LB, b:B)  == (z1:A):B +-> match(la, lb, z1, b)
+
+    match(la:LA, lb:LB, f:AB) == (z1:A):B +-> match(la, lb, z1, f)
+
+    match(la:LA, lb:LB, a:A, b:B) ==
+      (p := position(a, la)) < minIndex(la) => b
+      lb.p
+
+    match(la:LA, lb:LB, a:A, f:AB) ==
+      (p := position(a, la)) < minIndex(la) => f a
+      lb.p
+
 *)
 
 \end{chunk}
@@ -73443,6 +98985,189 @@ LocalParametrizationOfSimplePointPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc):_
 \begin{chunk}{COQ LPARSPT}
 (* package LPARSPT *)
 (*
+
+    import PCS
+    import PolyRing
+    import PPFC1
+    import PackPoly
+    
+    valuationAndMore: (UPUP,UPUP) -> _
+                       Record(ord:Integer,value:K,fnc:UPUP,crv:UPUP)
+
+    localize2: (PolyRing,ProjPt,PolyRing,Integer) -> _
+               Record(fnc2:UPUP,crv2:UPUP)
+
+    coerceToUPUP: (PolyRing,List Integer) -> UPUP
+
+    paramAtOrigin: (UPUP,UPUP,Integer) -> PCS
+  
+    strictTransform: (UPUP,NNI) -> UPUP
+
+    translate: (UPUP,K) -> UPUP
+
+    constant: UPUP -> K
+
+    intCoord: UPUP  -> K
+
+    localMultiplicity: UPUP -> NNI
+
+    mapDegree: (NNI,NNI,NNI) -> NNI
+
+    listVar:List(OV):= [index(i::PI)$OV for i in 1..#symb]
+
+    listMonoPols:List(PolyRing):=listVariable()
+
+    pointDominateBy(pl)==
+      lpl:List PCS:=localParam(pl)
+      empty? lpl => _
+       error "LPARSPT:pointDominateBy::parametrization of point not done yet"
+      lK:List K:=[ findCoef(s,0) for s in lpl]
+      projectivePoint(lK)
+    
+    localParamOfSimplePt(pt,curve,nV)==
+      mult:NNI:=multiplicity(curve,pt,nV)
+      ^one?(mult) => _
+        error "The point is not simple or is not on the curve !"
+      lcl:=[localize2(var,pt,curve,nV) for var in listMonoPols]
+      [paramAtOrigin(l.fnc2,l.crv2,0) for l in lcl]
+
+    pointToPlace(pt,curve)==
+      -- define the chart for strictTransform (of simple point)
+      nV:Integer:=lastNonNull pt
+      pth:=homogenize(pt,nV)
+      chart:List Integer:=[0,0,nV]
+      mult:NNI:=multiplicity(curve,pth,nV)
+      ^one?(mult) => 
+        error "The point is not simple or is not on the curve"
+      -- create a place from the simple point. This is done by giving
+      -- a name to the place: in this case it is the coordinate of 
+      -- the projective point.
+      lpth:List K:= pth :: List(K)
+      plc:Plc:=create(lpth)$Plc
+      ^empty?(localParam(plc)) => plc
+      lcl:=[localize2(var,pth,curve,nV) for var in listMonoPols]
+      lPar:=[paramAtOrigin(l.fnc2,l.crv2,0) for l in lcl]
+      setParam!(plc,lPar)
+      dd:=degree pth 
+      setDegree!(plc,dd)
+      plc
+
+    localVarForPrintInfo:Boolean:=false()$Boolean
+
+    printInfo()==localVarForPrintInfo
+
+    printInfo(flag)==localVarForPrintInfo:=flag
+
+    mapDegree(n,mx,m)==
+      dd:=(n+mx-m) 
+      dd < 0 => _
+        error "LPARSPT:mapDegree called by PARAMP:strictTransform failed"
+      dd  pretend NNI
+
+    strictTransform(pol,m)==
+      zero?(pol) => 0
+      tc:=leadingCoefficient pol
+      tk:= degree pol
+      newTc:= mapExponents(mapDegree(#1,tk,m),tc)
+      monomial(newTc,tk)$UPUP + strictTransform(reductum pol,m)
+
+    Y == monomial(1,1)$UPUP
+
+    trY: (K,NonNegativeInteger) -> UPUP
+    trY(a,n)== (monomial(monomial(a,0)$UP,0)$UPUP + Y)**n
+
+    translate(pol,a)==
+      zero?(pol) => 0 
+      tc:=leadingCoefficient pol
+      tk:= degree pol
+      trY(a,tk) * tc + translate(reductum pol, a)
+
+    constant(pol)==coefficient(coefficient(pol,0)$UPUP,0)$UP
+
+    intCoord(pol)==
+      coefY:=coefficient(coefficient(pol,1)$UPUP,0)$UP
+      cnst:=constant(pol)
+      -cnst * inv coefY
+
+    localMultiplicity(pol)==
+      zero?(pol) => error "Cannot compute the multiplicity for 0"
+      redPol:= reductum pol
+      tc:=leadingCoefficient pol
+      tk:= degree pol
+      m:=tk + minimumDegree(tc)$UP
+      zero?(redPol) => m
+      min( m, localMultiplicity(redPol))
+
+    coerceToUPUP(pol,chart)==
+      zero?(pol) => 0
+      lExp:=parts degree pol
+      lCoef:=leadingCoefficient pol
+      expX:=lExp(chart.1)
+      expY:=lExp(chart.2)
+      monomial(monomial(lCoef,expX)$UP,expY)$UPUP + _
+        coerceToUPUP(reductum(pol),chart)
+
+    -- testing this function. See paramPack for original version. 
+    valuationAndMore(f:UPUP,curve:UPUP)==
+      -- this function evaluate the function f at the origin 
+      -- which must be a simple point on the curve define by "curve"
+      val:= constant(f)
+      ^zero?(val) => [0,val,f,curve]
+      sTrCurve:=strictTransform(curve,1)
+      slp:=intCoord sTrCurve  
+      multPtf:Integer:= localMultiplicity(f)  pretend Integer 
+      sTrFnc:=strictTransform(f,multPtf pretend NNI)
+      newCurve:=translate(sTrCurve,slp)
+      f2:=translate(sTrFnc,slp)
+      val:= constant(f2)
+      [multPtf, val, f2, newCurve]
+
+    paramAtOrigin(f:UPUP,curve:UPUP,ex:Integer)== delay
+      -- this function must be
+      -- called for parametrization a the origin
+      u:=f
+      zero?(u) => 0
+      tt:=u exquo curve 
+      ^(tt case "failed") => 0
+      firstTerm:=valuationAndMore(u,curve)
+      od:=firstTerm.ord    
+      coef:=firstTerm.value
+      newU:=firstTerm.fnc - monomial(monomial(coef,0)$UP,0)$UPUP
+      newCurve:=firstTerm.crv
+      series(od+ex,coef,paramAtOrigin(newU,newCurve,ex+od))
+
+    localize(f:PolyRing,pt:ProjPt,curve:PolyRing,nV:Integer)==
+      curveT:=translateToOrigin(curve,pt,nV)
+      ft:=translateToOrigin(f,pt,nV)
+      fm:=minimalForm(curveT)
+      zero?(d:=totalDegree(fm)$PackPoly) => _
+        error "the point is not on the curve"
+      ^one?(d) => error "the point is singular"
+      subChart:=[i for i in 1..#symb | ^(i= (nV pretend PI))]
+      cf1:=degOneCoef(fm,(subChart.1) pretend PI)
+      cf2:=degOneCoef(fm,(subChart.2) pretend PI)
+      crt:List(Integer)
+      sc:List(Integer):=[(i pretend Integer) for i in subChart]
+      zero?(cf1) =>
+        crt:=concat(sc,nV)
+        [ft,curveT,crt]
+      zero?(cf2) =>
+        crt:=concat(reverse(sc),nV)
+        [ft,curveT,crt]
+      deg1:=degree(curveT,listVar(subChart.1))
+      deg2:=degree(curveT,listVar(subChart.2))
+      deg1 > deg2 =>
+        crt:=concat(sc,nV)
+        [ft,curveT,crt]
+      crt:=concat(reverse(sc),nV)
+      [ft,curveT,crt]
+
+    localize2(f:PolyRing,pt:ProjPt,curve:PolyRing,nV:Integer)==
+      recBlowUp:=localize(f,pt,curve,nV)
+      f2:=coerceToUPUP(recBlowUp.fnc,recBlowUp.chart)
+      curve2:=coerceToUPUP(recBlowUp.crv,recBlowUp.chart)
+      [f2,curve2]
+
 *)
 
 \end{chunk}
@@ -73531,11 +99256,13 @@ MakeBinaryCompiledFunction(S, D1, D2, I):Exports == Implementation where
       ++ applicable to objects of type \spad{(D1, D2)}
 
   Implementation ==> add
+
     import MakeFunction(S)
 
     func: (SY, D1, D2) -> I
 
     func(name, x, y)   == FUNCALL(name, x, y, NIL$Lisp)$Lisp
+
     binaryFunction name == (d1:D1,d2:D2):I +-> func(name, d1, d2)
 
     compiledFunction(e, x, y) ==
@@ -73547,6 +99274,19 @@ MakeBinaryCompiledFunction(S, D1, D2, I):Exports == Implementation where
 \begin{chunk}{COQ MKBCFUNC}
 (* package MKBCFUNC *)
 (*
+
+    import MakeFunction(S)
+
+    func: (SY, D1, D2) -> I
+
+    func(name, x, y)   == FUNCALL(name, x, y, NIL$Lisp)$Lisp
+
+    binaryFunction name == (d1:D1,d2:D2):I +-> func(name, d1, d2)
+
+    compiledFunction(e, x, y) ==
+      t := [devaluate(D1)$Lisp, devaluate(D2)$Lisp]$List(InputForm)
+      binaryFunction compile(function(e, declare DI, x, y), t)
+
 *)
 
 \end{chunk}
@@ -73645,6 +99385,7 @@ MakeFloatCompiledFunction(S): Exports == Implementation where
       ++ \axiomType{DoubleFloat})}.
 
   Implementation ==> add
+
     import MakeUnaryCompiledFunction(S, SF, SF)
     import MakeBinaryCompiledFunction(S, SF, SF, SF)
 
@@ -73661,7 +99402,9 @@ MakeFloatCompiledFunction(S): Exports == Implementation where
     lsf := convert([convert("DoubleFloat"::Symbol)@INF]$List(INF))@INF
 
     streq?(s, st)    == s = convert(st::Symbol)@INF
+
     gencode(s, l)    == convert(concat(convert(s::Symbol)@INF, l))@INF
+
     streqlist?(s, l) == member?(string symbol s, l)
 
     mkPretend form ==
@@ -73710,7 +99453,6 @@ MakeFloatCompiledFunction(S): Exports == Implementation where
         ans := concat(u::INF, ans)
       reverse_! ans
     
-
     mkLisp s ==
       atom? s => s
       op := first(l := destruct s)
@@ -73736,6 +99478,94 @@ MakeFloatCompiledFunction(S): Exports == Implementation where
 \begin{chunk}{COQ MKFLCFN}
 (* package MKFLCFN *)
 (*
+
+    import MakeUnaryCompiledFunction(S, SF, SF)
+    import MakeBinaryCompiledFunction(S, SF, SF, SF)
+
+    streq?    : (INF, String) -> Boolean
+    streqlist?: (INF, List String) -> Boolean
+    gencode   : (String, List INF) -> INF
+    mkLisp    : INF -> Union(INF, "failed")
+    mkLispList: List INF -> Union(List INF, "failed")
+    mkDefun   : (INF, List INF) -> INF
+    mkLispCall: INF -> INF
+    mkPretend : INF -> INF
+    mkCTOR : INF -> INF
+
+    lsf := convert([convert("DoubleFloat"::Symbol)@INF]$List(INF))@INF
+
+    streq?(s, st)    == s = convert(st::Symbol)@INF
+
+    gencode(s, l)    == convert(concat(convert(s::Symbol)@INF, l))@INF
+
+    streqlist?(s, l) == member?(string symbol s, l)
+
+    mkPretend form ==
+      convert([convert("pretend"::Symbol), form, lsf]$List(INF))@INF
+
+    mkCTOR form ==
+      convert([convert("C-TO-R"::Symbol), form]$List(INF))@INF
+
+
+    mkLispCall name ==
+      convert([convert("$elt"::Symbol),
+                           convert("Lisp"::Symbol), name]$List(INF))@INF
+
+    mkDefun(s, lv) ==
+      name := convert(new()$Symbol)@INF
+      fun  := convert([convert("DEFUN"::Symbol), name, convert lv,
+              gencode("DECLARE",[gencode("FLOAT",lv)]),mkCTOR s]$List(INF))@INF
+      EVAL(fun)$Lisp
+      if _$compileDontDefineFunctions$Lisp then COMPILE(name)$Lisp
+      name
+
+    makeFloatFunction(f, x, y) ==
+      (u := mkLisp(convert(f)@INF)) case "failed" =>
+        compiledFunction(f, x, y)
+      name := mkDefun(u::INF, [ix := convert x, iy := convert y])
+      t    := [lsf, lsf]$List(INF)
+      spadname := declare DI2
+      spadform:=mkPretend convert([mkLispCall name,ix,iy]$List(INF))@INF
+      interpret function(spadform, [x, y], spadname)
+      binaryFunction compile(spadname, t)
+
+    makeFloatFunction(f, var) ==
+      (u := mkLisp(convert(f)@INF)) case "failed" =>
+        compiledFunction(f, var)
+      name := mkDefun(u::INF, [ivar := convert var])
+      t    := [lsf]$List(INF)
+      spadname := declare DI1
+      spadform:= mkPretend convert([mkLispCall name,ivar]$List(INF))@INF
+      interpret function(spadform, [var], spadname)
+      unaryFunction compile(spadname, t)
+
+    mkLispList l ==
+      ans := nil()$List(INF)
+      for s in l repeat
+        (u := mkLisp s) case "failed" => return "failed"
+        ans := concat(u::INF, ans)
+      reverse_! ans
+    
+    mkLisp s ==
+      atom? s => s
+      op := first(l := destruct s)
+      (u := mkLispList rest l) case "failed" => "failed"
+      ll := u::List(INF)
+      streqlist?(op, ["+","*","/","-"]) => convert(concat(op, ll))@INF
+      streq?(op, "**") => gencode("EXPT", ll)
+      streqlist?(op, ["exp","sin","cos","tan","atan", 
+         "log", "sinh","cosh","tanh","asinh","acosh","atanh","sqrt"]) =>
+            gencode(upperCase string symbol op, ll)
+      streq?(op, "nthRoot") =>
+        second ll = convert(2::Integer)@INF =>gencode("SQRT",[first ll])
+        gencode("EXPT", concat(first ll, [1$INF / second ll]))
+      streq?(op, "float") =>
+        a := ll.1
+        e := ll.2
+        b := ll.3
+        _*(a, EXPT(b, e)$Lisp)$Lisp pretend INF
+      "failed"
+
 *)
 
 \end{chunk}
@@ -74005,8 +99835,11 @@ MakeFunction(S:ConvertibleTo InputForm): Exports == Implementation where
       ++ \spad{foo(x1,...,xn) == e}.
 
   Implementation ==> add
+
     function(s, name)            == function(s, name, nil())
+
     function(s:S, name:SY, x:SY) == function(s, name, [x])
+
     function(s, name, x, y)      == function(s, name, [x, y])
 
     function(s:S, name:SY, args:List SY) ==
@@ -74018,6 +99851,17 @@ MakeFunction(S:ConvertibleTo InputForm): Exports == Implementation where
 \begin{chunk}{COQ MKFUNC}
 (* package MKFUNC *)
 (*
+
+    function(s, name)            == function(s, name, nil())
+
+    function(s:S, name:SY, x:SY) == function(s, name, [x])
+
+    function(s, name, x, y)      == function(s, name, [x, y])
+
+    function(s:S, name:SY, args:List SY) ==
+      interpret function(convert s, args, name)$InputForm
+      name
+
 *)
 
 \end{chunk}
@@ -74085,6 +99929,7 @@ MakeRecord(S: Type, T: Type): public == private where
       ++ Record(part1:S, part2:R), 
       ++ where part1 is \spad{a} and part2 is \spad{b}.
   private == add
+
     makeRecord(s: S, t: T)  ==
       [s,t]$Record(part1: S, part2: T)
 
@@ -74093,6 +99938,10 @@ MakeRecord(S: Type, T: Type): public == private where
 \begin{chunk}{COQ MKRECORD}
 (* package MKRECORD *)
 (*
+
+    makeRecord(s: S, t: T)  ==
+      [s,t]$Record(part1: S, part2: T)
+
 *)
 
 \end{chunk}
@@ -74179,6 +100028,7 @@ MakeUnaryCompiledFunction(S, D, I): Exports == Implementation where
       ++ applicable to objects of type D.
 
   Implementation ==> add
+
     import MakeFunction(S)
 
     func: (SY, D) -> I
@@ -74196,6 +100046,20 @@ MakeUnaryCompiledFunction(S, D, I): Exports == Implementation where
 \begin{chunk}{COQ MKUCFUNC}
 (* package MKUCFUNC *)
 (*
+
+    import MakeFunction(S)
+
+    func: (SY, D) -> I
+
+    func(name, x)       == FUNCALL(name, x, NIL$Lisp)$Lisp
+
+    unaryFunction name  == (d1:D):I +-> func(name, d1)
+
+    compiledFunction(e:S, x:SY) ==
+      t := [convert([devaluate(D)$Lisp]$List(InputForm))
+           ]$List(InputForm)
+      unaryFunction compile(function(e, declare DI, x), t)
+
 *)
 
 \end{chunk}
@@ -74273,9 +100137,11 @@ MappingPackageInternalHacks1(A: SetCategory): MPcat == MPdef where
           ++\spad{recur(n,g,x)} is \spad{g(n,g(n-1,..g(1,x)..))}.
  
     MPdef == add
+
         iter(g,n,x)  ==
             for i in 1..n repeat x := g x     -- g(g(..(x)..))
             x
+
         recur(g,n,x) ==
             for i in 1..n repeat x := g(i,x)  -- g(n,g(n-1,..g(1,x)..))
             x
@@ -74285,6 +100151,15 @@ MappingPackageInternalHacks1(A: SetCategory): MPcat == MPdef where
 \begin{chunk}{COQ MAPHACK1}
 (* package MAPHACK1 *)
 (*
+
+        iter(g,n,x)  ==
+            for i in 1..n repeat x := g x     -- g(g(..(x)..))
+            x
+
+        recur(g,n,x) ==
+            for i in 1..n repeat x := g(i,x)  -- g(n,g(n-1,..g(1,x)..))
+            x
+
 *)
 
 \end{chunk}
@@ -74359,7 +100234,9 @@ MappingPackageInternalHacks2(A: SetCategory, C: SetCategory):_
           ++\spad{arg2(a,c)} selects its second argument.
  
     MPdef == add
+
         arg1(a, c)   == a
+
         arg2(a, c)   == c
 
 \end{chunk}
@@ -74367,6 +100244,11 @@ MappingPackageInternalHacks2(A: SetCategory, C: SetCategory):_
 \begin{chunk}{COQ MAPHACK2}
 (* package MAPHACK2 *)
 (*
+
+        arg1(a, c)   == a
+
+        arg2(a, c)   == c
+
 *)
 
 \end{chunk}
@@ -74436,6 +100318,7 @@ MappingPackageInternalHacks3(A: SetCategory, B: SetCategory, C: SetCategory):_
           ++\spad{comp(f,g,x)} is \spad{f(g x)}.
  
     MPdef == add
+
         comp(g,h,x)  == g h x
 
 \end{chunk}
@@ -74443,6 +100326,9 @@ MappingPackageInternalHacks3(A: SetCategory, B: SetCategory, C: SetCategory):_
 \begin{chunk}{COQ MAPHACK3}
 (* package MAPHACK3 *)
 (*
+
+        comp(g,h,x)  == g h x
+
 *)
 
 \end{chunk}
@@ -74957,7 +100843,9 @@ MappingPackage1(A:SetCategory): MPcat == MPdef where
         f0a:  ()-> A
  
         nullary a   == a
+
         coerce  a   == nullary a
+
         fixedPoint faa ==
             g0 := GENSYM()$Lisp
             g1 := faa g0
@@ -74973,6 +100861,7 @@ MappingPackage1(A:SetCategory): MPcat == MPdef where
  
         -- Composition and recursion.
         id a        == a
+
         g**n        == (a1:A):A +-> iter(g, n, a1)
  
         recur fnaa  == (n1:NNI,a2:A):A +-> recur(fnaa, n1, a2)
@@ -74982,6 +100871,37 @@ MappingPackage1(A:SetCategory): MPcat == MPdef where
 \begin{chunk}{COQ MAPPKG1}
 (* package MAPPKG1 *)
 (*
+ 
+        MappingPackageInternalHacks1(A)
+ 
+        a: A
+        faa:  A -> A
+        f0a:  ()-> A
+ 
+        nullary a   == a
+
+        coerce  a   == nullary a
+
+        fixedPoint faa ==
+            g0 := GENSYM()$Lisp
+            g1 := faa g0
+            EQ(g0, g1)$Lisp => error "All points are fixed points"
+            GEQNSUBSTLIST([g0]$Lisp, [g1]$Lisp, g1)$Lisp
+ 
+        fixedPoint(fll, n) ==
+            g0 := [(GENSYM()$Lisp):A for i in 1..n]
+            g1 := fll g0
+            or/[EQ(e0,e1)$Lisp for e0 in g0 for e1 in g1] =>
+                error "All points are fixed points"
+            GEQNSUBSTLIST(g0, g1, g1)$Lisp
+ 
+        -- Composition and recursion.
+        id a        == a
+
+        g**n        == (a1:A):A +-> iter(g, n, a1)
+ 
+        recur fnaa  == (n1:NNI,a2:A):A +-> recur(fnaa, n1, a2)
+
 *)
 
 \end{chunk}
@@ -75477,8 +101397,11 @@ MappingPackage2(A:SetCategory, C:SetCategory): MPcat == MPdef where
         faac: (A,A)->C
  
         const c       == (a1:A):C +-> arg2(a1, c)
+
         curry(fac, a) == fac a
+
         constant f0c  == (a1:A):C +-> arg2(a1, f0c())
+
         diag  faac    == (a1:A):C +-> faac(a1, a1)
 
 \end{chunk}
@@ -75486,6 +101409,24 @@ MappingPackage2(A:SetCategory, C:SetCategory): MPcat == MPdef where
 \begin{chunk}{COQ MAPPKG2}
 (* package MAPPKG2 *)
 (*
+ 
+        MappingPackageInternalHacks2(A, C)
+ 
+        a: A
+        c: C
+        faa:  A -> A
+        f0c:  ()-> C
+        fac:  A -> C
+        faac: (A,A)->C
+ 
+        const c       == (a1:A):C +-> arg2(a1, c)
+
+        curry(fac, a) == fac a
+
+        constant f0c  == (a1:A):C +-> arg2(a1, f0c())
+
+        diag  faac    == (a1:A):C +-> faac(a1, a1)
+
 *)
 
 \end{chunk}
@@ -76000,10 +101941,12 @@ MappingPackage3(A:SetCategory, B:SetCategory, C:SetCategory):_
  
         -- Fix left and right arguments as constants.
         curryRight(fabc,b) == (a:A):C +-> fabc(a,b)
+
         curryLeft(fabc,a)  == (b:B):C +-> fabc(a,b)
  
         -- Add left and right arguments which are ignored.
         constantRight fac == (a:A, b:B):C +-> fac a
+
         constantLeft fbc  == (a:A, b:B):C +-> fbc b
  
         -- Combinators to rearrange arguments.
@@ -76017,6 +101960,36 @@ MappingPackage3(A:SetCategory, B:SetCategory, C:SetCategory):_
 \begin{chunk}{COQ MAPPKG3}
 (* package MAPPKG3 *)
 (*
+ 
+        MappingPackageInternalHacks3(A, B, C)
+ 
+        a: A
+        b: B
+        c: C
+        faa:  A -> A
+        f0c:  ()-> C
+        fac:  A -> C
+        fbc:  B -> C
+        fab:  A -> B
+        fabc: (A,B)->C
+        faac: (A,A)->C
+ 
+        -- Fix left and right arguments as constants.
+        curryRight(fabc,b) == (a:A):C +-> fabc(a,b)
+
+        curryLeft(fabc,a)  == (b:B):C +-> fabc(a,b)
+ 
+        -- Add left and right arguments which are ignored.
+        constantRight fac == (a:A, b:B):C +-> fac a
+
+        constantLeft fbc  == (a:A, b:B):C +-> fbc b
+ 
+        -- Combinators to rearrange arguments.
+        twist fabc == (b:B, a:A):C +-> fabc(a,b)
+
+        -- Functional composition
+        fbc*fab == (a:A):C +-> comp(fbc,fab,a)
+
 *)
 
 \end{chunk}
@@ -76345,7 +102318,9 @@ MappingPackage4(A:SetCategory, B:Ring):
         ++X (p/q)(4)
         ++X (p/q)(x)
   == add
+
     fab ==> (A -> B)
+
     faei ==> (A -> Expression(Integer))
 
     funcAdd(g:fab,h:fab,x:A):B == ((g x) + (h x))$B
@@ -76370,6 +102345,28 @@ MappingPackage4(A:SetCategory, B:Ring):
 \begin{chunk}{COQ MAPPKG4}
 (* package MAPPKG4 *)
 (*
+
+    fab ==> (A -> B)
+
+    faei ==> (A -> Expression(Integer))
+
+    funcAdd(g:fab,h:fab,x:A):B == ((g x) + (h x))$B
+
+    (a:fab)+(b:fab) == c +-> funcAdd(a,b,c)
+
+    funcSub(g:fab,h:fab,x:A):B == ((g x) - (h x))$B
+
+    (a:fab)-(b:fab) == c +-> funcSub(a,b,c)
+
+    funcMul(g:fab,h:fab,x:A):B == ((g x) * (h x))$B
+
+    (a:fab)*(b:fab) == c +-> funcMul(a,b,c)
+
+    funcDiv(g:faei,h:faei,x:A):Expression(Integer)
+           == ((g x) / (h x))$Expression(Integer)
+
+    (a:faei)/(b:faei) == c +-> funcDiv(a,b,c)
+
 *)
 
 \end{chunk}
@@ -76461,6 +102458,7 @@ MatrixCategoryFunctions2(R1,Row1,Col1,M1,R2,Row2,Col2,M2):_
      ++ \spad{n[i,j] = f(m[i,j],r)} for all indices i and j.
 
   Implementation ==> add
+
     minr ==> minRowIndex
     maxr ==> maxRowIndex
     minc ==> minColIndex
@@ -76493,6 +102491,34 @@ MatrixCategoryFunctions2(R1,Row1,Col1,M1,R2,Row2,Col2,M2):_
 \begin{chunk}{COQ MATCAT2}
 (* package MATCAT2 *)
 (*
+
+    minr ==> minRowIndex
+    maxr ==> maxRowIndex
+    minc ==> minColIndex
+    maxc ==> maxColIndex
+
+    map(f:(R1->R2),m:M1):M2 ==
+      ans : M2 := new(nrows m,ncols m,0)
+      for i in minr(m)..maxr(m) for k in minr(ans)..maxr(ans) repeat
+        for j in minc(m)..maxc(m) for l in minc(ans)..maxc(ans) repeat
+          qsetelt_!(ans,k,l,f qelt(m,i,j))
+      ans
+
+    map(f:(R1 -> (Union(R2,"failed"))),m:M1):Union(M2,"failed") ==
+      ans : M2 := new(nrows m,ncols m,0)
+      for i in minr(m)..maxr(m) for k in minr(ans)..maxr(ans) repeat
+        for j in minc(m)..maxc(m) for l in minc(ans)..maxc(ans) repeat
+          (r := f qelt(m,i,j)) = "failed" => return "failed"
+          qsetelt_!(ans,k,l,r::R2)
+      ans
+
+    reduce(f,m,ident) ==
+      s := ident
+      for i in minr(m)..maxr(m) repeat
+       for j in minc(m)..maxc(m) repeat
+         s := f(qelt(m,i,j),s)
+      s
+
 *)
 
 \end{chunk}
@@ -76583,6 +102609,7 @@ MatrixCommonDenominator(R, Q): Exports == Implementation where
       ++ is a common denominator for the elements of q.
  
   Implementation ==> add
+
     import ListFunctions2(Q, R)
     import MatrixCategoryFunctions2(Q,VQ,VQ,Matrix Q,R,VR,VR,Matrix R)
  
@@ -76595,8 +102622,11 @@ MatrixCommonDenominator(R, Q): Exports == Implementation where
       [map(x +-> numer(d*x), m), d]
  
     if R has GcdDomain then
+
       commonDenominator m == lcm map(denom, parts m)
+
     else
+
       commonDenominator m == reduce("*",map(denom, parts m),1)$List(R)
 
 \end{chunk}
@@ -76604,6 +102634,26 @@ MatrixCommonDenominator(R, Q): Exports == Implementation where
 \begin{chunk}{COQ MCDEN}
 (* package MCDEN *)
 (*
+
+    import ListFunctions2(Q, R)
+    import MatrixCategoryFunctions2(Q,VQ,VQ,Matrix Q,R,VR,VR,Matrix R)
+ 
+    clearDenominator m ==
+      d := commonDenominator m
+      map(x +-> numer(d*x), m)
+ 
+    splitDenominator m ==
+      d := commonDenominator m
+      [map(x +-> numer(d*x), m), d]
+ 
+    if R has GcdDomain then
+
+      commonDenominator m == lcm map(denom, parts m)
+
+    else
+
+      commonDenominator m == reduce("*",map(denom, parts m),1)$List(R)
+
 *)
 
 \end{chunk}
@@ -76817,6 +102867,7 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where
       m
              -- elementary operation of second kind: add to column i --
                            -- a*column j (i^=j) --
+
     elColumn2!(m : M,a:R,i:I,j:I) : M ==
       vec:= map((r1:R):R +-> a*r1,column(m,j))
       vec:=map("+",column(m,i),vec)
@@ -76825,6 +102876,7 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where
 
     if R has IntegralDomain then
       -- Fraction-Free Gaussian Elimination
+
       fractionFreeGauss! x  ==
         (ndim := nrows x) = 1 => x
         ans := b := 1$R
@@ -76904,18 +102956,27 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where
       MAT2    ==> MatrixCategoryFunctions2(R,Row,Col,M,R,VR,VR,Matrix R)
 
       rowEchelon  y == rowEchelon(y)$IMATLIN
+
       rank        y == rank(y)$IMATLIN
+
       nullity     y == nullity(y)$IMATLIN
+
       determinant y == determinant(y)$IMATLIN
+
       inverse     y == inverse(y)$IMATLIN
+
       if Col has shallowlyMutable then
+
         nullSpace y == nullSpace(y)$IMATLIN
+
       else
+
         nullSpace y ==
           [map((r1:R):R +-> r1, v)$FLA2
             for v in nullSpace(map((r2:R):R +-> r2, y)$MAT2)$MMATLIN]
 
     else if R has IntegralDomain then
+
       QF     ==> Fraction R
       Row2   ==> Vector QF
       Col2   ==> Vector QF
@@ -76947,6 +103008,7 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where
       if R has EuclideanDomain then
 
         if R has IntegerNumberSystem then
+
             normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) ==
                qr := divide(n, d)
                qr.remainder >= 0 => qr
@@ -76957,7 +103019,9 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where
                qr.remainder := qr.remainder - d
                qr.quotient := qr.quotient + 1
                qr
+
         else
+
             normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) ==
                divide(n, d)
 
@@ -77013,6 +103077,276 @@ MatrixLinearAlgebraFunctions(R,Row,Col,M):Exports == Implementation where
 \begin{chunk}{COQ MATLIN}
 (* package MATLIN *)
 (*
+
+    rowAllZeroes?: (M,I) -> Boolean
+    rowAllZeroes?(x,i) ==
+      -- determines if the ith row of x consists only of zeroes
+      -- internal function: no check on index i
+      for j in minColIndex(x)..maxColIndex(x) repeat
+        qelt(x,i,j) ^= 0 => return false
+      true
+
+    colAllZeroes?: (M,I) -> Boolean
+    colAllZeroes?(x,j) ==
+      -- determines if the ith column of x consists only of zeroes
+      -- internal function: no check on index j
+      for i in minRowIndex(x)..maxRowIndex(x) repeat
+        qelt(x,i,j) ^= 0 => return false
+      true
+
+    minorDet:(M,I,List I,I,PrimitiveArray(Union(R,"uncomputed")))-> R
+    minorDet(x,m,l,i,v) ==
+      z := v.m
+      z case R => z
+      ans : R := 0; rl : List I := nil()
+      j := first l; l := rest l; pos := true
+      minR := minRowIndex x; minC := minColIndex x;
+      repeat
+        if qelt(x,j + minR,i + minC) ^= 0 then
+          ans :=
+            md := minorDet(x,m - 2**(j :: NonNegativeInteger),_
+                           concat_!(reverse rl,l),i + 1,v) *_
+                           qelt(x,j + minR,i + minC)
+            pos => ans + md
+            ans - md
+        null l =>
+          v.m := ans
+          return ans
+        pos := not pos; rl := cons(j,rl); j := first l; l := rest l
+
+    minordet x ==
+      (ndim := nrows x) ^= (ncols x) =>
+        error "determinant: matrix must be square"
+      -- minor expansion with (s---loads of) memory
+      n1 : I := ndim - 1
+      v : PrimitiveArray(Union(R,"uncomputed")) :=
+           new((2**ndim - 1) :: NonNegativeInteger,"uncomputed")
+      minR := minRowIndex x; maxC := maxColIndex x
+      for i in 0..n1 repeat
+        qsetelt_!(v,(2**i - 1),qelt(x,i + minR,maxC))
+      minorDet(x, 2**ndim - 2, [i for i in 0..n1], 0, v)
+
+       -- elementary operation of first kind: exchange two rows --
+    elRow1!(m:M,i:I,j:I) : M ==
+      vec:=row(m,i)
+      setRow!(m,i,row(m,j))
+      setRow!(m,j,vec)
+      m
+
+             -- elementary operation of second kind: add to row i--
+                         -- a*row j  (i^=j) --
+    elRow2!(m : M,a:R,i:I,j:I) : M ==
+      vec:= map((r1:R):R +-> a*r1,row(m,j))
+      vec:=map("+",row(m,i),vec)
+      setRow!(m,i,vec)
+      m
+             -- elementary operation of second kind: add to column i --
+                           -- a*column j (i^=j) --
+
+    elColumn2!(m : M,a:R,i:I,j:I) : M ==
+      vec:= map((r1:R):R +-> a*r1,column(m,j))
+      vec:=map("+",column(m,i),vec)
+      setColumn!(m,i,vec)
+      m
+
+    if R has IntegralDomain then
+      -- Fraction-Free Gaussian Elimination
+
+      fractionFreeGauss! x  ==
+        (ndim := nrows x) = 1 => x
+        ans := b := 1$R
+        minR := minRowIndex x; maxR := maxRowIndex x
+        minC := minColIndex x; maxC := maxColIndex x
+        i := minR
+        for j in minC..maxC repeat
+          if qelt(x,i,j) = 0 then -- candidate for pivot = 0
+            rown := minR - 1
+            for k in (i+1)..maxR repeat
+              if qelt(x,k,j) ^= 0 then
+                 rown := k -- found a pivot
+                 leave
+            if rown > minR - 1 then
+               swapRows_!(x,i,rown)
+               ans := -ans
+          (c := qelt(x,i,j)) = 0 =>  "next j" -- try next column
+          for k in (i+1)..maxR repeat
+            if qelt(x,k,j) = 0 then
+              for l in (j+1)..maxC repeat
+                qsetelt_!(x,k,l,(c * qelt(x,k,l) exquo b) :: R)
+            else
+              pv := qelt(x,k,j)
+              qsetelt_!(x,k,j,0)
+              for l in (j+1)..maxC repeat
+                val := c * qelt(x,k,l) - pv * qelt(x,i,l)
+                qsetelt_!(x,k,l,(val exquo b) :: R)
+          b := c
+          (i := i+1)>maxR => leave
+        if ans=-1 then
+          lasti := i-1
+          for j in 1..maxC repeat x(lasti, j) := -x(lasti,j)
+        x
+
+      --
+      lastStep(x:M)  : M ==
+        ndim := nrows x
+        minR := minRowIndex x; maxR := maxRowIndex x
+        minC := minColIndex x; maxC := minC+ndim -1
+        exCol:=maxColIndex x
+        det:=x(maxR,maxC)
+        maxR1:=maxR-1
+        maxC1:=maxC+1
+        minC1:=minC+1
+        iRow:=maxR
+        iCol:=maxC-1
+        for i in maxR1..1 by -1 repeat
+          for j in maxC1..exCol repeat
+            ss:=+/[x(i,iCol+k)*x(i+k,j) for k in 1..(maxR-i)]
+            x(i,j) := _exquo((det * x(i,j) - ss),x(i,iCol))::R
+          iCol:=iCol-1
+        subMatrix(x,minR,maxR,maxC1,exCol)
+
+      invertIfCan(y) ==
+        (nr:=nrows y) ^= (ncols y) =>
+            error "invertIfCan: matrix must be square"
+        adjRec := adjoint y
+        (den:=recip(adjRec.detMat)) case "failed" => "failed"
+        den::R * adjRec.adjMat
+
+      adjoint(y) ==
+        (nr:=nrows y) ^= (ncols y) => error "adjoint: matrix must be square"
+        maxR := maxRowIndex y
+        maxC := maxColIndex y
+        x := horizConcat(copy y,scalarMatrix(nr,1$R))
+        ffr:= fractionFreeGauss!(x)
+        det:=ffr(maxR,maxC)
+        [lastStep(ffr),det]
+
+
+    if R has Field then
+
+      VR      ==> Vector R
+      IMATLIN ==> InnerMatrixLinearAlgebraFunctions(R,Row,Col,M)
+      MMATLIN ==> InnerMatrixLinearAlgebraFunctions(R,VR,VR,Matrix R)
+      FLA2    ==> FiniteLinearAggregateFunctions2(R, VR, R, Col)
+      MAT2    ==> MatrixCategoryFunctions2(R,Row,Col,M,R,VR,VR,Matrix R)
+
+      rowEchelon  y == rowEchelon(y)$IMATLIN
+
+      rank        y == rank(y)$IMATLIN
+
+      nullity     y == nullity(y)$IMATLIN
+
+      determinant y == determinant(y)$IMATLIN
+
+      inverse     y == inverse(y)$IMATLIN
+
+      if Col has shallowlyMutable then
+
+        nullSpace y == nullSpace(y)$IMATLIN
+
+      else
+
+        nullSpace y ==
+          [map((r1:R):R +-> r1, v)$FLA2
+            for v in nullSpace(map((r2:R):R +-> r2, y)$MAT2)$MMATLIN]
+
+    else if R has IntegralDomain then
+
+      QF     ==> Fraction R
+      Row2   ==> Vector QF
+      Col2   ==> Vector QF
+      M2     ==> Matrix QF
+      IMATQF ==> InnerMatrixQuotientFieldFunctions(R,Row,Col,M,QF,Row2,Col2,M2)
+
+      nullSpace m == nullSpace(m)$IMATQF
+
+      determinant y ==
+        (nrows y) ^= (ncols y) => error "determinant: matrix must be square"
+        fm:=fractionFreeGauss!(copy y)
+        fm(maxRowIndex fm,maxColIndex fm)
+
+      rank x ==
+        y :=
+          (rk := nrows x) > (rh := ncols x) =>
+              rk := rh
+              transpose x
+          copy x
+        y := fractionFreeGauss! y
+        i := maxRowIndex y
+        while rk > 0 and rowAllZeroes?(y,i) repeat
+          i := i - 1
+          rk := (rk - 1) :: NonNegativeInteger
+        rk :: NonNegativeInteger
+
+      nullity x == (ncols x - rank x) :: NonNegativeInteger
+
+      if R has EuclideanDomain then
+
+        if R has IntegerNumberSystem then
+
+            normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) ==
+               qr := divide(n, d)
+               qr.remainder >= 0 => qr
+               d > 0 =>
+                  qr.remainder := qr.remainder + d
+                  qr.quotient := qr.quotient - 1
+                  qr
+               qr.remainder := qr.remainder - d
+               qr.quotient := qr.quotient + 1
+               qr
+
+        else
+
+            normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) ==
+               divide(n, d)
+
+        rowEchelon y ==
+          x := copy y
+          minR := minRowIndex x; maxR := maxRowIndex x
+          minC := minColIndex x; maxC := maxColIndex x
+          n := minR - 1
+          i := minR
+          for j in minC..maxC repeat
+            if i > maxR then leave x
+            n := minR - 1
+            xnj: R
+            for k in i..maxR repeat
+              if not zero?(xkj:=qelt(x,k,j)) and ((n = minR - 1) _
+                     or sizeLess?(xkj,xnj)) then
+                n := k
+                xnj := xkj
+            n = minR - 1 => "next j"
+            swapRows_!(x,i,n)
+            for k in (i+1)..maxR repeat
+              qelt(x,k,j) = 0 => "next k"
+              aa := extendedEuclidean(qelt(x,i,j),qelt(x,k,j))
+              (a,b,d) := (aa.coef1,aa.coef2,aa.generator)
+              b1 := (qelt(x,i,j) exquo d) :: R
+              a1 := (qelt(x,k,j) exquo d) :: R
+              -- a*b1+a1*b = 1
+              for k1 in (j+1)..maxC repeat
+                val1 := a * qelt(x,i,k1) + b * qelt(x,k,k1)
+                val2 := -a1 * qelt(x,i,k1) + b1 * qelt(x,k,k1)
+                qsetelt_!(x,i,k1,val1); qsetelt_!(x,k,k1,val2)
+              qsetelt_!(x,i,j,d); qsetelt_!(x,k,j,0)
+
+            un := unitNormal qelt(x,i,j)
+            qsetelt_!(x,i,j,un.canonical)
+            if un.associate ^= 1 then for jj in (j+1)..maxC repeat
+                qsetelt_!(x,i,jj,un.associate * qelt(x,i,jj))
+
+            xij := qelt(x,i,j)
+            for k in minR..(i-1) repeat
+              qelt(x,k,j) = 0 => "next k"
+              qr := normalizedDivide(qelt(x,k,j), xij)
+              qsetelt_!(x,k,j,qr.remainder)
+              for k1 in (j+1)..maxC repeat
+                qsetelt_!(x,k,k1,qelt(x,k,k1) - qr.quotient * qelt(x,i,k1))
+            i := i + 1
+          x
+
+    else determinant x == minordet x
+
 *)
 
 \end{chunk}
@@ -79578,6 +105912,151 @@ MatrixManipulation(R, Row, Col, M) : Exports == Implementation where
 \begin{chunk}{COQ MAMA}
 (* package MAMA *)
 (*
+
+    minr ==> minRowIndex
+    maxr ==> maxRowIndex
+    minc ==> minColIndex
+    maxc ==> maxColIndex
+
+    -- Custom function to expand Segment(PositiveInteger) into 
+    -- List(PositiveInteger). This operation is not supported by the 
+    -- overly restrictive library implementation.
+    expand(spi : SPI) : LPI ==
+        lr := empty()$LPI
+        l : PI := lo spi
+        h : PI := hi spi
+        inc : I := incr spi
+        zero? inc => error "Cannot expand a segment with an increment of zero"
+        if inc > 0 then
+          while l <= h repeat
+            lr := concat(l, lr)
+            l := (l + inc) pretend PI
+        else
+          while l >= h repeat
+            lr := concat(l, lr)
+            l := (l + inc) pretend PI
+        reverse! lr
+
+    element(A, r, c) ==
+      matrix([[A(r,c)]])
+
+    aRow(A:M, r:PI) : M ==
+      subMatrix(A, r, r, minc A, maxc A)
+
+    rows(A:M, lst:LPI) : M ==
+      ls := [aRow(A, r) for r in lst]
+      reduce(vertConcat, ls)
+
+    rows(A:M, si:SPI) : M ==
+      rows(A, expand(si))
+
+    aColumn(A:M, c:PI) : M ==
+      subMatrix(A, minr A, maxr A, c, c)
+
+    columns(A:M, lst:LPI) : M ==
+      ls := [aColumn(A,c) for c in lst]
+      reduce(horizConcat, ls)
+
+    columns(A:M, si:SPI) : M ==
+      columns(A, expand(si))
+
+    diagonalMatrix(A, n) ==
+      nr := nrows(A)
+      nc := ncols(A)
+      n > (nc-1) => error "requested diagonal out of range"
+      n < 0 and abs(n) > (nr-1) => error "requested diagonal out of range"
+      B := zero(nr,nc)
+      if n >= 0 then
+        dl := min(nc-n, nr)
+        sr := minr(A)
+        sc := minc(A) + n
+      else
+        dl := min(nc, nr-abs(n))
+        sr := minr(A) + abs(n)
+        sc := minc(A)
+      for i in 0..(dl-1) repeat
+        qsetelt!(B, sr+i, sc+i, A(sr+i, sc+i))
+      B
+
+    diagonalMatrix(A) ==
+      diagonalMatrix(A, 0)
+
+    bandMatrix(A:M, ln:LI) : M ==
+      -- Really inefficient
+      reduce("+", [diagonalMatrix(A,d) for d in ln])
+
+    bandMatrix(A:M, si:SI) : M ==
+      bandMatrix(A, expand(si))
+
+    subMatrix(A:M, lr:LPI, lc:LPI) : M ==
+      -- Really inefficient
+      lle := [[ element(A,r,c) for c in lc] for r in lr]
+      blockConcat(lle)
+
+    subMatrix(A:M, sr:SPI, sc:SPI) : M ==
+      subMatrix(A, low sr, high sr, low sc, high sc)
+
+    -- Stack matrices
+
+    horizConcat(LA) ==
+      reduce(horizConcat, LA)
+
+    vertConcat(LA) ==
+      reduce(vertConcat, LA)
+
+    blockConcat(LLA: List List M) : M ==
+      reduce(vertConcat, [reduce(horizConcat, LA) for LA in LLA])
+
+    -- Split matrices
+
+    vertSplit(A:M, r:PI) : List M ==
+      dr := nrows(A) exquo r
+      dr case "failed" => error "split does not result in an equal division"
+      mir := minr A
+      mic := minc A
+      mac := maxc A
+      [ subMatrix(A, mir+i*dr, mir+(i+1)*dr-1, mic, mac) for i in 0..(r-1) ]
+
+    vertSplit(A:M, lr:LPI) : List M ==
+      reduce("+", lr) ~= nrows(A) => _
+          error "split does not result in proper partition"
+      l : List PI := cons(1, scan(_+, lr, 1$PI)$ListFunctions2(PI,PI))
+      mir := minr(A) -1   -- additional shift because l starts at 1
+      mic := minc A
+      mac := maxc A
+      result := _
+        [ subMatrix(A, mir+l(i-1), mir+l(i)-1, mic, mac) for i in 2..#l ]
+
+    horizSplit(A:M, c:PI) : List M ==
+      dc := ncols(A) exquo c
+      dc case "failed" => error "split does not result in an equal division"
+      mir := minr A
+      mar := maxr A
+      mic := minc A
+      [ subMatrix(A, mir, mar, mic+i*dc, mic+(i+1)*dc-1) for i in 0..(c-1) ]
+
+    horizSplit(A:M, lc:LPI) : List M ==
+      reduce("+", lc) ~= ncols(A) => _
+          error "split does not result in proper partition"
+      l : List PI := cons(1, scan(_+, lc, 1$PI)$ListFunctions2(PI,PI))
+      mir := minr A
+      mar := maxr A
+      mic := minc(A) -1   -- additional shift because l starts at 1
+      result := _
+         [ subMatrix(A, mir, mar, mic+l(i-1), mic+l(i)-1) for i in 2..#l ]
+
+    blockSplit(A:M, nr:PI, nc:PI) : List List M ==
+      [ horizSplit(X, nc) for X in vertSplit(A, nr) ]
+
+    blockSplit(A:M, lr:LPI, nc:PI) : List List M ==
+      [ horizSplit(X, nc) for X in vertSplit(A, lr) ]
+
+    blockSplit(A:M, nr:PI, lc:LPI) : List List M ==
+      [ horizSplit(X, lc) for X in vertSplit(A, nr) ]
+
+    blockSplit(A:M, lr:LPI, lc:LPI) : List List M ==
+      [ horizSplit(X, lc) for X in vertSplit(A, lr) ]
+
 *)
 
 \end{chunk}
@@ -79642,12 +106121,15 @@ MergeThing(S:OrderedSet): Exports == Implementation where
       ++ mergeDifference(l1,l2) returns a list of elements in l1 not present
       ++ in l2. Assumes lists are ordered and all x in l2 are also in l1.
   Implementation == add
+
     mergeDifference1: (List S,S,List S) -> List S
+
     mergeDifference(x,y) == 
       null x or null y => x
       mergeDifference1(x,y.first,y.rest)
       x.first=y.first => x.rest
       x
+
     mergeDifference1(x,fy,ry) ==  
       rx := x
       while not null rx repeat
@@ -79669,6 +106151,31 @@ MergeThing(S:OrderedSet): Exports == Implementation where
 \begin{chunk}{COQ MTHING}
 (* package MTHING *)
 (*
+
+    mergeDifference1: (List S,S,List S) -> List S
+
+    mergeDifference(x,y) == 
+      null x or null y => x
+      mergeDifference1(x,y.first,y.rest)
+      x.first=y.first => x.rest
+      x
+
+    mergeDifference1(x,fy,ry) ==  
+      rx := x
+      while not null rx repeat
+        rx := rx.rest
+        frx := rx.first
+        while fy < frx repeat
+          null ry => return x
+          fy := first ry
+          ry := rest ry
+        frx = fy =>
+          x.rest := rx.rest
+          null ry => return x
+          fy := ry.first
+          ry := ry.rest
+        x := rx
+
 *)
 
 \end{chunk}
@@ -79775,11 +106282,11 @@ MeshCreationRoutinesForThreeDimensions():Exports == Implementation where
       ++ order to compile packages.
 
   Implementation ==> add
+
     import ViewDefaultsPackage()
     import SubSpaceComponentProperty()
     import DrawOptionFunctions0
     import SPACE3
-    --import TUBE()
 
     -- local functions
     numberCheck(nums:Point SF):Void ==
@@ -79791,10 +106298,13 @@ MeshCreationRoutinesForThreeDimensions():Exports == Implementation where
       -- upon the fact that Common Lisp supports complex numbers.
       for i in minIndex(nums)..maxIndex(nums) repeat
         COMPLEXP(nums.(i::PositiveInteger))$Lisp => 
-          error "An unexpected complex number was encountered in the calculations."
+          error _
+           "An unexpected complex number was encountered in the calculations."
         
     makePt:(SF,SF,SF,SF) -> POINT
+
     makePt(x,y,z,c) == point(l : List SF := [x,y,z,c])
+
     ptFunc(f,g,h,c) ==
      (z1:SF,z2:SF):POINT +->
       x := f(z1,z2); y := g(z1,z2); z := h(z1,z2)
@@ -79836,7 +106346,6 @@ MeshCreationRoutinesForThreeDimensions():Exports == Implementation where
       close(aProp,false)
       solid(aProp,false)
       space := sp
---      space := create3Space()
       mesh(space,llp,lProp,aProp)
       space 
 
@@ -79845,6 +106354,7 @@ MeshCreationRoutinesForThreeDimensions():Exports == Implementation where
       meshPar2Var(sp,ptFun,uSeg,vSeg,opts)
 
     zCoord: (SF,SF,SF) -> SF
+
     zCoord(x,y,z) == z
 
     meshPar2Var(xFun,yFun,zFun,colorFun,uSeg,vSeg,opts) ==
@@ -79869,6 +106379,98 @@ MeshCreationRoutinesForThreeDimensions():Exports == Implementation where
 \begin{chunk}{COQ MESH}
 (* package MESH *)
 (*
+
+    import ViewDefaultsPackage()
+    import SubSpaceComponentProperty()
+    import DrawOptionFunctions0
+    import SPACE3
+
+    -- local functions
+    numberCheck(nums:Point SF):Void ==
+      -- this function checks to see that the small floats are
+      -- actually just that - rather than complex numbers or
+      -- whatever (the whatever includes nothing presently
+      -- since NaN, Not a Number, is not necessarily supported
+      -- by common lisp). note that this function is dependent
+      -- upon the fact that Common Lisp supports complex numbers.
+      for i in minIndex(nums)..maxIndex(nums) repeat
+        COMPLEXP(nums.(i::PositiveInteger))$Lisp => 
+          error _
+           "An unexpected complex number was encountered in the calculations."
+        
+    makePt:(SF,SF,SF,SF) -> POINT
+
+    makePt(x,y,z,c) == point(l : List SF := [x,y,z,c])
+
+    ptFunc(f,g,h,c) ==
+     (z1:SF,z2:SF):POINT +->
+      x := f(z1,z2); y := g(z1,z2); z := h(z1,z2)
+      makePt(x,y,z,c(x,y,z))
+
+    -- parameterized equations of two variables
+    meshPar2Var(sp,ptFun,uSeg,vSeg,opts) ==
+      -- the issue of open and closed needs to be addressed, here, we are
+      -- defaulting to open (which is probably the correct default)
+      -- the user should be able to override that (optional argument?)
+      llp : L L POINT := nil()
+      uNum : PI  := var1Steps(opts,var1StepsDefault())
+      vNum : PI  := var2Steps(opts,var2StepsDefault())
+      ustep := (lo uSeg - hi uSeg)/uNum
+      vstep := (lo vSeg - hi vSeg)/vNum
+      someV := hi vSeg
+      for iv in vNum..0 by -1 repeat
+        if zero? iv then someV := lo vSeg  
+        -- hack: get last number in segment within segment
+        lp : L POINT := nil()
+        someU := hi uSeg
+        for iu in uNum..0 by -1 repeat
+          if zero? iu then someU := lo uSeg  
+          -- hack: get last number in segment within segment
+          pt := ptFun(someU,someV)
+          numberCheck pt
+          lp := concat(pt,lp)
+          someU := someU + ustep
+        llp := concat(lp,llp)
+        someV := someV + vstep
+      -- now llp contains a list of lists of points
+      -- for a surface that is a result of a function of 2 variables,
+      -- the main component is open and each sublist is open as well
+      lProp : L COMPPROP := [ new() for l in llp ]
+      for aProp in lProp repeat
+        close(aProp,false)
+        solid(aProp,false)
+      aProp : COMPPROP:= new()
+      close(aProp,false)
+      solid(aProp,false)
+      space := sp
+      mesh(space,llp,lProp,aProp)
+      space 
+
+    meshPar2Var(ptFun,uSeg,vSeg,opts) ==
+      sp := create3Space()
+      meshPar2Var(sp,ptFun,uSeg,vSeg,opts)
+
+    zCoord: (SF,SF,SF) -> SF
+
+    zCoord(x,y,z) == z
+
+    meshPar2Var(xFun,yFun,zFun,colorFun,uSeg,vSeg,opts) ==
+      -- the color function should be parameterized by (u,v) as well, 
+      -- not (x,y,z) but we also want some sort of consistency and so 
+      -- changing this over would mean possibly changing the explicit 
+      -- stuff over and there, we probably do want the color function 
+      -- to be parameterized by (x,y,z) - not just (x,y) (this being 
+      -- for convinience only since z is also defined in terms of (x,y)).
+      (colorFun case Fn3) =>
+        meshPar2Var(ptFunc(xFun,yFun,zFun,colorFun :: Fn3),uSeg,vSeg,opts)
+      meshPar2Var(ptFunc(xFun,yFun,zFun,zCoord),uSeg,vSeg,opts)
+
+    -- explicit equations of two variables
+    meshFun2Var(zFun,colorFun,xSeg,ySeg,opts) ==
+      -- here, we construct the data for a function of two variables
+      meshPar2Var((z1:SF,z2:SF):SF +-> z1,
+                  (x1:SF,x2:SF):SF +-> x2,zFun,colorFun,xSeg,ySeg,opts)
+
 *)
 
 \end{chunk}
@@ -79985,21 +106587,26 @@ ModularDistinctDegreeFactorizer(U):C == T where
       ++ power modulo the polynomial g and the prime p.
 
   T == add
+
     reduction(u:U,p:I):U ==
        zero? p => u
        map((i1:I):I +-> positiveRemainder(i1,p),u)
+
     merge(p:I,q:I):Union(I,"failed") ==
        p = q => p
        p = 0 => q
        q = 0 => p
        "failed"
+
     modInverse(c:I,p:I):I ==
         (extendedEuclidean(c,p,1)::Record(coef1:I,coef2:I)).coef1
+
     exactquo(u:U,v:U,p:I):Union(U,"failed") ==
         invlcv:=modInverse(leadingCoefficient v,p)
         r:=monicDivide(u,reduction(invlcv*v,p))
         reduction(r.remainder,p) ^=0 => "failed"
         reduction(invlcv*r.quotient,p)
+
     EMR := EuclideanModularRing(Integer,U,Integer,
                                 reduction,merge,exactquo)
 
@@ -80014,7 +106621,9 @@ ModularDistinctDegreeFactorizer(U):C == T where
     exptmod:(EMR,I,EMR) -> EMR
 
     lc(u:EMR):I == leadingCoefficient(u::U)
+
     degree(u:EMR):I == degree(u::U)
+
     makeMonic(u) == modInverse(lc(u),modulus(u)) * u
 
     i:I
@@ -80124,7 +106733,6 @@ ModularDistinctDegreeFactorizer(U):C == T where
           s:= 0
           ss := ss + 1
           x:= y * decode(ss, p, y)
---          not one? leadingCoefficient(x) =>
           not (leadingCoefficient(x) = 1) =>
               ss := p ** degree x
               x:= y ** (degree(x) + 1)
@@ -80160,6 +106768,182 @@ ModularDistinctDegreeFactorizer(U):C == T where
 \begin{chunk}{COQ MDDFACT}
 (* package MDDFACT *)
 (*
+
+    reduction(u:U,p:I):U ==
+       zero? p => u
+       map((i1:I):I +-> positiveRemainder(i1,p),u)
+
+    merge(p:I,q:I):Union(I,"failed") ==
+       p = q => p
+       p = 0 => q
+       q = 0 => p
+       "failed"
+
+    modInverse(c:I,p:I):I ==
+        (extendedEuclidean(c,p,1)::Record(coef1:I,coef2:I)).coef1
+
+    exactquo(u:U,v:U,p:I):Union(U,"failed") ==
+        invlcv:=modInverse(leadingCoefficient v,p)
+        r:=monicDivide(u,reduction(invlcv*v,p))
+        reduction(r.remainder,p) ^=0 => "failed"
+        reduction(invlcv*r.quotient,p)
+
+    EMR := EuclideanModularRing(Integer,U,Integer,
+                                reduction,merge,exactquo)
+
+    probSplit2:(EMR,EMR,I) -> Union(List EMR,"failed")
+    trace:(EMR,I,EMR) -> EMR
+    ddfactor:EMR -> L EMR
+    ddfact:EMR -> DDList
+    sepFact1:DDRecord -> L EMR
+    sepfact:DDList -> L EMR
+    probSplit:(EMR,EMR,I) -> Union(L EMR,"failed")
+    makeMonic:EMR -> EMR
+    exptmod:(EMR,I,EMR) -> EMR
+
+    lc(u:EMR):I == leadingCoefficient(u::U)
+
+    degree(u:EMR):I == degree(u::U)
+
+    makeMonic(u) == modInverse(lc(u),modulus(u)) * u
+
+    i:I
+
+    exptmod(u1,i,u2) ==
+      i < 0 => error("negative exponentiation not allowed for exptMod")
+      ans:= 1$EMR
+      while i > 0 repeat
+        if odd?(i) then ans:= (ans * u1) rem u2
+        i:= i quo 2
+        u1:= (u1 * u1) rem u2
+      ans
+
+    exptMod(a,i,b,q) ==
+      ans:= exptmod(reduce(a,q),i,reduce(b,q))
+      ans::U
+
+    ddfactor(u) ==
+      if (c:= lc(u)) ^= 1$I then u:= makeMonic(u)
+      ans:= sepfact(ddfact(u))
+      cons(c::EMR,[makeMonic(f) for f in ans | degree(f) > 0])
+
+    gcd(u,v,q) == gcd(reduce(u,q),reduce(v,q))::U
+
+    factor(u,q) ==
+      v:= reduce(u,q)
+      dv:= reduce(differentiate(u),q)
+      degree gcd(v,dv) > 0 =>
+        error("Modular factor: polynomial must be squarefree")
+      ans:= ddfactor v
+      [f::U for f in ans]
+
+    ddfact(u) ==
+      p:=modulus u
+      w:= reduce(monomial(1,1)$U,p)
+      m:= w
+      d:I:= 1
+      if (c:= lc(u)) ^= 1$I then u:= makeMonic u
+      ans:DDList:= []
+      repeat
+        w:= exptmod(w,p,u)
+        g:= gcd(w - m,u)
+        if degree g > 0 then
+          g:= makeMonic(g)
+          ans:= [[g,d],:ans]
+          u:= (u quo g)
+        degree(u) = 0 => return [[c::EMR,0$I],:ans]
+        d:= d+1
+        d > (degree(u):I quo 2) =>
+               return [[c::EMR,0$I],[u,degree(u)],:ans]
+
+    ddFact(u,q) ==
+      ans:= ddfact(reduce(u,q))
+      [[(dd.factor)::U,dd.degree]$UDDRecord for dd in ans]$UDDList
+
+    linears(u,q) == 
+       uu:=reduce(u,q)
+       m:= reduce(monomial(1,1)$U,q)
+       gcd(exptmod(m,q,uu)-m,uu)::U
+
+    sepfact(factList) ==
+      "append"/[sepFact1(f) for f in factList]
+
+    separateFactors(uddList,q) ==
+      ans:= sepfact [[reduce(udd.factor,q),udd.degree]$DDRecord for
+        udd in uddList]$DDList
+      [f::U for f in ans]
+
+    decode(s:Integer, p:Integer, x:U):U ==
+      s<p => s::U
+      qr := divide(s,p)
+      qr.remainder :: U + x*decode(qr.quotient, p, x)
+
+    sepFact1(f) ==
+      u:= f.factor
+      p:=modulus u
+      (d := f.degree) = 0 => [u]
+      if (c:= lc(u)) ^= 1$I then u:= makeMonic(u)
+      d = (du := degree(u)) => [u]
+      ans:L EMR:= []
+      x:U:= monomial(1,1)
+      -- for small primes find linear factors by exhaustion
+      d=1 and p < 1000  =>
+        for i in 0.. while du > 0 repeat
+          if u(i::U) = 0 then
+            ans := cons(reduce(x-(i::U),p),ans)
+            du := du-1
+        ans 
+      y:= x
+      s:I:= 0
+      ss:I := 1
+      stack:L EMR:= [u]
+      until null stack repeat
+        t:= reduce(((s::U)+x),p)
+        if not ((flist:= probSplit(first stack,t,d)) case "failed") then
+          stack:= rest stack
+          for fact in flist repeat
+            f1:= makeMonic(fact)
+            (df1:= degree(f1)) = 0 => nil
+            df1 > d => stack:= [f1,:stack]
+            ans:= [f1,:ans]
+        p = 2 =>
+          ss:= ss + 1
+          x := y * decode(ss, p, y)
+        s:= s+1
+        s = p =>
+          s:= 0
+          ss := ss + 1
+          x:= y * decode(ss, p, y)
+          not (leadingCoefficient(x) = 1) =>
+              ss := p ** degree x
+              x:= y ** (degree(x) + 1)
+      [c * first(ans),:rest(ans)]
+
+    probSplit(u,t,d) ==
+      (p:=modulus(u)) = 2 => probSplit2(u,t,d)
+      f1:= gcd(u,t)
+      r:= ((p**(d:NNI)-1) quo 2):NNI
+      n:= exptmod(t,r,u)
+      f2:= gcd(u,n + 1)
+      (g:= f1 * f2) = 1 => "failed"
+      g = u => "failed"
+      [f1,f2,(u quo g)]
+
+    probSplit2(u,t,d) ==
+      f:= gcd(u,trace(t,d,u))
+      f = 1 => "failed"
+      degree u = degree f => "failed"
+      [1,f,u quo f]
+
+    trace(t,d,u) ==
+      p:=modulus(t)
+      d:= d - 1
+      tt:=t
+      while d > 0 repeat
+        tt:= (tt + (t:=exptmod(t,p,u))) rem u
+        d:= d - 1
+      tt
+
 *)
 
 \end{chunk}
@@ -80267,6 +107051,7 @@ ModularHermitianRowReduction(R): Exports == Implementation where
 
 
   Implementation ==> add
+
     order   : (R, R) -> Z
     vconc   : (M, R) -> M
     non0    : (V, Z) -> Union(REC, "failed")
@@ -80278,8 +107063,8 @@ ModularHermitianRowReduction(R): Exports == Implementation where
 
     nonzero? v == any?(s +-> s ^= 0, v)
 
--- returns [a, i, rown] if v = [0,...,0,a,0,...,0]
--- where a <> 0 and i is the index of a, "failed" otherwise.
+    -- returns [a, i, rown] if v = [0,...,0,a,0,...,0]
+    -- where a <> 0 and i is the index of a, "failed" otherwise.
     non0(v, rown) ==
       ans:REC
       allZero:Boolean := true
@@ -80292,8 +107077,8 @@ ModularHermitianRowReduction(R): Exports == Implementation where
       allZero => "failed"
       ans
 
--- returns a matrix made from the non-zero rows of x whose row number
--- is not in l
+    -- returns a matrix made from the non-zero rows of x whose row number
+    -- is not in l
     mkMat(x, l) ==
       empty?(ll := [parts row(x, i)
          for i in minRowIndex x .. maxRowIndex x |
@@ -80301,9 +107086,9 @@ ModularHermitianRowReduction(R): Exports == Implementation where
               zero(1, ncols x)
       matrix ll
 
--- returns [m, d] where m = x with the zero rows and the rows of
--- the diagonal of d removed, if x has a diagonal submatrix of d's,
--- "failed" otherwise.
+    -- returns [m, d] where m = x with the zero rows and the rows of
+    -- the diagonal of d removed, if x has a diagonal submatrix of d's,
+    -- "failed" otherwise.
     diagSubMatrix x ==
       l  := [u::REC for i in minRowIndex x .. maxRowIndex x |
                                      (u := non0(row(x, i), i)) case REC]
@@ -80313,11 +107098,11 @@ ModularHermitianRowReduction(R): Exports == Implementation where
             => return [a, mkMat(x, [r.rw for r in l | a = r.val])]
       "failed"
 
--- returns a non-zero determinant of a minor of x of rank equal to
--- the number of columns of x, if there is one, 0 otherwise
+    -- returns a non-zero determinant of a minor of x of rank equal to
+    -- the number of columns of x, if there is one, 0 otherwise
     determinantOfMinor x ==
--- do not compute a modulus for square matrices, since this is as expensive
--- as the Hermite reduction itself
+      -- do not compute a modulus for square matrices, since this is as 
+      -- expensive as the Hermite reduction itself
       (nr := nrows x) <= (nc := ncols x) => 0
       lc := [i for i in minColIndex x .. maxColIndex x]$List(Integer)
       lr := [i for i in minRowIndex x .. maxRowIndex x]$List(Integer)
@@ -80327,10 +107112,10 @@ ModularHermitianRowReduction(R): Exports == Implementation where
           return gcd(d, determinant x(enumerateBinomial(lr, nc, j), lc))
       0
 
--- returns the i-th selection of m elements of l = (a1,...,an),
---                 /n\
--- where 1 <= i <= | |
---                 \m/
+    -- returns the i-th selection of m elements of l = (a1,...,an),
+    --                 /n\
+    -- where 1 <= i <= | |
+    --                 \m/
     enumerateBinomial(l, m, i) ==
       m1 := minIndex l - 1
       zero?(m := m - 1) => [l(m1 + i)]
@@ -80356,6 +107141,7 @@ ModularHermitianRowReduction(R): Exports == Implementation where
         m := mm::R
 
     if R has IntegerNumberSystem then
+
         normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) ==
             qr := divide(n, d)
             qr.remainder >= 0 => qr
@@ -80367,6 +107153,7 @@ ModularHermitianRowReduction(R): Exports == Implementation where
             qr.quotient := qr.quotient + 1
             qr
     else
+
         normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) ==
             divide(n, d)
 
@@ -80418,6 +107205,7 @@ ModularHermitianRowReduction(R): Exports == Implementation where
         x
 
     if R has Field then
+
       rowEchelon(y, m) == rowEchelon vconc(y, m)
 
     else
@@ -80452,7 +107240,6 @@ ModularHermitianRowReduction(R): Exports == Implementation where
           qsetelt_!(x,i,j,un.canonical)
           if un.associate ^= 1 then for jj in (j+1)..ncols repeat
               qsetelt_!(x,i,jj,un.associate * qelt(x,i,jj))
-
           xij := qelt(x,i,j)
           for k in minr .. i-1 repeat
             zero? qelt(x,k,j) => "next k"
@@ -80469,6 +107256,206 @@ ModularHermitianRowReduction(R): Exports == Implementation where
 \begin{chunk}{COQ MHROWRED}
 (* package MHROWRED *)
 (*
+
+    order   : (R, R) -> Z
+    vconc   : (M, R) -> M
+    non0    : (V, Z) -> Union(REC, "failed")
+    nonzero?: V -> Boolean
+    mkMat   : (M, List Z) -> M
+    diagSubMatrix: M -> Union(Record(val:R, mat:M), "failed")
+    determinantOfMinor: M -> R
+    enumerateBinomial: (List Z, Z, Z) -> List Z
+
+    nonzero? v == any?(s +-> s ^= 0, v)
+
+    -- returns [a, i, rown] if v = [0,...,0,a,0,...,0]
+    -- where a <> 0 and i is the index of a, "failed" otherwise.
+    non0(v, rown) ==
+      ans:REC
+      allZero:Boolean := true
+      for i in minIndex v .. maxIndex v repeat
+        if qelt(v, i) ^= 0 then
+          if allZero then
+            allZero := false
+            ans := [qelt(v, i), i, rown]
+          else return "failed"
+      allZero => "failed"
+      ans
+
+    -- returns a matrix made from the non-zero rows of x whose row number
+    -- is not in l
+    mkMat(x, l) ==
+      empty?(ll := [parts row(x, i)
+         for i in minRowIndex x .. maxRowIndex x |
+           (not member?(i, l)) and nonzero? row(x, i)]$List(List R)) =>
+              zero(1, ncols x)
+      matrix ll
+
+    -- returns [m, d] where m = x with the zero rows and the rows of
+    -- the diagonal of d removed, if x has a diagonal submatrix of d's,
+    -- "failed" otherwise.
+    diagSubMatrix x ==
+      l  := [u::REC for i in minRowIndex x .. maxRowIndex x |
+                                     (u := non0(row(x, i), i)) case REC]
+      for a in removeDuplicates([r.val for r in l]$List(R)) repeat
+        {[r.cl for r in l | r.val = a]$List(Z)}$Set(Z) =
+          {[z for z in minColIndex x .. maxColIndex x]$List(Z)}$Set(Z)
+            => return [a, mkMat(x, [r.rw for r in l | a = r.val])]
+      "failed"
+
+    -- returns a non-zero determinant of a minor of x of rank equal to
+    -- the number of columns of x, if there is one, 0 otherwise
+    determinantOfMinor x ==
+      -- do not compute a modulus for square matrices, since this is as 
+      -- expensive as the Hermite reduction itself
+      (nr := nrows x) <= (nc := ncols x) => 0
+      lc := [i for i in minColIndex x .. maxColIndex x]$List(Integer)
+      lr := [i for i in minRowIndex x .. maxRowIndex x]$List(Integer)
+      for i in 1..(n := binomial(nr, nc)) repeat
+        (d := determinant x(enumerateBinomial(lr, nc, i), lc)) ^= 0 =>
+          j := i + 1 + (random()$Z rem (n - i))
+          return gcd(d, determinant x(enumerateBinomial(lr, nc, j), lc))
+      0
+
+    -- returns the i-th selection of m elements of l = (a1,...,an),
+    --                 /n\
+    -- where 1 <= i <= | |
+    --                 \m/
+    enumerateBinomial(l, m, i) ==
+      m1 := minIndex l - 1
+      zero?(m := m - 1) => [l(m1 + i)]
+      for j in 1..(n := #l) repeat
+        i <= (b := binomial(n - j, m)) =>
+          return concat(l(m1 + j), enumerateBinomial(rest(l, j), m, i))
+        i := i - b
+      error "Should not happen"
+
+    rowEch x ==
+      (u := diagSubMatrix x) case "failed" =>
+        zero?(d := determinantOfMinor x) => rowEchelon x
+        rowEchelon(x, d)
+      rowEchelon(u.mat, u.val)
+
+    vconc(y, m) ==
+      vertConcat(diagonalMatrix new(ncols y, m)$V, map(s +-> s rem m, y))
+
+    order(m, p) ==
+      zero? m => -1
+      for i in 0.. repeat
+        (mm := m exquo p) case "failed" => return i
+        m := mm::R
+
+    if R has IntegerNumberSystem then
+
+        normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) ==
+            qr := divide(n, d)
+            qr.remainder >= 0 => qr
+            d > 0 =>
+                qr.remainder := qr.remainder + d
+                qr.quotient := qr.quotient - 1
+                qr
+            qr.remainder := qr.remainder - d
+            qr.quotient := qr.quotient + 1
+            qr
+    else
+
+        normalizedDivide(n:R, d:R):Record(quotient:R, remainder:R) ==
+            divide(n, d)
+
+    rowEchLocal(x,p) ==
+      (u := diagSubMatrix x) case "failed" =>
+        zero?(d := determinantOfMinor x) => rowEchelon x
+        rowEchelonLocal(x, d, p)
+      rowEchelonLocal(u.mat, u.val, p)
+
+    rowEchelonLocal(y, m, p) ==
+        m := p**(order(m,p)::NonNegativeInteger)
+        x     := vconc(y, m)
+        nrows := maxRowIndex x
+        ncols := maxColIndex x
+        minr  := i := minRowIndex x
+        for j in minColIndex x .. ncols repeat
+          if i > nrows then leave x
+          rown := minr - 1
+          pivord : Integer
+          npivord : Integer
+          for k in i .. nrows repeat
+            qelt(x,k,j) = 0 => "next k"
+            npivord := order(qelt(x,k,j),p)
+            (rown = minr - 1) or (npivord  <  pivord) =>
+                    rown := k
+                    pivord := npivord
+          rown = minr - 1 => "enuf"
+          x := swapRows_!(x, i, rown)
+          (a, b, d) := extendedEuclidean(qelt(x,i,j), m)
+          qsetelt_!(x,i,j,d)
+          pivot := d
+          for k in j+1 .. ncols repeat
+            qsetelt_!(x,i,k, a * qelt(x,i,k) rem m)
+          for k in i+1 .. nrows repeat
+            zero? qelt(x,k,j) => "next k"
+            q := (qelt(x,k,j) exquo pivot) :: R
+            for k1 in j+1 .. ncols repeat
+              v2 := (qelt(x,k,k1) - q * qelt(x,i,k1)) rem m
+              qsetelt_!(x, k, k1, v2)
+            qsetelt_!(x, k, j, 0)
+          for k in minr .. i-1 repeat
+            zero? qelt(x,k,j) => "enuf"
+            qr    := normalizedDivide(qelt(x,k,j), pivot)
+            qsetelt_!(x,k,j, qr.remainder)
+            for k1 in j+1 .. ncols x repeat
+              qsetelt_!(x,k,k1,
+                     (qelt(x,k,k1) - qr.quotient * qelt(x,i,k1)) rem m)
+          i := i+1
+        x
+
+    if R has Field then
+
+      rowEchelon(y, m) == rowEchelon vconc(y, m)
+
+    else
+
+      rowEchelon(y, m) ==
+        x     := vconc(y, m)
+        nrows := maxRowIndex x
+        ncols := maxColIndex x
+        minr  := i := minRowIndex x
+        for j in minColIndex x .. ncols repeat
+          if i > nrows then leave
+          rown := minr - 1
+          for k in i .. nrows repeat
+            if (qelt(x,k,j) ^= 0) and ((rown = minr - 1) or
+                  sizeLess?(qelt(x,k,j), qelt(x,rown,j))) then rown := k
+          rown = minr - 1 => "next j"
+          x := swapRows_!(x, i, rown)
+          for k in i+1 .. nrows repeat
+            zero? qelt(x,k,j) => "next k"
+            (a, b, d) := extendedEuclidean(qelt(x,i,j), qelt(x,k,j))
+            (b1, a1) :=
+               ((qelt(x,i,j) exquo d)::R, (qelt(x,k,j) exquo d)::R)
+            -- a*b1+a1*b = 1
+            for k1 in j+1 .. ncols repeat
+              v1 := (a  * qelt(x,i,k1) +  b * qelt(x,k,k1)) rem m
+              v2 := (b1 * qelt(x,k,k1) - a1 * qelt(x,i,k1)) rem m
+              qsetelt_!(x, i, k1, v1)
+              qsetelt_!(x, k, k1, v2)
+            qsetelt_!(x, i, j, d)
+            qsetelt_!(x, k, j, 0)
+          un := unitNormal qelt(x,i,j)
+          qsetelt_!(x,i,j,un.canonical)
+          if un.associate ^= 1 then for jj in (j+1)..ncols repeat
+              qsetelt_!(x,i,jj,un.associate * qelt(x,i,jj))
+          xij := qelt(x,i,j)
+          for k in minr .. i-1 repeat
+            zero? qelt(x,k,j) => "next k"
+            qr    := normalizedDivide(qelt(x,k,j), xij)
+            qsetelt_!(x,k,j, qr.remainder)
+            for k1 in j+1 .. ncols x repeat
+              qsetelt_!(x,k,k1,
+                     (qelt(x,k,k1) - qr.quotient * qelt(x,i,k1)) rem m)
+          i := i+1
+        x
+
 *)
 
 \end{chunk}
@@ -80542,6 +107529,7 @@ MonoidRingFunctions2(R,S,M) : Exports == Implementation where
         ++ u of the monoid ring to create an element of a monoid
         ++ ring with the same monoid b.
     Implementation ==> add
+
       map(fn, u) ==
         res : MonoidRing(S,M) := 0
         for te in terms u repeat
@@ -80553,6 +107541,13 @@ MonoidRingFunctions2(R,S,M) : Exports == Implementation where
 \begin{chunk}{COQ MRF2}
 (* package MRF2 *)
 (*
+
+      map(fn, u) ==
+        res : MonoidRing(S,M) := 0
+        for te in terms u repeat
+          res := res + monomial(fn(te.coef), te.monom)
+        res
+
 *)
 
 \end{chunk}
@@ -80656,6 +107651,7 @@ MonomialExtensionTools(F, UP): Exports == Implementation where
       ++ D is the derivation to use.
 
   Implementation ==> add
+
     normalDenom(f, derivation) == split(denom f, derivation).normal
 
     split(p, derivation) ==
@@ -80678,12 +107674,12 @@ MonomialExtensionTools(F, UP): Exports == Implementation where
 
     decompose(f, derivation) ==
       qr := divide(numer f, denom f)
--- rec.normal * rec.special = denom f
+      -- rec.normal * rec.special = denom f
       rec := split(denom f, derivation)
--- eeu.coef1 * rec.normal + eeu.coef2 * rec.special = qr.remainder
--- and degree(eeu.coef1) < degree(rec.special)
--- and degree(eeu.coef2) < degree(rec.normal)
--- qr.remainder/denom(f) = eeu.coef1 / rec.special + eeu.coef2 / rec.normal
+      -- eeu.coef1 * rec.normal + eeu.coef2 * rec.special = qr.remainder
+      -- and degree(eeu.coef1) < degree(rec.special)
+      -- and degree(eeu.coef2) < degree(rec.normal)
+      -- qr.remainder/denom(f)=eeu.coef1 / rec.special + eeu.coef2 / rec.normal
       eeu := extendedEuclidean(rec.normal, rec.special,
                                qr.remainder)::Record(coef1:UP, coef2:UP)
       [qr.quotient, eeu.coef2 / rec.normal, eeu.coef1 / rec.special]
@@ -80693,6 +107689,39 @@ MonomialExtensionTools(F, UP): Exports == Implementation where
 \begin{chunk}{COQ MONOTOOL}
 (* package MONOTOOL *)
 (*
+
+    normalDenom(f, derivation) == split(denom f, derivation).normal
+
+    split(p, derivation) ==
+      pbar := (gcd(p, derivation p) exquo gcd(p, differentiate p))::UP
+      zero? degree pbar => [p, 1]
+      rec := split((p exquo pbar)::UP, derivation)
+      [rec.normal, pbar * rec.special]
+
+    splitSquarefree(p, derivation) ==
+      s:Factored(UP) := 1
+      n := s
+      q := squareFree p
+      for rec in factors q repeat
+        r := rec.factor
+        g := gcd(r, derivation r)
+        if not ground? g then s := s * sqfrFactor(g, rec.exponent)
+        h := (r exquo g)::UP
+        if not ground? h then n := n * sqfrFactor(h, rec.exponent)
+      [n, unit(q) * s]
+
+    decompose(f, derivation) ==
+      qr := divide(numer f, denom f)
+      -- rec.normal * rec.special = denom f
+      rec := split(denom f, derivation)
+      -- eeu.coef1 * rec.normal + eeu.coef2 * rec.special = qr.remainder
+      -- and degree(eeu.coef1) < degree(rec.special)
+      -- and degree(eeu.coef2) < degree(rec.normal)
+      -- qr.remainder/denom(f)=eeu.coef1 / rec.special + eeu.coef2 / rec.normal
+      eeu := extendedEuclidean(rec.normal, rec.special,
+                               qr.remainder)::Record(coef1:UP, coef2:UP)
+      [qr.quotient, eeu.coef2 / rec.normal, eeu.coef1 / rec.special]
+
 *)
 
 \end{chunk}
@@ -80776,6 +107805,9 @@ MoreSystemCommands: public == private where
 \begin{chunk}{COQ MSYSCMD}
 (* package MSYSCMD *)
 (*
+ 
+    systemCommand cmd == doSystemCommand(cmd)$Lisp
+
 *)
 
 \end{chunk}
@@ -80895,6 +107927,22 @@ MPolyCatPolyFactorizer(E,OV,R,PPR) : C == T
 \begin{chunk}{COQ MPCPF}
 (* package MPCPF *)
 (*
+
+     import PushVariables(R,E,OV,PPR)
+
+        ----  factorization of p ----
+     factor(p:PPR) : Factored PPR ==
+       ground? p => nilFactor(p,1)
+       c := content p
+       p := (p exquo c)::PPR
+       vars:List OV :=variables p
+       g:PR:=retract pushdown(p, vars)
+       flist := factor(g)$GeneralizedMultivariateFactorize(Symbol,ISY,R,R,PR)
+       ffact : List(Record(irr:PPR,pow:Integer))
+       ffact:=[[pushup(u.factor::PPR,vars),u.exponent] for u in factors flist]
+       fcont:=(unit flist)::PPR
+       nilFactor(c*fcont,1)*(_*/[primeFactor(ff.irr,ff.pow) for ff in ffact])
+
 *)
 
 \end{chunk}
@@ -81110,6 +108158,86 @@ MPolyCatRationalFunctionFactorizer(E,OV,R,PRF) : C == T
 \begin{chunk}{COQ MPRFF}
 (* package MPRFF *)
 (*
+
+        ----  factorization of p ----
+     factor(p:PRF) : Factored PRF ==
+       truelist:List OV :=variables p
+       tp:=totalfract(p)
+       nump:P:= tp.sup
+       denp:F:=inv(tp.inf ::F)
+       ffact : List(Record(irr:PRF,pow:Integer))
+       flist:Factored P
+       if R is Fraction Integer then
+         flist:=
+           ((factor nump)$MRationalFactorize(ISE,SE,Integer,P))
+                          pretend (Factored P)
+       else
+         if R has FiniteFieldCategory  then
+            flist:= ((factor nump)$MultFiniteFactorize(SE,ISE,R,P))
+                    pretend (Factored P)
+
+         else
+            if R has Field then error "not done yet"
+
+            else
+              if R has CharacteristicZero then 
+                flist:= ((factor nump)$MultivariateFactorize(SE,ISE,R,P))
+                                                pretend (Factored P)
+              else error "can't happen"  
+       ffact:=[[u.factor::F::PRF,u.exponent] for u in factors flist]
+       fcont:=(unit flist)::F::PRF
+       for x in truelist repeat
+         fcont:=pushup(fcont,x)
+         ffact:=[[pushup(ff.irr,x),ff.pow] for ff in ffact]
+       (denp*fcont)*(_*/[primeFactor(ff.irr,ff.pow) for ff in ffact])
+
+
+-- the following functions are used to "push" x in the coefficient ring -
+
+        ----  push x in the coefficient domain for a polynomial ----
+     pushdown(g:PRF,x:OV) : PRF ==
+       ground? g => g
+       rf:PRF:=0$PRF
+       ug:=univariate(g,x)
+       while ug^=0 repeat
+         rf:=rf+pushdterm(ug,x)
+         ug := reductum ug
+       rf
+
+      ----  push x in the coefficient domain for a term ----
+     pushdterm(t:UPRF,x:OV):PRF ==
+       n:=degree(t)
+       cf:=monomial(1,convert x,n)$P :: F
+       cf * leadingCoefficient t
+
+               ----  push back the variable  ----
+     pushup(f:PRF,x:OV) :PRF ==
+       ground? f => pushuconst(retract f,x)
+       v:=mainVariable(f)::OV
+       g:=univariate(f,v)
+       multivariate(map((y:PRF):PRF +-> pushup(y,x),g),v)
+
+      ----  push x back from the coefficient domain ----
+     pushuconst(r:F,x:OV):PRF ==
+       xs:SE:=convert x
+       degree(denom r,xs)>0 => error "bad polynomial form"
+       inv((denom r)::F)*pushucoef(univariate(numer r,xs),x)
+
+
+     pushucoef(c:UP,x:OV):PRF ==
+       c = 0 => 0
+       monomial((leadingCoefficient c)::F::PRF,x,degree c) +
+                 pushucoef(reductum c,x)
+
+
+           ----  write p with a common denominator  ----
+
+     totalfract(p:PRF) : QuoForm ==
+       p=0 => [0$P,1$P]$QuoForm
+       for x in variables p repeat p:=pushdown(p,x)
+       g:F:=retract p
+       [numer g,denom g]$QuoForm
+
 *)
 
 \end{chunk}
@@ -81214,6 +108342,22 @@ MPolyCatFunctions2(VarSet,E1,E2,R,S,PR,PS) : public == private where
 \begin{chunk}{COQ MPC2}
 (* package MPC2 *)
 (*
+ 
+    supMap:  (R -> S, SUPR) -> SUPS
+ 
+    supMap(fn : R -> S, supr : SUPR): SUPS ==
+      supr = 0 => monomial(fn(0$R) :: PS,0)$SUPS
+      c : PS := map(fn,leadingCoefficient supr)$%
+      monomial(c,degree supr)$SUPS + supMap(fn, reductum supr)
+ 
+    map(fn : R -> S, pr : PR): PS ==
+      varu : Union(VarSet,"failed") := mainVariable pr
+      varu case "failed" =>  -- have a constant
+        fn(retract pr) :: PS
+      var : VarSet := varu :: VarSet
+      supr : SUPR := univariate(pr,var)$PR
+      multivariate(supMap(fn,supr),var)$PS
+
 *)
 
 \end{chunk}
@@ -81304,6 +108448,19 @@ MPolyCatFunctions3(Vars1,Vars2,E1,E2,R,PR1,PR2): C == T where
 \begin{chunk}{COQ MPC3}
 (* package MPC3 *)
 (*
+ 
+    map(f:Vars1 -> Vars2, p:PR1):PR2 ==
+      (x1 := mainVariable p) case "failed" =>
+        c:R:=(retract p)
+        c::PR2
+      up := univariate(p, x1::Vars1)
+      x2 := f(x1::Vars1)
+      ans:PR2 := 0
+      while up ^= 0 repeat
+        ans := ans + monomial(map(f,leadingCoefficient up),x2,degree up)
+        up  := reductum up
+      ans
+
 *)
 
 \end{chunk}
@@ -81383,6 +108540,7 @@ MRationalFactorize(E,OV,R,P) : C == T
        ++ which are fractions of elements of R.
 
   T  == add
+
      IE     ==> IndexedExponents OV
      PCLFRR ==> PolynomialCategoryLifting(E,OV,FR,P,MPR)
      PCLRFR ==> PolynomialCategoryLifting(IE,OV,R,MPR,P)
@@ -81390,8 +108548,11 @@ MRationalFactorize(E,OV,R,P) : C == T
      UPCF2  ==> UnivariatePolynomialCategoryFunctions2
 
      numer1(c:FR): MPR   == (numer c) :: MPR
+
      numer2(pol:P) : MPR == map(coerce,numer1,pol)$PCLFRR
+
      coerce1(d:R) : P == (d::FR)::P
+
      coerce2(pp:MPR) :P == map(coerce,coerce1,pp)$PCLRFR 
 
      factor(p:P) : Factored P ==
@@ -81408,6 +108569,30 @@ MRationalFactorize(E,OV,R,P) : C == T
 \begin{chunk}{COQ MRATFAC}
 (* package MRATFAC *)
 (*
+
+     IE     ==> IndexedExponents OV
+     PCLFRR ==> PolynomialCategoryLifting(E,OV,FR,P,MPR)
+     PCLRFR ==> PolynomialCategoryLifting(IE,OV,R,MPR,P)
+     MFACT  ==> MultivariateFactorize(OV,IE,R,MPR)
+     UPCF2  ==> UnivariatePolynomialCategoryFunctions2
+
+     numer1(c:FR): MPR   == (numer c) :: MPR
+
+     numer2(pol:P) : MPR == map(coerce,numer1,pol)$PCLFRR
+
+     coerce1(d:R) : P == (d::FR)::P
+
+     coerce2(pp:MPR) :P == map(coerce,coerce1,pp)$PCLRFR 
+
+     factor(p:P) : Factored P ==
+       pden:R:=lcm([denom c for c in coefficients p])
+       pol :P:= (pden::FR)*p
+       ipol:MPR:= map(coerce,numer1,pol)$PCLFRR
+       ffact:=(factor ipol)$MFACT
+       (1/pden)*map(coerce,coerce1,(unit ffact))$PCLRFR *
+           _*/[primeFactor(map(coerce,coerce1,u.factor)$PCLRFR,
+                           u.exponent) for u in factors ffact]
+
 *)
 
 \end{chunk}
@@ -81549,10 +108734,8 @@ MultFiniteFactorize(OV,E,F,PG) : C == T
         lvar:L OV:= "setUnion"/[variables cf for cf in coefficients um]
         lcont:SUP P
         lf:L SUP P
-
         flead : SUPFinalFact:=[0,empty()]$SUPFinalFact
         factorlist:L SUParFact :=empty()
-
         mdeg :=minimumDegree um     ---- is the Mindeg > 0? ----
         if mdeg>0 then
           f1:SUP P:=monomial(1,mdeg)
@@ -81561,26 +108744,20 @@ MultFiniteFactorize(OV,E,F,PG) : C == T
           if degree um=0 then return
             lfg:=convertPUP mFactor(ground um, dx)
             [lfg.contp,append(factorlist,lfg.factors)]
-
-
         om:=map((p1:P):PG+->pushup(p1,basicVar),um)$UPCF2(P,SUP P,PG,SUP PG)
         sqfacs:=squareFree(om)
         lcont:=
           map((p1:PG):P+->pushdown(p1,basicVar),unit sqfacs)_
             $UPCF2(PG,SUP PG,P,SUP P)
-
                                    ----   Factorize the content  ----
         if ground? lcont then
           flead:=convertPUP constantCase(ground lcont,empty())
         else
           flead:=supFactor(lcont,dx)
-
         factorlist:=flead.factors
-
                                  ----  Make the polynomial square-free  ----
         sqqfact:=[[map((p:PG):P+->pushdown(p,basicVar),ff.factor),ff.exponent]
                       for ff in factors sqfacs]
-
                         ---  Factorize the primitive square-free terms ---
         for fact in sqqfact repeat
           ffactor:SUP P:=fact.irr
@@ -81653,11 +108830,8 @@ MultFiniteFactorize(OV,E,F,PG) : C == T
           factorlist:=cons([ffactor,ffexp]$MParFact,factorlist)
           for lcterm in mFactor(lcont,dx).factors repeat
            factorlist:=cons([lcterm.irr,lcterm.pow * ffexp], factorlist)
-
         varch:=varChoose(ffactor,lvar,ldeg)
         um:=varch.npol
-
-
         ldeg:=ldeg.rest
         lvar:=lvar.rest
         if varch.nvar.1 ^= x then
@@ -81687,7 +108861,6 @@ MultFiniteFactorize(OV,E,F,PG) : C == T
       flead.factors:= factorlist
       flead
 
-
     pM(lum:L SUP R) : R ==
       x := monomial(1,1)$R
       for i in 1..size()$F repeat
@@ -81799,7 +108972,6 @@ MultFiniteFactorize(OV,E,F,PG) : C == T
       lvar:=cons(x,delete(lvar,i))
       [univariate(m,x),lvar,ldeg]$NewOrd
 
-
     norm(lum: L SUP R): Integer == "max"/[degree lup for lup in lum]
 
           ---  Choose the values to reduce to the univariate case  ---
@@ -81822,9 +108994,9 @@ MultFiniteFactorize(OV,E,F,PG) : C == T
       leadtest:=true --- the lc test with polCase has to be performed
       int:L R:=empty()
 
-   --  New sets of values are chosen until we find twice the
-   --  same number of "univariate" factors:the set smaller in modulo is
-   --  is chosen.
+       --  New sets of values are chosen until we find twice the
+       --  same number of "univariate" factors:the set smaller in modulo is
+       --  is chosen.
       while true repeat
        lval := [ ran(range) for i in 1..nvar1]
        member?(lval,ltry) => range:=1+range
@@ -81850,15 +109022,11 @@ MultFiniteFactorize(OV,E,F,PG) : C == T
        luniv:=generalTwoFactor(newm)$TwoFactorize(F)
        lunivf:= factors luniv
        nf:= #lunivf
-
        nf=0 or nf>nfatt => "next values"      ---  pretest failed ---
-
                         --- the univariate polynomial is irreducible ---
        if nf=1 then leave (unifact:=[newm])
-
        lffc1:=lcnm * retract(unit luniv)@R * lffc1
-
-   --  the new integer give the same number of factors
+       --  the new integer give the same number of factors
        nfatt = nf =>
        -- if this is the first univariate factorization with polCase=true
        -- or if the last factorization has smaller norm and satisfies
@@ -81871,8 +109039,7 @@ MultFiniteFactorize(OV,E,F,PG) : C == T
                 lffc:=lffc1
                 if testp then leadcomp:=leadcomp1
          leave "foundit"
-
-   --  the first univariate factorization, inizialize
+       --  the first univariate factorization, inizialize
        nfatt > degum =>
          unifact:=[uf.factor for uf in lunivf]
          lffc:=lffc1
@@ -81880,7 +109047,6 @@ MultFiniteFactorize(OV,E,F,PG) : C == T
          int:=lval
          leadtest := false
          nfatt := nf
-
        nfatt>nf =>  -- for the previous values there were more factors
          if testp then leadtest:=^polCase(lffc*clc,#plist,leadcomp)
          else leadtest:= false
@@ -81895,8 +109061,6 @@ MultFiniteFactorize(OV,E,F,PG) : C == T
 
 
     constantCase(m:P,factorlist:List MParFact) : MFinalFact ==
-    --if R case Integer then [const m,factorlist]$MFinalFact
-    --else
       lunm:=distdfact((retract m)@R,false)$DistinctDegreeFactorize(F,R)
       [(lunm.cont)::R, append(factorlist,
            [[(pp.irr)::P,pp.pow] for pp in lunm.factors])]$MFinalFact
@@ -81938,7 +109102,7 @@ MultFiniteFactorize(OV,E,F,PG) : C == T
     factor(m:PG):Factored PG ==
        lv:=variables m
        lv=empty() => makeFR(m,empty() )
-    -- reduce to multivariate over SUP
+       -- reduce to multivariate over SUP
        ld:=[degree(m,x) for x in lv]
        dx:="min"/ld
        basicVar:=lv(position(dx,ld))
@@ -81953,6 +109117,433 @@ MultFiniteFactorize(OV,E,F,PG) : C == T
 \begin{chunk}{COQ MFINFACT}
 (* package MFINFACT *)
 (*
+
+    import LeadingCoefDetermination(OV,IndexedExponents OV,R,P)
+    import MultivariateLifting(IndexedExponents OV,OV,R,P)
+    import FactoringUtilities(IndexedExponents OV,OV,R,P)
+    import FactoringUtilities(E,OV,F,PG)
+    import GenExEuclid(R,SUP R)
+
+    NNI       ==> NonNegativeInteger
+    L         ==> List
+    UPCF2     ==> UnivariatePolynomialCategoryFunctions2
+    LeadFact  ==> Record(polfac:L P,correct:R,corrfact:L SUP R)
+    ContPrim  ==> Record(cont:P,prim:P)
+    ParFact   ==> Record(irr:SUP R,pow:Z)
+    FinalFact ==> Record(contp:R,factors:L ParFact)
+    NewOrd    ==> Record(npol:SUP P,nvar:L OV,newdeg:L NNI)
+    Valuf     ==> Record(inval:L L R,unvfact:L SUP R,lu:R,complead:L R)
+
+                   ----  Local Functions  ----
+    ran       :                   Z              -> R
+    mFactor   :                (P,Z)             -> MFinalFact
+    supFactor :              (SUP P,Z)           -> SUPFinalFact
+    mfconst   :        (SUP P,Z,L OV,L NNI)      -> L SUP P
+    mfpol     :        (SUP P,Z,L OV,L NNI)      -> L SUP P
+    varChoose :           (P,L OV,L NNI)         -> NewOrd
+    simplify  :         (P,Z,L OV,L NNI)         -> MFinalFact
+    intChoose :        (SUP P,L OV,R,L P,L L R)  -> Valuf
+    pretest   :         (P,NNI,L OV,L R)         -> FinalFact
+    checkzero :            (SUP P,SUP R)         -> Boolean
+    pushdcoef :                  PG              -> P
+    pushdown  :                (PG,OV)           -> P
+    pushupconst :               (R,OV)           -> PG
+    pushup    :                 (P,OV)           -> PG
+    norm      :               L SUP R            -> Integer
+    constantCase :        (P,L MParFact)         -> MFinalFact
+    pM          :             L SUP R            -> R
+    intfact     :     (SUP P,L OV,L NNI,MFinalFact,L L R) -> L SUP P
+
+    basicVar:OV:=NIL$Lisp pretend OV  -- variable for the basic step
+
+
+    convertPUP(lfg:MFinalFact): SUPFinalFact ==
+      [lfg.contp,[[lff.irr ::SUP P,lff.pow]$SUParFact
+                    for lff in lfg.factors]]$SUPFinalFact
+
+    supFactor(um:SUP P,dx:Z) : SUPFinalFact ==
+        degree(um)=0 => convertPUP(mFactor(ground um,dx))
+        lvar:L OV:= "setUnion"/[variables cf for cf in coefficients um]
+        lcont:SUP P
+        lf:L SUP P
+        flead : SUPFinalFact:=[0,empty()]$SUPFinalFact
+        factorlist:L SUParFact :=empty()
+        mdeg :=minimumDegree um     ---- is the Mindeg > 0? ----
+        if mdeg>0 then
+          f1:SUP P:=monomial(1,mdeg)
+          um:=(um exquo f1)::SUP P
+          factorlist:=cons([monomial(1,1),mdeg],factorlist)
+          if degree um=0 then return
+            lfg:=convertPUP mFactor(ground um, dx)
+            [lfg.contp,append(factorlist,lfg.factors)]
+        om:=map((p1:P):PG+->pushup(p1,basicVar),um)$UPCF2(P,SUP P,PG,SUP PG)
+        sqfacs:=squareFree(om)
+        lcont:=
+          map((p1:PG):P+->pushdown(p1,basicVar),unit sqfacs)_
+            $UPCF2(PG,SUP PG,P,SUP P)
+                                   ----   Factorize the content  ----
+        if ground? lcont then
+          flead:=convertPUP constantCase(ground lcont,empty())
+        else
+          flead:=supFactor(lcont,dx)
+        factorlist:=flead.factors
+                                 ----  Make the polynomial square-free  ----
+        sqqfact:=[[map((p:PG):P+->pushdown(p,basicVar),ff.factor),ff.exponent]
+                      for ff in factors sqfacs]
+                        ---  Factorize the primitive square-free terms ---
+        for fact in sqqfact repeat
+          ffactor:SUP P:=fact.irr
+          ffexp:=fact.pow
+          ffcont:=content ffactor
+          coefs := coefficients ffactor
+          ldeg:= ["max"/[degree(fc,xx) for fc in coefs] for xx in lvar]
+          if ground?(leadingCoefficient ffactor) then
+             lf:= mfconst(ffactor,dx,lvar,ldeg)
+          else lf:=mfpol(ffactor,dx,lvar,ldeg)
+          auxfl:=[[lfp,ffexp]$SUParFact  for lfp in lf]
+          factorlist:=append(factorlist,auxfl)
+        lcfacs := 
+           */[leadingCoefficient leadingCoefficient(f.irr)**((f.pow)::NNI)
+                             for f in factorlist]
+        [(leadingCoefficient leadingCoefficient(um) exquo lcfacs)::R,
+                       factorlist]$SUPFinalFact
+
+    factor(um:SUP PG):Factored SUP PG ==
+        lv:List OV:=variables um
+        ld:=degree(um,lv)
+        dx:="min"/ld
+        basicVar:=lv.position(dx,ld)
+        cm:=map((p1:PG):P+->pushdown(p1,basicVar),um)$UPCF2(PG,SUP PG,P,SUP P)
+        flist := supFactor(cm,dx)
+        pushupconst(flist.contp,basicVar)::SUP(PG) *
+         (*/[primeFactor(
+           map((p1:P):PG+->pushup(p1,basicVar),u.irr)$UPCF2(P,SUP P,PG,SUP PG),
+                 u.pow) for u in flist.factors])
+
+    mFactor(m:P,dx:Z) : MFinalFact ==
+      ground?(m) => constantCase(m,empty())
+      lvar:L OV:= variables m
+      lcont:P
+      lf:L SUP P
+      flead : MFinalFact:=[1,empty()]$MFinalFact
+      factorlist:L MParFact :=empty()
+                                  ---- is the Mindeg > 0? ----
+      lmdeg :=minimumDegree(m,lvar)
+      or/[n>0 for n in lmdeg] => simplify(m,dx,lvar,lmdeg)
+                              ----  Make the polynomial square-free  ----
+      om:=pushup(m,basicVar)
+      sqfacs:=squareFree(om)
+      lcont := pushdown(unit sqfacs,basicVar)
+
+                                  ----  Factorize the content  ----
+      if ground? lcont then
+        flead:=constantCase(lcont,empty())
+      else
+        flead:=mFactor(lcont,dx)
+      factorlist:=flead.factors
+      sqqfact:List Record(factor:P,exponent:Integer)
+      sqqfact:=[[pushdown(ff.factor,basicVar),ff.exponent]
+                                              for ff in factors sqfacs]
+                       ---  Factorize the primitive square-free terms ---
+      for fact in sqqfact repeat
+        ffactor:P:=fact.factor
+        ffexp := fact.exponent
+        ground? ffactor =>
+          for lterm in constantCase(ffactor,empty()).factors repeat
+            factorlist:=cons([lterm.irr,lterm.pow * ffexp], factorlist)
+        lvar := variables ffactor
+        x:OV:=lvar.1
+        ldeg:=degree(ffactor,lvar)
+             ---  Is the polynomial linear in one of the variables ? ---
+        member?(1,ldeg) =>
+          x:OV:=lvar.position(1,ldeg)
+          lcont:= gcd coefficients(univariate(ffactor,x))
+          ffactor:=(ffactor exquo lcont)::P
+          factorlist:=cons([ffactor,ffexp]$MParFact,factorlist)
+          for lcterm in mFactor(lcont,dx).factors repeat
+           factorlist:=cons([lcterm.irr,lcterm.pow * ffexp], factorlist)
+        varch:=varChoose(ffactor,lvar,ldeg)
+        um:=varch.npol
+        ldeg:=ldeg.rest
+        lvar:=lvar.rest
+        if varch.nvar.1 ^= x then
+          lvar:= varch.nvar
+          x := lvar.1
+          lvar:=lvar.rest
+          pc:= gcd coefficients um
+          if pc^=1 then
+            um:=(um exquo pc)::SUP P
+            ffactor:=multivariate(um,x)
+            for lcterm in mFactor(pc,dx).factors repeat
+              factorlist:=cons([lcterm.irr,lcterm.pow*ffexp],factorlist)
+          ldeg:= degree(ffactor,lvar)
+
+        -- should be unitNormal if unified, but for now it is easier
+        lcum:F:= leadingCoefficient leadingCoefficient
+                leadingCoefficient um
+        if lcum ^=1  then
+          um:=((inv lcum)::R::P) * um
+          flead.contp := (lcum::R) *flead.contp
+
+        if ground?(leadingCoefficient um)
+        then lf:= mfconst(um,dx,lvar,ldeg)
+        else lf:=mfpol(um,dx,lvar,ldeg)
+        auxfl:=[[multivariate(lfp,x),ffexp]$MParFact  for lfp in lf]
+        factorlist:=append(factorlist,auxfl)
+      flead.factors:= factorlist
+      flead
+
+    pM(lum:L SUP R) : R ==
+      x := monomial(1,1)$R
+      for i in 1..size()$F repeat
+         p := x + (index(i::PositiveInteger)$F) ::R
+         testModulus(p,lum) => return p
+      for e in 2.. repeat
+          p :=  (createIrreduciblePoly(e::PositiveInteger))$FFPOLY
+          testModulus(p,lum) => return p
+          while not((q := nextIrreduciblePoly(p)$FFPOLY) case "failed") repeat
+             p := q::SUP F
+             if testModulus(p, lum)$GenExEuclid(R, SUP R) then return p
+
+      ----  push x in the coefficient domain for a term ----
+    pushdcoef(t:PG):P ==
+       map((f1:F):R+->coerce(f1)$R,t)$MPolyCatFunctions2(OV,E,
+                                           IndexedExponents OV,F,R,PG,P)
+
+
+              ----  internal function, for testing bad cases  ----
+    intfact(um:SUP P,lvar: L OV,ldeg:L NNI,
+            tleadpol:MFinalFact,ltry:L L R):  L SUP P ==
+      polcase:Boolean:=(not empty? tleadpol.factors )
+      vfchoo:Valuf:=
+        polcase =>
+          leadpol:L P:=[ff.irr for ff in tleadpol.factors]
+          intChoose(um,lvar,tleadpol.contp,leadpol,ltry)
+        intChoose(um,lvar,1,empty(),empty())
+      unifact:List SUP R := vfchoo.unvfact
+      nfact:NNI := #unifact
+      nfact=1 => [um]
+      ltry:L L R:= vfchoo.inval
+      lval:L R:=first ltry
+      dd:= vfchoo.lu
+      lpol:List P:=empty()
+      leadval:List R:=empty()
+      if polcase then
+        leadval := vfchoo.complead
+        distf := distFact(vfchoo.lu,unifact,tleadpol,leadval,lvar,lval)
+        distf case "failed" =>
+             return intfact(um,lvar,ldeg,tleadpol,ltry)
+        dist := distf :: LeadFact
+          -- check the factorization of leading coefficient
+        lpol:= dist.polfac
+        dd := dist.correct
+        unifact:=dist.corrfact
+      if dd^=1 then
+        unifact := [dd*unifact.i for i in 1..nfact]
+        um := ((dd**(nfact-1)::NNI)::P)*um
+      (ffin:= lifting(um,lvar,unifact,lval,lpol,ldeg,pM(unifact)))
+           case "failed" => intfact(um,lvar,ldeg,tleadpol,ltry)
+      factfin: L SUP P:=ffin :: L SUP P
+      if dd^=1 then
+        factfin:=[primitivePart ff  for ff in  factfin]
+      factfin
+
+-- the following functions are used to "push" x in the coefficient ring -
+               ----  push back the variable  ----
+    pushup(f:P,x:OV) :PG ==
+       ground? f => pushupconst((retract f)@R,x)
+       rr:PG:=0
+       while f^=0 repeat
+         lf:=leadingMonomial f
+         cf:=pushupconst(leadingCoefficient f,x)
+         lvf:=variables lf
+         rr:=rr+monomial(cf,lvf, degree(lf,lvf))$PG
+         f:=reductum f
+       rr
+
+        ----  push x in the coefficient domain for a polynomial ----
+    pushdown(g:PG,x:OV) : P ==
+       ground? g => ((retract g)@F)::R::P
+       rf:P:=0$P
+       ug:=univariate(g,x)
+       while ug^=0 repeat
+         cf:=monomial(1,degree ug)$R
+         rf:=rf+cf*pushdcoef(leadingCoefficient ug)
+         ug := reductum ug
+       rf
+
+      ----  push x back from the coefficient domain ----
+    pushupconst(r:R,x:OV):PG ==
+       ground? r => (retract r)@F ::PG
+       rr:PG:=0
+       while r^=0 repeat
+         rr:=rr+monomial((leadingCoefficient r)::PG,x,degree r)$PG
+         r:=reductum r
+       rr
+
+    -- This function has to be added to Eucliden domain
+    ran(k1:Z) : R ==
+      --if R case Integer then random()$R rem (2*k1)-k1
+      --else
+      +/[monomial(random()$F,i)$R for i in 0..k1]
+
+    checkzero(u:SUP P,um:SUP R) : Boolean ==
+      u=0 => um =0
+      um = 0 => false
+      degree u = degree um => checkzero(reductum u, reductum um)
+      false
+
+              ---  Choose the variable of least degree  ---
+    varChoose(m:P,lvar:L OV,ldeg:L NNI) : NewOrd ==
+      k:="min"/[d for d in ldeg]
+      k=degree(m,first lvar) =>
+                             [univariate(m,first lvar),lvar,ldeg]$NewOrd
+      i:=position(k,ldeg)
+      x:OV:=lvar.i
+      ldeg:=cons(k,delete(ldeg,i))
+      lvar:=cons(x,delete(lvar,i))
+      [univariate(m,x),lvar,ldeg]$NewOrd
+
+    norm(lum: L SUP R): Integer == "max"/[degree lup for lup in lum]
+
+          ---  Choose the values to reduce to the univariate case  ---
+    intChoose(um:SUP P,lvar:L OV,clc:R,plist:L P,ltry:L L R) : Valuf ==
+      -- declarations
+      degum:NNI := degree um
+      nvar1:=#lvar
+      range:NNI:=0
+      unifact:L SUP R
+      ctf1 : R := 1
+      testp:Boolean :=             -- polynomial leading coefficient
+        plist = empty() => false
+        true
+      leadcomp,leadcomp1 : L R
+      leadcomp:=leadcomp1:=empty()
+      nfatt:NNI := degum+1
+      lffc:R:=1
+      lffc1:=lffc
+      newunifact : L SUP R:=empty()
+      leadtest:=true --- the lc test with polCase has to be performed
+      int:L R:=empty()
+
+       --  New sets of values are chosen until we find twice the
+       --  same number of "univariate" factors:the set smaller in modulo is
+       --  is chosen.
+      while true repeat
+       lval := [ ran(range) for i in 1..nvar1]
+       member?(lval,ltry) => range:=1+range
+       ltry := cons(lval,ltry)
+       leadcomp1:=[retract eval(pol,lvar,lval) for pol in plist]
+       testp and or/[unit? epl for epl in leadcomp1] => range:=range+1
+       newm:SUP R:=completeEval(um,lvar,lval)
+       degum ^= degree newm or minimumDegree newm ^=0 => range:=range+1
+       lffc1:=content newm
+       newm:=(newm exquo lffc1)::SUP R
+       testp and leadtest and ^ polCase(lffc1*clc,#plist,leadcomp1)
+                           => range:=range+1
+       Dnewm := differentiate newm
+       D2newm := map(differentiate, newm)
+       degree(gcd [newm,Dnewm,D2newm])^=0 => range:=range+1
+      -- if R has Integer then luniv:=henselFact(newm,false)$
+      -- else
+       lcnm:F:=1
+        -- should be unitNormal if unified, but for now it is easier
+       if (lcnm:=leadingCoefficient leadingCoefficient newm)^=1 then
+         newm:=((inv lcnm)::R)*newm
+       dx:="max"/[degree uc  for uc in coefficients newm]
+       luniv:=generalTwoFactor(newm)$TwoFactorize(F)
+       lunivf:= factors luniv
+       nf:= #lunivf
+       nf=0 or nf>nfatt => "next values"      ---  pretest failed ---
+                        --- the univariate polynomial is irreducible ---
+       if nf=1 then leave (unifact:=[newm])
+       lffc1:=lcnm * retract(unit luniv)@R * lffc1
+       --  the new integer give the same number of factors
+       nfatt = nf =>
+       -- if this is the first univariate factorization with polCase=true
+       -- or if the last factorization has smaller norm and satisfies
+       -- polCase
+         if leadtest or
+           ((norm unifact > norm [ff.factor for ff in lunivf]) and
+             (^testp or polCase(lffc1*clc,#plist,leadcomp1))) then
+                unifact:=[uf.factor for uf in lunivf]
+                int:=lval
+                lffc:=lffc1
+                if testp then leadcomp:=leadcomp1
+         leave "foundit"
+       --  the first univariate factorization, inizialize
+       nfatt > degum =>
+         unifact:=[uf.factor for uf in lunivf]
+         lffc:=lffc1
+         if testp then leadcomp:=leadcomp1
+         int:=lval
+         leadtest := false
+         nfatt := nf
+       nfatt>nf =>  -- for the previous values there were more factors
+         if testp then leadtest:=^polCase(lffc*clc,#plist,leadcomp)
+         else leadtest:= false
+         -- if polCase=true we can consider the univariate decomposition
+         if ^leadtest then
+           unifact:=[uf.factor for uf in lunivf]
+           lffc:=lffc1
+           if testp then leadcomp:=leadcomp1
+           int:=lval
+         nfatt := nf
+      [cons(int,ltry),unifact,lffc,leadcomp]$Valuf
+
+
+    constantCase(m:P,factorlist:List MParFact) : MFinalFact ==
+      lunm:=distdfact((retract m)@R,false)$DistinctDegreeFactorize(F,R)
+      [(lunm.cont)::R, append(factorlist,
+           [[(pp.irr)::P,pp.pow] for pp in lunm.factors])]$MFinalFact
+
+                ----  The polynomial has mindeg>0   ----
+
+    simplify(m:P,dm:Z,lvar:L OV,lmdeg:L NNI):MFinalFact ==
+      factorlist:L MParFact:=empty()
+      pol1:P:= 1$P
+      for x in lvar repeat
+        i := lmdeg.(position(x,lvar))
+        i=0 => "next value"
+        pol1:=pol1*monomial(1$P,x,i)
+        factorlist:=cons([x::P,i]$MParFact,factorlist)
+      m := (m exquo pol1)::P
+      ground? m => constantCase(m,factorlist)
+      flead:=mFactor(m,dm)
+      flead.factors:=append(factorlist,flead.factors)
+      flead
+
+                ----  m square-free,primitive,lc constant  ----
+    mfconst(um:SUP P,dm:Z,lvar:L OV,ldeg:L NNI):L SUP P ==
+      nsign:Boolean
+      factfin:L SUP P:=empty()
+      empty? lvar =>
+          um1:SUP R:=map(ground,
+              um)$UPCF2(P,SUP P,R,SUP R)
+          lum:= generalTwoFactor(um1)$TwoFactorize(F)
+          [map(coerce,lumf.factor)$UPCF2(R,SUP R,P,SUP P)
+                for lumf in factors lum]
+      intfact(um,lvar,ldeg,[0,empty()]$MFinalFact,empty())
+
+              --- m is square-free,primitive,lc is a polynomial  ---
+    mfpol(um:SUP P,dm:Z,lvar:L OV,ldeg:L NNI):L SUP P ==
+      dist : LeadFact
+      tleadpol:=mFactor(leadingCoefficient um,dm)
+      intfact(um,lvar,ldeg,tleadpol,empty())
+
+    factor(m:PG):Factored PG ==
+       lv:=variables m
+       lv=empty() => makeFR(m,empty() )
+       -- reduce to multivariate over SUP
+       ld:=[degree(m,x) for x in lv]
+       dx:="min"/ld
+       basicVar:=lv(position(dx,ld))
+       cm:=pushdown(m,basicVar)
+       flist := mFactor(cm,dx)
+       pushupconst(flist.contp,basicVar) *
+          (*/[primeFactor(pushup(u.irr,basicVar),u.pow)
+                                                 for u in flist.factors])
+
 *)
 
 \end{chunk}
@@ -82030,6 +109621,7 @@ MultipleMap(R1,UP1,UPUP1,R2,UP2,UPUP2): Exports == Implementation where
       ++ map(f, p) lifts f to the domain of p then applies it to p.
 
   Implementation ==> add
+
     import UnivariatePolynomialCategoryFunctions2(R1, UP1, R2, UP2)
 
     rfmap: (R1 -> R2, Q1) -> Q2
@@ -82045,6 +109637,17 @@ MultipleMap(R1,UP1,UPUP1,R2,UP2,UPUP2): Exports == Implementation where
 \begin{chunk}{COQ MMAP}
 (* package MMAP *)
 (*
+
+    import UnivariatePolynomialCategoryFunctions2(R1, UP1, R2, UP2)
+
+    rfmap: (R1 -> R2, Q1) -> Q2
+
+    rfmap(f, q) == map(f, numer q) / map(f, denom q)
+
+    map(f, p) ==
+      map(x +-> rfmap(f,x),
+          p)$UnivariatePolynomialCategoryFunctions2(Q1, UPUP1, Q2, UPUP2)
+
 *)
 
 \end{chunk}
@@ -82198,12 +109801,15 @@ MultiVariableCalculusFunctions(S,F,FLAF,FLAS) : Exports == Implementation where
      ++ (The notation conforms to LAPACK/NAG-F07 conventions.)
 
   Implementation ==> add
+
     localGradient(v:F,xlist:List(S)):Vector(F) ==
        vector([D(v,x) for x in xlist])
+
     gradient(v,xflas) ==
        --xlist:List(S) := [xflas(i) for i in 1 .. maxIndex(xflas)]
        xlist:List(S) := parts(xflas)
        localGradient(v,xlist)
+
     localDivergence(vf:Vector(F),xlist:List(S)):F ==
        i: PI
        n: NNI
@@ -82213,6 +109819,7 @@ MultiVariableCalculusFunctions(S,F,FLAF,FLAS) : Exports == Implementation where
        ans:= 0
        for i in 1 .. n repeat ans := ans + D(vf(i),xlist(i)) 
        ans
+
     divergence(vf,xflas) ==
        xlist:List(S) := parts(xflas)
        i: PI
@@ -82223,20 +109830,21 @@ MultiVariableCalculusFunctions(S,F,FLAF,FLAS) : Exports == Implementation where
        ans:= 0
        for i in 1 .. n repeat ans := ans + D(vf(i),xlist(i)) 
        ans
+
     laplacian(v,xflas) ==
        xlist:List(S) := parts(xflas)
        gv:Vector(F) := localGradient(v,xlist)
        localDivergence(gv,xlist)
+
     hessian(v,xflas) ==
        xlist:List(S) := parts(xflas)
        matrix([[D(v,[x,y]) for x in xlist] for y in xlist])
-    --standardJacobian(vf,xlist) ==
-    --   i: PI
-    --   matrix([[D(vf(i),x) for x in xlist] for i in 1 .. maxIndex(vf)])
+
     jacobian(vf,xflas) ==
        xlist:List(S) := parts(xflas)
        i: PI
        matrix([[D(vf(i),x) for x in xlist] for i in 1 .. maxIndex(vf)])
+
     bandedHessian(v,xflas,k) ==
        xlist:List(S) := parts(xflas)
        j,iw: PI
@@ -82249,10 +109857,12 @@ MultiVariableCalculusFunctions(S,F,FLAF,FLAS) : Exports == Implementation where
          for j in 1 .. (n-iw+1) repeat (_
            setelt(bandM,iw,j,D(v,[xlist(j),xlist(j+iw-1)])) ) )
        bandM
+
     jacobian(vf,xflas) ==
        xlist:List(S) := parts(xflas)
        i: PI
        matrix([[D(vf(i),x) for x in xlist] for i in 1 .. maxIndex(vf)])
+
     bandedJacobian(vf,xflas,kl,ku) ==
        xlist:List(S) := parts(xflas)
        j,iw: PI
@@ -82274,6 +109884,84 @@ MultiVariableCalculusFunctions(S,F,FLAF,FLAS) : Exports == Implementation where
 \begin{chunk}{COQ MCALCFN}
 (* package MCALCFN *)
 (*
+
+    localGradient(v:F,xlist:List(S)):Vector(F) ==
+       vector([D(v,x) for x in xlist])
+
+    gradient(v,xflas) ==
+       --xlist:List(S) := [xflas(i) for i in 1 .. maxIndex(xflas)]
+       xlist:List(S) := parts(xflas)
+       localGradient(v,xlist)
+
+    localDivergence(vf:Vector(F),xlist:List(S)):F ==
+       i: PI
+       n: NNI
+       ans: F
+       -- Perhaps should report error if two args of min different
+       n:= min(#(xlist),((maxIndex(vf))::NNI))$NNI
+       ans:= 0
+       for i in 1 .. n repeat ans := ans + D(vf(i),xlist(i)) 
+       ans
+
+    divergence(vf,xflas) ==
+       xlist:List(S) := parts(xflas)
+       i: PI
+       n: NNI
+       ans: F
+       -- Perhaps should report error if two args of min different
+       n:= min(#(xlist),((maxIndex(vf))::NNI))$NNI
+       ans:= 0
+       for i in 1 .. n repeat ans := ans + D(vf(i),xlist(i)) 
+       ans
+
+    laplacian(v,xflas) ==
+       xlist:List(S) := parts(xflas)
+       gv:Vector(F) := localGradient(v,xlist)
+       localDivergence(gv,xlist)
+
+    hessian(v,xflas) ==
+       xlist:List(S) := parts(xflas)
+       matrix([[D(v,[x,y]) for x in xlist] for y in xlist])
+
+    jacobian(vf,xflas) ==
+       xlist:List(S) := parts(xflas)
+       i: PI
+       matrix([[D(vf(i),x) for x in xlist] for i in 1 .. maxIndex(vf)])
+
+    bandedHessian(v,xflas,k) ==
+       xlist:List(S) := parts(xflas)
+       j,iw: PI
+       n: NNI
+       bandM: Matrix F
+       n:= #(xlist)
+       bandM:= new(k+1,n,0)
+       for j in 1 .. n repeat setelt(bandM,1,j,D(v,xlist(j),2))
+       for iw in 2 .. (k+1) repeat (_
+         for j in 1 .. (n-iw+1) repeat (_
+           setelt(bandM,iw,j,D(v,[xlist(j),xlist(j+iw-1)])) ) )
+       bandM
+
+    jacobian(vf,xflas) ==
+       xlist:List(S) := parts(xflas)
+       i: PI
+       matrix([[D(vf(i),x) for x in xlist] for i in 1 .. maxIndex(vf)])
+
+    bandedJacobian(vf,xflas,kl,ku) ==
+       xlist:List(S) := parts(xflas)
+       j,iw: PI
+       n: NNI
+       bandM: Matrix F
+       n:= #(xlist)
+       bandM:= new(kl+ku+1,n,0)
+       for j in 1 .. n repeat setelt(bandM,ku+1,j,D(vf(j),xlist(j)))
+       for iw in (ku+2) .. (ku+kl+1) repeat (_
+         for j in 1 .. (n-iw+ku+1) repeat (_
+           setelt(bandM,iw,j,D(vf(j+iw-1-ku),xlist(j))) ) )
+       for iw in 1 .. ku repeat (_
+         for j in (ku+2-iw) .. n repeat (_
+           setelt(bandM,iw,j,D(vf(j+iw-1-ku),xlist(j))) ) )
+       bandM
+
 *)
 
 \end{chunk}
@@ -82365,6 +110053,7 @@ MultivariateFactorize(OV,E,R,P) : C == T
       ++ domain where p is represented as a univariate polynomial with
       ++ multivariate coefficients
   T == add
+
     factor(p:P) : Factored P ==
       R is Fraction Integer =>
          factor(p)$MRationalFactorize(E,OV,Integer,P)
@@ -82382,6 +110071,19 @@ MultivariateFactorize(OV,E,R,P) : C == T
 \begin{chunk}{COQ MULTFACT}
 (* package MULTFACT *)
 (*
+
+    factor(p:P) : Factored P ==
+      R is Fraction Integer =>
+         factor(p)$MRationalFactorize(E,OV,Integer,P)
+      R is Fraction Complex Integer =>
+         factor(p)$MRationalFactorize(E,OV,Complex Integer,P)
+      R is Fraction Polynomial Integer and OV has convert: % -> Symbol =>
+         factor(p)$MPolyCatRationalFunctionFactorizer(E,OV,Integer,P)
+      factor(p,factor$GenUFactorize(R))$InnerMultFact(OV,E,R,P)
+
+    factor(up:USP) : Factored USP ==
+      factor(up,factor$GenUFactorize(R))$InnerMultFact(OV,E,R,P)
+
 *)
 
 \end{chunk}
@@ -82471,6 +110173,7 @@ MultivariateLifting(E,OV,R,P) : C == T
       ++ lifting1(u,lv,lu,lr,lp,lt,ln,t,r) \undocumented
  
   T == add
+
     GenExEuclid(R,BP)
     NPCoef(BP,E,OV,R,P)
     IntegerCombinatoricFunctions(Z)
@@ -82492,14 +110195,11 @@ MultivariateLifting(E,OV,R,P) : C == T
              table:Table,pmod:R):Union(L SUP,"failed") ==
       --  The correction coefficients are evaluated recursively.
       --   Extended Euclidean algorithm for the multivariate case.
- 
       -- the polynomial is univariate  --
       #lvar=0 =>
         lp:=solveid(map(ground,m)$SUPF2(P,R),pmod,table)
         if lp case "failed" then return "failed"
         lcoef:= [map(coerce,mp)$SUPF2(R,P) for mp in lp::L BP]
- 
- 
       diff,ddiff,pol,polc:SUP
       listpolv,listcong:L SUP
       deg1:NNI:= ld.first
@@ -82529,10 +110229,11 @@ MultivariateLifting(E,OV,R,P) : C == T
       lcoef
   
     lifting1(m:SUP,lvar:L OV,plist:L SUP,vlist:L R,tlist:L P,_
-      coeflist:L VTerm,listdeg:L NNI,table:Table,pmod:R) :Union(L SUP,"failed") ==
-    -- The factors of m (multivariate) are determined ,
-    -- We suppose to know the true univariate factors
-    -- some coefficients are determined
+      coeflist:L VTerm,listdeg:L NNI,table:Table,pmod:R)_
+         :Union(L SUP,"failed") ==
+      -- The factors of m (multivariate) are determined ,
+      -- We suppose to know the true univariate factors
+      -- some coefficients are determined
       conglist:L SUP:=empty()
       nvar : NNI:= #lvar
       pol,polc:P
@@ -82661,6 +110362,190 @@ MultivariateLifting(E,OV,R,P) : C == T
 \begin{chunk}{COQ MLIFT}
 (* package MLIFT *)
 (*
+
+    GenExEuclid(R,BP)
+    NPCoef(BP,E,OV,R,P)
+    IntegerCombinatoricFunctions(Z)
+
+    SUPF2   ==> SparseUnivariatePolynomialFunctions2
+
+    DetCoef ==> Record(deter:L SUP,dterm:L VTerm,nfacts:L BP,
+                       nlead:L P)
+ 
+              ---   local functions   ---
+    normalDerivM    :    (P,Z,OV)     ->  P
+    normalDeriv     :     (SUP,Z)     ->  SUP
+    subslead        :     (SUP,P)     ->  SUP
+    subscoef        :   (SUP,L Term)  ->  SUP
+    maxDegree       :   (SUP,OV)      ->  NonNegativeInteger
+ 
+ 
+    corrPoly(m:SUP,lvar:L OV,fval:L R,ld:L NNI,flist:L SUP,
+             table:Table,pmod:R):Union(L SUP,"failed") ==
+      --  The correction coefficients are evaluated recursively.
+      --   Extended Euclidean algorithm for the multivariate case.
+      -- the polynomial is univariate  --
+      #lvar=0 =>
+        lp:=solveid(map(ground,m)$SUPF2(P,R),pmod,table)
+        if lp case "failed" then return "failed"
+        lcoef:= [map(coerce,mp)$SUPF2(R,P) for mp in lp::L BP]
+      diff,ddiff,pol,polc:SUP
+      listpolv,listcong:L SUP
+      deg1:NNI:= ld.first
+      np:NNI:= #flist
+      a:P:= fval.first ::P
+      y:OV:=lvar.first
+      lvar:=lvar.rest
+      listpolv:L SUP := [map((p1:P):P +-> eval(p1,y,a),f1) for f1 in flist]
+      um:=map((p1:P):P +-> eval(p1,y,a),m)
+      flcoef:=corrPoly(um,lvar,fval.rest,ld.rest,listpolv,table,pmod)
+      if flcoef case "failed" then return "failed"
+      else lcoef:=flcoef :: L SUP
+      listcong:=[*/[flist.i for i in 1..np | i^=l] for l in 1..np]
+      polc:SUP:= (monomial(1,y,1) - a)::SUP
+      pol := 1$SUP
+      diff:=m- +/[lcoef.i*listcong.i for i in 1..np]
+      for l in 1..deg1 repeat
+        if diff=0 then return lcoef
+        pol := pol*polc
+        (ddiff:=map((p:P):P+->eval(normalDerivM(p,l,y),y,a),diff)) = 0
+              => "next l"
+        fbeta := corrPoly(ddiff,lvar,fval.rest,ld.rest,listpolv,table,pmod)
+        if fbeta case "failed" then return "failed"
+        else beta:=fbeta :: L SUP
+        lcoef := [lcoef.i+beta.i*pol  for i in 1..np]
+        diff:=diff- +/[listcong.i*beta.i for i in 1..np]*pol
+      lcoef
+  
+    lifting1(m:SUP,lvar:L OV,plist:L SUP,vlist:L R,tlist:L P,_
+      coeflist:L VTerm,listdeg:L NNI,table:Table,pmod:R)_
+         :Union(L SUP,"failed") ==
+      -- The factors of m (multivariate) are determined ,
+      -- We suppose to know the true univariate factors
+      -- some coefficients are determined
+      conglist:L SUP:=empty()
+      nvar : NNI:= #lvar
+      pol,polc:P
+      mc,mj:SUP
+      testp:Boolean:= (not empty?(tlist))
+      lalpha : L SUP := empty()
+      tlv:L P:=empty()
+      subsvar:L OV:=empty()
+      subsval:L R:=empty()
+      li:L OV := lvar
+      ldeg:L NNI:=empty()
+      clv:L VTerm:=empty()
+      --j =#variables, i=#factors
+      for j in 1..nvar repeat
+        x  := li.first
+        li := rest li
+        conglist:= plist
+        v := vlist.first
+        vlist := rest vlist
+        degj := listdeg.j
+        ldeg := cons(degj,ldeg)
+        subsvar:=cons(x,subsvar)
+        subsval:=cons(v,subsval)
+ 
+      --substitute the determined coefficients
+        if testp then
+          if j<nvar then
+            tlv:=[eval(p,li,vlist) for p in tlist]
+            clv:=[[[term.expt,eval(term.pcoef,li,vlist)]$Term
+                   for term in clist] for clist  in coeflist]
+          else (tlv,clv):=(tlist,coeflist)
+          plist :=[subslead(p,lcp) for p in plist for lcp in tlv]
+          if not(empty? coeflist) then
+            plist:=[subscoef(tpol,clist)
+                   for tpol in plist for clist in clv]
+        mj := map((p1:P):P+->eval(p1,li,vlist),m)  --m(x1,..,xj,aj+1,..,an
+        polc := x::P - v::P  --(xj-aj)
+        pol:= 1$P
+      --Construction of Rik, k in 1..right degree for xj+1
+        for k in 1..degj repeat  --I can exit before
+         pol := pol*polc
+         mc := */[term for term in plist]-mj
+         if mc=0 then leave "next var"
+         --Modulus Dk
+         mc:=map((p1:P):P +-> normalDerivM(p1,k,x),mc)
+         (mc := map((p1:P):P +-> eval(p1,[x],[v]),mc))=0 => "next k"
+         flalpha:=corrPoly(mc,subsvar.rest,subsval.rest,
+                          ldeg.rest,conglist,table,pmod)
+         if flalpha case "failed" then return "failed"
+         else lalpha:=flalpha :: L SUP
+         plist:=[term-alpha*pol for term in plist for alpha in lalpha]
+        -- PGCD may call with a smaller valure of degj
+        idegj:Integer:=maxDegree(m,x)
+        for term in plist repeat idegj:=idegj -maxDegree(term,x)
+        idegj < 0 => return "failed"
+      plist
+        --There are not extraneous factors
+ 
+    maxDegree(um:SUP,x:OV):NonNegativeInteger ==
+       ans:NonNegativeInteger:=0
+       while um ^= 0 repeat  
+          ans:=max(ans,degree(leadingCoefficient um,x))
+          um:=reductum um    
+       ans                   
+                         
+    lifting(um:SUP,lvar:L OV,plist:L BP,vlist:L R,
+            tlist:L P,listdeg:L NNI,pmod:R):Union(L SUP,"failed") ==
+    -- The factors of m (multivariate) are determined, when the
+    --  univariate true factors are known and some coefficient determined
+      nplist:List SUP:=[map(coerce,pp)$SUPF2(R,P) for pp in plist]
+      listdet : L SUP := []
+      coeflist: L VTerm := []
+      if not(empty? tlist) then
+        ldcoef : DetCoef := npcoef(um, plist, tlist)
+        if not empty?(listdet := ldcoef.deter) then
+          if #listdet = #plist then return listdet
+          plist := ldcoef.nfacts
+          nplist := [map(coerce, pp)$SUPF2(R, P) for pp in plist]
+          um := (um exquo */[pol for pol in listdet])::SUP
+          tlist := ldcoef.nlead
+          coeflist := ldcoef.dterm
+      tab := tablePow(degree um, pmod, plist)
+      tab case "failed" => error "Table construction failed in MLIFT"
+      table:Table:=tab
+      ffl:=lifting1(um,lvar,nplist,vlist,tlist,coeflist,listdeg,tab,pmod)
+      if ffl case "failed" then return "failed"
+      append(listdet,ffl:: L SUP)
+
+    -- normalDerivM(f,m,x) = the normalized (divided by m!) m-th
+    -- derivative with respect to x of the multivariate polynomial f
+    normalDerivM(g:P,m:Z,x:OV) : P ==
+     multivariate(normalDeriv(univariate(g,x),m),x)
+
+    normalDeriv(f:SUP,m:Z) : SUP ==
+     (n1:Z:=degree f) < m => 0$SUP
+     n1=m => leadingCoefficient f :: SUP
+     k:=binomial(n1,m)
+     ris:SUP:=0$SUP
+     n:Z:=n1
+     while n>= m repeat
+       while n1>n repeat
+         k:=(k*(n1-m)) quo n1
+         n1:=n1-1
+       ris:=ris+monomial(k*leadingCoefficient f,(n-m)::NNI)
+       f:=reductum f
+       n:=degree f
+     ris
+
+    subslead(m:SUP,pol:P):SUP ==
+      dm:NNI:=degree m
+      monomial(pol,dm)+reductum m
+ 
+    subscoef(um:SUP,lterm:L Term):SUP ==
+      dm:NNI:=degree um
+      new:=monomial(leadingCoefficient um,dm)
+      for k in dm-1..0 by -1 repeat
+        i:NNI:=k::NNI
+        empty?(lterm) or lterm.first.expt^=i =>
+                                new:=new+monomial(coefficient(um,i),i)
+        new:=new+monomial(lterm.first.pcoef,i)
+        lterm:=lterm.rest
+      new
+
 *)
 
 \end{chunk}
@@ -82817,7 +110702,6 @@ MultivariateSquareFree (E,OV,R,P) : C == T where
  
    pmod:R   :=  (prevPrime(2**26)$IntegerPrimesPackage(Integer))::R
  
- 
    import GenExEuclid()
    import MultivariateLifting(E,OV,R,P)
    import PolynomialGcdPackage(E,OV,R,P)
@@ -82831,8 +110715,6 @@ MultivariateSquareFree (E,OV,R,P) : C == T where
    nsqfree(oldf:SUP,lvar:List(OV),ltry:List List R) : squareForm ==
      f:=oldf
      univPol := intChoose(f,lvar,ltry)
---     debug msg
---     if not empty? ltry then output("ltry =", (ltry::OutputForm))$OutputPackage
      f0:=univPol.upol
      --the polynomial is square-free
      f0=1$BP => [1$P,[[f,1]$FFES]]$squareForm
@@ -82889,7 +110771,6 @@ MultivariateSquareFree (E,OV,R,P) : C == T where
            lcr:=h1::P
            lpfact.exponent:=(lpfact.exponent)-exp0
      [((retract f) exquo ctf)::P,sqdec]$squareForm
-
  
    squareFree(f:SUP) : Factored SUP ==
      degree f =0 =>
@@ -82903,24 +110784,20 @@ MultivariateSquareFree (E,OV,R,P) : C == T where
        makeFR(map(coerce,unit usqfr)$UPCF2(R,BP,P,SUP),
               [["sqfr",map(coerce,ff.fctr)$UPCF2(R,BP,P,SUP),ff.xpnt]
                  for ff in factorList usqfr])
-
      lcf:=content f
      f:=(f exquo lcf) ::SUP
      lcSq:=squareFree lcf
      lfs:List ffSUP:=[["sqfr",ff.fctr ::SUP,ff.xpnt]
                         for ff in factorList lcSq]
      partSq:=nsqfree(f,lvar,empty())
-
      lfs:=append([["sqfr",fu.factor,fu.exponent]$ffSUP
                     for fu in partSq.suPart],lfs)
      makeFR((unit lcSq * partSq.unitPart) ::SUP,lfs)
 
    squareFree(f:P) : Factored P ==
      ground? f => makeFR(f,[])      ---   the polynomial is constant  ---
- 
      lvar:List(OV):=variables(f)
      result1:List ffP:= empty()
-
      lmdeg :=minimumDegree(f,lvar)     ---       is the mindeg > 0 ? ---
      p:P:=1$P
      for im in 1..#lvar repeat
@@ -82932,12 +110809,9 @@ MultivariateSquareFree (E,OV,R,P) : C == T where
        f := (f exquo p)::P
        if ground? f then return makeFR(f, result1)
        lvar:=variables(f)
- 
- 
      #lvar=1 =>                    ---  the polynomial is univariate ---
        result:=univcase(f,lvar.first)
        makeFR(unit result,append(result1,factorList result))
- 
      ldeg:=degree(f,lvar)          ---  general case ---
      m:="min"/[j for j in ldeg|j^=0]
      i:Z:=1
@@ -82954,8 +110828,8 @@ MultivariateSquareFree (E,OV,R,P) : C == T where
      sqlead:=squareFree(lcont)
      makeFR(unit sqlead*nsqfftot.unitPart,append(result1,factorList sqlead))
  
-  -- Choose the integer for the evaluation.                        --
-  -- If the polynomial is square-free the function returns upol=1. --
+    -- Choose the integer for the evaluation.                        --
+    -- If the polynomial is square-free the function returns upol=1. --
  
    intChoose(f:SUP,lvar:List(OV),ltry:List List R):Choice ==
      degf:= degree f
@@ -83001,7 +110875,6 @@ MultivariateSquareFree (E,OV,R,P) : C == T where
          lval1:=lval
          d1:=d0
  
- 
         ----  Choose the leading coefficient for the lifting  ----
    coefChoose(exp:Z,sqlead:Factored(P)) : P ==
      lcoef:P:=unit(sqlead)
@@ -83020,7 +110893,7 @@ MultivariateSquareFree (E,OV,R,P) : C == T where
  
          ----  lift the univariate square-free factor  ----
    lift(ud:SUP,g0:BP,g1:BP,lcoef:P,lvar:List(OV),
-                        ldeg:List(NNI),lval:List(R)) : Union(List SUP,"failed") ==
+                    ldeg:List(NNI),lval:List(R)) : Union(List SUP,"failed") ==
      leadpol:Boolean:=false
      lcd:P:=leadingCoefficient ud
      leadlist:List(P):=empty()
@@ -83049,15 +110922,6 @@ MultivariateSquareFree (E,OV,R,P) : C == T where
          [["sqfr",multivariate(term.factor,x),term.exponent]
            for term in factors result])
 
---   squareFreePrim(p:P) : Factored P ==
---     -- p is content free
---     ground? p => makeFR(p,[])      ---   the polynomial is constant  ---
--- 
---     lvar:List(OV):=variables p
---     #lvar=1 =>                    ---  the polynomial is univariate ---
---       univcase(p,lvar.first)
---     nsqfree(p,lvar,1)
- 
    compdegd(lfact:List(FFE)) : Z ==
      ris:Z:=0
      for pfact in lfact repeat
@@ -83087,6 +110951,253 @@ MultivariateSquareFree (E,OV,R,P) : C == T where
 \begin{chunk}{COQ MULTSQFR}
 (* package MULTSQFR *)
 (*
+ 
+   pmod:R   :=  (prevPrime(2**26)$IntegerPrimesPackage(Integer))::R
+ 
+   import GenExEuclid()
+   import MultivariateLifting(E,OV,R,P)
+   import PolynomialGcdPackage(E,OV,R,P)
+   import FactoringUtilities(E,OV,R,P)
+   import IntegerCombinatoricFunctions(Z)
+ 
+ 
+    ----  Are the univariate square-free decompositions consistent?  ----
+ 
+     ----  new square-free algorithm for primitive polynomial  ----
+   nsqfree(oldf:SUP,lvar:List(OV),ltry:List List R) : squareForm ==
+     f:=oldf
+     univPol := intChoose(f,lvar,ltry)
+     f0:=univPol.upol
+     --the polynomial is square-free
+     f0=1$BP => [1$P,[[f,1]$FFES]]$squareForm
+     lfact:List(FFE):=univPol.Lfact
+     lval:=univPol.Lval
+     ctf:=univPol.ctpol
+     leadpol:Boolean:=false
+     sqdec:List FFES := empty()
+     exp0:Z:=0
+     unitsq:P:=1
+     lcf:P:=leadingCoefficient f
+     if ctf^=1 then
+       f0:=ctf*f0
+       f:=(ctf::P)*f
+       lcf:=ctf*lcf
+     sqlead:List FFEP:= empty()
+     sqlc:Factored P:=1
+     if lcf^=1$P then
+       leadpol:=true
+       sqlc:=squareFree lcf
+       unitsq:=unitsq*(unit sqlc)
+       sqlead:= factors sqlc
+     lfact:=sort((z1:FFE,z2:FFE):Boolean +-> z1.exponent > z2.exponent,lfact)
+     while lfact^=[] repeat
+       pfact:=lfact.first
+       (g0,exp0):=(pfact.factor,pfact.exponent)
+       lfact:=lfact.rest
+       lfact=[] and exp0 =1 =>
+         f := (f exquo (ctf::P))::SUP
+         gg := unitNormal leadingCoefficient f
+         sqdec:=cons([gg.associate*f,exp0],sqdec)
+         return  [gg.unit, sqdec]$squareForm
+       if ctf^=1 then g0:=ctf*g0
+       npol:=consnewpol(f,f0,exp0)
+       (d,d0):=(npol.pol,npol.polval)
+       if leadpol then lcoef:=coefChoose(exp0,sqlc)
+       else lcoef:=1$P
+       ldeg:=myDegree(f,lvar,exp0::NNI)
+       result:=lift(d,g0,(d0 exquo g0)::BP,lcoef,lvar,ldeg,lval)
+       result case "failed" => return nsqfree(oldf,lvar,ltry)
+       result0:SUP:= (result::List SUP).1
+       r1:SUP:=result0**(exp0:NNI)
+       if (h:=f exquo r1) case "failed" then return nsqfree(oldf,lvar,empty())
+       sqdec:=cons([result0,exp0],sqdec)
+       f:=h::SUP
+       f0:=completeEval(h,lvar,lval)
+       lcr:P:=leadingCoefficient result0
+       if leadpol and lcr^=1$P then
+         for lpfact in sqlead  while lcr^=1 repeat
+           ground? lcr =>
+             unitsq:=(unitsq exquo lcr)::P
+             lcr:=1$P
+           (h1:=lcr exquo lpfact.factor) case "failed" => "next"
+           lcr:=h1::P
+           lpfact.exponent:=(lpfact.exponent)-exp0
+     [((retract f) exquo ctf)::P,sqdec]$squareForm
+ 
+   squareFree(f:SUP) : Factored SUP ==
+     degree f =0 =>
+       fu:=squareFree retract f
+       makeFR((unit fu)::SUP,[["sqfr",ff.fctr::SUP,ff.xpnt]
+               for ff in factorList fu])
+     lvar:= "setUnion"/[variables cf for cf in coefficients f]
+     empty? lvar =>  -- the polynomial is univariate
+       upol:=map(ground,f)$UPCF2(P,SUP,R,BP)
+       usqfr:=squareFree upol
+       makeFR(map(coerce,unit usqfr)$UPCF2(R,BP,P,SUP),
+              [["sqfr",map(coerce,ff.fctr)$UPCF2(R,BP,P,SUP),ff.xpnt]
+                 for ff in factorList usqfr])
+     lcf:=content f
+     f:=(f exquo lcf) ::SUP
+     lcSq:=squareFree lcf
+     lfs:List ffSUP:=[["sqfr",ff.fctr ::SUP,ff.xpnt]
+                        for ff in factorList lcSq]
+     partSq:=nsqfree(f,lvar,empty())
+     lfs:=append([["sqfr",fu.factor,fu.exponent]$ffSUP
+                    for fu in partSq.suPart],lfs)
+     makeFR((unit lcSq * partSq.unitPart) ::SUP,lfs)
+
+   squareFree(f:P) : Factored P ==
+     ground? f => makeFR(f,[])      ---   the polynomial is constant  ---
+     lvar:List(OV):=variables(f)
+     result1:List ffP:= empty()
+     lmdeg :=minimumDegree(f,lvar)     ---       is the mindeg > 0 ? ---
+     p:P:=1$P
+     for im in 1..#lvar repeat
+       (n:=lmdeg.im)=0 => "next im"
+       y:=lvar.im
+       p:=p*monomial(1$P,y,n)
+       result1:=cons(["sqfr",y::P,n],result1)
+     if p^=1$P then
+       f := (f exquo p)::P
+       if ground? f then return makeFR(f, result1)
+       lvar:=variables(f)
+     #lvar=1 =>                    ---  the polynomial is univariate ---
+       result:=univcase(f,lvar.first)
+       makeFR(unit result,append(result1,factorList result))
+     ldeg:=degree(f,lvar)          ---  general case ---
+     m:="min"/[j for j in ldeg|j^=0]
+     i:Z:=1
+     for j in ldeg while j>m repeat i:=i+1
+     x:=lvar.i
+     lvar:=delete(lvar,i)
+     f0:=univariate (f,x)
+     lcont:P:= content f0
+     nsqfftot:=nsqfree((f0 exquo lcont)::SUP,lvar,empty())
+     nsqff:List ffP:=[["sqfr",multivariate(fu.factor,x),fu.exponent]$ffP
+                          for fu in nsqfftot.suPart]
+     result1:=append(result1,nsqff)
+     ground? lcont => makeFR(lcont*nsqfftot.unitPart,result1)
+     sqlead:=squareFree(lcont)
+     makeFR(unit sqlead*nsqfftot.unitPart,append(result1,factorList sqlead))
+ 
+    -- Choose the integer for the evaluation.                        --
+    -- If the polynomial is square-free the function returns upol=1. --
+ 
+   intChoose(f:SUP,lvar:List(OV),ltry:List List R):Choice ==
+     degf:= degree f
+     try:NNI:=0
+     nvr:=#lvar
+     range:Z:=10
+     lfact1:List(FFE):=[]
+     lval1:List R := []
+     lfact:List(FFE)
+     ctf1:R:=1
+     f1:BP:=1$BP
+     d1:Z
+     while range<10000000000 repeat
+       range:=2*range
+       lval:= [ran(range) for i in 1..nvr]
+       member?(lval,ltry) => "new integer"
+       ltry:=cons(lval,ltry)
+       f0:=completeEval(f,lvar,lval)
+       degree f0 ^=degf  => "new integer"
+       ctf:=content f0
+       lfact:List(FFE):=factors(squareFree((f0 exquo (ctf:R)::BP)::BP))
+ 
+            ----  the univariate polynomial is square-free  ----
+       if #lfact=1 and (lfact.1).exponent=1 then
+         return [1$BP,lval,lfact,1$R]$Choice
+ 
+       d0:=compdegd lfact
+                 ----      inizialize lfact1      ----
+       try=0 =>
+         f1:=f0
+         lfact1:=lfact
+         ctf1:=ctf
+         lval1:=lval
+         d1:=d0
+         try:=1
+       d0=d1 =>
+         return [f1,lval1,lfact1,ctf1]$Choice
+       d0 < d1 =>
+         try:=1
+         f1:=f0
+         lfact1:=lfact
+         ctf1:=ctf
+         lval1:=lval
+         d1:=d0
+ 
+        ----  Choose the leading coefficient for the lifting  ----
+   coefChoose(exp:Z,sqlead:Factored(P)) : P ==
+     lcoef:P:=unit(sqlead)
+     for term in factors(sqlead) repeat
+       texp:=term.exponent
+       texp<exp => "next term"
+       texp=exp => lcoef:=lcoef*term.factor
+       lcoef:=lcoef*(term.factor)**((texp quo exp)::NNI)
+     lcoef
+ 
+        ----  Construction of the polynomials for the lifting  ----
+   consnewpol(g:SUP,g0:BP,deg:Z):Twopol ==
+     deg=1 => [g,g0]$Twopol
+     deg:=deg-1
+     [normalDeriv(g,deg),normDeriv2(g0,deg)]$Twopol
+ 
+         ----  lift the univariate square-free factor  ----
+   lift(ud:SUP,g0:BP,g1:BP,lcoef:P,lvar:List(OV),
+                    ldeg:List(NNI),lval:List(R)) : Union(List SUP,"failed") ==
+     leadpol:Boolean:=false
+     lcd:P:=leadingCoefficient ud
+     leadlist:List(P):=empty()
+ 
+     if ^ground?(leadingCoefficient ud) then
+       leadpol:=true
+       ud:=lcoef*ud
+       lcg0:R:=leadingCoefficient g0
+       if ground? lcoef then g0:=retract(lcoef) quo lcg0 *g0
+       else g0:=(retract(eval(lcoef,lvar,lval)) quo lcg0) * g0
+       g1:=lcg0*g1
+       leadlist:=[lcoef,lcd]
+     plist:=lifting(ud,lvar,[g0,g1],lval,leadlist,ldeg,pmod)
+     plist case "failed" => "failed" 
+     (p0:SUP,p1:SUP):=((plist::List SUP).1,(plist::List SUP).2)
+     if completeEval(p0,lvar,lval) ^= g0 then (p0,p1):=(p1,p0)
+     [primitivePart p0,primitivePart p1]
+
+                ----  the polynomial is univariate  ----
+   univcase(f:P,x:OV) : Factored(P) ==
+     uf := univariate f
+     cf:=content uf
+     uf :=(uf exquo cf)::BP
+     result:Factored BP:=squareFree uf
+     makeFR(multivariate(cf*unit result,x),
+         [["sqfr",multivariate(term.factor,x),term.exponent]
+           for term in factors result])
+
+   compdegd(lfact:List(FFE)) : Z ==
+     ris:Z:=0
+     for pfact in lfact repeat
+       ris:=ris+(pfact.exponent -1)*degree pfact.factor
+     ris
+ 
+   normDeriv2(f:BP,m:Z) : BP ==
+     (n1:Z:=degree f) < m => 0$BP
+     n1=m => (leadingCoefficient f)::BP
+     k:=binomial(n1,m)
+     ris:BP:=0$BP
+     n:Z:=n1
+     while n>= m repeat
+       while n1>n repeat
+         k:=(k*(n1-m)) quo n1
+         n1:=n1-1
+       ris:=ris+monomial(k*leadingCoefficient f,(n-m)::NNI)
+       f:=reductum f
+       n:=degree f
+     ris
+
+   myDegree(f:SUP,lvar:List OV,exp:NNI) : List NNI==
+     [n quo exp for n in degree(f,lvar)]
+
 *)
 
 \end{chunk}
@@ -88565,6 +116676,448 @@ NagEigenPackage(): Exports == Implementation where
 \begin{chunk}{COQ NAGF02}
 (* package NAGF02 *)
 (*
+
+    import Lisp
+    import DoubleFloat
+    import Any
+    import Record
+    import Integer
+    import Matrix DoubleFloat
+    import Boolean
+    import NAGLinkSupportPackage
+    import FortranPackage
+    import AnyFunctions1(Integer)
+    import AnyFunctions1(Boolean)
+    import AnyFunctions1(Matrix DoubleFloat)
+    import AnyFunctions1(Matrix Complex DoubleFloat)
+    import AnyFunctions1(DoubleFloat)
+
+
+    f02aaf(iaArg:Integer,nArg:Integer,aArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f02aaf",_
+        ["ia"::S,"n"::S,"ifail"::S,"r"::S,"a"::S,"e"::S]$Lisp,_
+        ["r"::S,"e"::S]$Lisp,_
+        [["double"::S,["r"::S,"n"::S]$Lisp,["a"::S,"ia"::S,"n"::S]$Lisp_
+        ,["e"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"ia"::S,"n"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["r"::S,"a"::S,"ifail"::S]$Lisp,_
+        [([iaArg::Any,nArg::Any,ifailArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f02abf(aArg:Matrix DoubleFloat,iaArg:Integer,nArg:Integer,_
+        ivArg:Integer,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f02abf",_
+        ["ia"::S,"n"::S,"iv"::S,"ifail"::S,"a"::S,"r"::S,"v"::S,"e"::S]$Lisp,_
+        ["r"::S,"v"::S,"e"::S]$Lisp,_
+        [["double"::S,["a"::S,"ia"::S,"n"::S]$Lisp_
+        ,["r"::S,"n"::S]$Lisp,["v"::S,"iv"::S,"n"::S]$Lisp,_
+        ["e"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"ia"::S,"n"::S,"iv"::S,"ifail"::S_
+        ]$Lisp_
+        ]$Lisp,_
+        ["r"::S,"v"::S,"ifail"::S]$Lisp,_
+        [([iaArg::Any,nArg::Any,ivArg::Any,ifailArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f02adf(iaArg:Integer,ibArg:Integer,nArg:Integer,_
+        aArg:Matrix DoubleFloat,bArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f02adf",_
+        ["ia"::S,"ib"::S,"n"::S,"ifail"::S,"r"::S,"a"::S,"b"::S,"de"::S]$Lisp,_
+        ["r"::S,"de"::S]$Lisp,_
+        [["double"::S,["r"::S,"n"::S]$Lisp,["a"::S,"ia"::S,"n"::S]$Lisp_
+        ,["b"::S,"ib"::S,"n"::S]$Lisp,["de"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"ia"::S,"ib"::S,"n"::S,"ifail"::S_
+        ]$Lisp_
+        ]$Lisp,_
+        ["r"::S,"a"::S,"b"::S,"ifail"::S]$Lisp,_
+        [([iaArg::Any,ibArg::Any,nArg::Any,ifailArg::Any,aArg::Any,bArg::Any])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f02aef(iaArg:Integer,ibArg:Integer,nArg:Integer,_
+        ivArg:Integer,aArg:Matrix DoubleFloat,bArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f02aef",_
+        ["ia"::S,"ib"::S,"n"::S,"iv"::S,"ifail"::S_
+        ,"r"::S,"v"::S,"a"::S,"b"::S,"dl"::S_
+        ,"e"::S]$Lisp,_
+        ["r"::S,"v"::S,"dl"::S,"e"::S]$Lisp,_
+        [["double"::S,["r"::S,"n"::S]$Lisp,["v"::S,"iv"::S,"n"::S]$Lisp_
+        ,["a"::S,"ia"::S,"n"::S]$Lisp,["b"::S,"ib"::S,"n"::S]$Lisp,_
+        ["dl"::S,"n"::S]$Lisp,["e"::S,"n"::S]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"ia"::S,"ib"::S,"n"::S,"iv"::S_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["r"::S,"v"::S,"a"::S,"b"::S,"ifail"::S]$Lisp,_
+        [([iaArg::Any,ibArg::Any,nArg::Any,ivArg::Any,_
+        ifailArg::Any,aArg::Any,bArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f02aff(iaArg:Integer,nArg:Integer,aArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f02aff",_
+        ["ia"::S,"n"::S,"ifail"::S,"rr"::S,"ri"::S,"intger"::S,"a"::S]$Lisp,_
+        ["rr"::S,"ri"::S,"intger"::S]$Lisp,_
+        [["double"::S,["rr"::S,"n"::S]$Lisp,["ri"::S,"n"::S]$Lisp_
+        ,["a"::S,"ia"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"ia"::S,"n"::S,["intger"::S,"n"::S]$Lisp_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["rr"::S,"ri"::S,"intger"::S,"a"::S,"ifail"::S]$Lisp,_
+        [([iaArg::Any,nArg::Any,ifailArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f02agf(iaArg:Integer,nArg:Integer,ivrArg:Integer,_
+        iviArg:Integer,aArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f02agf",_
+        ["ia"::S,"n"::S,"ivr"::S,"ivi"::S,"ifail"::S_
+        ,"rr"::S,"ri"::S,"vr"::S,"vi"::S,"intger"::S_
+        ,"a"::S]$Lisp,_
+        ["rr"::S,"ri"::S,"vr"::S,"vi"::S,"intger"::S]$Lisp,_
+        [["double"::S,["rr"::S,"n"::S]$Lisp,["ri"::S,"n"::S]$Lisp_
+        ,["vr"::S,"ivr"::S,"n"::S]$Lisp,["vi"::S,"ivi"::S,"n"::S]$Lisp,_
+        ["a"::S,"ia"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"ia"::S,"n"::S,"ivr"::S,"ivi"::S_
+        ,["intger"::S,"n"::S]$Lisp,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["rr"::S,"ri"::S,"vr"::S,"vi"::S,"intger"::S,"a"::S,"ifail"::S]$Lisp,_
+        [([iaArg::Any,nArg::Any,ivrArg::Any,iviArg::Any,_
+        ifailArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f02ajf(iarArg:Integer,iaiArg:Integer,nArg:Integer,_
+        arArg:Matrix DoubleFloat,aiArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f02ajf",_
+        ["iar"::S,"iai"::S,"n"::S,"ifail"::S,"rr"::S,"ri"::S,_
+        "ar"::S,"ai"::S,"intger"::S_
+        ]$Lisp,_
+        ["rr"::S,"ri"::S,"intger"::S]$Lisp,_
+        [["double"::S,["rr"::S,"n"::S]$Lisp,["ri"::S,"n"::S]$Lisp_
+        ,["ar"::S,"iar"::S,"n"::S]$Lisp,["ai"::S,"iai"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"iar"::S,"iai"::S,"n"::S,"ifail"::S_
+        ,["intger"::S,"n"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["rr"::S,"ri"::S,"ar"::S,"ai"::S,"ifail"::S]$Lisp,_
+        [([iarArg::Any,iaiArg::Any,nArg::Any,ifailArg::Any,_
+        arArg::Any,aiArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f02akf(iarArg:Integer,iaiArg:Integer,nArg:Integer,_
+        ivrArg:Integer,iviArg:Integer,arArg:Matrix DoubleFloat,_
+        aiArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f02akf",_
+        ["iar"::S,"iai"::S,"n"::S,"ivr"::S,"ivi"::S_
+        ,"ifail"::S,"rr"::S,"ri"::S,"vr"::S,"vi"::S,"ar"::S_
+        ,"ai"::S,"intger"::S]$Lisp,_
+        ["rr"::S,"ri"::S,"vr"::S,"vi"::S,"intger"::S]$Lisp,_
+        [["double"::S,["rr"::S,"n"::S]$Lisp,["ri"::S,"n"::S]$Lisp_
+        ,["vr"::S,"ivr"::S,"n"::S]$Lisp,["vi"::S,"ivi"::S,"n"::S]$Lisp,_
+        ["ar"::S,"iar"::S,"n"::S]$Lisp,["ai"::S,"iai"::S,"n"::S]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"iar"::S,"iai"::S,"n"::S,"ivr"::S_
+        ,"ivi"::S,"ifail"::S,["intger"::S,"n"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["rr"::S,"ri"::S,"vr"::S,"vi"::S,"ar"::S,"ai"::S,"ifail"::S]$Lisp,_
+        [([iarArg::Any,iaiArg::Any,nArg::Any,ivrArg::Any,iviArg::Any,_
+        ifailArg::Any,arArg::Any,aiArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f02awf(iarArg:Integer,iaiArg:Integer,nArg:Integer,_
+        arArg:Matrix DoubleFloat,aiArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f02awf",_
+        ["iar"::S,"iai"::S,"n"::S,"ifail"::S,"r"::S,"ar"::S,"ai"::S,_
+        "wk1"::S,"wk2"::S_
+        ,"wk3"::S]$Lisp,_
+        ["r"::S,"wk1"::S,"wk2"::S,"wk3"::S]$Lisp,_
+        [["double"::S,["r"::S,"n"::S]$Lisp,["ar"::S,"iar"::S,"n"::S]$Lisp_
+        ,["ai"::S,"iai"::S,"n"::S]$Lisp,["wk1"::S,"n"::S]$Lisp,_
+        ["wk2"::S,"n"::S]$Lisp,["wk3"::S,"n"::S]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"iar"::S,"iai"::S,"n"::S,"ifail"::S_
+        ]$Lisp_
+        ]$Lisp,_
+        ["r"::S,"ar"::S,"ai"::S,"ifail"::S]$Lisp,_
+        [([iarArg::Any,iaiArg::Any,nArg::Any,ifailArg::Any,arArg::Any,_
+        aiArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f02axf(arArg:Matrix DoubleFloat,iarArg:Integer,aiArg:Matrix DoubleFloat,_
+        iaiArg:Integer,nArg:Integer,ivrArg:Integer,_
+        iviArg:Integer,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f02axf",_
+        ["iar"::S,"iai"::S,"n"::S,"ivr"::S,"ivi"::S_
+        ,"ifail"::S,"ar"::S,"ai"::S,"r"::S,"vr"::S,"vi"::S_
+        ,"wk1"::S,"wk2"::S,"wk3"::S]$Lisp,_
+        ["r"::S,"vr"::S,"vi"::S,"wk1"::S,"wk2"::S,"wk3"::S]$Lisp,_
+        [["double"::S,["ar"::S,"iar"::S,"n"::S]$Lisp_
+        ,["ai"::S,"iai"::S,"n"::S]$Lisp,["r"::S,"n"::S]$Lisp,_
+        ["vr"::S,"ivr"::S,"n"::S]$Lisp,["vi"::S,"ivi"::S,"n"::S]$Lisp,_
+        ["wk1"::S,"n"::S]$Lisp_
+        ,["wk2"::S,"n"::S]$Lisp,["wk3"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"iar"::S,"iai"::S,"n"::S,"ivr"::S_
+        ,"ivi"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["r"::S,"vr"::S,"vi"::S,"ifail"::S]$Lisp,_
+        [([iarArg::Any,iaiArg::Any,nArg::Any,ivrArg::Any,iviArg::Any,_
+        ifailArg::Any,arArg::Any,aiArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f02bbf(iaArg:Integer,nArg:Integer,albArg:DoubleFloat,_
+        ubArg:DoubleFloat,mArg:Integer,ivArg:Integer,_
+        aArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f02bbf",_
+        ["ia"::S,"n"::S,"alb"::S,"ub"::S,"m"::S_
+        ,"iv"::S,"mm"::S,"ifail"::S,"r"::S,"v"::S,"icount"::S,"a"::S,"d"::S_
+        ,"e"::S,"e2"::S,"x"::S,"g"::S,"c"::S_
+        ]$Lisp,_
+        ["mm"::S,"r"::S,"v"::S,"icount"::S,"d"::S,"e"::S,"e2"::S,"x"::S,_
+        "g"::S,"c"::S]$Lisp,_
+        [["double"::S,"alb"::S,"ub"::S,["r"::S,"m"::S]$Lisp_
+        ,["v"::S,"iv"::S,"m"::S]$Lisp,["a"::S,"ia"::S,"n"::S]$Lisp,_
+        ["d"::S,"n"::S]$Lisp,["e"::S,"n"::S]$Lisp,["e2"::S,"n"::S]$Lisp_
+        ,["x"::S,"n"::S,7$Lisp]$Lisp,["g"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"ia"::S,"n"::S,"m"::S,"iv"::S_
+        ,"mm"::S,["icount"::S,"m"::S]$Lisp,"ifail"::S]$Lisp_
+        ,["logical"::S,["c"::S,"n"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["mm"::S,"r"::S,"v"::S,"icount"::S,"a"::S,"ifail"::S]$Lisp,_
+        [([iaArg::Any,nArg::Any,albArg::Any,ubArg::Any,mArg::Any,_
+        ivArg::Any,ifailArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f02bjf(nArg:Integer,iaArg:Integer,ibArg:Integer,_
+        eps1Arg:DoubleFloat,matvArg:Boolean,ivArg:Integer,_
+        aArg:Matrix DoubleFloat,bArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f02bjf",_
+        ["n"::S,"ia"::S,"ib"::S,"eps1"::S,"matv"::S_
+        ,"iv"::S,"ifail"::S,"alfr"::S,"alfi"::S,"beta"::S,"v"::S,"iter"::S_
+        ,"a"::S,"b"::S]$Lisp,_
+        ["alfr"::S,"alfi"::S,"beta"::S,"v"::S,"iter"::S]$Lisp,_
+        [["double"::S,"eps1"::S,["alfr"::S,"n"::S]$Lisp_
+        ,["alfi"::S,"n"::S]$Lisp,["beta"::S,"n"::S]$Lisp,_
+        ["v"::S,"iv"::S,"n"::S]$Lisp,["a"::S,"ia"::S,"n"::S]$Lisp,_
+        ["b"::S,"ib"::S,"n"::S]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"n"::S,"ia"::S,"ib"::S,"iv"::S_
+        ,["iter"::S,"n"::S]$Lisp,"ifail"::S]$Lisp_
+        ,["logical"::S,"matv"::S]$Lisp_
+        ]$Lisp,_
+        ["alfr"::S,"alfi"::S,"beta"::S,"v"::S,"iter"::S,"a"::S,"b"::S,_
+        "ifail"::S]$Lisp,_
+        [([nArg::Any,iaArg::Any,ibArg::Any,eps1Arg::Any,matvArg::Any,_
+        ivArg::Any,ifailArg::Any,aArg::Any,bArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f02fjf(nArg:Integer,kArg:Integer,tolArg:DoubleFloat,_
+        novecsArg:Integer,nrxArg:Integer,lworkArg:Integer,_
+        lrworkArg:Integer,liworkArg:Integer,mArg:Integer,_
+        noitsArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer,_
+        dotArg:Union(fn:FileName,fp:Asp27(DOT)),_
+        imageArg:Union(fn:FileName,fp:Asp28(IMAGE))): Result == 
+        pushFortranOutputStack(dotFilename := aspFilename "dot")$FOP
+        if dotArg case fn
+                  then outputAsFortran(dotArg.fn)
+                  else outputAsFortran(dotArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(imageFilename := aspFilename "image")$FOP
+        if imageArg case fn
+                  then outputAsFortran(imageArg.fn)
+                  else outputAsFortran(imageArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(monitFilename := aspFilename "monit")$FOP
+        outputAsFortran()$Asp29(MONIT)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([dotFilename,imageFilename,monitFilename]$Lisp,_
+        "f02fjf",_
+        ["n"::S,"k"::S,"tol"::S,"novecs"::S,"nrx"::S_
+        ,"lwork"::S,"lrwork"::S,"liwork"::S,"m"::S,"noits"::S_
+        ,"ifail"::S,"dot"::S,"image"::S,"monit"::S,"d"::S,"x"::S,_
+        "work"::S,"rwork"::S,"iwork"::S_
+        ]$Lisp,_
+        ["d"::S,"work"::S,"rwork"::S,"iwork"::S,"dot"::S,"image"::S,_
+        "monit"::S]$Lisp,_
+        [["double"::S,"tol"::S,["d"::S,"k"::S]$Lisp_
+        ,["x"::S,"nrx"::S,"k"::S]$Lisp,["work"::S,"lwork"::S]$Lisp,_
+        ["rwork"::S,"lrwork"::S]$Lisp,"dot"::S,"image"::S,"monit"::S_
+        ]$Lisp_
+        ,["integer"::S,"n"::S,"k"::S,"novecs"::S,"nrx"::S_
+        ,"lwork"::S,"lrwork"::S,"liwork"::S,"m"::S,"noits"::S,"ifail"::S,_
+        ["iwork"::S,"liwork"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["d"::S,"m"::S,"noits"::S,"x"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,kArg::Any,tolArg::Any,novecsArg::Any,nrxArg::Any,_
+        lworkArg::Any,lrworkArg::Any,liworkArg::Any,mArg::Any,_
+        noitsArg::Any,ifailArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f02fjf(nArg:Integer,kArg:Integer,tolArg:DoubleFloat,_
+        novecsArg:Integer,nrxArg:Integer,lworkArg:Integer,_
+        lrworkArg:Integer,liworkArg:Integer,mArg:Integer,_
+        noitsArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer,_
+        dotArg:Union(fn:FileName,fp:Asp27(DOT)),_
+        imageArg:Union(fn:FileName,fp:Asp28(IMAGE)),_
+        monitArg:FileName): Result == 
+        pushFortranOutputStack(dotFilename := aspFilename "dot")$FOP
+        if dotArg case fn
+                  then outputAsFortran(dotArg.fn)
+                  else outputAsFortran(dotArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(imageFilename := aspFilename "image")$FOP
+        if imageArg case fn
+                  then outputAsFortran(imageArg.fn)
+                  else outputAsFortran(imageArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(monitFilename := aspFilename "monit")$FOP
+        outputAsFortran(monitArg)
+        [(invokeNagman([dotFilename,imageFilename,monitFilename]$Lisp,_
+        "f02fjf",_
+        ["n"::S,"k"::S,"tol"::S,"novecs"::S,"nrx"::S_
+        ,"lwork"::S,"lrwork"::S,"liwork"::S,"m"::S,"noits"::S_
+        ,"ifail"::S,"dot"::S,"image"::S,"monit"::S,"d"::S,"x"::S,_
+        "work"::S,"rwork"::S,"iwork"::S_
+        ]$Lisp,_
+        ["d"::S,"work"::S,"rwork"::S,"iwork"::S,"dot"::S,"image"::S,_
+        "monit"::S]$Lisp,_
+        [["double"::S,"tol"::S,["d"::S,"k"::S]$Lisp_
+        ,["x"::S,"nrx"::S,"k"::S]$Lisp,["work"::S,"lwork"::S]$Lisp,_
+        ["rwork"::S,"lrwork"::S]$Lisp,"dot"::S,"image"::S,"monit"::S_
+        ]$Lisp_
+        ,["integer"::S,"n"::S,"k"::S,"novecs"::S,"nrx"::S_
+        ,"lwork"::S,"lrwork"::S,"liwork"::S,"m"::S,"noits"::S,"ifail"::S,_
+        ["iwork"::S,"liwork"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["d"::S,"m"::S,"noits"::S,"x"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,kArg::Any,tolArg::Any,novecsArg::Any,nrxArg::Any,_
+        lworkArg::Any,lrworkArg::Any,liworkArg::Any,mArg::Any,_
+        noitsArg::Any,ifailArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f02wef(mArg:Integer,nArg:Integer,ldaArg:Integer,_
+        ncolbArg:Integer,ldbArg:Integer,wantqArg:Boolean,_
+        ldqArg:Integer,wantpArg:Boolean,ldptArg:Integer,_
+        aArg:Matrix DoubleFloat,bArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        workLength : Integer :=
+          mArg >= nArg =>
+            wantqArg and wantpArg =>
+              max(max(nArg**2 + 5*(nArg - 1),nArg + ncolbArg),4)
+            wantqArg =>
+              max(max(nArg**2 + 4*(nArg - 1),nArg + ncolbArg),4)
+            wantpArg =>
+              zero? ncolbArg => max(3*(nArg - 1),2)
+              max(5*(nArg - 1),2)
+            zero? ncolbArg => max(2*(nArg - 1),2)
+            max(3*(nArg - 1),2)
+          wantqArg and wantpArg =>
+            max(mArg**2 + 5*(mArg - 1),2)
+          wantqArg =>
+            max(3*(mArg - 1),1)
+          wantpArg =>
+            zero? ncolbArg => max(mArg**2+3*(mArg - 1),2)
+            max(mArg**2+5*(mArg - 1),2)
+          zero? ncolbArg => max(2*(mArg - 1),1)
+          max(3*(mArg - 1),1)
+
+        [(invokeNagman(NIL$Lisp,_
+        "f02wef",_
+        ["m"::S,"n"::S,"lda"::S,"ncolb"::S,"ldb"::S_
+        ,"wantq"::S,"ldq"::S,"wantp"::S,"ldpt"::S,"ifail"::S_
+        ,"q"::S,"sv"::S,"pt"::S,"work"::S,"a"::S_
+        ,"b"::S]$Lisp,_
+        ["q"::S,"sv"::S,"pt"::S,"work"::S]$Lisp,_
+        [["double"::S,["q"::S,"ldq"::S,"m"::S]$Lisp_
+        ,["sv"::S,"m"::S]$Lisp,["pt"::S,"ldpt"::S,"n"::S]$Lisp,_
+        ["work"::S,workLength]$Lisp,["a"::S,"lda"::S,"n"::S]$Lisp,_
+        ["b"::S,"ldb"::S,"ncolb"::S]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"lda"::S,"ncolb"::S_
+        ,"ldb"::S,"ldq"::S,"ldpt"::S,"ifail"::S]$Lisp_
+        ,["logical"::S,"wantq"::S,"wantp"::S]$Lisp_
+        ]$Lisp,_
+        ["q"::S,"sv"::S,"pt"::S,"work"::S,"a"::S,"b"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,nArg::Any,ldaArg::Any,ncolbArg::Any,ldbArg::Any,_
+        wantqArg::Any,ldqArg::Any,wantpArg::Any,ldptArg::Any,_
+        ifailArg::Any,aArg::Any,bArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f02xef(mArg:Integer,nArg:Integer,ldaArg:Integer,_
+        ncolbArg:Integer,ldbArg:Integer,wantqArg:Boolean,_
+        ldqArg:Integer,wantpArg:Boolean,ldphArg:Integer,_
+        aArg:Matrix Complex DoubleFloat,bArg:Matrix Complex DoubleFloat,_
+        ifailArg:Integer): Result == 
+        -- This segment added by hand, to deal with an assumed size array GDN
+        tem : Integer := (min(mArg,nArg)-1)
+        rLen : Integer := 
+          zero? ncolbArg and not wantqArg and not wantpArg => 2*tem
+          zero? ncolbArg and wantpArg and not wantqArg => 3*tem
+          not wantpArg =>
+            ncolbArg >0 or wantqArg => 3*tem
+          5*tem
+        cLen : Integer :=
+          mArg >= nArg =>
+            wantqArg and wantpArg => 2*(nArg + max(nArg**2,ncolbArg))
+            wantqArg and not wantpArg => 2*(nArg + max(nArg**2+nArg,ncolbArg))
+            2*(nArg + max(nArg,ncolbArg))
+          wantpArg => 2*(mArg**2 + mArg)
+          2*mArg          
+        svLength : Integer :=
+          min(mArg,nArg)
+        [(invokeNagman(NIL$Lisp,_
+        "f02xef",_
+        ["m"::S,"n"::S,"lda"::S,"ncolb"::S,"ldb"::S_
+        ,"wantq"::S,"ldq"::S,"wantp"::S,"ldph"::S,"ifail"::S_
+        ,"q"::S,"sv"::S,"ph"::S,"rwork"::S,"a"::S_
+        ,"b"::S,"cwork"::S]$Lisp,_
+        ["q"::S,"sv"::S,"ph"::S,"rwork"::S,"cwork"::S]$Lisp,_
+        [["double"::S,["sv"::S,svLength]$Lisp,["rwork"::S,rLen]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"lda"::S,"ncolb"::S_
+        ,"ldb"::S,"ldq"::S,"ldph"::S,"ifail"::S]$Lisp_
+        ,["logical"::S,"wantq"::S,"wantp"::S]$Lisp_
+        ,["double complex"::S,["q"::S,"ldq"::S,"m"::S]$Lisp,_
+        ["ph"::S,"ldph"::S,"n"::S]$Lisp,["a"::S,"lda"::S,"n"::S]$Lisp,_
+        ["b"::S,"ldb"::S,"ncolb"::S]$Lisp,["cwork"::S,cLen]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["q"::S,"sv"::S,"ph"::S,"rwork"::S,"a"::S,"b"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,nArg::Any,ldaArg::Any,ncolbArg::Any,ldbArg::Any,_
+        wantqArg::Any,ldqArg::Any,wantpArg::Any,ldphArg::Any,_
+        ifailArg::Any,aArg::Any,bArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
 *)
 
 \end{chunk}
@@ -97417,6 +125970,7 @@ NagFittingPackage(): Exports == Implementation where
      ++ e02zaf(px,py,lamda,mu,m,x,y,npoint,nadres,ifail)
      ++ sorts two-dimensional data into rectangular panels.
      ++ See \downlink{Manual Page}{manpageXXe02zaf}.
+
   Implementation ==> add
 
     import Lisp
@@ -97862,6 +126416,445 @@ NagFittingPackage(): Exports == Implementation where
 \begin{chunk}{COQ NAGE02}
 (* package NAGE02 *)
 (*
+
+    import Lisp
+    import DoubleFloat
+    import Any
+    import Record
+    import Integer
+    import Matrix DoubleFloat
+    import Boolean
+    import NAGLinkSupportPackage
+    import AnyFunctions1(Integer)
+    import AnyFunctions1(Matrix DoubleFloat)
+    import AnyFunctions1(DoubleFloat)
+    import AnyFunctions1(Matrix Integer)
+    import AnyFunctions1(String)
+
+
+    e02adf(mArg:Integer,kplus1Arg:Integer,nrowsArg:Integer,_
+        xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_
+        wArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02adf",_
+        ["m"::S,"kplus1"::S,"nrows"::S,"ifail"::S,"x"::S,"y"::S,_
+        "w"::S,"a"::S,"s"::S_
+        ,"work1"::S,"work2"::S]$Lisp,_
+        ["a"::S,"s"::S,"work1"::S,"work2"::S]$Lisp,_
+        [["double"::S,["x"::S,"m"::S]$Lisp,["y"::S,"m"::S]$Lisp_
+        ,["w"::S,"m"::S]$Lisp,["a"::S,"nrows"::S,"kplus1"::S]$Lisp,_
+        ["s"::S,"kplus1"::S]$Lisp,["work1"::S,_
+        ["*"::S,3$Lisp,"m"::S]$Lisp]$Lisp_
+        ,["work2"::S,["*"::S,2$Lisp,"kplus1"::S]$Lisp]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,"kplus1"::S,"nrows"::S_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["a"::S,"s"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,kplus1Arg::Any,nrowsArg::Any,ifailArg::Any,_
+        xArg::Any,yArg::Any,wArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02aef(nplus1Arg:Integer,aArg:Matrix DoubleFloat,xcapArg:DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02aef",_
+        ["nplus1"::S,"xcap"::S,"p"::S,"ifail"::S,"a"::S]$Lisp,_
+        ["p"::S]$Lisp,_
+        [["double"::S,["a"::S,"nplus1"::S]$Lisp,"xcap"::S_
+        ,"p"::S]$Lisp_
+        ,["integer"::S,"nplus1"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["p"::S,"ifail"::S]$Lisp,_
+        [([nplus1Arg::Any,xcapArg::Any,ifailArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02agf(mArg:Integer,kplus1Arg:Integer,nrowsArg:Integer,_
+        xminArg:DoubleFloat,xmaxArg:DoubleFloat,xArg:Matrix DoubleFloat,_
+        yArg:Matrix DoubleFloat,wArg:Matrix DoubleFloat,mfArg:Integer,_
+        xfArg:Matrix DoubleFloat,yfArg:Matrix DoubleFloat,lyfArg:Integer,_
+        ipArg:Matrix Integer,lwrkArg:Integer,liwrkArg:Integer,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02agf",_
+        ["m"::S,"kplus1"::S,"nrows"::S,"xmin"::S,"xmax"::S_
+        ,"mf"::S,"lyf"::S,"lwrk"::S,"liwrk"::S,"np1"::S_
+        ,"ifail"::S,"x"::S,"y"::S,"w"::S,"xf"::S,"yf"::S_
+        ,"ip"::S,"a"::S,"s"::S,"wrk"::S,"iwrk"::S_
+        ]$Lisp,_
+        ["a"::S,"s"::S,"np1"::S,"wrk"::S,"iwrk"::S]$Lisp,_
+        [["double"::S,"xmin"::S,"xmax"::S,["x"::S,"m"::S]$Lisp_
+        ,["y"::S,"m"::S]$Lisp,["w"::S,"m"::S]$Lisp,["xf"::S,"mf"::S]$Lisp,_
+        ["yf"::S,"lyf"::S]$Lisp,["a"::S,"nrows"::S,"kplus1"::S]$Lisp_
+        ,["s"::S,"kplus1"::S]$Lisp,["wrk"::S,"lwrk"::S]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,"kplus1"::S,"nrows"::S_
+        ,"mf"::S,"lyf"::S,["ip"::S,"mf"::S]$Lisp,"lwrk"::S,"liwrk"::S,_
+        "np1"::S,"ifail"::S,["iwrk"::S,"liwrk"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["a"::S,"s"::S,"np1"::S,"wrk"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,kplus1Arg::Any,nrowsArg::Any,xminArg::Any,_
+        xmaxArg::Any,mfArg::Any,lyfArg::Any,lwrkArg::Any,liwrkArg::Any,_
+        ifailArg::Any,xArg::Any,yArg::Any,wArg::Any,xfArg::Any,_
+        yfArg::Any,ipArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02ahf(np1Arg:Integer,xminArg:DoubleFloat,xmaxArg:DoubleFloat,_
+        aArg:Matrix DoubleFloat,ia1Arg:Integer,laArg:Integer,_
+        iadif1Arg:Integer,ladifArg:Integer,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02ahf",_
+        ["np1"::S,"xmin"::S,"xmax"::S,"ia1"::S,"la"::S_
+        ,"iadif1"::S,"ladif"::S,"patm1"::S,"ifail"::S,"a"::S,"adif"::S]$Lisp,_
+        ["patm1"::S,"adif"::S]$Lisp,_
+        [["double"::S,"xmin"::S,"xmax"::S,["a"::S,"la"::S]$Lisp_
+        ,"patm1"::S,["adif"::S,"ladif"::S]$Lisp]$Lisp_
+        ,["integer"::S,"np1"::S,"ia1"::S,"la"::S,"iadif1"::S_
+        ,"ladif"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["patm1"::S,"adif"::S,"ifail"::S]$Lisp,_
+        [([np1Arg::Any,xminArg::Any,xmaxArg::Any,ia1Arg::Any,laArg::Any,_
+        iadif1Arg::Any,ladifArg::Any,ifailArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02ajf(np1Arg:Integer,xminArg:DoubleFloat,xmaxArg:DoubleFloat,_
+        aArg:Matrix DoubleFloat,ia1Arg:Integer,laArg:Integer,_
+        qatm1Arg:DoubleFloat,iaint1Arg:Integer,laintArg:Integer,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02ajf",_
+        ["np1"::S,"xmin"::S,"xmax"::S,"ia1"::S,"la"::S_
+        ,"qatm1"::S,"iaint1"::S,"laint"::S,"ifail"::S,"a"::S,"aint"::S]$Lisp,_
+        ["aint"::S]$Lisp,_
+        [["double"::S,"xmin"::S,"xmax"::S,["a"::S,"la"::S]$Lisp_
+        ,"qatm1"::S,["aint"::S,"laint"::S]$Lisp]$Lisp_
+        ,["integer"::S,"np1"::S,"ia1"::S,"la"::S,"iaint1"::S_
+        ,"laint"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["aint"::S,"ifail"::S]$Lisp,_
+        [([np1Arg::Any,xminArg::Any,xmaxArg::Any,ia1Arg::Any,laArg::Any,_
+        qatm1Arg::Any,iaint1Arg::Any,laintArg::Any,ifailArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02akf(np1Arg:Integer,xminArg:DoubleFloat,xmaxArg:DoubleFloat,_
+        aArg:Matrix DoubleFloat,ia1Arg:Integer,laArg:Integer,_
+        xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02akf",_
+        ["np1"::S,"xmin"::S,"xmax"::S,"ia1"::S,"la"::S_
+        ,"x"::S,"result"::S,"ifail"::S,"a"::S]$Lisp,_
+        ["result"::S]$Lisp,_
+        [["double"::S,"xmin"::S,"xmax"::S,["a"::S,"la"::S]$Lisp_
+        ,"x"::S,"result"::S]$Lisp_
+        ,["integer"::S,"np1"::S,"ia1"::S,"la"::S,"ifail"::S_
+        ]$Lisp_
+        ]$Lisp,_
+        ["result"::S,"ifail"::S]$Lisp,_
+        [([np1Arg::Any,xminArg::Any,xmaxArg::Any,ia1Arg::Any,laArg::Any,_
+        xArg::Any,ifailArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02baf(mArg:Integer,ncap7Arg:Integer,xArg:Matrix DoubleFloat,_
+        yArg:Matrix DoubleFloat,wArg:Matrix DoubleFloat,_
+        lamdaArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02baf",_
+        ["m"::S,"ncap7"::S,"ss"::S,"ifail"::S,"x"::S,"y"::S,"w"::S,_
+        "c"::S,"lamda"::S_
+        ,"work1"::S,"work2"::S]$Lisp,_
+        ["c"::S,"ss"::S,"work1"::S,"work2"::S]$Lisp,_
+        [["double"::S,["x"::S,"m"::S]$Lisp,["y"::S,"m"::S]$Lisp_
+        ,["w"::S,"m"::S]$Lisp,["c"::S,"ncap7"::S]$Lisp,"ss"::S,_
+        ["lamda"::S,"ncap7"::S]$Lisp,["work1"::S,"m"::S]$Lisp_
+        ,["work2"::S,["*"::S,4$Lisp,"ncap7"::S]$Lisp]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,"ncap7"::S,"ifail"::S_
+        ]$Lisp_
+        ]$Lisp,_
+        ["c"::S,"ss"::S,"lamda"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,ncap7Arg::Any,ifailArg::Any,xArg::Any,yArg::Any,_
+        wArg::Any,lamdaArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02bbf(ncap7Arg:Integer,lamdaArg:Matrix DoubleFloat,_
+        cArg:Matrix DoubleFloat,xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02bbf",_
+        ["ncap7"::S,"x"::S,"s"::S,"ifail"::S,"lamda"::S,"c"::S]$Lisp,_
+        ["s"::S]$Lisp,_
+        [["double"::S,["lamda"::S,"ncap7"::S]$Lisp_
+        ,["c"::S,"ncap7"::S]$Lisp,"x"::S,"s"::S]$Lisp_
+        ,["integer"::S,"ncap7"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s"::S,"ifail"::S]$Lisp,_
+        [([ncap7Arg::Any,xArg::Any,ifailArg::Any,lamdaArg::Any,cArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02bcf(ncap7Arg:Integer,lamdaArg:Matrix DoubleFloat,_
+        cArg:Matrix DoubleFloat,_
+        xArg:DoubleFloat,leftArg:Integer,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02bcf",_
+        ["ncap7"::S,"x"::S,"left"::S,"ifail"::S,"lamda"::S,_
+        "c"::S,"s"::S]$Lisp,_
+        ["s"::S]$Lisp,_
+        [["double"::S,["lamda"::S,"ncap7"::S]$Lisp_
+        ,["c"::S,"ncap7"::S]$Lisp,"x"::S,["s"::S,4$Lisp]$Lisp]$Lisp_
+        ,["integer"::S,"ncap7"::S,"left"::S,"ifail"::S_
+        ]$Lisp_
+        ]$Lisp,_
+        ["s"::S,"ifail"::S]$Lisp,_
+        [([ncap7Arg::Any,xArg::Any,leftArg::Any,ifailArg::Any,_
+        lamdaArg::Any,cArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02bdf(ncap7Arg:Integer,lamdaArg:Matrix DoubleFloat,_
+        cArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02bdf",_
+        ["ncap7"::S,"defint"::S,"ifail"::S,"lamda"::S,"c"::S]$Lisp,_
+        ["defint"::S]$Lisp,_
+        [["double"::S,["lamda"::S,"ncap7"::S]$Lisp_
+        ,["c"::S,"ncap7"::S]$Lisp,"defint"::S]$Lisp_
+        ,["integer"::S,"ncap7"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["defint"::S,"ifail"::S]$Lisp,_
+        [([ncap7Arg::Any,ifailArg::Any,lamdaArg::Any,cArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02bef(startArg:String,mArg:Integer,xArg:Matrix DoubleFloat,_
+        yArg:Matrix DoubleFloat,wArg:Matrix DoubleFloat,sArg:DoubleFloat,_
+        nestArg:Integer,lwrkArg:Integer,nArg:Integer,_
+        lamdaArg:Matrix DoubleFloat,ifailArg:Integer,_
+        wrkArg:Matrix DoubleFloat,_
+        iwrkArg:Matrix Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02bef",_
+        ["start"::S,"m"::S,"s"::S,"nest"::S,"lwrk"::S_
+        ,"fp"::S,"n"::S,"ifail"::S,"x"::S,"y"::S,"w"::S,"c"::S,"lamda"::S_
+        ,"wrk"::S,"iwrk"::S]$Lisp,_
+        ["c"::S,"fp"::S]$Lisp,_
+        [["double"::S,["x"::S,"m"::S]$Lisp,["y"::S,"m"::S]$Lisp_
+        ,["w"::S,"m"::S]$Lisp,"s"::S,["c"::S,"nest"::S]$Lisp,_
+        "fp"::S,["lamda"::S,"nest"::S]$Lisp,["wrk"::S,"lwrk"::S]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"m"::S,"nest"::S,"lwrk"::S,"n"::S_
+        ,"ifail"::S,["iwrk"::S,"nest"::S]$Lisp]$Lisp_
+        ,["character"::S,"start"::S]$Lisp_
+        ]$Lisp,_
+        ["c"::S,"fp"::S,"n"::S,"lamda"::S,"ifail"::S,"wrk"::S,"iwrk"::S]$Lisp,_
+        [([startArg::Any,mArg::Any,sArg::Any,nestArg::Any,lwrkArg::Any,_
+        nArg::Any,ifailArg::Any,xArg::Any,yArg::Any,wArg::Any,_
+        lamdaArg::Any,wrkArg::Any,iwrkArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02daf(mArg:Integer,pxArg:Integer,pyArg:Integer,_
+        xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_
+        fArg:Matrix DoubleFloat,_
+        wArg:Matrix DoubleFloat,muArg:Matrix DoubleFloat,_
+        pointArg:Matrix Integer,_
+        npointArg:Integer,ncArg:Integer,nwsArg:Integer,_
+        epsArg:DoubleFloat,lamdaArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02daf",_
+        ["m"::S,"px"::S,"py"::S,"npoint"::S,"nc"::S_
+        ,"nws"::S,"eps"::S,"sigma"::S,"rank"::S,"ifail"::S_
+        ,"x"::S,"y"::S,"f"::S,"w"::S,"mu"::S_
+        ,"point"::S,"dl"::S,"c"::S,"lamda"::S,"ws"::S_
+        ]$Lisp,_
+        ["dl"::S,"c"::S,"sigma"::S,"rank"::S,"ws"::S]$Lisp,_
+        [["double"::S,["x"::S,"m"::S]$Lisp,["y"::S,"m"::S]$Lisp_
+        ,["f"::S,"m"::S]$Lisp,["w"::S,"m"::S]$Lisp,_
+        ["mu"::S,"py"::S]$Lisp,"eps"::S,["dl"::S,"nc"::S]$Lisp,_
+        ["c"::S,"nc"::S]$Lisp_
+        ,"sigma"::S,["lamda"::S,"px"::S]$Lisp,["ws"::S,"nws"::S]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,"px"::S,"py"::S,["point"::S,"npoint"::S]$Lisp_
+        ,"npoint"::S,"nc"::S,"nws"::S,"rank"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["dl"::S,"c"::S,"sigma"::S,"rank"::S,"lamda"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,pxArg::Any,pyArg::Any,npointArg::Any,ncArg::Any,_
+        nwsArg::Any,epsArg::Any,ifailArg::Any,xArg::Any,yArg::Any,_
+        fArg::Any,wArg::Any,muArg::Any,pointArg::Any,lamdaArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02dcf(startArg:String,mxArg:Integer,xArg:Matrix DoubleFloat,_
+        myArg:Integer,yArg:Matrix DoubleFloat,fArg:Matrix DoubleFloat,_
+        sArg:DoubleFloat,nxestArg:Integer,nyestArg:Integer,_
+        lwrkArg:Integer,liwrkArg:Integer,nxArg:Integer,_
+        lamdaArg:Matrix DoubleFloat,nyArg:Integer,muArg:Matrix DoubleFloat,_
+        wrkArg:Matrix DoubleFloat,iwrkArg:Matrix Integer,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02dcf",_
+        ["start"::S,"mx"::S,"my"::S,"s"::S,"nxest"::S_
+        ,"nyest"::S,"lwrk"::S,"liwrk"::S,"fp"::S,"nx"::S_
+        ,"ny"::S,"ifail"::S,"x"::S,"y"::S,"f"::S,"c"::S,"lamda"::S_
+        ,"mu"::S,"wrk"::S,"iwrk"::S]$Lisp,_
+        ["c"::S,"fp"::S]$Lisp,_
+        [["double"::S,["x"::S,"mx"::S]$Lisp,["y"::S,"my"::S]$Lisp_
+        ,["f"::S,["*"::S,"mx"::S,"my"::S]$Lisp]$Lisp,"s"::S,_
+        ["c"::S,["*"::S,["-"::S,"nxest"::S,4$Lisp]$Lisp,_
+        ["-"::S,"nyest"::S,4$Lisp]$Lisp]$Lisp]$Lisp_
+        ,"fp"::S,["lamda"::S,"nxest"::S]$Lisp,_
+        ["mu"::S,"nyest"::S]$Lisp,["wrk"::S,"lwrk"::S]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"mx"::S,"my"::S,"nxest"::S,"nyest"::S_
+        ,"lwrk"::S,"liwrk"::S,"nx"::S,"ny"::S,["iwrk"::S,"liwrk"::S]$Lisp,_
+        "ifail"::S]$Lisp_
+        ,["character"::S,"start"::S]$Lisp_
+        ]$Lisp,_
+        ["c"::S,"fp"::S,"nx"::S,"lamda"::S,"ny"::S,"mu"::S,"wrk"::S,_
+        "iwrk"::S,"ifail"::S]$Lisp,_
+        [([startArg::Any,mxArg::Any,myArg::Any,sArg::Any,nxestArg::Any,_
+        nyestArg::Any,lwrkArg::Any,liwrkArg::Any,nxArg::Any,nyArg::Any,_
+        ifailArg::Any,xArg::Any,yArg::Any,fArg::Any,lamdaArg::Any,_
+        muArg::Any,wrkArg::Any,iwrkArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02ddf(startArg:String,mArg:Integer,xArg:Matrix DoubleFloat,_
+        yArg:Matrix DoubleFloat,fArg:Matrix DoubleFloat,_
+        wArg:Matrix DoubleFloat,_
+        sArg:DoubleFloat,nxestArg:Integer,nyestArg:Integer,_
+        lwrkArg:Integer,liwrkArg:Integer,nxArg:Integer,_
+        lamdaArg:Matrix DoubleFloat,nyArg:Integer,muArg:Matrix DoubleFloat,_
+        wrkArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02ddf",_
+        ["start"::S,"m"::S,"s"::S,"nxest"::S,"nyest"::S_
+        ,"lwrk"::S,"liwrk"::S,"fp"::S,"rank"::S,"nx"::S_
+        ,"ny"::S,"ifail"::S,"x"::S,"y"::S,"f"::S,"w"::S,"c"::S_
+        ,"iwrk"::S,"lamda"::S,"mu"::S,"wrk"::S]$Lisp,_
+        ["c"::S,"fp"::S,"rank"::S,"iwrk"::S]$Lisp,_
+        [["double"::S,["x"::S,"m"::S]$Lisp,["y"::S,"m"::S]$Lisp_
+        ,["f"::S,"m"::S]$Lisp,["w"::S,"m"::S]$Lisp,"s"::S,_
+        ["c"::S,["*"::S,["-"::S,"nxest"::S,4$Lisp]$Lisp,_
+        ["-"::S,"nyest"::S,4$Lisp]$Lisp]$Lisp]$Lisp_
+        ,"fp"::S,["lamda"::S,"nxest"::S]$Lisp,["mu"::S,"nyest"::S]$Lisp,_
+        ["wrk"::S,"lwrk"::S]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"m"::S,"nxest"::S,"nyest"::S_
+        ,"lwrk"::S,"liwrk"::S,"rank"::S,["iwrk"::S,"liwrk"::S]$Lisp,_
+        "nx"::S,"ny"::S,"ifail"::S]$Lisp_
+        ,["character"::S,"start"::S]$Lisp_
+        ]$Lisp,_
+        ["c"::S,"fp"::S,"rank"::S,"iwrk"::S,"nx"::S,"lamda"::S,"ny"::S,_
+        "mu"::S,"wrk"::S,"ifail"::S]$Lisp,_
+        [([startArg::Any,mArg::Any,sArg::Any,nxestArg::Any,nyestArg::Any,_
+        lwrkArg::Any,liwrkArg::Any,nxArg::Any,nyArg::Any,ifailArg::Any,_
+        xArg::Any,yArg::Any,fArg::Any,wArg::Any,lamdaArg::Any,muArg::Any,_
+        wrkArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02def(mArg:Integer,pxArg:Integer,pyArg:Integer,_
+        xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_
+        lamdaArg:Matrix DoubleFloat,_
+        muArg:Matrix DoubleFloat,cArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02def",_
+        ["m"::S,"px"::S,"py"::S,"ifail"::S,"x"::S,"y"::S,"lamda"::S,_
+         "mu"::S,"c"::S_
+        ,"ff"::S,"wrk"::S,"iwrk"::S]$Lisp,_
+        ["ff"::S,"wrk"::S,"iwrk"::S]$Lisp,_
+        [["double"::S,["x"::S,"m"::S]$Lisp,["y"::S,"m"::S]$Lisp_
+        ,["lamda"::S,"px"::S]$Lisp,["mu"::S,"py"::S]$Lisp,_
+        ["c"::S,["*"::S,["-"::S,"px"::S,4$Lisp]$Lisp,_
+        ["-"::S,"py"::S,4$Lisp]$Lisp]$Lisp]$Lisp_
+        ,["ff"::S,"m"::S]$Lisp,["wrk"::S,_
+        ["-"::S,"py"::S,4$Lisp]$Lisp]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,"px"::S,"py"::S,"ifail"::S_
+        ,["iwrk"::S,["-"::S,"py"::S,4$Lisp]$Lisp]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["ff"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,pxArg::Any,pyArg::Any,ifailArg::Any,xArg::Any,_
+        yArg::Any,lamdaArg::Any,muArg::Any,cArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02dff(mxArg:Integer,myArg:Integer,pxArg:Integer,_
+        pyArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_
+        lamdaArg:Matrix DoubleFloat,muArg:Matrix DoubleFloat,_
+        cArg:Matrix DoubleFloat,_
+        lwrkArg:Integer,liwrkArg:Integer,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02dff",_
+        ["mx"::S,"my"::S,"px"::S,"py"::S,"lwrk"::S_
+        ,"liwrk"::S,"ifail"::S,"x"::S,"y"::S,"lamda"::S,"mu"::S,"c"::S_
+        ,"ff"::S,"wrk"::S,"iwrk"::S]$Lisp,_
+        ["ff"::S,"wrk"::S,"iwrk"::S]$Lisp,_
+        [["double"::S,["x"::S,"mx"::S]$Lisp,["y"::S,"my"::S]$Lisp_
+        ,["lamda"::S,"px"::S]$Lisp,["mu"::S,"py"::S]$Lisp,_
+        ["c"::S,["*"::S,["-"::S,"px"::S,4$Lisp]$Lisp,_
+        ["-"::S,"py"::S,4$Lisp]$Lisp]$Lisp]$Lisp_
+        ,["ff"::S,["*"::S,"mx"::S,"my"::S]$Lisp]$Lisp,_
+        ["wrk"::S,"lwrk"::S]$Lisp]$Lisp_
+        ,["integer"::S,"mx"::S,"my"::S,"px"::S,"py"::S_
+        ,"lwrk"::S,"liwrk"::S,"ifail"::S,["iwrk"::S,"liwrk"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["ff"::S,"ifail"::S]$Lisp,_
+        [([mxArg::Any,myArg::Any,pxArg::Any,pyArg::Any,lwrkArg::Any,_
+        liwrkArg::Any,ifailArg::Any,xArg::Any,yArg::Any,lamdaArg::Any,_
+        muArg::Any,cArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02gaf(mArg:Integer,laArg:Integer,nplus2Arg:Integer,_
+        tolerArg:DoubleFloat,aArg:Matrix DoubleFloat,bArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02gaf",_
+        ["m"::S,"la"::S,"nplus2"::S,"toler"::S,"resid"::S,
+        "irank"::S,"iter"::S,"ifail"::S,"x"::S,"a"::S,"b"::S,"iwork"::S]$Lisp,_
+        ["x"::S,"resid"::S,"irank"::S,"iter"::S,"iwork"::S]$Lisp,_
+        [["double"::S,"toler"::S,["x"::S,"nplus2"::S]$Lisp,
+        "resid"::S,["a"::S,"la"::S,"nplus2"::S]$Lisp,_
+        ["b"::S,"m"::S]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,"la"::S,"nplus2"::S,"irank"::S_
+        ,"iter"::S,"ifail"::S,["iwork"::S,"m"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["x"::S,"resid"::S,"irank"::S,"iter"::S,"a"::S,"b"::S,_
+        "ifail"::S]$Lisp,_
+        [([mArg::Any,laArg::Any,nplus2Arg::Any,tolerArg::Any,_
+        ifailArg::Any,aArg::Any,bArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e02zaf(pxArg:Integer,pyArg:Integer,lamdaArg:Matrix DoubleFloat,_
+        muArg:Matrix DoubleFloat,mArg:Integer,xArg:Matrix DoubleFloat,_
+        yArg:Matrix DoubleFloat,npointArg:Integer,nadresArg:Integer,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e02zaf",_
+        ["px"::S,"py"::S,"m"::S,"npoint"::S,"nadres"::S_
+        ,"ifail"::S,"lamda"::S,"mu"::S,"x"::S,"y"::S,"point"::S_
+        ,"adres"::S]$Lisp,_
+        ["point"::S,"adres"::S]$Lisp,_
+        [["double"::S,["lamda"::S,"px"::S]$Lisp,["mu"::S,"py"::S]$Lisp_
+        ,["x"::S,"m"::S]$Lisp,["y"::S,"m"::S]$Lisp]$Lisp_
+        ,["integer"::S,"px"::S,"py"::S,"m"::S,"npoint"::S_
+        ,"nadres"::S,["point"::S,"npoint"::S]$Lisp,"ifail"::S,_
+        ["adres"::S,"nadres"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["point"::S,"ifail"::S]$Lisp,_
+        [([pxArg::Any,pyArg::Any,mArg::Any,npointArg::Any,nadresArg::Any,_
+        ifailArg::Any,lamdaArg::Any,muArg::Any,xArg::Any,yArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
 *)
 
 \end{chunk}
@@ -102808,6 +131801,7 @@ NagLinearEquationSolvingPackage(): Exports == Implementation where
      ++ squares problems and sparse damped linear least-squares problems,
      ++ using a Lanczos algorithm.
      ++ See \downlink{Manual Page}{manpageXXf04qaf}.
+
   Implementation ==> add
 
     import Lisp
@@ -103097,6 +132091,289 @@ NagLinearEquationSolvingPackage(): Exports == Implementation where
 \begin{chunk}{COQ NAGF04}
 (* package NAGF04 *)
 (*
+
+    import Lisp
+    import DoubleFloat
+    import Any
+    import Record
+    import Integer
+    import Matrix DoubleFloat
+    import Boolean
+    import NAGLinkSupportPackage
+    import FortranPackage
+    import AnyFunctions1(Integer)
+    import AnyFunctions1(DoubleFloat)
+    import AnyFunctions1(Boolean)
+    import AnyFunctions1(Matrix Complex DoubleFloat)
+    import AnyFunctions1(Matrix DoubleFloat)
+    import AnyFunctions1(Matrix Integer)
+
+
+    f04adf(iaArg:Integer,bArg:Matrix Complex DoubleFloat,ibArg:Integer,_
+        nArg:Integer,mArg:Integer,icArg:Integer,_
+        aArg:Matrix Complex DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f04adf",_
+        ["ia"::S,"ib"::S,"n"::S,"m"::S,"ic"::S_
+        ,"ifail"::S,"b"::S,"c"::S,"a"::S,"wkspce"::S]$Lisp,_
+        ["c"::S,"wkspce"::S]$Lisp,_
+        [["double"::S,["wkspce"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"ia"::S,"ib"::S,"n"::S,"m"::S_
+        ,"ic"::S,"ifail"::S]$Lisp_
+        ,["double complex"::S,["b"::S,"ib"::S,"m"::S]$Lisp,_
+        ["c"::S,"ic"::S,"m"::S]$Lisp,["a"::S,"ia"::S,"n"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["c"::S,"a"::S,"ifail"::S]$Lisp,_
+        [([iaArg::Any,ibArg::Any,nArg::Any,mArg::Any,icArg::Any,_
+        ifailArg::Any,bArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f04arf(iaArg:Integer,bArg:Matrix DoubleFloat,nArg:Integer,_
+        aArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f04arf",_
+        ["ia"::S,"n"::S,"ifail"::S,"b"::S,"c"::S,"a"::S,"wkspce"::S]$Lisp,_
+        ["c"::S,"wkspce"::S]$Lisp,_
+        [["double"::S,["b"::S,"n"::S]$Lisp,["c"::S,"n"::S]$Lisp_
+        ,["a"::S,"ia"::S,"n"::S]$Lisp,["wkspce"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"ia"::S,"n"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["c"::S,"a"::S,"ifail"::S]$Lisp,_
+        [([iaArg::Any,nArg::Any,ifailArg::Any,bArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f04asf(iaArg:Integer,bArg:Matrix DoubleFloat,nArg:Integer,_
+        aArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f04asf",_
+        ["ia"::S,"n"::S,"ifail"::S,"b"::S,"c"::S,"a"::S,"wk1"::S,"wk2"::S_
+        ]$Lisp,_
+        ["c"::S,"wk1"::S,"wk2"::S]$Lisp,_
+        [["double"::S,["b"::S,"n"::S]$Lisp,["c"::S,"n"::S]$Lisp,_
+        ["a"::S,"ia"::S,"n"::S]$Lisp,["wk1"::S,"n"::S]$Lisp,_
+        ["wk2"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"ia"::S,"n"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["c"::S,"a"::S,"ifail"::S]$Lisp,_
+        [([iaArg::Any,nArg::Any,ifailArg::Any,bArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f04atf(aArg:Matrix DoubleFloat,iaArg:Integer,bArg:Matrix DoubleFloat,_
+        nArg:Integer,iaaArg:Integer,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f04atf",_
+        ["ia"::S,"n"::S,"iaa"::S,"ifail"::S,"a"::S,"b"::S,"c"::S,_
+        "aa"::S,"wks1"::S,"wks2"::S]$Lisp,_
+        ["c"::S,"aa"::S,"wks1"::S,"wks2"::S]$Lisp,_
+        [["double"::S,["a"::S,"ia"::S,"n"::S]$Lisp_
+        ,["b"::S,"n"::S]$Lisp,["c"::S,"n"::S]$Lisp,_
+        ["aa"::S,"iaa"::S,"n"::S]$Lisp,["wks1"::S,"n"::S]$Lisp,_
+        ["wks2"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"ia"::S,"n"::S,"iaa"::S,"ifail"::S]$Lisp]$Lisp,_
+        ["c"::S,"aa"::S,"ifail"::S]$Lisp,_
+        [([iaArg::Any,nArg::Any,iaaArg::Any,ifailArg::Any,_
+        aArg::Any,bArg::Any])@List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f04axf(nArg:Integer,aArg:Matrix DoubleFloat,licnArg:Integer,_
+        icnArg:Matrix Integer,ikeepArg:Matrix Integer,mtypeArg:Integer,_
+        idispArg:Matrix Integer,rhsArg:Matrix DoubleFloat): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f04axf",_
+        ["n"::S,"licn"::S,"mtype"::S,"resid"::S,"a"::S,"icn"::S,_
+        "ikeep"::S,"idisp"::S,"rhs"::S,"w"::S]$Lisp,_
+        ["resid"::S,"w"::S]$Lisp,_
+        [["double"::S,["a"::S,"licn"::S]$Lisp,"resid"::S_
+        ,["rhs"::S,"n"::S]$Lisp,["w"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"licn"::S,["icn"::S,"licn"::S]$Lisp_
+        ,["ikeep"::S,["*"::S,"n"::S,5$Lisp]$Lisp]$Lisp,_
+        "mtype"::S,["idisp"::S,2$Lisp]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["resid"::S,"rhs"::S]$Lisp,_
+        [([nArg::Any,licnArg::Any,mtypeArg::Any,aArg::Any,icnArg::Any,_
+        ikeepArg::Any,idispArg::Any,rhsArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f04faf(jobArg:Integer,nArg:Integer,dArg:Matrix DoubleFloat,_
+        eArg:Matrix DoubleFloat,bArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f04faf",_
+        ["job"::S,"n"::S,"ifail"::S,"d"::S,"e"::S,"b"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,["d"::S,"n"::S]$Lisp,["e"::S,"n"::S]$Lisp_
+        ,["b"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"job"::S,"n"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["d"::S,"e"::S,"b"::S,"ifail"::S]$Lisp,_
+        [([jobArg::Any,nArg::Any,ifailArg::Any,dArg::Any,eArg::Any,bArg::Any])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f04jgf(mArg:Integer,nArg:Integer,nraArg:Integer,_
+        tolArg:DoubleFloat,lworkArg:Integer,aArg:Matrix DoubleFloat,_
+        bArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f04jgf",_
+        ["m"::S,"n"::S,"nra"::S,"tol"::S,"lwork"::S_
+        ,"svd"::S,"sigma"::S,"irank"::S,"ifail"::S,"work"::S,_
+        "a"::S,"b"::S]$Lisp,_
+        ["svd"::S,"sigma"::S,"irank"::S,"work"::S]$Lisp,_
+        [["double"::S,"tol"::S,"sigma"::S,["work"::S,"lwork"::S]$Lisp_
+        ,["a"::S,"nra"::S,"n"::S]$Lisp,["b"::S,"m"::S]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"nra"::S,"lwork"::S_
+        ,"irank"::S,"ifail"::S]$Lisp_
+        ,["logical"::S,"svd"::S]$Lisp_
+        ]$Lisp,_
+        ["svd"::S,"sigma"::S,"irank"::S,"work"::S,"a"::S,_
+        "b"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,nArg::Any,nraArg::Any,tolArg::Any,lworkArg::Any,_
+        ifailArg::Any,aArg::Any,bArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f04maf(nArg:Integer,nzArg:Integer,avalsArg:Matrix DoubleFloat,_
+        licnArg:Integer,irnArg:Matrix Integer,lirnArg:Integer,_
+        icnArg:Matrix Integer,wkeepArg:Matrix DoubleFloat,_
+        ikeepArg:Matrix Integer,_
+        informArg:Matrix Integer,bArg:Matrix DoubleFloat,_
+        accArg:Matrix DoubleFloat,_
+        noitsArg:Matrix Integer,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,"f04maf",_
+        ["n"::S,"nz"::S,"licn"::S,"lirn"::S,"ifail"::S_
+        ,"avals"::S,"irn"::S,"icn"::S,"wkeep"::S,"ikeep"::S_
+        ,"inform"::S,"work"::S,"b"::S,"acc"::S,"noits"::S]$Lisp,_
+        ["work"::S]$Lisp,_
+        [["double"::S,["avals"::S,"licn"::S]$Lisp,_
+        ["wkeep"::S,["*"::S,3$Lisp,"n"::S]$Lisp]$Lisp_
+        ,["work"::S,["*"::S,3$Lisp,"n"::S]$Lisp]$Lisp,_
+        ["b"::S,"n"::S]$Lisp,["acc"::S,2$Lisp]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"n"::S,"nz"::S,"licn"::S,["irn"::S,"lirn"::S]$Lisp_
+        ,"lirn"::S,["icn"::S,"licn"::S]$Lisp,["ikeep"::S,_
+        ["*"::S,2$Lisp,"n"::S]$Lisp]$Lisp,["inform"::S,4$Lisp]$Lisp_
+        ,["noits"::S,2$Lisp]$Lisp,"ifail"::S]$Lisp]$Lisp,_
+        ["work"::S,"b"::S,"acc"::S,"noits"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,nzArg::Any,licnArg::Any,lirnArg::Any,_
+        ifailArg::Any,avalsArg::Any,irnArg::Any,icnArg::Any,wkeepArg::Any,_
+        ikeepArg::Any,informArg::Any,bArg::Any,accArg::Any,noitsArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f04mbf(nArg:Integer,bArg:Matrix DoubleFloat,preconArg:Boolean,_
+        shiftArg:DoubleFloat,itnlimArg:Integer,msglvlArg:Integer,_
+        lrworkArg:Integer,liworkArg:Integer,rtolArg:DoubleFloat,_
+        ifailArg:Integer,aprodArg:Union(fn:FileName,fp:Asp28(APROD)),_
+        msolveArg:Union(fn:FileName,fp:Asp34(MSOLVE))): Result == 
+-- if both asps are AXIOM generated we do not need lrwork liwork
+--   and will set to 1.
+-- else believe the user but check that they are >0.
+        if (aprodArg case fp) and (msolveArg case fp)
+          then
+            lrworkArg:=1
+            liworkArg:=1
+          else 
+            lrworkArg:=max(1,lrworkArg)
+            liworkArg:=max(1,liworkArg)
+        pushFortranOutputStack(aprodFilename := aspFilename "aprod")$FOP
+        if aprodArg case fn
+          then outputAsFortran(aprodArg.fn)
+          else outputAsFortran(aprodArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(msolveFilename := aspFilename "msolve")$FOP
+        if msolveArg case fn
+          then outputAsFortran(msolveArg.fn)
+          else outputAsFortran(msolveArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([aprodFilename,msolveFilename]$Lisp,_
+        "f04mbf",_
+        ["n"::S,"precon"::S,"shift"::S,"itnlim"::S,"msglvl"::S_
+        ,"lrwork"::S,"liwork"::S,"itn"::S,"anorm"::S,"acond"::S_
+        ,"rnorm"::S,"xnorm"::S,"inform"::S,"rtol"::S,"ifail"::S_
+        ,"aprod"::S,"msolve"::S,"b"::S,"x"::S,"work"::S,"rwork"::S,"iwork"::S_
+        ]$Lisp,["x"::S,"itn"::S,"anorm"::S,"acond"::S,"rnorm"::S,"xnorm"::S,_
+        "inform"::S,"work"::S,"rwork"::S,"iwork"::S,"aprod"::S,_
+        "msolve"::S]$Lisp,[["double"::S,["b"::S,"n"::S]$Lisp,"shift"::S_
+        ,["x"::S,"n"::S]$Lisp,"anorm"::S,"acond"::S,"rnorm"::S,"xnorm"::S,_
+         "rtol"::S,["work"::S,"n"::S,5$Lisp]$Lisp,_
+        ["rwork"::S,"lrwork"::S]$Lisp_
+        ,"aprod"::S,"msolve"::S]$Lisp_
+        ,["integer"::S,"n"::S,"itnlim"::S,"msglvl"::S_
+        ,"lrwork"::S,"liwork"::S,"itn"::S,"inform"::S,"ifail"::S,_
+        ["iwork"::S,"liwork"::S]$Lisp]$Lisp_
+        ,["logical"::S,"precon"::S]$Lisp_
+        ]$Lisp,_
+        ["x"::S,"itn"::S,"anorm"::S,"acond"::S,"rnorm"::S,"xnorm"::S,_
+        "inform"::S,"rtol"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,preconArg::Any,shiftArg::Any,itnlimArg::Any,_
+        msglvlArg::Any,lrworkArg::Any,liworkArg::Any,rtolArg::Any,_
+        ifailArg::Any,bArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f04mcf(nArg:Integer,alArg:Matrix DoubleFloat,lalArg:Integer,_
+        dArg:Matrix DoubleFloat,nrowArg:Matrix Integer,irArg:Integer,_
+        bArg:Matrix DoubleFloat,nrbArg:Integer,iselctArg:Integer,_
+        nrxArg:Integer,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f04mcf",_
+        ["n"::S,"lal"::S,"ir"::S,"nrb"::S,"iselct"::S_
+        ,"nrx"::S,"ifail"::S,"al"::S,"d"::S,"nrow"::S,"b"::S,"x"::S_
+        ]$Lisp,_
+        ["x"::S]$Lisp,_
+        [["double"::S,["al"::S,"lal"::S]$Lisp,["d"::S,"n"::S]$Lisp_
+        ,["b"::S,"nrb"::S,"ir"::S]$Lisp,["x"::S,"nrx"::S,"ir"::S]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"lal"::S,["nrow"::S,"n"::S]$Lisp_
+        ,"ir"::S,"nrb"::S,"iselct"::S,"nrx"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["x"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,lalArg::Any,irArg::Any,nrbArg::Any,iselctArg::Any,_
+        nrxArg::Any,ifailArg::Any,alArg::Any,dArg::Any,nrowArg::Any,_
+        bArg::Any ])@List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f04qaf(mArg:Integer,nArg:Integer,dampArg:DoubleFloat,_
+        atolArg:DoubleFloat,btolArg:DoubleFloat,conlimArg:DoubleFloat,_
+        itnlimArg:Integer,msglvlArg:Integer,lrworkArg:Integer,_
+        liworkArg:Integer,bArg:Matrix DoubleFloat,ifailArg:Integer,_
+        aprodArg:Union(fn:FileName,fp:Asp30(APROD))): Result == 
+        pushFortranOutputStack(aprodFilename := aspFilename "aprod")$FOP
+        if aprodArg case fn
+          then outputAsFortran(aprodArg.fn)
+          else outputAsFortran(aprodArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([aprodFilename]$Lisp,_
+        "f04qaf",_
+        ["m"::S,"n"::S,"damp"::S,"atol"::S,"btol"::S_
+        ,"conlim"::S,"itnlim"::S,"msglvl"::S,"lrwork"::S,"liwork"::S_
+        ,"itn"::S,"anorm"::S,"acond"::S,"rnorm"::S,"arnorm"::S_
+        ,"xnorm"::S,"inform"::S,"ifail"::S,"aprod"::S,"x"::S,"se"::S,_
+        "b"::S,"work"::S,"rwork"::S_
+        ,"iwork"::S]$Lisp,_
+        ["x"::S,"se"::S,"itn"::S,"anorm"::S,"acond"::S,"rnorm"::S,_
+        "arnorm"::S,"xnorm"::S,"inform"::S,"work"::S,"rwork"::S,_
+        "iwork"::S,"aprod"::S]$Lisp,_
+        [["double"::S,"damp"::S,"atol"::S,"btol"::S_
+        ,"conlim"::S,["x"::S,"n"::S]$Lisp,["se"::S,"n"::S]$Lisp,_
+        "anorm"::S,"acond"::S,"rnorm"::S,"arnorm"::S,"xnorm"::S,_
+        ["b"::S,"m"::S]$Lisp_
+        ,["work"::S,"n"::S,2$Lisp]$Lisp,["rwork"::S,"lrwork"::S]$Lisp,_
+        "aprod"::S]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"itnlim"::S,"msglvl"::S_
+        ,"lrwork"::S,"liwork"::S,"itn"::S,"inform"::S,"ifail"::S,_
+        ["iwork"::S,"liwork"::S]$Lisp]$Lisp]$Lisp,_
+        ["x"::S,"se"::S,"itn"::S,"anorm"::S,"acond"::S,"rnorm"::S,_
+        "arnorm"::S,"xnorm"::S,"inform"::S,"b"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,nArg::Any,dampArg::Any,atolArg::Any,btolArg::Any,_
+        conlimArg::Any,itnlimArg::Any,msglvlArg::Any,lrworkArg::Any,_
+        liworkArg::Any,ifailArg::Any,bArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
 *)
 
 \end{chunk}
@@ -103190,6 +132467,7 @@ NAGLinkSupportPackage() : exports == implementation where
       ++ restorePrecision() \undocumented{}
 
   implementation ==> add
+
     makeAs:                   (Symbol,Symbol) -> Symbol
     changeVariables:          (Expression Integer,Symbol) -> Expression Integer
     changeVariablesF:         (Expression Float,Symbol) -> Expression Float
@@ -103214,19 +132492,23 @@ NAGLinkSupportPackage() : exports == implementation where
       void()$Void
 
     uniqueId : String := ""
+
     counter : Integer := 0
+
     getUniqueId():String ==
       if uniqueId = "" then
         uniqueId := concat(getEnv("HOST")$Lisp,getEnv("SPADNUM")$Lisp)
       concat(uniqueId,string (counter:=counter+1))
 
     fortranCompilerName() == string _$fortranCompilerName$Lisp
+
     fortranLinkerArgs() == string _$fortranLibraries$Lisp
 
     aspFilename(f:String):String == concat ["/tmp/",f,getUniqueId(),".f"]
 
     dimensionsOf(u:Symbol,m:Matrix DoubleFloat):SExpression ==
       [u,nrows m,ncols m]$Lisp
+
     dimensionsOf(u:Symbol,m:Matrix Integer):SExpression ==
       [u,nrows m,ncols m]$Lisp
 
@@ -103235,6 +132517,51 @@ NAGLinkSupportPackage() : exports == implementation where
 \begin{chunk}{COQ NAGSP}
 (* package NAGSP *)
 (*
+
+    makeAs:                   (Symbol,Symbol) -> Symbol
+    changeVariables:          (Expression Integer,Symbol) -> Expression Integer
+    changeVariablesF:         (Expression Float,Symbol) -> Expression Float
+
+    import String
+    import Symbol
+
+    checkPrecision():Boolean ==
+      (_$fortranPrecision$Lisp = "single"::Symbol) and _
+      (_$nagEnforceDouble$Lisp)  =>
+        systemCommand("set fortran precision double")$MoreSystemCommands
+        if _$nagMessages$Lisp  then 
+          print("*** Warning: Resetting fortran precision to double")_
+            $PrintPackage
+        true
+      false
+
+    restorePrecision():Void ==
+      systemCommand("set fortran precision single")$MoreSystemCommands
+      if _$nagMessages$Lisp  then 
+        print("** Warning: Restoring fortran precision to single")$PrintPackage
+      void()$Void
+
+    uniqueId : String := ""
+
+    counter : Integer := 0
+
+    getUniqueId():String ==
+      if uniqueId = "" then
+        uniqueId := concat(getEnv("HOST")$Lisp,getEnv("SPADNUM")$Lisp)
+      concat(uniqueId,string (counter:=counter+1))
+
+    fortranCompilerName() == string _$fortranCompilerName$Lisp
+
+    fortranLinkerArgs() == string _$fortranLibraries$Lisp
+
+    aspFilename(f:String):String == concat ["/tmp/",f,getUniqueId(),".f"]
+
+    dimensionsOf(u:Symbol,m:Matrix DoubleFloat):SExpression ==
+      [u,nrows m,ncols m]$Lisp
+
+    dimensionsOf(u:Symbol,m:Matrix Integer):SExpression ==
+      [u,nrows m,ncols m]$Lisp
+
 *)
 
 \end{chunk}
@@ -107243,6 +136570,7 @@ NagIntegrationPackage(): Exports == Implementation where
      ++ approximate relative error estimate is also returned. This 
      ++ routine is suitable for low accuracy work.
      ++ See \downlink{Manual Page}{manpageXXd01gbf}.
+
   Implementation ==> add
 
     import Lisp
@@ -107567,6 +136895,324 @@ NagIntegrationPackage(): Exports == Implementation where
 \begin{chunk}{COQ NAGD01}
 (* package NAGD01 *)
 (*
+
+    import Lisp
+    import DoubleFloat
+    import Any
+    import Record
+    import Integer
+    import Matrix DoubleFloat
+    import Boolean
+    import NAGLinkSupportPackage
+    import FortranPackage
+    import Union(fn:FileName,fp:Asp1(F))
+    import AnyFunctions1(DoubleFloat)
+    import AnyFunctions1(Integer)
+    import AnyFunctions1(Matrix DoubleFloat)
+
+
+    d01ajf(aArg:DoubleFloat,bArg:DoubleFloat,epsabsArg:DoubleFloat,_
+        epsrelArg:DoubleFloat,lwArg:Integer,liwArg:Integer,_
+        ifailArg:Integer,fArg:Union(fn:FileName,fp:Asp1(F))): Result == 
+        pushFortranOutputStack(fFilename := aspFilename "f")$FOP
+        if fArg case fn
+          then outputAsFortran(fArg.fn)
+          else outputAsFortran(fArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([fFilename]$Lisp,_
+        "d01ajf",_
+        ["a"::S,"b"::S,"epsabs"::S,"epsrel"::S,"lw"::S_
+        ,"liw"::S,"result"::S,"abserr"::S,"ifail"::S,"f"::S_
+        ,"w"::S,"iw"::S]$Lisp,_
+        ["result"::S,"abserr"::S,"w"::S,"iw"::S,"f"::S]$Lisp,_
+        [["double"::S,"a"::S,"b"::S,"epsabs"::S,"epsrel"::S_
+        ,"result"::S,"abserr"::S,["w"::S,"lw"::S]$Lisp,"f"::S]$Lisp_
+        ,["integer"::S,"lw"::S,"liw"::S,["iw"::S,"liw"::S]$Lisp_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["result"::S,"abserr"::S,"w"::S,"iw"::S,"ifail"::S]$Lisp,_
+        [([aArg::Any,bArg::Any,epsabsArg::Any,epsrelArg::Any,lwArg::Any,_
+        liwArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d01akf(aArg:DoubleFloat,bArg:DoubleFloat,epsabsArg:DoubleFloat,_
+        epsrelArg:DoubleFloat,lwArg:Integer,liwArg:Integer,_
+        ifailArg:Integer,fArg:Union(fn:FileName,fp:Asp1(F))): Result == 
+        pushFortranOutputStack(fFilename := aspFilename "f")$FOP
+        if fArg case fn
+          then outputAsFortran(fArg.fn)
+          else outputAsFortran(fArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([fFilename]$Lisp,_
+        "d01akf",_
+        ["a"::S,"b"::S,"epsabs"::S,"epsrel"::S,"lw"::S_
+        ,"liw"::S,"result"::S,"abserr"::S,"ifail"::S,"f"::S_
+        ,"w"::S,"iw"::S]$Lisp,_
+        ["result"::S,"abserr"::S,"w"::S,"iw"::S,"f"::S]$Lisp,_
+        [["double"::S,"a"::S,"b"::S,"epsabs"::S,"epsrel"::S_
+        ,"result"::S,"abserr"::S,["w"::S,"lw"::S]$Lisp,"f"::S]$Lisp_
+        ,["integer"::S,"lw"::S,"liw"::S,["iw"::S,"liw"::S]$Lisp_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["result"::S,"abserr"::S,"w"::S,"iw"::S,"ifail"::S]$Lisp,_
+        [([aArg::Any,bArg::Any,epsabsArg::Any,epsrelArg::Any,lwArg::Any,_
+        liwArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d01alf(aArg:DoubleFloat,bArg:DoubleFloat,nptsArg:Integer,_
+        pointsArg:Matrix DoubleFloat,epsabsArg:DoubleFloat,_
+        epsrelArg:DoubleFloat,_
+        lwArg:Integer,liwArg:Integer,ifailArg:Integer,_
+        fArg:Union(fn:FileName,fp:Asp1(F))): Result == 
+        pushFortranOutputStack(fFilename := aspFilename "f")$FOP
+        if fArg case fn
+          then outputAsFortran(fArg.fn)
+          else outputAsFortran(fArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([fFilename]$Lisp,_
+        "d01alf",_
+        ["a"::S,"b"::S,"npts"::S,"epsabs"::S,"epsrel"::S_
+        ,"lw"::S,"liw"::S,"result"::S,"abserr"::S,"ifail"::S_
+        ,"f"::S,"points"::S,"w"::S,"iw"::S]$Lisp,_
+        ["result"::S,"abserr"::S,"w"::S,"iw"::S,"f"::S]$Lisp,_
+        [["double"::S,"a"::S,"b"::S,["points"::S,"*"::S]$Lisp_
+        ,"epsabs"::S,"epsrel"::S,"result"::S,"abserr"::S,_
+        ["w"::S,"lw"::S]$Lisp,"f"::S]$Lisp_
+        ,["integer"::S,"npts"::S,"lw"::S,"liw"::S,["iw"::S,"liw"::S]$Lisp_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["result"::S,"abserr"::S,"w"::S,"iw"::S,"ifail"::S]$Lisp,_
+        [([aArg::Any,bArg::Any,nptsArg::Any,epsabsArg::Any,epsrelArg::Any,_
+        lwArg::Any,liwArg::Any,ifailArg::Any,pointsArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d01amf(boundArg:DoubleFloat,infArg:Integer,epsabsArg:DoubleFloat,_
+        epsrelArg:DoubleFloat,lwArg:Integer,liwArg:Integer,_
+        ifailArg:Integer,fArg:Union(fn:FileName,fp:Asp1(F))): Result == 
+        pushFortranOutputStack(fFilename := aspFilename "f")$FOP
+        if fArg case fn
+          then outputAsFortran(fArg.fn)
+          else outputAsFortran(fArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([fFilename]$Lisp,_
+        "d01amf",_
+        ["bound"::S,"inf"::S,"epsabs"::S,"epsrel"::S,"lw"::S_
+        ,"liw"::S,"result"::S,"abserr"::S,"ifail"::S,"f"::S_
+        ,"w"::S,"iw"::S]$Lisp,_
+        ["result"::S,"abserr"::S,"w"::S,"iw"::S,"f"::S]$Lisp,_
+        [["double"::S,"bound"::S,"epsabs"::S,"epsrel"::S_
+        ,"result"::S,"abserr"::S,["w"::S,"lw"::S]$Lisp,"f"::S]$Lisp_
+        ,["integer"::S,"inf"::S,"lw"::S,"liw"::S,["iw"::S,"liw"::S]$Lisp_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["result"::S,"abserr"::S,"w"::S,"iw"::S,"ifail"::S]$Lisp,_
+        [([boundArg::Any,infArg::Any,epsabsArg::Any,epsrelArg::Any,_
+        lwArg::Any,liwArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d01anf(aArg:DoubleFloat,bArg:DoubleFloat,omegaArg:DoubleFloat,_
+        keyArg:Integer,epsabsArg:DoubleFloat,epsrelArg:DoubleFloat,_
+        lwArg:Integer,liwArg:Integer,ifailArg:Integer,_
+        gArg:Union(fn:FileName,fp:Asp1(G))): Result == 
+        pushFortranOutputStack(gFilename := aspFilename "g")$FOP
+        if gArg case fn
+          then outputAsFortran(gArg.fn)
+          else outputAsFortran(gArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([gFilename]$Lisp,_
+        "d01anf",_
+        ["a"::S,"b"::S,"omega"::S,"key"::S,"epsabs"::S_
+        ,"epsrel"::S,"lw"::S,"liw"::S,"result"::S,"abserr"::S_
+        ,"ifail"::S,"g"::S,"w"::S,"iw"::S]$Lisp,_
+        ["result"::S,"abserr"::S,"w"::S,"iw"::S,"g"::S]$Lisp,_
+        [["double"::S,"a"::S,"b"::S,"omega"::S,"epsabs"::S_
+        ,"epsrel"::S,"result"::S,"abserr"::S,["w"::S,"lw"::S]$Lisp,_
+        "g"::S]$Lisp_
+        ,["integer"::S,"key"::S,"lw"::S,"liw"::S,["iw"::S,"liw"::S]$Lisp_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["result"::S,"abserr"::S,"w"::S,"iw"::S,"ifail"::S]$Lisp,_
+        [([aArg::Any,bArg::Any,omegaArg::Any,keyArg::Any,epsabsArg::Any,_
+        epsrelArg::Any,lwArg::Any,liwArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d01apf(aArg:DoubleFloat,bArg:DoubleFloat,alfaArg:DoubleFloat,_
+        betaArg:DoubleFloat,keyArg:Integer,epsabsArg:DoubleFloat,_
+        epsrelArg:DoubleFloat,lwArg:Integer,liwArg:Integer,_
+        ifailArg:Integer,gArg:Union(fn:FileName,fp:Asp1(G))): Result == 
+        pushFortranOutputStack(gFilename := aspFilename "g")$FOP
+        if gArg case fn
+          then outputAsFortran(gArg.fn)
+          else outputAsFortran(gArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([gFilename]$Lisp,_
+        "d01apf",_
+        ["a"::S,"b"::S,"alfa"::S,"beta"::S,"key"::S_
+        ,"epsabs"::S,"epsrel"::S,"lw"::S,"liw"::S,"result"::S_
+        ,"abserr"::S,"ifail"::S,"g"::S,"w"::S,"iw"::S]$Lisp,_
+        ["result"::S,"abserr"::S,"w"::S,"iw"::S,"g"::S]$Lisp,_
+        [["double"::S,"a"::S,"b"::S,"alfa"::S,"beta"::S_
+        ,"epsabs"::S,"epsrel"::S,"result"::S,"abserr"::S,_
+        ["w"::S,"lw"::S]$Lisp,"g"::S]$Lisp_
+        ,["integer"::S,"key"::S,"lw"::S,"liw"::S,["iw"::S,"liw"::S]$Lisp_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["result"::S,"abserr"::S,"w"::S,"iw"::S,"ifail"::S]$Lisp,_
+        [([aArg::Any,bArg::Any,alfaArg::Any,betaArg::Any,keyArg::Any,_
+        epsabsArg::Any,epsrelArg::Any,lwArg::Any,liwArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d01aqf(aArg:DoubleFloat,bArg:DoubleFloat,cArg:DoubleFloat,_
+        epsabsArg:DoubleFloat,epsrelArg:DoubleFloat,lwArg:Integer,_
+        liwArg:Integer,ifailArg:Integer,_
+        gArg:Union(fn:FileName,fp:Asp1(G))): Result == 
+        pushFortranOutputStack(gFilename := aspFilename "g")$FOP
+        if gArg case fn
+          then outputAsFortran(gArg.fn)
+          else outputAsFortran(gArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([gFilename]$Lisp,_
+        "d01aqf",_
+        ["a"::S,"b"::S,"c"::S,"epsabs"::S,"epsrel"::S_
+        ,"lw"::S,"liw"::S,"result"::S,"abserr"::S,"ifail"::S_
+        ,"g"::S,"w"::S,"iw"::S]$Lisp,_
+        ["result"::S,"abserr"::S,"w"::S,"iw"::S,"g"::S]$Lisp,_
+        [["double"::S,"a"::S,"b"::S,"c"::S,"epsabs"::S_
+        ,"epsrel"::S,"result"::S,"abserr"::S,_
+        ["w"::S,"lw"::S]$Lisp,"g"::S]$Lisp_
+        ,["integer"::S,"lw"::S,"liw"::S,["iw"::S,"liw"::S]$Lisp_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["result"::S,"abserr"::S,"w"::S,"iw"::S,"ifail"::S]$Lisp,_
+        [([aArg::Any,bArg::Any,cArg::Any,epsabsArg::Any,epsrelArg::Any,_
+        lwArg::Any,liwArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d01asf(aArg:DoubleFloat,omegaArg:DoubleFloat,keyArg:Integer,_
+        epsabsArg:DoubleFloat,limlstArg:Integer,lwArg:Integer,_
+        liwArg:Integer,ifailArg:Integer,_
+        gArg:Union(fn:FileName,fp:Asp1(G))): Result == 
+        pushFortranOutputStack(gFilename := aspFilename "g")$FOP
+        if gArg case fn
+          then outputAsFortran(gArg.fn)
+          else outputAsFortran(gArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([gFilename]$Lisp,_
+        "d01asf",_
+        ["a"::S,"omega"::S,"key"::S,"epsabs"::S,"limlst"::S_
+        ,"lw"::S,"liw"::S,"result"::S,"abserr"::S,"lst"::S_
+        ,"ifail"::S,"g"::S,"erlst"::S,"rslst"::S,"ierlst"::S,"iw"::S,"w"::S_
+        ]$Lisp,_
+        ["result"::S,"abserr"::S,"lst"::S,"erlst"::S,"rslst"::S,_
+        "ierlst"::S,"iw"::S,"w"::S,"g"::S]$Lisp,_
+        [["double"::S,"a"::S,"omega"::S,"epsabs"::S_
+        ,"result"::S,"abserr"::S,["erlst"::S,"limlst"::S]$Lisp,_
+        ["rslst"::S,"limlst"::S]$Lisp,["w"::S,"lw"::S]$Lisp,"g"::S]$Lisp_
+        ,["integer"::S,"key"::S,"limlst"::S,"lw"::S_
+        ,"liw"::S,"lst"::S,["ierlst"::S,"limlst"::S]$Lisp,_
+        ["iw"::S,"liw"::S]$Lisp,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["result"::S,"abserr"::S,"lst"::S,"erlst"::S,"rslst"::S,_
+        "ierlst"::S,"iw"::S,"ifail"::S]$Lisp,_
+        [([aArg::Any,omegaArg::Any,keyArg::Any,epsabsArg::Any,_
+        limlstArg::Any,lwArg::Any,liwArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d01bbf(aArg:DoubleFloat,bArg:DoubleFloat,itypeArg:Integer,_
+        nArg:Integer,gtypeArg:Integer,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "d01bbf",_
+        ["a"::S,"b"::S,"itype"::S,"n"::S,"gtype"::S_
+        ,"ifail"::S,"weight"::S,"abscis"::S]$Lisp,_
+        ["weight"::S,"abscis"::S]$Lisp,_
+        [["double"::S,"a"::S,"b"::S,["weight"::S,"n"::S]$Lisp_
+        ,["abscis"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"itype"::S,"n"::S,"gtype"::S_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["weight"::S,"abscis"::S,"ifail"::S]$Lisp,_
+        [([aArg::Any,bArg::Any,itypeArg::Any,nArg::Any,_
+        gtypeArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d01fcf(ndimArg:Integer,aArg:Matrix DoubleFloat,bArg:Matrix DoubleFloat,_
+        maxptsArg:Integer,epsArg:DoubleFloat,lenwrkArg:Integer,_
+        minptsArg:Integer,ifailArg:Integer,_
+        functnArg:Union(fn:FileName,fp:Asp4(FUNCTN))): Result == 
+        pushFortranOutputStack(functnFilename := aspFilename "functn")$FOP
+        if functnArg case fn
+          then outputAsFortran(functnArg.fn)
+          else outputAsFortran(functnArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([functnFilename]$Lisp,_
+        "d01fcf",_
+        ["ndim"::S,"maxpts"::S,"eps"::S,"lenwrk"::S,"acc"::S_
+        ,"finval"::S,"minpts"::S,"ifail"::S,"functn"::S,"a"::S,_
+        "b"::S,"wrkstr"::S]$Lisp,_
+        ["acc"::S,"finval"::S,"wrkstr"::S,"functn"::S]$Lisp,_
+        [["double"::S,["a"::S,"ndim"::S]$Lisp,["b"::S,"ndim"::S]$Lisp_
+        ,"eps"::S,"acc"::S,"finval"::S,["wrkstr"::S,"lenwrk"::S]$Lisp,_
+        "functn"::S]$Lisp_
+        ,["integer"::S,"ndim"::S,"maxpts"::S,"lenwrk"::S_
+        ,"minpts"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["acc"::S,"finval"::S,"minpts"::S,"ifail"::S]$Lisp,_
+        [([ndimArg::Any,maxptsArg::Any,epsArg::Any,lenwrkArg::Any,_
+        minptsArg::Any,ifailArg::Any,aArg::Any,bArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d01gaf(xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,nArg:Integer,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "d01gaf",_
+        ["n"::S,"ans"::S,"er"::S,"ifail"::S,"x"::S,"y"::S]$Lisp,_
+        ["ans"::S,"er"::S]$Lisp,_
+        [["double"::S,["x"::S,"n"::S]$Lisp,["y"::S,"n"::S]$Lisp_
+        ,"ans"::S,"er"::S]$Lisp_
+        ,["integer"::S,"n"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["ans"::S,"er"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,ifailArg::Any,xArg::Any,yArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d01gbf(ndimArg:Integer,aArg:Matrix DoubleFloat,bArg:Matrix DoubleFloat,_
+        maxclsArg:Integer,epsArg:DoubleFloat,lenwrkArg:Integer,_
+        minclsArg:Integer,wrkstrArg:Matrix DoubleFloat,ifailArg:Integer,_
+        functnArg:Union(fn:FileName,fp:Asp4(FUNCTN))): Result == 
+        pushFortranOutputStack(functnFilename := aspFilename "functn")$FOP
+        if functnArg case fn
+          then outputAsFortran(functnArg.fn)
+          else outputAsFortran(functnArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([functnFilename]$Lisp,_
+        "d01gbf",_
+        ["ndim"::S,"maxcls"::S,"eps"::S,"lenwrk"::S,"acc"::S_
+        ,"finest"::S,"mincls"::S,"ifail"::S,"functn"::S,"a"::S,_
+        "b"::S,"wrkstr"::S]$Lisp,_
+        ["acc"::S,"finest"::S,"functn"::S]$Lisp,_
+        [["double"::S,["a"::S,"ndim"::S]$Lisp,["b"::S,"ndim"::S]$Lisp_
+        ,"eps"::S,"acc"::S,"finest"::S,["wrkstr"::S,"lenwrk"::S]$Lisp,_
+        "functn"::S]$Lisp_
+        ,["integer"::S,"ndim"::S,"maxcls"::S,"lenwrk"::S_
+        ,"mincls"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["acc"::S,"finest"::S,"mincls"::S,"wrkstr"::S,"ifail"::S]$Lisp,_
+        [([ndimArg::Any,maxclsArg::Any,epsArg::Any,lenwrkArg::Any,_
+        minclsArg::Any,ifailArg::Any,aArg::Any,bArg::Any,wrkstrArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
 *)
 
 \end{chunk}
@@ -110529,6 +140175,7 @@ NagInterpolationPackage(): Exports == Implementation where
      ++ evaluates at a given point the two-dimensional 
      ++ interpolating function computed by E01SEF.
      ++ See \downlink{Manual Page}{manpageXXe01sff}.
+
   Implementation ==> add
 
     import Lisp
@@ -110748,6 +140395,219 @@ NagInterpolationPackage(): Exports == Implementation where
 \begin{chunk}{COQ NAGE01}
 (* package NAGE01 *)
 (*
+
+    import Lisp
+    import DoubleFloat
+    import Any
+    import Record
+    import Integer
+    import Matrix DoubleFloat
+    import Boolean
+    import NAGLinkSupportPackage
+    import AnyFunctions1(Integer)
+    import AnyFunctions1(Matrix DoubleFloat)
+    import AnyFunctions1(Matrix Integer)
+    import AnyFunctions1(DoubleFloat)
+
+
+    e01baf(mArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_
+        lckArg:Integer,lwrkArg:Integer,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e01baf",_
+        ["m"::S,"lck"::S,"lwrk"::S,"ifail"::S,"x"::S,"y"::S,_
+        "lamda"::S,"c"::S,"wrk"::S_
+        ]$Lisp,_
+        ["lamda"::S,"c"::S,"wrk"::S]$Lisp,_
+        [["double"::S,["x"::S,"m"::S]$Lisp,["y"::S,"m"::S]$Lisp_
+        ,["lamda"::S,"lck"::S]$Lisp,["c"::S,"lck"::S]$Lisp,_
+        ["wrk"::S,"lwrk"::S]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,"lck"::S,"lwrk"::S,"ifail"::S_
+        ]$Lisp_
+        ]$Lisp,_
+        ["lamda"::S,"c"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,lckArg::Any,lwrkArg::Any,ifailArg::Any,_
+        xArg::Any,yArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e01bef(nArg:Integer,xArg:Matrix DoubleFloat,fArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e01bef",_
+        ["n"::S,"ifail"::S,"x"::S,"f"::S,"d"::S]$Lisp,_
+        ["d"::S]$Lisp,_
+        [["double"::S,["x"::S,"n"::S]$Lisp,["f"::S,"n"::S]$Lisp_
+        ,["d"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["d"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,ifailArg::Any,xArg::Any,fArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e01bff(nArg:Integer,xArg:Matrix DoubleFloat,fArg:Matrix DoubleFloat,_
+        dArg:Matrix DoubleFloat,mArg:Integer,pxArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e01bff",_
+        ["n"::S,"m"::S,"ifail"::S,"x"::S,"f"::S,"d"::S,"px"::S,"pf"::S_
+        ]$Lisp,_
+        ["pf"::S]$Lisp,_
+        [["double"::S,["x"::S,"n"::S]$Lisp,["f"::S,"n"::S]$Lisp_
+        ,["d"::S,"n"::S]$Lisp,["px"::S,"m"::S]$Lisp,_
+        ["pf"::S,"m"::S]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"m"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["pf"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,mArg::Any,ifailArg::Any,xArg::Any,fArg::Any,_
+        dArg::Any,pxArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e01bgf(nArg:Integer,xArg:Matrix DoubleFloat,fArg:Matrix DoubleFloat,_
+        dArg:Matrix DoubleFloat,mArg:Integer,pxArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e01bgf",_
+        ["n"::S,"m"::S,"ifail"::S,"x"::S,"f"::S,"d"::S,"px"::S,"pf"::S_
+        ,"pd"::S]$Lisp,_
+        ["pf"::S,"pd"::S]$Lisp,_
+        [["double"::S,["x"::S,"n"::S]$Lisp,["f"::S,"n"::S]$Lisp_
+        ,["d"::S,"n"::S]$Lisp,["px"::S,"m"::S]$Lisp,_
+        ["pf"::S,"m"::S]$Lisp,["pd"::S,"m"::S]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"m"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["pf"::S,"pd"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,mArg::Any,ifailArg::Any,xArg::Any,_
+        fArg::Any,dArg::Any,pxArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e01bhf(nArg:Integer,xArg:Matrix DoubleFloat,fArg:Matrix DoubleFloat,_
+        dArg:Matrix DoubleFloat,aArg:DoubleFloat,bArg:DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e01bhf",_
+        ["n"::S,"a"::S,"b"::S,"pint"::S,"ifail"::S_
+        ,"x"::S,"f"::S,"d"::S]$Lisp,_
+        ["pint"::S]$Lisp,_
+        [["double"::S,["x"::S,"n"::S]$Lisp,["f"::S,"n"::S]$Lisp_
+        ,["d"::S,"n"::S]$Lisp,"a"::S,"b"::S,"pint"::S]$Lisp_
+        ,["integer"::S,"n"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["pint"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,aArg::Any,bArg::Any,ifailArg::Any,xArg::Any,_
+        fArg::Any,dArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e01daf(mxArg:Integer,myArg:Integer,xArg:Matrix DoubleFloat,_
+        yArg:Matrix DoubleFloat,fArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e01daf",_
+        ["mx"::S,"my"::S,"px"::S,"py"::S,"ifail"::S_
+        ,"x"::S,"y"::S,"f"::S,"lamda"::S,"mu"::S_
+        ,"c"::S,"wrk"::S]$Lisp,_
+        ["px"::S,"py"::S,"lamda"::S,"mu"::S,"c"::S,"wrk"::S]$Lisp,_
+        [["double"::S,["x"::S,"mx"::S]$Lisp,["y"::S,"my"::S]$Lisp_
+        ,["f"::S,["*"::S,"mx"::S,"my"::S]$Lisp]$Lisp,_
+        ["lamda"::S,["+"::S,"mx"::S,4$Lisp]$Lisp]$Lisp,_
+        ["mu"::S,["+"::S,"mx"::S,4$Lisp]$Lisp]$Lisp_
+        ,["c"::S,["*"::S,"mx"::S,"my"::S]$Lisp]$Lisp,_
+        ["wrk"::S,["*"::S,["+"::S,"mx"::S,6$Lisp]$Lisp,_
+        ["+"::S,"my"::S,6$Lisp]$Lisp]$Lisp]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"mx"::S,"my"::S,"px"::S,"py"::S_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["px"::S,"py"::S,"lamda"::S,"mu"::S,"c"::S,"ifail"::S]$Lisp,_
+        [([mxArg::Any,myArg::Any,ifailArg::Any,xArg::Any,_
+        yArg::Any,fArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e01saf(mArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_
+        fArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e01saf",_
+        ["m"::S,"ifail"::S,"x"::S,"y"::S,"f"::S,"triang"::S,"grads"::S_
+        ]$Lisp,_
+        ["triang"::S,"grads"::S]$Lisp,_
+        [["double"::S,["x"::S,"m"::S]$Lisp,["y"::S,"m"::S]$Lisp_
+        ,["f"::S,"m"::S]$Lisp,["grads"::S,2$Lisp,"m"::S]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,["triang"::S,["*"::S,7$Lisp,"m"::S]$Lisp]$Lisp_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["triang"::S,"grads"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,ifailArg::Any,xArg::Any,yArg::Any,fArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e01sbf(mArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_
+        fArg:Matrix DoubleFloat,triangArg:Matrix Integer,_
+        gradsArg:Matrix DoubleFloat,_
+        pxArg:DoubleFloat,pyArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e01sbf",_
+        ["m"::S,"px"::S,"py"::S,"pf"::S,"ifail"::S_
+        ,"x"::S,"y"::S,"f"::S,"triang"::S,"grads"::S_
+        ]$Lisp,_
+        ["pf"::S]$Lisp,_
+        [["double"::S,["x"::S,"m"::S]$Lisp,["y"::S,"m"::S]$Lisp_
+        ,["f"::S,"m"::S]$Lisp,["grads"::S,2$Lisp,"m"::S]$Lisp,_
+        "px"::S,"py"::S,"pf"::S]$Lisp_
+        ,["integer"::S,"m"::S,["triang"::S,["*"::S,7$Lisp,"m"::S]$Lisp]$Lisp_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["pf"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,pxArg::Any,pyArg::Any,ifailArg::Any,xArg::Any,_
+        yArg::Any,fArg::Any,triangArg::Any,gradsArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e01sef(mArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_
+        fArg:Matrix DoubleFloat,nwArg:Integer,nqArg:Integer,_
+        rnwArg:DoubleFloat,rnqArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e01sef",_
+        ["m"::S,"nw"::S,"nq"::S,"minnq"::S,"rnw"::S_
+        ,"rnq"::S,"ifail"::S,"x"::S,"y"::S,"f"::S,"fnodes"::S,"wrk"::S_
+        ]$Lisp,_
+        ["fnodes"::S,"minnq"::S,"wrk"::S]$Lisp,_
+        [["double"::S,["x"::S,"m"::S]$Lisp,["y"::S,"m"::S]$Lisp_
+        ,["f"::S,"m"::S]$Lisp,["fnodes"::S,["*"::S,5$Lisp,"m"::S]$Lisp]$Lisp,_
+        "rnw"::S,"rnq"::S,["wrk"::S,["*"::S,6$Lisp,"m"::S]$Lisp]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"m"::S,"nw"::S,"nq"::S,"minnq"::S_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["fnodes"::S,"minnq"::S,"rnw"::S,"rnq"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,nwArg::Any,nqArg::Any,rnwArg::Any,rnqArg::Any,_
+        ifailArg::Any,xArg::Any,yArg::Any,fArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e01sff(mArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_
+        fArg:Matrix DoubleFloat,rnwArg:DoubleFloat,_
+        fnodesArg:Matrix DoubleFloat,_
+        pxArg:DoubleFloat,pyArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e01sff",_
+        ["m"::S,"rnw"::S,"px"::S,"py"::S,"pf"::S_
+        ,"ifail"::S,"x"::S,"y"::S,"f"::S,"fnodes"::S]$Lisp,_
+        ["pf"::S]$Lisp,_
+        [["double"::S,["x"::S,"m"::S]$Lisp,["y"::S,"m"::S]$Lisp_
+        ,["f"::S,"m"::S]$Lisp,"rnw"::S,["fnodes"::S,_
+        ["*"::S,5$Lisp,"m"::S]$Lisp]$Lisp,"px"::S,"py"::S,"pf"::S]$Lisp_
+        ,["integer"::S,"m"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["pf"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,rnwArg::Any,pxArg::Any,pyArg::Any,_
+        ifailArg::Any,xArg::Any,yArg::Any,fArg::Any,fnodesArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
 *)
 
 \end{chunk}
@@ -111873,6 +141733,7 @@ NagLapack(): Exports == Implementation where
      ++ of linear equations with multiple right-hand sides, AX=B, where A
      ++ has been factorized by F07FDF (DPOTRF).
      ++ See \downlink{Manual Page}{manpageXXf07fef}.
+
   Implementation ==> add
 
     import Lisp
@@ -111966,6 +141827,93 @@ NagLapack(): Exports == Implementation where
 \begin{chunk}{COQ NAGF07}
 (* package NAGF07 *)
 (*
+
+    import Lisp
+    import DoubleFloat
+    import Any
+    import Record
+    import Integer
+    import Matrix DoubleFloat
+    import Boolean
+    import NAGLinkSupportPackage
+    import AnyFunctions1(Integer)
+    import AnyFunctions1(Matrix DoubleFloat)
+    import AnyFunctions1(String)
+    import AnyFunctions1(Matrix Integer)
+
+
+    f07adf(mArg:Integer,nArg:Integer,ldaArg:Integer,_
+        aArg:Matrix DoubleFloat): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f07adf",_
+        ["m"::S,"n"::S,"lda"::S,"info"::S,"ipiv"::S,"a"::S]$Lisp,_
+        ["ipiv"::S,"info"::S]$Lisp,_
+        [["double"::S,["a"::S,"lda"::S,"n"::S]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"lda"::S,["ipiv"::S,"m"::S]$Lisp_
+        ,"info"::S]$Lisp_
+        ]$Lisp,_
+        ["ipiv"::S,"info"::S,"a"::S]$Lisp,_
+        [([mArg::Any,nArg::Any,ldaArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f07aef(transArg:String,nArg:Integer,nrhsArg:Integer,_
+        aArg:Matrix DoubleFloat,ldaArg:Integer,ipivArg:Matrix Integer,_
+        ldbArg:Integer,bArg:Matrix DoubleFloat): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f07aef",_
+        ["trans"::S,"n"::S,"nrhs"::S,"lda"::S,"ldb"::S_
+        ,"info"::S,"a"::S,"ipiv"::S,"b"::S]$Lisp,_
+        ["info"::S]$Lisp,_
+        [["double"::S,["a"::S,"lda"::S,"n"::S]$Lisp_
+        ,["b"::S,"ldb"::S,"nrhs"::S]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"nrhs"::S,"lda"::S,["ipiv"::S,"n"::S]$Lisp_
+        ,"ldb"::S,"info"::S]$Lisp_
+        ,["character"::S,"trans"::S]$Lisp_
+        ]$Lisp,_
+        ["info"::S,"b"::S]$Lisp,_
+        [([transArg::Any,nArg::Any,nrhsArg::Any,ldaArg::Any,_
+        ldbArg::Any,aArg::Any,ipivArg::Any,bArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f07fdf(uploArg:String,nArg:Integer,ldaArg:Integer,_
+        aArg:Matrix DoubleFloat): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f07fdf",_
+        ["uplo"::S,"n"::S,"lda"::S,"info"::S,"a"::S]$Lisp,_
+        ["info"::S]$Lisp,_
+        [["double"::S,["a"::S,"lda"::S,"n"::S]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"n"::S,"lda"::S,"info"::S]$Lisp_
+        ,["character"::S,"uplo"::S]$Lisp_
+        ]$Lisp,_
+        ["info"::S,"a"::S]$Lisp,_
+        [([uploArg::Any,nArg::Any,ldaArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f07fef(uploArg:String,nArg:Integer,nrhsArg:Integer,_
+        aArg:Matrix DoubleFloat,ldaArg:Integer,ldbArg:Integer,_
+        bArg:Matrix DoubleFloat): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f07fef",_
+        ["uplo"::S,"n"::S,"nrhs"::S,"lda"::S,"ldb"::S_
+        ,"info"::S,"a"::S,"b"::S]$Lisp,_
+        ["info"::S]$Lisp,_
+        [["double"::S,["a"::S,"lda"::S,"n"::S]$Lisp_
+        ,["b"::S,"ldb"::S,"nrhs"::S]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"nrhs"::S,"lda"::S,"ldb"::S_
+        ,"info"::S]$Lisp_
+        ,["character"::S,"uplo"::S]$Lisp_
+        ]$Lisp,_
+        ["info"::S,"b"::S]$Lisp,_
+        [([uploArg::Any,nArg::Any,nrhsArg::Any,ldaArg::Any,_
+        ldbArg::Any,aArg::Any,bArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
 *)
 
 \end{chunk}
@@ -116151,6 +146099,7 @@ NagMatrixOperationsPackage(): Exports == Implementation where
      ++ unitary matrix Q, where Q is given as the product of Householder 
      ++ transformation matrices.
      ++ See \downlink{Manual Page}{manpageXXf01ref}.
+
   Implementation ==> add
 
     import Lisp
@@ -116170,7 +146119,6 @@ NagMatrixOperationsPackage(): Exports == Implementation where
     import AnyFunctions1(Matrix Complex DoubleFloat)
     import AnyFunctions1(Matrix Integer)
 
-
     f01brf(nArg:Integer,nzArg:Integer,licnArg:Integer,_
         lirnArg:Integer,pivotArg:DoubleFloat,lblockArg:Boolean,_
         growArg:Boolean,abortArg:List Boolean,aArg:Matrix DoubleFloat,_
@@ -116391,6 +146339,239 @@ NagMatrixOperationsPackage(): Exports == Implementation where
 \begin{chunk}{COQ NAGF01}
 (* package NAGF01 *)
 (*
+
+    import Lisp
+    import DoubleFloat
+    import Any
+    import Record
+    import Integer
+    import Matrix DoubleFloat
+    import Boolean
+    import NAGLinkSupportPackage
+    import AnyFunctions1(Integer)
+    import AnyFunctions1(DoubleFloat)
+    import AnyFunctions1(Boolean)
+    import AnyFunctions1(String)
+    import AnyFunctions1(List Boolean)
+    import AnyFunctions1(Matrix DoubleFloat)
+    import AnyFunctions1(Matrix Complex DoubleFloat)
+    import AnyFunctions1(Matrix Integer)
+
+    f01brf(nArg:Integer,nzArg:Integer,licnArg:Integer,_
+        lirnArg:Integer,pivotArg:DoubleFloat,lblockArg:Boolean,_
+        growArg:Boolean,abortArg:List Boolean,aArg:Matrix DoubleFloat,_
+        irnArg:Matrix Integer,icnArg:Matrix Integer,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f01brf",_
+        ["n"::S,"nz"::S,"licn"::S,"lirn"::S,"pivot"::S_
+        ,"lblock"::S,"grow"::S,"ifail"::S,"abort"::S,"ikeep"::S,_
+        "w"::S,"idisp"::S,"a"::S_
+        ,"irn"::S,"icn"::S,"iw"::S]$Lisp,_
+        ["ikeep"::S,"w"::S,"idisp"::S,"iw"::S]$Lisp,_
+        [["double"::S,"pivot"::S,["w"::S,"n"::S]$Lisp_
+        ,["a"::S,"licn"::S]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"nz"::S,"licn"::S,"lirn"::S_
+        ,["ikeep"::S,["*"::S,5$Lisp,"n"::S]$Lisp]$Lisp,_
+        ["idisp"::S,10$Lisp]$Lisp,["irn"::S,"lirn"::S]$Lisp,_
+        ["icn"::S,"licn"::S]$Lisp_
+        ,"ifail"::S,["iw"::S,["*"::S,8$Lisp,"n"::S]$Lisp]$Lisp]$Lisp_
+        ,["logical"::S,"lblock"::S,"grow"::S,["abort"::S,4$Lisp]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["ikeep"::S,"w"::S,"idisp"::S,"a"::S,"irn"::S,_
+        "icn"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,nzArg::Any,licnArg::Any,lirnArg::Any,pivotArg::Any,_
+        lblockArg::Any,growArg::Any,ifailArg::Any,abortArg::Any,_
+        aArg::Any,irnArg::Any,icnArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f01bsf(nArg:Integer,nzArg:Integer,licnArg:Integer,_
+        ivectArg:Matrix Integer,jvectArg:Matrix Integer,icnArg:Matrix Integer,_
+        ikeepArg:Matrix Integer,growArg:Boolean,etaArg:DoubleFloat,_
+        abortArg:Boolean,idispArg:Matrix Integer,avalsArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f01bsf",_
+        ["n"::S,"nz"::S,"licn"::S,"grow"::S,"eta"::S_
+        ,"abort"::S,"rpmin"::S,"ifail"::S,"ivect"::S,"jvect"::S,_
+        "icn"::S,"ikeep"::S,"idisp"::S_
+        ,"w"::S,"avals"::S,"iw"::S]$Lisp,_
+        ["w"::S,"rpmin"::S,"iw"::S]$Lisp,_
+        [["double"::S,"eta"::S,["w"::S,"n"::S]$Lisp_
+        ,"rpmin"::S,["avals"::S,"licn"::S]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"nz"::S,"licn"::S,["ivect"::S,"nz"::S]$Lisp_
+        ,["jvect"::S,"nz"::S]$Lisp,["icn"::S,"licn"::S]$Lisp,_
+        ["ikeep"::S,["*"::S,5$Lisp,"n"::S]$Lisp]$Lisp_
+        ,["idisp"::S,2$Lisp]$Lisp,"ifail"::S,_
+        ["iw"::S,["*"::S,8$Lisp,"n"::S]$Lisp]$Lisp]$Lisp_
+        ,["logical"::S,"grow"::S,"abort"::S]$Lisp_
+        ]$Lisp,_
+        ["w"::S,"rpmin"::S,"avals"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,nzArg::Any,licnArg::Any,growArg::Any,etaArg::Any,_
+        abortArg::Any,ifailArg::Any,ivectArg::Any,jvectArg::Any,icnArg::Any,_
+        ikeepArg::Any,idispArg::Any,avalsArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f01maf(nArg:Integer,nzArg:Integer,licnArg:Integer,_
+        lirnArg:Integer,abortArg:List Boolean,avalsArg:Matrix DoubleFloat,_
+        irnArg:Matrix Integer,icnArg:Matrix Integer,droptlArg:DoubleFloat,_
+        denswArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f01maf",_
+        ["n"::S,"nz"::S,"licn"::S,"lirn"::S,"droptl"::S_
+        ,"densw"::S,"ifail"::S,"abort"::S,"wkeep"::S,"ikeep"::S,_
+        "inform"::S,"avals"::S_
+        ,"irn"::S,"icn"::S,"iwork"::S]$Lisp,_
+        ["wkeep"::S,"ikeep"::S,"inform"::S,"iwork"::S]$Lisp,_
+        [["double"::S,["wkeep"::S,["*"::S,3$Lisp,"n"::S]$Lisp]$Lisp_
+        ,["avals"::S,"licn"::S]$Lisp,"droptl"::S,"densw"::S]$Lisp_
+        ,["integer"::S,"n"::S,"nz"::S,"licn"::S,"lirn"::S_
+        ,["ikeep"::S,["*"::S,2$Lisp,"n"::S]$Lisp]$Lisp,_
+        ["inform"::S,4$Lisp]$Lisp,["irn"::S,"lirn"::S]$Lisp,_
+        ["icn"::S,"licn"::S]$Lisp_
+        ,"ifail"::S,["iwork"::S,["*"::S,6$Lisp,"n"::S]$Lisp]$Lisp]$Lisp_
+        ,["logical"::S,["abort"::S,3$Lisp]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["wkeep"::S,"ikeep"::S,"inform"::S,"avals"::S,"irn"::S,_
+        "icn"::S,"droptl"::S,"densw"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,nzArg::Any,licnArg::Any,lirnArg::Any,droptlArg::Any,_
+        denswArg::Any,ifailArg::Any,abortArg::Any,avalsArg::Any,_
+        irnArg::Any,icnArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f01mcf(nArg:Integer,avalsArg:Matrix DoubleFloat,lalArg:Integer,_
+        nrowArg:Matrix Integer,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f01mcf",_
+        ["n"::S,"lal"::S,"ifail"::S,"avals"::S,"nrow"::S,"al"::S,"d"::S]$Lisp,_
+        ["al"::S,"d"::S]$Lisp,_
+        [["double"::S,["avals"::S,"lal"::S]$Lisp,["al"::S,"lal"::S]$Lisp_
+        ,["d"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"lal"::S,["nrow"::S,"n"::S]$Lisp_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["al"::S,"d"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,lalArg::Any,ifailArg::Any,avalsArg::Any,nrowArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f01qcf(mArg:Integer,nArg:Integer,ldaArg:Integer,_
+        aArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f01qcf",_
+        ["m"::S,"n"::S,"lda"::S,"ifail"::S,"zeta"::S,"a"::S]$Lisp,_
+        ["zeta"::S]$Lisp,_
+        [["double"::S,["zeta"::S,"n"::S]$Lisp,["a"::S,"lda"::S,"n"::S]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"lda"::S,"ifail"::S_
+        ]$Lisp_
+        ]$Lisp,_
+        ["zeta"::S,"a"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,nArg::Any,ldaArg::Any,ifailArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f01qdf(transArg:String,wheretArg:String,mArg:Integer,_
+        nArg:Integer,aArg:Matrix DoubleFloat,ldaArg:Integer,_
+        zetaArg:Matrix DoubleFloat,ncolbArg:Integer,ldbArg:Integer,_
+        bArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f01qdf",_
+        ["trans"::S,"wheret"::S,"m"::S,"n"::S,"lda"::S,"ncolb"::S,"ldb"::S,_
+        "ifail"::S,"a"::S,"zeta"::S,"b"::S,"work"::S]$Lisp,_
+        ["work"::S]$Lisp,_
+        [["double"::S,["a"::S,"lda"::S,"n"::S]$Lisp,["zeta"::S,"n"::S]$Lisp,_
+        ["b"::S,"ldb"::S,"ncolb"::S]$Lisp,["work"::S,"ncolb"::S]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"lda"::S,"ncolb"::S_
+        ,"ldb"::S,"ifail"::S]$Lisp_
+        ,["character"::S,"trans"::S,"wheret"::S]$Lisp_
+        ]$Lisp,_
+        ["b"::S,"ifail"::S]$Lisp,_
+        [([transArg::Any,wheretArg::Any,mArg::Any,nArg::Any,ldaArg::Any,_
+        ncolbArg::Any,ldbArg::Any,ifailArg::Any,aArg::Any,_
+        zetaArg::Any,bArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f01qef(wheretArg:String,mArg:Integer,nArg:Integer,_
+        ncolqArg:Integer,ldaArg:Integer,zetaArg:Matrix DoubleFloat,_
+        aArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f01qef",_
+        ["wheret"::S,"m"::S,"n"::S,"ncolq"::S,"lda"::S_
+        ,"ifail"::S,"zeta"::S,"a"::S,"work"::S]$Lisp,_
+        ["work"::S]$Lisp,_
+        [["double"::S,["zeta"::S,"n"::S]$Lisp,_
+        ["a"::S,"lda"::S,"ncolq"::S]$Lisp_
+        ,["work"::S,"ncolq"::S]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"ncolq"::S,"lda"::S_
+        ,"ifail"::S]$Lisp_
+        ,["character"::S,"wheret"::S]$Lisp_
+        ]$Lisp,_
+        ["a"::S,"ifail"::S]$Lisp,_
+        [([wheretArg::Any,mArg::Any,nArg::Any,ncolqArg::Any,ldaArg::Any,_
+        ifailArg::Any,zetaArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f01rcf(mArg:Integer,nArg:Integer,ldaArg:Integer,_
+        aArg:Matrix Complex DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f01rcf",_
+        ["m"::S,"n"::S,"lda"::S,"ifail"::S,"theta"::S,"a"::S]$Lisp,_
+        ["theta"::S]$Lisp,_
+        [["integer"::S,"m"::S,"n"::S,"lda"::S,"ifail"::S]$Lisp_
+        ,["double complex"::S,["theta"::S,"n"::S]$Lisp,_
+        ["a"::S,"lda"::S,"n"::S]$Lisp]$Lisp]$Lisp,_
+        ["theta"::S,"a"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,nArg::Any,ldaArg::Any,ifailArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f01rdf(transArg:String,wheretArg:String,mArg:Integer,_
+        nArg:Integer,aArg:Matrix Complex DoubleFloat,ldaArg:Integer,_
+        thetaArg:Matrix Complex DoubleFloat,ncolbArg:Integer,ldbArg:Integer,_
+        bArg:Matrix Complex DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f01rdf",_
+        ["trans"::S,"wheret"::S,"m"::S,"n"::S,"lda"::S_
+        ,"ncolb"::S,"ldb"::S,"ifail"::S,"a"::S,"theta"::S,_
+        "b"::S,"work"::S]$Lisp,["work"::S]$Lisp,_
+        [["integer"::S,"m"::S,"n"::S,"lda"::S,"ncolb"::S_
+        ,"ldb"::S,"ifail"::S]$Lisp_
+        ,["character"::S,"trans"::S,"wheret"::S]$Lisp_
+        ,["double complex"::S,["a"::S,"lda"::S,"n"::S]$Lisp,_
+        ["theta"::S,"n"::S]$Lisp,["b"::S,"ldb"::S,"ncolb"::S]$Lisp,_
+        ["work"::S,"ncolb"::S]$Lisp]$Lisp]$Lisp,_
+        ["b"::S,"ifail"::S]$Lisp,_
+        [([transArg::Any,wheretArg::Any,mArg::Any,nArg::Any,_
+        ldaArg::Any,ncolbArg::Any,ldbArg::Any,ifailArg::Any,aArg::Any,_
+        thetaArg::Any,bArg::Any ])@List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    f01ref(wheretArg:String,mArg:Integer,nArg:Integer,_
+        ncolqArg:Integer,ldaArg:Integer,thetaArg:Matrix Complex DoubleFloat,_
+        aArg:Matrix Complex DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "f01ref",_
+        ["wheret"::S,"m"::S,"n"::S,"ncolq"::S,"lda"::S_
+        ,"ifail"::S,"theta"::S,"a"::S,"work"::S]$Lisp,_
+        ["work"::S]$Lisp,_
+        [["integer"::S,"m"::S,"n"::S,"ncolq"::S,"lda"::S_
+        ,"ifail"::S]$Lisp_
+        ,["character"::S,"wheret"::S]$Lisp_
+        ,["double complex"::S,["theta"::S,"n"::S]$Lisp,_
+        ["a"::S,"lda"::S,"n"::S]$Lisp,["work"::S,"ncolq"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["a"::S,"ifail"::S]$Lisp,_
+        [([wheretArg::Any,mArg::Any,nArg::Any,ncolqArg::Any,ldaArg::Any,_
+        ifailArg::Any,thetaArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
 *)
 
 \end{chunk}
@@ -125849,6 +156030,7 @@ NagOptimisationPackage(): Exports == Implementation where
      ++ least squares problem. The estimates are derived from the 
      ++ Jacobian of the function f(x) at the solution.
      ++ See \downlink{Manual Page}{manpageXXe04ycf}.
+
   Implementation ==> add
 
     import Lisp
@@ -126159,6 +156341,310 @@ NagOptimisationPackage(): Exports == Implementation where
 \begin{chunk}{COQ NAGE04}
 (* package NAGE04 *)
 (*
+
+    import Lisp
+    import DoubleFloat
+    import Any
+    import Record
+    import Integer
+    import Matrix DoubleFloat
+    import Boolean
+    import NAGLinkSupportPackage
+    import FortranPackage
+    import Union(fn:FileName,fp:Asp49(OBJFUN))
+    import AnyFunctions1(Integer)
+    import AnyFunctions1(DoubleFloat)
+    import AnyFunctions1(Boolean)
+    import AnyFunctions1(Matrix DoubleFloat)
+    import AnyFunctions1(Matrix Integer)
+
+
+    e04dgf(nArg:Integer,esArg:DoubleFloat,fuArg:DoubleFloat,_
+        itArg:Integer,linArg:DoubleFloat,listArg:Boolean,_
+        maArg:DoubleFloat,opArg:DoubleFloat,prArg:Integer,_
+        staArg:Integer,stoArg:Integer,veArg:Integer,_
+        xArg:Matrix DoubleFloat,ifailArg:Integer,_
+        objfunArg:Union(fn:FileName,fp:Asp49(OBJFUN))): Result == 
+        pushFortranOutputStack(objfunFilename := aspFilename "objfun")$FOP
+        if objfunArg case fn
+          then outputAsFortran(objfunArg.fn)
+          else outputAsFortran(objfunArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([objfunFilename]$Lisp,_
+        "e04dgf",_
+        ["n"::S,"es"::S,"fu"::S,"it"::S,"lin"::S_
+        ,"list"::S,"ma"::S,"op"::S,"pr"::S,"sta"::S_
+        ,"sto"::S,"ve"::S,"iter"::S,"objf"::S,"ifail"::S_
+        ,"objfun"::S,"objgrd"::S,"x"::S,"iwork"::S,"work"::S,"iuser"::S_
+        ,"user"::S]$Lisp,_
+        ["iter"::S,"objf"::S,"objgrd"::S,"iwork"::S,"work"::S,"iuser"::S,_
+        "user"::S,"objfun"::S]$Lisp,_
+        [["double"::S,"es"::S,"fu"::S,"lin"::S,"ma"::S_
+        ,"op"::S,"objf"::S,["objgrd"::S,"n"::S]$Lisp,["x"::S,"n"::S]$Lisp,_
+        ["work"::S,["*"::S,13$Lisp,"n"::S]$Lisp]$Lisp,["user"::S,"*"::S]$Lisp_
+        ,"objfun"::S]$Lisp_
+        ,["integer"::S,"n"::S,"it"::S,"pr"::S,"sta"::S_
+        ,"sto"::S,"ve"::S,"iter"::S,"ifail"::S,["iwork"::S,_
+        ["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp,["iuser"::S,"*"::S]$Lisp]$Lisp_
+        ,["logical"::S,"list"::S]$Lisp_
+        ]$Lisp,_
+        ["iter"::S,"objf"::S,"objgrd"::S,"x"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,esArg::Any,fuArg::Any,itArg::Any,linArg::Any,_
+        listArg::Any,maArg::Any,opArg::Any,prArg::Any,staArg::Any,_
+        stoArg::Any,veArg::Any,ifailArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e04fdf(mArg:Integer,nArg:Integer,liwArg:Integer,_
+        lwArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer,_
+        lsfun1Arg:Union(fn:FileName,fp:Asp50(LSFUN1))): Result == 
+        pushFortranOutputStack(lsfun1Filename := aspFilename "lsfun1")$FOP
+        if lsfun1Arg case fn
+          then outputAsFortran(lsfun1Arg.fn)
+          else outputAsFortran(lsfun1Arg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([lsfun1Filename]$Lisp,_
+        "e04fdf",_
+        ["m"::S,"n"::S,"liw"::S,"lw"::S,"fsumsq"::S_
+        ,"ifail"::S,"lsfun1"::S,"w"::S,"x"::S,"iw"::S]$Lisp,_
+        ["fsumsq"::S,"w"::S,"iw"::S,"lsfun1"::S]$Lisp,_
+        [["double"::S,"fsumsq"::S,["w"::S,"lw"::S]$Lisp_
+        ,["x"::S,"n"::S]$Lisp,"lsfun1"::S]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"liw"::S,"lw"::S_
+        ,"ifail"::S,["iw"::S,"liw"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["fsumsq"::S,"w"::S,"x"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,nArg::Any,liwArg::Any,lwArg::Any,_
+        ifailArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e04gcf(mArg:Integer,nArg:Integer,liwArg:Integer,_
+        lwArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer,_
+        lsfun2Arg:Union(fn:FileName,fp:Asp19(LSFUN2))): Result == 
+        pushFortranOutputStack(lsfun2Filename := aspFilename "lsfun2")$FOP
+        if lsfun2Arg case fn
+                  then outputAsFortran(lsfun2Arg.fn)
+                  else outputAsFortran(lsfun2Arg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([lsfun2Filename]$Lisp,_
+        "e04gcf",_
+        ["m"::S,"n"::S,"liw"::S,"lw"::S,"fsumsq"::S_
+        ,"ifail"::S,"lsfun2"::S,"w"::S,"x"::S,"iw"::S]$Lisp,_
+        ["fsumsq"::S,"w"::S,"iw"::S,"lsfun2"::S]$Lisp,_
+        [["double"::S,"fsumsq"::S,["w"::S,"lw"::S]$Lisp_
+        ,["x"::S,"n"::S]$Lisp,"lsfun2"::S]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"liw"::S,"lw"::S_
+        ,"ifail"::S,["iw"::S,"liw"::S]$Lisp]$Lisp]$Lisp,_
+        ["fsumsq"::S,"w"::S,"x"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,nArg::Any,liwArg::Any,lwArg::Any,ifailArg::Any,_
+        xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e04jaf(nArg:Integer,iboundArg:Integer,liwArg:Integer,_
+        lwArg:Integer,blArg:Matrix DoubleFloat,buArg:Matrix DoubleFloat,_
+        xArg:Matrix DoubleFloat,ifailArg:Integer,_
+        funct1Arg:Union(fn:FileName,fp:Asp24(FUNCT1))): Result == 
+        pushFortranOutputStack(funct1Filename := aspFilename "funct1")$FOP
+        if funct1Arg case fn
+          then outputAsFortran(funct1Arg.fn)
+          else outputAsFortran(funct1Arg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([funct1Filename]$Lisp,_
+        "e04jaf",_
+        ["n"::S,"ibound"::S,"liw"::S,"lw"::S,"f"::S_
+        ,"ifail"::S,"funct1"::S,"bl"::S,"bu"::S,"x"::S,"iw"::S,"w"::S_
+        ]$Lisp,_
+        ["f"::S,"iw"::S,"w"::S,"funct1"::S]$Lisp,_
+        [["double"::S,"f"::S,["bl"::S,"n"::S]$Lisp_
+        ,["bu"::S,"n"::S]$Lisp,["x"::S,"n"::S]$Lisp,_
+        ["w"::S,"lw"::S]$Lisp,"funct1"::S]$Lisp_
+        ,["integer"::S,"n"::S,"ibound"::S,"liw"::S_
+        ,"lw"::S,"ifail"::S,["iw"::S,"liw"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["f"::S,"bl"::S,"bu"::S,"x"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,iboundArg::Any,liwArg::Any,lwArg::Any,_
+        ifailArg::Any,blArg::Any,buArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e04mbf(itmaxArg:Integer,msglvlArg:Integer,nArg:Integer,_
+        nclinArg:Integer,nctotlArg:Integer,nrowaArg:Integer,_
+        aArg:Matrix DoubleFloat,blArg:Matrix DoubleFloat,_
+        buArg:Matrix DoubleFloat,_
+        cvecArg:Matrix DoubleFloat,linobjArg:Boolean,liworkArg:Integer,_
+        lworkArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e04mbf",_
+        ["itmax"::S,"msglvl"::S,"n"::S,"nclin"::S,"nctotl"::S_
+        ,"nrowa"::S,"linobj"::S,"liwork"::S,"lwork"::S,"objlp"::S_
+        ,"ifail"::S,"a"::S,"bl"::S,"bu"::S,"cvec"::S,"istate"::S_
+        ,"clamda"::S,"x"::S,"iwork"::S,"work"::S]$Lisp,_
+        ["istate"::S,"objlp"::S,"clamda"::S,"iwork"::S,"work"::S]$Lisp,_
+        [["double"::S,["a"::S,"nrowa"::S,"n"::S]$Lisp_
+        ,["bl"::S,"nctotl"::S]$Lisp,["bu"::S,"nctotl"::S]$Lisp,_
+        ["cvec"::S,"n"::S]$Lisp,"objlp"::S,["clamda"::S,"nctotl"::S]$Lisp_
+        ,["x"::S,"n"::S]$Lisp,["work"::S,"lwork"::S]$Lisp]$Lisp_
+        ,["integer"::S,"itmax"::S,"msglvl"::S,"n"::S_
+        ,"nclin"::S,"nctotl"::S,"nrowa"::S,"liwork"::S,"lwork"::S,_
+        ["istate"::S,"nctotl"::S]$Lisp,"ifail"::S,_
+        ["iwork"::S,"liwork"::S]$Lisp]$Lisp_
+        ,["logical"::S,"linobj"::S]$Lisp]$Lisp,_
+        ["istate"::S,"objlp"::S,"clamda"::S,"x"::S,"ifail"::S]$Lisp,_
+        [([itmaxArg::Any,msglvlArg::Any,nArg::Any,nclinArg::Any,_
+        nctotlArg::Any,nrowaArg::Any,linobjArg::Any,liworkArg::Any,_
+        lworkArg::Any,ifailArg::Any,aArg::Any,blArg::Any,buArg::Any,_
+        cvecArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e04naf(itmaxArg:Integer,msglvlArg:Integer,nArg:Integer,_
+        nclinArg:Integer,nctotlArg:Integer,nrowaArg:Integer,_
+        nrowhArg:Integer,ncolhArg:Integer,bigbndArg:DoubleFloat,_
+        aArg:Matrix DoubleFloat,blArg:Matrix DoubleFloat,_
+        buArg:Matrix DoubleFloat,_
+        cvecArg:Matrix DoubleFloat,featolArg:Matrix DoubleFloat,_
+        hessArg:Matrix DoubleFloat,_
+        coldArg:Boolean,lppArg:Boolean,orthogArg:Boolean,_
+        liworkArg:Integer,lworkArg:Integer,xArg:Matrix DoubleFloat,_
+        istateArg:Matrix Integer,ifailArg:Integer,_
+        qphessArg:Union(fn:FileName,fp:Asp20(QPHESS))): Result == 
+        pushFortranOutputStack(qphessFilename := aspFilename "qphess")$FOP
+        if qphessArg case fn
+          then outputAsFortran(qphessArg.fn)
+          else outputAsFortran(qphessArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([qphessFilename]$Lisp,_
+        "e04naf",_
+        ["itmax"::S,"msglvl"::S,"n"::S,"nclin"::S,"nctotl"::S_
+        ,"nrowa"::S,"nrowh"::S,"ncolh"::S,"bigbnd"::S,"cold"::S_
+        ,"lpp"::S,"orthog"::S,"liwork"::S,"lwork"::S,"iter"::S_
+        ,"obj"::S,"ifail"::S,"qphess"::S,"a"::S,"bl"::S,"bu"::S,_
+        "cvec"::S,"featol"::S_
+        ,"hess"::S,"clamda"::S,"x"::S,"istate"::S,"iwork"::S_
+        ,"work"::S]$Lisp,_
+        ["iter"::S,"obj"::S,"clamda"::S,"iwork"::S,"work"::S,_
+        "qphess"::S]$Lisp,_
+        [["double"::S,"bigbnd"::S,["a"::S,"nrowa"::S,"n"::S]$Lisp_
+        ,["bl"::S,"nctotl"::S]$Lisp,["bu"::S,"nctotl"::S]$Lisp,_
+        ["cvec"::S,"n"::S]$Lisp,["featol"::S,"nctotl"::S]$Lisp_
+        ,["hess"::S,"nrowh"::S,"ncolh"::S]$Lisp,"obj"::S,_
+        ["clamda"::S,"nctotl"::S]$Lisp,["x"::S,"n"::S]$Lisp,_
+        ["work"::S,"lwork"::S]$Lisp_
+        ,"qphess"::S]$Lisp_
+        ,["integer"::S,"itmax"::S,"msglvl"::S,"n"::S_
+        ,"nclin"::S,"nctotl"::S,"nrowa"::S,"nrowh"::S,"ncolh"::S,_
+        "liwork"::S,"lwork"::S,"iter"::S,["istate"::S,"nctotl"::S]$Lisp_
+        ,"ifail"::S,["iwork"::S,"liwork"::S]$Lisp]$Lisp_
+        ,["logical"::S,"cold"::S,"lpp"::S,"orthog"::S]$Lisp_
+        ]$Lisp,_
+        ["iter"::S,"obj"::S,"clamda"::S,"x"::S,"istate"::S,"ifail"::S]$Lisp,_
+        [([itmaxArg::Any,msglvlArg::Any,nArg::Any,nclinArg::Any,_
+        nctotlArg::Any,nrowaArg::Any,nrowhArg::Any,ncolhArg::Any,_
+        bigbndArg::Any,coldArg::Any,lppArg::Any,orthogArg::Any,_
+        liworkArg::Any,lworkArg::Any,ifailArg::Any,aArg::Any,blArg::Any,_
+        buArg::Any,cvecArg::Any,featolArg::Any,hessArg::Any,xArg::Any,_
+        istateArg::Any ])@List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e04ucf(nArg:Integer,nclinArg:Integer,ncnlnArg:Integer,_
+        nrowaArg:Integer,nrowjArg:Integer,nrowrArg:Integer,_
+        aArg:Matrix DoubleFloat,blArg:Matrix DoubleFloat,_
+        buArg:Matrix DoubleFloat,_
+        liworkArg:Integer,lworkArg:Integer,staArg:Boolean,_
+        craArg:DoubleFloat,derArg:Integer,feaArg:DoubleFloat,_
+        funArg:DoubleFloat,hesArg:Boolean,infbArg:DoubleFloat,_
+        infsArg:DoubleFloat,linfArg:DoubleFloat,lintArg:DoubleFloat,_
+        listArg:Boolean,majiArg:Integer,majpArg:Integer,_
+        miniArg:Integer,minpArg:Integer,monArg:Integer,_
+        nonfArg:DoubleFloat,optArg:DoubleFloat,steArg:DoubleFloat,_
+        staoArg:Integer,stacArg:Integer,stooArg:Integer,_
+        stocArg:Integer,veArg:Integer,istateArg:Matrix Integer,_
+        cjacArg:Matrix DoubleFloat,clamdaArg:Matrix DoubleFloat,_
+        rArg:Matrix DoubleFloat,_
+        xArg:Matrix DoubleFloat,ifailArg:Integer,_
+        confunArg:Union(fn:FileName,fp:Asp55(CONFUN)),_
+        objfunArg:Union(fn:FileName,fp:Asp49(OBJFUN))): Result == 
+        pushFortranOutputStack(confunFilename := aspFilename "confun")$FOP
+        if confunArg case fn
+          then outputAsFortran(confunArg.fn)
+          else outputAsFortran(confunArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(objfunFilename := aspFilename "objfun")$FOP
+        if objfunArg case fn
+          then outputAsFortran(objfunArg.fn)
+          else outputAsFortran(objfunArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([confunFilename,objfunFilename]$Lisp,_
+        "e04ucf",_
+        ["n"::S,"nclin"::S,"ncnln"::S,"nrowa"::S,"nrowj"::S_
+        ,"nrowr"::S,"liwork"::S,"lwork"::S,"sta"::S,"cra"::S_
+        ,"der"::S,"fea"::S,"fun"::S,"hes"::S,"infb"::S_
+        ,"infs"::S,"linf"::S,"lint"::S,"list"::S,"maji"::S_
+        ,"majp"::S,"mini"::S,"minp"::S,"mon"::S,"nonf"::S_
+        ,"opt"::S,"ste"::S,"stao"::S,"stac"::S,"stoo"::S_
+        ,"stoc"::S,"ve"::S,"iter"::S,"objf"::S,"ifail"::S_
+        ,"confun"::S,"objfun"::S,"a"::S,"bl"::S,"bu"::S,"c"::S,"objgrd"::S_
+        ,"istate"::S,"cjac"::S,"clamda"::S,"r"::S,"x"::S_
+        ,"iwork"::S,"work"::S,"iuser"::S,"user"::S]$Lisp,_
+        ["iter"::S,"c"::S,"objf"::S,"objgrd"::S,"iwork"::S,"work"::S,_
+        "iuser"::S,"user"::S,"confun"::S,"objfun"::S]$Lisp,_
+        [["double"::S,["a"::S,"nrowa"::S,"n"::S]$Lisp_
+        ,["bl"::S,["+"::S,["+"::S,"nclin"::S,"ncnln"::S]$Lisp,_
+        "n"::S]$Lisp]$Lisp,["bu"::S,["+"::S,["+"::S,"nclin"::S,_
+        "ncnln"::S]$Lisp,"n"::S]$Lisp]$Lisp_
+        ,"cra"::S,"fea"::S,"fun"::S,"infb"::S,"infs"::S,"linf"::S,_
+        "lint"::S,"nonf"::S,"opt"::S,"ste"::S_
+        ,["c"::S,"ncnln"::S]$Lisp,"objf"::S,["objgrd"::S,"n"::S]$Lisp,_
+        ["cjac"::S,"nrowj"::S,"n"::S]$Lisp,["clamda"::S,["+"::S,_
+        ["+"::S,"nclin"::S,"ncnln"::S]$Lisp,"n"::S]$Lisp]$Lisp_
+        ,["r"::S,"nrowr"::S,"n"::S]$Lisp,["x"::S,"n"::S]$Lisp,_
+        ["work"::S,"lwork"::S]$Lisp_
+        ,["user"::S,1$Lisp]$Lisp,"confun"::S,"objfun"::S]$Lisp_
+        ,["integer"::S,"n"::S,"nclin"::S,"ncnln"::S_
+        ,"nrowa"::S,"nrowj"::S,"nrowr"::S,"liwork"::S,"lwork"::S,"der"::S,_
+        "maji"::S,"majp"::S,"mini"::S,"minp"::S,"mon"::S,"stao"::S_
+        ,"stac"::S,"stoo"::S,"stoc"::S,"ve"::S,"iter"::S,["istate"::S,_
+        ["+"::S,["+"::S,"nclin"::S,"ncnln"::S]$Lisp,"n"::S]$Lisp]$Lisp_
+        ,"ifail"::S,["iwork"::S,"liwork"::S]$Lisp,_
+        ["iuser"::S,1$Lisp]$Lisp]$Lisp_
+        ,["logical"::S,"sta"::S,"hes"::S,"list"::S]$Lisp_
+        ]$Lisp,_
+        ["iter"::S,"c"::S,"objf"::S,"objgrd"::S,"istate"::S,"cjac"::S,_
+        "clamda"::S,"r"::S,"x"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,nclinArg::Any,ncnlnArg::Any,nrowaArg::Any,_
+        nrowjArg::Any,nrowrArg::Any,liworkArg::Any,lworkArg::Any,_
+        staArg::Any,craArg::Any,derArg::Any,feaArg::Any,funArg::Any,_
+        hesArg::Any,infbArg::Any,infsArg::Any,linfArg::Any,lintArg::Any,_
+        listArg::Any,majiArg::Any,majpArg::Any,miniArg::Any,minpArg::Any,_
+        monArg::Any,nonfArg::Any,optArg::Any,steArg::Any,staoArg::Any,_
+        stacArg::Any,stooArg::Any,stocArg::Any,veArg::Any,ifailArg::Any,_
+        aArg::Any,blArg::Any,buArg::Any,istateArg::Any,cjacArg::Any,_
+        clamdaArg::Any,rArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    e04ycf(jobArg:Integer,mArg:Integer,nArg:Integer,_
+        fsumsqArg:DoubleFloat,sArg:Matrix DoubleFloat,lvArg:Integer,_
+        vArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "e04ycf",_
+        ["job"::S,"m"::S,"n"::S,"fsumsq"::S,"lv"::S_
+        ,"ifail"::S,"s"::S,"cj"::S,"v"::S,"work"::S]$Lisp,_
+        ["cj"::S,"work"::S]$Lisp,_
+        [["double"::S,"fsumsq"::S,["s"::S,"n"::S]$Lisp_
+        ,["cj"::S,"n"::S]$Lisp,["v"::S,"lv"::S,"n"::S]$Lisp,_
+        ["work"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"job"::S,"m"::S,"n"::S,"lv"::S_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["cj"::S,"v"::S,"ifail"::S]$Lisp,_
+        [([jobArg::Any,mArg::Any,nArg::Any,fsumsqArg::Any,lvArg::Any,_
+        ifailArg::Any,sArg::Any,vArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
 *)
 
 \end{chunk}
@@ -130833,6 +161319,7 @@ NagOrdinaryDifferentialEquationsPackage(): Exports == Implementation where
      ++ equations, using a deferred correction technique and Newton 
      ++ iteration.
      ++ See \downlink{Manual Page}{manpageXXd02raf}.
+
   Implementation ==> add
 
     import Lisp
@@ -131196,6 +161683,363 @@ NagOrdinaryDifferentialEquationsPackage(): Exports == Implementation where
 \begin{chunk}{COQ NAGD02}
 (* package NAGD02 *)
 (*
+
+    import Lisp
+    import DoubleFloat
+    import Any
+    import Record
+    import Integer
+    import Matrix DoubleFloat
+    import Boolean
+    import NAGLinkSupportPackage
+    import FortranPackage
+    import Union(fn:FileName,fp:Asp7(FCN))
+    import Union(fn:FileName,fp:Asp8(OUTPUT))
+    import AnyFunctions1(DoubleFloat)
+    import AnyFunctions1(Integer)
+    import AnyFunctions1(String)
+    import AnyFunctions1(Matrix DoubleFloat)
+
+
+    d02bbf(xendArg:DoubleFloat,mArg:Integer,nArg:Integer,_
+        irelabArg:Integer,xArg:DoubleFloat,yArg:Matrix DoubleFloat,_
+        tolArg:DoubleFloat,ifailArg:Integer,_
+        fcnArg:Union(fn:FileName,fp:Asp7(FCN)),_
+        outputArg:Union(fn:FileName,fp:Asp8(OUTPUT))): Result == 
+        pushFortranOutputStack(fcnFilename := aspFilename "fcn")$FOP
+        if fcnArg case fn
+          then outputAsFortran(fcnArg.fn)
+          else outputAsFortran(fcnArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(outputFilename := aspFilename "output")$FOP
+        if outputArg case fn
+          then outputAsFortran(outputArg.fn)
+          else outputAsFortran(outputArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([fcnFilename, outputFilename]$Lisp,_
+        "d02bbf",_
+        ["xend"::S,"m"::S,"n"::S,"irelab"::S,"x"::S,"tol"::S,"ifail"::S,_
+        "fcn"::S,"output"::S,"result"::S,"y"::S,"w"::S]$Lisp,_
+        ["result"::S,"w"::S,"fcn"::S,"output"::S]$Lisp,_
+        [["double"::S,"xend"::S,["result"::S,"m"::S,"n"::S]$Lisp_
+        ,"x"::S,["y"::S,"n"::S]$Lisp,"tol"::S,["w"::S,"n"::S,7$Lisp]$Lisp,_
+        "fcn"::S,"output"::S]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"irelab"::S,"ifail"::S]$Lisp]$Lisp,_
+        ["result"::S,"x"::S,"y"::S,"tol"::S,"ifail"::S]$Lisp,_
+        [([xendArg::Any,mArg::Any,nArg::Any,irelabArg::Any,xArg::Any,_
+        tolArg::Any,ifailArg::Any,yArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d02bhf(xendArg:DoubleFloat,nArg:Integer,irelabArg:Integer,_
+        hmaxArg:DoubleFloat,xArg:DoubleFloat,yArg:Matrix DoubleFloat,_
+        tolArg:DoubleFloat,ifailArg:Integer,_
+        gArg:Union(fn:FileName,fp:Asp9(G)),_
+        fcnArg:Union(fn:FileName,fp:Asp7(FCN))): Result == 
+        pushFortranOutputStack(gFilename := aspFilename "g")$FOP
+        if gArg case fn
+          then outputAsFortran(gArg.fn)
+          else outputAsFortran(gArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(fcnFilename := aspFilename "fcn")$FOP
+        if fcnArg case fn
+          then outputAsFortran(fcnArg.fn)
+          else outputAsFortran(fcnArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([gFilename,fcnFilename]$Lisp,_
+        "d02bhf",_
+        ["xend"::S,"n"::S,"irelab"::S,"hmax"::S,"x"::S_
+        ,"tol"::S,"ifail"::S,"g"::S,"fcn"::S,"y"::S,"w"::S]$Lisp,_
+        ["w"::S,"g"::S,"fcn"::S]$Lisp,_
+        [["double"::S,"xend"::S,"hmax"::S,"x"::S,["y"::S,"n"::S]$Lisp_
+        ,"tol"::S,["w"::S,"n"::S,7$Lisp]$Lisp,"g"::S,"fcn"::S]$Lisp_
+        ,["integer"::S,"n"::S,"irelab"::S,"ifail"::S]$Lisp]$Lisp,_
+        ["x"::S,"y"::S,"tol"::S,"ifail"::S]$Lisp,_
+        [([xendArg::Any,nArg::Any,irelabArg::Any,hmaxArg::Any,_
+        xArg::Any,tolArg::Any,ifailArg::Any,yArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d02cjf(xendArg:DoubleFloat,mArg:Integer,nArg:Integer,_
+        tolArg:DoubleFloat,relabsArg:String,xArg:DoubleFloat,_
+        yArg:Matrix DoubleFloat,ifailArg:Integer,_
+        gArg:Union(fn:FileName,fp:Asp9(G)),_
+        fcnArg:Union(fn:FileName,fp:Asp7(FCN)),_
+        outputArg:Union(fn:FileName,fp:Asp8(OUTPUT))): Result == 
+        pushFortranOutputStack(gFilename := aspFilename "g")$FOP
+        if gArg case fn
+          then outputAsFortran(gArg.fn)
+          else outputAsFortran(gArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(fcnFilename := aspFilename "fcn")$FOP
+        if fcnArg case fn
+          then outputAsFortran(fcnArg.fn)
+          else outputAsFortran(fcnArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(outputFilename := aspFilename "output")$FOP
+        if outputArg case fn
+          then outputAsFortran(outputArg.fn)
+          else outputAsFortran(outputArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([gFilename,fcnFilename,outputFilename]$Lisp,_
+        "d02cjf",_
+        ["xend"::S,"m"::S,"n"::S,"tol"::S,"relabs"::S_
+        ,"x"::S,"ifail"::S,"g"::S,"fcn"::S,"output"::S_
+        ,"result"::S,"y"::S,"w"::S]$Lisp,_
+        ["result"::S,"w"::S,"g"::S,"fcn"::S,"output"::S]$Lisp,_
+        [["double"::S,"xend"::S,"tol"::S,["result"::S,"m"::S,"n"::S]$Lisp_
+        ,"x"::S,["y"::S,"n"::S]$Lisp,["w"::S,["+"::S,_
+        ["*"::S,21$Lisp,"n"::S]$Lisp,28$Lisp]$Lisp]$Lisp,"g"::S_
+        ,"fcn"::S,"output"::S]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_
+        ,["character"::S,"relabs"::S]$Lisp]$Lisp,_
+        ["result"::S,"x"::S,"y"::S,"ifail"::S]$Lisp,_
+        [([xendArg::Any,mArg::Any,nArg::Any,tolArg::Any,relabsArg::Any,_
+        xArg::Any,ifailArg::Any,yArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d02ejf(xendArg:DoubleFloat,mArg:Integer,nArg:Integer,_
+        relabsArg:String,iwArg:Integer,xArg:DoubleFloat,_
+        yArg:Matrix DoubleFloat,tolArg:DoubleFloat,ifailArg:Integer,_
+        gArg:Union(fn:FileName,fp:Asp9(G)),_
+        fcnArg:Union(fn:FileName,fp:Asp7(FCN)),_
+        pedervArg:Union(fn:FileName,fp:Asp31(PEDERV)),_
+        outputArg:Union(fn:FileName,fp:Asp8(OUTPUT))): Result == 
+        pushFortranOutputStack(gFilename := aspFilename "g")$FOP
+        if gArg case fn
+          then outputAsFortran(gArg.fn)
+          else outputAsFortran(gArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(fcnFilename := aspFilename "fcn")$FOP
+        if fcnArg case fn
+          then outputAsFortran(fcnArg.fn)
+          else outputAsFortran(fcnArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(pedervFilename := aspFilename "pederv")$FOP
+        if pedervArg case fn
+          then outputAsFortran(pedervArg.fn)
+          else outputAsFortran(pedervArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(outputFilename := aspFilename "output")$FOP
+        if outputArg case fn
+          then outputAsFortran(outputArg.fn)
+          else outputAsFortran(outputArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([gFilename,fcnFilename,pedervFilename,_
+        outputFilename]$Lisp,_
+        "d02ejf",_
+        ["xend"::S,"m"::S,"n"::S,"relabs"::S,"iw"::S_
+        ,"x"::S,"tol"::S,"ifail"::S,"g"::S,"fcn"::S_
+        ,"pederv"::S,"output"::S,"result"::S,"y"::S,"w"::S]$Lisp,_
+        ["result"::S,"w"::S,"g"::S,"fcn"::S,"pederv"::S,"output"::S]$Lisp,_
+        [["double"::S,"xend"::S,["result"::S,"m"::S,"n"::S]$Lisp_
+        ,"x"::S,["y"::S,"n"::S]$Lisp,"tol"::S,["w"::S,"iw"::S]$Lisp,_
+        "g"::S,"fcn"::S,"pederv"::S,"output"::S]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"iw"::S,"ifail"::S_
+        ]$Lisp_
+        ,["character"::S,"relabs"::S]$Lisp_
+        ]$Lisp,_
+        ["result"::S,"x"::S,"y"::S,"tol"::S,"ifail"::S]$Lisp,_
+        [([xendArg::Any,mArg::Any,nArg::Any,relabsArg::Any,iwArg::Any,_
+        xArg::Any,tolArg::Any,ifailArg::Any,yArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d02gaf(uArg:Matrix DoubleFloat,vArg:Matrix DoubleFloat,nArg:Integer,_
+        aArg:DoubleFloat,bArg:DoubleFloat,tolArg:DoubleFloat,_
+        mnpArg:Integer,lwArg:Integer,liwArg:Integer,_
+        xArg:Matrix DoubleFloat,npArg:Integer,ifailArg:Integer,_
+        fcnArg:Union(fn:FileName,fp:Asp7(FCN))): Result == 
+        pushFortranOutputStack(fcnFilename := aspFilename "fcn")$FOP
+        if fcnArg case fn
+          then outputAsFortran(fcnArg.fn)
+          else outputAsFortran(fcnArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([fcnFilename]$Lisp,_
+        "d02gaf",_
+        ["n"::S,"a"::S,"b"::S,"tol"::S,"mnp"::S_
+        ,"lw"::S,"liw"::S,"np"::S,"ifail"::S,"fcn"::S_
+        ,"u"::S,"v"::S,"y"::S,"x"::S,"w"::S_
+        ,"iw"::S]$Lisp,_
+        ["y"::S,"w"::S,"iw"::S,"fcn"::S]$Lisp,_
+        [["double"::S,["u"::S,"n"::S,2$Lisp]$Lisp,["v"::S,"n"::S,2$Lisp]$Lisp_
+        ,"a"::S,"b"::S,"tol"::S,["y"::S,"n"::S,"mnp"::S]$Lisp,_
+        ["x"::S,"mnp"::S]$Lisp,["w"::S,"lw"::S]$Lisp_
+        ,"fcn"::S]$Lisp_
+        ,["integer"::S,"n"::S,"mnp"::S,"lw"::S,"liw"::S_
+        ,"np"::S,"ifail"::S,["iw"::S,"liw"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["y"::S,"x"::S,"np"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,aArg::Any,bArg::Any,tolArg::Any,mnpArg::Any,_
+        lwArg::Any,liwArg::Any,npArg::Any,ifailArg::Any,uArg::Any,_
+        vArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d02gbf(aArg:DoubleFloat,bArg:DoubleFloat,nArg:Integer,_
+        tolArg:DoubleFloat,mnpArg:Integer,lwArg:Integer,_
+        liwArg:Integer,cArg:Matrix DoubleFloat,dArg:Matrix DoubleFloat,_
+        gamArg:Matrix DoubleFloat,xArg:Matrix DoubleFloat,npArg:Integer,_
+        ifailArg:Integer,fcnfArg:Union(fn:FileName,fp:Asp77(FCNF)),_
+        fcngArg:Union(fn:FileName,fp:Asp78(FCNG))): Result == 
+        pushFortranOutputStack(fcnfFilename := aspFilename "fcnf")$FOP
+        if fcnfArg case fn
+          then outputAsFortran(fcnfArg.fn)
+          else outputAsFortran(fcnfArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(fcngFilename := aspFilename "fcng")$FOP
+        if fcngArg case fn
+          then outputAsFortran(fcngArg.fn)
+          else outputAsFortran(fcngArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([fcnfFilename,fcngFilename]$Lisp,_
+        "d02gbf",_
+        ["a"::S,"b"::S,"n"::S,"tol"::S,"mnp"::S_
+        ,"lw"::S,"liw"::S,"np"::S,"ifail"::S,"fcnf"::S_
+        ,"fcng"::S,"y"::S,"c"::S,"d"::S,"gam"::S,"x"::S_
+        ,"w"::S,"iw"::S]$Lisp,_
+        ["y"::S,"w"::S,"iw"::S,"fcnf"::S,"fcng"::S]$Lisp,_
+        [["double"::S,"a"::S,"b"::S,"tol"::S,["y"::S,"n"::S,"mnp"::S]$Lisp_
+        ,["c"::S,"n"::S,"n"::S]$Lisp,["d"::S,"n"::S,"n"::S]$Lisp,_
+        ["gam"::S,"n"::S]$Lisp,["x"::S,"mnp"::S]$Lisp_
+        ,["w"::S,"lw"::S]$Lisp,"fcnf"::S,"fcng"::S]$Lisp_
+        ,["integer"::S,"n"::S,"mnp"::S,"lw"::S,"liw"::S_
+        ,"np"::S,"ifail"::S,["iw"::S,"liw"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["y"::S,"c"::S,"d"::S,"gam"::S,"x"::S,"np"::S,"ifail"::S]$Lisp,_
+        [([aArg::Any,bArg::Any,nArg::Any,tolArg::Any,mnpArg::Any,lwArg::Any,_
+        liwArg::Any,npArg::Any,ifailArg::Any,cArg::Any,dArg::Any,_
+        gamArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d02kef(xpointArg:Matrix DoubleFloat,mArg:Integer,kArg:Integer,_
+        tolArg:DoubleFloat,maxfunArg:Integer,matchArg:Integer,_
+        elamArg:DoubleFloat,delamArg:DoubleFloat,hmaxArg:Matrix DoubleFloat,_
+        maxitArg:Integer,ifailArg:Integer,_
+        coeffnArg:Union(fn:FileName,fp:Asp10(COEFFN)),_
+        bdyvalArg:Union(fn:FileName,fp:Asp80(BDYVAL))): Result == 
+        pushFortranOutputStack(coeffnFilename := aspFilename "coeffn")$FOP
+        if coeffnArg case fn
+          then outputAsFortran(coeffnArg.fn)
+          else outputAsFortran(coeffnArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(bdyvalFilename := aspFilename "bdyval")$FOP
+        if bdyvalArg case fn
+          then outputAsFortran(bdyvalArg.fn)
+          else outputAsFortran(bdyvalArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(monitFilename := aspFilename "monit")$FOP
+        outputAsFortran()$Asp12(MONIT)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(reportFilename := aspFilename "report")$FOP
+        outputAsFortran()$Asp33(REPORT)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([coeffnFilename,bdyvalFilename,monitFilename,_
+        reportFilename]$Lisp,_
+        "d02kef",_
+        ["m"::S,"k"::S,"tol"::S,"maxfun"::S,"match"::S_
+        ,"elam"::S,"delam"::S,"maxit"::S,"ifail"::S,"coeffn"::S_
+        ,"bdyval"::S,"monit"::S,"report"::S,"xpoint"::S,"hmax"::S]$Lisp,_
+        ["coeffn"::S,"bdyval"::S,"monit"::S,"report"::S]$Lisp,_
+        [["double"::S,["xpoint"::S,"m"::S]$Lisp,"tol"::S_
+        ,"elam"::S,"delam"::S,["hmax"::S,2$Lisp,"m"::S]$Lisp,_
+        "coeffn"::S,"bdyval"::S,"monit"::S,"report"::S]$Lisp_
+        ,["integer"::S,"m"::S,"k"::S,"maxfun"::S,"match"::S_
+        ,"maxit"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["match"::S,"elam"::S,"delam"::S,"hmax"::S,"maxit"::S,_
+        "ifail"::S]$Lisp,_
+        [([mArg::Any,kArg::Any,tolArg::Any,maxfunArg::Any,matchArg::Any,_
+        elamArg::Any,delamArg::Any,maxitArg::Any,ifailArg::Any,_
+        xpointArg::Any,hmaxArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d02kef(xpointArg:Matrix DoubleFloat,mArg:Integer,kArg:Integer,_
+        tolArg:DoubleFloat,maxfunArg:Integer,matchArg:Integer,_
+        elamArg:DoubleFloat,delamArg:DoubleFloat,hmaxArg:Matrix DoubleFloat,_
+        maxitArg:Integer,ifailArg:Integer,_
+        coeffnArg:Union(fn:FileName,fp:Asp10(COEFFN)),_
+        bdyvalArg:Union(fn:FileName,fp:Asp80(BDYVAL)),_
+        monitArg:FileName,reportArg:FileName): Result == 
+        pushFortranOutputStack(coeffnFilename := aspFilename "coeffn")$FOP
+        if coeffnArg case fn
+          then outputAsFortran(coeffnArg.fn)
+          else outputAsFortran(coeffnArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(bdyvalFilename := aspFilename "bdyval")$FOP
+        if bdyvalArg case fn
+          then outputAsFortran(bdyvalArg.fn)
+          else outputAsFortran(bdyvalArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(monitFilename := aspFilename "monit")$FOP
+        outputAsFortran(monitArg)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(reportFilename := aspFilename "report")$FOP
+        outputAsFortran(reportArg)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([coeffnFilename,bdyvalFilename,monitFilename,_
+        reportFilename]$Lisp,_
+        "d02kef",_
+        ["m"::S,"k"::S,"tol"::S,"maxfun"::S,"match"::S_
+        ,"elam"::S,"delam"::S,"maxit"::S,"ifail"::S,"coeffn"::S_
+        ,"bdyval"::S,"monit"::S,"report"::S,"xpoint"::S,"hmax"::S]$Lisp,_
+        ["coeffn"::S,"bdyval"::S,"monit"::S,"report"::S]$Lisp,_
+        [["double"::S,["xpoint"::S,"m"::S]$Lisp,"tol"::S_
+        ,"elam"::S,"delam"::S,["hmax"::S,2$Lisp,"m"::S]$Lisp,_
+        "coeffn"::S,"bdyval"::S,"monit"::S,"report"::S]$Lisp_
+        ,["integer"::S,"m"::S,"k"::S,"maxfun"::S,"match"::S_
+        ,"maxit"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["match"::S,"elam"::S,"delam"::S,"hmax"::S,"maxit"::S,_
+        "ifail"::S]$Lisp,_
+        [([mArg::Any,kArg::Any,tolArg::Any,maxfunArg::Any,_
+        matchArg::Any,elamArg::Any,delamArg::Any,maxitArg::Any,_
+        ifailArg::Any,xpointArg::Any,hmaxArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d02raf(nArg:Integer,mnpArg:Integer,numbegArg:Integer,_
+        nummixArg:Integer,tolArg:DoubleFloat,initArg:Integer,_
+        iyArg:Integer,ijacArg:Integer,lworkArg:Integer,_
+        liworkArg:Integer,npArg:Integer,xArg:Matrix DoubleFloat,_
+        yArg:Matrix DoubleFloat,delepsArg:DoubleFloat,ifailArg:Integer,_
+        fcnArg:Union(fn:FileName,fp:Asp41(FCN,JACOBF,JACEPS)),_
+        gArg:Union(fn:FileName,fp:Asp42(G,JACOBG,JACGEP))): Result == 
+        pushFortranOutputStack(fcnFilename := aspFilename "fcn")$FOP
+        if fcnArg case fn
+          then outputAsFortran(fcnArg.fn)
+          else outputAsFortran(fcnArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(gFilename := aspFilename "g")$FOP
+        if gArg case fn
+          then outputAsFortran(gArg.fn)
+          else outputAsFortran(gArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([fcnFilename,gFilename]$Lisp,_
+        "d02raf",_
+        ["n"::S,"mnp"::S,"numbeg"::S,"nummix"::S,"tol"::S_
+        ,"init"::S,"iy"::S,"ijac"::S,"lwork"::S,"liwork"::S_
+        ,"np"::S,"deleps"::S,"ifail"::S,"fcn"::S,"g"::S_
+        ,"abt"::S,"x"::S,"y"::S,"work"::S,"iwork"::S_
+        ]$Lisp,_
+        ["abt"::S,"work"::S,"iwork"::S,"fcn"::S,"g"::S]$Lisp,_
+        [["double"::S,"tol"::S,["abt"::S,"n"::S]$Lisp_
+        ,["x"::S,"mnp"::S]$Lisp,["y"::S,"iy"::S,"mnp"::S]$Lisp,_
+        "deleps"::S,["work"::S,"lwork"::S]$Lisp,"fcn"::S,"g"::S]$Lisp_
+        ,["integer"::S,"n"::S,"mnp"::S,"numbeg"::S_
+        ,"nummix"::S,"init"::S,"iy"::S,"ijac"::S,"lwork"::S,"liwork"::S,_
+        "np"::S,"ifail"::S,["iwork"::S,"liwork"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["abt"::S,"np"::S,"x"::S,"y"::S,"deleps"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,mnpArg::Any,numbegArg::Any,nummixArg::Any,tolArg::Any,_
+        initArg::Any,iyArg::Any,ijacArg::Any,lworkArg::Any,liworkArg::Any,_
+        npArg::Any,delepsArg::Any,ifailArg::Any,xArg::Any,yArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
 *)
 
 \end{chunk}
@@ -133073,6 +163917,7 @@ NagPartialDifferentialEquationsPackage(): Exports == Implementation where
      ++ approximation. This routine is designed to be particularly 
      ++ efficient on vector processors.
      ++ See \downlink{Manual Page}{manpageXXd03faf}.
+
   Implementation ==> add
 
     import Lisp
@@ -133194,6 +164039,121 @@ NagPartialDifferentialEquationsPackage(): Exports == Implementation where
 \begin{chunk}{COQ NAGD03}
 (* package NAGD03 *)
 (*
+
+    import Lisp
+    import DoubleFloat
+    import Any
+    import Record
+    import Integer
+    import Matrix DoubleFloat
+    import Boolean
+    import NAGLinkSupportPackage
+    import AnyFunctions1(Integer)
+    import AnyFunctions1(String)
+    import AnyFunctions1(DoubleFloat)
+    import AnyFunctions1(Matrix DoubleFloat)
+    import AnyFunctions1(ThreeDimensionalMatrix DoubleFloat)
+    import FortranPackage
+    import Union(fn:FileName,fp:Asp73(PDEF))
+    import Union(fn:FileName,fp:Asp74(BNDY))
+
+    d03edf(ngxArg:Integer,ngyArg:Integer,ldaArg:Integer,_
+        maxitArg:Integer,accArg:DoubleFloat,ioutArg:Integer,_
+        aArg:Matrix DoubleFloat,rhsArg:Matrix DoubleFloat,_
+        ubArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "d03edf",_
+        ["ngx"::S,"ngy"::S,"lda"::S,"maxit"::S,"acc"::S,"iout"::S,"numit"::S,_
+        "ifail"::S,"us"::S,"u"::S,"a"::S,"rhs"::S,"ub"::S_
+        ]$Lisp,_
+        ["us"::S,"u"::S,"numit"::S]$Lisp,_
+        [["double"::S,"acc"::S,["us"::S,"lda"::S]$Lisp_
+        ,["u"::S,"lda"::S]$Lisp,["a"::S,"lda"::S,7$Lisp]$Lisp,_
+        ["rhs"::S,"lda"::S]$Lisp,_
+        ["ub"::S,["*"::S,"ngx"::S,"ngy"::S]$Lisp]$Lisp]$Lisp_
+        ,["integer"::S,"ngx"::S,"ngy"::S,"lda"::S,"maxit"::S_
+        ,"iout"::S,"numit"::S,"ifail"::S]$Lisp]$Lisp,_
+        ["us"::S,"u"::S,"numit"::S,"a"::S,"rhs"::S,"ub"::S,"ifail"::S]$Lisp,_
+        [([ngxArg::Any,ngyArg::Any,ldaArg::Any,maxitArg::Any,accArg::Any,_
+        ioutArg::Any,ifailArg::Any,aArg::Any,rhsArg::Any,ubArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d03eef(xminArg:DoubleFloat,xmaxArg:DoubleFloat,yminArg:DoubleFloat,_
+        ymaxArg:DoubleFloat,ngxArg:Integer,ngyArg:Integer,_
+        ldaArg:Integer,schemeArg:String,ifailArg:Integer,_
+        pdefArg:Union(fn:FileName,fp:Asp73(PDEF)),bndyArg:Union(fn:FileName,_
+        fp:Asp74(BNDY))): Result == 
+        pushFortranOutputStack(pdefFilename := aspFilename "pdef")$FOP
+        if pdefArg case fn
+          then outputAsFortran(pdefArg.fn)
+          else outputAsFortran(pdefArg.fp)
+        popFortranOutputStack()$FOP
+        pushFortranOutputStack(bndyFilename := aspFilename "bndy")$FOP
+        if bndyArg case fn
+          then outputAsFortran(bndyArg.fn)
+          else outputAsFortran(bndyArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([pdefFilename,bndyFilename]$Lisp,_
+        "d03eef",_
+        ["xmin"::S,"xmax"::S,"ymin"::S,"ymax"::S,"ngx"::S_
+        ,"ngy"::S,"lda"::S,"scheme"::S,"ifail"::S,"pdef"::S_
+        ,"bndy"::S,"a"::S,"rhs"::S]$Lisp,_
+        ["a"::S,"rhs"::S,"pdef"::S,"bndy"::S]$Lisp,_
+        [["double"::S,"xmin"::S,"xmax"::S,"ymin"::S,"ymax"::S,_
+        ["a"::S,"lda"::S,7$Lisp]$Lisp,_
+        ["rhs"::S,"lda"::S]$Lisp,"pdef"::S,"bndy"::S]$Lisp_
+        ,["integer"::S,"ngx"::S,"ngy"::S,"lda"::S,"ifail"::S]$Lisp_
+        ,["character"::S,"scheme"::S]$Lisp]$Lisp,_
+        ["a"::S,"rhs"::S,"ifail"::S]$Lisp,_
+        [([xminArg::Any,xmaxArg::Any,yminArg::Any,ymaxArg::Any,ngxArg::Any,_
+        ngyArg::Any,ldaArg::Any,schemeArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    d03faf(xsArg:DoubleFloat,xfArg:DoubleFloat,lArg:Integer,_
+        lbdcndArg:Integer,bdxsArg:Matrix DoubleFloat,_
+        bdxfArg:Matrix DoubleFloat,_
+        ysArg:DoubleFloat,yfArg:DoubleFloat,mArg:Integer,_
+        mbdcndArg:Integer,bdysArg:Matrix DoubleFloat,_
+        bdyfArg:Matrix DoubleFloat,_
+        zsArg:DoubleFloat,zfArg:DoubleFloat,nArg:Integer,_
+        nbdcndArg:Integer,bdzsArg:Matrix DoubleFloat,_
+        bdzfArg:Matrix DoubleFloat,_
+        lambdaArg:DoubleFloat,ldimfArg:Integer,mdimfArg:Integer,_
+        lwrkArg:Integer,fArg:ThreeDimensionalMatrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "d03faf",_
+        ["xs"::S,"xf"::S,"l"::S,"lbdcnd"::S,"ys"::S_
+        ,"yf"::S,"m"::S,"mbdcnd"::S,"zs"::S,"zf"::S_
+        ,"n"::S,"nbdcnd"::S,"lambda"::S,"ldimf"::S,"mdimf"::S_
+        ,"lwrk"::S,"pertrb"::S,"ifail"::S,"bdxs"::S,"bdxf"::S,"bdys"::S,_
+        "bdyf"::S,"bdzs"::S_
+        ,"bdzf"::S,"f"::S,"w"::S]$Lisp,_
+        ["pertrb"::S,"w"::S]$Lisp,_
+        [["double"::S,"xs"::S,"xf"::S,["bdxs"::S,"mdimf"::S,_
+        ["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp_
+        ,["bdxf"::S,"mdimf"::S,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp,"ys"::S,_
+        "yf"::S,["bdys"::S,"ldimf"::S,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp_
+        ,["bdyf"::S,"ldimf"::S,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp,"zs"::S_
+        ,"zf"::S,["bdzs"::S,"ldimf"::S,["+"::S,"m"::S,1$Lisp]$Lisp]$Lisp,_
+        ["bdzf"::S,"ldimf"::S,["+"::S,"m"::S,1$Lisp]$Lisp]$Lisp_
+        ,"lambda"::S,"pertrb"::S,["f"::S,"ldimf"::S,"mdimf"::S,_
+        ["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp,["w"::S,"lwrk"::S]$Lisp]$Lisp_
+        ,["integer"::S,"l"::S,"lbdcnd"::S,"m"::S,"mbdcnd"::S_
+        ,"n"::S,"nbdcnd"::S,"ldimf"::S,"mdimf"::S,"lwrk"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["pertrb"::S,"f"::S,"ifail"::S]$Lisp,_
+        [([xsArg::Any,xfArg::Any,lArg::Any,lbdcndArg::Any,ysArg::Any,_
+        yfArg::Any,mArg::Any,mbdcndArg::Any,zsArg::Any,zfArg::Any,_
+        nArg::Any,nbdcndArg::Any,lambdaArg::Any,ldimfArg::Any,mdimfArg::Any,_
+        lwrkArg::Any,ifailArg::Any,bdxsArg::Any,bdxfArg::Any,bdysArg::Any,_
+        bdyfArg::Any,bdzsArg::Any,bdzfArg::Any,fArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
 *)
 
 \end{chunk}
@@ -134045,6 +165005,7 @@ NagPolynomialRootsPackage(): Exports == Implementation where
      ++ finds all the roots of a real polynomial equation, using a
      ++ variant of Laguerre's Method.
      ++ See \downlink{Manual Page}{manpageXXc02agf}.
+
   Implementation ==> add
 
     import Lisp
@@ -134098,6 +165059,53 @@ NagPolynomialRootsPackage(): Exports == Implementation where
 \begin{chunk}{COQ NAGC02}
 (* package NAGC02 *)
 (*
+
+    import Lisp
+    import DoubleFloat
+    import Matrix DoubleFloat
+    import Any
+    import Record
+    import Integer
+    import Boolean
+    import NAGLinkSupportPackage
+    import AnyFunctions1(Matrix DoubleFloat)
+    import AnyFunctions1(Integer)
+    import AnyFunctions1(Boolean)
+
+    c02aff(aArg:Matrix DoubleFloat,nArg:Integer,scaleArg:Boolean,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "c02aff",_
+        ["n"::S,"scale"::S,"ifail"::S,"a"::S,"z"::S,"w"::S]$Lisp,_
+        ["z"::S,"w"::S]$Lisp,_
+        [["double"::S,["a"::S,2$Lisp,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp_
+        ,["z"::S,2$Lisp,"n"::S]$Lisp,["w"::S,["*"::S,_
+        ["+"::S,"n"::S,1$Lisp]$Lisp,4$Lisp]$Lisp]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"ifail"::S]$Lisp_
+        ,["logical"::S,"scale"::S]$Lisp_
+        ]$Lisp,_
+        ["z"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,scaleArg::Any,ifailArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    c02agf(aArg:Matrix DoubleFloat,nArg:Integer,scaleArg:Boolean,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "c02agf",_
+        ["n"::S,"scale"::S,"ifail"::S,"a"::S,"z"::S,"w"::S]$Lisp,_
+        ["z"::S,"w"::S]$Lisp,_
+        [["double"::S,["a"::S,["+"::S,"n"::S,1$Lisp]$Lisp]$Lisp_
+        ,["z"::S,2$Lisp,"n"::S]$Lisp,["w"::S,["*"::S,_
+        ["+"::S,"n"::S,1$Lisp]$Lisp,2$Lisp]$Lisp]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"ifail"::S]$Lisp_
+        ,["logical"::S,"scale"::S]$Lisp_
+        ]$Lisp,_
+        ["z"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,scaleArg::Any,ifailArg::Any,aArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
 *)
 
 \end{chunk}
@@ -135221,6 +166229,7 @@ NagRootFindingPackage(): Exports == Implementation where
      ++ of nonlinear equations by a modification of the Powell hybrid 
      ++ method. The user must provide the Jacobian.
      ++ See \downlink{Manual Page}{manpageXXc05pbf}.
+
   Implementation ==> add
 
     import Lisp
@@ -135311,6 +166320,90 @@ NagRootFindingPackage(): Exports == Implementation where
 \begin{chunk}{COQ NAGC05}
 (* package NAGC05 *)
 (*
+
+    import Lisp
+    import DoubleFloat
+    import Any
+    import Record
+    import Integer
+    import Matrix DoubleFloat
+    import Boolean
+    import NAGLinkSupportPackage
+    import FortranPackage
+    import Union(fn:FileName,fp:Asp1(F))
+    import AnyFunctions1(DoubleFloat)
+    import AnyFunctions1(Matrix DoubleFloat)
+    import AnyFunctions1(Integer)
+
+    c05adf(aArg:DoubleFloat,bArg:DoubleFloat,epsArg:DoubleFloat,_
+        etaArg:DoubleFloat,ifailArg:Integer,_
+        fArg:Union(fn:FileName,fp:Asp1(F))): Result == 
+        pushFortranOutputStack(fFilename := aspFilename "f")$FOP
+        if fArg case fn
+          then outputAsFortran(fArg.fn)
+          else outputAsFortran(fArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([fFilename]$Lisp,_
+        "c05adf",_
+        ["a"::S,"b"::S,"eps"::S,"eta"::S,"x"::S_
+        ,"ifail"::S,"f"::S]$Lisp,_
+        ["x"::S,"f"::S]$Lisp,_
+        [["double"::S,"a"::S,"b"::S,"eps"::S,"eta"::S_
+        ,"x"::S,"f"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["x"::S,"ifail"::S]$Lisp,_
+        [([aArg::Any,bArg::Any,epsArg::Any,etaArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    c05nbf(nArg:Integer,lwaArg:Integer,xArg:Matrix DoubleFloat,_
+        xtolArg:DoubleFloat,ifailArg:Integer,_
+        fcnArg:Union(fn:FileName,fp:Asp6(FCN))): Result == 
+        pushFortranOutputStack(fcnFilename := aspFilename "fcn")$FOP
+        if fcnArg case fn
+          then outputAsFortran(fcnArg.fn)
+          else outputAsFortran(fcnArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([fcnFilename]$Lisp,_
+        "c05nbf",_
+        ["n"::S,"lwa"::S,"xtol"::S,"ifail"::S,"fcn"::S_
+        ,"fvec"::S,"x"::S,"wa"::S]$Lisp,_
+        ["fvec"::S,"wa"::S,"fcn"::S]$Lisp,_
+        [["double"::S,["fvec"::S,"n"::S]$Lisp,["x"::S,"n"::S]$Lisp_
+        ,"xtol"::S,["wa"::S,"lwa"::S]$Lisp,"fcn"::S]$Lisp_
+        ,["integer"::S,"n"::S,"lwa"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["fvec"::S,"x"::S,"xtol"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,lwaArg::Any,xtolArg::Any,ifailArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    c05pbf(nArg:Integer,ldfjacArg:Integer,lwaArg:Integer,_
+        xArg:Matrix DoubleFloat,xtolArg:DoubleFloat,ifailArg:Integer,_
+        fcnArg:Union(fn:FileName,fp:Asp35(FCN))): Result == 
+        pushFortranOutputStack(fcnFilename := aspFilename "fcn")$FOP
+        if fcnArg case fn
+          then outputAsFortran(fcnArg.fn)
+          else outputAsFortran(fcnArg.fp)
+        popFortranOutputStack()$FOP
+        [(invokeNagman([fcnFilename]$Lisp,_
+        "c05pbf",_
+        ["n"::S,"ldfjac"::S,"lwa"::S,"xtol"::S,"ifail"::S_
+        ,"fcn"::S,"fvec"::S,"fjac"::S,"x"::S,"wa"::S]$Lisp,_
+        ["fvec"::S,"fjac"::S,"wa"::S,"fcn"::S]$Lisp,_
+        [["double"::S,["fvec"::S,"n"::S]$Lisp,_
+        ["fjac"::S,"ldfjac"::S,"n"::S]$Lisp_
+        ,["x"::S,"n"::S]$Lisp,"xtol"::S,["wa"::S,"lwa"::S]$Lisp,"fcn"::S]$Lisp_
+        ,["integer"::S,"n"::S,"ldfjac"::S,"lwa"::S_
+        ,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["fvec"::S,"fjac"::S,"x"::S,"xtol"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,ldfjacArg::Any,lwaArg::Any,xtolArg::Any,_
+        ifailArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
 *)
 
 \end{chunk}
@@ -138497,6 +169590,7 @@ NagSeriesSummationPackage(): Exports == Implementation where
      ++ values, and forms the real and imaginary parts of the m 
      ++ corresponding complex sequences.
      ++ See \downlink{Manual Page}{manpageXXc06gsf}.
+
   Implementation ==> add
 
     import Lisp
@@ -138713,6 +169807,216 @@ NagSeriesSummationPackage(): Exports == Implementation where
 \begin{chunk}{COQ NAGC06}
 (* package NAGC06 *)
 (*
+
+    import Lisp
+    import DoubleFloat
+    import Any
+    import Record
+    import Integer
+    import Matrix DoubleFloat
+    import Boolean
+    import NAGLinkSupportPackage
+    import AnyFunctions1(Integer)
+    import AnyFunctions1(String)
+    import AnyFunctions1(Matrix DoubleFloat)
+
+    c06eaf(nArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "c06eaf",_
+        ["n"::S,"ifail"::S,"x"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,["x"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["x"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,ifailArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+
+    c06ebf(nArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "c06ebf",_
+        ["n"::S,"ifail"::S,"x"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,["x"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["x"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,ifailArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    c06ecf(nArg:Integer,xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "c06ecf",_
+        ["n"::S,"ifail"::S,"x"::S,"y"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,["x"::S,"n"::S]$Lisp,["y"::S,"n"::S]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"n"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["x"::S,"y"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,ifailArg::Any,xArg::Any,yArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    c06ekf(jobArg:Integer,nArg:Integer,xArg:Matrix DoubleFloat,_
+        yArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "c06ekf",_
+        ["job"::S,"n"::S,"ifail"::S,"x"::S,"y"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,["x"::S,"n"::S]$Lisp,["y"::S,"n"::S]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"job"::S,"n"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["x"::S,"y"::S,"ifail"::S]$Lisp,_
+        [([jobArg::Any,nArg::Any,ifailArg::Any,xArg::Any,yArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    c06fpf(mArg:Integer,nArg:Integer,initArg:String,_
+        xArg:Matrix DoubleFloat,trigArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "c06fpf",_
+        ["m"::S,"n"::S,"init"::S,"ifail"::S,"x"::S,"trig"::S,"work"::S]$Lisp,_
+        ["work"::S]$Lisp,_
+        [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_
+        ,["trig"::S,["*"::S,2$Lisp,"n"::S]$Lisp]$Lisp,_
+        ["work"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_
+        ,["character"::S,"init"::S]$Lisp_
+        ]$Lisp,_
+        ["x"::S,"trig"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,nArg::Any,initArg::Any,ifailArg::Any,_
+        xArg::Any,trigArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    c06fqf(mArg:Integer,nArg:Integer,initArg:String,_
+        xArg:Matrix DoubleFloat,trigArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "c06fqf",_
+        ["m"::S,"n"::S,"init"::S,"ifail"::S,"x"::S,"trig"::S,"work"::S]$Lisp,_
+        ["work"::S]$Lisp,_
+        [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_
+        ,["trig"::S,["*"::S,2$Lisp,"n"::S]$Lisp]$Lisp,_
+        ["work"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_
+        ,["character"::S,"init"::S]$Lisp_
+        ]$Lisp,_
+        ["x"::S,"trig"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,nArg::Any,initArg::Any,ifailArg::Any,xArg::Any,_
+        trigArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    c06frf(mArg:Integer,nArg:Integer,initArg:String,_
+        xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_
+        trigArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "c06frf",_
+        ["m"::S,"n"::S,"init"::S,"ifail"::S,"x"::S,"y"::S,"trig"::S,_
+        "work"::S]$Lisp,_
+        ["work"::S]$Lisp,_
+        [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_
+        ,["y"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp,["trig"::S,_
+        ["*"::S,2$Lisp,"n"::S]$Lisp]$Lisp,["work"::S,_
+        ["*"::S,["*"::S,2$Lisp,"m"::S]$Lisp,"n"::S]$Lisp]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_
+        ,["character"::S,"init"::S]$Lisp]$Lisp,_
+        ["x"::S,"y"::S,"trig"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,nArg::Any,initArg::Any,ifailArg::Any,_
+        xArg::Any,yArg::Any,trigArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    c06fuf(mArg:Integer,nArg:Integer,initArg:String,_
+        xArg:Matrix DoubleFloat,yArg:Matrix DoubleFloat,_
+        trigmArg:Matrix DoubleFloat,_
+        trignArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "c06fuf",_
+        ["m"::S,"n"::S,"init"::S,"ifail"::S,"x"::S,"y"::S,"trigm"::S,_
+        "trign"::S,"work"::S]$Lisp,_
+        ["work"::S]$Lisp,_
+        [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_
+        ,["y"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp,["trigm"::S,_
+        ["*"::S,2$Lisp,"m"::S]$Lisp]$Lisp,["trign"::S,_
+        ["*"::S,2$Lisp,"n"::S]$Lisp]$Lisp_
+        ,["work"::S,["*"::S,["*"::S,2$Lisp,"m"::S]$Lisp,_
+        "n"::S]$Lisp]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_
+        ,["character"::S,"init"::S]$Lisp_
+        ]$Lisp,_
+        ["x"::S,"y"::S,"trigm"::S,"trign"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,nArg::Any,initArg::Any,ifailArg::Any,xArg::Any,_
+        yArg::Any,trigmArg::Any,trignArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    c06gbf(nArg:Integer,xArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "c06gbf",_
+        ["n"::S,"ifail"::S,"x"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,["x"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["x"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,ifailArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    c06gcf(nArg:Integer,yArg:Matrix DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "c06gcf",_
+        ["n"::S,"ifail"::S,"y"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,["y"::S,"n"::S]$Lisp]$Lisp_
+        ,["integer"::S,"n"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["y"::S,"ifail"::S]$Lisp,_
+        [([nArg::Any,ifailArg::Any,yArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    c06gqf(mArg:Integer,nArg:Integer,xArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "c06gqf",_
+        ["m"::S,"n"::S,"ifail"::S,"x"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_
+        ]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["x"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,nArg::Any,ifailArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    c06gsf(mArg:Integer,nArg:Integer,xArg:Matrix DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "c06gsf",_
+        ["m"::S,"n"::S,"ifail"::S,"x"::S,"u"::S,"v"::S]$Lisp,_
+        ["u"::S,"v"::S]$Lisp,_
+        [["double"::S,["x"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp_
+        ,["u"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp,_
+        ["v"::S,["*"::S,"m"::S,"n"::S]$Lisp]$Lisp]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["u"::S,"v"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,nArg::Any,ifailArg::Any,xArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
 *)
 
 \end{chunk}
@@ -146513,6 +177817,7 @@ NagSpecialFunctionsPackage(): Exports == Implementation where
      ++ returns a value of the symmetrised elliptic integral of 
      ++ the third kind, via the routine name.
      ++ See \downlink{Manual Page}{manpageXXs21bdf}.
+
   Implementation ==> add
 
     import Lisp
@@ -147068,6 +178373,555 @@ NagSpecialFunctionsPackage(): Exports == Implementation where
 \begin{chunk}{COQ NAGS}
 (* package NAGS *)
 (*
+
+    import Lisp
+    import DoubleFloat
+    import Any
+    import Record
+    import Integer
+    import Matrix DoubleFloat
+    import Boolean
+    import NAGLinkSupportPackage
+    import AnyFunctions1(Complex DoubleFloat)
+    import AnyFunctions1(Integer)
+    import AnyFunctions1(DoubleFloat)
+    import AnyFunctions1(String)
+
+    s01eaf(zArg:Complex DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s01eaf",_
+        ["z"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["integer"::S,"ifail"::S]$Lisp_
+        ,["double complex"::S,"s01eafResult"::S,"z"::S]$Lisp_
+        ]$Lisp,_
+        ["s01eafResult"::S,"ifail"::S]$Lisp,_
+        [([zArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s13aaf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s13aaf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s13aafResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s13aafResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s13acf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s13acf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s13acfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s13acfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s13adf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s13adf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s13adfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s13adfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s14aaf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s14aaf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s14aafResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s14aafResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s14abf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s14abf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s14abfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s14abfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s14baf(aArg:DoubleFloat,xArg:DoubleFloat,tolArg:DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s14baf",_
+        ["a"::S,"x"::S,"tol"::S,"p"::S,"q"::S_
+        ,"ifail"::S]$Lisp,_
+        ["p"::S,"q"::S]$Lisp,_
+        [["double"::S,"a"::S,"x"::S,"tol"::S,"p"::S_
+        ,"q"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["p"::S,"q"::S,"ifail"::S]$Lisp,_
+        [([aArg::Any,xArg::Any,tolArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s15adf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s15adf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s15adfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s15adfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s15aef(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s15aef",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s15aefResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s15aefResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s17acf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s17acf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s17acfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s17acfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s17adf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s17adf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s17adfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s17adfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s17aef(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s17aef",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s17aefResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s17aefResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s17aff(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s17aff",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s17affResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s17affResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s17agf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s17agf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s17agfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s17agfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s17ahf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s17ahf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s17ahfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s17ahfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s17ajf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s17ajf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s17ajfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s17ajfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s17akf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s17akf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s17akfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s17akfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+
+    s17dcf(fnuArg:DoubleFloat,zArg:Complex DoubleFloat,nArg:Integer,_
+        scaleArg:String,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s17dcf",_
+        ["fnu"::S,"z"::S,"n"::S,"scale"::S,"nz"::S_
+        ,"ifail"::S,"cy"::S,"cwrk"::S]$Lisp,_
+        ["cy"::S,"nz"::S,"cwrk"::S]$Lisp,_
+        [["double"::S,"fnu"::S]$Lisp_
+        ,["integer"::S,"n"::S,"nz"::S,"ifail"::S]$Lisp_
+        ,["character"::S,"scale"::S]$Lisp_
+        ,["double complex"::S,"z"::S,["cy"::S,"n"::S]$Lisp,_
+        ["cwrk"::S,"n"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["cy"::S,"nz"::S,"ifail"::S]$Lisp,_
+        [([fnuArg::Any,zArg::Any,nArg::Any,scaleArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s17def(fnuArg:DoubleFloat,zArg:Complex DoubleFloat,nArg:Integer,_
+        scaleArg:String,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s17def",_
+        ["fnu"::S,"z"::S,"n"::S,"scale"::S,"nz"::S_
+        ,"ifail"::S,"cy"::S]$Lisp,_
+        ["cy"::S,"nz"::S]$Lisp,_
+        [["double"::S,"fnu"::S]$Lisp_
+        ,["integer"::S,"n"::S,"nz"::S,"ifail"::S]$Lisp_
+        ,["character"::S,"scale"::S]$Lisp_
+        ,["double complex"::S,"z"::S,["cy"::S,"n"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["cy"::S,"nz"::S,"ifail"::S]$Lisp,_
+        [([fnuArg::Any,zArg::Any,nArg::Any,scaleArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s17dgf(derivArg:String,zArg:Complex DoubleFloat,scaleArg:String,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s17dgf",_
+        ["deriv"::S,"z"::S,"scale"::S,"ai"::S,"nz"::S_
+        ,"ifail"::S]$Lisp,_
+        ["ai"::S,"nz"::S]$Lisp,_
+        [["integer"::S,"nz"::S,"ifail"::S]$Lisp_
+        ,["character"::S,"deriv"::S,"scale"::S]$Lisp_
+        ,["double complex"::S,"z"::S,"ai"::S]$Lisp_
+        ]$Lisp,_
+        ["ai"::S,"nz"::S,"ifail"::S]$Lisp,_
+        [([derivArg::Any,zArg::Any,scaleArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s17dhf(derivArg:String,zArg:Complex DoubleFloat,scaleArg:String,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s17dhf",_
+        ["deriv"::S,"z"::S,"scale"::S,"bi"::S,"ifail"::S_
+        ]$Lisp,_
+        ["bi"::S]$Lisp,_
+        [["integer"::S,"ifail"::S]$Lisp_
+        ,["character"::S,"deriv"::S,"scale"::S]$Lisp_
+        ,["double complex"::S,"z"::S,"bi"::S]$Lisp_
+        ]$Lisp,_
+        ["bi"::S,"ifail"::S]$Lisp,_
+        [([derivArg::Any,zArg::Any,scaleArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s17dlf(mArg:Integer,fnuArg:DoubleFloat,zArg:Complex DoubleFloat,_
+        nArg:Integer,scaleArg:String,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s17dlf",_
+        ["m"::S,"fnu"::S,"z"::S,"n"::S,"scale"::S_
+        ,"nz"::S,"ifail"::S,"cy"::S]$Lisp,_
+        ["cy"::S,"nz"::S]$Lisp,_
+        [["double"::S,"fnu"::S]$Lisp_
+        ,["integer"::S,"m"::S,"n"::S,"nz"::S,"ifail"::S_
+        ]$Lisp_
+        ,["character"::S,"scale"::S]$Lisp_
+        ,["double complex"::S,"z"::S,["cy"::S,"n"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["cy"::S,"nz"::S,"ifail"::S]$Lisp,_
+        [([mArg::Any,fnuArg::Any,zArg::Any,nArg::Any,scaleArg::Any,_
+        ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s18acf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s18acf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s18acfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s18acfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s18adf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s18adf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s18adfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s18adfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s18aef(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s18aef",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s18aefResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s18aefResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s18aff(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s18aff",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s18affResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s18affResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s18dcf(fnuArg:DoubleFloat,zArg:Complex DoubleFloat,nArg:Integer,_
+        scaleArg:String,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s18dcf",_
+        ["fnu"::S,"z"::S,"n"::S,"scale"::S,"nz"::S_
+        ,"ifail"::S,"cy"::S]$Lisp,_
+        ["cy"::S,"nz"::S]$Lisp,_
+        [["double"::S,"fnu"::S]$Lisp_
+        ,["integer"::S,"n"::S,"nz"::S,"ifail"::S]$Lisp_
+        ,["character"::S,"scale"::S]$Lisp_
+        ,["double complex"::S,"z"::S,["cy"::S,"n"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["cy"::S,"nz"::S,"ifail"::S]$Lisp,_
+        [([fnuArg::Any,zArg::Any,nArg::Any,scaleArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s18def(fnuArg:DoubleFloat,zArg:Complex DoubleFloat,nArg:Integer,_
+        scaleArg:String,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s18def",_
+        ["fnu"::S,"z"::S,"n"::S,"scale"::S,"nz"::S_
+        ,"ifail"::S,"cy"::S]$Lisp,_
+        ["cy"::S,"nz"::S]$Lisp,_
+        [["double"::S,"fnu"::S]$Lisp_
+        ,["integer"::S,"n"::S,"nz"::S,"ifail"::S]$Lisp_
+        ,["character"::S,"scale"::S]$Lisp_
+        ,["double complex"::S,"z"::S,["cy"::S,"n"::S]$Lisp]$Lisp_
+        ]$Lisp,_
+        ["cy"::S,"nz"::S,"ifail"::S]$Lisp,_
+        [([fnuArg::Any,zArg::Any,nArg::Any,scaleArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s19aaf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s19aaf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s19aafResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s19aafResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s19abf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s19abf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s19abfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s19abfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s19acf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s19acf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s19acfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s19acfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s19adf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s19adf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s19adfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s19adfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s20acf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s20acf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s20acfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s20acfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s20adf(xArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s20adf",_
+        ["x"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s20adfResult"::S,"x"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s20adfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s21baf(xArg:DoubleFloat,yArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s21baf",_
+        ["x"::S,"y"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s21bafResult"::S,"x"::S,"y"::S_
+        ]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s21bafResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,yArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s21bbf(xArg:DoubleFloat,yArg:DoubleFloat,zArg:DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s21bbf",_
+        ["x"::S,"y"::S,"z"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s21bbfResult"::S,"x"::S,"y"::S_
+        ,"z"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s21bbfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,yArg::Any,zArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s21bcf(xArg:DoubleFloat,yArg:DoubleFloat,zArg:DoubleFloat,_
+        ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s21bcf",_
+        ["x"::S,"y"::S,"z"::S,"ifail"::S]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s21bcfResult"::S,"x"::S,"y"::S_
+        ,"z"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s21bcfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,yArg::Any,zArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
+    s21bdf(xArg:DoubleFloat,yArg:DoubleFloat,zArg:DoubleFloat,_
+        rArg:DoubleFloat,ifailArg:Integer): Result == 
+        [(invokeNagman(NIL$Lisp,_
+        "s21bdf",_
+        ["x"::S,"y"::S,"z"::S,"r"::S,"ifail"::S_
+        ]$Lisp,_
+        []$Lisp,_
+        [["double"::S,"s21bdfResult"::S,"x"::S,"y"::S_
+        ,"z"::S,"r"::S]$Lisp_
+        ,["integer"::S,"ifail"::S]$Lisp_
+        ]$Lisp,_
+        ["s21bdfResult"::S,"ifail"::S]$Lisp,_
+        [([xArg::Any,yArg::Any,zArg::Any,rArg::Any,ifailArg::Any ])_
+        @List Any]$Lisp)$Lisp)_
+        pretend List (Record(key:Symbol,entry:Any))]$Result
+
 *)
 
 \end{chunk}
@@ -147140,6 +178994,7 @@ NewSparseUnivariatePolynomialFunctions2(R:Ring, S:Ring): with
     ++ \axiom{map(func, poly)} creates a new polynomial by applying func to
     ++ every non-zero coefficient of the polynomial poly.
  == add
+
   map(f, p) == map(f, p)$UnivariatePolynomialCategoryFunctions2(R,
            NewSparseUnivariatePolynomial R, S, NewSparseUnivariatePolynomial S)
 
@@ -147148,6 +179003,10 @@ NewSparseUnivariatePolynomialFunctions2(R:Ring, S:Ring): with
 \begin{chunk}{COQ NSUP2}
 (* package NSUP2 *)
 (*
+
+  map(f, p) == map(f, p)$UnivariatePolynomialCategoryFunctions2(R,
+           NewSparseUnivariatePolynomial R, S, NewSparseUnivariatePolynomial S)
+
 *)
 
 \end{chunk}
@@ -147233,7 +179092,7 @@ NewtonInterpolation F: Exports == Implementation where
 
       z: SparseUnivariatePolynomial(F) := monomial(1,1)
 
--- we assume x=[1,2,3,...,n]
+      -- we assume x=[1,2,3,...,n]
       newtonAux(k: F, fact: F, yl: List F): SparseUnivariatePolynomial(F) ==
         if empty? rest yl 
         then ((yl.1) exquo fact)::F::SparseUnivariatePolynomial(F)
@@ -147249,6 +179108,23 @@ NewtonInterpolation F: Exports == Implementation where
 \begin{chunk}{COQ NEWTON}
 (* package NEWTON *)
 (*
+
+      differences(yl: List F): List F == 
+        [y2-y1 for y1 in yl for y2 in rest yl]
+
+      z: SparseUnivariatePolynomial(F) := monomial(1,1)
+
+      -- we assume x=[1,2,3,...,n]
+      newtonAux(k: F, fact: F, yl: List F): SparseUnivariatePolynomial(F) ==
+        if empty? rest yl 
+        then ((yl.1) exquo fact)::F::SparseUnivariatePolynomial(F)
+        else ((yl.1) exquo fact)::F::SparseUnivariatePolynomial(F) 
+             + (z-k::SparseUnivariatePolynomial(F)) _
+               * newtonAux(k+1$F, fact*k, differences yl)
+
+
+      newton yl == newtonAux(1$F, 1$F, yl)
+
 *)
 
 \end{chunk}
@@ -147360,7 +179236,6 @@ NewtonPolygon(K,PolyRing,E,dim):Exports == Implementation where
       [hgt, bs,  eucl.quotient, eucl.remainder , "right" ]$recSlope
       
     oneToPos:  List List PolyRing -> List List PolyRing
-
     oneToPos(lpol)==
       fedge:= first lpol
       sl:= slope fedge
@@ -147524,6 +179399,181 @@ NewtonPolygon(K,PolyRing,E,dim):Exports == Implementation where
 \begin{chunk}{COQ NPOLYGON}
 (* package NPOLYGON *)
 (*
+
+    slope(p1,p2)==
+      -- calcule la pente de p1 a p2 et change le signe. 
+      e1:=degree p1
+      e2:=degree p2
+      hgt:= ( e1.2 pretend Integer) - ( e2.2 pretend Integer) 
+      bs:= ( e2.1 pretend Integer) - ( e1.1 pretend Integer )
+      zero? bs =>  [hgt, bs, 0$Integer, 0$Integer, "vertical" ]$recSlope
+      zero? hgt => [hgt, bs, 0$Integer, 0$Integer, "horizontal" ]$recSlope
+      hgt = bs  => [hgt, bs, 1$Integer, 0$Integer, "center" ]$recSlope
+      hgt > bs =>
+         eucl:=divide(hgt,bs)
+         [hgt, bs,  eucl.quotient, eucl.remainder , "left" ]$recSlope
+      eucl:=divide(bs, hgt)
+      [hgt, bs,  eucl.quotient, eucl.remainder , "right" ]$recSlope
+      
+    oneToPos:  List List PolyRing -> List List PolyRing
+    oneToPos(lpol)==
+      fedge:= first lpol
+      sl:= slope fedge
+      one? ( #(lpol) ) =>
+        if sl.height > sl.base then [ fedge, empty() ]
+        else [ empty() , fedge ] 
+      ^( sl.base < sl.height ) => [ empty() , fedge ]
+      restPANE:= oneToPos  rest lpol
+      fedge2 := first restPANE
+      sl2:= slope fedge2
+      ^( sl2.base < sl2.height ) => [ fedge , fedge2 ]
+      restPANE 
+
+    oneToNeg:  List List PolyRing -> List List PolyRing
+
+    oneToNeg(lpol)==
+      fedge:= first lpol
+      sl:= slope fedge
+      one? ( #(lpol) ) =>
+        if sl.height < sl.base then [ empty(), fedge ]
+        else [ fedge , empty()  ] 
+      ( sl.height < sl.base ) => [ empty() , fedge ]
+      restPANE:= oneToNeg  rest lpol
+      fedge2 := first restPANE
+      sl2:= slope fedge2
+      ( sl2.height < sl2.base ) => [ fedge , fedge2 ]
+      restPANE 
+
+    negAndPosEdge(pol, lpol)==
+      -- cette fonction retourne deux liste de polynomes: 
+      -- la premiere est liee a
+      -- la transformation x = x y^l (i.e v(x) >= v(y) ). 
+      -- la deuxieme est liee a la transformation
+      -- y = x^l y (i.e. v(x) <= v(y) ). 
+      -- si le degree en Y est inferieur a celui en X on 
+      -- previligie la transformation
+      -- y = x^l y.
+      degree( pol , 2 )$PackPoly < degree( pol, 1 )$PackPoly => oneToPos lpol
+      oneToNeg lpol
+
+    localNewtonPolygon: List PolyRing -> List PolyRing
+
+    slEq: (recSlope, recSlope) -> Boolean
+
+    regroup: List PolyRing -> List List PolyRing
+
+    multiplicity( lpol )==
+      nl:=#(lpol)
+      flpol:= first lpol
+      one? nl=> totalDegree( last flpol)$PackPoly
+      s:=slope flpol
+      s.height < s.base => totalDegree( first flpol )$PackPoly
+      multiplicity( rest lpol )
+
+    slEq(s1,s2)==
+      s1.height * s2.base = s2.height * s1.base
+
+    regroup(lpol)==
+      -- Note : les elements de lpol sont sur la frontiere d'un poly. 
+      -- de Newton et il sont deja trie's. 
+      nl:=#(lpol)
+      one? nl => [lpol]
+      2 = nl => [lpol]
+      f:=first lpol
+      r:= regroup rest lpol
+      -- Note : les listes de "r" contiennent au moins 2 elements !!
+      fg:=first r
+      s1:=slope(f, first fg)
+      s2:=slope(fg.1,fg.2)
+      slEq(s1,s2) => cons( cons(f, fg) , rest r)
+      cons( [f, first fg], r)
+
+-- ================================================
+-- sortMono :  trie les monomes par ordre croissant 
+-- ================================================
+
+    sortMono: (PolyRing, PolyRing) -> Boolean
+    sortMono(p1,p2)==
+      a:= degree p1
+      b:= degree p2
+      a.1 < b.1 => true                  -- p1 est a gauche de p2
+      a.1 = b.1 and  a.2 > b.2 => true   -- p1 est au dessus de p2 
+      false
+    
+-- ===================================================
+-- newtonPolygon :  retourne tous les monomes sur la 
+-- frontiere de du polygone de Newton,
+-- regroupes selon leur pente.
+-- ===================================================
+  
+    properSlope: ( List PolyRing, Integer, Integer, _
+            Union("left","center","right","vertical","horizontal")) -> Boolean
+
+    properSlope(lpol,hgt,bs, tp)==
+      s:=slope lpol
+      tp case "left" and s.height = hgt and s.base = bs => true
+      tp case "right" and s.height = bs and s.base = hgt => true
+      false
+
+
+    newtonPolygon(pol,hgt,bs,tp)==
+      ans:=regroup localNewtonPolygon _
+                              sort( sortMono(#1,#2) , monomials(pol)$PackPoly)
+      zero?(bs) => ans
+      [ l for l in ans | properSlope(l,hgt,bs,tp)] 
+
+    comp2pol: (PolyRing,PolyRing) -> List PolyRing
+    comp2pol(p1,p2)==
+      rs:= slope(p1,p2)
+      zero? rs.base =>               -- p1 et p2 sont alignes verticalement !!
+        zero? rs.height => [p1 + p2] -- les monomes sont identiques !
+        rs.height < 0 => [p1]        -- p2 est au dessus de p1, 
+                                     -- il faut retourner p1 !! 
+        [p2]                         -- sinon p1 est au dessus de p2 .
+      rs.base > 0 =>                 -- p1 est a gauche de p2
+        rs.height > 0 => [p1,p2]     -- p1 est plus haut que p2
+        [p1]                         -- p1 est a la meme hauteur que p2
+                                     -- ici p2 est a gauche de p1
+      rs.height < 0 => [p2,p1]       -- p2 est plus haut que p1 
+      [p2]                           -- p2 est a la meme hauteur que p1.
+
+    slope(lpol) == 
+      ^one?(#lpol) => slope( first lpol, second lpol)
+      f:= first lpol
+      ( degree(f,2)$PackPoly < degree(f,1)$PackPoly ) => _
+                               [ 0$Integer, 1$Integer,0,0, "right" ]$recSlope
+      [1$Integer, 0$Integer,0,0 , "left"  ]$recSlope
+
+    convex_?: (PolyRing,PolyRing,PolyRing) -> Boolean
+    convex_?(p1,p2,p3)==
+      s1:=slope(p1,p2)
+      s2:=slope(p2,p3)
+      s1.type case "horizontal" => true
+      s2.type case "vertical" => true
+      s1.type case "vertical" => false  -- car ici il faut c2 vertical
+      s2.type case "horizontal" => false      
+      (s1.height * s2.base) < (s2.height  * s1.base)
+
+    consBondary: (PolyRing , List PolyRing) -> List PolyRing
+    consBondary(lt, lpol)==
+      -- "lt" est un monome a ajouter ou non a "lpol" qui est une 
+      empty? lpol => [lt]
+      st:=first lpol
+      nl:NonNegativeInteger:= # lpol      
+      one? nl => comp2pol(lt,st)
+      degree(lt).1 = degree(st).1 and degree(lt).2 > degree(st).2 => lpol
+      ^convex?(lt , st , lpol.2) => cons(lt, lpol)
+      consBondary( lt, rest lpol )
+
+    localNewtonPolygon(lpol)==
+      -- lpol doit etre trie' par sortMono 
+      empty? lpol =>  empty() 
+      nl:= #(lpol)
+      one?  nl => lpol
+      lt:=first lpol 
+      polgRest:= localNewtonPolygon rest lpol 
+      consBondary( lt , polgRest )              
+
 *)
 
 \end{chunk}
@@ -147644,6 +179694,7 @@ NonCommutativeOperatorDivision(P, F): PDcat == PDdef  where
             ++ computed using left-division.
 
     PDdef == add
+
         leftDivide(a, b) ==
             q: P := 0
             r: P := a
@@ -147657,16 +179708,20 @@ NonCommutativeOperatorDivision(P, F): PDcat == PDdef  where
 
         -- leftQuotient(a,b) is the quotient from left division, etc.
         leftQuotient(a,b)   == leftDivide(a,b).quotient
+
         leftRemainder(a,b)   == leftDivide(a,b).remainder
+
         leftExactQuotient(a,b) ==
              qr := leftDivide(a,b)
              if qr.remainder = 0 then qr.quotient else "failed"
+
         -- l = leftGcd(a,b) means  a = aa*l  b = bb*l.  Uses leftDivide.
         leftGcd(a,b) ==
              a = 0 =>b
              b = 0 =>a
              while degree b > 0 repeat (a,b) := (b, leftRemainder(a,b))
              if b=0 then a else b
+
         -- l = leftLcm(a,b) means  l = a*aa  l = b*bb   Uses leftDivide.
         leftLcm(a,b) ==
             a = 0 =>b
@@ -147685,6 +179740,47 @@ NonCommutativeOperatorDivision(P, F): PDcat == PDdef  where
 \begin{chunk}{COQ NCODIV}
 (* package NCODIV *)
 (*
+
+        leftDivide(a, b) ==
+            q: P := 0
+            r: P := a
+            iv:F := inv leadingCoefficient b
+            while degree r >= degree b and r ^= 0 repeat
+                h := monomial(iv*leadingCoefficient r,
+                                 (degree r - degree b)::NonNegativeInteger)$P
+                r := r - b*h
+                q := q + h
+            [q,r]
+
+        -- leftQuotient(a,b) is the quotient from left division, etc.
+        leftQuotient(a,b)   == leftDivide(a,b).quotient
+
+        leftRemainder(a,b)   == leftDivide(a,b).remainder
+
+        leftExactQuotient(a,b) ==
+             qr := leftDivide(a,b)
+             if qr.remainder = 0 then qr.quotient else "failed"
+
+        -- l = leftGcd(a,b) means  a = aa*l  b = bb*l.  Uses leftDivide.
+        leftGcd(a,b) ==
+             a = 0 =>b
+             b = 0 =>a
+             while degree b > 0 repeat (a,b) := (b, leftRemainder(a,b))
+             if b=0 then a else b
+
+        -- l = leftLcm(a,b) means  l = a*aa  l = b*bb   Uses leftDivide.
+        leftLcm(a,b) ==
+            a = 0 =>b
+            b = 0 =>a
+            b0 := b
+            u  := monomial(1,0)$P
+            v  := 0
+            while leadingCoefficient b ^= 0 repeat
+                qr     := leftDivide(a,b)
+                (a, b) := (b, qr.remainder)
+                (u, v) := (u*qr.quotient+v, u)
+            b0*u
+
 *)
 
 \end{chunk}
@@ -147754,6 +179850,7 @@ NoneFunctions1(S:Type): Exports == Implementation where
       ++ \spadtype{None}.
 
   Implementation ==> add
+
     coerce(s:S):None == s pretend None
 
 \end{chunk}
@@ -147761,6 +179858,9 @@ NoneFunctions1(S:Type): Exports == Implementation where
 \begin{chunk}{COQ NONE1}
 (* package NONE1 *)
 (*
+
+    coerce(s:S):None == s pretend None
+
 *)
 
 \end{chunk}
@@ -147852,6 +179952,7 @@ NonLinearFirstOrderODESolver(R, F): Exports == Implementation where
       ++ "failed" if no first-integral can be found.
 
   Implementation ==> add
+
     import ODEIntegration(R, F)
     import ElementaryFunctionODESolver(R, F)    -- recursive dependency!
 
@@ -147863,72 +179964,73 @@ NonLinearFirstOrderODESolver(R, F): Exports == Implementation where
     integratingFactor: (F, F, SY, SY) -> U
 
     unk    := new()$SY
+
     kunk:K := kernel unk
 
     solve(m, n, y, x) ==
--- first replace the operator y(x) by a new symbol z in m(x,y) and n(x,y)
+      -- first replace the operator y(x) by a new symbol z in m(x,y) and n(x,y)
       lk:List(K) := [retract(yx := y(x::F))@K]
       lv:List(F) := [kunk::F]
       mm := eval(m, lk, lv)
       nn := eval(n, lk, lv)
--- put over a common denominator (to balance m and n)
+      -- put over a common denominator (to balance m and n)
       d := lcm(denom mm, denom nn)::F
       mm := d * mm
       nn := d * nn
--- look for an integrating factor mu
+      -- look for an integrating factor mu
       (u := integratingFactor(mm, nn, unk, x)) case F =>
         mu := u::F
         mm := mm * mu
         nn := nn * mu
         eval(int(mm,x) + int(nn-int(differentiate(mm,unk),x), unk),[kunk],[yx])
--- check for Bernoulli equation
+      -- check for Bernoulli equation
       (w := checkBernoulli(m, n, k1 := first lk)) case BER =>
         solveBernoulli(w::BER, y, x, yx)
--- check for Riccati equation
+      -- check for Riccati equation
       (v := checkRiccati(m, n, k1)) case List(F) =>
         solveRiccati(v::List(F), y, x, yx)
       "failed"
 
--- look for an integrating factor
+    -- look for an integrating factor
     integratingFactor(m, n, y, x) ==
--- check first for exactness
+      -- check first for exactness
       zero?(d := differentiate(m, y) - differentiate(n, x)) => 1
--- look for an integrating factor involving x only
+      -- look for an integrating factor involving x only
       not member?(y, variables(f := d / n)) => expint(f, x)
--- look for an integrating factor involving y only
+      -- look for an integrating factor involving y only
       not member?(x, variables(f := - d / m)) => expint(f, y)
--- room for more techniques later on (e.g. Prelle-Singer etc...)
+      -- room for more techniques later on (e.g. Prelle-Singer etc...)
       "failed"
 
--- check whether the equation is of the form
---    dy/dx + p(x)y + q(x)y^N = 0   with N > 1
--- i.e. whether m/n is of the form  p(x) y + q(x) y^N
--- returns [p, q, N] if the equation is in that form
+    -- check whether the equation is of the form
+    --    dy/dx + p(x)y + q(x)y^N = 0   with N > 1
+    -- i.e. whether m/n is of the form  p(x) y + q(x) y^N
+    -- returns [p, q, N] if the equation is in that form
     checkBernoulli(m, n, ky) ==
       r := denom(f := m / n)::F
       (not freeOf?(r, y := ky::F))
           or (d := degree(p := univariate(numer f, ky))) < 2
             or degree(pp := reductum p) ^= 1 or reductum(pp) ^= 0
               or (not freeOf?(a := (leadingCoefficient(pp)::F), y))
-                or (not freeOf?(b := (leadingCoefficient(p)::F), y)) => "failed"
+               or (not freeOf?(b := (leadingCoefficient(p)::F), y)) => "failed"
       [a / r, b / r, d]
 
--- solves the equation dy/dx + rec.coef1 y + rec.coefn y^rec.exponent = 0
--- the change of variable v = y^{1-n} transforms the above equation to
---  dv/dx + (1 - n) p v + (1 - n) q = 0
+    -- solves the equation dy/dx + rec.coef1 y + rec.coefn y^rec.exponent = 0
+    -- the change of variable v = y^{1-n} transforms the above equation to
+    --  dv/dx + (1 - n) p v + (1 - n) q = 0
     solveBernoulli(rec, y, x, yx) ==
       n1 := 1 - rec.exponent::Integer
       deq := differentiate(yx, x) + n1 * rec.coef1 * yx + n1 * rec.coefn
       sol := solve(deq, y, x)::SOL          -- can always solve for order 1
--- if v = vp + c v0 is the general solution of the linear equation, then
--- the general first integral for the Bernoulli equation is
--- (y^{1-n} - vp) / v0  =   c   for any constant c
+      -- if v = vp + c v0 is the general solution of the linear equation, then
+      -- the general first integral for the Bernoulli equation is
+      -- (y^{1-n} - vp) / v0  =   c   for any constant c
       (yx**n1 - sol.particular) / first(sol.basis)
 
--- check whether the equation is of the form
---    dy/dx + q0(x) + q1(x)y + q2(x)y^2 = 0
--- i.e. whether m/n is a quadratic polynomial in y.
--- returns the list [q0, q1, q2] if the equation is in that form
+    -- check whether the equation is of the form
+    --    dy/dx + q0(x) + q1(x)y + q2(x)y^2 = 0
+    -- i.e. whether m/n is a quadratic polynomial in y.
+    -- returns the list [q0, q1, q2] if the equation is in that form
     checkRiccati(m, n, ky) ==
       q := denom(f := m / n)::F
       (not freeOf?(q, y := ky::F)) or degree(p := univariate(numer f, ky)) > 2
@@ -147937,30 +180039,30 @@ NonLinearFirstOrderODESolver(R, F): Exports == Implementation where
              or (not freeOf?(a2 := (coefficient(p, 2)::F), y)) => "failed"
       [a0 / q, a1 / q, a2 / q]
 
--- solves the equation dy/dx + l.1 + l.2 y + l.3 y^2 = 0
+    -- solves the equation dy/dx + l.1 + l.2 y + l.3 y^2 = 0
     solveRiccati(l, y, x, yx) ==
--- get first a particular solution
+      -- get first a particular solution
       (u := partSolRiccati(l, y, x, yx)) case "failed" => "failed"
--- once a particular solution yp is known, the general solution is of the
--- form  y = yp + 1/v  where v satisfies the linear 1st order equation
--- v' - (l.2 + 2 l.3 yp) v = l.3
+      -- once a particular solution yp is known, the general solution is of the
+      -- form  y = yp + 1/v  where v satisfies the linear 1st order equation
+      -- v' - (l.2 + 2 l.3 yp) v = l.3
       deq := differentiate(yx, x) - (l.2 + 2 * l.3 * u::F) * yx - l.3
       gsol := solve(deq, y, x)::SOL         -- can always solve for order 1
--- if v = vp + c v0 is the general solution of the above equation, then
--- the general first integral for the Riccati equation is
---  (1/(y - yp) - vp) / v0  =   c   for any constant c
+      -- if v = vp + c v0 is the general solution of the above equation, then
+      -- the general first integral for the Riccati equation is
+      --  (1/(y - yp) - vp) / v0  =   c   for any constant c
       (inv(yx - u::F) - gsol.particular) / first(gsol.basis)
 
--- looks for a particular solution of dy/dx + l.1 + l.2 y + l.3 y^2 = 0
+    -- looks for a particular solution of dy/dx + l.1 + l.2 y + l.3 y^2 = 0
     partSolRiccati(l, y, x, yx) ==
--- we first do the change of variable y = z / l.3, which transforms
--- the equation into  dz/dx + l.1 l.3 + (l.2 - l.3'/l.3) z + z^2 = 0
+      -- we first do the change of variable y = z / l.3, which transforms
+      -- the equation into  dz/dx + l.1 l.3 + (l.2 - l.3'/l.3) z + z^2 = 0
       q0 := l.1 * (l3 := l.3)
       q1 := l.2 - differentiate(l3, x) / l3
--- the equation dz/dx + q0 + q1 z + z^2 = 0 is transformed by the change
--- of variable z = w'/w into the linear equation w'' + q1 w' + q0 w = 0
+      -- the equation dz/dx + q0 + q1 z + z^2 = 0 is transformed by the change
+      -- of variable z = w'/w into the linear equation w'' + q1 w' + q0 w = 0
       lineq := differentiate(yx, x, 2) + q1 * differentiate(yx, x) + q0 * yx
--- should be made faster by requesting a particular nonzero solution only
+      -- should be made faster by requesting a particular nonzero solution only
       (not((gsol := solve(lineq, y, x)) case SOL))
                               or empty?(bas := (gsol::SOL).basis) => "failed"
       differentiate(first bas, x) / (l3 * first bas)
@@ -147970,6 +180072,121 @@ NonLinearFirstOrderODESolver(R, F): Exports == Implementation where
 \begin{chunk}{COQ NODE1}
 (* package NODE1 *)
 (*
+
+    import ODEIntegration(R, F)
+    import ElementaryFunctionODESolver(R, F)    -- recursive dependency!
+
+    checkBernoulli   : (F, F, K) -> Union(BER, "failed")
+    solveBernoulli   : (BER, OP, SY, F) -> Union(F, "failed")
+    checkRiccati     : (F, F, K) -> Union(List F, "failed")
+    solveRiccati     : (List F, OP, SY, F) -> Union(F, "failed")
+    partSolRiccati   : (List F, OP, SY, F) -> Union(F, "failed")
+    integratingFactor: (F, F, SY, SY) -> U
+
+    unk    := new()$SY
+
+    kunk:K := kernel unk
+
+    solve(m, n, y, x) ==
+      -- first replace the operator y(x) by a new symbol z in m(x,y) and n(x,y)
+      lk:List(K) := [retract(yx := y(x::F))@K]
+      lv:List(F) := [kunk::F]
+      mm := eval(m, lk, lv)
+      nn := eval(n, lk, lv)
+      -- put over a common denominator (to balance m and n)
+      d := lcm(denom mm, denom nn)::F
+      mm := d * mm
+      nn := d * nn
+      -- look for an integrating factor mu
+      (u := integratingFactor(mm, nn, unk, x)) case F =>
+        mu := u::F
+        mm := mm * mu
+        nn := nn * mu
+        eval(int(mm,x) + int(nn-int(differentiate(mm,unk),x), unk),[kunk],[yx])
+      -- check for Bernoulli equation
+      (w := checkBernoulli(m, n, k1 := first lk)) case BER =>
+        solveBernoulli(w::BER, y, x, yx)
+      -- check for Riccati equation
+      (v := checkRiccati(m, n, k1)) case List(F) =>
+        solveRiccati(v::List(F), y, x, yx)
+      "failed"
+
+    -- look for an integrating factor
+    integratingFactor(m, n, y, x) ==
+      -- check first for exactness
+      zero?(d := differentiate(m, y) - differentiate(n, x)) => 1
+      -- look for an integrating factor involving x only
+      not member?(y, variables(f := d / n)) => expint(f, x)
+      -- look for an integrating factor involving y only
+      not member?(x, variables(f := - d / m)) => expint(f, y)
+      -- room for more techniques later on (e.g. Prelle-Singer etc...)
+      "failed"
+
+    -- check whether the equation is of the form
+    --    dy/dx + p(x)y + q(x)y^N = 0   with N > 1
+    -- i.e. whether m/n is of the form  p(x) y + q(x) y^N
+    -- returns [p, q, N] if the equation is in that form
+    checkBernoulli(m, n, ky) ==
+      r := denom(f := m / n)::F
+      (not freeOf?(r, y := ky::F))
+          or (d := degree(p := univariate(numer f, ky))) < 2
+            or degree(pp := reductum p) ^= 1 or reductum(pp) ^= 0
+              or (not freeOf?(a := (leadingCoefficient(pp)::F), y))
+               or (not freeOf?(b := (leadingCoefficient(p)::F), y)) => "failed"
+      [a / r, b / r, d]
+
+    -- solves the equation dy/dx + rec.coef1 y + rec.coefn y^rec.exponent = 0
+    -- the change of variable v = y^{1-n} transforms the above equation to
+    --  dv/dx + (1 - n) p v + (1 - n) q = 0
+    solveBernoulli(rec, y, x, yx) ==
+      n1 := 1 - rec.exponent::Integer
+      deq := differentiate(yx, x) + n1 * rec.coef1 * yx + n1 * rec.coefn
+      sol := solve(deq, y, x)::SOL          -- can always solve for order 1
+      -- if v = vp + c v0 is the general solution of the linear equation, then
+      -- the general first integral for the Bernoulli equation is
+      -- (y^{1-n} - vp) / v0  =   c   for any constant c
+      (yx**n1 - sol.particular) / first(sol.basis)
+
+    -- check whether the equation is of the form
+    --    dy/dx + q0(x) + q1(x)y + q2(x)y^2 = 0
+    -- i.e. whether m/n is a quadratic polynomial in y.
+    -- returns the list [q0, q1, q2] if the equation is in that form
+    checkRiccati(m, n, ky) ==
+      q := denom(f := m / n)::F
+      (not freeOf?(q, y := ky::F)) or degree(p := univariate(numer f, ky)) > 2
+         or (not freeOf?(a0 := (coefficient(p, 0)::F), y))
+           or (not freeOf?(a1 := (coefficient(p, 1)::F), y))
+             or (not freeOf?(a2 := (coefficient(p, 2)::F), y)) => "failed"
+      [a0 / q, a1 / q, a2 / q]
+
+    -- solves the equation dy/dx + l.1 + l.2 y + l.3 y^2 = 0
+    solveRiccati(l, y, x, yx) ==
+      -- get first a particular solution
+      (u := partSolRiccati(l, y, x, yx)) case "failed" => "failed"
+      -- once a particular solution yp is known, the general solution is of the
+      -- form  y = yp + 1/v  where v satisfies the linear 1st order equation
+      -- v' - (l.2 + 2 l.3 yp) v = l.3
+      deq := differentiate(yx, x) - (l.2 + 2 * l.3 * u::F) * yx - l.3
+      gsol := solve(deq, y, x)::SOL         -- can always solve for order 1
+      -- if v = vp + c v0 is the general solution of the above equation, then
+      -- the general first integral for the Riccati equation is
+      --  (1/(y - yp) - vp) / v0  =   c   for any constant c
+      (inv(yx - u::F) - gsol.particular) / first(gsol.basis)
+
+    -- looks for a particular solution of dy/dx + l.1 + l.2 y + l.3 y^2 = 0
+    partSolRiccati(l, y, x, yx) ==
+      -- we first do the change of variable y = z / l.3, which transforms
+      -- the equation into  dz/dx + l.1 l.3 + (l.2 - l.3'/l.3) z + z^2 = 0
+      q0 := l.1 * (l3 := l.3)
+      q1 := l.2 - differentiate(l3, x) / l3
+      -- the equation dz/dx + q0 + q1 z + z^2 = 0 is transformed by the change
+      -- of variable z = w'/w into the linear equation w'' + q1 w' + q0 w = 0
+      lineq := differentiate(yx, x, 2) + q1 * differentiate(yx, x) + q0 * yx
+      -- should be made faster by requesting a particular nonzero solution only
+      (not((gsol := solve(lineq, y, x)) case SOL))
+                              or empty?(bas := (gsol::SOL).basis) => "failed"
+      differentiate(first bas, x) / (l3 * first bas)
+
 *)
 
 \end{chunk}
@@ -148070,6 +180287,7 @@ NonLinearSolvePackage(R:IntegralDomain): Exports == Implementation where
       ++ functions with respect to all the symbols appearing in lp.
 
   Implementation ==> add
+
     solveInField l == solveInField(l, "setUnion"/[variables p for p in l])
 
     if R has AlgebraicallyClosedField then
@@ -148082,12 +180300,15 @@ NonLinearSolvePackage(R:IntegralDomain): Exports == Implementation where
       evalSol  : (List EQ, List EQ) -> List EQ
 
       solve l        == solve(l, "setUnion"/[variables p for p in l])
+
       solve(lp, lv)  == concat([expandSol sol for sol in solveInField(lp, lv)])
+
       addRoot(eq, l) == [concat(eq, sol) for sol in l]
+
       evalSol(ls, l) == [equation(lhs eq, eval(rhs eq, l)) for eq in ls]
 
--- converts [p1(a1),...,pn(an)] to
--- [[a1=v1,...,an=vn]] where vi ranges over all the zeros of pi
+      -- converts [p1(a1),...,pn(an)] to
+      -- [[a1=v1,...,an=vn]] where vi ranges over all the zeros of pi
       allRoots l ==
         empty? l => [empty()$List(EQ)]
         z := allRoots rest l
@@ -148103,7 +180324,6 @@ NonLinearSolvePackage(R:IntegralDomain): Exports == Implementation where
                                      else lsubs := concat(eq, lsubs)
           else
             if ((u := retractIfCan(lhs eq)@Union(P, "failed")) case P) and
---               one?(# variables(u::P)) and ((r := RIfCan rhs eq) case R) then
                ((# variables(u::P)) = 1) and ((r := RIfCan rhs eq) case R) then
                  luniv := concat(u::P - r::R::P, luniv)
             else return [l]
@@ -148112,22 +180332,28 @@ NonLinearSolvePackage(R:IntegralDomain): Exports == Implementation where
 
       RIfCan f ==
         ((n := retractIfCan(numer f)@Union(R,"failed")) case R) and
-          ((d := retractIfCan(denom f)@Union(R,"failed")) case R) => n::R / d::R
+          ((d:= retractIfCan(denom f)@Union(R,"failed")) case R) => n::R / d::R
         "failed"
+
     else
+
       solve l       == solveInField l
+
       solve(lp, lv) == solveInField(lp, lv)
 
- -- 'else if' is doubtful with this compiler so all 3 conditions are explicit
+     -- 'else if' is doubtful with this compiler; all 3 conditions are explicit
     if (not(R is Q)) and (R has RetractableTo Q) then
+
       solveInField(lp, lv) == solveRetract(lp, lv)$SOL(Q, R)
 
     if (not(R is Z)) and (not(R has RetractableTo Q)) and
       (R has RetractableTo Z) then
+
         solveInField(lp, lv) == solveRetract(lp, lv)$SOL(Z, R)
 
     if (not(R is Z)) and (not(R has RetractableTo Q)) and
       (not(R has RetractableTo Z)) then
+
         solveInField(lp, lv) == solve([p::F for p in lp]$List(F), lv)$SSP(R)
 
 \end{chunk}
@@ -148135,6 +180361,75 @@ NonLinearSolvePackage(R:IntegralDomain): Exports == Implementation where
 \begin{chunk}{COQ NLINSOL}
 (* package NLINSOL *)
 (*
+
+    solveInField l == solveInField(l, "setUnion"/[variables p for p in l])
+
+    if R has AlgebraicallyClosedField then
+      import RationalFunction(R)
+
+      expandSol: List EQ -> List List EQ
+      RIfCan   : F -> Union(R, "failed")
+      addRoot  : (EQ, List List EQ) -> List List EQ
+      allRoots : List P -> List List EQ
+      evalSol  : (List EQ, List EQ) -> List EQ
+
+      solve l        == solve(l, "setUnion"/[variables p for p in l])
+
+      solve(lp, lv)  == concat([expandSol sol for sol in solveInField(lp, lv)])
+
+      addRoot(eq, l) == [concat(eq, sol) for sol in l]
+
+      evalSol(ls, l) == [equation(lhs eq, eval(rhs eq, l)) for eq in ls]
+
+      -- converts [p1(a1),...,pn(an)] to
+      -- [[a1=v1,...,an=vn]] where vi ranges over all the zeros of pi
+      allRoots l ==
+        empty? l => [empty()$List(EQ)]
+        z := allRoots rest l
+        s := mainVariable(p := first l)::SY::P::F
+        concat [addRoot(equation(s, a::P::F), z) for a in zerosOf univariate p]
+
+      expandSol l ==
+        lassign := lsubs := empty()$List(EQ)
+        luniv := empty()$List(P)
+        for eq in l repeat
+          if retractIfCan(lhs eq)@Union(SY, "failed") case SY then
+            if RIfCan(rhs eq) case R then lassign := concat(eq, lassign)
+                                     else lsubs := concat(eq, lsubs)
+          else
+            if ((u := retractIfCan(lhs eq)@Union(P, "failed")) case P) and
+               ((# variables(u::P)) = 1) and ((r := RIfCan rhs eq) case R) then
+                 luniv := concat(u::P - r::R::P, luniv)
+            else return [l]
+        empty? luniv => [l]
+        [concat(z, concat(evalSol(lsubs,z), lassign)) for z in allRoots luniv]
+
+      RIfCan f ==
+        ((n := retractIfCan(numer f)@Union(R,"failed")) case R) and
+          ((d:= retractIfCan(denom f)@Union(R,"failed")) case R) => n::R / d::R
+        "failed"
+
+    else
+
+      solve l       == solveInField l
+
+      solve(lp, lv) == solveInField(lp, lv)
+
+     -- 'else if' is doubtful with this compiler; all 3 conditions are explicit
+    if (not(R is Q)) and (R has RetractableTo Q) then
+
+      solveInField(lp, lv) == solveRetract(lp, lv)$SOL(Q, R)
+
+    if (not(R is Z)) and (not(R has RetractableTo Q)) and
+      (R has RetractableTo Z) then
+
+        solveInField(lp, lv) == solveRetract(lp, lv)$SOL(Z, R)
+
+    if (not(R is Z)) and (not(R has RetractableTo Q)) and
+      (not(R has RetractableTo Z)) then
+
+        solveInField(lp, lv) == solve([p::F for p in lp]$List(F), lv)$SSP(R)
+
 *)
 
 \end{chunk}
@@ -148395,61 +180690,187 @@ NormalizationPackage(R,E,V,P,TS): Exports == Implementation where
 \begin{chunk}{COQ NORMPK}
 (* package NORMPK *)
 (*
-*)
-
-\end{chunk}
 
-\begin{chunk}{NORMPK.dotabb}
-"NORMPK" [color="#FF4488",href="bookvol10.4.pdf#nameddest=NORMPK"]
-"SFRTCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=SFRTCAT"]
-"NORMPK" -> "SFRTCAT"
+     if TS has SquareFreeRegularTriangularSetCategory(R,E,V,P)
+     then
 
-\end{chunk}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{package NORMMA NormInMonogenicAlgebra}
-\begin{chunk}{NormInMonogenicAlgebra.input}
-)set break resume
-)sys rm -f NormInMonogenicAlgebra.output
-)spool NormInMonogenicAlgebra.output
-)set message test on
-)set message auto off
-)clear all
+       normInvertible?(p:P, ts:TS): List BWT ==
+         stoseInvertible?_sqfreg(p,ts)$regsetgcdpack
 
---S 1 of 1
-)show NormInMonogenicAlgebra
---R 
---R NormInMonogenicAlgebra(R: GcdDomain,PolR: UnivariatePolynomialCategory(R),E: MonogenicAlgebra(R,PolR),PolE: UnivariatePolynomialCategory(E))  is a package constructor
---R Abbreviation for NormInMonogenicAlgebra is NORMMA 
---R This constructor is exposed in this frame.
---R Issue )edit bookvol10.4.pamphlet to see algebra source code for NORMMA 
---R
---R------------------------------- Operations --------------------------------
---R norm : PolE -> PolR                  
---R
---E 1
+     else
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{NormInMonogenicAlgebra.help}
-====================================================================
-NormInMonogenicAlgebra examples
-====================================================================
+       normInvertible?(p:P, ts:TS): List BWT ==
+         stoseInvertible?_reg(p,ts)$regsetgcdpack
 
-This package implements the norm of a polynomial with coefficients
-in a monogenic algebra (using resultants)
+     if (R has RetractableTo(Integer)) and (V has ConvertibleTo(Symbol))
+     then 
 
-See Also:
-o )show NormInMonogenicAlgebra
+       outputArgs(s1:S, s2: S, p:P,ts:TS): Void ==
+         if not empty? s1 then output(s1, p::OutputForm)$OutputPackage
+         if not empty? s1 then _
+              output(s1,(convert(p)@String)::OutputForm)$OutputPackage
+         output(" ")$OutputPackage
+         if not empty? s2 then output(s2, ts::OutputForm)$OutputPackage       
+         empty? s2 => void()
+         output(s2,("[")::OutputForm)$OutputPackage
+         lp: List P := members(ts)
+         for q in lp repeat
+            output((convert(q)@String)::OutputForm)$OutputPackage
+         output("]")$OutputPackage
+         output(" ")$OutputPackage
 
-\end{chunk}
-\pagehead{NormInMonogenicAlgebra}{NORMMA}
-\pagepic{ps/v104norminmonogenicalgebra.ps}{NORMMA}{1.00}
+     else
 
-{\bf Exports:}\\
-\cross{NORMMA}{norm} 
+       outputArgs(s1:S, s2: S, p:P,ts:TS): Void ==
+         if not empty? s1 then output(s1, p::OutputForm)$OutputPackage
+         output(" ")$OutputPackage
+         if not empty? s2 then output(s2, ts::OutputForm)$OutputPackage       
+         output(" ")$OutputPackage
 
-\begin{chunk}{package NORMMA NormInMonogenicAlgebra}
+     recip(p:P,ts:TS): Record(num:P, den:P) ==
+     -- ASSUME p is invertible w.r.t. ts
+     -- ASSUME mvar(p) is algebraic w.r.t. ts
+       v := mvar(p)
+       ts_v := select(ts,v)::P
+       if mdeg(p) < mdeg(ts_v)
+         then
+           hesrg: Record (gcd : P, coef2 : P)  := _
+                    halfExtendedSubResultantGcd2(ts_v,p)$P
+           d: P :=  hesrg.gcd; n: P := hesrg.coef2
+         else
+           hesrg: Record (gcd : P, coef1 : P) := _
+                    halfExtendedSubResultantGcd1(p,ts_v)$P
+           d: P :=  hesrg.gcd; n: P := hesrg.coef1
+       g := gcd(n,d)
+       (n, d) := ((n exquo g)::P, (d exquo g)::P)
+       remn, remd: Record(rnum:R,polnum:P,den:R)
+       remn := remainder(n,ts); remd := remainder(d,ts)
+       cn := remn.rnum; pn := remn.polnum; dn := remn.den
+       cd := remd.rnum; pd := remd.polnum; dp := remd.den
+       k: K := (cn / cd) * (dp / dn)
+       pn := removeZero(pn,ts)
+       pd := removeZero(pd,ts)
+       [numer(k) * pn, denom(k) * pd]$Record(num:P, den:P)
+
+     normalizedAssociate(p:P,ts:TS): P ==
+     -- ASSUME p is invertible or zero w.r.t. ts
+       empty? ts => p
+       zero?(p) => p
+       ground?(p) => 1
+       zero? initiallyReduce(init(p),ts) =>
+         error "in normalizedAssociate$NORMPK: bad #1"
+       vp := mvar(p)
+       ip: P := p
+       mp: P := 1
+       tp: P := 0
+       while not ground?(ip) repeat
+         v := mvar(ip)
+         if algebraic?(v,ts)
+           then
+             if v = vp
+               then
+                 ts_v := select(ts,v)::P
+                 ip := lastSubResultant(ip,ts_v)$P
+                 ip := remainder(ip,ts).polnum
+                 -- ip := primitivePart stronglyReduce(ip,ts)
+                 ip := primitivePart initiallyReduce(ip,ts)
+               else
+                 qr := recip(ip,ts)
+                 ip := qr.den
+                 tp := qr.num * tp
+                 zero? ip =>
+                     outputArgs("p = ", " ts = ",p,ts)
+                     error _
+                       "in normalizedAssociate$NORMPK: should never happen !"
+           else
+             tp := tail(ip) * mp + tp
+             mp := mainMonomial(ip) * mp
+             ip := init(ip)
+       r := ip * mp + tp
+       r := remainder(r,ts).polnum
+       -- primitivePart stronglyReduce(r,ts)
+       primitivePart initiallyReduce(r,ts)
+
+     normalize(p: P, ts: TS): List PWT ==
+       zero? p => [[p,ts]$PWT]
+       ground? p => [[1,ts]$PWT]
+       zero? initiallyReduce(init(p),ts) =>
+         error "in normalize$NORMPK: init(#1) reduces to 0 w.r.t. #2"
+       --output("Entering  normalize")$OutputPackage
+       --outputArgs("p = ", " ts = ",p,ts)
+       --output("Calling  normInvertible?")$OutputPackage
+       lbwt: List BWT := normInvertible?(p,ts)
+       --output("Result is: ")$OutputPackage
+       --output(lbwt::OutputForm)$OutputPackage
+       lpwt: List PWT := []
+       for bwt in lbwt repeat
+         us := bwt.tower
+         q := remainder(p,us).polnum
+         q := removeZero(q,us)
+         bwt.val =>
+           --output("Calling  normalizedAssociate")$OutputPackage
+           --outputArgs("q = ", " us = ",q,us)
+           lpwt := cons([normalizedAssociate(q,us)@P,us]$PWT, lpwt)
+           --output("Leaving  normalizedAssociate")$OutputPackage
+         zero? q => lpwt := cons([0$P,us]$PWT, lpwt)
+         lpwt := concat(normalize(q,us)@(List PWT),lpwt)
+       lpwt
+
+*)
+
+\end{chunk}
+
+\begin{chunk}{NORMPK.dotabb}
+"NORMPK" [color="#FF4488",href="bookvol10.4.pdf#nameddest=NORMPK"]
+"SFRTCAT" [color="#4488FF",href="bookvol10.2.pdf#nameddest=SFRTCAT"]
+"NORMPK" -> "SFRTCAT"
+
+\end{chunk}
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{package NORMMA NormInMonogenicAlgebra}
+\begin{chunk}{NormInMonogenicAlgebra.input}
+)set break resume
+)sys rm -f NormInMonogenicAlgebra.output
+)spool NormInMonogenicAlgebra.output
+)set message test on
+)set message auto off
+)clear all
+
+--S 1 of 1
+)show NormInMonogenicAlgebra
+--R 
+--R NormInMonogenicAlgebra(R: GcdDomain,PolR: UnivariatePolynomialCategory(R),E: MonogenicAlgebra(R,PolR),PolE: UnivariatePolynomialCategory(E))  is a package constructor
+--R Abbreviation for NormInMonogenicAlgebra is NORMMA 
+--R This constructor is exposed in this frame.
+--R Issue )edit bookvol10.4.pamphlet to see algebra source code for NORMMA 
+--R
+--R------------------------------- Operations --------------------------------
+--R norm : PolE -> PolR                  
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{NormInMonogenicAlgebra.help}
+====================================================================
+NormInMonogenicAlgebra examples
+====================================================================
+
+This package implements the norm of a polynomial with coefficients
+in a monogenic algebra (using resultants)
+
+See Also:
+o )show NormInMonogenicAlgebra
+
+\end{chunk}
+\pagehead{NormInMonogenicAlgebra}{NORMMA}
+\pagepic{ps/v104norminmonogenicalgebra.ps}{NORMMA}{1.00}
+
+{\bf Exports:}\\
+\cross{NORMMA}{norm} 
+
+\begin{chunk}{package NORMMA NormInMonogenicAlgebra}
 )abbrev package NORMMA NormInMonogenicAlgebra
 ++ Author: Manuel Bronstein
 ++ Date Created: 23 February 1995
@@ -148472,6 +180893,7 @@ NormInMonogenicAlgebra(R, PolR, E, PolE): Exports == Implementation where
       ++ i.e. the product of all the conjugates of q.
 
   Implementation ==> add
+
     import UnivariatePolynomialCategoryFunctions2(R, PolR, PolR, SUP PolR)
 
     PolR2SUP: PolR -> SUP PolR
@@ -148491,6 +180913,21 @@ NormInMonogenicAlgebra(R, PolR, E, PolE): Exports == Implementation where
 \begin{chunk}{COQ NORMMA}
 (* package NORMMA *)
 (*
+
+    import UnivariatePolynomialCategoryFunctions2(R, PolR, PolR, SUP PolR)
+
+    PolR2SUP: PolR -> SUP PolR
+    PolR2SUP q == map(x +-> x::PolR, q)
+
+    defpol := PolR2SUP(definingPolynomial()$E)
+
+    norm q ==
+      p:SUP PolR := 0
+      while q ~= 0 repeat
+        p := p + monomial(1,degree q)$PolR * PolR2SUP lift leadingCoefficient q
+        q := reductum q
+      primitivePart resultant(p, defpol)
+
 *)
 
 \end{chunk}
@@ -148608,6 +181045,36 @@ NormRetractPackage(F, ExtF, SUEx, ExtP, n):C  == T where
 \begin{chunk}{COQ NORMRETR}
 (* package NORMRETR *)
 (*
+
+      normFactors(p:ExtP):List ExtP ==
+          facs : List ExtP := [p]
+          for i in 1..n-1 repeat 
+             member?((p := Frobenius p), facs) => return facs
+             facs := cons(p, facs)
+          facs
+
+      Frobenius(ff:ExtP):ExtP ==
+         fft:ExtP:=0
+         while ff^=0 repeat
+           fft:=fft + monomial(map(Frobenius, leadingCoefficient ff),
+                               degree ff)
+           ff:=reductum ff
+         fft
+
+      retractIfCan(ff:ExtP):Union(P, "failed") ==          
+         fft:P:=0
+         while ff ^= 0 repeat
+           lc : SUEx := leadingCoefficient ff
+           plc: SUP F := 0
+           while lc ^= 0 repeat
+              lclc:ExtF := leadingCoefficient lc
+              (retlc := retractIfCan lclc) case "failed" => return "failed"
+              plc := plc + monomial(retlc::F, degree lc)
+              lc := reductum lc
+           fft:=fft+monomial(plc, degree ff)
+           ff:=reductum ff
+         fft
+
 *)
 
 \end{chunk}
@@ -148832,6 +181299,129 @@ NPCoef(BP,E,OV,R,P) : C == T where
 \begin{chunk}{COQ NPCOEF}
 (* package NPCOEF *)
 (*
+ 
+                 ----   Local  Functions  ----
+  check      : (TermC,Vector P) -> Union(Detc,"failed")
+  buildvect  : (List(VTerm),NNI) -> Vector(List(VTerm))
+  buildtable : (Vector(P),List(List NNI),List P) -> TCoef
+  modify : (TCoef,Detc) -> TCoef 
+  constructp : VTerm -> USP
+
+  npcoef(u:USP,factlist:List(BP),leadlist:List(P)) :DetCoef ==
+    detcoef:List(VTerm):=empty();detufact:List(USP):=empty()
+    lexp:List(List(NNI)):=[listexp(v) for v in factlist]
+    ulist :Vector(P):=vector [coefficient(u,i) for i in 0..degree u]
+    tablecoef:=buildtable(ulist,lexp,leadlist)
+    detcoef:=[[[ep.first,lcu]$Term]  for ep in lexp for lcu in leadlist]
+    ldtcf:=detcoef
+    lexp:=[ep.rest for ep in lexp]
+    ndet:NNI:=#factlist
+    changed:Boolean:=true
+    ltochange:List(NNI):=empty()
+    ltodel:List(NNI):=empty()
+    while changed and ndet^=1 repeat
+      changed :=false
+      dt:=#tablecoef
+      for i in 1..dt while ^changed repeat
+        (cf:=check(tablecoef.i,ulist)) case "failed" => "next i"
+        ltochange:=cons(i,ltochange)
+        celtf:Detc:=cf::Detc
+        tablecoef:=modify(tablecoef,celtf)
+        vpos:=celtf.posit
+        vexp:=celtf.valexp
+        nterm:=[vexp,celtf.valcoef]$Term
+        detcoef.vpos:=cons(nterm,detcoef.vpos)
+        lexp.vpos:=delete(lexp.vpos,position(vexp,lexp.vpos))
+        if lexp.vpos=[] then
+         ltodel:=cons(vpos,ltodel)
+         ndet:=(ndet-1):NNI
+         detufact:=cons(constructp(detcoef.vpos),detufact)
+        changed:=true
+      for i in ltochange repeat tablecoef:=delete(tablecoef,i)
+      ltochange:=[]
+    if ndet=1 then
+     uu:=u exquo */[pol for pol in detufact]
+     if uu case "failed" then return
+       [empty(),ldtcf,factlist,leadlist]$DetCoef
+     else  detufact:=cons(uu::USP,detufact)
+    else
+      ltodel:=sort((n1:NNI,n2:NNI):Boolean +-> n1>n2,ltodel)
+      for i in ltodel repeat
+        detcoef:=delete(detcoef,i)
+        factlist:=delete(factlist,i)
+        leadlist:=delete(leadlist,i)
+    [detufact,detcoef,factlist,leadlist]$DetCoef
+ 
+ 
+  check(tterm:TermC,ulist:Vector(P)) : Union(Detc,"failed") ==
+    cfu:P:=1$P;doit:NNI:=0;poselt:NNI:=0;pp:Union(P,"failed")
+    termlist:List(VTerm):=tterm.detfacts
+    vterm:VTerm:=empty()
+    #termlist=1 =>
+      vterm:=termlist.first
+      for elterm in vterm while doit<2 repeat
+        (cu1:=elterm.pcoef)^=0 => cfu:=cu1*cfu
+        doit:=doit+1
+        poselt:=position(elterm,vterm):NNI
+      doit=2  or (pp:=tterm.coefu exquo cfu) case "failed" => "failed"
+      [vterm.poselt.expt,pp::P,poselt]$Detc
+    "failed"
+ 
+  buildvect(lvterm:List(VTerm),n:NNI) : Vector(List(VTerm)) ==
+    vtable:Vector(List(VTerm)):=new(n,empty())
+    (#lvterm)=1 =>
+      for term in lvterm.first repeat vtable.(term.expt+1):=[[term]]
+      vtable
+ 
+    vtable:=buildvect(lvterm.rest,n)
+    ntable:Vector(List(VTerm)):=new(n,empty())
+    for term in lvterm.first repeat
+      nexp:=term.expt
+      for i in 1..n while (nexp+i)<(n+1) repeat
+        ntable.(nexp+i):=append(
+                            [cons(term,lvterm) for lvterm in vtable.i],
+                               ntable.(nexp+i))
+    ntable
+ 
+  buildtable(vu:Vector(P),lvect:List(List(NNI)),leadlist:List(P)):TCoef==
+    nfact:NNI:=#leadlist
+    table:TCoef:=empty()
+    degu:=(#vu-1)::NNI
+    prelim:List(VTerm):=[[[e,0$P]$Term for e in lv] for lv in lvect]
+    for i in 1..nfact repeat prelim.i.first.pcoef:=leadlist.i
+    partialv:Vector(List(VTerm)):=new(nfact,empty())
+    partialv:=buildvect(prelim,degu)
+    for i in 1..degu repeat
+      empty? partialv.i => "next i"
+      table:=cons([vu.i,partialv.i]$TermC, table)
+    table
+ 
+  modify(tablecoef:TCoef,cfter:Detc) : TCoef ==
+    cfexp:=cfter.valexp;cfcoef:=cfter.valcoef;cfpos:=cfter.posit
+    lterase:List(NNI):=empty()
+    for cterm in tablecoef | ^empty?(ctdet:=cterm.detfacts) repeat
+      (+/[term.expt for term in ctdet.first])<cfexp => "next term"
+      for celt in ctdet repeat
+        if celt.cfpos.expt=cfexp then
+          celt.cfpos.pcoef:=cfcoef
+          if (and/[cc.pcoef ^=0 for cc in celt]) then
+            k:=position(celt,ctdet):NNI
+            lterase:=cons(k,lterase)
+            cterm.coefu:=(cterm.coefu - */[cc.pcoef for cc in celt])
+      if not empty? lterase then
+        lterase:=sort((n1:NNI,n2:NNI):Boolean +-> n1>n2,lterase)
+        for i in lterase repeat ctdet:=delete(ctdet,i)
+        cterm.detfacts:=ctdet
+        lterase:=empty()
+    tablecoef
+ 
+  listexp(up:BP) :List(NNI) ==
+    degree up=0 => [0]
+    [degree up,:listexp(reductum up)]
+ 
+  constructp(lterm:VTerm):USP ==
+    +/[monomial(term.pcoef,term.expt) for term in lterm]
+
 *)
 
 \end{chunk}
@@ -148951,6 +181541,7 @@ NumberFieldIntegralBasis(UP,F): Exports == Implementation where
       ++ \spad{wi = sum(bij * vj, j = 1..n)}.
 
   Implementation ==> add
+
     import IntegralBasisTools(I, UP, F)
     import ModularHermitianRowReduction(I)
     import TriangularMatrixOperations(I, Vector I, Vector I, Matrix I)
@@ -149003,7 +181594,6 @@ NumberFieldIntegralBasis(UP,F): Exports == Implementation where
       -- these are wrt the original basis for F
       runningRbden : I := 1
       -- runningRbden = denominator for current basis matrix
---      one? sing and empty? wilds => [runningRb, runningRbden, runningRbinv]
       (sing = 1) and empty? wilds => [runningRb, runningRbden, runningRbinv]
       -- id = basis matrix of the ideal (p-radical) wrt current basis
       matrixOut : Mat := scalarMatrix(n,0)
@@ -149070,7 +181660,6 @@ NumberFieldIntegralBasis(UP,F): Exports == Implementation where
         rbinv := UpTriBddDenomInv(rb, rbden)
         disc := disc0 quo (index * index)
         indexChange := index quo oldIndex; oldIndex := index
---        one? indexChange => return [rb, rbden, rbinv, disc]
         (indexChange = 1) => return [rb, rbden, rbinv, disc]
         tfm := ((rb * traceMat * transpose rb) exquo (rbden * rbden)) :: Mat
 
@@ -149104,7 +181693,6 @@ NumberFieldIntegralBasis(UP,F): Exports == Implementation where
         rbinv := UpTriBddDenomInv(rb, rbden)
         indexChange := index quo oldIndex; oldIndex := index
         disc := disc quo (indexChange * indexChange)
---        one? indexChange or gcd(p2,disc) ^= p2 =>
         (indexChange = 1) or gcd(p2,disc) ^= p2 =>
           return [rb, rbden, rbinv, disc]
 
@@ -149120,6 +181708,168 @@ NumberFieldIntegralBasis(UP,F): Exports == Implementation where
 \begin{chunk}{COQ NFINTBAS}
 (* package NFINTBAS *)
 (*
+
+    import IntegralBasisTools(I, UP, F)
+    import ModularHermitianRowReduction(I)
+    import TriangularMatrixOperations(I, Vector I, Vector I, Matrix I)
+
+    frobMatrix              : (Mat,Mat,I,NNI) -> Mat
+    wildPrimes              : (FR,I) -> List I
+    tameProduct             : (FR,I) -> I
+    iTameLocalIntegralBasis : (Mat,I,I) -> Ans
+    iWildLocalIntegralBasis : (Mat,I,I) -> Ans
+
+    frobMatrix(rb,rbinv,rbden,p) ==
+      n := rank()$F; b := basis()$F
+      v : Vector F := new(n,0)
+      for i in minIndex(v)..maxIndex(v)
+        for ii in minRowIndex(rb)..maxRowIndex(rb) repeat
+          a : F := 0
+          for j in minIndex(b)..maxIndex(b)
+            for jj in minColIndex(rb)..maxColIndex(rb) repeat
+              a := a + qelt(rb,ii,jj) * qelt(b,j)
+          qsetelt_!(v,i,a**p)
+      mat := transpose coordinates v
+      ((transpose(rbinv) * mat) exquo (rbden ** p)) :: Mat
+
+    wildPrimes(factoredDisc,n) ==
+      -- returns a list of the primes <=n which divide factoredDisc to a
+      -- power greater than 1
+      ans : List I := empty()
+      for f in factors(factoredDisc) repeat
+        if f.exponent > 1 and f.factor <= n then ans := concat(f.factor,ans)
+      ans
+
+    tameProduct(factoredDisc,n) ==
+      -- returns the product of the primes > n which divide factoredDisc
+      -- to a power greater than 1
+      ans : I := 1
+      for f in factors(factoredDisc) repeat
+        if f.exponent > 1 and f.factor > n then ans := f.factor * ans
+      ans
+
+    integralBasis() ==
+      traceMat := traceMatrix()$F; n := rank()$F
+      disc := determinant traceMat  -- discriminant of current order
+      disc0 := disc                 -- this is disc(F)
+      factoredDisc := factor(disc0)$IntegerFactorizationPackage(Integer)
+      wilds := wildPrimes(factoredDisc,n)
+      sing := tameProduct(factoredDisc,n)
+      runningRb := scalarMatrix(n, 1); runningRbinv := scalarMatrix(n, 1)
+      -- runningRb    = basis matrix of current order
+      -- runningRbinv = inverse basis matrix of current order
+      -- these are wrt the original basis for F
+      runningRbden : I := 1
+      -- runningRbden = denominator for current basis matrix
+      (sing = 1) and empty? wilds => [runningRb, runningRbden, runningRbinv]
+      -- id = basis matrix of the ideal (p-radical) wrt current basis
+      matrixOut : Mat := scalarMatrix(n,0)
+      for p in wilds repeat
+        lb := iWildLocalIntegralBasis(matrixOut,disc,p)
+        rb := lb.basis; rbinv := lb.basisInv; rbden := lb.basisDen
+        disc := lb.discr
+        -- update 'running integral basis' if newly computed
+        -- local integral basis is non-trivial
+        if sizeLess?(1,rbden) then
+          mat := vertConcat(rbden * runningRb,runningRbden * rb)
+          runningRbden := runningRbden * rbden
+          runningRb := squareTop rowEchelon(mat,runningRbden)
+          runningRbinv := UpTriBddDenomInv(runningRb,runningRbden)
+      lb := iTameLocalIntegralBasis(traceMat,disc,sing)
+      rb := lb.basis; rbinv := lb.basisInv; rbden := lb.basisDen
+      disc := lb.discr
+      -- update 'running integral basis' if newly computed
+      -- local integral basis is non-trivial
+      if sizeLess?(1,rbden) then
+        mat := vertConcat(rbden * runningRb,runningRbden * rb)
+        runningRbden := runningRbden * rbden
+        runningRb := squareTop rowEchelon(mat,runningRbden)
+        runningRbinv := UpTriBddDenomInv(runningRb,runningRbden)
+      [runningRb,runningRbden,runningRbinv]
+
+    localIntegralBasis p ==
+      traceMat := traceMatrix()$F; n := rank()$F
+      disc := determinant traceMat  -- discriminant of current order
+      (disc exquo (p*p)) case "failed" =>
+        [scalarMatrix(n, 1), 1, scalarMatrix(n, 1)]
+      lb :=
+        p > rank()$F =>
+          iTameLocalIntegralBasis(traceMat,disc,p)
+        iWildLocalIntegralBasis(scalarMatrix(n,0),disc,p)
+      [lb.basis,lb.basisDen,lb.basisInv]
+
+    iTameLocalIntegralBasis(traceMat,disc,sing) ==
+      n := rank()$F; disc0 := disc
+      rb := scalarMatrix(n, 1); rbinv := scalarMatrix(n, 1)
+      -- rb    = basis matrix of current order
+      -- rbinv = inverse basis matrix of current order
+      -- these are wrt the original basis for F
+      rbden : I := 1; index : I := 1; oldIndex : I := 1
+      -- rbden = denominator for current basis matrix
+      -- id = basis matrix of the ideal (p-radical) wrt current basis
+      tfm := traceMat
+      repeat
+        -- compute the p-radical = p-trace-radical
+        idinv := transpose squareTop rowEchelon(tfm,sing)
+        -- [u1,..,un] are the coordinates of an element of the p-radical
+        -- iff [u1,..,un] * idinv is in p * Z^n
+        id := rowEchelon LowTriBddDenomInv(idinv, sing)
+        -- id = basis matrix of the p-radical
+        idinv := UpTriBddDenomInv(id, sing)
+        -- id * idinv = sing * identity
+        -- no need to check for inseparability in this case
+        rbinv := idealiser(id * rb, rbinv * idinv, sing * rbden)
+        index := diagonalProduct rbinv
+        rb := rowEchelon LowTriBddDenomInv(rbinv, sing * rbden)
+        g := matrixGcd(rb,sing,n)
+        if sizeLess?(1,g) then rb := (rb exquo g) :: Mat
+        rbden := rbden * (sing quo g)
+        rbinv := UpTriBddDenomInv(rb, rbden)
+        disc := disc0 quo (index * index)
+        indexChange := index quo oldIndex; oldIndex := index
+        (indexChange = 1) => return [rb, rbden, rbinv, disc]
+        tfm := ((rb * traceMat * transpose rb) exquo (rbden * rbden)) :: Mat
+
+    iWildLocalIntegralBasis(matrixOut,disc,p) ==
+      n := rank()$F; disc0 := disc
+      rb := scalarMatrix(n, 1); rbinv := scalarMatrix(n, 1)
+      -- rb    = basis matrix of current order
+      -- rbinv = inverse basis matrix of current order
+      -- these are wrt the original basis for F
+      rbden : I := 1; index : I := 1; oldIndex : I := 1
+      -- rbden = denominator for current basis matrix
+      -- id = basis matrix of the ideal (p-radical) wrt current basis
+      p2 := p * p; lp := leastPower(p::NNI,n)
+      repeat
+        tfm := frobMatrix(rb,rbinv,rbden,p::NNI) ** lp
+        -- compute Rp = p-radical
+        idinv := transpose squareTop rowEchelon(tfm, p)
+        -- [u1,..,un] are the coordinates of an element of Rp
+        -- iff [u1,..,un] * idinv is in p * Z^n
+        id := rowEchelon LowTriBddDenomInv(idinv,p)
+        -- id = basis matrix of the p-radical
+        idinv := UpTriBddDenomInv(id,p)
+        -- id * idinv = p * identity
+        -- no need to check for inseparability in this case
+        rbinv := idealiser(id * rb, rbinv * idinv, p * rbden)
+        index := diagonalProduct rbinv
+        rb := rowEchelon LowTriBddDenomInv(rbinv, p * rbden)
+        if divideIfCan_!(rb,matrixOut,p,n) = 1
+          then rb := matrixOut
+          else rbden := p * rbden
+        rbinv := UpTriBddDenomInv(rb, rbden)
+        indexChange := index quo oldIndex; oldIndex := index
+        disc := disc quo (indexChange * indexChange)
+        (indexChange = 1) or gcd(p2,disc) ^= p2 =>
+          return [rb, rbden, rbinv, disc]
+
+    discriminant() ==
+      disc := determinant traceMatrix()$F
+      intBas := integralBasis()
+      rb := intBas.basis; rbden := intBas.basisDen
+      index := ((rbden ** rank()$F) exquo (determinant rb)) :: Integer
+      (disc exquo (index * index)) :: Integer
+
 *)
 
 \end{chunk}
@@ -149220,23 +181970,27 @@ NumberFormats(): NFexports == NFimplementation where
             ++ ScanFloatIgnoreSpacesIfCan(s) tries to form a floating point
             ++ number from the string s ignoring any spaces.
 
-
     NFimplementation ==> add
+
         import SExpression
         import Symbol
         replaceD: C -> C
         replaced: C -> C
         contract: S -> S
         check: S ->Boolean
+
         replaceD c ==
           if c = char "D" then char "E" else c
+
         replaced c ==
           if c = char "d" then char "E" else c
+
         contract s ==
           s:= map(replaceD,s)
           s:= map(replaced,s)
           ls:List S := split(s,char " ")$String
           s:= concat ls
+
         check s ==
           NUMBERP(READ_-FROM_-STRING(s)$Lisp)$Lisp and
            -- if there is an "E" then there must be a "."
@@ -149245,8 +181999,6 @@ NumberFormats(): NFexports == NFimplementation where
            not (any?((c1:C):Boolean +-> c1=char "E",s) 
              and not any?((c2:C):Boolean +-> c2=char ".",s) )
 
---        Original interpreter function:
---        )lis (defun scanstr(x) (spadcomp::|parseFromString| x))
         sexfloat:SExpression:=convert(coerce("Float")@Symbol)$SExpression
         ScanFloatIgnoreSpaces s ==
           s := contract s
@@ -149300,6 +182052,7 @@ NumberFormats(): NFexports == NFimplementation where
         ichar:C := char "I"
 
         FormatArabic n == PRINC_-TO_-STRING(n)$Lisp
+
         ScanArabic   s == PARSE_-INTEGER(s)$Lisp
 
         FormatRoman pn ==
@@ -149382,6 +182135,165 @@ NumberFormats(): NFexports == NFimplementation where
 \begin{chunk}{COQ NUMFMT}
 (* package NUMFMT *)
 (*
+
+        import SExpression
+        import Symbol
+        replaceD: C -> C
+        replaced: C -> C
+        contract: S -> S
+        check: S ->Boolean
+
+        replaceD c ==
+          if c = char "D" then char "E" else c
+
+        replaced c ==
+          if c = char "d" then char "E" else c
+
+        contract s ==
+          s:= map(replaceD,s)
+          s:= map(replaced,s)
+          ls:List S := split(s,char " ")$String
+          s:= concat ls
+
+        check s ==
+          NUMBERP(READ_-FROM_-STRING(s)$Lisp)$Lisp and
+           -- if there is an "E" then there must be a "."
+           -- this is not caught by code above
+           -- also if the exponent is v.big the above returns false
+           not (any?((c1:C):Boolean +-> c1=char "E",s) 
+             and not any?((c2:C):Boolean +-> c2=char ".",s) )
+
+        sexfloat:SExpression:=convert(coerce("Float")@Symbol)$SExpression
+        ScanFloatIgnoreSpaces s ==
+          s := contract s
+          not check s => error "Non-numeric value"
+          sex := interpret(ncParseFromString(s)$Lisp)$Lisp
+          sCheck := car(car(sex))
+          if (sCheck=sexfloat) = true then
+             f := (cdr cdr sex) pretend Float
+          else
+             if integer?(cdr sex) = true then
+                f := (cdr sex) pretend Integer
+                f::F
+             else
+                error "Non-numeric value"
+
+        ScanFloatIgnoreSpacesIfCan s ==
+          s := contract s
+          not check s => "failed"
+          sex := interpret(ncParseFromString(s)$Lisp)$Lisp
+          sCheck := car(car(sex))
+          if (sCheck=sexfloat) = true then
+             f := (cdr cdr sex) pretend Float
+          else
+             if integer?(cdr sex) = true then
+                f := (cdr sex) pretend Integer
+                f::F
+             else
+                "failed"
+
+        units:V S :=
+           construct ["","I","II","III","IV","V","VI","VII","VIII","IX"]
+        tens :V S :=
+           construct ["","X","XX","XXX","XL","L","LX","LXX","LXXX","XC"]
+        hunds:V S :=
+           construct ["","C","CC","CCC","CD","D","DC","DCC","DCCC","CM"]
+        umin := minIndex units
+        tmin := minIndex tens
+        hmin := minIndex hunds
+        romval:V I := new(256, -1)
+        romval ord char(" ")$C := 0
+        romval ord char("I")$C := 1
+        romval ord char("V")$C := 5
+        romval ord char("X")$C := 10
+        romval ord char("L")$C := 50
+        romval ord char("C")$C := 100
+        romval ord char("D")$C := 500
+        romval ord char("M")$C := 1000
+        thou:C  := char "M"
+        plen:C  := char "("
+        pren:C  := char ")"
+        ichar:C := char "I"
+
+        FormatArabic n == PRINC_-TO_-STRING(n)$Lisp
+
+        ScanArabic   s == PARSE_-INTEGER(s)$Lisp
+
+        FormatRoman pn ==
+            n := pn::Integer
+            -- Units
+            d := (n rem 10) + umin
+            n := n quo 10
+            s := units.d
+            zero? n => s
+            -- Tens
+            d := (n rem 10) + tmin
+            n := n quo 10
+            s := concat(tens.d, s)
+            zero? n => s
+            -- Hundreds
+            d := (n rem 10) + hmin
+            n := n quo 10
+            s := concat(hunds.d, s)
+            zero? n => s
+            -- Thousands
+            d := n rem 10
+            n := n quo 10
+            s := concat(new(d::NonNegativeInteger, thou), s)
+            zero? n => s
+            -- Ten thousand and higher
+            for i in 2.. while not zero? n repeat
+                -- Coefficient of 10**(i+2)
+                d := n rem 10
+                n := n quo 10
+                zero? d => "iterate"
+                m0:String := concat(new(i,plen),concat("I",new(i,pren)))
+                mm := concat([m0 for j in 1..d]$List(String))
+                -- strictly speaking the blank is gratuitous
+                if #s > 0 then s := concat(" ", s)
+                s  := concat(mm, s)
+            s
+
+        -- ScanRoman
+        --
+        -- The Algorithm:
+        --    Read number from right to left.  When the current
+        --    numeral is lower in magnitude than the previous maximum
+        --    then subtract otherwise add.
+        --    Shift left and repeat until done.
+
+        ScanRoman s ==
+            s      := upperCase s
+            tot: I := 0
+            Max: I := 0
+            i:   I := maxIndex s
+            while i >= minIndex s repeat
+                -- Read a single roman digit
+                c := s.i; i := i-1
+                n := romval ord c
+                -- (I)=1000, ((I))=10000, (((I)))=100000, etc
+                if n < 0 then
+                    c ^= pren =>
+                       error ["Improper character in Roman numeral: ",c]
+                    nprens: PI := 1
+                    while c = pren and i >= minIndex s repeat
+                       c := s.i; i := i-1
+                       if c = pren then nprens := nprens+1
+                    c ^= ichar =>
+                       error "Improper Roman numeral: (x)"
+                    for k in 1..nprens while i >= minIndex s repeat
+                       c := s.i; i := i-1
+                       c ^= plen =>
+                          error "Improper Roman numeral: unbalanced ')'"
+                    n := 10**(nprens + 2)
+                if n < Max then
+                    tot := tot - n
+                else
+                    tot := tot + n
+                    Max := n
+            tot < 0 => error ["Improper Roman numeral: ", tot]
+            tot::PI
+
 *)
 
 \end{chunk}
@@ -149483,6 +182395,7 @@ NumberTheoreticPolynomialFunctions(R: CommutativeRing): Exports == Impl where
             r
 
         if R has Algebra RN then
+
             eulerE(k, x) ==
                 p: SUP(RN) := euler(k)
                 r: R       := 0
@@ -149492,6 +182405,7 @@ NumberTheoreticPolynomialFunctions(R: CommutativeRing): Exports == Impl where
                     p := reductum p
                     r := c*x**d + r
                 r
+
             bernoulliB(k, x) ==
                 p: SUP(RN) := bernoulli(k)
                 r: R       := 0
@@ -149507,6 +182421,45 @@ NumberTheoreticPolynomialFunctions(R: CommutativeRing): Exports == Impl where
 \begin{chunk}{COQ NTPOLFN}
 (* package NTPOLFN *)
 (*
+
+        import PolynomialNumberTheoryFunctions()
+
+        I   ==> Integer
+        SUP ==> SparseUnivariatePolynomial
+
+        -- This is the wrong way to evaluate the polynomial.
+        cyclotomic(k, x) ==
+            p: SUP(I) := cyclotomic(k)
+            r: R      := 0
+            while p ^= 0 repeat
+                d := degree p
+                c := leadingCoefficient p
+                p := reductum p
+                r := c*x**d + r
+            r
+
+        if R has Algebra RN then
+
+            eulerE(k, x) ==
+                p: SUP(RN) := euler(k)
+                r: R       := 0
+                while p ^= 0 repeat
+                    d := degree p
+                    c := leadingCoefficient p
+                    p := reductum p
+                    r := c*x**d + r
+                r
+
+            bernoulliB(k, x) ==
+                p: SUP(RN) := bernoulli(k)
+                r: R       := 0
+                while p ^= 0 repeat
+                    d := degree p
+                    c := leadingCoefficient p
+                    p := reductum p
+                    r := c*x**d + r
+                r
+
 *)
 
 \end{chunk}
@@ -149735,16 +182688,18 @@ Numeric(S:ConvertibleTo Float): with
                                                   Union(Complex Float,"failed")
         ++ complexNumericIfCan(x, n) returns a complex approximation of x
         ++ up to n decimal places, or "failed" if \axiom{x} is not a constant.
-      complexNumericIfCan: Expression Complex S -> Union(Complex Float,"failed")
+      complexNumericIfCan: Expression Complex S -> 
+                                                  Union(Complex Float,"failed")
         ++ complexNumericIfCan(x) returns a complex approximation of x,
         ++ or "failed" if \axiom{x} is not a constant.
       complexNumericIfCan: (Expression Complex S, PositiveInteger) ->
-                                                   Union(Complex Float,"failed")
+                                                  Union(Complex Float,"failed")
         ++ complexNumericIfCan(x, n) returns a complex approximation of x
         ++ up to n decimal places, or "failed" if \axiom{x} is not a constant.
  == add
  
   if S has CommutativeRing then
+
     complexNumericIfCan(p:Polynomial Complex S) ==
       p' : Union(Complex(S),"failed") := retractIfCan p
       p' case "failed" => "failed"
@@ -149756,6 +182711,7 @@ Numeric(S:ConvertibleTo Float): with
       complexNumeric(p',n)
  
   if S has Ring then
+
     numericIfCan(p:Polynomial S) ==
       p' : Union(S,"failed") := retractIfCan p
       p' case "failed" => "failed"
@@ -149778,6 +182734,7 @@ Numeric(S:ConvertibleTo Float): with
       ans
  
   if S has IntegralDomain then
+
     numericIfCan(f:Fraction Polynomial S)==
       num := numericIfCan(numer(f))
       num case "failed" => "failed"
@@ -149820,6 +182777,7 @@ Numeric(S:ConvertibleTo Float): with
       num/den
  
     if S has OrderedSet then
+
       numericIfCan(x:Expression S) ==
         retractIfCan(map(convert, x)$ExpressionFunctions2(S, Float))
  
@@ -149837,14 +182795,17 @@ Numeric(S:ConvertibleTo Float): with
  
       complexNumericIfCan(x:Expression S, n:PositiveInteger) ==
         old := digits(n)$Float
-        x' : Expression Complex S := map(coerce, x)$ExpressionFunctions2(S, Complex S)
+        x' : Expression Complex S := _
+          map(coerce, x)$ExpressionFunctions2(S, Complex S)
         ans : Union(Complex Float,"failed") := complexNumericIfCan(x')
         digits(old)$Float
         ans
 
       if S has RealConstant then
+
         complexNumericIfCan(x:Expression Complex S) ==
-          retractIfCan(map(convert, x)$ExpressionFunctions2(Complex S,Complex Float))
+          retractIfCan(map(convert, x)_
+            $ExpressionFunctions2(Complex S,Complex Float))
  
         complexNumericIfCan(x:Expression Complex S, n:PositiveInteger) ==
           old := digits(n)$Float
@@ -149853,11 +182814,15 @@ Numeric(S:ConvertibleTo Float): with
           ans : Union(Complex Float,"failed") := retractIfCan x'
           digits(old)$Float
           ans
+
       else
-        convert(x:Complex S):Complex(Float)==map(convert,x)$ComplexFunctions2(S,Float)
+
+        convert(x:Complex S):Complex(Float) ==
+          map(convert,x)$ComplexFunctions2(S,Float)
 
         complexNumericIfCan(x:Expression Complex S) ==
-          retractIfCan(map(convert, x)$ExpressionFunctions2(Complex S,Complex Float))
+          retractIfCan(map(convert, x)_
+            $ExpressionFunctions2(Complex S,Complex Float))
  
         complexNumericIfCan(x:Expression Complex S, n:PositiveInteger) ==
           old := digits(n)$Float
@@ -149866,9 +182831,11 @@ Numeric(S:ConvertibleTo Float): with
           ans : Union(Complex Float,"failed") := retractIfCan x'
           digits(old)$Float
           ans
+
   numeric(s:S) == convert(s)@Float
  
   if S has ConvertibleTo Complex Float then
+
     complexNumeric(s:S) == convert(s)@Complex(Float)
  
     complexNumeric(s:S, n:PositiveInteger) ==
@@ -149878,12 +182845,14 @@ Numeric(S:ConvertibleTo Float): with
       ans
  
   else
+
     complexNumeric(s:S) == convert(s)@Float :: Complex(Float)
  
     complexNumeric(s:S,n:PositiveInteger) ==
       numeric(s, n)::Complex(Float)
 
   if S has CommutativeRing then
+
     complexNumeric(p:Polynomial Complex S) ==
       p' : Union(Complex(S),"failed") := retractIfCan p
       p' case "failed" => 
@@ -149906,6 +182875,7 @@ Numeric(S:ConvertibleTo Float): with
         ans
 
     else if Complex(S) has ConvertibleTo(Complex Float) then
+
       complexNumeric(s:Complex S) == convert(s)@Complex(Float)
   
       complexNumeric(s:Complex S, n:PositiveInteger) ==
@@ -149915,6 +182885,7 @@ Numeric(S:ConvertibleTo Float): with
         ans
 
     else
+
       complexNumeric(s:Complex S) ==
         s' : Union(S,"failed") := retractIfCan s
         s' case "failed" =>
@@ -149937,10 +182908,11 @@ Numeric(S:ConvertibleTo Float): with
     ans
  
   if S has Ring then
+
     numeric(p:Polynomial S) ==
       p' : Union(S,"failed") := retractIfCan p
-      p' case "failed" => error
-       "Can only compute the numerical value of a constant, real-valued polynomial"
+      p' case "failed" => error _
+   "Can only compute the numerical value of a constant, real-valued polynomial"
       numeric(p')
 
     complexNumeric(p:Polynomial S) ==
@@ -149962,6 +182934,7 @@ Numeric(S:ConvertibleTo Float): with
       ans
  
   if S has IntegralDomain then
+
     numeric(f:Fraction Polynomial S)==
         numeric(numer(f)) / numeric(denom f)
  
@@ -149984,18 +182957,20 @@ Numeric(S:ConvertibleTo Float): with
       complexNumeric(numer f, n)/complexNumeric(denom f, n)
  
     if S has OrderedSet then
+
       numeric(x:Expression S) ==
         x' : Union(Float,"failed") := 
          retractIfCan(map(convert, x)$ExpressionFunctions2(S, Float))
-        x' case "failed" => error
-         "Can only compute the numerical value of a constant, real-valued Expression"
+        x' case "failed" => error _
+   "Can only compute the numerical value of a constant, real-valued Expression"
         x'
  
       complexNumeric(x:Expression S) ==
         x' : Union(Complex Float,"failed") := retractIfCan(
          map(complexNumeric, x)$ExpressionFunctions2(S,Complex Float))
         x' case "failed" =>
-         error "Cannot compute the numerical value of a non-constant expression"
+         error _
+          "Cannot compute the numerical value of a non-constant expression"
         x'
  
       numeric(x:Expression S, n:PositiveInteger) ==
@@ -150003,8 +182978,8 @@ Numeric(S:ConvertibleTo Float): with
         x' : Expression Float := map(convert, x)$ExpressionFunctions2(S, Float)
         ans : Union(Float,"failed") := retractIfCan x'
         digits(old)$Float
-        ans case "failed" => error
-         "Can only compute the numerical value of a constant, real-valued Expression"
+        ans case "failed" => error _
+   "Can only compute the numerical value of a constant, real-valued Expression"
         ans
  
       complexNumeric(x:Expression S, n:PositiveInteger) ==
@@ -150014,14 +182989,16 @@ Numeric(S:ConvertibleTo Float): with
         ans : Union(Complex Float,"failed") := retractIfCan x'
         digits(old)$Float
         ans case "failed" =>
-         error "Cannot compute the numerical value of a non-constant expression"
+         error _
+          "Cannot compute the numerical value of a non-constant expression"
         ans
 
       complexNumeric(x:Expression Complex S) ==
         x' : Union(Complex Float,"failed") := retractIfCan(
          map(complexNumeric, x)$ExpressionFunctions2(Complex S,Complex Float))
         x' case "failed" =>
-         error "Cannot compute the numerical value of a non-constant expression"
+         error _
+          "Cannot compute the numerical value of a non-constant expression"
         x'
  
       complexNumeric(x:Expression Complex S, n:PositiveInteger) ==
@@ -150031,7 +183008,8 @@ Numeric(S:ConvertibleTo Float): with
         ans : Union(Complex Float,"failed") := retractIfCan x'
         digits(old)$Float
         ans case "failed" =>
-         error "Cannot compute the numerical value of a non-constant expression"
+         error _
+          "Cannot compute the numerical value of a non-constant expression"
         ans
 
 \end{chunk}
@@ -150039,6 +183017,321 @@ Numeric(S:ConvertibleTo Float): with
 \begin{chunk}{COQ NUMERIC}
 (* package NUMERIC *)
 (*
+ 
+  if S has CommutativeRing then
+
+    complexNumericIfCan(p:Polynomial Complex S) ==
+      p' : Union(Complex(S),"failed") := retractIfCan p
+      p' case "failed" => "failed"
+      complexNumeric(p')
+
+    complexNumericIfCan(p:Polynomial Complex S,n:PositiveInteger) ==
+      p' : Union(Complex(S),"failed") := retractIfCan p
+      p' case "failed" => "failed"
+      complexNumeric(p',n)
+ 
+  if S has Ring then
+
+    numericIfCan(p:Polynomial S) ==
+      p' : Union(S,"failed") := retractIfCan p
+      p' case "failed" => "failed"
+      numeric(p')
+
+    complexNumericIfCan(p:Polynomial S) ==
+      p' : Union(S,"failed") := retractIfCan p
+      p' case "failed" => "failed"
+      complexNumeric(p')
+ 
+    complexNumericIfCan(p:Polynomial S, n:PositiveInteger) ==
+      p' : Union(S,"failed") := retractIfCan p
+      p' case "failed" => "failed"
+      complexNumeric(p', n)
+ 
+    numericIfCan(p:Polynomial S, n:PositiveInteger) ==
+      old := digits(n)$Float
+      ans := numericIfCan p
+      digits(old)$Float
+      ans
+ 
+  if S has IntegralDomain then
+
+    numericIfCan(f:Fraction Polynomial S)==
+      num := numericIfCan(numer(f))
+      num case "failed" => "failed"
+      den := numericIfCan(denom f)
+      den case "failed" => "failed"
+      num/den
+ 
+    complexNumericIfCan(f:Fraction Polynomial S) ==
+      num := complexNumericIfCan(numer f)
+      num case "failed" => "failed"
+      den := complexNumericIfCan(denom f)
+      den case "failed" => "failed"
+      num/den
+ 
+    complexNumericIfCan(f:Fraction Polynomial S, n:PositiveInteger) ==
+      num := complexNumericIfCan(numer f, n)
+      num case "failed" => "failed"
+      den := complexNumericIfCan(denom f, n)
+      den case "failed" => "failed"
+      num/den
+ 
+    numericIfCan(f:Fraction Polynomial S, n:PositiveInteger) ==
+      old := digits(n)$Float
+      ans := numericIfCan f
+      digits(old)$Float
+      ans
+
+    complexNumericIfCan(f:Fraction Polynomial Complex S) ==
+      num := complexNumericIfCan(numer f)
+      num case "failed" => "failed"
+      den := complexNumericIfCan(denom f)
+      den case "failed" => "failed"
+      num/den
+ 
+    complexNumericIfCan(f:Fraction Polynomial Complex S, n:PositiveInteger) ==
+      num := complexNumericIfCan(numer f, n)
+      num case "failed" => "failed"
+      den := complexNumericIfCan(denom f, n)
+      den case "failed" => "failed"
+      num/den
+ 
+    if S has OrderedSet then
+
+      numericIfCan(x:Expression S) ==
+        retractIfCan(map(convert, x)$ExpressionFunctions2(S, Float))
+ 
+      --s2cs(u:S):Complex(S) == complex(u,0)
+
+      complexNumericIfCan(x:Expression S) ==
+         complexNumericIfCan map(coerce, x)$ExpressionFunctions2(S,Complex S)
+ 
+      numericIfCan(x:Expression S, n:PositiveInteger) ==
+        old := digits(n)$Float
+        x' : Expression Float := map(convert, x)$ExpressionFunctions2(S, Float)
+        ans : Union(Float,"failed") := retractIfCan x'
+        digits(old)$Float
+        ans
+ 
+      complexNumericIfCan(x:Expression S, n:PositiveInteger) ==
+        old := digits(n)$Float
+        x' : Expression Complex S := _
+          map(coerce, x)$ExpressionFunctions2(S, Complex S)
+        ans : Union(Complex Float,"failed") := complexNumericIfCan(x')
+        digits(old)$Float
+        ans
+
+      if S has RealConstant then
+
+        complexNumericIfCan(x:Expression Complex S) ==
+          retractIfCan(map(convert, x)_
+            $ExpressionFunctions2(Complex S,Complex Float))
+ 
+        complexNumericIfCan(x:Expression Complex S, n:PositiveInteger) ==
+          old := digits(n)$Float
+          x' : Expression Complex Float :=
+           map(convert, x)$ExpressionFunctions2(Complex S,Complex Float)
+          ans : Union(Complex Float,"failed") := retractIfCan x'
+          digits(old)$Float
+          ans
+
+      else
+
+        convert(x:Complex S):Complex(Float) ==
+          map(convert,x)$ComplexFunctions2(S,Float)
+
+        complexNumericIfCan(x:Expression Complex S) ==
+          retractIfCan(map(convert, x)_
+            $ExpressionFunctions2(Complex S,Complex Float))
+ 
+        complexNumericIfCan(x:Expression Complex S, n:PositiveInteger) ==
+          old := digits(n)$Float
+          x' : Expression Complex Float :=
+           map(convert, x)$ExpressionFunctions2(Complex S,Complex Float)
+          ans : Union(Complex Float,"failed") := retractIfCan x'
+          digits(old)$Float
+          ans
+
+  numeric(s:S) == convert(s)@Float
+ 
+  if S has ConvertibleTo Complex Float then
+
+    complexNumeric(s:S) == convert(s)@Complex(Float)
+ 
+    complexNumeric(s:S, n:PositiveInteger) ==
+      old := digits(n)$Float
+      ans := complexNumeric s
+      digits(old)$Float
+      ans
+ 
+  else
+
+    complexNumeric(s:S) == convert(s)@Float :: Complex(Float)
+ 
+    complexNumeric(s:S,n:PositiveInteger) ==
+      numeric(s, n)::Complex(Float)
+
+  if S has CommutativeRing then
+
+    complexNumeric(p:Polynomial Complex S) ==
+      p' : Union(Complex(S),"failed") := retractIfCan p
+      p' case "failed" => 
+        error "Cannot compute the numerical value of a non-constant polynomial"
+      complexNumeric(p')
+
+    complexNumeric(p:Polynomial Complex S,n:PositiveInteger) ==
+      p' : Union(Complex(S),"failed") := retractIfCan p
+      p' case "failed" => 
+        error "Cannot compute the numerical value of a non-constant polynomial"
+      complexNumeric(p',n)
+
+    if S has RealConstant then
+      complexNumeric(s:Complex S) == convert(s)$Complex(S)
+  
+      complexNumeric(s:Complex S, n:PositiveInteger) ==
+        old := digits(n)$Float
+        ans := complexNumeric s
+        digits(old)$Float
+        ans
+
+    else if Complex(S) has ConvertibleTo(Complex Float) then
+
+      complexNumeric(s:Complex S) == convert(s)@Complex(Float)
+  
+      complexNumeric(s:Complex S, n:PositiveInteger) ==
+        old := digits(n)$Float
+        ans := complexNumeric s
+        digits(old)$Float
+        ans
+
+    else
+
+      complexNumeric(s:Complex S) ==
+        s' : Union(S,"failed") := retractIfCan s
+        s' case "failed" =>
+          error "Cannot compute the numerical value of a non-constant object"
+        complexNumeric(s')
+  
+      complexNumeric(s:Complex S, n:PositiveInteger) ==
+        s' : Union(S,"failed") := retractIfCan s
+        s' case "failed" =>
+          error "Cannot compute the numerical value of a non-constant object"
+        old := digits(n)$Float
+        ans := complexNumeric s'
+        digits(old)$Float
+        ans
+ 
+  numeric(s:S, n:PositiveInteger) ==
+    old := digits(n)$Float
+    ans := numeric s
+    digits(old)$Float
+    ans
+ 
+  if S has Ring then
+
+    numeric(p:Polynomial S) ==
+      p' : Union(S,"failed") := retractIfCan p
+      p' case "failed" => error _
+   "Can only compute the numerical value of a constant, real-valued polynomial"
+      numeric(p')
+
+    complexNumeric(p:Polynomial S) ==
+      p' : Union(S,"failed") := retractIfCan p
+      p' case "failed" => 
+        error "Cannot compute the numerical value of a non-constant polynomial"
+      complexNumeric(p')
+ 
+    complexNumeric(p:Polynomial S, n:PositiveInteger) ==
+      p' : Union(S,"failed") := retractIfCan p
+      p' case "failed" => 
+        error "Cannot compute the numerical value of a non-constant polynomial"
+      complexNumeric(p', n)
+ 
+    numeric(p:Polynomial S, n:PositiveInteger) ==
+      old := digits(n)$Float
+      ans := numeric p
+      digits(old)$Float
+      ans
+ 
+  if S has IntegralDomain then
+
+    numeric(f:Fraction Polynomial S)==
+        numeric(numer(f)) / numeric(denom f)
+ 
+    complexNumeric(f:Fraction Polynomial S) ==
+      complexNumeric(numer f)/complexNumeric(denom f)
+ 
+    complexNumeric(f:Fraction Polynomial S, n:PositiveInteger) ==
+      complexNumeric(numer f, n)/complexNumeric(denom f, n)
+ 
+    numeric(f:Fraction Polynomial S, n:PositiveInteger) ==
+      old := digits(n)$Float
+      ans := numeric f
+      digits(old)$Float
+      ans
+
+    complexNumeric(f:Fraction Polynomial Complex S) ==
+      complexNumeric(numer f)/complexNumeric(denom f)
+ 
+    complexNumeric(f:Fraction Polynomial Complex S, n:PositiveInteger) ==
+      complexNumeric(numer f, n)/complexNumeric(denom f, n)
+ 
+    if S has OrderedSet then
+
+      numeric(x:Expression S) ==
+        x' : Union(Float,"failed") := 
+         retractIfCan(map(convert, x)$ExpressionFunctions2(S, Float))
+        x' case "failed" => error _
+   "Can only compute the numerical value of a constant, real-valued Expression"
+        x'
+ 
+      complexNumeric(x:Expression S) ==
+        x' : Union(Complex Float,"failed") := retractIfCan(
+         map(complexNumeric, x)$ExpressionFunctions2(S,Complex Float))
+        x' case "failed" =>
+         error _
+          "Cannot compute the numerical value of a non-constant expression"
+        x'
+ 
+      numeric(x:Expression S, n:PositiveInteger) ==
+        old := digits(n)$Float
+        x' : Expression Float := map(convert, x)$ExpressionFunctions2(S, Float)
+        ans : Union(Float,"failed") := retractIfCan x'
+        digits(old)$Float
+        ans case "failed" => error _
+   "Can only compute the numerical value of a constant, real-valued Expression"
+        ans
+ 
+      complexNumeric(x:Expression S, n:PositiveInteger) ==
+        old := digits(n)$Float
+        x' : Expression Complex Float :=
+         map(complexNumeric, x)$ExpressionFunctions2(S,Complex Float)
+        ans : Union(Complex Float,"failed") := retractIfCan x'
+        digits(old)$Float
+        ans case "failed" =>
+         error _
+          "Cannot compute the numerical value of a non-constant expression"
+        ans
+
+      complexNumeric(x:Expression Complex S) ==
+        x' : Union(Complex Float,"failed") := retractIfCan(
+         map(complexNumeric, x)$ExpressionFunctions2(Complex S,Complex Float))
+        x' case "failed" =>
+         error _
+          "Cannot compute the numerical value of a non-constant expression"
+        x'
+ 
+      complexNumeric(x:Expression Complex S, n:PositiveInteger) ==
+        old := digits(n)$Float
+        x' : Expression Complex Float :=
+         map(complexNumeric, x)$ExpressionFunctions2(Complex S,Complex Float)
+        ans : Union(Complex Float,"failed") := retractIfCan x'
+        digits(old)$Float
+        ans case "failed" =>
+         error _
+          "Cannot compute the numerical value of a non-constant expression"
+        ans
+
 *)
 
 \end{chunk}
@@ -150382,15 +183675,13 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where
     ++ For details, see \con{NumericalOrdinaryDifferentialEquations}.
 
   Implementation ==>  add
-  --some local function definitions here
+
    rk4qclocal : (V NF,V NF,I,NF,RK4STEP,NF,V NF,(V NF,V NF,NF) -> VOID
                 ,V NF,V NF,V NF,V NF,V NF,V NF) -> VOID
    rk4local   : (V NF,V NF,I,NF,NF,V NF,(V NF,V NF,NF) -> VOID
                 ,V NF,V NF,V NF) -> VOID
    import OutputPackage
 
-------------------------------------------------------------
-
    rk4a(ystart,nvar,x1,x2,eps,htry,nstep,derivs) ==
       y       : V NF := new(nvar::NNI,0.0)
       yscal   : V NF := new(nvar::NNI,1.0)
@@ -150408,33 +183699,28 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where
       outlist : L OFORM := [x::E,x::E,x::E]
       i       : I
       iter    : I
-
       eps  := 1.0/eps
       for i in 1..m repeat
          y(i)  := ystart(i)
       for iter in 1..nstep repeat
---compute the derivative
+         --compute the derivative
          derivs(dydx,y,x)
---if overshoot, the set h accordingly
+         --if overshoot, the set h accordingly
          if (x + step.try - x2) > 0.0 then
             step.try := x2 - x
---find the correct scaling
+         --find the correct scaling
          for i in 1..m repeat
             yscal(i) := abs(y(i)) + abs(step.try * dydx(i)) + tiny
---take a quality controlled runge-kutta step
+         --take a quality controlled runge-kutta step
          rk4qclocal(y,dydx,nvar,x,step,eps,yscal,derivs
                    ,t1,t2,t3,t4,t5,t6)
          x         := x + step.did
---       outlist.0 := x::E
---       outlist.1 := y(0)::E
---       outlist.2 := y(1)::E
---       output(blankSeparate(outlist)::E)
---check to see if done
+         --check to see if done
          if (x-x2) >= 0.0 then
             leave
---next stepsize to use
+         --next stepsize to use
          step.try := step.next
---end nstep repeat
+      --end nstep repeat
       if iter = (nstep+1) then
          output("ode: ERROR ")
          outlist.1 := nstep::E
@@ -150445,8 +183731,6 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where
       for i in 1..m repeat
          ystart(i) := y(i)
 
-----------------------------------------------------------------
-
    rk4qc(y,n,x,step,eps,yscal,derivs) ==
       t1 : V NF := new(n::NNI,0.0)
       t2 : V NF := new(n::NNI,0.0)
@@ -150459,15 +183743,11 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where
       eps := 1.0/eps
       rk4qclocal(y,t7,n,x,step,eps,yscal,derivs,t1,t2,t3,t4,t5,t6)
 
---------------------------------------------------------
-
    rk4qc(y,n,x,step,eps,yscal,derivs,t1,t2,t3,t4,t5,t6,dydx) ==
       derivs(dydx,y,x)
       eps := 1.0/eps
       rk4qclocal(y,dydx,n,x,step,eps,yscal,derivs,t1,t2,t3,t4,t5,t6)
 
---------------------------------------------------------
-
    rk4qclocal(y,dydx,n,x,step,eps,yscal,derivs
              ,t1,t2,t3,ysav,dysav,ytemp) ==
       xsav   : NF := x
@@ -150481,30 +183761,28 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where
       errmax : NF
       i      : I
       m      : I  := n
---
       for i in 1..m repeat
          dysav(i) := dydx(i)
          ysav(i)  := y(i)
---cut down step size till error criterion is met
+      --cut down step size till error criterion is met
       repeat
---take two little steps to get to x + h
+        --take two little steps to get to x + h
          hh := 0.5 * h
          rk4local(ysav,dysav,n,xsav,hh,ytemp,derivs,t1,t2,t3)
          x  := xsav + hh
          derivs(dydx,ytemp,x)
          rk4local(ytemp,dydx,n,x,hh,y,derivs,t1,t2,t3)
          x  := xsav + h
---take one big step get to x + h
+         --take one big step get to x + h
          rk4local(ysav,dysav,n,xsav,h,ytemp,derivs,t1,t2,t3)
-
---compute the maximum scaled difference
+         --compute the maximum scaled difference
          errmax := 0.0
          for i in 1..m repeat
             ytemp(i) := y(i) - ytemp(i)
             errmax   := max(errmax,abs(ytemp(i)/yscal(i)))
---scale relative to required accuracy
+         --scale relative to required accuracy
          errmax := errmax * eps
---update integration stepsize
+         --update integration stepsize
          if (errmax > 1.0) then
             h := safety * h * (errmax ** shrink)
          else
@@ -150514,12 +183792,10 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where
             else
                step.next := 4 * h
             leave
---make fifth order with 4-th order error estimate
+      --make fifth order with 4-th order error estimate
       for i in 1..m repeat
          y(i) := y(i) + ytemp(i) * fcor
 
---------------------------------------------
-
    rk4f(y,nvar,x1,x2,nstep,derivs) ==
      yt   : V NF := new(nvar::NNI,0.0)
      dyt  : V NF := new(nvar::NNI,0.0)
@@ -150530,14 +183806,12 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where
      x    : NF := x1
      i    : I
      j    : I
--- start integrating
+     -- start integrating
      for i in 1..nstep repeat
         derivs(dydx,y,x)
         rk4local(y,dydx,nvar,x,h,y,derivs,yt,dyt,dym)
         x := x + h
 
---------------------------------------------------------
-
    rk4(y,n,x,h,derivs) ==
       t1 : V NF := new(n::NNI,0.0)
       t2 : V NF := new(n::NNI,0.0)
@@ -150546,33 +183820,29 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where
       derivs(t1,y,x)
       rk4local(y,t1,n,x,h,y,derivs,t2,t3,t4)
 
-------------------------------------------------------------
-
    rk4(y,n,x,h,derivs,t1,t2,t3,t4) ==
       derivs(t1,y,x)
       rk4local(y,t1,n,x,h,y,derivs,t2,t3,t4)
 
-------------------------------------------------------------
-
    rk4local(y,dydx,n,x,h,yout,derivs,yt,dyt,dym) ==
       hh : NF := h*0.5
       h6 : NF := h/6.0
       xh : NF := x+hh
       m  : I  := n
       i  : I
--- first step
+      -- first step
       for i in 1..m repeat
          yt(i) := y(i) + hh*dydx(i)
--- second step
+      -- second step
       derivs(dyt,yt,xh)
       for i in 1..m repeat
          yt(i) := y(i) + hh*dyt(i)
--- third step
+      -- third step
       derivs(dym,yt,xh)
       for i in 1..m repeat
          yt(i)  := y(i)   + h*dym(i)
          dym(i) := dyt(i) + dym(i)
--- fourth step
+      -- fourth step
       derivs(dyt,yt,x+h)
       for i in 1..m repeat
          yout(i) := y(i) + h6*( dydx(i) + 2.0*dym(i) + dyt(i) )
@@ -150582,6 +183852,178 @@ NumericalOrdinaryDifferentialEquations(): Exports == Implementation where
 \begin{chunk}{COQ NUMODE}
 (* package NUMODE *)
 (*
+
+   rk4qclocal : (V NF,V NF,I,NF,RK4STEP,NF,V NF,(V NF,V NF,NF) -> VOID
+                ,V NF,V NF,V NF,V NF,V NF,V NF) -> VOID
+   rk4local   : (V NF,V NF,I,NF,NF,V NF,(V NF,V NF,NF) -> VOID
+                ,V NF,V NF,V NF) -> VOID
+   import OutputPackage
+
+   rk4a(ystart,nvar,x1,x2,eps,htry,nstep,derivs) ==
+      y       : V NF := new(nvar::NNI,0.0)
+      yscal   : V NF := new(nvar::NNI,1.0)
+      dydx    : V NF := new(nvar::NNI,0.0)
+      t1      : V NF := new(nvar::NNI,0.0)
+      t2      : V NF := new(nvar::NNI,0.0)
+      t3      : V NF := new(nvar::NNI,0.0)
+      t4      : V NF := new(nvar::NNI,0.0)
+      t5      : V NF := new(nvar::NNI,0.0)
+      t6      : V NF := new(nvar::NNI,0.0)
+      step    : RK4STEP := [htry,0.0,0.0]
+      x       : NF   := x1
+      tiny    : NF   := 10.0**(-(digits()+1)::I)
+      m       : I    := nvar
+      outlist : L OFORM := [x::E,x::E,x::E]
+      i       : I
+      iter    : I
+      eps  := 1.0/eps
+      for i in 1..m repeat
+         y(i)  := ystart(i)
+      for iter in 1..nstep repeat
+         --compute the derivative
+         derivs(dydx,y,x)
+         --if overshoot, the set h accordingly
+         if (x + step.try - x2) > 0.0 then
+            step.try := x2 - x
+         --find the correct scaling
+         for i in 1..m repeat
+            yscal(i) := abs(y(i)) + abs(step.try * dydx(i)) + tiny
+         --take a quality controlled runge-kutta step
+         rk4qclocal(y,dydx,nvar,x,step,eps,yscal,derivs
+                   ,t1,t2,t3,t4,t5,t6)
+         x         := x + step.did
+         --check to see if done
+         if (x-x2) >= 0.0 then
+            leave
+         --next stepsize to use
+         step.try := step.next
+      --end nstep repeat
+      if iter = (nstep+1) then
+         output("ode: ERROR ")
+         outlist.1 := nstep::E
+         outlist.2 := " steps to small, last h = "::E
+         outlist.3 := step.did::E
+         output(blankSeparate(outlist))
+         output(" y= ",y::E)
+      for i in 1..m repeat
+         ystart(i) := y(i)
+
+   rk4qc(y,n,x,step,eps,yscal,derivs) ==
+      t1 : V NF := new(n::NNI,0.0)
+      t2 : V NF := new(n::NNI,0.0)
+      t3 : V NF := new(n::NNI,0.0)
+      t4 : V NF := new(n::NNI,0.0)
+      t5 : V NF := new(n::NNI,0.0)
+      t6 : V NF := new(n::NNI,0.0)
+      t7 : V NF := new(n::NNI,0.0)
+      derivs(t7,y,x)
+      eps := 1.0/eps
+      rk4qclocal(y,t7,n,x,step,eps,yscal,derivs,t1,t2,t3,t4,t5,t6)
+
+   rk4qc(y,n,x,step,eps,yscal,derivs,t1,t2,t3,t4,t5,t6,dydx) ==
+      derivs(dydx,y,x)
+      eps := 1.0/eps
+      rk4qclocal(y,dydx,n,x,step,eps,yscal,derivs,t1,t2,t3,t4,t5,t6)
+
+   rk4qclocal(y,dydx,n,x,step,eps,yscal,derivs
+             ,t1,t2,t3,ysav,dysav,ytemp) ==
+      xsav   : NF := x
+      h      : NF := step.try
+      fcor   : NF := 1.0/15.0
+      safety : NF := 0.9
+      grow   : NF := -0.20
+      shrink : NF := -0.25
+      errcon : NF := 0.6E-04  --(this is 4/safety)**(1/grow)
+      hh     : NF
+      errmax : NF
+      i      : I
+      m      : I  := n
+      for i in 1..m repeat
+         dysav(i) := dydx(i)
+         ysav(i)  := y(i)
+      --cut down step size till error criterion is met
+      repeat
+        --take two little steps to get to x + h
+         hh := 0.5 * h
+         rk4local(ysav,dysav,n,xsav,hh,ytemp,derivs,t1,t2,t3)
+         x  := xsav + hh
+         derivs(dydx,ytemp,x)
+         rk4local(ytemp,dydx,n,x,hh,y,derivs,t1,t2,t3)
+         x  := xsav + h
+         --take one big step get to x + h
+         rk4local(ysav,dysav,n,xsav,h,ytemp,derivs,t1,t2,t3)
+         --compute the maximum scaled difference
+         errmax := 0.0
+         for i in 1..m repeat
+            ytemp(i) := y(i) - ytemp(i)
+            errmax   := max(errmax,abs(ytemp(i)/yscal(i)))
+         --scale relative to required accuracy
+         errmax := errmax * eps
+         --update integration stepsize
+         if (errmax > 1.0) then
+            h := safety * h * (errmax ** shrink)
+         else
+            step.did := h
+            if errmax > errcon then
+               step.next := safety * h * (errmax ** grow)
+            else
+               step.next := 4 * h
+            leave
+      --make fifth order with 4-th order error estimate
+      for i in 1..m repeat
+         y(i) := y(i) + ytemp(i) * fcor
+
+   rk4f(y,nvar,x1,x2,nstep,derivs) ==
+     yt   : V NF := new(nvar::NNI,0.0)
+     dyt  : V NF := new(nvar::NNI,0.0)
+     dym  : V NF := new(nvar::NNI,0.0)
+     dydx : V NF := new(nvar::NNI,0.0)
+     ynew : V NF := new(nvar::NNI,0.0)
+     h    : NF := (x2-x1) / (nstep::NF)
+     x    : NF := x1
+     i    : I
+     j    : I
+     -- start integrating
+     for i in 1..nstep repeat
+        derivs(dydx,y,x)
+        rk4local(y,dydx,nvar,x,h,y,derivs,yt,dyt,dym)
+        x := x + h
+
+   rk4(y,n,x,h,derivs) ==
+      t1 : V NF := new(n::NNI,0.0)
+      t2 : V NF := new(n::NNI,0.0)
+      t3 : V NF := new(n::NNI,0.0)
+      t4 : V NF := new(n::NNI,0.0)
+      derivs(t1,y,x)
+      rk4local(y,t1,n,x,h,y,derivs,t2,t3,t4)
+
+   rk4(y,n,x,h,derivs,t1,t2,t3,t4) ==
+      derivs(t1,y,x)
+      rk4local(y,t1,n,x,h,y,derivs,t2,t3,t4)
+
+   rk4local(y,dydx,n,x,h,yout,derivs,yt,dyt,dym) ==
+      hh : NF := h*0.5
+      h6 : NF := h/6.0
+      xh : NF := x+hh
+      m  : I  := n
+      i  : I
+      -- first step
+      for i in 1..m repeat
+         yt(i) := y(i) + hh*dydx(i)
+      -- second step
+      derivs(dyt,yt,xh)
+      for i in 1..m repeat
+         yt(i) := y(i) + hh*dyt(i)
+      -- third step
+      derivs(dym,yt,xh)
+      for i in 1..m repeat
+         yt(i)  := y(i)   + h*dym(i)
+         dym(i) := dyt(i) + dym(i)
+      -- fourth step
+      derivs(dyt,yt,x+h)
+      for i in 1..m repeat
+         yout(i) := y(i) + h6*( dydx(i) + 2.0*dym(i) + dyt(i) )
+
 *)
 
 \end{chunk}
@@ -150911,12 +184353,11 @@ NumericalQuadrature(): Exports == Implementation where
      ++ See \spadtype{NumericalQuadrature} for details.
 
   Implementation ==> add
+
    trapclosed : (F -> F,F,F,F,I) -> F
    trapopen   : (F -> F,F,F,F,I) -> F
    import OutputPackage
 
----------------------------------------------------
-
    aromberg(func,a,b,epsrel,epsabs,nmin,nmax,nint) ==
       ans  : TrapAns
       sum  : F := 0.0
@@ -150942,8 +184383,6 @@ NumericalQuadrature(): Exports == Implementation where
          x2   := x2 + hh
       return( [sum , err , pts , done] )
 
----------------------------------------------------
-
    asimpson(func,a,b,epsrel,epsabs,nmin,nmax,nint) ==
       ans  : TrapAns
       sum  : F := 0.0
@@ -150969,8 +184408,6 @@ NumericalQuadrature(): Exports == Implementation where
          x2   := x2 + hh
       return( [sum , err , pts , done] )
 
----------------------------------------------------
-
    atrapezoidal(func,a,b,epsrel,epsabs,nmin,nmax,nint) ==
       ans  : TrapAns
       sum  : F := 0.0
@@ -150996,8 +184433,6 @@ NumericalQuadrature(): Exports == Implementation where
          x2   := x2 + hh
       return( [sum , err , pts , done] )
 
----------------------------------------------------
-
    romberg(func,a,b,epsrel,epsabs,nmin,nmax) ==
       length : F := (b-a)
       delta  : F := length
@@ -151052,8 +184487,6 @@ NumericalQuadrature(): Exports == Implementation where
          qx1    := table(1)
       return( [table(1) , 1.25*change , pts+1 ,false] )
 
----------------------------------------------------
-
    simpson(func,a,b,epsrel,epsabs,nmin,nmax) ==
       length : F := (b-a)
       delta  : F := length
@@ -151096,8 +184529,6 @@ NumericalQuadrature(): Exports == Implementation where
          pts    := 2*pts
       return( [newest , 1.25*change , pts+1 ,false] )
 
----------------------------------------------------
-
    trapezoidal(func,a,b,epsrel,epsabs,nmin,nmax) ==
       length : F := (b-a)
       delta  : F := length
@@ -151135,8 +184566,6 @@ NumericalQuadrature(): Exports == Implementation where
          pts   := 2*pts
       return( [newsum , 1.25*change , pts+1 ,false] )
 
----------------------------------------------------
-
    rombergo(func,a,b,epsrel,epsabs,nmin,nmax) ==
       length : F := (b-a)
       delta  : F := length / 3.0
@@ -151177,8 +184606,6 @@ NumericalQuadrature(): Exports == Implementation where
          qx1    := table(1)
       return( [table(1) , 1.5*change , pts ,false] )
 
----------------------------------------------------
-
    simpsono(func,a,b,epsrel,epsabs,nmin,nmax) ==
       length : F := (b-a)
       delta  : F := length / 3.0
@@ -151206,8 +184633,6 @@ NumericalQuadrature(): Exports == Implementation where
          pts    := 3*pts
       return( [newest , 1.5*change , pts ,false] )
 
----------------------------------------------------
-
    trapezoidalo(func,a,b,epsrel,epsabs,nmin,nmax) ==
       length : F := (b-a)
       delta  : F := length/3.0
@@ -151230,8 +184655,6 @@ NumericalQuadrature(): Exports == Implementation where
          pts   := 3*pts
       return([newsum , 1.5*change , pts ,false] )
 
----------------------------------------------------
-
    trapclosed(func,start,h,oldsum,numpoints) ==
       x   : F := start + 0.5*h
       sum : F := 0.0
@@ -151241,8 +184664,6 @@ NumericalQuadrature(): Exports == Implementation where
           x   := x + h
       return( 0.5*(oldsum + sum*h) )
 
----------------------------------------------------
-
    trapopen(func,start,del,oldsum,numpoints) ==
       ddel : F := 2.0*del
       x   : F := start + 0.5*del
@@ -151260,6 +184681,329 @@ NumericalQuadrature(): Exports == Implementation where
 \begin{chunk}{COQ NUMQUAD}
 (* package NUMQUAD *)
 (*
+
+   trapclosed : (F -> F,F,F,F,I) -> F
+   trapopen   : (F -> F,F,F,F,I) -> F
+   import OutputPackage
+
+   aromberg(func,a,b,epsrel,epsabs,nmin,nmax,nint) ==
+      ans  : TrapAns
+      sum  : F := 0.0
+      err  : F := 0.0
+      pts  : I  := 1
+      done : B  := true
+      hh   : F := (b-a) / nint
+      x1   : F := a
+      x2   : F := a + hh
+      io   : L OFORM := [x1::E,x2::E]
+      i    : I
+      for i in 1..nint repeat
+         ans := romberg(func,x1,x2,epsrel,epsabs,nmin,nmax)
+         if (not ans.success) then
+           io.1 := x1::E
+           io.2 := x2::E
+           print blankSeparate cons("accuracy not reached in interval"::E,io)
+         sum  := sum + ans.value
+         err  := err + abs(ans.error)
+         pts  := pts + ans.totalpts-1
+         done := (done and ans.success)
+         x1   := x2
+         x2   := x2 + hh
+      return( [sum , err , pts , done] )
+
+   asimpson(func,a,b,epsrel,epsabs,nmin,nmax,nint) ==
+      ans  : TrapAns
+      sum  : F := 0.0
+      err  : F := 0.0
+      pts  : I  := 1
+      done : B  := true
+      hh   : F := (b-a) / nint
+      x1   : F := a
+      x2   : F := a + hh
+      io   : L OFORM := [x1::E,x2::E]
+      i    : I
+      for i in 1..nint repeat
+         ans := simpson(func,x1,x2,epsrel,epsabs,nmin,nmax)
+         if (not ans.success) then
+           io.1 := x1::E
+           io.2 := x2::E
+           print blankSeparate cons("accuracy not reached in interval"::E,io)
+         sum  := sum + ans.value
+         err  := err + abs(ans.error)
+         pts  := pts + ans.totalpts-1
+         done := (done and ans.success)
+         x1   := x2
+         x2   := x2 + hh
+      return( [sum , err , pts , done] )
+
+   atrapezoidal(func,a,b,epsrel,epsabs,nmin,nmax,nint) ==
+      ans  : TrapAns
+      sum  : F := 0.0
+      err  : F := 0.0
+      pts  : I  := 1
+      i    : I
+      done : B := true
+      hh   : F := (b-a) / nint
+      x1   : F := a
+      x2   : F := a + hh
+      io   : L OFORM := [x1::E,x2::E]
+      for i in 1..nint repeat
+         ans := trapezoidal(func,x1,x2,epsrel,epsabs,nmin,nmax)
+         if (not ans.success) then
+           io.1 := x1::E
+           io.2 := x2::E
+           print blankSeparate cons("accuracy not reached in interval"::E,io)
+         sum  := sum + ans.value
+         err  := err + abs(ans.error)
+         pts  := pts + ans.totalpts-1
+         done := (done and ans.success)
+         x1   := x2
+         x2   := x2 + hh
+      return( [sum , err , pts , done] )
+
+   romberg(func,a,b,epsrel,epsabs,nmin,nmax) ==
+      length : F := (b-a)
+      delta  : F := length
+      newsum : F := 0.5 * length * (func(a)+func(b))
+      newest : F := 0.0
+      oldsum : F := 0.0
+      oldest : F := 0.0
+      change : F := 0.0
+      qx1    : F := newsum
+      table  : V F := new((nmax+1)::PI,0.0)
+      n      : I  := 1
+      pts    : I  := 1
+      four   : I
+      j      : I
+      i      : I
+      if (nmin < 2) then
+         output("romberg: nmin to small (nmin > 1) nmin = ",nmin::E)
+         return([0.0,0.0,0,false])
+      if (nmax < nmin) then
+         output("romberg: nmax < nmin : nmax = ",nmax::E)
+         output("                       nmin = ",nmin::E)
+         return([0.0,0.0,0,false])
+      if (a = b) then
+         output("romberg: integration limits are equal  = ",a::E)
+         return([0.0,0.0,1,true])
+      if (epsrel < 0.0) then
+         output("romberg: eps_r < 0.0            eps_r  = ",epsrel::E)
+         return([0.0,0.0,0,false])
+      if (epsabs < 0.0) then
+         output("romberg: eps_a < 0.0            eps_a  = ",epsabs::E)
+         return([0.0,0.0,0,false])
+      for n in 1..nmax repeat
+         oldsum := newsum
+         newsum := trapclosed(func,a,delta,oldsum,pts)
+         newest := (4.0 * newsum - oldsum) / 3.0
+         four   := 4
+         table(n) := newest
+         for j in 2..n repeat
+            i        := n+1-j
+            four     := four * 4
+            table(i) := table(i+1) + (table(i+1)-table(i)) / (four-1)
+         if n > nmin then
+            change := abs(table(1) - qx1)
+            if change < abs(epsrel*qx1) then
+               return( [table(1) , change , 2*pts+1 , true] )
+            if change < epsabs then
+               return( [table(1) , change , 2*pts+1 , true] )
+         oldsum := newsum
+         oldest := newest
+         delta  := 0.5*delta
+         pts    := 2*pts
+         qx1    := table(1)
+      return( [table(1) , 1.25*change , pts+1 ,false] )
+
+   simpson(func,a,b,epsrel,epsabs,nmin,nmax) ==
+      length : F := (b-a)
+      delta  : F := length
+      newsum : F := 0.5*(b-a)*(func(a)+func(b))
+      newest : F := 0.0
+      oldsum : F := 0.0
+      oldest : F := 0.0
+      change : F := 0.0
+      n      : I  := 1
+      pts    : I  := 1
+      if (nmin < 2) then
+         output("simpson: nmin to small (nmin > 1) nmin = ",nmin::E)
+         return([0.0,0.0,0,false])
+      if (nmax < nmin) then
+         output("simpson: nmax < nmin : nmax = ",nmax::E)
+         output("                       nmin = ",nmin::E)
+         return([0.0,0.0,0,false])
+      if (a = b) then
+         output("simpson: integration limits are equal  = ",a::E)
+         return([0.0,0.0,1,true])
+      if (epsrel < 0.0) then
+         output("simpson: eps_r < 0.0 : eps_r = ",epsrel::E)
+         return([0.0,0.0,0,false])
+      if (epsabs < 0.0) then
+         output("simpson: eps_a < 0.0 : eps_a = ",epsabs::E)
+         return([0.0,0.0,0,false])
+      for n in 1..nmax repeat
+         oldsum := newsum
+         newsum := trapclosed(func,a,delta,oldsum,pts)
+         newest := (4.0 * newsum - oldsum) / 3.0
+         if n > nmin then
+            change := abs(newest-oldest)
+            if change < abs(epsrel*oldest) then
+               return( [newest , 1.25*change , 2*pts+1 , true] )
+            if change < epsabs then
+               return( [newest , 1.25*change , 2*pts+1 , true] )
+         oldsum := newsum
+         oldest := newest
+         delta  := 0.5*delta
+         pts    := 2*pts
+      return( [newest , 1.25*change , pts+1 ,false] )
+
+   trapezoidal(func,a,b,epsrel,epsabs,nmin,nmax) ==
+      length : F := (b-a)
+      delta  : F := length
+      newsum : F := 0.5*(b-a)*(func(a)+func(b))
+      change : F := 0.0
+      oldsum : F
+      n      : I  := 1
+      pts    : I  := 1
+      if (nmin < 2) then
+         output("trapezoidal: nmin to small (nmin > 1) nmin = ",nmin::E)
+         return([0.0,0.0,0,false])
+      if (nmax < nmin) then
+         output("trapezoidal: nmax < nmin : nmax = ",nmax::E)
+         output("                           nmin = ",nmin::E)
+         return([0.0,0.0,0,false])
+      if (a = b) then
+         output("trapezoidal: integration limits are equal  = ",a::E)
+         return([0.0,0.0,1,true])
+      if (epsrel < 0.0) then
+         output("trapezoidal: eps_r < 0.0 : eps_r = ",epsrel::E)
+         return([0.0,0.0,0,false])
+      if (epsabs < 0.0) then
+         output("trapezoidal: eps_a < 0.0 : eps_a = ",epsabs::E)
+         return([0.0,0.0,0,false])
+      for n in 1..nmax repeat
+         oldsum := newsum
+         newsum := trapclosed(func,a,delta,oldsum,pts)
+         if n > nmin then
+            change := abs(newsum-oldsum)
+            if change < abs(epsrel*oldsum) then
+               return( [newsum , 1.25*change , 2*pts+1 , true] )
+            if change < epsabs then
+               return( [newsum , 1.25*change , 2*pts+1 , true] )
+         delta := 0.5*delta
+         pts   := 2*pts
+      return( [newsum , 1.25*change , pts+1 ,false] )
+
+   rombergo(func,a,b,epsrel,epsabs,nmin,nmax) ==
+      length : F := (b-a)
+      delta  : F := length / 3.0
+      newsum : F := length * func( 0.5*(a+b) )
+      newest : F := 0.0
+      oldsum : F := 0.0
+      oldest : F := 0.0
+      change : F := 0.0
+      qx1    : F := newsum
+      table  : V F := new((nmax+1)::PI,0.0)
+      four   : I
+      j      : I
+      i      : I
+      n      : I  := 1
+      pts    : I  := 1
+      for n in 1..nmax repeat
+         oldsum   := newsum
+         newsum   := trapopen(func,a,delta,oldsum,pts)
+         newest   := (9.0 * newsum - oldsum) / 8.0
+         table(n) := newest
+         nine     := 9
+         output(newest::E)
+         for j in 2..n repeat
+            i        := n+1-j
+            nine     := nine * 9
+            table(i) := table(i+1) + (table(i+1)-table(i)) / (nine-1)
+         if n > nmin then
+            change := abs(table(1) - qx1)
+            if change < abs(epsrel*qx1) then
+               return( [table(1) , 1.5*change , 3*pts , true] )
+            if change < epsabs then
+               return( [table(1) , 1.5*change , 3*pts , true] )
+         output(table::E)
+         oldsum := newsum
+         oldest := newest
+         delta  := delta / 3.0
+         pts    := 3*pts
+         qx1    := table(1)
+      return( [table(1) , 1.5*change , pts ,false] )
+
+   simpsono(func,a,b,epsrel,epsabs,nmin,nmax) ==
+      length : F := (b-a)
+      delta  : F := length / 3.0
+      newsum : F := length * func( 0.5*(a+b) )
+      newest : F := 0.0
+      oldsum : F := 0.0
+      oldest : F := 0.0
+      change : F := 0.0
+      n      : I  := 1
+      pts    : I  := 1
+      for n in 1..nmax repeat
+         oldsum := newsum
+         newsum := trapopen(func,a,delta,oldsum,pts)
+         newest := (9.0 * newsum - oldsum) / 8.0
+         output(newest::E)
+         if n > nmin then
+            change := abs(newest - oldest)
+            if change < abs(epsrel*oldest) then
+               return( [newest , 1.5*change , 3*pts , true] )
+            if change < epsabs then
+               return( [newest , 1.5*change , 3*pts , true] )
+         oldsum := newsum
+         oldest := newest
+         delta  := delta / 3.0
+         pts    := 3*pts
+      return( [newest , 1.5*change , pts ,false] )
+
+   trapezoidalo(func,a,b,epsrel,epsabs,nmin,nmax) ==
+      length : F := (b-a)
+      delta  : F := length/3.0
+      newsum : F := length*func( 0.5*(a+b) )
+      change : F := 0.0
+      pts    : I  := 1
+      oldsum : F
+      n      : I
+      for n in 1..nmax repeat
+         oldsum := newsum
+         newsum := trapopen(func,a,delta,oldsum,pts)
+         output(newsum::E)
+         if n > nmin then
+            change := abs(newsum-oldsum)
+            if change < abs(epsrel*oldsum) then
+               return([newsum , 1.5*change , 3*pts , true] )
+            if change < epsabs then
+               return([newsum , 1.5*change , 3*pts , true] )
+         delta := delta / 3.0
+         pts   := 3*pts
+      return([newsum , 1.5*change , pts ,false] )
+
+   trapclosed(func,start,h,oldsum,numpoints) ==
+      x   : F := start + 0.5*h
+      sum : F := 0.0
+      i   : I
+      for i in 1..numpoints repeat
+          sum := sum + func(x)
+          x   := x + h
+      return( 0.5*(oldsum + sum*h) )
+
+   trapopen(func,start,del,oldsum,numpoints) ==
+      ddel : F := 2.0*del
+      x   : F := start + 0.5*del
+      sum : F := 0.0
+      i   : I
+      for i in 1..numpoints repeat
+          sum := sum + func(x)
+          x   := x + ddel
+          sum := sum + func(x)
+          x   := x + del
+      return( (oldsum/3.0 + sum*del) )
+
 *)
 
 \end{chunk}
@@ -151402,6 +185146,23 @@ NumericComplexEigenPackage(Par) : C == T
 \begin{chunk}{COQ NCEP}
 (* package NCEP *)
 (*
+
+     import InnerNumericEigenPackage(GRN,Complex Par,Par)
+
+     characteristicPolynomial(m:MGRN) : Polynomial GRN  ==
+       x:SE:=new()$SE
+       multivariate(charpol m, x)
+
+            ----  characteristic polynomial of a matrix A ----
+     characteristicPolynomial(A:MGRN,x:SE):Polynomial GRN ==
+       multivariate(charpol A, x)
+
+     complexEigenvalues(m:MGRN,eps:Par) : List Complex Par  ==
+       solve1(charpol m, eps)
+
+     complexEigenvectors(m:MGRN,eps:Par) :List outForm ==
+       innerEigenvectors(m,eps,factor$ComplexFactorization(RN,SUPGRN))
+
 *)
 
 \end{chunk}
@@ -151495,6 +185256,20 @@ NumericContinuedFraction(F): Exports == Implementation where
 \begin{chunk}{COQ NCNTFRAC}
 (* package NCNTFRAC *)
 (*
+
+    cfc: F -> ST
+    cfc(a) == delay
+      aa := wholePart a
+      zero?(b := a - (aa :: F)) => concat(aa,empty()$ST)
+      concat(aa,cfc inv b)
+
+    continuedFraction a ==
+      aa := wholePart a
+      zero?(b := a - (aa :: F)) =>
+        reducedContinuedFraction(aa,empty()$ST) 
+      if negative? b then (aa := aa - 1; b := b + 1)
+      reducedContinuedFraction(aa,cfc inv b) 
+
 *)
 
 \end{chunk}
@@ -151637,6 +185412,23 @@ NumericRealEigenPackage(Par) : C == T
 \begin{chunk}{COQ NREP}
 (* package NREP *)
 (*
+
+     import InnerNumericEigenPackage(RN, Par, Par)
+
+     characteristicPolynomial(m:MRN) : Polynomial RN ==
+       x:SE:=new()$SE
+       multivariate(charpol(m),x)
+
+            ----  characteristic polynomial of a matrix A ----
+     characteristicPolynomial(A:MRN,x:SE):Polynomial RN ==
+       multivariate(charpol(A),x)
+
+     realEigenvalues(m:MRN,eps:Par) : List Par  ==
+       solve1(charpol m, eps)
+
+     realEigenvectors(m:MRN,eps:Par) :List outForm ==
+       innerEigenvectors(m,eps,factor$GenUFactorize(RN))
+
 *)
 
 \end{chunk}
@@ -151715,6 +185507,7 @@ NumericTubePlot(Curve): Exports == Implementation where
       ++ tube(c,r,n) creates a tube of radius r around the curve c.
  
   Implementation ==> add
+
     import TubePlotTools
  
     LINMAX  := convert(0.995)@SF
@@ -151793,6 +185586,80 @@ NumericTubePlot(Curve): Exports == Implementation where
 \begin{chunk}{COQ NUMTUBE}
 (* package NUMTUBE *)
 (*
+
+    import TubePlotTools
+ 
+    LINMAX  := convert(0.995)@SF
+    XHAT := point(1,0,0,0)
+    YHAT := point(0,1,0,0)
+    PREV0 := point(1,1,0,0)
+    PREV := PREV0
+ 
+    colinearity: (Pt,Pt) -> SF
+    colinearity(x,y) == dot(x,y)**2/(dot(x,x) * dot(y,y))
+ 
+    orthog: (Pt,Pt) -> Pt
+    orthog(x,y) ==
+      if colinearity(x,y) > LINMAX then y := PREV
+      if colinearity(x,y) > LINMAX then
+        y := (colinearity(x,XHAT) < LINMAX => XHAT; YHAT)
+      a := -dot(x,y)/dot(x,x)
+      PREV := a*x + y
+ 
+    poTriad:(Pt,Pt,Pt) -> Triad
+    poTriad(pl,po,pr) ==
+      -- use divided difference for t.
+      t := unitVector(pr - pl)
+      -- compute n as orthogonal to t in plane containing po.
+      pol := pl - po
+      n   := unitVector orthog(t,pol)
+      [t,n,cross(t,n)]
+ 
+    curveTriads: L Pt -> L Triad
+    curveTriads l ==
+      (k := #l) < 2 => error "Need at least 2 points to specify a curve"
+      PREV := PREV0
+      k = 2 =>
+        t := unitVector(second l - first l)
+        n := unitVector(t - XHAT)
+        b := cross(t,n)
+        triad : Triad := [t,n,b]
+        [triad,triad]
+      -- compute interior triads using divided differences
+      midtriads : L Triad :=
+        [poTriad(pl,po,pr) for pl in l for po in rest l _
+               for pr in rest rest l]
+      -- compute first triad using a forward difference
+      x := first midtriads
+      t := unitVector(second l - first l)
+      n := unitVector orthog(t,x.norm)
+      begtriad : Triad := [t,n,cross(t,n)]
+      -- compute last triad using a backward difference
+      x := last midtriads
+      -- efficiency!!
+      t := unitVector(l.k - l.(k-1))
+      n := unitVector orthog(t,x.norm)
+      endtriad : Triad := [t,n,cross(t,n)]
+      concat(begtriad,concat(midtriads,endtriad))
+ 
+    curveLoops: (L Pt,SF,I) -> L L Pt
+    curveLoops(pts,r,nn) ==
+      triads := curveTriads pts
+      cosSin := cosSinInfo nn
+      loops : L L Pt := nil()
+      for pt in pts for triad in triads repeat
+        n := triad.norm; b := triad.bin
+        loops := concat(loopPoints(pt,n,b,r,cosSin),loops)
+      reverse_! loops
+ 
+    tube(curve,r,n) ==
+      n < 3 => error "tube: n should be at least 3"
+      brans := listBranches curve
+      loops : L L Pt := nil()
+      for bran in brans repeat
+        loops := concat(loops,curveLoops(bran,r,n))
+      tube(curve,loops,false)
+
 *)
 
 \end{chunk}
@@ -151877,6 +185744,7 @@ OctonionCategoryFunctions2(OR,R,OS,S) : Exports ==
         ++ map(f,u) maps f onto the component parts of the octonion
         ++ u.
     Implementation == add
+
       map(fn : R -> S, u : OR): OS ==
         octon(fn real u, fn imagi u, fn imagj u, fn imagk u,_
         fn imagE u, fn imagI u, fn imagJ u, fn imagK u)$OS
@@ -151886,6 +185754,11 @@ OctonionCategoryFunctions2(OR,R,OS,S) : Exports ==
 \begin{chunk}{COQ OCTCT2}
 (* package OCTCT2 *)
 (*
+
+      map(fn : R -> S, u : OR): OS ==
+        octon(fn real u, fn imagi u, fn imagj u, fn imagk u,_
+        fn imagE u, fn imagI u, fn imagJ u, fn imagK u)$OS
+
 *)
 
 \end{chunk}
@@ -151978,6 +185851,7 @@ ODEIntegration(R, F): Exports == Implementation where
       ++ diff(x) returns the derivation with respect to x.
 
   Implementation ==> add
+
     import FunctionSpaceIntegration(R, F)
     import ElementaryFunctionStructurePackage(R, F)
 
@@ -151987,13 +185861,13 @@ ODEIntegration(R, F): Exports == Implementation where
 
     diff x == (f1:F):F +-> differentiate(f1, x)
 
--- This is the integration function to be used for quadratures
+    -- This is the integration function to be used for quadratures
     int(f, x) ==
       (u := integrate(f, x)) case F => u::F
       first(u::List(F))
 
--- mkprod([q1, f1],...,[qn,fn]) returns */(fi^qi) but groups the
--- qi having the same denominator together
+    -- mkprod([q1, f1],...,[qn,fn]) returns */(fi^qi) but groups the
+    -- qi having the same denominator together
     mkprod l ==
       empty? l => 1
       rec := first l
@@ -152002,7 +185876,7 @@ ODEIntegration(R, F): Exports == Implementation where
       nthRoot(*/[r.logand ** numer(r.coef) for r in ll], d) *
         mkprod setDifference(l, ll)
 
--- computes exp(int(f,x)) in a non-naive way
+    -- computes exp(int(f,x)) in a non-naive way
     expint(f, x) ==
       a := int(f, x)
       (u := validExponential(tower a, a, x)) case F => u::F
@@ -152019,7 +185893,7 @@ ODEIntegration(R, F): Exports == Implementation where
           exponent := exponent + term
       mkprod(lrec) * exp(exponent / da)
 
--- checks if all the elements of l are rational numbers, returns their product
+    -- checks if all the elements of l are rational numbers, returns product
     isQ l ==
       prod:Q := 1
       for x in l repeat
@@ -152027,7 +185901,7 @@ ODEIntegration(R, F): Exports == Implementation where
         prod := prod * u::Q
       prod
 
--- checks if a non-sum expr is of the form c * log(g) for a rational number c
+    -- checks if a non-sum expr is of the form c * log(g) for rational number c
     isQlog f ==
       is?(f, "log"::SY) => [1, first argument(retract(f)@K)]
       (v := isTimes f) case List(F) and (#(l := v::List(F)) <= 3) =>
@@ -152042,6 +185916,66 @@ ODEIntegration(R, F): Exports == Implementation where
 \begin{chunk}{COQ ODEINT}
 (* package ODEINT *)
 (*
+
+    import FunctionSpaceIntegration(R, F)
+    import ElementaryFunctionStructurePackage(R, F)
+
+    isQ   : List F -> UQ
+    isQlog: F -> Union(REC, "failed")
+    mkprod: List REC -> F
+
+    diff x == (f1:F):F +-> differentiate(f1, x)
+
+    -- This is the integration function to be used for quadratures
+    int(f, x) ==
+      (u := integrate(f, x)) case F => u::F
+      first(u::List(F))
+
+    -- mkprod([q1, f1],...,[qn,fn]) returns */(fi^qi) but groups the
+    -- qi having the same denominator together
+    mkprod l ==
+      empty? l => 1
+      rec := first l
+      d := denom(rec.coef)
+      ll := select((z1:REC):Boolean +-> denom(z1.coef) = d, l)
+      nthRoot(*/[r.logand ** numer(r.coef) for r in ll], d) *
+        mkprod setDifference(l, ll)
+
+    -- computes exp(int(f,x)) in a non-naive way
+    expint(f, x) ==
+      a := int(f, x)
+      (u := validExponential(tower a, a, x)) case F => u::F
+      da := denom a
+      l :=
+        (v := isPlus(na := numer a)) case List(P) => v::List(P)
+        [na]
+      exponent:P := 0
+      lrec:List(REC) := empty()
+      for term in l repeat
+        if (w := isQlog(term / da)) case REC then
+          lrec := concat(w::REC, lrec)
+        else
+          exponent := exponent + term
+      mkprod(lrec) * exp(exponent / da)
+
+    -- checks if all the elements of l are rational numbers, returns product
+    isQ l ==
+      prod:Q := 1
+      for x in l repeat
+        (u := retractIfCan(x)@UQ) case "failed" => return "failed"
+        prod := prod * u::Q
+      prod
+
+    -- checks if a non-sum expr is of the form c * log(g) for rational number c
+    isQlog f ==
+      is?(f, "log"::SY) => [1, first argument(retract(f)@K)]
+      (v := isTimes f) case List(F) and (#(l := v::List(F)) <= 3) =>
+          l := reverse_! sort_! l
+          is?(first l, "log"::SY) and ((u := isQ rest l) case Q) =>
+              [u::Q, first argument(retract(first(l))@K)]
+          "failed"
+      "failed"
+
 *)
 
 \end{chunk}
@@ -152141,6 +186075,7 @@ ODETools(F, LODO): Exports == Implementation where
       ++ Note that the method of variations of parameters is used.
 
   Implementation ==> add
+
     import LinearSystemMatrixPackage(F, V, V, M)
 
     diff := D()$LODO
@@ -152174,6 +186109,35 @@ ODETools(F, LODO): Exports == Implementation where
 \begin{chunk}{COQ ODETOOLS}
 (* package ODETOOLS *)
 (*
+
+    import LinearSystemMatrixPackage(F, V, V, M)
+
+    diff := D()$LODO
+
+    wronskianMatrix l == wronskianMatrix(l, #l)
+
+    wronskianMatrix(l, q) ==
+      v:V := vector l
+      m:M := zero(q, #v)
+      for i in minRowIndex m .. maxRowIndex m repeat
+        setRow_!(m, i, v)
+        v := map_!((f1:F):F +-> diff f1, v)
+      m
+
+    variationOfParameters(op, g, b) ==
+      empty? b => "failed"
+      v:V := new(n := degree op, 0)
+      qsetelt_!(v, maxIndex v, g / leadingCoefficient op)
+      particularSolution(wronskianMatrix(b, n), v)
+
+    particularSolution(op, g, b, integration) ==
+      zero? g => 0
+      (sol := variationOfParameters(op, g, b)) case "failed" => "failed"
+      ans:F := 0
+      for f in b for i in minIndex(s := sol::V) .. repeat
+        ans := ans + integration(qelt(s, i)) * f
+      ans
+
 *)
 
 \end{chunk}
@@ -152281,8 +186245,11 @@ OneDimensionalArrayFunctions2(A, B): Exports == Implementation where
     ++X map(x+->x+2,[i for i in 1..10])$T1
 
   Implementation ==> add
+
     map(f, v)       == map(f, v)$O2
+
     scan(f, v, b)   == scan(f, v, b)$O2
+
     reduce(f, v, b) == reduce(f, v, b)$O2
 
 \end{chunk}
@@ -152290,6 +186257,13 @@ OneDimensionalArrayFunctions2(A, B): Exports == Implementation where
 \begin{chunk}{COQ ARRAY12}
 (* package ARRAY12 *)
 (*
+
+    map(f, v)       == map(f, v)$O2
+
+    scan(f, v, b)   == scan(f, v, b)$O2
+
+    reduce(f, v, b) == reduce(f, v, b)$O2
+
 *)
 
 \end{chunk}
@@ -152367,6 +186341,7 @@ OnePointCompletionFunctions2(R, S): Exports == Implementation where
       ++ f(infinity) = i.
 
   Implementation ==> add
+
     map(f, r) == map(f, r, infinity())
 
     map(f, r, i) ==
@@ -152378,6 +186353,13 @@ OnePointCompletionFunctions2(R, S): Exports == Implementation where
 \begin{chunk}{COQ ONECOMP2}
 (* package ONECOMP2 *)
 (*
+
+    map(f, r) == map(f, r, infinity())
+
+    map(f, r, i) ==
+      (u := retractIfCan r) case R => (f(u::R))::OPS
+      i
+
 *)
 
 \end{chunk}
@@ -152480,6 +186462,7 @@ OpenMathPackage(): with
   ++ is unable to handle.  Note that this is different from an unexpected
   ++ symbol.
  == add
+
   import OpenMathEncoding
   import OpenMathDevice
   import String
@@ -152522,6 +186505,44 @@ OpenMathPackage(): with
 \begin{chunk}{COQ OMPKG}
 (* package OMPKG *)
 (*
+
+  import OpenMathEncoding
+  import OpenMathDevice
+  import String
+
+  OMunhandledSymbol(u,v) ==
+    error concat ["AXIOM is unable to process the symbol ",u," from CD ",v,"."]
+
+  OMread(dev: OpenMathDevice): Any ==
+    interpret(OM_-READ(dev)$Lisp :: InputForm)
+
+  OMreadFile(filename: String): Any ==
+    dev := OMopenFile(filename, "r", OMencodingUnknown())
+    res: Any := interpret(OM_-READ(dev)$Lisp :: InputForm)
+    OMclose(dev)
+    res
+
+  OMreadStr(str: String): Any ==
+    strp := OM_-STRINGTOSTRINGPTR(str)$Lisp
+    dev := OMopenString(strp pretend String, OMencodingUnknown())
+    res: Any := interpret(OM_-READ(dev)$Lisp :: InputForm)
+    OMclose(dev)
+    res
+
+  OMlistCDs(): List(String) ==
+    OM_-LISTCDS()$Lisp pretend List(String)
+
+  OMlistSymbols(cd: String): List(String) ==
+    OM_-LISTSYMBOLS(cd)$Lisp pretend List(String)
+
+  import SExpression
+
+  OMsupportsCD?(cd: String): Boolean ==
+    not null? OM_-SUPPORTSCD(cd)$Lisp 
+
+  OMsupportsSymbol?(cd: String, name: String): Boolean ==
+    not null? OM_-SUPPORTSSYMBOL(cd, name)$Lisp
+
 *)
 
 \end{chunk}
@@ -152606,13 +186627,12 @@ OpenMathServerPackage(): with
   ++ \axiom{portnum}.  The parameter \axiom{timeout} specifies the timeout
   ++ period for the connection.
  == add
+
   import OpenMathDevice
   import OpenMathConnection
   import OpenMathPackage
   import OpenMath
 
-
-
   OMreceive(conn: OpenMathConnection): Any ==
     dev: OpenMathDevice := OMconnInDevice(conn)
     OMsetEncoding(dev, OMencodingUnknown);
@@ -152647,6 +186667,41 @@ OpenMathServerPackage(): with
 \begin{chunk}{COQ OMSERVER}
 (* package OMSERVER *)
 (*
+
+  import OpenMathDevice
+  import OpenMathConnection
+  import OpenMathPackage
+  import OpenMath
+
+  OMreceive(conn: OpenMathConnection): Any ==
+    dev: OpenMathDevice := OMconnInDevice(conn)
+    OMsetEncoding(dev, OMencodingUnknown);
+    OMread(dev)
+
+  OMsend(conn: OpenMathConnection, value: Any): Void ==
+    dev: OpenMathDevice := OMconnOutDevice(conn)
+    OMsetEncoding(dev, OMencodingXML);
+    --retractable?(value)$AnyFunctions1(Expression Integer) =>
+    --  OMwrite(dev, retract(value)$AnyFunctions1(Expression Integer), true)
+    retractable?(value)$AnyFunctions1(Integer) =>
+      OMwrite(dev, retract(value)$AnyFunctions1(Integer), true)
+    retractable?(value)$AnyFunctions1(Float) =>
+      OMwrite(dev, retract(value)$AnyFunctions1(Float), true)
+    retractable?(value)$AnyFunctions1(SingleInteger) =>
+      OMwrite(dev, retract(value)$AnyFunctions1(SingleInteger), true)
+    retractable?(value)$AnyFunctions1(DoubleFloat) =>
+      OMwrite(dev, retract(value)$AnyFunctions1(DoubleFloat), true)
+    retractable?(value)$AnyFunctions1(String) =>
+      OMwrite(dev, retract(value)$AnyFunctions1(String), true)
+
+  OMserve(portNum: SingleInteger, timeout: SingleInteger): Void ==
+    conn: OpenMathConnection := OMmakeConn(timeout)
+    OMbindTCP(conn, portNum)
+    val: Any
+    while true repeat
+      val := OMreceive(conn)
+      OMsend(conn, val)
+
 *)
 
 \end{chunk}
@@ -152712,6 +186767,7 @@ OperationsQuery(): Exports == Implementation where
       ++ browser database.  The legal values for "char" are "o" (operations),
       ++ "k" (constructors), "d" (domains), "c" (categories) or "p" (packages).
   Implementation == add
+
     getDatabase(s) == getBrowseDatabase(s)$Lisp
 
 \end{chunk}
@@ -152719,6 +186775,9 @@ OperationsQuery(): Exports == Implementation where
 \begin{chunk}{COQ OPQUERY}
 (* package OPQUERY *)
 (*
+
+    getDatabase(s) == getBrowseDatabase(s)$Lisp
+
 *)
 
 \end{chunk}
@@ -152797,11 +186856,11 @@ OrderedCompletionFunctions2(R, S): Exports == Implementation where
       ++ f(plusInfinity) = p and that f(minusInfinity) = m.
 
   Implementation ==> add
+
     map(f, r) == map(f, r, plusInfinity(), minusInfinity())
 
     map(f, r, p, m) ==
       zero?(n := whatInfinity r) => (f retract r)::ORS
---      one? n => p
       (n = 1) => p
       m
 
@@ -152810,6 +186869,14 @@ OrderedCompletionFunctions2(R, S): Exports == Implementation where
 \begin{chunk}{COQ ORDCOMP2}
 (* package ORDCOMP2 *)
 (*
+
+    map(f, r) == map(f, r, plusInfinity(), minusInfinity())
+
+    map(f, r, p, m) ==
+      zero?(n := whatInfinity r) => (f retract r)::ORS
+      (n = 1) => p
+      m
+
 *)
 
 \end{chunk}
@@ -152898,16 +186965,17 @@ OrderingFunctions(dim,S) : T == C  where
        ++ the reverse lexicographic ordering.
 
   C == add
+
     n:NonNegativeInteger:=dim
 
- -- pure lexicographical ordering
+    -- pure lexicographical ordering
     pureLex(v1:VS,v2:VS) : Boolean ==
       for i in 1..n repeat
         if qelt(v1,i) < qelt(v2,i) then return true
         if qelt(v2,i) < qelt(v1,i) then return false
       false
 
- -- total ordering refined with lex
+    -- total ordering refined with lex
     totalLex(v1:VS,v2:VS) :Boolean ==
       n1:S:=0
       n2:S:=0
@@ -152921,7 +186989,7 @@ OrderingFunctions(dim,S) : T == C  where
         if qelt(v2,i) < qelt(v1,i) then return false
       false
 
- -- reverse lexicographical ordering
+    -- reverse lexicographical ordering
     reverseLex(v1:VS,v2:VS) :Boolean ==
       n1:S:=0
       n2:S:=0
@@ -152940,6 +187008,44 @@ OrderingFunctions(dim,S) : T == C  where
 \begin{chunk}{COQ ORDFUNS}
 (* package ORDFUNS *)
 (*
+
+    n:NonNegativeInteger:=dim
+
+    -- pure lexicographical ordering
+    pureLex(v1:VS,v2:VS) : Boolean ==
+      for i in 1..n repeat
+        if qelt(v1,i) < qelt(v2,i) then return true
+        if qelt(v2,i) < qelt(v1,i) then return false
+      false
+
+    -- total ordering refined with lex
+    totalLex(v1:VS,v2:VS) :Boolean ==
+      n1:S:=0
+      n2:S:=0
+      for i in 1..n repeat
+        n1:= n1+qelt(v1,i)
+        n2:=n2+qelt(v2,i)
+      n1<n2 => true
+      n2<n1 => false
+      for i in 1..n repeat
+        if qelt(v1,i) < qelt(v2,i) then return true
+        if qelt(v2,i) < qelt(v1,i) then return false
+      false
+
+    -- reverse lexicographical ordering
+    reverseLex(v1:VS,v2:VS) :Boolean ==
+      n1:S:=0
+      n2:S:=0
+      for i in 1..n repeat
+        n1:= n1+qelt(v1,i)
+        n2:=n2+qelt(v2,i)
+      n1<n2 => true
+      n2<n1 => false
+      for i in reverse(1..n) repeat
+        if qelt(v2,i) < qelt(v1,i) then return true
+        if qelt(v1,i) < qelt(v2,i) then return false
+      false
+
 *)
 
 \end{chunk}
@@ -153041,7 +187147,7 @@ OrthogonalPolynomialFunctions(R: CommutativeRing): Exports == Impl where
 
         laguerreL:  (NNI, NNI, R) -> R
            ++ laguerreL(m,n,x) is the associated Laguerre polynomial,
-           ++ \spad{L<m>[n](x)}.  This is the m-th derivative of \spad{L[n](x)}.
+           ++ \spad{L<m>[n](x)}. This is the m-th derivative of \spad{L[n](x)}.
 
         if R has Algebra RN then
             legendreP:  (NNI, R) -> R
@@ -153050,6 +187156,7 @@ OrthogonalPolynomialFunctions(R: CommutativeRing): Exports == Impl where
                 ++ \spad{1/sqrt(1-2*x*t+t**2) = sum(P[n](x)*t**n, n = 0..)}.
 
     Impl ==> add
+
         p0, p1: R
         cx:     Integer
 
@@ -153061,6 +187168,7 @@ OrthogonalPolynomialFunctions(R: CommutativeRing): Exports == Impl where
             for i in 1..n-1 repeat
                 (p1, p0) := ((2*i::R + 1 - x)*p1 - i**2*p0, p1)
             p1
+
         laguerreL(m, n, x) ==
             ni := n::Integer
             mi := m::Integer
@@ -153073,25 +187181,30 @@ OrthogonalPolynomialFunctions(R: CommutativeRing): Exports == Impl where
                 p0 := p0 * x
                 p1 := p1 + cx*p0
             p1
+
         chebyshevT(n, x) ==
             n = 0 => 1
             (p1, p0) := (x, 1)
             for i in 1..n-1 repeat
                 (p1, p0) := (2*x*p1 - p0, p1)
             p1
+
         chebyshevU(n, x) ==
             n = 0 => 1
             (p1, p0) := (2*x, 1)
             for i in 1..n-1 repeat
                 (p1, p0) := (2*x*p1 - p0, p1)
             p1
+
         hermiteH(n, x) ==
             n = 0 => 1
             (p1, p0) := (2*x, 1)
             for i in 1..n-1 repeat
                 (p1, p0) := (2*x*p1 - 2*i*p0, p1)
             p1
+
         if R has Algebra RN then
+
             legendreP(n, x) ==
                 n = 0 => 1
                 p0 := 1
@@ -153106,6 +187219,64 @@ OrthogonalPolynomialFunctions(R: CommutativeRing): Exports == Impl where
 \begin{chunk}{COQ ORTHPOL}
 (* package ORTHPOL *)
 (*
+
+        p0, p1: R
+        cx:     Integer
+
+        import IntegerCombinatoricFunctions()
+
+        laguerreL(n, x) ==
+            n = 0 => 1
+            (p1, p0) := (-x + 1, 1)
+            for i in 1..n-1 repeat
+                (p1, p0) := ((2*i::R + 1 - x)*p1 - i**2*p0, p1)
+            p1
+
+        laguerreL(m, n, x) ==
+            ni := n::Integer
+            mi := m::Integer
+            cx := (-1)**m * binomial(ni,ni-mi) * factorial(ni)
+            p0 := 1
+            p1 := cx::R
+            for j in 1..ni-mi repeat
+                cx := -cx*(ni-mi-j+1)
+                cx := (cx exquo ((mi+j)*j))::Integer
+                p0 := p0 * x
+                p1 := p1 + cx*p0
+            p1
+
+        chebyshevT(n, x) ==
+            n = 0 => 1
+            (p1, p0) := (x, 1)
+            for i in 1..n-1 repeat
+                (p1, p0) := (2*x*p1 - p0, p1)
+            p1
+
+        chebyshevU(n, x) ==
+            n = 0 => 1
+            (p1, p0) := (2*x, 1)
+            for i in 1..n-1 repeat
+                (p1, p0) := (2*x*p1 - p0, p1)
+            p1
+
+        hermiteH(n, x) ==
+            n = 0 => 1
+            (p1, p0) := (2*x, 1)
+            for i in 1..n-1 repeat
+                (p1, p0) := (2*x*p1 - 2*i*p0, p1)
+            p1
+
+        if R has Algebra RN then
+
+            legendreP(n, x) ==
+                n = 0 => 1
+                p0 := 1
+                p1 := x
+                for i in 1..n-1 repeat
+                    c: RN := 1/(i+1)
+                    (p1, p0) := (c*((2*i+1)*x*p1 - i*p0), p1)
+                p1
+
 *)
 
 \end{chunk}
@@ -153231,6 +187402,36 @@ OutputPackage: with
 \begin{chunk}{COQ OUT}
 (* package OUT *)
 (*
+
+    --ExpressionPackage()
+    E      ==> OutputForm
+    putout ==> mathprint$Lisp
+
+    s: String
+    e: OutputForm
+    l: List Any
+
+    output e ==
+      mathprint(e)$Lisp
+      void()
+
+    -- Note that we have to do the pretend here because otherwise we will
+    -- try to load STRING which is not yet compiled during build.
+
+    output s ==
+      output(s pretend OutputForm)
+
+    output(s,e) ==
+      output blankSeparate [s pretend OutputForm, e]
+
+    outputList(l) ==                                -- MGR
+      output hconcat
+        [if retractable?(x)$AnyFunctions1(String) then
+            message(retract(x)$AnyFunctions1(String))$OutputForm
+          else
+            x::OutputForm
+         for x in l]
+
 *)
 
 \end{chunk}
@@ -153528,6 +187729,7 @@ PackageForAlgebraicFunctionField(K,symb,BLMET):Exports == Implementation where
         ++ extension. Calculated by using the L-Polynomial
 
   Implementation ==>  add
+
     import BP
 
     homogenize(pol,n) == homogenize(pol,n)$PACKPOLY
@@ -153644,6 +187846,118 @@ PackageForAlgebraicFunctionField(K,symb,BLMET):Exports == Implementation where
 \begin{chunk}{COQ PAFF}
 (* package PAFF *)
 (*
+
+    import BP
+
+    homogenize(pol,n) == homogenize(pol,n)$PACKPOLY
+
+    pointDominateBy(pl)== pointDominateBy(pl)$BP
+
+    placesAbove(pt)== placesAbove(pt)$BP
+
+    setSingularPoints(lspt)==    setSingularPoints(lspt)$BP
+
+    projectivePoint(lpt)==projectivePoint(lpt)$ProjPt   
+
+    interpolateFormsForFact(d,lm)==
+      interpolateFormsForFact(d,lm)$BP
+
+    if K has Finite then 
+      
+      goppaCode(d:DIVISOR,lp:List(Plc))==
+        lb:=lBasis(d)
+        dd:=lb.den
+        ll:=[[eval(f,dd,pl) for pl in lp] for f in lb.num]
+        matrix ll
+      
+      goppaCode(d:DIVISOR,p:DIVISOR)==
+        lp:=supp p
+        goppaCode(d,lp)
+    
+      ZetaFunction == ZetaFunction()$BP
+
+      ZetaFunction(d) == ZetaFunction(d)$BP
+
+      numberOfPlacesOfDegree(i)==numberOfPlacesOfDegree(i)$BP
+
+      placesOfDegree(i) ==placesOfDegree(i)$BP
+
+      numberRatPlacesExtDeg(extDegree)==numberRatPlacesExtDeg(extDegree)$BP
+
+      numberPlacesDegExtDeg(degree,extDegree)==
+        numberPlacesDegExtDeg(degree,extDegree)$BP
+
+      LPolynomial == LPolynomial()$BP
+
+      LPolynomial(extDeg)==LPolynomial(extDeg)$BP
+
+      classNumber== classNumber()$BP
+
+      rationalPlaces == rationalPlaces()$BP 
+
+      rationalPoints==rationalPoints()$BP
+      
+    crvLocal:PolyRing
+
+    eval(f:PolyRing,pl:Plc)==
+      dd:= degree pl
+      ^one?(dd) => error " cannot evaluate at place of degree greater than one"
+      eval(f,pl)$BP
+
+    evalIfCan(f:PolyRing,pl:Plc)==
+      dd:= degree pl
+      ^one?(dd) => error " cannot evaluate at place of degree greater than one"
+      evalIfCan(f,pl)$BP
+    
+    setCurve(pol)==setCurve(pol)$BP
+
+    lBasis(divis)==lBasis(divis)$BP
+
+    genus==genus()$BP
+
+    genusNeg==genusNeg()$BP
+
+    theCurve==theCurve()$BP
+
+    desingTree==desingTree()$BP
+
+    desingTreeWoFullParam== desingTreeWoFullParam()$BP
+
+    -- compute the adjunction divisor of the curve using 
+    -- adjunctionDivisor from DesingTreePackage
+    adjunctionDivisor == adjunctionDivisor()$BP
+    
+    singularPoints==singularPoints()$BP
+
+    parametrize(f,pl)==parametrize(f,pl)$BP
+
+    -- compute the interpolating forms (see package InterpolateFormsPackage)
+    interpolateForms(d,n)==interpolateForms(d,n)$BP
+
+    eval(f:PolyRing,g:PolyRing,pl:Plc)==eval(f,g,pl)$BP
+    
+    eval(u:FRACPOLY,pl:Plc)==
+      ff:=numer u
+      gg:=denom u
+      eval(ff,gg,pl)
+
+    evalIfCan(f:PolyRing,g:PolyRing,pl:Plc)==evalIfCan(f,g,pl)$BP
+    
+    evalIfCan(u:FRACPOLY,pl:Plc)==
+      ff:=numer u
+      gg:=denom u
+      evalIfCan(ff,gg,pl)
+    
+    intersectionDivisor(pol)==intersectionDivisor(pol)$BP
+
+    fullDesTree==
+      fullOutput()$DesTree => fullOutput(false())$DesTree
+      fullOutput(true())$DesTree
+
+    fullInfClsPt==
+      fullOutput()$InfClsPoint => fullOutput(false())$InfClsPoint
+      fullOutput(true())$InfClsPoint
+
 *)
 
 \end{chunk}
@@ -153945,6 +188259,7 @@ PackageForAlgebraicFunctionFieldOverFiniteField(K,symb,BLMET):Exp == Impl where
 	++ extension. Calculated by using the L-Polynomial
 	
   Impl ==>  add
+
     import BP
 
     homogenize(pol,n) == homogenize(pol,n)$PackageForPoly(K,PolyRing,E,#symb)
@@ -154109,12 +188424,176 @@ PackageForAlgebraicFunctionFieldOverFiniteField(K,symb,BLMET):Exp == Impl where
       fullOutput()$InfClsPoint => fullOutput(false())$InfClsPoint
       fullOutput(true())$InfClsPoint
 
-
 \end{chunk}
 
 \begin{chunk}{COQ PAFFFF}
 (* package PAFFFF *)
 (*
+
+    import BP
+
+    homogenize(pol,n) == homogenize(pol,n)$PackageForPoly(K,PolyRing,E,#symb)
+    
+    toPolyRing2: PolyRing -> PolyRing2
+
+    toPolyRing: PolyRing2 -> PolyRing
+
+    projectivePoint(lpt)==projectivePoint(lpt)$ProjPt
+
+    pointDominateBy(pl)== pointDominateBy(pl)$BP
+
+    placesAbove(pt)== placesAbove(pt)$BP
+
+    setSingularPoints(lspt)==    setSingularPoints(lspt)$BP
+    
+    findOrderOfDivisor(divis,lb,hb) ==
+      ens:=findOrderOfDivisor(divis,lb,hb)$BP
+      [ens.ord, toPolyRing ens.num, toPolyRing ens.den, ens.upTo]      
+    
+    setCurve(pol)==
+      ooo:=setCurve(toPolyRing2 pol)$BP
+      pol
+    
+    ZetaFunction == ZetaFunction()$BP
+
+    ZetaFunction(d) == ZetaFunction(d)$BP
+
+    numberOfPlacesOfDegree(i)==numberOfPlacesOfDegree(i)$BP
+
+    placesOfDegree(i) ==placesOfDegree(i)$BP
+
+    numberRatPlacesExtDeg(extDegree)==numberRatPlacesExtDeg(extDegree)$BP
+
+    numberPlacesDegExtDeg(degree,extDegree)==
+      numberPlacesDegExtDeg(degree,extDegree)$BP
+
+    LPolynomial == LPolynomial()$BP
+
+    LPolynomial(extDeg)==LPolynomial(extDeg)$BP
+
+    classNumber== classNumber()$BP
+
+    rationalPlaces == rationalPlaces()$BP 
+
+    rationalPoints==rationalPoints()$BP
+      
+    goppaCode(d:DIVISOR,lp:List(Plc))==
+      lb:=lBasis(d)
+      dd:=lb.den
+      ll:=[[eval(f,dd,pl) for pl in lp] for f in lb.num]
+      matrix ll
+      
+    goppaCode(d:DIVISOR,p:DIVISOR)==
+      lp:=supp p
+      goppaCode(d,lp)
+
+    toPolyRing(pol)==
+      zero?(pol) => 0$PolyRing
+      lc:=leadingCoefficient pol
+      lce:K:= retract lc
+      lm:=leadingMonomial pol
+      lt:=degree lm
+      monomial(lce,lt)$PolyRing + toPolyRing( reductum pol )
+
+    toPolyRing2(pol)==
+      zero?(pol) => 0$PolyRing2
+      lc:=leadingCoefficient pol
+      lce:DK:= lc :: DK 
+      lm:=leadingMonomial pol
+      lt:=degree lm
+      monomial(lce,lt)$PolyRing2 + toPolyRing2( reductum pol )
+
+    evalIfCan(f:PolyRing,pl:Plc)==
+      dd:= degree pl
+      ^one?(dd) => error " cannot evaluate at place of degree greater than one"
+      ee:=evalIfCan(toPolyRing2 f,pl)$BP
+      ee case "failed" => "failed"
+      retract ee 
+      
+    eval(f:PolyRing,pl:Plc)==
+      dd:= degree pl
+      ^one?(dd) => error " cannot evaluate at place of degree greater than one"
+      ee:=eval(toPolyRing2 f,pl)$BP
+      retract ee 
+      
+    lBasis(divis)==
+      ans:=lBasis(divis)$BP
+      nn:=ans.num
+      dd:=ans.den
+      nnd:=[toPolyRing pol for pol in nn]
+      ddd:=toPolyRing dd
+      [nnd,ddd]
+
+    genus==genus()$BP
+
+    genusNeg==genusNeg()$BP
+
+    theCurve==
+      ccc:= theCurve()$BP
+      toPolyRing ccc
+
+    desingTree==desingTree()$BP
+
+    desingTreeWoFullParam== desingTreeWoFullParam()$BP
+
+    -- compute the adjunction divisor of the curve using 
+    -- adjunctionDivisor from DesingTreePackage
+    adjunctionDivisor == adjunctionDivisor()$BP
+    
+    singularPoints==singularPoints()$BP
+
+    parametrize(f,pl)==
+      ff:= toPolyRing2 f
+      parametrize(ff,pl)$BP
+
+    -- compute the interpolating forms (see package InterpolateFormsPackage)
+    interpolateForms(d,n)==
+      ans:=interpolateForms(d,n)$BP
+      [toPolyRing pol for pol in ans]
+
+    interpolateFormsForFact(d,lm)==
+      lm2:List PolyRing2 := [ toPolyRing2 p for p in lm]
+      interpolateFormsForFact(d,lm2)$BP
+
+    evalIfCan(ff:PolyRing,gg:PolyRing,pl:Plc)==
+      dd:= degree pl
+      ^one?(dd) => error " cannot evaluate at place of degree greater than one"
+      f:=toPolyRing2 ff
+      g:=toPolyRing2 gg
+      ee:=evalIfCan(f,g,pl)$BP
+      ee case "failed" => "failed"
+      retract ee 
+
+    eval(ff:PolyRing,gg:PolyRing,pl:Plc)==
+      dd:= degree pl
+      ^one?(dd) => error " cannot evaluate at place of degree greater than one"
+      f:=toPolyRing2 ff
+      g:=toPolyRing2 gg
+      ee:=eval(f,g,pl)$BP
+      retract ee 
+    
+    evalIfCan(u:FracPoly,pl:Plc)==
+      ff:=numer u
+      gg:=denom u
+      evalIfCan(ff,gg,pl)
+
+    eval(u:FracPoly,pl:Plc)==
+      ff:=numer u
+      gg:=denom u
+      eval(ff,gg,pl)
+    
+    intersectionDivisor(pol)==
+      polu:=toPolyRing2 pol
+      intersectionDivisor(polu)$BP
+
+    fullDesTree==
+      fullOutput()$DesTree => fullOutput(false())$DesTree
+      fullOutput(true())$DesTree
+
+    fullInfClsPt==
+      fullOutput()$InfClsPoint => fullOutput(false())$InfClsPoint
+      fullOutput(true())$InfClsPoint
+
 *)
 
 \end{chunk}
@@ -154293,6 +188772,7 @@ PackageForPoly(R,PolyRing,E,dim): public == private where
 
 
   private == add
+
       import PolyRing
 
       monomials(pol)==
@@ -154502,12 +188982,221 @@ PackageForPoly(R,PolyRing,E,dim): public == private where
       listAllMono(l)==
         [monomial(1,e)$PolyRing for e in listAllMonoExp(l)]
 
-
 \end{chunk}
 
 \begin{chunk}{COQ PFORP}
 (* package PFORP *)
 (*
+
+      import PolyRing
+
+      monomials(pol)==
+        zero? pol => empty()
+        lt:=leadingMonomial pol
+        cons( lt , monomials reductum pol )
+
+      lll: Integer -> E
+      lll(i) == 
+        le:=new( dim , 0$NNI)$List(NNI)
+        le.i := 1
+        directProduct( vector(le)$Vector(NNI) )$E
+
+      listVariable== 
+        [monomial(1,ee)$PolyRing for ee in [lll(i) for i in 1..dim]]
+
+      univariate(pol)==
+        zero? pol => 0
+        d:=degree pol
+        lc:=leadingCoefficient pol
+        td := reduce("+", entries d)
+        monomial(lc,td)$SparseUnivariatePolynomial(R)+univariate(reductum pol)
+      
+      collectExpon: List Term -> PolyRing
+
+      translateLocal: (PolyRing,List R,Integer) -> PolyRing
+
+      lA: (Integer,Integer) -> List List NNI
+
+      toListRep: PolyRing -> List Term
+
+      exponentEntryToZero: (E,Integer) -> E
+
+      exponentEntryZero?: (E,Integer) -> Boolean
+
+      homogenizeExp: (E,NNI,INT) -> E
+
+      translateMonomial: (PolyRing,List R,INT,R) -> PolyRing
+
+      leadingTerm: PolyRing -> Term
+
+      mapExponents(f,pol)==
+        zero?(pol) => 0
+	lt:=leadingTerm pol
+	newExp:E:= f(lt.k)
+	newMono:PolyRing:= monomial(lt.c,newExp)$PolyRing
+	newMono + mapExponents(f,reductum pol)
+	
+      collectExpon(pol)==
+        empty? pol => 0
+	ft:=first pol
+	monomial(ft.c,ft.k) + collectExpon( rest pol )
+
+      subs1stVar(pol, spol)==
+        zero? pol => 0
+        lexpE:E:= degree pol
+	lexp:List NNI:= parts lexpE
+        coef:= leadingCoefficient pol 
+	coef * spol ** lexp.1  * second(listVariable())**lexp.2 _
+           + subs1stVar( reductum pol, spol )
+
+      subs2ndVar(pol, spol)==
+        zero? pol => 0
+        lexpE:E:= degree pol
+	lexp:List NNI:= parts lexpE
+        coef:= leadingCoefficient pol 
+	coef * first(listVariable())**lexp.1   *  spol ** lexp.2 _
+           + subs2ndVar( reductum pol, spol )
+
+      subsInVar( pol, spol, n)==
+        one?( n ) => subs1stVar( pol, spol)
+        subs2ndVar(pol,spol) 
+
+      translate(pol,lpt)==        
+        zero? pol => 0
+        lexpE:E:= degree pol
+	lexp:List NNI:= parts lexpE
+        coef:= leadingCoefficient pol 
+	trVar:=[(listVariable().i + (lpt.i)::PolyRing)**lexp.i for i in 1..dim]
+        coef * reduce("*",trVar,1) + translate(reductum pol , lpt)
+
+      translate(poll,lpt,nV)==
+        pol:=replaceVarByOne(poll,nV)
+        translateLocal(pol,lpt,nV)
+
+      translateLocal(pol,lpt,nV)==
+	zero?(pol) => 0
+        lll:List R:=[l for l in lpt | ^zero?(l)]
+        nbOfNonZero:=# lll
+	ltk:=leadingMonomial pol
+	ltc:=leadingCoefficient pol
+        if one?(nbOfNonZero) then
+	  pol
+        else
+	  translateMonomial(ltk,lpt,nV,ltc) + _
+           translateLocal(reductum(pol),lpt,nV)
+
+      exponentEntryToZero(exp,nV)==
+        pexp:= parts exp
+	pexp(nV):=0
+	directProduct(vector(pexp)$Vector(NonNegativeInteger))
+
+      exponentEntryZero?(exp,nV)==
+        pexp:= parts exp
+	zero?(pexp(nV))
+
+      replaceVarByZero(pol,nV)==
+        -- surement le collectExpon ici n'est pas necessaire  !!!!
+        zero?(pol) => 0	
+        lRep:=	toListRep pol
+        reduce("+",_
+               [monomial(p.c,p.k)$PolyRing _
+                 for p in lRep | exponentEntryZero?(p.k,nV) ],0)
+
+      replaceVarByOne(pol,nV)==
+        zero?(pol) => 0	
+        lRep:=	toListRep pol
+	reduce("+",_
+         [monomial(p.c,exponentEntryToZero(p.k,nV))$PolyRing for p in lRep],0)
+
+      homogenizeExp(exp,deg,nV)==
+        lv:List NNI:=parts(exp)
+        lv.nV:=(deg+lv.nV - reduce("+",lv)) pretend NNI
+        directProduct(vector(lv)$Vector(NNI))$E
+
+      listTerm: PolyRing -> List E
+      listTerm(pol)==
+        zero? pol => empty
+        cons( degree pol,  listTerm reductum pol )
+
+      degree( a : PolyRing , n : Integer )==
+        zero? a => error "Degree for 0 is not defined for this degree fnc"
+        "max" / [ ee.n for ee in listTerm a ]
+
+      totalDegree p ==
+         zero? p => 0
+         "max"/[reduce("+",t::(Vector NNI), 0) for t in listTerm p]
+
+      homogenize(pol,nV)==
+        degP:=totalDegree(pol)
+        mapExponents(homogenizeExp(#1,degP,nV),pol)
+
+      degOneCoef(p:PolyRing,i:PI)==
+        vv:=new(dim,0)$Vector(NNI)
+        vv.i:=1
+        pd:=directProduct(vv)$E
+	lp:=toListRep p
+        lc:=[t.c for t in lp | t.k=pd]
+        reduce("+",lc,0)
+
+      constant(p)==
+        vv:=new(dim,0)$Vector(NNI)
+        pd:=directProduct(vv)$E
+	lp:=toListRep p
+        lc:=[t.c for t in lp | t.k=pd]
+        reduce("+",lc,0)
+
+      degreeOfMinimalForm(pol)==
+        totalDegree minimalForm pol
+
+      minimalForm(pol)==
+	zero?(pol) => pol
+	lpol:=toListRep pol
+	actTerm:Term:=  first lpol
+	minDeg:NNI:=reduce("+", parts(actTerm.k))
+	actDeg:NNI
+	lminForm:List(Term):= [actTerm]
+	for p in rest(lpol) repeat
+	  actDeg:= reduce("+", parts(p.k))
+	  if actDeg = minDeg then
+	    lminForm := concat(lminForm,p)
+	  if actDeg < minDeg then
+	    minDeg:=actDeg
+	    lminForm:=[p]
+	collectExpon lminForm
+
+    -- le code de collectExponSort a ete emprunte a D. Augot.
+      
+      leadingTerm(pol)==
+        zero?(pol) => error "no leading term for 0  (message from package)"
+	lcoef:R:=leadingCoefficient(pol)$PolyRing
+	lterm:PolyRing:=leadingMonomial(pol)$PolyRing
+	tt:E:=degree(lterm)$PolyRing
+	[tt,lcoef]$Term
+	
+      toListRep(pol)==
+        zero?(pol) => empty()
+	lt:=leadingTerm pol
+	cons(lt, toListRep reductum pol)  
+
+      lA(n,l)==
+        zero?(n) => [new((l pretend NNI),0)$List(NNI)]
+	one?(l) => [[(n pretend NNI)]]
+	concat [[ concat([i],lll) for lll in lA(n-i,l-1)] for i in 0..n]
+
+      listAllMonoExp(l)==
+        lst:=lA(l,(dim pretend Integer))
+        [directProduct(vector(pexp)$Vector(NNI)) for pexp in lst]
+
+      translateMonomial(mono,pt,nV,coef)==
+        lexpE:E:= degree mono
+	lexp:List NNI:= parts lexpE
+        lexp(nV):=0 
+	trVar:=[(listVariable().i + (pt.i)::PolyRing)** lexp.i for i in 1..dim]
+        coef * reduce("*",trVar,1)
+
+      listAllMono(l)==
+        [monomial(1,e)$PolyRing for e in listAllMonoExp(l)]
+
 *)
 
 \end{chunk}
@@ -154598,9 +189287,11 @@ PadeApproximantPackage(R: Field, x:Symbol, pt:R): Exports == Implementation wher
       ++ which matches the series s to order \spad{nd + dd}.
 
    Implementation ==> add
+
      n,m : NNI
      u,v : PS
      pa := PadeApproximants(R,PS,UP)
+
      pade(n,m,u,v) ==
        ans:=pade(n,m,u,v)$pa
        ans case "failed" => ans
@@ -154611,6 +189302,7 @@ PadeApproximantPackage(R: Field, x:Symbol, pt:R): Exports == Implementation wher
        num := num(xpt)
        den := den(xpt)
        num/den
+
      pade(n,m,u) == pade(n,m,u,1)
 
 \end{chunk}
@@ -154618,6 +189310,24 @@ PadeApproximantPackage(R: Field, x:Symbol, pt:R): Exports == Implementation wher
 \begin{chunk}{COQ PADEPAC}
 (* package PADEPAC *)
 (*
+
+     n,m : NNI
+     u,v : PS
+     pa := PadeApproximants(R,PS,UP)
+
+     pade(n,m,u,v) ==
+       ans:=pade(n,m,u,v)$pa
+       ans case "failed" => ans
+       pt = 0 => ans
+       num := numer(ans::QF)
+       den := denom(ans::QF)
+       xpt : UP := monomial(1,1)-monomial(pt,0)
+       num := num(xpt)
+       den := den(xpt)
+       num/den
+
+     pade(n,m,u) == pade(n,m,u,1)
+
 *)
 
 \end{chunk}
@@ -154714,6 +189424,7 @@ PadeApproximants(R,PS,UP): Exports == Implementation where
       ++ ds (denominator series of function).
  
   Implementation ==> add
+
     -- The approximant is represented as
     --   p0 + x**a1/(p1 + x**a2/(...))
  
@@ -154819,6 +189530,107 @@ PadeApproximants(R,PS,UP): Exports == Implementation where
 \begin{chunk}{COQ PADE}
 (* package PADE *)
 (*
+
+    -- The approximant is represented as
+    --   p0 + x**a1/(p1 + x**a2/(...))
+ 
+    PadeRep ==> Record(ais: List UP, degs: List NNI) -- #ais= #degs
+    PadeU   ==> Union(PadeRep, "failed")             -- #ais= #degs+1
+ 
+    constInner(up:UP):PadeU == [[up], []]
+ 
+    truncPoly(p:UP,n:NNI):UP ==
+      while n < degree p repeat p := reductum p
+      p
+ 
+    truncSeries(s:PS,n:NNI):UP ==
+      p: UP := 0
+      for i in 0..n repeat p := p + monomial(coefficient(s,i),i)
+      p
+ 
+    -- Assumes s starts with a<n>*x**n + ... and divides out x**n.
+    divOutDegree(s:PS,n:NNI):PS ==
+      for i in 1..n repeat s := quoByVar s
+      s
+ 
+    padeNormalize: (NNI,NNI,PS,PS) -> PadeU
+    padeInner:     (NNI,NNI,PS,PS) -> PadeU
+ 
+    pade(l,m,gps,dps) ==
+      (ad := padeNormalize(l,m,gps,dps)) case "failed" => "failed"
+      plist := ad.ais; dlist := ad.degs
+      approx := first(plist) :: QF
+      for d in dlist for p in rest plist repeat
+        approx := p::QF + (monomial(1,d)$UP :: QF)/approx
+      approx
+ 
+    padecf(l,m,gps,dps) ==
+      (ad := padeNormalize(l,m,gps,dps)) case "failed" => "failed"
+      alist := reverse(ad.ais)
+      blist := [monomial(1,d)$UP for d in reverse ad.degs]
+      continuedFraction(first(alist),_
+                          blist::Stream UP,(rest alist) :: Stream UP)
+ 
+    padeNormalize(l,m,gps,dps) ==
+      zero? dps => "failed"
+      zero? gps => constInner 0
+      -- Normalize so numerator or denominator has constant term.
+      ldeg:= min(order dps,order gps)
+      if ldeg > 0 then
+        dps := divOutDegree(dps,ldeg)
+        gps := divOutDegree(gps,ldeg)
+      padeInner(l,m,gps,dps)
+ 
+    padeInner(l, m, gps, dps) ==
+      zero? coefficient(gps,0) and zero? coefficient(dps,0) =>
+        error "Pade' problem not normalized."
+      plist: List UP := nil()
+      alist: List NNI := nil()
+      -- Ensure denom has constant term.
+      if zero? coefficient(dps,0) then
+        -- g/d = 0 + z**0/(d/g)
+        (gps,dps) := (dps,gps)
+        (l,m)     := (m,l)
+        plist := concat(0,plist)
+        alist := concat(0,alist)
+      -- Ensure l >= m, maintaining coef(dps,0)^=0.
+      if l < m then
+        --   (a<n>*x**n + a<n+1>*x**n+1 + ...)/b
+        -- = x**n/b + (a<n> + a<n+1>*x + ...)/b
+        alpha := order gps
+        if alpha > l then return "failed"
+        gps := divOutDegree(gps, alpha)
+        (l,m) := (m,(l-alpha) :: NNI)
+        (gps,dps) := (dps,gps)
+        plist := concat(0,plist)
+        alist := concat(alpha,alist)
+      degbd: NNI := l + m + 1
+      g := truncSeries(gps,degbd)
+      d := truncSeries(dps,degbd)
+      for j in 0.. repeat
+        -- Normalize d so constant coefs cancel. (B&G-M is wrong)
+        d0 := coefficient(d,0)
+        d := (1/d0) * d; g := (1/d0) * g
+        p : UP := 0; s := g
+        if l-m+1 < 0 then error "Internal pade error"
+        degbd := (l-m+1) :: NNI
+        for k in 1..degbd repeat
+          pk := coefficient(s,0)
+          p  := p + monomial(pk,(k-1) :: NNI)
+          s  := s - pk*d
+          s  := (s exquo monomial(1,1)) :: UP
+        plist := concat(p,plist)
+        s = 0 => return [plist,alist]
+        alpha := minimumDegree(s) + degbd
+        alpha > l + m => return [plist,alist]
+        alpha > l     => return "failed"
+        alist := concat(alpha,alist)
+        h := (s exquo monomial(1,minimumDegree s)) :: UP
+        degbd := (l + m - alpha) :: NNI
+        g := truncPoly(d,degbd)
+        d := truncPoly(h,degbd)
+        (l,m) := (m,(l-alpha) :: NNI)
+
 *)
 
 \end{chunk}
@@ -154959,6 +189771,7 @@ PAdicWildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where
       ++ reducedDiscriminant(up) \undocumented
 
   Implementation ==> add
+
     import IntegralBasisTools(R, UP, F)
     import GeneralHenselPackage(R,UP)
     import ModularHermitianRowReduction(R)
@@ -155063,7 +189876,8 @@ PAdicWildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where
         [(f.factor) **((f.exponent) :: NNI) for f in factorListSAE]
       -- lift these factors to elements of UP
       primaries : List UP :=
-        [mapUnivariate(lift,ff)$IBPTOOLS(R,UP,SUP UP,sae) for ff in redPrimaries]
+        [mapUnivariate(lift,ff)$IBPTOOLS(R,UP,SUP UP,sae)_
+          for ff in redPrimaries]
       -- lift the factors to factors modulo a suitable power of 'prime'
       deg := (1 + order(redDisc,prime) * degree(prime)) :: PI
       henselInfo := HenselLift(p,primaries,prime,deg)
@@ -155078,7 +189892,7 @@ PAdicWildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where
           compLocalBasis(qq,prime)
         factorBases := concat(base,factorBases)
       factorBases := reverse_! factorBases
-      ib := chineseRemainder(henselFactors,factorBases,rank()$F)$IBACHIN(K,R,UP)
+      ib:= chineseRemainder(henselFactors,factorBases,rank()$F)$IBACHIN(K,R,UP)
       index := diagonalProduct(ib.basisInv)
       [ib.basis,ib.basisDen,ib.basisInv,disc quo (index * index)]
 
@@ -155128,6 +189942,172 @@ PAdicWildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where
 \begin{chunk}{COQ PWFFINTB}
 (* package PWFFINTB *)
 (*
+
+    import IntegralBasisTools(R, UP, F)
+    import GeneralHenselPackage(R,UP)
+    import ModularHermitianRowReduction(R)
+    import TriangularMatrixOperations(R, Vector R, Vector R, Matrix R)
+
+    reducedDiscriminant f ==
+      ff : SUP Q := mapUnivariate((r1:R):Q+->r1 :: Q,f)$IBPTOOLS(R,UP,SUP UP,Q)
+      ee := extendedEuclidean(ff,differentiate ff)
+      cc := concat(coefficients(ee.coef1),coefficients(ee.coef2))
+      cden := splitDenominator(cc)$CDEN(R,Q,L Q)
+      denom := cden.den
+      gg := gcd map(numer,cden.num)$L2(Q,R)
+      (ans := denom exquo gg) case "failed" =>
+        error "PWFFINTB: error in reduced discriminant computation"
+      ans :: R
+
+    compLocalBasis: (UP,R) -> Result
+    compLocalBasis(poly,prime) ==
+      -- compute a local integral basis at 'prime' for k[x,y]/(poly(x,y)).
+      sae := SAE(R,UP,poly)
+      localIntegralBasis(prime)$WFFINTBS(K,R,UP,sae)
+
+    compLocalBasisOverExt: (UP,R,UP,NNI) -> Result
+    compLocalBasisOverExt(poly0,prime0,irrPoly0,k) ==
+      -- poly0 = irrPoly0**k (mod prime0)
+      n := degree poly0; disc0 := discriminant poly0
+      (disc0 exquo prime0) case "failed" =>
+        [scalarMatrix(n,1), 1, scalarMatrix(n,1)]
+      r := degree irrPoly0
+      -- extend scalars:
+      -- construct irreducible polynomial of degree r over K
+      irrPoly := generateIrredPoly(r :: PI)$IRREDFFX(K)
+      -- construct extension of degree r over K
+      E := SAE(K,SUP K,irrPoly)
+      -- lift coefficients to elements of E
+      poly := mapBivariate((k1:K):E +-> k1::E,poly0)$IBPTOOLS(K,R,UP,E)
+      redDisc0 := reducedDiscriminant poly0
+      redDisc := mapUnivariate((k1:K):E +-> k1::E,redDisc0)$IBPTOOLS(K,R,UP,E)
+      prime := mapUnivariate((k1:K):E +-> k1::E,prime0)$IBPTOOLS(K,R,UP,E)
+      sae := SAE(E,SUP E,prime)
+      -- reduction (mod prime) of polynomial of which poly is the kth power
+      redIrrPoly :=
+        pp := mapBivariate((k1:K):E +-> k1::E,irrPoly0)$IBPTOOLS(K,R,UP,E)
+        mapUnivariate(reduce,pp)$IBPTOOLS(SUP E,SUP SUP E,SUP SUP SUP E,sae)
+      -- factor the reduction
+      factorListSAE := factors factor(redIrrPoly)$DDFACT(sae,SUP sae)
+      -- list the 'primary factors' of the reduction of poly
+      redFactors : List SUP sae := [(f.factor)**k for f in factorListSAE]
+      -- lift these factors to elements of SUP SUP E
+      primaries : List SUP SUP E :=
+        [mapUnivariate(lift,ff)$IBPTOOLS(SUP E,SUP SUP E,SUP SUP SUP E,sae) _
+             for ff in redFactors]
+      -- lift the factors to factors modulo a suitable power of 'prime'
+      deg := (1 + order(redDisc,prime) * degree(prime)) :: PI
+      henselInfo := HenselLift(poly,primaries,prime,deg)$GHEN(SUP E,SUP SUP E)
+      henselFactors := henselInfo.plist
+      psi1 := first henselFactors
+      FF := SAE(SUP E,SUP SUP E,psi1)
+      factorIb := localIntegralBasis(prime)$WFFINTBS(E,SUP E,SUP SUP E,FF)
+      bs := listConjugateBases(factorIb,size()$K,r)$IBACHIN(E,SUP E,SUP SUP E)
+      ib := chineseRemainder(henselFactors,bs,n)$IBACHIN(E,SUP E,SUP SUP E)
+      b : Matrix R :=
+        bas := mapMatrixIfCan(retractIfCan,ib.basis)$IBPTOOLS(K,R,UP,E)
+        bas case "failed" => error "retraction of basis failed"
+        bas :: Matrix R
+      bInv : Matrix R :=
+        --bas := mapMatrixIfCan(ric,ib.basisInv)$IBPTOOLS(K,R,UP,E)
+        bas := mapMatrixIfCan(retractIfCan,ib.basisInv)$IBPTOOLS(K,R,UP,E)
+        bas case "failed" => error "retraction of basis inverse failed"
+        bas :: Matrix R
+      bDen : R :=
+        p := mapUnivariateIfCan(retractIfCan,ib.basisDen)$IBPTOOLS(K,R,UP,E)
+        p case "failed" => error "retraction of basis denominator failed"
+        p :: R
+      [b,bDen,bInv]
+
+    padicLocalIntegralBasis: (UP,R,R,R) -> IResult
+    padicLocalIntegralBasis(p,disc,redDisc,prime) ==
+      -- polynomials in x modulo 'prime'
+      sae := SAE(K,R,prime)
+      -- find the factorization of 'p' modulo 'prime' and lift the
+      -- prime powers to elements of UP:
+      -- reduce 'p' modulo 'prime'
+      reducedP := mapUnivariate(reduce,p)$IBPTOOLS(R,UP,SUP UP,sae)
+      -- factor the reduced polynomial
+      factorListSAE := factors factor(reducedP)$DDFACT(sae,SUP sae)
+      -- if only one prime factor, perform usual integral basis computation
+      (# factorListSAE) = 1 =>
+        ib := localIntegralBasis(prime)$WFFINTBS(K,R,UP,F)
+        index := diagonalProduct(ib.basisInv)
+        [ib.basis,ib.basisDen,ib.basisInv,disc quo (index * index)]
+      -- list the 'prime factors' of the reduced polynomial
+      redPrimes : List SUP sae :=
+        [f.factor for f in factorListSAE]
+      -- lift these factors to elements of UP
+      primes : List UP :=
+        [mapUnivariate(lift,ff)$IBPTOOLS(R,UP,SUP UP,sae) for ff in redPrimes]
+      -- list the exponents
+      expons : List NNI := [((f.exponent) :: NNI) for f in factorListSAE]
+      -- list the 'primary factors' of the reduced polynomial
+      redPrimaries : List SUP sae :=
+        [(f.factor) **((f.exponent) :: NNI) for f in factorListSAE]
+      -- lift these factors to elements of UP
+      primaries : List UP :=
+        [mapUnivariate(lift,ff)$IBPTOOLS(R,UP,SUP UP,sae)_
+          for ff in redPrimaries]
+      -- lift the factors to factors modulo a suitable power of 'prime'
+      deg := (1 + order(redDisc,prime) * degree(prime)) :: PI
+      henselInfo := HenselLift(p,primaries,prime,deg)
+      henselFactors := henselInfo.plist
+      -- compute integral bases for the factors
+      factorBases : List Result := empty(); degPrime := degree prime
+      for pp in primes for k in expons for qq in henselFactors repeat
+        base :=
+          degPp := degree pp
+          degPp > 1 and gcd(degPp,degPrime) = 1 =>
+            compLocalBasisOverExt(qq,prime,pp,k)
+          compLocalBasis(qq,prime)
+        factorBases := concat(base,factorBases)
+      factorBases := reverse_! factorBases
+      ib:= chineseRemainder(henselFactors,factorBases,rank()$F)$IBACHIN(K,R,UP)
+      index := diagonalProduct(ib.basisInv)
+      [ib.basis,ib.basisDen,ib.basisInv,disc quo (index * index)]
+
+    localIntegralBasis prime ==
+      p := definingPolynomial()$F; disc := discriminant p
+      --disc := determinant traceMatrix()$F
+      redDisc := reducedDiscriminant p
+      ib := padicLocalIntegralBasis(p,disc,redDisc,prime)
+      [ib.basis,ib.basisDen,ib.basisInv]
+
+    listSquaredFactors: R -> List R
+    listSquaredFactors px ==
+      -- returns a list of the factors of px which occur with
+      -- exponent > 1
+      ans : List R := empty()
+      factored := factor(px)$DistinctDegreeFactorize(K,R)
+      for f in factors(factored) repeat
+        if f.exponent > 1 then ans := concat(f.factor,ans)
+      ans
+
+    integralBasis() ==
+      p := definingPolynomial()$F; disc := discriminant p; n := rank()$F
+      --traceMat := traceMatrix()$F; n := rank()$F
+      --disc := determinant traceMat        -- discriminant of current order
+      singList := listSquaredFactors disc -- singularities of relative Spec
+      redDisc := reducedDiscriminant p
+      runningRb := runningRbinv := scalarMatrix(n,1)$Mat
+      -- runningRb    = basis matrix of current order
+      -- runningRbinv = inverse basis matrix of current order
+      -- these are wrt the original basis for F
+      runningRbden : R := 1
+      -- runningRbden = denominator for current basis matrix
+      empty? singList => [runningRb, runningRbden, runningRbinv]
+      for prime in singList repeat
+        lb := padicLocalIntegralBasis(p,disc,redDisc,prime)
+        rb := lb.basis; rbinv := lb.basisInv; rbden := lb.basisDen
+        disc := lb.discr
+        mat := vertConcat(rbden * runningRb,runningRbden * rb)
+        runningRbden := runningRbden * rbden
+        runningRb := squareTop rowEchelon(mat,runningRbden)
+        --runningRb := squareTop rowEch mat
+        runningRbinv := UpTriBddDenomInv(runningRb,runningRbden)
+      [runningRb, runningRbden, runningRbinv]
+
 *)
 
 \end{chunk}
@@ -155226,6 +190206,22 @@ ParadoxicalCombinatorsForStreams(A):Exports == Implementation where
 \begin{chunk}{COQ YSTREAM}
 (* package YSTREAM *)
 (*
+ 
+    Y f ==
+      y : ST A := CONS(0$I,0$I)$Lisp
+      j := f y
+      RPLACA(y,frst j)$Lisp
+      RPLACD(y,rst j)$Lisp
+      y
+ 
+    Y(g,n) ==
+      x : L ST A := [CONS(0$I,0$I)$Lisp for i in 1..n]
+      j := g x
+      for xi in x for ji in j repeat
+        RPLACA(xi,frst ji)$Lisp
+        RPLACD(xi,rst ji)$Lisp
+      x
+
 *)
 
 \end{chunk}
@@ -155658,6 +190654,7 @@ ParametricLinearEquations(R,Var,Expon,GR):
       for p in pl repeat
         ground? p => return true
       false
+
     inconsistent?(pl:L PR):Boolean ==
       for p in pl repeat
         ground? p => return true
@@ -155735,7 +190732,6 @@ ParametricLinearEquations(R,Var,Expon,GR):
 
     bsolve (coeff, w, h, outname, mode) ==
       r:=nrows coeff
---    n:=ncols coeff
       r ^= #w => error "number of rows unequal on lhs and rhs"
       newfile:FNAME
       rksoln:File Rec3
@@ -155796,11 +190792,7 @@ ParametricLinearEquations(R,Var,Expon,GR):
             p:GR:= redPol$rp (rc.det, zro)
             p = 0 => "incompatible or covered subdeterminant"
             test:=hasoln(zro, [rc.det])
---          zroideal:=ideal(zro)
---          inRadical? (p, zroideal) => "incompatible or covered"
             ^test.sysok => "incompatible or covered"
--- The next line is WRONG! cannot replace zro by test.z0
---          zro:=groebner$gb (cons(*/test.n0, test.z0))
             zro:=groebner$gb (cons(p,zro))
             npc:=cons(rc,npc)
             done:= covered:= inconsistent? zro
@@ -155848,22 +190840,28 @@ ParametricLinearEquations(R,Var,Expon,GR):
 
     psolve (mat:M GR, w:L GR): L Rec3 ==
       bsolve(mat, dmp2rfi w, 1, "nofile", 1).rgl
+
     psolve (mat:M GR, w:L Symbol): L Rec3 ==
       bsolve(mat,  se2rfi w, 1, "nofile", 2).rgl
+
     psolve (mat:M GR): L Rec3 ==
       bsolve(mat, [0$GF for i in 1..nrows mat], 1, "nofile", 3).rgl
 
     psolve (mat:M GR, w:L GR, h:PI): L Rec3 ==
       bsolve(mat, dmp2rfi w, h::NNI, "nofile", 4).rgl
+
     psolve (mat:M GR, w:L Symbol, h:PI): L Rec3 ==
       bsolve(mat, se2rfi w, h::NNI, "nofile", 5).rgl
+
     psolve (mat:M GR, h:PI): L Rec3 ==
       bsolve(mat, [0$GF for i in 1..nrows mat], h::NNI, "nofile", 6).rgl
 
     psolve (mat:M GR, w:L GR, outname:S): I ==
       bsolve(mat, dmp2rfi w, 1, outname, 7).rgsz
+
     psolve (mat:M GR, w:L Symbol, outname:S): I ==
       bsolve(mat, se2rfi w, 1, outname, 8).rgsz
+
     psolve (mat:M GR, outname:S): I ==
       bsolve(mat, [0$GF for i in 1..nrows mat], 1, outname, 9).rgsz
 
@@ -155901,8 +190899,6 @@ ParametricLinearEquations(R,Var,Expon,GR):
       nzro:=[p for p in nzro | ^(ground? p)]
       [true, zro, nzro]
 
-
-
     se2rfi w == [coerce$GF monomial$PR (1$PR, wi, 1) for wi in w]
 
     pr2dmp p ==
@@ -155913,7 +190909,6 @@ ParametricLinearEquations(R,Var,Expon,GR):
       newfile:FNAME:=new$FNAME ("",outname,"regime")
       rksoln: File Rec3:=open$(File Rec3) newfile
       count:I:=0  -- number of distinct regimes
---      rec3: Rec3
       for rec3 in lrec3 repeat
           write_!(rksoln, rec3)
           count:=count+1
@@ -155950,7 +190945,6 @@ ParametricLinearEquations(R,Var,Expon,GR):
 
     sqfree p == */[j.factor for j in factors(squareFree p)]
 
-
     ParCond (mat, k) ==
       k = 0 => [[1, [], []]$Rec]
       j:NNI:=k::NNI
@@ -155971,14 +190965,11 @@ ParametricLinearEquations(R,Var,Expon,GR):
       found => [first DetEqn]$Eqns
       sort((z1:Rec,z2:Rec):Boolean +-> degree z1.det < degree z2.det, DetEqn)
 
-
-
     overset?(p,qlist) ==
       empty? qlist => false
       or/[(brace$(Set GR) q) <$(Set GR) (brace$(Set GR) p) _
                                                 for q in qlist]
 
-
     redmat (mat,psb) ==
       i,j:I
       r:=nrows(mat)
@@ -155996,6 +190987,339 @@ ParametricLinearEquations(R,Var,Expon,GR):
 \begin{chunk}{COQ PLEQN}
 (* package PLEQN *)
 (*
+
+    inconsistent?(pl:L GR):Boolean ==
+      for p in pl repeat
+        ground? p => return true
+      false
+
+    inconsistent?(pl:L PR):Boolean ==
+      for p in pl repeat
+        ground? p => return true
+      false
+
+    B1solve (sys:Linsys):Linsoln ==
+      i,j,i1,j1:I
+      rss:L I:=sys.rows
+      nss:L I:=sys.cols
+      k:=sys.rank
+      cmat:M GF:=sys.mat
+      n:=ncols cmat
+      frcols:L I:=setDifference$(L I) (expand$(SEG I) (1..n), nss)
+      w:L GF:=sys.vec
+      p:V GF:=new(n,0)
+      pbas:L V GF:=[]
+      if k ^= 0 then
+        augmat:M GF:=zero(k,n+1)
+        for i in rss for i1 in 1.. repeat
+          for j in nss for j1 in 1.. repeat
+            augmat(i1,j1):=cmat(i,j)
+          for j in frcols for j1 in k+1.. repeat
+            augmat(i1,j1):=-cmat(i,j)
+          augmat(i1,n+1):=w.i
+        augmat:=rowEchelon$(M GF) augmat
+        for i in nss for i1 in 1.. repeat p.i:=augmat(i1,n+1)
+        for j in frcols for j1 in k+1.. repeat
+          pb:V GF:=new(n,0)
+          pb.j:=1
+          for i in nss for i1 in 1.. repeat
+            pb.i:=augmat(i1,j1)
+          pbas:=cons(pb,pbas)
+      else
+        for j in frcols for j1 in k+1.. repeat
+          pb:V GF:=new(n,0)
+          pb.j:=1
+          pbas:=cons(pb,pbas)
+      [p,pbas]
+
+    regime (y, coef, w, psbf, rk, rkmax, mode) ==
+      i,j:I
+      -- use the y.det nonzero to simplify the groebner basis
+      -- of ideal generated by higher order subdeterminants
+      ydetf:L GR:=factorset y.det
+      yzero:L GR:=
+        rk = rkmax => nil$(L GR)
+        psbf:=[setDifference(x, ydetf) for x in psbf]
+        groebner$gb [*/x for x in psbf]
+      -- simplify coefficients by modulo ideal
+      nc:M GF:=dmp2rfi redmat(coef,yzero)
+      -- solve the system
+      rss:L I:=y.rows;  nss:L I :=y.cols
+      sys:Linsys:=[nc,w,rk,rss,nss]$Linsys
+      pps:= B1solve(sys)
+      pp:=pps.partsol
+      frows:L I:=setDifference$(L I) (expand$(SEG I) (1..nrows coef),rss)
+      wcd:L PR:= []
+      -- case homogeneous rhs
+      entry? (mode, [3,6,9,12]$(L I)) =>
+               [yzero, ydetf,wcd, redpps(pps, yzero)]$Rec3
+      -- case arbitrary rhs, pps not reduced
+      for i in frows repeat
+          weqn:GF:=+/[nc(i,j)*(pp.j) for j in nss]
+          wnum:PR:=numer$GF (w.i - weqn)
+          wnum = 0 => "trivially satisfied"
+          ground? wnum => return [yzero, ydetf,[1$PR]$(L PR),pps]$Rec3
+          wcd:=cons(wnum,wcd)
+      entry? (mode, [2,5,8,11]$(L I)) => [yzero, ydetf, wcd, pps]$Rec3
+      -- case no new rhs variable
+      if not empty? wcd then _
+        yzero:=removeDuplicates append(yzero,[pr2dmp pw for pw in wcd])
+      test:Rec8:=hasoln (yzero, ydetf)
+      not test.sysok => [test.z0, test.n0, [1$PR]$(L PR), pps]$Rec3
+      [test.z0, test.n0, [], redpps(pps, test.z0)]$Rec3
+
+    bsolve (coeff, w, h, outname, mode) ==
+      r:=nrows coeff
+      r ^= #w => error "number of rows unequal on lhs and rhs"
+      newfile:FNAME
+      rksoln:File Rec3
+      count:I:=0
+      lrec3:L Rec3:=[]
+      filemode:Boolean:= entry? (mode, [7,8,9,10,11,12]$(L I))
+      if filemode then
+        newfile:=new$FNAME  ("",outname,"regime")
+        rksoln:=open$(File Rec3) newfile
+      y:Rec
+      k:NNI
+      rrcl:RankConds:=
+        entry? (mode,[1,2,3,7,8,9]$(L I)) => ParCondList (coeff,0)
+        entry? (mode,[4,5,6,10,11,12]$(L I)) => ParCondList (coeff,h)
+      rkmax:=maxrank rrcl
+      rkmin:=minrank rrcl
+      for k in rkmax-rkmin+1..1 by -1 repeat
+        rk:=rrcl.k.rank
+        pc:Eqns:=rrcl.k.eqns
+        psb:Fgb:= (if rk=rkmax then [] else rrcl.(k+1).fgb)
+        psbf:L L GR:= [factorset x for x in psb]
+        psbf:= minset(psbf)
+        for y in pc repeat
+          rec3:Rec3:= regime (y, coeff, w, psbf, rk, rkmax, mode)
+          inconsistent? rec3.wcond => "incompatible system"
+          if filemode then write_!(rksoln, rec3)
+          else lrec3:= cons(rec3, lrec3)
+          count:=count+1
+      if filemode then close_! rksoln
+      [lrec3, count]$Ranksolns
+
+    factorset y ==
+      ground? y => []
+      [j.factor for j in factors(factor$mf y)]
+
+    ParCondList (mat, h) ==
+      rcl: RankConds:= []
+      ps: L GR:=[]
+      pc:Eqns:=[]
+      npc: Eqns:=[]
+      psbf: Fgb:=[]
+      rc: Rec
+      done: Boolean := false
+      r:=nrows mat
+      n:=ncols mat
+      maxrk:I:=min(r,n)
+      k:NNI
+      for k in min(r,n)..h by -1 until done repeat
+        pc:= ParCond(mat,k)
+        npc:=[]
+        (empty? pc) and (k >= 1) => maxrk:= k - 1
+        if ground? pc.1.det -- only one is sufficient (neqzro = {})
+        then (npc:=pc; done:=true; ps := [1$GR])
+        else
+          zro:L GR:= (if k = maxrk then [] else rcl.1.fgb)
+          covered:Boolean:=false
+          for rc in pc until covered repeat
+            p:GR:= redPol$rp (rc.det, zro)
+            p = 0 => "incompatible or covered subdeterminant"
+            test:=hasoln(zro, [rc.det])
+            ^test.sysok => "incompatible or covered"
+            zro:=groebner$gb (cons(p,zro))
+            npc:=cons(rc,npc)
+            done:= covered:= inconsistent? zro
+          ps:=zro
+        pcl: Rec2:= construct(k,npc,ps)
+        rcl:=cons(pcl,rcl)
+      rcl
+
+    redpps(pps, zz) ==
+      pv:=pps.partsol
+      r:=#pv
+      pb:=pps.basis
+      n:=#pb + 1
+      nummat:M GR:=zero(r,n)
+      denmat:M GR:=zero(r,n)
+      for i in  1..r repeat
+        nummat(i,1):=pr2dmp numer$GF pv.i
+        denmat(i,1):=pr2dmp denom$GF pv.i
+      for j in 2..n repeat
+        for i in 1..r  repeat
+          nummat(i,j):=pr2dmp numer$GF (pb.(j-1)).i
+          denmat(i,j):=pr2dmp denom$GF (pb.(j-1)).i
+      nummat:=redmat(nummat, zz)
+      denmat:=redmat(denmat, zz)
+      for i in 1..r repeat
+        pv.i:=(dmp2rfi nummat(i,1))/(dmp2rfi denmat(i,1))
+      for j in 2..n repeat
+        pbj:V GF:=new(r,0)
+        for i in 1..r repeat
+          pbj.i:=(dmp2rfi nummat(i,j))/(dmp2rfi  denmat(i,j))
+        pb.(j-1):=pbj
+      [pv, pb]
+
+    dmp2rfi (mat:M GR): M GF ==
+      r:=nrows mat
+      n:=ncols mat
+      nmat:M GF:=zero(r,n)
+      for i in 1..r repeat
+        for j in 1..n repeat
+          nmat(i,j):=dmp2rfi mat(i,j)
+      nmat
+
+    dmp2rfi (vl: L GR):L GF ==
+      [dmp2rfi v for v in vl]
+
+    psolve (mat:M GR, w:L GR): L Rec3 ==
+      bsolve(mat, dmp2rfi w, 1, "nofile", 1).rgl
+
+    psolve (mat:M GR, w:L Symbol): L Rec3 ==
+      bsolve(mat,  se2rfi w, 1, "nofile", 2).rgl
+
+    psolve (mat:M GR): L Rec3 ==
+      bsolve(mat, [0$GF for i in 1..nrows mat], 1, "nofile", 3).rgl
+
+    psolve (mat:M GR, w:L GR, h:PI): L Rec3 ==
+      bsolve(mat, dmp2rfi w, h::NNI, "nofile", 4).rgl
+
+    psolve (mat:M GR, w:L Symbol, h:PI): L Rec3 ==
+      bsolve(mat, se2rfi w, h::NNI, "nofile", 5).rgl
+
+    psolve (mat:M GR, h:PI): L Rec3 ==
+      bsolve(mat, [0$GF for i in 1..nrows mat], h::NNI, "nofile", 6).rgl
+
+    psolve (mat:M GR, w:L GR, outname:S): I ==
+      bsolve(mat, dmp2rfi w, 1, outname, 7).rgsz
+
+    psolve (mat:M GR, w:L Symbol, outname:S): I ==
+      bsolve(mat, se2rfi w, 1, outname, 8).rgsz
+
+    psolve (mat:M GR, outname:S): I ==
+      bsolve(mat, [0$GF for i in 1..nrows mat], 1, outname, 9).rgsz
+
+    nextSublist (n,k) ==
+      n <= 0 => []
+      k <= 0 => [ nil$(List Integer) ]
+      k > n => []
+      n = 1 and k = 1 => [[1]]
+      mslist: L L I:=[]
+      for ms in nextSublist(n-1,k-1) repeat
+        mslist:=cons(append(ms,[n]),mslist)
+      append(nextSublist(n-1,k), mslist)
+
+    psolve (mat:M GR, w:L GR, h:PI, outname:S): I ==
+      bsolve(mat, dmp2rfi w, h::NNI, outname, 10).rgsz
+    psolve (mat:M GR, w:L Symbol, h:PI, outname:S): I ==
+      bsolve(mat, se2rfi w, h::NNI, outname, 11).rgsz
+    psolve (mat:M GR, h:PI, outname:S): I ==
+      bsolve(mat,[0$GF for i in 1..nrows mat],h::NNI,outname, 12).rgsz
+
+    hasoln (zro,nzro) ==
+      empty? zro => [true, zro, nzro]
+      zro:=groebner$gb zro
+      inconsistent? zro => [false, zro, nzro]
+      empty? nzro =>[true, zro, nzro]
+      pnzro:GR:=redPol$rp (*/nzro, zro)
+      pnzro = 0 => [false, zro, nzro]
+      nzro:=factorset pnzro
+      psbf:L L GR:= minset [factorset p for p in zro]
+      psbf:= [setDifference(x, nzro) for x in psbf]
+      entry? ([], psbf) => [false, zro, nzro]
+      zro:=groebner$gb [*/x for x in psbf]
+      inconsistent? zro => [false, zro, nzro]
+      nzro:=[redPol$rp (p,zro) for p in nzro]
+      nzro:=[p for p in nzro | ^(ground? p)]
+      [true, zro, nzro]
+
+    se2rfi w == [coerce$GF monomial$PR (1$PR, wi, 1) for wi in w]
+
+    pr2dmp p ==
+      ground? p => (ground p)::GR
+      algCoerceInteractive(p,PR,GR)$(Lisp) pretend GR
+
+    wrregime (lrec3, outname) ==
+      newfile:FNAME:=new$FNAME ("",outname,"regime")
+      rksoln: File Rec3:=open$(File Rec3) newfile
+      count:I:=0  -- number of distinct regimes
+      for rec3 in lrec3 repeat
+          write_!(rksoln, rec3)
+          count:=count+1
+      close_!(rksoln)
+      count
+
+    dmp2rfi (p:GR):GF ==
+      map$plift ((v1:Var):GF +-> (convert v1)@Symbol::GF, 
+                 (r1:R):GF +-> r1::PR::GF, p)
+
+
+    rdregime inname ==
+      infilename:=filename$FNAME ("",inname, "regime")
+      infile: File Rec3:=open$(File Rec3) (infilename, "input")
+      rksoln:L Rec3:=[]
+      rec3:Union(Rec3, "failed"):=readIfCan_!$(File Rec3) (infile)
+      while rec3 case Rec3 repeat
+        rksoln:=cons(rec3::Rec3,rksoln) -- replace : to :: for AIX
+        rec3:=readIfCan_!$(File Rec3) (infile)
+      close_!(infile)
+      rksoln
+
+    maxrank rcl ==
+      empty? rcl => 0
+      "max"/[j.rank for j in rcl]
+
+    minrank rcl ==
+      empty? rcl => 0
+      "min"/[j.rank for j in rcl]
+
+    minset lset ==
+      empty? lset => lset
+      [x for x in lset | ^(overset?(x,lset))]
+
+    sqfree p == */[j.factor for j in factors(squareFree p)]
+
+    ParCond (mat, k) ==
+      k = 0 => [[1, [], []]$Rec]
+      j:NNI:=k::NNI
+      DetEqn :Eqns := []
+      r:I:= nrows(mat)
+      n:I:= ncols(mat)
+      k > min(r,n) => error "k exceeds maximum possible rank "
+      found:Boolean:=false
+      for rss in nextSublist(r, k) until found repeat
+        for nss in nextSublist(n, k) until found repeat
+          matsub := mat(rss, nss) pretend SM(j, GR)
+          detmat := determinant(matsub)
+          if detmat ^= 0 then
+            found:= (ground? detmat)
+            detmat:=sqfree detmat
+            neweqn:Rec:=construct(detmat,rss,nss)
+            DetEqn:=cons(neweqn, DetEqn)
+      found => [first DetEqn]$Eqns
+      sort((z1:Rec,z2:Rec):Boolean +-> degree z1.det < degree z2.det, DetEqn)
+
+    overset?(p,qlist) ==
+      empty? qlist => false
+      or/[(brace$(Set GR) q) <$(Set GR) (brace$(Set GR) p) _
+                                                for q in qlist]
+
+    redmat (mat,psb) ==
+      i,j:I
+      r:=nrows(mat)
+      n:=ncols(mat)
+      newmat: M GR:=zero(r,n)
+      for i in 1..r repeat
+        for j in 1..n repeat
+          p:GR:=mat(i,j)
+          ground? p => newmat(i,j):=p
+          newmat(i,j):=redPol$rp (p,psb)
+      newmat
+
 *)
 
 \end{chunk}
@@ -156058,6 +191382,7 @@ ParametricPlaneCurveFunctions2(CF1: Type, CF2:Type): with
   map: (CF1 -> CF2, ParametricPlaneCurve(CF1)) -> ParametricPlaneCurve(CF2)
     ++ map(f,x) \undocumented
  == add
+
   map(f, c) == curve(f coordinate(c,1), f coordinate(c, 2))
 
 \end{chunk}
@@ -156065,6 +191390,9 @@ ParametricPlaneCurveFunctions2(CF1: Type, CF2:Type): with
 \begin{chunk}{COQ PARPC2}
 (* package PARPC2 *)
 (*
+
+  map(f, c) == curve(f coordinate(c,1), f coordinate(c, 2))
+
 *)
 
 \end{chunk}
@@ -156127,6 +191455,7 @@ ParametricSpaceCurveFunctions2(CF1: Type, CF2:Type): with
   map: (CF1 -> CF2, ParametricSpaceCurve(CF1)) -> ParametricSpaceCurve(CF2)
     ++ map(f,x) \undocumented
  == add
+
   map(f, c) == curve(f coordinate(c,1), f coordinate(c,2), f coordinate(c,3))
 
 \end{chunk}
@@ -156134,6 +191463,9 @@ ParametricSpaceCurveFunctions2(CF1: Type, CF2:Type): with
 \begin{chunk}{COQ PARSC2}
 (* package PARSC2 *)
 (*
+
+  map(f, c) == curve(f coordinate(c,1), f coordinate(c,2), f coordinate(c,3))
+
 *)
 
 \end{chunk}
@@ -156196,6 +191528,7 @@ ParametricSurfaceFunctions2(CF1: Type, CF2:Type): with
   map: (CF1 -> CF2, ParametricSurface(CF1)) -> ParametricSurface(CF2)
     ++ map(f,x) \undocumented
  == add
+
   map(f, c) == surface(f coordinate(c,1), f coordinate(c,2), f coordinate(c,3))
 
 \end{chunk}
@@ -156203,6 +191536,9 @@ ParametricSurfaceFunctions2(CF1: Type, CF2:Type): with
 \begin{chunk}{COQ PARSU2}
 (* package PARSU2 *)
 (*
+
+  map(f, c) == surface(f coordinate(c,1), f coordinate(c,2), f coordinate(c,3))
+
 *)
 
 \end{chunk}
@@ -156335,11 +191671,44 @@ ParametrizationPackage(K,symb,PolyRing,E,ProjPt,PCS,Plc):Exp == Impl where
     parametrize(f:PolyRing,pt:Plc,n:Integer)==
       s:=parametrize(f,pt)
       shift(s,n)
+
 \end{chunk}
 
 \begin{chunk}{COQ PARAMP}
 (* package PARAMP *)
 (*
+
+    import PCS
+    import PolyRing
+    
+    -- the following returns the parametrization in term of 
+    -- the precomputed local parametrization
+    -- of the point pt. Note if pl is a place and pl = pt::PLc then 
+    -- parametrize(f,pt) <> parametrize(pl) unless pt is a simple point
+    parametrize(f:PolyRing,localPar:List(PCS))==
+      zero?(f) => 0
+      lc:K:=leadingCoefficient(f)
+      ld:E:=degree f
+      ldp:List NonNegativeInteger :=parts(ld)
+      if empty?(localPar) then error _
+              "the parametrization of the place or leaf has not been done yet!"
+      monoPar:PCS:=reduce("*",[ s**e for s in localPar for e in ldp])
+      lc* monoPar + parametrize(reductum(f),localPar)
+ 
+    parametrize(f:PolyRing,pt:Plc)==
+      zero?(f) => 0
+      localPar:List PCS:=localParam pt
+      parametrize(f,localPar)
+      
+    parametrize(f:PolyRing,g:PolyRing,pt:Plc)==
+      sf:=parametrize(f,pt)
+      sg:=parametrize(g,pt)
+      sf * inv sg
+
+    parametrize(f:PolyRing,pt:Plc,n:Integer)==
+      s:=parametrize(f,pt)
+      shift(s,n)
+
 *)
 
 \end{chunk}
@@ -156498,6 +191867,7 @@ PartialFractionPackage(R): Cat == Capsule where
       ++ whose factored denominator is facdenom with respect to the 
       ++ variable var.
   Capsule == add
+
     partialFraction(rf, v) ==
       df := factor(denom rf)$MultivariateFactorize(Symbol, INDE,R,PR)
       partialFraction(numer rf, df, v)
@@ -156523,6 +191893,27 @@ PartialFractionPackage(R): Cat == Capsule where
 \begin{chunk}{COQ PFRPAC}
 (* package PFRPAC *)
 (*
+
+    partialFraction(rf, v) ==
+      df := factor(denom rf)$MultivariateFactorize(Symbol, INDE,R,PR)
+      partialFraction(numer rf, df, v)
+
+    makeSup(p:Polynomial R, v:Symbol) : SparseUnivariatePolynomial FPR ==
+      up := univariate(p,v)
+      map((z1:PR):FPR +-> z1::FPR,up)_
+        $UnivariatePolynomialCategoryFunctions2(PR, SUP PR, FPR, SUP FPR)
+
+    partialFraction(p, facq, v) ==
+      up := UnivariatePolynomial(v, Fraction Polynomial R)
+      fup := Factored up
+      ffact : List(Record(irr:up,pow:Integer))
+      ffact:=[[makeSup(u.factor,v) pretend up,u.exponent]
+                   for u in factors facq]
+      fcont:=makeSup(unit facq,v) pretend up
+      nflist:fup := fcont*(*/[primeFactor(ff.irr,ff.pow) for ff in ffact])
+      pfup:=partialFraction(makeSup(p,v) pretend up,nflist)$PartialFraction(up)
+      coerce(pfup)$AnyFunctions1(PartialFraction up)
+
 *)
 
 \end{chunk}
@@ -156708,6 +192099,57 @@ PartitionsAndPermutations: Exports == Implementation where
 \begin{chunk}{COQ PARTPERM}
 (* package PARTPERM *)
 (*
+ 
+    partitions(M,N,n) ==
+      zero? n => concat(empty()$L(I),empty()$(ST L I))
+      zero? M or zero? N or n < 0 => empty()
+      c := map((l1:List(I)):List(I)+->concat(N,l1),partitions(M - 1,N,n - N))
+      concat(c,partitions(M,N - 1,n))
+ 
+    partitions n == partitions(n,n,n)
+ 
+    partitions(M,N)==
+      aaa : L ST L I := [partitions(M,N,i) for i in 0..M*N]
+      concat(aaa :: ST ST L I)$ST1(L I)
+ 
+    -- nogreq(n,l) is the number of elements of l that are greater or
+    -- equal to n
+    nogreq: (I,L I) -> I
+    nogreq(n,x) == +/[1 for i in x | i >= n]
+ 
+    conjugate x ==
+      empty? x => empty()
+      [nogreq(i,x) for i in 1..first x]
+ 
+    conjugates z == map(conjugate,z)
+ 
+    shuffle(x,y)==
+      empty? x => concat(y,empty())$(ST L I)
+      empty? y => concat(x,empty())$(ST L I)
+      concat(map((l1:List(I)):List(I)+->concat(first x,l1),shuffle(rest x,y)),_
+             map((l2:List(I)):List(I)+->concat(first y,l2),shuffle(x,rest y)))
+ 
+    shufflein(x,yy) ==
+      concat(map((l1:List(I)):ST(L I)+->shuffle(x,l1),yy)_
+        $ST2(L I,ST L I))$ST1(L I)
+ 
+    -- rpt(n,m) is the list of n m's
+    rpt: (I,I) -> L I
+    rpt(n,m) == [m for i in 1..n]
+ 
+    -- zrpt(x,y) where x is [x0,x1,x2...] and y is [y0,y1,y2...]
+    -- is the stream [rpt(x0,y0),rpt(x1,y1),...]
+    zrpt: (L I,L I) -> ST L I
+    zrpt(x,y) == map(rpt,x :: ST I,y :: ST I)$ST3(I,I,L I)
+ 
+    sequences(x,y) ==
+      reduce(concat(empty()$L(I),empty()$(ST L I)),_
+                    shufflein,zrpt(x,y))$ST2(L I,ST L I)
+ 
+    sequences x == sequences(x,[i for i in 0..#x-1])
+ 
+    permutations n == sequences(rpt(n,1),[i for i in 1..n])
+
 *)
 
 \end{chunk}
@@ -156808,6 +192250,7 @@ PatternFunctions1(R:SetCategory, D:Type): with
       ++ badValues(p) returns the list of "bad values" for p;
       ++ p is not allowed to match any of its "bad values".
   == add
+
     A1D ==> AnyFunctions1(D)
     A1  ==> AnyFunctions1(D -> Boolean)
     A1L ==> AnyFunctions1(List D -> Boolean)
@@ -156816,11 +192259,17 @@ PatternFunctions1(R:SetCategory, D:Type): with
     st      : (Pattern R, List Any) -> Pattern R
  
     st(p, l)          == withPredicates(p, concat(predicates p, l))
+
     predicate p       == (d1:D):Boolean +-> applyAll(predicates p, d1)
+
     addBadValue(p, v) == addBadValue(p, coerce(v)$A1D)
+
     badValues p       == [retract(v)$A1D for v in getBadValues p]
+
     suchThat(p, l, f) == setTopPredicate(copy p, l, coerce(f)$A1L)
+
     suchThat(p:Pattern R, f:D -> Boolean) == st(p, [coerce(f)$A1])
+
     satisfy?(d:D, p:Pattern R)            == applyAll(predicates p, d)
  
     satisfy?(l:List D, p:Pattern R) ==
@@ -156840,6 +192289,40 @@ PatternFunctions1(R:SetCategory, D:Type): with
 \begin{chunk}{COQ PATTERN1}
 (* package PATTERN1 *)
 (*
+
+    A1D ==> AnyFunctions1(D)
+    A1  ==> AnyFunctions1(D -> Boolean)
+    A1L ==> AnyFunctions1(List D -> Boolean)
+ 
+    applyAll: (List Any, D) -> Boolean
+    st      : (Pattern R, List Any) -> Pattern R
+ 
+    st(p, l)          == withPredicates(p, concat(predicates p, l))
+
+    predicate p       == (d1:D):Boolean +-> applyAll(predicates p, d1)
+
+    addBadValue(p, v) == addBadValue(p, coerce(v)$A1D)
+
+    badValues p       == [retract(v)$A1D for v in getBadValues p]
+
+    suchThat(p, l, f) == setTopPredicate(copy p, l, coerce(f)$A1L)
+
+    suchThat(p:Pattern R, f:D -> Boolean) == st(p, [coerce(f)$A1])
+
+    satisfy?(d:D, p:Pattern R)            == applyAll(predicates p, d)
+ 
+    satisfy?(l:List D, p:Pattern R) ==
+      empty?((rec := topPredicate p).var) => true
+      retract(rec.pred)$A1L l
+ 
+    applyAll(l, d) ==
+      for f in l repeat
+        not(retract(f)$A1 d) => return false
+      true
+ 
+    suchThat(p:Pattern R, l:List(D -> Boolean)) ==
+      st(p, [coerce(f)$A1 for f in l])
+
 *)
 
 \end{chunk}
@@ -156910,6 +192393,7 @@ PatternFunctions2(R:SetCategory, S:SetCategory): with
       ++ map(f, p) applies f to all the leaves of p and
       ++ returns the result as a pattern over S.
   == add
+
     map(f, p) ==
       (r := (retractIfCan p)@Union(R, "failed")) case R =>
         f(r::R)::Pattern(S)
@@ -156939,6 +192423,31 @@ PatternFunctions2(R:SetCategory, S:SetCategory): with
 \begin{chunk}{COQ PATTERN2}
 (* package PATTERN2 *)
 (*
+
+    map(f, p) ==
+      (r := (retractIfCan p)@Union(R, "failed")) case R =>
+        f(r::R)::Pattern(S)
+      (u := isOp p) case Record(op:BasicOperator, arg:List Pattern R) =>
+        ur := u::Record(op:BasicOperator, arg:List Pattern R)
+        (ur.op) [map(f, x) for x in ur.arg]
+      (v := isQuotient p) case Record(num:Pattern R, den:Pattern R) =>
+        vr := v::Record(num:Pattern R, den:Pattern R)
+        map(f, vr.num) / map(f, vr.den)
+      (l := isPlus p) case List(Pattern R) =>
+        reduce("+", [map(f, x) for x in l::List(Pattern R)])
+      (l := isTimes p) case List(Pattern R) =>
+        reduce("*", [map(f, x) for x in l::List(Pattern R)])
+      (x := isPower p) case
+       Record(val:Pattern R, exponent: Pattern R) =>
+        xr := x::Record(val:Pattern R, exponent: Pattern R)
+        map(f, xr.val) ** map(f, xr.exponent)
+      (w := isExpt p) case
+       Record(val:Pattern R, exponent: NonNegativeInteger) =>
+        wr := w::Record(val:Pattern R, exponent: NonNegativeInteger)
+        map(f, wr.val) ** wr.exponent
+      sy := retract(p)@Symbol
+      setPredicates(sy::Pattern(S), copy predicates p)
+
 *)
 
 \end{chunk}
@@ -157046,28 +192555,36 @@ PatternMatch(Base, Subject, Pat): Exports == Implementation where
           ++ returns a \spadfun{failed} match if pat does not match expr.
 
   Implementation ==> add
+
     import PatternMatchListAggregate(Base, Subject, List Subject)
 
     ist: (Subject, Pat) -> PatternMatchResult(Base, Subject)
 
     ist(s, p)                  == patternMatch(s, convert p, new())
+
     is?(s:     Subject, p:Pat) == not failed? ist(s, p)
+
     is?(s:List Subject, p:Pat) == not failed? Is(s, p)
+
     Is(s:List Subject,  p:Pat) == patternMatch(s, convert p, new())
 
     if Subject has RetractableTo(Symbol) then
+
       Is(s:Subject, p:Pat):List(Equation Subject) ==
         failed?(r := ist(s, p)) => empty()
         [rec.key::Subject = rec.entry for rec in destruct r]
 
     else
+
       if Subject has Ring then
+
         Is(s:Subject, p:Pat):List(Equation Polynomial Subject) ==
           failed?(r := ist(s, p)) => empty()
           [rec.key::Polynomial(Subject) =$Equation(Polynomial Subject)
            rec.entry::Polynomial(Subject) for rec in destruct r]
 
       else
+
         Is(s:Subject,p:Pat):PatternMatchResult(Base,Subject) == ist(s,p)
 
 \end{chunk}
@@ -157075,6 +192592,38 @@ PatternMatch(Base, Subject, Pat): Exports == Implementation where
 \begin{chunk}{COQ PATMATCH}
 (* package PATMATCH *)
 (*
+
+    import PatternMatchListAggregate(Base, Subject, List Subject)
+
+    ist: (Subject, Pat) -> PatternMatchResult(Base, Subject)
+
+    ist(s, p)                  == patternMatch(s, convert p, new())
+
+    is?(s:     Subject, p:Pat) == not failed? ist(s, p)
+
+    is?(s:List Subject, p:Pat) == not failed? Is(s, p)
+
+    Is(s:List Subject,  p:Pat) == patternMatch(s, convert p, new())
+
+    if Subject has RetractableTo(Symbol) then
+
+      Is(s:Subject, p:Pat):List(Equation Subject) ==
+        failed?(r := ist(s, p)) => empty()
+        [rec.key::Subject = rec.entry for rec in destruct r]
+
+    else
+
+      if Subject has Ring then
+
+        Is(s:Subject, p:Pat):List(Equation Polynomial Subject) ==
+          failed?(r := ist(s, p)) => empty()
+          [rec.key::Polynomial(Subject) =$Equation(Polynomial Subject)
+           rec.entry::Polynomial(Subject) for rec in destruct r]
+
+      else
+
+        Is(s:Subject,p:Pat):PatternMatchResult(Base,Subject) == ist(s,p)
+
 *)
 
 \end{chunk}
@@ -157169,11 +192718,15 @@ PatternMatchAssertions(): Exports == Implementation where
       ++ that x should match a list instead of an element of a list.
 
   Implementation ==> add
+
     import FunctionSpaceAssertions(Integer, FE)
 
     constant x   == constant(x::FE)
+
     multiple x   == multiple(x::FE)
+
     optional x   == optional(x::FE)
+
     assert(x, s) == assert(x::FE, s)
 
 \end{chunk}
@@ -157181,6 +192734,17 @@ PatternMatchAssertions(): Exports == Implementation where
 \begin{chunk}{COQ PMASS}
 (* package PMASS *)
 (*
+
+    import FunctionSpaceAssertions(Integer, FE)
+
+    constant x   == constant(x::FE)
+
+    multiple x   == multiple(x::FE)
+
+    optional x   == optional(x::FE)
+
+    assert(x, s) == assert(x::FE, s)
+
 *)
 
 \end{chunk}
@@ -157265,6 +192829,7 @@ PatternMatchFunctionSpace(S, R, F): Exports== Implementation where
       ++ are already matched and their matches.
 
   Implementation ==> add
+
     import PatternMatchKernel(S, F)
     import PatternMatchTools(S, R, F)
     import PatternMatchPushDown(S, R, F)
@@ -157313,6 +192878,50 @@ PatternMatchFunctionSpace(S, R, F): Exports== Implementation where
 \begin{chunk}{COQ PMFS}
 (* package PMFS *)
 (*
+
+    import PatternMatchKernel(S, F)
+    import PatternMatchTools(S, R, F)
+    import PatternMatchPushDown(S, R, F)
+
+    patternMatch(x, p, l) ==
+      generic? p => addMatch(p, x, l)
+      (r := retractIfCan(x)@Union(R, "failed")) case R =>
+        patternMatch(r::R, p, l)
+      (v := retractIfCan(x)@Union(K, "failed")) case K =>
+        patternMatch(v::K, p, l)
+      (q := isQuotient p) case Record(num:PAT, den:PAT) =>
+        uq := q::Record(num:PAT, den:PAT)
+        failed?(l := patternMatch(numer(x)::F, uq.num, l)) => l
+        patternMatch(denom(x)::F, uq.den, l)
+      (u := isPlus p) case List(PAT) =>
+        (lx := isPlus x) case List(F) =>
+          patternMatch(lx::List(F), u::List(PAT), l1 +-> +/l1, l, patternMatch)
+        (u := optpair(u::List(PAT))) case List(PAT) =>
+          failed?(l := addMatch(first(u::List(PAT)), 0, l)) => failed()
+          patternMatch(x, second(u::List(PAT)), l)
+        failed()
+      (u := isTimes p) case List(PAT) =>
+        (lx := isTimes x) case List(F) =>
+          patternMatchTimes(lx::List(F), u::List(PAT), l, patternMatch)
+        (u := optpair(u::List(PAT))) case List(PAT) =>
+          failed?(l := addMatch(first(u::List(PAT)), 1, l)) => failed()
+          patternMatch(x, second(u::List(PAT)), l)
+        failed()
+      (uu := isPower p) case Record(val:PAT, exponent:PAT) =>
+        uur := uu::Record(val:PAT, exponent: PAT)
+        (ex := isExpt x) case RCX =>
+          failed?(l := patternMatch((ex::RCX).exponent::Integer::F,
+                                           uur.exponent, l)) => failed()
+          patternMatch((ex::RCX).var, uur.val, l)
+        optional?(uur.exponent) =>
+          failed?(l := addMatch(uur.exponent, 1, l)) => failed()
+          patternMatch(x, uur.val, l)
+        failed()
+      ((ep := isExpt p) case RCP) and ((ex := isExpt x) case RCX) and
+           (ex::RCX).exponent = ((ep::RCP).exponent)::Integer =>
+               patternMatch((ex::RCX).var, (ep::RCP).val, l)
+      failed()
+
 *)
 
 \end{chunk}
@@ -157381,6 +192990,7 @@ PatternMatchIntegerNumberSystem(I:IntegerNumberSystem): with
     ++ integer n; res contains the variables of pat which
     ++ are already matched and their matches.
  == add
+
    import IntegerRoots(I)
 
    PAT ==> Pattern Integer
@@ -157447,6 +193057,68 @@ PatternMatchIntegerNumberSystem(I:IntegerNumberSystem): with
 \begin{chunk}{COQ PMINS}
 (* package PMINS *)
 (*
+
+   import IntegerRoots(I)
+
+   PAT ==> Pattern Integer
+   PMR ==> PatternMatchResult(Integer, I)
+
+   patternMatchInner     : (I, PAT, PMR) -> PMR
+   patternMatchRestricted: (I, PAT, PMR, I) -> PMR
+   patternMatchSumProd   :
+     (I, List PAT, PMR, (I, I) -> Union(I, "failed"), I) -> PMR
+
+   patternMatch(x, p, l) ==
+     generic? p => addMatch(p, x, l)
+     patternMatchInner(x, p, l)
+
+   patternMatchRestricted(x, p, l, y) ==
+     generic? p => addMatchRestricted(p, x, l, y)
+     patternMatchInner(x, p, l)
+
+   patternMatchSumProd(x, lp, l, invOp, ident) ==
+     #lp = 2 =>
+       p2 := last lp
+       if ((r:= retractIfCan(p1 := first lp)@Union(Integer,"failed"))
+                          case "failed") then (p1 := p2; p2 := first lp)
+       (r := retractIfCan(p1)@Union(Integer, "failed")) case "failed" =>
+                                                                failed()
+       (y := invOp(x, r::Integer::I)) case "failed" => failed()
+       patternMatchRestricted(y::I, p2, l, ident)
+     failed()
+
+   patternMatchInner(x, p, l) ==
+     constant? p =>
+       (r := retractIfCan(p)@Union(Integer, "failed")) case Integer =>
+         convert(x)@Integer = r::Integer => l
+         failed()
+       failed()
+     (u := isExpt p) case Record(val:PAT,exponent:NonNegativeInteger) =>
+       ur := u::Record(val:PAT, exponent:NonNegativeInteger)
+       (v := perfectNthRoot(x, ur.exponent)) case "failed" => failed()
+       patternMatchRestricted(v::I, ur.val, l, 1)
+     (uu := isPower p) case Record(val:PAT, exponent:PAT) =>
+       uur := uu::Record(val:PAT, exponent: PAT)
+       pr := perfectNthRoot x
+       failed?(l := patternMatchRestricted(pr.exponent::Integer::I,
+                                         uur.exponent, l,1)) => failed()
+       patternMatchRestricted(pr.base, uur.val, l, 1)
+     (w := isTimes p) case List(PAT) =>
+       patternMatchSumProd(x, w::List(PAT), l,
+        (i1:I,i2:I):Union(I,"failed") +-> i1 exquo i2, 1)
+     (w := isPlus p) case List(PAT) =>
+      patternMatchSumProd(x,w::List(PAT),l,
+        (i1:I,i2:I):Union(I,"failed") +-> (i1-i2)::Union(I,"failed"),0)
+     (uv := isQuotient p) case Record(num:PAT, den:PAT) =>
+       uvr := uv::Record(num:PAT, den:PAT)
+       (r := retractIfCan(uvr.num)@Union(Integer,"failed")) case Integer
+         and (v := r::Integer::I exquo x) case I =>
+           patternMatchRestricted(v::I, uvr.den, l, 1)
+       (r := retractIfCan(uvr.den)@Union(Integer,"failed")) case Integer
+         => patternMatch(r::Integer * x, uvr.num, l)
+       failed()
+     failed()
+
 *)
 
 \end{chunk}
@@ -157570,6 +193242,7 @@ PatternMatchIntegration(R, F): Exports == Implementation where
              ++ if it can be found by the built-in pattern matching rules.
 
   Implementation ==> add
+
     import PatternMatch(Z, F, F)
     import ElementaryFunctionSign(R, F)
     import FunctionSpaceAssertions(R, F)
@@ -157587,10 +193260,13 @@ PatternMatchIntegration(R, F): Exports == Implementation where
     pmb := new pm
 
     c := optional(pmc::F)
+
     w := suchThat(optional(pmw::F), 
       (x1:F):Boolean +-> empty? variables x1)
+
     s := suchThat(optional(pms::F), 
       (x1:F):Boolean +-> empty? variables x1 and real? x1)
+
     m := suchThat(optional(pmm::F),
       (x1:F):Boolean+->(retractIfCan(x1)@Union(Z,"failed") case Z) and x1 >= 0)
 
@@ -157643,15 +193319,13 @@ PatternMatchIntegration(R, F): Exports == Implementation where
            goodlilog? : (K, P) -> Boolean
            gooddilog? : (K, P, P) -> Boolean
 
---           goodlilog?(k, p) == is?(k, "log"::SY) and one? minimumDegree(p, k)
            goodlilog?(k, p) == is?(k, "log"::SY) and (minimumDegree(p, k) = 1)
 
            gooddilog?(k, p, q) ==
---             is?(k, "log"::SY) and one? degree(p, k) and zero? degree(q, k)
              is?(k, "log"::SY) and (degree(p, k) = 1) and zero? degree(q, k)
 
--- matches the integral to a result of the form d * erf(u) or d * ei(u)
--- returns [case, u, d]
+           -- matches the integral to a result of the form d*erf(u) or d*ei(u)
+           -- returns [case, u, d]
            matcherfei(f, x, comp?) ==
              res0 := new()$RES
              pat := c * exp(pma::F)
@@ -157668,8 +193342,8 @@ PatternMatchIntegration(R, F): Exports == Implementation where
                [NONE, 0, 0]
              [NONE, 0, 0]
 
--- matches the integral to a result of the form d * ei(k * log u)
--- returns [case, k * log u, d]
+           -- matches the integral to a result of the form d * ei(k * log u)
+           -- returns [case, k * log u, d]
            matchei(f, x) ==
              res0 := new()$RES
              a := pma::F
@@ -157682,8 +193356,8 @@ PatternMatchIntegration(R, F): Exports == Implementation where
              zero? differentiate(d, x) => [EI, (1 + l.pmw) * log a, d]
              [NONE, 0, 0]
 
--- matches the integral to a result of the form d * dilog(u) + int(v),
--- returns [u,d,v] or []
+           -- matches the integral to a result of the form d*dilog(u) + int(v),
+           -- returns [u,d,v] or []
            matchdilog(f, x) ==
              n := numer f
              df := (d := denom f)::F
@@ -157692,9 +193366,9 @@ PatternMatchIntegration(R, F): Exports == Implementation where
                  not empty?(l := matchdilog0(f, k, x, n, df)) => return l
              empty()
 
--- matches the integral to a result of the form d * dilog(a) + int(v)
--- where k = log(a)
--- returns [a,d,v] or []
+           -- matches the integral to a result of the form d*dilog(a) + int(v)
+           -- where k = log(a)
+           -- returns [a,d,v] or []
            matchdilog0(f, k, x, p, q) ==
              zero?(da := differentiate(a := first argument k, x)) => empty()
              a1 := 1 - a
@@ -157702,8 +193376,8 @@ PatternMatchIntegration(R, F): Exports == Implementation where
              zero? differentiate(d, x) => [a, d, f - d * da * (k::F) / a1]
              empty()
 
--- matches the integral to a result of the form d * li(u) + int(v),
--- returns [u,d,v] or []
+           -- matches the integral to a result of the form d * li(u) + int(v),
+           -- returns [u,d,v] or []
            matchli(f, x) ==
              d := denom f
              for k in select_!(
@@ -157711,9 +193385,9 @@ PatternMatchIntegration(R, F): Exports == Implementation where
                  not empty?(l := matchli0(f, k, x)) => return l
              empty()
 
--- matches the integral to a result of the form d * li(a) + int(v)
--- where k = log(a)
--- returns [a,d,v] or []
+           -- matches the integral to a result of the form d * li(a) + int(v)
+           -- where k = log(a)
+           -- returns [a,d,v] or []
            matchli0(f, k, x) ==
              g := (lg := k::F) * f
              zero?(da := differentiate(a := first argument k, x)) => empty()
@@ -157724,9 +193398,8 @@ PatternMatchIntegration(R, F): Exports == Implementation where
              zero? differentiate(d := coefficient(p, 0) / da, x) =>
                [a, d, leadingCoefficient p]
              empty()
-
--- matches the integral to a result of the form d * Si(u) or d * Ci(u)
--- returns [case, u, d]
+           -- matches the integral to a result of the form 
+           -- d * Si(u) or d * Ci(u) returns [case, u, d]
            matchsici(f, x) ==
              res0 := new()$RES
              b := pmb::F
@@ -157736,8 +193409,8 @@ PatternMatchIntegration(R, F): Exports == Implementation where
              patci0 := c / patden
              ci0?:Boolean
              (ci? := failed?(res := patternMatch(f, convert(patsi)@PAT, res0)))
-               and (ci0?:=failed?(res:=patternMatch(f,convert(patci)@PAT,res0)))
-                 and failed?(res := patternMatch(f,convert(patci0)@PAT,res0)) =>
+              and (ci0?:=failed?(res:=patternMatch(f,convert(patci)@PAT,res0)))
+                and failed?(res := patternMatch(f,convert(patci0)@PAT,res0)) =>
                    [NONE, 0, 0]
              l := mkalist res
              (b := l.pmb) ^= 2 * (a := l.pma) => [NONE, 0, 0]
@@ -157750,10 +193423,9 @@ PatternMatchIntegration(R, F): Exports == Implementation where
                [SI, b, d / (2::F)]
              [NONE, 0, 0]
 
--- returns a simplified sqrt(y)
+           -- returns a simplified sqrt(y)
            insqrt y ==
              rec := froot(y, 2)$PolynomialRoots(IndexedExponents K, K, R, P, F)
---             one?(rec.exponent) => rec.coef * rec.radicand
              ((rec.exponent) = 1) => rec.coef * rec.radicand
              rec.exponent ^=2 => error "insqrt: hould not happen"
              rec.coef * sqrt(rec.radicand)
@@ -157786,22 +193458,24 @@ PatternMatchIntegration(R, F): Exports == Implementation where
              "failed"
 
          if F has SpecialFunctionCategory then
+
            match1    : (F, SY, F, F) -> List F
            formula1  : (F, SY, F, F) -> Union(F, "failed")
 
--- tries only formula (1) of the Geddes & al, AAECC 1 (1990) paper
+           -- tries only formula (1) of the Geddes & al, AAECC 1 (1990) paper
            formula1(f, x, t, cc) ==
              empty?(l := match1(f, x, t, cc)) => "failed"
              mw := first l
-             zero?(ms := third l) or ((sgs := sign ms) case "failed")=> "failed"
+             zero?(ms := third l) or ((sgs := sign ms) case "failed")=>_
+                "failed"
              ((sgz := sign(z := (mw + 1) / ms)) case "failed") or (sgz::Z < 0)
                 => "failed"
              mmi := retract(mm := second l)@Z
              sgs * (last l) * ms**(- mmi - 1) *
-                 eval(differentiate(Gamma(x::F), x, mmi::N), [kernel(x)@K], [z])
+                eval(differentiate(Gamma(x::F), x, mmi::N), [kernel(x)@K], [z])
 
--- returns [w, m, s, c] or []
--- matches only formula (1) of the Geddes & al, AAECC 1 (1990) paper
+           -- returns [w, m, s, c] or []
+           -- matches only formula (1) of the Geddes & al, AAECC 1 (1990) paper
            match1(f, x, t, cc) ==
              res0 := new()$RES
              pat := cc * log(t)**m * exp(-t**s)
@@ -157827,7 +193501,6 @@ PatternMatchIntegration(R, F): Exports == Implementation where
              empty()
 
            pmintegrate(f, x, a, b) ==
---             zero? a and one? whatInfinity b =>
              zero? a and ((whatInfinity b) = 1) =>
                formula1(f, x, constant(x::F), 
                  suchThat(c, (x1:F):Boolean +-> freeOf?(x1, x)))
@@ -157838,6 +193511,270 @@ PatternMatchIntegration(R, F): Exports == Implementation where
 \begin{chunk}{COQ INTPM}
 (* package INTPM *)
 (*
+
+    import PatternMatch(Z, F, F)
+    import ElementaryFunctionSign(R, F)
+    import FunctionSpaceAssertions(R, F)
+    import TrigonometricManipulations(R, F)
+    import FunctionSpaceAttachPredicates(R, F, F)
+
+    mkalist   : RES -> AssociationList(SY, F)
+
+    pm := new()$SY
+    pmw := new pm
+    pmm := new pm
+    pms := new pm
+    pmc := new pm
+    pma := new pm
+    pmb := new pm
+
+    c := optional(pmc::F)
+
+    w := suchThat(optional(pmw::F), 
+      (x1:F):Boolean +-> empty? variables x1)
+
+    s := suchThat(optional(pms::F), 
+      (x1:F):Boolean +-> empty? variables x1 and real? x1)
+
+    m := suchThat(optional(pmm::F),
+      (x1:F):Boolean+->(retractIfCan(x1)@Union(Z,"failed") case Z) and x1 >= 0)
+
+    spi := sqrt(pi()$F)
+
+    half := 1::F / 2::F
+
+    mkalist res == construct destruct res
+
+    splitConstant(f, x) ==
+      not member?(x, variables f) => [f, 1]
+      (retractIfCan(f)@Union(K, "failed")) case K => [1, f]
+      (u := isTimes f) case List(F) =>
+        cc := nc := 1$F
+        for g in u::List(F) repeat
+          rec := splitConstant(g, x)
+          cc  := cc * rec.const
+          nc  := nc * rec.nconst
+        [cc, nc]
+      (u := isPlus f) case List(F) =>
+        rec := splitConstant(first(u::List(F)), x)
+        cc  := rec.const
+        nc  := rec.nconst
+        for g in rest(u::List(F)) repeat
+          rec := splitConstant(g, x)
+          if rec.nconst = nc then cc := cc + rec.const
+          else if rec.nconst = -nc then cc := cc - rec.const
+          else return [1, f]
+        [cc, nc]
+      if (v := isPower f) case Record(val:F, exponent:Z) then
+        vv := v::Record(val:F, exponent:Z)
+        (vv.exponent ^= 1) =>
+          rec := splitConstant(vv.val, x)
+          return [rec.const ** vv.exponent, rec.nconst ** vv.exponent]
+      error "splitConstant: should not happen"
+
+    if R has ConvertibleTo Pattern Integer and
+       R has PatternMatchable Integer then
+         if F has LiouvillianFunctionCategory then
+           import ElementaryFunctionSign(R, F)
+
+           insqrt     : F -> F
+           matchei    : (F, SY) -> REC
+           matcherfei : (F, SY, Boolean) -> REC
+           matchsici  : (F, SY) -> REC
+           matchli    : (F, SY) -> List F
+           matchli0   : (F, K, SY) -> List F
+           matchdilog : (F, SY) -> List F
+           matchdilog0: (F, K, SY, P, F) -> List F
+           goodlilog? : (K, P) -> Boolean
+           gooddilog? : (K, P, P) -> Boolean
+
+           goodlilog?(k, p) == is?(k, "log"::SY) and (minimumDegree(p, k) = 1)
+
+           gooddilog?(k, p, q) ==
+             is?(k, "log"::SY) and (degree(p, k) = 1) and zero? degree(q, k)
+
+           -- matches the integral to a result of the form d*erf(u) or d*ei(u)
+           -- returns [case, u, d]
+           matcherfei(f, x, comp?) ==
+             res0 := new()$RES
+             pat := c * exp(pma::F)
+             failed?(res := patternMatch(f, convert(pat)@PAT, res0)) =>
+               comp? => [NONE, 0,0]
+               matchei(f,x)
+             l := mkalist res
+             da := differentiate(a := l.pma, x)
+             d := a * (cc := l.pmc) / da
+             zero? differentiate(d, x) => [EI, a, d]
+             comp? or (((u := sign a) case Z) and (u::Z) < 0) =>
+               d := cc * (sa := insqrt(- a)) / da
+               zero? differentiate(d, x) => [ERF, sa, - d * spi]
+               [NONE, 0, 0]
+             [NONE, 0, 0]
+
+           -- matches the integral to a result of the form d * ei(k * log u)
+           -- returns [case, k * log u, d]
+           matchei(f, x) ==
+             res0 := new()$RES
+             a := pma::F
+             pat := c * a**w / log a
+             failed?(res := patternMatch(f, convert(pat)@PAT, res0)) =>
+               [NONE, 0, 0]
+             l := mkalist res
+             da := differentiate(a := l.pma, x)
+             d := (cc := l.pmc) / da
+             zero? differentiate(d, x) => [EI, (1 + l.pmw) * log a, d]
+             [NONE, 0, 0]
+
+           -- matches the integral to a result of the form d*dilog(u) + int(v),
+           -- returns [u,d,v] or []
+           matchdilog(f, x) ==
+             n := numer f
+             df := (d := denom f)::F
+             for k in select_!(
+              (x1:K):Boolean +-> gooddilog?(x1,n,d),variables n)$List(K) repeat
+                 not empty?(l := matchdilog0(f, k, x, n, df)) => return l
+             empty()
+
+           -- matches the integral to a result of the form d*dilog(a) + int(v)
+           -- where k = log(a)
+           -- returns [a,d,v] or []
+           matchdilog0(f, k, x, p, q) ==
+             zero?(da := differentiate(a := first argument k, x)) => empty()
+             a1 := 1 - a
+             d := coefficient(univariate(p, k), 1)::F * a1 / (q * da)
+             zero? differentiate(d, x) => [a, d, f - d * da * (k::F) / a1]
+             empty()
+
+           -- matches the integral to a result of the form d * li(u) + int(v),
+           -- returns [u,d,v] or []
+           matchli(f, x) ==
+             d := denom f
+             for k in select_!(
+               (x1:K):Boolean+->goodlilog?(x1,d), variables d)$List(K) repeat
+                 not empty?(l := matchli0(f, k, x)) => return l
+             empty()
+
+           -- matches the integral to a result of the form d * li(a) + int(v)
+           -- where k = log(a)
+           -- returns [a,d,v] or []
+           matchli0(f, k, x) ==
+             g := (lg := k::F) * f
+             zero?(da := differentiate(a := first argument k, x)) => empty()
+             zero? differentiate(d := g / da, x) => [a, d, 0]
+             ug := univariate(g, k)
+             (u:=retractIfCan(ug)@Union(SUP,"failed")) case "failed" => empty()
+             degree(p := u::SUP) > 1 => empty()
+             zero? differentiate(d := coefficient(p, 0) / da, x) =>
+               [a, d, leadingCoefficient p]
+             empty()
+           -- matches the integral to a result of the form 
+           -- d * Si(u) or d * Ci(u) returns [case, u, d]
+           matchsici(f, x) ==
+             res0 := new()$RES
+             b := pmb::F
+             t := tan(a := pma::F)
+             patsi := c * t / (patden := b + b * t**2)
+             patci := (c - c * t**2) / patden
+             patci0 := c / patden
+             ci0?:Boolean
+             (ci? := failed?(res := patternMatch(f, convert(patsi)@PAT, res0)))
+              and (ci0?:=failed?(res:=patternMatch(f,convert(patci)@PAT,res0)))
+                and failed?(res := patternMatch(f,convert(patci0)@PAT,res0)) =>
+                   [NONE, 0, 0]
+             l := mkalist res
+             (b := l.pmb) ^= 2 * (a := l.pma) => [NONE, 0, 0]
+             db := differentiate(b, x)
+             d := (cc := l.pmc) / db
+             zero? differentiate(d, x) =>
+               ci? =>
+                  ci0? => [CI0, b, d / (2::F)]
+                  [CI, b, d]
+               [SI, b, d / (2::F)]
+             [NONE, 0, 0]
+
+           -- returns a simplified sqrt(y)
+           insqrt y ==
+             rec := froot(y, 2)$PolynomialRoots(IndexedExponents K, K, R, P, F)
+             ((rec.exponent) = 1) => rec.coef * rec.radicand
+             rec.exponent ^=2 => error "insqrt: hould not happen"
+             rec.coef * sqrt(rec.radicand)
+
+           pmintegrate(f, x) ==
+             (rc := splitConstant(f, x)).const ^= 1 =>
+               (u := pmintegrate(rc.nconst, x)) case "failed" => "failed"
+               rec := u::ANS
+               [rc.const * rec.special, rc.const * rec.integrand]
+             not empty?(l := matchli(f, x)) => [second l * li first l, third l]
+             not empty?(l := matchdilog(f, x)) =>
+                                            [second l * dilog first l, third l]
+             cse := (rec := matcherfei(f, x, false)).which
+             cse = EI   => [rec.coeff * Ei(rec.exponent), 0]
+             cse = ERF  => [rec.coeff * erf(rec.exponent), 0]
+             cse := (rec := matchsici(f, x)).which
+             cse = SI => [rec.coeff * Si(rec.exponent), 0]
+             cse = CI => [rec.coeff * Ci(rec.exponent), 0]
+             cse = CI0 => [rec.coeff * Ci(rec.exponent)
+                           + rec.coeff * log(rec.exponent), 0]
+             "failed"
+
+           pmComplexintegrate(f, x) ==
+             (rc := splitConstant(f, x)).const ^= 1 =>
+               (u := pmintegrate(rc.nconst, x)) case "failed" => "failed"
+               rec := u::ANS
+               [rc.const * rec.special, rc.const * rec.integrand]
+             cse := (rec := matcherfei(f, x, true)).which
+             cse = ERF  => [rec.coeff * erf(rec.exponent), 0]
+             "failed"
+
+         if F has SpecialFunctionCategory then
+
+           match1    : (F, SY, F, F) -> List F
+           formula1  : (F, SY, F, F) -> Union(F, "failed")
+
+           -- tries only formula (1) of the Geddes & al, AAECC 1 (1990) paper
+           formula1(f, x, t, cc) ==
+             empty?(l := match1(f, x, t, cc)) => "failed"
+             mw := first l
+             zero?(ms := third l) or ((sgs := sign ms) case "failed")=>_
+                "failed"
+             ((sgz := sign(z := (mw + 1) / ms)) case "failed") or (sgz::Z < 0)
+                => "failed"
+             mmi := retract(mm := second l)@Z
+             sgs * (last l) * ms**(- mmi - 1) *
+                eval(differentiate(Gamma(x::F), x, mmi::N), [kernel(x)@K], [z])
+
+           -- returns [w, m, s, c] or []
+           -- matches only formula (1) of the Geddes & al, AAECC 1 (1990) paper
+           match1(f, x, t, cc) ==
+             res0 := new()$RES
+             pat := cc * log(t)**m * exp(-t**s)
+             not failed?(res := patternMatch(f, convert(pat)@PAT, res0)) =>
+               l := mkalist res
+               [0, l.pmm, l.pms, l.pmc]
+             pat := cc * t**w * exp(-t**s)
+             not failed?(res := patternMatch(f, convert(pat)@PAT, res0)) =>
+               l := mkalist res
+               [l.pmw, 0, l.pms, l.pmc]
+             pat := cc / t**w * exp(-t**s)
+             not failed?(res := patternMatch(f, convert(pat)@PAT, res0)) =>
+               l := mkalist res
+               [- l.pmw, 0, l.pms, l.pmc]
+             pat := cc * t**w * log(t)**m * exp(-t**s)
+             not failed?(res := patternMatch(f, convert(pat)@PAT, res0)) =>
+               l := mkalist res
+               [l.pmw, l.pmm, l.pms, l.pmc]
+             pat := cc / t**w * log(t)**m * exp(-t**s)
+             not failed?(res := patternMatch(f, convert(pat)@PAT, res0)) =>
+               l := mkalist res
+               [- l.pmw, l.pmm, l.pms, l.pmc]
+             empty()
+
+           pmintegrate(f, x, a, b) ==
+             zero? a and ((whatInfinity b) = 1) =>
+               formula1(f, x, constant(x::F), 
+                 suchThat(c, (x1:F):Boolean +-> freeOf?(x1, x)))
+             "failed"
+
 *)
 
 \end{chunk}
@@ -157918,6 +193855,7 @@ PatternMatchKernel(S, E): Exports == Implementation where
       ++ are already matched and their matches.
 
   Implementation ==> add
+
     patternMatchArg  : (List E, List PAT, PRS) -> PRS
     patternMatchInner: (Kernel E, PAT, PRS) -> Union(PRS, "failed")
 
@@ -157945,6 +193883,7 @@ PatternMatchKernel(S, E): Exports == Implementation where
       "failed"
 
     if E has Monoid then
+
       patternMatchMonoid: (Kernel E, PAT, PRS) -> Union(PRS, "failed")
       patternMatchOpt   : (E, List PAT, PRS, E) -> PRS
 
@@ -157971,6 +193910,7 @@ PatternMatchKernel(S, E): Exports == Implementation where
         "failed"
 
       if E has AbelianMonoid then
+
         patternMatch(s, p, l) ==
           (u := patternMatchMonoid(s, p, l)) case PRS => u::PRS
           (w := isPlus p) case List(PAT) =>
@@ -157978,11 +193918,13 @@ PatternMatchKernel(S, E): Exports == Implementation where
           failed()
 
       else
+
         patternMatch(s, p, l) ==
           (u := patternMatchMonoid(s, p, l)) case PRS => u::PRS
           failed()
 
     else
+
       patternMatch(s, p, l) ==
         (u := patternMatchInner(s, p, l)) case PRS => u::PRS
         failed()
@@ -157992,6 +193934,80 @@ PatternMatchKernel(S, E): Exports == Implementation where
 \begin{chunk}{COQ PMKERNEL}
 (* package PMKERNEL *)
 (*
+
+    patternMatchArg  : (List E, List PAT, PRS) -> PRS
+    patternMatchInner: (Kernel E, PAT, PRS) -> Union(PRS, "failed")
+
+    -- matches the ordered lists ls and lp.
+    patternMatchArg(ls, lp, l) ==
+      #ls ^= #lp => failed()
+      for p in lp for s in ls repeat
+        generic? p and failed?(l := addMatch(p,s,l)) => return failed()
+      for p in lp for s in ls repeat
+        not(generic? p) and failed?(l := patternMatch(s, p, l)) =>
+                                                         return failed()
+      l
+
+    patternMatchInner(s, p, l) ==
+      generic? p => addMatch(p, s::E, l)
+      (u := isOp p) case Record(op:BasicOperator, arg: List PAT) =>
+        ur := u::Record(op:BasicOperator, arg: List PAT)
+        ur.op = operator s => patternMatchArg(argument s, ur.arg, l)
+        failed()
+      constant? p =>
+        ((v := retractIfCan(p)@Union(Symbol, "failed")) case Symbol)
+          and ((w := symbolIfCan s) case Symbol) and
+            (v::Symbol = w::Symbol) => l
+        failed()
+      "failed"
+
+    if E has Monoid then
+
+      patternMatchMonoid: (Kernel E, PAT, PRS) -> Union(PRS, "failed")
+      patternMatchOpt   : (E, List PAT, PRS, E) -> PRS
+
+      patternMatchOpt(x, lp, l, id) ==
+        (u := optpair lp) case List(PAT) =>
+          failed?(l := addMatch(first(u::List(PAT)), id, l)) => failed()
+          patternMatch(x, second(u::List(PAT)), l)
+        failed()
+
+      patternMatchMonoid(s, p, l) ==
+        (u := patternMatchInner(s, p, l)) case PRS => u::PRS
+        (v := isPower p) case Record(val:PAT, exponent:PAT) =>
+          vr := v::Record(val:PAT, exponent: PAT)
+          is?(op := operator s, POWER) =>
+            patternMatchArg(argument s, [vr.val, vr.exponent], l)
+          is?(op,NTHRT) and ((r := recip(second(arg := argument s))) case E) =>
+            patternMatchArg([first arg, r::E], [vr.val, vr.exponent], l)
+          optional?(vr.exponent) =>
+            failed?(l := addMatch(vr.exponent, 1, l)) => failed()
+            patternMatch(s::E, vr.val, l)
+          failed()
+        (w := isTimes p) case List(PAT) =>
+          patternMatchOpt(s::E, w::List(PAT), l, 1)
+        "failed"
+
+      if E has AbelianMonoid then
+
+        patternMatch(s, p, l) ==
+          (u := patternMatchMonoid(s, p, l)) case PRS => u::PRS
+          (w := isPlus p) case List(PAT) =>
+            patternMatchOpt(s::E, w::List(PAT), l, 0)
+          failed()
+
+      else
+
+        patternMatch(s, p, l) ==
+          (u := patternMatchMonoid(s, p, l)) case PRS => u::PRS
+          failed()
+
+    else
+
+      patternMatch(s, p, l) ==
+        (u := patternMatchInner(s, p, l)) case PRS => u::PRS
+        failed()
+
 *)
 
 \end{chunk}
@@ -158067,6 +194083,7 @@ PatternMatchListAggregate(S, R, L): Exports == Implementation where
       ++ are already matched and their matches.
 
   Implementation ==> add
+
     match: (L, List Pattern S, PLR, Boolean) -> PLR
 
     patternMatch(l, p, r) ==
@@ -158093,6 +194110,28 @@ PatternMatchListAggregate(S, R, L): Exports == Implementation where
 \begin{chunk}{COQ PMLSAGG}
 (* package PMLSAGG *)
 (*
+
+    match: (L, List Pattern S, PLR, Boolean) -> PLR
+
+    patternMatch(l, p, r) ==
+      (u := isList p) case "failed" => failed()
+      match(l, u::List Pattern S, r, true)
+
+    match(l, lp, r, new?) ==
+      empty? lp =>
+        empty? l => r
+        failed()
+      multiple?(p0 := first lp) =>
+        empty? rest lp =>
+          if not new? then l := reverse_! l
+          makeResult(atoms r, addMatchRestricted(p0,l,lists r,empty()))
+        new? => match(reverse l, reverse lp, r, false)
+        error "Only one multiple pattern allowed in list"
+      empty? l => failed()
+      failed?(r := makeResult(patternMatch(first l,p0,atoms r),lists r))
+                                                             => failed()
+      match(rest l, rest lp, r, new?)
+
 *)
 
 \end{chunk}
@@ -158183,10 +194222,12 @@ PatternMatchPolynomialCategory(S,E,V,R,P):Exports== Implementation where
         ++ are already matched and their matches.
 
   Implementation ==> add
+
     import PatternMatchTools(S, R, P)
     import PatternMatchPushDown(S, R, P)
 
     if V has PatternMatchable S then
+
       patternMatch(x, p, l) ==
         patternMatch(x, p, l, patternMatch$PatternMatchPushDown(S,V,P))
 
@@ -158233,6 +194274,53 @@ PatternMatchPolynomialCategory(S,E,V,R,P):Exports== Implementation where
 \begin{chunk}{COQ PMPLCAT}
 (* package PMPLCAT *)
 (*
+
+    import PatternMatchTools(S, R, P)
+    import PatternMatchPushDown(S, R, P)
+
+    if V has PatternMatchable S then
+
+      patternMatch(x, p, l) ==
+        patternMatch(x, p, l, patternMatch$PatternMatchPushDown(S,V,P))
+
+    patternMatch(x, p, l, vmatch) ==
+      generic? p => addMatch(p, x, l)
+      (r := retractIfCan(x)@Union(R, "failed")) case R =>
+        patternMatch(r::R, p, l)
+      (v := retractIfCan(x)@Union(V, "failed")) case V =>
+        vmatch(v::V, p, l)
+      (u := isPlus p) case List(PAT) =>
+        (lx := isPlus x) case List(P) =>
+          patternMatch(lx::List(P), u::List(PAT), 
+            (l1:List(P)):P +-> +/l1, l, 
+              (p1:P,p2:PAT,p3:PRS):PRS +-> patternMatch(p1, p2, p3, vmatch))
+        (u := optpair(u::List(PAT))) case List(PAT) =>
+          failed?(l := addMatch(first(u::List(PAT)), 0, l)) => failed()
+          patternMatch(x, second(u::List(PAT)), l, vmatch)
+        failed()
+      (u := isTimes p) case List(PAT) =>
+        (lx := isTimes x) case List(P) =>
+          patternMatchTimes(lx::List(P), u::List(PAT), l,
+            (p1:P,p2:PAT,p3:PRS):PRS +-> patternMatch(p1, p2, p3, vmatch))
+        (u := optpair(u::List(PAT))) case List(PAT) =>
+          failed?(l := addMatch(first(u::List(PAT)), 1, l)) => failed()
+          patternMatch(x, second(u::List(PAT)), l, vmatch)
+        failed()
+      (uu := isPower p) case Record(val:PAT, exponent:PAT) =>
+        uur := uu::Record(val:PAT, exponent: PAT)
+        (ex := isExpt x) case RCX =>
+          failed?(l := patternMatch((ex::RCX).exponent::Integer::P,
+                                   uur.exponent, l, vmatch)) => failed()
+          vmatch((ex::RCX).var, uur.val, l)
+        optional?(uur.exponent) =>
+          failed?(l := addMatch(uur.exponent, 1, l)) => failed()
+          patternMatch(x, uur.val, l, vmatch)
+        failed()
+      ((ep := isExpt p) case RCP) and ((ex := isExpt x) case RCX) and
+           (ex::RCX).exponent = (ep::RCP).exponent =>
+               vmatch((ex::RCX).var, (ep::RCP).val, l)
+      failed()
+
 *)
 
 \end{chunk}
@@ -158319,6 +194407,7 @@ PatternMatchPushDown(S, A, B): Exports == Implementation where
       ++ and calling the matching function provided by \spad{A}.
 
   Implementation ==> add
+
     import PatternMatchResultFunctions2(S, A, B)
 
     fixPred      : Any -> Union(Any, "failed")
@@ -158392,6 +194481,75 @@ PatternMatchPushDown(S, A, B): Exports == Implementation where
 \begin{chunk}{COQ PMDOWN}
 (* package PMDOWN *)
 (*
+
+    import PatternMatchResultFunctions2(S, A, B)
+
+    fixPred      : Any -> Union(Any, "failed")
+    inA          : (PAT, PRB) -> Union(List A, "failed")
+    fixPredicates: (PAT, PRB, PRA) -> Union(REC, "failed")
+    fixList:(List PAT -> PAT, List PAT, PRB, PRA) -> Union(REC,"failed")
+
+    fixPredicate f == (a1:A):Boolean +-> f(a1::B)
+
+    patternMatch(a, p, l) ==
+      (u := fixPredicates(p, l, new())) case "failed" => failed()
+      union(l, map((a1:A):B +->a1::B, 
+                patternMatch(a, (u::REC).pat, (u::REC).res)))
+
+    inA(p, l) ==
+      (u := getMatch(p, l)) case "failed" => empty()
+      (r := retractIfCan(u::B)@Union(A, "failed")) case A => [r::A]
+      "failed"
+
+    fixList(fn, l, lb, la) ==
+      ll:List(PAT) := empty()
+      for x in l repeat
+        (f := fixPredicates(x, lb, la)) case "failed" => return "failed"
+        ll := concat((f::REC).pat, ll)
+        la := (f::REC).res
+      [fn ll, la]
+
+    fixPred f ==
+      (u:= retractIfCan(f)$AnyFunctions1(B -> Boolean)) case "failed" =>
+                                                                "failed"
+      g := fixPredicate(u::(B -> Boolean))
+      coerce(g)$AnyFunctions1(A -> Boolean)
+
+    fixPredicates(p, lb, la) ==
+      (r:=retractIfCan(p)@Union(S,"failed")) case S or quoted? p =>[p,la]
+      (u := isOp p) case Record(op:BasicOperator, arg:List PAT) =>
+        ur := u::Record(op:BasicOperator, arg:List PAT)
+        fixList((l1:List(PAT)):PAT+-> (ur.op) l1, ur.arg, lb, la)
+      (us := isPlus p) case List(PAT) =>
+        fixList((l1:List(PAT)):PAT +-> reduce("+", l1), us::List(PAT), lb, la)
+      (us := isTimes p) case List(PAT) =>
+        fixList((l1:List(PAT)):PAT+->reduce("*", l1), us::List(PAT), lb, la)
+      (v := isQuotient p) case Record(num:PAT, den:PAT) =>
+        vr := v::Record(num:PAT, den:PAT)
+        (fn := fixPredicates(vr.num, lb, la)) case "failed" => "failed"
+        la  := (fn::REC).res
+        (fd := fixPredicates(vr.den, lb, la)) case "failed" => "failed"
+        [(fn::REC).pat / (fd::REC).pat, (fd::REC).res]
+      (w:= isExpt p) case Record(val:PAT,exponent:NonNegativeInteger) =>
+        wr := w::Record(val:PAT, exponent: NonNegativeInteger)
+        (f := fixPredicates(wr.val, lb, la)) case "failed" => "failed"
+        [(f::REC).pat ** wr.exponent, (f::REC).res]
+      (uu := isPower p) case Record(val:PAT, exponent:PAT) =>
+        uur := uu::Record(val:PAT, exponent: PAT)
+        (fv := fixPredicates(uur.val, lb, la)) case "failed" => "failed"
+        la  := (fv::REC).res
+        (fe := fixPredicates(uur.exponent, lb, la)) case "failed" =>
+          "failed"
+        [(fv::REC).pat ** (fe::REC).pat, (fe::REC).res]
+      generic? p =>
+        (ua := inA(p, lb)) case "failed" => "failed"
+        lp := [if (h := fixPred g) case Any then h::Any else
+                        return "failed" for g in predicates p]$List(Any)
+        q := setPredicates(patternVariable(retract p, constant? p,
+                                           optional? p, multiple? p), lp)
+        [q, (empty?(ua::List A) => la; insertMatch(q,first(ua::List A), la))]
+      error "Should not happen"
+
 *)
 
 \end{chunk}
@@ -158468,6 +194626,7 @@ PatternMatchQuotientFieldCategory(S,R,Q):Exports == Implementation where
       ++ are already matched and their matches.
 
   Implementation ==> add
+
     import PatternMatchPushDown(S, R, Q)
 
     patternMatch(x, p, l) ==
@@ -158485,6 +194644,19 @@ PatternMatchQuotientFieldCategory(S,R,Q):Exports == Implementation where
 \begin{chunk}{COQ PMQFCAT}
 (* package PMQFCAT *)
 (*
+
+    import PatternMatchPushDown(S, R, Q)
+
+    patternMatch(x, p, l) ==
+      generic? p => addMatch(p, x, l)
+      (r := retractIfCan x)@Union(R, "failed") case R =>
+        patternMatch(r::R, p, l)
+      (u := isQuotient p) case Record(num:PAT, den:PAT) =>
+        ur := u::Record(num:PAT, den:PAT)
+        failed?(l := patternMatch(numer x, ur.num, l)) => l
+        patternMatch(denom x, ur.den, l)
+      failed()
+
 *)
 
 \end{chunk}
@@ -158557,6 +194729,7 @@ PatternMatchResultFunctions2(R, A, B): Exports == Implementation where
       ++ [(v1,f(a1)),...,(vn,f(an))].
 
   Implementation ==> add
+
     map(f, r) ==
       failed? r => failed()
       construct [[rec.key, f(rec.entry)] for rec in destruct r]
@@ -158566,6 +194739,11 @@ PatternMatchResultFunctions2(R, A, B): Exports == Implementation where
 \begin{chunk}{COQ PATRES2}
 (* package PATRES2 *)
 (*
+
+    map(f, r) ==
+      failed? r => failed()
+      construct [[rec.key, f(rec.entry)] for rec in destruct r]
+
 *)
 
 \end{chunk}
@@ -158636,6 +194814,7 @@ PatternMatchSymbol(S:SetCategory): with
     ++ expression expr; res contains the variables of pat which
     ++ are already matched and their matches (necessary for recursion).
  == add
+
   import TopLevelPatternMatchControl
 
   patternMatch(s, p, l) ==
@@ -158651,6 +194830,17 @@ PatternMatchSymbol(S:SetCategory): with
 \begin{chunk}{COQ PMSYM}
 (* package PMSYM *)
 (*
+
+  import TopLevelPatternMatchControl
+
+  patternMatch(s, p, l) ==
+    generic? p  => addMatch(p, s, l)
+    constant? p =>
+      ((u := retractIfCan(p)@Union(Symbol, "failed")) case Symbol)
+        and (u::Symbol) = s => l
+      failed()
+    failed()
+
 *)
 
 \end{chunk}
@@ -158743,6 +194933,7 @@ PatternMatchTools(S, R, P): Exports == Implementation where
       ++ and match is a pattern-matching function on P.
 
   Implementation ==> add
+
     import PatternFunctions1(S, P)
 
     preprocessList: (PAT, List P, PRS) -> Union(List P, "failed")
@@ -158761,9 +194952,9 @@ PatternMatchTools(S, R, P): Exports == Implementation where
           (r::R < 0) => return x
       "failed"
 
--- tries to match the list of patterns lp to the list of subjects rc.s
--- with rc.res being the list of existing matches.
--- updates rc with the new result and subjects still to match
+    -- tries to match the list of patterns lp to the list of subjects rc.s
+    -- with rc.res being the list of existing matches.
+    -- updates rc with the new result and subjects still to match
     tryToMatch(lp, rc, ident, pmatch) ==
       rec:REC := [l := rc.res, ls := rc.s]
       for p in lp repeat
@@ -158772,7 +194963,7 @@ PatternMatchTools(S, R, P): Exports == Implementation where
         ls := rec.s
       rec
 
--- handles -1 in the pattern list.
+    -- handles -1 in the pattern list.
     patternMatchTimes(ls, lp, l, pmatch) ==
       member?(mn1, lp) =>
         (u := negConstant ls) case "failed" => failed()
@@ -158781,7 +194972,7 @@ PatternMatchTools(S, R, P): Exports == Implementation where
           (l1:List(P)):P +-> */l1, l, pmatch)
       patternMatch(ls, lp, (l1:List(P)):P +-> */l1, l, pmatch)
 
--- finds a match for p in ls, try not to match to a "bad" value
+    -- finds a match for p in ls, try not to match to a "bad" value
     findMatch(p, ls, l, ident, pmatch) ==
       bad:List(P) :=
         generic? p => setIntersection(badValues p, ls)
@@ -158796,7 +194987,7 @@ PatternMatchTools(S, R, P): Exports == Implementation where
         [l1, remove(t, ls)]
       [l1, remove(t, ls)]
 
--- filters out pattern if it's generic and already matched.
+    -- filters out pattern if it's generic and already matched.
     preprocessList(pattern, ls, l) ==
       generic? pattern =>
         (u := getMatch(pattern, l)) case P =>
@@ -158805,7 +194996,7 @@ PatternMatchTools(S, R, P): Exports == Implementation where
         empty()
       empty()
 
--- take out already matched generic patterns
+    -- take out already matched generic patterns
     filterMatchedPatterns(lp, ls, l) ==
       for p in lp repeat
         (rc := preprocessList(p, ls, l)) case "failed" => return "failed"
@@ -158814,7 +195005,7 @@ PatternMatchTools(S, R, P): Exports == Implementation where
           ls := remove(first(rc::List(P)), ls)
       [lp, ls]
 
--- select a generic pattern with no predicate if possible
+    -- select a generic pattern with no predicate if possible
     selBestGen l ==
       ans := empty()$List(PAT)
       for p in l | generic? p repeat
@@ -158822,7 +195013,7 @@ PatternMatchTools(S, R, P): Exports == Implementation where
         not hasPredicate? p => return ans
       ans
 
--- matches unordered lists ls and lp
+    -- matches unordered lists ls and lp
     patternMatch(ls, lp, op, l, pmatch) ==
       ident := op empty()
       (rc := filterMatchedPatterns(lp, ls, l)) case "failed" => return failed()
@@ -158862,7 +195053,7 @@ PatternMatchTools(S, R, P): Exports == Implementation where
       rec := u::REC
       (rc := filterMatchedPatterns(l4,rec.s,rec.res)) case "failed" => failed()
       rec := [rec.res, (rc::RC).s]
-      (u := tryToMatch((rc::RC).pat,rec,ident,pmatch)) case "failed" => failed()
+      (u:= tryToMatch((rc::RC).pat,rec,ident,pmatch)) case "failed" => failed()
       rec := u::REC
       l := rec.res
       ls := rec.s
@@ -158876,6 +195067,135 @@ PatternMatchTools(S, R, P): Exports == Implementation where
 \begin{chunk}{COQ PMTOOLS}
 (* package PMTOOLS *)
 (*
+
+    import PatternFunctions1(S, P)
+
+    preprocessList: (PAT, List P, PRS) -> Union(List P, "failed")
+    selBestGen    : List PAT -> List PAT
+    negConstant   : List P -> Union(P, "failed")
+    findMatch     : (PAT, List P, PRS, P, (P, PAT, PRS) -> PRS) -> REC
+    tryToMatch    : (List PAT, REC, P, (P, PAT, PRS) -> PRS) ->
+                                                  Union(REC, "failed")
+    filterMatchedPatterns: (List PAT, List P, PRS) -> Union(RC, "failed")
+
+    mn1 := convert(-1::P)@Pattern(S)
+
+    negConstant l ==
+      for x in l repeat
+        ((r := retractIfCan(x)@Union(R, "failed")) case R) and
+          (r::R < 0) => return x
+      "failed"
+
+    -- tries to match the list of patterns lp to the list of subjects rc.s
+    -- with rc.res being the list of existing matches.
+    -- updates rc with the new result and subjects still to match
+    tryToMatch(lp, rc, ident, pmatch) ==
+      rec:REC := [l := rc.res, ls := rc.s]
+      for p in lp repeat
+        rec := findMatch(p, ls, l, ident, pmatch)
+        failed?(l := rec.res) => return "failed"
+        ls := rec.s
+      rec
+
+    -- handles -1 in the pattern list.
+    patternMatchTimes(ls, lp, l, pmatch) ==
+      member?(mn1, lp) =>
+        (u := negConstant ls) case "failed" => failed()
+        if (u::P ^= -1::P) then ls := concat(-u::P, ls)
+        patternMatch(remove(u::P,ls), remove(mn1,lp), 
+          (l1:List(P)):P +-> */l1, l, pmatch)
+      patternMatch(ls, lp, (l1:List(P)):P +-> */l1, l, pmatch)
+
+    -- finds a match for p in ls, try not to match to a "bad" value
+    findMatch(p, ls, l, ident, pmatch) ==
+      bad:List(P) :=
+        generic? p => setIntersection(badValues p, ls)
+        empty()
+      l1:PRS := failed()
+      for x in setDifference(ls, bad)
+        while (t := x; failed?(l1 := pmatch(x, p, l))) repeat 0
+      failed? l1 =>
+        for x in bad
+          while (t := x; failed?(l1 := pmatch(x, p, l))) repeat 0
+        failed? l1 => [addMatchRestricted(p, ident, l, ident), ls]
+        [l1, remove(t, ls)]
+      [l1, remove(t, ls)]
+
+    -- filters out pattern if it's generic and already matched.
+    preprocessList(pattern, ls, l) ==
+      generic? pattern =>
+        (u := getMatch(pattern, l)) case P =>
+          member?(u::P, ls) => [u::P]
+          "failed"
+        empty()
+      empty()
+
+    -- take out already matched generic patterns
+    filterMatchedPatterns(lp, ls, l) ==
+      for p in lp repeat
+        (rc := preprocessList(p, ls, l)) case "failed" => return "failed"
+        if not empty?(rc::List(P)) then
+          lp := remove(p,  lp)
+          ls := remove(first(rc::List(P)), ls)
+      [lp, ls]
+
+    -- select a generic pattern with no predicate if possible
+    selBestGen l ==
+      ans := empty()$List(PAT)
+      for p in l | generic? p repeat
+        ans := [p]
+        not hasPredicate? p => return ans
+      ans
+
+    -- matches unordered lists ls and lp
+    patternMatch(ls, lp, op, l, pmatch) ==
+      ident := op empty()
+      (rc := filterMatchedPatterns(lp, ls, l)) case "failed" => return failed()
+      lp := (rc::RC).pat
+      ls := (rc::RC).s
+      empty? lp => l
+      #(lpm := select(optional?, lp)) > 1 =>
+        error "More than one optional pattern in sum/product"
+      (#ls + #lpm) < #lp => failed()
+      if (not empty? lpm) and (#ls + 1 = #lp) then
+        lp := remove(first lpm, lp)
+        failed?(l := addMatch(first lpm, ident, l)) => return l
+      #(lpm := select(multiple?, lp)) > 1 =>
+        error "More than one expandable pattern in sum/product"
+      #ls > #lp and empty? lpm and empty?(lpm := selBestGen lp) =>
+        failed()
+      if not empty? lpm then lp := remove(first lpm, lp)
+      -- this is the order in which we try to match predicates
+      -- l1 = constant patterns (i.e. 'x, or sin('x))
+      l1 := select(constant?, lp)
+      -- l2 = patterns with a predicate attached to them
+      l2 := select((p1:PAT):Boolean+->hasPredicate? p1 and not constant? p1,lp)
+      -- l3 = non-generic patterns without predicates
+      l3 := sort_!((z1:PAT,z2:PAT):Boolean+->depth(z1) > depth(z2),
+        select((p2:PAT):Boolean+->not(hasPredicate? p2
+                  or generic? p2 or constant? p2),lp))
+      -- l4 = generic patterns with predicates
+      l4 := select((p1:PAT):Boolean +-> generic? p1 and
+                              not(hasPredicate? p1 or constant? p1), lp)
+      rec:REC := [l, ls]
+      (u := tryToMatch(l1, rec, ident, pmatch)) case "failed" =>
+        failed()
+      (u := tryToMatch(l2, u::REC, ident, pmatch)) case "failed" =>
+        failed()
+      (u := tryToMatch(l3, u::REC, ident, pmatch)) case "failed" =>
+        failed()
+      rec := u::REC
+      (rc := filterMatchedPatterns(l4,rec.s,rec.res)) case "failed" => failed()
+      rec := [rec.res, (rc::RC).s]
+      (u:= tryToMatch((rc::RC).pat,rec,ident,pmatch)) case "failed" => failed()
+      rec := u::REC
+      l := rec.res
+      ls := rec.s
+      empty? lpm =>
+        empty? ls => l
+        failed()
+      addMatch(first lpm, op ls, l)
+
 *)
 
 \end{chunk}
@@ -159173,6 +195493,135 @@ Permanent(n : PositiveInteger, R : Ring with commutative("*")):
 \begin{chunk}{COQ PERMAN}
 (* package PERMAN *)
 (*
+ 
+    -- local functions:
+ 
+    permanent2:  SM  -> R
+ 
+    permanent3:  SM  -> R
+ 
+    x : SM
+    a,b : R
+    i,j,k,l : I
+ 
+    permanent3(x) ==
+      -- This algorithm is based upon the principle of inclusion-
+      -- exclusion. A Gray-code is used to generate the subsets of
+      -- 1,... ,n. This reduces the number of additions needed in
+      -- every step.
+      sgn : R := 1
+      k : R
+      a := 0$R
+      vv : V V I := firstSubsetGray(n)$GRAY
+        -- For the meaning of the elements of vv, see GRAY.
+      w : V R := new(n,0$R)
+      j := 1   -- Will be the number of the element changed in subset
+      while j ^= (n+1) repeat  -- we sum over all subsets of (1,...,n)
+        sgn := -sgn
+        b := sgn
+        if vv.1.j = 1 then k := -1
+        else k := 1  -- was that element deleted(k=-1) or added(k=1)?
+        for i in 1..(n::I) repeat
+          w.i :=  w.i +$R k *$R  x(i,j)
+          b := b *$R w.i
+        a := a +$R b
+        vv := nextSubsetGray(vv,n)$GRAY
+        j := vv.2.1
+      if odd?(n) then a := -a
+      a
+ 
+ 
+    permanent(x) ==
+      -- If 2 has an inverse in R, we can spare half of the calcu-
+      -- lation needed in "permanent3": This is the algorithm of
+      -- [Nijenhuis and Wilf, ch.19,p.158]
+      n = 1 => x(1,1)
+      two : R := (2:I) :: R
+      half : Union(R,"failed") := recip(two)
+      if (half case "failed") then
+        if n < 7 then return permanent3(x)
+        else return permanent2(x)
+      sgn : R := 1
+      a := 0$R
+      w : V R := new(n,0$R)
+      -- w.i will be at first x.i and later lambda.i in
+      -- [Nijenhuis and Wilf, p.158, (24a) resp.(26)].
+      rowi : V R := new(n,0$R)
+      for i in 1..n repeat
+        rowi := row(x,i) :: V R
+        b := 0$R
+        for j in 1..n repeat
+          b := b + rowi.j
+        w.i := rowi(n) - (half*b)$R
+      vv : V V I := firstSubsetGray((n-1): PI)$GRAY
+       -- For the meaning of the elements of vv, see GRAY.
+      n :: I
+      b := 1
+      for i in 1..n repeat
+        b := b * w.i
+      a := a+b
+      j := 1   -- Will be the number of the element changed in subset
+      while j ^= n repeat  -- we sum over all subsets of (1,...,n-1)
+        sgn := -sgn
+        b := sgn
+        if vv.1.j = 1 then k := -1
+        else k := 1  -- was that element deleted(k=-1) or added(k=1)?
+        for i in 1..n repeat
+          w.i :=  w.i +$R k *$R  x(i,j)
+          b := b *$R w.i
+        a := a +$R b
+        vv := nextSubsetGray(vv,(n-1) : PI)$GRAY
+        j := vv.2.1
+      if not odd?(n) then a := -a
+      two * a
+ 
+    permanent2(x) ==
+      c : R := 0
+      sgn : R := 1
+      if (not (R has IntegralDomain))
+        -- or (characteristic()$R = (2:NNI))
+        -- compiler refuses to compile the line above !!
+        or  (sgn + sgn = c)
+      then return permanent3(x)
+      -- This is a slight modification of permanent which is
+      -- necessary if 2 is not zero or a zero-divisor in R, but has
+      -- no inverse in R.
+      n = 1 => x(1,1)
+      two : R := (2:I) :: R
+      a := 0$R
+      w : V R := new(n,0$R)
+      -- w.i will be at first x.i and later lambda.i in
+      -- [Nijenhuis and Wilf, p.158, (24a) resp.(26)].
+      rowi : V R := new(n,0$R)
+      for i in 1..n repeat
+        rowi := row(x,i) :: V R
+        b := 0$R
+        for j in 1..n repeat
+          b := b + rowi.j
+        w.i := (two*(rowi(n)))$R - b
+      vv : V V I := firstSubsetGray((n-1): PI)$GRAY
+      n :: I
+      b := 1
+      for i in 1..n repeat
+        b := b *$R w.i
+      a := a +$R b
+      j := 1   -- Will be the number of the element changed in subset
+      while j ^= n repeat  -- we sum over all subsets of (1,...,n-1)
+        sgn := -sgn
+        b := sgn
+        if vv.1.j = 1 then k := -1
+        else k := 1  -- was that element deleted(k=-1) or added(k=1)?
+        c := k * two
+        for i in 1..n repeat
+          w.i :=  w.i +$R c *$R x(i,j)
+          b := b *$R w.i
+        a := a +$R b
+        vv := nextSubsetGray(vv,(n-1) : PI)$GRAY
+        j := vv.2.1
+      if not odd?(n) then a := -a
+      b := two ** ((n-1):NNI)
+      (a exquo b) :: R
+
 *)
 
 \end{chunk}
@@ -159485,17 +195934,23 @@ PermutationGroupExamples():public == private where
         -- each generator represents a 90 degree turn of the appropriate
         -- side.
         f:L L I:=
-         [[11,13,15,17],[12,14,16,18],[51,31,21,41],[53,33,23,43],[52,32,22,42]]
+         [[11,13,15,17],[12,14,16,18],[51,31,21,41],_
+          [53,33,23,43],[52,32,22,42]]
         r:L L I:=
-         [[21,23,25,27],[22,24,26,28],[13,37,67,43],[15,31,61,45],[14,38,68,44]]
+         [[21,23,25,27],[22,24,26,28],[13,37,67,43],_
+          [15,31,61,45],[14,38,68,44]]
         u:L L I:=
-         [[31,33,35,37],[32,34,36,38],[13,51,63,25],[11,57,61,23],[12,58,62,24]]
+         [[31,33,35,37],[32,34,36,38],[13,51,63,25],_
+          [11,57,61,23],[12,58,62,24]]
         d:L L I:=
-         [[41,43,45,47],[42,44,46,48],[17,21,67,55],[15,27,65,53],[16,28,66,54]]
+         [[41,43,45,47],[42,44,46,48],[17,21,67,55],_
+          [15,27,65,53],[16,28,66,54]]
         l:L L I:=
-         [[51,53,55,57],[52,54,56,58],[11,41,65,35],[17,47,63,33],[18,48,64,34]]
+         [[51,53,55,57],[52,54,56,58],[11,41,65,35],_
+          [17,47,63,33],[18,48,64,34]]
         b:L L I:=
-         [[61,63,65,67],[62,64,66,68],[45,25,35,55],[47,27,37,57],[46,26,36,56]]
+         [[61,63,65,67],[62,64,66,68],[45,25,35,55],_
+          [47,27,37,57],[46,26,36,56]]
         llli2gp [f,r,u,d,l,b]
 
       mathieu11(l:L I):PERMGRP I ==
@@ -159508,7 +195963,7 @@ PermutationGroupExamples():public == private where
       mathieu11():PERMGRP I == mathieu11 li1n 11
 
       mathieu12(l:L I):PERMGRP I ==
-      -- permutations derived from the ATLAS
+        -- permutations derived from the ATLAS
         l:=removeDuplicates l
         #l ^= 12 => error "Exactly 12 integers for mathieu12 needed !"
         a:L L I:=
@@ -159518,7 +195973,7 @@ PermutationGroupExamples():public == private where
       mathieu12():PERMGRP I == mathieu12 li1n 12
 
       mathieu22(l:L I):PERMGRP I ==
-      -- permutations derived from the ATLAS
+        -- permutations derived from the ATLAS
         l:=removeDuplicates l
         #l ^= 22 => error "Exactly 22 integers for mathieu22 needed !"
         a:L L I:=[[l.1,l.2,l.4,l.8,l.16,l.9,l.18,l.13,l.3,l.6,l.12],   _
@@ -159533,9 +195988,10 @@ PermutationGroupExamples():public == private where
       -- permutations derived from the ATLAS
         l:=removeDuplicates l
         #l ^= 23 => error "Exactly 23 integers for mathieu23 needed !"
-        a:L L I:= [[l.1,l.2,l.3,l.4,l.5,l.6,l.7,l.8,l.9,l.10,l.11,l.12,l.13,l.14,_
+        a:L L I:= [[l.1,l.2,l.3,l.4,l.5,l.6,l.7,l.8,l.9,l.10,_
+                   l.11,l.12,l.13,l.14,_
                    l.15,l.16,l.17,l.18,l.19,l.20,l.21,l.22,l.23]]
-        b:L L I:= [[l.2,l.16,l.9,l.6,l.8],[l.3,l.12,l.13,l.18,l.4],              _
+        b:L L I:= [[l.2,l.16,l.9,l.6,l.8],[l.3,l.12,l.13,l.18,l.4],          _
                    [l.7,l.17,l.10,l.11,l.22],[l.14,l.19,l.21,l.20,l.15]]
         llli2gp [a,b]
 
@@ -159545,16 +196001,16 @@ PermutationGroupExamples():public == private where
       -- permutations derived from the ATLAS
         l:=removeDuplicates l
         #l ^= 24 => error "Exactly 24 integers for mathieu24 needed !"
-        a:L L I:= [[l.1,l.16,l.10,l.22,l.24],[l.2,l.12,l.18,l.21,l.7],          _
-                   [l.4,l.5,l.8,l.6,l.17],[l.9,l.11,l.13,l.19,l.15]]
-        b:L L I:= [[l.1,l.22,l.13,l.14,l.6,l.20,l.3,l.21,l.8,l.11],[l.2,l.10],  _
-                   [l.4,l.15,l.18,l.17,l.16,l.5,l.9,l.19,l.12,l.7],[l.23,l.24]]
+        a:L L I:=[[l.1,l.16,l.10,l.22,l.24],[l.2,l.12,l.18,l.21,l.7],        _
+                  [l.4,l.5,l.8,l.6,l.17],[l.9,l.11,l.13,l.19,l.15]]
+        b:L L I:=[[l.1,l.22,l.13,l.14,l.6,l.20,l.3,l.21,l.8,l.11],[l.2,l.10], _
+                  [l.4,l.15,l.18,l.17,l.16,l.5,l.9,l.19,l.12,l.7],[l.23,l.24]]
         llli2gp [a,b]
 
       mathieu24():PERMGRP I == mathieu24 li1n 24
 
       janko2(l:L I):PERMGRP I ==
-      -- permutations derived from the ATLAS
+        -- permutations derived from the ATLAS
         l:=removeDuplicates l
         #l ^= 100 => error "Exactly 100 integers for janko2 needed !"
         a:L L I:=[                                                            _
@@ -159573,13 +196029,19 @@ PermutationGroupExamples():public == private where
                  [l.86,l.87,l.88,l.89,l.90,l.91,l.92],                        _
                  [l.93,l.94,l.95,l.96,l.97,l.98,l.99] ]
         b:L L I:=[
-                [l.1,l.74,l.83,l.21,l.36,l.77,l.44,l.80,l.64,l.2,l.34,l.75,l.48,l.17,l.100],_
-                [l.3,l.15,l.31,l.52,l.19,l.11,l.73,l.79,l.26,l.56,l.41,l.99,l.39,l.84,l.90],_
-                [l.4,l.57,l.86,l.63,l.85,l.95,l.82,l.97,l.98,l.81,l.8,l.69,l.38,l.43,l.58],_
+                [l.1,l.74,l.83,l.21,l.36,l.77,l.44,l.80,l.64,_
+                 l.2,l.34,l.75,l.48,l.17,l.100],_
+                [l.3,l.15,l.31,l.52,l.19,l.11,l.73,l.79,l.26,_
+                 l.56,l.41,l.99,l.39,l.84,l.90],_
+                [l.4,l.57,l.86,l.63,l.85,l.95,l.82,l.97,l.98,_
+                 l.81,l.8,l.69,l.38,l.43,l.58],_
                 [l.5,l.66,l.49,l.59,l.61],_
-                [l.6,l.68,l.89,l.94,l.92,l.20,l.13,l.54,l.24,l.51,l.87,l.27,l.76,l.23,l.67],_
-                [l.7,l.72,l.22,l.35,l.30,l.70,l.47,l.62,l.45,l.46,l.40,l.28,l.65,l.93,l.42],_
-                [l.9,l.71,l.37,l.91,l.18,l.55,l.96,l.60,l.16,l.53,l.50,l.25,l.32,l.14,l.33],_
+                [l.6,l.68,l.89,l.94,l.92,l.20,l.13,l.54,l.24,_
+                 l.51,l.87,l.27,l.76,l.23,l.67],_
+                [l.7,l.72,l.22,l.35,l.30,l.70,l.47,l.62,l.45,_
+                 l.46,l.40,l.28,l.65,l.93,l.42],_
+                [l.9,l.71,l.37,l.91,l.18,l.55,l.96,l.60,l.16,_
+                 l.53,l.50,l.25,l.32,l.14,l.33],_
                 [l.10,l.78,l.88,l.29,l.12] ]
         llli2gp [a,b]
 
@@ -159640,6 +196102,209 @@ PermutationGroupExamples():public == private where
 \begin{chunk}{COQ PGE}
 (* package PGE *)
 (*
+
+      -- import the permutation and permutation group domains:
+
+      import PERM I
+      import PERMGRP I
+
+      -- import the needed map function:
+
+      import ListFunctions2(L L I,PERM I)
+      -- the internal functions:
+
+      llli2gp(l:L L L I):PERMGRP I ==
+        --++ Converts an list of permutations each represented by a list
+        --++ of cycles ( each of them represented as a list of Integers )
+        --++ to the permutation group generated by these permutations.
+        (map(cycles,l))::PERMGRP I
+
+      li1n(n:I):L I ==
+        --++ constructs the list of integers from 1 to n
+        [i for i in 1..n]
+
+      -- definition of the exported functions:
+      youngGroup(l:L I):PERMGRP I ==
+        gens:= nil()$(L L L I)
+        element:I:= 1
+        for n in l | n > 1 repeat
+          gens:=cons(list [i for i in element..(element+n-1)], gens)
+          if n >= 3 then gens := cons([[element,element+1]],gens)
+          element:=element+n
+        llli2gp
+          #gens = 0 => [[[1]]]
+          gens
+
+      youngGroup(lambda : Partition):PERMGRP I ==
+        youngGroup(convert(lambda)$Partition)
+
+      rubiksGroup():PERMGRP I ==
+        -- each generator represents a 90 degree turn of the appropriate
+        -- side.
+        f:L L I:=
+         [[11,13,15,17],[12,14,16,18],[51,31,21,41],_
+          [53,33,23,43],[52,32,22,42]]
+        r:L L I:=
+         [[21,23,25,27],[22,24,26,28],[13,37,67,43],_
+          [15,31,61,45],[14,38,68,44]]
+        u:L L I:=
+         [[31,33,35,37],[32,34,36,38],[13,51,63,25],_
+          [11,57,61,23],[12,58,62,24]]
+        d:L L I:=
+         [[41,43,45,47],[42,44,46,48],[17,21,67,55],_
+          [15,27,65,53],[16,28,66,54]]
+        l:L L I:=
+         [[51,53,55,57],[52,54,56,58],[11,41,65,35],_
+          [17,47,63,33],[18,48,64,34]]
+        b:L L I:=
+         [[61,63,65,67],[62,64,66,68],[45,25,35,55],_
+          [47,27,37,57],[46,26,36,56]]
+        llli2gp [f,r,u,d,l,b]
+
+      mathieu11(l:L I):PERMGRP I ==
+      -- permutations derived from the ATLAS
+        l:=removeDuplicates l
+        #l ^= 11 => error "Exactly 11 integers for mathieu11 needed !"
+        a:L L I:=[[l.1,l.10],[l.2,l.8],[l.3,l.11],[l.5,l.7]]
+        llli2gp [a,[[l.1,l.4,l.7,l.6],[l.2,l.11,l.10,l.9]]]
+
+      mathieu11():PERMGRP I == mathieu11 li1n 11
+
+      mathieu12(l:L I):PERMGRP I ==
+        -- permutations derived from the ATLAS
+        l:=removeDuplicates l
+        #l ^= 12 => error "Exactly 12 integers for mathieu12 needed !"
+        a:L L I:=
+          [[l.1,l.2,l.3,l.4,l.5,l.6,l.7,l.8,l.9,l.10,l.11]]
+        llli2gp [a,[[l.1,l.6,l.5,l.8,l.3,l.7,l.4,l.2,l.9,l.10],[l.11,l.12]]]
+
+      mathieu12():PERMGRP I == mathieu12 li1n 12
+
+      mathieu22(l:L I):PERMGRP I ==
+        -- permutations derived from the ATLAS
+        l:=removeDuplicates l
+        #l ^= 22 => error "Exactly 22 integers for mathieu22 needed !"
+        a:L L I:=[[l.1,l.2,l.4,l.8,l.16,l.9,l.18,l.13,l.3,l.6,l.12],   _
+          [l.5,l.10,l.20,l.17,l.11,l.22,l.21,l.19,l.15,l.7,l.14]]
+        b:L L I:= [[l.1,l.2,l.6,l.18],[l.3,l.15],[l.5,l.8,l.21,l.13],   _
+          [l.7,l.9,l.20,l.12],[l.10,l.16],[l.11,l.19,l.14,l.22]]
+        llli2gp [a,b]
+
+      mathieu22():PERMGRP I == mathieu22 li1n 22
+
+      mathieu23(l:L I):PERMGRP I ==
+      -- permutations derived from the ATLAS
+        l:=removeDuplicates l
+        #l ^= 23 => error "Exactly 23 integers for mathieu23 needed !"
+        a:L L I:= [[l.1,l.2,l.3,l.4,l.5,l.6,l.7,l.8,l.9,l.10,_
+                   l.11,l.12,l.13,l.14,_
+                   l.15,l.16,l.17,l.18,l.19,l.20,l.21,l.22,l.23]]
+        b:L L I:= [[l.2,l.16,l.9,l.6,l.8],[l.3,l.12,l.13,l.18,l.4],          _
+                   [l.7,l.17,l.10,l.11,l.22],[l.14,l.19,l.21,l.20,l.15]]
+        llli2gp [a,b]
+
+      mathieu23():PERMGRP I == mathieu23 li1n 23
+
+      mathieu24(l:L I):PERMGRP I ==
+      -- permutations derived from the ATLAS
+        l:=removeDuplicates l
+        #l ^= 24 => error "Exactly 24 integers for mathieu24 needed !"
+        a:L L I:=[[l.1,l.16,l.10,l.22,l.24],[l.2,l.12,l.18,l.21,l.7],        _
+                  [l.4,l.5,l.8,l.6,l.17],[l.9,l.11,l.13,l.19,l.15]]
+        b:L L I:=[[l.1,l.22,l.13,l.14,l.6,l.20,l.3,l.21,l.8,l.11],[l.2,l.10], _
+                  [l.4,l.15,l.18,l.17,l.16,l.5,l.9,l.19,l.12,l.7],[l.23,l.24]]
+        llli2gp [a,b]
+
+      mathieu24():PERMGRP I == mathieu24 li1n 24
+
+      janko2(l:L I):PERMGRP I ==
+        -- permutations derived from the ATLAS
+        l:=removeDuplicates l
+        #l ^= 100 => error "Exactly 100 integers for janko2 needed !"
+        a:L L I:=[                                                            _
+                 [l.2,l.3,l.4,l.5,l.6,l.7,l.8],                               _
+                 [l.9,l.10,l.11,l.12,l.13,l.14,l.15],                         _
+                 [l.16,l.17,l.18,l.19,l.20,l.21,l.22],                        _
+                 [l.23,l.24,l.25,l.26,l.27,l.28,l.29],                        _
+                 [l.30,l.31,l.32,l.33,l.34,l.35,l.36],                        _
+                 [l.37,l.38,l.39,l.40,l.41,l.42,l.43],                        _
+                 [l.44,l.45,l.46,l.47,l.48,l.49,l.50],                        _
+                 [l.51,l.52,l.53,l.54,l.55,l.56,l.57],                        _
+                 [l.58,l.59,l.60,l.61,l.62,l.63,l.64],                        _
+                 [l.65,l.66,l.67,l.68,l.69,l.70,l.71],                        _
+                 [l.72,l.73,l.74,l.75,l.76,l.77,l.78],                        _
+                 [l.79,l.80,l.81,l.82,l.83,l.84,l.85],                        _
+                 [l.86,l.87,l.88,l.89,l.90,l.91,l.92],                        _
+                 [l.93,l.94,l.95,l.96,l.97,l.98,l.99] ]
+        b:L L I:=[
+                [l.1,l.74,l.83,l.21,l.36,l.77,l.44,l.80,l.64,_
+                 l.2,l.34,l.75,l.48,l.17,l.100],_
+                [l.3,l.15,l.31,l.52,l.19,l.11,l.73,l.79,l.26,_
+                 l.56,l.41,l.99,l.39,l.84,l.90],_
+                [l.4,l.57,l.86,l.63,l.85,l.95,l.82,l.97,l.98,_
+                 l.81,l.8,l.69,l.38,l.43,l.58],_
+                [l.5,l.66,l.49,l.59,l.61],_
+                [l.6,l.68,l.89,l.94,l.92,l.20,l.13,l.54,l.24,_
+                 l.51,l.87,l.27,l.76,l.23,l.67],_
+                [l.7,l.72,l.22,l.35,l.30,l.70,l.47,l.62,l.45,_
+                 l.46,l.40,l.28,l.65,l.93,l.42],_
+                [l.9,l.71,l.37,l.91,l.18,l.55,l.96,l.60,l.16,_
+                 l.53,l.50,l.25,l.32,l.14,l.33],_
+                [l.10,l.78,l.88,l.29,l.12] ]
+        llli2gp [a,b]
+
+      janko2():PERMGRP I == janko2 li1n 100
+
+      abelianGroup(l:L PI):PERMGRP I ==
+        gens:= nil()$(L L L I)
+        element:I:= 1
+        for n in l | n > 1 repeat
+          gens:=cons( list [i for i in element..(element+n-1) ], gens )
+          element:=element+n
+        llli2gp
+          #gens = 0 => [[[1]]]
+          gens
+
+      alternatingGroup(l:L I):PERMGRP I ==
+        l:=removeDuplicates l
+        #l = 0 =>
+          error "Cannot construct alternating group on empty set"
+        #l < 3 => llli2gp [[[l.1]]]
+        #l = 3 => llli2gp [[[l.1,l.2,l.3]]]
+        tmp:= [l.i for i in 3..(#l)]
+        gens:L L L I:=[[tmp],[[l.1,l.2,l.3]]]
+        odd?(#l) => llli2gp gens
+        gens.1 := cons([l.1,l.2],gens.1)
+        llli2gp gens
+
+      alternatingGroup(n:PI):PERMGRP I == alternatingGroup li1n n
+
+      symmetricGroup(l:L I):PERMGRP I ==
+        l:=removeDuplicates l
+        #l = 0 => error "Cannot construct symmetric group on empty set !"
+        #l < 3 => llli2gp [[l]]
+        llli2gp [[l],[[l.1,l.2]]]
+
+      symmetricGroup(n:PI):PERMGRP I == symmetricGroup li1n n
+
+      cyclicGroup(l:L I):PERMGRP I ==
+        l:=removeDuplicates l
+        #l = 0 => error "Cannot construct cyclic group on empty set"
+        llli2gp [[l]]
+
+      cyclicGroup(n:PI):PERMGRP I == cyclicGroup li1n n
+
+      dihedralGroup(l:L I):PERMGRP I ==
+        l:=removeDuplicates l
+        #l < 3 => error "in dihedralGroup: Minimum of 3 elements needed !"
+        tmp := [[l.i, l.(#l-i+1) ] for i in 1..(#l quo 2)]
+        llli2gp [ [ l ], tmp ]
+
+      dihedralGroup(n:PI):PERMGRP I ==
+        n = 1 => symmetricGroup (2::PI)
+        n = 2 => llli2gp [[[1,2]],[[3,4]]]
+        dihedralGroup li1n n
+
 *)
 
 \end{chunk}
@@ -159707,6 +196372,7 @@ PiCoercions(R:Join(OrderedSet, IntegralDomain)): with
   coerce: Pi -> Expression R
     ++ coerce(f) returns f as an Expression(R).
  == add
+
   p2e: SparseUnivariatePolynomial Integer -> Expression R
 
   coerce(x:Pi):Expression(R) ==
@@ -159723,6 +196389,18 @@ PiCoercions(R:Join(OrderedSet, IntegralDomain)): with
 \begin{chunk}{COQ PICOERCE}
 (* package PICOERCE *)
 (*
+
+  p2e: SparseUnivariatePolynomial Integer -> Expression R
+
+  coerce(x:Pi):Expression(R) ==
+    f := convert(x)@Fraction(SparseUnivariatePolynomial Integer)
+    p2e(numer f) / p2e(denom f)
+
+  p2e p ==
+    map((x1:Integer):Expression(R) +-> x1::Expression(R), p)_
+      $SparseUnivariatePolynomialFunctions2(Integer, Expression R)_
+       (pi()$Expression(R))
+
 *)
 
 \end{chunk}
@@ -159805,12 +196483,16 @@ PlotFunctions1(S:ConvertibleTo InputForm): with
       ++ plotPolar(f,theta) plots the graph of \spad{r = f(theta)} as
       ++ theta ranges from 0 to 2 pi
   == add
+
     import MakeFloatCompiledFunction(S)
 
     plot(f, x, xRange) == plot(makeFloatFunction(f, x), xRange)
+
     plotPolar(f,theta) == plotPolar(makeFloatFunction(f,theta))
+
     plot(f1, f2, t, tRange) ==
       plot(makeFloatFunction(f1, t), makeFloatFunction(f2, t), tRange)
+
     plotPolar(f,theta,thetaRange) ==
       plotPolar(makeFloatFunction(f,theta),thetaRange)
 
@@ -159819,6 +196501,19 @@ PlotFunctions1(S:ConvertibleTo InputForm): with
 \begin{chunk}{COQ PLOT1}
 (* package PLOT1 *)
 (*
+
+    import MakeFloatCompiledFunction(S)
+
+    plot(f, x, xRange) == plot(makeFloatFunction(f, x), xRange)
+
+    plotPolar(f,theta) == plotPolar(makeFloatFunction(f,theta))
+
+    plot(f1, f2, t, tRange) ==
+      plot(makeFloatFunction(f1, t), makeFloatFunction(f2, t), tRange)
+
+    plotPolar(f,theta,thetaRange) ==
+      plotPolar(makeFloatFunction(f,theta),thetaRange)
+
 *)
 
 \end{chunk}
@@ -159893,6 +196588,7 @@ PlotTools(): Exports == Implementation where
       ++ calcRanges(l) \undocumented
  
   Implementation ==> add
+
     import GraphicsDefaults
     import PLOT
     import TwoDimensionalPlotClipping
@@ -159922,6 +196618,7 @@ PlotTools(): Exports == Implementation where
       m
  
     xRange0(list:L Pt) == select(list,xCoord,min) .. select(list,xCoord,max)
+
     yRange0(list:L Pt) == select(list,yCoord,min) .. select(list,yCoord,max)
  
     select2: (L L Pt,L Pt -> SF,(SF,SF) -> SF) -> SF
@@ -159938,7 +196635,7 @@ PlotTools(): Exports == Implementation where
       select2(list,(u1:L(Pt)):SF +-> lo(yRange0(u1)),min) _
          .. select2(list,(v1:L(Pt)):SF +-> hi(yRange0(v1)),max)
 
-  --%Exported Functions
+    --%Exported Functions
     calcRanges(llp) ==
       drawToScale() => drawToScaleRanges(xRange llp, yRange llp)
       [xRange llp, yRange llp]
@@ -159948,6 +196645,58 @@ PlotTools(): Exports == Implementation where
 \begin{chunk}{COQ PLOTTOOL}
 (* package PLOTTOOL *)
 (*
+
+    import GraphicsDefaults
+    import PLOT
+    import TwoDimensionalPlotClipping
+    import DrawOptionFunctions0
+    import ViewportPackage
+    import POINT
+    import PointPackage(SF)
+ 
+    --%Local functions
+    xRange0: L Pt -> SEG SF
+    xRange: L L Pt -> SEG SF
+    yRange0: L Pt -> SEG SF
+    yRange: L L Pt -> SEG SF
+    drawToScaleRanges: (SEG SF,SEG SF) -> L SEG SF
+  
+    drawToScaleRanges(xVals,yVals) ==
+      xDiff := (xHi := hi xVals) - (xLo := lo xVals)
+      yDiff := (yHi := hi yVals) - (yLo := lo yVals)
+      pad := abs(yDiff - xDiff)/2
+      yDiff > xDiff => [segment(xLo - pad,xHi + pad),yVals]
+      [xVals,segment(yLo - pad,yHi + pad)]
+ 
+    select : (L Pt,Pt -> SF,(SF,SF) -> SF) -> SF
+    select(l,f,g) ==
+      m := f first l
+      for p in rest l repeat m := g(m,f p)
+      m
+ 
+    xRange0(list:L Pt) == select(list,xCoord,min) .. select(list,xCoord,max)
+
+    yRange0(list:L Pt) == select(list,yCoord,min) .. select(list,yCoord,max)
+ 
+    select2: (L L Pt,L Pt -> SF,(SF,SF) -> SF) -> SF
+    select2(l,f,g) ==
+      m := f first l
+      for p in rest l repeat m := g(m,f p)
+      m
+ 
+    xRange(list:L L Pt) ==
+      select2(list,(u1:L(Pt)):SF +-> lo(xRange0(u1)),min) _
+         .. select2(list,(v1:L(Pt)):SF +-> hi(xRange0(v1)),max)
+ 
+    yRange(list:L L Pt) ==
+      select2(list,(u1:L(Pt)):SF +-> lo(yRange0(u1)),min) _
+         .. select2(list,(v1:L(Pt)):SF +-> hi(yRange0(v1)),max)
+
+    --%Exported Functions
+    calcRanges(llp) ==
+      drawToScale() => drawToScaleRanges(xRange llp, yRange llp)
+      [xRange llp, yRange llp]
+
 *)
 
 \end{chunk}
@@ -160179,6 +196928,125 @@ ProjectiveAlgebraicSetPackage(K,symb,PolyRing,E,ProjPt):_
 \begin{chunk}{COQ PRJALGPK}
 (* package PRJALGPK *)
 (*
+
+    import PPFC1
+    import PolyRing
+    import ProjPt
+    
+    listVar:List(OV):= [index(i::PI)$OV for i in 1..#symb]
+    polyToX10 : PolyRing -> SUP(K)
+      
+    --fonctions de resolution de sys. alg. de dim 0
+    singularPoints(crb)==
+      F:=crb
+      Fx:=differentiate(F,index(1)$OV)
+      Fy:=differentiate(F,index(2)$OV)
+      Fz:=differentiate(F,index(3)$OV)
+      idealT:List PolyRing:=[F,Fx,Fy,Fz]
+      idealToX10: List SUP(K) := [polyToX10 pol for pol in idealT]
+      recOfZerosX10:= distinguishedCommonRootsOf(idealToX10,1)$RFP(K)      
+      listOfExtDeg:List Integer:=[recOfZerosX10.extDegree]
+      degExt:=lcm listOfExtDeg
+      zero?(degExt) =>
+        error("------- Infinite number of points ------")
+      ^one?(degExt) =>
+        print(("You need an extension of degree")::OF)
+        print(degExt::OF)
+        error("-------------Have a nice day-------------")
+      listPtsIdl:= [projectivePoint([a,1,0]) for a in recOfZerosX10.zeros]
+      tempL:= affineSingularPoints(crb)$SPWRES
+      if tempL case "failed" then
+        print(("failed with resultant")::OF)
+        print("The singular points will be computed using grobner basis"::OF)
+        tempL := affineSingularPoints(crb)$SPWGRO
+      tempL case "Infinite" =>      
+        error("------- Infinite number of points ------")
+      tempL case Integer => 
+        print(("You need an extension of degree")::OF)
+        print(tempL ::OF)
+        error("-------------Have a nice day-------------")
+      listPtsIdl2:List(ProjPt)
+      if tempL case List(ProjPt) then 
+        listPtsIdl2:= ( tempL :: List(ProjPt))
+      else 
+        error" From ProjectiveAlgebraicSetPackage: this should not happen"
+      listPtsIdl := concat( listPtsIdl , listPtsIdl2)
+      if  pointInIdeal?(idealT,projectivePoint([1,0,0]))$PPFC1 then
+        listPtsIdl:=cons(projectivePoint([1,0,0]),listPtsIdl)
+      listPtsIdl
+
+    algebraicSet(idealT:List(PolyRing)) ==
+      idealToX10: List SUP(K) := [polyToX10 pol for pol in idealT]
+      recOfZerosX10:= distinguishedCommonRootsOf(idealToX10,1)$RFP(K)      
+      listOfExtDeg:List Integer:=[recOfZerosX10.extDegree]
+      degExt:=lcm listOfExtDeg
+      zero?(degExt) =>
+        error("------- Infinite number of points ------")
+      ^one?(degExt) =>
+        print(("You need an extension of degree")::OF)
+        print(degExt::OF)
+        error("-------------Have a nice day-------------")
+      listPtsIdl:= [projectivePoint([a,1,0]) for a in recOfZerosX10.zeros]
+      tempL:= affineAlgSet( idealT )$SPWRES
+      if tempL case "failed" then
+        print("failed with resultant"::OF)
+        print("The finte alg. set  will be computed using grobner basis"::OF)
+        tempL := affineAlgSet( idealT )$SPWGRO
+      tempL case "Infinite" =>      
+        error("------- Infinite number of points ------")
+      tempL case Integer => 
+        print(("You need an extension of degree")::OF)
+        print(tempL ::OF)
+        error("-------------Have a nice day-------------")
+      listPtsIdl2:List(ProjPt)
+      if tempL case List(ProjPt) then 
+        listPtsIdl2:= ( tempL :: List(ProjPt) )
+      else 
+        error" From ProjectiveAlgebraicSetPackage: this should not hapen"
+      listPtsIdl := concat( listPtsIdl , listPtsIdl2)
+      if  pointInIdeal?(idealT,projectivePoint([1,0,0]))$PPFC1 then
+        listPtsIdl:=cons(projectivePoint([1,0,0]),listPtsIdl)
+      listPtsIdl
+   
+    if K has FiniteFieldCategory then
+      
+      rationalPoints(crv:PolyRing,extdegree:PI):List(ProjPt) ==
+	--The code of this is almost the same as for algebraicSet
+	--We could just construct the ideal and call algebraicSet
+	--Should we do that? This might be a bit faster.
+	listPtsIdl:List(ProjPt):= empty()
+        x:= monomial(1,1)$SUP(K)
+	if K has PseudoAlgebraicClosureOfFiniteFieldCategory then 
+	  setTower!(1$K)$K
+        q:= size()$K 
+        px:= x**(q**extdegree) - x
+	crvX10:= polyToX10 crv
+	recOfZerosX10:=distinguishedCommonRootsOf([crvX10,px],1$K)$RFP(K)
+        listPtsIdl:=[projectivePoint([a,1,0]) for a in recOfZerosX10.zeros]
+        --now we got all of the projective points where z = 0 and y ^= 0
+        ratXY1 : List ProjPt:= affineRationalPoints( crv, extdegree )$SPWGRO
+	listPtsIdl:= concat(ratXY1,listPtsIdl)	
+        if  pointInIdeal?([crv],projectivePoint([1,0,0]))$PPFC1 then
+          listPtsIdl:=cons(projectivePoint([1,0,0]),listPtsIdl)
+        listPtsIdl
+
+    polyToX10(pol)==
+      zero?(pol) => 0
+      dd:= degree pol
+      lc:= leadingCoefficient pol
+      pp:= parts dd
+      lp:= last pp
+      ^zero?(lp) => polyToX10 reductum pol
+      e1:= pp.1
+      monomial(lc,e1)$SUP(K) + polyToX10 reductum pol
+
+    singularPointsWithRestriction(F,lstPol)==
+      Fx:=differentiate(F,index(1)$OV)
+      Fy:=differentiate(F,index(2)$OV)
+      Fz:=differentiate(F,index(3)$OV)
+      idealSingulier:List(PolyRing):=concat([F,Fx,Fy,Fz],lstPol)
+      algebraicSet(idealSingulier)
+
 *)
 
 \end{chunk}
@@ -160244,17 +197112,27 @@ PointFunctions2(R1:Ring,R2:Ring):Exports == Implementation where
       ++ map(f,p) \undocumented
  
   Implementation ==> add
+
     import Point(R1)
     import Point(R2)
  
     map(mapping,p) ==
-      point([mapping p.(i::PositiveInteger) for i in minIndex(p)..maxIndex(p)])$Point(R2)
+      point([mapping p.(i::PositiveInteger)_
+       for i in minIndex(p)..maxIndex(p)])$Point(R2)
 
 \end{chunk}
 
 \begin{chunk}{COQ PTFUNC2}
 (* package PTFUNC2 *)
 (*
+
+    import Point(R1)
+    import Point(R2)
+ 
+    map(mapping,p) ==
+      point([mapping p.(i::PositiveInteger)_
+       for i in minIndex(p)..maxIndex(p)])$Point(R2)
+
 *)
 
 \end{chunk}
@@ -160399,16 +197277,24 @@ PointPackage(R:Ring):Exports == Implementation where
   Implementation ==> add
  
     xCoord p == elt(p,1)
+
     yCoord p == elt(p,2)
+
     zCoord p == elt(p,3)
+
     rCoord p == elt(p,1)
+
     thetaCoord p == elt(p,2)
+
     phiCoord p == elt(p,3)
+
     color p == 
       #p > 3 => p.4
       p.3
+
     hue p == elt(p,3)       
       -- 4D points in 2D using extra dimensions for palette information
+
     shade p == elt(p,4)     
       -- 4D points in 2D using extra dimensions for palette information
 
@@ -160417,6 +197303,29 @@ PointPackage(R:Ring):Exports == Implementation where
 \begin{chunk}{COQ PTPACK}
 (* package PTPACK *)
 (*
+ 
+    xCoord p == elt(p,1)
+
+    yCoord p == elt(p,2)
+
+    zCoord p == elt(p,3)
+
+    rCoord p == elt(p,1)
+
+    thetaCoord p == elt(p,2)
+
+    phiCoord p == elt(p,3)
+
+    color p == 
+      #p > 3 => p.4
+      p.3
+
+    hue p == elt(p,3)       
+      -- 4D points in 2D using extra dimensions for palette information
+
+    shade p == elt(p,4)     
+      -- 4D points in 2D using extra dimensions for palette information
+
 *)
 
 \end{chunk}
@@ -160520,6 +197429,7 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where
       ++ torsionIfCan(f)\ undocumented
 
   Implementation ==> add
+
     import IntegerPrimesPackage(Z)
     import PointsOfFiniteOrderTools(UPQ, UPUPQ)
     import UnivariatePolynomialCommonDenominator(Z, Q, UPQ)
@@ -160557,15 +197467,25 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where
     q := FunctionSpaceReduce(R0, F)
 
     torsion? d == order(d) case N
+
     Q2F x      == numer(x)::F / denom(x)::F
+
     qmod x     == bringDown(x)$q
+
     kqmod(x,k) == bringDown(x, k)$q
+
     fmod p     == map(qmod, p)$SparseUnivariatePolynomialFunctions2(F, Q)
+
     pmod p     == map(qmod, p)$MultipleMap(F, UP, UPUP, Q, UPQ, UPUPQ)
+
     Q2UPUP p   == map(Q2F, p)$MultipleMap(Q, UPQ, UPUPQ, F, UP, UPUP)
+
     klist d    == "setUnion"/[kernels c for c in coefficients d]
+
     notIrr? d  == #(factors factor(d)$RationalFactorize(UPQ)) > 1
+
     kbadBadNum(d, m) == mix [badNum(c rem m) for c in coefficients d]
+
     kbad3Num(h, m)   == lcm [kbadBadNum(c, m) for c in coefficients h]
     
     torsionIfCan d ==
@@ -160585,8 +197505,11 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where
         $UnivariatePolynomialCategoryFunctions2(UP2, UP3, QF, UPUP)
 
     if R0 has GcdDomain then
+
        cmult(l:List SMP):SMP == lcm l
+
     else
+
        cmult(l:List SMP):SMP == */l
 
     doubleDisc(f:UP3):Z ==
@@ -160643,23 +197566,19 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where
       gf := InnerPrimeField p
       m  := map((z1:Q):gf +-> retract(z1)@Z :: gf,mm)_
               $SparseUnivariatePolynomialFunctions2(Q, gf)
---      one? degree m =>
       (degree m = 1) =>
         alpha := - coefficient(m, 0) / leadingCoefficient m
         order(d, pp,
            (z1:F):gf +-> (map((q1:Q):gf +-> numer(q1)::gf / denom(q1)::gf,
             kqmod(z1,k))$SparseUnivariatePolynomialFunctions2(Q,gf))(alpha)
                                    )$ReducedDivisor(F, UP, UPUP, R, gf)
-        -- d1 := toQ1(dd, mm)
-        -- rat(pp, divisor ideal([(toQ1(b, mm) / d1)::QF::R,
-                                       -- inv(d1::QF) * toQ2(h,mm)])$ID, p)
       sae:= SimpleAlgebraicExtension(gf,SparseUnivariatePolynomial gf,m)
       order(d, pp,
         (z1:F):sae +-> reduce(map((q1:Q):gf +-> numer(q1)::gf / denom(q1)::gf,
             kqmod(z1,k))$SparseUnivariatePolynomialFunctions2(Q,gf))$sae
                                    )$ReducedDivisor(F, UP, UPUP, R, sae)
 
--- returns the potential order of d, 0 if d is of infinite order
+    -- returns the potential order of d, 0 if d is of infinite order
     ratcurve(d, rc) ==
       mn  := minIndex(nm := numer(i := minimize ideal d))
       h   := pmod lift(hh := nm(mn + 1))
@@ -160667,27 +197586,25 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where
       s   := separate(rmod(retract(norm hh)@UP), b).primePart
       bd  := badNum rmod denom i
       r   := resultant(s, b)
-      bad := lcm [rc.disc, numer r, denom r, bd.den*bd.gcdnum, badNum h]$List(Z)
+      bad := lcm [rc.disc, numer r,denom r, bd.den*bd.gcdnum, badNum h]$List(Z)
       pp  := Q2UPUP(rc.ncurve)
       n   := rat(pp, d, p := getGoodPrime bad)
--- if n > 1 then it is cheaper to compute the order modulo a second prime,
--- since computing n * d could be very expensive
---      one? n => n
+      -- if n > 1 then it's cheaper to compute the order modulo a second prime,
+      -- since computing n * d could be very expensive
       (n = 1) => n
       m   := rat(pp, d, getGoodPrime(p * bad))
       n = m => n
       0
 
--- returns the order of d mod p
+    -- returns the order of d mod p
     rat(pp, d, p) ==
       gf := InnerPrimeField p
       order(d, pp, 
         (q1:F):gf +-> (qq := qmod q1;numer(qq)::gf / denom(qq)::gf)
                                     )$ReducedDivisor(F, UP, UPUP, R, gf)
 
--- returns the potential order of d, 0 if d is of infinite order
+    -- returns the potential order of d, 0 if d is of infinite order
     possibleOrder d ==
---      zero?(genus()) or one?(#(numer ideal d)) => 1
       zero?(genus()) or (#(numer ideal d) = 1) => 1
       empty?(la := alglist d) => ratcurve(d, selIntegers())
       not(empty? rest la) =>
@@ -160736,7 +197653,6 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where
              factor(map((z1:Q):gf +-> retract(z1)@Z :: gf,
                rec.dfpoly)$SparseUnivariatePolynomialFunctions2(Q,
                  gf))$DistinctDegreeFactorize(gf,
---                   SparseUnivariatePolynomial gf) | one?(f.exponent)]
                    SparseUnivariatePolynomial gf) | (f.exponent = 1)]
       empty? l => "failed"
       mdg := first l
@@ -160758,6 +197674,246 @@ PointsOfFiniteOrder(R0, F, UP, UPUP, R): Exports == Implementation where
 \begin{chunk}{COQ PFO}
 (* package PFO *)
 (*
+
+    import IntegerPrimesPackage(Z)
+    import PointsOfFiniteOrderTools(UPQ, UPUPQ)
+    import UnivariatePolynomialCommonDenominator(Z, Q, UPQ)
+
+    cmult: List SMP -> SMP
+    raise         : (UPQ, K) -> F
+    raise2        : (UP2, K) -> UP
+    qmod          : F     -> Q
+    fmod          : UPF   -> UPQ
+    rmod          : UP    -> UPQ
+    pmod          : UPUP  -> UPUPQ
+    kqmod         : (F,    K) -> UPQ
+    krmod         : (UP,   K) -> UP2
+    kpmod         : (UPUP, K) -> UP3
+    selectIntegers: K   -> REC
+    selIntegers:    ()  -> RC0
+    possibleOrder : FD -> N
+    ratcurve      : (FD, RC0)    -> N
+    algcurve      : (FD, REC, K) -> N
+    kbad3Num      : (UP3, UPQ) -> Z
+    kbadBadNum    : (UP2, UPQ) -> Z
+    kgetGoodPrime : (REC, UPQ, UP3, UP2,UP2) -> Record(prime:PI,poly:UPQ)
+    goodRed       : (REC, UPQ, UP3, UP2, UP2, PI) -> Union(UPQ, "failed")
+    good?         : (UPQ, UP3, UP2, UP2, PI, UPQ) -> Boolean
+    klist         : UP -> List K
+    aklist        : R  -> List K
+    alglist       : FD -> List K
+    notIrr?       : UPQ -> Boolean
+    rat           : (UPUP, FD, PI) -> N
+    toQ1          : (UP2, UPQ) -> UP
+    toQ2          : (UP3, UPQ) -> R
+    Q2F           : Q -> F
+    Q2UPUP        : UPUPQ -> UPUP
+
+    q := FunctionSpaceReduce(R0, F)
+
+    torsion? d == order(d) case N
+
+    Q2F x      == numer(x)::F / denom(x)::F
+
+    qmod x     == bringDown(x)$q
+
+    kqmod(x,k) == bringDown(x, k)$q
+
+    fmod p     == map(qmod, p)$SparseUnivariatePolynomialFunctions2(F, Q)
+
+    pmod p     == map(qmod, p)$MultipleMap(F, UP, UPUP, Q, UPQ, UPUPQ)
+
+    Q2UPUP p   == map(Q2F, p)$MultipleMap(Q, UPQ, UPUPQ, F, UP, UPUP)
+
+    klist d    == "setUnion"/[kernels c for c in coefficients d]
+
+    notIrr? d  == #(factors factor(d)$RationalFactorize(UPQ)) > 1
+
+    kbadBadNum(d, m) == mix [badNum(c rem m) for c in coefficients d]
+
+    kbad3Num(h, m)   == lcm [kbadBadNum(c, m) for c in coefficients h]
+    
+    torsionIfCan d ==
+      zero?(n := possibleOrder(d := reduce d)) => "failed"
+      (g := generator reduce(n::Z * d)) case "failed" => "failed"
+      [n, g::R]
+
+    UPQ2F(p:UPQ, k:K):F ==
+      map(Q2F, p)$UnivariatePolynomialCategoryFunctions2(Q, UPQ, F, UP) (k::F)
+
+    UP22UP(p:UP2, k:K):UP ==
+      map((p1:UPQ):F +-> UPQ2F(p1, k), p)_
+        $UnivariatePolynomialCategoryFunctions2(UPQ,UP2,F,UP)
+
+    UP32UPUP(p:UP3, k:K):UPUP ==
+      map((p1:UP2):QF +-> UP22UP(p1,k)::QF,p)_
+        $UnivariatePolynomialCategoryFunctions2(UP2, UP3, QF, UPUP)
+
+    if R0 has GcdDomain then
+
+       cmult(l:List SMP):SMP == lcm l
+
+    else
+
+       cmult(l:List SMP):SMP == */l
+
+    doubleDisc(f:UP3):Z ==
+      d := discriminant f
+      g := gcd(d, differentiate d)
+      d := (d exquo g)::UP2
+      zero?(e := discriminant d) => 0
+      gcd [retract(c)@Z for c in coefficients e]
+
+    commonDen(p:UP):SMP ==
+      l1:List F := coefficients p
+      l2:List SMP := [denom c for c in l1]
+      cmult l2
+
+    polyred(f:UPUP):UPUP ==
+      cmult([commonDen(retract(c)@UP) for c in coefficients f])::F::UP::QF * f
+
+    aklist f ==
+      (r := retractIfCan(f)@Union(QF, "failed")) case "failed" =>
+        "setUnion"/[klist(retract(c)@UP) for c in coefficients lift f]
+      klist(retract(r::QF)@UP)
+
+    alglist d ==
+      n := numer(i := ideal d)
+      select_!((k1:K):Boolean +-> has?(operator k1, ALGOP),
+          setUnion(klist denom i,
+            "setUnion"/[aklist qelt(n,i) for i in minIndex n..maxIndex n]))
+
+    krmod(p,k) ==
+       map(z1 +-> kqmod(z1, k),
+           p)$UnivariatePolynomialCategoryFunctions2(F, UP, UPQ, UP2)
+
+    rmod p ==
+       map(qmod, p)$UnivariatePolynomialCategoryFunctions2(F, UP, Q, UPQ)
+
+    raise(p, k) ==
+      (map(Q2F, p)$SparseUnivariatePolynomialFunctions2(Q, F)) (k::F)
+
+    raise2(p, k) ==
+      map(z1 +-> raise(z1, k),
+          p)$UnivariatePolynomialCategoryFunctions2(UPQ, UP2, F, UP)
+
+    algcurve(d, rc, k) ==
+      mn := minIndex(n := numer(i := minimize ideal d))
+      h  := kpmod(lift(hh := n(mn + 1)), k)
+      b2 := primitivePart
+                 raise2(b := krmod(retract(retract(n.mn)@QF)@UP, k), k)
+      s  := kqmod(resultant(primitivePart separate(raise2(krmod(
+                    retract(norm hh)@UP, k), k), b2).primePart, b2), k)
+      pr := kgetGoodPrime(rc, s, h, b, dd := krmod(denom i, k))
+      p  := pr.prime
+      pp := UP32UPUP(rc.ncurve, k)
+      mm := pr.poly
+      gf := InnerPrimeField p
+      m  := map((z1:Q):gf +-> retract(z1)@Z :: gf,mm)_
+              $SparseUnivariatePolynomialFunctions2(Q, gf)
+      (degree m = 1) =>
+        alpha := - coefficient(m, 0) / leadingCoefficient m
+        order(d, pp,
+           (z1:F):gf +-> (map((q1:Q):gf +-> numer(q1)::gf / denom(q1)::gf,
+            kqmod(z1,k))$SparseUnivariatePolynomialFunctions2(Q,gf))(alpha)
+                                   )$ReducedDivisor(F, UP, UPUP, R, gf)
+      sae:= SimpleAlgebraicExtension(gf,SparseUnivariatePolynomial gf,m)
+      order(d, pp,
+        (z1:F):sae +-> reduce(map((q1:Q):gf +-> numer(q1)::gf / denom(q1)::gf,
+            kqmod(z1,k))$SparseUnivariatePolynomialFunctions2(Q,gf))$sae
+                                   )$ReducedDivisor(F, UP, UPUP, R, sae)
+
+    -- returns the potential order of d, 0 if d is of infinite order
+    ratcurve(d, rc) ==
+      mn  := minIndex(nm := numer(i := minimize ideal d))
+      h   := pmod lift(hh := nm(mn + 1))
+      b   := rmod(retract(retract(nm.mn)@QF)@UP)
+      s   := separate(rmod(retract(norm hh)@UP), b).primePart
+      bd  := badNum rmod denom i
+      r   := resultant(s, b)
+      bad := lcm [rc.disc, numer r,denom r, bd.den*bd.gcdnum, badNum h]$List(Z)
+      pp  := Q2UPUP(rc.ncurve)
+      n   := rat(pp, d, p := getGoodPrime bad)
+      -- if n > 1 then it's cheaper to compute the order modulo a second prime,
+      -- since computing n * d could be very expensive
+      (n = 1) => n
+      m   := rat(pp, d, getGoodPrime(p * bad))
+      n = m => n
+      0
+
+    -- returns the order of d mod p
+    rat(pp, d, p) ==
+      gf := InnerPrimeField p
+      order(d, pp, 
+        (q1:F):gf +-> (qq := qmod q1;numer(qq)::gf / denom(qq)::gf)
+                                    )$ReducedDivisor(F, UP, UPUP, R, gf)
+
+    -- returns the potential order of d, 0 if d is of infinite order
+    possibleOrder d ==
+      zero?(genus()) or (#(numer ideal d) = 1) => 1
+      empty?(la := alglist d) => ratcurve(d, selIntegers())
+      not(empty? rest la) =>
+           error "PFO::possibleOrder: more than 1 algebraic constant"
+      algcurve(d, selectIntegers first la, first la)
+
+    selIntegers():RC0 ==
+      f := definingPolynomial()$R
+      while zero?(d := doubleDisc(r := polyred pmod f)) repeat newReduc()$q
+      [r, d]
+
+    selectIntegers(k:K):REC ==
+      g := polyred(f := definingPolynomial()$R)
+      p := minPoly k
+      while zero?(d := doubleDisc(r := kpmod(g, k))) or (notIrr? fmod p)
+          repeat newReduc()$q
+      [r, d, splitDenominator(fmod p).num]
+
+    toQ1(p, d) ==
+      map((p1:UPQ):F +-> Q2F(retract(p1 rem d)@Q),
+          p)$UnivariatePolynomialCategoryFunctions2(UPQ, UP2, F, UP)
+
+    toQ2(p, d) ==
+      reduce map((p1:UP2):QF +-> toQ1(p1, d)::QF,
+        p)$UnivariatePolynomialCategoryFunctions2(UP2, UP3, QF, UPUP)
+
+    kpmod(p, k) ==
+      map((p1:QF):UP2 +-> krmod(retract(p1)@UP, k),
+        p)$UnivariatePolynomialCategoryFunctions2(QF, UPUP, UP2, UP3)
+
+    order d ==
+      zero?(n := possibleOrder(d := reduce d)) => "failed"
+      principal? reduce(n::Z * d) => n
+      "failed"
+
+    kgetGoodPrime(rec, res, h, b, d) ==
+      p:PI := 3
+      while (u := goodRed(rec, res, h, b, d, p)) case "failed" repeat
+        p := nextPrime(p::Z)::PI
+      [p, u::UPQ]
+
+    goodRed(rec, res, h, b, d, p) ==
+      zero?(rec.disc rem p) => "failed"
+      gf := InnerPrimeField p
+      l  := [f.factor for f in factors 
+             factor(map((z1:Q):gf +-> retract(z1)@Z :: gf,
+               rec.dfpoly)$SparseUnivariatePolynomialFunctions2(Q,
+                 gf))$DistinctDegreeFactorize(gf,
+                   SparseUnivariatePolynomial gf) | (f.exponent = 1)]
+      empty? l => "failed"
+      mdg := first l
+      for ff in rest l repeat
+        if degree(ff) < degree(mdg) then mdg := ff
+      md := map((z1:gf):Q +-> convert(z1)@Z :: Q,
+                 mdg)$SparseUnivariatePolynomialFunctions2(gf, Q)
+      good?(res, h, b, d, p, md) => md
+      "failed"
+
+    good?(res, h, b, d, p, m) ==
+      bd := badNum(res rem m)
+      not (zero?(bd.den rem p) or zero?(bd.gcdnum rem p) or
+        zero?(kbadBadNum(b,m) rem p) or zero?(kbadBadNum(d,m) rem p)
+              or zero?(kbad3Num(h, m) rem p))
+
 *)
 
 \end{chunk}
@@ -160849,6 +198005,7 @@ PointsOfFiniteOrderRational(UP, UPUP, R): Exports == Implementation where
       ++ torsionIfCan(f) \undocumented
 
   Implementation ==> add
+
     import PointsOfFiniteOrderTools(UP, UPUP)
 
     possibleOrder: FD -> N
@@ -160857,7 +198014,7 @@ PointsOfFiniteOrderRational(UP, UPUP, R): Exports == Implementation where
 
     torsion? d  == order(d) case N
 
--- returns the potential order of d, 0 if d is of infinite order
+    -- returns the potential order of d, 0 if d is of infinite order
     ratcurve(d, modulus, disc) ==
       mn  := minIndex(nm := numer(i := ideal d))
       h   := lift(hh := nm(mn + 1))
@@ -160867,9 +198024,8 @@ PointsOfFiniteOrderRational(UP, UPUP, R): Exports == Implementation where
       r   := resultant(s, b)
       bad := lcm [disc, numer r, denom r, bd.den * bd.gcdnum, badNum h]$List(Z)
       n   := rat(modulus, d, p := getGoodPrime bad)
--- if n > 1 then it is cheaper to compute the order modulo a second prime,
--- since computing n * d could be very expensive
---      one? n => n
+      -- if n > 1 then it's cheaper to compute the order modulo a second prime,
+      -- since computing n * d could be very expensive
       (n = 1) => n
       m   := rat(modulus, d, getGoodPrime(p * bad))
       n = m => n
@@ -160881,9 +198037,8 @@ PointsOfFiniteOrderRational(UP, UPUP, R): Exports == Implementation where
        (z1:Q):gf +-> 
         numer(z1)::gf / denom(z1)::gf)$ReducedDivisor(Q, UP, UPUP, R, gf)
 
--- returns the potential order of d, 0 if d is of infinite order
+    -- returns the potential order of d, 0 if d is of infinite order
     possibleOrder d ==
---      zero?(genus()) or one?(#(numer ideal d)) => 1
       zero?(genus()) or (#(numer ideal d) = 1) => 1
       r := polyred definingPolynomial()$R
       ratcurve(d, r, doubleDisc r)
@@ -160903,6 +198058,54 @@ PointsOfFiniteOrderRational(UP, UPUP, R): Exports == Implementation where
 \begin{chunk}{COQ PFOQ}
 (* package PFOQ *)
 (*
+
+    import PointsOfFiniteOrderTools(UP, UPUP)
+
+    possibleOrder: FD -> N
+    ratcurve     : (FD, UPUP, Z) -> N
+    rat          : (UPUP, FD, PI) -> N
+
+    torsion? d  == order(d) case N
+
+    -- returns the potential order of d, 0 if d is of infinite order
+    ratcurve(d, modulus, disc) ==
+      mn  := minIndex(nm := numer(i := ideal d))
+      h   := lift(hh := nm(mn + 1))
+      s   := separate(retract(norm hh)@UP,
+               b := retract(retract(nm.mn)@Fraction(UP))@UP).primePart
+      bd  := badNum denom i
+      r   := resultant(s, b)
+      bad := lcm [disc, numer r, denom r, bd.den * bd.gcdnum, badNum h]$List(Z)
+      n   := rat(modulus, d, p := getGoodPrime bad)
+      -- if n > 1 then it's cheaper to compute the order modulo a second prime,
+      -- since computing n * d could be very expensive
+      (n = 1) => n
+      m   := rat(modulus, d, getGoodPrime(p * bad))
+      n = m => n
+      0
+
+    rat(pp, d, p) ==
+      gf := InnerPrimeField p
+      order(d, pp,
+       (z1:Q):gf +-> 
+        numer(z1)::gf / denom(z1)::gf)$ReducedDivisor(Q, UP, UPUP, R, gf)
+
+    -- returns the potential order of d, 0 if d is of infinite order
+    possibleOrder d ==
+      zero?(genus()) or (#(numer ideal d) = 1) => 1
+      r := polyred definingPolynomial()$R
+      ratcurve(d, r, doubleDisc r)
+
+    order d ==
+      zero?(n := possibleOrder(d := reduce d)) => "failed"
+      principal? reduce(n::Z * d) => n
+      "failed"
+
+    torsionIfCan d ==
+      zero?(n := possibleOrder(d := reduce d)) => "failed"
+      (g := generator reduce(n::Z * d)) case "failed" => "failed"
+      [n, g::R]
+
 *)
 
 \end{chunk}
@@ -160998,10 +198201,12 @@ PointsOfFiniteOrderTools(UP, UPUP): Exports == Implementation where
       ++ polyred(u) \undocumented
 
   Implementation ==> add
+
     import IntegerPrimesPackage(Z)
     import UnivariatePolynomialCommonDenominator(Z, Q, UP)
 
     mix l          == lcm(lcm [p.den for p in l], gcd [p.gcdnum for p in l])
+
     badNum(p:UPUP) == mix [badNum(retract(c)@UP) for c in coefficients p]
 
     polyred r ==
@@ -161026,6 +198231,31 @@ PointsOfFiniteOrderTools(UP, UPUP): Exports == Implementation where
 \begin{chunk}{COQ PFOTOOLS}
 (* package PFOTOOLS *)
 (*
+
+    import IntegerPrimesPackage(Z)
+    import UnivariatePolynomialCommonDenominator(Z, Q, UP)
+
+    mix l          == lcm(lcm [p.den for p in l], gcd [p.gcdnum for p in l])
+
+    badNum(p:UPUP) == mix [badNum(retract(c)@UP) for c in coefficients p]
+
+    polyred r ==
+      lcm [commonDenominator(retract(c)@UP) for c in coefficients r] * r
+
+    badNum(p:UP) ==
+      cd := splitDenominator p
+      [cd.den, gcd [retract(c)@Z for c in coefficients(cd.num)]]
+
+    getGoodPrime n ==
+      p:PI := 3
+      while zero?(n rem p) repeat
+        p := nextPrime(p::Z)::PI
+      p
+
+    doubleDisc r ==
+      d := retract(discriminant r)@UP
+      retract(discriminant((d exquo gcd(d, differentiate d))::UP))@Z
+
 *)
 
 \end{chunk}
@@ -161187,6 +198417,46 @@ PolynomialPackageForCurve(K,PolyRing,E,dim,ProjPt):Exp == Impl where
 \begin{chunk}{COQ PLPKCRV}
 (* package PLPKCRV *)
 (*
+
+    import PolyRing
+    import ProjPt
+    import PackPoly
+
+    translateToOrigin(pol,pt,nV)==
+        zero?(pt.nV) => error "Impossible de translater"
+	pt:=homogenize(pt,nV)
+	lpt:List K:=list(pt)$ProjPt
+	translate(pol,lpt,nV)
+	
+    pointInIdeal?(lstPol,pt)==
+      temp:Boolean:=true()$Boolean
+      for pol in lstPol repeat
+        temp:=(zero?(eval(pol,pt)) and temp)
+      temp
+
+    eval(f,pt)==
+      zero? f => 0
+      lpt:List(K) := list pt
+      dd:List NonNegativeInteger := entries degree f
+      lc:= leadingCoefficient f
+      ee:= reduce( "*" , [ p**e for p in lpt for e in dd | ^zero?(e)], 1$K)
+      lc * ee + eval( reductum f, pt) 
+
+    translateToOrigin(pol,pt)==
+      translateToOrigin(pol,pt,lastNonNull(pt))
+
+    multiplicity(crb,pt)==
+      degreeOfMinimalForm(translateToOrigin(crb,pt))
+
+    multiplicity(crb,pt,nV)==
+      degreeOfMinimalForm(translateToOrigin(crb,pt,nV))
+
+    minimalForm(crb,pt)==
+      minimalForm(translateToOrigin(crb,pt))
+
+    minimalForm(crb,pt,nV)==
+      minimalForm(translateToOrigin(crb,pt,nV))
+
 *)
 
 \end{chunk}
@@ -161293,30 +198563,30 @@ PolToPol(lv,R) : C == T
  
     variable1(xx:Symbol):Ov == variable(xx)::Ov
  
-   -- transform a P in a HDPoly --
+    -- transform a P in a HDPoly --
     pToHdmp(pol:P) : HDPoly ==
       map(variable1,pol)$MPC3(Symbol,Ov,IES,HDP,R,P,HDPoly)
  
-   -- transform an HDPoly in a P --
+    -- transform an HDPoly in a P --
     hdmpToP(hdpol:HDPoly) : P ==
       map(convert,hdpol)$MPC3(Ov,Symbol,HDP,IES,R,HDPoly,P)
  
-   -- transform an DPoly in a P --
+    -- transform an DPoly in a P --
     dmpToP(dpol:DPoly) : P ==
       map(convert,dpol)$MPC3(Ov,Symbol,DP,IES,R,DPoly,P)
  
-   -- transform a P in a DPoly --
+    -- transform a P in a DPoly --
     pToDmp(pol:P) : DPoly ==
       map(variable1,pol)$MPC3(Symbol,Ov,IES,DP,R,P,DPoly)
  
-   -- transform a DPoly in a HDPoly --
+    -- transform a DPoly in a HDPoly --
     dmpToHdmp(dpol:DPoly) : HDPoly ==
       dpol=0 => 0$HDPoly
       monomial(leadingCoefficient dpol,
                directProduct(degree(dpol)::VV)$HDP)$HDPoly+
                                                  dmpToHdmp(reductum dpol)
  
-   -- transform a HDPoly in a DPoly --
+    -- transform a HDPoly in a DPoly --
     hdmpToDmp(hdpol:HDPoly) : DPoly ==
       hdpol=0 => 0$DPoly
       dd:DP:= directProduct((degree hdpol)::VV)$DP
@@ -161328,6 +198598,39 @@ PolToPol(lv,R) : C == T
 \begin{chunk}{COQ POLTOPOL}
 (* package POLTOPOL *)
 (*
+
+    variable1(xx:Symbol):Ov == variable(xx)::Ov
+ 
+    -- transform a P in a HDPoly --
+    pToHdmp(pol:P) : HDPoly ==
+      map(variable1,pol)$MPC3(Symbol,Ov,IES,HDP,R,P,HDPoly)
+ 
+    -- transform an HDPoly in a P --
+    hdmpToP(hdpol:HDPoly) : P ==
+      map(convert,hdpol)$MPC3(Ov,Symbol,HDP,IES,R,HDPoly,P)
+ 
+    -- transform an DPoly in a P --
+    dmpToP(dpol:DPoly) : P ==
+      map(convert,dpol)$MPC3(Ov,Symbol,DP,IES,R,DPoly,P)
+ 
+    -- transform a P in a DPoly --
+    pToDmp(pol:P) : DPoly ==
+      map(variable1,pol)$MPC3(Symbol,Ov,IES,DP,R,P,DPoly)
+ 
+    -- transform a DPoly in a HDPoly --
+    dmpToHdmp(dpol:DPoly) : HDPoly ==
+      dpol=0 => 0$HDPoly
+      monomial(leadingCoefficient dpol,
+               directProduct(degree(dpol)::VV)$HDP)$HDPoly+
+                                                 dmpToHdmp(reductum dpol)
+ 
+    -- transform a HDPoly in a DPoly --
+    hdmpToDmp(hdpol:HDPoly) : DPoly ==
+      hdpol=0 => 0$DPoly
+      dd:DP:= directProduct((degree hdpol)::VV)$DP
+      monomial(leadingCoefficient hdpol,dd)$DPoly+
+               hdmpToDmp(reductum hdpol)
+
 *)
 
 \end{chunk}
@@ -161434,6 +198737,7 @@ PolyGroebner(F) : C == T
        ++ The variables are ordered by their position in the list lv.
  
   T == add
+
      lexGroebner(lp: L P,lv:L E) : L P ==
        PP:=  PolToPol(lv,F)
        DPoly := DistributedMultivariatePolynomial(lv,F)
@@ -161457,6 +198761,25 @@ PolyGroebner(F) : C == T
 \begin{chunk}{COQ PGROEB}
 (* package PGROEB *)
 (*
+
+     lexGroebner(lp: L P,lv:L E) : L P ==
+       PP:=  PolToPol(lv,F)
+       DPoly := DistributedMultivariatePolynomial(lv,F)
+       DP:=DirectProduct(#lv,NNI)
+       OV:=OrderedVariableList lv
+       b:L DPoly:=[pToDmp(pol)$PP for pol in lp]
+       gb:L DPoly :=groebner(b)$GroebnerPackage(F,DP,OV,DPoly)
+       [dmpToP(pp)$PP for pp in gb]
+ 
+     totalGroebner(lp: L P,lv:L E) : L P ==
+       PP:=  PolToPol(lv,F)
+       HDPoly := HomogeneousDistributedMultivariatePolynomial(lv,F)
+       HDP:=HomogeneousDirectProduct(#lv,NNI)
+       OV:=OrderedVariableList lv
+       b:L HDPoly:=[pToHdmp(pol)$PP for pol in lp]
+       gb:=groebner(b)$GroebnerPackage(F,HDP,OV,HDPoly)
+       [hdmpToP(pp)$PP for pp in gb]
+
 *)
 
 \end{chunk}
@@ -161534,9 +198857,11 @@ PolynomialAN2Expression():Target == Implementation where
         ++ \spad{p} with
         ++ algebraic number coefficients to \spadtype{Expression Integer}.
   Implementation ==> add
+
     coerce(p:PAN):EXPR ==
         map(x+->x::EXPR, y+->y::EXPR, p)$PolynomialCategoryLifting(
                                   IndexedExponents SY, SY, AN, PAN, EXPR)
+
     coerce(rf:Fraction PAN):EXPR ==
         numer(rf)::EXPR / denom(rf)::EXPR
 
@@ -161545,6 +198870,14 @@ PolynomialAN2Expression():Target == Implementation where
 \begin{chunk}{COQ PAN2EXPR}
 (* package PAN2EXPR *)
 (*
+
+    coerce(p:PAN):EXPR ==
+        map(x+->x::EXPR, y+->y::EXPR, p)$PolynomialCategoryLifting(
+                                  IndexedExponents SY, SY, AN, PAN, EXPR)
+
+    coerce(rf:Fraction PAN):EXPR ==
+        numer(rf)::EXPR / denom(rf)::EXPR
+
 *)
 
 \end{chunk}
@@ -161635,6 +198968,7 @@ PolynomialCategoryLifting(E,Vars,R,P,S): Exports == Implementation where
       ++ in S
 
   Implementation ==> add
+
     map(fv, fc, p) ==
       (x1 := mainVariable p) case "failed" => fc leadingCoefficient p
       up := univariate(p, x1::Vars)
@@ -161650,6 +198984,17 @@ PolynomialCategoryLifting(E,Vars,R,P,S): Exports == Implementation where
 \begin{chunk}{COQ POLYLIFT}
 (* package POLYLIFT *)
 (*
+
+    map(fv, fc, p) ==
+      (x1 := mainVariable p) case "failed" => fc leadingCoefficient p
+      up := univariate(p, x1::Vars)
+      t  := fv(x1::Vars)
+      ans:= fc 0
+      while not ground? up repeat
+        ans := ans + map(fv,fc, leadingCoefficient up) * t ** (degree up)
+        up  := reductum up
+      ans + map(fv, fc, leadingCoefficient up)
+
 *)
 
 \end{chunk}
@@ -161781,6 +199126,7 @@ PolynomialCategoryQuotientFunctions(E, V, R, P, F):
       ++ "failed" otherwise.
 
   Implementation ==> add
+
     P2UP: (P, V) -> UP
 
     univariate(f, x) == P2UP(numer f, x) / P2UP(denom f, x)
@@ -161817,14 +199163,12 @@ PolynomialCategoryQuotientFunctions(E, V, R, P, F):
 
     isExpt f ==
       (ur := isExpt numer f) case "failed" =>
---        one? numer f =>
         (numer f) = 1 =>
           (ur := isExpt denom f) case "failed" => "failed"
           r := ur::Record(var:V, exponent:NonNegativeInteger)
           [r.var, - (r.exponent::Integer)]
         "failed"
       r := ur::Record(var:V, exponent:NonNegativeInteger)
---      one? denom f => [r.var, r.exponent::Integer]
       (denom f) = 1 => [r.var, r.exponent::Integer]
       "failed"
 
@@ -161833,9 +199177,7 @@ PolynomialCategoryQuotientFunctions(E, V, R, P, F):
       l:Union(List F, "failed") :=
         t case "failed" => "failed"
         [x::F for x in t]
---      one?(den := denom f) => l
       ((den := denom f) = 1) => l
---      one? num => "failed"
       num = 1 => "failed"
       d := inv(den::F)
       l case "failed" => [num::F, d]
@@ -161861,6 +199203,78 @@ PolynomialCategoryQuotientFunctions(E, V, R, P, F):
 \begin{chunk}{COQ POLYCATQ}
 (* package POLYCATQ *)
 (*
+
+    P2UP: (P, V) -> UP
+
+    univariate(f, x) == P2UP(numer f, x) / P2UP(denom f, x)
+
+    univariate(f, x, modulus) ==
+      (bc := extendedEuclidean(P2UP(denom f, x), modulus, 1))
+             case "failed" => error "univariate: denominator is 0 mod p"
+      (P2UP(numer f, x) * bc.coef1) rem modulus
+
+    multivariate(f, x) ==
+      v := x::P::F
+      ((numer f) v) / ((denom f) v)
+
+    mymerge:(List V,List V) ->List V 
+    mymerge(l:List V,m:List V):List V==
+         empty? l => m
+         empty? m => l
+         first l = first m => cons(first l,mymerge(rest l,rest m))
+         first l > first m => cons(first l,mymerge(rest l,m))
+         cons(first m,mymerge(l,rest m))
+
+    variables f ==
+      mymerge(variables numer f, variables denom f)
+
+    isPower f ==
+      (den := denom f) ^= 1 =>
+        numer f ^= 1 => "failed"
+        (ur := isExpt den) case "failed" => [den::F, -1]
+        r := ur::Record(var:V, exponent:NonNegativeInteger)
+        [r.var::P::F, - (r.exponent::Integer)]
+      (ur := isExpt numer f) case "failed" => "failed"
+      r := ur::Record(var:V, exponent:NonNegativeInteger)
+      [r.var::P::F, r.exponent::Integer]
+
+    isExpt f ==
+      (ur := isExpt numer f) case "failed" =>
+        (numer f) = 1 =>
+          (ur := isExpt denom f) case "failed" => "failed"
+          r := ur::Record(var:V, exponent:NonNegativeInteger)
+          [r.var, - (r.exponent::Integer)]
+        "failed"
+      r := ur::Record(var:V, exponent:NonNegativeInteger)
+      (denom f) = 1 => [r.var, r.exponent::Integer]
+      "failed"
+
+    isTimes f ==
+      t := isTimes(num := numer f)
+      l:Union(List F, "failed") :=
+        t case "failed" => "failed"
+        [x::F for x in t]
+      ((den := denom f) = 1) => l
+      num = 1 => "failed"
+      d := inv(den::F)
+      l case "failed" => [num::F, d]
+      concat_!(l::List(F), d)
+
+    isPlus f ==
+      denom f ^= 1 => "failed"
+      (s := isPlus numer f) case "failed" => "failed"
+      [x::F for x in s]
+
+    mainVariable f ==
+      a := mainVariable numer f
+      (b := mainVariable denom f) case "failed" => a
+      a case "failed" => b
+      max(a::V, b::V)
+
+    P2UP(p, x) ==
+      map(z +-> z::F,
+          univariate(p, x))$SparseUnivariatePolynomialFunctions2(P, F)
+
 *)
 
 \end{chunk}
@@ -161927,6 +199341,7 @@ PolynomialComposition(UP: UnivariatePolynomialCategory(R), R: Ring): with
         compose: (UP, UP) -> UP
           ++ compose(p,q) \undocumented
     == add
+
         compose(g, h) ==
             r: UP := 0
             while g ^= 0 repeat
@@ -161939,6 +199354,14 @@ PolynomialComposition(UP: UnivariatePolynomialCategory(R), R: Ring): with
 \begin{chunk}{COQ PCOMP}
 (* package PCOMP *)
 (*
+
+        compose(g, h) ==
+            r: UP := 0
+            while g ^= 0 repeat
+                r := leadingCoefficient(g)*h**degree(g) + r
+                g := reductum g
+            r
+
 *)
 
 \end{chunk}
@@ -162026,6 +199449,7 @@ PolynomialDecomposition(UP, F): PDcat == PDdef where
         rightFactorCandidate:  (UP, NNI) -> UP
           ++ rightFactorCandidate(p,n) \undocumented
     PDdef == add
+
         leftFactor(f, h) ==
              g: UP := 0
              for i in 0.. while f ^= 0 repeat
@@ -162051,6 +199475,7 @@ PolynomialDecomposition(UP, F): PDcat == PDdef where
                 g case UP => return
                     append(decompose(g::UP), decompose h)
             [f]
+
         rightFactorCandidate(f, dh) ==
             f  := f/leadingCoefficient f
             df := degree f
@@ -162058,7 +199483,8 @@ PolynomialDecomposition(UP, F): PDcat == PDdef where
             h  := monomial(1, dh)
             for k in 1..dh repeat
                 hdg:= h**dg
-                c  := (coefficient(f,(df-k)::NNI)-coefficient(hdg,(df-k)::NNI))/(dg::F)
+                c  := (coefficient(f,(df-k)::NNI)-_
+                       coefficient(hdg,(df-k)::NNI))/(dg::F)
                 h  := h + monomial(c, (dh-k)::NNI)
             h - monomial(coefficient(h, 0), 0) -- drop constant term
 
@@ -162067,6 +199493,45 @@ PolynomialDecomposition(UP, F): PDcat == PDdef where
 \begin{chunk}{COQ PDECOMP}
 (* package PDECOMP *)
 (*
+
+        leftFactor(f, h) ==
+             g: UP := 0
+             for i in 0.. while f ^= 0 repeat
+                 fr := divide(f, h)
+                 f := fr.quotient; r := fr.remainder
+                 degree r > 0 => return "failed"
+                 g := g + r * monomial(1, i)
+             g
+ 
+        decompose(f, dg, dh) ==
+            df := degree f
+            dg*dh ^= df => "failed"
+            h := rightFactorCandidate(f, dh)
+            g := leftFactor(f, h)
+            g case "failed" => "failed"
+            [g::UP, h]
+ 
+        decompose f ==
+            df := degree f
+            for dh in 2..df-1 | df rem dh = 0 repeat
+                h := rightFactorCandidate(f, dh)
+                g := leftFactor(f, h)
+                g case UP => return
+                    append(decompose(g::UP), decompose h)
+            [f]
+
+        rightFactorCandidate(f, dh) ==
+            f  := f/leadingCoefficient f
+            df := degree f
+            dg := df quo dh
+            h  := monomial(1, dh)
+            for k in 1..dh repeat
+                hdg:= h**dg
+                c  := (coefficient(f,(df-k)::NNI)-_
+                       coefficient(hdg,(df-k)::NNI))/(dg::F)
+                h  := h + monomial(c, (dh-k)::NNI)
+            h - monomial(coefficient(h, 0), 0) -- drop constant term
+
 *)
 
 \end{chunk}
@@ -162182,10 +199647,12 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public ==
      factorSFBRlcUnit: (List VarSet, SupS) -> Factored SupS
         ++ factorSFBRlcUnit(p) returns the square free factorization of
         ++ polynomial p
-        ++ (see \spadfun{factorSquareFreeByRecursion}{PolynomialFactorizationByRecursionUnivariate})
+        ++ (see \spadfun{factorSquareFreeByRecursion}
+        ++ {PolynomialFactorizationByRecursionUnivariate})
         ++ in the case where the leading coefficient of p
         ++ is a unit.
   private  == add
+
    supR: SparseUnivariatePolynomial R
    pp: SupS
    lpolys,factors: List SupS
@@ -162214,15 +199681,19 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public ==
      --++ drop in degree
    chooseFSQViableSubstitutions: (List VarSet,SupS) ->
     Record(substnsField:List R,ppRField:SupR)
-     --++ chooseFSQViableSubstitutions(lv,p) chooses substitutions for the variables in first arg (which are all
+     --++ chooseFSQViableSubstitutions(lv,p) chooses substitutions 
+     --++ for the variables in first arg (which are all
      --++ the variables that exist) so that the second argument poly doesn't
      --++ drop in degree and remains square-free
    raise: SupR -> SupS
    lower: SupS -> SupR
+
    SLPEBR: (List SupS, List VarSet, SupS, List VarSet)  ->
                                          Union(List SupS,"failed")
+
    factorSFBRlcUnitInner: (List VarSet, SupS,R) ->
                                          Union(Factored SupS,"failed")
+
    hensel(pp,vv,r,factors) ==
       origFactors:=factors
       totdegree:Integer:=0
@@ -162281,7 +199752,9 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public ==
       hen:=hensel(pp,first lvpp,r,factors)
       hen case "failed" => "failed"
       makeFR(1,[["irred",u,1] for u in hen.fctrs])
+
    if R has StepThrough then
+
      factorSFBRlcUnit(lvpp,pp) ==
        val:R := init()
        while true repeat
@@ -162291,26 +199764,38 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public ==
           val1 case "failed" =>
             error "at this point, we know we have a finite field"
           val:=val1
+
    else
+
      factorSFBRlcUnit(lvpp,pp) ==
        val:R := randomR()
        while true repeat
           tempAns:=factorSFBRlcUnitInner(lvpp,pp,val)
           not (tempAns case "failed") => return tempAns
           val := randomR()
+
    if R has random: -> R then
+
       randomR() == random()
-   else randomR() == (random()$Integer)::R
+
+   else 
+
+      randomR() == (random()$Integer)::R
+
    if R has FiniteFieldCategory then
+
      bivariateSLPEBR(lpolys,pp,v) ==
        lpolysR:List SupSupR:=[map(univariate,u) for u in lpolys]
        ppR: SupSupR:=map(univariate,pp)
        ans:=solveLinearPolynomialEquation(lpolysR,ppR)$SupR
        ans case "failed" => "failed"
        [map(z1 +-> multivariate(z1,v),w) for w in ans]
+
    else
+
      bivariateSLPEBR(lpolys,pp,v) ==
        solveLinearPolynomialEquationByFractions(lpolys,pp)$LPEBFS
+
    chooseFSQViableSubstitutions(lvpp,pp) ==
      substns:List R
      ppR: SupR
@@ -162321,6 +199806,7 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public ==
         degree gcd(ppR,differentiate ppR)>0 => "next"
         leave
      [substns,ppR]
+
    chooseSLPEViableSubstitutions(lvpolys,lpolys,pp) ==
      substns:List R
      lpolysR:List SupR
@@ -162340,8 +199826,11 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public ==
         leave
      ppR:=map(z1 +-> (retract eval(z1,lvpolys,substns))::R,pp)
      [substns,lpolysR,ppR]
+
    raise(supR) == map(z1 +-> z1:R::S,supR)
+
    lower(pp) == map(z1 +-> retract(z1)::R,pp)
+
    SLPEBR(lpolys,lvpolys,pp,lvpp) ==
      not empty? (m:=setDifference(lvpp,lvpolys)) =>
          v:=first m
@@ -162388,6 +199877,7 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public ==
      pp:=(pp exquo c)::SupS
      mergeFactors(refine(squareFree pp,factorSquareFreeByRecursion),
                   map(z1 +-> z1:S::SupS,factor(c)$S))
+
    factorSquareFreeByRecursion pp ==
      lv:List(VarSet) := removeDuplicates_!
                            concat [variables z for z in coefficients pp]
@@ -162433,6 +199923,272 @@ PolynomialFactorizationByRecursion(R,E, VarSet:OrderedSet, S): public ==
 \begin{chunk}{COQ PFBR}
 (* package PFBR *)
 (*
+
+   supR: SparseUnivariatePolynomial R
+   pp: SupS
+   lpolys,factors: List SupS
+   vv:VarSet
+   lvpolys,lvpp: List VarSet
+   r:R
+   lr:List R
+   import FactoredFunctionUtilities(SupS)
+   import FactoredFunctions2(S,SupS)
+   import FactoredFunctions2(SupR,SupS)
+   import CommuteUnivariatePolynomialCategory(S,SupS, SupSupS)
+   import UnivariatePolynomialCategoryFunctions2(S,SupS,SupS,SupSupS)
+   import UnivariatePolynomialCategoryFunctions2(SupS,SupSupS,S,SupS)
+   import UnivariatePolynomialCategoryFunctions2(S,SupS,R,SupR)
+   import UnivariatePolynomialCategoryFunctions2(R,SupR,S,SupS)
+   import UnivariatePolynomialCategoryFunctions2(S,SupS,SupR,SupSupR)
+   import UnivariatePolynomialCategoryFunctions2(SupR,SupSupR,S,SupS)
+   hensel: (SupS,VarSet,R,List SupS) ->
+           Union(Record(fctrs:List SupS),"failed")
+   chooseSLPEViableSubstitutions: (List VarSet,List SupS,SupS) ->
+    Record(substnsField:List R,lpolysRField:List SupR,ppRField:SupR)
+     --++ chooseSLPEViableSubstitutions(lv,lp,p) chooses substitutions
+     --++ for the variables in first arg (which are all
+     --++ the variables that exist) so that the polys in second argument don't
+     --++ drop in degree and remain square-free, and third arg doesn't drop
+     --++ drop in degree
+   chooseFSQViableSubstitutions: (List VarSet,SupS) ->
+    Record(substnsField:List R,ppRField:SupR)
+     --++ chooseFSQViableSubstitutions(lv,p) chooses substitutions 
+     --++ for the variables in first arg (which are all
+     --++ the variables that exist) so that the second argument poly doesn't
+     --++ drop in degree and remains square-free
+   raise: SupR -> SupS
+   lower: SupS -> SupR
+
+   SLPEBR: (List SupS, List VarSet, SupS, List VarSet)  ->
+                                         Union(List SupS,"failed")
+
+   factorSFBRlcUnitInner: (List VarSet, SupS,R) ->
+                                         Union(Factored SupS,"failed")
+
+   hensel(pp,vv,r,factors) ==
+      origFactors:=factors
+      totdegree:Integer:=0
+      proddegree:Integer:=
+                   "max"/[degree(u,vv) for u in coefficients pp]
+      n:PI:=1
+      prime:=vv::S - r::S
+      foundFactors:List SupS:=empty()
+      while (totdegree <= proddegree) repeat
+          pn:=prime**n
+          Ecart:=(pp-*/factors) exquo  pn
+          Ecart case "failed" =>
+                error "failed lifting in hensel in PFBR"
+          zero? Ecart =>
+             -- then we have all the factors
+             return [append(foundFactors, factors)]
+          step:=solveLinearPolynomialEquation(origFactors,
+                                              map(z1 +-> eval(z1,vv,r),
+                                                  Ecart))
+          step case "failed" => return "failed" -- must be a false split
+          factors:=[a+b*pn for a in factors for b in step]
+          for a in factors for c in origFactors repeat
+              pp1:= pp exquo a
+              pp1 case "failed" => "next"
+              pp:=pp1
+              proddegree := proddegree - "max"/[degree(u,vv)
+                                                for u in coefficients a]
+              factors:=remove(a,factors)
+              origFactors:=remove(c,origFactors)
+              foundFactors:=[a,:foundFactors]
+          #factors < 2 =>
+             return [(empty? factors => foundFactors;
+                                     [pp,:foundFactors])]
+          totdegree:= +/["max"/[degree(u,vv)
+                                for u in coefficients u1]
+                         for u1 in factors]
+          n:=n+1
+      "failed" -- must have been a false split
+
+   factorSFBRlcUnitInner(lvpp,pp,r) ==
+      -- pp is square-free as a Sup, and its coefficients have precisely
+      -- the variables of lvpp. Furthermore, its LC is a unit
+      -- returns "failed" if the substitution is bad, else a factorization
+      ppR:=map(z1 +-> eval(z1,first lvpp,r),pp)
+      degree ppR < degree pp => "failed"
+      degree gcd(ppR,differentiate ppR) >0 => "failed"
+      factors:=
+         empty? rest lvpp =>
+            fDown:=factorSquareFreePolynomial map(z1 +-> retract(z1)::R,ppR)
+            [raise (unit fDown * factorList(fDown).first.fctr),
+             :[raise u.fctr for u in factorList(fDown).rest]]
+         fSame:=factorSFBRlcUnit(rest lvpp,ppR)
+         [unit fSame * factorList(fSame).first.fctr,
+          :[uu.fctr for uu in factorList(fSame).rest]]
+      #factors = 1 => makeFR(1,[["irred",pp,1]])
+      hen:=hensel(pp,first lvpp,r,factors)
+      hen case "failed" => "failed"
+      makeFR(1,[["irred",u,1] for u in hen.fctrs])
+
+   if R has StepThrough then
+
+     factorSFBRlcUnit(lvpp,pp) ==
+       val:R := init()
+       while true repeat
+          tempAns:=factorSFBRlcUnitInner(lvpp,pp,val)
+          not (tempAns case "failed") => return tempAns
+          val1:=nextItem val
+          val1 case "failed" =>
+            error "at this point, we know we have a finite field"
+          val:=val1
+
+   else
+
+     factorSFBRlcUnit(lvpp,pp) ==
+       val:R := randomR()
+       while true repeat
+          tempAns:=factorSFBRlcUnitInner(lvpp,pp,val)
+          not (tempAns case "failed") => return tempAns
+          val := randomR()
+
+   if R has random: -> R then
+
+      randomR() == random()
+
+   else 
+
+      randomR() == (random()$Integer)::R
+
+   if R has FiniteFieldCategory then
+
+     bivariateSLPEBR(lpolys,pp,v) ==
+       lpolysR:List SupSupR:=[map(univariate,u) for u in lpolys]
+       ppR: SupSupR:=map(univariate,pp)
+       ans:=solveLinearPolynomialEquation(lpolysR,ppR)$SupR
+       ans case "failed" => "failed"
+       [map(z1 +-> multivariate(z1,v),w) for w in ans]
+
+   else
+
+     bivariateSLPEBR(lpolys,pp,v) ==
+       solveLinearPolynomialEquationByFractions(lpolys,pp)$LPEBFS
+
+   chooseFSQViableSubstitutions(lvpp,pp) ==
+     substns:List R
+     ppR: SupR
+     while true repeat
+        substns:= [randomR() for v in lvpp]
+        zero? eval(leadingCoefficient pp,lvpp,substns ) => "next"
+        ppR:=map(z1 +->(retract eval(z1,lvpp,substns))::R,pp)
+        degree gcd(ppR,differentiate ppR)>0 => "next"
+        leave
+     [substns,ppR]
+
+   chooseSLPEViableSubstitutions(lvpolys,lpolys,pp) ==
+     substns:List R
+     lpolysR:List SupR
+     ppR: SupR
+     while true repeat
+        substns:= [randomR() for v in lvpolys]
+        zero? eval(leadingCoefficient pp,lvpolys,substns ) => "next"
+        "or"/[zero? eval(leadingCoefficient u,lvpolys,substns)
+                    for u in lpolys] => "next"
+        lpolysR:=[map(z1 +-> (retract eval(z1,lvpolys,substns))::R,u)
+                  for u in lpolys]
+        uu:=lpolysR
+        while not empty? uu repeat
+          "or"/[ degree(gcd(uu.first,v))>0 for v in uu.rest] => leave
+          uu:=rest uu
+        not empty? uu => "next"
+        leave
+     ppR:=map(z1 +-> (retract eval(z1,lvpolys,substns))::R,pp)
+     [substns,lpolysR,ppR]
+
+   raise(supR) == map(z1 +-> z1:R::S,supR)
+
+   lower(pp) == map(z1 +-> retract(z1)::R,pp)
+
+   SLPEBR(lpolys,lvpolys,pp,lvpp) ==
+     not empty? (m:=setDifference(lvpp,lvpolys)) =>
+         v:=first m
+         lvpp:=remove(v,lvpp)
+         pp1:SupSupS :=swap map(z1 +-> univariate(z1,v),pp)
+         -- pp1 is mathematically equal to pp, but is in S[z][v]
+         -- so we wish to operate on all of its coefficients
+         ans:List SupSupS:= [0 for u in lpolys]
+         for m in reverse_! monomials pp1 repeat
+             ans1:=SLPEBR(lpolys,lvpolys,leadingCoefficient m,lvpp)
+             ans1 case "failed" => return "failed"
+             d:=degree m
+             ans:=[monomial(a1,d)+a for a in ans for a1 in ans1]
+         [map(z1 +-> multivariate(z1,v),swap pp1) for pp1 in ans]
+     empty? lvpolys =>
+         lpolysR:List SupR
+         ppR:SupR
+         lpolysR:=[map(retract,u) for u in lpolys]
+         ppR:=map(retract,pp)
+         ansR:=solveLinearPolynomialEquation(lpolysR,ppR)
+         ansR case "failed" => return "failed"
+         [map(z1 +-> z1::S,uu) for uu in ansR]
+     cVS:=chooseSLPEViableSubstitutions(lvpolys,lpolys,pp)
+     ansR:=solveLinearPolynomialEquation(cVS.lpolysRField,cVS.ppRField)
+     ansR case "failed" => "failed"
+     #lvpolys = 1 => bivariateSLPEBR(lpolys,pp, first lvpolys)
+     solveLinearPolynomialEquationByFractions(lpolys,pp)$LPEBFS
+
+   solveLinearPolynomialEquationByRecursion(lpolys,pp) ==
+     lvpolys := removeDuplicates_!
+                  concat [ concat [variables z for z in coefficients u]
+                                               for u in lpolys]
+     lvpp := removeDuplicates_!
+                concat [variables z for z in coefficients pp]
+     SLPEBR(lpolys,lvpolys,pp,lvpp)
+
+   factorByRecursion pp ==
+     lv:List(VarSet) := removeDuplicates_!
+                           concat [variables z for z in coefficients pp]
+     empty? lv =>
+         map(raise,factorPolynomial lower pp)
+     c:=content pp
+     unit? c => refine(squareFree pp,factorSquareFreeByRecursion)
+     pp:=(pp exquo c)::SupS
+     mergeFactors(refine(squareFree pp,factorSquareFreeByRecursion),
+                  map(z1 +-> z1:S::SupS,factor(c)$S))
+
+   factorSquareFreeByRecursion pp ==
+     lv:List(VarSet) := removeDuplicates_!
+                           concat [variables z for z in coefficients pp]
+     empty? lv =>
+         map(raise,factorPolynomial lower pp)
+     unit? (lcpp := leadingCoefficient pp) => factorSFBRlcUnit(lv,pp)
+     oldnfact:NonNegativeInteger:= 999999
+                       -- I hope we never have to factor a polynomial
+                       -- with more than this number of factors
+     lcppPow:S
+     while true repeat
+       cVS:=chooseFSQViableSubstitutions(lv,pp)
+       factorsR:=factorSquareFreePolynomial(cVS.ppRField)
+       (nfact:=numberOfFactors factorsR) = 1 =>
+                  return makeFR(1,[["irred",pp,1]])
+       -- OK, force all leading coefficients to be equal to the leading
+       -- coefficient of the input
+       nfact > oldnfact => "next"   -- can't be a good reduction
+       oldnfact:=nfact
+       factors:=[(lcpp exquo leadingCoefficient u.fctr)::S * raise u.fctr
+                  for u in factorList factorsR]
+       ppAdjust:=(lcppPow:=lcpp**#(rest factors)) * pp
+       lvppList:=lv
+       OK:=true
+       for u in lvppList for v in cVS.substnsField repeat
+           hen:=hensel(ppAdjust,u,v,factors)
+           hen case "failed" =>
+               OK:=false
+               "leave"
+           factors:=hen.fctrs
+       OK => leave
+     factors:=[ (lc:=content w;
+                 lcppPow:=(lcppPow exquo lc)::S;
+                  (w exquo lc)::SupS)
+                for w in factors]
+     not unit? lcppPow =>
+         error "internal error in factorSquareFreeByRecursion"
+     makeFR((recip lcppPow)::S::SupS,
+             [["irred",w,1] for w in factors])
+
 *)
 
 \end{chunk}
@@ -162548,6 +200304,7 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where
         ++ in the case where the leading coefficient of p
         ++ is a unit.
   private  == add
+
    supR: SparseUnivariatePolynomial R
    pp: SupS
    lpolys,factors: List SupS
@@ -162576,6 +200333,7 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where
    -- N.B., we know that R is NOT a FiniteField, since
    -- that is meant to have a special implementation, to break the
    -- recursion
+
    solveLinearPolynomialEquationByRecursion(lpolys,pp) ==
      lhsdeg:="max"/["max"/[degree v for v in coefficients u] for u in lpolys]
      rhsdeg:="max"/[degree v for v in coefficients pp]
@@ -162591,6 +200349,7 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where
                     for c in recAns for d in answer]
        answer
      solveLinearPolynomialEquationByFractions(lpolys,pp)$LPEBFS
+
    -- local function definitions
    hensel(pp,r,factors) ==
       -- factors is a relatively prime factorization of pp modulo the ideal
@@ -162634,6 +200393,7 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where
           n:=n+1
           pn:=pn*prime
       "failed" -- must have been a false split
+
    chooseFSQViableSubstitutions(pp) ==
      substns:R
      ppR: SupR
@@ -162644,8 +200404,11 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where
         degree gcd(ppR,differentiate ppR)>0 => "next"
         leave
      [substns,ppR]
+
    raise(supR) == map(z1 +-> z1:R::S,supR)
+
    lower(pp) == map(z1 +-> retract(z1)::R,pp)
+
    factorSFBRlcUnitInner(pp,r) ==
       -- pp is square-free as a Sup, but the Up  variable occurs.
       -- Furthermore, its LC is a unit
@@ -162662,7 +200425,9 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where
       hen case "failed" => "failed"
       makeFR(1,[["irred",u,1] for u in hen.fctrs])
    -- exported function definitions
+
    if R has StepThrough then
+
      factorSFBRlcUnit(pp) ==
        val:R := init()
        while true repeat
@@ -162672,15 +200437,20 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where
           val1 case "failed" =>
             error "at this point, we know we have a finite field"
           val:=val1
+
    else
+
      factorSFBRlcUnit(pp) ==
        val:R := randomR()
        while true repeat
           tempAns:=factorSFBRlcUnitInner(pp,val)
           not (tempAns case "failed") => return tempAns
           val := randomR()
+
    if R has StepThrough then
+
       randomCount:R:= init()
+
       randomR() ==
         v:=nextItem(randomCount)
         v case "failed" =>
@@ -162689,9 +200459,15 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where
           randomCount
         randomCount:=v
         randomCount
+
    else if R has random: -> R then
+
       randomR() == random()
-   else randomR() == (random()$Integer rem 100)::R
+
+   else
+
+      randomR() == (random()$Integer rem 100)::R
+
    factorByRecursion pp ==
      and/[zero? degree u for u in coefficients pp] =>
          map(raise,factorPolynomial lower pp)
@@ -162700,6 +200476,7 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where
      pp:=(pp exquo c)::SupS
      mergeFactors(refine(squareFree pp,factorSquareFreeByRecursion),
                   map(z1 +-> z1:S::SupS,factor(c)$S))
+
    factorSquareFreeByRecursion pp ==
      and/[zero? degree u for u in coefficients pp] =>
         map(raise,factorSquareFreePolynomial lower pp)
@@ -162724,8 +200501,6 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where
        -- factors now multiplies to give cVS.ppRField * lcppR^(#factors-1)
        -- Now change the leading coefficient to be lcpp
        factors:=[monomial(lcpp,degree u) + reductum u for u in factors]
---     factors:=[(lcpp exquo leadingCoefficient u.fctr)::S * raise u.fctr
---                for u in factorList factorsR]
        ppAdjust:=(lcppPow:=lcpp**#(rest factors)) * pp
        OK:=true
        hen:=hensel(ppAdjust,cVS.substnsField,factors)
@@ -162746,6 +200521,218 @@ PolynomialFactorizationByRecursionUnivariate(R, S): public == private where
 \begin{chunk}{COQ PFBRU}
 (* package PFBRU *)
 (*
+
+   supR: SparseUnivariatePolynomial R
+   pp: SupS
+   lpolys,factors: List SupS
+   r:R
+   lr:List R
+   import FactoredFunctionUtilities(SupS)
+   import FactoredFunctions2(SupR,SupS)
+   import FactoredFunctions2(S,SupS)
+   import UnivariatePolynomialCategoryFunctions2(S,SupS,R,SupR)
+   import UnivariatePolynomialCategoryFunctions2(R,SupR,S,SupS)
+   -- local function declarations
+   raise: SupR -> SupS
+   lower: SupS -> SupR
+   factorSFBRlcUnitInner: (SupS,R) -> Union(Factored SupS,"failed")
+   hensel: (SupS,R,List SupS) ->
+           Union(Record(fctrs:List SupS),"failed")
+   chooseFSQViableSubstitutions: (SupS) ->
+    Record(substnsField:R,ppRField:SupR)
+     --++ chooseFSQViableSubstitutions(p), p is a sup
+     --++ ("sparse univariate polynomial")
+     --++ over a sup over R, returns a record
+     --++ \spad{[substnsField: r, ppRField: q]} where r is a substitution point
+     --++ q is a sup over R so that the (implicit) variable in q
+     --++ does not drop in degree and remains square-free.
+   -- here for the moment, until it compiles
+   -- N.B., we know that R is NOT a FiniteField, since
+   -- that is meant to have a special implementation, to break the
+   -- recursion
+
+   solveLinearPolynomialEquationByRecursion(lpolys,pp) ==
+     lhsdeg:="max"/["max"/[degree v for v in coefficients u] for u in lpolys]
+     rhsdeg:="max"/[degree v for v in coefficients pp]
+     lhsdeg = 0 =>
+       lpolysLower:=[lower u for u in lpolys]
+       answer:List SupS := [0 for u in lpolys]
+       for i in 0..rhsdeg repeat
+         ppx:=map((z1:S):R +-> coefficient(z1,i),pp)
+         zero? ppx => "next"
+         recAns:= solveLinearPolynomialEquation(lpolysLower,ppx)
+         recAns case "failed" => return "failed"
+         answer:=[monomial(1,i)$S * raise c + d
+                    for c in recAns for d in answer]
+       answer
+     solveLinearPolynomialEquationByFractions(lpolys,pp)$LPEBFS
+
+   -- local function definitions
+   hensel(pp,r,factors) ==
+      -- factors is a relatively prime factorization of pp modulo the ideal
+      -- (x-r), with suitably imposed leading coefficients.
+      -- This is lifted, without re-combinations, to a factorization
+      -- return "failed" if this can't be done
+      origFactors:=factors
+      totdegree:Integer:=0
+      proddegree:Integer:=
+                   "max"/[degree(u) for u in coefficients pp]
+      n:PI:=1
+      pn:=prime:=monomial(1,1) - r::S
+      foundFactors:List SupS:=empty()
+      while (totdegree <= proddegree) repeat
+          Ecart:=(pp-*/factors) exquo  pn
+          Ecart case "failed" =>
+                error "failed lifting in hensel in PFBRU"
+          zero? Ecart =>
+             -- then we have all the factors
+             return [append(foundFactors, factors)]
+          step:=solveLinearPolynomialEquation(origFactors,
+                                              map(z1 +-> elt(z1,r::S),
+                                                  Ecart))
+          step case "failed" => return "failed" -- must be a false split
+          factors:=[a+b*pn for a in factors for b in step]
+          for a in factors for c in origFactors repeat
+              pp1:= pp exquo a
+              pp1 case "failed" => "next"
+              pp:=pp1
+              proddegree := proddegree - "max"/[degree(u)
+                                                for u in coefficients a]
+              factors:=remove(a,factors)
+              origFactors:=remove(c,origFactors)
+              foundFactors:=[a,:foundFactors]
+          #factors < 2 =>
+             return [(empty? factors => foundFactors;
+                                     [pp,:foundFactors])]
+          totdegree:= +/["max"/[degree(u)
+                                for u in coefficients u1]
+                         for u1 in factors]
+          n:=n+1
+          pn:=pn*prime
+      "failed" -- must have been a false split
+
+   chooseFSQViableSubstitutions(pp) ==
+     substns:R
+     ppR: SupR
+     while true repeat
+        substns:= randomR()
+        zero? elt(leadingCoefficient pp,substns ) => "next"
+        ppR:=map(z1 +-> elt(z1,substns),pp)
+        degree gcd(ppR,differentiate ppR)>0 => "next"
+        leave
+     [substns,ppR]
+
+   raise(supR) == map(z1 +-> z1:R::S,supR)
+
+   lower(pp) == map(z1 +-> retract(z1)::R,pp)
+
+   factorSFBRlcUnitInner(pp,r) ==
+      -- pp is square-free as a Sup, but the Up  variable occurs.
+      -- Furthermore, its LC is a unit
+      -- returns "failed" if the substitution is bad, else a factorization
+      ppR:=map(z1 +-> elt(z1,r),pp)
+      degree ppR < degree pp => "failed"
+      degree gcd(ppR,differentiate ppR) >0 => "failed"
+      factors:=
+        fDown:=factorSquareFreePolynomial ppR
+        [raise (unit fDown * factorList(fDown).first.fctr),
+         :[raise u.fctr for u in factorList(fDown).rest]]
+      #factors = 1 => makeFR(1,[["irred",pp,1]])
+      hen:=hensel(pp,r,factors)
+      hen case "failed" => "failed"
+      makeFR(1,[["irred",u,1] for u in hen.fctrs])
+   -- exported function definitions
+
+   if R has StepThrough then
+
+     factorSFBRlcUnit(pp) ==
+       val:R := init()
+       while true repeat
+          tempAns:=factorSFBRlcUnitInner(pp,val)
+          not (tempAns case "failed") => return tempAns
+          val1:=nextItem val
+          val1 case "failed" =>
+            error "at this point, we know we have a finite field"
+          val:=val1
+
+   else
+
+     factorSFBRlcUnit(pp) ==
+       val:R := randomR()
+       while true repeat
+          tempAns:=factorSFBRlcUnitInner(pp,val)
+          not (tempAns case "failed") => return tempAns
+          val := randomR()
+
+   if R has StepThrough then
+
+      randomCount:R:= init()
+
+      randomR() ==
+        v:=nextItem(randomCount)
+        v case "failed" =>
+          SAY$Lisp "Taking another set of random values"
+          randomCount:=init()
+          randomCount
+        randomCount:=v
+        randomCount
+
+   else if R has random: -> R then
+
+      randomR() == random()
+
+   else
+
+      randomR() == (random()$Integer rem 100)::R
+
+   factorByRecursion pp ==
+     and/[zero? degree u for u in coefficients pp] =>
+         map(raise,factorPolynomial lower pp)
+     c:=content pp
+     unit? c => refine(squareFree pp,factorSquareFreeByRecursion)
+     pp:=(pp exquo c)::SupS
+     mergeFactors(refine(squareFree pp,factorSquareFreeByRecursion),
+                  map(z1 +-> z1:S::SupS,factor(c)$S))
+
+   factorSquareFreeByRecursion pp ==
+     and/[zero? degree u for u in coefficients pp] =>
+        map(raise,factorSquareFreePolynomial lower pp)
+     unit? (lcpp := leadingCoefficient pp) => factorSFBRlcUnit(pp)
+     oldnfact:NonNegativeInteger:= 999999
+                       -- I hope we never have to factor a polynomial
+                       -- with more than this number of factors
+     lcppPow:S
+     while true repeat  -- a loop over possible false splits
+       cVS:=chooseFSQViableSubstitutions(pp)
+       newppR:=primitivePart cVS.ppRField
+       factorsR:=factorSquareFreePolynomial(newppR)
+       (nfact:=numberOfFactors factorsR) = 1 =>
+                  return makeFR(1,[["irred",pp,1]])
+       -- OK, force all leading coefficients to be equal to the leading
+       -- coefficient of the input
+       nfact > oldnfact => "next"   -- can't be a good reduction
+       oldnfact:=nfact
+       lcppR:=leadingCoefficient cVS.ppRField
+       factors:=[raise((lcppR exquo leadingCoefficient u.fctr) ::R * u.fctr)
+                  for u in factorList factorsR]
+       -- factors now multiplies to give cVS.ppRField * lcppR^(#factors-1)
+       -- Now change the leading coefficient to be lcpp
+       factors:=[monomial(lcpp,degree u) + reductum u for u in factors]
+       ppAdjust:=(lcppPow:=lcpp**#(rest factors)) * pp
+       OK:=true
+       hen:=hensel(ppAdjust,cVS.substnsField,factors)
+       hen case "failed" => "next"
+       factors:=hen.fctrs
+       leave
+     factors:=[ (lc:=content w;
+                 lcppPow:=(lcppPow exquo lc)::S;
+                  (w exquo lc)::SupS)
+                for w in factors]
+     not unit? lcppPow =>
+         error "internal error in factorSquareFreeByRecursion"
+     makeFR((recip lcppPow)::S::SupS,
+             [["irred",w,1] for w in factors])
+
 *)
 
 \end{chunk}
@@ -162811,16 +200798,21 @@ PolynomialFunctions2(R:Ring, S:Ring): with
     ++ map(f, p) produces a new polynomial as a result of applying
     ++ the function f to every coefficient of the polynomial p.
  == add
+
   map(f, p) == map(x1 +-> x1::Polynomial(S), x2 +-> f(x2)::Polynomial(S),
                    p)$PolynomialCategoryLifting(IndexedExponents Symbol,
                                    Symbol, R, Polynomial R, Polynomial S)
 
-
 \end{chunk}
 
 \begin{chunk}{COQ POLY2}
 (* package POLY2 *)
 (*
+
+  map(f, p) == map(x1 +-> x1::Polynomial(S), x2 +-> f(x2)::Polynomial(S),
+                   p)$PolynomialCategoryLifting(IndexedExponents Symbol,
+                                   Symbol, R, Polynomial R, Polynomial S)
+
 *)
 
 \end{chunk}
@@ -162995,11 +200987,11 @@ PolynomialGcdPackage(E,OV,R,P):C == T where
       lift  :(SUPP,SUP,SUP,P,List OV,List NNI,List R) -> Union(SUPP,"failed")
  
                      ---- Local  functions ----
-    -- test if something wrong happened in the gcd
+      -- test if something wrong happened in the gcd
       failtest(f:SUPP,p1:SUPP,p2:SUPP) : Boolean ==
         (p1 exquo f) case "failed" or (p2 exquo f) case "failed"
  
-    -- Choose the integers
+      -- Choose the integers
       chooseVal(p1:SUPP,p2:SUPP,lvr:List OV,_
                 ltry:List List R):Union(UTerm,"failed") ==
         d1:=degree(p1)
@@ -163019,16 +201011,13 @@ PolynomialGcdPackage(E,OV,R,P):C == T where
           degree uf2 ^= d2 => "new point"
           u:=gcd(uf1,uf2)
           du:=degree u
-         --the univariate gcd is 1
+          --the univariate gcd is 1
           if du=0 then return [[1$SUP],ltry,0$SUPP]$UTerm
- 
           ugcd:List SUP:=[u,(uf1 exquo u)::SUP,(uf2 exquo u)::SUP]
           uterm:=[ugcd,ltry,0$SUPP]$UTerm
           dd=0 => dd:=du
- 
-        --the degree is not changed
+          --the degree is not changed
           du=dd =>
- 
            --test if one of the polynomials is the gcd
             dd=d1 =>
               if ^((f:=p2 exquo p1) case "failed") then
@@ -163040,8 +201029,7 @@ PolynomialGcdPackage(E,OV,R,P):C == T where
                 return [[u],ltry,p2]$UTerm
               dd:=(dd-1)::NNI
             return uterm
- 
-         --the new gcd has degree less
+          --the new gcd has degree less
           du<dd => dd:=du
  
       good(f:SUPP,lvr:List OV, _
@@ -163072,6 +201060,7 @@ algorithm so {\sl all} remainders are normalized. Without this
 constraint the remainders will have huge numerators and denominators.
 
 \begin{chunk}{package PGCD PolynomialGcdPackage}
+
       -- impose the right leading condition, check for failure.
       imposelc(lipol:List SUP, lvar:List OV, lval:List R,
                leadc:List P): Union(List SUP, "failed") ==
@@ -163083,7 +201072,7 @@ constraint the remainders will have huge numerators and denominators.
            result := cons(p1u::SUP, result)
         reverse result
  
-    --Compute the gcd between not coprime polynomials
+      --Compute the gcd between not coprime polynomials
       notCoprime(g:SUPP, p2:SUPP, ldeg:List NNI,_
                  lvar1:List OV, ltry:List List R) : SUPP ==
         g1:=gcd(g,differentiate g)
@@ -163135,43 +201124,38 @@ constraint the remainders will have huge numerators and denominators.
         -- special cases
         result=1 => 1$SUPP
         while failtest(result,p1,p2) repeat
---        SAY$Lisp  "retrying gcd"
           ltry:=totResult.goodint
           totResult:=localgcd(p1,p2,lvar,ltry)
           result:=totResult.locgcd
         result
  
-    --local function for the gcd : it returns the evaluation point too
+       --local function for the gcd : it returns the evaluation point too
       localgcd(p1:SUPP,p2:SUPP,lvar:List(OV),ltry:List List R) : LGcd ==
         uterm:=chooseVal(p1,p2,lvar,ltry)::UTerm
         ltry:=uterm.lint
         listpol:= uterm.lpol
         ud:=listpol.first
         dd:= degree ud
- 
         --the univariate gcd is 1
         dd=0 => [1$SUPP,ltry]$LGcd
- 
         --one of the polynomials is the gcd
         dd=degree(p1) or dd=degree(p2) =>
                          [uterm.mpol,ltry]$LGcd
         ldeg:List NNI:=map(min,degree(p1,lvar),degree(p2,lvar))
- 
-       -- if there is a polynomial g s.t. g/gcd and gcd are coprime ...
+        -- if there is a polynomial g s.t. g/gcd and gcd are coprime ...
         -- I can lift
         (h:=lift?(p1,p2,uterm,ldeg,lvar)) case notCoprime =>
           [notCoprime(p1,p2,ldeg,lvar,ltry),ltry]$LGcd
         h case failed => localgcd(p1,p2,lvar,ltry) -- skip bad values?
         [h.s,ltry]$LGcd
  
- 
-  -- content, internal functions return the poly if it is a monomial
+      -- content, internal functions return the poly if it is a monomial
       monomContent(p:SUPP):SUPP ==
         degree(p)=0 => 1
         md:= minimumDegree(p)
         monomial(gcd sort(better,coefficients p),md)
  
-  -- Ordering for gcd purposes
+      -- Ordering for gcd purposes
       better(p1:P,p2:P):Boolean ==
         ground? p1 => true
         ground? p2 => false
@@ -163188,8 +201172,8 @@ constraint the remainders will have huge numerators and denominators.
                   ress := cons(p, ress)
           cons(best, ress)
 
-  -- Gcd between polynomial p1 and p2 with
-  -- mainVariable p1 < x=mainVariable p2
+      -- Gcd between polynomial p1 and p2 with
+      -- mainVariable p1 < x=mainVariable p2
       gcdTermList(p1:P,p2:P) : P ==
         termList := best_to_front(
            cons(p1,coefficients univariate(p2,(mainVariable p2)::OV)))
@@ -163197,7 +201181,7 @@ constraint the remainders will have huge numerators and denominators.
         for term in termList.rest until q = 1$P repeat q:= gcd(q,term)
         q
  
-  -- Gcd between polynomials with the same mainVariable
+      -- Gcd between polynomials with the same mainVariable
       gcd(p1:SUPP,p2:SUPP): SUPP ==
         if degree(p1) > degree(p2) then (p1,p2):= (p2,p1)
         degree p1 = 0 =>
@@ -163212,7 +201196,7 @@ constraint the remainders will have huge numerators and denominators.
         p2:= (p2 exquo c2)::SUPP
         gcdPrimitive(p1,p2) * gcdMonom(c1,c2)
  
-   -- gcd between 2 monomials
+      -- gcd between 2 monomials
       gcdMonom(m1:SUPP,m2:SUPP):SUPP ==
         monomial(gcd(leadingCoefficient(m1),leadingCoefficient(m2)),
                  min(degree(m1),degree(m2)))
@@ -163227,7 +201211,7 @@ See Volume 10.1 for more details.
  
 \begin{chunk}{package PGCD PolynomialGcdPackage}
 
-    --If there is a pol s.t. pol/gcd and gcd are coprime I can lift
+       --If there is a pol s.t. pol/gcd and gcd are coprime I can lift
       lift?(p1:SUPP,p2:SUPP,uterm:UTerm,ldeg:List NNI, _
             lvar:List OV) : _
               Union(s:SUPP,failed:"failed",notCoprime:"notCoprime") ==
@@ -163246,7 +201230,7 @@ See Volume 10.1 for more details.
         l case "failed" => ["failed"]
         [l :: SUPP]
  
-   -- interface with the general "lifting" function
+       -- interface with the general "lifting" function
       lift(f:SUPP,d:SUP,uf:SUP,lgcd:P,lvar:List OV,
                         ldeg:List NNI,lval:List R):Union(SUPP,"failed") ==
         leadpol : Boolean := false
@@ -163280,7 +201264,7 @@ See Volume 10.1 for more details.
         not leadpol => p0
         p0 exquo content(p0)
  
-  -- Gcd for two multivariate polynomials
+      -- Gcd for two multivariate polynomials
       gcd(p1:P,p2:P) : P ==
         ground? p1 =>
           p1 := unitCanonical p1
@@ -163301,7 +201285,7 @@ See Volume 10.1 for more details.
         mv1 < mv2 => gcdTermList(p1,p2)
         gcdTermList(p2,p1)
  
-  -- Gcd for a list of multivariate polynomials
+      -- Gcd for a list of multivariate polynomials
       gcd(listp:List P) : P ==
         lf := best_to_front(listp)
         f:=lf.first
@@ -163319,7 +201303,7 @@ See Volume 10.1 for more details.
         f
 
  
-   -- Gcd for primitive polynomials
+      -- Gcd for primitive polynomials
       gcdPrimitive(p1:P,p2:P):P ==
         (p1:= unitCanonical(p1)) = (p2:= unitCanonical(p2)) => p1
         ground? p1 =>
@@ -163343,7 +201327,7 @@ See Volume 10.1 for more details.
           mp*multivariate(gcdPrimitive(up1,up2),mv1)
         1$P
  
-  -- Gcd for a list of primitive multivariate polynomials
+      -- Gcd for a list of primitive multivariate polynomials
       gcdPrimitive(listp:List P) : P ==
         lf:=sort(better,listp)
         f:=lf.first
@@ -163357,6 +201341,359 @@ See Volume 10.1 for more details.
 \begin{chunk}{COQ PGCD}
 (* package PGCD *)
 (*
+ 
+      SUP      ==> SparseUnivariatePolynomial R
+ 
+      LGcd     ==> Record(locgcd:SUPP,goodint:List List R)
+      UTerm    ==> Record(lpol:List SUP,lint:List List R,mpol:SUPP)
+      pmod:R   :=  (prevPrime(2**26)$IntegerPrimesPackage(Integer))::R
+ 
+      import MultivariateLifting(E,OV,R,P)
+      import FactoringUtilities(E,OV,R,P)
+ 
+                 --------  Local  Functions  --------
+ 
+      myran           :    Integer   -> Union(R,"failed")
+      better          :    (P,P)     -> Boolean
+      failtest        :   (SUPP,SUPP,SUPP)    -> Boolean
+      monomContent    :   (SUPP)   -> SUPP
+      gcdMonom        :  (SUPP,SUPP)    -> SUPP
+      gcdTermList     :    (P,P)     -> P
+      good :  (SUPP,List OV,List List R) -> Record(upol:SUP,inval:List List R)
+ 
+      chooseVal :  (SUPP,SUPP,List OV,List List R) -> Union(UTerm,"failed")
+      localgcd        :  (SUPP,SUPP,List OV,List List R) -> LGcd
+      notCoprime      :  (SUPP,SUPP, List NNI,List OV,List List R)   -> SUPP
+      imposelc        : (List SUP,List OV,List R,List P) -> 
+                          Union(List SUP, "failed")
+ 
+      lift? :(SUPP,SUPP,UTerm,List NNI,List OV) -> _
+               Union(s:SUPP,failed:"failed",notCoprime:"notCoprime")
+      lift  :(SUPP,SUP,SUP,P,List OV,List NNI,List R) -> Union(SUPP,"failed")
+ 
+                     ---- Local  functions ----
+      -- test if something wrong happened in the gcd
+      failtest(f:SUPP,p1:SUPP,p2:SUPP) : Boolean ==
+        (p1 exquo f) case "failed" or (p2 exquo f) case "failed"
+ 
+      -- Choose the integers
+      chooseVal(p1:SUPP,p2:SUPP,lvr:List OV,_
+                ltry:List List R):Union(UTerm,"failed") ==
+        d1:=degree(p1)
+        d2:=degree(p2)
+        dd:NNI:=0$NNI
+        nvr:NNI:=#lvr
+        lval:List R :=[]
+        range:I:=8
+        repeat
+          range:=2*range
+          lval:=[ran(range) for i in 1..nvr]
+          member?(lval,ltry) => "new point"
+          ltry:=cons(lval,ltry)
+          uf1:SUP:=completeEval(p1,lvr,lval)
+          degree uf1 ^= d1 => "new point"
+          uf2:SUP:= completeEval(p2,lvr,lval)
+          degree uf2 ^= d2 => "new point"
+          u:=gcd(uf1,uf2)
+          du:=degree u
+          --the univariate gcd is 1
+          if du=0 then return [[1$SUP],ltry,0$SUPP]$UTerm
+          ugcd:List SUP:=[u,(uf1 exquo u)::SUP,(uf2 exquo u)::SUP]
+          uterm:=[ugcd,ltry,0$SUPP]$UTerm
+          dd=0 => dd:=du
+          --the degree is not changed
+          du=dd =>
+           --test if one of the polynomials is the gcd
+            dd=d1 =>
+              if ^((f:=p2 exquo p1) case "failed") then
+                return [[u],ltry,p1]$UTerm
+              if dd^=d2 then dd:=(dd-1)::NNI
+ 
+            dd=d2 =>
+              if ^((f:=p1 exquo p2) case "failed") then
+                return [[u],ltry,p2]$UTerm
+              dd:=(dd-1)::NNI
+            return uterm
+          --the new gcd has degree less
+          du<dd => dd:=du
+ 
+      good(f:SUPP,lvr:List OV, _
+           ltry:List List R):Record(upol:SUP,inval:List List R) ==
+        nvr:NNI:=#lvr
+        range:I:=1
+        while true repeat
+          range:=2*range
+          lval:=[ran(range) for i in 1..nvr]
+          member?(lval,ltry) => "new point"
+          ltry:=cons(lval,ltry)
+          uf:=completeEval(f,lvr,lval)
+          if degree gcd(uf,differentiate uf)=0 then return [uf,ltry]
+
+      -- impose the right leading condition, check for failure.
+      imposelc(lipol:List SUP, lvar:List OV, lval:List R,
+               leadc:List P): Union(List SUP, "failed") ==
+        result:List SUP :=[]
+        for pol in lipol for leadpol in leadc repeat
+           p1 := univariate eval(leadpol, lvar, lval) * pol
+           p1u := p1 exquo leadingCoefficient pol
+           p1u case "failed" => return "failed"
+           result := cons(p1u::SUP, result)
+        reverse result
+ 
+      --Compute the gcd between not coprime polynomials
+      notCoprime(g:SUPP, p2:SUPP, ldeg:List NNI,_
+                 lvar1:List OV, ltry:List List R) : SUPP ==
+        g1:=gcd(g,differentiate g)
+        l1 := (g exquo g1)::SUPP
+        lg:LGcd:=localgcd(l1,p2,lvar1,ltry)
+        (l,ltry):=(lg.locgcd,lg.goodint)
+        lval:=ltry.first
+        p2l:=(p2 exquo l)::SUPP
+        (gd1,gd2):=(l,l)
+        ul:=completeEval(l,lvar1,lval)
+        dl:=degree ul
+        if degree gcd(ul,differentiate ul) ^=0 then
+          newchoice:=good(l,lvar1,ltry)
+          ul:=newchoice.upol
+          ltry:=newchoice.inval
+          lval:=ltry.first
+        ug1:=completeEval(g1,lvar1,lval)
+        ulist:=[ug1,completeEval(p2l,lvar1,lval)]
+        lcpol:List P:=[leadingCoefficient g1, leadingCoefficient p2]
+        while true repeat
+          d:SUP:=gcd(cons(ul,ulist))
+          if degree d =0 then return gd1
+          lquo:=(ul exquo d)::SUP
+          if degree lquo ^=0 then
+            lgcd:=gcd(cons(leadingCoefficient l,lcpol))
+            (gdl:=lift(l,d,lquo,lgcd,lvar1,ldeg,lval)) case "failed" =>
+               return notCoprime(g,p2,ldeg,lvar1,ltry)
+            l:=gd2:=gdl::SUPP
+            ul:=completeEval(l,lvar1,lval)
+            dl:=degree ul
+          gd1:=gd1*gd2
+          ulist:=[(uf exquo d)::SUP for uf in ulist]
+ 
+      gcdPrimitive(p1:SUPP,p2:SUPP) : SUPP ==
+        if (d1:=degree(p1)) > (d2:=degree(p2)) then
+            (p1,p2):= (p2,p1)
+            (d1,d2):= (d2,d1)
+        degree p1 = 0 =>
+            p1 = 0 => unitCanonical p2
+            unitCanonical p1
+        lvar:List OV:=
+          sort((a:OV,b:OV):Boolean+->a>b,setUnion(variables p1,variables p2))
+        empty? lvar =>
+           raisePolynomial(gcd(lowerPolynomial p1,lowerPolynomial p2))
+        (p2 exquo p1) case SUPP => unitCanonical p1
+        ltry:List List R:=empty()
+        totResult:=localgcd(p1,p2,lvar,ltry)
+        result: SUPP:=totResult.locgcd
+        -- special cases
+        result=1 => 1$SUPP
+        while failtest(result,p1,p2) repeat
+          ltry:=totResult.goodint
+          totResult:=localgcd(p1,p2,lvar,ltry)
+          result:=totResult.locgcd
+        result
+ 
+       --local function for the gcd : it returns the evaluation point too
+      localgcd(p1:SUPP,p2:SUPP,lvar:List(OV),ltry:List List R) : LGcd ==
+        uterm:=chooseVal(p1,p2,lvar,ltry)::UTerm
+        ltry:=uterm.lint
+        listpol:= uterm.lpol
+        ud:=listpol.first
+        dd:= degree ud
+        --the univariate gcd is 1
+        dd=0 => [1$SUPP,ltry]$LGcd
+        --one of the polynomials is the gcd
+        dd=degree(p1) or dd=degree(p2) =>
+                         [uterm.mpol,ltry]$LGcd
+        ldeg:List NNI:=map(min,degree(p1,lvar),degree(p2,lvar))
+        -- if there is a polynomial g s.t. g/gcd and gcd are coprime ...
+        -- I can lift
+        (h:=lift?(p1,p2,uterm,ldeg,lvar)) case notCoprime =>
+          [notCoprime(p1,p2,ldeg,lvar,ltry),ltry]$LGcd
+        h case failed => localgcd(p1,p2,lvar,ltry) -- skip bad values?
+        [h.s,ltry]$LGcd
+ 
+      -- content, internal functions return the poly if it is a monomial
+      monomContent(p:SUPP):SUPP ==
+        degree(p)=0 => 1
+        md:= minimumDegree(p)
+        monomial(gcd sort(better,coefficients p),md)
+ 
+      -- Ordering for gcd purposes
+      better(p1:P,p2:P):Boolean ==
+        ground? p1 => true
+        ground? p2 => false
+        degree(p1,mainVariable(p1)::OV) < degree(p2,mainVariable(p2)::OV)
+ 
+      best_to_front(l : List P) : List P ==
+          ress := []
+          best := first(l)
+          for p in rest l repeat
+              if better(p, best) then
+                  ress := cons(best, ress)
+                  best := p
+              else
+                  ress := cons(p, ress)
+          cons(best, ress)
+
+      -- Gcd between polynomial p1 and p2 with
+      -- mainVariable p1 < x=mainVariable p2
+      gcdTermList(p1:P,p2:P) : P ==
+        termList := best_to_front(
+           cons(p1,coefficients univariate(p2,(mainVariable p2)::OV)))
+        q:P:=termList.first
+        for term in termList.rest until q = 1$P repeat q:= gcd(q,term)
+        q
+ 
+      -- Gcd between polynomials with the same mainVariable
+      gcd(p1:SUPP,p2:SUPP): SUPP ==
+        if degree(p1) > degree(p2) then (p1,p2):= (p2,p1)
+        degree p1 = 0 =>
+           p1 = 0 => unitCanonical p2
+           p1 = 1 => unitCanonical p1
+           gcd(leadingCoefficient p1, content p2)::SUPP
+        reductum(p1)=0 => gcdMonom(p1,monomContent p2)
+        c1:= monomContent(p1)
+        reductum(p2)=0 => gcdMonom(c1,p2)
+        c2:= monomContent(p2)
+        p1:= (p1 exquo c1)::SUPP
+        p2:= (p2 exquo c2)::SUPP
+        gcdPrimitive(p1,p2) * gcdMonom(c1,c2)
+ 
+      -- gcd between 2 monomials
+      gcdMonom(m1:SUPP,m2:SUPP):SUPP ==
+        monomial(gcd(leadingCoefficient(m1),leadingCoefficient(m2)),
+                 min(degree(m1),degree(m2)))
+
+       --If there is a pol s.t. pol/gcd and gcd are coprime I can lift
+      lift?(p1:SUPP,p2:SUPP,uterm:UTerm,ldeg:List NNI, _
+            lvar:List OV) : _
+              Union(s:SUPP,failed:"failed",notCoprime:"notCoprime") ==
+        (listpol, lval) := (uterm.lpol, first(uterm.lint))
+        d := first(listpol)
+        listpol := rest(listpol)
+        uf := listpol(1)
+        f := p1
+        --note uf and d not necessarily primitive
+        if degree gcd(uf, d) ~= 0 then
+          uf := listpol(2)
+          f := p2
+          if degree gcd(uf, d) ~= 0 then return ["notCoprime"]
+        lgcd := gcd(leadingCoefficient p1, leadingCoefficient p2)
+        l := lift(f, d, uf, lgcd, lvar, ldeg, lval)
+        l case "failed" => ["failed"]
+        [l :: SUPP]
+ 
+       -- interface with the general "lifting" function
+      lift(f:SUPP,d:SUP,uf:SUP,lgcd:P,lvar:List OV,
+                        ldeg:List NNI,lval:List R):Union(SUPP,"failed") ==
+        leadpol : Boolean := false
+        lcf : P
+        lcf := leadingCoefficient f
+        df := degree f
+        leadlist : List(P) := []
+
+        if lgcd ^= 1 then
+          leadpol := true
+          f := lgcd*f
+          ldeg := [n0+n1 for n0 in ldeg for n1 in degree(lgcd, lvar)]
+          lcd : R := leadingCoefficient d
+          lgcd1 :=
+              degree(lgcd) = 0 => retract lgcd
+              retract(eval(lgcd, lvar, lval))
+          du := (lgcd1*d) exquo lcd
+          du case "failed" => "failed"
+          d := du::SUP
+          uf := lcd*uf
+        leadlist := [lgcd, lcf]
+        lgu := imposelc([d, uf], lvar, lval, leadlist)
+        lgu case "failed" => "failed"
+        lg := lgu::List(SUP)
+        (pl := lifting(f,lvar,lg,lval,leadlist,ldeg,pmod)) case "failed" =>
+               "failed"
+        plist := pl :: List SUPP
+        (p0 : SUPP, p1 : SUPP) := (plist.first, plist.2)
+        if completeEval(p0, lvar, lval) ^= lg.first then
+           (p0, p1) := (p1, p0)
+        not leadpol => p0
+        p0 exquo content(p0)
+ 
+      -- Gcd for two multivariate polynomials
+      gcd(p1:P,p2:P) : P ==
+        ground? p1 =>
+          p1 := unitCanonical p1
+          p1 = 1$P => p1
+          p1 = 0$P => unitCanonical p2
+          ground? p2 => gcd((retract p1)@R,(retract p2)@R)::P
+          gcdTermList(p1,p2)
+        ground? p2 =>
+          p2 := unitCanonical p2
+          p2 = 1$P => p2
+          p2 = 0$P => unitCanonical p1
+          gcdTermList(p2,p1)
+        (p1:= unitCanonical(p1)) = (p2:= unitCanonical(p2)) => p1
+        mv1:= mainVariable(p1)::OV
+        mv2:= mainVariable(p2)::OV
+        mv1 = mv2 => multivariate(gcd(univariate(p1,mv1),
+                                      univariate(p2,mv1)),mv1)
+        mv1 < mv2 => gcdTermList(p1,p2)
+        gcdTermList(p2,p1)
+ 
+      -- Gcd for a list of multivariate polynomials
+      gcd(listp:List P) : P ==
+        lf := best_to_front(listp)
+        f:=lf.first
+        for g in lf.rest repeat
+          f:=gcd(f,g)
+          if f=1$P then return f
+        f
+
+      gcd(listp:List SUPP) : SUPP ==
+        lf:=sort((z1:SUPP,z2:SUPP):Boolean +-> degree(z1)<degree(z2),listp)
+        f:=lf.first
+        for g in lf.rest repeat
+          f:=gcd(f,g)
+          if f=1 then return f
+        f
+
+ 
+      -- Gcd for primitive polynomials
+      gcdPrimitive(p1:P,p2:P):P ==
+        (p1:= unitCanonical(p1)) = (p2:= unitCanonical(p2)) => p1
+        ground? p1 =>
+          ground? p2 => gcd((retract p1)@R,(retract p2)@R)::P
+          p1 = 0$P => p2
+          1$P
+        ground? p2 =>
+          p2 = 0$P => p1
+          1$P
+        mv1:= mainVariable(p1)::OV
+        mv2:= mainVariable(p2)::OV
+        mv1 = mv2 =>
+          md:=min(minimumDegree(p1,mv1),minimumDegree(p2,mv2))
+          mp:=1$P
+          if md>1 then
+            mp:=(mv1::P)**md
+            p1:=(p1 exquo mp)::P
+            p2:=(p2 exquo mp)::P
+          up1 := univariate(p1,mv1)
+          up2 := univariate(p2,mv2)
+          mp*multivariate(gcdPrimitive(up1,up2),mv1)
+        1$P
+ 
+      -- Gcd for a list of primitive multivariate polynomials
+      gcdPrimitive(listp:List P) : P ==
+        lf:=sort(better,listp)
+        f:=lf.first
+        for g in lf.rest repeat
+          f:=gcdPrimitive(f,g)
+          if f=1$P then return f
+        f
+
 *)
 
 \end{chunk}
@@ -163429,6 +201766,7 @@ PolynomialInterpolation(xx, F): Cat == Body   where
           ++ interpolate(lf,lg) \undocumented
  
     Body ==> add
+
         PIA ==> PolynomialInterpolationAlgorithms
  
         interpolate(qx, lx, ly) ==
@@ -163443,6 +201781,16 @@ PolynomialInterpolation(xx, F): Cat == Body   where
 \begin{chunk}{COQ PINTERP}
 (* package PINTERP *)
 (*
+
+        PIA ==> PolynomialInterpolationAlgorithms
+ 
+        interpolate(qx, lx, ly) ==
+            px := LagrangeInterpolation(lx, ly)$PIA(F, UP(xx, F))
+            elt(px, qx)
+ 
+        interpolate(lx, ly) ==
+            LagrangeInterpolation(lx, ly)$PIA(F, SUP F)
+
 *)
 
 \end{chunk}
@@ -163510,6 +201858,7 @@ PolynomialInterpolationAlgorithms(F, P): Cat == Body   where
           ++ LagrangeInterpolation(l1,l2) \undocumented
  
     Body ==> add
+
         LagrangeInterpolation(lx, ly) ==
             #lx ^= #ly =>
                 error "Different number of points and values."
@@ -163528,6 +201877,20 @@ PolynomialInterpolationAlgorithms(F, P): Cat == Body   where
 \begin{chunk}{COQ PINTERPA}
 (* package PINTERPA *)
 (*
+
+        LagrangeInterpolation(lx, ly) ==
+            #lx ^= #ly =>
+                error "Different number of points and values."
+            ip: P := 0
+            for xi in lx for yi in ly for i in 0.. repeat
+                pp: P := 1
+                xp: F := 1
+                for xj in lx for j in 0.. | i ^= j repeat
+                    pp := pp * (monomial(1,1) - monomial(xj,0))
+                    xp := xp * (xi - xj)
+                ip := ip + (yi/xp) * pp
+            ip
+
 *)
 
 \end{chunk}
@@ -163666,6 +202029,7 @@ PolynomialNumberTheoryFunctions(): Exports == Implementation where
     ++ from the two term recurrence.  The generating function is:
     ++ \spad{1/sqrt(1-2*t*x+t**2) = sum(P[n](x)*t**n, n=0..infinity)}.
  Implementation ==> add
+
   import IntegerPrimesPackage(I)
 
   x := monomial(1,1)$SUP(I)
@@ -163810,6 +202174,146 @@ PolynomialNumberTheoryFunctions(): Exports == Implementation where
 \begin{chunk}{COQ PNTHEORY}
 (* package PNTHEORY *)
 (*
+
+  import IntegerPrimesPackage(I)
+
+  x := monomial(1,1)$SUP(I)
+  y := monomial(1,1)$SUP(RN)
+
+  -- For functions computed via a fixed term recurrence we record
+  -- previous values so that the next value can be computed directly
+
+  E : Record(En:I, Ev:SUP(RN)) := [0,1]
+  B : Record( Bn:I, Bv:SUP(RN) ) := [0,1]
+  H : Record( Hn:I, H1:SUP(I), H2:SUP(I) ) := [0,1,x]
+  L : Record( Ln:I, L1:SUP(I), L2:SUP(I) ) := [0,1,x]
+  P : Record( Pn:I, P1:SUP(RN), P2:SUP(RN) ) := [0,1,y]
+  CT : Record( Tn:I, T1:SUP(I), T2:SUP(I) ) := [0,1,x]
+  U : Record( Un:I, U1:SUP(I), U2:SUP(I) ) := [0,1,0]
+
+  MonicQuotient: (SUP(I),SUP(I)) -> SUP(I)
+  MonicQuotient (a,b) ==
+    leadingCoefficient(b) ^= 1 => error "divisor must be monic"
+    b = 1 => a
+    da := degree a
+    db := degree b            -- assertion: degree b > 0
+    q:SUP(I) := 0
+    while da >= db repeat
+      t := monomial(leadingCoefficient a, (da-db)::NNI)
+      a := a - b * t
+      q := q + t
+      da := degree a
+    q
+
+  cyclotomic n ==
+    --++ cyclotomic polynomial denoted phi[n](x)
+    p:I; q:I; r:I; s:I; m:NNI; c:SUP(I); t:SUP(I)
+    n < 0 => error "cyclotomic not defined for negative integers"
+    n = 0 => x
+    k := n; s := p := 1
+    c := x - 1
+    while k > 1 repeat
+      p := nextPrime p
+      (q,r) := divide(k, p)
+      if r = 0 then
+        while r = 0 repeat (k := q; (q,r) := divide(k,p))
+        t := multiplyExponents(c,p::NNI)
+        c := MonicQuotient(t,c)
+        s := s * p
+    m := (n quo s) :: NNI
+    multiplyExponents(c,m)
+
+  euler n ==
+    p : SUP(RN); t : SUP(RN); c : RN; s : I
+    n < 0 => error "euler not defined for negative integers"
+    if n < E.En then (s,p) := (0$I,1$SUP(RN)) else (s,p) := E
+    -- (s,p) := if n < E.En then (0,1) else E
+    for i in s+1 .. n repeat
+      t := (i::RN) * integrate p
+      c := euler(i)$IntegerNumberTheoryFunctions / 2**(i::NNI) - t(1/2)
+      p := t + c::SUP(RN)
+    E.En := n
+    E.Ev := p
+    p
+
+  bernoulli n ==
+    p : SUP RN; t : SUP RN; c : RN; s : I
+    n < 0 => error "bernoulli not defined for negative integers"
+    if n < B.Bn then (s,p) := (0$I,1$SUP(RN)) else (s,p) := B
+    -- (s,p) := if n < B.Bn then (0,1) else B
+    for i in s+1 .. n repeat
+      t := (i::RN) * integrate p
+      c := bernoulli(i)$IntegerNumberTheoryFunctions
+      p := t + c::SUP(RN)
+    B.Bn := n
+    B.Bv := p
+    p
+
+  fixedDivisor a ==
+    g:I; d:NNI; SUP(I)
+    d := degree a
+    g := coefficient(a, minimumDegree a)
+    for k in 1..d while g > 1 repeat g := gcd(g,a k)
+    g
+
+  hermite n ==
+    s : I; p : SUP(I); q : SUP(I)
+    n < 0 => error "hermite not defined for negative integers"
+    -- (s,p,q) := if n < H.Hn then (0,1,x) else H
+    if n < H.Hn then (s := 0; p := 1; q := x) else (s,p,q) := H
+    for k in s+1 .. n repeat (p,q) := (2*x*p-2*(k-1)*q,p)
+    H.Hn := n
+    H.H1 := p
+    H.H2 := q
+    p
+
+  legendre n ==
+    s:I; t:I; p:SUP(RN); q:SUP(RN)
+    n < 0 => error "legendre not defined for negative integers"
+    -- (s,p,q) := if n < P.Pn then (0,1,y) else P
+    if n < P.Pn then (s := 0; p := 1; q := y) else (s,p,q) := P
+    for k in s+1 .. n repeat
+      t := k-1
+      (p,q) := ((k+t)$I/k*y*p - t/k*q,p)
+    P.Pn := n
+    P.P1 := p
+    P.P2 := q
+    p
+
+  laguerre n ==
+    k:I; s:I; t:I; p:SUP(I); q:SUP(I)
+    n < 0 => error "laguerre not defined for negative integers"
+    -- (s,p,q) := if n < L.Ln then (0,1,x) else L
+    if n < L.Ln then (s := 0; p := 1; q := x) else (s,p,q) := L
+    for k in s+1 .. n repeat
+      t := k-1
+      (p,q) := ((((k+t)$I)::SUP(I)-x)*p-t**2*q,p)
+    L.Ln := n
+    L.L1 := p
+    L.L2 := q
+    p
+
+  chebyshevT n ==
+    s : I; p : SUP(I); q : SUP(I)
+    n < 0 => error "chebyshevT not defined for negative integers"
+    -- (s,p,q) := if n < CT.Tn then (0,1,x) else CT
+    if n < CT.Tn then (s := 0; p := 1; q := x) else (s,p,q) := CT
+    for k in s+1 .. n repeat (p,q) := ((2*x*p - q),p)
+    CT.Tn := n
+    CT.T1 := p
+    CT.T2 := q
+    p
+
+  chebyshevU n ==
+    s : I; p : SUP(I); q : SUP(I)
+    n < 0 => error "chebyshevU not defined for negative integers"
+    if n < U.Un then (s := 0; p := 1; q := 0) else (s,p,q) := U
+    for k in s+1 .. n repeat (p,q) := ((2*x*p - q),p)
+    U.Un := n
+    U.U1 := p
+    U.U2 := q
+    p
+
 *)
 
 \end{chunk}
@@ -163916,6 +202420,7 @@ PolynomialRoots(E, V, R, P, F):Exports == Implementation where
       ++ nthr(p,n) should be local but conditional
 
   Implementation ==> add
+
     import FactoredFunctions Z
     import FactoredFunctions P
 
@@ -163923,12 +202428,12 @@ PolynomialRoots(E, V, R, P, F):Exports == Implementation where
     zroot : (Z, N) -> Record(exponent:N, coef:Z, radicand:Z)
 
     zroot(x, n) ==
---      zero? x or one? x => [1, x, 1]
       zero? x or (x = 1) => [1, x, 1]
       s := nthRoot(squareFree x, n)
       [s.exponent, s.coef, */s.radicand]
 
     if R has imaginary: () -> R then
+
       czroot: (Z, N) -> REC
 
       czroot(x, n) ==
@@ -163944,7 +202449,9 @@ PolynomialRoots(E, V, R, P, F):Exports == Implementation where
         [m, sn.coef / sd.coef,
                     (sn.radicand ** (m quo sn.exponent)) /
                                 (sd.radicand ** (m quo sd.exponent))]
+
     else
+
       qroot(x, n) ==
         sn := zroot(numer x, n)
         sd := zroot(denom x, n)
@@ -163954,18 +202461,23 @@ PolynomialRoots(E, V, R, P, F):Exports == Implementation where
                                 (sd.radicand ** (m quo sd.exponent))::F]
 
     if R has RetractableTo Fraction Z then
+
       rroot(x, n) ==
         (r := retractIfCan(x)@Union(Fraction Z,"failed")) case "failed"
           => [n, 1, x::P::F]
         qroot(r::Q, n)
 
     else
+
       if R has RetractableTo Z then
+
         rroot(x, n) ==
           (r := retractIfCan(x)@Union(Z,"failed")) case "failed"
             => [n, 1, x::P::F]
           qroot(r::Z::Q, n)
+
       else
+
         rroot(x, n) == [n, 1, x::P::F]
 
     rsplit l ==
@@ -163979,15 +202491,18 @@ PolynomialRoots(E, V, R, P, F):Exports == Implementation where
 
     if R has GcdDomain then
       if R has RetractableTo Z then
+
         nthr(x, n) ==
           (r := retractIfCan(x)@Union(Z,"failed")) case "failed"
              => nthRoot(squareFree x, n)
           rec := zroot(r::Z, n)
           [rec.exponent, rec.coef::P, [rec.radicand::P]]
-      else nthr(x, n) == nthRoot(squareFree x, n)
+
+      else 
+
+        nthr(x, n) == nthRoot(squareFree x, n)
 
       froot(x, n) ==
---        zero? x or one? x => [1, x, 1]
         zero? x or (x = 1) => [1, x, 1]
         sn := nthr(numer x, n)
         sd := nthr(denom x, n)
@@ -164008,6 +202523,104 @@ PolynomialRoots(E, V, R, P, F):Exports == Implementation where
 \begin{chunk}{COQ POLYROOT}
 (* package POLYROOT *)
 (*
+
+    import FactoredFunctions Z
+    import FactoredFunctions P
+
+    rsplit: List P -> Record(coef:R, poly:P)
+    zroot : (Z, N) -> Record(exponent:N, coef:Z, radicand:Z)
+
+    zroot(x, n) ==
+      zero? x or (x = 1) => [1, x, 1]
+      s := nthRoot(squareFree x, n)
+      [s.exponent, s.coef, */s.radicand]
+
+    if R has imaginary: () -> R then
+
+      czroot: (Z, N) -> REC
+
+      czroot(x, n) ==
+        rec := zroot(x, n)
+        rec.exponent = 2 and rec.radicand < 0 =>
+          [rec.exponent, rec.coef * imaginary()::P::F, (-rec.radicand)::F]
+        [rec.exponent, rec.coef::F, rec.radicand::F]
+
+      qroot(x, n) ==
+        sn := czroot(numer x, n)
+        sd := czroot(denom x, n)
+        m  := lcm(sn.exponent, sd.exponent)::N
+        [m, sn.coef / sd.coef,
+                    (sn.radicand ** (m quo sn.exponent)) /
+                                (sd.radicand ** (m quo sd.exponent))]
+
+    else
+
+      qroot(x, n) ==
+        sn := zroot(numer x, n)
+        sd := zroot(denom x, n)
+        m  := lcm(sn.exponent, sd.exponent)::N
+        [m, sn.coef::F / sd.coef::F,
+                    (sn.radicand ** (m quo sn.exponent))::F /
+                                (sd.radicand ** (m quo sd.exponent))::F]
+
+    if R has RetractableTo Fraction Z then
+
+      rroot(x, n) ==
+        (r := retractIfCan(x)@Union(Fraction Z,"failed")) case "failed"
+          => [n, 1, x::P::F]
+        qroot(r::Q, n)
+
+    else
+
+      if R has RetractableTo Z then
+
+        rroot(x, n) ==
+          (r := retractIfCan(x)@Union(Z,"failed")) case "failed"
+            => [n, 1, x::P::F]
+          qroot(r::Z::Q, n)
+
+      else
+
+        rroot(x, n) == [n, 1, x::P::F]
+
+    rsplit l ==
+      r := 1$R
+      p := 1$P
+      for q in l repeat
+        if (u := retractIfCan(q)@Union(R, "failed")) case "failed"
+          then p := p * q
+          else r := r * u::R
+      [r, p]
+
+    if R has GcdDomain then
+      if R has RetractableTo Z then
+
+        nthr(x, n) ==
+          (r := retractIfCan(x)@Union(Z,"failed")) case "failed"
+             => nthRoot(squareFree x, n)
+          rec := zroot(r::Z, n)
+          [rec.exponent, rec.coef::P, [rec.radicand::P]]
+
+      else 
+
+        nthr(x, n) == nthRoot(squareFree x, n)
+
+      froot(x, n) ==
+        zero? x or (x = 1) => [1, x, 1]
+        sn := nthr(numer x, n)
+        sd := nthr(denom x, n)
+        pn := rsplit(sn.radicand)
+        pd := rsplit(sd.radicand)
+        rn := rroot(pn.coef, sn.exponent)
+        rd := rroot(pd.coef, sd.exponent)
+        m := lcm([rn.exponent, rd.exponent, sn.exponent, sd.exponent])::N
+        [m, (sn.coef::F / sd.coef::F) * (rn.coef / rd.coef),
+             ((rn.radicand ** (m quo rn.exponent)) /
+                    (rd.radicand ** (m quo rd.exponent))) *
+                           (pn.poly ** (m quo sn.exponent))::F /
+                                    (pd.poly ** (m quo sd.exponent))::F]
+
+
 *)
 
 \end{chunk}
@@ -164143,219 +202756,811 @@ o )show PolynomialSetUtilitiesPackage
 
 PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where
 
-  R : IntegralDomain
-  E : OrderedAbelianMonoidSup
-  V : OrderedSet
-  P : RecursivePolynomialCategory(R,E,V)
-  N ==> NonNegativeInteger
-  Z ==> Integer
-  B ==> Boolean
-  LP ==> List P
-  FP ==> Factored P
-  T ==> GeneralTriangularSet(R,E,V,P)
-  RRZ ==> Record(factor: P,exponent: Integer)
-  RBT ==> Record(bas:T,top:LP)
-  RUL ==> Record(chs:Union(T,"failed"),rfs:LP)
-  GPS ==> GeneralPolynomialSet(R,E,V,P)
-  pf ==> MultivariateFactorize(V, E, R, P)
+  R : IntegralDomain
+  E : OrderedAbelianMonoidSup
+  V : OrderedSet
+  P : RecursivePolynomialCategory(R,E,V)
+  N ==> NonNegativeInteger
+  Z ==> Integer
+  B ==> Boolean
+  LP ==> List P
+  FP ==> Factored P
+  T ==> GeneralTriangularSet(R,E,V,P)
+  RRZ ==> Record(factor: P,exponent: Integer)
+  RBT ==> Record(bas:T,top:LP)
+  RUL ==> Record(chs:Union(T,"failed"),rfs:LP)
+  GPS ==> GeneralPolynomialSet(R,E,V,P)
+  pf ==> MultivariateFactorize(V, E, R, P)
+
+  Exports ==  with
+     
+     removeRedundantFactors: LP -> LP
+        ++ \axiom{removeRedundantFactors(lp)} returns \axiom{lq} such that if
+        ++ \axiom{lp = [p1,...,pn]} and \axiom{lq = [q1,...,qm]}
+        ++ then the product \axiom{p1*p2*...*pn} vanishes iff the product \axiom{q1*q2*...*qm} vanishes, 
+        ++ and the product of degrees of the \axiom{qi} is not greater than 
+        ++ the one of the \axiom{pj}, and no polynomial in \axiom{lq}
+        ++ divides another polynomial in \axiom{lq}. In particular,
+        ++ polynomials lying in the base ring \axiom{R} are removed.
+        ++ Moreover, \axiom{lq} is sorted w.r.t \axiom{infRittWu?}.
+        ++ Furthermore, if R is gcd-domain, the polynomials in \axiom{lq} are 
+        ++ pairwise without common non trivial factor.
+     removeRedundantFactors: (P,P) -> LP
+        ++ \axiom{removeRedundantFactors(p,q)} returns the same as 
+        ++ \axiom{removeRedundantFactors([p,q])}
+     removeSquaresIfCan : LP -> LP
+        ++ \axiom{removeSquaresIfCan(lp)} returns
+        ++ \axiom{removeDuplicates [squareFreePart(p)$P for p in lp]}
+        ++ if \axiom{R} is gcd-domain else returns \axiom{lp}.
+     unprotectedRemoveRedundantFactors: (P,P) -> LP
+        ++ \axiom{unprotectedRemoveRedundantFactors(p,q)} returns the same as 
+        ++ \axiom{removeRedundantFactors(p,q)} but does assume that neither 
+        ++ \axiom{p} nor \axiom{q} lie in the base ring \axiom{R} and assumes that
+        ++ \axiom{infRittWu?(p,q)} holds. Moreover, if \axiom{R} is gcd-domain,
+        ++ then \axiom{p} and \axiom{q} are assumed to be square free.
+     removeRedundantFactors: (LP,P) -> LP
+        ++ \axiom{removeRedundantFactors(lp,q)} returns the same as 
+        ++ \axiom{removeRedundantFactors(cons(q,lp))} assuming
+        ++ that \axiom{removeRedundantFactors(lp)} returns \axiom{lp}
+        ++ up to replacing some polynomial \axiom{pj} in \axiom{lp}
+        ++ by some some polynomial \axiom{qj} associated to \axiom{pj}.
+     removeRedundantFactors : (LP,LP) -> LP
+        ++ \axiom{removeRedundantFactors(lp,lq)} returns the same as
+        ++ \axiom{removeRedundantFactors(concat(lp,lq))} assuming
+        ++ that \axiom{removeRedundantFactors(lp)} returns \axiom{lp}
+        ++ up to replacing some polynomial \axiom{pj} in \axiom{lp}
+        ++ by some polynomial \axiom{qj} associated to \axiom{pj}.
+     removeRedundantFactors : (LP,LP,(LP -> LP)) -> LP
+        ++ \axiom{removeRedundantFactors(lp,lq,remOp)} returns the same as
+        ++ \axiom{concat(remOp(removeRoughlyRedundantFactorsInPols(lp,lq)),lq)}
+        ++ assuming that \axiom{remOp(lq)} returns \axiom{lq} up to similarity.
+     certainlySubVariety? : (LP,LP) -> B
+        ++ \axiom{certainlySubVariety?(newlp,lp)} returns true iff for every \axiom{p}
+        ++ in \axiom{lp} the remainder of \axiom{p} by \axiom{newlp} using the division algorithm
+        ++ of Groebner techniques is zero.
+     possiblyNewVariety? : (LP, List LP) -> B
+        ++ \axiom{possiblyNewVariety?(newlp,llp)} returns true iff for every \axiom{lp} 
+        ++ in \axiom{llp} certainlySubVariety?(newlp,lp) does not hold.
+     probablyZeroDim?: LP -> B
+        ++ \axiom{probablyZeroDim?(lp)} returns true iff the number of polynomials
+        ++ in \axiom{lp} is not smaller than the number of variables occurring 
+        ++ in these polynomials.
+     selectPolynomials : ((P -> B),LP) -> Record(goodPols:LP,badPols:LP)
+        ++ \axiom{selectPolynomials(pred?,ps)} returns \axiom{gps,bps} where 
+        ++ \axiom{gps} is a list of the polynomial \axiom{p} in \axiom{ps}
+        ++ such that \axiom{pred?(p)} holds and \axiom{bps} are the other ones.
+     selectOrPolynomials : (List (P -> B),LP) -> Record(goodPols:LP,badPols:LP)
+        ++ \axiom{selectOrPolynomials(lpred?,ps)} returns \axiom{gps,bps} where 
+        ++ \axiom{gps} is a list of the polynomial \axiom{p} in \axiom{ps}
+        ++ such that \axiom{pred?(p)} holds for some \axiom{pred?} in \axiom{lpred?}
+        ++ and \axiom{bps} are the other ones.
+     selectAndPolynomials : (List (P -> B),LP) -> Record(goodPols:LP,badPols:LP)
+        ++ \axiom{selectAndPolynomials(lpred?,ps)} returns \axiom{gps,bps} where 
+        ++ \axiom{gps} is a list of the polynomial \axiom{p} in \axiom{ps}
+        ++ such that \axiom{pred?(p)} holds for every \axiom{pred?} in \axiom{lpred?}
+        ++ and \axiom{bps} are the other ones.
+     quasiMonicPolynomials : LP -> Record(goodPols:LP,badPols:LP)
+        ++ \axiom{quasiMonicPolynomials(lp)} returns \axiom{qmps,nqmps} where 
+        ++ \axiom{qmps} is a list of the quasi-monic polynomials in \axiom{lp}
+        ++ and \axiom{nqmps} are the other ones.
+     univariate? : P -> B
+        ++ \axiom{univariate?(p)} returns true iff \axiom{p} involves one and 
+        ++ only one variable.
+     univariatePolynomials : LP -> Record(goodPols:LP,badPols:LP)
+        ++ \axiom{univariatePolynomials(lp)} returns \axiom{ups,nups} where 
+        ++ \axiom{ups} is a list of the univariate polynomials,
+        ++ and \axiom{nups} are the other ones.
+     linear? : P -> B
+        ++ \axiom{linear?(p)} returns true iff \axiom{p} does not lie 
+        ++ in the base ring \axiom{R} and has main degree \axiom{1}.
+     linearPolynomials : LP -> Record(goodPols:LP,badPols:LP)
+        ++ \axiom{linearPolynomials(lp)} returns \axiom{lps,nlps} where
+        ++ \axiom{lps} is a list of the linear polynomials in lp,
+        ++ and  \axiom{nlps} are the other ones.
+     bivariate? : P -> B
+        ++ \axiom{bivariate?(p)} returns true iff \axiom{p} involves two and 
+        ++ only two variables.
+     bivariatePolynomials : LP -> Record(goodPols:LP,badPols:LP)
+        ++ \axiom{bivariatePolynomials(lp)} returns \axiom{bps,nbps} where 
+        ++ \axiom{bps} is a list of the bivariate polynomials,
+        ++ and \axiom{nbps} are the other ones.
+     removeRoughlyRedundantFactorsInPols : (LP, LP) -> LP
+        ++ \axiom{removeRoughlyRedundantFactorsInPols(lp,lf)} returns 
+        ++ \axiom{newlp}where \axiom{newlp} is obtained from \axiom{lp} 
+        ++ by removing in every polynomial \axiom{p} of \axiom{lp} 
+        ++ any occurence of a polynomial \axiom{f} in \axiom{lf}.
+        ++ This may involve a lot of exact-quotients computations.
+     removeRoughlyRedundantFactorsInPols : (LP, LP,B) -> LP
+        ++ \axiom{removeRoughlyRedundantFactorsInPols(lp,lf,opt)} returns 
+        ++ the same as \axiom{removeRoughlyRedundantFactorsInPols(lp,lf)}
+        ++ if \axiom{opt} is \axiom{false} and if the previous operation
+        ++ does not return any non null and constant polynomial, 
+        ++ else return \axiom{[1]}.
+     removeRoughlyRedundantFactorsInPol : (P,LP) -> P
+        ++ \axiom{removeRoughlyRedundantFactorsInPol(p,lf)} returns the same as
+        ++ removeRoughlyRedundantFactorsInPols([p],lf,true)
+     interReduce: LP -> LP
+        ++ \axiom{interReduce(lp)} returns \axiom{lq} such that \axiom{lp} 
+        ++ and \axiom{lq} generate the same ideal and no polynomial
+        ++ in \axiom{lq} is reducuble by the others in the sense 
+        ++ of Groebner bases. Since no assumptions are required
+        ++ the result may depend on the ordering the reductions are
+        ++ performed.
+     roughBasicSet: LP -> Union(Record(bas:T,top:LP),"failed")
+        ++ \axiom{roughBasicSet(lp)} returns the smallest (with Ritt-Wu
+        ++ ordering) triangular set contained in \axiom{lp}.
+     crushedSet: LP -> LP
+        ++ \axiom{crushedSet(lp)} returns \axiom{lq} such that \axiom{lp} and
+        ++ and \axiom{lq} generate the same ideal and no rough basic
+        ++ sets reduce (in the sense of Groebner bases) the other
+        ++ polynomials in \axiom{lq}.
+     rewriteSetByReducingWithParticularGenerators : (LP,(P->B),((P,P)->B),((P,P)->P)) -> LP
+        ++ \axiom{rewriteSetByReducingWithParticularGenerators(lp,pred?,redOp?,redOp)}
+        ++ returns \axiom{lq} where \axiom{lq} is computed by the following
+        ++ algorithm. Chose a basic set w.r.t. the reduction-test \axiom{redOp?}
+        ++ among the polynomials satisfying property \axiom{pred?},
+        ++ if it is empty then leave, else reduce the other polynomials by
+        ++ this basic set w.r.t. the reduction-operation \axiom{redOp}.
+        ++ Repeat while another basic set with smaller rank can be computed.
+        ++ See code. If \axiom{pred?} is \axiom{quasiMonic?} the ideal is unchanged.
+     rewriteIdealWithQuasiMonicGenerators : (LP,((P,P)->B),((P,P)->P)) -> LP
+        ++ \axiom{rewriteIdealWithQuasiMonicGenerators(lp,redOp?,redOp)} returns
+        ++ \axiom{lq} where \axiom{lq} and \axiom{lp} generate 
+        ++ the same ideal in \axiom{R^(-1) P} and \axiom{lq}
+        ++ has rank not higher than the one of \axiom{lp}.
+        ++ Moreover, \axiom{lq} is computed by reducing \axiom{lp}
+        ++ w.r.t. some basic set of the ideal generated by
+        ++ the quasi-monic polynomials in \axiom{lp}.
+     if R has GcdDomain
+     then 
+       squareFreeFactors : P -> LP
+          ++ \axiom{squareFreeFactors(p)} returns the square-free factors of \axiom{p}
+          ++ over \axiom{R}
+       univariatePolynomialsGcds : LP -> LP
+          ++ \axiom{univariatePolynomialsGcds(lp)} returns \axiom{lg} where
+          ++ \axiom{lg} is a list of the gcds of every pair in \axiom{lp}
+          ++ of univariate polynomials in the same main variable.
+       univariatePolynomialsGcds : (LP,B) -> LP
+          ++ \axiom{univariatePolynomialsGcds(lp,opt)} returns the same as
+          ++ \axiom{univariatePolynomialsGcds(lp)} if \axiom{opt} is 
+          ++ \axiom{false} and if the previous operation does not return 
+          ++ any non null and constant polynomial, else return \axiom{[1]}.
+       removeRoughlyRedundantFactorsInContents : (LP, LP) -> LP
+          ++ \axiom{removeRoughlyRedundantFactorsInContents(lp,lf)} returns 
+          ++ \axiom{newlp}where \axiom{newlp} is obtained from \axiom{lp} 
+          ++ by removing in the content of every polynomial of \axiom{lp} 
+          ++ any occurence of a polynomial \axiom{f} in \axiom{lf}. Moreover,
+          ++ squares over \axiom{R} are first removed in the content 
+          ++ of every polynomial of \axiom{lp}.
+       removeRedundantFactorsInContents : (LP, LP) -> LP
+          ++ \axiom{removeRedundantFactorsInContents(lp,lf)} returns \axiom{newlp}
+          ++ where \axiom{newlp} is obtained from \axiom{lp} by removing
+          ++ in the content of every polynomial of \axiom{lp} any non trivial 
+          ++ factor of any polynomial \axiom{f} in \axiom{lf}. Moreover,
+          ++ squares over \axiom{R} are first removed in the content 
+          ++ of every polynomial of \axiom{lp}.
+       removeRedundantFactorsInPols : (LP, LP) -> LP
+          ++ \axiom{removeRedundantFactorsInPols(lp,lf)} returns \axiom{newlp}
+          ++ where \axiom{newlp} is obtained from \axiom{lp} by removing
+          ++ in every polynomial \axiom{p} of \axiom{lp} any non trivial 
+          ++ factor of any polynomial \axiom{f} in \axiom{lf}. Moreover,
+          ++ squares over \axiom{R} are first removed in every 
+          ++ polynomial \axiom{lp}.
+     if (R has EuclideanDomain) and (R has CharacteristicZero)
+     then
+       irreducibleFactors : LP -> LP
+          ++ \axiom{irreducibleFactors(lp)} returns \axiom{lf} such that if
+          ++ \axiom{lp = [p1,...,pn]} and \axiom{lf = [f1,...,fm]} then 
+          ++ \axiom{p1*p2*...*pn=0} means \axiom{f1*f2*...*fm=0}, and the \axiom{fi}
+          ++ are irreducible over \axiom{R} and are pairwise distinct.
+       lazyIrreducibleFactors : LP -> LP
+          ++ \axiom{lazyIrreducibleFactors(lp)} returns \axiom{lf} such that if
+          ++ \axiom{lp = [p1,...,pn]} and \axiom{lf = [f1,...,fm]} then 
+          ++ \axiom{p1*p2*...*pn=0} means \axiom{f1*f2*...*fm=0}, and the \axiom{fi}
+          ++ are irreducible over \axiom{R} and are pairwise distinct.
+          ++ The algorithm tries to avoid factorization into irreducible
+          ++ factors as far as possible and makes previously use of gcd
+          ++ techniques over \axiom{R}.
+       removeIrreducibleRedundantFactors : (LP, LP) -> LP
+          ++ \axiom{removeIrreducibleRedundantFactors(lp,lq)} returns the same
+          ++ as \axiom{irreducibleFactors(concat(lp,lq))} assuming
+          ++ that \axiom{irreducibleFactors(lp)} returns \axiom{lp}
+          ++ up to replacing some polynomial \axiom{pj} in \axiom{lp}
+          ++ by some polynomial \axiom{qj} associated to \axiom{pj}.
+       
+  Implementation ==  add
+
+     autoRemainder: T -> List(P)
+
+     removeAssociates (lp:LP):LP ==
+       removeDuplicates [primPartElseUnitCanonical(p) for p in lp]
+
+     selectPolynomials  (pred?,ps) ==
+       gps : LP := []
+       bps : LP := []
+       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)
+       bps := sort(infRittWu?,bps)
+       [gps,bps]
+
+     selectOrPolynomials (lpred?,ps) ==   
+       gps : LP := []
+       bps : LP := []
+       while not empty? ps repeat
+         p := first ps
+         ps := rest ps
+         clpred? :=  lpred?
+         while (not empty? clpred?) and (not (first clpred?)(p)) repeat
+           clpred? :=  rest clpred?
+         if not empty?(clpred?)
+           then
+             gps := cons(p,gps)
+           else
+             bps := cons(p,bps)
+       gps := sort(infRittWu?,gps)
+       bps := sort(infRittWu?,bps)
+       [gps,bps]
+
+     selectAndPolynomials (lpred?,ps) ==   
+       gps : LP := []
+       bps : LP := []
+       while not empty? ps repeat
+         p := first ps
+         ps := rest ps
+         clpred? :=  lpred?
+         while (not empty? clpred?) and ((first clpred?)(p)) repeat
+           clpred? :=  rest clpred?
+         if empty?(clpred?)
+           then
+             gps := cons(p,gps)
+           else
+             bps := cons(p,bps)
+       gps := sort(infRittWu?,gps)
+       bps := sort(infRittWu?,bps)
+       [gps,bps]
+
+     linear? p ==
+       ground? p => false
+       (mdeg(p) = 1)
+
+     linearPolynomials  ps ==
+       selectPolynomials(linear?,ps)
+
+     univariate? p ==
+       ground? p => false
+       not(ground?(init(p))) => false
+       tp := tail(p)
+       ground?(tp) => true
+       not (mvar(p) = mvar(tp)) => false
+       univariate?(tp)
+
+     univariatePolynomials ps ==
+       selectPolynomials(univariate?,ps)
+
+     bivariate? p ==
+       ground? p => false
+       ground? tail(p) => univariate?(init(p))
+       vp := mvar(p)
+       vtp := mvar(tail(p))
+       ((ground? init(p)) and (vp = vtp)) => bivariate? tail(p)
+       ((ground? init(p)) and (vp > vtp)) => univariate? tail(p)
+       not univariate?(init(p)) => false
+       vip := mvar(init(p))
+       vip > vtp => false
+       vip = vtp => univariate? tail(p)
+       vtp < vp => false
+       zero? degree(tail(p),vip) => univariate? tail(p)
+       bivariate? tail(p)
+
+     bivariatePolynomials ps ==
+       selectPolynomials(bivariate?,ps)
+
+     quasiMonicPolynomials ps ==
+       selectPolynomials(quasiMonic?,ps)
+
+     removeRoughlyRedundantFactorsInPols (lp,lf,opt) ==
+       empty? lp => lp
+       newlp : LP := []
+       stop : B := false
+       lp := remove(zero?,lp)
+       lf := sort(infRittWu?,lf)
+       test : Union(P,"failed")
+       while (not empty? lp) and (not stop) repeat
+         p := first lp
+         lp := rest lp
+         copylf := lf
+         while (not empty? copylf) and (not ground? p) _
+                and (not (mvar(p) < mvar(first copylf))) repeat
+           f := first copylf
+           copylf := rest copylf
+           while (((test := p exquo$P f)) case P) repeat
+             p := test::P
+         stop := opt and ground?(p)
+         newlp := cons(unitCanonical(p),newlp)
+       stop => [1$P]
+       newlp 
+
+     removeRoughlyRedundantFactorsInPol(p,lf) ==
+       zero? p => p
+       lp : LP := [p]
+       first removeRoughlyRedundantFactorsInPols (lp,lf,true()$B)
+
+     removeRoughlyRedundantFactorsInPols (lp,lf) ==
+       removeRoughlyRedundantFactorsInPols (lp,lf,false()$B)
+
+     possiblyNewVariety?(newlp,llp) ==       
+       while (not empty? llp) and _
+        (not certainlySubVariety?(newlp,first(llp))) repeat
+         llp := rest llp
+       empty? llp
+
+     certainlySubVariety?(lp,lq) ==
+       gs := construct(lp)$GPS
+       while (not empty? lq) and _
+        (zero? (remainder(first(lq),gs)$GPS).polnum) repeat
+         lq := rest lq    
+       empty? lq
+
+     probablyZeroDim?(lp: List P) : Boolean ==
+       m := #lp
+       lv : List V := variables(first lp)
+       while not empty? (lp := rest lp) repeat
+         lv := concat(variables(first lp),lv)
+       n := #(removeDuplicates lv)
+       not (n > m)
+
+     interReduce(lp: LP): LP ==
+       ps := lp
+       rs: List(P) := []
+       repeat
+         empty? ps => return rs
+         ps := sort(supRittWu?, ps)
+         p := first ps
+         ps := rest ps
+         r := remainder(p,[ps]$GPS).polnum
+         zero? r => "leave"
+         ground? r => return []
+         associates?(r,p) => rs := cons(r,rs)
+         ps := concat(ps,cons(r,rs))
+         rs := []
+
+     roughRed?(p:P,q:P):B == 
+       ground? p => false
+       ground? q => true
+       mvar(p) > mvar(q)
+
+     roughBasicSet(lp) == basicSet(lp,roughRed?)$T
+
+     autoRemainder(ts:T): List(P) ==
+       empty? ts => members(ts)
+       lp := sort(infRittWu?, reverse members(ts))
+       newlp : List(P) := [primPartElseUnitCanonical first(lp)]
+       lp := rest(lp)
+       while not empty? lp repeat
+         p := (remainder(first(lp),construct(newlp)$GPS)$GPS).polnum
+         if not zero? p
+           then
+             if ground? p
+               then
+                 newlp := [1$P]
+                 lp := []
+               else
+                 newlp := cons(p,newlp)
+                 lp := rest(lp)
+           else
+             lp := rest(lp)
+       newlp
+
+     crushedSet(lp) ==
+       rec := roughBasicSet(lp)
+       contradiction := (rec case "failed")@B
+       finished : B := false       
+       while (not finished) and (not contradiction) repeat 
+         bs := (rec::RBT).bas        
+         rs := (rec::RBT).top
+         rs :=  rewriteIdealWithRemainder(rs,bs)$T
+         contradiction := ((not empty? rs) and (first(rs) = 1))
+         if not contradiction
+           then
+             rs := concat(rs,autoRemainder(bs))
+             rec := roughBasicSet(rs)
+             contradiction := (rec case "failed")@B
+             not contradiction => finished := not infRittWu?((rec::RBT).bas,bs)
+       contradiction => [1$P]
+       rs
+
+     rewriteSetByReducingWithParticularGenerators (ps,pred?,redOp?,redOp) ==
+       rs : LP := remove(zero?,ps)
+       any?(ground?,rs) => [1$P]
+       contradiction : B := false
+       bs1 : T := empty()$T
+       rec : Union(RBT,"failed")
+       ar : Union(T,List(P))
+       stop : B := false
+       while (not contradiction) and (not stop) repeat
+         rec := basicSet(rs,pred?,redOp?)$T
+         bs2 : T := (rec::RBT).bas
+         rs := (rec::RBT).top
+         -- ar := autoReduce(bs2,lazyPrem,reduced?)@Union(T,List(P))
+         ar := bs2::Union(T,List(P))
+         if (ar case T)@B
+           then
+             bs2 := ar::T
+             if infRittWu?(bs2,bs1)
+               then
+                 rs := rewriteSetWithReduction(rs,bs2,redOp,redOp?)$T
+                 bs1 := bs2
+               else
+                 stop := true
+             rs := concat(members(bs2),rs)
+           else
+             rs := concat(ar::LP,rs)
+         if any?(ground?,rs)
+           then
+             contradiction := true
+             rs := [1$P]
+       rs        
+
+     removeRedundantFactors (lp:LP,lq :LP, remOp : (LP -> LP)) ==
+       -- ASSUME remOp(lp) returns lp up to similarity 
+       lq := removeRoughlyRedundantFactorsInPols(lq,lp,false)
+       lq := remOp lq
+       sort(infRittWu?,concat(lp,lq))
+
+     removeRedundantFactors (lp:LP,lq :LP) ==
+       lq := removeRoughlyRedundantFactorsInPols(lq,lp,false)
+       lq := removeRedundantFactors lq
+       sort(infRittWu?,concat(lp,lq))
+
+     if (R has EuclideanDomain) and (R has CharacteristicZero)
+     then
+
+       irreducibleFactors lp ==
+         newlp : LP := []
+         lrrz : List RRZ
+         rrz : RRZ
+         fp : FP
+         while not empty? lp repeat
+           p := first lp
+           lp := rest lp
+           fp := factor(p)$pf
+           lrrz := factors(fp)$FP
+           lf := remove(ground?,[rrz.factor for rrz in lrrz])
+           newlp := concat(lf,newlp)
+         removeDuplicates newlp
+
+       lazyIrreducibleFactors lp ==
+         lp := removeRedundantFactors(lp)
+         newlp : LP := []
+         lrrz : List RRZ
+         rrz : RRZ
+         fp : FP
+         while not empty? lp repeat
+           p := first lp
+           lp := rest lp
+           fp := factor(p)$pf
+           lrrz := factors(fp)$FP
+           lf := remove(ground?,[rrz.factor for rrz in lrrz])
+           newlp := concat(lf,newlp)
+         newlp
+
+       removeIrreducibleRedundantFactors (lp:LP,lq :LP) ==
+         -- ASSUME lp only contains irreducible factors over R
+         lq := removeRoughlyRedundantFactorsInPols(lq,lp,false)
+         lq := irreducibleFactors lq
+         sort(infRittWu?,concat(lp,lq))
+
+     if R has GcdDomain
+     then
+
+       squareFreeFactors(p:P) ==
+         sfp: Factored P := squareFree(p)$P
+         lsf: List P := [foo.factor for foo in factors(sfp)]
+         lsf
+
+       univariatePolynomialsGcds (ps,opt) ==
+         lg : LP := []
+         pInV : LP 
+         stop : B := false
+         ps := sort(infRittWu?,ps)
+         p,g : P
+         v : V
+         while (not empty? ps) and (not stop) repeat
+           while (not empty? ps) and (not univariate?((p := first(ps)))) repeat
+             ps := rest ps
+           if not empty? ps
+             then
+               v := mvar(p)$P
+               pInV := [p]
+               while (not empty? ps) and (mvar((p := first(ps))) = v) repeat
+                 if (univariate?(p))
+                   then
+                     pInV := cons(p,pInV)
+                 ps := rest ps
+               g := gcd(pInV)$P
+               stop := opt and (ground? g)
+               lg := cons(g,lg)
+         stop => [1$P]
+         lg
+
+       univariatePolynomialsGcds ps ==
+         univariatePolynomialsGcds (ps,false)
+         
+       removeSquaresIfCan lp ==
+         empty? lp => lp
+         removeDuplicates [squareFreePart(p)$P for p in lp]
+
+       rewriteIdealWithQuasiMonicGenerators (ps,redOp?,redOp) ==
+         ups := removeSquaresIfCan(univariatePolynomialsGcds(ps,true))
+         ps := removeDuplicates concat(ups,ps)
+         rewriteSetByReducingWithParticularGenerators_
+             (ps,quasiMonic?,redOp?,redOp)
+
+       removeRoughlyRedundantFactorsInContents (ps,lf) ==
+         empty? ps => ps
+         newps : LP := []
+         p,newp,cp,newcp,f,g : P
+         test : Union(P,"failed")
+         copylf : LP
+         while not empty? ps repeat
+           p := first ps 
+           ps := rest ps
+           cp := mainContent(p)$P
+           newcp := squareFreePart(cp)$P
+           newp := (p exquo$P cp)::P
+           if not ground? newcp
+             then
+               copylf := [f for f in lf | mvar(f) <= mvar(newcp)]
+               while (not empty? copylf) and (not ground? newcp) repeat
+                 f := first copylf
+                 copylf := rest copylf
+                 test := (newcp exquo$P f)
+                 if (test case P)@B
+                   then
+                     newcp := test::P
+           if ground? newcp
+             then
+               newp := unitCanonical(newp)
+             else
+               newp := unitCanonical(newp * newcp)
+           newps := cons(newp,newps)
+         newps
+
+       removeRedundantFactorsInContents (ps,lf) ==
+         empty? ps => ps
+         newps : LP := []
+         p,newp,cp,newcp,f,g : P
+         while not empty? ps repeat
+           p := first ps 
+           ps := rest ps
+           cp := mainContent(p)$P
+           newcp := squareFreePart(cp)$P
+           newp := (p exquo$P cp)::P
+           if not ground? newcp
+             then
+               copylf := lf
+               while (not empty? copylf) and (not ground? newcp) repeat
+                 f := first copylf
+                 copylf := rest copylf
+                 g := gcd(newcp,f)$P
+                 if not ground? g
+                   then
+                     newcp := (newcp exquo$P g)::P
+           if ground? newcp
+             then
+               newp := unitCanonical(newp)
+             else
+               newp := unitCanonical(newp * newcp)
+           newps := cons(newp,newps)
+         newps
+
+       removeRedundantFactorsInPols (ps,lf) ==
+         empty? ps => ps
+         newps : LP := []
+         p,newp,cp,newcp,f,g : P
+         while not empty? ps repeat
+           p := first ps 
+           ps := rest ps
+           cp := mainContent(p)$P
+           newcp := squareFreePart(cp)$P
+           newp := (p exquo$P cp)::P
+           newp := squareFreePart(newp)$P
+           copylf := lf
+           while not empty? copylf repeat
+             f := first copylf
+             copylf := rest copylf
+             if not ground? newcp
+               then
+                 g := gcd(newcp,f)$P
+                 if not ground? g
+                   then
+                     newcp := (newcp exquo$P g)::P
+             if not ground? newp
+               then
+                 g := gcd(newp,f)$P
+                 if not ground? g
+                   then
+                     newp := (newp exquo$P g)::P
+           if ground? newcp
+             then
+               newp := unitCanonical(newp)
+             else
+               newp := unitCanonical(newp * newcp)
+           newps := cons(newp,newps)
+         newps
+
+       removeRedundantFactors (a:P,b:P) : LP ==
+         a := primPartElseUnitCanonical(squareFreePart(a))
+         b := primPartElseUnitCanonical(squareFreePart(b))
+         if not infRittWu?(a,b)
+           then
+            (a,b) := (b,a)
+         if ground? a
+           then
+             if ground? b
+               then
+                 return([])
+               else
+                 return([b])
+           else
+             if ground? b
+               then
+                 return([a])
+               else
+                 return(unprotectedRemoveRedundantFactors(a,b))
+
+       unprotectedRemoveRedundantFactors (a,b) ==
+         c := b exquo$P a
+         if (c case P)@B
+           then
+             d : P := c::P
+             if ground? d
+               then
+                 return([a])
+               else
+                 return([a,d])
+           else
+             g : P := gcd(a,b)$P
+             if ground? g
+               then
+                 return([a,b])
+               else
+                 return([g,(a exquo$P g)::P,(b exquo$P g)::P])
+
+     else
+
+       removeSquaresIfCan lp ==
+         lp
+
+       rewriteIdealWithQuasiMonicGenerators (ps,redOp?,redOp) ==
+         rewriteSetByReducingWithParticularGenerators_
+           (ps,quasiMonic?,redOp?,redOp)
+
+       removeRedundantFactors (a:P,b:P) ==
+         a := primPartElseUnitCanonical(a)
+         b := primPartElseUnitCanonical(b)
+         if not infRittWu?(a,b)
+           then
+            (a,b) := (b,a)
+         if ground? a
+           then
+             if ground? b
+               then
+                 return([])
+               else
+                 return([b])
+           else
+             if ground? b
+               then
+                 return([a])
+               else
+                 return(unprotectedRemoveRedundantFactors(a,b))
+        
+       unprotectedRemoveRedundantFactors (a,b) ==
+         c := b exquo$P a
+         if (c case P)@B
+           then
+             d : P := c::P
+             if ground? d
+               then
+                 return([a])
+               else
+                 if infRittWu?(d,a) then (a,d) := (d,a)
+                 return(unprotectedRemoveRedundantFactors(a,d))
+            else
+              return([a,b])
+
+     removeRedundantFactors (lp:LP) ==
+       lp := remove(ground?, lp)
+       lp := removeDuplicates [primPartElseUnitCanonical(p) for p in lp]
+       lp := removeSquaresIfCan lp
+       lp := removeDuplicates [unitCanonical(p) for p in lp]
+       empty? lp => lp
+       size?(lp,1$N)$(List P) => lp
+       lp := sort(infRittWu?,lp)
+       p : P := first lp
+       lp := rest lp
+       base : LP := unprotectedRemoveRedundantFactors(p,first lp)
+       top : LP := rest lp
+       while not empty? top repeat
+         p := first top
+         base := removeRedundantFactors(base,p)
+         top := rest top
+       base
+
+     removeRedundantFactors (lp:LP,a:P) ==
+       lp := remove(ground?, lp)
+       lp := sort(infRittWu?, lp)
+       ground? a => lp
+       empty? lp => [a]
+       toSee : LP := lp
+       toSave : LP := []
+       while not empty? toSee repeat
+         b := first toSee
+         toSee := rest toSee
+         if not infRittWu?(b,a) 
+           then
+             (c,d) := (a,b)
+           else
+             (c,d) := (b,a)
+         rrf := unprotectedRemoveRedundantFactors(c,d)
+         empty? rrf =>
+           error"in removeRedundantFactors : (LP,P) -> LP from PSETPK"
+         c := first rrf
+         rrf := rest rrf
+         if empty? rrf
+           then
+             if associates?(c,b)
+               then
+                 toSave := concat(toSave,toSee)
+                 a := b
+                 toSee := []
+               else
+                 a := c
+                 toSee := concat(toSave,toSee)
+                 toSave := []
+           else
+             d := first rrf
+             rrf := rest rrf
+             if empty? rrf
+               then
+                 if associates?(c,b)
+                   then
+                     toSave := concat(toSave,[b])
+                     a := d
+                   else
+                     if associates?(d,b)
+                       then
+                         toSave := concat(toSave,[b])
+                         a := c
+                       else
+                         toSave := removeRedundantFactors(toSave,c)
+                         a := d
+               else
+                 e := first rrf
+                 not empty? rest(rrf) => 
+                   error"in removeRedundantFactors:(LP,P)->LP from PSETPK"
+                 -- ASSUME that neither c, nor d, nor e may be associated to b
+                 toSave := removeRedundantFactors(toSave,c)
+                 toSave := removeRedundantFactors(toSave,d)
+                 a := e
+         if empty? toSee
+           then
+             toSave := sort(infRittWu?,cons(a,toSave))
+       toSave   
+
+\end{chunk}
 
-  Exports ==  with
-     
-     removeRedundantFactors: LP -> LP
-        ++ \axiom{removeRedundantFactors(lp)} returns \axiom{lq} such that if
-        ++ \axiom{lp = [p1,...,pn]} and \axiom{lq = [q1,...,qm]}
-        ++ then the product \axiom{p1*p2*...*pn} vanishes iff the product \axiom{q1*q2*...*qm} vanishes, 
-        ++ and the product of degrees of the \axiom{qi} is not greater than 
-        ++ the one of the \axiom{pj}, and no polynomial in \axiom{lq}
-        ++ divides another polynomial in \axiom{lq}. In particular,
-        ++ polynomials lying in the base ring \axiom{R} are removed.
-        ++ Moreover, \axiom{lq} is sorted w.r.t \axiom{infRittWu?}.
-        ++ Furthermore, if R is gcd-domain, the polynomials in \axiom{lq} are 
-        ++ pairwise without common non trivial factor.
-     removeRedundantFactors: (P,P) -> LP
-        ++ \axiom{removeRedundantFactors(p,q)} returns the same as 
-        ++ \axiom{removeRedundantFactors([p,q])}
-     removeSquaresIfCan : LP -> LP
-        ++ \axiom{removeSquaresIfCan(lp)} returns
-        ++ \axiom{removeDuplicates [squareFreePart(p)$P for p in lp]}
-        ++ if \axiom{R} is gcd-domain else returns \axiom{lp}.
-     unprotectedRemoveRedundantFactors: (P,P) -> LP
-        ++ \axiom{unprotectedRemoveRedundantFactors(p,q)} returns the same as 
-        ++ \axiom{removeRedundantFactors(p,q)} but does assume that neither 
-        ++ \axiom{p} nor \axiom{q} lie in the base ring \axiom{R} and assumes that
-        ++ \axiom{infRittWu?(p,q)} holds. Moreover, if \axiom{R} is gcd-domain,
-        ++ then \axiom{p} and \axiom{q} are assumed to be square free.
-     removeRedundantFactors: (LP,P) -> LP
-        ++ \axiom{removeRedundantFactors(lp,q)} returns the same as 
-        ++ \axiom{removeRedundantFactors(cons(q,lp))} assuming
-        ++ that \axiom{removeRedundantFactors(lp)} returns \axiom{lp}
-        ++ up to replacing some polynomial \axiom{pj} in \axiom{lp}
-        ++ by some some polynomial \axiom{qj} associated to \axiom{pj}.
-     removeRedundantFactors : (LP,LP) -> LP
-        ++ \axiom{removeRedundantFactors(lp,lq)} returns the same as
-        ++ \axiom{removeRedundantFactors(concat(lp,lq))} assuming
-        ++ that \axiom{removeRedundantFactors(lp)} returns \axiom{lp}
-        ++ up to replacing some polynomial \axiom{pj} in \axiom{lp}
-        ++ by some polynomial \axiom{qj} associated to \axiom{pj}.
-     removeRedundantFactors : (LP,LP,(LP -> LP)) -> LP
-        ++ \axiom{removeRedundantFactors(lp,lq,remOp)} returns the same as
-        ++ \axiom{concat(remOp(removeRoughlyRedundantFactorsInPols(lp,lq)),lq)}
-        ++ assuming that \axiom{remOp(lq)} returns \axiom{lq} up to similarity.
-     certainlySubVariety? : (LP,LP) -> B
-        ++ \axiom{certainlySubVariety?(newlp,lp)} returns true iff for every \axiom{p}
-        ++ in \axiom{lp} the remainder of \axiom{p} by \axiom{newlp} using the division algorithm
-        ++ of Groebner techniques is zero.
-     possiblyNewVariety? : (LP, List LP) -> B
-        ++ \axiom{possiblyNewVariety?(newlp,llp)} returns true iff for every \axiom{lp} 
-        ++ in \axiom{llp} certainlySubVariety?(newlp,lp) does not hold.
-     probablyZeroDim?: LP -> B
-        ++ \axiom{probablyZeroDim?(lp)} returns true iff the number of polynomials
-        ++ in \axiom{lp} is not smaller than the number of variables occurring 
-        ++ in these polynomials.
-     selectPolynomials : ((P -> B),LP) -> Record(goodPols:LP,badPols:LP)
-        ++ \axiom{selectPolynomials(pred?,ps)} returns \axiom{gps,bps} where 
-        ++ \axiom{gps} is a list of the polynomial \axiom{p} in \axiom{ps}
-        ++ such that \axiom{pred?(p)} holds and \axiom{bps} are the other ones.
-     selectOrPolynomials : (List (P -> B),LP) -> Record(goodPols:LP,badPols:LP)
-        ++ \axiom{selectOrPolynomials(lpred?,ps)} returns \axiom{gps,bps} where 
-        ++ \axiom{gps} is a list of the polynomial \axiom{p} in \axiom{ps}
-        ++ such that \axiom{pred?(p)} holds for some \axiom{pred?} in \axiom{lpred?}
-        ++ and \axiom{bps} are the other ones.
-     selectAndPolynomials : (List (P -> B),LP) -> Record(goodPols:LP,badPols:LP)
-        ++ \axiom{selectAndPolynomials(lpred?,ps)} returns \axiom{gps,bps} where 
-        ++ \axiom{gps} is a list of the polynomial \axiom{p} in \axiom{ps}
-        ++ such that \axiom{pred?(p)} holds for every \axiom{pred?} in \axiom{lpred?}
-        ++ and \axiom{bps} are the other ones.
-     quasiMonicPolynomials : LP -> Record(goodPols:LP,badPols:LP)
-        ++ \axiom{quasiMonicPolynomials(lp)} returns \axiom{qmps,nqmps} where 
-        ++ \axiom{qmps} is a list of the quasi-monic polynomials in \axiom{lp}
-        ++ and \axiom{nqmps} are the other ones.
-     univariate? : P -> B
-        ++ \axiom{univariate?(p)} returns true iff \axiom{p} involves one and 
-        ++ only one variable.
-     univariatePolynomials : LP -> Record(goodPols:LP,badPols:LP)
-        ++ \axiom{univariatePolynomials(lp)} returns \axiom{ups,nups} where 
-        ++ \axiom{ups} is a list of the univariate polynomials,
-        ++ and \axiom{nups} are the other ones.
-     linear? : P -> B
-        ++ \axiom{linear?(p)} returns true iff \axiom{p} does not lie 
-        ++ in the base ring \axiom{R} and has main degree \axiom{1}.
-     linearPolynomials : LP -> Record(goodPols:LP,badPols:LP)
-        ++ \axiom{linearPolynomials(lp)} returns \axiom{lps,nlps} where
-        ++ \axiom{lps} is a list of the linear polynomials in lp,
-        ++ and  \axiom{nlps} are the other ones.
-     bivariate? : P -> B
-        ++ \axiom{bivariate?(p)} returns true iff \axiom{p} involves two and 
-        ++ only two variables.
-     bivariatePolynomials : LP -> Record(goodPols:LP,badPols:LP)
-        ++ \axiom{bivariatePolynomials(lp)} returns \axiom{bps,nbps} where 
-        ++ \axiom{bps} is a list of the bivariate polynomials,
-        ++ and \axiom{nbps} are the other ones.
-     removeRoughlyRedundantFactorsInPols : (LP, LP) -> LP
-        ++ \axiom{removeRoughlyRedundantFactorsInPols(lp,lf)} returns 
-        ++ \axiom{newlp}where \axiom{newlp} is obtained from \axiom{lp} 
-        ++ by removing in every polynomial \axiom{p} of \axiom{lp} 
-        ++ any occurence of a polynomial \axiom{f} in \axiom{lf}.
-        ++ This may involve a lot of exact-quotients computations.
-     removeRoughlyRedundantFactorsInPols : (LP, LP,B) -> LP
-        ++ \axiom{removeRoughlyRedundantFactorsInPols(lp,lf,opt)} returns 
-        ++ the same as \axiom{removeRoughlyRedundantFactorsInPols(lp,lf)}
-        ++ if \axiom{opt} is \axiom{false} and if the previous operation
-        ++ does not return any non null and constant polynomial, 
-        ++ else return \axiom{[1]}.
-     removeRoughlyRedundantFactorsInPol : (P,LP) -> P
-        ++ \axiom{removeRoughlyRedundantFactorsInPol(p,lf)} returns the same as
-        ++ removeRoughlyRedundantFactorsInPols([p],lf,true)
-     interReduce: LP -> LP
-        ++ \axiom{interReduce(lp)} returns \axiom{lq} such that \axiom{lp} 
-        ++ and \axiom{lq} generate the same ideal and no polynomial
-        ++ in \axiom{lq} is reducuble by the others in the sense 
-        ++ of Groebner bases. Since no assumptions are required
-        ++ the result may depend on the ordering the reductions are
-        ++ performed.
-     roughBasicSet: LP -> Union(Record(bas:T,top:LP),"failed")
-        ++ \axiom{roughBasicSet(lp)} returns the smallest (with Ritt-Wu
-        ++ ordering) triangular set contained in \axiom{lp}.
-     crushedSet: LP -> LP
-        ++ \axiom{crushedSet(lp)} returns \axiom{lq} such that \axiom{lp} and
-        ++ and \axiom{lq} generate the same ideal and no rough basic
-        ++ sets reduce (in the sense of Groebner bases) the other
-        ++ polynomials in \axiom{lq}.
-     rewriteSetByReducingWithParticularGenerators : (LP,(P->B),((P,P)->B),((P,P)->P)) -> LP
-        ++ \axiom{rewriteSetByReducingWithParticularGenerators(lp,pred?,redOp?,redOp)}
-        ++ returns \axiom{lq} where \axiom{lq} is computed by the following
-        ++ algorithm. Chose a basic set w.r.t. the reduction-test \axiom{redOp?}
-        ++ among the polynomials satisfying property \axiom{pred?},
-        ++ if it is empty then leave, else reduce the other polynomials by
-        ++ this basic set w.r.t. the reduction-operation \axiom{redOp}.
-        ++ Repeat while another basic set with smaller rank can be computed.
-        ++ See code. If \axiom{pred?} is \axiom{quasiMonic?} the ideal is unchanged.
-     rewriteIdealWithQuasiMonicGenerators : (LP,((P,P)->B),((P,P)->P)) -> LP
-        ++ \axiom{rewriteIdealWithQuasiMonicGenerators(lp,redOp?,redOp)} returns
-        ++ \axiom{lq} where \axiom{lq} and \axiom{lp} generate 
-        ++ the same ideal in \axiom{R^(-1) P} and \axiom{lq}
-        ++ has rank not higher than the one of \axiom{lp}.
-        ++ Moreover, \axiom{lq} is computed by reducing \axiom{lp}
-        ++ w.r.t. some basic set of the ideal generated by
-        ++ the quasi-monic polynomials in \axiom{lp}.
-     if R has GcdDomain
-     then 
-       squareFreeFactors : P -> LP
-          ++ \axiom{squareFreeFactors(p)} returns the square-free factors of \axiom{p}
-          ++ over \axiom{R}
-       univariatePolynomialsGcds : LP -> LP
-          ++ \axiom{univariatePolynomialsGcds(lp)} returns \axiom{lg} where
-          ++ \axiom{lg} is a list of the gcds of every pair in \axiom{lp}
-          ++ of univariate polynomials in the same main variable.
-       univariatePolynomialsGcds : (LP,B) -> LP
-          ++ \axiom{univariatePolynomialsGcds(lp,opt)} returns the same as
-          ++ \axiom{univariatePolynomialsGcds(lp)} if \axiom{opt} is 
-          ++ \axiom{false} and if the previous operation does not return 
-          ++ any non null and constant polynomial, else return \axiom{[1]}.
-       removeRoughlyRedundantFactorsInContents : (LP, LP) -> LP
-          ++ \axiom{removeRoughlyRedundantFactorsInContents(lp,lf)} returns 
-          ++ \axiom{newlp}where \axiom{newlp} is obtained from \axiom{lp} 
-          ++ by removing in the content of every polynomial of \axiom{lp} 
-          ++ any occurence of a polynomial \axiom{f} in \axiom{lf}. Moreover,
-          ++ squares over \axiom{R} are first removed in the content 
-          ++ of every polynomial of \axiom{lp}.
-       removeRedundantFactorsInContents : (LP, LP) -> LP
-          ++ \axiom{removeRedundantFactorsInContents(lp,lf)} returns \axiom{newlp}
-          ++ where \axiom{newlp} is obtained from \axiom{lp} by removing
-          ++ in the content of every polynomial of \axiom{lp} any non trivial 
-          ++ factor of any polynomial \axiom{f} in \axiom{lf}. Moreover,
-          ++ squares over \axiom{R} are first removed in the content 
-          ++ of every polynomial of \axiom{lp}.
-       removeRedundantFactorsInPols : (LP, LP) -> LP
-          ++ \axiom{removeRedundantFactorsInPols(lp,lf)} returns \axiom{newlp}
-          ++ where \axiom{newlp} is obtained from \axiom{lp} by removing
-          ++ in every polynomial \axiom{p} of \axiom{lp} any non trivial 
-          ++ factor of any polynomial \axiom{f} in \axiom{lf}. Moreover,
-          ++ squares over \axiom{R} are first removed in every 
-          ++ polynomial \axiom{lp}.
-     if (R has EuclideanDomain) and (R has CharacteristicZero)
-     then
-       irreducibleFactors : LP -> LP
-          ++ \axiom{irreducibleFactors(lp)} returns \axiom{lf} such that if
-          ++ \axiom{lp = [p1,...,pn]} and \axiom{lf = [f1,...,fm]} then 
-          ++ \axiom{p1*p2*...*pn=0} means \axiom{f1*f2*...*fm=0}, and the \axiom{fi}
-          ++ are irreducible over \axiom{R} and are pairwise distinct.
-       lazyIrreducibleFactors : LP -> LP
-          ++ \axiom{lazyIrreducibleFactors(lp)} returns \axiom{lf} such that if
-          ++ \axiom{lp = [p1,...,pn]} and \axiom{lf = [f1,...,fm]} then 
-          ++ \axiom{p1*p2*...*pn=0} means \axiom{f1*f2*...*fm=0}, and the \axiom{fi}
-          ++ are irreducible over \axiom{R} and are pairwise distinct.
-          ++ The algorithm tries to avoid factorization into irreducible
-          ++ factors as far as possible and makes previously use of gcd
-          ++ techniques over \axiom{R}.
-       removeIrreducibleRedundantFactors : (LP, LP) -> LP
-          ++ \axiom{removeIrreducibleRedundantFactors(lp,lq)} returns the same
-          ++ as \axiom{irreducibleFactors(concat(lp,lq))} assuming
-          ++ that \axiom{irreducibleFactors(lp)} returns \axiom{lp}
-          ++ up to replacing some polynomial \axiom{pj} in \axiom{lp}
-          ++ by some polynomial \axiom{qj} associated to \axiom{pj}.
-       
-  Implementation ==  add
+\begin{chunk}{COQ PSETPK}
+(* package PSETPK *)
+(*
 
      autoRemainder: T -> List(P)
 
@@ -164415,7 +203620,6 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where
 
      linear? p ==
        ground? p => false
---       one?(mdeg(p))
        (mdeg(p) = 1)
 
      linearPolynomials  ps ==
@@ -164464,7 +203668,8 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where
          p := first lp
          lp := rest lp
          copylf := lf
-         while (not empty? copylf) and (not ground? p) and (not (mvar(p) < mvar(first copylf))) repeat
+         while (not empty? copylf) and (not ground? p) _
+                and (not (mvar(p) < mvar(first copylf))) repeat
            f := first copylf
            copylf := rest copylf
            while (((test := p exquo$P f)) case P) repeat
@@ -164553,7 +203758,6 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where
          bs := (rec::RBT).bas        
          rs := (rec::RBT).top
          rs :=  rewriteIdealWithRemainder(rs,bs)$T
---         contradiction := ((not empty? rs) and (one? first(rs)))
          contradiction := ((not empty? rs) and (first(rs) = 1))
          if not contradiction
            then
@@ -164609,6 +203813,7 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where
 
      if (R has EuclideanDomain) and (R has CharacteristicZero)
      then
+
        irreducibleFactors lp ==
          newlp : LP := []
          lrrz : List RRZ
@@ -164687,7 +203892,8 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where
        rewriteIdealWithQuasiMonicGenerators (ps,redOp?,redOp) ==
          ups := removeSquaresIfCan(univariatePolynomialsGcds(ps,true))
          ps := removeDuplicates concat(ups,ps)
-         rewriteSetByReducingWithParticularGenerators(ps,quasiMonic?,redOp?,redOp)
+         rewriteSetByReducingWithParticularGenerators_
+             (ps,quasiMonic?,redOp?,redOp)
 
        removeRoughlyRedundantFactorsInContents (ps,lf) ==
          empty? ps => ps
@@ -164826,7 +204032,8 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where
          lp
 
        rewriteIdealWithQuasiMonicGenerators (ps,redOp?,redOp) ==
-         rewriteSetByReducingWithParticularGenerators(ps,quasiMonic?,redOp?,redOp)
+         rewriteSetByReducingWithParticularGenerators_
+           (ps,quasiMonic?,redOp?,redOp)
 
        removeRedundantFactors (a:P,b:P) ==
          a := primPartElseUnitCanonical(a)
@@ -164896,7 +204103,8 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where
            else
              (c,d) := (b,a)
          rrf := unprotectedRemoveRedundantFactors(c,d)
-         empty? rrf => error"in removeRedundantFactors : (LP,P) -> LP from PSETPK"
+         empty? rrf =>
+           error"in removeRedundantFactors : (LP,P) -> LP from PSETPK"
          c := first rrf
          rrf := rest rrf
          if empty? rrf
@@ -164929,7 +204137,8 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where
                          a := d
                else
                  e := first rrf
-                 not empty? rest(rrf) => error"in removeRedundantFactors:(LP,P)->LP from PSETPK"
+                 not empty? rest(rrf) => 
+                   error"in removeRedundantFactors:(LP,P)->LP from PSETPK"
                  -- ASSUME that neither c, nor d, nor e may be associated to b
                  toSave := removeRedundantFactors(toSave,c)
                  toSave := removeRedundantFactors(toSave,d)
@@ -164939,11 +204148,6 @@ PolynomialSetUtilitiesPackage (R,E,V,P) : Exports == Implementation where
              toSave := sort(infRittWu?,cons(a,toSave))
        toSave   
 
-\end{chunk}
-
-\begin{chunk}{COQ PSETPK}
-(* package PSETPK *)
-(*
 *)
 
 \end{chunk}
@@ -165295,6 +204499,221 @@ PolynomialSolveByFormulas(UP, F): PSFcat == PSFdef where
 \begin{chunk}{COQ SOLVEFOR}
 (* package SOLVEFOR *)
 (*
+
+        -----------------------------------------------------------------
+        -- Stuff for mapSolve
+        -----------------------------------------------------------------
+        id ==> (IDENTITY$Lisp)
+
+        maplist: List Record(arg: F, res: F) := []
+        mapSolving?: Boolean := false
+        -- map: F -> F := id #1    replaced with line below
+        map: Boolean := false
+
+        mapSolve(p, fn) ==
+            -- map := fn #1   replaced with line below
+            locmap: F -> F := x +-> fn x; map := id locmap
+            mapSolving? := true;  maplist := []
+            slist := solve p
+            mapSolving? := false;
+            -- map := id #1   replaced with line below
+            locmap := x +-> id x; map := id locmap
+            [slist, maplist]
+
+        part(s: F): F ==
+            not mapSolving? => s
+            -- t := map s     replaced with line below
+            t: F := SPADCALL(s, map)$Lisp
+            t = s => s
+            maplist := cons([t, s], maplist)
+            t
+
+        -----------------------------------------------------------------
+        -- Entry points and error handling
+        -----------------------------------------------------------------
+        cc ==> coefficient
+
+        -- local intsolve
+        intsolve(u:UP):L(F) ==
+            u := (factors squareFree u).1.factor
+            n := degree u
+            n=1 => linear    (cc(u,1), cc(u,0))
+            n=2 => quadratic (cc(u,2), cc(u,1), cc(u,0))
+            n=3 => cubic     (cc(u,3), cc(u,2), cc(u,1), cc(u,0))
+            n=4 => quartic   (cc(u,4), cc(u,3), cc(u,2), cc(u,1), cc(u,0))
+            error "All sqfr factors of polynomial must be of degree < 5"
+
+        solve u ==
+            ls := nil$L(F)
+            for f in factors squareFree u repeat
+               lsf := intsolve f.factor
+               for i in 1..(f.exponent) repeat ls := [:lsf,:ls]
+            ls
+
+        particularSolution u ==
+            u := (factors squareFree u).1.factor
+            n := degree u
+            n=1 => aLinear    (cc(u,1), cc(u,0))
+            n=2 => aQuadratic (cc(u,2), cc(u,1), cc(u,0))
+            n=3 => aCubic     (cc(u,3), cc(u,2), cc(u,1), cc(u,0))
+            n=4 => aQuartic   (cc(u,4), cc(u,3), cc(u,2), cc(u,1), cc(u,0))
+            error "All sqfr factors of polynomial must be of degree < 5"
+
+        needDegree(n: Integer, u: UP): Boolean ==
+            degree u = n => true
+            error concat("Polynomial must be of degree ", n::String)
+
+        needLcoef(cn: F): Boolean ==
+            cn ^= 0 => true
+            error "Leading coefficient must not be 0."
+
+        needChar0(): Boolean ==
+            characteristic()$F = 0 => true
+            error "Formula defined only for fields of characteristic 0."
+
+        linear u ==
+            needDegree(1, u)
+            linear (coefficient(u,1), coefficient(u,0))
+
+        quadratic u ==
+            needDegree(2, u)
+            quadratic (coefficient(u,2), coefficient(u,1),
+                       coefficient(u,0))
+
+        cubic u ==
+            needDegree(3, u)
+            cubic (coefficient(u,3), coefficient(u,2),
+                   coefficient(u,1), coefficient(u,0))
+
+        quartic u ==
+            needDegree(4, u)
+            quartic (coefficient(u,4),coefficient(u,3),
+                     coefficient(u,2),coefficient(u,1),coefficient(u,0))
+
+        -----------------------------------------------------------------
+        -- The formulas
+        -----------------------------------------------------------------
+
+        -- local function for testing equality of radicals.
+        --  This function is necessary to detect at least some of the
+        --  situations like sqrt(9)-3 = 0 --> false.
+        equ(x:F,y:F):Boolean ==
+            ( (recip(x-y)) case "failed" ) => true
+            false
+
+        linear(c1, c0) ==
+            needLcoef c1
+            [- c0/c1 ]
+
+        aLinear(c1, c0) ==
+            first linear(c1,c0)
+
+        quadratic(c2, c1, c0) ==
+            needLcoef c2; needChar0()
+            (c0 = 0) => [0$F,:linear(c2, c1)]
+            (c1 = 0) => [(-c0/c2)**(1/2),-(-c0/c2)**(1/2)]
+            D := part(c1**2 - 4*c2*c0)**(1/2)
+            [(-c1+D)/(2*c2), (-c1-D)/(2*c2)]
+
+        aQuadratic(c2, c1, c0) ==
+            needLcoef c2; needChar0()
+            (c0 = 0) => 0$F
+            (c1 = 0) => (-c0/c2)**(1/2)
+            D := part(c1**2 - 4*c2*c0)**(1/2)
+            (-c1+D)/(2*c2)
+
+        w3: F := (-1 + (-3::F)**(1/2)) / 2::F
+
+        cubic(c3, c2, c1, c0) ==
+            needLcoef c3; needChar0()
+
+            -- case one root = 0, not necessary but keeps result small
+            (c0 = 0) => [0$F,:quadratic(c3, c2, c1)]
+            a1 := c2/c3;  a2 := c1/c3;  a3 := c0/c3
+
+            -- case x**3-a3 = 0, not necessary but keeps result small
+            (a1 = 0 and a2 = 0) =>
+                [ u*(-a3)**(1/3) for u in [1, w3, w3**2 ] ]
+
+            -- case x**3 + a1*x**2 + a1**2*x/3 + a3 = 0, the general for-
+            --   mula is not valid in this case, but solution is easy.
+            P := part(-a1/3::F)
+            equ(a1**2,3*a2) =>
+              S := part((- a3 + (a1**3)/27::F)**(1/3))
+              [ P + S*u for u in [1,w3,w3**2] ]
+
+            -- general case
+            Q := part((3*a2 - a1**2)/9::F)
+            R := part((9*a1*a2 - 27*a3 - 2*a1**3)/54::F)
+            D := part(Q**3 + R**2)**(1/2)
+            S := part(R + D)**(1/3)
+            -- S = 0 is done in the previous case
+            [ P + S*u - Q/(S*u) for u in [1, w3, w3**2] ]
+
+        aCubic(c3, c2, c1, c0) ==
+            needLcoef c3; needChar0()
+            (c0 = 0) => 0$F
+            a1 := c2/c3;  a2 := c1/c3;  a3 := c0/c3
+            (a1 = 0 and a2 = 0) => (-a3)**(1/3)
+            P := part(-a1/3::F)
+            equ(a1**2,3*a2) =>
+              S := part((- a3 + (a1**3)/27::F)**(1/3))
+              P + S
+            Q := part((3*a2 - a1**2)/9::F)
+            R := part((9*a1*a2 - 27*a3 - 2*a1**3)/54::F)
+            D := part(Q**3 + R**2)**(1/2)
+            S := part(R + D)**(1/3)
+            P + S - Q/S
+
+        quartic(c4, c3, c2, c1, c0) ==
+            needLcoef c4; needChar0()
+
+            -- case one root = 0, not necessary but keeps result small
+            (c0 = 0) => [0$F,:cubic(c4, c3, c2, c1)]
+            -- Make monic:
+            a1 := c3/c4; a2 := c2/c4; a3 := c1/c4; a4 := c0/c4
+
+            -- case x**4 + a4 = 0 <=> (x**2-sqrt(-a4))*(x**2+sqrt(-a4))
+            -- not necessary but keeps result small.
+            (a1 = 0 and a2 = 0 and a3 = 0) =>
+                append( quadratic(1, 0, (-a4)**(1/2)),_
+                        quadratic(1 ,0, -((-a4)**(1/2))) )
+
+            -- Translate w = x+a1/4 to eliminate a1:  w**4+p*w**2+q*w+r
+            p := part(a2-3*a1*a1/8::F)
+            q := part(a3-a1*a2/2::F + a1**3/8::F)
+            r := part(a4-a1*a3/4::F + a1**2*a2/16::F - 3*a1**4/256::F)
+            -- t0 := the cubic resolvent of x**3-p*x**2-4*r*x+4*p*r-q**2
+            -- The roots of the translated polynomial are those of
+            -- two quadratics. (What about rt=0 ?)
+            -- rt=0 can be avoided by picking a root ^= p of the cubic
+            -- polynomial above. This is always possible provided that
+            -- the input is squarefree. In this case the two other roots
+            -- are +(-) 2*r**(1/2).
+            if equ(q,0)            -- this means p is a root
+              then t0 := part(2*(r**(1/2)))
+              else t0 := aCubic(1, -p, -4*r, 4*p*r - q**2)
+            rt    := part(t0 - p)**(1/2)
+            slist := append( quadratic( 1,  rt, (-q/rt + t0)/2::F ),
+                             quadratic( 1, -rt, ( q/rt + t0)/2::F ))
+            -- Translate back:
+            [s - a1/4::F for s in slist]
+
+        aQuartic(c4, c3, c2, c1, c0) ==
+            needLcoef c4; needChar0()
+            (c0 = 0) => 0$F
+            a1 := c3/c4; a2 := c2/c4; a3 := c1/c4; a4 := c0/c4
+            (a1 = 0 and a2 = 0 and a3 = 0) => (-a4)**(1/4)
+            p  := part(a2-3*a1*a1/8::F)
+            q  := part(a3-a1*a2/2::F + a1**2*a1/8::F)
+            r  := part(a4-a1*a3/4::F + a1**2*a2/16::F - 3*a1**4/256::F)
+            if equ(q,0)
+              then t0 := part(2*(r**(1/2)))
+              else t0 := aCubic(1, -p, -4*r, 4*p*r - q**2)
+            rt := part(t0 - p)**(1/2)
+            s  := aQuadratic( 1,  rt, (-q/rt + t0)/2::F )
+            s - a1/4::F
+
 *)
 
 \end{chunk}
@@ -165376,6 +204795,7 @@ PolynomialSquareFree(VarSet:OrderedSet,E,RC:GcdDomain,P):C == T where
       ++ factors are pairwise relatively prime.
 
   T == add
+
     SUP    ==> SparseUnivariatePolynomial(P)
     NNI    ==> NonNegativeInteger
     fUnion ==> Union("nil", "sqfr", "irred", "prime")
@@ -165476,6 +204896,102 @@ PolynomialSquareFree(VarSet:OrderedSet,E,RC:GcdDomain,P):C == T where
 \begin{chunk}{COQ PSQFR}
 (* package PSQFR *)
 (*
+
+    SUP    ==> SparseUnivariatePolynomial(P)
+    NNI    ==> NonNegativeInteger
+    fUnion ==> Union("nil", "sqfr", "irred", "prime")
+    FF     ==> Record(flg:fUnion, fctr:P, xpnt:Integer)
+
+    finSqFr : (P,List VarSet) -> Factored P
+    pthPower : P -> Factored P
+    pPolRoot : P -> P
+    putPth   : P -> P
+
+    chrc:=characteristic$RC
+
+    if RC has CharacteristicNonZero then
+    -- find the p-th root of a polynomial
+      pPolRoot(f:P) : P ==
+        lvar:=variables f
+        empty? lvar => f
+        mv:=first lvar
+        uf:=univariate(f,mv)
+        uf:=divideExponents(uf,chrc)::SUP
+        uf:=map(pPolRoot,uf)
+        multivariate(uf,mv)
+
+    -- substitute variables with their p-th power
+      putPth(f:P) : P ==
+        lvar:=variables f
+        empty? lvar => f
+        mv:=first lvar
+        uf:=univariate(f,mv)
+        uf:=multiplyExponents(uf,chrc)::SUP
+        uf:=map(putPth,uf)
+        multivariate(uf,mv)
+
+    -- the polynomial is a perfect power
+      pthPower(f:P) : Factored P ==
+        proot : P := 0
+        isSq  : Boolean := false
+        if (g:=charthRoot f) case "failed" then proot:=pPolRoot(f)
+        else
+          proot := g :: P
+          isSq  := true
+        psqfr:=finSqFr(proot,variables f)
+        isSq  =>
+          makeFR((unit psqfr)**chrc,[[u.flg,u.fctr,
+           (u.xpnt)*chrc] for u in factorList psqfr])
+        makeFR((unit psqfr),[["nil",putPth u.fctr,u.xpnt]
+                             for u in factorList psqfr])
+
+    -- compute the square free decomposition, finite characteristic case
+      finSqFr(f:P,lvar:List VarSet) : Factored P ==
+         empty? lvar => pthPower(f)
+         mv:=first lvar
+         lvar:=lvar.rest
+         differentiate(f,mv)=0 => finSqFr(f,lvar)
+         uf:=univariate(f,mv)
+         cont := content uf
+         cont1:P:=1
+         uf := (uf exquo cont)::SUP
+         squf := squareFree(uf)$UnivariatePolynomialSquareFree(P,SUP)
+         pfaclist:List FF :=[]
+         for u in factorList squf repeat
+           uexp:NNI:=(u.xpnt):NNI
+           u.flg = "sqfr" =>  -- the square free factor is OK
+             pfaclist:= cons([u.flg,multivariate(u.fctr,mv),uexp],
+                              pfaclist)
+           --listfin1:= finSqFr(multivariate(u.fctr,mv),lvar)
+           listfin1:= squareFree multivariate(u.fctr,mv)
+           flistfin1:=[[uu.flg,uu.fctr,uu.xpnt*uexp]
+                        for uu in factorList listfin1]
+           cont1:=cont1*((unit listfin1)**uexp)
+           pfaclist:=append(flistfin1,pfaclist)
+         cont:=cont*cont1
+         cont ^= 1 =>
+           sqp := squareFree cont
+           pfaclist:= append (factorList sqp,pfaclist)
+           makeFR(unit(sqp)*coefficient(unit squf,0),pfaclist)
+         makeFR(coefficient(unit squf,0),pfaclist)
+
+    squareFree(p:P) ==
+       mv:=mainVariable p
+       mv case "failed" => makeFR(p,[])$Factored(P)
+       characteristic$RC ^=0 => finSqFr(p,variables p)
+       up:=univariate(p,mv)
+       cont := content up
+       up := (up exquo cont)::SUP
+       squp := squareFree(up)$UnivariatePolynomialSquareFree(P,SUP)
+       pfaclist:List FF :=
+         [[u.flg,multivariate(u.fctr,mv),u.xpnt]
+                                            for u in factorList squp]
+       cont ^= 1 =>
+         sqp := squareFree cont
+         makeFR(unit(sqp)*coefficient(unit squp,0),
+              append(factorList sqp, pfaclist))
+       makeFR(coefficient(unit squp,0),pfaclist)
+
 *)
 
 \end{chunk}
@@ -165547,6 +205063,7 @@ PolynomialToUnivariatePolynomial(x:Symbol, R:Ring): with
      ++ univariate(p, x) converts the polynomial p to a one of type
      ++ \spad{UnivariatePolynomial(x,Polynomial(R))}, ie. as a member of \spad{R[...][x]}.
  == add
+
   univariate(p, y) ==
     q:SparseUnivariatePolynomial(Polynomial R) := univariate(p, x)
     map(x1+->x1, q)$UnivariatePolynomialCategoryFunctions2(Polynomial R,
@@ -165558,6 +205075,13 @@ PolynomialToUnivariatePolynomial(x:Symbol, R:Ring): with
 \begin{chunk}{COQ POLY2UP}
 (* package POLY2UP *)
 (*
+
+  univariate(p, y) ==
+    q:SparseUnivariatePolynomial(Polynomial R) := univariate(p, x)
+    map(x1+->x1, q)$UnivariatePolynomialCategoryFunctions2(Polynomial R,
+                  SparseUnivariatePolynomial Polynomial R, Polynomial R,
+                      UnivariatePolynomial(x, Polynomial R))
+
 *)
 
 \end{chunk}
@@ -165672,6 +205196,480 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where
       ++ \spad{lim(x -> a+,f(x))}.
 
   Implementation ==> add
+
+    import ToolsForSign(R)
+    import ElementaryFunctionStructurePackage(R,FE)
+
+    zeroFE:FE := 0
+    anyRootsOrAtrigs?   : FE -> Boolean
+    complLimit  : (FE,SY) -> Union(OPF,"failed")
+    okProblem?  : (String,String) -> Boolean
+    realLimit   : (FE,SY) -> U
+    xxpLimit    : (FE,SY) -> RESULT
+    limitPlus   : (FE,SY) -> RESULT
+    localsubst  : (FE,Kernel FE,Z,FE) -> FE
+    locallimit  : (FE,SY,OFE) -> U
+    locallimitcomplex : (FE,SY,OPF) -> Union(OPF,"failed")
+    poleLimit:(RN,FE,SY) -> U
+    poleLimitPlus:(RN,FE,SY) -> RESULT
+
+    noX?: (FE,SY) -> Boolean
+    noX?(fcn,x) == not member?(x,variables fcn)
+
+    constant?: FE -> Boolean
+    constant? fcn == empty? variables fcn
+
+    firstNonLogPtr: (FE,SY) -> List Kernel FE
+    firstNonLogPtr(fcn,x) ==
+      -- returns a pointer to the first element of kernels(fcn) which
+      -- has 'x' as a variable, which is not a logarithm, and which is
+      -- not simply 'x'
+      list := kernels fcn
+      while not empty? list repeat
+        ker := first list
+        not is?(ker,"log" :: Symbol) and member?(x,variables(ker::FE)) _
+               and not(x = name(ker)) =>
+          return list
+        list := rest list
+      empty()
+
+    finiteValueAtInfinity?: Kernel FE -> Boolean
+    finiteValueAtInfinity? ker ==
+      is?(ker,"erf" :: Symbol) => true
+      is?(ker,"sech" :: Symbol) => true
+      is?(ker,"csch" :: Symbol) => true
+      is?(ker,"tanh" :: Symbol) => true
+      is?(ker,"coth" :: Symbol) => true
+      is?(ker,"atan" :: Symbol) => true
+      is?(ker,"acot" :: Symbol) => true
+      is?(ker,"asec" :: Symbol) => true
+      is?(ker,"acsc" :: Symbol) => true
+      is?(ker,"acsch" :: Symbol) => true
+      is?(ker,"acoth" :: Symbol) => true
+      is?(ker,"fresnelS" :: Symbol) => true
+      is?(ker,"fresnelC" :: Symbol) => true
+      error "finiteValueAtInfinity? true, but unknown value at infinity"
+
+    knownValueAtInfinity?: Kernel FE -> Boolean
+    knownValueAtInfinity? ker ==
+      is?(ker,"exp" :: Symbol) => true
+      is?(ker,"sinh" :: Symbol) => true
+      is?(ker,"cosh" :: Symbol) => true
+      false
+
+    leftOrRight: (FE,SY,FE) -> SingleInteger
+    leftOrRight(fcn,x,limVal) ==
+      -- function is called when limitPlus(fcn,x) = limVal
+      -- determines whether the limiting value is approached
+      -- from the left or from the right
+      (value := limitPlus(inv(fcn - limVal),x)) case "failed" => 0
+      (inf := whatInfinity(val := value :: OFE)) = 0 =>
+         error "limit package: internal error"
+      inf
+
+    specialLimit1: (FE,SY) -> RESULT
+    specialLimitKernel: (Kernel FE,SY) -> RESULT
+    specialLimitNormalize: (FE,SY) -> RESULT
+    specialLimit: (FE, SY) -> RESULT
+
+    specialLimit(fcn, x) ==
+      xkers := [k for k in kernels fcn | member?(x,variables(k::FE))]
+      #xkers = 1 => specialLimit1(fcn,x)
+      num := numerator fcn
+      den := denominator fcn
+      for k in xkers repeat
+        (fval := limitPlus(k::FE,x)) case "failed" =>
+            return specialLimitNormalize(fcn,x)
+        whatInfinity(val := fval::OFE) ^= 0 =>
+            return specialLimitNormalize(fcn,x)
+        (valu := retractIfCan(val)@Union(FE,"failed")) case "failed" =>
+            return specialLimitNormalize(fcn,x)
+        finVal := valu :: FE
+        num := eval(num, k, finVal)
+        den := eval(den, k, finVal)
+        den = 0 => return specialLimitNormalize(fcn,x)
+      (num/den) :: OFE :: RESULT
+
+    specialLimitNormalize(fcn,x) == -- tries to normalize result first
+      nfcn := normalize(fcn)
+      fcn ^= nfcn => limitPlus(nfcn,x)
+      xkers := [k for k in tower fcn | member?(x,variables(k::FE))]
+      # xkers ^= 2 => "failed"
+      expKers := [k for k in xkers | is?(k, "exp" :: Symbol)]
+      # expKers ^= 1 => "failed"
+      -- fcn is a rational function of x and exp(g(x)) 
+      -- for some rational function g
+      expKer := first expKers
+      (fval := limitPlus(expKer::FE,x)) case "failed" => "failed"
+      vv := new()$SY; eq : EQ FE := equation(expKer :: FE,vv :: FE)
+      cc := eval(fcn,eq)
+      expKerLim := fval :: OFE
+      -- following test for "failed" is needed due to compiler bug
+      -- limVal case OFE generates EQCAR(limVal, 1) which 
+      -- fails on atom "failed"
+      (limVal := locallimit(cc,vv,expKerLim)) case "failed" => "failed"
+      limVal case OFE =>
+         limm := limVal :: OFE
+         (lim := retractIfCan(limm)@Union(FE,"failed")) case "failed" =>
+               "failed" -- need special handling for directions at infinity
+         limitPlus(lim, x)
+      "failed"
+
+    -- limit of expression having only 1 kernel involving x
+    specialLimit1(fcn,x) ==
+      -- find the first interesting kernel in tower(fcn)
+      xkers := [k for k in kernels fcn | member?(x,variables(k::FE))]
+      #xkers ^= 1 => "failed"
+      ker := first xkers
+      vv := new()$SY; eq : EQ FE := equation(ker :: FE,vv :: FE)
+      cc := eval(fcn,eq)
+      member?(x,variables cc) => "failed"
+      (lim := specialLimitKernel(ker, x)) case "failed" => lim
+      argLim : OFE := lim :: OFE
+      (limVal := locallimit(cc,vv,argLim)) case "failed" => "failed"
+      limVal case OFE => limVal :: OFE
+      "failed"
+
+    -- limit of single kernel involving x
+    specialLimitKernel(ker,x) ==
+      is?(ker,"log" :: Symbol) =>
+          args := argument ker
+          empty? args => "failed" -- error "No argument"
+          not empty? rest args => "failed" -- error "Too many arugments"
+          arg := first args
+          -- compute limit(x -> 0+,arg)
+          (limm := limitPlus(arg,x)) case "failed" => "failed"
+          lim := limm :: OFE
+          (inf := whatInfinity lim) = -1 => "failed"
+          argLim : OFE :=
+            -- log(+infinity) = +infinity
+            inf = 1 => lim
+            -- now 'lim' must be finite
+            (li := retractIfCan(lim)@Union(FE,"failed") :: FE) = 0 =>
+              -- log(0) = -infinity
+              leftOrRight(arg,x,0) = 1 => minusInfinity()
+              return "failed"
+            log(li) :: OFE
+      -- kernel should be a function of one argument f(arg)
+      args := argument(ker)
+      empty? args => "failed"  -- error "No argument"
+      not empty? rest args => "failed" -- error "Too many arugments"
+      arg := first args
+      -- compute limit(x -> 0+,arg)
+      (limm := limitPlus(arg,x)) case "failed" => "failed"
+      lim := limm :: OFE
+      f := elt(operator ker,(var := new()$SY) :: FE)
+      -- compute limit(x -> 0+,f(arg))
+      -- case where 'lim' is finite
+      (inf := whatInfinity lim) = 0 =>
+         is?(ker,"erf" :: Symbol) => erf(retract(lim)@FE)$LF(R,FE) :: OFE
+         (kerValue := locallimit(f,var,lim)) case "failed" => "failed"
+         kerValue case OFE => kerValue :: OFE
+         "failed"
+      -- case where 'lim' is plus infinity
+      inf = 1 =>
+        finiteValueAtInfinity? ker =>
+          val : FE :=
+            is?(ker,"erf" :: Symbol) => 1
+            is?(ker,"sech" :: Symbol) => 0
+            is?(ker,"csch" :: Symbol) => 0
+            is?(ker,"tanh" :: Symbol) => 0
+            is?(ker,"coth" :: Symbol) => 0
+            is?(ker,"atan" :: Symbol) => pi()/(2 :: FE)
+            is?(ker,"acot" :: Symbol) => 0
+            is?(ker,"asec" :: Symbol) => pi()/(2 :: FE)
+            is?(ker,"acsc" :: Symbol) => 0
+            is?(ker,"acsch" :: Symbol) => 0
+            is?(ker,"fresnelS" :: Symbol) => -sqrt(pi()/(8::FE))
+            is?(ker,"fresnelC" :: Symbol) => -sqrt(pi()/(8::FE))
+            error "finiteValueAtInfinity? true, but unknown value at infinity"
+            -- ker must be acoth
+            0
+          val :: OFE
+        knownValueAtInfinity? ker =>
+          lim -- limit(exp, cosh, sinh ,x=inf) = inf
+        "failed"
+      -- case where 'lim' is minus infinity
+      finiteValueAtInfinity? ker =>
+        val : FE :=
+          is?(ker,"erf" :: Symbol) => -1
+          is?(ker,"sech" :: Symbol) => 0
+          is?(ker,"csch" :: Symbol) => 0
+          is?(ker,"tanh" :: Symbol) => 0
+          is?(ker,"coth" :: Symbol) => 0
+          is?(ker,"atan" :: Symbol) => -pi()/(2 :: FE)
+          is?(ker,"acot" :: Symbol) => pi()
+          is?(ker,"asec" :: Symbol) => -pi()/(2 :: FE)
+          is?(ker,"acsc" :: Symbol) => -pi()
+          is?(ker,"acsch" :: Symbol) => 0
+          -- ker must be acoth
+          0
+        val :: OFE
+      knownValueAtInfinity? ker =>
+        is?(ker,"exp" :: Symbol) => (0@FE) :: OFE
+        is?(ker,"sinh" :: Symbol) => lim
+        is?(ker,"cosh" :: Symbol) => plusInfinity()
+        "failed"
+      "failed"
+
+    logOnlyLimit: (FE,SY) -> RESULT
+    logOnlyLimit(coef,x) ==
+      -- this function is called when the 'constant' coefficient involves
+      -- the variable 'x'. Its purpose is to compute a right hand limit
+      -- of an expression involving log x. Here log x is replaced by -1/v,
+      -- where v is a new variable. If the new expression no longer involves
+      -- x, then take the right hand limit as v -> 0+
+      vv := new()$SY
+      eq : EQ FE := equation(log(x :: FE),-inv(vv :: FE))
+      member?(x,variables(cc := eval(coef,eq))) => "failed"
+      limitPlus(cc,vv)
+
+    locallimit(fcn,x,a) ==
+      -- Here 'fcn' is a function f(x) = f(x,...) in 'x' and possibly
+      -- other variables, and 'a' is a limiting value.  The function
+      -- computes lim(x -> a,f(x)).
+      xK := retract(x::FE)@Kernel(FE)
+      (n := whatInfinity a) = 0 =>
+        realLimit(localsubst(fcn,xK,1,retract(a)@FE),x)
+      (u := limitPlus(eval(fcn,xK,n * inv(xK::FE)),x))
+                                                case "failed" => "failed"
+      u::OFE
+
+    localsubst(fcn, k, n, a) ==
+      a = 0 and n = 1 => fcn
+      eval(fcn,k,n * (k::FE) + a)
+
+    locallimitcomplex(fcn,x,a) ==
+      xK := retract(x::FE)@Kernel(FE)
+      (g := retractIfCan(a)@Union(FE,"failed")) case FE =>
+        complLimit(localsubst(fcn,xK,1,g::FE),x)
+      complLimit(eval(fcn,xK,inv(xK::FE)),x)
+
+    limit(fcn,eq,str) ==
+      (xx := retractIfCan(lhs eq)@Union(SY,"failed")) case "failed" =>
+        error "limit:left hand side must be a variable"
+      x := xx :: SY; a := rhs eq
+      xK := retract(x::FE)@Kernel(FE)
+      limitPlus(localsubst(fcn,xK,direction str,a),x)
+
+    anyRootsOrAtrigs? fcn ==
+      -- determines if 'fcn' has any kernels which are roots
+      -- or if 'fcn' has any kernels which are inverse trig functions
+      -- which could produce series expansions with fractional exponents
+      for kernel in tower fcn repeat
+        is?(kernel,"nthRoot" :: Symbol) => return true
+        is?(kernel,"asin" :: Symbol) => return true
+        is?(kernel,"acos" :: Symbol) => return true
+        is?(kernel,"asec" :: Symbol) => return true
+        is?(kernel,"acsc" :: Symbol) => return true
+      false
+
+    complLimit(fcn,x) ==
+      -- computes lim(x -> 0,fcn) using a Puiseux expansion of fcn,
+      -- if fcn is an expression involving roots, and using a Laurent
+      -- expansion of fcn otherwise
+      lim : FE :=
+        anyRootsOrAtrigs? fcn =>
+          ppack := FS2UPS(R,FE,RN,_
+              UPXS(FE,x,zeroFE),EFUPXS(FE,ULS(FE,x,zeroFE),UPXS(FE,x,zeroFE),_
+              EFULS(FE,UTS(FE,x,zeroFE),ULS(FE,x,zeroFE))),x)
+          pseries := exprToUPS(fcn,false,"complex")$ppack
+          pseries case %problem => return "failed"
+          if pole?(upxs := pseries.%series) then upxs := map(normalize,upxs)
+          pole? upxs => return infinity()
+          coefficient(upxs,0)
+        lpack := FS2UPS(R,FE,Z,ULS(FE,x,zeroFE),_
+                 EFULS(FE,UTS(FE,x,zeroFE),ULS(FE,x,zeroFE)),x)
+        lseries := exprToUPS(fcn,false,"complex")$lpack
+        lseries case %problem => return "failed"
+        if pole?(uls := lseries.%series) then uls := map(normalize,uls)
+        pole? uls => return infinity()
+        coefficient(uls,0)
+      -- can the following happen?
+      member?(x,variables lim) =>
+        member?(x,variables(answer := normalize lim)) =>
+          error "limit: can't evaluate limit"
+        answer :: OPF
+      lim :: FE :: OPF
+
+    okProblem?(function,problem) ==
+      (function = "log") or (function = "nth root") =>
+        (problem = "series of non-zero order") or _
+               (problem = "negative leading coefficient")
+      (function = "atan") => problem = "branch problem"
+      (function = "erf") => problem = "unknown kernel"
+      problem = "essential singularity"
+
+    poleLimit(order,coef,x) ==
+      -- compute limit for function with pole
+      not member?(x,variables coef) =>
+        (s := sign(coef)$SIGNEF) case Integer =>
+          rtLim := (s :: Integer) * plusInfinity()
+          even? numer order => rtLim
+          even? denom order => ["failed",rtLim]$TwoSide
+          [-rtLim,rtLim]$TwoSide
+        -- infinite limit, but cannot determine sign
+        "failed"
+      error "limit: can't evaluate limit"
+
+    poleLimitPlus(order,coef,x) ==
+      -- compute right hand limit for function with pole
+      not member?(x,variables coef) =>
+        (s := sign(coef)$SIGNEF) case Integer =>
+          (s :: Integer) * plusInfinity()
+        -- infinite limit, but cannot determine sign
+        "failed"
+      (clim := specialLimit(coef,x)) case "failed" => "failed"
+      zero? (lim := clim :: OFE) =>
+        -- in this event, we need to determine if the limit of
+        -- the coef is 0+ or 0-
+        (cclim := specialLimit(inv coef,x)) case "failed" => "failed"
+        ss := whatInfinity(cclim :: OFE) :: Z
+        zero? ss =>
+          error "limit: internal error"
+        ss * plusInfinity()
+      t := whatInfinity(lim :: OFE) :: Z
+      zero? t =>
+        (tt := sign(coef)$SIGNEF) case Integer =>
+          (tt :: Integer) * plusInfinity()
+        -- infinite limit, but cannot determine sign
+        "failed"
+      t * plusInfinity()
+
+    realLimit(fcn,x) ==
+      -- computes lim(x -> 0,fcn) using a Puiseux expansion of fcn,
+      -- if fcn is an expression involving roots, and using a Laurent
+      -- expansion of fcn otherwise
+      lim : Union(FE,"failed") :=
+        anyRootsOrAtrigs? fcn =>
+          ppack := FS2UPS(R,FE,RN,_
+               UPXS(FE,x,zeroFE),EFUPXS(FE,ULS(FE,x,zeroFE),UPXS(FE,x,zeroFE),_
+               EFULS(FE,UTS(FE,x,zeroFE),ULS(FE,x,zeroFE))),x)
+          pseries := exprToUPS(fcn,true,"real: two sides")$ppack
+          pseries case %problem =>
+            trouble := pseries.%problem
+            function := trouble.func; problem := trouble.prob
+            okProblem?(function,problem) =>
+              left :=
+                xK : Kernel FE := kernel x
+                fcn0 := eval(fcn,xK,-(xK :: FE))
+                limitPlus(fcn0,x)
+              right := limitPlus(fcn,x)
+              (left case "failed") and (right case "failed") =>
+                return "failed"
+              if (left case OFE) and (right case OFE) then
+                (left :: OFE) = (right :: OFE) => return (left :: OFE)
+              return([left,right]$TwoSide)
+            return "failed"
+          if pole?(upxs := pseries.%series) then upxs := map(normalize,upxs)
+          pole? upxs =>
+            cp := coefficient(upxs,ordp := order upxs)
+            return poleLimit(ordp,cp,x)
+          coefficient(upxs,0)
+        lpack := FS2UPS(R,FE,Z,ULS(FE,x,zeroFE),_
+                 EFULS(FE,UTS(FE,x,zeroFE),ULS(FE,x,zeroFE)),x)
+        lseries := exprToUPS(fcn,true,"real: two sides")$lpack
+        lseries case %problem =>
+          trouble := lseries.%problem
+          function := trouble.func; problem := trouble.prob
+          okProblem?(function,problem) =>
+            left :=
+              xK : Kernel FE := kernel x
+              fcn0 := eval(fcn,xK,-(xK :: FE))
+              limitPlus(fcn0,x)
+            right := limitPlus(fcn,x)
+            (left case "failed") and (right case "failed") =>
+              return "failed"
+            if (left case OFE) and (right case OFE) then
+              (left :: OFE) = (right :: OFE) => return (left :: OFE)
+            return([left,right]$TwoSide)
+          return "failed"
+        if pole?(uls := lseries.%series) then uls := map(normalize,uls)
+        pole? uls =>
+          cl := coefficient(uls,ordl := order uls)
+          return poleLimit(ordl :: RN,cl,x)
+        coefficient(uls,0)
+      lim case "failed" => "failed"
+      member?(x,variables(lim :: FE)) =>
+        member?(x,variables(answer := normalize(lim :: FE))) =>
+          error "limit: can't evaluate limit"
+        answer :: OFE
+      lim :: FE :: OFE
+
+    xxpLimit(fcn,x) ==
+      -- computes lim(x -> 0+,fcn) using an exponential expansion of fcn
+      xpack := FS2EXPXP(R,FE,x,zeroFE)
+      xxp := exprToXXP(fcn,true)$xpack
+      xxp case %problem => "failed"
+      limitPlus(xxp.%expansion)
+
+    limitPlus(fcn,x) ==
+      -- computes lim(x -> 0+,fcn) using a generalized Puiseux expansion
+      -- of fcn, if fcn is an expression involving roots, and using a
+      -- generalized Laurent expansion of fcn otherwise
+      lim : Union(FE,"failed") :=
+        anyRootsOrAtrigs? fcn =>
+          ppack := FS2UPS(R,FE,RN,_
+               UPXS(FE,x,zeroFE),EFUPXS(FE,ULS(FE,x,zeroFE),UPXS(FE,x,zeroFE),_
+               EFULS(FE,UTS(FE,x,zeroFE),ULS(FE,x,zeroFE))),x)
+          pseries := exprToGenUPS(fcn,true,"real: right side")$ppack
+          pseries case %problem =>
+            trouble := pseries.%problem
+            ff := trouble.func; pp := trouble.prob
+            (pp = "negative leading coefficient") => return "failed"
+            "failed"
+          -- pseries case %problem => return "failed"
+          if pole?(upxs := pseries.%series) then upxs := map(normalize,upxs)
+          pole? upxs =>
+            cp := coefficient(upxs,ordp := order upxs)
+            return poleLimitPlus(ordp,cp,x)
+          coefficient(upxs,0)
+        lpack := FS2UPS(R,FE,Z,ULS(FE,x,zeroFE),_
+                 EFULS(FE,UTS(FE,x,zeroFE),ULS(FE,x,zeroFE)),x)
+        lseries := exprToGenUPS(fcn,true,"real: right side")$lpack
+        lseries case %problem =>
+          trouble := lseries.%problem
+          ff := trouble.func; pp := trouble.prob
+          (pp = "negative leading coefficient") => return "failed"
+          "failed"
+        -- lseries case %problem => return "failed"
+        if pole?(uls := lseries.%series) then uls := map(normalize,uls)
+        pole? uls =>
+          cl := coefficient(uls,ordl := order uls)
+          return poleLimitPlus(ordl :: RN,cl,x)
+        coefficient(uls,0)
+      lim case "failed" =>
+        (xLim := xxpLimit(fcn,x)) case "failed" => specialLimit(fcn,x)
+        xLim
+      member?(x,variables(lim :: FE)) =>
+        member?(x,variables(answer := normalize(lim :: FE))) =>
+          (xLim := xxpLimit(answer,x)) case "failed" => specialLimit(answer,x)
+          xLim
+        answer :: OFE
+      lim :: FE :: OFE
+
+    limit(fcn:FE,eq:EQ OFE) ==
+      (f := retractIfCan(lhs eq)@Union(FE,"failed")) case "failed" =>
+        error "limit:left hand side must be a variable"
+      (xx := retractIfCan(f)@Union(SY,"failed")) case "failed" =>
+        error "limit:left hand side must be a variable"
+      x := xx :: SY; a := rhs eq
+      locallimit(fcn,x,a)
+
+    complexLimit(fcn:FE,eq:EQ OPF) ==
+      (f := retractIfCan(lhs eq)@Union(FE,"failed")) case "failed" =>
+        error "limit:left hand side must be a variable"
+      (xx := retractIfCan(f)@Union(SY,"failed")) case "failed" =>
+        error "limit:left hand side must be a variable"
+      x := xx :: SY; a := rhs eq
+      locallimitcomplex(fcn,x,a)
+
+\end{chunk}
+
+\begin{chunk}{COQ LIMITPS}
+(* package LIMITPS *)
+(*
+
     import ToolsForSign(R)
     import ElementaryFunctionStructurePackage(R,FE)
 
@@ -165772,14 +205770,16 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where
       # xkers ^= 2 => "failed"
       expKers := [k for k in xkers | is?(k, "exp" :: Symbol)]
       # expKers ^= 1 => "failed"
-    -- fcn is a rational function of x and exp(g(x)) for some rational function g
+      -- fcn is a rational function of x and exp(g(x)) 
+      -- for some rational function g
       expKer := first expKers
       (fval := limitPlus(expKer::FE,x)) case "failed" => "failed"
       vv := new()$SY; eq : EQ FE := equation(expKer :: FE,vv :: FE)
       cc := eval(fcn,eq)
       expKerLim := fval :: OFE
-        -- following test for "failed" is needed due to compiler bug
-        -- limVal case OFE generates EQCAR(limVal, 1) which fails on atom "failed"
+      -- following test for "failed" is needed due to compiler bug
+      -- limVal case OFE generates EQCAR(limVal, 1) which 
+      -- fails on atom "failed"
       (limVal := locallimit(cc,vv,expKerLim)) case "failed" => "failed"
       limVal case OFE =>
          limm := limVal :: OFE
@@ -166137,11 +206137,6 @@ PowerSeriesLimitPackage(R,FE): Exports == Implementation where
       x := xx :: SY; a := rhs eq
       locallimitcomplex(fcn,x,a)
 
-\end{chunk}
-
-\begin{chunk}{COQ LIMITPS}
-(* package LIMITPS *)
-(*
 *)
 
 \end{chunk}
@@ -166225,6 +206220,7 @@ PrecomputedAssociatedEquations(R, L): Exports == Implementation where
       ++ the particular combination \spad{degree(L), m}.
  
   Implementation ==> add
+
     A32:  L -> U
     A42:  L -> U
     A425: (A, A, A) -> List R
@@ -166297,6 +206293,74 @@ PrecomputedAssociatedEquations(R, L): Exports == Implementation where
 \begin{chunk}{COQ PREASSOC}
 (* package PREASSOC *)
 (*
+
+    A32:  L -> U
+    A42:  L -> U
+    A425: (A, A, A) -> List R
+    A426: (A, A, A) -> List R
+    makeMonic: L -> Union(A, "failed")
+ 
+    diff:L := D()
+ 
+    firstUncouplingMatrix(op, m) ==
+      n := degree op
+      n = 3 and m = 2 => A32 op
+      n = 4 and m = 2 => A42 op
+      "failed"
+        
+    makeMonic op ==
+      lc := leadingCoefficient op
+      a:A := new(n := degree op, 0)
+      for i in 0..(n-1)::N repeat
+        (u := coefficient(op, i) exquo lc) case "failed" => return "failed"
+        a.i := - (u::R)
+      a
+    
+    A32 op ==
+      (u := makeMonic op) case "failed" => "failed"
+      a := u::A
+      matrix [[0, 1, 0], [a.1, a.2, 1],
+              [diff(a.1) + a.1 * a.2 - a.0, diff(a.2) + a.2**2 + a.1, 2 * a.2]]
+ 
+    A42 op ==
+      (u := makeMonic op) case "failed" => "failed"
+      a := u::A
+      a':A := new(4, 0)
+      a'':A := new(4, 0)
+      for i in 0..3 repeat
+        a'.i := diff(a.i)
+        a''.i := diff(a'.i)
+      matrix [[0, 1, 0, 0, 0, 0], [0, 0, 1, 1, 0, 0], [a.1,a.2,0,a.3,2::R,0],
+              [a'.1 + a.1 * a.3 - 2 * a.0, a'.2 + a.2 * a.3 + a.1, 3 * a.2,
+               a'.3 + a.3 ** 2 + a.2, 3 * a.3, 2::R],
+                A425(a, a', a''), A426(a, a', a'')]
+ 
+    A425(a, a', a'') ==
+      [a''.1 + 2 * a.1 * a'.3 + a.3 * a'.1 - 2 * a'.0 + a.1 * a.3 ** 2
+       - 3 * a.0 * a.3 + a.1 * a.2,
+        a''.2 + 2 * a.2 * a'.3 + a.3 * a'.2 + 2 * a'.1 + a.2 * a.3 ** 2
+         + a.1 * a.3 + a.2 ** 2 - 4 * a.0,
+          4 * a'.2 + 4 * a.2 * a.3 - a.1,
+           a''.3 + 3 * a.3 * a'.3 + 2 * a'.2 + a.3 ** 3 + 2 * a.2 * a.3 + a.1,
+            4 * a'.3 + 4 * a.3 ** 2 + 4 * a.2, 5 * a.3]
+              
+    A426(a, a', a'') ==
+      [diff(a''.1) + 3 * a.1 * a''.3 + a.3 * a''.1 - 2 * a''.0
+       + (3 * a'.1 + 5 * a.1 * a.3 - 7 * a.0) * a'.3 + 3 * a.1 * a'.2
+        + (a.3 ** 2 + a.2) * a'.1 - 3 * a.3 * a'.0 + a.1 * a.3 ** 3
+         - 4 * a.0 * a.3 ** 2 + 2 * a.1 * a.2 * a.3 - 4 * a.0 * a.2 + a.1 ** 2,
+          diff(a''.2) + 3 * a.2 * a''.3 + a.3 * a''.2 + 3 * a''.1
+           + (3*a'.2 + 5*a.2 * a.3 + 3 * a.1) * a'.3 + (a.3**2 + 4*a.2)*a'.2
+            + 2 * a.3 * a'.1 - 6 * a'.0 + a.2 * a.3 ** 3 + a.1 * a.3 ** 2
+             + (2 * a.2**2 - 8 * a.0) * a.3 + 2 * a.1 * a.2,
+              5 * a''.2 + 10 * a.2 * a'.3 + 5 * a.3 * a'.2 + a'.1
+               + 5 * a.2 * a.3 ** 2 - 4 * a.1 * a.3 + 5 * a.2**2 - 4 * a.0,
+                diff(a''.3) + 4 * a.3 * a''.3 + 3*a''.2 + 3 * a'.3**2
+                 + (6 * a.3**2 + 4 * a.2) * a'.3 + 5 * a.3 * a'.2 + 3 * a'.1
+                  + a.3**4 + 3 * a.2 * a.3**2 + 2 * a.1 * a.3 + a.2**2 - 4*a.0,
+                   5 * a''.3 + 15 * a.3 * a'.3 + 10 * a'.2 + 5 * a.3**3
+                    + 10 * a.2 * a.3, 9 * a'.3 + 9 * a.3**2 + 4 * a.2]
+
 *)
 
 \end{chunk}
@@ -166405,8 +206469,11 @@ PrimitiveArrayFunctions2(A, B): Exports == Implementation where
     ++X map(x+->x+2,[i for i in 1..10])$T1
 
   Implementation ==> add
+
     map(f, v)       == map(f, v)$O2
+
     scan(f, v, b)   == scan(f, v, b)$O2
+
     reduce(f, v, b) == reduce(f, v, b)$O2
 
 \end{chunk}
@@ -166414,6 +206481,13 @@ PrimitiveArrayFunctions2(A, B): Exports == Implementation where
 \begin{chunk}{COQ PRIMARR2}
 (* package PRIMARR2 *)
 (*
+
+    map(f, v)       == map(f, v)$O2
+
+    scan(f, v, b)   == scan(f, v, b)$O2
+
+    reduce(f, v, b) == reduce(f, v, b)$O2
+
 *)
 
 \end{chunk}
@@ -166516,6 +206590,7 @@ PrimitiveElement(F): Exports == Implementation where
       ++ \spadglossSee{groebner bases}{Groebner basis}.
 
   Implementation ==> add
+
     import PolyGroebner(F)
 
     multi     : (UP, SY) -> P
@@ -166526,12 +206601,14 @@ PrimitiveElement(F): Exports == Implementation where
     innerPrimitiveElement: (List P, List SY, SY) -> REC
 
     multi(p, v)            == multivariate(map((f1:F):F +-> f1, p), v)
-    randomInts(n, m)       == [symmetricRemainder(random()$Integer, m) for i in 1..n]
+
+    randomInts(n, m) == [symmetricRemainder(random()$Integer, m) for i in 1..n]
+
     incl?(a, b)            == every?((s1:SY):Boolean +-> member?(s1, b), a)
+
     primitiveElement(l, v) == primitiveElement(l, v, new()$SY)
 
     primitiveElement(p1, a1, p2, a2) ==
---      one? degree(p2, a1) => [0, 1, univariate resultant(p1, p2, a1)]
       (degree(p2, a1) = 1) => [0, 1, univariate resultant(p1, p2, a1)]
       u := (new()$SY)::P
       b := a2::P
@@ -166578,6 +206655,66 @@ PrimitiveElement(F): Exports == Implementation where
 \begin{chunk}{COQ PRIMELT}
 (* package PRIMELT *)
 (*
+
+    import PolyGroebner(F)
+
+    multi     : (UP, SY) -> P
+    randomInts: (NonNegativeInteger, NonNegativeInteger) -> List Integer
+    findUniv  : (List P, SY, SY) -> Union(P, "failed")
+    incl?     : (List SY, List SY) -> Boolean
+    triangularLinearIfCan:(List P,List SY,SY) -> Union(List UP,"failed")
+    innerPrimitiveElement: (List P, List SY, SY) -> REC
+
+    multi(p, v)            == multivariate(map((f1:F):F +-> f1, p), v)
+
+    randomInts(n, m) == [symmetricRemainder(random()$Integer, m) for i in 1..n]
+
+    incl?(a, b)            == every?((s1:SY):Boolean +-> member?(s1, b), a)
+
+    primitiveElement(l, v) == primitiveElement(l, v, new()$SY)
+
+    primitiveElement(p1, a1, p2, a2) ==
+      (degree(p2, a1) = 1) => [0, 1, univariate resultant(p1, p2, a1)]
+      u := (new()$SY)::P
+      b := a2::P
+      for i in 10.. repeat
+        c := symmetricRemainder(random()$Integer, i)
+        w := u - c * b
+        r := univariate resultant(eval(p1, a1, w), eval(p2, a1, w), a2)
+        not zero? r and r = squareFreePart r => return [1, c, r]
+
+    findUniv(l, v, opt) ==
+      for p in l repeat
+        degree(p, v) > 0 and incl?(variables p, [v, opt]) => return p
+      "failed"
+
+    triangularLinearIfCan(l, lv, w) ==
+      (u := findUniv(l, w, w)) case "failed" => "failed"
+      pw := univariate(u::P)
+      ll := nil()$List(UP)
+      for v in lv repeat
+        ((u := findUniv(l, v, w)) case "failed") or
+          (degree(p := univariate(u::P, v)) ^= 1) => return "failed"
+        (bc := extendedEuclidean(univariate leadingCoefficient p, pw,1))
+           case "failed" => error "Should not happen"
+        ll := concat(map((z1:F):F +-> z1,
+                (- univariate(coefficient(p,0)) * bc.coef1) rem pw), ll)
+      concat(map((f1:F):F +-> f1, pw), reverse_! ll)
+
+    primitiveElement(l, vars, uu) ==
+      u    := uu::P
+      vv   := [v::P for v in vars]
+      elim := concat(vars, uu)
+      w    := uu::P
+      n    := #l
+      for i in 10.. repeat
+        cf := randomInts(n, i)
+        (tt := triangularLinearIfCan(lexGroebner(
+             concat(w - +/[c * t for c in cf for t in vv], l), elim),
+                vars, uu)) case List(UP) =>
+                   ltt := tt::List(UP)
+                   return([cf, rest ltt, first ltt])
+
 *)
 
 \end{chunk}
@@ -166707,6 +206844,7 @@ PrimitiveRatDE(F, UP, L, LQ): Exports == Implementation where
       ++ \spad{op0 y = c1 h1 + ... + cm hm} have the same solutions.
 
   Implementation ==> add
+
     import BoundIntegerRoots(F, UP)
     import BalancedFactorisation(F, UP)
     import InnerCommonDenominator(UP, RF, List UP, List RF)
@@ -166726,7 +206864,9 @@ PrimitiveRatDE(F, UP, L, LQ): Exports == Implementation where
     diff := D()$L
 
     UP2UP2 p                    == map((f1:F):UP +->f1::UP, p)
+
     indicialEquations(op:L)     == indicialEquations(op, leadingCoefficient op)
+
     indicialEquation(op:L, a:F) == indeq(monomial(1, 1) - a::UP, op)
 
     splitDenominator(op, lg) ==
@@ -166750,7 +206890,7 @@ PrimitiveRatDE(F, UP, L, LQ): Exports == Implementation where
     indicialEquation(op:LQ, a:F) ==
       indeq(monomial(1, 1) - a::UP, splitDenominator(op, empty()).eq)
 
--- returns z(z-1)...(z-(n-1))
+    -- returns z(z-1)...(z-(n-1))
     UPfact n ==
       zero? n => 1
       z := monomial(1, 1)$UP
@@ -166779,7 +206919,7 @@ PrimitiveRatDE(F, UP, L, LQ): Exports == Implementation where
               lf := concat(a, lf)
       [mup, lamb, lf]
 
--- e = 0 means homogeneous equation
+    -- e = 0 means homogeneous equation
     NPbound(c, l, e) ==
       rec := NPmulambda(c, l)
       n := max(0, - integerBound indicialEq(c, rec.lambda, rec.func))
@@ -166794,8 +206934,8 @@ PrimitiveRatDE(F, UP, L, LQ): Exports == Implementation where
       hdenom(l, d, e) * */[hh.factor ** max(0, order(e, hh.factor) - n)::N
                                  for hh in factors balancedFactorisation(h, e)]
 
--- returns a polynomials whose zeros are the zeros of e which are not
--- zeros of d
+    -- returns a polynomials whose zeros are the zeros of e which are not
+    -- zeros of d
     separateZeros(d, e) ==
       ((g := squareFreePart e) exquo gcd(g, squareFreePart d))::UP
 
@@ -166807,7 +206947,7 @@ PrimitiveRatDE(F, UP, L, LQ): Exports == Implementation where
       [[dd.factor, indeq(dd.factor, op)]
                    for dd in factors balancedFactorisation(p, coefficients op)]
 
--- cannot return "failed" in the homogeneous case
+    -- cannot return "failed" in the homogeneous case
     denomLODE(l:L, g:RF) ==
       d := leadingCoefficient l
       zero? g => hdenom(l, d, 0)
@@ -166827,6 +206967,124 @@ PrimitiveRatDE(F, UP, L, LQ): Exports == Implementation where
 \begin{chunk}{COQ ODEPRIM}
 (* package ODEPRIM *)
 (*
+
+    import BoundIntegerRoots(F, UP)
+    import BalancedFactorisation(F, UP)
+    import InnerCommonDenominator(UP, RF, List UP, List RF)
+    import UnivariatePolynomialCategoryFunctions2(F, UP, UP, UP2)
+
+    tau          : (UP, UP, UP, N) -> UP
+    NPbound      : (UP, L, UP) -> N
+    hdenom       : (L, UP, UP) -> UP
+    denom0       : (Z, L, UP, UP, UP) -> UP
+    indicialEq   : (UP, List N, List UP) -> UP
+    separateZeros: (UP, UP) -> UP
+    UPfact       : N -> UP
+    UP2UP2       : UP -> UP2
+    indeq        : (UP, L) -> UP
+    NPmulambda   : (UP, L) -> Record(mu:Z, lambda:List N, func:List UP)
+
+    diff := D()$L
+
+    UP2UP2 p                    == map((f1:F):UP +->f1::UP, p)
+
+    indicialEquations(op:L)     == indicialEquations(op, leadingCoefficient op)
+
+    indicialEquation(op:L, a:F) == indeq(monomial(1, 1) - a::UP, op)
+
+    splitDenominator(op, lg) ==
+      cd := splitDenominator coefficients op
+      f  := cd.den / gcd(cd.num)
+      l:L := 0
+      while op ^= 0 repeat
+          l  := l + monomial(retract(f * leadingCoefficient op), degree op)
+          op := reductum op
+      [l, [f * g for g in lg]]
+
+    tau(p, pp, q, n) ==
+      ((pp ** n) * ((q exquo (p ** order(q, p)))::UP)) rem p
+
+    indicialEquations(op:LQ) ==
+      indicialEquations(splitDenominator(op, empty()).eq)
+
+    indicialEquations(op:LQ, p:UP) ==
+      indicialEquations(splitDenominator(op, empty()).eq, p)
+
+    indicialEquation(op:LQ, a:F) ==
+      indeq(monomial(1, 1) - a::UP, splitDenominator(op, empty()).eq)
+
+    -- returns z(z-1)...(z-(n-1))
+    UPfact n ==
+      zero? n => 1
+      z := monomial(1, 1)$UP
+      */[z - i::F::UP for i in 0..(n-1)::N]
+
+    indicialEq(c, lamb, lf) ==
+      cp := diff c
+      cc := UP2UP2 c
+      s:UP2 := 0
+      for i in lamb for f in lf repeat
+        s := s + (UPfact i) * UP2UP2 tau(c, cp, f, i)
+      primitivePart resultant(cc, s)
+
+    NPmulambda(c, l) ==
+      lamb:List(N) := [d := degree l]
+      lf:List(UP) := [a := leadingCoefficient l]
+      mup := d::Z - order(a, c)
+      while (l := reductum l) ^= 0 repeat
+          a := leadingCoefficient l
+          if (m := (d := degree l)::Z - order(a, c)) > mup then
+              mup := m
+              lamb := [d]
+              lf := [a]
+          else if (m = mup) then
+              lamb := concat(d, lamb)
+              lf := concat(a, lf)
+      [mup, lamb, lf]
+
+    -- e = 0 means homogeneous equation
+    NPbound(c, l, e) ==
+      rec := NPmulambda(c, l)
+      n := max(0, - integerBound indicialEq(c, rec.lambda, rec.func))
+      zero? e => n::N
+      max(n, order(e, c)::Z - rec.mu)::N
+
+    hdenom(l, d, e) ==
+      */[dd.factor ** NPbound(dd.factor, l, e)
+                    for dd in factors balancedFactorisation(d, coefficients l)]
+
+    denom0(n, l, d, e, h) ==
+      hdenom(l, d, e) * */[hh.factor ** max(0, order(e, hh.factor) - n)::N
+                                 for hh in factors balancedFactorisation(h, e)]
+
+    -- returns a polynomials whose zeros are the zeros of e which are not
+    -- zeros of d
+    separateZeros(d, e) ==
+      ((g := squareFreePart e) exquo gcd(g, squareFreePart d))::UP
+
+    indeq(c, l) ==
+      rec := NPmulambda(c, l)
+      indicialEq(c, rec.lambda, rec.func)
+
+    indicialEquations(op:L, p:UP) ==
+      [[dd.factor, indeq(dd.factor, op)]
+                   for dd in factors balancedFactorisation(p, coefficients op)]
+
+    -- cannot return "failed" in the homogeneous case
+    denomLODE(l:L, g:RF) ==
+      d := leadingCoefficient l
+      zero? g => hdenom(l, d, 0)
+      h := separateZeros(d, e := denom g)
+      n := degree l
+      (e exquo (h**(n + 1))) case "failed" => "failed"
+      denom0(n, l, d, e, h)
+
+    denomLODE(l:L, lg:List RF) ==
+      empty? lg => denomLODE(l, 0)::UP
+      d := leadingCoefficient l
+      h := separateZeros(d, e := "lcm"/[denom g for g in lg])
+      denom0(degree l, l, d, e, h)
+
 *)
 
 \end{chunk}
@@ -166847,119 +207105,323 @@ PrimitiveRatDE(F, UP, L, LQ): Exports == Implementation where
 )set message auto off
 )clear all
 
---S 1 of 1
-)show PrimitiveRatRicDE
---R 
---R PrimitiveRatRicDE(F: Join(Field,CharacteristicZero,RetractableTo(Fraction(Integer))),UP: UnivariatePolynomialCategory(F),L: LinearOrdinaryDifferentialOperatorCategory(UP),LQ: LinearOrdinaryDifferentialOperatorCategory(Fraction(UP)))  is a package constructor
---R Abbreviation for PrimitiveRatRicDE is ODEPRRIC 
---R This constructor is not exposed in this frame.
---R Issue )edit bookvol10.4.pamphlet to see algebra source code for ODEPRRIC 
---R
---R------------------------------- Operations --------------------------------
---R changeVar : (L,UP) -> L               changeVar : (L,Fraction(UP)) -> L
---R denomRicDE : L -> UP                 
---R constantCoefficientRicDE : (L,(UP -> List(F))) -> List(Record(constant: F,eq: L))
---R leadingCoefficientRicDE : L -> List(Record(deg: NonNegativeInteger,eq: UP))
---R polyRicDE : (L,(UP -> List(F))) -> List(Record(poly: UP,eq: L))
---R singRicDE : (L,((UP,SparseUnivariatePolynomial(UP)) -> List(UP)),(UP -> Factored(UP))) -> List(Record(frac: Fraction(UP),eq: L))
---R
---E 1
+--S 1 of 1
+)show PrimitiveRatRicDE
+--R 
+--R PrimitiveRatRicDE(F: Join(Field,CharacteristicZero,RetractableTo(Fraction(Integer))),UP: UnivariatePolynomialCategory(F),L: LinearOrdinaryDifferentialOperatorCategory(UP),LQ: LinearOrdinaryDifferentialOperatorCategory(Fraction(UP)))  is a package constructor
+--R Abbreviation for PrimitiveRatRicDE is ODEPRRIC 
+--R This constructor is not exposed in this frame.
+--R Issue )edit bookvol10.4.pamphlet to see algebra source code for ODEPRRIC 
+--R
+--R------------------------------- Operations --------------------------------
+--R changeVar : (L,UP) -> L               changeVar : (L,Fraction(UP)) -> L
+--R denomRicDE : L -> UP                 
+--R constantCoefficientRicDE : (L,(UP -> List(F))) -> List(Record(constant: F,eq: L))
+--R leadingCoefficientRicDE : L -> List(Record(deg: NonNegativeInteger,eq: UP))
+--R polyRicDE : (L,(UP -> List(F))) -> List(Record(poly: UP,eq: L))
+--R singRicDE : (L,((UP,SparseUnivariatePolynomial(UP)) -> List(UP)),(UP -> Factored(UP))) -> List(Record(frac: Fraction(UP),eq: L))
+--R
+--E 1
+
+)spool
+)lisp (bye)
+\end{chunk}
+\begin{chunk}{PrimitiveRatRicDE.help}
+====================================================================
+PrimitiveRatRicDE examples
+====================================================================
+
+In-field solution of Riccati equations, primitive case.
+
+See Also:
+o )show PrimitiveRatRicDE
+
+\end{chunk}
+\pagehead{PrimitiveRatRicDE}{ODEPRRIC}
+\pagepic{ps/v104primitiveratricde.ps}{ODEPRRIC}{1.00}
+
+{\bf Exports:}\\
+\begin{tabular}{llll}
+\cross{ODEPRRIC}{changeVar} &
+\cross{ODEPRRIC}{denomRicDE} &
+\cross{ODEPRRIC}{constantCoefficientRicDE} &
+\cross{ODEPRRIC}{leadingCoefficientRicDE} \\
+\cross{ODEPRRIC}{polyRicDE} &
+\cross{ODEPRRIC}{singRicDE} &&
+\end{tabular}
+
+\begin{chunk}{package ODEPRRIC PrimitiveRatRicDE}
+)abbrev package ODEPRRIC PrimitiveRatRicDE
+++ Author: Manuel Bronstein
+++ Date Created: 22 October 1991
+++ Date Last Updated: 2 February 1993
+++ Description: 
+++ In-field solution of Riccati equations, primitive case.
+
+PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where
+  F  : Join(Field, CharacteristicZero, RetractableTo Fraction Integer)
+  UP : UnivariatePolynomialCategory F
+  L  : LinearOrdinaryDifferentialOperatorCategory UP
+  LQ : LinearOrdinaryDifferentialOperatorCategory Fraction UP
+
+  N    ==> NonNegativeInteger
+  Z    ==> Integer
+  RF   ==> Fraction UP
+  UP2  ==> SparseUnivariatePolynomial UP
+  REC  ==> Record(deg:N, eq:UP)
+  REC2 ==> Record(deg:N, eq:UP2)
+  POL  ==> Record(poly:UP, eq:L)
+  FRC  ==> Record(frac:RF, eq:L)
+  CNT  ==> Record(constant:F, eq:L)
+  IJ   ==> Record(ij: List Z, deg:N)
+
+  Exports ==> with
+    denomRicDE: L -> UP
+      ++ denomRicDE(op) returns a polynomial \spad{d} such that any rational
+      ++ solution of the associated Riccati equation of \spad{op y = 0} is
+      ++ of the form \spad{p/d + q'/q + r} for some polynomials p and q
+      ++ and a reduced r. Also, \spad{deg(p) < deg(d)} and {gcd(d,q) = 1}.
+    leadingCoefficientRicDE:  L -> List REC
+      ++ leadingCoefficientRicDE(op) returns
+      ++ \spad{[[m1, p1], [m2, p2], ... , [mk, pk]]} such that the polynomial
+      ++ part of any rational solution of the associated Riccati equation of
+      ++ \spad{op y = 0} must have degree mj for some j, and its leading
+      ++ coefficient is then a zero of pj. In addition,\spad{m1>m2> ... >mk}.
+    constantCoefficientRicDE: (L, UP -> List F) -> List CNT
+      ++ constantCoefficientRicDE(op, ric) returns
+      ++ \spad{[[a1, L1], [a2, L2], ... , [ak, Lk]]} such that any rational
+      ++ solution with no polynomial part of the associated Riccati equation of
+      ++ \spad{op y = 0} must be one of the ai's in which case the equation for
+      ++ \spad{z = y e^{-int ai}} is \spad{Li z = 0}.
+      ++ \spad{ric} is a Riccati equation solver over \spad{F}, whose input
+      ++ is the associated linear equation.
+    polyRicDE: (L, UP -> List F) -> List POL
+      ++ polyRicDE(op, zeros) returns
+      ++ \spad{[[p1, L1], [p2, L2], ... , [pk, Lk]]} such that the polynomial
+      ++ part of any rational solution of the associated Riccati equation of
+      ++ \spad{op y=0} must be one of the pi's (up to the constant coefficient),
+      ++ in which case the equation for \spad{z=y e^{-int p}} is \spad{Li z =0}.
+      ++ \spad{zeros} is a zero finder in \spad{UP}.
+    singRicDE: (L, (UP, UP2) -> List UP, UP -> Factored UP) -> List FRC
+      ++ singRicDE(op, zeros, ezfactor) returns
+      ++ \spad{[[f1, L1], [f2, L2], ... , [fk, Lk]]} such that the singular
+      ++ part of any rational solution of the associated Riccati equation of
+      ++ \spad{op y=0} must be one of the fi's (up to the constant coefficient),
+      ++ in which case the equation for \spad{z=y e^{-int p}} is \spad{Li z=0}.
+      ++ \spad{zeros(C(x),H(x,y))} returns all the \spad{P_i(x)}'s such that
+      ++ \spad{H(x,P_i(x)) = 0 modulo C(x)}.
+      ++ Argument \spad{ezfactor} is a factorisation in \spad{UP},
+      ++ not necessarily into irreducibles.
+    changeVar: (L, UP) -> L
+      ++ changeVar(+/[ai D^i], a) returns the operator \spad{+/[ai (D+a)^i]}.
+    changeVar: (L, RF) -> L
+      ++ changeVar(+/[ai D^i], a) returns the operator \spad{+/[ai (D+a)^i]}.
+
+  Implementation ==> add
+
+    import PrimitiveRatDE(F, UP, L, LQ)
+    import BalancedFactorisation(F, UP)
+
+    bound             : (UP, L) -> N
+    lambda            : (UP, L) -> List IJ
+    infmax            : (IJ, L) -> List Z
+    dmax              : (IJ, UP, L) -> List Z
+    getPoly           : (IJ, L, List Z) -> UP
+    getPol            : (IJ, UP, L, List Z) -> UP2
+    innerlb           : (L, UP -> Z) -> List IJ
+    innermax          : (IJ, L, UP -> Z) -> List Z
+    tau0              : (UP, UP) -> UP
+    poly1             : (UP, UP, Z) -> UP2
+    getPol1           : (List Z, UP, L) -> UP2
+    getIndices        : (N, List IJ) -> List Z
+    refine            : (List UP, UP -> Factored UP) -> List UP
+    polysol           : (L, N, Boolean, UP -> List F) -> List POL
+    fracsol           : (L, (UP, UP2) -> List UP, List UP) -> List FRC
+    padicsol      l   : (UP, L, N, Boolean, (UP, UP2) -> List UP) -> List FRC
+    leadingDenomRicDE : (UP, L) -> List REC2
+    factoredDenomRicDE: L -> List UP
+    constantCoefficientOperator: (L, N) -> UP
+    infLambda: L -> List IJ
+      -- infLambda(op) returns
+      -- \spad{[[[i,j], (\deg(a_i)-\deg(a_j))/(i-j) ]]} for all the pairs
+      -- of indices \spad{i,j} such that \spad{(\deg(a_i)-\deg(a_j))/(i-j)} is
+      -- an integer.
+
+    diff  := D()$L
+    diffq := D()$LQ
+
+    lambda(c, l)       == innerlb(l, z +-> order(z, c)::Z)
+
+    infLambda l        == innerlb(l, z +-> -(degree(z)::Z))
+
+    infmax(rec,l)      == innermax(rec, l, z +-> degree(z)::Z)
+
+    dmax(rec, c,l)     == innermax(rec, l, z +-> - order(z, c)::Z)
+
+    tau0(p, q)         == ((q exquo (p ** order(q, p)))::UP) rem p
+
+    poly1(c, cp,i)     == */[monomial(1,1)$UP2 - (j * cp)::UP2 for j in 0..i-1]
+
+    getIndices(n,l)    == removeDuplicates_! concat [r.ij for r in l | r.deg=n]
+
+    denomRicDE l       == */[c ** bound(c, l) for c in factoredDenomRicDE l]
+
+    polyRicDE(l,zeros) == concat([0, l], polysol(l, 0, false, zeros))
+
+    -- refine([p1,...,pn], foo) refines the list of factors using foo
+    refine(l, ezfactor) ==
+      concat [[r.factor for r in factors ezfactor p] for p in l]
+
+    -- returns [] if the solutions of l have no p-adic component at c
+    padicsol(c, op, b, finite?, zeros) ==
+      ans:List(FRC) := empty()
+      finite? and zero? b => ans
+      lc := leadingDenomRicDE(c, op)
+      if finite? then lc := select_!(z +-> z.deg <= b, lc)
+      for rec in lc repeat
+        for r in zeros(c, rec.eq) | r ^= 0 repeat
+          rcn := r /$RF (c ** rec.deg)
+          neweq := changeVar(op, rcn)
+          sols := padicsol(c, neweq, (rec.deg-1)::N, true, zeros)
+          ans :=
+            empty? sols => concat([rcn, neweq], ans)
+            concat_!([[rcn + sol.frac, sol.eq] for sol in sols], ans)
+      ans
+
+    leadingDenomRicDE(c, l) ==
+      ind:List(Z)          -- to cure the compiler... (won't compile without)
+      lb := lambda(c, l)
+      done:List(N) := empty()
+      ans:List(REC2) := empty()
+      for rec in lb | (not member?(rec.deg, done)) and
+        not(empty?(ind := dmax(rec, c, l))) repeat
+          ans := concat([rec.deg, getPol(rec, c, l, ind)], ans)
+          done := concat(rec.deg, done)
+      sort_!((z1,z2) +-> z1.deg > z2.deg, ans)
+
+    getPol(rec, c, l, ind) ==
+      (rec.deg = 1) => getPol1(ind, c, l)
+      +/[monomial(tau0(c, coefficient(l, i::N)), i::N)$UP2 for i in ind]
+
+    getPol1(ind, c, l) ==
+      cp := diff c
+      +/[tau0(c, coefficient(l, i::N)) * poly1(c, cp, i) for i in ind]
+
+    constantCoefficientRicDE(op, ric) ==
+      m := "max"/[degree p for p in coefficients op]
+      [[a, changeVar(op,a::UP)] for a in ric constantCoefficientOperator(op,m)]
+
+    constantCoefficientOperator(op, m) ==
+      ans:UP := 0
+      while op ^= 0 repeat
+        if degree(p := leadingCoefficient op) = m then
+          ans := ans + monomial(leadingCoefficient p, degree op)
+        op := reductum op
+      ans
+
+    getPoly(rec, l, ind) ==
+      +/[monomial(leadingCoefficient coefficient(l,i::N),i::N)$UP for i in ind]
+
+    -- returns empty() if rec is does not reach the max,
+    -- the list of indices (including rec) that reach the max otherwise
+    innermax(rec, l, nu) ==
+      n := degree l
+      i := first(rec.ij)
+      m := i * (d := rec.deg) + nu coefficient(l, i::N)
+      ans:List(Z) := empty()
+      for j in 0..n | (f := coefficient(l, j)) ^= 0 repeat
+        if ((k := (j * d + nu f)) > m) then return empty()
+        else if (k = m) then ans := concat(j, ans)
+      ans
+
+    leadingCoefficientRicDE l ==
+      ind:List(Z)          -- to cure the compiler... (won't compile without)
+      lb := infLambda l
+      done:List(N) := empty()
+      ans:List(REC) := empty()
+      for rec in lb | (not member?(rec.deg, done)) and
+        not(empty?(ind := infmax(rec, l))) repeat
+          ans := concat([rec.deg, getPoly(rec, l, ind)], ans)
+          done := concat(rec.deg, done)
+      sort_!((z1,z2) +-> z1.deg > z2.deg, ans)
 
-)spool
-)lisp (bye)
-\end{chunk}
-\begin{chunk}{PrimitiveRatRicDE.help}
-====================================================================
-PrimitiveRatRicDE examples
-====================================================================
+    factoredDenomRicDE l ==
+      bd := factors balancedFactorisation(leadingCoefficient l, coefficients l)
+      [dd.factor for dd in bd]
 
-In-field solution of Riccati equations, primitive case.
+    changeVar(l:L, a:UP) ==
+      dpa := diff + a::L            -- the operator (D + a)
+      dpan:L := 1                   -- will accumulate the powers of (D + a)
+      op:L := 0
+      for i in 0..degree l repeat
+        op   := op + coefficient(l, i) * dpan
+        dpan := dpa * dpan
+      primitivePart op
 
-See Also:
-o )show PrimitiveRatRicDE
+    changeVar(l:L, a:RF) ==
+      dpa := diffq + a::LQ          -- the operator (D + a)
+      dpan:LQ := 1                  -- will accumulate the powers of (D + a)
+      op:LQ := 0
+      for i in 0..degree l repeat
+        op   := op + coefficient(l, i)::RF * dpan
+        dpan := dpa * dpan
+      splitDenominator(op, empty()).eq
 
-\end{chunk}
-\pagehead{PrimitiveRatRicDE}{ODEPRRIC}
-\pagepic{ps/v104primitiveratricde.ps}{ODEPRRIC}{1.00}
+    bound(c, l) ==
+      empty?(lb := lambda(c, l)) => 1
+      "max"/[rec.deg for rec in lb]
 
-{\bf Exports:}\\
-\begin{tabular}{llll}
-\cross{ODEPRRIC}{changeVar} &
-\cross{ODEPRRIC}{denomRicDE} &
-\cross{ODEPRRIC}{constantCoefficientRicDE} &
-\cross{ODEPRRIC}{leadingCoefficientRicDE} \\
-\cross{ODEPRRIC}{polyRicDE} &
-\cross{ODEPRRIC}{singRicDE} &&
-\end{tabular}
+    -- returns all the pairs [[i, j], n] such that
+    -- n = (nu(i) - nu(j)) / (i - j) is an integer
+    innerlb(l, nu) ==
+      lb:List(IJ) := empty()
+      n := degree l
+      for i in 0..n | (li := coefficient(l, i)) ^= 0repeat
+        for j in i+1..n | (lj := coefficient(l, j)) ^= 0 repeat
+          u := (nu li - nu lj) exquo (i-j)
+          if (u case Z) and ((b := u::Z) > 0) then
+            lb := concat([[i, j], b::N], lb)
+      lb
 
-\begin{chunk}{package ODEPRRIC PrimitiveRatRicDE}
-)abbrev package ODEPRRIC PrimitiveRatRicDE
-++ Author: Manuel Bronstein
-++ Date Created: 22 October 1991
-++ Date Last Updated: 2 February 1993
-++ Description: 
-++ In-field solution of Riccati equations, primitive case.
+    singRicDE(l, zeros, ezfactor) ==
+      concat([0, l], fracsol(l, zeros, refine(factoredDenomRicDE l, ezfactor)))
 
-PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where
-  F  : Join(Field, CharacteristicZero, RetractableTo Fraction Integer)
-  UP : UnivariatePolynomialCategory F
-  L  : LinearOrdinaryDifferentialOperatorCategory UP
-  LQ : LinearOrdinaryDifferentialOperatorCategory Fraction UP
+    -- returns [] if the solutions of l have no singular component
+    fracsol(l, zeros, lc) ==
+      ans:List(FRC) := empty()
+      empty? lc => ans
+      empty?(sols := padicsol(first lc, l, 0, false, zeros)) =>
+        fracsol(l, zeros, rest lc)
+      for rec in sols repeat
+        neweq := changeVar(l, rec.frac)
+        sols := fracsol(neweq, zeros, rest lc)
+        ans :=
+          empty? sols => concat(rec, ans)
+          concat_!([[rec.frac + sol.frac, sol.eq] for sol in sols], ans)
+      ans
 
-  N    ==> NonNegativeInteger
-  Z    ==> Integer
-  RF   ==> Fraction UP
-  UP2  ==> SparseUnivariatePolynomial UP
-  REC  ==> Record(deg:N, eq:UP)
-  REC2 ==> Record(deg:N, eq:UP2)
-  POL  ==> Record(poly:UP, eq:L)
-  FRC  ==> Record(frac:RF, eq:L)
-  CNT  ==> Record(constant:F, eq:L)
-  IJ   ==> Record(ij: List Z, deg:N)
+    -- returns [] if the solutions of l have no polynomial component
+    polysol(l, b, finite?, zeros) ==
+      ans:List(POL) := empty()
+      finite? and zero? b => ans
+      lc := leadingCoefficientRicDE l
+      if finite? then lc := select_!(z +-> z.deg <= b, lc)
+      for rec in lc repeat
+        for a in zeros(rec.eq) | a ^= 0 repeat
+          atn:UP := monomial(a, rec.deg)
+          neweq := changeVar(l, atn)
+          sols := polysol(neweq, (rec.deg - 1)::N, true, zeros)
+          ans :=
+            empty? sols => concat([atn, neweq], ans)
+            concat_!([[atn + sol.poly, sol.eq] for sol in sols], ans)
+      ans
 
-  Exports ==> with
-    denomRicDE: L -> UP
-      ++ denomRicDE(op) returns a polynomial \spad{d} such that any rational
-      ++ solution of the associated Riccati equation of \spad{op y = 0} is
-      ++ of the form \spad{p/d + q'/q + r} for some polynomials p and q
-      ++ and a reduced r. Also, \spad{deg(p) < deg(d)} and {gcd(d,q) = 1}.
-    leadingCoefficientRicDE:  L -> List REC
-      ++ leadingCoefficientRicDE(op) returns
-      ++ \spad{[[m1, p1], [m2, p2], ... , [mk, pk]]} such that the polynomial
-      ++ part of any rational solution of the associated Riccati equation of
-      ++ \spad{op y = 0} must have degree mj for some j, and its leading
-      ++ coefficient is then a zero of pj. In addition,\spad{m1>m2> ... >mk}.
-    constantCoefficientRicDE: (L, UP -> List F) -> List CNT
-      ++ constantCoefficientRicDE(op, ric) returns
-      ++ \spad{[[a1, L1], [a2, L2], ... , [ak, Lk]]} such that any rational
-      ++ solution with no polynomial part of the associated Riccati equation of
-      ++ \spad{op y = 0} must be one of the ai's in which case the equation for
-      ++ \spad{z = y e^{-int ai}} is \spad{Li z = 0}.
-      ++ \spad{ric} is a Riccati equation solver over \spad{F}, whose input
-      ++ is the associated linear equation.
-    polyRicDE: (L, UP -> List F) -> List POL
-      ++ polyRicDE(op, zeros) returns
-      ++ \spad{[[p1, L1], [p2, L2], ... , [pk, Lk]]} such that the polynomial
-      ++ part of any rational solution of the associated Riccati equation of
-      ++ \spad{op y=0} must be one of the pi's (up to the constant coefficient),
-      ++ in which case the equation for \spad{z=y e^{-int p}} is \spad{Li z =0}.
-      ++ \spad{zeros} is a zero finder in \spad{UP}.
-    singRicDE: (L, (UP, UP2) -> List UP, UP -> Factored UP) -> List FRC
-      ++ singRicDE(op, zeros, ezfactor) returns
-      ++ \spad{[[f1, L1], [f2, L2], ... , [fk, Lk]]} such that the singular
-      ++ part of any rational solution of the associated Riccati equation of
-      ++ \spad{op y=0} must be one of the fi's (up to the constant coefficient),
-      ++ in which case the equation for \spad{z=y e^{-int p}} is \spad{Li z=0}.
-      ++ \spad{zeros(C(x),H(x,y))} returns all the \spad{P_i(x)}'s such that
-      ++ \spad{H(x,P_i(x)) = 0 modulo C(x)}.
-      ++ Argument \spad{ezfactor} is a factorisation in \spad{UP},
-      ++ not necessarily into irreducibles.
-    changeVar: (L, UP) -> L
-      ++ changeVar(+/[ai D^i], a) returns the operator \spad{+/[ai (D+a)^i]}.
-    changeVar: (L, RF) -> L
-      ++ changeVar(+/[ai D^i], a) returns the operator \spad{+/[ai (D+a)^i]}.
+\end{chunk}
+
+\begin{chunk}{COQ ODEPRRIC}
+(* package ODEPRRIC *)
+(*
 
-  Implementation ==> add
     import PrimitiveRatDE(F, UP, L, LQ)
     import BalancedFactorisation(F, UP)
 
@@ -166992,20 +207454,28 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where
     diffq := D()$LQ
 
     lambda(c, l)       == innerlb(l, z +-> order(z, c)::Z)
+
     infLambda l        == innerlb(l, z +-> -(degree(z)::Z))
+
     infmax(rec,l)      == innermax(rec, l, z +-> degree(z)::Z)
+
     dmax(rec, c,l)     == innermax(rec, l, z +-> - order(z, c)::Z)
+
     tau0(p, q)         == ((q exquo (p ** order(q, p)))::UP) rem p
+
     poly1(c, cp,i)     == */[monomial(1,1)$UP2 - (j * cp)::UP2 for j in 0..i-1]
+
     getIndices(n,l)    == removeDuplicates_! concat [r.ij for r in l | r.deg=n]
+
     denomRicDE l       == */[c ** bound(c, l) for c in factoredDenomRicDE l]
+
     polyRicDE(l,zeros) == concat([0, l], polysol(l, 0, false, zeros))
 
--- refine([p1,...,pn], foo) refines the list of factors using foo
+    -- refine([p1,...,pn], foo) refines the list of factors using foo
     refine(l, ezfactor) ==
       concat [[r.factor for r in factors ezfactor p] for p in l]
 
--- returns [] if the solutions of l have no p-adic component at c
+    -- returns [] if the solutions of l have no p-adic component at c
     padicsol(c, op, b, finite?, zeros) ==
       ans:List(FRC) := empty()
       finite? and zero? b => ans
@@ -167033,7 +207503,6 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where
       sort_!((z1,z2) +-> z1.deg > z2.deg, ans)
 
     getPol(rec, c, l, ind) ==
---      one?(rec.deg) => getPol1(ind, c, l)
       (rec.deg = 1) => getPol1(ind, c, l)
       +/[monomial(tau0(c, coefficient(l, i::N)), i::N)$UP2 for i in ind]
 
@@ -167056,8 +207525,8 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where
     getPoly(rec, l, ind) ==
       +/[monomial(leadingCoefficient coefficient(l,i::N),i::N)$UP for i in ind]
 
--- returns empty() if rec is does not reach the max,
--- the list of indices (including rec) that reach the max otherwise
+    -- returns empty() if rec is does not reach the max,
+    -- the list of indices (including rec) that reach the max otherwise
     innermax(rec, l, nu) ==
       n := degree l
       i := first(rec.ij)
@@ -167105,8 +207574,8 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where
       empty?(lb := lambda(c, l)) => 1
       "max"/[rec.deg for rec in lb]
 
--- returns all the pairs [[i, j], n] such that
--- n = (nu(i) - nu(j)) / (i - j) is an integer
+    -- returns all the pairs [[i, j], n] such that
+    -- n = (nu(i) - nu(j)) / (i - j) is an integer
     innerlb(l, nu) ==
       lb:List(IJ) := empty()
       n := degree l
@@ -167120,7 +207589,7 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where
     singRicDE(l, zeros, ezfactor) ==
       concat([0, l], fracsol(l, zeros, refine(factoredDenomRicDE l, ezfactor)))
 
--- returns [] if the solutions of l have no singular component
+    -- returns [] if the solutions of l have no singular component
     fracsol(l, zeros, lc) ==
       ans:List(FRC) := empty()
       empty? lc => ans
@@ -167134,7 +207603,7 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where
           concat_!([[rec.frac + sol.frac, sol.eq] for sol in sols], ans)
       ans
 
--- returns [] if the solutions of l have no polynomial component
+    -- returns [] if the solutions of l have no polynomial component
     polysol(l, b, finite?, zeros) ==
       ans:List(POL) := empty()
       finite? and zero? b => ans
@@ -167150,11 +207619,6 @@ PrimitiveRatRicDE(F, UP, L, LQ): Exports == Implementation where
             concat_!([[atn + sol.poly, sol.eq] for sol in sols], ans)
       ans
 
-\end{chunk}
-
-\begin{chunk}{COQ ODEPRRIC}
-(* package ODEPRRIC *)
-(*
 *)
 
 \end{chunk}
@@ -167220,6 +207684,7 @@ PrintPackage(): with
       ++ print(o) writes the output form o on standard output using the
       ++ two-dimensional formatter.
  == add
+
     print(x) == print(x)$OutputForm
 
 \end{chunk}
@@ -167227,6 +207692,9 @@ PrintPackage(): with
 \begin{chunk}{COQ PRINT}
 (* package PRINT *)
 (*
+
+    print(x) == print(x)$OutputForm
+
 *)
 
 \end{chunk}
@@ -167315,15 +207783,16 @@ PseudoLinearNormalForm(K:Field): Exports == Implementation where
       ++ \spad{m = diagonal(C_1,...,C_k)}.
 
   Implementation ==> add
+
     normalForm0: (Matrix K, Automorphism K, Automorphism K, K -> K) -> REC
     mulMatrix: (Integer, Integer, K) -> Matrix K
-      -- mulMatrix(N, i, a): under a change of base with the resulting matrix of
+      -- mulMatrix(N, i, a): under change of base with the resulting matrix of
       -- size N*N the following operations are performed:
       -- D1: column i will be multiplied by sig(a)
       -- D2: row i will be multiplied by 1/a
       -- D3: addition of der(a)/a to the element at position (i,i)
     addMatrix: (Integer, Integer, Integer, K) -> Matrix K
-      -- addMatrix(N, i, k, a): under a change of base with the resulting matrix
+      -- addMatrix(N, i, k, a): under change of base with the resulting matrix
       -- of size N*N the following operations are performed:
       -- C1: addition of column i multiplied by sig(a) to column k
       -- C2: addition of row k multiplied by -a to row i
@@ -167338,8 +207807,10 @@ PseudoLinearNormalForm(K:Field): Exports == Implementation where
       -- avoids possible type conflicts
 
     inv m                      == inverse(m) :: Matrix K
+
     changeBase(M, A, sig, der) == 
       inv(A) * (M * map((k1:K):K +-> sig k1, A) + map(der, A))
+
     normalForm(M, sig, der)    == normalForm0(M, sig, inv sig, der)
 
     companionBlocks(R, w) ==
@@ -167445,6 +207916,134 @@ PseudoLinearNormalForm(K:Field): Exports == Implementation where
 \begin{chunk}{COQ PSEUDLIN}
 (* package PSEUDLIN *)
 (*
+
+    normalForm0: (Matrix K, Automorphism K, Automorphism K, K -> K) -> REC
+    mulMatrix: (Integer, Integer, K) -> Matrix K
+      -- mulMatrix(N, i, a): under change of base with the resulting matrix of
+      -- size N*N the following operations are performed:
+      -- D1: column i will be multiplied by sig(a)
+      -- D2: row i will be multiplied by 1/a
+      -- D3: addition of der(a)/a to the element at position (i,i)
+    addMatrix: (Integer, Integer, Integer, K) -> Matrix K
+      -- addMatrix(N, i, k, a): under change of base with the resulting matrix
+      -- of size N*N the following operations are performed:
+      -- C1: addition of column i multiplied by sig(a) to column k
+      -- C2: addition of row k multiplied by -a to row i
+      -- C3: addition of -a*der(a) to the element at position (i,k)
+    permutationMatrix: (Integer, Integer, Integer) -> Matrix K
+      -- permutationMatrix(N, i, k): under a change of base with the resulting
+      -- permutation matrix of size N*N the following operations are performed:
+      -- P1: columns i and k will be exchanged
+      -- P2: rows i and k will be exchanged
+    inv: Matrix K -> Matrix K
+      -- inv(M): computes the inverse of a invertable matrix M.
+      -- avoids possible type conflicts
+
+    inv m                      == inverse(m) :: Matrix K
+
+    changeBase(M, A, sig, der) == 
+      inv(A) * (M * map((k1:K):K +-> sig k1, A) + map(der, A))
+
+    normalForm(M, sig, der)    == normalForm0(M, sig, inv sig, der)
+
+    companionBlocks(R, w) ==
+      -- decomposes the rational matrix R into single companion blocks
+      -- and the inhomogenity w as well
+      i:Integer := 1
+      n := nrows R
+      l:List(ER) := empty()
+      while i <= n repeat
+        j := i
+        while j+1 <= n and R(j,j+1) = 1 repeat j := j+1
+        --split block now
+        v:Vector K := new((j-i+1)::NonNegativeInteger, 0)
+        for k in i..j repeat v(k-i+1) := w k
+        l := concat([subMatrix(R,i,j,i,j), v], l)
+        i := j+1
+      l
+
+    normalForm0(M, sig, siginv, der) ==
+      -- the changes of base will be incremented in B and Binv,
+      -- where B**(-1)=Binv; E defines an elementary matrix
+      B, Binv, E    : Matrix K
+      recOfMatrices : REC
+      N := nrows M
+      B := diagonalMatrix [1 for k in 1..N]
+      Binv := copy B
+      -- avoid unnecessary recursion
+      if diagonal?(M) then return [M, B, Binv]
+      i : Integer := 1
+      while i < N repeat
+        j := i + 1
+        while j <= N and M(i, j) = 0 repeat  j := j + 1
+        if j <= N then
+          -- expand companionblock by lemma 5
+          if j ^= i+1 then
+            -- perform first a permutation
+            E := permutationMatrix(N, i+1, j)
+            M := changeBase(M, E, sig, der)
+            B := B*E
+            Binv := E*Binv
+          -- now is M(i, i+1) ^= 0
+          E := mulMatrix(N, i+1, siginv inv M(i,i+1))
+          M := changeBase(M, E, sig, der)
+          B := B*E
+          Binv := inv(E)*Binv
+          for j in 1..N repeat
+            if j ^= i+1 then
+              E := addMatrix(N, i+1, j, siginv(-M(i,j)))
+              M := changeBase(M, E, sig, der)
+              B := B*E
+              Binv := inv(E)*Binv
+          i := i + 1
+        else
+          -- apply lemma 6
+          for j in i..2 by -1 repeat
+            for k in (i+1)..N repeat
+              E := addMatrix(N, k, j-1, M(k,j))
+              M := changeBase(M, E, sig, der)
+              B := B*E
+              Binv := inv(E)*Binv
+          j := i + 1
+          while j <= N and M(j,1) = 0 repeat  j := j + 1
+          if j <= N then
+            -- expand companionblock by lemma 8
+            E := permutationMatrix(N, 1, j)
+            M := changeBase(M, E, sig, der)
+            B := B*E
+            Binv := E*Binv
+            -- start again to establish rational form
+            i := 1
+          else
+            -- split a direct factor
+            recOfMatrices :=
+              normalForm(subMatrix(M, i+1, N, i+1, N), sig, der)
+            setsubMatrix!(M, i+1, i+1, recOfMatrices.R)
+            E := diagonalMatrix [1 for k in 1..N]
+            setsubMatrix!(E, i+1, i+1, recOfMatrices.A)
+            B := B*E
+            setsubMatrix!(E, i+1, i+1, recOfMatrices.Ainv)
+            Binv := E*Binv
+            -- M in blockdiagonalform, stop program
+            i := N
+      [M, B, Binv]
+
+    mulMatrix(N, i, a) ==
+      M : Matrix K := diagonalMatrix [1 for j in 1..N]
+      M(i, i) := a
+      M
+
+    addMatrix(N, i, k, a) ==
+      A : Matrix K := diagonalMatrix [1 for j in 1..N]
+      A(i, k) := a
+      A
+
+    permutationMatrix(N, i, k) ==
+      P : Matrix K := diagonalMatrix [1 for j in 1..N]
+      P(i, i) := P(k, k) := 0
+      P(i, k) := P(k, i) := 1
+      P
+
 *)
 
 \end{chunk}
@@ -167784,6 +208383,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where
          ++ by means of the naive algorithm.
 
   Implementation == add
+
     X : polR := monomial(1$R,1)
 
     r : R * v : Vector(polR) == r::polR * v
@@ -167794,7 +208394,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where
 
     pseudoDivide(P : polR, Q : polR) : 
                                  Record(coef:R,quotient:polR,remainder:polR) ==
-    -- computes the pseudoDivide of P by Q
+       -- computes the pseudoDivide of P by Q
        zero?(Q) => error("PseudoDivide$PRS : division by 0")
        zero?(P) => construct(1, 0, P)
        lcQ : R := LC(Q)
@@ -167826,7 +208426,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where
          return construct(quot, F)
 
     resultant_naif(P : polR, Q : polR) : R ==
-    -- valid over a field
+       -- valid over a field
        a : R := 1
        repeat
           zero?(Q) => return 0
@@ -167839,7 +208439,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where
 
     resultantEuclidean_naif(P : polR, Q : polR) :
                        Record(coef1 : polR, coef2 : polR, resultant : R) ==
-    -- valid over a field.
+       -- valid over a field.
        a : R := 1
        old_cf1 : polR := 1 ; cf1 : polR := 0
        old_cf2 : polR := 0 ; cf2 : polR := 1
@@ -167858,7 +208458,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where
 
     semiResultantEuclidean_naif(P : polR, Q : polR) :
                        Record(coef2 : polR, resultant : R) ==
-    -- valid over a field
+       -- valid over a field
        a : R := 1
        old_cf2 : polR := 0 ; cf2 : polR := 1
        repeat
@@ -167875,14 +208475,12 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where
 
     Lazard(x : R, y : R, n : NNI) : R ==
        zero?(n) => error("Lazard$PRS : n = 0")
---       one?(n) => x
        (n = 1) => x
        a : NNI := 1
        while n >= (b := 2*a) repeat a := b
        c : R := x
        n := (n - a)::NNI
        repeat                    --  c = x**i / y**(i-1),  i=n_0 quo a,  a=2**?
---          one?(a) => return c
           (a = 1) => return c
           a := a quo 2
           c := ((c * c) exquo y)::R
@@ -167890,15 +208488,13 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where
 
     Lazard2(F : polR, x : R, y : R, n : NNI) : polR ==
        zero?(n) => error("Lazard2$PRS : n = 0")
---       one?(n) => F
        (n = 1) => F
        x := Lazard(x, y, (n-1)::NNI)
        return ((x * F) exquo y)::polR
 
     Lazard3(V : Vector(polR), x : R, y : R, n : NNI) : Vector(polR) ==
-    -- computes x**(n-1) * V / y**(n-1)
+       -- computes x**(n-1) * V / y**(n-1)
        zero?(n) => error("Lazard2$prs : n = 0")
---       one?(n) => V
        (n = 1) => V
        x := Lazard(x, y, (n-1)::NNI)
        return ((x * V) exquo y)
@@ -167927,11 +208523,10 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where
 
     next_sousResultant3(VP : Vector(polR), VQ : Vector(polR), s : R, ss : R) :
                                                       Vector(polR) ==
-    -- P ~ S_d,  Q = S_d-1,  s = lc(S_d),  ss = lc(S_e)
+       -- P ~ S_d,  Q = S_d-1,  s = lc(S_d),  ss = lc(S_e)
        (P, Q) := (VP.1, VQ.1)
        (lcP, c) := (LC(P), LC(Q))
        e : NNI := degree(Q)
---       if one?(delta := degree(P) - e) then                   -- algo_new
        if ((delta := degree(P) - e) = 1) then                   -- algo_new
          VP := c * VP - coefficient(P, e) * VQ
          VP := VP exquo lcP
@@ -168032,7 +208627,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where
        degree(P) < degree(Q) => error("semiResultantEuclidean2 : bad degrees")
        if zero?(degree(Q)) then
           degP : NNI := degree(P)
-          zero?(degP) => error("semiResultantEuclidean2 : constant polynomials")
+          zero?(degP) => error("semiResultantEuclidean2: constant polynomials")
           s : R := LC(Q)**(degP-1)::NNI
           return construct(s::polR, s * LC(Q))
        R has Finite => semiResultantEuclidean_naif(P, Q)
@@ -168440,6 +209035,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where
        return construct(c2, cr)
 
     if R has GcdDomain then
+
        resultantReduit(P : polR, Q : polR) : R ==
           UV := subResultantGcdEuclidean(P, Q)
           UVs : polR := UV.gcd
@@ -168471,7 +209067,7 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where
           return construct(c2, rr)
 
        gcd_naif(P : polR, Q : polR) : polR ==
-       -- valid over a field
+          -- valid over a field
           zero?(P) => (Q exquo LC(Q))::polR
           repeat
              zero?(Q) => return (P exquo LC(P))::polR
@@ -168494,6 +209090,708 @@ PseudoRemainderSequence(R, polR) : Specification == Implementation where
 \begin{chunk}{COQ PRS}
 (* package PRS *)
 (*
+
+    X : polR := monomial(1$R,1)
+
+    r : R * v : Vector(polR) == r::polR * v
+              -- the instruction  map(r * #1, v) is slower !?
+
+    v : Vector(polR) exquo r : R == 
+      map((p1:polR):polR +-> (p1 exquo r)::polR, v)
+
+    pseudoDivide(P : polR, Q : polR) : 
+                                 Record(coef:R,quotient:polR,remainder:polR) ==
+       -- computes the pseudoDivide of P by Q
+       zero?(Q) => error("PseudoDivide$PRS : division by 0")
+       zero?(P) => construct(1, 0, P)
+       lcQ : R := LC(Q)
+       (degP, degQ) := (degree(P), degree(Q))
+       degP < degQ => construct(1, 0, P)
+       Q := reductum(Q)
+       i : NNI := (degP - degQ + 1)::NNI
+       co : R := lcQ**i
+       quot : polR := 0$polR
+       while (delta : Integer := degree(P) - degQ) >= 0 repeat
+         i := (i - 1)::NNI
+         mon := monomial(LC(P), delta::NNI)$polR
+         quot := quot + lcQ**i * mon
+         P := lcQ * reductum(P) - mon * Q
+       P := lcQ**i * P
+       return construct(co, quot, P)
+
+    divide(F : polR, G : polR) : Record(quotient : polR, remainder : polR)==
+    -- computes quotient and rest of the exact euclidean division of F by G
+         lcG : R := LC(G)
+         degG : NNI := degree(G)
+         zero?(degG) => ( F := (F exquo lcG)::polR; return construct(F, 0))
+         G : polR := reductum(G)
+         quot : polR := 0
+         while (delta := degree(F) - degG) >= 0 repeat
+            mon : polR := monomial((LC(F) exquo lcG)::R, delta::NNI)
+            quot := quot + mon
+            F := reductum(F) - mon * G
+         return construct(quot, F)
+
+    resultant_naif(P : polR, Q : polR) : R ==
+       -- valid over a field
+       a : R := 1
+       repeat
+          zero?(Q) => return 0
+          (degP, degQ) := (degree(P), degree(Q))
+          if odd?(degP) and odd?(degQ) then a := - a
+          zero?(degQ) => return (a * LC(Q)**degP)
+          U : polR := divide(P, Q).remainder
+          a := a * LC(Q)**(degP - degree(U))::NNI
+          (P, Q) := (Q, U)
+
+    resultantEuclidean_naif(P : polR, Q : polR) :
+                       Record(coef1 : polR, coef2 : polR, resultant : R) ==
+       -- valid over a field.
+       a : R := 1
+       old_cf1 : polR := 1 ; cf1 : polR := 0
+       old_cf2 : polR := 0 ; cf2 : polR := 1
+       repeat
+          zero?(Q) => construct(0::polR, 0::polR, 0::R)
+          (degP, degQ) := (degree(P), degree(Q))
+          if odd?(degP) and odd?(degQ) then a := -a
+          if zero?(degQ) then
+             a := a * LC(Q)**(degP-1)::NNI
+             return construct(a*cf1, a*cf2, a*LC(Q))
+          divid := divide(P,Q)
+          a := a * LC(Q)**(degP - degree(divid.remainder))::NNI
+          (P, Q) := (Q, divid.remainder)
+          (old_cf1, old_cf2, cf1, cf2) := (cf1, cf2, 
+                old_cf1 - divid.quotient * cf1, old_cf2 - divid.quotient * cf2)
+
+    semiResultantEuclidean_naif(P : polR, Q : polR) :
+                       Record(coef2 : polR, resultant : R) ==
+       -- valid over a field
+       a : R := 1
+       old_cf2 : polR := 0 ; cf2 : polR := 1
+       repeat
+          zero?(Q) => construct(0::polR, 0::R)
+          (degP, degQ) := (degree(P), degree(Q))
+          if odd?(degP) and odd?(degQ) then a := -a
+          if zero?(degQ) then
+             a := a * LC(Q)**(degP-1)::NNI
+             return construct(a*cf2, a*LC(Q))
+          divid := divide(P,Q)
+          a := a * LC(Q)**(degP - degree(divid.remainder))::NNI
+          (P, Q) := (Q, divid.remainder)
+          (old_cf2, cf2) := (cf2, old_cf2 - divid.quotient * cf2)
+
+    Lazard(x : R, y : R, n : NNI) : R ==
+       zero?(n) => error("Lazard$PRS : n = 0")
+       (n = 1) => x
+       a : NNI := 1
+       while n >= (b := 2*a) repeat a := b
+       c : R := x
+       n := (n - a)::NNI
+       repeat                    --  c = x**i / y**(i-1),  i=n_0 quo a,  a=2**?
+          (a = 1) => return c
+          a := a quo 2
+          c := ((c * c) exquo y)::R
+          if n >= a then ( c := ((c * x) exquo y)::R ; n := (n - a)::NNI )
+
+    Lazard2(F : polR, x : R, y : R, n : NNI) : polR ==
+       zero?(n) => error("Lazard2$PRS : n = 0")
+       (n = 1) => F
+       x := Lazard(x, y, (n-1)::NNI)
+       return ((x * F) exquo y)::polR
+
+    Lazard3(V : Vector(polR), x : R, y : R, n : NNI) : Vector(polR) ==
+       -- computes x**(n-1) * V / y**(n-1)
+       zero?(n) => error("Lazard2$prs : n = 0")
+       (n = 1) => V
+       x := Lazard(x, y, (n-1)::NNI)
+       return ((x * V) exquo y)
+
+    next_sousResultant2(P : polR, Q : polR, Z : polR, s : R) : polR ==
+       (lcP, c, se) := (LC(P), LC(Q), LC(Z))
+       (d, e) := (degree(P), degree(Q))
+       (P, Q, H) := (reductum(P), reductum(Q), - reductum(Z))
+       A : polR := coefficient(P, e) * H
+       for i in e+1..d-1 repeat 
+          H := if degree(H) = e-1 then  
+                  X * reductum(H) - ((LC(H) * Q) exquo c)::polR
+               else
+                  X * H
+          -- H = s_e * X^i mod S_d-1
+          A := coefficient(P, i) * H + A
+       while degree(P) >= e repeat P := reductum(P)
+       A := A + se * P            --  A = s_e * reductum(P_0)       mod S_d-1
+       A := (A exquo lcP)::polR   --  A = s_e * reductum(S_d) / s_d mod S_d-1
+       A := if degree(H) = e-1 then 
+               c * (X * reductum(H) + A) - LC(H) * Q
+            else
+               c * (X * H + A)
+       A := (A exquo s)::polR                    -- A = +/- S_e-1
+       return (if odd?(d-e) then A else - A)
+
+    next_sousResultant3(VP : Vector(polR), VQ : Vector(polR), s : R, ss : R) :
+                                                      Vector(polR) ==
+       -- P ~ S_d,  Q = S_d-1,  s = lc(S_d),  ss = lc(S_e)
+       (P, Q) := (VP.1, VQ.1)
+       (lcP, c) := (LC(P), LC(Q))
+       e : NNI := degree(Q)
+       if ((delta := degree(P) - e) = 1) then                   -- algo_new
+         VP := c * VP - coefficient(P, e) * VQ
+         VP := VP exquo lcP
+         VP := c * (VP - X * VQ) + coefficient(Q, (e-1)::NNI) * VQ
+         VP := VP exquo s
+       else                                    -- algorithm of Lickteig - Roy
+         (r, rr) := (s * lcP, ss * c)
+         divid := divide(rr * P, Q)
+         VP.1 := (divid.remainder exquo r)::polR
+         for i in 2..#VP repeat
+           VP.i := rr * VP.i - VQ.i * divid.quotient
+           VP.i := (VP.i exquo r)::polR
+       return (if odd?(delta) then VP else - VP)
+
+    algo_new(P : polR, Q : polR) : R ==
+       delta : NNI := (degree(P) - degree(Q))::NNI
+       s : R := LC(Q)**delta
+       (P, Q) := (Q, pseudoRemainder(P, -Q))
+       repeat      
+          -- P = S_c-1 (except the first turn : P ~ S_c-1), 
+          -- Q = S_d-1,  s = lc(S_d)
+          zero?(Q) => return 0
+          delta := (degree(P) - degree(Q))::NNI
+          Z : polR := Lazard2(Q, LC(Q), s, delta)          
+          -- Z = S_e ~ S_d-1
+          zero?(degree(Z)) => return LC(Z)
+          (P, Q) := (Q, next_sousResultant2(P, Q, Z, s))
+          s := LC(Z)
+
+    resultant(P : polR, Q : polR) : R ==
+       zero?(Q) or zero?(P) => 0
+       if degree(P) < degree(Q) then 
+          (P, Q) := (Q, P)
+          if odd?(degree(P)) and odd?(degree(Q)) then Q := - Q
+       zero?(degree(Q)) => LC(Q)**degree(P)
+       -- degree(P) >= degree(Q) > 0
+       R has Finite => resultant_naif(P, Q)
+       return algo_new(P, Q)
+
+    subResultantEuclidean(P : polR, Q : polR) :
+                          Record(coef1 : polR, coef2 : polR, resultant : R) ==
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       VP : Vector(polR) := [Q, 0::polR, 1::polR]
+       pdiv := pseudoDivide(P, -Q)
+       VQ : Vector(polR) := [pdiv.remainder, pdiv.coef::polR, pdiv.quotient]
+       repeat
+          --  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s=lc(S_d)
+          --  S_{c-1} = VP.2 P_0 + VP.3 Q_0,  S_{d-1} = VQ.2 P_0 + VQ.3 Q_0
+          (P, Q) := (VP.1, VQ.1)
+          zero?(Q) => return construct(0::polR, 0::polR, 0::R)
+          e : NNI := degree(Q)
+          delta : NNI := (degree(P) - e)::NNI
+          if zero?(e) then
+             l : Vector(polR) := Lazard3(VQ, LC(Q), s, delta)
+             return construct(l.2, l.3, LC(l.1))
+          ss : R := Lazard(LC(Q), s, delta)
+          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
+          s := ss
+
+    resultantEuclidean(P : polR, Q : polR) : 
+                       Record(coef1 : polR, coef2 : polR, resultant : R) ==
+       zero?(P) or zero?(Q) => construct(0::polR, 0::polR, 0::R)
+       if degree(P) < degree(Q) then 
+          e : Integer := if odd?(degree(P)) and odd?(degree(Q)) then -1 else 1
+          l := resultantEuclidean(Q, e * P)
+          return construct(e * l.coef2, l.coef1, l.resultant)
+       if zero?(degree(Q)) then
+          degP : NNI := degree(P)
+          zero?(degP) => error("resultantEuclidean$PRS : constant polynomials")
+          s : R := LC(Q)**(degP-1)::NNI
+          return construct(0::polR, s::polR, s * LC(Q))
+       R has Finite => resultantEuclidean_naif(P, Q)
+       return subResultantEuclidean(P,Q)
+
+    semiSubResultantEuclidean(P : polR, Q : polR) :
+                       Record(coef2 : polR, resultant : R) ==
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       VP : Vector(polR) := [Q, 1::polR]
+       pdiv := pseudoDivide(P, -Q)
+       VQ : Vector(polR) := [pdiv.remainder, pdiv.quotient]
+       repeat
+          --  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s=lc(S_d)
+          --  S_{c-1} = ...P_0 + VP.3 Q_0,  S_{d-1} = ...P_0 + VQ.3 Q_0
+          (P, Q) := (VP.1, VQ.1)
+          zero?(Q) => return construct(0::polR, 0::R)
+          e : NNI := degree(Q)
+          delta : NNI := (degree(P) - e)::NNI
+          if zero?(e) then
+             l : Vector(polR) := Lazard3(VQ, LC(Q), s, delta)
+             return construct(l.2, LC(l.1))
+          ss : R := Lazard(LC(Q), s, delta)
+          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
+          s := ss
+
+    semiResultantEuclidean2(P : polR, Q : polR) : 
+                       Record(coef2 : polR, resultant : R) ==
+       zero?(P) or zero?(Q) => construct(0::polR, 0::R)
+       degree(P) < degree(Q) => error("semiResultantEuclidean2 : bad degrees")
+       if zero?(degree(Q)) then
+          degP : NNI := degree(P)
+          zero?(degP) => error("semiResultantEuclidean2: constant polynomials")
+          s : R := LC(Q)**(degP-1)::NNI
+          return construct(s::polR, s * LC(Q))
+       R has Finite => semiResultantEuclidean_naif(P, Q)
+       return semiSubResultantEuclidean(P,Q)
+
+    semiResultantEuclidean1(P : polR, Q : polR) :
+                       Record(coef1 : polR, resultant : R) ==
+       result := resultantEuclidean(P,Q)
+       [result.coef1, result.resultant]
+
+    indiceSubResultant(P : polR, Q : polR, i : NNI) : polR == 
+       zero?(Q) or zero?(P) => 0
+       if degree(P) < degree(Q) then 
+          (P, Q) := (Q, P)
+          if odd?(degree(P)-i) and odd?(degree(Q)-i) then Q := - Q
+       if i = degree(Q) then
+          delta : NNI := (degree(P)-degree(Q))::NNI
+          zero?(delta) => error("indiceSubResultant$PRS : bad degrees")
+          s : R := LC(Q)**(delta-1)::NNI
+          return s*Q
+       i > degree(Q) => 0
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       (P, Q) := (Q, pseudoRemainder(P, -Q))
+       repeat
+          -- P = S_{c-1} ~ S_d , Q = S_{d-1},  s = lc(S_d),  i < d
+          (degP, degQ) := (degree(P), degree(Q))
+          i = degP-1 => return Q
+          zero?(Q) or (i > degQ) => return 0
+          Z : polR := Lazard2(Q, LC(Q), s, (degP - degQ)::NNI)
+          --  Z = S_e ~ S_d-1
+          i = degQ => return Z
+          (P, Q) := (Q, next_sousResultant2(P, Q, Z, s))
+          s := LC(Z)
+
+    indiceSubResultantEuclidean(P : polR, Q : polR, i : NNI) :
+                    Record(coef1 : polR, coef2 : polR, subResultant : polR) == 
+       zero?(Q) or zero?(P) => construct(0::polR, 0::polR, 0::polR)
+       if degree(P) < degree(Q) then 
+          e := if odd?(degree(P)-i) and odd?(degree(Q)-i) then -1 else 1
+          l := indiceSubResultantEuclidean(Q, e * P, i)
+          return construct(e * l.coef2, l.coef1, l.subResultant)
+       if i = degree(Q) then
+          delta : NNI := (degree(P)-degree(Q))::NNI
+          zero?(delta) => 
+                      error("indiceSubResultantEuclidean$PRS : bad degrees")
+          s : R := LC(Q)**(delta-1)::NNI
+          return construct(0::polR, s::polR, s * Q)
+       i > degree(Q) => construct(0::polR, 0::polR, 0::polR)
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       VP : Vector(polR) := [Q, 0::polR, 1::polR]
+       pdiv := pseudoDivide(P, -Q)
+       VQ : Vector(polR) := [pdiv.remainder, pdiv.coef::polR, pdiv.quotient]
+       repeat
+          --  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s=lc(S_d),  i < d
+          --  S_{c-1} = VP.2 P_0 + VP.3 Q_0,  S_{d-1} = VQ.2 P_0 + VQ.3 Q_0
+          (P, Q) := (VP.1, VQ.1)
+          zero?(Q) => return construct(0::polR, 0::polR, 0::polR)
+          (degP, degQ) := (degree(P), degree(Q))
+          i = degP-1 => return construct(VQ.2, VQ.3, VQ.1)
+          (i > degQ) => return construct(0::polR, 0::polR, 0::polR)
+          VZ := Lazard3(VQ, LC(Q), s, (degP - degQ)::NNI)
+          i = degQ => return construct(VZ.2, VZ.3, VZ.1)
+          ss : R := LC(VZ.1)
+          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
+          s := ss
+
+    semiIndiceSubResultantEuclidean(P : polR, Q : polR, i : NNI) :
+                    Record(coef2 : polR, subResultant : polR) == 
+       zero?(Q) or zero?(P) => construct(0::polR, 0::polR)
+       degree(P) < degree(Q) => 
+                  error("semiIndiceSubResultantEuclidean$PRS : bad degrees")
+       if i = degree(Q) then
+          delta : NNI := (degree(P)-degree(Q))::NNI
+          zero?(delta) => 
+                  error("semiIndiceSubResultantEuclidean$PRS : bad degrees")
+          s : R := LC(Q)**(delta-1)::NNI
+          return construct(s::polR, s * Q)
+       i > degree(Q) => construct(0::polR, 0::polR)
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       VP : Vector(polR) := [Q, 1::polR]
+       pdiv := pseudoDivide(P, -Q)
+       VQ : Vector(polR) := [pdiv.remainder, pdiv.quotient]
+       repeat
+          --  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s = lc(S_d),  i < d
+          --  S_{c-1} = ...P_0 + VP.2 Q_0,  S_{d-1} = ...P_0 + ...Q_0
+          (P, Q) := (VP.1, VQ.1)
+          zero?(Q) => return construct(0::polR, 0::polR)
+          (degP, degQ) := (degree(P), degree(Q))
+          i = degP-1 => return construct(VQ.2, VQ.1)
+          (i > degQ) => return construct(0::polR, 0::polR)
+          VZ := Lazard3(VQ, LC(Q), s, (degP - degQ)::NNI)
+          i = degQ => return construct(VZ.2, VZ.1)
+          ss : R := LC(VZ.1)
+          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
+          s := ss
+
+    degreeSubResultant(P : polR, Q : polR, i : NNI) : polR == 
+       zero?(Q) or zero?(P) => 0
+       if degree(P) < degree(Q) then (P, Q) := (Q, P)
+       if i = degree(Q) then
+          delta : NNI := (degree(P)-degree(Q))::NNI
+          zero?(delta) => error("degreeSubResultant$PRS : bad degrees")
+          s : R := LC(Q)**(delta-1)::NNI
+          return s*Q
+       i > degree(Q) => 0
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       (P, Q) := (Q, pseudoRemainder(P, -Q))
+       repeat
+          -- P = S_{c-1},  Q = S_{d-1},  s = lc(S_d)
+          zero?(Q) or (i > degree(Q)) => return 0
+          i = degree(Q) => return Q
+          Z : polR := Lazard2(Q, LC(Q), s, (degree(P) - degree(Q))::NNI)
+          --  Z = S_e ~ S_d-1
+          (P, Q) := (Q, next_sousResultant2(P, Q, Z, s))
+          s := LC(Z)
+
+    degreeSubResultantEuclidean(P : polR, Q : polR, i : NNI) : 
+                     Record(coef1 : polR, coef2 : polR, subResultant : polR) ==
+       zero?(Q) or zero?(P) => construct(0::polR, 0::polR, 0::polR)
+       if degree(P) < degree(Q) then 
+          l := degreeSubResultantEuclidean(Q, P, i)
+          return construct(l.coef2, l.coef1, l.subResultant)
+       if i = degree(Q) then
+          delta : NNI := (degree(P)-degree(Q))::NNI
+          zero?(delta) => 
+                      error("degreeSubResultantEuclidean$PRS : bad degrees")
+          s : R := LC(Q)**(delta-1)::NNI
+          return construct(0::polR, s::polR, s * Q)
+       i > degree(Q) => construct(0::polR, 0::polR, 0::polR)
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       VP : Vector(polR) := [Q, 0::polR, 1::polR]
+       pdiv := pseudoDivide(P, -Q)
+       VQ : Vector(polR) := [pdiv.remainder, pdiv.coef::polR, pdiv.quotient]
+       repeat
+          --  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s=lc(S_d)
+          --  S_{c-1} = ...P_0 + VP.3 Q_0,  S_{d-1} = ...P_0 + VQ.3 Q_0
+          (P, Q) := (VP.1, VQ.1)
+          zero?(Q) or (i > degree(Q)) => 
+               return construct(0::polR, 0::polR, 0::polR)
+          i = degree(Q) => return construct(VQ.2, VQ.3, VQ.1)
+          ss : R := Lazard(LC(Q), s, (degree(P)-degree(Q))::NNI)
+          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
+          s := ss
+
+    semiDegreeSubResultantEuclidean(P : polR, Q : polR, i : NNI) : 
+                     Record(coef2 : polR, subResultant : polR) ==
+       zero?(Q) or zero?(P) => construct(0::polR, 0::polR)
+       degree(P) < degree(Q) =>
+                  error("semiDegreeSubResultantEuclidean$PRS : bad degrees")
+       if i = degree(Q) then
+          delta : NNI := (degree(P)-degree(Q))::NNI
+          zero?(delta) => 
+                  error("semiDegreeSubResultantEuclidean$PRS : bad degrees")
+          s : R := LC(Q)**(delta-1)::NNI
+          return construct(s::polR, s * Q)
+       i > degree(Q) => construct(0::polR, 0::polR)
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       VP : Vector(polR) := [Q, 1::polR]
+       pdiv := pseudoDivide(P, -Q)
+       VQ : Vector(polR) := [pdiv.remainder, pdiv.quotient]
+       repeat
+          --  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s=lc(S_d)
+          --  S_{c-1} = ...P_0 + VP.3 Q_0,  S_{d-1} = ...P_0 + VQ.3 Q_0
+          (P, Q) := (VP.1, VQ.1)
+          zero?(Q) or (i > degree(Q)) => 
+               return construct(0::polR, 0::polR)
+          i = degree(Q) => return construct(VQ.2, VQ.1)
+          ss : R := Lazard(LC(Q), s, (degree(P)-degree(Q))::NNI)
+          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
+          s := ss
+
+    lastSubResultant(P : polR, Q : polR) : polR ==
+       zero?(Q) or zero?(P) => 0
+       if degree(P) < degree(Q) then (P, Q) := (Q, P)
+       zero?(degree(Q)) => (LC(Q)**degree(P))::polR
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       (P, Q) := (Q, pseudoRemainder(P, -Q))
+       Z : polR := P
+       repeat
+          -- Z = S_d  (except the first turn : Z = P)
+          -- P = S_{c-1} ~ S_d,  Q = S_{d-1},  s = lc(S_d)
+          zero?(Q) => return Z
+          Z := Lazard2(Q, LC(Q), s, (degree(P) - degree(Q))::NNI)
+          -- Z = S_e ~ S_{d-1}
+          zero?(degree(Z)) => return Z
+          (P, Q) := (Q, next_sousResultant2(P, Q, Z, s))
+          s := LC(Z)
+
+    lastSubResultantEuclidean(P : polR, Q : polR) :
+                    Record(coef1 : polR, coef2 : polR, subResultant : polR) == 
+       zero?(Q) or zero?(P) => construct(0::polR, 0::polR, 0::polR)
+       if degree(P) < degree(Q) then 
+          l := lastSubResultantEuclidean(Q, P)
+          return construct(l.coef2, l.coef1, l.subResultant)
+       if zero?(degree(Q)) then
+          degP : NNI := degree(P)
+          zero?(degP) => 
+              error("lastSubResultantEuclidean$PRS : constant polynomials")
+          s : R := LC(Q)**(degP-1)::NNI
+          return construct(0::polR, s::polR, s * Q)
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       VP : Vector(polR) := [Q, 0::polR, 1::polR]
+       pdiv := pseudoDivide(P, -Q)
+       VQ : Vector(polR) := [pdiv.remainder, pdiv.coef::polR, pdiv.quotient]
+       VZ : Vector(polR) := copy(VP)
+       repeat
+          --  VZ.1 = S_d,  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s = lc(S_d)
+          --  S_{c-1} = VP.2 P_0 + VP.3 Q_0
+          --  S_{d-1} = VQ.2 P_0 + VQ.3 Q_0
+          --  S_d     = VZ.2 P_0 + VZ.3 Q_0
+          (Q, Z) := (VQ.1, VZ.1)
+          zero?(Q) => return construct(VZ.2, VZ.3, VZ.1)
+          VZ := Lazard3(VQ, LC(Q), s, (degree(Z) - degree(Q))::NNI)
+          zero?(degree(Q)) => return construct(VZ.2, VZ.3, VZ.1)
+          ss : R := LC(VZ.1)
+          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
+          s := ss
+
+    semiLastSubResultantEuclidean(P : polR, Q : polR) :
+                    Record(coef2 : polR, subResultant : polR) == 
+       zero?(Q) or zero?(P) => construct(0::polR, 0::polR)
+       degree(P) < degree(Q) =>
+              error("semiLastSubResultantEuclidean$PRS : bad degrees")
+       if zero?(degree(Q)) then
+          degP : NNI := degree(P)
+          zero?(degP) => 
+              error("semiLastSubResultantEuclidean$PRS : constant polynomials")
+          s : R := LC(Q)**(degP-1)::NNI
+          return construct(s::polR, s * Q)
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       VP : Vector(polR) := [Q, 1::polR]
+       pdiv := pseudoDivide(P, -Q)
+       VQ : Vector(polR) := [pdiv.remainder, pdiv.quotient]
+       VZ : Vector(polR) := copy(VP)
+       repeat
+          --  VZ.1 = S_d,  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s = lc(S_d)
+          --  S_{c-1} = ... P_0 + VP.2 Q_0
+          --  S_{d-1} = ... P_0 + VQ.2 Q_0
+          --  S_d     = ... P_0 + VZ.2 Q_0
+          (Q, Z) := (VQ.1, VZ.1)
+          zero?(Q) => return construct(VZ.2, VZ.1)
+          VZ := Lazard3(VQ, LC(Q), s, (degree(Z) - degree(Q))::NNI)
+          zero?(degree(Q)) => return construct(VZ.2, VZ.1)
+          ss : R := LC(VZ.1)
+          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
+          s := ss
+
+    chainSubResultants(P : polR, Q : polR) : List(polR) ==
+       zero?(Q) or zero?(P) => []
+       if degree(P) < degree(Q) then 
+          (P, Q) := (Q, P)
+          if odd?(degree(P)) and odd?(degree(Q)) then Q := - Q
+       L : List(polR) := []
+       zero?(degree(Q)) => L
+       L := [Q]
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       (P, Q) := (Q, pseudoRemainder(P, -Q))
+       repeat
+          -- P = S_{c-1},  Q = S_{d-1},  s = lc(S_d)
+          -- L = [S_d,....,S_{q-1}]
+          zero?(Q) => return L
+          L := concat(Q, L)
+          -- L = [S_{d-1},....,S_{q-1}]
+          delta : NNI := (degree(P) - degree(Q))::NNI
+          Z : polR := Lazard2(Q, LC(Q), s, delta)            -- Z = S_e ~ S_d-1
+          if delta > 1 then L := concat(Z, L)
+          -- L = [S_e,....,S_{q-1}]
+          zero?(degree(Z)) => return L
+          (P, Q) := (Q, next_sousResultant2(P, Q, Z, s))
+          s := LC(Z)
+
+    schema(P : polR, Q : polR) : List(NNI) ==
+       zero?(Q) or zero?(P) => []
+       if degree(P) < degree(Q) then (P, Q) := (Q, P)
+       zero?(degree(Q)) => [0]
+       L : List(NNI) := []
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       (P, Q) := (Q, pseudoRemainder(P, Q))
+       repeat
+          -- P = S_{c-1} ~ S_d,  Q = S_{d-1},  s = lc(S_d)
+          zero?(Q) => return L
+          e : NNI := degree(Q)
+          L := concat(e, L)
+          delta : NNI := (degree(P) - e)::NNI
+          Z : polR := Lazard2(Q, LC(Q), s, delta)            -- Z = S_e ~ S_d-1
+          if delta > 1 then L := concat(e, L)
+          zero?(e) => return L
+          (P, Q) := (Q, next_sousResultant2(P, Q, Z, s))
+          s := LC(Z)
+
+    subResultantGcd(P : polR, Q : polR) : polR == 
+       zero?(P) and zero?(Q) => 0
+       zero?(P) => Q
+       zero?(Q) => P
+       if degree(P) < degree(Q) then (P, Q) := (Q, P)
+       zero?(degree(Q)) => 1$polR
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       (P, Q) := (Q, pseudoRemainder(P, -Q))
+       repeat
+          -- P = S_{c-1},  Q = S_{d-1},  s = lc(S_d)
+          zero?(Q) => return P
+          zero?(degree(Q)) => return 1$polR
+          Z : polR := Lazard2(Q, LC(Q), s, (degree(P) - degree(Q))::NNI) 
+          -- Z = S_e ~ S_d-1
+          (P, Q) := (Q, next_sousResultant2(P, Q, Z, s))
+          s := LC(Z)
+            
+    subResultantGcdEuclidean(P : polR, Q : polR) :
+                    Record(coef1 : polR, coef2 : polR, gcd : polR) ==
+       zero?(P) and zero?(Q) => construct(0::polR, 0::polR, 0::polR)
+       zero?(P) => construct(0::polR, 1::polR, Q)
+       zero?(Q) => construct(1::polR, 0::polR, P)
+       if degree(P) < degree(Q) then 
+          l := subResultantGcdEuclidean(Q, P)
+          return construct(l.coef2, l.coef1, l.gcd)
+       zero?(degree(Q)) => construct(0::polR, 1::polR, Q)
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       VP : Vector(polR) := [Q, 0::polR, 1::polR]
+       pdiv := pseudoDivide(P, -Q)
+       VQ : Vector(polR) := [pdiv.remainder, pdiv.coef::polR, pdiv.quotient]
+       repeat
+          --  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s=lc(S_d)
+          --  S_{c-1} = VP.2 P_0 + VP.3 Q_0,  S_{d-1} = VQ.2 P_0 + VQ.3 Q_0
+          (P, Q) := (VP.1, VQ.1)
+          zero?(Q) => return construct(VP.2, VP.3, P)
+          e : NNI := degree(Q)
+          zero?(e) => return construct(VQ.2, VQ.3, Q)
+          ss := Lazard(LC(Q), s, (degree(P) - e)::NNI)
+          (VP,VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
+          s := ss
+
+    semiSubResultantGcdEuclidean2(P : polR, Q : polR) :
+                                  Record(coef2 : polR, gcd : polR) ==
+       zero?(P) and zero?(Q) => construct(0::polR, 0::polR)
+       zero?(P) => construct(1::polR, Q)
+       zero?(Q) => construct(0::polR, P)
+       degree(P) < degree(Q) => 
+                       error("semiSubResultantGcdEuclidean2$PRS : bad degrees")
+       zero?(degree(Q)) => construct(1::polR, Q)
+       s : R := LC(Q)**(degree(P) - degree(Q))::NNI
+       VP : Vector(polR) := [Q, 1::polR]
+       pdiv := pseudoDivide(P, -Q)
+       VQ : Vector(polR) := [pdiv.remainder, pdiv.quotient]
+       repeat
+          --  P=S_{c-1},  Q=S_{d-1},  s=lc(S_d)
+          --  S_{c-1} = ? P_0 + old_cf2 Q_0,  S_{d-1} = ? P_0 + cf2 Q_0
+          (P, Q) := (VP.1, VQ.1)
+          zero?(Q) => return construct(VP.2, P)
+          e : NNI := degree(Q)
+          zero?(e) => return construct(VQ.2, Q)
+          ss := Lazard(LC(Q), s, (degree(P) - e)::NNI)
+          (VP,VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
+          s := ss
+
+    semiSubResultantGcdEuclidean1(P : polR, Q : polR) :
+                       Record(coef1 : polR, gcd : polR) ==
+       result := subResultantGcdEuclidean(P,Q)
+       [result.coef1, result.gcd]
+
+    discriminant(P : polR) : R ==
+       d : Integer := degree(P)
+       zero?(d) => error "cannot take discriminant of constants"
+       a : Integer := (d * (d-1)) quo 2
+       a := (-1)**a::NonNegativeInteger
+       dP : polR := differentiate P
+       r : R := resultant(P, dP)
+       d := d - degree(dP) - 1
+       return (if zero?(d) then a * (r exquo LC(P))::R
+               else a * r * LC(P)**(d-1)::NNI)
+
+    discriminantEuclidean(P : polR) : 
+                       Record(coef1 : polR, coef2 : polR, discriminant : R) ==
+       d : Integer := degree(P)
+       zero?(d) => error "cannot take discriminant of constants"
+       a : Integer := (d * (d-1)) quo 2
+       a := (-1)**a::NonNegativeInteger
+       dP : polR := differentiate P
+       rE := resultantEuclidean(P, dP)
+       d := d - degree(dP) - 1
+       if zero?(d) then 
+          c1 : polR := a * (rE.coef1 exquo LC(P))::polR
+          c2 : polR := a * (rE.coef2 exquo LC(P))::polR
+          cr : R := a * (rE.resultant exquo LC(P))::R
+       else
+          c1 : polR := a * rE.coef1 * LC(P)**(d-1)::NNI
+          c2 : polR := a * rE.coef2 * LC(P)**(d-1)::NNI
+          cr : R := a * rE.resultant * LC(P)**(d-1)::NNI
+       return construct(c1, c2, cr)
+
+    semiDiscriminantEuclidean(P : polR) : 
+                            Record(coef2 : polR, discriminant : R) ==
+       d : Integer := degree(P)
+       zero?(d) => error "cannot take discriminant of constants"
+       a : Integer := (d * (d-1)) quo 2
+       a := (-1)**a::NonNegativeInteger
+       dP : polR := differentiate P
+       rE := semiResultantEuclidean2(P, dP)
+       d := d - degree(dP) - 1
+       if zero?(d) then 
+          c2 : polR := a * (rE.coef2 exquo LC(P))::polR
+          cr : R := a * (rE.resultant exquo LC(P))::R
+       else
+          c2 : polR := a * rE.coef2 * LC(P)**(d-1)::NNI
+          cr : R := a * rE.resultant * LC(P)**(d-1)::NNI
+       return construct(c2, cr)
+
+    if R has GcdDomain then
+
+       resultantReduit(P : polR, Q : polR) : R ==
+          UV := subResultantGcdEuclidean(P, Q)
+          UVs : polR := UV.gcd
+          degree(UVs) > 0 => 0
+          l : List(R) := concat(coefficients(UV.coef1), coefficients(UV.coef2))
+          return (LC(UVs) exquo gcd(l))::R
+
+       resultantReduitEuclidean(P : polR, Q : polR) :
+                     Record(coef1 : polR, coef2 : polR, resultantReduit : R) ==
+          UV := subResultantGcdEuclidean(P, Q)
+          UVs : polR := UV.gcd
+          degree(UVs) > 0 => construct(0::polR, 0::polR, 0::R)
+          l : List(R) := concat(coefficients(UV.coef1), coefficients(UV.coef2))
+          gl : R := gcd(l)
+          c1 : polR := (UV.coef1 exquo gl)::polR
+          c2 : polR := (UV.coef2 exquo gl)::polR
+          rr : R := (LC(UVs) exquo gl)::R
+          return construct(c1, c2, rr)
+
+       semiResultantReduitEuclidean(P : polR, Q : polR) :
+                                   Record(coef2 : polR, resultantReduit : R) ==
+          UV := subResultantGcdEuclidean(P, Q)
+          UVs : polR := UV.gcd
+          degree(UVs) > 0 => construct(0::polR, 0::R)
+          l : List(R) := concat(coefficients(UV.coef1), coefficients(UV.coef2))
+          gl : R := gcd(l)
+          c2 : polR := (UV.coef2 exquo gl)::polR
+          rr : R := (LC(UVs) exquo gl)::R
+          return construct(c2, rr)
+
+       gcd_naif(P : polR, Q : polR) : polR ==
+          -- valid over a field
+          zero?(P) => (Q exquo LC(Q))::polR
+          repeat
+             zero?(Q) => return (P exquo LC(P))::polR
+             zero?(degree(Q)) => return 1$polR
+             (P, Q) := (Q, divide(P, Q).remainder)
+
+       gcd(P : polR, Q : polR) : polR ==
+          R has Finite => gcd_naif(P,Q) 
+          zero?(P) => Q
+          zero?(Q) => P
+          cP : R := content(P)
+          cQ : R := content(Q)
+          P := (P exquo cP)::polR
+          Q := (Q exquo cQ)::polR
+          G : polR := subResultantGcd(P, Q)
+          return gcd(cP,cQ) * primitivePart(G)
+
 *)
 
 \end{chunk}
@@ -168629,6 +209927,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where
         ++ y is an algebraic function of x.
 
   Implementation ==> add
+
     import IntegrationTools(R, F)
     import RationalIntegration(F, UP)
     import GenusZeroIntegration(R, F, L)
@@ -168667,7 +209966,9 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where
     dumk  := kernel(dummy)@K
 
     UPUP2F1(p, t, cf, kx, k) == UPUP2F0(eval(p, t, cf), kx, k)
+
     UPUP2F0(p, kx, k)        == multivariate(p, kx, k::F)
+
     chv(f, n, a, b)          == univariate(chv0(f, n, a, b), dumk)
 
     RF2UPUP(f, modulus) ==
@@ -168675,8 +209976,8 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where
                                       1)::Record(coef1:UPUP, coef2:UPUP)
       (map((x1:F):RF+->x1::UP::RF, numer f) * bc.coef1) rem modulus
 
--- returns "failed", or (xx, c) such that f(x, y)dx = f(xx, y) c dy
--- if p(x, y) = 0 is linear in x
+    -- returns "failed", or (xx, c) such that f(x, y)dx = f(xx, y) c dy
+    -- if p(x, y) = 0 is linear in x
     linearInXIfCan(x, y) ==
       a := b := 0$UP
       p := clearDenominator lift(minPoly y, x)
@@ -168688,7 +209989,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where
       xx:RF := b / a
       [xx(dumk::F), differentiate(xx, differentiate)]
 
--- return Int(f(x,y)dx) where y is an n^th root of a rational function in x
+    -- return Int(f(x,y)dx) where y is an n^th root of a rational function in x
     prootintegrate(f, x, y) ==
       modulus := lift(p := minPoly y, x)
       rf      := reductum(ff := univariate(f, x, y, p))
@@ -168722,29 +210023,29 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where
       algaddx(map(x1+->UPUP2F1(lift x1, cv.c1, cv.c2, x, y),
         palgintegrate(reduce(cv.func), differentiate$UP)$ALG)$IR2, x::F)
 
--- Do the rationalizing change of variable
--- Int(f(x, y) dx) --> Int(n u^(n-1) f((u^n - b)/a, u) / a du) where
--- u^n = y^n = g(x) = a x + b
--- returns the integral as an integral of a rational function in u
+    -- Do the rationalizing change of variable
+    -- Int(f(x, y) dx) --> Int(n u^(n-1) f((u^n - b)/a, u) / a du) where
+    -- u^n = y^n = g(x) = a x + b
+    -- returns the integral as an integral of a rational function in u
     rationalInt(f, n, g) ==
---      not one? degree g => error "rationalInt: radicand must be linear"
       not ((degree g) = 1) => error "rationalInt: radicand must be linear"
       a := leadingCoefficient g
       integrate(n * monomial(inv a, (n-1)::N)$UP
                   * chv(f, n, a, leadingCoefficient reductum g))
 
--- Do the rationalizing change of variable f(x,y) --> f((u^n - b)/a, u) where
--- u = y = (a x + b)^(1/n).
--- Returns f((u^n - b)/a,u) as an element of F
+    -- Do the rationalizing change of variable 
+    -- f(x,y) --> f((u^n - b)/a, u) where
+    -- u = y = (a x + b)^(1/n).
+    -- Returns f((u^n - b)/a,u) as an element of F
     chv0(f, n, a, b) ==
       d := dumk::F
       (f (d::UP::RF)) ((d ** n - b) / a)
 
--- candidates(p) returns a list of pairs [g, u] such that p(x) = g(u(x)),
--- those u's are candidates for change of variables
--- currently uses a dumb heuristic where the candidates u's are p itself
--- and all the powers x^2, x^3, ..., x^{deg(p)},
--- will use polynomial decomposition in smarter days   MB 8/93
+    -- candidates(p) returns a list of pairs [g, u] such that p(x) = g(u(x)),
+    -- those u's are candidates for change of variables
+    -- currently uses a dumb heuristic where the candidates u's are p itself
+    -- and all the powers x^2, x^3, ..., x^{deg(p)},
+    -- will use polynomial decomposition in smarter days   MB 8/93
     candidates p ==
       l:List(CND) := empty()
       ground? p => l
@@ -168753,11 +210054,11 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where
           l := concat([u::UP, xi], l)
       concat([monomial(1, 1), p], l)
 
--- checks whether Int(p(x, y) dx) can be rewritten as
--- Int(r(u, z) du) where u is some polynomial of x,
--- z = d y for some polynomial d, and z^m = g(u)
--- returns either [r(u, z), g, u, d, m] or "failed"
--- we have y^n = radi
+    -- checks whether Int(p(x, y) dx) can be rewritten as
+    -- Int(r(u, z) du) where u is some polynomial of x,
+    -- z = d y for some polynomial d, and z^m = g(u)
+    -- returns either [r(u, z), g, u, d, m] or "failed"
+    -- we have y^n = radi
     changeVarIfCan(p, radi, n) ==
       rec := rootPoly(radi, n)
       for cnd in candidates(rec.radicand) repeat
@@ -168766,10 +210067,10 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where
                  return [u::UPUP, cnd.left, cnd.right, rec.coef, rec.exponent]
       "failed"
 
--- checks whether Int(p(x, y) dx) can be rewritten as
--- Int(r(u, z) du) where u is some polynomial of x and z = d y
--- we have y^n = a(x)/d(x)
--- returns either "failed" or r(u, z)
+    -- checks whether Int(p(x, y) dx) can be rewritten as
+    -- Int(r(u, z) du) where u is some polynomial of x and z = d y
+    -- we have y^n = a(x)/d(x)
+    -- returns either "failed" or r(u, z)
     chvarIfCan(p, d, u, u1) ==
       ans:UPUP := 0
       while p ^= 0 repeat
@@ -168789,14 +210090,15 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where
       r       := radPoly(modulus)::Record(radicand:RF, deg:N)
       rec     := rootPoly(r.radicand, r.deg)
       dqdx    := inv(differentiate(q := rec.radicand)::RF)
-      ((uf := chvarIfCan(ff := univariate(f,x,k,p),rec.coef,q,1)) case UPUP) and
-        ((ug:=chvarIfCan(gg:=univariate(g,x,k,p),rec.coef,q,dqdx)) case UPUP) =>
+      ((uf := chvarIfCan(ff := univariate(f,x,k,p),rec.coef,q,1)) case UPUP) _
+       and _
+        ((ug:=chvarIfCan(gg:=univariate(g,x,k,p),rec.coef,q,dqdx))_
+             case UPUP) =>
           (u := rde(chv0(uf::UPUP, rec.exponent, 1, 0), rec.exponent *
                     (dumk::F) ** (rec.exponent * (rec.exponent - 1))
                       * chv0(ug::UPUP, rec.exponent, 1, 0),
                        symbolIfCan(dumk)::SY)) case "failed" => "failed"
           eval(u::F, dumk, k::F)
---      one?(rec.coef) =>
       ((rec.coef) = 1) =>
         curve  := RadicalFunctionField(F, UP, UPUP, q::RF, rec.exponent)
         rc := algDsolve(D()$LDALG + reduce(univariate(nfp, x, k, p))::LDALG,
@@ -168936,6 +210238,7 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where
       "failed"
 
     if L has LinearOrdinaryDifferentialOperatorCategory F then
+
       palgLODE(eq, g, kx, y, x) ==
         (v := linearInXIfCan(kx, y)) case "failed" =>
           (u := quadIfCan(kx, y)) case "failed" =>
@@ -168948,6 +210251,325 @@ PureAlgebraicIntegration(R, F, L): Exports == Implementation where
 \begin{chunk}{COQ INTPAF}
 (* package INTPAF *)
 (*
+
+    import IntegrationTools(R, F)
+    import RationalIntegration(F, UP)
+    import GenusZeroIntegration(R, F, L)
+    import ChangeOfVariable(F, UP, UPUP)
+    import IntegrationResultFunctions2(F, F)
+    import IntegrationResultFunctions2(RF, F)
+    import SparseUnivariatePolynomialFunctions2(F, RF)
+    import UnivariatePolynomialCommonDenominator(UP, RF, UPUP)
+    import PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                                                        K, R, P, F)
+
+    quadIfCan      : (K, K) -> Union(Record(coef:F, poly:UP), "failed")
+    linearInXIfCan : (K, K) -> Union(Record(xsub:F, dxsub:RF), "failed")
+    prootintegrate : (F, K, K) -> IR
+    prootintegrate1: (UPUP, K, K, UPUP) -> IR
+    prootextint    : (F, K, K, F) -> U2
+    prootlimint    : (F, K, K, List F) -> U3
+    prootRDE       : (F, F, F, K, K, (F, F, SY) -> U1) -> U1
+    palgRDE1       : (F, F, K, K) -> U1
+    palgLODE1      : (List F, F, K, K, SY) -> REC
+    palgintegrate  : (F, K, K) -> IR
+    palgext        : (F, K, K, F) -> U2
+    palglim        : (F, K, K, List F) -> U3
+    UPUP2F1        : (UPUP, RF, RF, K, K) -> F
+    UPUP2F0        : (UPUP, K, K) -> F
+    RF2UPUP        : (RF, UPUP) -> UPUP
+    algaddx        : (IR, F) -> IR
+    chvarIfCan     : (UPUP, RF, UP, RF) -> Union(UPUP, "failed")
+    changeVarIfCan : (UPUP, RF, N) -> Union(CHV, "failed")
+    rationalInt    : (UPUP, N, UP) -> IntegrationResult RF
+    chv            : (UPUP, N, F, F) -> RF
+    chv0           : (UPUP, N, F, F) -> F
+    candidates     : UP -> List CND
+
+    dummy := new()$SY
+    dumk  := kernel(dummy)@K
+
+    UPUP2F1(p, t, cf, kx, k) == UPUP2F0(eval(p, t, cf), kx, k)
+
+    UPUP2F0(p, kx, k)        == multivariate(p, kx, k::F)
+
+    chv(f, n, a, b)          == univariate(chv0(f, n, a, b), dumk)
+
+    RF2UPUP(f, modulus) ==
+      bc := extendedEuclidean(map((z1:F):RF+->z1::UP::RF, denom f), modulus,
+                                      1)::Record(coef1:UPUP, coef2:UPUP)
+      (map((x1:F):RF+->x1::UP::RF, numer f) * bc.coef1) rem modulus
+
+    -- returns "failed", or (xx, c) such that f(x, y)dx = f(xx, y) c dy
+    -- if p(x, y) = 0 is linear in x
+    linearInXIfCan(x, y) ==
+      a := b := 0$UP
+      p := clearDenominator lift(minPoly y, x)
+      while p ^= 0 repeat
+        degree(q := numer leadingCoefficient p) > 1 => return "failed"
+        a := a + monomial(coefficient(q, 1), d := degree p)
+        b := b - monomial(coefficient(q, 0), d)
+        p := reductum p
+      xx:RF := b / a
+      [xx(dumk::F), differentiate(xx, differentiate)]
+
+    -- return Int(f(x,y)dx) where y is an n^th root of a rational function in x
+    prootintegrate(f, x, y) ==
+      modulus := lift(p := minPoly y, x)
+      rf      := reductum(ff := univariate(f, x, y, p))
+      ((r := retractIfCan(rf)@Union(RF,"failed")) case RF) and rf ^= 0 =>
+            -- in this case, ff := lc(ff) y^i + r so we integrate both terms
+            -- separately to gain time
+            map(f1+->f1(x::F), integrate(r::RF)) +
+                 prootintegrate1(leadingMonomial ff, x, y, modulus)
+      prootintegrate1(ff, x, y, modulus)
+
+    prootintegrate1(ff, x, y, modulus) ==
+      chv:CHV
+      r := radPoly(modulus)::Record(radicand:RF, deg:N)
+      (uu := changeVarIfCan(ff, r.radicand, r.deg)) case CHV =>
+        chv := uu::CHV
+        newalg := nthRoot((chv.left)(dumk::F), chv.deg)
+        kz := retract(numer newalg)@K
+        newf := multivariate(chv.int, ku := dumk, newalg)
+        vu := (chv.right)(x::F)
+        vz := (chv.den)(x::F) * (y::F) * denom(newalg)::F
+        map(x1+->eval(x1, [ku, kz], [vu, vz]), palgint(newf, ku, kz))
+      cv     := chvar(ff, modulus)
+      r      := radPoly(cv.poly)::Record(radicand:RF, deg:N)
+      qprime := differentiate(q := retract(r.radicand)@UP)::RF
+      not zero? qprime and
+       ((u := chvarIfCan(cv.func, 1, q, inv qprime)) case UPUP) =>
+         m := monomial(1, r.deg)$UPUP - q::RF::UPUP
+         map(x1+->UPUP2F1(RF2UPUP(x1, m), cv.c1, cv.c2, x, y),
+            rationalInt(u::UPUP, r.deg, monomial(1, 1)))
+      curve  := RadicalFunctionField(F, UP, UPUP, q::RF, r.deg)
+      algaddx(map(x1+->UPUP2F1(lift x1, cv.c1, cv.c2, x, y),
+        palgintegrate(reduce(cv.func), differentiate$UP)$ALG)$IR2, x::F)
+
+    -- Do the rationalizing change of variable
+    -- Int(f(x, y) dx) --> Int(n u^(n-1) f((u^n - b)/a, u) / a du) where
+    -- u^n = y^n = g(x) = a x + b
+    -- returns the integral as an integral of a rational function in u
+    rationalInt(f, n, g) ==
+      not ((degree g) = 1) => error "rationalInt: radicand must be linear"
+      a := leadingCoefficient g
+      integrate(n * monomial(inv a, (n-1)::N)$UP
+                  * chv(f, n, a, leadingCoefficient reductum g))
+
+    -- Do the rationalizing change of variable 
+    -- f(x,y) --> f((u^n - b)/a, u) where
+    -- u = y = (a x + b)^(1/n).
+    -- Returns f((u^n - b)/a,u) as an element of F
+    chv0(f, n, a, b) ==
+      d := dumk::F
+      (f (d::UP::RF)) ((d ** n - b) / a)
+
+    -- candidates(p) returns a list of pairs [g, u] such that p(x) = g(u(x)),
+    -- those u's are candidates for change of variables
+    -- currently uses a dumb heuristic where the candidates u's are p itself
+    -- and all the powers x^2, x^3, ..., x^{deg(p)},
+    -- will use polynomial decomposition in smarter days   MB 8/93
+    candidates p ==
+      l:List(CND) := empty()
+      ground? p => l
+      for i in 2..degree p repeat
+        if (u := composite(p, xi := monomial(1, i))) case UP then
+          l := concat([u::UP, xi], l)
+      concat([monomial(1, 1), p], l)
+
+    -- checks whether Int(p(x, y) dx) can be rewritten as
+    -- Int(r(u, z) du) where u is some polynomial of x,
+    -- z = d y for some polynomial d, and z^m = g(u)
+    -- returns either [r(u, z), g, u, d, m] or "failed"
+    -- we have y^n = radi
+    changeVarIfCan(p, radi, n) ==
+      rec := rootPoly(radi, n)
+      for cnd in candidates(rec.radicand) repeat
+        (u := chvarIfCan(p, rec.coef, cnd.right,
+              inv(differentiate(cnd.right)::RF))) case UPUP =>
+                 return [u::UPUP, cnd.left, cnd.right, rec.coef, rec.exponent]
+      "failed"
+
+    -- checks whether Int(p(x, y) dx) can be rewritten as
+    -- Int(r(u, z) du) where u is some polynomial of x and z = d y
+    -- we have y^n = a(x)/d(x)
+    -- returns either "failed" or r(u, z)
+    chvarIfCan(p, d, u, u1) ==
+      ans:UPUP := 0
+      while p ^= 0 repeat
+        (v := composite(u1 * leadingCoefficient(p) / d ** degree(p), u))
+          case "failed" => return "failed"
+        ans := ans + monomial(v::RF, degree p)
+        p   := reductum p
+      ans
+
+    algaddx(i, xx) ==
+      elem? i => i
+      mkAnswer(ratpart i, logpart i,
+                [[- ne.integrand / (xx**2), xx] for ne in notelem i])
+
+    prootRDE(nfp, f, g, x, k, rde) ==
+      modulus := lift(p := minPoly k, x)
+      r       := radPoly(modulus)::Record(radicand:RF, deg:N)
+      rec     := rootPoly(r.radicand, r.deg)
+      dqdx    := inv(differentiate(q := rec.radicand)::RF)
+      ((uf := chvarIfCan(ff := univariate(f,x,k,p),rec.coef,q,1)) case UPUP) _
+       and _
+        ((ug:=chvarIfCan(gg:=univariate(g,x,k,p),rec.coef,q,dqdx))_
+             case UPUP) =>
+          (u := rde(chv0(uf::UPUP, rec.exponent, 1, 0), rec.exponent *
+                    (dumk::F) ** (rec.exponent * (rec.exponent - 1))
+                      * chv0(ug::UPUP, rec.exponent, 1, 0),
+                       symbolIfCan(dumk)::SY)) case "failed" => "failed"
+          eval(u::F, dumk, k::F)
+      ((rec.coef) = 1) =>
+        curve  := RadicalFunctionField(F, UP, UPUP, q::RF, rec.exponent)
+        rc := algDsolve(D()$LDALG + reduce(univariate(nfp, x, k, p))::LDALG,
+                         reduce univariate(g, x, k, p))$RDALG
+        rc.particular case "failed" => "failed"
+        UPUP2F0(lift((rc.particular)::curve), x, k)
+      palgRDE1(nfp, g, x, k)
+
+    prootlimint(f, x, k, lu) ==
+      modulus := lift(p := minPoly k, x)
+      r       := radPoly(modulus)::Record(radicand:RF, deg:N)
+      rec     := rootPoly(r.radicand, r.deg)
+      dqdx    := inv(differentiate(q := rec.radicand)::RF)
+      (uf:=chvarIfCan(ff := univariate(f,x,k,p),rec.coef,q,dqdx)) case UPUP =>
+        l := empty()$List(RF)
+        n := rec.exponent * monomial(1, (rec.exponent - 1)::N)$UP
+        for u in lu repeat
+         if ((v:=chvarIfCan(uu:=univariate(u,x,k,p),rec.coef,q,dqdx))case UPUP)
+            then l := concat(n * chv(v::UPUP,rec.exponent, 1, 0), l) else FAIL
+        m := monomial(1, rec.exponent)$UPUP - q::RF::UPUP
+        map(x1+->UPUP2F0(RF2UPUP(x1,m), x, k),
+            limitedint(n * chv(uf::UPUP, rec.exponent, 1, 0), reverse_! l))
+      cv     := chvar(ff, modulus)
+      r      := radPoly(cv.poly)::Record(radicand:RF, deg:N)
+      dqdx   := inv(differentiate(q := retract(r.radicand)@UP)::RF)
+      curve  := RadicalFunctionField(F, UP, UPUP, q::RF, r.deg)
+      (ui := palginfieldint(reduce(cv.func), differentiate$UP)$ALG)
+        case "failed" => FAIL
+      [UPUP2F1(lift(ui::curve), cv.c1, cv.c2, x, k), empty()]
+
+    prootextint(f, x, k, g) ==
+      modulus := lift(p := minPoly k, x)
+      r       := radPoly(modulus)::Record(radicand:RF, deg:N)
+      rec     := rootPoly(r.radicand, r.deg)
+      dqdx    := inv(differentiate(q := rec.radicand)::RF)
+      ((uf:=chvarIfCan(ff:=univariate(f,x,k,p),rec.coef,q,dqdx)) case UPUP) and
+       ((ug:=chvarIfCan(gg:=univariate(g,x,k,p),rec.coef,q,dqdx)) case UPUP) =>
+          m := monomial(1, rec.exponent)$UPUP - q::RF::UPUP
+          n := rec.exponent * monomial(1, (rec.exponent - 1)::N)$UP
+          map(x1+->UPUP2F0(RF2UPUP(x1,m), x, k),
+              extendedint(n * chv(uf::UPUP, rec.exponent, 1, 0),
+                          n * chv(ug::UPUP, rec.exponent, 1, 0)))
+      cv     := chvar(ff, modulus)
+      r      := radPoly(cv.poly)::Record(radicand:RF, deg:N)
+      dqdx   := inv(differentiate(q := retract(r.radicand)@UP)::RF)
+      curve  := RadicalFunctionField(F, UP, UPUP, q::RF, r.deg)
+      (u := palginfieldint(reduce(cv.func), differentiate$UP)$ALG)
+        case "failed" => FAIL
+      [UPUP2F1(lift(u::curve), cv.c1, cv.c2, x, k), 0]
+
+    palgRDE1(nfp, g, x, y) ==
+      palgLODE1([nfp, 1], g, x, y, symbolIfCan(x)::SY).particular
+
+    palgLODE1(eq, g, kx, y, x) ==
+      modulus:= lift(p := minPoly y, kx)
+      curve  := AlgebraicFunctionField(F, UP, UPUP, modulus)
+      neq:LDALG := 0
+      for f in eq for i in 0.. repeat
+          neq := neq + monomial(reduce univariate(f, kx, y, p), i)
+      empty? remove_!(y, remove_!(kx, varselect(kernels g, x))) =>
+        rec := algDsolve(neq, reduce univariate(g, kx, y, p))$RDALG
+        bas:List(F) := [UPUP2F0(lift h, kx, y) for h in rec.basis]
+        rec.particular case "failed" => ["failed", bas]
+        [UPUP2F0(lift((rec.particular)::curve), kx, y), bas]
+      rec := algDsolve(neq, 0)
+      ["failed", [UPUP2F0(lift h, kx, y) for h in rec.basis]]
+
+    palgintegrate(f, x, k) ==
+      modulus:= lift(p := minPoly k, x)
+      cv     := chvar(univariate(f, x, k, p), modulus)
+      curve  := AlgebraicFunctionField(F, UP, UPUP, cv.poly)
+      knownInfBasis(cv.deg)
+      algaddx(map(x1+->UPUP2F1(lift x1, cv.c1, cv.c2, x, k),
+        palgintegrate(reduce(cv.func), differentiate$UP)$ALG)$IR2, x::F)
+
+    palglim(f, x, k, lu) ==
+      modulus:= lift(p := minPoly k, x)
+      cv     := chvar(univariate(f, x, k, p), modulus)
+      curve  := AlgebraicFunctionField(F, UP, UPUP, cv.poly)
+      knownInfBasis(cv.deg)
+      (u := palginfieldint(reduce(cv.func), differentiate$UP)$ALG)
+        case "failed" => FAIL
+      [UPUP2F1(lift(u::curve), cv.c1, cv.c2, x, k), empty()]
+
+    palgext(f, x, k, g) ==
+      modulus:= lift(p := minPoly k, x)
+      cv     := chvar(univariate(f, x, k, p), modulus)
+      curve  := AlgebraicFunctionField(F, UP, UPUP, cv.poly)
+      knownInfBasis(cv.deg)
+      (u := palginfieldint(reduce(cv.func), differentiate$UP)$ALG)
+        case "failed" => FAIL
+      [UPUP2F1(lift(u::curve), cv.c1, cv.c2, x, k), 0]
+
+    palgint(f, x, y) ==
+      (v := linearInXIfCan(x, y)) case "failed" =>
+        (u := quadIfCan(x, y)) case "failed" =>
+          is?(y, "nthRoot"::SY) => prootintegrate(f, x, y)
+          is?(y,  "rootOf"::SY) => palgintegrate(f, x, y)
+          FAIL
+        palgint0(f, x, y, u.coef, u.poly)
+      palgint0(f, x, y, dumk, v.xsub, v.dxsub)
+
+    palgextint(f, x, y, g) ==
+      (v := linearInXIfCan(x, y)) case "failed" =>
+        (u := quadIfCan(x, y)) case "failed" =>
+          is?(y, "nthRoot"::SY) => prootextint(f, x, y, g)
+          is?(y,  "rootOf"::SY) => palgext(f, x, y, g)
+          FAIL
+        palgextint0(f, x, y, g, u.coef, u.poly)
+      palgextint0(f, x, y, g, dumk, v.xsub, v.dxsub)
+
+    palglimint(f, x, y, lu) ==
+      (v := linearInXIfCan(x, y)) case "failed" =>
+        (u := quadIfCan(x, y)) case "failed" =>
+          is?(y, "nthRoot"::SY) => prootlimint(f, x, y, lu)
+          is?(y,  "rootOf"::SY) => palglim(f, x, y, lu)
+          FAIL
+        palglimint0(f, x, y, lu, u.coef, u.poly)
+      palglimint0(f, x, y, lu, dumk, v.xsub, v.dxsub)
+
+    palgRDE(nfp, f, g, x, y, rde) ==
+      (v := linearInXIfCan(x, y)) case "failed" =>
+        (u := quadIfCan(x, y)) case "failed" =>
+          is?(y, "nthRoot"::SY) => prootRDE(nfp, f, g, x, y, rde)
+          palgRDE1(nfp, g, x, y)
+        palgRDE0(f, g, x, y, rde, u.coef, u.poly)
+      palgRDE0(f, g, x, y, rde, dumk, v.xsub, v.dxsub)
+
+    -- returns "failed", or (d, P) such that (dy)**2 = P(x)
+    -- and degree(P) = 2
+    quadIfCan(x, y) ==
+      (degree(p := minPoly y) = 2) and zero?(coefficient(p, 1)) =>
+        d := denom(ff :=
+                 univariate(- coefficient(p, 0) / coefficient(p, 2), x))
+        degree(radi := d * numer ff) = 2 => [d(x::F), radi]
+        "failed"
+      "failed"
+
+    if L has LinearOrdinaryDifferentialOperatorCategory F then
+
+      palgLODE(eq, g, kx, y, x) ==
+        (v := linearInXIfCan(kx, y)) case "failed" =>
+          (u := quadIfCan(kx, y)) case "failed" =>
+            palgLODE1([coefficient(eq, i) for i in 0..degree eq], g, kx, y, x)
+          palgLODE0(eq, g, kx, y, u.coef, u.poly)
+        palgLODE0(eq, g, kx, y, dumk, v.xsub, v.dxsub)
+
 *)
 
 \end{chunk}
@@ -169027,6 +210649,7 @@ PureAlgebraicLODE(F, UP, UPUP, R): Exports == Implementation where
       ++ \spad{R} of the homogeneous equation.
 
   Implementation ==> add
+
     import RationalLODE(F, UP)
     import SystemODESolver(RF, LQ)
     import ReduceLODE(RF, LQ, UPUP, R, L)
@@ -169043,6 +210666,18 @@ PureAlgebraicLODE(F, UP, UPUP, R): Exports == Implementation where
 \begin{chunk}{COQ ODEPAL}
 (* package ODEPAL *)
 (*
+
+    import RationalLODE(F, UP)
+    import SystemODESolver(RF, LQ)
+    import ReduceLODE(RF, LQ, UPUP, R, L)
+
+    algDsolve(l, g) ==
+      rec := reduceLODE(l, g)
+      sol := solveInField(rec.mat, rec.vec, ratDsolve)
+      bas:List(R) := [represents v for v in sol.basis]
+      (u := sol.particular) case V => [represents(u::V), bas]
+      ["failed", bas]
+
 *)
 
 \end{chunk}
@@ -169131,6 +210766,7 @@ PushVariables(R,E,OV,PPR):C == T where
        ++ map(f,p) \undocumented{}
 
    T == add
+
      pushdown(g:PPR,x:OV) : PPR ==
        eval(g,x,monomial(1,convert x,1)$PR)
 
@@ -169173,6 +210809,44 @@ PushVariables(R,E,OV,PPR):C == T where
 \begin{chunk}{COQ PUSHVAR}
 (* package PUSHVAR *)
 (*
+
+     pushdown(g:PPR,x:OV) : PPR ==
+       eval(g,x,monomial(1,convert x,1)$PR)
+
+     pushdown(g:PPR, lv:List OV) : PPR ==
+       vals:=[monomial(1,convert x,1)$PR for x in lv]
+       eval(g,lv,vals)
+
+     map(f:(PR -> PPR), p: PPR) : PPR ==
+       ground? p => f(retract p)
+       v:=mainVariable(p)::OV
+       multivariate(map((x:PPR):PPR+->map(f,x),univariate(p,v)),v)
+
+               ----  push back the variable  ----
+     pushupCoef(c:PR, lv:List OV): PPR ==
+       ground? c => c::PPR
+       v:=mainVariable(c)::Symbol
+       v2 := variable(v)$OV
+       uc := univariate(c,v)
+       ppr : PPR := 0
+       v2 case OV =>
+          while not zero? uc repeat
+             ppr := ppr + monomial(1,v2,degree(uc))$PPR *
+                            pushupCoef(leadingCoefficient uc, lv)
+             uc := reductum uc
+          ppr
+       while not zero? uc repeat
+          ppr := ppr + monomial(1,v,degree(uc))$PR *
+                            pushupCoef(leadingCoefficient uc, lv)
+          uc := reductum uc
+       ppr
+
+     pushup(f:PPR,x:OV) :PPR ==
+       map(y +-> pushupCoef(y,[x]), f)
+
+     pushup(g:PPR, lv:List OV) : PPR ==
+       map(y +-> pushupCoef(y, lv), g)
+
 *)
 
 \end{chunk}
@@ -169308,6 +210982,7 @@ QuasiAlgebraicSet2(vl,nv) : C == T where
        ++ inequation reduced with respect to the basis, using
        ++ using groebner basis of radical ideals
    T  == add
+
                 ----  Local Functions  ----
      ts:=new()$Symbol
      newvl:=concat(ts, vl)
@@ -169324,6 +210999,7 @@ QuasiAlgebraicSet2(vl,nv) : C == T where
      import QuasiAlgebraicSet(F, Var, Expon, Dpoly)
      import PolynomialCategoryLifting(Expon,Var,F,Dpoly,newPoly)
      import PolynomialCategoryLifting(newExpon,newVar,F,newPoly,Dpoly)
+
      f(v:Var):newPoly ==
        variable((convert v)@Symbol)@Union(newVar,"failed")::newVar
          ::newPoly
@@ -169360,6 +211036,55 @@ QuasiAlgebraicSet2(vl,nv) : C == T where
 \begin{chunk}{COQ QALGSET2}
 (* package QALGSET2 *)
 (*
+
+                ----  Local Functions  ----
+     ts:=new()$Symbol
+     newvl:=concat(ts, vl)
+     tv:newVar:=(variable ts)::newVar
+     npoly         :     Dpoly            ->  newPoly
+     oldpoly       :     newPoly          ->  Union(Dpoly,"failed")
+     f             :     Var              ->  newPoly
+     g             :     newVar           ->  Dpoly
+ 
+     import PolynomialIdeals(F,newExpon,newVar,newPoly)
+     import GroebnerPackage(F,Expon,Var,Dpoly)
+     import GroebnerPackage(F,newExpon,newVar,newPoly)
+     import IdealDecompositionPackage(newvl,#newvl)
+     import QuasiAlgebraicSet(F, Var, Expon, Dpoly)
+     import PolynomialCategoryLifting(Expon,Var,F,Dpoly,newPoly)
+     import PolynomialCategoryLifting(newExpon,newVar,F,newPoly,Dpoly)
+
+     f(v:Var):newPoly ==
+       variable((convert v)@Symbol)@Union(newVar,"failed")::newVar
+         ::newPoly
+     g(v:newVar):Dpoly ==
+       v = tv => 0
+       variable((convert v)@Symbol)@Union(Var,"failed")::Var::Dpoly
+ 
+     npoly(p:Dpoly) : newPoly ==  map(z1 +-> f z1, z2 +-> z2::newPoly, p)
+ 
+     oldpoly(q:newPoly) : Union(Dpoly,"failed") ==
+       (x:=mainVariable q) case "failed" => (leadingCoefficient q)::Dpoly
+       (x::newVar = tv) => "failed"
+       map(z1 +-> g z1, z2 +-> z2::Dpoly, q)
+ 
+     radicalSimplify x ==
+       status(x)$QALG = true => x     -- x is empty
+       z0:=definingEquations x
+       n0:=definingInequation x
+       t:newPoly:= coerce(tv)$newPoly
+       tp:newPoly:= t * (npoly n0) - 1$newPoly
+       gen:List newPoly:= concat(tp, [npoly g for g in z0])
+       id:=ideal gen
+       ngb:=generators radical(id)
+       member? (1$newPoly, ngb) => empty()$QALG
+       gb:List Dpoly:=nil
+       while not empty? ngb repeat
+         if ((k:=oldpoly ngb.first) case Dpoly) then gb:=concat(k, gb)
+         ngb:=ngb.rest
+       y:=quasiAlgebraicSet(gb, primitivePart normalForm(n0, gb))
+       setStatus(y,false::Status)
+
 *)
 
 \end{chunk}
@@ -169830,6 +211555,271 @@ QuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where
 \begin{chunk}{COQ QCMPACK}
 (* package QCMPACK *)
 (*
+
+     squareFreeFactors(lp: LP): LP == 
+       lsflp: LP := []
+       for p in lp repeat 
+         lsfp := squareFreeFactors(p)$polsetpack
+         lsflp := concat(lsfp,lsflp)
+       sort(infRittWu?,removeDuplicates lsflp)
+
+     startTable!(ok: S, ko: S, domainName: S): Void == 
+       initTable!()$H
+       if (not empty? ok) and (not empty? ko) then printInfo!(ok,ko)$H
+       if (not empty? domainName) then startStats!(domainName)$H
+       void()
+
+     stopTable!(): Void ==   
+       if makingStats?()$H then printStats!()$H
+       clearTable!()$H
+
+     supDimElseRittWu? (ts:TS,us:TS): Boolean ==
+       #ts < #us => true
+       #ts > #us => false
+       lp1 :LP := members(ts)
+       lp2 :LP := members(us)
+       while (not empty? lp1) 
+        and (not infRittWu?(first(lp2),first(lp1))) repeat
+         lp1 := rest lp1
+         lp2 := rest lp2
+       not empty? lp1
+
+     algebraicSort (lts:Split): Split ==
+       lts := removeDuplicates lts
+       sort(supDimElseRittWu?,lts)
+
+     moreAlgebraic?(ts:TS,us:TS): Boolean  ==
+       empty? ts => empty? us 
+       empty? us => true
+       #ts < #us => false
+       for p in (members us) repeat 
+          not algebraic?(mvar(p),ts) => return false
+       true
+
+     subTriSet?(ts:TS,us:TS): Boolean  ==
+       empty? ts => true
+       empty? us => false
+       mvar(ts) > mvar(us) => false
+       mvar(ts) < mvar(us) => subTriSet?(ts,rest(us)::TS)
+       first(ts)::P = first(us)::P => subTriSet?(rest(ts)::TS,rest(us)::TS)
+       false
+
+     internalSubPolSet?(lp1: LP, lp2: LP): Boolean  ==
+       empty? lp1 => true
+       empty? lp2 => false
+       associates?(first lp1, first lp2) => 
+         internalSubPolSet?(rest lp1, rest lp2)
+       infRittWu?(first lp1, first lp2) => false
+       internalSubPolSet?(lp1, rest lp2)
+
+     subPolSet?(lp1: LP, lp2: LP): Boolean  ==
+       lp1 := sort(infRittWu?, lp1)
+       lp2 := sort(infRittWu?, lp2)
+       internalSubPolSet?(lp1,lp2)
+
+     infRittWu?(lp1: LP, lp2: LP): Boolean ==
+       lp1 := sort(infRittWu?, lp1)
+       lp2 := sort(infRittWu?, lp2)
+       internalInfRittWu?(lp1,lp2)
+
+     internalInfRittWu?(lp1: LP, lp2: LP): Boolean ==
+       empty? lp1 => not empty? lp2
+       empty? lp2 => false
+       infRittWu?(first lp1, first lp2)$P => true
+       infRittWu?(first lp2, first lp1)$P => false
+       infRittWu?(rest lp1, rest lp2)$$
+
+     subCase? (lpwt1:LpWT,lpwt2:LpWT): Boolean == 
+       -- ASSUME lpwt.{1,2}.val is sorted w.r.t. infRittWu?
+       not internalSubPolSet?(lpwt2.val, lpwt1.val) => false
+       subQuasiComponent?(lpwt1.tower,lpwt2.tower)
+
+     internalSubQuasiComponent?(ts:TS,us:TS): Union(Boolean,"failed") ==
+       -- "failed" is false iff saturate(us) is radical
+       subTriSet?(us,ts) => true
+       not moreAlgebraic?(ts,us) => false::Union(Boolean,"failed")
+       for p in (members us) repeat 
+         mdeg(p) < mdeg(select(ts,mvar(p))::P) => 
+           return("failed"::Union(Boolean,"failed"))
+       for p in (members us) repeat 
+         not zero? initiallyReduce(p,ts) =>
+           return("failed"::Union(Boolean,"failed"))
+       lsfp := squareFreeFactors(initials us)
+       for p in lsfp repeat 
+         not invertible?(p,ts)@B => 
+           return(false::Union(Boolean,"failed"))
+       true::Union(Boolean,"failed")
+
+     subQuasiComponent?(ts:TS,us:TS): Boolean ==
+       k: Key := [ts, us]
+       e := extractIfCan(k)$H
+       e case Entry => e::Entry
+       ubf: Union(Boolean,"failed") := internalSubQuasiComponent?(ts,us)
+       b: Boolean := (ubf case Boolean) and (ubf::Boolean)
+       insert!(k,b)$H
+       b
+
+     subQuasiComponent?(ts:TS,lus:Split): Boolean ==
+       for us in lus repeat
+          subQuasiComponent?(ts,us)@B => return true
+       false
+
+     removeSuperfluousCases (cases:List LpWT) ==
+       #cases < 2 => cases
+       toSee := 
+         sort((x:LpWT,y:LpWT):Boolean +-> 
+               supDimElseRittWu?(x.tower,y.tower),cases)
+       lpwt1,lpwt2 : LpWT
+       toSave,headmaxcases,maxcases,copymaxcases : List LpWT
+       while not empty? toSee repeat
+         lpwt1 := first toSee
+         toSee := rest toSee
+         toSave := []
+         for lpwt2 in toSee repeat
+            if subCase?(lpwt1,lpwt2) 
+              then
+                lpwt1 := lpwt2
+              else
+                if not subCase?(lpwt2,lpwt1) 
+                  then
+                    toSave := cons(lpwt2,toSave)
+         if empty? maxcases
+           then
+             headmaxcases := [lpwt1]
+             maxcases := headmaxcases
+           else
+             copymaxcases := maxcases
+             while (not empty? copymaxcases) and _
+               (not subCase?(lpwt1,first(copymaxcases))) repeat
+                 copymaxcases := rest copymaxcases
+             if empty? copymaxcases
+               then
+                 setrest!(headmaxcases,[lpwt1])
+                 headmaxcases := rest headmaxcases
+         toSee := reverse toSave
+       maxcases
+
+     removeSuperfluousQuasiComponents(lts: Split): Split ==
+       lts := removeDuplicates lts
+       #lts < 2 => lts
+       toSee := algebraicSort lts
+       toSave,headmaxlts,maxlts,copymaxlts : Split
+       while not empty? toSee repeat
+         ts := first toSee
+         toSee := rest toSee
+         toSave := []
+         for us in toSee repeat
+            if subQuasiComponent?(ts,us)@B
+              then
+                ts := us
+              else
+                if not subQuasiComponent?(us,ts)@B 
+                  then
+                    toSave := cons(us,toSave)
+         if empty? maxlts
+           then
+             headmaxlts := [ts]
+             maxlts := headmaxlts
+           else
+             copymaxlts := maxlts
+             while (not empty? copymaxlts) and _
+               (not subQuasiComponent?(ts,first(copymaxlts))@B) repeat
+                 copymaxlts := rest copymaxlts
+             if empty? copymaxlts
+               then
+                 setrest!(headmaxlts,[ts])
+                 headmaxlts := rest headmaxlts
+         toSee := reverse toSave
+       algebraicSort maxlts
+
+     removeAssociates (lp:LP):LP ==
+       removeDuplicates [primitivePart(p) for p in lp]
+
+     branchIfCan(leq: LP,ts: TS,lineq: LP, b1:B,b2:B,b3:B,b4:B,b5:B):UBF ==
+        -- ASSUME pols in leq are squarefree and mainly primitive
+        -- if b1 then CLEAN UP leq
+        -- if b2 then CLEAN UP lineq
+        -- if b3 then SEARCH for ZERO in lineq with leq
+        -- if b4 then SEARCH for ZERO in lineq with ts
+        -- if b5 then SEARCH for ONE in leq with lineq
+        if b1 
+          then 
+            leq := removeAssociates(leq)
+            leq := remove(zero?,leq)
+            any?(ground?,leq) => 
+              return("failed"::Union(Branch,"failed"))
+        if b2
+          then
+            any?(zero?,lineq) =>
+              return("failed"::Union(Branch,"failed"))
+            lineq := removeRedundantFactors(lineq)$polsetpack
+        if b3
+          then
+            ps: PS := construct(leq)$PS
+            for q in lineq repeat
+              zero? remainder(q,ps).polnum =>
+                return("failed"::Union(Branch,"failed"))
+        (empty? leq) or (empty? lineq) => ([leq, ts, lineq]$Branch)::UBF
+        if b4
+          then
+            for q in lineq repeat
+              zero? initiallyReduce(q,ts) => 
+                return("failed"::Union(Branch,"failed"))
+        if b5
+          then
+            newleq: LP := []
+            for p in leq repeat
+              for q in lineq repeat
+                if mvar(p) = mvar(q)
+                  then
+                    g := gcd(p,q)
+                    newp := (p exquo g)::P
+                    ground? newp => 
+                      return("failed"::Union(Branch,"failed"))
+                    newleq := cons(newp,newleq)
+                  else
+                    newleq := cons(p,newleq)
+            leq := newleq
+        leq := sort(infRittWu?, removeDuplicates leq)
+        ([leq, ts, lineq]$Branch)::UBF
+
+     prepareDecompose(lp: LP, lts: List(TS), b1: B, b2: B): List Branch ==
+       -- if b1 then REMOVE REDUNDANT COMPONENTS in lts
+       -- if b2 then SPLIT the input system with squareFree
+       lp := sort(infRittWu?, remove(zero?,removeAssociates(lp)))
+       any?(ground?,lp) => []
+       empty? lts => []
+       if b1 then lts := removeSuperfluousQuasiComponents lts
+       not b2 =>
+         [[lp,ts,squareFreeFactors(initials ts)]$Branch for ts in lts]
+       toSee: List Branch 
+       lq: LP := []         
+       toSee := [[lq,ts,squareFreeFactors(initials ts)]$Branch for ts in lts]
+       empty? lp => toSee
+       for p in lp repeat
+         lsfp := squareFreeFactors(p)$polsetpack
+         branches: List Branch := []
+         lq := []
+         for f in lsfp repeat
+           for branch in toSee repeat
+             leq : LP := branch.eq
+             ts := branch.tower
+             lineq : LP := branch.ineq
+             ubf1: UBF := branchIfCan(leq,ts,lq,false,false,true,true,true)@UBF
+             ubf1 case "failed" => "leave"
+             ubf2: UBF := 
+               branchIfCan([f],ts,lineq,false,false,true,true,true)@UBF
+             ubf2 case "failed" => "leave"
+             leq := sort(infRittWu?,removeDuplicates concat(ubf1.eq,ubf2.eq))
+             lineq := 
+               sort(infRittWu?,removeDuplicates concat(ubf1.ineq,ubf2.ineq))
+             newBranch := 
+               branchIfCan(leq,ts,lineq,false,false,false,false,false)
+             branches:= cons(newBranch::Branch,branches)
+           lq := cons(f,lq)
+         toSee := branches
+       sort((x,y) +-> supDimElseRittWu?(x.tower,y.tower),toSee)
+
 *)
 
 \end{chunk}
@@ -169901,6 +211891,7 @@ QuotientFieldCategoryFunctions2(A, B, R, S): Exports == Impl where
       ++ and denominator of frac.
 
   Impl ==> add
+
     map(f, r) == f(numer r) / f(denom r)
 
 \end{chunk}
@@ -169908,6 +211899,9 @@ QuotientFieldCategoryFunctions2(A, B, R, S): Exports == Impl where
 \begin{chunk}{COQ QFCAT2}
 (* package QFCAT2 *)
 (*
+
+    map(f, r) == f(numer r) / f(denom r)
+
 *)
 
 \end{chunk}
@@ -170044,6 +212038,7 @@ QuaternionCategoryFunctions2(QR,R,QS,S) : Exports ==
         ++X map(f,q)
 
     Implementation == add
+
       map(fn : R -> S, u : QR): QS ==
         quatern(fn real u, fn imagI u, fn imagJ u, fn imagK u)$QS
 
@@ -170052,6 +212047,10 @@ QuaternionCategoryFunctions2(QR,R,QS,S) : Exports ==
 \begin{chunk}{COQ QUATCT2}
 (* package QUATCT2 *)
 (*
+
+      map(fn : R -> S, u : QR): QS ==
+        quatern(fn real u, fn imagI u, fn imagJ u, fn imagK u)$QS
+
 *)
 
 \end{chunk}
@@ -170193,6 +212192,7 @@ RadicalEigenPackage() : C == T
        ++ Error: if m is not a symmetric matrix.
 
    T == add
+
      PI       ==> PositiveInteger
      RSP := RadicalSolvePackage R
      import EigenPackage R
@@ -170304,6 +212304,113 @@ RadicalEigenPackage() : C == T
 \begin{chunk}{COQ REP}
 (* package REP *)
 (*
+
+     PI       ==> PositiveInteger
+     RSP := RadicalSolvePackage R
+     import EigenPackage R
+
+                 ----  Local  Functions  ----
+     evalvect         :  (M,RE,SE)  ->  MRE
+     innerprod        :   (MRE,MRE)   ->  RE
+
+         ----  eval a vector of F in a radical expression  ----
+     evalvect(vect:M,alg:RE,x:SE) : MRE ==
+       n:=nrows vect
+       xx:=kernel(x)$Kernel(RE)
+       w:MRE:=zero(n,1)$MRE
+       for i in 1..n repeat
+         v:=eval(vect(i,1) :: RE,xx,alg)
+         setelt(w,i,1,v)
+       w
+                      ---- inner product ----
+     innerprod(v1:MRE,v2:MRE): RE == (((transpose v1)* v2)::MRE)(1,1)
+
+                 ----  normalization of a vector  ----
+     normalise(v:MRE) : MRE ==
+       normv:RE := sqrt(innerprod(v,v))
+       normv = 0$RE => v
+       (1/normv)*v
+
+                ----  Eigenvalues of the matrix A  ----
+     radicalEigenvalues(A:M): List(RE) ==
+       x:SE :=new()$SE
+       pol:= characteristicPolynomial(A,x) :: F
+       radicalRoots(pol,x)$RSP
+
+      ----  Eigenvectors belonging to a given eigenvalue  ----
+            ----  expressed in terms of radicals ----
+     radicalEigenvector(alpha:RE,A:M) : List(MRE) ==
+       n:=nrows A
+       B:MRE := zero(n,n)$MRE
+       for i in 1..n repeat
+         for j in 1..n repeat B(i,j):=(A(i,j))::RE
+         B(i,i):= B(i,i) - alpha
+       [v::MRE  for v in nullSpace B]
+
+             ----  eigenvectors and eigenvalues  ----
+     radicalEigenvectors(A:M) : List(RadicalForm) ==
+       leig:List EigenForm := eigenvectors A
+       n:=nrows A
+       sln:List RadicalForm := empty()
+       veclist: List MRE
+       for eig in leig repeat
+         eig.eigval case F =>
+           veclist := empty()
+           for ll in eig.eigvec repeat
+             m:MRE:=zero(n,1)
+             for i in 1..n repeat m(i,1):=(ll(i,1))::RE
+             veclist:=cons(m,veclist)
+           sln:=cons([(eig.eigval)::F::RE,eig.eigmult,veclist]$RadicalForm,sln)
+         sym := eig.eigval :: ST
+         xx:= lhs sym
+         lval : List RE := radicalRoots((rhs sym) :: F ,xx)$RSP
+         for alg in lval repeat
+           nsl:=[alg,eig.eigmult,
+                 [evalvect(ep,alg,xx) for ep in eig.eigvec]]$RadicalForm
+           sln:=cons(nsl,sln)
+       sln
+
+            ----  orthonormalization of a list of vectors  ----
+                  ----  Grahm - Schmidt process  ----
+
+     gramschmidt(lvect:List(MRE)) : List(MRE) ==
+       lvect=[]  => []
+       v:=lvect.first
+       n := nrows v
+       RMR:=RectangularMatrix(n:PI,1,RE)
+       orth:List(MRE):=[(normalise v)]
+       for v in lvect.rest repeat
+         pol:=((v:RMR)-(+/[(innerprod(w,v)*w):RMR for w in orth])):MRE
+         orth:=cons(normalise pol,orth)
+       orth
+
+
+              ----  The matrix of eigenvectors  ----
+
+     eigenMatrix(A:M) : Union(MRE,"failed") ==
+       lef:List(MRE):=[:eiv.radvect  for eiv in radicalEigenvectors(A)]
+       n:=nrows A
+       #lef <n => "failed"
+       d:MRE:=copy(lef.first)
+       for v in lef.rest repeat d:=(horizConcat(d,v))::MRE
+       d
+
+         ----  orthogonal basis for a symmetric matrix  ----
+
+     orthonormalBasis(A:M):List(MRE) ==
+       ^symmetric?(A) => error "the matrix is not symmetric"
+       basis:List(MRE):=[]
+       lvec:List(MRE) := []
+       alglist:List(RadicalForm):=radicalEigenvectors(A)
+       n:=nrows A
+       for alterm in alglist repeat
+         if (lvec:=alterm.radvect)=[] then error "sorry "
+         if #(lvec)>1  then
+           lvec:= gramschmidt(lvec)
+           basis:=[:lvec,:basis]
+         else basis:=[normalise(lvec.first),:basis]
+       basis
+
 *)
 
 \end{chunk}
@@ -171117,6 +213224,7 @@ RadicalSolvePackage(R): Cat == Capsule where
           ++X contractSolve(b,x)
 
     Capsule ==> add
+
         import DegreeReductionPackage(PR, R)
         import SOLVEFOR
 
@@ -171146,10 +213254,15 @@ RadicalSolvePackage(R): Cat == Capsule where
             S
 
         linear u    == [(-coefficient(u,0))::RE /(coefficient(u,1))::RE]
+
         quadratic u == quadratic(map(coerce,u)$UPF2)$SOLVEFOR
+
         cubic u     == cubic(map(coerce,u)$UPF2)$SOLVEFOR
+
         quartic u   == quartic(map(coerce,u)$UPF2)$SOLVEFOR
+
         rad n       == n::Z::RE
+
         wrap s      == (ContractSoln => New s; s)
 
 
@@ -171302,6 +213415,192 @@ RadicalSolvePackage(R): Cat == Capsule where
 \begin{chunk}{COQ SOLVERAD}
 (* package SOLVERAD *)
 (*
+
+        import DegreeReductionPackage(PR, R)
+        import SOLVEFOR
+
+        SideEquations: List EQ RE := []
+        ContractSoln:  B := false
+
+        ---- Local Function Declarations ----
+        solveInner:(PR, SY, B) -> SU
+        linear:    UP -> List RE
+        quadratic: UP -> List RE
+        cubic:     UP -> List RE
+        quartic:   UP -> List RE
+        rad:       PI -> RE
+        wrap:      RE -> RE
+        New:       RE -> RE
+        makeEq : (List RE,L SY) -> L EQ RE
+        select :    L L RE      -> L L RE
+        isGeneric? :  (L PR,L SY)  ->  Boolean
+        findGenZeros :  (L PR,L SY) -> L L RE
+        findZeros   :   (L PR,L SY) -> L L RE
+
+
+        New s ==
+            s = 0 => 0
+            S := new()$Symbol ::PR::RF::RE
+            SideEquations := append([S = s], SideEquations)
+            S
+
+        linear u    == [(-coefficient(u,0))::RE /(coefficient(u,1))::RE]
+
+        quadratic u == quadratic(map(coerce,u)$UPF2)$SOLVEFOR
+
+        cubic u     == cubic(map(coerce,u)$UPF2)$SOLVEFOR
+
+        quartic u   == quartic(map(coerce,u)$UPF2)$SOLVEFOR
+
+        rad n       == n::Z::RE
+
+        wrap s      == (ContractSoln => New s; s)
+
+
+        ---- Exported Functions ----
+
+
+       -- find the zeros of components in "generic" position --
+        findGenZeros(rlp:L PR,rlv:L SY) : L L RE ==
+         pp:=rlp.first
+         v:=first rlv
+         rlv:=rest rlv
+         res:L L RE:=[]
+         res:=append([reverse cons(r,[eval(
+           (-coefficient(univariate(p,vv),0)::RE)/
+            (leadingCoefficient univariate(p,vv))::RE,
+              kernel(v)@Kernel(RE),r) for vv in rlv for p in rlp.rest])
+                for r in radicalRoots(pp::RF,v)],res)
+         res
+
+
+        findZeros(rlp:L PR,rlv:L SY) : L L RE ==
+         parRes:=[radicalRoots(p::RF,v) for p in rlp for v in rlv]
+         parRes:=select parRes
+         res:L L RE :=[]
+         res1:L RE
+         for par in parRes repeat
+           res1:=[par.first]
+           lv1:L Kernel(RE):=[kernel rlv.first]
+           rlv1:=rlv.rest
+           p1:=par.rest
+           while p1^=[] repeat
+             res1:=cons(eval(p1.first,lv1,res1),res1)
+             p1:=p1.rest
+             lv1:=cons(kernel rlv1.first,lv1)
+             rlv1:=rlv1.rest
+           res:=cons(res1,res)
+         res
+
+        radicalSolve(pol:RF,v:SY) ==
+          [equation(v::RE,r) for r in radicalRoots(pol,v)]
+
+        radicalSolve(p:RF) ==
+          zero? p =>
+             error "equation is always satisfied"
+          lv:=removeDuplicates
+             concat(variables numer p, variables denom p)
+          empty? lv => error "inconsistent equation"
+          #lv>1 => error "too many variables"
+          radicalSolve(p,lv.first)
+
+        radicalSolve(eq: EQ RF) ==
+          radicalSolve(lhs eq -rhs eq)
+
+        radicalSolve(eq: EQ RF,v:SY) ==
+           radicalSolve(lhs eq - rhs eq,v)
+
+        radicalRoots(lp: L RF,lv: L SY) ==
+          parRes:=triangularSystems(lp,lv)$SystemSolvePackage(R)
+          parRes= list [] => []
+           -- select the components in "generic" form
+          rlv:=reverse lv
+          rpRes:=[reverse res for res in parRes]
+          listGen:= [res for res in rpRes|isGeneric?(res,rlv)]
+          result:L L RE:=[]
+          if listGen^=[] then
+            result:="append"/[findGenZeros(res,rlv) for res in listGen]
+            for res in listGen repeat
+                rpRes:=delete(rpRes,position(res,rpRes))
+           --  non-generic components
+          rpRes = [] => result
+          append("append"/[findZeros(res,rlv) for res in rpRes],
+                         result)
+
+        radicalSolve(lp:L RF,lv:L SY) ==
+          [makeEq(lres,lv) for lres in radicalRoots(lp,lv)]
+
+        radicalSolve(lp: L RF) ==
+          lv:="setUnion"/[setUnion(variables numer p,variables denom p)
+                          for p in lp]
+          [makeEq(lres,lv) for lres in radicalRoots(lp,lv)]
+
+        radicalSolve(le:L EQ RF,lv:L SY) ==
+          lp:=[rhs p -lhs p for p in le]
+          [makeEq(lres,lv) for lres in radicalRoots(lp,lv)]
+
+        radicalSolve(le: L EQ RF) ==
+          lp:=[rhs p -lhs p for p in le]
+          lv:="setUnion"/[setUnion(variables numer p,variables denom p)
+                          for p in lp]
+          [makeEq(lres,lv) for lres in radicalRoots(lp,lv)]
+
+        contractSolve(eq:EQ RF, v:SY)==
+           solveInner(numer(lhs eq - rhs eq), v, true)
+
+        contractSolve(pq:RF, v:SY) == solveInner(numer pq, v, true)
+
+        radicalRoots(pq:RF, v:SY) == lhs solveInner(numer pq, v, false)
+
+
+       -- test if the ideal is radical in generic position --
+        isGeneric?(rlp:L PR,rlv:L SY) : Boolean ==
+          "and"/[degree(f,x)=1 for f in rest rlp  for x in rest rlv]
+
+        ---- select  the univariate factors
+        select(lp:L L RE) : L L RE ==
+          lp=[] => list []
+          [:[cons(f,lsel) for lsel in select lp.rest] for f in lp.first]
+
+        ---- Local Functions ----
+       -- construct the equation
+        makeEq(nres:L RE,lv:L SY) : L EQ RE ==
+          [equation(x :: RE,r) for x in lv for r in nres]
+
+        solveInner(pq:PR,v:SY,contractFlag:B) ==
+            SideEquations := []
+            ContractSoln  := contractFlag
+
+            factors:= factors
+               (factor pq)$MultivariateFactorize(SY,IndexedExponents SY,R,PR)
+
+            constants:  List PR     := []
+            unsolved:   List PR     := []
+            solutions:  List RE     := []
+
+            for f in factors repeat
+                ff:=f.factor
+                ^ member?(v, variables (ff)) =>
+                    constants := cons(ff, constants)
+                u := univariate(ff, v)
+                t := reduce u
+                u := t.pol
+                n := degree u
+                l: List RE :=
+                    n = 1 => linear u
+                    n = 2 => quadratic u
+                    n = 3 => cubic u
+                    n = 4 => quartic u
+                    unsolved := cons(ff, unsolved)
+                    []
+                for s in l repeat
+                    if t.deg > 1 then s := wrap s
+                    T0 := expand(s, t.deg)
+                    for i in 1..f.exponent repeat
+                        solutions := append(T0, solutions)
+                    re := SideEquations
+            [solutions, SideEquations]$SU
+
 *)
 
 \end{chunk}
@@ -171368,6 +213667,7 @@ RadixUtilities: Exports == Implementation where
     radix: (Fraction Integer,Integer) -> Any
       ++ radix(x,b) converts x to a radix expansion in base b.
   Implementation ==> add
+
     radix(q, b) ==
       coerce(q :: RadixExpansion(b))$AnyFunctions1(RadixExpansion b)
 
@@ -171376,6 +213676,10 @@ RadixUtilities: Exports == Implementation where
 \begin{chunk}{COQ RADUTIL}
 (* package RADUTIL *)
 (*
+
+    radix(q, b) ==
+      coerce(q :: RadixExpansion(b))$AnyFunctions1(RadixExpansion b)
+
 *)
 
 \end{chunk}
@@ -171450,6 +213754,7 @@ RandomDistributions(S: SetCategory): with
         rdHack1:  (Vector S,Vector Integer,Integer)->(()->S)
           ++ rdHack1(v,u,n) \undocumented
     == add
+
         import RandomNumberSource()
 
         weighted lvw ==
@@ -171491,6 +213796,43 @@ RandomDistributions(S: SetCategory): with
 \begin{chunk}{COQ RDIST}
 (* package RDIST *)
 (*
+
+        import RandomNumberSource()
+
+        weighted lvw ==
+            -- Collapse duplicates, adding weights.
+            t: Table(S, Integer) := table()
+            for r in lvw repeat
+                u := search(r.value,t)
+                w := (u case "failed" => 0; u::Integer)
+                t r.value := w + r.weight
+
+            -- Construct vectors of values and cumulative weights.
+            kl := keys t
+            n  := (#kl)::NonNegativeInteger
+            n = 0 => error "Cannot select from empty set"
+            kv: Vector(S)       := new(n, kl.0)
+            wv: Vector(Integer) := new(n, 0)
+
+            totwt: Integer := 0
+            for k in kl for i in 1..n repeat
+                kv.i := k
+                totwt:= totwt + t k
+                wv.i := totwt
+
+            -- Function to generate an integer and lookup.
+            rdHack1(kv, wv, totwt)
+
+        rdHack1(kv, wv, totwt) ==
+            w := randnum totwt
+            -- do binary search in wv
+            kv.1
+
+        uniform fset ==
+            l := members fset
+            n := #l
+            l.(randnum(n)+1)
+
 *)
 
 \end{chunk}
@@ -171600,14 +213942,15 @@ RandomFloatDistributions(): Cat == Body where
 
 
     Body ==> add
+
         import RandomNumberSource()
---      FloatPackage0()
 
         -- random()  generates numbers in 0..rnmax
         rnmax := (size()$RandomNumberSource() - 1)::Float
 
         uniform01() ==
             randnum()::Float/rnmax
+
         uniform(a,b) ==
             a + uniform01()*(b-a)
 
@@ -171661,6 +214004,63 @@ RandomFloatDistributions(): Cat == Body where
 \begin{chunk}{COQ RFDIST}
 (* package RFDIST *)
 (*
+
+        import RandomNumberSource()
+
+        -- random()  generates numbers in 0..rnmax
+        rnmax := (size()$RandomNumberSource() - 1)::Float
+
+        uniform01() ==
+            randnum()::Float/rnmax
+
+        uniform(a,b) ==
+            a + uniform01()*(b-a)
+
+        exponential1() ==
+            u: Float := 0
+            -- This test should really be  u < m where m is
+            -- the minumum acceptible argument to log.
+            while u = 0 repeat u := uniform01()
+            - log u
+        exponential(mean) ==
+            mean*exponential1()
+
+        -- This method is correct but slow.
+        normal01() ==
+            s := 2::Float
+            while s >= 1 repeat
+                v1 := 2 * uniform01() - 1
+                v2 := 2 * uniform01() - 1
+                s  := v1**2 + v2**2
+            v1 * sqrt(-2 * log s/s)
+        normal(mean, stdev) ==
+            mean + stdev*normal01()
+
+        chiSquare1 dgfree ==
+            x: Float := 0
+            for i in 1..dgfree quo 2 repeat
+                x := x + 2*exponential1()
+            if odd? dgfree then
+                x := x + normal01()**2
+            x
+        chiSquare dgfree ==
+            chiSquare1 dgfree
+
+        Beta(dgfree1, dgfree2) ==
+            y1 := chiSquare1 dgfree1
+            y2 := chiSquare1 dgfree2
+            y1/(y1 + y2)
+
+        F(dgfree1, dgfree2) ==
+            y1 := chiSquare1 dgfree1
+            y2 := chiSquare1 dgfree2
+            (dgfree2 * y1)/(dgfree1 * y2)
+
+        t dgfree ==
+            n := normal01()
+            d := chiSquare1(dgfree) / (dgfree::Float)
+            n / sqrt d
+
 *)
 
 \end{chunk}
@@ -171749,6 +214149,7 @@ RandomIntegerDistributions(): with
    ridHack1:  (Integer,Integer,Integer,Integer) -> Integer
      ++ ridHack1(i,j,k,l) \undocumented
  == add
+
    import RandomNumberSource()
    import IntegerBits()
 
@@ -171775,6 +214176,28 @@ RandomIntegerDistributions(): with
 \begin{chunk}{COQ RIDIST}
 (* package RIDIST *)
 (*
+
+   import RandomNumberSource()
+   import IntegerBits()
+
+   uniform aTob ==
+       a := lo aTob;  b := hi aTob
+       l := min(a,b); m := abs(a-b) + 1
+
+       w := 2**(bitLength size() quo 2)::NonNegativeInteger
+
+       n  := 0
+       mq := m  -- m quo w**n
+       while (mqnext := mq quo w) > 0 repeat
+           n  := n + 1
+           mq := mqnext
+       ridHack1(mq, n, w, l)
+
+   ridHack1(mq, n, w, l) ==
+       r := randnum mq
+       for i in 1..n repeat r := r*w + randnum w
+       r + l
+
 *)
 
 \end{chunk}
@@ -171867,6 +214290,7 @@ RandomNumberSource(): with
            ++ seed() returns the current seed value.
  
     == add
+
         -- This random number generator passes the spectral test
         -- with flying colours. [Knuth vol2, 2nd ed, p105]
         ranbase: Integer := 2**31-1
@@ -171880,6 +214304,7 @@ RandomNumberSource(): with
             x1:= t
  
         size() == ranbase
+
         reseed n ==
             x0 := n rem ranbase
             -- x1 := (n quo ranbase) rem ranbase
@@ -171896,6 +214321,32 @@ RandomNumberSource(): with
 \begin{chunk}{COQ RANDSRC}
 (* package RANDSRC *)
 (*
+
+        -- This random number generator passes the spectral test
+        -- with flying colours. [Knuth vol2, 2nd ed, p105]
+        ranbase: Integer := 2**31-1
+        x0:   Integer := 1231231231
+        x1:   Integer := 3243232987
+ 
+        randnum() ==
+            t := (271828183 * x1 - 314159269 * x0) rem ranbase
+            if t < 0 then t := t + ranbase
+            x0:= x1
+            x1:= t
+ 
+        size() == ranbase
+
+        reseed n ==
+            x0 := n rem ranbase
+            -- x1 := (n quo ranbase) rem ranbase
+            x1 := n quo ranbase
+
+        seed() == x1*ranbase + x0
+ 
+        -- Compute an integer in 0..n-1.
+        randnum n ==
+            (n * randnum()) quo ranbase
+
 *)
 
 \end{chunk}
@@ -171989,6 +214440,7 @@ RationalFactorize(RP) : public == private where
       ++ polynomial p over the rational numbers.
 
   private  ==> add
+
      import GaloisGroupFactorizer (BP)
      ParFact   ==> Record(irr:BP,pow:I)
      FinalFact ==> Record(contp:I,factors:List(ParFact))
@@ -172022,6 +214474,35 @@ RationalFactorize(RP) : public == private where
 \begin{chunk}{COQ RATFACT}
 (* package RATFACT *)
 (*
+
+     import GaloisGroupFactorizer (BP)
+     ParFact   ==> Record(irr:BP,pow:I)
+     FinalFact ==> Record(contp:I,factors:List(ParFact))
+     URNI      ==> UnivariatePolynomialCategoryFunctions2(RN,RP,I,BP)
+     UIRN      ==> UnivariatePolynomialCategoryFunctions2(I,BP,RN,RP)
+     fUnion    ==> Union("nil", "sqfr", "irred", "prime")
+     FFE       ==> Record(flg:fUnion, fctr:RP, xpnt:I)
+ 
+     factor(p:RP) : Factored(RP) ==
+       p = 0 => 0
+       pden: I := lcm([denom c for c in coefficients p])
+       pol : RP := pden*p
+       ipol: BP := map(numer,pol)$URNI
+       ffact: FinalFact := henselFact(ipol,false)
+       makeFR(((ffact.contp)/pden)::RP,
+         [["prime",map(coerce,u.irr)$UIRN,u.pow]$FFE
+                             for u in ffact.factors])
+ 
+     factorSquareFree(p:RP) : Factored(RP) ==
+       p = 0 => 0
+       pden: I := lcm([denom c for c in coefficients p])
+       pol : RP := pden*p
+       ipol: BP := map(numer,pol)$URNI
+       ffact: FinalFact := henselFact(ipol,true)
+       makeFR(((ffact.contp)/pden)::RP,
+         [["prime",map(coerce,u.irr)$UIRN,u.pow]$FFE
+                             for u in ffact.factors])
+
 *)
 
 \end{chunk}
@@ -172140,16 +214621,24 @@ RationalFunction(R:IntegralDomain): Exports == Implementation where
       ++ coerce(r) returns r viewed as a rational function over R.
 
   Implementation ==> add
+
     foo  : (List V, List Q, V) -> Q
     peval: (P, List V, List Q) -> Q
 
     coerce(r:R):Q            == r::P::Q
+
     variables f              == variables(f)$QF
+
     mainVariable f           == mainVariable(f)$QF
+
     univariate(f, x)         == univariate(f, x)$QF
+
     multivariate(f, x)       == multivariate(f, x)$QF
+
     eval(x:Q, s:V, y:Q)      == eval(x, [s], [y])
+
     eval(x:Q, eq:Equation Q) == eval(x, [eq])
+
     foo(ls, lv, x)           == match(ls, lv, x, x::Q)$ListToMap(V, Q)
 
     eval(x:Q, l:List Equation Q) ==
@@ -172168,6 +214657,37 @@ RationalFunction(R:IntegralDomain): Exports == Implementation where
 \begin{chunk}{COQ RF}
 (* package RF *)
 (*
+
+    foo  : (List V, List Q, V) -> Q
+    peval: (P, List V, List Q) -> Q
+
+    coerce(r:R):Q            == r::P::Q
+
+    variables f              == variables(f)$QF
+
+    mainVariable f           == mainVariable(f)$QF
+
+    univariate(f, x)         == univariate(f, x)$QF
+
+    multivariate(f, x)       == multivariate(f, x)$QF
+
+    eval(x:Q, s:V, y:Q)      == eval(x, [s], [y])
+
+    eval(x:Q, eq:Equation Q) == eval(x, [eq])
+
+    foo(ls, lv, x)           == match(ls, lv, x, x::Q)$ListToMap(V, Q)
+
+    eval(x:Q, l:List Equation Q) ==
+      eval(x, [retract(lhs eq)@V for eq in l]$List(V),
+              [rhs eq for eq in l]$List(Q))
+
+    eval(x:Q, ls:List V, lv:List Q) ==
+      peval(numer x, ls, lv) / peval(denom x, ls, lv)
+
+    peval(p, ls, lv) ==
+      map(z1 +-> foo(ls, lv, z1), z2 +-> z2::Q,p)
+       $PolynomialCategoryLifting(IndexedExponents V,V,R,P,Q)
+
 *)
 
 \end{chunk}
@@ -172276,6 +214796,7 @@ RationalFunctionDefiniteIntegration(R): Exports == Implementation where
       ++ if the last argument is not "noPole".
 
   Implementation ==> add
+
     import DefiniteIntegrationTools(R, FE)
     import IntegrationResultRFToFunction(R)
     import OrderedCompletionFunctions2(RF, FE)
@@ -172321,6 +214842,47 @@ RationalFunctionDefiniteIntegration(R): Exports == Implementation where
 \begin{chunk}{COQ DEFINTRF}
 (* package DEFINTRF *)
 (*
+
+    import DefiniteIntegrationTools(R, FE)
+    import IntegrationResultRFToFunction(R)
+    import OrderedCompletionFunctions2(RF, FE)
+
+    int   : (RF, SE, OFE, OFE, Boolean) -> U
+    nopole: (RF, SE, OFE, OFE) -> U
+
+    integrate(f:RF, s:SegmentBinding OFE) ==
+      int(f, variable s, lo segment s, hi segment s, false)
+
+    nopole(f, x, a, b) ==
+      k := kernel(x)@Kernel(FE)
+      (u := integrate(f, x)) case FE =>
+        (v := computeInt(k, u::FE, a, b, true)) case "failed" => ["failed"]
+        [v::OFE]
+      ans := empty()$List(OFE)
+      for g in u::List(FE) repeat
+        (v := computeInt(k, g, a, b, true)) case "failed" => return ["failed"]
+        ans := concat_!(ans, [v::OFE])
+      [ans]
+
+    integrate(f:RF, s:SegmentBinding ORF) ==
+      int(f, variable s, map(x +-> x::FE, lo segment s),
+                         map(x +-> x::FE, hi segment s), false)
+
+    integrate(f:RF, s:SegmentBinding ORF, str:String) ==
+      int(f, variable s, map(x +-> x::FE, lo segment s),
+                         map(x +-> x::FE, hi segment s), ignore? str)
+
+    integrate(f:RF, s:SegmentBinding OFE, str:String) ==
+      int(f, variable s, lo segment s, hi segment s, ignore? str)
+
+    int(f, x, a, b, ignor?) ==
+      a = b => [0::OFE]
+      (z := checkForZero(denom f, x, a, b, true)) case "failed" =>
+        ignor? => nopole(f, x, a, b)
+        ["potentialPole"]
+      z::Boolean => error "integrate: pole in path of integration"
+      nopole(f, x, a, b)
+
 *)
 
 \end{chunk}
@@ -172395,6 +214957,7 @@ RationalFunctionFactor(UP): Exports == Implementation where
       ++ factor(p) returns a prime factorisation of p.
  
   Implementation ==> add
+
     likuniv: (P, SE, P) -> UP
  
     dummy := new()$SE
@@ -172414,6 +214977,21 @@ RationalFunctionFactor(UP): Exports == Implementation where
 \begin{chunk}{COQ RFFACT}
 (* package RFFACT *)
 (*
+
+    likuniv: (P, SE, P) -> UP
+ 
+    dummy := new()$SE
+ 
+    likuniv(p, x, d) ==
+      map(y +-> y/d, univariate(p, x))$UPCF2(P,SparseUnivariatePolynomial P,
+                                          RF, UP)
+ 
+    factor p ==
+      d  := denom(q := elt(p,dummy::P :: RF))
+      map(x +-> likuniv(x,dummy,d),
+          factor(numer q)$MultivariateFactorize(SE,
+               IndexedExponents SE,Integer,P))$FactoredFunctions2(P, UP)
+
 *)
 
 \end{chunk}
@@ -172513,6 +215091,22 @@ RationalFunctionFactorizer(R) : C == T
 \begin{chunk}{COQ RFFACTOR}
 (* package RFFACTOR *)
 (*
+
+     factorFraction(p:FP) : Fraction Factored(P) ==
+       R is Fraction Integer =>
+         MR:=MRationalFactorize(IndexedExponents SE,SE,
+                                Integer,P)
+         (factor(numer p)$MR)/ (factor(denom p)$MR)
+
+       R has FiniteFieldCategory =>
+         FF:=MultFiniteFactorize(SE,IndexedExponents SE,R,P)
+         (factor(numer p))$FF/(factor(denom p))$FF
+
+       R has CharacteristicZero =>
+          MFF:=MultivariateFactorize(SE,IndexedExponents SE,R,P)
+          (factor(numer p))$MFF/(factor(denom p))$MFF
+       error "case not handled"
+
 *)
 
 \end{chunk}
@@ -172613,6 +215207,7 @@ RationalFunctionIntegration(F): Exports == Implementation where
        ++ "failed" otherwise.
 
   Implementation ==> add
+
     import RationalIntegration(Q, UP)
     import IntegrationResultFunctions2(QF, Q)
     import PolynomialCategoryQuotientFunctions(IndexedExponents SE,
@@ -172637,6 +215232,26 @@ RationalFunctionIntegration(F): Exports == Implementation where
 \begin{chunk}{COQ INTRF}
 (* package INTRF *)
 (*
+
+    import RationalIntegration(Q, UP)
+    import IntegrationResultFunctions2(QF, Q)
+    import PolynomialCategoryQuotientFunctions(IndexedExponents SE,
+                                                       SE, F, P, Q)
+
+    infieldIntegrate(f, x) ==
+      map(x1 +-> multivariate(x1, x), infieldint univariate(f, x))
+
+    internalIntegrate(f, x) ==
+      map(x1 +-> multivariate(x1, x), integrate univariate(f, x))
+
+    extendedIntegrate(f, x, g) ==
+      map(x1 +-> multivariate(x1, x),
+          extendedint(univariate(f, x), univariate(g, x)))
+
+    limitedIntegrate(f, x, lu) ==
+      map(x1 +-> multivariate(x1, x),
+          limitedint(univariate(f, x), [univariate(u, x) for u in lu]))
+
 *)
 
 \end{chunk}
@@ -172749,6 +215364,7 @@ RationalFunctionLimitPackage(R:GcdDomain):Exports==Implementation where
       ++ approaches \spad{a} from the right.
  
   Implementation ==> add
+
     import ToolsForSign R
     import InnerPolySign(RF, UP)
     import RFSGN
@@ -172759,7 +215375,7 @@ RationalFunctionLimitPackage(R:GcdDomain):Exports==Implementation where
     finiteLimit       : (QF, RF) -> U
     fLimit            : (Z, UP, RF, Z) -> Result
  
--- These 2 should be exported, see comment above
+    -- These 2 should be exported, see comment above
     locallimit       : (RF, SE, ORF) -> U
     locallimitcomplex: (RF, SE, OPF) -> OPF
  
@@ -172849,6 +215465,102 @@ RationalFunctionLimitPackage(R:GcdDomain):Exports==Implementation where
 \begin{chunk}{COQ LIMITRF}
 (* package LIMITRF *)
 (*
+
+    import ToolsForSign R
+    import InnerPolySign(RF, UP)
+    import RFSGN
+    import PolynomialCategoryQuotientFunctions(IndexedExponents SE,
+                                                      SE, R, P, RF)
+ 
+    finiteComplexLimit: (QF, RF) -> OPF
+    finiteLimit       : (QF, RF) -> U
+    fLimit            : (Z, UP, RF, Z) -> Result
+ 
+    -- These 2 should be exported, see comment above
+    locallimit       : (RF, SE, ORF) -> U
+    locallimitcomplex: (RF, SE, OPF) -> OPF
+ 
+    limit(f:RF,eq:EQ RF) ==
+      (xx := retractIfCan(lhs eq)@Union(SE,"failed")) case "failed" =>
+        error "limit: left hand side must be a variable"
+      x := xx :: SE; a := rhs eq
+      locallimit(f,x,a::ORF)
+ 
+    complexLimit(f:RF,eq:EQ RF) ==
+      (xx := retractIfCan(lhs eq)@Union(SE,"failed")) case "failed" =>
+        error "limit: left hand side must be a variable"
+      x := xx :: SE; a := rhs eq
+      locallimitcomplex(f,x,a::OPF)
+ 
+    limit(f:RF,eq:EQ OrderedCompletion P) ==
+      (p := retractIfCan(lhs eq)@Union(P,"failed")) case "failed" =>
+        error "limit: left hand side must be a variable"
+      (xx := retractIfCan(p)@Union(SE,"failed")) case "failed" =>
+        error "limit: left hand side must be a variable"
+      x := xx :: SE
+      a := map(y +-> y::RF,rhs eq)$OrderedCompletionFunctions2(P,RF)
+      locallimit(f,x,a)
+ 
+    complexLimit(f:RF,eq:EQ OnePointCompletion P) ==
+      (p := retractIfCan(lhs eq)@Union(P,"failed")) case "failed" =>
+        error "limit: left hand side must be a variable"
+      (xx := retractIfCan(p)@Union(SE,"failed")) case "failed" =>
+        error "limit: left hand side must be a variable"
+      x := xx :: SE
+      a := map(y +-> y::RF,rhs eq)$OnePointCompletionFunctions2(P,RF)
+      locallimitcomplex(f,x,a)
+ 
+    fLimit(n, d, a, dir) ==
+      (s := signAround(d, a, dir, sign$RFSGN)) case "failed" => "failed"
+      n * (s::Z) * plusInfinity()
+ 
+    finiteComplexLimit(f, a) ==
+      zero?(n := (numer f) a) => 0
+      zero?(d := (denom f) a) => infinity()
+      (n / d)::OPF
+ 
+    finiteLimit(f, a) ==
+      zero?(n := (numer f) a) => 0
+      zero?(d := (denom f) a) =>
+        (s := sign(n)$RFSGN) case "failed" => "failed"
+        rhsl := fLimit(s::Z, denom f, a, 1)
+        lhsl := fLimit(s::Z, denom f, a, -1)
+        rhsl case "failed" =>
+          lhsl case "failed" => "failed"
+          [lhsl, rhsl]
+        lhsl case "failed" => [lhsl, rhsl]
+        rhsl::ORF = lhsl::ORF => lhsl::ORF
+        [lhsl, rhsl]
+      (n / d)::ORF
+ 
+    locallimit(f,x,a) ==
+      g := univariate(f, x)
+      zero?(n := whatInfinity a) => finiteLimit(g, retract a)
+      (dn := degree numer g) > (dd := degree denom g) =>
+        (sn := signAround(numer g, n, sign$RFSGN)) case "failed" => "failed"
+        (sd := signAround(denom g, n, sign$RFSGN)) case "failed" => "failed"
+        (sn::Z) * (sd::Z) * plusInfinity()
+      dn < dd => 0
+      ((leadingCoefficient numer g) / (leadingCoefficient denom g))::ORF
+ 
+    limit(f,eq,st) ==
+      (xx := retractIfCan(lhs eq)@Union(SE,"failed")) case "failed" =>
+        error "limit: left hand side must be a variable"
+      x := xx :: SE; a := rhs eq
+      zero?(n := (numer(g := univariate(f, x))) a) => 0
+      zero?(d := (denom g) a) =>
+        (s := sign(n)$RFSGN) case "failed" => "failed"
+        fLimit(s::Z, denom g, a, direction st)
+      (n / d)::ORF
+ 
+    locallimitcomplex(f,x,a) ==
+      g := univariate(f, x)
+      (r := retractIfCan(a)@Union(RF, "failed")) case RF =>
+        finiteComplexLimit(g, r::RF)
+      (dn := degree numer g) > (dd := degree denom g) => infinity()
+      dn < dd => 0
+      ((leadingCoefficient numer g) / (leadingCoefficient denom g))::OPF
+
 *)
 
 \end{chunk}
@@ -172933,6 +215645,7 @@ RationalFunctionSign(R:GcdDomain): Exports == Implementation where
       ++ or from the right (above) if s is the string \spad{"right"}.
  
   Implementation ==> add
+
     import SGN
     import InnerPolySign(RF, UP)
     import PolynomialCategoryQuotientFunctions(IndexedExponents SE,
@@ -172997,6 +215710,66 @@ RationalFunctionSign(R:GcdDomain): Exports == Implementation where
 \begin{chunk}{COQ SIGNRF}
 (* package SIGNRF *)
 (*
+
+    import SGN
+    import InnerPolySign(RF, UP)
+    import PolynomialCategoryQuotientFunctions(IndexedExponents SE,
+                                                      SE, R, P, RF)
+ 
+    psign     : P -> U
+    sqfrSign  : P -> U
+    termSign  : P -> U
+    listSign  : (List P, Integer) -> U
+    finiteSign: (Fraction UP, RF) -> U
+ 
+    sign f ==
+      (un := psign numer f) case "failed" => "failed"
+      (ud := psign denom f) case "failed" => "failed"
+      (un::Integer) * (ud::Integer)
+ 
+    finiteSign(g, a) ==
+      (ud := signAround(denom g, a, sign$%)) case "failed" => "failed"
+      (un := signAround(numer g, a, sign$%)) case "failed" => "failed"
+      (un::Integer) * (ud::Integer)
+ 
+    sign(f, x, a) ==
+      g := univariate(f, x)
+      zero?(n := whatInfinity a) => finiteSign(g, retract a)
+      (ud := signAround(denom g, n, sign$%)) case "failed" => "failed"
+      (un := signAround(numer g, n, sign$%)) case "failed" => "failed"
+      (un::Integer) * (ud::Integer)
+ 
+    sign(f, x, a, st) ==
+      (ud := signAround(denom(g := univariate(f, x)), a,
+                    d := direction st, sign$%)) case "failed" => "failed"
+      (un := signAround(numer g, a, d, sign$%)) case "failed" => "failed"
+      (un::Integer) * (ud::Integer)
+ 
+    psign p ==
+      (r := retractIfCan(p)@Union(R, "failed")) case R => sign(r::R)$SGN
+      (u := sign(retract(unit(s := squareFree p))@R)$SGN) case "failed" =>
+        "failed"
+      ans := u::Integer
+      for term in factors s | odd?(term.exponent) repeat
+        (u := sqfrSign(term.factor)) case "failed" => return "failed"
+        ans := ans * (u::Integer)
+      ans
+ 
+    sqfrSign p ==
+      (u := termSign first(l := monomials p)) case "failed" => "failed"
+      listSign(rest l, u::Integer)
+ 
+    listSign(l, s) ==
+      for term in l repeat
+        (u := termSign term) case "failed" => return "failed"
+        u::Integer ^= s => return "failed"
+      s
+ 
+    termSign term ==
+      for var in variables term repeat
+        odd? degree(term, var) => return "failed"
+      sign(leadingCoefficient term)$SGN
+
 *)
 
 \end{chunk}
@@ -173326,6 +216099,7 @@ RationalFunctionSum(R): Exports == Impl where
       ++X sum(i::Fraction(Polynomial(Integer)),i=1..n)
 
   Impl ==> add
+
     import RationalFunction R
     import GosperSummationMethod(IndexedExponents SE, SE, R, P, RF)
 
@@ -173364,6 +216138,40 @@ RationalFunctionSum(R): Exports == Impl where
 \begin{chunk}{COQ SUMRF}
 (* package SUMRF *)
 (*
+
+    import RationalFunction R
+    import GosperSummationMethod(IndexedExponents SE, SE, R, P, RF)
+
+    innersum    : (RF, SE) -> Union(RF, "failed")
+    innerpolysum: (P, SE) -> RF
+
+    sum(f:RF, s:SegmentBinding RF) ==
+      (indef := innersum(f, v := variable s)) case "failed" =>
+        summation(f::FE,map((z:RF):FE +->z::FE,s)
+          $SegmentBindingFunctions2(RF,FE))
+      eval(indef::RF, v, 1 + hi segment s)
+        - eval(indef::RF, v,lo segment s)
+
+    sum(an:RF, n:SE) ==
+      (u := innersum(an, n)) case "failed" => summation(an::FE, n)
+      u::RF
+
+    sum(p:P, s:SegmentBinding P) ==
+      f := sum(p, v := variable s)
+      eval(f, v, (1 + hi segment s)::RF) - eval(f,v,lo(segment s)::RF)
+
+    innersum(an, n) ==
+      (r := retractIfCan(an)@Union(P, "failed")) case "failed" =>
+         an1 := eval(an, n, -1 + n::RF)
+         (u := GospersMethod(an/an1, n, new$SE)) case "failed" =>
+           "failed"
+         an1 * eval(u::RF, n, -1 + n::RF)
+      sum(r::P, n)
+
+    sum(p:P, n:SE) ==
+      rec := sum(p, n)$InnerPolySum(IndexedExponents SE, SE, R, P)
+      rec.num / (rec.den :: P)
+
 *)
 
 \end{chunk}
@@ -173463,6 +216271,7 @@ RationalIntegration(F, UP): Exports == Implementation where
        ++ \spad{(h+sum(ci log(gi)))' = f}, if possible, "failed" otherwise.
 
   Implementation ==> add
+
     import TranscendentalIntegration(F, UP)
 
     infieldint f ==
@@ -173493,6 +216302,32 @@ RationalIntegration(F, UP): Exports == Implementation where
 \begin{chunk}{COQ INTRAT}
 (* package INTRAT *)
 (*
+
+    import TranscendentalIntegration(F, UP)
+
+    infieldint f ==
+      rec := baseRDE(0, f)$TranscendentalRischDE(F, UP)
+      rec.nosol => "failed"
+      rec.ans
+
+    integrate f ==
+      rec := monomialIntegrate(f, differentiate)
+      integrate(rec.polypart)::RF::IR + rec.ir
+
+    limitedint(f, lu) ==
+      quorem := divide(numer f, denom f)
+      (u := primlimintfrac(quorem.remainder / (denom f), differentiate,
+        lu)) case "failed" => "failed"
+      [u.mainpart + integrate(quorem.quotient)::RF, u.limitedlogs]
+
+    extendedint(f, g) ==
+      fqr := divide(numer f, denom f)
+      gqr := divide(numer g, denom g)
+      (i1 := primextintfrac(fqr.remainder / (denom f), differentiate,
+                   gqr.remainder / (denom g))) case "failed" => "failed"
+      i2:=integrate(fqr.quotient-retract(i1.coeff)@UP *gqr.quotient)::RF
+      [i2 + i1.ratpart, i1.coeff]
+
 *)
 
 \end{chunk}
@@ -173671,6 +216506,29 @@ Finally, we generate the rational function:
 \begin{chunk}{COQ RINTERP}
 (* package RINTERP *)
 (*
+        interpolate(xlist, ylist, m, k) ==
+            #xlist ^= #ylist =>
+                error "Different number of points and values."
+            #xlist ^= m+k+1 =>
+                error "wrong number of points"
+            tempvec: List F := [1 for i in 1..(m+k+1)]
+
+            collist: List List F := cons(tempvec, 
+                                         [(tempvec := [tempvec.i * xlist.i _
+                                                       for i in 1..(m+k+1)]) _
+                                          for j in 1..max(m,k)])
+
+            collist := append([collist.j for j in 1..(m+1)], _
+                              [[- collist.j.i * ylist.i for i in 1..(m+k+1)] _
+                               for j in 1..(k+1)])
+            res: List Vector F := nullSpace((transpose matrix collist) _
+                                            ::Matrix F)
+            if #res~=1 then output("Warning: unattainable points!" _
+                                   ::OutputForm)$OutputPackage
+            reslist: List List Polynomial F := _
+                      [[(res.1).(i+1)*(xx::Polynomial F)**i for i in 0..m], _
+                      [(res.1).(i+m+2)*(xx::Polynomial F)**i for i in 0..k]] 
+            reduce((_+),reslist.1)/reduce((_+),reslist.2)
 *)
 
 \end{chunk}
@@ -173787,6 +216645,7 @@ RationalLODE(F, UP): Exports == Implementation where
       ++ \spad{op} at infinity.
 
   Implementation ==> add
+
     import BoundIntegerRoots(F, UP)
     import RationalIntegration(F, UP)
     import PrimitiveRatDE(F, UP, LODO2, LODO)
@@ -173811,6 +216670,7 @@ RationalLODE(F, UP): Exports == Implementation where
     dummy := new()$Symbol
 
     infOrder f == (degree denom f) - (degree numer f)
+
     evenodd n  == (even? n => 1; -1)
 
     ratDsolve1(op, lg) ==
@@ -173904,7 +216764,7 @@ RationalLODE(F, UP): Exports == Implementation where
         not zero? qelt(v, i) => return true
       false
 
--- returns z(z+1)...(z+(n-1))
+    -- returns z(z+1)...(z+(n-1))
     UPfact n ==
       zero? n => 1
       z := monomial(1, 1)$UP
@@ -173968,6 +216828,184 @@ RationalLODE(F, UP): Exports == Implementation where
 \begin{chunk}{COQ ODERAT}
 (* package ODERAT *)
 (*
+
+    import BoundIntegerRoots(F, UP)
+    import RationalIntegration(F, UP)
+    import PrimitiveRatDE(F, UP, LODO2, LODO)
+    import LinearSystemMatrixPackage(F, V, V, M)
+    import InnerCommonDenominator(UP, RF, List UP, List RF)
+
+    nzero?             : V -> Boolean
+    evenodd            : N -> F
+    UPfact             : N -> UP
+    infOrder           : RF -> Z
+    infTau             : (UP, N) -> F
+    infBound           : (LODO2, List RF) -> N
+    regularPoint       : (LODO2, List RF) -> Z
+    infIndicialEquation: (List N, List UP) -> UP
+    makeDot            : (Vector F, List RF) -> RF
+    unitlist           : (N, N) -> List F
+    infMuLambda: LODO2 -> Record(mu:Z, lambda:List N, func:List UP)
+    ratDsolve0: (LODO2, RF) -> Record(particular: U, basis: List RF)
+    ratDsolve1: (LODO2, List RF) -> Record(basis:List RF, mat:Matrix F)
+    candidates: (LODO2,List RF,UP) -> Record(basis:List RF,particular:List RF)
+
+    dummy := new()$Symbol
+
+    infOrder f == (degree denom f) - (degree numer f)
+
+    evenodd n  == (even? n => 1; -1)
+
+    ratDsolve1(op, lg) ==
+      d := denomLODE(op, lg)
+      rec := candidates(op, lg, d)
+      l := concat([op q for q in rec.basis],
+                  [op(rec.particular.i) - lg.i for i in 1..#(rec.particular)])
+      sys1 := reducedSystem(matrix [l])@Matrix(UP)
+      [rec.basis, reducedSystem sys1]
+
+    ratDsolve0(op, g) ==
+      zero? degree op => [inv(leadingCoefficient(op)::RF) * g, empty()]
+      minimumDegree op > 0 =>
+        sol := ratDsolve0(monicRightDivide(op, monomial(1, 1)).quotient, g)
+        b:List(RF) := [1]
+        for f in sol.basis repeat
+          if (uu := infieldint f) case RF then b := concat(uu::RF, b)
+        sol.particular case "failed" => ["failed", b]
+        [infieldint(sol.particular::RF), b]
+      (u := denomLODE(op, g)) case "failed" => ["failed", empty()]
+      rec := candidates(op, [g], u::UP)
+      l := lb := lsol := empty()$List(RF)
+      for q in rec.basis repeat
+          if zero?(opq := op q) then lsol := concat(q, lsol)
+          else (l := concat(opq, l); lb := concat(q, lb))
+      h:RF := (zero? g => 0; first(rec.particular))
+      empty? l =>
+          zero? g => [0, lsol]
+          [(g = op h => h; "failed"), lsol]
+      m:M
+      v:V
+      if zero? g then
+          m := reducedSystem(reducedSystem(matrix [l])@Matrix(UP))@M
+          v := new(ncols m, 0)$V
+      else
+          sys1 := reducedSystem(matrix [l], vector [g - op h]
+                               )@Record(mat: Matrix UP, vec: Vector UP)
+          sys2 := reducedSystem(sys1.mat, sys1.vec)@Record(mat:M, vec:V)
+          m := sys2.mat
+          v := sys2.vec
+      sol := solve(m, v)
+      part:U :=
+        zero? g => 0
+        sol.particular case "failed" => "failed"
+        makeDot(sol.particular::V, lb) + first(rec.particular)
+      [part,
+       concat_!(lsol, [makeDot(v, lb) for v in sol.basis | nzero? v])]
+
+    indicialEquationAtInfinity(op:LODO2) ==
+      rec := infMuLambda op
+      infIndicialEquation(rec.lambda, rec.func)
+
+    indicialEquationAtInfinity(op:LODO) ==
+      rec := splitDenominator(op, empty())
+      indicialEquationAtInfinity(rec.eq)
+
+    regularPoint(l, lg) ==
+      a := leadingCoefficient(l) * commonDenominator lg
+      coefficient(a, 0) ^= 0 => 0
+      for i in 1.. repeat
+        a(j := i::F) ^= 0 => return i
+        a(-j) ^= 0 => return(-i)
+
+    unitlist(i, q) ==
+      v := new(q, 0)$Vector(F)
+      v.i := 1
+      parts v
+
+    candidates(op, lg, d) ==
+      n := degree d + infBound(op, lg)
+      m := regularPoint(op, lg)
+      uts := UnivariateTaylorSeries(F, dummy, m::F)
+      tools := UTSodetools(F, UP, LODO2, uts)
+      solver := UnivariateTaylorSeriesODESolver(F, uts)
+      dd := UP2UTS(d)$tools
+      f := LODO2FUN(op)$tools
+      q := degree op
+      e := unitlist(1, q)
+      hom := [UTS2UP(dd * ode(f, unitlist(i, q))$solver, n)$tools /$RF d
+                   for i in 1..q]$List(RF)
+      a1 := inv(leadingCoefficient(op)::RF)
+      part := 
+       [UTS2UP(dd * 
+         ode((l1:List(uts)):uts +-> 
+              RF2UTS(a1 * g)$tools + f l1, e)$solver, n)$tools
+                /$RF d for g in lg | g ^= 0]$List(RF)
+      [hom, part]
+
+    nzero? v ==
+      for i in minIndex v .. maxIndex v repeat
+        not zero? qelt(v, i) => return true
+      false
+
+    -- returns z(z+1)...(z+(n-1))
+    UPfact n ==
+      zero? n => 1
+      z := monomial(1, 1)$UP
+      */[z + i::F::UP for i in 0..(n-1)::N]
+
+    infMuLambda l ==
+      lamb:List(N) := [d := degree l]
+      lf:List(UP) := [a := leadingCoefficient l]
+      mup := degree(a)::Z - d
+      while (l := reductum l) ^= 0 repeat
+          a := leadingCoefficient l
+          if (m := degree(a)::Z - (d := degree l)) > mup then
+            mup := m
+            lamb := [d]
+            lf := [a]
+          else if (m = mup) then
+            lamb := concat(d, lamb)
+            lf := concat(a, lf)
+      [mup, lamb, lf]
+
+    infIndicialEquation(lambda, lf) ==
+      ans:UP := 0
+      for i in lambda for f in lf repeat
+        ans := ans + evenodd i * leadingCoefficient f * UPfact i
+      ans
+
+    infBound(l, lg) ==
+      rec := infMuLambda l
+      n := min(- degree(l)::Z - 1,
+               integerBound infIndicialEquation(rec.lambda, rec.func))
+      while not(empty? lg) and zero? first lg repeat lg := rest lg
+      empty? lg => (-n)::N
+      m := infOrder first lg
+      for g in rest lg repeat
+        if not(zero? g) and (mm := infOrder g) < m then m := mm
+      (-min(n, rec.mu - degree(leadingCoefficient l)::Z + m))::N
+
+    makeDot(v, bas) ==
+      ans:RF := 0
+      for i in 1.. for b in bas repeat ans := ans + v.i::UP * b
+      ans
+
+    ratDsolve(op:LODO, g:RF) ==
+      rec := splitDenominator(op, [g])
+      ratDsolve0(rec.eq, first(rec.rh))
+
+    ratDsolve(op:LODO, lg:List RF) ==
+      rec := splitDenominator(op, lg)
+      ratDsolve1(rec.eq, rec.rh)
+
+    ratDsolve(op:LODO2, g:RF) ==
+      unit?(c := content op) => ratDsolve0(op, g)
+      ratDsolve0((op exquo c)::LODO2, inv(c::RF) * g)
+
+    ratDsolve(op:LODO2, lg:List RF) ==
+      unit?(c := content op) => ratDsolve1(op, lg)
+      ratDsolve1((op exquo c)::LODO2, [inv(c::RF) * g for g in lg])
+
 *)
 
 \end{chunk}
@@ -174045,8 +217083,11 @@ RationalRetractions(S:RetractableTo(Fraction Integer)): with
       ++ rationalIfCan(x) returns x as a rational number,
       ++ "failed" if x is not a rational number;
   == add
+
     rational s      == retract s
+
     rational? s     == retractIfCan(s) case Fraction(Integer)
+
     rationalIfCan s == retractIfCan s
 
 \end{chunk}
@@ -174054,6 +217095,13 @@ RationalRetractions(S:RetractableTo(Fraction Integer)): with
 \begin{chunk}{COQ RATRET}
 (* package RATRET *)
 (*
+
+    rational s      == retract s
+
+    rational? s     == retractIfCan(s) case Fraction(Integer)
+
+    rationalIfCan s == retractIfCan s
+
 *)
 
 \end{chunk}
@@ -174209,6 +217257,7 @@ RationalRicDE(F, UP): Exports == Implementation where
         ++ not necessarily into irreducibles.
 
   Implementation ==> add
+
     import RatODETools(P, SUP)
     import RationalLODE(F, UP)
     import NonLinearSolvePackage F
@@ -174238,9 +217287,13 @@ RationalRicDE(F, UP): Exports == Implementation where
 
     UP2SUP p == map(z +-> z::P,p)
                            $UnivariatePolynomialCategoryFunctions2(F,UP,P,SUP)
+
     logDerOnly l == [differentiate(s) / s for s in ratDsolve(l, 0).basis]
+
     ricDsolve(l:LQ, zeros:UP -> List F) == ricDsolve(l, zeros, squareFree)
+
     ricDsolve(l:L,  zeros:UP -> List F) == ricDsolve(l, zeros, squareFree)
+
     singRicDE(l, ezfactor)              == singRicDE(l, solveModulo, ezfactor)
 
     ricDsolve(l:LQ, zeros:UP -> List F, ezfactor:UP -> Factored UP) ==
@@ -174256,7 +217309,7 @@ RationalRicDE(F, UP): Exports == Implementation where
            (n::F) / (d::F)
       "failed"
 
--- returns [0, []] if n < 0
+    -- returns [0, []] if n < 0
     genericPolynomial(s, n) ==
       ans:SUP := 0
       l:List(SY) := empty()
@@ -174282,7 +217335,7 @@ RationalRicDE(F, UP): Exports == Implementation where
         if ((u := ratsln sol) case SOL) then ans := concat(u::SOL, ans)
       ans
 
--- returns [] if the solutions of l have no polynomial component
+    -- returns [] if the solutions of l have no polynomial component
     polyRicDE(l, zeros) ==
       ans:List(POL) := [[0, l]]
       empty?(lc := leadingCoefficientRicDE l) => ans
@@ -174292,7 +217345,7 @@ RationalRicDE(F, UP): Exports == Implementation where
             ans := concat([p, changeVar(l, p)], ans)
       ans
 
--- reverseUP(a_0 + a_1 x + ... + an x^n) = a_n + ... + a_0 x^n
+    -- reverseUP(a_0 + a_1 x + ... + an x^n) = a_n + ... + a_0 x^n
     reverseUP p ==
       ans:UTS := 0
       n := degree(p)::Z
@@ -174301,11 +217354,11 @@ RationalRicDE(F, UP): Exports == Implementation where
         p   := reductum p
       ans
 
--- reverseUTS(a_0 + a_1 x + ..., n) = a_n + ... + a_0 x^n
+    -- reverseUTS(a_0 + a_1 x + ..., n) = a_n + ... + a_0 x^n
     reverseUTS(s, n) ==
       +/[monomial(coefficient(s, i), (n - i)::N)$UP for i in 0..n]
 
--- returns a potential polynomial solution p with leading coefficient a*?**n
+    -- returns potential polynomial solution p with leading coefficient a*?**n
     newtonSolution(l, a, n, zeros) ==
       i:N
       m:Z := 0
@@ -174325,15 +217378,16 @@ RationalRicDE(F, UP): Exports == Implementation where
       -- newton lifting failed, so revert to traditional method
       atn := monomial(a, n)$UP
       neq := changeVar(l, atn)
-      sols := [sol.poly for sol in polyRicDE(neq, zeros) | degree(sol.poly) < n]
+      sols := 
+        [sol.poly for sol in polyRicDE(neq, zeros) | degree(sol.poly) < n]
       empty? sols => atn
       atn + first sols
 
--- solves the algebraic equation eq for y, returns a solution of degree n with
--- initial term a
--- uses naive newton approximation for now
--- an example where this fails is   y^2 + 2 x y + 1 + x^2 = 0
--- which arises from the differential operator D^2 + 2 x D + 1 + x^2
+    -- solves the algebraic equation eq for y, returns a solution of 
+    -- degree n with initial term a
+    -- uses naive newton approximation for now
+    -- an example where this fails is   y^2 + 2 x y + 1 + x^2 = 0
+    -- which arises from the differential operator D^2 + 2 x D + 1 + x^2
     newtonSolve(eq, a, n) ==
       deq := differentiate eq
       sol := a::UTS
@@ -174342,23 +217396,23 @@ RationalRicDE(F, UP): Exports == Implementation where
         sol := truncate(sol - xquo::UTS, i)
       sol
 
--- there could be the same solutions coming in different ways, so we
--- stop when the number of solutions reaches the order of the equation
+    -- there could be the same solutions coming in different ways, so we
+    -- stop when the number of solutions reaches the order of the equation
     ricDsolve(l:L, zeros:UP -> List F, ezfactor:UP -> Factored UP) ==
       n := degree l
       ans:List(QF) := empty()
       for rec in singRicDE(l, ezfactor) repeat
         ans := removeDuplicates_! concat_!(ans,
-                         [rec.frac + f for f in nonSingSolve(n, rec.eq, zeros)])
+                        [rec.frac + f for f in nonSingSolve(n, rec.eq, zeros)])
         #ans = n => return ans
       ans
 
--- there could be the same solutions coming in different ways, so we
--- stop when the number of solutions reaches the order of the equation
+    -- there could be the same solutions coming in different ways, so we
+    -- stop when the number of solutions reaches the order of the equation
     nonSingSolve(n, l, zeros) ==
       ans:List(QF) := empty()
       for rec in polyRicDE(l, zeros) repeat
-        ans := removeDuplicates_! concat_!(ans, nopoly(n,rec.poly,rec.eq,zeros))
+        ans:= removeDuplicates_! concat_!(ans, nopoly(n,rec.poly,rec.eq,zeros))
         #ans = n => return ans
       ans
 
@@ -174366,8 +217420,8 @@ RationalRicDE(F, UP): Exports == Implementation where
       zero? degree p => empty()
       zeros squareFreePart p
 
--- there could be the same solutions coming in different ways, so we
--- stop when the number of solutions reaches the order of the equation
+    -- there could be the same solutions coming in different ways, so we
+    -- stop when the number of solutions reaches the order of the equation
     nopoly(n, p, l, zeros) ==
       ans:List(QF) := empty()
       for rec in constantCoefficientRicDE(l,z+->constantRic(z, zeros)) repeat
@@ -174376,7 +217430,7 @@ RationalRicDE(F, UP): Exports == Implementation where
         #ans = n => return ans
       ans
 
--- returns [p1,...,pn] s.t. h(x,pi(x)) = 0 mod c(x)
+    -- returns [p1,...,pn] s.t. h(x,pi(x)) = 0 mod c(x)
     solveModulo(c, h) ==
       rec := genericPolynomial(dummy, degree(c)::Z - 1)
       unk:SUP := 0
@@ -174388,10 +217442,12 @@ RationalRicDE(F, UP): Exports == Implementation where
       [mapeval(rec.poly, s.var, s.val) for s in sol]
 
     if F has AlgebraicallyClosedField then
+
       zro1: UP -> List F
       zro : (UP, UP -> Factored UP) -> List F
 
       ricDsolve(l:L)  == ricDsolve(l, squareFree)
+
       ricDsolve(l:LQ) == ricDsolve(l, squareFree)
 
       ricDsolve(l:L, ezfactor:UP -> Factored UP) ==
@@ -174413,6 +217469,213 @@ RationalRicDE(F, UP): Exports == Implementation where
 \begin{chunk}{COQ ODERTRIC}
 (* package ODERTRIC *)
 (*
+
+    import RatODETools(P, SUP)
+    import RationalLODE(F, UP)
+    import NonLinearSolvePackage F
+    import PrimitiveRatDE(F, UP, L, LQ)
+    import PrimitiveRatRicDE(F, UP, L, LQ)
+
+    FifCan           : RF -> Union(F, "failed")
+    UP2SUP           : UP -> SUP
+    innersol         : (List UP, Boolean) -> List QF
+    mapeval          : (SUP, List SY, List F) -> UP
+    ratsol           : List List EQ -> List SOL
+    ratsln           : List EQ -> Union(SOL, "failed")
+    solveModulo      : (UP, UP2) -> List UP
+    logDerOnly       : L -> List QF
+    nonSingSolve     : (N, L, UP -> List F) -> List QF
+    constantRic      : (UP, UP -> List F) -> List F
+    nopoly           : (N, UP, L, UP -> List F) -> List QF
+    reverseUP        : UP -> UTS
+    reverseUTS       : (UTS, N) -> UP
+    newtonSolution   : (L, F, N, UP -> List F) -> UP
+    newtonSolve      : (UPS, F, N) -> Union(UTS, "failed")
+    genericPolynomial: (SY, Z) -> Record(poly:SUP, vars:List SY)
+      -- genericPolynomial(s, n) returns
+      -- \spad{[[s0 + s1 X +...+ sn X^n],[s0,...,sn]]}.
+
+    dummy := new()$SY
+
+    UP2SUP p == map(z +-> z::P,p)
+                           $UnivariatePolynomialCategoryFunctions2(F,UP,P,SUP)
+
+    logDerOnly l == [differentiate(s) / s for s in ratDsolve(l, 0).basis]
+
+    ricDsolve(l:LQ, zeros:UP -> List F) == ricDsolve(l, zeros, squareFree)
+
+    ricDsolve(l:L,  zeros:UP -> List F) == ricDsolve(l, zeros, squareFree)
+
+    singRicDE(l, ezfactor)              == singRicDE(l, solveModulo, ezfactor)
+
+    ricDsolve(l:LQ, zeros:UP -> List F, ezfactor:UP -> Factored UP) ==
+      ricDsolve(splitDenominator(l, empty()).eq, zeros, ezfactor)
+
+    mapeval(p, ls, lv) ==
+      map(z +-> ground eval(z, ls, lv),p)
+                        $UnivariatePolynomialCategoryFunctions2(P, SUP, F, UP)
+
+    FifCan f ==
+      ((n := retractIfCan(numer f))@Union(F, "failed") case F) and
+        ((d := retractIfCan(denom f))@Union(F, "failed") case F) =>
+           (n::F) / (d::F)
+      "failed"
+
+    -- returns [0, []] if n < 0
+    genericPolynomial(s, n) ==
+      ans:SUP := 0
+      l:List(SY) := empty()
+      for i in 0..n repeat
+        ans := ans + monomial((sy := new s)::P, i::N)
+        l := concat(sy, l)
+      [ans, reverse_! l]
+
+    ratsln l ==
+      ls:List(SY) := empty()
+      lv:List(F) := empty()
+      for eq in l repeat
+        ((u := FifCan rhs eq) case "failed") or
+          ((v := retractIfCan(lhs eq)@Union(SY, "failed")) case "failed")
+             => return "failed"
+        lv := concat(u::F, lv)
+        ls := concat(v::SY, ls)
+      [ls, lv]
+
+    ratsol l ==
+      ans:List(SOL) := empty()
+      for sol in l repeat
+        if ((u := ratsln sol) case SOL) then ans := concat(u::SOL, ans)
+      ans
+
+    -- returns [] if the solutions of l have no polynomial component
+    polyRicDE(l, zeros) ==
+      ans:List(POL) := [[0, l]]
+      empty?(lc := leadingCoefficientRicDE l) => ans
+      rec := first lc                            -- one with highest degree
+      for a in zeros(rec.eq) | a ^= 0 repeat
+        if (p := newtonSolution(l, a, rec.deg, zeros)) ^= 0 then
+            ans := concat([p, changeVar(l, p)], ans)
+      ans
+
+    -- reverseUP(a_0 + a_1 x + ... + an x^n) = a_n + ... + a_0 x^n
+    reverseUP p ==
+      ans:UTS := 0
+      n := degree(p)::Z
+      while p ^= 0 repeat
+        ans := ans + monomial(leadingCoefficient p, (n - degree p)::N)
+        p   := reductum p
+      ans
+
+    -- reverseUTS(a_0 + a_1 x + ..., n) = a_n + ... + a_0 x^n
+    reverseUTS(s, n) ==
+      +/[monomial(coefficient(s, i), (n - i)::N)$UP for i in 0..n]
+
+    -- returns potential polynomial solution p with leading coefficient a*?**n
+    newtonSolution(l, a, n, zeros) ==
+      i:N
+      m:Z := 0
+      aeq:UPS := 0
+      op := l
+      while op ^= 0 repeat
+        mu := degree(op) * n + degree leadingCoefficient op
+        op := reductum op
+        if mu > m then m := mu
+      while l ^= 0 repeat
+        c := leadingCoefficient l
+        d := degree l
+        s:UTS := monomial(1, (m - d * n - degree c)::N)$UTS * reverseUP c
+        aeq := aeq + monomial(s, d)
+        l := reductum l
+      (u := newtonSolve(aeq, a, n)) case UTS => reverseUTS(u::UTS, n)
+      -- newton lifting failed, so revert to traditional method
+      atn := monomial(a, n)$UP
+      neq := changeVar(l, atn)
+      sols := 
+        [sol.poly for sol in polyRicDE(neq, zeros) | degree(sol.poly) < n]
+      empty? sols => atn
+      atn + first sols
+
+    -- solves the algebraic equation eq for y, returns a solution of 
+    -- degree n with initial term a
+    -- uses naive newton approximation for now
+    -- an example where this fails is   y^2 + 2 x y + 1 + x^2 = 0
+    -- which arises from the differential operator D^2 + 2 x D + 1 + x^2
+    newtonSolve(eq, a, n) ==
+      deq := differentiate eq
+      sol := a::UTS
+      for i in 1..n repeat
+        (xquo := eq(sol) exquo deq(sol)) case "failed" => return "failed"
+        sol := truncate(sol - xquo::UTS, i)
+      sol
+
+    -- there could be the same solutions coming in different ways, so we
+    -- stop when the number of solutions reaches the order of the equation
+    ricDsolve(l:L, zeros:UP -> List F, ezfactor:UP -> Factored UP) ==
+      n := degree l
+      ans:List(QF) := empty()
+      for rec in singRicDE(l, ezfactor) repeat
+        ans := removeDuplicates_! concat_!(ans,
+                        [rec.frac + f for f in nonSingSolve(n, rec.eq, zeros)])
+        #ans = n => return ans
+      ans
+
+    -- there could be the same solutions coming in different ways, so we
+    -- stop when the number of solutions reaches the order of the equation
+    nonSingSolve(n, l, zeros) ==
+      ans:List(QF) := empty()
+      for rec in polyRicDE(l, zeros) repeat
+        ans:= removeDuplicates_! concat_!(ans, nopoly(n,rec.poly,rec.eq,zeros))
+        #ans = n => return ans
+      ans
+
+    constantRic(p, zeros) ==
+      zero? degree p => empty()
+      zeros squareFreePart p
+
+    -- there could be the same solutions coming in different ways, so we
+    -- stop when the number of solutions reaches the order of the equation
+    nopoly(n, p, l, zeros) ==
+      ans:List(QF) := empty()
+      for rec in constantCoefficientRicDE(l,z+->constantRic(z, zeros)) repeat
+        ans := removeDuplicates_! concat_!(ans,
+                  [(rec.constant::UP + p)::QF + f for f in logDerOnly(rec.eq)])
+        #ans = n => return ans
+      ans
+
+    -- returns [p1,...,pn] s.t. h(x,pi(x)) = 0 mod c(x)
+    solveModulo(c, h) ==
+      rec := genericPolynomial(dummy, degree(c)::Z - 1)
+      unk:SUP := 0
+      while not zero? h repeat
+        unk := unk + UP2SUP(leadingCoefficient h) * (rec.poly ** degree h)
+        h   := reductum h
+      sol := ratsol solve(coefficients(monicDivide(unk,UP2SUP c).remainder),
+                          rec.vars)
+      [mapeval(rec.poly, s.var, s.val) for s in sol]
+
+    if F has AlgebraicallyClosedField then
+
+      zro1: UP -> List F
+      zro : (UP, UP -> Factored UP) -> List F
+
+      ricDsolve(l:L)  == ricDsolve(l, squareFree)
+
+      ricDsolve(l:LQ) == ricDsolve(l, squareFree)
+
+      ricDsolve(l:L, ezfactor:UP -> Factored UP) ==
+        ricDsolve(l, z +-> zro(z, ezfactor), ezfactor)
+
+      ricDsolve(l:LQ, ezfactor:UP -> Factored UP) ==
+        ricDsolve(l, z +-> zro(z, ezfactor), ezfactor)
+
+      zro(p, ezfactor) ==
+        concat [zro1(r.factor) for r in factors ezfactor p]
+
+      zro1 p ==
+        [zeroOf(map((z:F):F +-> z, p)
+          $UnivariatePolynomialCategoryFunctions2(F, UP, F, 
+              SparseUnivariatePolynomial F))]
+
 *)
 
 \end{chunk}
@@ -174523,6 +217786,7 @@ RationalUnivariateRepresentationPackage(R,ls): Exports == Implementation where
        ++ Moreover, if \spad{check?} is \spad{true} then the result is checked.
 
   Implementation == add
+
      news: Symbol := new()$Symbol
      lv: List Symbol := concat(ls,news)
      V ==> OrderedVariableList(lv)
@@ -174603,6 +217867,82 @@ RationalUnivariateRepresentationPackage(R,ls): Exports == Implementation where
 \begin{chunk}{COQ RURPK}
 (* package RURPK *)
 (*
+
+     news: Symbol := new()$Symbol
+     lv: List Symbol := concat(ls,news)
+     V ==> OrderedVariableList(lv)
+     Q ==> NewSparseMultivariatePolynomial(R,V)
+     E ==> IndexedExponents V
+     TS ==> SquareFreeRegularTriangularSet(R,E,V,Q)
+     QWT ==> Record(val: Q, tower: TS)
+     LQWT ==> Record(val: List Q, tower: TS)
+     polsetpack ==> PolynomialSetUtilitiesPackage(R,E,V,Q)
+     normpack ==> NormalizationPackage(R,E,V,Q,TS)
+     rurpack ==> InternalRationalUnivariateRepresentationPackage(R,E,V,Q,TS)
+     newv: V := variable(news)::V
+     newq : Q := newv :: Q
+     
+     rur(lp: List P, univ?: Boolean, check?: Boolean): List RUR ==
+       lp := remove(zero?,lp)
+       empty? lp =>
+         error "rur$RURPACK: #1 is empty"
+       any?(ground?,lp) =>
+         error "rur$RURPACK: #1 is not a triangular set"
+       ts: TS := [[newq]$(List Q)]       
+       lq: List Q := []
+       for p in lp repeat
+         rif: Union(Q,"failed") := retractIfCan(p)$Q
+         rif case "failed" =>
+           error "rur$RURPACK: #1 is not a subset of R[ls]"
+         q: Q := rif::Q
+         lq := cons(q,lq)
+       lq := sort(infRittWu?,lq)
+       toSee: List LQWT := [[lq,ts]$LQWT]
+       toSave: List TS := []
+       while not empty? toSee repeat
+         lqwt := first toSee; toSee := rest toSee
+         lq := lqwt.val; ts := lqwt.tower
+         empty? lq => 
+           -- output(ts::OutputForm)$OutputPackage
+           toSave := cons(ts,toSave)
+         q := first lq; lq := rest lq
+         not (mvar(q) > mvar(ts)) =>
+           error "rur$RURPACK: #1 is not a triangular set"
+         empty? (rest(ts)::TS) =>  
+           lfq := irreducibleFactors([q])$polsetpack 
+           for fq in lfq repeat
+             newts := internalAugment(fq,ts)
+             newlq := [remainder(q,newts).polnum for q in lq]
+             toSee := cons([newlq,newts]$LQWT,toSee)
+         lsfqwt: List QWT := squareFreePart(q,ts)
+         for qwt in lsfqwt repeat
+           q := qwt.val; ts := qwt.tower
+           if not ground? init(q)
+             then
+               q := normalizedAssociate(q,ts)$normpack
+           newts := internalAugment(q,ts)           
+           newlq := [remainder(q,newts).polnum for q in lq]
+           toSee := cons([newlq,newts]$LQWT,toSee)
+       toReturn: List RUR := []
+       for ts in toSave repeat
+         lus := rur(ts,univ?)$rurpack 
+         check? and (not checkRur(ts,lus)$rurpack) =>
+           output("RUR for: ")$OutputPackage
+           output(ts::OutputForm)$OutputPackage
+           output("Is: ")$OutputPackage
+           for us in lus repeat output(us::OutputForm)$OutputPackage
+           error "rur$RURPACK: bad result with function rur$IRURPK"
+         for us in lus repeat
+            g: U  := univariate(select(us,newv)::Q)$Q
+            lc: LP := [convert(q)@P for q in parts(collectUpper(us,newv))]
+            toReturn := cons([g,lc]$RUR, toReturn)
+       toReturn 
+
+     rur(lp: List P, univ?: Boolean): List RUR ==
+       rur(lp,univ?,false)
+
+     rur(lp: List P): List RUR == rur(lp,true)
+
 *)
 
 \end{chunk}
@@ -174773,15 +218113,6 @@ RealPolynomialUtilitiesPackage(TheField,ThePols) : PUB == PRIV where
          null(l) => 1
          1 + ("max" / [ abs(t) for t in l ])
 
---       sturmVariationsOf(l) == 
---         res : N := 0
---         lsg := sign(first(l))
---         for term in l repeat
---           if ^( (sg := sign(term) ) = 0 ) then
---             if (sg ^= lsg) then res := res + 1
---             lsg := sg
---         res
-
        sturmVariationsOf(l) == 
          null(l) => error "POLUTIL: sturmVariationsOf: empty list !"
          l1 := first(l)
@@ -174823,6 +218154,66 @@ RealPolynomialUtilitiesPackage(TheField,ThePols) : PUB == PRIV where
 \begin{chunk}{COQ POLUTIL}
 (* package POLUTIL *)
 (*
+
+     sturmSequence(p) ==
+       sylvesterSequence(p,differentiate(p))
+
+     sylvesterSequence(p1,p2) ==
+       res : List(ThePols) := [p1]
+       while (p2 ^= 0) repeat
+         res := cons(p2 , res)
+         (p1 , p2) := (p2 , -(p1 rem p2))
+       if degree(p1) > 0
+       then
+         p1 := unitCanonical(p1)
+         res := [ term quo p1 for term in res ]
+       reverse! res
+
+     if TheField has OrderedRing
+     then
+
+       boundOfCauchy(p) ==
+         c :TheField := inv(leadingCoefficient(p))
+         l := [ c*term for term in rest(coefficients(p))]
+         null(l) => 1
+         1 + ("max" / [ abs(t) for t in l ])
+
+       sturmVariationsOf(l) == 
+         null(l) => error "POLUTIL: sturmVariationsOf: empty list !"
+         l1 := first(l)
+         -- first 0 counts as a sign
+         ll : List(TheField) := []
+         for term in rest(l) repeat
+           -- zeros don't count
+           if not(zero?(term)) then ll := cons(term,ll)
+         -- if l1 is not zero then ll = reverse(l)
+         null(ll) => error "POLUTIL: sturmVariationsOf: Bad sequence"
+         ln := first(ll)
+         ll := reverse(rest(ll))
+         -- if l1 is not zero then first(l) = first(ll)
+         -- if l1 is zero then first zero should count as a sign
+         zero?(l1) => 1 + lazyVariations(rest(ll),sign(first(ll)),sign(ln))
+         lazyVariations(ll, sign(l1), sign(ln))
+
+       lazyVariations(l,sl,sh) ==
+         zero?(sl) or zero?(sh) => error "POLUTIL: lazyVariations: zero sign!"
+         null(l) =>
+           if sl = sh then 0 else 1
+         null(rest(l)) => 
+           if zero?(first(l))
+           then error "POLUTIL: lazyVariations: zero sign!"
+           else
+             if sl = sh 
+             then 
+               if (sl = sign(first(l)))
+               then 0
+               else 2
+             -- in this case we save one test
+             else 1
+         s := sign(l.2)
+         lazyVariations([first(l)],sl,s) + 
+           lazyVariations(rest(rest(l)),s,sh)
+    
 *)
 
 \end{chunk}
@@ -175081,6 +218472,21 @@ RealSolvePackage(): Exports == Implementation where
 \begin{chunk}{COQ REALSOLV}
 (* package REALSOLV *)
 (*
+
+    prn2rfi: P RN -> RFI
+    prn2rfi p ==
+      map(x+->x::RFI, x+->(numer(x)::RFI)/(denom(x)::RFI), p)$LIFT
+
+    pi2rfi: P I -> RFI
+    pi2rfi p == p :: RFI
+
+    solve(p:P RN,eps:NF) == realRoots(prn2rfi p, eps)$SOLV
+
+    solve(p:P I,eps:NF)  == realRoots(p::RFI, eps)$SOLV
+
+    realSolve(lp,lv,eps) ==
+      realRoots(map(pi2rfi, lp)$ListFunctions2(P I,RFI),lv,eps)$SOLV
+
 *)
 
 \end{chunk}
@@ -175199,6 +218605,7 @@ RealZeroPackage(Pol): T == C where
         ++ midpoints(isolist) returns the list of midpoints for the list
         ++ of intervals isolist.
    C == add
+
       --Local Functions
       makeSqfr: Pol -> Pol
       ReZeroSqfr: (Pol) -> isoList
@@ -175323,16 +218730,6 @@ RealZeroPackage(Pol): T == C where
               d := n
          G
 
---    otransAdd1(F : Pol) ==
---                --computes Pol G such that G(x) = F(x+1)
---       G : Pol := F
---       n : Integer := 1
---       while (F := differentiate(F)) ^= 0 repeat
---            if not ((tempF := F exquo n) case "failed") then F := tempF
---            G := G + F
---            n := n + 1
---       G
-
       transAdd1(F : Pol) ==
                   --computes Pol G such that G(x) = F(x+1)
          n := degree F
@@ -175438,6 +218835,231 @@ RealZeroPackage(Pol): T == C where
 \begin{chunk}{COQ REAL0}
 (* package REAL0 *)
 (*
+
+      --Local Functions
+      makeSqfr: Pol -> Pol
+      ReZeroSqfr: (Pol) -> isoList
+      PosZero: (Pol) -> isoList
+      Zero1: (Pol) -> isoList
+      transMult: (Integer, Pol) -> Pol
+      transMultInv: (Integer, Pol) -> Pol
+      transAdd1: (Pol) -> Pol
+      invert: (Pol) -> Pol
+      minus: (Pol) -> Pol
+      negate: Interval -> Interval
+      rootBound: (Pol) -> Integer
+      var: (Pol) -> Integer
+
+      negate(int : Interval):Interval == [-int.right,-int.left]
+
+      midpoint(i : Interval):RN ==  (1/2)*(i.left + i.right)
+
+      midpoints(li : isoList) : List RN ==
+        [midpoint x for x in li]
+
+      makeSqfr(F : Pol):Pol ==
+         sqfr := squareFree F
+         F := */[s.factor for s in factors(sqfr)]
+
+      realZeros(F : Pol) ==
+         ReZeroSqfr makeSqfr F
+
+      realZeros(F : Pol, rn : RN) ==
+         F := makeSqfr F
+         [refine(F,int,rn) for int in ReZeroSqfr(F)]
+
+      realZeros(F : Pol, bounds : Interval) ==
+         F := makeSqfr F
+         [rint::Interval for int in ReZeroSqfr(F) |
+             (rint:=refine(F,int,bounds)) case Interval]
+
+      realZeros(F : Pol, bounds : Interval, rn : RN) ==
+         F := makeSqfr F
+         [refine(F,int,rn) for int in realZeros(F,bounds)]
+
+      ReZeroSqfr(F : Pol) ==
+         F = 0 => error "ReZeroSqfr: zero polynomial"
+         L : isoList := []
+         degree(F) = 0 => L
+         if (r := minimumDegree(F)) > 0 then
+              L := [[0,0]$Interval]
+              tempF := F exquo monomial(1, r)
+              if not (tempF case "failed") then
+                   F := tempF
+         J:isoList := [negate int for int in reverse(PosZero(minus(F)))]
+         K : isoList := PosZero(F)
+         append(append(J, L), K)
+
+      PosZero(F : Pol) ==   --F is square free, primitive
+                          --and F(0) ^= 0; returns isoList for positive
+                          --roots of F
+
+         b : Integer := rootBound(F)
+         F := transMult(b,F)
+         L : isoList := Zero1(F)
+         int : Interval
+         L := [[b*int.left, b*int.right]$Interval for int in L]
+
+      Zero1(F : Pol) ==   --returns isoList for roots of F in (0,1)
+         J : isoList
+         K : isoList
+         L : isoList
+         L := []
+         (v := var(transAdd1(invert(F)))) = 0 => []
+         v = 1 => L := [[0,1]$Interval]
+         G : Pol := transMultInv(2, F)
+         H : Pol := transAdd1(G)
+         if minimumDegree H > 0 then
+                 -- H has a root at 0 => F has one at 1/2, and G at 1
+              L := [[1/2,1/2]$Interval]
+              Q : Pol := monomial(1, 1)
+              tempH : Union(Pol, "failed") := H exquo Q
+              if not (tempH case "failed") then H := tempH
+              Q := Q + monomial(-1, 0)
+              tempG : Union(Pol, "failed") := G exquo Q
+              if not (tempG case "failed") then G := tempG
+         int : Interval
+         J := [[(int.left+1)* (1/2),(int.right+1) * (1/2)]$Interval
+                                                 for int in Zero1(H)]
+         K := [[int.left * (1/2), int.right * (1/2)]$Interval
+                                                 for int in Zero1(G)]
+         append(append(J, L), K)
+
+      rootBound(F : Pol) ==  --returns power of 2 that is a bound
+                             --for the positive roots of F
+         if leadingCoefficient(F) < 0 then F := -F
+         lcoef := leadingCoefficient(F)
+         F := reductum(F)
+         i : Integer := 0
+         while not (F = 0) repeat
+              if (an := leadingCoefficient(F)) < 0 then i := i - an
+              F := reductum(F)
+         b : Integer := 1
+         while (b * lcoef) <= i repeat
+              b := 2 * b
+         b
+
+      transMult(c : Integer, F : Pol) ==
+                  --computes Pol G such that G(x) = F(c*x)
+         G : Pol := 0
+         while not (F = 0) repeat
+              n := degree(F)
+              G := G + monomial((c**n) * leadingCoefficient(F), n)
+              F := reductum(F)
+         G
+
+      transMultInv(c : Integer, F : Pol) ==
+                  --computes Pol G such that G(x) = (c**n) * F(x/c)
+         d := degree(F)
+         cc : Integer := 1
+         G : Pol := monomial(leadingCoefficient F,d)
+         while (F:=reductum(F)) ^= 0 repeat
+              n := degree(F)
+              cc := cc*(c**(d-n):NonNegativeInteger)
+              G := G + monomial(cc * leadingCoefficient(F), n)
+              d := n
+         G
+
+      transAdd1(F : Pol) ==
+                  --computes Pol G such that G(x) = F(x+1)
+         n := degree F
+         v := vectorise(F, n+1)
+         for i in 0..(n-1) repeat
+            for j in (n-i)..n repeat
+               qsetelt_!(v,j, qelt(v,j) + qelt(v,(j+1)))
+         ans : Pol := 0
+         for i in 0..n repeat
+            ans := ans + monomial(qelt(v,(i+1)),i)
+         ans
+
+
+      minus(F : Pol) ==
+                  --computes Pol G such that G(x) = F(-x)
+         G : Pol := 0
+         while not (F = 0) repeat
+              n := degree(F)
+              coef := leadingCoefficient(F)
+              odd? n =>
+                   G := G + monomial(-coef, n)
+                   F := reductum(F)
+              G := G + monomial(coef, n)
+              F := reductum(F)
+         G
+
+      invert(F : Pol) ==
+                  --computes Pol G such that G(x) = (x**n) * F(1/x)
+         G : Pol := 0
+         n := degree(F)
+         while not (F = 0) repeat
+              G := G + monomial(leadingCoefficient(F),
+                                (n-degree(F))::NonNegativeInteger)
+              F := reductum(F)
+         G
+
+      var(F : Pol) ==    --number of sign variations in coefs of F
+         i : Integer := 0
+         LastCoef : Boolean
+         next : Boolean
+         LastCoef := leadingCoefficient(F) < 0
+         while not ((F := reductum(F)) = 0) repeat
+              next := leadingCoefficient(F) < 0
+              if ((not LastCoef) and next) or
+                  ((not next) and LastCoef) then i := i+1
+              LastCoef := next
+         i
+
+      refine(F : Pol, int : Interval, bounds : Interval) ==
+         lseg := min(int.right,bounds.right) - max(int.left,bounds.left)
+         lseg < 0 => "failed"
+         lseg = 0 =>
+            pt :=
+               int.left = bounds.right => int.left
+               int.right
+            elt(transMultInv(denom(pt),F),numer pt) = 0 => [pt,pt]
+            "failed"
+         lseg = int.right - int.left => int
+         refine(F, refine(F, int, lseg), bounds)
+
+      refine(F : Pol, int : Interval, eps : RN) ==
+         a := int.left
+         b := int.right
+         a=b => [a,b]$Interval
+         an : Integer := numer(a)
+         ad : Integer := denom(a)
+         bn : Integer := numer(b)
+         bd : Integer := denom(b)
+         xfl : Boolean := false
+         if (u:=elt(transMultInv(ad, F), an)) = 0 then
+             F := (F exquo (monomial(ad,1)-monomial(an,0)))::Pol
+             u:=elt(transMultInv(ad, F), an)
+         if (v:=elt(transMultInv(bd, F), bn)) = 0 then
+             F := (F exquo (monomial(bd,1)-monomial(bn,0)))::Pol
+             v:=elt(transMultInv(bd, F), bn)
+             u:=elt(transMultInv(ad, F), an)
+         if u > 0 then (F:=-F;v:=-v)
+         if v < 0 then
+            error [int, "is not a valid isolation interval for", F]
+         if eps <= 0 then error "precision must be positive"
+         while (b - a) >= eps repeat
+              mid : RN := (b + a) * (1/2)
+              midn : Integer := numer(mid)
+              midd : Integer := denom(mid)
+              (v := elt(transMultInv(midd, F), midn)) < 0 =>
+                   a := mid
+                   an := midn
+                   ad := midd
+              v > 0 =>
+                   b := mid
+                   bn := midn
+                   bd := midd
+              v = 0 =>
+                   a := mid
+                   b := mid
+                   an := midn
+                   ad := midd
+                   xfl := true
+         [a, b]$Interval
+
 *)
 
 \end{chunk}
@@ -175549,22 +219171,29 @@ RealZeroPackageQ(Pol): T == C where
         ++ root of pol, and returns an isolating interval which
         ++ is contained within range, or "failed" if no such isolating interval exists.
    C == add
+
       import RealZeroPackage SparseUnivariatePolynomial Integer
  
       convert2PolInt: Pol -> SparseUnivariatePolynomial Integer
  
       convert2PolInt(f : Pol) ==
          pden:I :=lcm([denom c for c in coefficients f])
-         map(numer,pden * f)$UnivariatePolynomialCategoryFunctions2(RN,Pol,I,SUP I)
+         map(numer,pden * f)_
+          $UnivariatePolynomialCategoryFunctions2(RN,Pol,I,SUP I)
  
       realZeros(f : Pol) == realZeros(convert2PolInt f)
+
       realZeros(f : Pol, rn : RN) == realZeros(convert2PolInt f, rn)
+
       realZeros(f : Pol, bounds : Interval) ==
                realZeros(convert2PolInt f, bounds)
+
       realZeros(f : Pol, bounds : Interval, rn : RN) ==
                realZeros(convert2PolInt f, bounds, rn)
+
       refine(f : Pol, int : Interval, eps : RN) ==
                refine(convert2PolInt f, int, eps)
+
       refine(f : Pol, int : Interval, bounds : Interval) ==
                refine(convert2PolInt f, int, bounds)
 
@@ -175573,6 +219202,32 @@ RealZeroPackageQ(Pol): T == C where
 \begin{chunk}{COQ REAL0Q}
 (* package REAL0Q *)
 (*
+
+      import RealZeroPackage SparseUnivariatePolynomial Integer
+ 
+      convert2PolInt: Pol -> SparseUnivariatePolynomial Integer
+ 
+      convert2PolInt(f : Pol) ==
+         pden:I :=lcm([denom c for c in coefficients f])
+         map(numer,pden * f)_
+          $UnivariatePolynomialCategoryFunctions2(RN,Pol,I,SUP I)
+ 
+      realZeros(f : Pol) == realZeros(convert2PolInt f)
+
+      realZeros(f : Pol, rn : RN) == realZeros(convert2PolInt f, rn)
+
+      realZeros(f : Pol, bounds : Interval) ==
+               realZeros(convert2PolInt f, bounds)
+
+      realZeros(f : Pol, bounds : Interval, rn : RN) ==
+               realZeros(convert2PolInt f, bounds, rn)
+
+      refine(f : Pol, int : Interval, eps : RN) ==
+               refine(convert2PolInt f, int, eps)
+
+      refine(f : Pol, int : Interval, bounds : Interval) ==
+               refine(convert2PolInt f, int, bounds)
+
 *)
 
 \end{chunk}
@@ -175662,6 +219317,7 @@ RectangularMatrixCategoryFunctions2(m,n,R1,Row1,Col1,M1,R2,Row2,Col2,M2):_
       ++ \spad{n[i,j] = f(m[i,j],r)} for all indices spad{i} and \spad{j}.
 
   Implementation ==> add
+
     minr ==> minRowIndex
     maxr ==> maxRowIndex
     minc ==> minColIndex
@@ -175686,6 +219342,26 @@ RectangularMatrixCategoryFunctions2(m,n,R1,Row1,Col1,M1,R2,Row2,Col2,M2):_
 \begin{chunk}{COQ RMCAT2}
 (* package RMCAT2 *)
 (*
+
+    minr ==> minRowIndex
+    maxr ==> maxRowIndex
+    minc ==> minColIndex
+    maxc ==> maxColIndex
+
+    map(f,mat) ==
+      ans : M2 := new(m,n,0)$Matrix(R2) pretend M2
+      for i in minr(mat)..maxr(mat) for k in minr(ans)..maxr(ans) repeat
+        for j in minc(mat)..maxc(mat) for l in minc(ans)..maxc(ans) repeat
+          qsetelt_!(ans pretend Matrix R2,k,l,f qelt(mat,i,j))
+      ans
+
+    reduce(f,mat,ident) ==
+      s := ident
+      for i in minr(mat)..maxr(mat) repeat
+       for j in minc(mat)..maxc(mat) repeat
+         s := f(qelt(mat,i,j),s)
+      s
+
 *)
 
 \end{chunk}
@@ -176217,6 +219893,7 @@ getOrder returns the maximum derivative of op occurring in f.
 \subsubsection{Displaying a functional equation}
 
 \begin{chunk}{implementation: RecurrenceOperator}
+
     ddADE: List F -> OutputForm
     ddADE l ==
       op := operatorName l
@@ -176243,6 +219920,28 @@ getOrder returns the maximum derivative of op occurring in f.
 \begin{chunk}{COQ RECOP}
 (* package RECOP *)
 (*
+
+    ddADE: List F -> OutputForm
+    ddADE l ==
+      op := operatorName l
+      values := reverse l
+
+      vals: List OutputForm
+           := cons(eval(eqAsF l, dummyAsF l, displayVariable l)::OutputForm = _
+                   0::OutputForm,
+                   [eval(D(op(dummyAsF l), dummy l, i), _
+                         dummyAsF l=0)::OutputForm = _
+                    (values.(i+1))::OutputForm * _
+                    factorial(box(i::R::F)$F)::OutputForm _
+                    for i in 0..min(4,#values-5)])
+
+      bracket(hconcat([bracket((displayVariable l)::OutputForm ** _
+                               (operatorArgument l)::OutputForm), 
+                       (op(displayVariable l))::OutputForm, ": ",
+                       commaSeparate vals]))
+
+    setProperty(opADE, "%specialDisp", 
+                ddADE@(List F -> OutputForm) pretend None)
 *)
 
 \end{chunk}
@@ -176321,10 +220020,11 @@ ReducedDivisor(F1, UP, UPUP, R, F2): Exports == Implementation where
       ++ order(f,u,g) \undocumented
 
   Implementation ==> add
+
     algOrder : (FD, UPUP, F1 -> F2)  -> N
     rootOrder: (FD, UP, N, F1 -> F2) -> N
 
--- pp is not necessarily monic
+    -- pp is not necessarily monic
     order(d, pp, f) ==
       (r := retractIfCan(reductum pp)@Union(Fraction UP, "failed"))
         case "failed" => algOrder(d, pp, f)
@@ -176351,6 +220051,32 @@ ReducedDivisor(F1, UP, UPUP, R, F2): Exports == Implementation where
 \begin{chunk}{COQ RDIV}
 (* package RDIV *)
 (*
+
+    algOrder : (FD, UPUP, F1 -> F2)  -> N
+    rootOrder: (FD, UP, N, F1 -> F2) -> N
+
+    -- pp is not necessarily monic
+    order(d, pp, f) ==
+      (r := retractIfCan(reductum pp)@Union(Fraction UP, "failed"))
+        case "failed" => algOrder(d, pp, f)
+      rootOrder(d, - retract(r::Fraction(UP) / leadingCoefficient pp)@UP,
+                degree pp, f)
+
+    algOrder(d, modulus, reduce) ==
+      redmod := map(reduce, modulus)$MultipleMap(F1,UP,UPUP,F2,UP2,UPUP2)
+      curve  := AlgebraicFunctionField(F2, UP2, UPUP2, redmod)
+      order(map(reduce,
+              d)$FiniteDivisorFunctions2(F1,UP,UPUP,R,F2,UP2,UPUP2,curve)
+                                 )$FindOrderFinite(F2, UP2, UPUP2, curve)
+
+    rootOrder(d, radicand, n, reduce) ==
+      redrad := map(reduce,
+           radicand)$UnivariatePolynomialCategoryFunctions2(F1,UP,F2,UP2)
+      curve  := RadicalFunctionField(F2, UP2, UPUP2, redrad::Fraction UP2, n)
+      order(map(reduce,
+              d)$FiniteDivisorFunctions2(F1,UP,UPUP,R,F2,UP2,UPUP2,curve)
+                                 )$FindOrderFinite(F2, UP2, UPUP2, curve)
+
 *)
 
 \end{chunk}
@@ -176434,26 +220160,28 @@ ReduceLODE(F, L, UP, A, LO): Exports == Implementation where
       ++ differential system \spad{M.z = v}.
 
   Implementation ==> add
+
     matF2L: Matrix F -> M
 
     diff := D()$L
 
--- coerces a matrix of elements of F into a matrix of (order 0) L.O.D.O's
+    -- coerces a matrix of elements of F into a matrix of (order 0) L.O.D.O's
     matF2L m ==
       map((f1:F):L+->f1::L, m)$MatrixCategoryFunctions2(F, V, V, Matrix F,
                                                 L, Vector L, Vector L, M)
 
--- This follows the algorithm and notation of
---  "The Risch Differential Equation on an Algebraic Curve", M. Bronstein,
--- in 'Proceedings of ISSAC '91', Bonn, BRD, ACM Press, pp.241-246, July 1991.
+    -- This follows the algorithm and notation of
+    --  "The Risch Differential Equation on an Algebraic Curve", M. Bronstein,
+    -- in 'Proceedings of ISSAC '91', Bonn, BRD, ACM Press, 
+    -- pp.241-246, July 1991.
     reduceLODE(l, g) ==
       n := rank()$A
--- md is the basic differential matrix (D x I + Dy)
+      -- md is the basic differential matrix (D x I + Dy)
       md := matF2L transpose derivationCoordinates(basis(), (f1:F):F+->diff f1)
       for i in minRowIndex md .. maxRowIndex md
         for j in minColIndex md .. maxColIndex md repeat
           md(i, j) := diff + md(i, j)
--- mdi will go through the successive powers of md
+      -- mdi will go through the successive powers of md
       mdi := copy md
       sys := matF2L(transpose regularRepresentation coefficient(l, 0))
       for i in 1..degree l repeat
@@ -176467,6 +220195,36 @@ ReduceLODE(F, L, UP, A, LO): Exports == Implementation where
 \begin{chunk}{COQ ODERED}
 (* package ODERED *)
 (*
+
+    matF2L: Matrix F -> M
+
+    diff := D()$L
+
+    -- coerces a matrix of elements of F into a matrix of (order 0) L.O.D.O's
+    matF2L m ==
+      map((f1:F):L+->f1::L, m)$MatrixCategoryFunctions2(F, V, V, Matrix F,
+                                                L, Vector L, Vector L, M)
+
+    -- This follows the algorithm and notation of
+    --  "The Risch Differential Equation on an Algebraic Curve", M. Bronstein,
+    -- in 'Proceedings of ISSAC '91', Bonn, BRD, ACM Press, 
+    -- pp.241-246, July 1991.
+    reduceLODE(l, g) ==
+      n := rank()$A
+      -- md is the basic differential matrix (D x I + Dy)
+      md := matF2L transpose derivationCoordinates(basis(), (f1:F):F+->diff f1)
+      for i in minRowIndex md .. maxRowIndex md
+        for j in minColIndex md .. maxColIndex md repeat
+          md(i, j) := diff + md(i, j)
+      -- mdi will go through the successive powers of md
+      mdi := copy md
+      sys := matF2L(transpose regularRepresentation coefficient(l, 0))
+      for i in 1..degree l repeat
+        sys := sys +
+                matF2L(transpose regularRepresentation coefficient(l, i)) * mdi
+        mdi := md * mdi
+      [sys, coordinates g]
+
 *)
 
 \end{chunk}
@@ -176551,6 +220309,7 @@ ReductionOfOrder(F, L): Exports == Impl where
       ++ of \spad{op y = 0}. Each \spad{fi} must satisfy \spad{op fi = 0}.
 
   Impl ==> add
+
     ithcoef   : (L, Z, A) -> F
     locals    : (A, Z, Z) -> F
     localbinom: (Z, Z) -> Z
@@ -176590,6 +220349,41 @@ ReductionOfOrder(F, L): Exports == Impl where
 \begin{chunk}{COQ REDORDER}
 (* package REDORDER *)
 (*
+
+    ithcoef   : (L, Z, A) -> F
+    locals    : (A, Z, Z) -> F
+    localbinom: (Z, Z) -> Z
+
+    diff := D()$L
+
+    localbinom(j, i) == (j > i => binomial(j, i+1); 0)
+    locals(s, j, i)  == (j > i => qelt(s, j - i - 1); 0)
+
+    ReduceOrder(l:L, sols:List F) ==
+      empty? sols => [l, empty()]
+      neweq := ReduceOrder(l, sol := first sols)
+      rec := ReduceOrder(neweq, [diff(s / sol) for s in rest sols])
+      [rec.eq, concat_!(rec.op, sol)]
+
+    ithcoef(eq, i, s) ==
+      ans:F := 0
+      while eq ^= 0 repeat
+          j   := degree eq
+          ans := ans + localbinom(j, i) * locals(s,j,i) * leadingCoefficient eq
+          eq  := reductum eq
+      ans
+
+    ReduceOrder(eq:L, sol:F) ==
+      s:A := new(n := degree eq, 0)         -- will contain derivatives of sol
+      si := sol                             -- will run through the derivatives
+      qsetelt_!(s, 0, si)
+      for i in 1..(n-1)::NonNegativeInteger repeat 
+          qsetelt_!(s, i, si := diff si)
+      ans:L := 0
+      for i in 0..(n-1)::NonNegativeInteger repeat
+          ans := ans + monomial(ithcoef(eq, i, s), i)
+      ans
+
 *)
 
 \end{chunk}
@@ -176767,7 +220561,8 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where
        for ts in lts repeat lv := concat(variables(ts), lv)
        # removeDuplicates(lv)
 
-     algebraicDecompose(p: P, ts: TS, clos?: B): Record(done: Split, todo: List LpWT) ==
+     algebraicDecompose(p: P, ts: TS, clos?: B):_
+            Record(done: Split, todo: List LpWT) ==
        ground? p =>
          error " in algebraicDecompose$REGSET: should never happen !"
        v := mvar(p); n := #ts
@@ -176776,9 +220571,11 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where
        ts_v := select(ts,v)::P
        if mdeg(p) < mdeg(ts_v)
          then 
-           lgwt := internalLastSubResultant(ts_v,p,ts_v_-,true,false)$regsetgcdpack
+           lgwt := 
+            internalLastSubResultant(ts_v,p,ts_v_-,true,false)$regsetgcdpack
          else
-           lgwt := internalLastSubResultant(p,ts_v,ts_v_-,true,false)$regsetgcdpack
+           lgwt := 
+            internalLastSubResultant(p,ts_v,ts_v_-,true,false)$regsetgcdpack
        lts: Split := []
        llpwt: List LpWT := []
        for gwt in lgwt repeat
@@ -176786,7 +220583,8 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where
          zero? g => 
            error " in algebraicDecompose$REGSET: should never happen !!"
          ground? g => "leave"
-         if mvar(g) = v then lts := concat(augment(members(ts_v_+),augment(g,us)),lts) 
+         if mvar(g) = v then _
+           lts := concat(augment(members(ts_v_+),augment(g,us)),lts) 
          h := leadingCoefficient(g,v)
          b: Boolean := purelyAlgebraic?(us)
          lsfp := squareFreeFactors(h)$polsetpack
@@ -176798,7 +220596,8 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where
               llpwt := cons([[f,p],vs]$LpWT, llpwt)
        [lts,llpwt]
 
-     transcendentalDecompose(p: P, ts: TS,bound: N): Record(done: Split, todo: List LpWT) ==
+     transcendentalDecompose(p: P, ts: TS,bound: N):_
+             Record(done: Split, todo: List LpWT) ==
        lts: Split
        if #ts < bound 
          then
@@ -176808,16 +220607,19 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where
        llpwt: List LpWT := []
        [lts,llpwt]
 
-     transcendentalDecompose(p: P, ts: TS): Record(done: Split, todo: List LpWT) ==
+     transcendentalDecompose(p: P, ts: TS):_
+          Record(done: Split, todo: List LpWT) ==
        lts: Split:= augment(p,ts)
        llpwt: List LpWT := []
        [lts,llpwt]
 
-     internalDecompose(p: P, ts: TS,bound: N,clos?:B): Record(done: Split, todo: List LpWT) ==
+     internalDecompose(p: P, ts: TS,bound: N,clos?:B):_
+          Record(done: Split, todo: List LpWT) ==
        clos? => internalDecompose(p,ts,bound)
        internalDecompose(p,ts)
 
-     internalDecompose(p: P, ts: TS,bound: N): Record(done: Split, todo: List LpWT) ==
+     internalDecompose(p: P, ts: TS,bound: N):_
+           Record(done: Split, todo: List LpWT) ==
        -- ASSUME p not constant
        llpwt: List LpWT := []
        lts: Split := []
@@ -176839,8 +220641,8 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where
                rsl := transcendentalDecompose(p,bwt.tower,bound)
            lts := concat(rsl.done,lts)
            llpwt := concat(rsl.todo,llpwt)
-           -- purelyAlgebraicLeadingMonomial?(ip,bwt.tower) => "leave"  -- UNPROVED CRITERIA
-           purelyAlgebraic?(ip,bwt.tower) and purelyAlgebraic?(bwt.tower) => "leave" -- SAFE
+           purelyAlgebraic?(ip,bwt.tower) and _
+             purelyAlgebraic?(bwt.tower) => "leave" -- SAFE
            (not ground? ip) => 
              zero? tp => llpwt := cons([[ip],bwt.tower]$LpWT, llpwt)
              (not ground? tp) => llpwt := cons([[ip,tp],bwt.tower]$LpWT, llpwt)
@@ -176873,7 +220675,8 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where
                rsl := transcendentalDecompose(p,bwt.tower)
            lts := concat(rsl.done,lts)
            llpwt :=  concat(rsl.todo,llpwt)
-           purelyAlgebraic?(ip,bwt.tower) and purelyAlgebraic?(bwt.tower) => "leave"
+           purelyAlgebraic?(ip,bwt.tower) and _
+             purelyAlgebraic?(bwt.tower) => "leave"
            (not ground? ip) => 
              zero? tp => llpwt := cons([[ip],bwt.tower]$LpWT, llpwt)
              (not ground? tp) => llpwt := cons([[ip,tp],bwt.tower]$LpWT, llpwt)
@@ -176888,12 +220691,13 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where
        decompose(lp,lts,false,false,clos?,true,info?)
 
      convert(lpwt: LpWT): String ==
-       ls: List String := ["<", string((#(lpwt.val))::Z), ",", string((#(lpwt.tower))::Z), ">" ]
+       ls: List String := _
+        ["<", string((#(lpwt.val))::Z), ",", string((#(lpwt.tower))::Z), ">" ]
        concat ls
 
      printInfo(toSee: List LpWT, n: N): Void ==
        lpwt := first toSee
-       s: String := concat ["[", string((#toSee)::Z), " ", convert(lpwt)@String]
+       s: String:= concat ["[", string((#toSee)::Z), " ", convert(lpwt)@String]
        m: N := #(lpwt.val)
        toSee := rest toSee
        for lpwt in toSee repeat
@@ -176903,18 +220707,21 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where
        iprint(s)$iprintpack
        void()
 
-     decompose(lp: LP, lts: Split, cleanW?: B, sqfr?: B, clos?: B, rem?: B, info?: B): Split ==
+     decompose(lp: LP, lts: Split, cleanW?: B, sqfr?: B, clos?: B, _
+               rem?: B, info?: B): Split ==
        -- if cleanW? then REMOVE REDUNDANT COMPONENTS in lts
        -- if sqfr? then SPLIT the system with SQUARE-FREE FACTORIZATION
        -- if clos? then SOLVE in the closure sense 
        -- if rem? then REDUCE the current p by using remainder
        -- if info? then PRINT info
        empty? lp => lts
-       branches: List Branch := prepareDecompose(lp,lts,cleanW?,sqfr?)$quasicomppack
+       branches: List Branch :=
+         prepareDecompose(lp,lts,cleanW?,sqfr?)$quasicomppack
        empty? branches => []
        toSee: List LpWT := [[br.eq,br.tower]$LpWT for br in branches]
        toSave: Split := []
-       if clos? then bound := KrullNumber(lp,lts) else bound := numberOfVariables(lp,lts)
+       if clos? then bound := KrullNumber(lp,lts) _
+                else bound := numberOfVariables(lp,lts)
        while (not empty? toSee) repeat
          if info? then printInfo(toSee,#toSave)
          lpwt := first toSee; toSee := rest toSee
@@ -176932,7 +220739,8 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where
          toSee := upDateBranches(lp,toSave,toSee,rsl,bound)
        removeSuperfluousQuasiComponents(toSave)$quasicomppack
 
-     upDateBranches(leq:LP,lts:Split,current:List LpWT,wip: Wip,n:N): List LpWT ==
+     upDateBranches(leq:LP,lts:Split,current:List LpWT,wip: Wip,n:N):_
+          List LpWT ==
        newBranches: List LpWT := wip.todo
        newComponents: Split := wip.done
        branches1, branches2:  List LpWT 
@@ -176941,21 +220749,15 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where
          us := branch.tower
          #us > n => "leave"
          newleq := sort(infRittWu?,concat(leq,branch.val))
-         --foo := rewriteSetWithReduction(newleq,us,initiallyReduce,initiallyReduced?)
-         --any?(ground?,foo)  => "leave"
          branches1 := cons([newleq,us]$LpWT, branches1)
        for us in newComponents repeat
          #us > n => "leave"
          subQuasiComponent?(us,lts)$quasicomppack => "leave"
-         --newleq := leq
-         --foo := rewriteSetWithReduction(newleq,us,initiallyReduce,initiallyReduced?)
-         --any?(ground?,foo)  => "leave"
          branches2 := cons([leq,us]$LpWT, branches2)
        empty? branches1 => 
          empty? branches2 => current
          concat(branches2, current)
        branches := concat [branches2, branches1, current]
-       -- branches := concat(branches,current)
        removeSuperfluousCases(branches)$quasicomppack
 
 \end{chunk}
@@ -176963,6 +220765,215 @@ RegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation where
 \begin{chunk}{COQ RSDCMPK}
 (* package RSDCMPK *)
 (*
+
+     KrullNumber(lp: LP, lts: Split): N ==
+       ln: List N := [#(ts) for ts in lts]
+       n := #lp + reduce(max,ln)
+
+     numberOfVariables(lp: LP, lts: Split): N ==
+       lv: List V := variables([lp]$PS)
+       for ts in lts repeat lv := concat(variables(ts), lv)
+       # removeDuplicates(lv)
+
+     algebraicDecompose(p: P, ts: TS, clos?: B):_
+            Record(done: Split, todo: List LpWT) ==
+       ground? p =>
+         error " in algebraicDecompose$REGSET: should never happen !"
+       v := mvar(p); n := #ts
+       ts_v_- := collectUnder(ts,v)
+       ts_v_+ := collectUpper(ts,v)
+       ts_v := select(ts,v)::P
+       if mdeg(p) < mdeg(ts_v)
+         then 
+           lgwt := 
+            internalLastSubResultant(ts_v,p,ts_v_-,true,false)$regsetgcdpack
+         else
+           lgwt := 
+            internalLastSubResultant(p,ts_v,ts_v_-,true,false)$regsetgcdpack
+       lts: Split := []
+       llpwt: List LpWT := []
+       for gwt in lgwt repeat
+         g := gwt.val; us := gwt.tower
+         zero? g => 
+           error " in algebraicDecompose$REGSET: should never happen !!"
+         ground? g => "leave"
+         if mvar(g) = v then _
+           lts := concat(augment(members(ts_v_+),augment(g,us)),lts) 
+         h := leadingCoefficient(g,v)
+         b: Boolean := purelyAlgebraic?(us)
+         lsfp := squareFreeFactors(h)$polsetpack
+         lus := augment(members(ts_v_+),augment(ts_v,us)@Split)
+         for f in lsfp repeat
+           ground? f => "leave"
+           b and purelyAlgebraic?(f,us) => "leave"
+           for vs in lus repeat
+              llpwt := cons([[f,p],vs]$LpWT, llpwt)
+       [lts,llpwt]
+
+     transcendentalDecompose(p: P, ts: TS,bound: N):_
+             Record(done: Split, todo: List LpWT) ==
+       lts: Split
+       if #ts < bound 
+         then
+           lts := augment(p,ts)
+         else
+           lts := []
+       llpwt: List LpWT := []
+       [lts,llpwt]
+
+     transcendentalDecompose(p: P, ts: TS):_
+          Record(done: Split, todo: List LpWT) ==
+       lts: Split:= augment(p,ts)
+       llpwt: List LpWT := []
+       [lts,llpwt]
+
+     internalDecompose(p: P, ts: TS,bound: N,clos?:B):_
+          Record(done: Split, todo: List LpWT) ==
+       clos? => internalDecompose(p,ts,bound)
+       internalDecompose(p,ts)
+
+     internalDecompose(p: P, ts: TS,bound: N):_
+           Record(done: Split, todo: List LpWT) ==
+       -- ASSUME p not constant
+       llpwt: List LpWT := []
+       lts: Split := []
+       -- EITHER mvar(p) is null
+       if (not zero? tail(p)) and (not ground? (lmp := leastMonomial(p)))
+         then
+           llpwt := cons([[mvar(p)::P],ts]$LpWT,llpwt)
+           p := (p exquo lmp)::P
+       ip := squareFreePart init(p); tp := tail p
+       p := mainPrimitivePart p
+       -- OR init(p) is null or not
+       lbwt := invertible?(ip,ts)@(List BWT)
+       for bwt in lbwt repeat
+         bwt.val =>
+           if algebraic?(mvar(p),bwt.tower) 
+             then 
+               rsl := algebraicDecompose(p,bwt.tower,true)
+             else
+               rsl := transcendentalDecompose(p,bwt.tower,bound)
+           lts := concat(rsl.done,lts)
+           llpwt := concat(rsl.todo,llpwt)
+           purelyAlgebraic?(ip,bwt.tower) and _
+             purelyAlgebraic?(bwt.tower) => "leave" -- SAFE
+           (not ground? ip) => 
+             zero? tp => llpwt := cons([[ip],bwt.tower]$LpWT, llpwt)
+             (not ground? tp) => llpwt := cons([[ip,tp],bwt.tower]$LpWT, llpwt)
+         riv := removeZero(ip,bwt.tower)
+         (zero? riv) =>
+           zero? tp => lts := cons(bwt.tower,lts)
+           (not ground? tp) => llpwt := cons([[tp],bwt.tower]$LpWT, llpwt)
+         llpwt := cons([[riv * mainMonomial(p) + tp],bwt.tower]$LpWT, llpwt)
+       [lts,llpwt]
+
+     internalDecompose(p: P, ts: TS): Record(done: Split, todo: List LpWT) ==
+       -- ASSUME p not constant
+       llpwt: List LpWT := []
+       lts: Split := []
+       -- EITHER mvar(p) is null
+       if (not zero? tail(p)) and (not ground? (lmp := leastMonomial(p)))
+         then
+           llpwt := cons([[mvar(p)::P],ts]$LpWT,llpwt)
+           p := (p exquo lmp)::P
+       ip := squareFreePart init(p); tp := tail p
+       p := mainPrimitivePart p
+       -- OR init(p) is null or not
+       lbwt := invertible?(ip,ts)@(List BWT)
+       for bwt in lbwt repeat
+         bwt.val =>
+           if algebraic?(mvar(p),bwt.tower) 
+             then 
+               rsl := algebraicDecompose(p,bwt.tower,false)
+             else
+               rsl := transcendentalDecompose(p,bwt.tower)
+           lts := concat(rsl.done,lts)
+           llpwt :=  concat(rsl.todo,llpwt)
+           purelyAlgebraic?(ip,bwt.tower) and _
+             purelyAlgebraic?(bwt.tower) => "leave"
+           (not ground? ip) => 
+             zero? tp => llpwt := cons([[ip],bwt.tower]$LpWT, llpwt)
+             (not ground? tp) => llpwt := cons([[ip,tp],bwt.tower]$LpWT, llpwt)
+         riv := removeZero(ip,bwt.tower)
+         (zero? riv) =>
+           zero? tp => lts := cons(bwt.tower,lts)
+           (not ground? tp) => llpwt := cons([[tp],bwt.tower]$LpWT, llpwt)
+         llpwt := cons([[riv * mainMonomial(p) + tp],bwt.tower]$LpWT, llpwt)
+       [lts,llpwt]
+
+     decompose(lp: LP, lts: Split, clos?: B, info?: B): Split ==
+       decompose(lp,lts,false,false,clos?,true,info?)
+
+     convert(lpwt: LpWT): String ==
+       ls: List String := _
+        ["<", string((#(lpwt.val))::Z), ",", string((#(lpwt.tower))::Z), ">" ]
+       concat ls
+
+     printInfo(toSee: List LpWT, n: N): Void ==
+       lpwt := first toSee
+       s: String:= concat ["[", string((#toSee)::Z), " ", convert(lpwt)@String]
+       m: N := #(lpwt.val)
+       toSee := rest toSee
+       for lpwt in toSee repeat
+         m := m + #(lpwt.val)
+         s := concat [s, ",", convert(lpwt)@String]
+       s := concat [s, " -> |", string(m::Z), "|; {", string(n::Z),"}]"]
+       iprint(s)$iprintpack
+       void()
+
+     decompose(lp: LP, lts: Split, cleanW?: B, sqfr?: B, clos?: B, _
+               rem?: B, info?: B): Split ==
+       -- if cleanW? then REMOVE REDUNDANT COMPONENTS in lts
+       -- if sqfr? then SPLIT the system with SQUARE-FREE FACTORIZATION
+       -- if clos? then SOLVE in the closure sense 
+       -- if rem? then REDUCE the current p by using remainder
+       -- if info? then PRINT info
+       empty? lp => lts
+       branches: List Branch :=
+         prepareDecompose(lp,lts,cleanW?,sqfr?)$quasicomppack
+       empty? branches => []
+       toSee: List LpWT := [[br.eq,br.tower]$LpWT for br in branches]
+       toSave: Split := []
+       if clos? then bound := KrullNumber(lp,lts) _
+                else bound := numberOfVariables(lp,lts)
+       while (not empty? toSee) repeat
+         if info? then printInfo(toSee,#toSave)
+         lpwt := first toSee; toSee := rest toSee
+         lp := lpwt.val; ts := lpwt.tower
+         empty? lp => 
+           toSave := cons(ts, toSave)
+         p := first lp;  lp := rest lp
+         if rem? and (not ground? p) and (not empty? ts)  
+            then 
+              p := remainder(p,ts).polnum
+         p := removeZero(p,ts)
+         zero? p => toSee := cons([lp,ts]$LpWT, toSee)
+         ground? p => "leave"
+         rsl := internalDecompose(p,ts,bound,clos?)
+         toSee := upDateBranches(lp,toSave,toSee,rsl,bound)
+       removeSuperfluousQuasiComponents(toSave)$quasicomppack
+
+     upDateBranches(leq:LP,lts:Split,current:List LpWT,wip: Wip,n:N):_
+          List LpWT ==
+       newBranches: List LpWT := wip.todo
+       newComponents: Split := wip.done
+       branches1, branches2:  List LpWT 
+       branches1 := []; branches2  := []
+       for branch in newBranches repeat
+         us := branch.tower
+         #us > n => "leave"
+         newleq := sort(infRittWu?,concat(leq,branch.val))
+         branches1 := cons([newleq,us]$LpWT, branches1)
+       for us in newComponents repeat
+         #us > n => "leave"
+         subQuasiComponent?(us,lts)$quasicomppack => "leave"
+         branches2 := cons([leq,us]$LpWT, branches2)
+       empty? branches1 => 
+         empty? branches2 => current
+         concat(branches2, current)
+       branches := concat [branches2, branches1, current]
+       removeSuperfluousCases(branches)$quasicomppack
+
 *)
 
 \end{chunk}
@@ -177253,7 +221264,6 @@ RegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation where
      -- ASSUME p is not constant and mvar(p) > mvar(ts)
      -- ASSUME init(p) is invertible w.r.t. ts
      -- ASSUME p is mainly primitive
---       one? mdeg(p) => [[p,ts]$PWT]
        mdeg(p) = 1 => [[p,ts]$PWT]
        v := mvar(p)$P
        q: P := mainPrimitivePart D(p,v)
@@ -177343,7 +221353,7 @@ RegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation where
          toSee := llpwt; llpwt := []
          -- CONSIDER FIRST the vanishing current last subresultant
          for lpwt in toSee repeat 
-           p1 := lpwt.val.1; p2 := lpwt.val.2; s := lpwt.val.3; ts := lpwt.tower
+           p1:= lpwt.val.1; p2 := lpwt.val.2; s := lpwt.val.3; ts := lpwt.tower
            lbwt := toseInvertible?(leadingCoefficient(p2,v),ts)@(List BWT)
            for bwt in lbwt repeat
              bwt.val = false => 
@@ -177393,6 +221403,265 @@ RegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation where
 \begin{chunk}{COQ RSETGCD}
 (* package RSETGCD *)
 (*
+
+     startTableGcd!(ok: S, ko: S, domainName: S): Void == 
+       initTable!()$HGcd
+       printInfo!(ok,ko)$HGcd
+       startStats!(domainName)$HGcd
+       void()
+
+     stopTableGcd!(): Void ==   
+       if makingStats?()$HGcd then printStats!()$HGcd
+       clearTable!()$HGcd
+
+     startTableInvSet!(ok: S, ko: S, domainName: S): Void == 
+       initTable!()$HInvSet
+       printInfo!(ok,ko)$HInvSet
+       startStats!(domainName)$HInvSet
+       void()
+
+     stopTableInvSet!(): Void ==   
+       if makingStats?()$HInvSet then printStats!()$HInvSet
+       clearTable!()$HInvSet
+
+     toseInvertible?(p:P,ts:TS): Boolean == 
+       q := primitivePart initiallyReduce(p,ts)
+       zero? q => false
+       normalized?(q,ts) => true
+       v := mvar(q)
+       not algebraic?(v,ts) => 
+         toCheck: List BWT := toseInvertible?(p,ts)@(List BWT)
+         for bwt in toCheck repeat
+           bwt.val = false => return false
+         return true
+       ts_v := select(ts,v)::P
+       ts_v_- := collectUnder(ts,v)
+       lgwt := internalLastSubResultant(ts_v,q,ts_v_-,false,true)
+       for gwt in lgwt repeat
+         g := gwt.val; 
+         (not ground? g) and (mvar(g) = v) => 
+           return false
+       true
+       
+     toseInvertible?(p:P,ts:TS): List BWT ==
+       q := primitivePart initiallyReduce(p,ts)
+       zero? q => [[false,ts]$BWT]
+       normalized?(q,ts) => [[true,ts]$BWT]
+       v := mvar(q)
+       not algebraic?(v,ts) => 
+         lbwt: List BWT := []
+         toCheck: List BWT := toseInvertible?(init(q),ts)@(List BWT)
+         for bwt in toCheck repeat
+           bwt.val => lbwt := cons(bwt,lbwt)
+           newq := removeZero(q,bwt.tower)
+           zero? newq => lbwt := cons(bwt,lbwt)
+           lbwt := concat(toseInvertible?(newq,bwt.tower)@(List BWT), lbwt)
+         return lbwt
+       ts_v := select(ts,v)::P
+       ts_v_- := collectUnder(ts,v)
+       ts_v_+ := collectUpper(ts,v)
+       lgwt := internalLastSubResultant(ts_v,q,ts_v_-,false,false)
+       lbwt: List BWT := []
+       for gwt in lgwt repeat
+         g := gwt.val; ts := gwt.tower
+         (ground? g) or (mvar(g) < v) => 
+           ts := internalAugment(ts_v,ts)
+           ts := internalAugment(members(ts_v_+),ts)
+           lbwt := cons([true, ts]$BWT,lbwt)
+         g := mainPrimitivePart g
+         ts_g := internalAugment(g,ts)
+         ts_g := internalAugment(members(ts_v_+),ts_g)
+         -- USE internalAugment with parameters ??
+         lbwt := cons([false, ts_g]$BWT,lbwt)
+         h := lazyPquo(ts_v,g)
+         (ground? h) or (mvar(h) < v) => "leave"
+         h := mainPrimitivePart h
+         ts_h := internalAugment(h,ts)
+         ts_h := internalAugment(members(ts_v_+),ts_h)
+         -- USE internalAugment with parameters ??
+         -- CAN BE OPTIMIZED if the input tower is separable
+         inv := toseInvertible?(q,ts_h)@(List BWT)
+         lbwt := concat([bwt for bwt in inv | bwt.val],lbwt)
+       sort((x,y) +-> x.val < y.val,lbwt)
+
+     toseInvertibleSet(p:P,ts:TS): Split ==
+       k: KeyInvSet := [p,ts]
+       e := extractIfCan(k)$HInvSet
+       e case EntryInvSet => e::EntryInvSet
+       q := primitivePart initiallyReduce(p,ts)
+       zero? q => []
+       normalized?(q,ts) => [ts]
+       v := mvar(q)
+       toSave: Split := []
+       not algebraic?(v,ts) => 
+         toCheck: List BWT := toseInvertible?(init(q),ts)@(List BWT)
+         for bwt in toCheck repeat
+           bwt.val => toSave := cons(bwt.tower,toSave)
+           newq := removeZero(q,bwt.tower)
+           zero? newq => "leave"
+           toSave := concat(toseInvertibleSet(newq,bwt.tower), toSave)
+         toSave := removeDuplicates toSave
+         return algebraicSort(toSave)$quasicomppack
+       ts_v := select(ts,v)::P
+       ts_v_- := collectUnder(ts,v)
+       ts_v_+ := collectUpper(ts,v)
+       lgwt := internalLastSubResultant(ts_v,q,ts_v_-,false,false)
+       for gwt in lgwt repeat
+         g := gwt.val; ts := gwt.tower
+         (ground? g) or (mvar(g) < v) => 
+           ts := internalAugment(ts_v,ts)
+           ts := internalAugment(members(ts_v_+),ts)
+           toSave := cons(ts,toSave)
+         g := mainPrimitivePart g
+         h := lazyPquo(ts_v,g)
+         h := mainPrimitivePart h
+         (ground? h) or (mvar(h) < v) => "leave"
+         ts_h := internalAugment(h,ts)
+         ts_h := internalAugment(members(ts_v_+),ts_h)
+         inv := toseInvertibleSet(q,ts_h)
+         toSave := removeDuplicates concat(inv,toSave)
+       toSave := algebraicSort(toSave)$quasicomppack
+       insert!(k,toSave)$HInvSet
+       toSave
+
+     toseSquareFreePart_wip(p:P, ts: TS): List PWT ==
+     -- ASSUME p is not constant and mvar(p) > mvar(ts)
+     -- ASSUME init(p) is invertible w.r.t. ts
+     -- ASSUME p is mainly primitive
+       mdeg(p) = 1 => [[p,ts]$PWT]
+       v := mvar(p)$P
+       q: P := mainPrimitivePart D(p,v)
+       lgwt: List PWT := internalLastSubResultant(p,q,ts,true,false)
+       lpwt : List PWT := []
+       sfp : P
+       for gwt in lgwt repeat
+         g := gwt.val; us := gwt.tower
+         (ground? g) or (mvar(g) < v) =>
+           lpwt := cons([p,us],lpwt)
+         g := mainPrimitivePart g
+         sfp := lazyPquo(p,g)
+         sfp := mainPrimitivePart stronglyReduce(sfp,us)
+         lpwt := cons([sfp,us],lpwt)
+       lpwt
+
+     toseSquareFreePart_base(p:P, ts: TS): List PWT == [[p,ts]$PWT]
+
+     toseSquareFreePart(p:P, ts: TS): List PWT == toseSquareFreePart_wip(p,ts)
+
+     prepareSubResAlgo(p1:P,p2:P,ts:TS): List LpWT ==
+       -- ASSUME mvar(p1) = mvar(p2) > mvar(ts) and mdeg(p1) >= mdeg(p2)
+       -- ASSUME init(p1) invertible modulo ts !!!
+       toSee: List LpWT := [[[p1,p2],ts]$LpWT]
+       toSave: List LpWT := []
+       v := mvar(p1)
+       while (not empty? toSee) repeat
+         lpwt := first toSee; toSee := rest toSee
+         p1 := lpwt.val.1; p2 := lpwt.val.2
+         ts := lpwt.tower
+         lbwt := toseInvertible?(leadingCoefficient(p2,v),ts)@(List BWT)
+         for bwt in lbwt repeat
+           (bwt.val = true) and (degree(p2,v) > 0) =>
+             p3 := prem(p1, -p2)
+             s: P := init(p2)**(mdeg(p1) - mdeg(p2))::N
+             toSave := cons([[p2,p3,s],bwt.tower]$LpWT,toSave)
+           -- p2 := initiallyReduce(p2,bwt.tower)
+           newp2 := primitivePart initiallyReduce(p2,bwt.tower)
+           (bwt.val = true) =>
+             -- toSave := cons([[p2,0,1],bwt.tower]$LpWT,toSave)
+             toSave := cons([[p2,0,1],bwt.tower]$LpWT,toSave)
+           -- zero? p2 => 
+           zero? newp2 => 
+             toSave := cons([[p1,0,1],bwt.tower]$LpWT,toSave)
+           -- toSee := cons([[p1,p2],ts]$LpWT,toSee)
+           toSee := cons([[p1,newp2],bwt.tower]$LpWT,toSee)
+       toSave
+
+     integralLastSubResultant(p1:P,p2:P,ts:TS): List PWT ==
+       -- ASSUME mvar(p1) = mvar(p2) > mvar(ts) and mdeg(p1) >= mdeg(p2)
+       -- ASSUME p1 and p2 have no algebraic coefficients
+       lsr := lastSubResultant(p1, p2)
+       ground?(lsr) => [[lsr,ts]$PWT]
+       mvar(lsr) < mvar(p1) => [[lsr,ts]$PWT]
+       gi1i2 := gcd(init(p1),init(p2))
+       ex: Union(P,"failed") := (gi1i2 * lsr) exquo$P init(lsr)
+       ex case "failed" => [[lsr,ts]$PWT]
+       [[ex::P,ts]$PWT]
+            
+     internalLastSubResultant(p1:P,p2:P,ts:TS,b1:B,b2:B): List PWT ==
+       -- ASSUME mvar(p1) = mvar(p2) > mvar(ts) and mdeg(p1) >= mdeg(p2)
+       -- if b1 ASSUME init(p2) invertible w.r.t. ts
+       -- if b2 BREAK with the first non-trivial gcd 
+       k: KeyGcd := [p1,p2,ts,b2]
+       e := extractIfCan(k)$HGcd
+       e case EntryGcd => e::EntryGcd
+       toSave: List PWT 
+       empty? ts => 
+         toSave := integralLastSubResultant(p1,p2,ts)
+         insert!(k,toSave)$HGcd
+         return toSave
+       toSee: List LpWT 
+       if b1
+         then
+           p3 := prem(p1, -p2)
+           s: P := init(p2)**(mdeg(p1) - mdeg(p2))::N
+           toSee := [[[p2,p3,s],ts]$LpWT]
+         else
+           toSee := prepareSubResAlgo(p1,p2,ts)
+       toSave := internalLastSubResultant(toSee,mvar(p1),b2)
+       insert!(k,toSave)$HGcd
+       toSave
+
+     internalLastSubResultant(llpwt: List LpWT,v:V,b2:B): List PWT ==
+       toReturn: List PWT := []; toSee: List LpWT; 
+       while (not empty? llpwt) repeat
+         toSee := llpwt; llpwt := []
+         -- CONSIDER FIRST the vanishing current last subresultant
+         for lpwt in toSee repeat 
+           p1:= lpwt.val.1; p2 := lpwt.val.2; s := lpwt.val.3; ts := lpwt.tower
+           lbwt := toseInvertible?(leadingCoefficient(p2,v),ts)@(List BWT)
+           for bwt in lbwt repeat
+             bwt.val = false => 
+               toReturn := cons([p1,bwt.tower]$PWT, toReturn)
+               b2 and positive?(degree(p1,v)) => return toReturn
+             llpwt := cons([[p1,p2,s],bwt.tower]$LpWT, llpwt)
+         empty? llpwt => "leave"
+         -- CONSIDER NOW the branches where the computations continue
+         toSee := llpwt; llpwt := []
+         lpwt := first toSee; toSee := rest toSee
+         p1 := lpwt.val.1; p2 := lpwt.val.2; s := lpwt.val.3
+         delta: N := (mdeg(p1) - degree(p2,v))::N
+         p3: P := LazardQuotient2(p2, leadingCoefficient(p2,v), s, delta)
+         zero?(degree(p3,v)) =>
+           toReturn := cons([p3,lpwt.tower]$PWT, toReturn)
+           for lpwt in toSee repeat 
+             toReturn := cons([p3,lpwt.tower]$PWT, toReturn)
+         (p1, p2) := (p3, next_subResultant2(p1, p2, p3, s))
+         s := leadingCoefficient(p1,v)
+         llpwt := cons([[p1,p2,s],lpwt.tower]$LpWT, llpwt)
+         for lpwt in toSee repeat 
+           llpwt := cons([[p1,p2,s],lpwt.tower]$LpWT, llpwt)
+       toReturn
+
+     toseLastSubResultant(p1:P,p2:P,ts:TS): List PWT ==
+       ground? p1 => 
+         error"in toseLastSubResultantElseSplit$TOSEGCD  : bad #1"
+       ground? p2 => 
+         error"in toseLastSubResultantElseSplit$TOSEGCD : bad #2"
+       not (mvar(p2) = mvar(p1)) => 
+         error"in toseLastSubResultantElseSplit$TOSEGCD : bad #2"
+       algebraic?(mvar(p1),ts) =>
+         error"in toseLastSubResultantElseSplit$TOSEGCD : bad #1"
+       not initiallyReduced?(p1,ts) => 
+         error"in toseLastSubResultantElseSplit$TOSEGCD : bad #1"
+       not initiallyReduced?(p2,ts) => 
+         error"in toseLastSubResultantElseSplit$TOSEGCD : bad #2"
+       purelyTranscendental?(p1,ts) and purelyTranscendental?(p2,ts) =>
+         integralLastSubResultant(p1,p2,ts)
+       if mdeg(p1) < mdeg(p2) then 
+          (p1, p2) := (p2, p1)
+          if odd?(mdeg(p1)) and odd?(mdeg(p2)) then p2 := - p2
+       internalLastSubResultant(p1,p2,ts,false,false)
+
 *)
 
 \end{chunk}
@@ -177467,10 +221736,11 @@ RepeatedDoubling(S):Exports ==Implementation where
      double: (PositiveInteger,S) -> S 
        ++ double(i, r) multiplies r by i using repeated doubling.
    Implementation == add
+
      x: S
      n: PositiveInteger
+
      double(n,x) ==
---        one? n => x
         (n = 1) => x
         odd?(n)$Integer =>
            x + double(shift(n,-1) pretend PositiveInteger,(x+x))
@@ -177481,6 +221751,16 @@ RepeatedDoubling(S):Exports ==Implementation where
 \begin{chunk}{COQ REPDB}
 (* package REPDB *)
 (*
+
+     x: S
+     n: PositiveInteger
+
+     double(n,x) ==
+        (n = 1) => x
+        odd?(n)$Integer =>
+           x + double(shift(n,-1) pretend PositiveInteger,(x+x))
+        double(shift(n,-1) pretend PositiveInteger,(x+x))
+
 *)
 
 \end{chunk}
@@ -177570,10 +221850,11 @@ RepeatedSquaring(S): Exports == Implementation where
      expt: (S,PositiveInteger) -> S 
        ++ expt(r, i) computes r**i  by repeated squaring
    Implementation == add
+
      x: S
      n: PositiveInteger
+
      expt(x, n) ==
---        one? n => x
         (n = 1) => x
         odd?(n)$Integer=> x * expt(x*x,shift(n,-1) pretend PositiveInteger)
         expt(x*x,shift(n,-1) pretend PositiveInteger)
@@ -177583,6 +221864,15 @@ RepeatedSquaring(S): Exports == Implementation where
 \begin{chunk}{COQ REPSQ}
 (* package REPSQ *)
 (*
+
+     x: S
+     n: PositiveInteger
+
+     expt(x, n) ==
+        (n = 1) => x
+        odd?(n)$Integer=> x * expt(x*x,shift(n,-1) pretend PositiveInteger)
+        expt(x*x,shift(n,-1) pretend PositiveInteger)
+
 *)
 
 \end{chunk}
@@ -177812,28 +222102,23 @@ RepresentationPackage1(R): public == private where
  
      -- declaration of local functions:
  
- 
      calcCoef : (L I, M I) -> I
        -- calcCoef(beta,C) calculates the term
        -- |S(beta) gamma S(alpha)| / |S(beta)|
  
- 
      invContent : L I -> V I
        -- invContent(alpha) calculates the weak monoton function f with
        -- f : m -> n with invContent alpha. f is stored in the returned
        -- vector
  
- 
      -- definition of local functions
  
- 
      calcCoef(beta,C) ==
        prod : I := 1
        for i in 1..maxIndex beta repeat
          prod := prod * multinomial(beta(i), entries row(C,i))$ICF
        prod
  
- 
      invContent(alpha) ==
        n : NNI := (+/alpha)::NNI
        f : V I  := new(n,0)
@@ -177846,14 +222131,11 @@ RepresentationPackage1(R): public == private where
            i := i + 1
        f
  
- 
      -- exported functions:
  
- 
- 
      if R has commutative("*") then
+
        antisymmetricTensors ( a : M R , k : PI ) ==
- 
          n      : NNI   := nrows a
          k = 1 => a
          k > n =>
@@ -177875,27 +222157,22 @@ RepresentationPackage1(R): public == private where
              setelt(b, i, j, determinant c)
          b
  
- 
      if R has commutative("*") then
+
        antisymmetricTensors(la: L M R, k: PI) ==
          [antisymmetricTensors(ma,k) for ma in la]
  
- 
- 
      symmetricTensors (a : M R, n : PI) ==
- 
        m : NNI := nrows a
        m ^= ncols a =>
          error("Input to symmetricTensors is no square matrix")
        n = 1 => a
- 
        dim : NNI := (binomial(m+n-1,n)$ICF)::NNI
        c : M R := new(dim,dim,0)
        f : V I := new(n,0)
        g : V I := new(n,0)
        nullMatrix : M I := new(1,1,0)
        colemanMatrix : M I
- 
        for i in 1..dim repeat
          -- unrankImproperPartitions1 starts counting from 0
          alpha := unrankImproperPartitions1(n,m,i-1)$SGCF
@@ -177915,14 +222192,11 @@ RepresentationPackage1(R): public == private where
            -- end of while
          -- end of j-loop
        -- end of i-loop
- 
        c
  
- 
      symmetricTensors(la : L M R, k : PI) ==
        [symmetricTensors (ma, k) for ma in la]
  
- 
      tensorProduct(a: M R, b: M R) ==
        n      : NNI := nrows a
        m      : NNI := nrows b
@@ -177940,11 +222214,9 @@ RepresentationPackage1(R): public == private where
              indexr := indexr + 1
        c
  
- 
      tensorProduct (la: L M R, lb: L M R) ==
        [tensorProduct(la.i, lb.i) for i in 1..maxIndex la]
  
- 
      tensorProduct(a : M R) == tensorProduct(a, a)
  
      tensorProduct(la : L M R) ==
@@ -177957,7 +222229,6 @@ RepresentationPackage1(R): public == private where
           a(eval(p,i)$(PERM I),i) := 1
        a
  
- 
      permutationRepresentation (p : L I) ==
        -- permutations are assumed to permute {1,2,...,n}
        n : I := #p
@@ -177966,7 +222237,6 @@ RepresentationPackage1(R): public == private where
           a(p.i,i) := 1
        a
  
- 
      permutationRepresentation(listperm : L PERM I, n : I) ==
        -- permutations are assumed to permute {1,2,...,n}
        [permutationRepresentation(perm, n) for perm in listperm]
@@ -177991,6 +222261,167 @@ RepresentationPackage1(R): public == private where
 \begin{chunk}{COQ REP1}
 (* package REP1 *)
 (*
+ 
+     -- import of domains and packages
+ 
+     import OutputForm
+ 
+     -- declaration of local functions:
+ 
+     calcCoef : (L I, M I) -> I
+       -- calcCoef(beta,C) calculates the term
+       -- |S(beta) gamma S(alpha)| / |S(beta)|
+ 
+     invContent : L I -> V I
+       -- invContent(alpha) calculates the weak monoton function f with
+       -- f : m -> n with invContent alpha. f is stored in the returned
+       -- vector
+ 
+     -- definition of local functions
+ 
+     calcCoef(beta,C) ==
+       prod : I := 1
+       for i in 1..maxIndex beta repeat
+         prod := prod * multinomial(beta(i), entries row(C,i))$ICF
+       prod
+ 
+     invContent(alpha) ==
+       n : NNI := (+/alpha)::NNI
+       f : V I  := new(n,0)
+       i : NNI := 1
+       j : I   := - 1
+       for og in alpha repeat
+         j := j + 1
+         for k in 1..og repeat
+           f(i) := j
+           i := i + 1
+       f
+ 
+     -- exported functions:
+ 
+     if R has commutative("*") then
+
+       antisymmetricTensors ( a : M R , k : PI ) ==
+         n      : NNI   := nrows a
+         k = 1 => a
+         k > n =>
+           error("second parameter for antisymmetricTensors is too large")
+         m      :   I   := binomial(n,k)$ICF
+         il     : L L I   := [subSet(n,k,i)$SGCF for i in 0..m-1]
+         b      :  M R   := zero(m::NNI, m::NNI)
+         for i in 1..m repeat
+           for j in 1..m repeat
+             c : M R := zero(k,k)
+             lr: L I := il.i
+             lt: L I := il.j
+             for  r in 1..k repeat
+               for t in 1..k repeat
+                 rr : I := lr.r
+                 tt : I := lt.t
+                 --c.r.t := a.(1+rr).(1+tt)
+                 setelt(c,r,t,elt(a, 1+rr, 1+tt))
+             setelt(b, i, j, determinant c)
+         b
+ 
+     if R has commutative("*") then
+
+       antisymmetricTensors(la: L M R, k: PI) ==
+         [antisymmetricTensors(ma,k) for ma in la]
+ 
+     symmetricTensors (a : M R, n : PI) ==
+       m : NNI := nrows a
+       m ^= ncols a =>
+         error("Input to symmetricTensors is no square matrix")
+       n = 1 => a
+       dim : NNI := (binomial(m+n-1,n)$ICF)::NNI
+       c : M R := new(dim,dim,0)
+       f : V I := new(n,0)
+       g : V I := new(n,0)
+       nullMatrix : M I := new(1,1,0)
+       colemanMatrix : M I
+       for i in 1..dim repeat
+         -- unrankImproperPartitions1 starts counting from 0
+         alpha := unrankImproperPartitions1(n,m,i-1)$SGCF
+         f := invContent(alpha)
+         for j in 1..dim repeat
+           -- unrankImproperPartitions1 starts counting from 0
+           beta := unrankImproperPartitions1(n,m,j-1)$SGCF
+           g := invContent(beta)
+           colemanMatrix := nextColeman(alpha,beta,nullMatrix)$SGCF
+           while colemanMatrix ^= nullMatrix repeat
+             gamma := inverseColeman(alpha,beta,colemanMatrix)$SGCF
+             help : R := calcCoef(beta,colemanMatrix)::R
+             for k in 1..n repeat
+               help := help * a( (1+f k)::NNI, (1+g(gamma k))::NNI )
+             c(i,j) := c(i,j) + help
+             colemanMatrix := nextColeman(alpha,beta,colemanMatrix)$SGCF
+           -- end of while
+         -- end of j-loop
+       -- end of i-loop
+       c
+ 
+     symmetricTensors(la : L M R, k : PI) ==
+       [symmetricTensors (ma, k) for ma in la]
+ 
+     tensorProduct(a: M R, b: M R) ==
+       n      : NNI := nrows a
+       m      : NNI := nrows b
+       nc     : NNI := ncols a
+       mc     : NNI := ncols b
+       c      : M R   := zero(n * m, nc * mc)
+       indexr : NNI := 1                             --   row index
+       for i in 1..n repeat
+          for k in 1..m repeat
+             indexc : NNI := 1                       --   column index
+             for j in 1..nc repeat
+                for l in 1..mc repeat
+                   c(indexr,indexc) := a(i,j) * b(k,l)
+                   indexc          := indexc + 1
+             indexr := indexr + 1
+       c
+ 
+     tensorProduct (la: L M R, lb: L M R) ==
+       [tensorProduct(la.i, lb.i) for i in 1..maxIndex la]
+ 
+     tensorProduct(a : M R) == tensorProduct(a, a)
+ 
+     tensorProduct(la : L M R) ==
+       tensorProduct(la :: L M R, la :: L M R)
+ 
+     permutationRepresentation (p : PERM I, n : I) ==
+       -- permutations are assumed to permute {1,2,...,n}
+       a : M I := zero(n :: NNI, n :: NNI)
+       for i in 1..n repeat
+          a(eval(p,i)$(PERM I),i) := 1
+       a
+ 
+     permutationRepresentation (p : L I) ==
+       -- permutations are assumed to permute {1,2,...,n}
+       n : I := #p
+       a : M I := zero(n::NNI, n::NNI)
+       for i in 1..n repeat
+          a(p.i,i) := 1
+       a
+ 
+     permutationRepresentation(listperm : L PERM I, n : I) ==
+       -- permutations are assumed to permute {1,2,...,n}
+       [permutationRepresentation(perm, n) for perm in listperm]
+ 
+     permutationRepresentation (listperm : L L I) ==
+       -- permutations are assumed to permute {1,2,...,n}
+       [permutationRepresentation perm for perm in listperm]
+ 
+     createGenericMatrix(m) ==
+       res : M P R := new(m,m,0$(P R))
+       for i in 1..m repeat
+         for j in 1..m repeat
+            iof : OF := coerce(i)$Integer
+            jof : OF := coerce(j)$Integer
+            le : L OF := cons(iof,list jof)
+            sy : Symbol := subscript(x::Symbol, le)$Symbol
+            res(i,j) := (sy :: P R)
+       res
+
 *)
 
 \end{chunk}
@@ -178304,19 +222735,19 @@ RepresentationPackage2(R): public == private where
     -- declarations and definitions of local variables and
     -- local function
  
+    -- blockMultiply(a,b,li,n) assumes that a has n columns
+    -- and b has n rows, li is a sublist of the rows of a and
+    -- a sublist of the columns of b. The result is the
+    -- multiplication of the (li x n) part of a with the
+    -- (n x li) part of b. We need this, because just matrix
+    -- multiplying the parts would require extra storage.
     blockMultiply: (M R, M R, L I, I) -> M R
-      -- blockMultiply(a,b,li,n) assumes that a has n columns
-      -- and b has n rows, li is a sublist of the rows of a and
-      -- a sublist of the columns of b. The result is the
-      -- multiplication of the (li x n) part of a with the
-      -- (n x li) part of b. We need this, because just matrix
-      -- multiplying the parts would require extra storage.
     blockMultiply(a, b, li, n) ==
       matrix([[ +/[a(i,s) * b(s,j) for s in 1..n ] _
         for j in li  ]  for i in li])
  
+    -- is local, because one should know all the results for smaller i
     fingerPrint: (NNI, M R, M R, M R) -> M R
-      -- is local, because one should know all the results for smaller i
     fingerPrint (i : NNI, a : M R, b : M R, x :M R) ==
       -- i > 2 only gives the correct result if the value of x from
       -- the parameter list equals the result of fingerprint(i-1,...)
@@ -178329,22 +222760,11 @@ RepresentationPackage2(R): public == private where
       error "Sorry, but there are only 6 fingerprints!"
       x
  
- 
-    -- definition of exported functions
- 
- 
-    --randomWord(lli,lm)  ==
-    --  -- we assume that all matrices are square of same size
-    --  numberOfMatrices := #lm
-    --  +/[*/[lm.(1+i rem numberOfMatrices) for i in li ] for li in lli]
- 
     completeEchelonBasis(basis) ==
- 
       dimensionOfSubmodule : NNI := #basis
       n : NNI := # basis.1
       indexOfVectorToBeScanned : NNI := 1
       row : NNI := dimensionOfSubmodule
- 
       completedBasis : M R := zero(n, n)
       for i in 1..dimensionOfSubmodule repeat
         completedBasis := setRow_!(completedBasis, i, basis.i)
@@ -178362,7 +222782,6 @@ RepresentationPackage2(R): public == private where
           completedBasis(j,j) := 1  --put unit vector into basis
       completedBasis
  
- 
     createRandomElement(aG,algElt) ==
       numberOfGenerators : NNI := #aG
       -- randomIndex := randnum numberOfGenerators
@@ -178372,8 +222791,8 @@ RepresentationPackage2(R): public == private where
       randomIndex := 1+(random()$Integer rem numberOfGenerators)
       algElt + aG.randomIndex
  
- 
     if R has EuclideanDomain then
+
       cyclicSubmodule (lm : L M R, v : V R)  ==
         basis : M R := rowEchelon matrix list entries v
         -- normalizing the vector
@@ -178400,7 +222819,6 @@ RepresentationPackage2(R): public == private where
              furtherElts := rest furtherElts
         vector [row(basis, i) for i in 1..maxRowIndex basis]
  
- 
       standardBasisOfCyclicSubmodule (lm : L M R, v : V R)  ==
         dim   : NNI := #v
         standardBasis : L L R := list(entries v)
@@ -178430,14 +222848,12 @@ RepresentationPackage2(R): public == private where
              furtherElts := rest furtherElts
         transpose matrix standardBasis
  
- 
     if R has Field then  -- only because of inverse in Matrix
  
       -- as conditional local functions, *internal have to be here
  
       splitInternal: (L M R, V R, B) -> L L M R
       splitInternal(algebraGenerators : L M R, vector: V R,doSplitting? : B) ==
- 
         n : I := # vector    -- R-rank of representation module =
                                -- degree of representation
         submodule : V V R := cyclicSubmodule (algebraGenerators,vector)
@@ -178473,17 +222889,18 @@ RepresentationPackage2(R): public == private where
           messagePrint "  The generated cyclic submodule was not proper"
           [algebraGenerators]
  
- 
- 
       irreducibilityTestInternal: (L M R, M R, B) -> L L M R
       irreducibilityTestInternal(algebraGenerators,_
           singularMatrix,split?) ==
         algebraGeneratorsTranspose : L M R := [transpose _
            algebraGenerators.j for j in 1..maxIndex algebraGenerators]
         xt : M R := transpose singularMatrix
-        messagePrint "  We know that all the cyclic submodules generated by all"
-        messagePrint "    non-trivial element of the singular matrix under view are"
-        messagePrint "    not proper, hence Norton's irreducibility test can be done:"
+        messagePrint _
+         "  We know that all the cyclic submodules generated by all"
+        messagePrint _
+         "    non-trivial element of the singular matrix under view are"
+        messagePrint _
+         "    not proper, hence Norton's irreducibility test can be done:"
         -- actually we only would need one (!) non-trivial element from
         -- the kernel of xt, such an element must exist as the transpose
         -- of a singular matrix is of course singular. Question: Can
@@ -178500,7 +222917,8 @@ RepresentationPackage2(R): public == private where
              messagePrint "    whether it is absolutely irreducible"
         else
           if split? then
-            messagePrint "  Representation is not irreducible and it will be split:"
+            messagePrint _
+             "  Representation is not irreducible and it will be split:"
             -- these are the dual representations, so calculate the
             -- dual to get the desired result, i.e. "transpose inverse"
             -- improvements??
@@ -178510,24 +222928,20 @@ RepresentationPackage2(R): public == private where
                 result.i.j := _
                   transpose autoCoerce(inverse mat)$Union(M R,"failed")
           else
-            messagePrint "  Representation is not irreducible, use meatAxe to split"
+            messagePrint _
+             "  Representation is not irreducible, use meatAxe to split"
         -- if "split?" then dual representation interchange factor
         -- and submodules, hence reverse
         reverse result
  
- 
- 
       -- exported functions for FiniteField-s.
  
- 
       areEquivalent? (aG0, aG1) ==
         areEquivalent? (aG0, aG1, true, 25)
  
- 
       areEquivalent? (aG0, aG1, numberOfTries) ==
         areEquivalent? (aG0, aG1, true, numberOfTries)
  
- 
       areEquivalent? (aG0, aG1, randomelements, numberOfTries) ==
           result : B := false
           transitionM : M R := zero(1, 1)
@@ -178592,7 +223006,7 @@ RepresentationPackage2(R): public == private where
             baseChange1 : M R := standardBasisOfCyclicSubmodule(_
               aG1,kernel1.1)
             (ncols baseChange0) ^= (ncols baseChange1) =>
-              messagePrint  "  Dimensions of generated cyclic submodules differ"
+              messagePrint "  Dimensions of generated cyclic submodules differ"
               foundResult := true
               result := false
             -- can assume that dimensions of cyclic submodules are equal
@@ -178605,10 +223019,12 @@ RepresentationPackage2(R): public == private where
                 if (aG0.j*transitionM) ^= (transitionM*aG1.j) then
                   result := false
                   transitionM := zero(1 ,1)
-                  messagePrint "  There is no isomorphism, as the only possible one"
+                  messagePrint _
+                   "  There is no isomorphism, as the only possible one"
                   messagePrint "    fails to do the necessary base change"
             -- can assume that dimensions of cyclic submodules are not "n"
-            messagePrint  "  Generated cyclic submodules have equal, but not full"
+            messagePrint _
+              "  Generated cyclic submodules have equal, but not full"
             messagePrint  "    dimension, hence we can not draw any conclusion"
           -- here ends the for-loop
           if not foundResult then
@@ -178624,10 +223040,8 @@ RepresentationPackage2(R): public == private where
               messagePrint  "Representations are not equivalent."
           transitionM
  
- 
       isAbsolutelyIrreducible?(aG) == isAbsolutelyIrreducible?(aG,25)
  
- 
       isAbsolutelyIrreducible?(aG, numberOfTries) ==
         result : B := false
         numberOfGenerators  : NNI := #aG
@@ -178657,8 +223071,8 @@ RepresentationPackage2(R): public == private where
             messagePrint "  one-dimensional kernel"
             kernel : L V R := nullSpace x
             if n=#cyclicSubmodule(aG, first kernel) then
-              result := (irreducibilityTestInternal(aG,x,false)).1 ^= nil()$(L M R)
-              -- result := not null? first irreducibilityTestInternal(aG,x,false) -- this down't compile !!
+              result := (irreducibilityTestInternal(aG,x,false)).1 ^= nil()_
+                 $(L M R)
             else -- we found a proper submodule
               result := false
               --split(aG,kernel.1) -- to get the splitting
@@ -178676,13 +223090,10 @@ RepresentationPackage2(R): public == private where
         --    messagePrint "Representation is irreducible."
         result
  
- 
- 
       split(algebraGenerators: L M R, vector: V R) ==
         splitInternal(algebraGenerators, vector, true)
  
- 
-      split(algebraGenerators : L M R, submodule: V V R) == --not zero submodule
+      split(algebraGenerators : L M R, submodule: V V R)== --not zero submodule
         n : NNI := #submodule.1 -- R-rank of representation module =
                                 -- degree of representation
         rankOfSubmodule : I := (#submodule) :: I --R-Rank of submodule
@@ -178757,7 +223168,8 @@ RepresentationPackage2(R): public == private where
               if randomelements then
                  messagePrint "Random element in generated algebra is singular"
               else
-                 messagePrint "Fingerprint element in generated algebra is singular"
+                 messagePrint _
+                  "Fingerprint element in generated algebra is singular"
               kernel : L V R := nullSpace x
               -- the first number is the maximal number of one dimensional
               -- subspaces of the kernel, the second is a user given
@@ -178792,9 +223204,11 @@ RepresentationPackage2(R): public == private where
               -- here ends the inner for-loop
             else  -- x non-singular
               if randomelements then
-                messagePrint "Random element in generated algebra is non-singular"
+                messagePrint _
+                 "Random element in generated algebra is non-singular"
               else
-                messagePrint "Fingerprint element in generated algebra is non-singular"
+                messagePrint _
+                 "Fingerprint element in generated algebra is non-singular"
           -- here ends the outer for-loop
           if not foundResult then
              result : L L M R := [nil()$(L M R), nil()$(L M R)]
@@ -178803,21 +223217,16 @@ RepresentationPackage2(R): public == private where
              messagePrint "  or consider using an extension field."
           result
  
- 
         meatAxe (algebraGenerators) ==
           meatAxe(algebraGenerators, false, 25, 7)
  
- 
         meatAxe (algebraGenerators, randomElements?) ==
           randomElements? => meatAxe (algebraGenerators, true, 25, 7)
           meatAxe(algebraGenerators, false, 6, 7)
  
- 
         meatAxe (algebraGenerators:L M R, numberOfTries:PI) ==
           meatAxe (algebraGenerators, true, numberOfTries, 7)
  
- 
- 
         scanOneDimSubspaces(basis,n) ==
           -- "dimension" of subspace generated by "basis"
           dim : NNI := #basis
@@ -178849,6 +223258,531 @@ RepresentationPackage2(R): public == private where
 \begin{chunk}{COQ REP2}
 (* package REP2 *)
 (*
+ 
+    -- import of domain and packages
+    import OutputForm
+ 
+    -- declarations and definitions of local variables and
+    -- local function
+ 
+    -- blockMultiply(a,b,li,n) assumes that a has n columns
+    -- and b has n rows, li is a sublist of the rows of a and
+    -- a sublist of the columns of b. The result is the
+    -- multiplication of the (li x n) part of a with the
+    -- (n x li) part of b. We need this, because just matrix
+    -- multiplying the parts would require extra storage.
+    blockMultiply: (M R, M R, L I, I) -> M R
+    blockMultiply(a, b, li, n) ==
+      matrix([[ +/[a(i,s) * b(s,j) for s in 1..n ] _
+        for j in li  ]  for i in li])
+ 
+    -- is local, because one should know all the results for smaller i
+    fingerPrint: (NNI, M R, M R, M R) -> M R
+    fingerPrint (i : NNI, a : M R, b : M R, x :M R) ==
+      -- i > 2 only gives the correct result if the value of x from
+      -- the parameter list equals the result of fingerprint(i-1,...)
+      (i::PI) = 1 => x := a + b + a*b
+      (i::PI) = 2 => x := (x + a*b)*b
+      (i::PI) = 3 => x := a + b*x
+      (i::PI) = 4 => x := x + b
+      (i::PI) = 5 => x := x + a*b
+      (i::PI) = 6 => x := x - a + b*a
+      error "Sorry, but there are only 6 fingerprints!"
+      x
+ 
+    completeEchelonBasis(basis) ==
+      dimensionOfSubmodule : NNI := #basis
+      n : NNI := # basis.1
+      indexOfVectorToBeScanned : NNI := 1
+      row : NNI := dimensionOfSubmodule
+      completedBasis : M R := zero(n, n)
+      for i in 1..dimensionOfSubmodule repeat
+        completedBasis := setRow_!(completedBasis, i, basis.i)
+      if #basis <= n then
+        newStart : NNI := 1
+        for j in 1..n
+          while indexOfVectorToBeScanned <= dimensionOfSubmodule repeat
+            if basis.indexOfVectorToBeScanned.j = 0 then
+              completedBasis(1+row,j) := 1  --put unit vector into basis
+              row := row + 1
+            else
+              indexOfVectorToBeScanned := indexOfVectorToBeScanned + 1
+            newStart : NNI := j + 1
+        for j in newStart..n repeat
+          completedBasis(j,j) := 1  --put unit vector into basis
+      completedBasis
+ 
+    createRandomElement(aG,algElt) ==
+      numberOfGenerators : NNI := #aG
+      -- randomIndex := randnum numberOfGenerators
+      randomIndex := 1+(random()$Integer rem numberOfGenerators)
+      algElt := algElt * aG.randomIndex
+      -- randomIndxElement := randnum numberOfGenerators
+      randomIndex := 1+(random()$Integer rem numberOfGenerators)
+      algElt + aG.randomIndex
+ 
+    if R has EuclideanDomain then
+
+      cyclicSubmodule (lm : L M R, v : V R)  ==
+        basis : M R := rowEchelon matrix list entries v
+        -- normalizing the vector
+        -- all these elements lie in the submodule generated by v
+        furtherElts : L V R := [(lm.i*v)::V R for i in 1..maxIndex lm]
+        --furtherElts has elements of the generated submodule. It will
+        --will be checked whether they are in the span of the vectors
+        --computed so far. Of course we stop if we have got the whole
+        --space.
+        while (^null furtherElts) and (nrows basis < #v)  repeat
+          w : V R := first furtherElts
+          nextVector : M R := matrix list entries w -- normalizing the vector
+          -- will the rank change if we add this nextVector
+          -- to the basis so far computed?
+          addedToBasis : M R := vertConcat(basis, nextVector)
+          if rank addedToBasis ^= nrows basis then
+             basis := rowEchelon addedToBasis  -- add vector w to basis
+             updateFurtherElts : L V R := _
+               [(lm.i*w)::V R for i in 1..maxIndex lm]
+             furtherElts := append (rest furtherElts, updateFurtherElts)
+          else
+             -- the vector w lies in the span of matrix, no updating
+             -- of the basis
+             furtherElts := rest furtherElts
+        vector [row(basis, i) for i in 1..maxRowIndex basis]
+ 
+      standardBasisOfCyclicSubmodule (lm : L M R, v : V R)  ==
+        dim   : NNI := #v
+        standardBasis : L L R := list(entries v)
+        basis : M R := rowEchelon matrix list entries v
+        -- normalizing the vector
+        -- all these elements lie in the submodule generated by v
+        furtherElts : L V R := [(lm.i*v)::V R for i in 1..maxIndex lm]
+        --furtherElts has elements of the generated submodule. It will
+        --will be checked whether they are in the span of the vectors
+        --computed so far. Of course we stop if we  have got the whole
+        --space.
+        while (^null furtherElts) and (nrows basis < #v)  repeat
+          w : V R := first furtherElts
+          nextVector : M R := matrix list entries w  -- normalizing the vector
+          -- will the rank change if we add this nextVector
+          -- to the basis so far computed?
+          addedToBasis : M R := vertConcat(basis, nextVector)
+          if rank addedToBasis ^= nrows basis then
+             standardBasis := cons(entries w, standardBasis)
+             basis := rowEchelon addedToBasis  -- add vector w to basis
+             updateFurtherElts : L V R := _
+               [lm.i*w for i in 1..maxIndex lm]
+             furtherElts := append (rest furtherElts, updateFurtherElts)
+          else
+             -- the vector w lies in the span of matrix, therefore
+             -- no updating of matrix
+             furtherElts := rest furtherElts
+        transpose matrix standardBasis
+ 
+    if R has Field then  -- only because of inverse in Matrix
+ 
+      -- as conditional local functions, *internal have to be here
+ 
+      splitInternal: (L M R, V R, B) -> L L M R
+      splitInternal(algebraGenerators : L M R, vector: V R,doSplitting? : B) ==
+        n : I := # vector    -- R-rank of representation module =
+                               -- degree of representation
+        submodule : V V R := cyclicSubmodule (algebraGenerators,vector)
+        rankOfSubmodule : I := # submodule  -- R-Rank of submodule
+        submoduleRepresentation    : L M R := nil()
+        factormoduleRepresentation : L M R := nil()
+        if n ^= rankOfSubmodule then
+          messagePrint "  A proper cyclic submodule is found."
+          if doSplitting? then   -- no else !!
+            submoduleIndices : L I := [i for i in 1..rankOfSubmodule]
+            factormoduleIndices : L I := [i for i in (1+rankOfSubmodule)..n]
+            transitionMatrix : M R := _
+              transpose completeEchelonBasis submodule
+            messagePrint "  Transition matrix computed"
+            inverseTransitionMatrix : M R :=  _
+             autoCoerce(inverse transitionMatrix)$Union(M R,"failed")
+            messagePrint "  The inverse of the transition matrix computed"
+            messagePrint "  Now transform the matrices"
+            for i in 1..maxIndex algebraGenerators repeat
+              helpMatrix : M R := inverseTransitionMatrix * algebraGenerators.i
+              -- in order to not create extra space and regarding the fact
+              -- that we only want the two blocks in the main diagonal we
+              -- multiply with the aid of the local function blockMultiply
+              submoduleRepresentation := cons( blockMultiply( _
+                helpMatrix,transitionMatrix,submoduleIndices,n), _
+                submoduleRepresentation)
+              factormoduleRepresentation := cons( blockMultiply( _
+                helpMatrix,transitionMatrix,factormoduleIndices,n), _
+                factormoduleRepresentation)
+          [reverse submoduleRepresentation, reverse _
+            factormoduleRepresentation]
+        else -- represesentation is irreducible
+          messagePrint "  The generated cyclic submodule was not proper"
+          [algebraGenerators]
+ 
+      irreducibilityTestInternal: (L M R, M R, B) -> L L M R
+      irreducibilityTestInternal(algebraGenerators,_
+          singularMatrix,split?) ==
+        algebraGeneratorsTranspose : L M R := [transpose _
+           algebraGenerators.j for j in 1..maxIndex algebraGenerators]
+        xt : M R := transpose singularMatrix
+        messagePrint _
+         "  We know that all the cyclic submodules generated by all"
+        messagePrint _
+         "    non-trivial element of the singular matrix under view are"
+        messagePrint _
+         "    not proper, hence Norton's irreducibility test can be done:"
+        -- actually we only would need one (!) non-trivial element from
+        -- the kernel of xt, such an element must exist as the transpose
+        -- of a singular matrix is of course singular. Question: Can
+        -- we get it more easily from the kernel of x = singularMatrix?
+        kernel : L V R := nullSpace xt
+        result : L L M R :=  _
+          splitInternal(algebraGeneratorsTranspose,first kernel,split?)
+        if null rest result then  -- this means first kernel generates
+          -- the whole module
+          if 1 = #kernel then
+             messagePrint "  Representation is absolutely irreducible"
+          else
+             messagePrint "  Representation is irreducible, but we don't know "
+             messagePrint "    whether it is absolutely irreducible"
+        else
+          if split? then
+            messagePrint _
+             "  Representation is not irreducible and it will be split:"
+            -- these are the dual representations, so calculate the
+            -- dual to get the desired result, i.e. "transpose inverse"
+            -- improvements??
+            for i in 1..maxIndex result repeat
+              for j in 1..maxIndex (result.i) repeat
+                mat : M R := result.i.j
+                result.i.j := _
+                  transpose autoCoerce(inverse mat)$Union(M R,"failed")
+          else
+            messagePrint _
+             "  Representation is not irreducible, use meatAxe to split"
+        -- if "split?" then dual representation interchange factor
+        -- and submodules, hence reverse
+        reverse result
+ 
+      -- exported functions for FiniteField-s.
+ 
+      areEquivalent? (aG0, aG1) ==
+        areEquivalent? (aG0, aG1, true, 25)
+ 
+      areEquivalent? (aG0, aG1, numberOfTries) ==
+        areEquivalent? (aG0, aG1, true, numberOfTries)
+ 
+      areEquivalent? (aG0, aG1, randomelements, numberOfTries) ==
+          result : B := false
+          transitionM : M R := zero(1, 1)
+          numberOfGenerators  : NNI := #aG0
+          -- need a start value for creating random matrices:
+          -- if we switch to randomelements later, we take the last
+          -- fingerprint.
+          if randomelements then   -- random should not be from I
+             --randomIndex  : I   := randnum numberOfGenerators
+             randomIndex := 1+(random()$Integer rem numberOfGenerators)
+             x0 : M R := aG0.randomIndex
+             x1 : M R := aG1.randomIndex
+          n : NNI := #row(x0,1)   -- degree  of representation
+          foundResult : B := false
+          for i in 1..numberOfTries until foundResult repeat
+            -- try to create a non-singular element of the algebra
+            -- generated by "aG". If only two generators,
+            -- i < 7 and not "randomelements" use Parker's  fingerprints
+            -- i >= 7 create random elements recursively:
+            -- x_i+1 :=x_i * mr1 + mr2, where mr1 and mr2 are randomly
+            -- chosen elements form "aG".
+            if i = 7 then randomelements := true
+            if randomelements then
+               --randomIndex := randnum numberOfGenerators
+               randomIndex := 1+(random()$Integer rem numberOfGenerators)
+               x0 := x0 * aG0.randomIndex
+               x1 := x1 * aG1.randomIndex
+               --randomIndex := randnum numberOfGenerators
+               randomIndex := 1+(random()$Integer rem numberOfGenerators)
+               x0 := x0 + aG0.randomIndex
+               x1 := x1 + aG1.randomIndex
+            else
+               x0 := fingerPrint (i, aG0.0, aG0.1 ,x0)
+               x1 := fingerPrint (i, aG1.0, aG1.1 ,x1)
+            -- test singularity of x0 and x1
+            rk0 : NNI := rank x0
+            rk1 : NNI := rank x1
+            rk0 ^= rk1 =>
+              messagePrint  "Dimensions of kernels differ"
+              foundResult := true
+              result := false
+            -- can assume dimensions are equal
+            rk0 ^= n - 1 =>
+              -- not of any use here if kernel not one-dimensional
+              if randomelements then
+                messagePrint  "Random element in generated algebra does"
+                messagePrint  "  not have a one-dimensional kernel"
+              else
+                messagePrint  "Fingerprint element in generated algebra does"
+                messagePrint  "  not have a one-dimensional kernel"
+            -- can assume dimensions are equal and equal to n-1
+            if randomelements then
+              messagePrint  "Random element in generated algebra has"
+              messagePrint  "  one-dimensional kernel"
+            else
+              messagePrint  "Fingerprint element in generated algebra has"
+              messagePrint  "  one-dimensional kernel"
+            kernel0 : L V R := nullSpace x0
+            kernel1 : L V R := nullSpace x1
+            baseChange0 : M R := standardBasisOfCyclicSubmodule(_
+              aG0,kernel0.1)
+            baseChange1 : M R := standardBasisOfCyclicSubmodule(_
+              aG1,kernel1.1)
+            (ncols baseChange0) ^= (ncols baseChange1) =>
+              messagePrint "  Dimensions of generated cyclic submodules differ"
+              foundResult := true
+              result := false
+            -- can assume that dimensions of cyclic submodules are equal
+            (ncols baseChange0) = n =>   -- full dimension
+              transitionM := baseChange0 * _
+                autoCoerce(inverse baseChange1)$Union(M R,"failed")
+              foundResult := true
+              result := true
+              for j in 1..numberOfGenerators while result repeat
+                if (aG0.j*transitionM) ^= (transitionM*aG1.j) then
+                  result := false
+                  transitionM := zero(1 ,1)
+                  messagePrint _
+                   "  There is no isomorphism, as the only possible one"
+                  messagePrint "    fails to do the necessary base change"
+            -- can assume that dimensions of cyclic submodules are not "n"
+            messagePrint _
+              "  Generated cyclic submodules have equal, but not full"
+            messagePrint  "    dimension, hence we can not draw any conclusion"
+          -- here ends the for-loop
+          if not foundResult then
+            messagePrint  " "
+            messagePrint  "Can neither prove equivalence nor inequivalence."
+            messagePrint  "  Try again."
+          else
+            if result then
+              messagePrint  " "
+              messagePrint  "Representations are equivalent."
+            else
+              messagePrint  " "
+              messagePrint  "Representations are not equivalent."
+          transitionM
+ 
+      isAbsolutelyIrreducible?(aG) == isAbsolutelyIrreducible?(aG,25)
+ 
+      isAbsolutelyIrreducible?(aG, numberOfTries) ==
+        result : B := false
+        numberOfGenerators  : NNI := #aG
+        -- need a start value for creating random matrices:
+        -- randomIndex  : I   := randnum numberOfGenerators
+        randomIndex := 1+(random()$Integer rem numberOfGenerators)
+        x : M R := aG.randomIndex
+        n : NNI := #row(x,1)   -- degree  of representation
+        foundResult : B := false
+        for i in 1..numberOfTries until foundResult repeat
+          -- try to create a non-singular element of the algebra
+          -- generated by "aG", dimension of its kernel being 1.
+          -- create random elements recursively:
+          -- x_i+1 :=x_i * mr1 + mr2, where mr1 and mr2 are randomly
+          -- chosen elements form "aG".
+          -- randomIndex := randnum numberOfGenerators
+          randomIndex := 1+(random()$Integer rem numberOfGenerators)
+          x := x * aG.randomIndex
+          --randomIndex := randnum numberOfGenerators
+          randomIndex := 1+(random()$Integer rem numberOfGenerators)
+          x := x + aG.randomIndex
+          -- test whether rank of x is n-1
+          rk : NNI := rank x
+          if rk = n - 1 then
+            foundResult := true
+            messagePrint "Random element in generated algebra has"
+            messagePrint "  one-dimensional kernel"
+            kernel : L V R := nullSpace x
+            if n=#cyclicSubmodule(aG, first kernel) then
+              result := (irreducibilityTestInternal(aG,x,false)).1 ^= nil()_
+                 $(L M R)
+            else -- we found a proper submodule
+              result := false
+              --split(aG,kernel.1) -- to get the splitting
+          else -- not of any use here if kernel not one-dimensional
+            messagePrint "Random element in generated algebra does"
+            messagePrint "  not have a one-dimensional kernel"
+        -- here ends the for-loop
+        if not foundResult then
+          messagePrint "We have not found a one-dimensional kernel so far,"
+          messagePrint "  as we do a random search you could try again"
+        --else
+        --  if not result then
+        --    messagePrint "Representation is not irreducible."
+        --  else
+        --    messagePrint "Representation is irreducible."
+        result
+ 
+      split(algebraGenerators: L M R, vector: V R) ==
+        splitInternal(algebraGenerators, vector, true)
+ 
+      split(algebraGenerators : L M R, submodule: V V R)== --not zero submodule
+        n : NNI := #submodule.1 -- R-rank of representation module =
+                                -- degree of representation
+        rankOfSubmodule : I := (#submodule) :: I --R-Rank of submodule
+        submoduleRepresentation    : L M R := nil()
+        factormoduleRepresentation : L M R := nil()
+        submoduleIndices : L I := [i for i in 1..rankOfSubmodule]
+        factormoduleIndices : L I := [i for i in (1+rankOfSubmodule)..(n::I)]
+        transitionMatrix : M R := _
+          transpose completeEchelonBasis submodule
+        messagePrint "  Transition matrix computed"
+        inverseTransitionMatrix : M R :=
+          autoCoerce(inverse transitionMatrix)$Union(M R,"failed")
+        messagePrint "  The inverse of the transition matrix computed"
+        messagePrint "  Now transform the matrices"
+        for i in 1..maxIndex algebraGenerators repeat
+          helpMatrix : M R := inverseTransitionMatrix * algebraGenerators.i
+          -- in order to not create extra space and regarding the fact
+          -- that we only want the two blocks in the main diagonal we
+          -- multiply with the aid of the local function blockMultiply
+          submoduleRepresentation := cons( blockMultiply( _
+            helpMatrix,transitionMatrix,submoduleIndices,n), _
+            submoduleRepresentation)
+          factormoduleRepresentation := cons( blockMultiply( _
+            helpMatrix,transitionMatrix,factormoduleIndices,n), _
+            factormoduleRepresentation)
+        cons(reverse submoduleRepresentation, list( reverse _
+          factormoduleRepresentation)::(L L M R))
+ 
+ 
+    -- the following is "under"  "if R has Field", as there are compiler
+    -- problems with conditinally defined local functions, i.e. it
+    -- doesn't know, that "FiniteField" has "Field".
+ 
+ 
+      -- we are scanning through the vectorspaces
+      if (R has Finite) and (R has Field) then
+ 
+        meatAxe(algebraGenerators, randomelements, numberOfTries, _
+           maxTests) ==
+          numberOfGenerators  : NNI := #algebraGenerators
+          result : L L M R := nil()$(L L M R)
+          q   : PI  := size()$R:PI
+          -- need a start value for creating random matrices:
+          -- if we switch to randomelements later, we take the last
+          -- fingerprint.
+          if randomelements then   -- random should not be from I
+             --randomIndex  : I   := randnum numberOfGenerators
+             randomIndex := 1+(random()$Integer rem numberOfGenerators)
+             x : M R := algebraGenerators.randomIndex
+          foundResult : B := false
+          for i in 1..numberOfTries until foundResult repeat
+            -- try to create a non-singular element of the algebra
+            -- generated by "algebraGenerators". If only two generators,
+            -- i < 7 and not "randomelements" use Parker's  fingerprints
+            -- i >= 7 create random elements recursively:
+            -- x_i+1 :=x_i * mr1 + mr2, where mr1 and mr2 are randomly
+            -- chosen elements form "algebraGenerators".
+            if i = 7 then randomelements := true
+            if randomelements then
+               --randomIndex := randnum numberOfGenerators
+               randomIndex := 1+(random()$Integer rem numberOfGenerators)
+               x := x * algebraGenerators.randomIndex
+               --randomIndex := randnum numberOfGenerators
+               randomIndex := 1+(random()$Integer rem numberOfGenerators)
+               x := x + algebraGenerators.randomIndex
+            else
+               x := fingerPrint (i, algebraGenerators.1,_
+                 algebraGenerators.2 , x)
+            -- test singularity of x
+            n : NNI := #row(x, 1)  -- degree  of representation
+            if (rank x) ^= n then  -- x singular
+              if randomelements then
+                 messagePrint "Random element in generated algebra is singular"
+              else
+                 messagePrint _
+                  "Fingerprint element in generated algebra is singular"
+              kernel : L V R := nullSpace x
+              -- the first number is the maximal number of one dimensional
+              -- subspaces of the kernel, the second is a user given
+              -- constant
+              numberOfOneDimSubspacesInKernel : I := (q**(#kernel)-1)quo(q-1)
+              numberOfTests : I :=  _
+                min(numberOfOneDimSubspacesInKernel, maxTests)
+              for j in 1..numberOfTests repeat
+                 --we create an element in the kernel, there is a good
+                 --probability for it to generate a proper submodule, the
+                 --called "split" does the further work:
+                 result := _
+                   split(algebraGenerators,scanOneDimSubspaces(kernel,j))
+                 -- we had "not null rest result" directly in the following
+                 -- if .. then, but the statment there foundResult := true
+                 -- didn't work properly
+                 foundResult :=  not null rest result
+                 if foundResult then
+                   leave -- inner for-loop
+                   -- finish here with result
+                 else  -- no proper submodule
+                   -- we were not successfull, i.e gen. submodule was
+                   -- not proper, if the whole kernel is already scanned,
+                   -- Norton's irreducibility test is used now.
+                   if (j+1)>numberOfOneDimSubspacesInKernel then
+                     -- we know that all the cyclic submodules generated
+                     -- by all non-trivial elements of the kernel are proper.
+                     foundResult := true
+                     result : L L M R := irreducibilityTestInternal (_
+                       algebraGenerators,x,true)
+                     leave  -- inner for-loop
+              -- here ends the inner for-loop
+            else  -- x non-singular
+              if randomelements then
+                messagePrint _
+                 "Random element in generated algebra is non-singular"
+              else
+                messagePrint _
+                 "Fingerprint element in generated algebra is non-singular"
+          -- here ends the outer for-loop
+          if not foundResult then
+             result : L L M R := [nil()$(L M R), nil()$(L M R)]
+             messagePrint " "
+             messagePrint "Sorry, no result, try meatAxe(...,true)"
+             messagePrint "  or consider using an extension field."
+          result
+ 
+        meatAxe (algebraGenerators) ==
+          meatAxe(algebraGenerators, false, 25, 7)
+ 
+        meatAxe (algebraGenerators, randomElements?) ==
+          randomElements? => meatAxe (algebraGenerators, true, 25, 7)
+          meatAxe(algebraGenerators, false, 6, 7)
+ 
+        meatAxe (algebraGenerators:L M R, numberOfTries:PI) ==
+          meatAxe (algebraGenerators, true, numberOfTries, 7)
+ 
+        scanOneDimSubspaces(basis,n) ==
+          -- "dimension" of subspace generated by "basis"
+          dim : NNI := #basis
+          -- "dimension of the whole space:
+          nn : NNI := #(basis.1)
+          q : NNI := size()$R
+          -- number of all one-dimensional subspaces:
+          nred : I := n rem ((q**dim -1) quo (q-1))
+          pos : I := nred
+          i : I := 0
+          for i in 0..dim-1 while nred >= 0 repeat
+            pos := nred
+            nred := nred - (q**i)
+          i  := if i = 0 then 0 else i-1
+          coefficients : V R := new(dim,0$R)
+          coefficients.(dim-i) := 1$R
+          iR : L I := wholeRagits(pos::RADIX q)
+          for j in 1..(maxIndex iR) repeat
+            coefficients.(dim-((#iR)::I) +j) := index((iR.j+(q::I))::PI)$R
+          result : V R := new(nn,0)
+          for i in 1..maxIndex coefficients repeat
+            newAdd : V R := coefficients.i * basis.i
+            for j in 1..nn repeat
+              result.j := result.j + newAdd.j
+          result
+
 *)
 
 \end{chunk}
@@ -178924,7 +223858,9 @@ ResolveLatticeCompletion(S: Type): with
              ++ used for formal type correctness when a function will not
              ++ return directly to its caller.
     == add
+
         coerce(s: S): Void == void()
+
         coerce(e: Exit): S ==
             error "Bug: Should not be able to obtain value of type Exit"
 
@@ -178933,6 +223869,12 @@ ResolveLatticeCompletion(S: Type): with
 \begin{chunk}{COQ RESLATC}
 (* package RESLATC *)
 (*
+
+        coerce(s: S): Void == void()
+
+        coerce(e: Exit): S ==
+            error "Bug: Should not be able to obtain value of type Exit"
+
 *)
 
 \end{chunk}
@@ -179017,6 +223959,7 @@ RetractSolvePackage(Q, R): Exports == Implementation where
       ++ to Q before solving if possible.
 
   Implementation ==> add
+
     LEQQ2F : List EQ FQ -> List EQ F
     FQ2F   : FQ -> F
     PQ2P   : PQ -> P
@@ -179056,6 +223999,41 @@ RetractSolvePackage(Q, R): Exports == Implementation where
 \begin{chunk}{COQ RETSOL}
 (* package RETSOL *)
 (*
+
+    LEQQ2F : List EQ FQ -> List EQ F
+    FQ2F   : FQ -> F
+    PQ2P   : PQ -> P
+    QIfCan : List P -> Union(List FQ, "failed")
+    PQIfCan: P -> Union(FQ, "failed")
+
+    PQ2P p   == map((q1:Q):R +-> q1::R, p)$PolynomialFunctions2(Q, R)
+    FQ2F f   == PQ2P numer f / PQ2P denom f
+    LEQQ2F l == [equation(FQ2F lhs eq, FQ2F rhs eq) for eq in l]
+
+    solveRetract(lp, lv) ==
+      (u := QIfCan lp) case "failed" =>
+        solve([p::F for p in lp]$List(F), lv)$SSP(R)
+      [LEQQ2F l for l in solve(u::List(FQ), lv)$SSP(Q)]
+
+    QIfCan l ==
+      ans:List(FQ) := empty()
+      for p in l repeat
+        (u := PQIfCan p) case "failed" => return "failed"
+        ans := concat(u::FQ, ans)
+      ans
+
+    PQIfCan p ==
+      (u := mainVariable p) case "failed" =>
+        (r := retractIfCan(ground p)@Union(Q,"failed")) case Q => r::Q::PQ::FQ
+        "failed"
+      up := univariate(p, s := u::SY)
+      ans:FQ := 0
+      while up ^= 0 repeat
+        (v := PQIfCan leadingCoefficient up) case "failed" => return "failed"
+        ans := ans + monomial(1, s, degree up)$PQ * (v::FQ)
+        up  := reductum up
+      ans
+
 *)
 
 \end{chunk}
@@ -179176,6 +224154,7 @@ RootsFindingPackage(K):P==T where
       ++ setFoundZeroes sets the list of foundZeroes to the given one.
 
   T== add
+
     -- signature of local function
     zeroOfLinearPoly: SUP(K) -> K
     -- local variable
@@ -179184,6 +224163,7 @@ RootsFindingPackage(K):P==T where
     foundZeroes==listOfAllZeros
     
     if K has PseudoAlgebraicClosureOfPerfectFieldCategory then 
+
       distinguishedRootsOf(polyZero, theExtension) ==
         --PRECONDITION: setExtension! is called in K to set the extension to 
         --the extension of factorization
@@ -179194,6 +224174,7 @@ RootsFindingPackage(K):P==T where
 
     if K has FiniteFieldCategory  and _
      ^(K has PseudoAlgebraicClosureOfFiniteFieldCategory) then
+
       distinguishedRootsOf(polyZero,dummy)==
         zero?(polyZero) => [empty(),0]
         factorpolyZero:=factor(polyZero)$FFFACTSE(K,SUP(K))
@@ -179207,6 +224188,7 @@ RootsFindingPackage(K):P==T where
 
     if K has QuotientFieldCategory( Integer ) and _
      ^(K has PseudoAlgebraicClosureOfRationalNumberCategory) then
+
       distinguishedRootsOf(polyZero,dummy)==
         zero?(polyZero) => [empty(),0]
         factorpolyZero:=factor(polyZero)$RationalFactorize( SUP(K) ) 
@@ -179237,12 +224219,76 @@ RootsFindingPackage(K):P==T where
       listOfAllZeros:=setlist
       oldListOfAllZeroes
 
-
 \end{chunk}
 
 \begin{chunk}{COQ RFP}
 (* package RFP *)
 (*
+
+    -- signature of local function
+    zeroOfLinearPoly: SUP(K) -> K
+    -- local variable
+    listOfAllZeros:List(K):=empty()
+
+    foundZeroes==listOfAllZeros
+    
+    if K has PseudoAlgebraicClosureOfPerfectFieldCategory then 
+
+      distinguishedRootsOf(polyZero, theExtension) ==
+        --PRECONDITION: setExtension! is called in K to set the extension to 
+        --the extension of factorization
+        zero?(polyZero) =>
+          [empty(),0]
+        listOfZeros:List(K):=distinguishedRootsOf(polyZero,theExtension)$K
+        [listOfZeros,1]
+
+    if K has FiniteFieldCategory  and _
+     ^(K has PseudoAlgebraicClosureOfFiniteFieldCategory) then
+
+      distinguishedRootsOf(polyZero,dummy)==
+        zero?(polyZero) => [empty(),0]
+        factorpolyZero:=factor(polyZero)$FFFACTSE(K,SUP(K))
+        listOfFactor:=factorList(factorpolyZero)
+        listFact:= [pol.fctr for pol in listOfFactor]
+        degExt:INT:=
+          lcm(([degree(poly) for poly in listFact]) pretend LIST(INT))
+        listOfZeros:List(K):=removeDuplicates_
+          [zeroOfLinearPoly(poly) for poly in listFact | one?(degree(poly))]
+        [listOfZeros,degExt]
+
+    if K has QuotientFieldCategory( Integer ) and _
+     ^(K has PseudoAlgebraicClosureOfRationalNumberCategory) then
+
+      distinguishedRootsOf(polyZero,dummy)==
+        zero?(polyZero) => [empty(),0]
+        factorpolyZero:=factor(polyZero)$RationalFactorize( SUP(K) ) 
+        listOfFactor:=factorList(factorpolyZero)
+        listFact:= [pol.fctr for pol in listOfFactor]
+        degExt:INT:= 
+          lcm(([degree(poly) for poly in listFact]) pretend LIST(INT))
+        listOfZeros:List(K):=removeDuplicates_
+          [zeroOfLinearPoly(poly) for poly in listFact | one?(degree(poly))]
+        [listOfZeros,degExt]
+
+    distinguishedCommonRootsOf(listOfPoly1,theExtension)==
+      listOfPoly:List(SUP(K)):=[pol for pol in listOfPoly1 | ^zero?(pol)]
+      empty?(listOfPoly) ==> [empty(),0]
+      reco:= distinguishedRootsOf(gcd(listOfPoly),theExtension)
+      listOfZeros:= reco.zeros
+      degExt:INT:= reco.extDegree
+      [listOfZeros,degExt]
+
+    zeroOfLinearPoly(pol)==
+      ^one?(degree(pol)) => error "the polynomial is not linear"
+      listCoef:List(K):=coefficients(pol)
+      one?(#listCoef) => 0
+      - last(listCoef) / first(listCoef)
+
+    setFoundZeroes(setlist)==
+      oldListOfAllZeroes:= copy listOfAllZeros
+      listOfAllZeros:=setlist
+      oldListOfAllZeroes
+
 *)
 
 \end{chunk}
@@ -179317,6 +224363,7 @@ SAERationalFunctionAlgFactor(UP, SAE, UPA): Exports == Implementation where
       ++ factor(p) returns a prime factorisation of p.
  
   Implementation ==> add
+
     factor q ==
       factor(q, factor$RationalFunctionFactor(UP)
               )$InnerAlgFactor(Fraction Polynomial Integer, UP, SAE, UPA)
@@ -179326,6 +224373,11 @@ SAERationalFunctionAlgFactor(UP, SAE, UPA): Exports == Implementation where
 \begin{chunk}{COQ SAERFFC}
 (* package SAERFFC *)
 (*
+
+    factor q ==
+      factor(q, factor$RationalFunctionFactor(UP)
+              )$InnerAlgFactor(Fraction Polynomial Integer, UP, SAE, UPA)
+
 *)
 
 \end{chunk}
@@ -179403,6 +224455,7 @@ ScriptFormulaFormat1(S : SetCategory): public == private where
       ++ before it is coerced to SCRIPT formula format.
 
   private == add
+
     import ScriptFormulaFormat()
 
     coerce(s : S): ScriptFormulaFormat ==
@@ -179413,6 +224466,12 @@ ScriptFormulaFormat1(S : SetCategory): public == private where
 \begin{chunk}{COQ FORMULA1}
 (* package FORMULA1 *)
 (*
+
+    import ScriptFormulaFormat()
+
+    coerce(s : S): ScriptFormulaFormat ==
+      coerce(s :: OutputForm)$ScriptFormulaFormat
+
 *)
 
 \end{chunk}
@@ -179479,6 +224538,7 @@ SegmentBindingFunctions2(R:Type, S:Type): with
   map: (R -> S, SegmentBinding R) -> SegmentBinding S
       ++ map(f,v=a..b) returns the value given by \spad{v=f(a)..f(b)}.
  == add
+
   map(f, b) ==
     equation(variable b, map(f, segment b)$SegmentFunctions2(R, S))
 
@@ -179487,6 +224547,10 @@ SegmentBindingFunctions2(R:Type, S:Type): with
 \begin{chunk}{COQ SEGBIND2}
 (* package SEGBIND2 *)
 (*
+
+  map(f, b) ==
+    equation(variable b, map(f, segment b)$SegmentFunctions2(R, S))
+
 *)
 
 \end{chunk}
@@ -179561,10 +224625,12 @@ SegmentFunctions2(R:Type, S:Type): public == private where
 
 
   private ==> add
+
     map(f : R->S, r : Segment R): Segment S ==
       SEGMENT(f lo r,f hi r)$Segment(S)
 
     if R has OrderedRing then
+
      map(f : R->S, r : Segment R): List S ==
        lr := nil()$List(S)
        l := lo r
@@ -179585,6 +224651,27 @@ SegmentFunctions2(R:Type, S:Type): public == private where
 \begin{chunk}{COQ SEG2}
 (* package SEG2 *)
 (*
+
+    map(f : R->S, r : Segment R): Segment S ==
+      SEGMENT(f lo r,f hi r)$Segment(S)
+
+    if R has OrderedRing then
+
+     map(f : R->S, r : Segment R): List S ==
+       lr := nil()$List(S)
+       l := lo r
+       h := hi r
+       inc := (incr r)::R
+       if inc > 0 then
+         while l <= h repeat
+           lr := concat(f(l), lr)
+           l := l + inc
+       else
+         while l >= h repeat
+           lr := concat(f(l), lr)
+           l := l + inc
+       reverse_! lr
+
 *)
 
 \end{chunk}
@@ -179657,6 +224744,7 @@ SimpleAlgebraicExtensionAlgFactor(UP,SAE,UPA):Exports==Implementation where
       ++ factor(p) returns a prime factorisation of p.
  
   Implementation ==> add
+
     factor q ==
       factor(q, factor$RationalFactorize(UP)
                        )$InnerAlgFactor(Fraction Integer, UP, SAE, UPA)
@@ -179666,6 +224754,11 @@ SimpleAlgebraicExtensionAlgFactor(UP,SAE,UPA):Exports==Implementation where
 \begin{chunk}{COQ SAEFACT}
 (* package SAEFACT *)
 (*
+
+    factor q ==
+      factor(q, factor$RationalFactorize(UP)
+                       )$InnerAlgFactor(Fraction Integer, UP, SAE, UPA)
+
 *)
 
 \end{chunk}
@@ -179730,14 +224823,21 @@ SimplifyAlgebraicNumberConvertPackage(): with
   simplify: AlgebraicNumber -> Expression(Integer)
     ++ simplify(an) applies simplifications to an
  == add
+
   simplify(a:AlgebraicNumber) ==
-    simplify(a::Expression(Integer))$TranscendentalManipulations(Integer, Expression Integer)
+    simplify(a::Expression(Integer))_
+     $TranscendentalManipulations(Integer, Expression Integer)
 
 \end{chunk}
 
 \begin{chunk}{COQ SIMPAN}
 (* package SIMPAN *)
 (*
+
+  simplify(a:AlgebraicNumber) ==
+    simplify(a::Expression(Integer))$_
+      TranscendentalManipulations(Integer, Expression Integer)
+
 *)
 
 \end{chunk}
@@ -179842,6 +224942,191 @@ SmithNormalForm(R,Row,Col,M) : Exports == Implementation where
       ++ an integer  basis  of the equation \spad{AX = B}.
 
   Implementation == add
+
+    MATCAT1 ==> MatrixCategoryFunctions2(R,Row,Col,M,QF,Row2,Col2,M2)
+    MATCAT2 ==> MatrixCategoryFunctions2(QF,Row2,Col2,M2,R,Row,Col,M)
+    QF      ==> Fraction R
+    Row2    ==> Vector QF
+    Col2    ==> Vector QF
+    M2      ==> Matrix QF
+
+                 ------  Local Functions -----
+    elRow1       :   (M,I,I)         ->  M
+    elRow2       :  (M,R,I,I)        ->  M
+    elColumn2    :  (M,R,I,I)        ->  M
+    isDiagonal?  :      M            ->  Boolean
+    ijDivide     : (SmithForm ,I,I)  ->  SmithForm 
+    lastStep     :   SmithForm       ->  SmithForm
+    test1        :  (M,Col,NNI)      ->  Union(NNI, "failed")
+    test2        : (M, Col,NNI,NNI)  ->  Union( Col, "failed")
+
+     -- inconsistent system : case  0 = c -- 
+    test1(sm:M,b:Col,m1 : NNI) : Union(NNI , "failed") ==
+      km:=m1
+      while zero? sm(km,km) repeat
+        if not zero?(b(km)) then return "failed"
+        km:= (km - 1) :: NNI
+      km
+
+    if Col has shallowlyMutable then
+
+      test2(sm : M ,b : Col, n1:NNI,dk:NNI) : Union( Col, "failed") ==
+        -- test divisibility --
+        sol:Col := new(n1,0)
+        for k in 1..dk repeat
+          if (c:=(b(k) exquo sm(k,k))) case "failed" then return "failed"
+          sol(k):= c::R
+        sol
+
+     -- test if the matrix is diagonal or pseudo-diagonal --   
+    isDiagonal?(m : M) : Boolean ==
+      m1:= nrows m
+      n1:= ncols m
+      for i in 1..m1 repeat
+        for j in 1..n1 | (j ^= i) repeat
+          if  not zero?(m(i,j)) then return false
+      true
+ 
+       -- elementary operation of first kind: exchange two rows --
+    elRow1(m:M,i:I,j:I) : M ==
+      vec:=row(m,i)
+      setRow!(m,i,row(m,j))
+      setRow!(m,j,vec)
+      m
+
+             -- elementary operation of second kind: add to row i--
+                         -- a*row j  (i^=j) --
+    elRow2(m : M,a:R,i:I,j:I) : M ==
+      vec:= map(x +-> a*x,row(m,j))
+      vec:=map("+",row(m,i),vec)
+      setRow!(m,i,vec)
+      m
+             -- elementary operation of second kind: add to column i --
+                           -- a*column j (i^=j) --
+    elColumn2(m : M,a:R,i:I,j:I) : M ==
+      vec:= map(x +-> a*x,column(m,j))
+      vec:=map("+",column(m,i),vec)
+      setColumn!(m,i,vec)
+      m
+
+       -- modify SmithForm in such a way that the term m(i,i) --
+           -- divides the term m(j,j). m is diagonal --
+    ijDivide(sf : SmithForm , i : I,j : I) : SmithForm ==
+      m:=sf.Smith
+      mii:=m(i,i)
+      mjj:=m(j,j)
+      extGcd:=extendedEuclidean(mii,mjj)
+      d := extGcd.generator
+      mii:=(mii exquo d)::R
+      mjj := (mjj exquo d) :: R
+      -- add to row j extGcd.coef1*row i --
+      lMat:=elRow2(sf.leftEqMat,extGcd.coef1,j,i)
+      -- switch rows i and j --
+      lMat:=elRow1(lMat,i,j)
+      -- add to row j -mii*row i --
+      lMat := elRow2(lMat,-mii,j,i)
+      m(j,j):= m(i,i) * mjj
+      m(i,i):= d
+      -- add to column i extGcd.coef2 * column j --
+      rMat := elColumn2(sf.rightEqMat,extGcd.coef2,i,j)
+      -- add to column j -mjj*column i --
+      rMat:=elColumn2(rMat,-mjj,j,i)
+      -- multiply by -1 column j --
+      setColumn!(rMat,j,map(x +-> -1*x,column(rMat,j)))
+      [m,lMat,rMat]
+               
+
+     -- given a diagonal matrix compute its Smith form --
+    lastStep(sf : SmithForm) : SmithForm ==
+      m:=sf.Smith
+      m1:=min(nrows m,ncols m)
+      for i in 1..m1 while (mii:=m(i,i)) ^=0 repeat
+        for j in i+1..m1 repeat
+          if (m(j,j) exquo mii) case "failed" then return
+             lastStep(ijDivide(sf,i,j))
+      sf
+
+    -- given m and t row-equivalent matrices, with t in upper triangular --
+          -- form  compute the matrix u such that u*m=t --
+    findEqMat(m :  M,t : M) : Record(Hermite : M, eqMat : M) ==
+      m1:=nrows m
+      n1:=ncols m
+      "and"/[zero? t(m1,j) for j in 1..n1] => -- there are 0 rows
+         if "and"/[zero? t(1,j) for j in 1..n1] 
+         then return [m,scalarMatrix(m1,1)]  -- m is the zero matrix
+         mm:=horizConcat(m,scalarMatrix(m1,1))
+         mmh:=rowEchelon mm
+         [subMatrix(mmh,1,m1,1,n1), subMatrix(mmh,1,m1,n1+1,n1+m1)]
+      u:M:=zero(m1,m1)
+      j:=1
+      while t(1,j)=0 repeat j:=j+1  -- there are 0 columns
+      t1:=copy t
+      mm:=copy m
+      if j>1 then 
+        t1:=subMatrix(t,1,m1,j,n1)
+        mm:=subMatrix(m,1,m1,j,n1)
+      t11:=t1(1,1)
+      for i in 1..m1 repeat
+        u(i,1) := (mm(i,1) exquo t11) :: R
+        for j in 2..m1 repeat
+          j0:=j
+          while zero?(tjj:=t1(j,j0)) repeat j0:=j0+1
+          u(i,j) :=
+           ((mm(i,j0)-("+"/[u(i,k)*t1(k,j0) for k in 1..(j-1)])) exquo tjj)::R
+      u1:M2:= map(x +-> x::QF,u)$MATCAT1
+      [t,map(retract$QF,(inverse u1)::M2)$MATCAT2]
+
+                --- Hermite normal form of m ---
+    hermite(m:M) : M == rowEchelon m
+
+     -- Hermite normal form and equivalence matrix --
+    completeHermite(m : M) : Record(Hermite : M, eqMat : M) ==
+      findEqMat(m,rowEchelon m)
+ 
+    smith(m : M) : M == completeSmith(m).Smith
+
+    completeSmith(m : M) : Record(Smith : M, leftEqMat : M, rightEqMat : M) ==
+      cm1:=completeHermite m
+      leftm:=cm1.eqMat
+      m1:=cm1.Hermite
+      isDiagonal? m1 => lastStep([m1,leftm,scalarMatrix(ncols m,1)])
+      nr:=nrows m
+      cm1:=completeHermite transpose m1
+      rightm:= transpose cm1.eqMat
+      m1:=cm1.Hermite
+      isDiagonal? m1 => 
+        cm2:=lastStep([m1,leftm,rightm])
+        nrows(m:=cm2.Smith) = nr => cm2
+        [transpose m,cm2.leftEqMat, cm2.rightEqMat]
+      cm2:=completeSmith m1
+      cm2:=lastStep([cm2.Smith,transpose(cm2.rightEqMat)*leftm,
+                rightm*transpose(cm2.leftEqMat)])
+      nrows(m:=cm2.Smith) = nr => cm2
+      [transpose m, cm2.leftEqMat, cm2.rightEqMat]
+
+    -- Find the solution in R of the linear system mX = b --
+    diophantineSystem(m : M, b : Col) : Both  ==
+      sf:=completeSmith m
+      sm:=sf.Smith
+      m1:=nrows sm
+      lm:=sf.leftEqMat
+      b1:Col:= lm* b
+      (t1:=test1(sm,b1,m1)) case "failed" => ["failed",empty()]
+      dk:=t1 :: NNI
+      n1:=ncols sm
+      (t2:=test2(sm,b1,n1,dk)) case "failed" => ["failed",empty()]
+      rm := sf.rightEqMat
+      sol:=rm*(t2 :: Col)  -- particular solution
+      dk = n1  => [sol,list new(n1,0)]
+      lsol:List Col := [column(rm,i) for i in (dk+1)..n1]
+      [sol,lsol]
+
+\end{chunk}
+
+\begin{chunk}{COQ SMITH}
+(* package SMITH *)
+(*
+
     MATCAT1 ==> MatrixCategoryFunctions2(R,Row,Col,M,QF,Row2,Col2,M2)
     MATCAT2 ==> MatrixCategoryFunctions2(QF,Row2,Col2,M2,R,Row,Col,M)
     QF      ==> Fraction R
@@ -179924,7 +225209,6 @@ SmithNormalForm(R,Row,Col,M) : Exports == Implementation where
       lMat:=elRow1(lMat,i,j)
       -- add to row j -mii*row i --
       lMat := elRow2(lMat,-mii,j,i)
---      lMat := ijModify(mii,mjj,extGcd.coef1,extGcd.coef2,sf.leftEqMat,i,j)
       m(j,j):= m(i,i) * mjj
       m(i,i):= d
       -- add to column i extGcd.coef2 * column j --
@@ -180021,11 +225305,6 @@ SmithNormalForm(R,Row,Col,M) : Exports == Implementation where
       lsol:List Col := [column(rm,i) for i in (dk+1)..n1]
       [sol,lsol]
 
-\end{chunk}
-
-\begin{chunk}{COQ SMITH}
-(* package SMITH *)
-(*
 *)
 
 \end{chunk}
@@ -180121,6 +225400,7 @@ SortedCache(S:CachableSet): Exports == Implementation where
       ++ It returns x with an integer associated with it.
 
   Implementation ==> add
+
     shiftCache   : (List S, N) -> Void
     insertInCache: (List S, List S, S, N) -> S
 
@@ -180173,6 +225453,54 @@ SortedCache(S:CachableSet): Exports == Implementation where
 \begin{chunk}{COQ SCACHE}
 (* package SCACHE *)
 (*
+
+    shiftCache   : (List S, N) -> Void
+    insertInCache: (List S, List S, S, N) -> S
+
+    cach := [nil()]$Record(cche:List S)
+
+    cache() == cach.cche
+
+    shiftCache(l, n) ==
+      for x in l repeat setPosition(x, n + position x)
+      void
+
+    clearCache() ==
+      for x in cache repeat setPosition(x, 0)
+      cach.cche := nil()
+      void
+
+    enterInCache(x:S, equal?:S -> Boolean) ==
+      scan := cache()
+      while not null scan repeat
+        equal?(y := first scan) =>
+          setPosition(x, position y)
+          return y
+        scan := rest scan
+      setPosition(x, 1 + #cache())
+      cach.cche := concat(cache(), x)
+      x
+
+    enterInCache(x:S, triage:(S, S) -> Integer) ==
+      scan := cache()
+      pos:N:= 0
+      for i in 1..#scan repeat
+        zero?(n := triage(x, y := first scan)) =>
+          setPosition(x, position y)
+          return y
+        n<0 => return insertInCache(first(cache(),(i-1)::N),scan,x,pos)
+        scan := rest scan
+        pos  := position y
+      setPosition(x, pos + DIFF)
+      cach.cche := concat(cache(), x)
+      x
+
+    insertInCache(before, after, x, pos) ==
+      if ((pos+1) = position first after) then shiftCache(after, DIFF)
+      setPosition(x, pos + (((position first after) - pos)::N quo 2))
+      cach.cche := concat(before, concat(x, after))
+      x
+
 *)
 
 \end{chunk}
@@ -180257,12 +225585,14 @@ SortPackage(S,A) : Exports == Implementation where
         ++ insertionSort! \undocumented
 
   Implementation == add
+
     bubbleSort_!(m,f) ==
       n := #m
       for i in 1..(n-1) repeat
         for j in n..(i+1) by -1 repeat
           if f(m.j,m.(j-1)) then swap_!(m,j,j-1)
       m
+
     insertionSort_!(m,f) ==
       for i in 2..#m repeat
         j := i
@@ -180270,10 +225600,15 @@ SortPackage(S,A) : Exports == Implementation where
           swap_!(m,j,j-1)
           j := (j - 1) pretend PositiveInteger
       m
+
     if S has OrderedSet then
+
       bubbleSort_!(m) == bubbleSort_!(m,_<$S)
+
       insertionSort_!(m) == insertionSort_!(m,_<$S)
+
     if A has UnaryRecursiveAggregate(S) then
+
       bubbleSort_!(m,fn) ==
         empty? m => m
         l := m
@@ -180292,6 +225627,43 @@ SortPackage(S,A) : Exports == Implementation where
 \begin{chunk}{COQ SORTPAK}
 (* package SORTPAK *)
 (*
+
+    bubbleSort_!(m,f) ==
+      n := #m
+      for i in 1..(n-1) repeat
+        for j in n..(i+1) by -1 repeat
+          if f(m.j,m.(j-1)) then swap_!(m,j,j-1)
+      m
+
+    insertionSort_!(m,f) ==
+      for i in 2..#m repeat
+        j := i
+        while j > 1 and f(m.j,m.(j-1)) repeat
+          swap_!(m,j,j-1)
+          j := (j - 1) pretend PositiveInteger
+      m
+
+    if S has OrderedSet then
+
+      bubbleSort_!(m) == bubbleSort_!(m,_<$S)
+
+      insertionSort_!(m) == insertionSort_!(m,_<$S)
+
+    if A has UnaryRecursiveAggregate(S) then
+
+      bubbleSort_!(m,fn) ==
+        empty? m => m
+        l := m
+        while not empty? (r := l.rest) repeat
+           r := bubbleSort_!(r,fn)
+           x := l.first
+           if fn(r.first,x) then
+             l.first := r.first
+             r.first := x
+           l.rest := r
+           l := l.rest
+        m
+
 *)
 
 \end{chunk}
@@ -180366,6 +225738,7 @@ SparseUnivariatePolynomialFunctions2(R:Ring, S:Ring): with
     ++ map(func, poly) creates a new polynomial by applying func to
     ++ every non-zero coefficient of the polynomial poly.
  == add
+
   map(f, p) == map(f, p)$UnivariatePolynomialCategoryFunctions2(R,
            SparseUnivariatePolynomial R, S, SparseUnivariatePolynomial S)
 
@@ -180374,6 +225747,10 @@ SparseUnivariatePolynomialFunctions2(R:Ring, S:Ring): with
 \begin{chunk}{COQ SUP2}
 (* package SUP2 *)
 (*
+
+  map(f, p) == map(f, p)$UnivariatePolynomialCategoryFunctions2(R,
+           SparseUnivariatePolynomial R, S, SparseUnivariatePolynomial S)
+
 *)
 
 \end{chunk}
@@ -180475,6 +225852,7 @@ SpecialOutputPackage: public == private where
       ++ \spadsyscom{set output tex}.
 
   private == add
+
     e : OutputForm
     l : List OutputForm
     var : String
@@ -180517,6 +225895,44 @@ SpecialOutputPackage: public == private where
 \begin{chunk}{COQ SPECOUT}
 (* package SPECOUT *)
 (*
+
+    e : OutputForm
+    l : List OutputForm
+    var : String
+    --ExpressionPackage()
+
+    juxtaposeTerms: List OutputForm -> OutputForm
+    juxtaposeTerms l == blankSeparate l
+
+    outputAsFortran e ==
+      dispfortexp$Lisp e
+      void()$Void
+
+    outputAsFortran(var,e) ==
+      e := var::Symbol::OutputForm  = e
+      dispfortexp(e)$Lisp
+      void()$Void
+
+    outputAsFortran l ==
+      dispfortexp$Lisp juxtaposeTerms l
+      void()$Void
+
+    outputAsScript e ==
+      formulaFormat$Lisp e
+      void()$Void
+
+    outputAsScript l ==
+      formulaFormat$Lisp juxtaposeTerms l
+      void()$Void
+
+    outputAsTex e ==
+      texFormat$Lisp e
+      void()$Void
+
+    outputAsTex l ==
+      texFormat$Lisp juxtaposeTerms l
+      void()$Void
+
 *)
 
 \end{chunk}
@@ -181004,6 +226420,287 @@ SquareFreeQuasiComponentPackage(R,E,V,P,TS): Exports == Implementation where
 \begin{chunk}{COQ SFQCMPK}
 (* package SFQCMPK *)
 (*
+
+     squareFreeFactors(lp: LP): LP == 
+       lsflp: LP := []
+       for p in lp repeat 
+         lsfp := squareFreeFactors(p)$polsetpack
+         lsflp := concat(lsfp,lsflp)
+       sort(infRittWu?,removeDuplicates lsflp)
+
+     startTable!(ok: S, ko: S, domainName: S): Void == 
+       initTable!()$H
+       if (not empty? ok) and (not empty? ko) then printInfo!(ok,ko)$H
+       if (not empty? domainName) then startStats!(domainName)$H
+       void()
+
+     stopTable!(): Void ==   
+       if makingStats?()$H then printStats!()$H
+       clearTable!()$H
+
+     supDimElseRittWu? (ts:TS,us:TS): Boolean ==
+       #ts < #us => true
+       #ts > #us => false
+       lp1 :LP := members(ts)
+       lp2 :LP := members(us)
+       while (not empty? lp1) and (not infRittWu?(first(lp2),first(lp1)))
+        repeat
+         lp1 := rest lp1
+         lp2 := rest lp2
+       not empty? lp1
+
+     algebraicSort (lts:Split): Split ==
+       lts := removeDuplicates lts
+       sort(supDimElseRittWu?,lts)
+
+     moreAlgebraic?(ts:TS,us:TS): Boolean  ==
+       empty? ts => empty? us 
+       empty? us => true
+       #ts < #us => false
+       for p in (members us) repeat 
+          not algebraic?(mvar(p),ts) => return false
+       true
+
+     subTriSet?(ts:TS,us:TS): Boolean  ==
+       empty? ts => true
+       empty? us => false
+       mvar(ts) > mvar(us) => false
+       mvar(ts) < mvar(us) => subTriSet?(ts,rest(us)::TS)
+       first(ts)::P = first(us)::P => subTriSet?(rest(ts)::TS,rest(us)::TS)
+       false
+
+     internalSubPolSet?(lp1: LP, lp2: LP): Boolean  ==
+       empty? lp1 => true
+       empty? lp2 => false
+       associates?(first lp1, first lp2) => 
+         internalSubPolSet?(rest lp1, rest lp2)
+       infRittWu?(first lp1, first lp2) => false
+       internalSubPolSet?(lp1, rest lp2)
+
+     subPolSet?(lp1: LP, lp2: LP): Boolean  ==
+       lp1 := sort(infRittWu?, lp1)
+       lp2 := sort(infRittWu?, lp2)
+       internalSubPolSet?(lp1,lp2)
+
+     infRittWu?(lp1: LP, lp2: LP): Boolean ==
+       lp1 := sort(infRittWu?, lp1)
+       lp2 := sort(infRittWu?, lp2)
+       internalInfRittWu?(lp1,lp2)
+
+     internalInfRittWu?(lp1: LP, lp2: LP): Boolean ==
+       empty? lp1 => not empty? lp2
+       empty? lp2 => false
+       infRittWu?(first lp1, first lp2)$P => true
+       infRittWu?(first lp2, first lp1)$P => false
+       infRittWu?(rest lp1, rest lp2)$$
+
+     subCase? (lpwt1:LpWT,lpwt2:LpWT): Boolean == 
+       -- ASSUME lpwt.{1,2}.val is sorted w.r.t. infRittWu?
+       not internalSubPolSet?(lpwt2.val, lpwt1.val) => false
+       subQuasiComponent?(lpwt1.tower,lpwt2.tower)
+
+     if TS has SquareFreeRegularTriangularSetCategory(R,E,V,P)
+     then
+
+       internalSubQuasiComponent?(ts:TS,us:TS): Union(Boolean,"failed") ==
+         subTriSet?(us,ts) => true
+         not moreAlgebraic?(ts,us) => false::Union(Boolean,"failed")
+         for p in (members us) repeat 
+           mdeg(p) < mdeg(select(ts,mvar(p))::P) => 
+             return("failed"::Union(Boolean,"failed"))
+         for p in (members us) repeat 
+           not zero? initiallyReduce(p,ts) =>
+             return("failed"::Union(Boolean,"failed"))
+         lsfp := squareFreeFactors(initials us)
+         for p in lsfp repeat 
+           b: B := invertible?(p,ts)$TS
+           not b => 
+             return(false::Union(Boolean,"failed"))
+         true::Union(Boolean,"failed")
+
+     else
+
+       internalSubQuasiComponent?(ts:TS,us:TS): Union(Boolean,"failed") ==
+         subTriSet?(us,ts) => true
+         not moreAlgebraic?(ts,us) => false::Union(Boolean,"failed")
+         for p in (members us) repeat 
+           mdeg(p) < mdeg(select(ts,mvar(p))::P) => 
+             return("failed"::Union(Boolean,"failed"))
+         for p in (members us) repeat 
+           not zero? reduceByQuasiMonic(p,ts) =>
+             return("failed"::Union(Boolean,"failed"))
+         true::Union(Boolean,"failed")
+
+     subQuasiComponent?(ts:TS,us:TS): Boolean ==
+       k: Key := [ts, us]
+       e := extractIfCan(k)$H
+       e case Entry => e::Entry
+       ubf: Union(Boolean,"failed") := internalSubQuasiComponent?(ts,us)
+       b: Boolean := (ubf case Boolean) and (ubf::Boolean)
+       insert!(k,b)$H
+       b
+
+     subQuasiComponent?(ts:TS,lus:Split): Boolean ==
+       for us in lus repeat
+          subQuasiComponent?(ts,us)@B => return true
+       false
+
+     removeSuperfluousCases (cases:List LpWT) ==
+       #cases < 2 => cases
+       toSee := 
+         sort((x:LpWT,y:LpWT):Boolean +-> supDimElseRittWu?(x.tower,y.tower),
+              cases)
+       lpwt1,lpwt2 : LpWT
+       toSave,headmaxcases,maxcases,copymaxcases : List LpWT
+       while not empty? toSee repeat
+         lpwt1 := first toSee
+         toSee := rest toSee
+         toSave := []
+         for lpwt2 in toSee repeat
+            if subCase?(lpwt1,lpwt2) 
+              then
+                lpwt1 := lpwt2
+              else
+                if not subCase?(lpwt2,lpwt1) 
+                  then
+                    toSave := cons(lpwt2,toSave)
+         if empty? maxcases
+           then
+             headmaxcases := [lpwt1]
+             maxcases := headmaxcases
+           else
+             copymaxcases := maxcases
+             while (not empty? copymaxcases) and _
+               (not subCase?(lpwt1,first(copymaxcases))) repeat
+                 copymaxcases := rest copymaxcases
+             if empty? copymaxcases
+               then
+                 setrest!(headmaxcases,[lpwt1])
+                 headmaxcases := rest headmaxcases
+         toSee := reverse toSave
+       maxcases
+
+     removeSuperfluousQuasiComponents(lts: Split): Split ==
+       lts := removeDuplicates lts
+       #lts < 2 => lts
+       toSee := algebraicSort lts
+       toSave,headmaxlts,maxlts,copymaxlts : Split
+       while not empty? toSee repeat
+         ts := first toSee
+         toSee := rest toSee
+         toSave := []
+         for us in toSee repeat
+            if subQuasiComponent?(ts,us)@B
+              then
+                ts := us
+              else
+                if not subQuasiComponent?(us,ts)@B 
+                  then
+                    toSave := cons(us,toSave)
+         if empty? maxlts
+           then
+             headmaxlts := [ts]
+             maxlts := headmaxlts
+           else
+             copymaxlts := maxlts
+             while (not empty? copymaxlts) and _
+               (not subQuasiComponent?(ts,first(copymaxlts))@B) repeat
+                 copymaxlts := rest copymaxlts
+             if empty? copymaxlts
+               then
+                 setrest!(headmaxlts,[ts])
+                 headmaxlts := rest headmaxlts
+         toSee := reverse toSave
+       algebraicSort maxlts
+
+     removeAssociates (lp:LP):LP ==
+       removeDuplicates [primitivePart(p) for p in lp]
+
+     branchIfCan(leq: LP,ts: TS,lineq: LP, b1:B,b2:B,b3:B,b4:B,b5:B):UBF ==
+        -- ASSUME pols in leq are squarefree and mainly primitive
+        -- if b1 then CLEAN UP leq
+        -- if b2 then CLEAN UP lineq
+        -- if b3 then SEARCH for ZERO in lineq with leq
+        -- if b4 then SEARCH for ZERO in lineq with ts
+        -- if b5 then SEARCH for ONE in leq with lineq
+        if b1 
+          then 
+            leq := removeAssociates(leq)
+            leq := remove(zero?,leq)
+            any?(ground?,leq) => 
+              return("failed"::Union(Branch,"failed"))
+        if b2
+          then
+            any?(zero?,lineq) =>
+              return("failed"::Union(Branch,"failed"))
+            lineq := removeRedundantFactors(lineq)$polsetpack
+        if b3
+          then
+            ps: PS := construct(leq)$PS
+            for q in lineq repeat
+              zero? remainder(q,ps).polnum =>
+                return("failed"::Union(Branch,"failed"))
+        (empty? leq) or (empty? lineq) => ([leq, ts, lineq]$Branch)::UBF
+        if b4
+          then
+            for q in lineq repeat
+              zero? initiallyReduce(q,ts) => 
+                return("failed"::Union(Branch,"failed"))
+        if b5
+          then
+            newleq: LP := []
+            for p in leq repeat
+              for q in lineq repeat
+                if mvar(p) = mvar(q)
+                  then
+                    g := gcd(p,q)
+                    newp := (p exquo g)::P
+                    ground? newp => 
+                      return("failed"::Union(Branch,"failed"))
+                    newleq := cons(newp,newleq)
+                  else
+                    newleq := cons(p,newleq)
+            leq := newleq
+        leq := sort(infRittWu?, removeDuplicates leq)
+        ([leq, ts, lineq]$Branch)::UBF
+
+     prepareDecompose(lp: LP, lts: List(TS), b1: B, b2: B): List Branch ==
+       -- if b1 then REMOVE REDUNDANT COMPONENTS in lts
+       -- if b2 then SPLIT the input system with squareFree
+       lp := sort(infRittWu?, remove(zero?,removeAssociates(lp)))
+       any?(ground?,lp) => []
+       empty? lts => []
+       if b1 then lts := removeSuperfluousQuasiComponents lts
+       not b2 =>
+         [[lp,ts,squareFreeFactors(initials ts)]$Branch for ts in lts]
+       toSee: List Branch 
+       lq: LP := []         
+       toSee := [[lq,ts,squareFreeFactors(initials ts)]$Branch for ts in lts]
+       empty? lp => toSee
+       for p in lp repeat
+         lsfp := squareFreeFactors(p)$polsetpack
+         branches: List Branch := []
+         lq := []
+         for f in lsfp repeat
+           for branch in toSee repeat
+             leq : LP := branch.eq
+             ts := branch.tower
+             lineq : LP := branch.ineq
+             ubf1: UBF := branchIfCan(leq,ts,lq,false,false,true,true,true)@UBF
+             ubf1 case "failed" => "leave"
+             ubf2: UBF := 
+               branchIfCan([f],ts,lineq,false,false,true,true,true)@UBF
+             ubf2 case "failed" => "leave"
+             leq := sort(infRittWu?,removeDuplicates concat(ubf1.eq,ubf2.eq))
+             lineq := 
+               sort(infRittWu?,removeDuplicates concat(ubf1.ineq,ubf2.ineq))
+             newBranch := 
+               branchIfCan(leq,ts,lineq,false,false,false,false,false)
+             branches:= cons(newBranch::Branch,branches)
+           lq := cons(f,lq)
+         toSee := branches
+       sort((x,y) +-> supDimElseRittWu?(x.tower,y.tower),toSee)
+
 *)
 
 \end{chunk}
@@ -181187,10 +226884,222 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation
        ts_v := select(ts,v)::P
        lgwt: List PWT
        if mdeg(p) < mdeg(ts_v)
-         then 
-           lgwt := stoseInternalLastSubResultant(ts_v,p,ts_v_-,true,false)$regsetgcdpack
+        then 
+         lgwt := _
+          stoseInternalLastSubResultant(ts_v,p,ts_v_-,true,false)$regsetgcdpack
+        else
+         lgwt := _
+          stoseInternalLastSubResultant(p,ts_v,ts_v_-,true,false)$regsetgcdpack
+       lts: Split := []
+       llpwt: List LpWT := []
+       for gwt in lgwt repeat
+         g := gwt.val; us := gwt.tower
+         zero? g => 
+           error " in algebraicDecompose$REGSET: should never happen !!"
+         ground? g => "leave"
+         h := leadingCoefficient(g,v)
+         lus := augment(members(ts_v_+),augment(ts_v,us)$TS)$TS
+         lsfp := squareFreeFactors(h)$polsetpack
+         for f in lsfp repeat
+           ground? f => "leave"
+           for vs in lus repeat
+             llpwt := cons([[f,p],vs]$LpWT, llpwt)
+         n < #us => 
+           error " in algebraicDecompose$REGSET: should never happen !!!"
+         mvar(g) = v => 
+           lts := concat(augment(members(ts_v_+),augment(g,us)$TS)$TS,lts)         
+       [lts,llpwt]
+
+     transcendentalDecompose(p: P, ts: TS,bound: N): _
+          Record(done: Split, todo: List LpWT) ==
+       lts: Split
+       if #ts < bound 
+         then
+           lts := augment(p,ts)$TS
          else
-           lgwt := stoseInternalLastSubResultant(p,ts_v,ts_v_-,true,false)$regsetgcdpack
+           lts := []
+       llpwt: List LpWT := []
+       [lts,llpwt]
+
+     transcendentalDecompose(p: P, ts: TS): _
+         Record(done: Split, todo: List LpWT) ==
+       lts: Split:= augment(p,ts)$TS
+       llpwt: List LpWT := []
+       [lts,llpwt]
+
+     internalDecompose(p: P, ts: TS,bound: N,clos?:B): _
+         Record(done: Split, todo: List LpWT) ==
+       clos? => internalDecompose(p,ts,bound)
+       internalDecompose(p,ts)
+
+     internalDecompose(p: P, ts: TS,bound: N): _
+         Record(done: Split, todo: List LpWT) ==
+       -- ASSUME p not constant
+       llpwt: List LpWT := []
+       lts: Split := []
+       -- EITHER mvar(p) is null
+       if (not zero? tail(p)) and (not ground? (lmp := leastMonomial(p)))
+         then
+           llpwt := cons([[mvar(p)::P],ts]$LpWT,llpwt)
+           p := (p exquo lmp)::P
+       ip := squareFreePart init(p); tp := tail p
+       p := mainPrimitivePart p
+       -- OR init(p) is null or not
+       lbwt: List BWT := stoseInvertible?_sqfreg(ip,ts)$regsetgcdpack
+       for bwt in lbwt repeat
+         bwt.val =>
+           if algebraic?(mvar(p),bwt.tower) 
+             then 
+               rsl := algebraicDecompose(p,bwt.tower)
+             else
+               rsl := transcendentalDecompose(p,bwt.tower,bound)
+           lts := concat(rsl.done,lts)
+           llpwt :=  concat(rsl.todo,llpwt)
+           (not ground? ip) =>
+             zero? tp => llpwt := cons([[ip],bwt.tower]$LpWT, llpwt)
+             (not ground? tp) => llpwt := cons([[ip,tp],bwt.tower]$LpWT, llpwt)
+         riv := removeZero(ip,bwt.tower)
+         (zero? riv) =>
+           zero? tp => lts := cons(bwt.tower,lts)
+           (not ground? tp) => llpwt := cons([[tp],bwt.tower]$LpWT, llpwt)
+         llpwt := cons([[riv * mainMonomial(p) + tp],bwt.tower]$LpWT, llpwt)
+       [lts,llpwt]
+
+     internalDecompose(p: P, ts: TS): Record(done: Split, todo: List LpWT) ==
+       -- ASSUME p not constant
+       llpwt: List LpWT := []
+       lts: Split := []
+       -- EITHER mvar(p) is null
+       if (not zero? tail(p)) and (not ground? (lmp := leastMonomial(p)))
+         then
+           llpwt := cons([[mvar(p)::P],ts]$LpWT,llpwt)
+           p := (p exquo lmp)::P
+       ip := squareFreePart init(p); tp := tail p
+       p := mainPrimitivePart p
+       -- OR init(p) is null or not
+       lbwt: List BWT := stoseInvertible?_sqfreg(ip,ts)$regsetgcdpack
+       for bwt in lbwt repeat
+         bwt.val =>
+           if algebraic?(mvar(p),bwt.tower) 
+             then 
+               rsl := algebraicDecompose(p,bwt.tower)
+             else
+               rsl := transcendentalDecompose(p,bwt.tower)
+           lts := concat(rsl.done,lts)
+           llpwt :=  concat(rsl.todo,llpwt)
+           (not ground? ip) => 
+             zero? tp => llpwt := cons([[ip],bwt.tower]$LpWT, llpwt)
+             (not ground? tp) => llpwt := cons([[ip,tp],bwt.tower]$LpWT, llpwt)
+         riv := removeZero(ip,bwt.tower)
+         (zero? riv) =>
+           zero? tp => lts := cons(bwt.tower,lts)
+           (not ground? tp) => llpwt := cons([[tp],bwt.tower]$LpWT, llpwt)
+         llpwt := cons([[riv * mainMonomial(p) + tp],bwt.tower]$LpWT, llpwt)
+       [lts,llpwt]
+
+     decompose(lp: LP, lts: Split, clos?: B, info?: B): Split ==
+       decompose(lp,lts,false,false,clos?,true,info?)
+
+     convert(lpwt: LpWT): String ==
+       ls: List String := _
+        ["<", string((#(lpwt.val))::Z), ",", string((#(lpwt.tower))::Z), ">" ]
+       concat ls
+
+     printInfo(toSee: List LpWT, n: N): Void ==
+       lpwt := first toSee
+       s:String := concat ["[", string((#toSee)::Z), " ", convert(lpwt)@String]
+       m: N := #(lpwt.val)
+       toSee := rest toSee
+       for lpwt in toSee repeat
+         m := m + #(lpwt.val)
+         s := concat [s, ",", convert(lpwt)@String]
+       s := concat [s, " -> |", string(m::Z), "|; {", string(n::Z),"}]"]
+       iprint(s)$iprintpack
+       void()
+
+     decompose(lp: LP, lts: Split, cleanW?: B, sqfr?: B, clos?: B, _
+               rem?: B, info?: B): Split ==
+       -- if cleanW? then REMOVE REDUNDANT COMPONENTS in lts
+       -- if sqfr? then SPLIT the system with SQUARE-FREE FACTORIZATION
+       -- if clos? then SOLVE in the closure sense 
+       -- if rem? then REDUCE the current p by using remainder
+       -- if info? then PRINT info
+       empty? lp => lts
+       branches: List Branch := _
+         prepareDecompose(lp,lts,cleanW?,sqfr?)$quasicomppack
+       empty? branches => []
+       toSee: List LpWT := [[br.eq,br.tower]$LpWT for br in branches]
+       toSave: Split := []
+       if clos? then bound := _
+         KrullNumber(lp,lts) else bound := numberOfVariables(lp,lts)
+       while (not empty? toSee) repeat
+         if info? then printInfo(toSee,#toSave)
+         lpwt := first toSee; toSee := rest toSee
+         lp := lpwt.val; ts := lpwt.tower
+         empty? lp => 
+           toSave := cons(ts, toSave)
+         p := first lp;  lp := rest lp
+         if rem? and (not ground? p) and (not empty? ts)  
+            then 
+              p := remainder(p,ts).polnum
+         p := removeZero(p,ts)
+         zero? p => toSee := cons([lp,ts]$LpWT, toSee)
+         ground? p => "leave"
+         rsl := internalDecompose(p,ts,bound,clos?)
+         toSee := upDateBranches(lp,toSave,toSee,rsl,bound)
+       removeSuperfluousQuasiComponents(toSave)$quasicomppack
+
+     upDateBranches(leq:LP,lts:Split,current:List LpWT,wip: Wip,n:N):_
+           List LpWT ==
+       newBranches: List LpWT := wip.todo
+       newComponents: Split := wip.done
+       branches1, branches2:  List LpWT 
+       branches1 := []; branches2  := []
+       for branch in newBranches repeat
+         us := branch.tower
+         #us > n => "leave"
+         newleq := sort(infRittWu?,concat(leq,branch.val))
+         branches1 := cons([newleq,us]$LpWT, branches1)
+       for us in newComponents repeat
+         #us > n => "leave"
+         subQuasiComponent?(us,lts)$quasicomppack => "leave"
+         branches2 := cons([leq,us]$LpWT, branches2)
+       empty? branches1 => 
+         empty? branches2 => current
+         concat(branches2, current)
+       branches := concat [branches2, branches1, current]
+       removeSuperfluousCases(branches)$quasicomppack
+
+\end{chunk}
+
+\begin{chunk}{COQ SRDCMPK}
+(* package SRDCMPK *)
+(*
+
+     KrullNumber(lp: LP, lts: Split): N ==
+       ln: List N := [#(ts) for ts in lts]
+       n := #lp + reduce(max,ln)
+
+     numberOfVariables(lp: LP, lts: Split): N ==
+       lv: List V := variables([lp]$PS)
+       for ts in lts repeat lv := concat(variables(ts), lv)
+       # removeDuplicates(lv)
+
+     algebraicDecompose(p: P, ts: TS): Record(done: Split, todo: List LpWT) ==
+       ground? p =>
+         error " in algebraicDecompose$REGSET: should never happen !"
+       v := mvar(p); n := #ts
+       ts_v_- := collectUnder(ts,v)
+       ts_v_+ := collectUpper(ts,v)
+       ts_v := select(ts,v)::P
+       lgwt: List PWT
+       if mdeg(p) < mdeg(ts_v)
+        then 
+         lgwt := _
+          stoseInternalLastSubResultant(ts_v,p,ts_v_-,true,false)$regsetgcdpack
+        else
+         lgwt := _
+          stoseInternalLastSubResultant(p,ts_v,ts_v_-,true,false)$regsetgcdpack
        lts: Split := []
        llpwt: List LpWT := []
        for gwt in lgwt repeat
@@ -181211,7 +227120,8 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation
            lts := concat(augment(members(ts_v_+),augment(g,us)$TS)$TS,lts)         
        [lts,llpwt]
 
-     transcendentalDecompose(p: P, ts: TS,bound: N): Record(done: Split, todo: List LpWT) ==
+     transcendentalDecompose(p: P, ts: TS,bound: N): _
+          Record(done: Split, todo: List LpWT) ==
        lts: Split
        if #ts < bound 
          then
@@ -181221,16 +227131,19 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation
        llpwt: List LpWT := []
        [lts,llpwt]
 
-     transcendentalDecompose(p: P, ts: TS): Record(done: Split, todo: List LpWT) ==
+     transcendentalDecompose(p: P, ts: TS): _
+         Record(done: Split, todo: List LpWT) ==
        lts: Split:= augment(p,ts)$TS
        llpwt: List LpWT := []
        [lts,llpwt]
 
-     internalDecompose(p: P, ts: TS,bound: N,clos?:B): Record(done: Split, todo: List LpWT) ==
+     internalDecompose(p: P, ts: TS,bound: N,clos?:B): _
+         Record(done: Split, todo: List LpWT) ==
        clos? => internalDecompose(p,ts,bound)
        internalDecompose(p,ts)
 
-     internalDecompose(p: P, ts: TS,bound: N): Record(done: Split, todo: List LpWT) ==
+     internalDecompose(p: P, ts: TS,bound: N): _
+         Record(done: Split, todo: List LpWT) ==
        -- ASSUME p not constant
        llpwt: List LpWT := []
        lts: Split := []
@@ -181298,12 +227211,13 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation
        decompose(lp,lts,false,false,clos?,true,info?)
 
      convert(lpwt: LpWT): String ==
-       ls: List String := ["<", string((#(lpwt.val))::Z), ",", string((#(lpwt.tower))::Z), ">" ]
+       ls: List String := __
+        ["<", string((#(lpwt.val))::Z), ",", string((#(lpwt.tower))::Z), ">" ]
        concat ls
 
      printInfo(toSee: List LpWT, n: N): Void ==
        lpwt := first toSee
-       s: String := concat ["[", string((#toSee)::Z), " ", convert(lpwt)@String]
+       s:String := concat ["[", string((#toSee)::Z), " ", convert(lpwt)@String]
        m: N := #(lpwt.val)
        toSee := rest toSee
        for lpwt in toSee repeat
@@ -181313,18 +227227,21 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation
        iprint(s)$iprintpack
        void()
 
-     decompose(lp: LP, lts: Split, cleanW?: B, sqfr?: B, clos?: B, rem?: B, info?: B): Split ==
+     decompose(lp: LP, lts: Split, cleanW?: B, sqfr?: B, clos?: B, _
+               rem?: B, info?: B): Split ==
        -- if cleanW? then REMOVE REDUNDANT COMPONENTS in lts
        -- if sqfr? then SPLIT the system with SQUARE-FREE FACTORIZATION
        -- if clos? then SOLVE in the closure sense 
        -- if rem? then REDUCE the current p by using remainder
        -- if info? then PRINT info
        empty? lp => lts
-       branches: List Branch := prepareDecompose(lp,lts,cleanW?,sqfr?)$quasicomppack
+       branches: List Branch := _
+         prepareDecompose(lp,lts,cleanW?,sqfr?)$quasicomppack
        empty? branches => []
        toSee: List LpWT := [[br.eq,br.tower]$LpWT for br in branches]
        toSave: Split := []
-       if clos? then bound := KrullNumber(lp,lts) else bound := numberOfVariables(lp,lts)
+       if clos? then bound := _
+         KrullNumber(lp,lts) else bound := numberOfVariables(lp,lts)
        while (not empty? toSee) repeat
          if info? then printInfo(toSee,#toSave)
          lpwt := first toSee; toSee := rest toSee
@@ -181342,7 +227259,8 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation
          toSee := upDateBranches(lp,toSave,toSee,rsl,bound)
        removeSuperfluousQuasiComponents(toSave)$quasicomppack
 
-     upDateBranches(leq:LP,lts:Split,current:List LpWT,wip: Wip,n:N): List LpWT ==
+     upDateBranches(leq:LP,lts:Split,current:List LpWT,wip: Wip,n:N):_
+           List LpWT ==
        newBranches: List LpWT := wip.todo
        newComponents: Split := wip.done
        branches1, branches2:  List LpWT 
@@ -181351,28 +227269,17 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation
          us := branch.tower
          #us > n => "leave"
          newleq := sort(infRittWu?,concat(leq,branch.val))
-         --foo := rewriteSetWithReduction(newleq,us,initiallyReduce,initiallyReduced?)
-         --any?(ground?,foo)  => "leave"
          branches1 := cons([newleq,us]$LpWT, branches1)
        for us in newComponents repeat
          #us > n => "leave"
          subQuasiComponent?(us,lts)$quasicomppack => "leave"
-         --newleq := leq
-         --foo := rewriteSetWithReduction(newleq,us,initiallyReduce,initiallyReduced?)
-         --any?(ground?,foo)  => "leave"
          branches2 := cons([leq,us]$LpWT, branches2)
        empty? branches1 => 
          empty? branches2 => current
          concat(branches2, current)
        branches := concat [branches2, branches1, current]
-       -- branches := concat(branches,current)
        removeSuperfluousCases(branches)$quasicomppack
 
-\end{chunk}
-
-\begin{chunk}{COQ SRDCMPK}
-(* package SRDCMPK *)
-(*
 *)
 
 \end{chunk}
@@ -181693,7 +227600,6 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation
      -- ASSUME p is not constant and mvar(p) > mvar(ts)
      -- ASSUME init(p) is invertible w.r.t. ts
      -- ASSUME p is mainly primitive
---       one? mdeg(p) => [[p,ts]$PWT]
        mdeg(p) = 1 => [[p,ts]$PWT]
        v := mvar(p)$P
        q: P := mainPrimitivePart D(p,v)
@@ -181907,6 +227813,375 @@ SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,TS): Exports == Implementation
 \begin{chunk}{COQ SFRGCD}
 (* package SFRGCD *)
 (*
+
+     startTableGcd!(ok: S, ko: S, domainName: S): Void == 
+       initTable!()$HGcd
+       printInfo!(ok,ko)$HGcd
+       startStats!(domainName)$HGcd
+       void()
+
+     stopTableGcd!(): Void ==   
+       if makingStats?()$HGcd then printStats!()$HGcd
+       clearTable!()$HGcd
+
+     startTableInvSet!(ok: S, ko: S, domainName: S): Void == 
+       initTable!()$HInvSet
+       printInfo!(ok,ko)$HInvSet
+       startStats!(domainName)$HInvSet
+       void()
+
+     stopTableInvSet!(): Void ==   
+       if makingStats?()$HInvSet then printStats!()$HInvSet
+       clearTable!()$HInvSet
+
+     stoseInvertible?(p:P,ts:TS): Boolean == 
+       q := primitivePart initiallyReduce(p,ts)
+       zero? q => false
+       normalized?(q,ts) => true
+       v := mvar(q)
+       not algebraic?(v,ts) => 
+         toCheck: List BWT := stoseInvertible?(p,ts)@(List BWT)
+         for bwt in toCheck repeat
+           bwt.val = false => return false
+         return true
+       ts_v := select(ts,v)::P
+       ts_v_- := collectUnder(ts,v)
+       lgwt := stoseInternalLastSubResultant(ts_v,q,ts_v_-,false,true)
+       for gwt in lgwt repeat
+         g := gwt.val; 
+         (not ground? g) and (mvar(g) = v) => 
+           return false
+       true
+
+     stosePrepareSubResAlgo(p1:P,p2:P,ts:TS): List LpWT ==
+       -- ASSUME mvar(p1) = mvar(p2) > mvar(ts) and mdeg(p1) >= mdeg(p2)
+       -- ASSUME init(p1) invertible modulo ts !!!
+       toSee: List LpWT := [[[p1,p2],ts]$LpWT]
+       toSave: List LpWT := []
+       v := mvar(p1)
+       while (not empty? toSee) repeat
+         lpwt := first toSee; toSee := rest toSee
+         p1 := lpwt.val.1; p2 := lpwt.val.2
+         ts := lpwt.tower
+         lbwt := stoseInvertible?(leadingCoefficient(p2,v),ts)@(List BWT)
+         for bwt in lbwt repeat
+           (bwt.val = true) and (degree(p2,v) > 0) =>
+             p3 := prem(p1, -p2)
+             s: P := init(p2)**(mdeg(p1) - mdeg(p2))::N
+             toSave := cons([[p2,p3,s],bwt.tower]$LpWT,toSave)
+           -- p2 := initiallyReduce(p2,bwt.tower)
+           newp2 := primitivePart initiallyReduce(p2,bwt.tower)
+           (bwt.val = true) =>
+             -- toSave := cons([[p2,0,1],bwt.tower]$LpWT,toSave)
+             toSave := cons([[p2,0,1],bwt.tower]$LpWT,toSave)
+           -- zero? p2 => 
+           zero? newp2 => 
+             toSave := cons([[p1,0,1],bwt.tower]$LpWT,toSave)
+           -- toSee := cons([[p1,p2],bwt.tower]$LpWT,toSee)
+           toSee := cons([[p1,newp2],bwt.tower]$LpWT,toSee)
+       toSave
+
+     stoseIntegralLastSubResultant(p1:P,p2:P,ts:TS): List PWT ==
+       -- ASSUME mvar(p1) = mvar(p2) > mvar(ts) and mdeg(p1) >= mdeg(p2)
+       -- ASSUME p1 and p2 have no algebraic coefficients
+       lsr := lastSubResultant(p1, p2)
+       ground?(lsr) => [[lsr,ts]$PWT]
+       mvar(lsr) < mvar(p1) => [[lsr,ts]$PWT]
+       gi1i2 := gcd(init(p1),init(p2))
+       ex: Union(P,"failed") := (gi1i2 * lsr) exquo$P init(lsr)
+       ex case "failed" => [[lsr,ts]$PWT]
+       [[ex::P,ts]$PWT]
+            
+     stoseInternalLastSubResultant(p1:P,p2:P,ts:TS,b1:B,b2:B): List PWT ==
+       -- ASSUME mvar(p1) = mvar(p2) > mvar(ts) and mdeg(p1) >= mdeg(p2)
+       -- if b1 ASSUME init(p2) invertible w.r.t. ts
+       -- if b2 BREAK with the first non-trivial gcd 
+       k: KeyGcd := [p1,p2,ts,b2]
+       e := extractIfCan(k)$HGcd
+       e case EntryGcd => e::EntryGcd
+       toSave: List PWT 
+       empty? ts => 
+         toSave := stoseIntegralLastSubResultant(p1,p2,ts)
+         insert!(k,toSave)$HGcd
+         return toSave
+       toSee: List LpWT 
+       if b1
+         then
+           p3 := prem(p1, -p2)
+           s: P := init(p2)**(mdeg(p1) - mdeg(p2))::N
+           toSee := [[[p2,p3,s],ts]$LpWT]
+         else
+           toSee := stosePrepareSubResAlgo(p1,p2,ts)
+       toSave := stoseInternalLastSubResultant(toSee,mvar(p1),b2)
+       insert!(k,toSave)$HGcd
+       toSave
+
+     stoseInternalLastSubResultant(llpwt: List LpWT,v:V,b2:B): List PWT ==
+       toReturn: List PWT := []; toSee: List LpWT; 
+       while (not empty? llpwt) repeat
+         toSee := llpwt; llpwt := []
+         -- CONSIDER FIRST the vanishing current last subresultant
+         for lpwt in toSee repeat 
+           p1 := lpwt.val.1; 
+           p2 := lpwt.val.2; 
+           s := lpwt.val.3; 
+           ts := lpwt.tower
+           lbwt := stoseInvertible?(leadingCoefficient(p2,v),ts)@(List BWT)
+           for bwt in lbwt repeat
+             bwt.val = false => 
+               toReturn := cons([p1,bwt.tower]$PWT, toReturn)
+               b2 and positive?(degree(p1,v)) => return toReturn
+             llpwt := cons([[p1,p2,s],bwt.tower]$LpWT, llpwt)
+         empty? llpwt => "leave"
+         -- CONSIDER NOW the branches where the computations continue
+         toSee := llpwt; llpwt := []
+         lpwt := first toSee; toSee := rest toSee
+         p1 := lpwt.val.1; p2 := lpwt.val.2; s := lpwt.val.3
+         delta: N := (mdeg(p1) - degree(p2,v))::N
+         p3: P := LazardQuotient2(p2, leadingCoefficient(p2,v), s, delta)
+         zero?(degree(p3,v)) =>
+           toReturn := cons([p3,lpwt.tower]$PWT, toReturn)
+           for lpwt in toSee repeat 
+             toReturn := cons([p3,lpwt.tower]$PWT, toReturn)
+         (p1, p2) := (p3, next_subResultant2(p1, p2, p3, s))
+         s := leadingCoefficient(p1,v)
+         llpwt := cons([[p1,p2,s],lpwt.tower]$LpWT, llpwt)
+         for lpwt in toSee repeat 
+           llpwt := cons([[p1,p2,s],lpwt.tower]$LpWT, llpwt)
+       toReturn
+
+     stoseLastSubResultant(p1:P,p2:P,ts:TS): List PWT ==
+       ground? p1 => 
+         error"in stoseLastSubResultantElseSplit$SFRGCD  : bad #1"
+       ground? p2 => 
+         error"in stoseLastSubResultantElseSplit$SFRGCD : bad #2"
+       not (mvar(p2) = mvar(p1)) => 
+         error"in stoseLastSubResultantElseSplit$SFRGCD : bad #2"
+       algebraic?(mvar(p1),ts) =>
+         error"in stoseLastSubResultantElseSplit$SFRGCD : bad #1"
+       not initiallyReduced?(p1,ts) => 
+         error"in stoseLastSubResultantElseSplit$SFRGCD : bad #1"
+       not initiallyReduced?(p2,ts) => 
+         error"in stoseLastSubResultantElseSplit$SFRGCD : bad #2"
+       purelyTranscendental?(p1,ts) and purelyTranscendental?(p2,ts) =>
+         stoseIntegralLastSubResultant(p1,p2,ts)
+       if mdeg(p1) < mdeg(p2) then 
+          (p1, p2) := (p2, p1)
+          if odd?(mdeg(p1)) and odd?(mdeg(p2)) then p2 := - p2
+       stoseInternalLastSubResultant(p1,p2,ts,false,false)
+
+     stoseSquareFreePart_wip(p:P, ts: TS): List PWT ==
+     -- ASSUME p is not constant and mvar(p) > mvar(ts)
+     -- ASSUME init(p) is invertible w.r.t. ts
+     -- ASSUME p is mainly primitive
+       mdeg(p) = 1 => [[p,ts]$PWT]
+       v := mvar(p)$P
+       q: P := mainPrimitivePart D(p,v)
+       lgwt: List PWT := stoseInternalLastSubResultant(p,q,ts,true,false)
+       lpwt : List PWT := []
+       sfp : P
+       for gwt in lgwt repeat
+         g := gwt.val; us := gwt.tower
+         (ground? g) or (mvar(g) < v) =>
+           lpwt := cons([p,us],lpwt)
+         g := mainPrimitivePart g
+         sfp := lazyPquo(p,g)
+         sfp := mainPrimitivePart stronglyReduce(sfp,us)
+         lpwt := cons([sfp,us],lpwt)
+       lpwt
+
+     stoseSquareFreePart_base(p:P, ts: TS): List PWT == [[p,ts]$PWT]
+
+     stoseSquareFreePart(p:P, ts:TS): List PWT == stoseSquareFreePart_wip(p,ts)
+       
+     stoseInvertible?_sqfreg(p:P,ts:TS): List BWT ==
+       --iprint("+")$iprintpack
+       q := primitivePart initiallyReduce(p,ts)
+       zero? q => [[false,ts]$BWT]
+       normalized?(q,ts) => [[true,ts]$BWT]
+       v := mvar(q)
+       not algebraic?(v,ts) => 
+         lbwt: List BWT := []
+         toCheck: List BWT := stoseInvertible?_sqfreg(init(q),ts)@(List BWT)
+         for bwt in toCheck repeat
+           bwt.val => lbwt := cons(bwt,lbwt)
+           newq := removeZero(q,bwt.tower)
+           zero? newq => lbwt := cons(bwt,lbwt)
+           lbwt := 
+            concat(stoseInvertible?_sqfreg(newq,bwt.tower)@(List BWT), lbwt)
+         return lbwt
+       ts_v := select(ts,v)::P
+       ts_v_- := collectUnder(ts,v)
+       ts_v_+ := collectUpper(ts,v)
+       lgwt := stoseInternalLastSubResultant(ts_v,q,ts_v_-,false,false)
+       lbwt: List BWT := []
+       lts, lts_g, lts_h: Split
+       for gwt in lgwt repeat
+         g := gwt.val; ts := gwt.tower
+         (ground? g) or (mvar(g) < v) => 
+           lts := augment(ts_v,ts)$TS
+           lts := augment(members(ts_v_+),lts)$TS
+           for ts in lts repeat
+             lbwt := cons([true, ts]$BWT,lbwt)
+         g := mainPrimitivePart g
+         lts_g := augment(g,ts)$TS
+         lts_g := augment(members(ts_v_+),lts_g)$TS
+         -- USE stoseInternalAugment with parameters ??
+         for ts_g in lts_g repeat
+           lbwt := cons([false, ts_g]$BWT,lbwt)
+         h := lazyPquo(ts_v,g)
+         (ground? h) or (mvar(h) < v) => "leave"
+         h := mainPrimitivePart h
+         lts_h := augment(h,ts)$TS
+         lts_h := augment(members(ts_v_+),lts_h)$TS
+         -- USE stoseInternalAugment with parameters ??
+         for ts_h in lts_h repeat
+           lbwt := cons([true, ts_h]$BWT,lbwt)
+       sort((x,y) +-> x.val < y.val,lbwt)
+
+     stoseInvertibleSet_sqfreg(p:P,ts:TS): Split ==
+       --iprint("*")$iprintpack
+       k: KeyInvSet := [p,ts]
+       e := extractIfCan(k)$HInvSet
+       e case EntryInvSet => e::EntryInvSet
+       q := primitivePart initiallyReduce(p,ts)
+       zero? q => []
+       normalized?(q,ts) => [ts]
+       v := mvar(q)
+       toSave: Split := []
+       not algebraic?(v,ts) => 
+         toCheck: List BWT := stoseInvertible?_sqfreg(init(q),ts)@(List BWT)
+         for bwt in toCheck repeat
+           bwt.val => toSave := cons(bwt.tower,toSave)
+           newq := removeZero(q,bwt.tower)
+           zero? newq => "leave"
+           toSave := concat(stoseInvertibleSet_sqfreg(newq,bwt.tower), toSave)
+         toSave := removeDuplicates toSave
+         return algebraicSort(toSave)$quasicomppack
+       ts_v := select(ts,v)::P
+       ts_v_- := collectUnder(ts,v)
+       ts_v_+ := collectUpper(ts,v)
+       lgwt := stoseInternalLastSubResultant(ts_v,q,ts_v_-,false,false)
+       lts, lts_h: Split
+       for gwt in lgwt repeat
+         g := gwt.val; ts := gwt.tower
+         (ground? g) or (mvar(g) < v) => 
+           lts := augment(ts_v,ts)$TS
+           lts := augment(members(ts_v_+),lts)$TS
+           toSave := concat(lts,toSave)
+         g := mainPrimitivePart g
+         h := lazyPquo(ts_v,g)
+         h := mainPrimitivePart h
+         (ground? h) or (mvar(h) < v) => "leave"
+         lts_h := augment(h,ts)$TS
+         lts_h := augment(members(ts_v_+),lts_h)$TS
+         toSave := concat(lts_h,toSave)
+       toSave := algebraicSort(toSave)$quasicomppack
+       insert!(k,toSave)$HInvSet
+       toSave
+       
+     stoseInvertible?_reg(p:P,ts:TS): List BWT ==
+       --iprint("-")$iprintpack
+       q := primitivePart initiallyReduce(p,ts)
+       zero? q => [[false,ts]$BWT]
+       normalized?(q,ts) => [[true,ts]$BWT]
+       v := mvar(q)
+       not algebraic?(v,ts) => 
+         lbwt: List BWT := []
+         toCheck: List BWT := stoseInvertible?_reg(init(q),ts)@(List BWT)
+         for bwt in toCheck repeat
+           bwt.val => lbwt := cons(bwt,lbwt)
+           newq := removeZero(q,bwt.tower)
+           zero? newq => lbwt := cons(bwt,lbwt)
+           lbwt := 
+            concat(stoseInvertible?_reg(newq,bwt.tower)@(List BWT), lbwt)
+         return lbwt
+       ts_v := select(ts,v)::P
+       ts_v_- := collectUnder(ts,v)
+       ts_v_+ := collectUpper(ts,v)
+       lgwt := stoseInternalLastSubResultant(ts_v,q,ts_v_-,false,false)
+       lbwt: List BWT := []
+       lts, lts_g, lts_h: Split
+       for gwt in lgwt repeat
+         g := gwt.val; ts := gwt.tower
+         (ground? g) or (mvar(g) < v) => 
+           lts := augment(ts_v,ts)$TS
+           lts := augment(members(ts_v_+),lts)$TS
+           for ts in lts repeat
+             lbwt := cons([true, ts]$BWT,lbwt)
+         g := mainPrimitivePart g
+         lts_g := augment(g,ts)$TS
+         lts_g := augment(members(ts_v_+),lts_g)$TS
+         -- USE internalAugment with parameters ??
+         for ts_g in lts_g repeat
+           lbwt := cons([false, ts_g]$BWT,lbwt)
+         h := lazyPquo(ts_v,g)
+         (ground? h) or (mvar(h) < v) => "leave"
+         h := mainPrimitivePart h
+         lts_h := augment(h,ts)$TS
+         lts_h := augment(members(ts_v_+),lts_h)$TS
+         -- USE internalAugment with parameters ??
+         for ts_h in lts_h repeat
+           inv := stoseInvertible?_reg(q,ts_h)@(List BWT)
+           lbwt := concat([bwt for bwt in inv | bwt.val],lbwt)
+       sort((x,y) +-> x.val < y.val,lbwt)
+
+     stoseInvertibleSet_reg(p:P,ts:TS): Split ==
+       --iprint("/")$iprintpack
+       k: KeyInvSet := [p,ts]
+       e := extractIfCan(k)$HInvSet
+       e case EntryInvSet => e::EntryInvSet
+       q := primitivePart initiallyReduce(p,ts)
+       zero? q => []
+       normalized?(q,ts) => [ts]
+       v := mvar(q)
+       toSave: Split := []
+       not algebraic?(v,ts) =>
+         toCheck: List BWT := stoseInvertible?_reg(init(q),ts)@(List BWT)
+         for bwt in toCheck repeat
+           bwt.val => toSave := cons(bwt.tower,toSave)
+           newq := removeZero(q,bwt.tower)
+           zero? newq => "leave"
+           toSave := concat(stoseInvertibleSet_reg(newq,bwt.tower), toSave)
+         toSave := removeDuplicates toSave
+         return algebraicSort(toSave)$quasicomppack
+       ts_v := select(ts,v)::P
+       ts_v_- := collectUnder(ts,v)
+       ts_v_+ := collectUpper(ts,v)
+       lgwt := stoseInternalLastSubResultant(ts_v,q,ts_v_-,false,false)
+       lts, lts_h: Split
+       for gwt in lgwt repeat
+         g := gwt.val; ts := gwt.tower
+         (ground? g) or (mvar(g) < v) => 
+           lts := augment(ts_v,ts)$TS
+           lts := augment(members(ts_v_+),lts)$TS
+           toSave := concat(lts,toSave)
+         g := mainPrimitivePart g
+         h := lazyPquo(ts_v,g)
+         h := mainPrimitivePart h
+         (ground? h) or (mvar(h) < v) => "leave"
+         lts_h := augment(h,ts)$TS
+         lts_h := augment(members(ts_v_+),lts_h)$TS
+         for ts_h in lts_h repeat
+           inv := stoseInvertibleSet_reg(q,ts_h)
+           toSave := removeDuplicates concat(inv,toSave)
+       toSave := algebraicSort(toSave)$quasicomppack
+       insert!(k,toSave)$HInvSet
+       toSave
+
+     if TS has SquareFreeRegularTriangularSetCategory(R,E,V,P)
+     then
+
+       stoseInvertible?(p:P,ts:TS): List BWT == stoseInvertible?_sqfreg(p,ts)
+
+       stoseInvertibleSet(p:P,ts:TS): Split == stoseInvertibleSet_sqfreg(p,ts)
+
+     else
+       
+       stoseInvertible?(p:P,ts:TS): List BWT == stoseInvertible?_reg(p,ts)
+ 
+       stoseInvertibleSet(p:P,ts:TS): Split == stoseInvertibleSet_reg(p,ts)
+
 *)
 
 \end{chunk}
@@ -182154,7 +228429,6 @@ StorageEfficientMatrixOperations(R): Exports == Implementation where
             copy_!(a,c)
           flag := true
           copy_!(a,b)
---        one? p => return a
         (p = 1) => return a
         p := p quo 2
         times_!(c,b,b)
@@ -182170,6 +228444,130 @@ StorageEfficientMatrixOperations(R): Exports == Implementation where
 \begin{chunk}{COQ MATSTOR}
 (* package MATSTOR *)
 (*
+ 
+    rep : M -> REP
+    rep m == m pretend REP
+ 
+    copy_!(c,a) ==
+      m := nrows a; n := ncols a
+      not((nrows c) = m and (ncols c) = n) =>
+        error "copy!: matrices of incompatible dimensions"
+      aa := rep a; cc := rep c
+      for i in 0..(m-1) repeat
+        aRow := qelt(aa,i); cRow := qelt(cc,i)
+        for j in 0..(n-1) repeat
+          qsetelt_!(cRow,j,qelt(aRow,j))
+      c
+ 
+    plus_!(c,a,b) ==
+      m := nrows a; n := ncols a
+      not((nrows b) = m and (ncols b) = n) =>
+        error "plus!: matrices of incompatible dimensions"
+      not((nrows c) = m and (ncols c) = n) =>
+        error "plus!: matrices of incompatible dimensions"
+      aa := rep a; bb := rep b; cc := rep c
+      for i in 0..(m-1) repeat
+        aRow := qelt(aa,i); bRow := qelt(bb,i); cRow := qelt(cc,i)
+        for j in 0..(n-1) repeat
+          qsetelt_!(cRow,j,qelt(aRow,j) + qelt(bRow,j))
+      c
+ 
+    minus_!(c,a) ==
+      m := nrows a; n := ncols a
+      not((nrows c) = m and (ncols c) = n) =>
+        error "minus!: matrices of incompatible dimensions"
+      aa := rep a; cc := rep c
+      for i in 0..(m-1) repeat
+        aRow := qelt(aa,i); cRow := qelt(cc,i)
+        for j in 0..(n-1) repeat
+          qsetelt_!(cRow,j,-qelt(aRow,j))
+      c
+ 
+    minus_!(c,a,b) ==
+      m := nrows a; n := ncols a
+      not((nrows b) = m and (ncols b) = n) =>
+        error "minus!: matrices of incompatible dimensions"
+      not((nrows c) = m and (ncols c) = n) =>
+        error "minus!: matrices of incompatible dimensions"
+      aa := rep a; bb := rep b; cc := rep c
+      for i in 0..(m-1) repeat
+        aRow := qelt(aa,i); bRow := qelt(bb,i); cRow := qelt(cc,i)
+        for j in 0..(n-1) repeat
+          qsetelt_!(cRow,j,qelt(aRow,j) - qelt(bRow,j))
+      c
+ 
+    leftScalarTimes_!(c,r,a) ==
+      m := nrows a; n := ncols a
+      not((nrows c) = m and (ncols c) = n) =>
+        error "leftScalarTimes!: matrices of incompatible dimensions"
+      aa := rep a; cc := rep c
+      for i in 0..(m-1) repeat
+        aRow := qelt(aa,i); cRow := qelt(cc,i)
+        for j in 0..(n-1) repeat
+          qsetelt_!(cRow,j,r * qelt(aRow,j))
+      c
+ 
+    rightScalarTimes_!(c,a,r) ==
+      m := nrows a; n := ncols a
+      not((nrows c) = m and (ncols c) = n) =>
+        error "rightScalarTimes!: matrices of incompatible dimensions"
+      aa := rep a; cc := rep c
+      for i in 0..(m-1) repeat
+        aRow := qelt(aa,i); cRow := qelt(cc,i)
+        for j in 0..(n-1) repeat
+          qsetelt_!(cRow,j,qelt(aRow,j) * r)
+      c
+ 
+    copyCol_!: (ARR,REP,Integer,Integer) -> ARR
+    copyCol_!(bCol,bb,j,n1) ==
+      for i in 0..n1 repeat qsetelt_!(bCol,i,qelt(qelt(bb,i),j))
+ 
+    times_!(c,a,b) ==
+      m := nrows a; n := ncols a; p := ncols b
+      not((nrows b) = n and (nrows c) = m and (ncols c) = p) =>
+        error "times!: matrices of incompatible dimensions"
+      aa := rep a; bb := rep b; cc := rep c
+      bCol : ARR := new(n,0)
+      m1 := (m :: Integer) - 1; n1 := (n :: Integer) - 1
+      for j in 0..(p-1) repeat
+        copyCol_!(bCol,bb,j,n1)
+        for i in 0..m1 repeat
+          aRow := qelt(aa,i); cRow := qelt(cc,i)
+          sum : R := 0
+          for k in 0..n1 repeat
+            sum := sum + qelt(aRow,k) * qelt(bCol,k)
+          qsetelt_!(cRow,j,sum)
+      c
+ 
+    power_!(a,b,c,m,p) ==
+      mm := nrows a; nn := ncols a
+      not(mm = nn) =>
+        error "power!: matrix must be square"
+      not((nrows b) = mm and (ncols b) = nn) =>
+        error "power!: matrices of incompatible dimensions"
+      not((nrows c) = mm and (ncols c) = nn) =>
+        error "power!: matrices of incompatible dimensions"
+      not((nrows m) = mm and (ncols m) = nn) =>
+        error "power!: matrices of incompatible dimensions"
+      flag := false
+      copy_!(b,m)
+      repeat
+        if odd? p then
+          flag =>
+            times_!(c,b,a)
+            copy_!(a,c)
+          flag := true
+          copy_!(a,b)
+        (p = 1) => return a
+        p := p quo 2
+        times_!(c,b,b)
+        copy_!(b,c)
+ 
+    m ** n ==
+      not square? m => error "**: matrix must be square"
+      a := copy m; b := copy m; c := copy m
+      power_!(a,b,c,m,n)
+
 *)
 
 \end{chunk}
@@ -182256,6 +228654,12 @@ StreamFunctions1(S:Type): Exports == Implementation where
 \begin{chunk}{COQ STREAM1}
 (* package STREAM1 *)
 (*
+
+    concat z == delay
+      empty? z => empty()
+      empty?(x := frst z) => concat rst z
+      concat(frst x,concat(rst x,concat rst z))
+
 *)
 
 \end{chunk}
@@ -182374,8 +228778,6 @@ StreamFunctions2(A:Type,B:Type): Exports == Implementation where
       eq?(x,rst x) => repeating([f frst x])
       mapp(f, x)
 
---  reshape(y,x) == y
-
     scan(b,h,x) == delay
       empty? x => empty()
       c := h(frst x,b)
@@ -182384,15 +228786,32 @@ StreamFunctions2(A:Type,B:Type): Exports == Implementation where
     reduce(b,h,x) ==
       empty? x => b
       reduce(h(frst x,b),h,rst x)
---  rreduce(b,h,x) ==
---    empty? x => b
---    h(frst x,rreduce(b,h,rst x))
 
 \end{chunk}
 
 \begin{chunk}{COQ STREAM2}
 (* package STREAM2 *)
 (*
+
+    mapp: (A -> B,ST A) -> ST B
+    mapp(f,x)== delay
+      empty? x => empty()
+      concat(f frst x, map(f,rst x))
+
+    map(f,x) ==
+      explicitlyEmpty? x => empty()
+      eq?(x,rst x) => repeating([f frst x])
+      mapp(f, x)
+
+    scan(b,h,x) == delay
+      empty? x => empty()
+      c := h(frst x,b)
+      concat(c,scan(c,h,rst x))
+
+    reduce(b,h,x) ==
+      empty? x => b
+      reduce(h(frst x,b),h,rst x)
+
 *)
 
 \end{chunk}
@@ -182491,6 +228910,19 @@ StreamFunctions3(A,B,C): Exports == Implementation where
 \begin{chunk}{COQ STREAM3}
 (* package STREAM3 *)
 (*
+
+    mapp:((A,B) -> C,ST A,ST B) -> ST C
+    mapp(g,x,y) == delay
+      empty? x or empty? y => empty()
+      concat(g(frst x,frst y), map(g,rst x,rst y))
+
+    map(g,x,y) ==
+      explicitlyEmpty? x => empty()
+      eq?(x,rst x) => map(z +-> g(frst x,z),y)$StreamFunctions2(B,C)
+      explicitlyEmpty? y => empty()
+      eq?(y,rst y) => map(z +-> g(z,frst y),x)$StreamFunctions2(A,C)
+      mapp(g,x,y)
+
 *)
 
 \end{chunk}
@@ -182594,8 +229026,11 @@ StreamInfiniteProduct(Coef): Exports == Implementation where
       import StreamTranscendentalFunctions(Coef)
  
       infiniteProduct st             == exp lambert log st
+
       evenInfiniteProduct st         == exp evenlambert log st
+
       oddInfiniteProduct st          == exp oddlambert log st
+
       generalInfiniteProduct(st,a,d) == exp generalLambert(log st,a,d)
  
     else
@@ -182609,8 +229044,11 @@ StreamInfiniteProduct(Coef): Exports == Implementation where
         map(z1 +-> retract(z1)@Coef,f stQF)$StreamFunctions2(QF Coef,Coef)
  
       infiniteProduct st     == applyOverQF(z1 +-> exp lambert log z1,st)
+
       evenInfiniteProduct st == applyOverQF(z1 +-> exp evenlambert log z1,st)
+
       oddInfiniteProduct st  == applyOverQF(z1 +-> exp oddlambert log z1,st)
+
       generalInfiniteProduct(st,a,d) ==
         applyOverQF(z1 +-> exp generalLambert(log z1,a,d),st)
 
@@ -182619,6 +229057,39 @@ StreamInfiniteProduct(Coef): Exports == Implementation where
 \begin{chunk}{COQ STINPROD}
 (* package STINPROD *)
 (*
+ 
+    if Coef has Field then
+ 
+      import StreamTaylorSeriesOperations(Coef)
+      import StreamTranscendentalFunctions(Coef)
+ 
+      infiniteProduct st             == exp lambert log st
+
+      evenInfiniteProduct st         == exp evenlambert log st
+
+      oddInfiniteProduct st          == exp oddlambert log st
+
+      generalInfiniteProduct(st,a,d) == exp generalLambert(log st,a,d)
+ 
+    else
+ 
+      import StreamTaylorSeriesOperations(QF Coef)
+      import StreamTranscendentalFunctions(QF Coef)
+ 
+      applyOverQF:(ST QF Coef -> ST QF Coef,ST Coef) -> ST Coef
+      applyOverQF(f,st) ==
+        stQF := map(z1 +-> z1::QF(Coef),st)$StreamFunctions2(Coef,QF Coef)
+        map(z1 +-> retract(z1)@Coef,f stQF)$StreamFunctions2(QF Coef,Coef)
+ 
+      infiniteProduct st     == applyOverQF(z1 +-> exp lambert log z1,st)
+
+      evenInfiniteProduct st == applyOverQF(z1 +-> exp evenlambert log z1,st)
+
+      oddInfiniteProduct st  == applyOverQF(z1 +-> exp oddlambert log z1,st)
+
+      generalInfiniteProduct(st,a,d) ==
+        applyOverQF(z1 +-> exp generalLambert(log z1,a,d),st)
+
 *)
 
 \end{chunk}
@@ -182865,32 +229336,342 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where
       ++ invmultisect(a,b,st) substitutes \spad{x**((a+b)*n)} for \spad{x**n}
       ++ and multiplies by \spad{x**b}.
     if A has Algebra RN then
-      integrate  : (A,ST A) -> ST A
-        ++ integrate(r,a) returns the integral of the power series \spad{a}
-        ++ with respect to the power series variableintegration where
-        ++ r denotes the constant of integration. Thus
-        ++ \spad{integrate(a,[a0,a1,a2,...]) = [a,a0,a1/2,a2/3,...]}.
-      lazyIntegrate  : (A,() -> ST A) -> ST A
-        ++ lazyIntegrate(r,f) is a local function
-        ++ used for fixed point computations.
-      nlde       : ST ST A -> ST A
-        ++ nlde(u) solves a
-        ++ first order non-linear differential equation described by u of the
-        ++ form \spad{[[b<0,0>,b<0,1>,...],[b<1,0>,b<1,1>,.],...]}.
-        ++ the differential equation has the form
-        ++ \spad{y'=sum(i=0 to infinity,j=0 to infinity,b<i,j>*(x**i)*(y**j))}.
-      powern : (RN,ST A) -> ST A
-        ++ powern(r,f) raises power series f to the power r.
+      integrate  : (A,ST A) -> ST A
+        ++ integrate(r,a) returns the integral of the power series \spad{a}
+        ++ with respect to the power series variableintegration where
+        ++ r denotes the constant of integration. Thus
+        ++ \spad{integrate(a,[a0,a1,a2,...]) = [a,a0,a1/2,a2/3,...]}.
+      lazyIntegrate  : (A,() -> ST A) -> ST A
+        ++ lazyIntegrate(r,f) is a local function
+        ++ used for fixed point computations.
+      nlde       : ST ST A -> ST A
+        ++ nlde(u) solves a
+        ++ first order non-linear differential equation described by u of the
+        ++ form \spad{[[b<0,0>,b<0,1>,...],[b<1,0>,b<1,1>,.],...]}.
+        ++ the differential equation has the form
+        ++ \spad{y'=sum(i=0 to infinity,j=0 to infinity,b<i,j>*(x**i)*(y**j))}.
+      powern : (RN,ST A) -> ST A
+        ++ powern(r,f) raises power series f to the power r.
+    if A has Field then
+      mapdiv     : (ST A,ST A) -> ST A
+        ++ mapdiv([a0,a1,..],[b0,b1,..]) returns
+        ++ \spad{[a0/b0,a1/b1,..]}.
+      lazyGintegrate : (I -> A,A,() -> ST A) -> ST A
+        ++ lazyGintegrate(f,r,g) is used for fixed point computations.
+      power      : (A,ST A) -> ST A
+        ++ power(a,f) returns the power series f raised to the power \spad{a}.
+
+  Implementation ==> add
+
+--% definitions
+
+    zro: () -> ST A
+    -- returns a zero power series
+    zro() == empty()$ST(A)
+
+--% arithmetic
+
+    x + y == delay
+      empty? y => x
+      empty? x => y
+      eq?(x,rst x) => map(z +-> frst x+z, y)
+      eq?(y,rst y) => map(z +-> frst y+z, x)
+      concat(frst x + frst y,rst x + rst y)
+
+    x - y == delay
+      empty? y => x
+      empty? x => -y
+      eq?(x,rst x) => map(z +-> frst x-z, y)
+      eq?(y,rst y) => map(z +-> z-frst y, x)
+      concat(frst x - frst y,rst x - rst y)
+
+    -y == map(z +-> -z, y)
+
+    (x:ST A) * (y:ST A) == delay
+      empty? y => zro()
+      empty? x => zro()
+      concat(frst x * frst y,frst x * rst y + rst x * y)
+
+    (s:A) * (x:ST A) ==
+      zero? s => zro()
+      map(z +-> s*z, x)
+
+    (x:ST A) * (s:A) ==
+      zero? s => zro()
+      map(z +-> z*s, x)
+
+    iDiv: (ST A,ST A,A) -> ST A
+    iDiv(x,y,ry0) == delay
+      empty? x => empty()
+      c0 := frst x * ry0
+      concat(c0,iDiv(rst x - c0 * rst y,y,ry0))
+
+    x exquo y ==
+      for n in 1.. repeat
+        n > 1000 => return "failed"
+        empty? y => return "failed"
+        empty? x => return empty()
+        frst y = 0 =>
+          frst x = 0 => (x := rst x; y := rst y)
+          return "failed"
+        leave "first entry in y is non-zero"
+      (ry0 := recip frst y) case "failed" => "failed"
+      empty? rst y => map(z +-> z*(ry0 :: A), x)
+      iDiv(x,y,ry0 :: A)
+
+    (x:ST A) / (y:ST A) == delay
+      empty? y => error "/: division by zero"
+      empty? x => empty()
+      (ry0 := recip frst y) case "failed" =>
+        error "/: second argument is not invertible"
+      empty? rst y => map(z +-> z*(ry0::A),x)
+      iDiv(x,y,ry0 :: A)
+
+    recip x ==
+      empty? x => "failed"
+      rh1 := recip frst x
+      rh1 case "failed" => "failed"
+      rh := rh1 :: A
+      delay
+        concat(rh,iDiv(- rh * rst x,x,rh))
+
+--% coefficients
+
+    rp: (I,A) -> L A
+    -- rp(z,s) is a list of length z each of whose entries is s.
+    rp(z,s) ==
+      z <= 0 => empty()
+      concat(s,rp(z-1,s))
+
+    rpSt: (I,A) -> ST A
+    -- rpSt(z,s) is a stream of length z each of whose entries is s.
+    rpSt(z,s) == delay
+      z <= 0 => empty()
+      concat(s,rpSt(z-1,s))
+
+    monom(s,z) ==
+      z < 0 => error "monom: cannot create monomial of negative degree"
+      concat(rpSt(z,0),concat(s,zro()))
+
+--% some streams of integers
+    nnintegers: NNI -> ST NNI
+    nnintegers zz == generate(y +-> y+1, zz)
+
+    integers z    == generate(y +-> y+1, z)
+
+    oddintegers z == generate(y +-> y+2, z)
+
+    int s         == generate(y +-> y+1, s)
+
+--% derivatives
+
+    mapmult(x,y) == delay
+      empty? y => zro()
+      empty? x => zro()
+      concat(frst x * frst y,mapmult(rst x,rst y))
+
+    deriv x ==
+      empty? x => zro()
+      mapmult(int 1,rest x)
+
+    gderiv(f,x) ==
+      empty? x => zro()
+      mapmult(map(f,integers 0)$SP2(I,A),x)
+
+--% coercions
+
+    coerce(s:A) ==
+      zero? s => zro()
+      concat(s,zro())
+
+--% evaluations and compositions
+
+    eval(x,at) == 
+      scan(0,(y,z) +-> y+z,mapmult(x,generate(y +-> at*y,1)))$SP2(A,A)
+
+    compose(x,y) == delay
+      empty? y => concat(frst x,zro())
+      not zero? frst y =>
+        error "compose: 2nd argument should have 0 constant coefficient"
+      empty? x => zro()
+      concat(frst x,compose(rst x,y) * rst(y))
+
+--% reversion
+
+    lagrangere:(ST A,ST A) -> ST A
+    lagrangere(x,c) == delay(concat(0,compose(x,c)))
+
+    lagrange x == YS(y +-> lagrangere(x,y))
+
+    revert x ==
+      empty? x => error "revert should start 0,1,..."
+      zero? frst x =>
+        empty? rst x => error "revert: should start 0,1,..."
+        (frst rst x) = 1 => lagrange(recip(rst x) :: (ST A))
+      error "revert:should start 0,1,..."
+
+--% lambert functions
+
+    addiag(ststa:ST ST A) == delay
+      empty? ststa => zro()
+      empty? frst ststa => concat(0,addiag rst ststa)
+      concat(frst(frst ststa),rst(frst ststa) + addiag(rst ststa))
+
+-- lambert operates on a series +/[a[i]x**i for i in 1..] , and produces
+-- the series +/[a[i](x**i/(1-x**i)) for i in 1..] i.e. forms the
+-- coefficients A[n] which is the sum of a[i] for all divisors i of n
+-- (including 1 and n)
+
+    --                               ---------
+    -- returns the repeating stream [s,0,...,0]; (there are z zeroes)
+    rptg1:(I,A) -> ST A
+    rptg1(z,s) == repeating concat(s,rp(z,0))
+
+    --                                       ---------
+    -- returns the repeating stream [0,...,0,s,0,...,0]
+    -- there are z leading zeroes and z-1 in the period
+    rptg2:(I,A) -> ST A
+    rptg2(z,s) == repeating concat(rp(z,0),concat(s,rp(z-1,0)))
+
+    rptg3:(I,I,I,A) -> ST A
+    rptg3(a,d,n,s) ==
+      concat(rpSt(n*(a-1),0),repeating(concat(s,rp(d*n-1,0))))
+
+    lambert x == delay
+      empty? x => zro()
+      zero? frst x =>
+        concat(0,addiag(map(rptg1,integers 0,rst x)$SP3(I,A,ST A)))
+      error "lambert:constant coefficient should be zero"
+
+    oddlambert x == delay
+      empty? x => zro()
+      zero? frst x =>
+        concat(0,addiag(map(rptg1,oddintegers 1,rst x)$SP3(I,A,ST A)))
+      error "oddlambert: constant coefficient should be zero"
+
+    evenlambert x == delay
+      empty? x => zro()
+      zero? frst x =>
+        concat(0,addiag(map(rptg2,integers 1,rst x)$SP3(I,A,ST A)))
+      error "evenlambert: constant coefficient should be zero"
+
+    generalLambert(st,a,d) == delay
+      a < 1 or d < 1 =>
+        error "generalLambert: both integer arguments must be positive"
+      empty? st => zro()
+      zero? frst st =>
+        concat(0,addiag(map((x,y) +-> rptg3(a,d,x,y),
+                 integers 1,rst st)$SP3(I,A,ST A)))
+      error "generalLambert: constant coefficient should be zero"
+
+--% misc. functions
+
+    ms: (I,I,ST A) -> ST A
+    ms(m,n,s) == delay
+      empty? s => zro()
+      zero? n => concat(frst s,ms(m,m-1,rst s))
+      ms(m,n-1,rst s)
+
+    multisect(b,a,x) == ms(a+b,0,rest(x,a :: NNI))
+
+    altn: (ST A,ST A) -> ST A
+    altn(zs,s) == delay
+      empty? s => zro()
+      concat(frst s,concat(zs,altn(zs,rst s)))
+
+    invmultisect(a,b,x) ==
+      concat(rpSt(b,0),altn(rpSt(a + b - 1,0),x))
+
+    -- comps(ststa,y) forms the composition of +/b[i,j]*y**i*x**j
+    -- where y is a power series in y.
+
+    cssa ==> concat$(ST ST A)
+    mapsa ==> map$SP2(ST A,ST A)
+
+    comps: (ST ST A,ST A) -> ST ST A
+    comps(ststa,x) == delay$(ST ST A)
+       empty? ststa => empty()$(ST ST A)
+       empty? x => cssa(frst ststa,empty()$(ST ST A))
+       cssa(frst ststa,mapsa(y +-> (rst x)*y,comps(rst ststa,x)))
+
+    if A has Algebra RN then
+
+      integre: (ST A,I) -> ST A
+      integre(x,n) == delay
+        empty? x => zro()
+        concat((1$I/n) * frst(x),integre(rst x,n + 1))
+
+      integ: ST A -> ST A
+      integ x == integre(x,1)
+
+      integrate(a,x) == concat(a,integ x)
+
+      lazyIntegrate(s,xf) == concat(s,integ(delay xf))
+
+      nldere:(ST ST A,ST A) -> ST A
+
+      nldere(lslsa,c) == lazyIntegrate(0,addiag(comps(lslsa,c)))
+
+      nlde lslsa == YS(y +-> nldere(lslsa,y))
+
+      RATPOWERS : Boolean := A has "**": (A,RN) -> A
+
+      smult: (RN,ST A) -> ST A
+      smult(rn,x) == map(y +-> rn*y, x)
+
+      powerrn:(RN,ST A,ST A) -> ST A
+      powerrn(rn,x,c) == delay
+        concat(1,integ(smult(rn + 1,c * deriv x)) - rst x * c)
+
+      powern(rn,x) ==
+        order : I := 0
+        for n in 0.. repeat
+          empty? x => return zro()
+          not zero? frst x => (order := n; leave x)
+          x := rst x
+          n = 1000 =>
+            error "**: series with many leading zero coefficients"
+        (ord := (order exquo denom(rn))) case "failed" =>
+          error "**: rational power does not exist"
+        co := frst x
+        (invCo := recip co) case "failed" =>
+           error "** rational power of coefficient undefined"
+        power :=
+          (co = 1) => YS(y +-> powerrn(rn,x,y))
+          (denom rn) = 1 =>
+            not negative?(num := numer rn) => 
+              (co**num::NNI) * YS(y +-> powerrn(rn,(invCo :: A) * x, y))
+            (invCo::A)**((-num)::NNI) * YS(y +-> powerrn(rn,(invCo :: A)*x, y))
+          RATPOWERS => co**rn * YS(y +-> powerrn(rn,(invCo :: A)*x, y))
+          error "** rational power of coefficient undefined"
+
     if A has Field then
-      mapdiv     : (ST A,ST A) -> ST A
-        ++ mapdiv([a0,a1,..],[b0,b1,..]) returns
-        ++ \spad{[a0/b0,a1/b1,..]}.
-      lazyGintegrate : (I -> A,A,() -> ST A) -> ST A
-        ++ lazyGintegrate(f,r,g) is used for fixed point computations.
-      power      : (A,ST A) -> ST A
-        ++ power(a,f) returns the power series f raised to the power \spad{a}.
 
-  Implementation ==> add
+      mapdiv(x,y) == delay
+        empty? y => error "stream division by zero"
+        empty? x => zro()
+        concat(frst x/frst y,mapdiv(rst x,rst y))
+
+      ginteg: (I -> A,ST A) -> ST A
+      ginteg(f,x) == mapdiv(x,map(f,integers 1)$SP2(I,A))
+
+      lazyGintegrate(fntoa,s,xf) == concat(s,ginteg(fntoa,delay xf))
+
+      finteg: ST A -> ST A
+      finteg x == mapdiv(x,int 1)
+
+      powerre: (A,ST A,ST A) -> ST A
+      powerre(s,x,c) == delay
+        empty? x => zro()
+        frst x^=1 => error "**:constant coefficient should be 1"
+        concat(frst x,finteg((s+1)*(c*deriv x))-rst x * c)
+      power(s,x) == YS(y +-> powerre(s,x,y))
+
+\end{chunk}
+
+\begin{chunk}{COQ STTAYLOR}
+(* package STTAYLOR *)
+(*
 
 --% definitions
 
@@ -182985,8 +229766,11 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where
 --% some streams of integers
     nnintegers: NNI -> ST NNI
     nnintegers zz == generate(y +-> y+1, zz)
+
     integers z    == generate(y +-> y+1, z)
+
     oddintegers z == generate(y +-> y+2, z)
+
     int s         == generate(y +-> y+1, s)
 
 --% derivatives
@@ -183026,13 +229810,13 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where
 
     lagrangere:(ST A,ST A) -> ST A
     lagrangere(x,c) == delay(concat(0,compose(x,c)))
+
     lagrange x == YS(y +-> lagrangere(x,y))
 
     revert x ==
       empty? x => error "revert should start 0,1,..."
       zero? frst x =>
         empty? rst x => error "revert: should start 0,1,..."
---        one? frst rst x => lagrange(recip(rst x) :: (ST A))
         (frst rst x) = 1 => lagrange(recip(rst x) :: (ST A))
       error "revert:should start 0,1,..."
 
@@ -183048,15 +229832,15 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where
 -- coefficients A[n] which is the sum of a[i] for all divisors i of n
 -- (including 1 and n)
 
-    rptg1:(I,A) -> ST A
     --                               ---------
     -- returns the repeating stream [s,0,...,0]; (there are z zeroes)
+    rptg1:(I,A) -> ST A
     rptg1(z,s) == repeating concat(s,rp(z,0))
 
-    rptg2:(I,A) -> ST A
     --                                       ---------
     -- returns the repeating stream [0,...,0,s,0,...,0]
     -- there are z leading zeroes and z-1 in the period
+    rptg2:(I,A) -> ST A
     rptg2(z,s) == repeating concat(rp(z,0),concat(s,rp(z-1,0)))
 
     rptg3:(I,I,I,A) -> ST A
@@ -183108,11 +229892,12 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where
     invmultisect(a,b,x) ==
       concat(rpSt(b,0),altn(rpSt(a + b - 1,0),x))
 
--- comps(ststa,y) forms the composition of +/b[i,j]*y**i*x**j
--- where y is a power series in y.
+    -- comps(ststa,y) forms the composition of +/b[i,j]*y**i*x**j
+    -- where y is a power series in y.
 
     cssa ==> concat$(ST ST A)
     mapsa ==> map$SP2(ST A,ST A)
+
     comps: (ST ST A,ST A) -> ST ST A
     comps(ststa,x) == delay$(ST ST A)
        empty? ststa => empty()$(ST ST A)
@@ -183120,6 +229905,7 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where
        cssa(frst ststa,mapsa(y +-> (rst x)*y,comps(rst ststa,x)))
 
     if A has Algebra RN then
+
       integre: (ST A,I) -> ST A
       integre(x,n) == delay
         empty? x => zro()
@@ -183129,19 +229915,24 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where
       integ x == integre(x,1)
 
       integrate(a,x) == concat(a,integ x)
+
       lazyIntegrate(s,xf) == concat(s,integ(delay xf))
 
       nldere:(ST ST A,ST A) -> ST A
+
       nldere(lslsa,c) == lazyIntegrate(0,addiag(comps(lslsa,c)))
+
       nlde lslsa == YS(y +-> nldere(lslsa,y))
 
       RATPOWERS : Boolean := A has "**": (A,RN) -> A
 
       smult: (RN,ST A) -> ST A
       smult(rn,x) == map(y +-> rn*y, x)
+
       powerrn:(RN,ST A,ST A) -> ST A
       powerrn(rn,x,c) == delay
         concat(1,integ(smult(rn + 1,c * deriv x)) - rst x * c)
+
       powern(rn,x) ==
         order : I := 0
         for n in 0.. repeat
@@ -183155,20 +229946,17 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where
         co := frst x
         (invCo := recip co) case "failed" =>
            error "** rational power of coefficient undefined"
--- This error message is misleading, isn't it? see sups.spad/cRationalPower
         power :=
---          one? co => YS(y +-> powerrn(rn,x,y))
           (co = 1) => YS(y +-> powerrn(rn,x,y))
           (denom rn) = 1 =>
             not negative?(num := numer rn) => 
--- It seems that this cannot happen, but I don't know why
               (co**num::NNI) * YS(y +-> powerrn(rn,(invCo :: A) * x, y))
             (invCo::A)**((-num)::NNI) * YS(y +-> powerrn(rn,(invCo :: A)*x, y))
-
           RATPOWERS => co**rn * YS(y +-> powerrn(rn,(invCo :: A)*x, y))
           error "** rational power of coefficient undefined"
 
     if A has Field then
+
       mapdiv(x,y) == delay
         empty? y => error "stream division by zero"
         empty? x => zro()
@@ -183181,6 +229969,7 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where
 
       finteg: ST A -> ST A
       finteg x == mapdiv(x,int 1)
+
       powerre: (A,ST A,ST A) -> ST A
       powerre(s,x,c) == delay
         empty? x => zro()
@@ -183188,11 +229977,6 @@ StreamTaylorSeriesOperations(A): Exports == Implementation where
         concat(frst x,finteg((s+1)*(c*deriv x))-rst x * c)
       power(s,x) == YS(y +-> powerre(s,x,y))
 
-\end{chunk}
-
-\begin{chunk}{COQ STTAYLOR}
-(* package STTAYLOR *)
-(*
 *)
 
 \end{chunk}
@@ -183267,6 +230051,11 @@ StreamTensor(R: Type): with
 \begin{chunk}{COQ STNSR}
 (* package STNSR *)
 (*
+
+        tensorMap(s, f) ==
+            empty? s => empty()
+            concat([f first s], delay tensorMap(rest s, f))
+
 *)
 
 \end{chunk}
@@ -183449,6 +230238,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where
       ++ cosecant of a power series st.
 
   Implementation ==> add
+
     import StreamTaylorSeriesOperations Coef
 
     TRANSFCN : Boolean := Coef has TranscendentalFunctionCategory
@@ -183456,14 +230246,21 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where
 --% Error Reporting
 
     TRCONST : SG := "series expansion involves transcendental constants"
+
     NPOWERS : SG := "series expansion has terms of negative degree"
+
     FPOWERS : SG := "series expansion has terms of fractional degree"
+
     MAYFPOW : SG := "series expansion may have terms of fractional degree"
+
     LOGS : SG := "series expansion has logarithmic term"
+
     NPOWLOG : SG :=
        "series expansion has terms of negative degree or logarithmic term"
+
     FPOWLOG : SG :=
        "series expansion has terms of fractional degree or logarithmic term"
+
     NOTINV : SG := "leading coefficient not invertible"
 
 --% Exponentials and Logarithms
@@ -183492,16 +230289,6 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where
     sincosre(rs,rc,sc,dx,sign) ==
       [lazyIntegrate(rs,(second sc)*dx),lazyIntegrate(rc,sign*(first sc)*dx)]
 
-    -- When the compiler had difficulties with the above definition,
-    -- I did the following to help it:
-
-    -- sincosre:(Coef,Coef,L ST,ST,Coef) -> L ST
-    -- sincosre(rs,rc,sc,dx,sign) ==
-      -- st1 : ST := (second sc) * dx
-      -- st2 : ST := (first sc) * dx
-      -- st2 := sign * st2
-      -- [lazyIntegrate(rs,st1),lazyIntegrate(rc,st2)]
-
     sincos z ==
       empty? z => [0 :: ST,1 :: ST]
       l :=
@@ -183516,18 +230303,6 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where
     tanre:(Coef,ST,ST,Coef) -> ST
     tanre(r,t,dx,sign) == lazyIntegrate(r,((1 :: ST) + sign*t*t)*dx)
 
-    -- When the compiler had difficulties with the above definition,
-    -- I did the following to help it:
-
-    -- tanre:(Coef,ST,ST,Coef) -> ST
-    -- tanre(r,t,dx,sign) ==
-      -- st1 : ST := t * t
-      -- st1 := sign * st1
-      -- st2 : ST := 1 :: ST
-      -- st1 := st2 + st1
-      -- st1 := st1 * dx
-      -- lazyIntegrate(r,st1)
-
     tan z ==
       empty? z => 0 :: ST
       (coef := frst z) = 0 => YS(y +-> tanre(0,y,deriv z,1))
@@ -183537,18 +230312,6 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where
     cotre:(Coef,ST,ST) -> ST
     cotre(r,t,dx) == lazyIntegrate(r,-((1 :: ST) + t*t)*dx)
 
-    -- When the compiler had difficulties with the above definition,
-    -- I did the following to help it:
-
-    -- cotre:(Coef,ST,ST) -> ST
-    -- cotre(r,t,dx) ==
-      -- st1 : ST := t * t
-      -- st2 : ST := 1 :: ST
-      -- st1 := st2 + st1
-      -- st1 := st1 * dx
-      -- st1 := -st1
-      -- lazyIntegrate(r,st1)
-
     cot z ==
       empty? z => error "cot: cot(0) is undefined"
       (coef := frst z) = 0 => error concat("cot: ",NPOWERS)
@@ -183694,6 +230457,7 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where
       [first l,second l]
 
     sinh z == sinhcosh(z).sinh
+
     cosh z == sinhcosh(z).cosh
 
     tanh z ==
@@ -183801,6 +230565,328 @@ StreamTranscendentalFunctions(Coef): Exports == Implementation where
 \begin{chunk}{COQ STTF}
 (* package STTF *)
 (*
+
+    import StreamTaylorSeriesOperations Coef
+
+    TRANSFCN : Boolean := Coef has TranscendentalFunctionCategory
+
+--% Error Reporting
+
+    TRCONST : SG := "series expansion involves transcendental constants"
+
+    NPOWERS : SG := "series expansion has terms of negative degree"
+
+    FPOWERS : SG := "series expansion has terms of fractional degree"
+
+    MAYFPOW : SG := "series expansion may have terms of fractional degree"
+
+    LOGS : SG := "series expansion has logarithmic term"
+
+    NPOWLOG : SG :=
+       "series expansion has terms of negative degree or logarithmic term"
+
+    FPOWLOG : SG :=
+       "series expansion has terms of fractional degree or logarithmic term"
+
+    NOTINV : SG := "leading coefficient not invertible"
+
+--% Exponentials and Logarithms
+
+    expre:(Coef,ST,ST) -> ST
+    expre(r,e,dx) == lazyIntegrate(r,e*dx)
+
+    exp z ==
+      empty? z => 1 :: ST
+      (coef := frst z) = 0 => YS(y +-> expre(1,y,deriv z))
+      TRANSFCN => YS(y +-> expre(exp coef,y,deriv z))
+      error concat("exp: ",TRCONST)
+
+    log z ==
+      empty? z => error "log: constant coefficient should not be 0"
+      (coef := frst z) = 0 => error "log: constant coefficient should not be 0"
+      coef = 1 => lazyIntegrate(0,deriv z/z)
+      TRANSFCN => lazyIntegrate(log coef,deriv z/z)
+      error concat("log: ",TRCONST)
+
+    z1:ST ** z2:ST == exp(z2 * log z1)
+
+--% Trigonometric Functions
+
+    sincosre:(Coef,Coef,L ST,ST,Coef) -> L ST
+    sincosre(rs,rc,sc,dx,sign) ==
+      [lazyIntegrate(rs,(second sc)*dx),lazyIntegrate(rc,sign*(first sc)*dx)]
+
+    sincos z ==
+      empty? z => [0 :: ST,1 :: ST]
+      l :=
+        (coef := frst z) = 0 => YS(y +-> sincosre(0,1,y,deriv z,-1),2)
+        TRANSFCN => YS(y +-> sincosre(sin coef,cos coef,y,deriv z,-1),2)
+        error concat("sincos: ",TRCONST)
+      [first l,second l]
+
+    sin z == sincos(z).sin
+    cos z == sincos(z).cos
+
+    tanre:(Coef,ST,ST,Coef) -> ST
+    tanre(r,t,dx,sign) == lazyIntegrate(r,((1 :: ST) + sign*t*t)*dx)
+
+    tan z ==
+      empty? z => 0 :: ST
+      (coef := frst z) = 0 => YS(y +-> tanre(0,y,deriv z,1))
+      TRANSFCN => YS(y +-> tanre(tan coef,y,deriv z,1))
+      error concat("tan: ",TRCONST)
+
+    cotre:(Coef,ST,ST) -> ST
+    cotre(r,t,dx) == lazyIntegrate(r,-((1 :: ST) + t*t)*dx)
+
+    cot z ==
+      empty? z => error "cot: cot(0) is undefined"
+      (coef := frst z) = 0 => error concat("cot: ",NPOWERS)
+      TRANSFCN => YS(y +-> cotre(cot coef,y,deriv z))
+      error concat("cot: ",TRCONST)
+
+    sec z ==
+      empty? z => 1 :: ST
+      frst z = 0 => recip(cos z) :: ST
+      TRANSFCN =>
+        cosz := cos z
+        first cosz = 0 => error concat("sec: ",NPOWERS)
+        recip(cosz) :: ST
+      error concat("sec: ",TRCONST)
+
+    csc z ==
+      empty? z => error "csc: csc(0) is undefined"
+      TRANSFCN =>
+        sinz := sin z
+        first sinz = 0 => error concat("csc: ",NPOWERS)
+        recip(sinz) :: ST
+      error concat("csc: ",TRCONST)
+
+    orderOrFailed : ST -> Union(I,"failed")
+    orderOrFailed x ==
+    -- returns the order of x or "failed"
+    -- if -1 is returned, the series is identically zero
+      for n in 0..1000 repeat
+        empty? x => return -1
+        not zero? frst x => return n :: I
+        x := rst x
+      "failed"
+
+    asin z ==
+      empty? z => 0 :: ST
+      (coef := frst z) = 0 =>
+        integrate(0,powern(-1/2,(1 :: ST) - z*z) * (deriv z))
+      TRANSFCN =>
+        coef = 1 or coef = -1 =>
+          x := (1 :: ST) - z*z
+          -- compute order of 'x'
+          (ord := orderOrFailed x) case "failed" =>
+            error concat("asin: ",MAYFPOW)
+          (order := ord :: I) = -1 => return asin(coef) :: ST
+          odd? order => error concat("asin: ",FPOWERS)
+          squirt := powern(1/2,x)
+          (quot := (deriv z) exquo squirt) case "failed" =>
+             error concat("asin: ",NOTINV)
+          integrate(asin coef,quot :: ST)
+        integrate(asin coef,powern(-1/2,(1 :: ST) - z*z) * (deriv z))
+      error concat("asin: ",TRCONST)
+
+    acos z ==
+      empty? z =>
+        TRANSFCN => acos(0)$Coef :: ST
+        error concat("acos: ",TRCONST)
+      TRANSFCN =>
+        coef := frst z
+        coef = 1 or coef = -1 =>
+          x := (1 :: ST) - z*z
+          -- compute order of 'x'
+          (ord := orderOrFailed x) case "failed" =>
+            error concat("acos: ",MAYFPOW)
+          (order := ord :: I) = -1 => return acos(coef) :: ST
+          odd? order => error concat("acos: ",FPOWERS)
+          squirt := powern(1/2,x)
+          (quot := (-deriv z) exquo squirt) case "failed" =>
+             error concat("acos: ",NOTINV)
+          integrate(acos coef,quot :: ST)
+        integrate(acos coef,-powern(-1/2,(1 :: ST) - z*z) * (deriv z))
+      error concat("acos: ",TRCONST)
+
+    atan z ==
+      empty? z => 0 :: ST
+      (coef := frst z) = 0 =>
+        integrate(0,(recip((1 :: ST) + z*z) :: ST) * (deriv z))
+      TRANSFCN =>
+        (y := recip((1 :: ST) + z*z)) case "failed" =>
+          error concat("atan: ",LOGS)
+        integrate(atan coef,(y :: ST) * (deriv z))
+      error concat("atan: ",TRCONST)
+
+    acot z ==
+      empty? z =>
+        TRANSFCN => acot(0)$Coef :: ST
+        error concat("acot: ",TRCONST)
+      TRANSFCN =>
+        (y := recip((1 :: ST) + z*z)) case "failed" =>
+          error concat("acot: ",LOGS)
+        integrate(acot frst z,-(y :: ST) * (deriv z))
+      error concat("acot: ",TRCONST)
+
+    asec z ==
+      empty? z => error "asec: constant coefficient should not be 0"
+      TRANSFCN =>
+        (coef := frst z) = 0 =>
+          error "asec: constant coefficient should not be 0"
+        coef = 1 or coef = -1 =>
+          x := z*z - (1 :: ST)
+          -- compute order of 'x'
+          (ord := orderOrFailed x) case "failed" =>
+            error concat("asec: ",MAYFPOW)
+          (order := ord :: I) = -1 => return asec(coef) :: ST
+          odd? order => error concat("asec: ",FPOWERS)
+          squirt := powern(1/2,x)
+          (quot := (deriv z) exquo squirt) case "failed" =>
+            error concat("asec: ",NOTINV)
+          (quot2 := (quot :: ST) exquo z) case "failed" =>
+            error concat("asec: ",NOTINV)
+          integrate(asec coef,quot2 :: ST)
+        integrate(asec coef,(powern(-1/2,z*z-(1::ST))*(deriv z)) / z)
+      error concat("asec: ",TRCONST)
+
+    acsc z ==
+      empty? z => error "acsc: constant coefficient should not be zero"
+      TRANSFCN =>
+        (coef := frst z) = 0 =>
+          error "acsc: constant coefficient should not be zero"
+        coef = 1 or coef = -1 =>
+          x := z*z - (1 :: ST)
+          -- compute order of 'x'
+          (ord := orderOrFailed x) case "failed" =>
+            error concat("acsc: ",MAYFPOW)
+          (order := ord :: I) = -1 => return acsc(coef) :: ST
+          odd? order => error concat("acsc: ",FPOWERS)
+          squirt := powern(1/2,x)
+          (quot := (-deriv z) exquo squirt) case "failed" =>
+            error concat("acsc: ",NOTINV)
+          (quot2 := (quot :: ST) exquo z) case "failed" =>
+            error concat("acsc: ",NOTINV)
+          integrate(acsc coef,quot2 :: ST)
+        integrate(acsc coef,-(powern(-1/2,z*z-(1::ST))*(deriv z)) / z)
+      error concat("acsc: ",TRCONST)
+
+--% Hyperbolic Trigonometric Functions
+
+    sinhcosh z ==
+      empty? z => [0 :: ST,1 :: ST]
+      l :=
+        (coef := frst z) = 0 => YS(y +-> sincosre(0,1,y,deriv z,1),2)
+        TRANSFCN => YS(y +-> sincosre(sinh coef,cosh coef,y,deriv z,1),2)
+        error concat("sinhcosh: ",TRCONST)
+      [first l,second l]
+
+    sinh z == sinhcosh(z).sinh
+
+    cosh z == sinhcosh(z).cosh
+
+    tanh z ==
+      empty? z => 0 :: ST
+      (coef := frst z) = 0 => YS(y +-> tanre(0,y,deriv z,-1))
+      TRANSFCN => YS(y +-> tanre(tanh coef,y,deriv z,-1))
+      error concat("tanh: ",TRCONST)
+
+    coth z ==
+      tanhz := tanh z
+      empty? tanhz => error "coth: coth(0) is undefined"
+      (frst tanhz) = 0 => error concat("coth: ",NPOWERS)
+      recip(tanhz) :: ST
+
+    sech z ==
+      coshz := cosh z
+      (empty? coshz) or (frst coshz = 0) => error concat("sech: ",NPOWERS)
+      recip(coshz) :: ST
+
+    csch z ==
+      sinhz := sinh z
+      (empty? sinhz) or (frst sinhz = 0) => error concat("csch: ",NPOWERS)
+      recip(sinhz) :: ST
+
+    asinh z ==
+      empty? z => 0 :: ST
+      (coef := frst z) = 0 => log(z + powern(1/2,(1 :: ST) + z*z))
+      TRANSFCN =>
+        x := (1 :: ST) + z*z
+        -- compute order of 'x', in case coefficient(z,0) = +- %i
+        (ord := orderOrFailed x) case "failed" =>
+          error concat("asinh: ",MAYFPOW)
+        (order := ord :: I) = -1 => return asinh(coef) :: ST
+        odd? order => error concat("asinh: ",FPOWERS)
+        -- the argument to 'log' must have a non-zero constant term
+        log(z + powern(1/2,x))
+      error concat("asinh: ",TRCONST)
+
+    acosh z ==
+      empty? z =>
+        TRANSFCN => acosh(0)$Coef :: ST
+        error concat("acosh: ",TRCONST)
+      TRANSFCN =>
+        coef := frst z
+        coef = 1 or coef = -1 =>
+          x := z*z - (1 :: ST)
+          -- compute order of 'x'
+          (ord := orderOrFailed x) case "failed" =>
+            error concat("acosh: ",MAYFPOW)
+          (order := ord :: I) = -1 => return acosh(coef) :: ST
+          odd? order => error concat("acosh: ",FPOWERS)
+          -- the argument to 'log' must have a non-zero constant term
+          log(z + powern(1/2,x))
+        log(z + powern(1/2,z*z - (1 :: ST)))
+      error concat("acosh: ",TRCONST)
+
+    atanh z ==
+      empty? z => 0 :: ST
+      (coef := frst z) = 0 =>
+        (inv(2::RN)::Coef) * log(((1 :: ST) + z)/((1 :: ST) - z))
+      TRANSFCN =>
+        coef = 1 or coef = -1 => error concat("atanh: ",LOGS)
+        (inv(2::RN)::Coef) * log(((1 :: ST) + z)/((1 :: ST) - z))
+      error concat("atanh: ",TRCONST)
+
+    acoth z ==
+      empty? z =>
+        TRANSFCN => acoth(0)$Coef :: ST
+        error concat("acoth: ",TRCONST)
+      TRANSFCN =>
+        frst z = 1 or frst z = -1 => error concat("acoth: ",LOGS)
+        (inv(2::RN)::Coef) * log((z + (1 :: ST))/(z - (1 :: ST)))
+      error concat("acoth: ",TRCONST)
+
+    asech z ==
+      empty? z => error "asech: asech(0) is undefined"
+      TRANSFCN =>
+        (coef := frst z) = 0 => error concat("asech: ",NPOWLOG)
+        coef = 1 or coef = -1 =>
+          x := (1 :: ST) - z*z
+          -- compute order of 'x'
+          (ord := orderOrFailed x) case "failed" =>
+            error concat("asech: ",MAYFPOW)
+          (order := ord :: I) = -1 => return asech(coef) :: ST
+          odd? order => error concat("asech: ",FPOWERS)
+          log(((1 :: ST) + powern(1/2,x))/z)
+        log(((1 :: ST) + powern(1/2,(1 :: ST) - z*z))/z)
+      error concat("asech: ",TRCONST)
+
+    acsch z ==
+      empty? z => error "acsch: acsch(0) is undefined"
+      TRANSFCN =>
+        frst z = 0 => error concat("acsch: ",NPOWLOG)
+        x := z*z + (1 :: ST)
+        -- compute order of 'x'
+        (ord := orderOrFailed x) case "failed" =>
+          error concat("acsc: ",MAYFPOW)
+        (order := ord :: I) = -1 => return acsch(frst z) :: ST
+        odd? order => error concat("acsch: ",FPOWERS)
+        log(((1 :: ST) + powern(1/2,x))/z)
+      error concat("acsch: ",TRCONST)
+
 *)
 
 \end{chunk}
@@ -183970,6 +231056,7 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _
       ++ cosecant of a power series st.
 
   Implementation ==> add
+
     import StreamTaylorSeriesOperations(Coef)
 
 --% Error Reporting
@@ -184051,8 +231138,11 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _
       error concat("atan: ",ZERO)
 
     acos z == error "acos: acos undefined on this coefficient domain"
+
     acot z == error "acot: acot undefined on this coefficient domain"
+
     asec z == error "asec: asec undefined on this coefficient domain"
+
     acsc z == error "acsc: acsc undefined on this coefficient domain"
 
 --% Hyperbolic Trigonometric Functions
@@ -184110,8 +231200,11 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _
       error concat("atanh: ",ZERO)
 
     acosh z == error "acosh: acosh undefined on this coefficient domain"
+
     acoth z == error "acoth: acoth undefined on this coefficient domain"
+
     asech z == error "asech: asech undefined on this coefficient domain"
+
     acsch z == error "acsch: acsch undefined on this coefficient domain"
 
 \end{chunk}
@@ -184119,6 +231212,157 @@ StreamTranscendentalFunctionsNonCommutative(Coef): _
 \begin{chunk}{COQ STTFNC}
 (* package STTFNC *)
 (*
+
+    import StreamTaylorSeriesOperations(Coef)
+
+--% Error Reporting
+
+    ZERO    : SG := "series must have constant coefficient zero"
+    ONE     : SG := "series must have constant coefficient one"
+    NPOWERS : SG := "series expansion has terms of negative degree"
+
+--% Exponentials and Logarithms
+
+    exp z ==
+      empty? z => 1 :: ST
+      (frst z) = 0 =>
+        expx := exp(monom(1,1))$STTF
+        compose(expx,z)
+      error concat("exp: ",ZERO)
+
+    log z ==
+      empty? z => error concat("log: ",ONE)
+      (frst z) = 1 =>
+        log1PlusX := log(monom(1,0) + monom(1,1))$STTF
+        compose(log1PlusX,z - monom(1,0))
+      error concat("log: ",ONE)
+
+    (z1:ST) ** (z2:ST) == exp(log(z1) * z2)
+
+--% Trigonometric Functions
+
+    sin z ==
+      empty? z => 0 :: ST
+      (frst z) = 0 =>
+        sinx := sin(monom(1,1))$STTF
+        compose(sinx,z)
+      error concat("sin: ",ZERO)
+
+    cos z ==
+      empty? z => 1 :: ST
+      (frst z) = 0 =>
+        cosx := cos(monom(1,1))$STTF
+        compose(cosx,z)
+      error concat("cos: ",ZERO)
+
+    tan z ==
+      empty? z => 0 :: ST
+      (frst z) = 0 =>
+        tanx := tan(monom(1,1))$STTF
+        compose(tanx,z)
+      error concat("tan: ",ZERO)
+
+    cot z ==
+      empty? z => error "cot: cot(0) is undefined"
+      (frst z) = 0 => error concat("cot: ",NPOWERS)
+      error concat("cot: ",ZERO)
+
+    sec z ==
+      empty? z => 1 :: ST
+      (frst z) = 0 =>
+        secx := sec(monom(1,1))$STTF
+        compose(secx,z)
+      error concat("sec: ",ZERO)
+
+    csc z ==
+      empty? z => error "csc: csc(0) is undefined"
+      (frst z) = 0 => error concat("csc: ",NPOWERS)
+      error concat("csc: ",ZERO)
+
+    asin z ==
+      empty? z => 0 :: ST
+      (frst z) = 0 =>
+        asinx := asin(monom(1,1))$STTF
+        compose(asinx,z)
+      error concat("asin: ",ZERO)
+
+    atan z ==
+      empty? z => 0 :: ST
+      (frst z) = 0 =>
+        atanx := atan(monom(1,1))$STTF
+        compose(atanx,z)
+      error concat("atan: ",ZERO)
+
+    acos z == error "acos: acos undefined on this coefficient domain"
+
+    acot z == error "acot: acot undefined on this coefficient domain"
+
+    asec z == error "asec: asec undefined on this coefficient domain"
+
+    acsc z == error "acsc: acsc undefined on this coefficient domain"
+
+--% Hyperbolic Trigonometric Functions
+
+    sinh z ==
+      empty? z => 0 :: ST
+      (frst z) = 0 =>
+        sinhx := sinh(monom(1,1))$STTF
+        compose(sinhx,z)
+      error concat("sinh: ",ZERO)
+
+    cosh z ==
+      empty? z => 1 :: ST
+      (frst z) = 0 =>
+        coshx := cosh(monom(1,1))$STTF
+        compose(coshx,z)
+      error concat("cosh: ",ZERO)
+
+    tanh z ==
+      empty? z => 0 :: ST
+      (frst z) = 0 =>
+        tanhx := tanh(monom(1,1))$STTF
+        compose(tanhx,z)
+      error concat("tanh: ",ZERO)
+
+    coth z ==
+      empty? z => error "coth: coth(0) is undefined"
+      (frst z) = 0 => error concat("coth: ",NPOWERS)
+      error concat("coth: ",ZERO)
+
+    sech z ==
+      empty? z => 1 :: ST
+      (frst z) = 0 =>
+        sechx := sech(monom(1,1))$STTF
+        compose(sechx,z)
+      error concat("sech: ",ZERO)
+
+    csch z ==
+      empty? z => error "csch: csch(0) is undefined"
+      (frst z) = 0 => error concat("csch: ",NPOWERS)
+      error concat("csch: ",ZERO)
+
+    asinh z ==
+      empty? z => 0 :: ST
+      (frst z) = 0 =>
+        asinhx := asinh(monom(1,1))$STTF
+        compose(asinhx,z)
+      error concat("asinh: ",ZERO)
+
+    atanh z ==
+      empty? z => 0 :: ST
+      (frst z) = 0 =>
+        atanhx := atanh(monom(1,1))$STTF
+        compose(atanhx,z)
+      error concat("atanh: ",ZERO)
+
+    acosh z == error "acosh: acosh undefined on this coefficient domain"
+
+    acoth z == error "acoth: acoth undefined on this coefficient domain"
+
+    asech z == error "asech: asech undefined on this coefficient domain"
+
+    acsch z == error "acsch: acsch undefined on this coefficient domain"
+
 *)
 
 \end{chunk}
@@ -184249,7 +231493,7 @@ StructuralConstantsPackage(R:Field): public == private where
           error("coordinates: the second argument is linearly dependent")
         (res.particular  case "failed") =>
           error("coordinates: first argument is not in linear span of _
-second argument")
+                second argument")
         (res.particular) :: (Vector R)
 
       structuralConstants b ==
@@ -184268,7 +231512,7 @@ second argument")
         nn := #(ls)
         nrows(mt) ^= nn or ncols(mt) ^= nn =>
           error "structuralConstants: size of second argument does not _
-agree with number of generators"
+                 agree with number of generators"
         gamma : L M POLY R := []
         lscopy : L S := copy ls
         while not null lscopy repeat
@@ -184279,7 +231523,7 @@ agree with number of generators"
               p := qelt(mt,i,j)
               totalDegree(p,ls) > 1 =>
                 error "structuralConstants: entries of second argument _
-must be linear polynomials in the generators"
+                       must be linear polynomials in the generators"
               if (c := coefficient(p, s, 1) ) ^= 0 then qsetelt_!(mat,i,j,c)
           gamma := cons(mat, gamma)
           lscopy := rest lscopy
@@ -184289,7 +231533,7 @@ must be linear polynomials in the generators"
         nn := #(ls)
         nrows(mt) ^= nn or ncols(mt) ^= nn =>
           error "structuralConstants: size of second argument does not _
-agree with number of generators"
+                 agree with number of generators"
         gamma : L M FRAC(POLY R) := []
         lscopy : L S := copy ls
         while not null lscopy repeat
@@ -184301,11 +231545,11 @@ agree with number of generators"
               q := denom(r)
               totalDegree(q,ls) ^= 0 =>
                 error "structuralConstants: entries of second argument _
-must be (linear) polynomials in the generators"
+                       must be (linear) polynomials in the generators"
               p := numer(r)
               totalDegree(p,ls) > 1 =>
                 error "structuralConstants: entries of second argument _
-must be linear polynomials in the generators"
+                       must be linear polynomials in the generators"
               if (c := coefficient(p, s, 1) ) ^= 0 then qsetelt_!(mat,i,j,c/q)
           gamma := cons(mat, gamma)
           lscopy := rest lscopy
@@ -184316,6 +231560,87 @@ must be linear polynomials in the generators"
 \begin{chunk}{COQ SCPKG}
 (* package SCPKG *)
 (*
+
+      matrix2Vector: M R -> V R
+      matrix2Vector m ==
+        lili : L L R := listOfLists m
+        --li : L R  := reduce(concat, listOfLists m)
+        li : L R  := reduce(concat, lili)
+        construct(li)$(V R)
+
+      coordinates(x,b) ==
+        m : NonNegativeInteger := (maxIndex b) :: NonNegativeInteger
+        n : NonNegativeInteger := nrows(b.1) * ncols(b.1)
+        transitionMatrix   : Matrix R := new(n,m,0$R)$Matrix(R)
+        for i in 1..m repeat
+          setColumn_!(transitionMatrix,i,matrix2Vector(b.i))
+        res : REC := solve(transitionMatrix,matrix2Vector(x))$LSMP
+        if (not every?(zero?$R,first res.basis)) then
+          error("coordinates: the second argument is linearly dependent")
+        (res.particular  case "failed") =>
+          error("coordinates: first argument is not in linear span of _
+                second argument")
+        (res.particular) :: (Vector 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
+
+      structuralConstants(ls:L S, mt: M POLY R)  ==
+        nn := #(ls)
+        nrows(mt) ^= nn or ncols(mt) ^= nn =>
+          error "structuralConstants: size of second argument does not _
+                 agree with number of generators"
+        gamma : L M POLY R := []
+        lscopy : L S := copy ls
+        while not null lscopy repeat
+          mat : M POLY R := new(nn,nn,0)
+          s : S := first lscopy
+          for i in 1..nn repeat
+            for j in 1..nn repeat
+              p := qelt(mt,i,j)
+              totalDegree(p,ls) > 1 =>
+                error "structuralConstants: entries of second argument _
+                       must be linear polynomials in the generators"
+              if (c := coefficient(p, s, 1) ) ^= 0 then qsetelt_!(mat,i,j,c)
+          gamma := cons(mat, gamma)
+          lscopy := rest lscopy
+        vector reverse gamma
+
+      structuralConstants(ls:L S, mt: M FRAC POLY R)  ==
+        nn := #(ls)
+        nrows(mt) ^= nn or ncols(mt) ^= nn =>
+          error "structuralConstants: size of second argument does not _
+                 agree with number of generators"
+        gamma : L M FRAC(POLY R) := []
+        lscopy : L S := copy ls
+        while not null lscopy repeat
+          mat : M FRAC(POLY R) := new(nn,nn,0)
+          s : S := first lscopy
+          for i in 1..nn repeat
+            for j in 1..nn repeat
+              r := qelt(mt,i,j)
+              q := denom(r)
+              totalDegree(q,ls) ^= 0 =>
+                error "structuralConstants: entries of second argument _
+                       must be (linear) polynomials in the generators"
+              p := numer(r)
+              totalDegree(p,ls) > 1 =>
+                error "structuralConstants: entries of second argument _
+                       must be linear polynomials in the generators"
+              if (c := coefficient(p, s, 1) ) ^= 0 then qsetelt_!(mat,i,j,c/q)
+          gamma := cons(mat, gamma)
+          lscopy := rest lscopy
+        vector reverse gamma
+
 *)
 
 \end{chunk}
@@ -184453,6 +231778,7 @@ SturmHabichtPackage(R,x): T == C where
 
 
   C == add
+
      p1,p2: UP(x,R)
      Ex ==> OutputForm
      import OutputForm
@@ -184529,22 +231855,290 @@ SturmHabichtPackage(R,x): T == C where
          List2:L UP(x,R):=append(List2:L UP(x,R),[Pr1]:L UP(x,R))
        List2
 
+-- Computation of the delta function:
+
+     delta(int1:NNI):R ==
+       (-1)**((int1*(int1+1) exquo 2)::NNI)
+
+-- Computation of the Sturm-Habicht sequence of two polynomials P and Q
+-- in R[x] where R is an ordered integral domaine
+
+     polsth1(p1,p:NNI,p2,q:NNI,c1:R):L UP(x,R) ==
+       sc1:R:=(sign(c1))::R
+       Pr1:UP(x,R):=pseudoRemainder(differentiate(p1)*p2,p1)
+       Pr2:UP(x,R):=(Pr1 exquo c1**(q::NNI))::UP(x,R)
+       c2:R:=leadingCoefficient(Pr2)
+       r:NNI:=degree(Pr2)
+       Pr3:UP(x,R):=monomial(sc1**((p-r-1)::NNI),0)*p1
+       Pr4:UP(x,R):=monomial(sc1**((p-r-1)::NNI),0)*Pr2
+       Listf:L UP(x,R):=[Pr3,Pr4]
+       if r < p-1 then
+         Pr5:UP(x,R):=monomial(delta((p-r-1)::NNI)*c2**((p-r-1)::NNI),0)*Pr2
+         for j in ((r+1)::INT)..((p-2)::INT) repeat
+           Listf:L UP(x,R):=append(Listf:L UP(x,R),[0]:L UP(x,R))
+         Listf:L UP(x,R):=append(Listf:L UP(x,R),[Pr5]:L UP(x,R))
+       if Pr1=0 then List1:L UP(x,R):=Listf
+                else List1:L UP(x,R):=subresultantSequence(p1,Pr2)
+       List2:L UP(x,R):=[]
+       for j in 0..((r-1)::INT) repeat
+         Pr6:UP(x,R):=monomial(delta((p-j-1)::NNI),0)*List1.((p-j+1)::NNI)
+         List2:L UP(x,R):=append([Pr6]:L UP(x,R),List2:L UP(x,R))
+       append(Listf:L UP(x,R),List2:L UP(x,R))
+
+     polsth2(p1,p:NNI,p2,q:NNI,c1:R):L UP(x,R) ==
+       sc1:R:=(sign(c1))::R
+       Pr1:UP(x,R):=monomial(sc1,0)*p1
+       Pr2:UP(x,R):=differentiate(p1)*p2
+       Pr3:UP(x,R):=monomial(sc1,0)*Pr2
+       Listf:L UP(x,R):=[Pr1,Pr3]
+       List1:L UP(x,R):=subresultantSequence(p1,Pr2)
+       List2:L UP(x,R):=[]
+       for j in 0..((p-2)::INT) repeat
+         Pr4:UP(x,R):=monomial(delta((p-j-1)::NNI),0)*List1.((p-j+1)::NNI)
+         Pr5:UP(x,R):=(Pr4 exquo c1)::UP(x,R)
+         List2:L UP(x,R):=append([Pr5]:L UP(x,R),List2:L UP(x,R))
+       append(Listf:L UP(x,R),List2:L UP(x,R))
+
+     polsth3(p1,p:NNI,p2,q:NNI,c1:R):L UP(x,R) ==
+       sc1:R:=(sign(c1))::R
+       q1:NNI:=(q-1)::NNI
+       v:NNI:=(p+q1)::NNI
+       Pr1:UP(x,R):=monomial(delta(q1::NNI)*sc1**((q+1)::NNI),0)*p1
+       Listf:L UP(x,R):=[Pr1]
+       List1:L UP(x,R):=subresultantSequence(differentiate(p1)*p2,p1)
+       List2:L UP(x,R):=[]
+       for j in 0..((p-1)::NNI) repeat
+         Pr2:UP(x,R):=monomial(delta((v-j)::NNI),0)*List1.((v-j+1)::NNI)
+         Pr3:UP(x,R):=(Pr2 exquo c1)::UP(x,R)
+         List2:L UP(x,R):=append([Pr3]:L UP(x,R),List2:L UP(x,R))
+       append(Listf:L UP(x,R),List2:L UP(x,R))
+
+     SturmHabichtSequence(p1,p2):L UP(x,R) ==
+       p:NNI:=degree(p1)
+       q:NNI:=degree(p2)
+       c1:R:=leadingCoefficient(p1)
+       c1 = 1 or q = 1 => polsth1(p1,p,p2,q,c1)
+       q = 0 => polsth2(p1,p,p2,q,c1)
+       polsth3(p1,p,p2,q,c1)
+
+
+-- Computation of the Sturm-Habicht principal coefficients of two
+-- polynomials P and Q in R[x] where R is an ordered integral domain
+
+     SturmHabichtCoefficients(p1,p2):L R ==
+       List1:L UP(x,R):=SturmHabichtSequence(p1,p2)
+       qp:NNI:=#(List1)::NNI
+       [coefficient(p,(qp-j)::NNI) for p in List1 for j in 1..qp]
+
+
+-- Computation of the number of sign variations of a list of non zero
+-- elements in an ordered integral domain
+
+     variation(Lsig:L R):INT ==
+       size?(Lsig,1) => 0
+       elt1:R:=first Lsig
+       elt2:R:=Lsig.2
+       sig1:R:=(sign(elt1*elt2))::R
+       List1:L R:=rest Lsig
+       sig1 = 1 => variation List1
+       1+variation List1
+
+
+-- Computation of the number of sign permanences of a list of non zero
+-- elements in an ordered integral domain
+
+     permanence(Lsig:L R):INT ==
+       size?(Lsig,1) => 0
+       elt1:R:=first Lsig
+       elt2:R:=Lsig.2
+       sig1:R:=(sign(elt1*elt2))::R
+       List1:L R:=rest Lsig
+       sig1 = -1 => permanence List1
+       1+permanence List1
+
+
+-- Computation of the functional W which works over a list of elements
+-- in an ordered integral domain, with non zero first element
+
+     qzeros(Lsig:L R):L R ==
+       while last Lsig = 0 repeat
+         Lsig:L R:=reverse rest reverse Lsig
+       Lsig
+
+     epsil(int1:NNI,elt1:R,elt2:R):INT ==
+       int1 = 0 => 0
+       odd? int1 => 0
+       ct1:INT:=if elt1 > 0 then 1 else -1
+       ct2:INT:=if elt2 > 0 then 1 else -1
+       ct3:NNI:=(int1 exquo 2)::NNI
+       ct4:INT:=(ct1*ct2)::INT
+       ((-1)**(ct3::NNI))*ct4
+
+     numbnce(Lsig:L R):NNI ==
+       null Lsig => 0
+       eltp:R:=Lsig.1
+       eltp = 0 => 0
+       1 + numbnce(rest Lsig)
+
+     numbce(Lsig:L R):NNI ==
+       null Lsig => 0
+       eltp:R:=Lsig.1
+       not(eltp = 0) => 0
+       1 + numbce(rest Lsig)
+
+     wfunctaux(Lsig:L R):INT ==
+       null Lsig => 0
+       List2:L R:=[]
+       List1:L R:=Lsig:L R
+       cont1:NNI:=numbnce(List1:L R)
+       for j in 1..cont1 repeat
+         List2:L R:=append(List2:L R,[first List1]:L R)
+         List1:L R:=rest List1
+       ind2:INT:=0
+       cont2:NNI:=numbce(List1:L R)
+       for j in 1..cont2 repeat
+         List1:L R:=rest List1
+         ind2:INT:=epsil(cont2:NNI,last List2,first List1)
+       ind3:INT:=permanence(List2:L R)-variation(List2:L R)
+       ind4:INT:=ind2+ind3
+       ind4+wfunctaux(List1:L R)
+
+     wfunct(Lsig:L R):INT ==
+       List1:L R:=qzeros(Lsig:L R)
+       wfunctaux(List1:L R)
+
+
+-- Computation of the integer number:
+--    #[{a in Rc(R)/P(a)=0 Q(a)>0}] - #[{a in Rc(R)/P(a)=0 Q(a)<0}]
+-- where:
+--    - R is an ordered integral domain,
+--    - Rc(R) is the real clousure of R,
+--    - P and Q are polynomials in R[x],
+--    - by #[A] we note the cardinal of the set A
+
+-- In particular:
+--     - SturmHabicht(P,1) is the number of "real" roots of P,
+--     - SturmHabicht(P,Q**2) is the number of "real" roots of P making Q neq 0
+
+     SturmHabicht(p1,p2):INT ==
+       p2 = 0 => 0
+       degree(p1:UP(x,R)) = 0 => 0
+       List1:L UP(x,R):=SturmHabichtSequence(p1,p2)
+       qp:NNI:=#(List1)::NNI
+       wfunct [coefficient(p,(qp-j)::NNI) for p in List1 for j in 1..qp]
+
+     countRealRoots(p1):INT == SturmHabicht(p1,1)
+
+     if R has GcdDomain then
+
+        SturmHabichtMultiple(p1,p2):INT ==
+          p2 = 0 => 0
+          degree(p1:UP(x,R)) = 0 => 0
+          SH:L UP(x,R):=SturmHabichtSequence(p1,p2)
+          qp:NNI:=#(SH)::NNI
+          ans:= wfunct [coefficient(p,(qp-j)::NNI) for p in SH for j in 1..qp]
+          SH:=reverse SH
+          while first SH = 0 repeat SH:=rest SH
+          degree first SH = 0 => ans
+          -- OK: it probably wasn't square free, so this item is probably the 
+          -- gcd of p1 and p1'
+          -- unless p1 and p2 have a factor in common (naughty!)
+          differentiate(p1) exquo first SH case UP(x,R) =>
+             -- it was the gcd of p1 and p1'
+             ans+SturmHabichtMultiple(first SH,p2)
+          sqfr:=factorList squareFree p1
+          #sqfr = 1 and sqfr.first.xpnt=1 => ans
+          reduce("+",[f.xpnt*SturmHabicht(f.fctr,p2) for f in sqfr])
+
+        countRealRootsMultiple(p1):INT == SturmHabichtMultiple(p1,1)
+
+\end{chunk}
+
+\begin{chunk}{COQ SHP}
+(* package SHP *)
+(*
+
+     p1,p2: UP(x,R)
+     Ex ==> OutputForm
+     import OutputForm
+
+     subresultantSequenceBegin(p1,p2):L UP(x,R) ==
+       d1:NNI:=degree(p1)
+       d2:NNI:=degree(p2)
+       n:NNI:=(d1-1)::NNI
+       d2 = n =>
+         Pr:UP(x,R):=pseudoRemainder(p1,p2)
+         append([p1,p2]::L UP(x,R),[Pr]::L UP(x,R))
+       d2 = (n-1)::NNI =>
+         Lc1:UP(x,R):=leadingCoefficient(p1)*leadingCoefficient(p2)*p2
+         Lc2:UP(x,R):=-leadingCoefficient(p1)*pseudoRemainder(p1,p2)
+         append([p1,p2]::L UP(x,R),[Lc1,Lc2]::L UP(x,R))
+       LSubr:L UP(x,R):=[p1,p2]
+       in1:INT:=(d2+1)::INT
+       in2:INT:=(n-1)::INT
+       for i in in1..in2 repeat
+         LSubr:L UP(x,R):=append(LSubr::L UP(x,R),[0]::L UP(x,R))
+       c1:R:=(leadingCoefficient(p1)*leadingCoefficient(p2))**((n-d2)::NNI)
+       Lc1:UP(x,R):=monomial(c1,0)*p2
+       Lc2:UP(x,R):=
+         (-leadingCoefficient(p1))**((n-d2)::NNI)*pseudoRemainder(p1,p2)
+       append(LSubr::L UP(x,R),[Lc1,Lc2]::L UP(x,R))
+
+     subresultantSequenceNext(LcsI:L UP(x,R)):L UP(x,R) ==
+       p2:UP(x,R):=last LcsI
+       p1:UP(x,R):=first rest reverse LcsI
+       d1:NNI:=degree(p1)
+       d2:NNI:=degree(p2)
+       in1:NNI:=(d1-1)::NNI
+       d2 = in1 =>
+         pr1:UP(x,R):=
+           (pseudoRemainder(p1,p2) exquo (leadingCoefficient(p1))**2)::UP(x,R)
+         append(LcsI:L UP(x,R),[pr1]:L UP(x,R))
+       d2 < in1 =>
+         c1:R:=leadingCoefficient(p1)
+         pr1:UP(x,R):=
+          (leadingCoefficient(p2)**((in1-d2)::NNI)*p2 exquo
+              c1**((in1-d2)::NNI))::UP(x,R)
+         pr2:UP(x,R):=
+           (pseudoRemainder(p1,p2) exquo (-c1)**((in1-d2+2)::NNI))::UP(x,R)
+         LSub:L UP(x,R):=[pr1,pr2]
+         for k in ((d2+1)::INT)..((in1-1)::INT) repeat
+           LSub:L UP(x,R):=append([0]:L UP(x,R),LSub:L UP(x,R))
+         append(LcsI:L UP(x,R),LSub:L UP(x,R))
+
+     subresultantSequenceInner(p1,p2):L UP(x,R) ==
+       Lin:L UP(x,R):=subresultantSequenceBegin(p1:UP(x,R),p2:UP(x,R))
+       indf:NNI:= if not(Lin.last::UP(x,R) = 0) then degree(Lin.last::UP(x,R))
+                                               else 0
+       while not(indf = 0) repeat
+         Lin:L UP(x,R):=subresultantSequenceNext(Lin:L UP(x,R))
+         indf:NNI:= if not(Lin.last::UP(x,R)=0) then degree(Lin.last::UP(x,R))
+                                               else 0
+       for j in #(Lin:L UP(x,R))..degree(p1) repeat
+         Lin:L UP(x,R):=append(Lin:L UP(x,R),[0]:L UP(x,R))
+       Lin
 
--- Computation of the sign (+1,0,-1) of an element in an ordered integral
--- domain
 
---     sign(r:R):R ==
---       r =$R 0 => 0
---       r >$R 0 => 1
---       -1
+-- Computation of the subresultant sequence Sres(j)(P,p,Q,q) when:
+--             deg(P) = p   and   deg(Q) = q   and   p > q
 
+     subresultantSequence(p1,p2):L UP(x,R) ==
+       p:NNI:=degree(p1)
+       q:NNI:=degree(p2)
+       List1:L UP(x,R):=subresultantSequenceInner(p1,p2)
+       List2:L UP(x,R):=[p1,p2]
+       c1:R:=leadingCoefficient(p1)
+       for j in 3..#(List1) repeat
+         Pr0:UP(x,R):=List1.j
+         Pr1:UP(x,R):=(Pr0 exquo c1**((p-q-1)::NNI))::UP(x,R)
+         List2:L UP(x,R):=append(List2:L UP(x,R),[Pr1]:L UP(x,R))
+       List2
 
 -- Computation of the delta function:
 
      delta(int1:NNI):R ==
        (-1)**((int1*(int1+1) exquo 2)::NNI)
 
-
 -- Computation of the Sturm-Habicht sequence of two polynomials P and Q
 -- in R[x] where R is an ordered integral domaine
 
@@ -184612,13 +232206,8 @@ SturmHabichtPackage(R,x): T == C where
 
      SturmHabichtCoefficients(p1,p2):L R ==
        List1:L UP(x,R):=SturmHabichtSequence(p1,p2)
---       List2:L R:=[]
        qp:NNI:=#(List1)::NNI
        [coefficient(p,(qp-j)::NNI) for p in List1 for j in 1..qp]
---       for j in 1..qp repeat
---         Ply:R:=coefficient(List1.j,(qp-j)::NNI)
---         List2:L R:=append(List2,[Ply])
---       List2
 
 
 -- Computation of the number of sign variations of a list of non zero
@@ -184707,11 +232296,10 @@ SturmHabichtPackage(R,x): T == C where
 --    - by #[A] we note the cardinal of the set A
 
 -- In particular:
---      - SturmHabicht(P,1) is the number of "real" roots of P,
---      - SturmHabicht(P,Q**2) is the number of "real" roots of P making Q neq 0
+--     - SturmHabicht(P,1) is the number of "real" roots of P,
+--     - SturmHabicht(P,Q**2) is the number of "real" roots of P making Q neq 0
 
      SturmHabicht(p1,p2):INT ==
---     print("+" :: Ex)
        p2 = 0 => 0
        degree(p1:UP(x,R)) = 0 => 0
        List1:L UP(x,R):=SturmHabichtSequence(p1,p2)
@@ -184721,8 +232309,8 @@ SturmHabichtPackage(R,x): T == C where
      countRealRoots(p1):INT == SturmHabicht(p1,1)
 
      if R has GcdDomain then
+
         SturmHabichtMultiple(p1,p2):INT ==
-   --     print("+" :: Ex)
           p2 = 0 => 0
           degree(p1:UP(x,R)) = 0 => 0
           SH:L UP(x,R):=SturmHabichtSequence(p1,p2)
@@ -184743,11 +232331,6 @@ SturmHabichtPackage(R,x): T == C where
 
         countRealRootsMultiple(p1):INT == SturmHabichtMultiple(p1,1)
 
-\end{chunk}
-
-\begin{chunk}{COQ SHP}
-(* package SHP *)
-(*
 *)
 
 \end{chunk}
@@ -184942,6 +232525,104 @@ SubResultantPackage(R, UP): Exports == Implementation where
 \begin{chunk}{COQ SUBRESP}
 (* package SUBRESP *)
 (*
+
+    Lionel ==> PseudoRemainderSequence(R,UP)
+
+    if R has EuclideanDomain then
+      primitivePart(p, q) ==
+         rec := extendedEuclidean(leadingCoefficient p, q,
+                                  1)::Record(coef1:R, coef2:R)
+         unitCanonical primitivePart map(x1 +-> (rec.coef1 * x1) rem q, p)
+ 
+    subresultantVector(p1, p2) ==
+       F : UP -- auxiliary stuff !
+       res : PrimitiveArray(UP) := new(2+max(degree(p1),degree(p2)), 0)
+       --
+       -- kind of stupid interface to Lionel's  Package !!!!!!!!!!!!
+       -- might have been wiser to rewrite the loop ...
+       -- But I'm too lazy. [rr]
+       --
+       l := chainSubResultants(p1,p2)$Lionel
+       --
+       -- this returns the chain of non null subresultants !
+       -- we must  rebuild subresultants from this.
+       -- we really hope Lionel Ducos minded what he wrote
+       -- since we are fully blind !
+       --
+       null l =>
+         -- Hum it seems that Lionel returns [] when min(|p1|,|p2|) = 0
+         zero?(degree(p1)) =>
+           res.degree(p2) := p2
+           if degree(p2) > 0
+           then
+             res.((degree(p2)-1)::NonNegativeInteger) := p1
+             res.0 := (leadingCoefficient(p1)**(degree p2)) :: UP
+           else
+             -- both are of degree 0 the resultant is 1 according to Loos
+             res.0 := 1
+           res
+         zero?(degree(p2)) =>
+           if degree(p1) > 0
+           then
+             res.((degree(p1)-1)::NonNegativeInteger) := p2
+             res.0 := (leadingCoefficient(p2)**(degree p1)) :: UP
+           else
+             -- both are of degree 0 the resultant is 1 according to Loos
+             res.0 := 1
+           res
+         error "SUBRESP: strange Subresultant chain from PRS"
+       Sn := first(l)
+       --
+       -- as of Loos definitions last subresultant should not be defective
+       --
+       l := rest(l)
+       n := degree(Sn)
+       F := Sn
+       null l => error "SUBRESP: strange Subresultant chain from PRS"
+       zero? Sn => error "SUBRESP: strange Subresultant chain from PRS"
+       while (l ^= []) repeat
+         res.(n) := Sn
+         F := first(l)
+         l := rest(l)
+         -- F is potentially defective
+         if degree(F) = n
+         then
+           --
+           -- F is defective
+           --
+           null l => error "SUBRESP: strange Subresultant chain from PRS"
+           Sn := first(l)
+           l := rest(l)
+           n := degree(Sn)
+           res.((n-1)::NonNegativeInteger) := F
+         else
+           --
+           -- F is non defective
+           --
+           degree(F) < n => error "strange result !"
+           Sn := F
+           n := degree(Sn)
+       --
+       -- Lionel forgets about p1 if |p1| > |p2|
+       -- forgets about p2 if |p2| > |p1|
+       -- but he reminds p2 if |p1| = |p2|
+       -- a glance at Loos should correct this !
+       --
+       res.n := Sn
+       --
+       -- Loos definition
+       --
+       if degree(p1) = degree(p2)
+       then
+         res.((degree p1)+1) := p1
+       else
+         if degree(p1) > degree(p2)
+         then
+           res.(degree p1) := p1
+         else
+           res.(degree p2) := p2
+       res
+
 *)
 
 \end{chunk}
@@ -185030,6 +232711,7 @@ SupFractionFactorizer(E,OV,R,P) : C == T
        ++ pairwise relatively prime.
 
   T  == add
+
      MFACT  ==> MultivariateFactorize(OV,E,R,P)
      MSQFR  ==> MultivariateSquareFree(E,OV,R,P)
      UPCF2  ==> UnivariatePolynomialCategoryFunctions2
@@ -185065,6 +232747,37 @@ SupFractionFactorizer(E,OV,R,P) : C == T
 \begin{chunk}{COQ SUPFRACF}
 (* package SUPFRACF *)
 (*
+
+     MFACT  ==> MultivariateFactorize(OV,E,R,P)
+     MSQFR  ==> MultivariateSquareFree(E,OV,R,P)
+     UPCF2  ==> UnivariatePolynomialCategoryFunctions2
+
+     factor(p:SUP FP) : Factored SUP FP  ==
+       p=0 => 0
+       R has CharacteristicZero and R has EuclideanDomain =>
+         pden : P := lcm [denom c for c in coefficients p]
+         pol  : SUP FP := (pden::FP)*p
+         ipol: SUP P := map(numer,pol)$UPCF2(FP,SUP FP,P,SUP P)
+         ffact: Factored SUP P := 0
+         ffact := factor(ipol)$MFACT
+         makeFR((1/pden * map(coerce,unit ffact)$UPCF2(P,SUP P,FP,SUP FP)),
+         [["prime",map(coerce,u.factor)$UPCF2(P,SUP P,FP,SUP FP),
+            u.exponent] for u in factors ffact])
+       squareFree p
+
+     squareFree(p:SUP FP) : Factored SUP FP  ==
+       p=0 => 0
+       pden : P := lcm [denom c for c in coefficients p]
+       pol  : SUP FP := (pden::FP)*p
+       ipol: SUP P := map(numer,pol)$UPCF2(FP,SUP FP,P,SUP P)
+       ffact: Factored SUP P := 0
+       if R has CharacteristicZero and R has EuclideanDomain then
+         ffact := squareFree(ipol)$MSQFR
+       else ffact := squareFree(ipol)
+       makeFR((1/pden * map(coerce,unit ffact)$UPCF2(P,SUP P,FP,SUP FP)),
+         [["sqfr",map(coerce,u.factor)$UPCF2(P,SUP P,FP,SUP FP),
+            u.exponent] for u in factors ffact])
+
 *)
 
 \end{chunk}
@@ -185183,6 +232896,7 @@ SystemODESolver(F, LO): Exports == Implementation where
       ++ ordinary differential equation in \spad{F}.
 
   Implementation ==> add
+
     import PseudoLinearNormalForm F
 
     applyLodo   : (M, Z, V, N) -> F
@@ -185296,9 +233010,9 @@ SystemODESolver(F, LO): Exports == Implementation where
         mf:MF := new(nrows m, ncols m, 0)
         for i in minRowIndex m .. maxRowIndex m repeat
             for j in minColIndex m .. maxColIndex m repeat
-                (u := retractIfCan(m(i, j))@Union(F, "failed")) case "failed" =>
+               (u := retractIfCan(m(i, j))@Union(F, "failed")) case "failed" =>
                      return "failed"
-                mf(i, j) := u::F
+               mf(i, j) := u::F
         mf
 
     FSL2USL rec ==
@@ -185366,6 +233080,185 @@ SystemODESolver(F, LO): Exports == Implementation where
 \begin{chunk}{COQ ODESYS}
 (* package ODESYS *)
 (*
+
+    import PseudoLinearNormalForm F
+
+    applyLodo   : (M, Z, V, N) -> F
+    applyLodo0  : (M, Z, Matrix F, Z, N) -> F
+    backsolve   : (M, V, (LO, F) -> FSL) -> VSL
+    firstnonzero: (M, Z) -> Z
+    FSL2USL     : FSL -> USL
+    M2F         : M -> Union(MF, "failed")
+
+    diff := D()$LO
+
+    solve(mm, v, solve) ==
+      rec  := triangulate(mm, v)
+      sols:List(SOL) := empty()
+      for e in rec.eqs repeat
+          (u := solve(e.eq, e.rh)) case "failed" => return "failed"
+          sols := concat(u::SOL, sols)
+      n := nrows(rec.A)    -- dimension of original vectorspace
+      k:N := 0             -- sum of sizes of visited companionblocks
+      i:N := 0             -- number of companionblocks
+      m:N := 0             -- number of Solutions
+      part:V := new(n, 0)
+      -- count first the different solutions
+      for sol in sols repeat 
+        m := m + count((f1:F):Boolean +-> f1 ^= 0, sol.basis)$List(F)
+      SolMatrix:MF := new(n, m, 0)
+      m := 0
+      for sol in reverse_! sols repeat
+          i := i+1
+          er := rec.eqs.i
+          nn := #(er.g)           -- size of active companionblock
+          for s in sol.basis repeat
+              solVec:V := new(n, 0)
+              -- compute corresponding solution base with recursion (24)
+              solVec(k+1) := s
+              for l in 2..nn repeat solVec(k+l) := diff solVec(k+l-1)
+              m := m+1
+              setColumn!(SolMatrix, m, solVec)
+          -- compute with (24) the corresponding components of the part. sol.
+          part(k+1) := sol.particular
+          for l in 2..nn repeat part(k+l) := diff part(k+l-1) - (er.g)(l-1)
+          k := k+nn
+      -- transform these values back to the original system
+      [rec.A * part, rec.A * SolMatrix]
+
+    triangulate(m:MF, v:V) ==
+      k:N := 0       -- sum of companion-dimensions
+      rat := normalForm(m, 1, (f1:F):F +-> - diff f1)
+      l   := companionBlocks(rat.R, rat.Ainv * v)
+      ler:List(ER) := empty()
+      for er in l repeat
+        n := nrows(er.C)         -- dimension of this companion vectorspace
+        op:LO := 0               -- compute homogeneous equation
+        for j in 0..n-1 repeat op := op + monomial((er.C)(n, j + 1), j)
+        op := monomial(1, n) - op
+        sum:V := new(n::N, 0)    -- compute inhomogen Vector (25)
+        for j in 1..n-1 repeat sum(j+1) := diff(sum j) + (er.g) j
+        h0:F := 0                 -- compute inhomogenity (26)
+        for j in 1..n repeat h0 := h0 - (er.C)(n, j) * sum j
+        h0 := h0 + diff(sum n) + (er.g) n
+        ler := concat([er.C, er.g, op, h0], ler)
+        k := k + n
+      [rat.A, ler]
+
+-- like solveInField, but expects a system already triangularized
+    backsolve(m, v, solve) ==
+      part:V
+      r := maxRowIndex m
+      offset := minIndex v - (mr := minRowIndex m)
+      while r >= mr and every?(zero?, row(m, r))$Vector(LO) repeat r := r - 1
+      r < mr => error "backsolve: system has a 0 matrix"
+      (c := firstnonzero(m, r)) ^= maxColIndex m =>
+        error "backsolve: undetermined system"
+      rec := solve(m(r, c), v(r + offset))
+      dim := (r - mr + 1)::N
+      if (part? := ((u := rec.particular) case F)) then
+        part := new(dim, 0)                           -- particular solution
+        part(r + offset) :=  u::F
+-- hom is the basis for the homogeneous solutions, each column is a solution
+      hom:Matrix(F) := new(dim, #(rec.basis), 0)
+      for i in minColIndex hom .. maxColIndex hom for b in rec.basis repeat
+        hom(r, i) := b
+      n:N := 1                 -- number of equations already solved
+      while r > mr repeat
+        r := r - 1
+        c := c - 1
+        firstnonzero(m, r) ^= c => error "backsolve: undetermined system"
+        degree(eq := m(r, c)) > 0 => error "backsolve: pivot of order > 0"
+        a := leadingCoefficient(eq)::F
+        if part? then
+           part(r + offset) := (v(r + offset) - applyLodo(m, r, part, n)) / a
+        for i in minColIndex hom .. maxColIndex hom repeat
+          hom(r, i) := - applyLodo0(m, r, hom, i, n)
+        n := n + 1
+      bas:List(V) := [column(hom,i) for i in minColIndex hom..maxColIndex hom]
+      part? => [part, bas]
+      ["failed", bas]
+
+    solveInField(m, v, solve) ==
+      ((n := nrows m) = ncols m) and
+         ((u := M2F(diagonalMatrix [diff for i in 1..n] - m)) case MF) =>
+             (uu := solve(u::MF, v, 
+               (l1:LO,f2:F):USL +-> FSL2USL solve(l1, f2))) case "failed" =>
+                  ["failed", empty()]
+             rc := uu::Record(particular:V, basis:MF)
+             [rc.particular, [column(rc.basis, i) for i in 1..ncols(rc.basis)]]
+      rec := triangulate(m, v)
+      backsolve(rec.mat, rec.vec, solve)
+
+    M2F m ==
+        mf:MF := new(nrows m, ncols m, 0)
+        for i in minRowIndex m .. maxRowIndex m repeat
+            for j in minColIndex m .. maxColIndex m repeat
+               (u := retractIfCan(m(i, j))@Union(F, "failed")) case "failed" =>
+                     return "failed"
+               mf(i, j) := u::F
+        mf
+
+    FSL2USL rec ==
+        rec.particular case "failed" => "failed"
+        [rec.particular::F, rec.basis]
+
+-- returns the index of the first nonzero entry in row r of m
+    firstnonzero(m, r) ==
+      for c in minColIndex m .. maxColIndex m repeat
+        m(r, c) ^= 0 => return c
+      error "firstnonzero: zero row"
+
+-- computes +/[m(r, i) v(i) for i ranging over the last n columns of m]
+    applyLodo(m, r, v, n) ==
+      ans:F := 0
+      c := maxColIndex m
+      cv := maxIndex v
+      for i in 1..n repeat
+        ans := ans + m(r, c) (v cv)
+        c := c - 1
+        cv := cv - 1
+      ans
+
+-- computes +/[m(r, i) mm(i, c) for i ranging over the last n columns of m]
+    applyLodo0(m, r, mm, c, n) ==
+      ans := 0
+      rr := maxRowIndex mm
+      cc := maxColIndex m
+      for i in 1..n repeat
+        ans := ans + m(r, cc) mm(rr, c)
+        cc := cc - 1
+        rr := rr - 1
+      ans
+
+    triangulate(m:M, v:V) ==
+      x := copy m
+      w := copy v
+      nrows := maxRowIndex x
+      ncols := maxColIndex x
+      minr  := i := minRowIndex x
+      offset := minIndex w - minr
+      for j in minColIndex x .. ncols repeat
+        if i > nrows then leave x
+        rown := minr - 1
+        for k in i .. nrows repeat
+          if (x(k, j) ^= 0) and ((rown = minr - 1) or
+                              degree x(k,j) < degree x(rown,j)) then rown := k
+          rown = minr - 1 => "enuf"
+          x := swapRows_!(x, i, rown)
+          swap_!(w, i + offset, rown + offset)
+        for k in i+1 .. nrows | x(k, j) ^= 0 repeat
+          l := rightLcm(x(i,j), x(k,j))
+          a := rightQuotient(l, x(i, j))
+          b := rightQuotient(l, x(k, j))
+          -- l = a x(i,j) = b x(k,j)
+          for k1 in j+1 .. ncols repeat
+            x(k, k1) :=  a * x(i, k1) - b * x(k, k1)
+          x(k, j) := 0
+          w(k + offset) := a(w(i + offset)) - b(w(k + offset))
+        i := i+1
+      [x, w]
+
 *)
 
 \end{chunk}
@@ -185672,19 +233565,167 @@ SystemSolvePackage(R): Cat == Cap where
                    rhs :=  rhs soln.i
                    eqns := append(eqns, [lhs = rhs])
                [eqns]
-
                          -- polynomial system --
            if R has GcdDomain then
              parRes:=triangularSystems(lr,vl)
-             [[makeEq(map(makeR2F,f)$PP2,vl) for f in pr]
-                                                        for pr in parRes]
+             [[makeEq(map(makeR2F,f)$PP2,vl) for f in pr] for pr in parRes]
+           else [[]]
+
+\end{chunk}
+
+\begin{chunk}{COQ SYSSOLP}
+(* package SYSSOLP *)
+(*
+
+       import MPolyCatRationalFunctionFactorizer(IE,SE,R,P F)
+
+                     ---- Local Functions ----
+       linSolve: (L F,    L SE) -> Union(L EQ F, "failed")
+       makePolys :   L EQ F     ->  L F
+
+       makeR2F(r : R) : F == r :: (P R) :: F
+
+       makeP2F(p:P F):F ==
+         lv:=variables p
+         lv = [] => retract p
+         for v in lv repeat p:=pushdown(p,v)
+         retract p
+                     ---- Local Functions ----
+       makeEq(p:P F,lv:L SE): EQ F ==
+         z:=last lv
+         np:=numer makeP2F p
+         lx:=variables np
+         for x in lv repeat if member?(x,lx) then leave x
+         up:=univariate(np,x)
+         (degree up)=1 =>
+           equation(x::P(R)::F,-coefficient(up,0)/leadingCoefficient up)
+         equation(np::F,0$F)
+
+       varInF(v: SE): F == v::P(R) :: F
+
+       newInF(n: Integer):F==varInF new()$SE
+
+       testDegree(f :P R , lv :L SE) : Boolean ==
+         "or"/[degree(f,vv)>0 for vv in lv]
+                    ---- Exported Functions ----
+
+       -- solve a system of rational functions
+       triangularSystems(lf: L F,lv:L SE) : L L P R ==
+           empty? lv => empty()
+           empty? lf => empty()
+           #lf = 1 =>
+              p:= numer(first lf)
+              fp:=(factor p)$GeneralizedMultivariateFactorize(SE,IE,R,R,P R)
+              [[ff.factor] for ff in factors fp | testDegree(ff.factor,lv)]
+           dmp:=DistributedMultivariatePolynomial(lv,P R)
+           OV:=OrderedVariableList(lv)
+           DP:=DirectProduct(#lv, NonNegativeInteger)
+           push:=PushVariables(R,DP,OV,dmp)
+           lq : L dmp
+           lvv:L OV:=[variable(vv)::OV for vv in lv]
+           lq:=[pushup(df::dmp,lvv)$push for f in lf|(df:=denom f)^=1]
+           lp:=[pushup(numer(f)::dmp,lvv)$push for f in lf]
+           parRes:=groebSolve(lp,lvv)$GroebnerSolve(lv,P R,R)
+           if lq^=[] then
+             gb:=GroebnerInternalPackage(P R,DirectProduct(#lv,NNI),OV,dmp)
+             parRes:=[pr for pr in parRes|
+                       and/[(redPol(fq,pr pretend List(dmp))$gb) ^=0
+                         for fq in lq]]
+           [[retract pushdown(pf,lvv)$push for pf in pr] for pr in parRes]
+
+      -- One polynomial. Implicit variable --
+       solve(pol : F) ==
+         zero? pol =>
+            error "equation is always satisfied"
+         lv:=removeDuplicates
+             concat(variables numer pol, variables denom pol)
+         empty? lv => error "inconsistent equation"
+         #lv>1 => error "too many variables"
+         solve(pol,first lv)
+
+       -- general solver. Input in equation style. Implicit variables --
+       solve(eq : EQ F) ==
+         pol:= lhs eq - rhs eq
+         zero? pol =>
+            error "equation is always satisfied"
+         lv:=removeDuplicates
+             concat(variables numer pol, variables denom pol)
+         empty? lv => error "inconsistent equation"
+         #lv>1 => error "too many variables"
+         solve(pol,first lv)
+
+       -- general solver. Input in equation style  --
+       solve(eq:EQ F,var:SE)  == solve(lhs eq - rhs eq,var)
+
+       -- general solver. Input in polynomial style  --
+       solve(pol:F,var:SE) ==
+         if R has GcdDomain then
+           p:=primitivePart(numer pol,var)
+           fp:=(factor p)$GeneralizedMultivariateFactorize(SE,IE,R,R,P R)
+           [makeEq(map(makeR2F,ff.factor)$PP2,[var]) for ff in factors fp]
+         else empty()
+
+       -- Convert a list of Equations in a list of Polynomials
+       makePolys(l: L EQ F):L F == [lhs e - rhs e for e in l]
+
+       -- linear systems solver. Input as list of polynomials  --
+       linSolve(lp:L F,lv:L SE) ==
+           rec:Record(particular:Union(V F,"failed"),basis:L V F)
+           lr : L P R:=[numer f for f in lp]
+           rec:=linSolve(lr,lv)$LinearSystemPolynomialPackage(R,IE,SE,P R)
+           rec.particular case "failed" => "failed"
+           rhs := rec.particular :: V F
+           zeron:V F:=zero(#lv)
+           for p in rec.basis | p ^= zeron repeat
+               sym := newInF(1)
+               for i in 1..#lv repeat
+                   rhs.i := rhs.i + sym*p.i
+           eqs: L EQ F := []
+           for i in 1..#lv repeat
+             eqs := append(eqs,[(lv.i)::(P R)::F = rhs.i])
+           eqs
+
+      -- general solver. Input in polynomial style. Implicit variables --
+       solve(lr : L F) ==
+         lv :="setUnion"/[setUnion(variables numer p, variables denom p)
+               for p in lr]
+         solve(lr,lv)
+
+       -- general solver. Input in equation style. Implicit variables --
+       solve(le : L EQ F) ==
+         lr:=makePolys le
+         lv :="setUnion"/[setUnion(variables numer p, variables denom p)
+               for p in lr]
+         solve(lr,lv)
+
+       -- general solver. Input in equation style  --
+       solve(le:L EQ F,lv:L SE)  == solve(makePolys le, lv)
+
+       checkLinear(lr:L F,vl:L SE):Boolean ==
+         ld:=[denom pol for pol in lr]
+         for f in ld repeat
+           if (or/[member?(x,vl) for x in variables f]) then return false
+         and/[totalDegree(numer pol,vl) < 2 for pol in lr]
+
+       -- general solver. Input in polynomial style  --
+       solve(lr:L F,vl:L SE) ==
+           empty? vl => empty()
+           checkLinear(lr,vl) =>
+                            -- linear system --
+               soln := linSolve(lr, vl)
+               soln case "failed" => []
+               eqns: L EQ F := []
+               for i in 1..#vl repeat
+                   lhs := (vl.i::(P R))::F
+                   rhs :=  rhs soln.i
+                   eqns := append(eqns, [lhs = rhs])
+               [eqns]
+                         -- polynomial system --
+           if R has GcdDomain then
+             parRes:=triangularSystems(lr,vl)
+             [[makeEq(map(makeR2F,f)$PP2,vl) for f in pr] for pr in parRes]
            else [[]]
 
-\end{chunk}
-
-\begin{chunk}{COQ SYSSOLP}
-(* package SYSSOLP *)
-(*
 *)
 
 \end{chunk}
@@ -185915,7 +233956,6 @@ SymmetricGroupCombinatoricFunctions(): public == private where
  
     -- declaration of local functions
  
- 
     numberOfImproperPartitionsInternal: (I,I,I) -> I
       -- this is used as subtree counting function in
       -- "unrankImproperPartitions1". For (n,m,cm) it counts
@@ -185924,10 +233964,8 @@ SymmetricGroupCombinatoricFunctions(): public == private where
       -- positions sum up to n. Example: (3,3,2) counts
       -- [x,3,0], [x,0,3], [0,x,3], [x,2,1], [x,1,2], x non-zero.
  
- 
     -- definition of local functions
  
- 
     numberOfImproperPartitionsInternal(n,m,cm) ==
       n = 0 => binomial(m,cm)$ICF
       cm = 0 and n > 0 => 0
@@ -185936,7 +233974,6 @@ SymmetricGroupCombinatoricFunctions(): public == private where
         s := s + numberOfImproperPartitionsInternal(i,m,cm-1)
       s
  
- 
     -- definition of exported functions
  
     numberOfImproperPartitions(n,m) ==
@@ -185947,7 +233984,6 @@ SymmetricGroupCombinatoricFunctions(): public == private where
         s := s + numberOfImproperPartitions(n-i,m-1)
       s
  
- 
     unrankImproperPartitions0(n,m,k) ==
       l : L I  := nil$(L I)
       k < 0 => error"counting of partitions is started at 0"
@@ -185965,7 +234001,6 @@ SymmetricGroupCombinatoricFunctions(): public == private where
       l := append(l,list(n)$(L I))$(L I)
       l
  
- 
     unrankImproperPartitions1(n,m,k) ==
       -- we use the counting procedure of the leaves in a tree
       -- having the following structure: First of all non-zero
@@ -185998,7 +234033,6 @@ SymmetricGroupCombinatoricFunctions(): public == private where
       for i in 1..m-cm  repeat partition.(1+nonZeroPos.i) := nonZeros.i
       entries partition
  
- 
     subSet(n,m,k) ==
       k < 0 or n < 0 or m < 0 or m > n =>
         error "improper argument to subSet"
@@ -186017,21 +234051,17 @@ SymmetricGroupCombinatoricFunctions(): public == private where
          s := s-1
       l
  
- 
     nextLatticePermutation(lambda, lattP, constructNotFirst) ==
- 
       lprime  : L I  := conjugate(lambda)$PartitionsAndPermutations
       columns : NNI := (first(lambda)$(L I))::NNI
       rows    : NNI := (first(lprime)$(L I))::NNI
       n       : NNI :=(+/lambda)::NNI
- 
       not constructNotFirst =>   -- first lattice permutation
         lattP := nil$(L I)
         for i in columns..1 by -1 repeat
           for l in 1..lprime(i) repeat
             lattP := cons(i,lattP)
         lattP
- 
       help : V I := new(columns,0) -- entry help(i) stores the number
       -- of occurences of number i on our way from right to left
       rightPosition  : NNI := n
@@ -186070,7 +234100,6 @@ SymmetricGroupCombinatoricFunctions(): public == private where
       not constructNotFirst =>  nil$(L I)
       lattP
  
- 
     makeYoungTableau(lambda,gitter) ==
       lprime  : L I  := conjugate(lambda)$PartitionsAndPermutations
       columns : NNI := (first(lambda)$(L I))::NNI
@@ -186087,18 +234116,6 @@ SymmetricGroupCombinatoricFunctions(): public == private where
         help(j) := help(j) + 1
       ytab
  
- 
---    coerce(ytab) ==
---      lli := listOfLists(ytab)$(M I)
---      -- remove the filling zeros in each row. It is assumed that
---      -- that there are no such in row 0.
---      for i in 2..maxIndex lli repeat
---        THIS IS DEFINIVELY WRONG, I NEED A FUNCTION WHICH DELETES THE
---        0s, in my version there are no mapping facilities yet.
---        deleteInPlace(not zero?,lli i)
---      tableau(lli)$Tableau(I)
- 
- 
     listYoungTableaus(lambda) ==
       lattice   : L I
       ytab      : M I
@@ -186110,7 +234127,6 @@ SymmetricGroupCombinatoricFunctions(): public == private where
         lattice   := nextLatticePermutation(lambda,lattice,true)
       younglist
  
- 
     nextColeman(alpha,beta,C) ==
       nrow  : NNI := #beta
       ncol  : NNI := #alpha
@@ -186153,11 +234169,9 @@ SymmetricGroupCombinatoricFunctions(): public == private where
         --  vrest(k) := vrest(k) - succ(k)
       setRow_!(coleman, nrow, vrest)
  
- 
     nextPartition(gamma:V I, part:V I, number:I) ==
       nextPartition(entries gamma, part, number)
  
- 
     nextPartition(gamma:L I,part:V I,number:I) ==
       n : NNI := #gamma
       vnull : V I := vector(nil()$(L I)) -- empty vector
@@ -186184,7 +234198,6 @@ SymmetricGroupCombinatoricFunctions(): public == private where
         part(k) := 0
       part
  
- 
     inverseColeman(alpha,beta,C) ==
       pi   : L I  := nil$(L I)
       nrow : NNI := #beta
@@ -186201,7 +234214,6 @@ SymmetricGroupCombinatoricFunctions(): public == private where
             help(i) := help(i) + 1
       pi
  
- 
     coleman(alpha,beta,pi) ==
       nrow : NNI := #beta
       ncol : NNI := #alpha
@@ -186230,6 +234242,292 @@ SymmetricGroupCombinatoricFunctions(): public == private where
 \begin{chunk}{COQ SGCF}
 (* package SGCF *)
 (*
+ 
+    import Set I
+ 
+    -- declaration of local functions
+ 
+    numberOfImproperPartitionsInternal: (I,I,I) -> I
+      -- this is used as subtree counting function in
+      -- "unrankImproperPartitions1". For (n,m,cm) it counts
+      -- the following set of m-tuples: The  first (from left
+      -- to right) m-cm non-zero entries are equal, the remaining
+      -- positions sum up to n. Example: (3,3,2) counts
+      -- [x,3,0], [x,0,3], [0,x,3], [x,2,1], [x,1,2], x non-zero.
+ 
+    -- definition of local functions
+ 
+    numberOfImproperPartitionsInternal(n,m,cm) ==
+      n = 0 => binomial(m,cm)$ICF
+      cm = 0 and n > 0 => 0
+      s := 0
+      for i in 0..n-1 repeat
+        s := s + numberOfImproperPartitionsInternal(i,m,cm-1)
+      s
+ 
+    -- definition of exported functions
+ 
+    numberOfImproperPartitions(n,m) ==
+      if n < 0 or m < 1 then return 0
+      if m = 1 or n = 0 then return 1
+      s := 0
+      for i in 0..n repeat
+        s := s + numberOfImproperPartitions(n-i,m-1)
+      s
+ 
+    unrankImproperPartitions0(n,m,k) ==
+      l : L I  := nil$(L I)
+      k < 0 => error"counting of partitions is started at 0"
+      k >= numberOfImproperPartitions(n,m) =>
+        error"there are not so many partitions"
+      for t in 0..(m-2) repeat
+        s : I := 0
+        for y in 0..n repeat
+          sOld := s
+          s := s + numberOfImproperPartitions(n-y,m-t-1)
+          if s > k then leave
+        l := append(l,list(y)$(L I))$(L I)
+        k := k - sOld
+        n := n - y
+      l := append(l,list(n)$(L I))$(L I)
+      l
+ 
+    unrankImproperPartitions1(n,m,k) ==
+      -- we use the counting procedure of the leaves in a tree
+      -- having the following structure: First of all non-zero
+      -- labels for the sons. If addition along a path gives n,
+      -- then we go on creating the subtree for (n choose cm)
+      -- where cm is the length of the path. These subsets determine
+      -- the positions for the non-zero labels for the partition
+      -- to be formeded. The remaining positions are filled by zeros.
+      nonZeros   : L I := nil$(L I)
+      partition  : V I :=  new(m::NNI,0$I)$(V I)
+      k < 0 => nonZeros
+      k >= numberOfImproperPartitions(n,m) => nonZeros
+      cm : I := m    --cm gives the depth of the tree
+      while n ^= 0 repeat
+        s : I := 0
+        cm := cm - 1
+        for y in n..1 by -1 repeat   --determination of the next son
+          sOld := s  -- remember old s
+          -- this functions counts the number of elements in a subtree
+          s := s + numberOfImproperPartitionsInternal(n-y,m,cm)
+          if s > k then leave
+        -- y is the next son, so put it into the pathlist "nonZero"
+        nonZeros := append(nonZeros,list(y)$(L I))$(L I)
+        k := k - sOld    --updating
+        n := n - y       --updating
+      --having found all m-cm non-zero entries we change the structure
+      --of the tree and determine the non-zero positions
+      nonZeroPos : L I := reverse subSet(m,m-cm,k)
+      --building the partition
+      for i in 1..m-cm  repeat partition.(1+nonZeroPos.i) := nonZeros.i
+      entries partition
+ 
+    subSet(n,m,k) ==
+      k < 0 or n < 0 or m < 0 or m > n =>
+        error "improper argument to subSet"
+      bin : I := binomial$ICF (n,m)
+      k >= bin =>
+        error "there are not so many subsets"
+      l : L I  := []
+      n = 0 => l
+      mm : I := k
+      s  : I := m
+      for t in 0..(m-1) repeat
+         for y in (s-1)..(n+1) repeat
+            if binomial$ICF (y,s) > mm then leave
+         l := append (l,list(y-1)$(L I))
+         mm := mm - binomial$ICF (y-1,s)
+         s := s-1
+      l
+ 
+    nextLatticePermutation(lambda, lattP, constructNotFirst) ==
+      lprime  : L I  := conjugate(lambda)$PartitionsAndPermutations
+      columns : NNI := (first(lambda)$(L I))::NNI
+      rows    : NNI := (first(lprime)$(L I))::NNI
+      n       : NNI :=(+/lambda)::NNI
+      not constructNotFirst =>   -- first lattice permutation
+        lattP := nil$(L I)
+        for i in columns..1 by -1 repeat
+          for l in 1..lprime(i) repeat
+            lattP := cons(i,lattP)
+        lattP
+      help : V I := new(columns,0) -- entry help(i) stores the number
+      -- of occurences of number i on our way from right to left
+      rightPosition  : NNI := n
+      leftEntry : NNI := lattP(rightPosition)::NNI
+      ready  : B  := false
+      until (ready or (not constructNotFirst)) repeat
+        rightEntry : NNI := leftEntry
+        leftEntry := lattP(rightPosition-1)::NNI
+        help(rightEntry) := help(rightEntry) + 1
+        -- search backward decreasing neighbour elements
+        if rightEntry > leftEntry then
+          if ((lprime(leftEntry)-help(leftEntry)) >_
+            (lprime(rightEntry)-help(rightEntry)+1)) then
+            -- the elements may be swapped because the number of occurances
+            -- of leftEntry would still be greater than those of rightEntry
+            ready := true
+            j : NNI := leftEntry + 1
+            -- search among the numbers leftEntry+1..rightEntry for the
+            -- smallest one which can take the place of leftEntry.
+            -- negation of condition above:
+            while (help(j)=0) or ((lprime(leftEntry)-lprime(j))
+              < (help(leftEntry)-help(j)+2)) repeat j := j + 1
+            lattP(rightPosition-1) := j
+            help(j) := help(j)-1
+            help(leftEntry) := help(leftEntry) + 1
+            -- reconstruct the rest of the list in increasing order
+            for l in rightPosition..n repeat
+              j := 0
+              while help(1+j) = 0 repeat j := j + 1
+              lattP(l::NNI) := j+1
+              help(1+j) := help(1+j) - 1
+        -- end of "if rightEntry > leftEntry"
+        rightPosition := (rightPosition-1)::NNI
+        if rightPosition = 1 then constructNotFirst := false
+      -- end of repeat-loop
+      not constructNotFirst =>  nil$(L I)
+      lattP
+ 
+    makeYoungTableau(lambda,gitter) ==
+      lprime  : L I  := conjugate(lambda)$PartitionsAndPermutations
+      columns : NNI := (first(lambda)$(L I))::NNI
+      rows    : NNI := (first(lprime)$(L I))::NNI
+      ytab    : M I  := new(rows,columns,0)
+      help    : V I  := new(columns,1)
+      i : I := -1     -- this makes the entries ranging from 0,..,n-1
+                      -- i := 0 would make it from 1,..,n.
+      j : I := 0
+      for l in 1..maxIndex gitter repeat
+        j := gitter(l)
+        i := i + 1
+        ytab(help(j),j) := i
+        help(j) := help(j) + 1
+      ytab
+ 
+    listYoungTableaus(lambda) ==
+      lattice   : L I
+      ytab      : M I
+      younglist : L M I := nil$(L M I)
+      lattice   := nextLatticePermutation(lambda,lattice,false)
+      until null lattice repeat
+        ytab      := makeYoungTableau(lambda,lattice)
+        younglist := append(younglist,[ytab]$(L M I))$(L M I)
+        lattice   := nextLatticePermutation(lambda,lattice,true)
+      younglist
+ 
+    nextColeman(alpha,beta,C) ==
+      nrow  : NNI := #beta
+      ncol  : NNI := #alpha
+      vnull : V I  := vector(nil()$(L I)) -- empty vector
+      vzero : V I  := new(ncol,0)
+      vrest : V I  := new(ncol,0)
+      cnull : M I  := new(1,1,0)
+      coleman := copy C
+      if coleman ^= cnull then
+        -- look for the first row of "coleman" that has a succeeding
+        -- partition, this can be atmost row nrow-1
+        i : NNI := (nrow-1)::NNI
+        vrest := row(coleman,i) + row(coleman,nrow)
+        --for k in 1..ncol repeat
+        --  vrest(k) := coleman(i,k) + coleman(nrow,k)
+        succ := nextPartition(vrest,row(coleman, i),beta(i))
+        while (succ = vnull) repeat
+          if i = 1 then return cnull -- part is last partition
+          i := (i - 1)::NNI
+          --for k in 1..ncol repeat
+          --  vrest(k) := vrest(k) + coleman(i,k)
+          vrest := vrest + row(coleman,i)
+          succ := nextPartition(vrest, row(coleman, i), beta(i))
+        j : I := i
+        coleman := setRow_!(coleman, i, succ)
+        --for k in 1..ncol repeat
+        --  vrest(k) := vrest(k) - coleman(i,k)
+        vrest := vrest - row(coleman,i)
+      else
+        vrest := vector alpha
+        -- for k in 1..ncol repeat
+        --  vrest(k) := alpha(k)
+        coleman := new(nrow,ncol,0)
+        j : I := 0
+      for i in (j+1)::NNI..nrow-1 repeat
+        succ := nextPartition(vrest,vnull,beta(i))
+        coleman := setRow_!(coleman, i, succ)
+        vrest := vrest - succ
+        --for k in 1..ncol repeat
+        --  vrest(k) := vrest(k) - succ(k)
+      setRow_!(coleman, nrow, vrest)
+ 
+    nextPartition(gamma:V I, part:V I, number:I) ==
+      nextPartition(entries gamma, part, number)
+ 
+    nextPartition(gamma:L I,part:V I,number:I) ==
+      n : NNI := #gamma
+      vnull : V I := vector(nil()$(L I)) -- empty vector
+      if part ^= vnull then
+        i : NNI := 2
+        sum := part(1)
+        while (part(i) = gamma(i)) or (sum = 0) repeat
+          sum := sum + part(i)
+          i := i + 1
+          if i = 1+n then return vnull -- part is last partition
+        sum := sum - 1
+        part(i) := part(i) + 1
+      else
+        sum := number
+        part := new(n,0)
+        i := 1+n
+      j : NNI := 1
+      while sum > gamma(j) repeat
+        part(j) := gamma(j)
+        sum := sum - gamma(j)
+        j := j + 1
+      part(j) := sum
+      for k in j+1..i-1 repeat
+        part(k) := 0
+      part
+ 
+    inverseColeman(alpha,beta,C) ==
+      pi   : L I  := nil$(L I)
+      nrow : NNI := #beta
+      ncol : NNI := #alpha
+      help : V I  := new(nrow,0)
+      sum  : I   := 1
+      for i in 1..nrow repeat
+        help(i) := sum
+        sum := sum + beta(i)
+      for j in 1..ncol repeat
+        for i in 1..nrow repeat
+          for k in 2..1+C(i,j) repeat
+            pi := append(pi,list(help(i))$(L I))
+            help(i) := help(i) + 1
+      pi
+ 
+    coleman(alpha,beta,pi) ==
+      nrow : NNI := #beta
+      ncol : NNI := #alpha
+      temp : L L I := nil$(L L I)
+      help : L I  := nil$(L I)
+      colematrix : M I := new(nrow,ncol,0)
+      betasum  : NNI := 0
+      alphasum : NNI := 0
+      for i in 1..ncol repeat
+        help := nil$(L I)
+        for j in alpha(i)..1 by-1 repeat
+          help := cons(pi(j::NNI+alphasum),help)
+        alphasum := (alphasum + alpha(i))::NNI
+        temp := append(temp,list(help)$(L L I))
+      for i in 1..nrow repeat
+        help := nil$(L I)
+        for j in beta(i)..1 by-1 repeat
+          help := cons(j::NNI+betasum, help)
+        betasum := (betasum + beta(i))::NNI
+        for j in 1..ncol repeat
+          colematrix(i,j) := #intersect(brace(help),brace(temp(j)))
+      colematrix
+
 *)
 
 \end{chunk}
@@ -186305,6 +234603,7 @@ SymmetricFunctions(R:Ring): Exports == Implementation where
       ++ symmetric functions in \spad{[r,r,...,r]} \spad{n} times.
 
   Implementation ==> add
+
     signFix: (UP, NonNegativeInteger) -> Vector R
 
     symFunc(x, n) == signFix((monomial(1, 1)$UP - x::UP) ** n, 1 + n)
@@ -186323,6 +234622,20 @@ SymmetricFunctions(R:Ring): Exports == Implementation where
 \begin{chunk}{COQ SYMFUNC}
 (* package SYMFUNC *)
 (*
+
+    signFix: (UP, NonNegativeInteger) -> Vector R
+
+    symFunc(x, n) == signFix((monomial(1, 1)$UP - x::UP) ** n, 1 + n)
+
+    symFunc l ==
+      signFix(*/[monomial(1, 1)$UP - a::UP for a in l], 1 + #l)
+
+    signFix(p, n) ==
+      m := minIndex(v := vectorise(p, n)) + 1
+      for i in 0..((#v quo 2) - 1)::NonNegativeInteger repeat
+        qsetelt_!(v, 2*i + m, - qelt(v, 2*i + m))
+      reverse_! v
+
 *)
 
 \end{chunk}
@@ -186464,7 +234777,9 @@ TableauxBumpers(S:OrderedSet):T==C where
          ++ finds the position of the maximum element of a tableau t
          ++ which is in the lowest row, producing a record of results
      C== add
+
        cf:(S,S)->B
+
        bumprow(cf,x:(PAIR),lls:(L PAIR))==
          if null lls
          then [false,x,[x]]$ROW
@@ -186485,13 +234800,18 @@ TableauxBumpers(S:OrderedSet):T==C where
        bumptab1(x,llls)==bumptab((s1,s2) +-> s1<s2, x, llls)
 
        rd==> reduce$StreamFunctions2(PAIR,L L PAIR)
+
        tab1(lls:(L PAIR))== rd([],bumptab1,lls::(ST PAIR))
 
        srt==>sort$(PAIR)
+
        lexorder:(PAIR,PAIR)->B
        lexorder(p1,p2)==if p1.1=p2.1 then p1.2<p2.2 else p1.1<p2.1
+
        lex lp==(sort$(L PAIR))((s1,s2) +-> lexorder(s1,s2), lp)
+
        slex ls==lex([[i,j] for i in srt((s1, s2) +-> s1<s2, ls) for j in ls])
+
        inverse ls==[lss.2 for lss in
                     lex([[j,i] for i in srt((s1,s2) +-> s1<s2, ls) 
                                for j in ls])]
@@ -186528,6 +234848,72 @@ TableauxBumpers(S:OrderedSet):T==C where
 \begin{chunk}{COQ TABLBUMP}
 (* package TABLBUMP *)
 (*
+
+       cf:(S,S)->B
+
+       bumprow(cf,x:(PAIR),lls:(L PAIR))==
+         if null lls
+         then [false,x,[x]]$ROW
+         else (y:(PAIR):=first lls;
+               if cf(x.2,y.2)
+               then [true,[x.1,y.2],cons([y.1,x.2],rest lls)]$ROW
+               else (rw:ROW:=bumprow(cf,x,rest lls);
+                       [rw.fs,rw.sd,cons(first lls,rw.td)]$ROW ))
+
+       bumptab(cf,x:(PAIR),llls:(L L PAIR))==
+           if null llls
+           then [[x]]
+           else (rw:ROW:= bumprow(cf,x,first llls);
+                 if rw.fs
+                 then cons(rw.td, bumptab(cf,rw.sd,rest llls))
+                 else cons(rw.td,rest llls))
+
+       bumptab1(x,llls)==bumptab((s1,s2) +-> s1<s2, x, llls)
+
+       rd==> reduce$StreamFunctions2(PAIR,L L PAIR)
+
+       tab1(lls:(L PAIR))== rd([],bumptab1,lls::(ST PAIR))
+
+       srt==>sort$(PAIR)
+
+       lexorder:(PAIR,PAIR)->B
+       lexorder(p1,p2)==if p1.1=p2.1 then p1.2<p2.2 else p1.1<p2.1
+
+       lex lp==(sort$(L PAIR))((s1,s2) +-> lexorder(s1,s2), lp)
+
+       slex ls==lex([[i,j] for i in srt((s1, s2) +-> s1<s2, ls) for j in ls])
+
+       inverse ls==[lss.2 for lss in
+                    lex([[j,i] for i in srt((s1,s2) +-> s1<s2, ls) 
+                               for j in ls])]
+
+       tab(ls:(PAIR))==(tableau tab1 slex ls )
+
+       maxrow(n,a,b,c,d,llls)==
+        if null llls or null(first llls)
+        then [n,a,b,c]$RC
+        else (fst:=first first llls;rst:=rest first llls;
+              if fst.1>n.1
+              then maxrow(fst,d,rst,rest llls,cons(first llls,d),rest llls)
+              else maxrow(n,a,b,c,cons(first llls,d),rest llls))
+
+       mr llls==maxrow(first first llls,[],rest first llls,rest llls,
+                                                               [],llls)
+
+       untab(lp, llls)==
+         if null llls
+         then lp
+         else (rc:RC:=mr llls;
+               rv:=reverse (bumptab((s1:S,s2:S):B +-> s2<s1, rc. f1, rc. f2));
+               untab(cons(first first rv,lp)
+                     ,append(rest rv,
+                                         if null rc.f3
+                                         then []
+                                         else cons(rc.f3,rc.f4))))
+
+       bat1 llls==untab([],[reverse lls for lls in llls])
+       bat tb==bat1(listOfLists tb)
+
 *)
 
 \end{chunk}
@@ -186655,6 +235041,7 @@ TabulatedComputationPackage(Key ,Entry): Exports == Implementation where
        ++ entry is \axiom{y}.
 
   Implementation == add
+
      table?: Boolean := false
      t: H := empty()
      info?: Boolean := false
@@ -186668,6 +235055,7 @@ TabulatedComputationPackage(Key ,Entry): Exports == Implementation where
        table? := true
        t := empty()
        void()
+
      printInfo!(s1: String, s2: String): Void ==
        (empty? s1) or (empty? s2) => void()
        not usingTable? =>
@@ -186676,6 +235064,7 @@ TabulatedComputationPackage(Key ,Entry): Exports == Implementation where
        ok := s1
        ko := s2
        void()
+
      startStats!(s: String): Void == 
        empty? s => void()
        not table? =>
@@ -186684,6 +235073,7 @@ TabulatedComputationPackage(Key ,Entry): Exports == Implementation where
        used := 0
        domainName := s
        void()
+
      printStats!(): Void == 
        not table? =>
          error "in printStats!()$TBCMPPK: not allowed to use hashtable"
@@ -186695,6 +235085,7 @@ TabulatedComputationPackage(Key ,Entry): Exports == Implementation where
        n: N := #t
        output("   Table     size: ", n::OutputForm)$OutputPackage
        output("   Entries reused: ", used::OutputForm)$OutputPackage
+
      clearTable!(): Void == 
        not table? =>
          error "in clearTable!()$TBCMPPK: not allowed to use hashtable"
@@ -186704,9 +235095,13 @@ TabulatedComputationPackage(Key ,Entry): Exports == Implementation where
        stats? := false
        domainName := empty()$String
        void()
+
      usingTable?() == table?
+
      printingInfo?() == info?
+
      makingStats?() == stats?
+
      extractIfCan(k: Key): Union(Entry,"failed") ==
        not table? => "failed" :: Union(Entry,"failed")
        s: Union(Entry,"failed") := search(k,t)
@@ -186715,6 +235110,7 @@ TabulatedComputationPackage(Key ,Entry): Exports == Implementation where
          if stats? then used := used + 1
          return s
        "failed" :: Union(Entry,"failed")
+
      insert!(k: Key, e:Entry): Void ==
        not table? => void()
        t.k := e
@@ -186726,6 +235122,82 @@ TabulatedComputationPackage(Key ,Entry): Exports == Implementation where
 \begin{chunk}{COQ TBCMPPK}
 (* package TBCMPPK *)
 (*
+
+     table?: Boolean := false
+     t: H := empty()
+     info?: Boolean := false
+     stats?: Boolean := false
+     used: NonNegativeInteger := 0
+     ok: String := "o"
+     ko: String := "+"
+     domainName: String := empty()$String
+     
+     initTable!(): Void ==
+       table? := true
+       t := empty()
+       void()
+
+     printInfo!(s1: String, s2: String): Void ==
+       (empty? s1) or (empty? s2) => void()
+       not usingTable? =>
+         error "in printInfo!()$TBCMPPK: not allowed to use hashtable"
+       info? := true
+       ok := s1
+       ko := s2
+       void()
+
+     startStats!(s: String): Void == 
+       empty? s => void()
+       not table? =>
+         error "in startStats!()$TBCMPPK: not allowed to use hashtable"
+       stats? := true
+       used := 0
+       domainName := s
+       void()
+
+     printStats!(): Void == 
+       not table? =>
+         error "in printStats!()$TBCMPPK: not allowed to use hashtable"
+       not stats? =>
+         error "in printStats!()$TBCMPPK: statistics not started"
+       output(" ")$OutputPackage
+       title: String := concat("*** ", concat(domainName," Statistics ***"))
+       output(title)$OutputPackage
+       n: N := #t
+       output("   Table     size: ", n::OutputForm)$OutputPackage
+       output("   Entries reused: ", used::OutputForm)$OutputPackage
+
+     clearTable!(): Void == 
+       not table? =>
+         error "in clearTable!()$TBCMPPK: not allowed to use hashtable"
+       t := empty()
+       table? := false
+       info? := false
+       stats? := false
+       domainName := empty()$String
+       void()
+
+     usingTable?() == table?
+
+     printingInfo?() == info?
+
+     makingStats?() == stats?
+
+     extractIfCan(k: Key): Union(Entry,"failed") ==
+       not table? => "failed" :: Union(Entry,"failed")
+       s: Union(Entry,"failed") := search(k,t)
+       s case Entry => 
+         if info? then iprint(ok)$iprintpack
+         if stats? then used := used + 1
+         return s
+       "failed" :: Union(Entry,"failed")
+
+     insert!(k: Key, e:Entry): Void ==
+       not table? => void()
+       t.k := e
+       if info? then iprint(ko)$iprintpack
+       void()
+
 *)
 
 \end{chunk}
@@ -186810,6 +235282,7 @@ TangentExpansions(R:Field): Exports == Implementation where
       ++ if \spad{a = tan(u)} then \spad{f(a) = tan(n * u)}.
 
   Implementation ==> add
+
     import SymmetricFunctions(R)
     import SymmetricFunctions(UP)
 
@@ -186817,6 +235290,7 @@ TangentExpansions(R:Field): Exports == Implementation where
     tanPIa: PI -> QF
 
     m1toN n     == (odd? n => -1; 1)
+
     tanAn(a, n) == a * denom(q := tanPIa n) - numer q
 
     tanNa(a, n) ==
@@ -186829,8 +235303,8 @@ TangentExpansions(R:Field): Exports == Implementation where
       +/[m1toN(i+1) * v(2*i - 1 + m) for i in 1..(#v quo 2)]
         / +/[m1toN(i) * v(2*i + m) for i in 0..((#v - 1) quo 2)]
 
--- tanPIa(n) returns P(a)/Q(a) such that
--- if a = tan(u) then P(a)/Q(a) = tan(n * u);
+    -- tanPIa(n) returns P(a)/Q(a) such that
+    -- if a = tan(u) then P(a)/Q(a) = tan(n * u);
     tanPIa n ==
       m := minIndex(v := symFunc(monomial(1, 1)$UP, n))
       +/[m1toN(i+1) * v(2*i - 1 + m) for i in 1..(#v quo 2)]
@@ -186841,6 +235315,34 @@ TangentExpansions(R:Field): Exports == Implementation where
 \begin{chunk}{COQ TANEXP}
 (* package TANEXP *)
 (*
+
+    import SymmetricFunctions(R)
+    import SymmetricFunctions(UP)
+
+    m1toN : Integer -> Integer
+    tanPIa: PI -> QF
+
+    m1toN n     == (odd? n => -1; 1)
+
+    tanAn(a, n) == a * denom(q := tanPIa n) - numer q
+
+    tanNa(a, n) ==
+      zero? n => 0
+      negative? n => - tanNa(a, -n)
+      (numer(t := tanPIa(n::PI)) a) / ((denom t) a)
+
+    tanSum l ==
+      m := minIndex(v := symFunc l)
+      +/[m1toN(i+1) * v(2*i - 1 + m) for i in 1..(#v quo 2)]
+        / +/[m1toN(i) * v(2*i + m) for i in 0..((#v - 1) quo 2)]
+
+    -- tanPIa(n) returns P(a)/Q(a) such that
+    -- if a = tan(u) then P(a)/Q(a) = tan(n * u);
+    tanPIa n ==
+      m := minIndex(v := symFunc(monomial(1, 1)$UP, n))
+      +/[m1toN(i+1) * v(2*i - 1 + m) for i in 1..(#v quo 2)]
+        / +/[m1toN(i) * v(2*i + m) for i in 0..((#v - 1) quo 2)]
+
 *)
 
 \end{chunk}
@@ -186940,7 +235442,6 @@ TaylorSolve(F, UTSF, UTSSUPF): Exports == Implementation where
              map((x:F):SUP F +-> x::(SUP F), l)
                   $ListFunctions2(F, SUP F)::(Stream SUP F)
             coeffs: Stream SUP F := concat(c1, generate(monomial(1$F,1$NNI)))
---            coeffs: Stream SUP F := concat(c1, monomial(1$F,1$NNI))
 \end{chunk}
 
 coeffs is the stream of the already computed coefficients of the solution,
@@ -186965,7 +235466,7 @@ obtain $f\big(0, y(0)\big)=0$. It is not necessarily the case that this
 determines $y(0)$ uniquely, so we need one initial value that satisfies this
 equation.
 \begin{verbatim}
-  seriesSolve should check that the given initial values satisfy $f\big(0, y(0),
+ seriesSolve should check that the given initial values satisfy $f\big(0, y(0),
   y'(0),...\big) = 0$.
 \end{verbatim}
 Now consider the derivatives of $f$, where we write $y$ instead of $y(x)$ for
@@ -187023,18 +235524,15 @@ should be unique.
                     if degree eq > 1 then
                         if monomial? eq then res := 0
                         else 
-                            output(hconcat("The equation is: ", eq::OutputForm))
+                            output(hconcat("The equation is: ",eq::OutputForm))
                                   $OutputPackage
-                            error "seriesSolve: equation for coefficient not linear"
+                            error _
+                             "seriesSolve: equation for coefficient not linear"
                     else res := (-coefficient(eq, 0$NNI)$(SUP F)
                                  /coefficient(eq, 1$NNI)$(SUP F))
-
                     nr.1 := res::SUP F
---                    concat!(st.2, monomial(1$F,1$NNI))
                     st.1 := rest nr
-
                 res
-
             series generate next
 
 \end{chunk}
@@ -187042,6 +235540,39 @@ should be unique.
 \begin{chunk}{COQ UTSSOL}
 (* package UTSSOL *)
 (*
+        seriesSolve(f, l) ==
+            c1 := 
+             map((x:F):SUP F +-> x::(SUP F), l)
+                  $ListFunctions2(F, SUP F)::(Stream SUP F)
+            coeffs: Stream SUP F := concat(c1, generate(monomial(1$F,1$NNI)))
+            st: List Stream SUP F := [coeffs, coeffs]
+            next: () -> F := 
+                nr := st.1
+                res: F
+
+                if ground?(coeff: SUP F := nr.1)$(SUP F)
+                then 
+                    res := ground coeff 
+                    st.1 := rest nr
+                else
+                    ns := st.2
+                    eqs: Stream SUP F := coefficients f series ns
+                    while zero? first eqs repeat eqs := rest eqs
+                    eq: SUP F := first eqs
+                    if degree eq > 1 then
+                        if monomial? eq then res := 0
+                        else 
+                            output(hconcat("The equation is: ",eq::OutputForm))
+                                  $OutputPackage
+                            error _
+                             "seriesSolve: equation for coefficient not linear"
+                    else res := (-coefficient(eq, 0$NNI)$(SUP F)
+                                 /coefficient(eq, 1$NNI)$(SUP F))
+                    nr.1 := res::SUP F
+                    st.1 := rest nr
+                res
+            series generate next
+
 *)
 
 \end{chunk}
@@ -187139,6 +235670,23 @@ TemplateUtilities(): Exports == Implementation where
 \begin{chunk}{COQ TEMUTL}
 (* package TEMUTL *)
 (*
+
+    import InputForm
+
+    stripC(s:String,u:String):String ==
+      i : Integer := position(u,s,1)
+      i = 0 => s
+      delete(s,i..)
+
+    stripCommentsAndBlanks(s:String):String ==
+      trim(stripC(stripC(s,"++"),"--"),char " ")
+
+    parse(s:String):InputForm ==
+      ncParseFromString(s)$Lisp::InputForm 
+
+    interpretString(s:String):Any ==
+      interpret parse s
+
 *)
 
 \end{chunk}
@@ -187210,6 +235758,7 @@ TexFormat1(S : SetCategory): public == private where
       ++ it is coerced to TeX format.
 
   private == add
+
     import TexFormat()
 
     coerce(s : S): TexFormat ==
@@ -187220,6 +235769,12 @@ TexFormat1(S : SetCategory): public == private where
 \begin{chunk}{COQ TEX1}
 (* package TEX1 *)
 (*
+
+    import TexFormat()
+
+    coerce(s : S): TexFormat ==
+      coerce(s :: OutputForm)$TexFormat
+
 *)
 
 \end{chunk}
@@ -187298,13 +235853,17 @@ ToolsForSign(R:Ring): with
  == add
  
     if R is AlgebraicNumber then
+
       nonQsign r ==
         sign((r pretend AlgebraicNumber)::Expression(
                   Integer))$ElementaryFunctionSign(Integer, Expression Integer)
+
     else
+
       nonQsign r == "failed"
  
     if R has RetractableTo Fraction Integer then
+
       sign r ==
         (u := retractIfCan(r)@Union(Fraction Integer, "failed"))
           case Fraction(Integer) => sign(u::Fraction Integer)
@@ -187312,15 +235871,16 @@ ToolsForSign(R:Ring): with
  
     else
       if R has RetractableTo Integer then
+
         sign r ==
           (u := retractIfCan(r)@Union(Integer, "failed"))
             case "failed" => "failed"
           sign(u::Integer)
  
       else
+
         sign r ==
           zero? r => 0
---          one? r => 1
           r = 1 => 1
           r = -1 => -1
           "failed"
@@ -187335,6 +235895,45 @@ ToolsForSign(R:Ring): with
 \begin{chunk}{COQ TOOLSIGN}
 (* package TOOLSIGN *)
 (*
+ 
+    if R is AlgebraicNumber then
+
+      nonQsign r ==
+        sign((r pretend AlgebraicNumber)::Expression(
+                  Integer))$ElementaryFunctionSign(Integer, Expression Integer)
+
+    else
+
+      nonQsign r == "failed"
+ 
+    if R has RetractableTo Fraction Integer then
+
+      sign r ==
+        (u := retractIfCan(r)@Union(Fraction Integer, "failed"))
+          case Fraction(Integer) => sign(u::Fraction Integer)
+        nonQsign r
+ 
+    else
+      if R has RetractableTo Integer then
+
+        sign r ==
+          (u := retractIfCan(r)@Union(Integer, "failed"))
+            case "failed" => "failed"
+          sign(u::Integer)
+ 
+      else
+
+        sign r ==
+          zero? r => 0
+          r = 1 => 1
+          r = -1 => -1
+          "failed"
+ 
+    direction st ==
+      st = "right" => 1
+      st = "left" => -1
+      error "Unknown option"
+
 *)
 
 \end{chunk}
@@ -187546,6 +236145,7 @@ TopLevelDrawFunctions(Ex:Join(ConvertibleTo InputForm,SetCategory)):
       ++ the default title.
 
   Implementation ==> add
+
     import TopLevelDrawFunctionsForCompiledFunctions
     import MakeFloatCompiledFunction(Ex)
     import ParametricPlaneCurve(SF -> SF)
@@ -187733,6 +236333,189 @@ TopLevelDrawFunctions(Ex:Join(ConvertibleTo InputForm,SetCategory)):
 \begin{chunk}{COQ DRAW}
 (* package DRAW *)
 (*
+
+    import TopLevelDrawFunctionsForCompiledFunctions
+    import MakeFloatCompiledFunction(Ex)
+    import ParametricPlaneCurve(SF -> SF)
+    import ParametricSpaceCurve(SF -> SF)
+    import ParametricSurface((SF,SF) -> SF)
+    import ThreeSpace(SF)
+
+------------------------------------------------------------------------
+--                     2D - draw's  (given by formulae)
+------------------------------------------------------------------------
+
+--% Two Dimensional Function Plots
+ 
+    draw(f:Ex,bind:BIND,l:L DROP) ==
+      -- create title if necessary
+      if not option?(l,"title" :: Symbol) then
+        s:String := unparse(convert(f)@InputForm)
+        if sayLength(s)$DisplayPackage > 50 then
+          l := concat(title "AXIOM2D",l)
+        else l := concat(title s,l)
+      -- call 'draw'
+      draw(makeFloatFunction(f,variable bind),segment bind,l)
+ 
+    draw(f:Ex,bind:BIND) == draw(f,bind,nil())
+ 
+--% Parametric Plane Curves
+
+    draw(ppc:PPC,bind:BIND,l:L DROP) ==
+      f := coordinate(ppc,1); g := coordinate(ppc,2)
+      -- create title if necessary
+      if not option?(l,"title" :: Symbol) then
+        s:String := unparse(convert(f)@InputForm)
+        if sayLength(s)$DisplayPackage > 50 then
+          l := concat(title "AXIOM2D",l)
+        else l := concat(title s,l)
+      -- create curve with functions as coordinates
+      curve : PPCF := curve(makeFloatFunction(f,variable bind),_
+                            makeFloatFunction(g,variable bind))$PPCF
+      -- call 'draw'
+      draw(curve,segment bind,l)
+ 
+    draw(ppc:PPC,bind:BIND) == draw(ppc,bind,nil())
+
+------------------------------------------------------------------------
+--                     3D - Curves  (given by formulas)
+------------------------------------------------------------------------
+
+    makeObject(psc:PSC,tBind:BIND,l:L DROP) ==
+      -- obtain dependent variable and coordinate functions
+      t := variable tBind; tSeg := segment tBind
+      f := coordinate(psc,1); g := coordinate(psc,2); h := coordinate(psc,3)
+      -- create title if necessary
+      if not option?(l,"title" :: Symbol) then
+        s:String := unparse(convert(f)@InputForm)
+        if sayLength(s)$DisplayPackage > 50 then
+          l := concat(title "AXIOM3D",l)
+        else l := concat(title s,l)
+      -- indicate draw style if necessary
+      if not option?(l,"style" :: Symbol) then
+        l := concat(style unparse(convert(f)@InputForm),l)
+      -- create curve with functions as coordinates
+      curve : PSCF := curve(makeFloatFunction(f,t),_
+                            makeFloatFunction(g,t),_
+                            makeFloatFunction(h,t))
+      -- call 'draw'
+      makeObject(curve,tSeg,l)
+
+    makeObject(psc:PSC,tBind:BIND) ==
+      makeObject(psc,tBind,nil())
+
+    draw(psc:PSC,tBind:BIND,l:L DROP) ==
+      -- obtain dependent variable and coordinate functions
+      t := variable tBind; tSeg := segment tBind
+      f := coordinate(psc,1); g := coordinate(psc,2); h := coordinate(psc,3)
+      -- create title if necessary
+      if not option?(l,"title" :: Symbol) then
+        s:String := unparse(convert(f)@InputForm)
+        if sayLength(s)$DisplayPackage > 50 then
+          l := concat(title "AXIOM3D",l)
+        else l := concat(title s,l)
+      -- indicate draw style if necessary
+      if not option?(l,"style" :: Symbol) then
+        l := concat(style unparse(convert(f)@InputForm),l)
+      -- create curve with functions as coordinates
+      curve : PSCF := curve(makeFloatFunction(f,t),_
+                            makeFloatFunction(g,t),_
+                            makeFloatFunction(h,t))
+      -- call 'draw'
+      draw(curve,tSeg,l)
+
+    draw(psc:PSC,tBind:BIND) ==
+      draw(psc,tBind,nil())
+
+------------------------------------------------------------------------
+--                     3D - Surfaces  (given by formulas)
+------------------------------------------------------------------------
+
+--% Three Dimensional Function Plots
+
+    makeObject(f:Ex,xBind:BIND,yBind:BIND,l:L DROP) ==
+      -- create title if necessary
+      if not option?(l,"title" :: Symbol) then
+        s:String := unparse(convert(f)@InputForm)
+        if sayLength(s)$DisplayPackage > 50 then
+          l := concat(title "AXIOM3D",l)
+        else l := concat(title s,l)
+      -- indicate draw style if necessary
+      if not option?(l,"style" :: Symbol) then
+        l := concat(style unparse(convert(f)@InputForm),l)
+      -- obtain dependent variables and their ranges
+      x := variable xBind; xSeg := segment xBind
+      y := variable yBind; ySeg := segment yBind
+      -- call 'draw'
+      makeObject(makeFloatFunction(f,x,y),xSeg,ySeg,l)
+
+    makeObject(f:Ex,xBind:BIND,yBind:BIND) ==
+      makeObject(f,xBind,yBind,nil())
+
+    draw(f:Ex,xBind:BIND,yBind:BIND,l:L DROP) ==
+      -- create title if necessary
+      if not option?(l,"title" :: Symbol) then
+        s:String := unparse(convert(f)@InputForm)
+        if sayLength(s)$DisplayPackage > 50 then
+          l := concat(title "AXIOM3D",l)
+        else l := concat(title s,l)
+      -- indicate draw style if necessary
+      if not option?(l,"style" :: Symbol) then
+        l := concat(style unparse(convert(f)@InputForm),l)
+      -- obtain dependent variables and their ranges
+      x := variable xBind; xSeg := segment xBind
+      y := variable yBind; ySeg := segment yBind
+      -- call 'draw'
+      draw(makeFloatFunction(f,x,y),xSeg,ySeg,l)
+
+    draw(f:Ex,xBind:BIND,yBind:BIND) ==
+      draw(f,xBind,yBind,nil())
+
+--% parametric surface
+
+    makeObject(s:PSF,uBind:BIND,vBind:BIND,l:L DROP) ==
+      f := coordinate(s,1); g := coordinate(s,2); h := coordinate(s,3)
+      if not option?(l,"title" :: Symbol) then
+        s:String := unparse(convert(f)@InputForm)
+        if sayLength(s)$DisplayPackage > 50 then
+          l := concat(title "AXIOM3D",l)
+        else l := concat(title s,l)
+      if not option?(l,"style" :: Symbol) then
+        l := concat(style unparse(convert(f)@InputForm),l)
+      u := variable uBind; uSeg := segment uBind
+      v := variable vBind; vSeg := segment vBind
+      surf : PSFF := surface(makeFloatFunction(f,u,v),_
+                             makeFloatFunction(g,u,v),_
+                             makeFloatFunction(h,u,v))
+      makeObject(surf,uSeg,vSeg,l)
+
+    makeObject(s:PSF,uBind:BIND,vBind:BIND) ==
+      makeObject(s,uBind,vBind,nil())
+
+    draw(s:PSF,uBind:BIND,vBind:BIND,l:L DROP) ==
+      f := coordinate(s,1); g := coordinate(s,2); h := coordinate(s,3)
+      -- create title if necessary
+      if not option?(l,"title" :: Symbol) then
+        s:String := unparse(convert(f)@InputForm)
+        if sayLength(s)$DisplayPackage > 50 then
+          l := concat(title "AXIOM3D",l)
+        else l := concat(title s,l)
+      -- indicate draw style if necessary
+      if not option?(l,"style" :: Symbol) then
+        l := concat(style unparse(convert(f)@InputForm),l)
+      -- obtain dependent variables and their ranges
+      u := variable uBind; uSeg := segment uBind
+      v := variable vBind; vSeg := segment vBind
+      -- create surface with functions as coordinates
+      surf : PSFF := surface(makeFloatFunction(f,u,v),_
+                             makeFloatFunction(g,u,v),_
+                             makeFloatFunction(h,u,v))
+      -- call 'draw'
+      draw(surf,uSeg,vSeg,l)
+
+    draw(s:PSF,uBind:BIND,vBind:BIND) ==
+      draw(s,uBind,vBind,nil())
+
 *)
 
 \end{chunk}
@@ -187821,6 +236604,7 @@ TopLevelDrawFunctionsForAlgebraicCurves(R,Ex): Exports == Implementation where
       ++ in the plane in which the curve is to sketched.
 
   Implementation ==> add
+
     import ViewportPackage
     import PlaneAlgebraicCurvePlot
     import ViewDefaultsPackage
@@ -187908,6 +236692,89 @@ TopLevelDrawFunctionsForAlgebraicCurves(R,Ex): Exports == Implementation where
 \begin{chunk}{COQ DRAWCURV}
 (* package DRAWCURV *)
 (*
+
+    import ViewportPackage
+    import PlaneAlgebraicCurvePlot
+    import ViewDefaultsPackage
+    import GraphicsDefaults
+    import DrawOptionFunctions0
+    import SegmentFunctions2(RN,F)
+    import SegmentFunctions2(F,RN)
+    import AnyFunctions1(L SEG RN)
+
+    drawToScaleRanges: (SEG F,SEG F) -> L SEG F
+    drawToScaleRanges(xVals,yVals) ==
+      -- warning: assumes window is square
+      xHi := hi xVals; xLo := lo xVals
+      yHi := hi yVals; yLo := lo yVals
+      xDiff := xHi - xLo; yDiff := yHi - yLo
+      pad := abs(yDiff - xDiff)/2
+      yDiff > xDiff =>
+        [segment(xLo - pad,xHi + pad),yVals]
+      [xVals,segment(yLo - pad,yHi + pad)]
+
+    intConvert: R -> I
+    intConvert r ==
+      (nn := retractIfCan(r)@Union(I,"failed")) case "failed" =>
+        error "draw: polynomial must have rational coefficients"
+      nn :: I
+
+    polyEquation: EQ Ex -> P I
+    polyEquation eq ==
+      ff := lhs(eq) - rhs(eq)
+      (r := retractIfCan(ff)@Union(FRAC P R,"failed")) case "failed" =>
+        error "draw: not a polynomial equation"
+      rat := r :: FRAC P R
+      retractIfCan(denom rat)@Union(R,"failed") case "failed" =>
+        error "draw: non-constant denominator"
+      map(intConvert,numer rat)$PolynomialFunctions2(R,I)
+
+    draw(eq,x,y,l) ==
+      -- obtain polynomial equation
+      p := polyEquation eq
+      -- extract ranges from option list
+      floatRange := option(l,"rangeFloat" :: Symbol)
+      ratRange := option(l,"rangeRat" :: Symbol)
+      (floatRange case "failed") and (ratRange case "failed") =>
+        error "draw: you must specify ranges for an implicit plot"
+      ranges : L SEG RN := nil()             -- dummy value
+      floatRanges : L SEG F := nil()         -- dummy value
+      xRange : SEG RN := segment(0,0)        -- dummy value
+      yRange : SEG RN := segment(0,0)        -- dummy value
+      xRangeFloat : SEG F := segment(0,0)    -- dummy value
+      yRangeFloat : SEG F := segment(0,0)    -- dummy value
+      if not ratRange case "failed" then
+        ranges := retract(ratRange :: Any)$ANY1(L SEG RN)
+        not size?(ranges,2) => error "draw: you must specify two ranges"
+        xRange := first ranges; yRange := second ranges
+        xRangeFloat := map((s:RN):F+->convert(s)@Float,xRange)@(SEG F)
+        yRangeFloat := map((s:RN):F+->convert(s)@Float,yRange)@(SEG F)
+        floatRanges := [xRangeFloat,yRangeFloat]
+      else
+        floatRanges := retract(floatRange :: Any)$ANY1(L SEG F)
+        not size?(floatRanges,2) =>
+          error "draw: you must specify two ranges"
+        xRangeFloat := first floatRanges
+        yRangeFloat := second floatRanges
+        xRange := map((s:F):RN+->retract(s)@RN,xRangeFloat)@(SEG RN)
+        yRange := map((s:F):RN+->retract(s)@RN,yRangeFloat)@(SEG RN)
+        ranges := [xRange,yRange]
+      -- create curve plot
+      acplot := makeSketch(p,x,y,xRange,yRange)
+      -- process scaling information
+      if toScale(l,drawToScale()) then
+        scaledRanges := drawToScaleRanges(xRangeFloat,yRangeFloat)
+        -- add scaled ranges to list of options
+        l := concat(ranges scaledRanges,l)
+      else
+        -- add ranges to list of options
+        l := concat(ranges floatRanges,l)
+      -- process color information
+      ptCol := pointColorPalette(l,pointColorDefault())
+      crCol := curveColorPalette(l,lineColorDefault())
+      -- draw
+      drawCurves(listBranches acplot,ptCol,crCol,pointSizeDefault(),l)
+
 *)
 
 \end{chunk}
@@ -188177,29 +237044,454 @@ TopLevelDrawFunctionsForCompiledFunctions():
       ++ recolor(), uninteresting to top level user; exported in order to 
       ++ compile package.
 
-  Implementation ==> add
+  Implementation ==> add
+\end{chunk}
+I have had to work my way around the following bug in the compiler:
+When a local variable is given a mapping as a value, e.g.
+\begin{verbatim}
+   foo : SF -> SF := makeFloatFunction(f,t),
+\end{verbatim}
+the compiler cannot distinguish that local variable from a local
+function defined elsewhere in the package.  Thus, when 'foo' is
+passed to a function, e.g.
+\begin{verbatim}
+  bird := fcn(foo),
+\end{verbatim}
+foo will often be compiled as DRAW;foo rather than foo. This,
+of course, causes a run-time error.
+
+To avoid this problem, local variables are not given mappings as
+values, but rather (singleton) lists of mappings.  The first element
+of the list can always be extracted and everything goes through
+as before.  There is no major loss in efficiency, as the computation
+of points will always dominate the computation time.\\
+\ \ \ \  - cjw,  22 June MCMXC
+\begin{chunk}{package DRAWCFUN TopLevelDrawFunctionsForCompiledFunctions}
+
+    import PLOT
+    import TwoDimensionalPlotClipping
+    import GraphicsDefaults
+    import ViewportPackage
+    import ThreeDimensionalViewport
+    import DrawOptionFunctions0
+    import MakeFloatCompiledFunction(Ex)
+    import MeshCreationRoutinesForThreeDimensions
+    import SegmentFunctions2(SF,Float)
+    import ViewDefaultsPackage
+    import AnyFunctions1(Pt -> Pt)
+    import AnyFunctions1((SF,SF,SF) -> SF)
+    import DrawOptionFunctions0
+    import SPACE3
+
+    EXTOVARERROR : String := _
+      "draw: when specifying function, left hand side must be a variable"
+    SMALLRANGEERROR : String := _
+      "draw: range is in interval with only one point"
+    DEPVARERROR : String := _
+      "draw: independent variable appears on lhs of function definition"
+
+------------------------------------------------------------------------
+--                     2D - draw's  
+------------------------------------------------------------------------
+
+    drawToScaleRanges: (Segment SF,Segment SF) -> L SEG
+    drawToScaleRanges(xVals,yVals) ==
+      -- warning: assumes window is square
+      xHi := convert(hi xVals)@Float; xLo := convert(lo xVals)@Float
+      yHi := convert(hi yVals)@Float; yLo := convert(lo yVals)@Float
+      xDiff := xHi - xLo; yDiff := yHi - yLo
+      pad := abs(yDiff - xDiff)/2
+      yDiff > xDiff =>
+        [segment(xLo - pad,xHi + pad),map(x +-> convert(x)@Float,yVals)]
+      [map(x +-> convert(x)@Float,xVals),segment(yLo - pad,yHi + pad)]
+
+    drawPlot: (PLOT,L DROP) -> VIEW2
+    drawPlot(plot,l) ==
+      branches := listBranches plot
+      xRange := xRange plot; yRange := yRange plot
+      -- process clipping information
+      if (cl := option(l,"clipSegment" :: Symbol)) case "failed" then
+        if clipBoolean(l,clipPointsDefault()) then
+          clipInfo :=
+            parametric? plot => clipParametric plot
+            clip plot
+          branches := clipInfo.brans
+          xRange := clipInfo.xValues; yRange := clipInfo.yValues
+        else
+          "No explicit user-specified clipping"
+      else
+        segList := retract(cl :: Any)$ANY1(L SEG)
+        empty? segList =>
+          error "draw: you may specify at least 1 segment for 2D clipping"
+        more?(segList,2) =>
+          error "draw: you may specify at most 2 segments for 2D clipping"
+        xLo : SF := 0; xHi : SF := 0; yLo : SF := 0; yHi : SF := 0
+        if empty? rest segList then
+          xLo := lo xRange; xHi := hi xRange
+          yRangeF := first segList
+          yLo := convert(lo yRangeF)@SF; yHi := convert(hi yRangeF)@SF
+        else
+          xRangeF := first segList
+          xLo := convert(lo xRangeF)@SF; xHi := convert(hi xRangeF)@SF
+          yRangeF := second segList
+          yLo := convert(lo yRangeF)@SF; yHi := convert(hi yRangeF)@SF
+        clipInfo := clipWithRanges(branches,xLo,xHi,yLo,yHi)
+        branches := clipInfo.brans
+        xRange := clipInfo.xValues; yRange := clipInfo.yValues
+      -- process scaling information
+      if toScale(l,drawToScale()) then
+        scaledRanges := drawToScaleRanges(xRange,yRange)
+        -- add scaled ranges to list of options
+        l := concat(ranges scaledRanges,l)
+      else
+        xRangeFloat : SEG := map(x +-> convert(x)@Float,xRange)
+        yRangeFloat : SEG := map(x +-> convert(x)@Float,yRange)
+        -- add ranges to list of options
+        l := concat(ranges(ll : L SEG := [xRangeFloat,yRangeFloat]),l)
+      -- process color information
+      ptCol := pointColorPalette(l,pointColorDefault())
+      crCol := curveColorPalette(l,lineColorDefault())
+      -- draw
+      drawCurves(branches,ptCol,crCol,pointSizeDefault(),l)
+
+    normalize: SEG -> Segment SF
+    normalize seg ==
+      -- normalize [a,b]:
+      -- error if a = b, returns [a,b] if a < b, returns [b,a] if b > a
+      a := convert(lo seg)@SF; b := convert(hi seg)@SF
+      a = b => error SMALLRANGEERROR
+      a < b => segment(a,b)
+      segment(b,a)
+
+\end{chunk}
+The function {\tt myTrap1} is a local function for used in creating
+maps SF -> Point SF (two dimensional). The range of this function
+is SingleFloat. As originally coded it would return {\tt \$NaNvalue\$Lisp}
+which is outside the range. Since this function is only used internallly
+by the draw package we handle the ``failed'' case by returning zero.
+We handle the out-of-range case by returning the maximum or minimum
+SingleFloat value.
+\begin{chunk}{package DRAWCFUN TopLevelDrawFunctionsForCompiledFunctions}
+
+    myTrap1: (SF-> SF, SF) -> SF
+    myTrap1(ff:SF-> SF, f:SF):SF ==
+      s := trapNumericErrors(ff(f))$Lisp :: Union(SF, "failed")
+      s case "failed" => 0
+      r:=s::SF
+      r >max()$SF => max()$SF
+      r < min()$SF => min()$SF
+      r
+
+    makePt2: (SF,SF) -> Point SF
+    makePt2(x,y) == point(l : List SF := [x,y])
+
+--% Two Dimensional Function Plots
+ 
+    draw(f:SF -> SF,seg:SEG,l:L DROP) ==
+      -- set adaptive plotting off or on
+      oldAdaptive := adaptive?()$PLOT
+      setAdaptive(adaptive(l,oldAdaptive))$PLOT
+      -- create function SF -> Point SF
+      ff : L(SF -> Point SF) := [x +-> makePt2(myTrap1(f,x),x)]
+      -- process change of coordinates
+      if (c := option(l,"coordinates" :: Symbol)) case "failed" then
+        -- default coordinate transformation
+        ff := [x +-> makePt2(x,myTrap1(f,x))]
+      else
+        cc : L(Pt -> Pt) := [retract(c :: Any)$ANY1(Pt -> Pt)]
+        ff := [x +-> (first cc)((first ff)(x))]
+      -- create PLOT
+      pl := pointPlot(first ff,normalize seg)
+      -- reset adaptive plotting
+      setAdaptive(oldAdaptive)$PLOT
+      -- draw
+      drawPlot(pl,l)
+ 
+    draw(f:SF -> SF,seg:SEG) == draw(f,seg,nil())
+ 
+--% Parametric Plane Curves
+
+    draw(ppc:PPC,seg:SEG,l:L DROP) ==
+      -- set adaptive plotting off or on
+      oldAdaptive := adaptive?()$PLOT
+      setAdaptive(adaptive(l,oldAdaptive))$PLOT
+      -- create function SF -> Point SF
+      f := coordinate(ppc,1); g := coordinate(ppc,2)
+      fcn : L(SF -> Pt) := [x +-> makePt2(myTrap1(f,x),myTrap1(g,x))]
+      -- process change of coordinates
+      if not (c := option(l,"coordinates" :: Symbol)) case "failed" then
+        cc : L(Pt -> Pt) := [retract(c :: Any)$ANY1(Pt -> Pt)]
+        fcn := [x +-> (first cc)((first fcn)(x))]
+      -- create PLOT
+      pl := pointPlot(first fcn,normalize seg)
+      -- reset adaptive plotting
+      setAdaptive(oldAdaptive)$PLOT
+      -- draw
+      drawPlot(pl,l)
+ 
+    draw(ppc:PPC,seg:SEG) == draw(ppc,seg,nil())
+
+------------------------------------------------------------------------
+--                     3D - Curves  
+------------------------------------------------------------------------
+
+--% functions for creation of maps SF -> Point SF (three dimensional)
+
+    makePt4: (SF,SF,SF,SF) -> Point SF
+    makePt4(x,y,z,c) == point(l : List SF := [x,y,z,c])
+
+--% Parametric Space Curves
+
+    id: SF -> SF
+    id x == x
+
+    zCoord: (SF,SF,SF) -> SF
+    zCoord(x,y,z) == z
+
+    colorPoints: (List List Pt,(SF,SF,SF) -> SF) -> List List Pt
+    colorPoints(llp,func) ==
+      for lp in llp repeat for p in lp repeat
+        p.4 := func(p.1,p.2,p.3)
+      llp
+
+    makeObject(psc:PSC,seg:SEG,l:L DROP) ==
+      sp := space l
+      -- obtain dependent variable and coordinate functions
+      f := coordinate(psc,1); g := coordinate(psc,2); h := coordinate(psc,3)
+      -- create function SF -> Point SF with default or user-specified
+      -- color function
+      fcn : L(SF -> Pt) := [x +-> makePt4(myTrap1(f,x),myTrap1(g,x),
+                            myTrap1(h,x), myTrap1(id,x))]
+      pointsColored? : Boolean := false
+      if not (c1 := option(l,"colorFunction1" :: Symbol)) case "failed" then
+        pointsColored? := true
+        fcn := [x +-> makePt4(myTrap1(f,x),myTrap1(g,x),myTrap1(h,x),
+                retract(c1 :: Any)$ANY1(SF -> SF)(x))]
+      -- process change of coordinates
+      if not (c := option(l,"coordinates" :: Symbol)) case "failed" then
+        cc : L(Pt -> Pt) := [retract(c :: Any)$ANY1(Pt -> Pt)]
+        fcn := [x +-> (first cc)((first fcn)(x))]
+      -- create PLOT
+      pl := pointPlot(first fcn,normalize seg)$Plot3D
+      -- create ThreeSpace
+      s := sp
+      -- draw Tube
+      option?(l,"tubeRadius" :: Symbol) =>
+        pts := tubePoints(l,8)
+        rad := convert(tubeRadius(l,0.25))@DoubleFloat
+        tub := tube(pl,rad,pts)$NumericTubePlot(Plot3D)
+        loops := listLoops tub
+        -- color points if this has not been done already
+        if not pointsColored? then
+          if (c3 := option(l,"colorFunction3" :: Symbol)) case "failed"
+            then colorPoints(loops,zCoord)  -- default color function
+            else colorPoints(loops,retract(c3 :: Any)$ANY1((SF,SF,SF) -> SF))
+        mesh(s,loops,false,false)
+        s
+      -- draw curve
+      br := listBranches pl
+      for b in br repeat curve(s,b)
+      s
+
+    makeObject(psc:PCFUN,seg:SEG,l:L DROP) ==
+      sp := space l
+      -- create function SF -> Point SF with default or user-specified
+      -- color function
+      fcn : L(SF -> Pt) := [psc]
+      pointsColored? : Boolean := false
+      if not (c1 := option(l,"colorFunction1" :: Symbol)) case "failed" then
+        pointsColored? := true
+        fcn := [x +-> concat(psc(x), retract(c1 :: Any)$ANY1(SF -> SF)(x))]
+      -- process change of coordinates
+      if not (c := option(l,"coordinates" :: Symbol)) case "failed" then
+        cc : L(Pt -> Pt) := [retract(c :: Any)$ANY1(Pt -> Pt)]
+        fcn := [x +-> (first cc)((first fcn)(x))]
+      -- create PLOT
+      pl := pointPlot(first fcn,normalize seg)$Plot3D
+      -- create ThreeSpace
+      s := sp
+      -- draw Tube
+      option?(l,"tubeRadius" :: Symbol) =>
+        pts := tubePoints(l,8)
+        rad := convert(tubeRadius(l,0.25))@DoubleFloat
+        tub := tube(pl,rad,pts)$NumericTubePlot(Plot3D)
+        loops := listLoops tub
+        -- color points if this has not been done already
+        mesh(s,loops,false,false)
+        s
+      -- draw curve
+      br := listBranches pl
+      for b in br repeat curve(s,b)
+      s
+
+    makeObject(psc:PSC,seg:SEG) ==
+      makeObject(psc,seg,nil())
+
+    makeObject(psc:PCFUN,seg:SEG) ==
+      makeObject(psc,seg,nil())
+
+    draw(psc:PSC,seg:SEG,l:L DROP) ==
+      sp := makeObject(psc,seg,l)
+      makeViewport3D(sp, l)
+
+    draw(psc:PSC,seg:SEG) ==
+      draw(psc,seg,nil())
+
+    draw(psc:PCFUN,seg:SEG,l:L DROP) ==
+      sp := makeObject(psc,seg,l)
+      makeViewport3D(sp, l)
+
+    draw(psc:PCFUN,seg:SEG) ==
+      draw(psc,seg,nil())
+
+------------------------------------------------------------------------
+--                     3D - Surfaces  
+------------------------------------------------------------------------
+
+\end{chunk}
+The function {\tt myTrap2} is a local function for used in creating
+maps SF -> Point SF (three dimensional). The range of this function
+is SingleFloat. As originally coded it would return {\tt \$NaNvalue\$Lisp}
+which is outside the range. Since this function is only used internallly
+by the draw package we handle the ``failed'' case by returning zero.
+We handle the out-of-range case by returning the maximum or minimum
+SingleFloat value.
+\begin{chunk}{package DRAWCFUN TopLevelDrawFunctionsForCompiledFunctions}
+
+    myTrap2: ((SF, SF) -> SF, SF, SF) -> SF
+    myTrap2(ff:(SF, SF) -> SF, u:SF, v:SF):SF ==
+      s := trapNumericErrors(ff(u, v))$Lisp :: Union(SF, "failed")
+      s case "failed" => 0
+      r:SF := s::SF
+      r >max()$SF => max()$SF
+      r < min()$SF => min()$SF
+      r
+
+    recolor(ptFunc,colFunc) ==
+     (f1,f2) +->
+       pt := ptFunc(f1,f2)
+       pt.4 := colFunc(pt.1,pt.2,pt.3)
+       pt
+
+    xCoord: (SF,SF) -> SF
+    xCoord(x,y) == x
+
+--% Three Dimensional Function Plots
+
+    makeObject(f:(SF,SF) -> SF,xSeg:SEG,ySeg:SEG,l:L DROP) ==
+      sp := space l
+      -- process color function of two variables
+      col2 : L((SF,SF) -> SF) := [xCoord]     -- dummy color function
+      pointsColored? : Boolean := false
+      if not (c2 := option(l,"colorFunction2" :: Symbol)) case "failed" then
+        pointsColored? := true
+        col2 := [retract(c2 :: Any)$ANY1((SF,SF) -> SF)]
+      fcn : L((SF,SF) -> Pt) :=
+        [(x,y) +-> makePt4(myTrap2(f,x,y),x,y,(first col2)(x,y))]
+      -- process change of coordinates
+      if (c := option(l,"coordinates" :: Symbol)) case "failed" then
+        -- default coordinate transformation
+        fcn := [(x,y) +-> makePt4(x,y,myTrap2(f,x,y),(first col2)(x,y))]
+      else
+        cc : L(Pt -> Pt) := [retract(c :: Any)$ANY1(Pt -> Pt)]
+        fcn := [(x,y) +-> (first cc)((first fcn)(x,y))]
+      -- process color function of three variables, if there was no
+      -- color function of two variables
+      if not pointsColored? then
+        c := option(l,"colorFunction3" :: Symbol)
+        fcn := 
+          c case "failed" => [recolor((first fcn),zCoord)]
+          [recolor((first fcn),retract(c :: Any)$ANY1((SF,SF,SF) -> SF))]
+      -- create mesh
+      mesh := meshPar2Var(sp,first fcn,normalize xSeg,normalize ySeg,l)
+      mesh
+
+    makeObject(f:(SF,SF) -> SF,xSeg:SEG,ySeg:SEG) ==
+      makeObject(f,xSeg,ySeg,nil())
+
+    draw(f:(SF,SF) -> SF,xSeg:SEG,ySeg:SEG,l:L DROP) ==
+      sp := makeObject(f, xSeg, ySeg, l)
+      makeViewport3D(sp, l)
+
+    draw(f:(SF,SF) -> SF,xSeg:SEG,ySeg:SEG) ==
+      draw(f,xSeg,ySeg,nil())
+
+--% parametric surface
+
+    makeObject(s:PSF,uSeg:SEG,vSeg:SEG,l:L DROP) ==
+      sp := space l
+      -- create functions from expressions
+      f : L((SF,SF) -> SF) := [coordinate(s,1)]
+      g : L((SF,SF) -> SF) := [coordinate(s,2)]
+      h : L((SF,SF) -> SF) := [coordinate(s,3)]
+      -- process color function of two variables
+      col2 : L((SF,SF) -> SF) := [xCoord]     -- dummy color function
+      pointsColored? : Boolean := false
+      if not (c2 := option(l,"colorFunction2" :: Symbol)) case "failed" then
+        pointsColored? := true
+        col2 := [retract(c2 :: Any)$ANY1((SF,SF) -> SF)]
+      fcn : L((SF,SF) -> Pt) := 
+        [(x,y)+->makePt4(myTrap2((first f),x,y),myTrap2((first g),x,y),
+                  myTrap2((first h),x,y), myTrap2((first col2),x,y))]
+      -- process change of coordinates
+      if not (c := option(l,"coordinates" :: Symbol)) case "failed" then
+        cc : L(Pt -> Pt) := [retract(c :: Any)$ANY1(Pt -> Pt)]
+        fcn := [(x,y) +-> (first cc)((first fcn)(x,y))]
+      -- process color function of three variables, if there was no
+      -- color function of two variables
+      if not pointsColored? then
+        col3 : L((SF,SF,SF) -> SF) := [zCoord]  -- default color function
+        if not (c := option(l,"colorFunction3" :: Symbol)) case "failed" then 
+          col3 := [retract(c :: Any)$ANY1((SF,SF,SF) -> SF)]
+        fcn := [recolor((first fcn),(first col3))]
+      -- create mesh
+      mesh := meshPar2Var(sp,first fcn,normalize uSeg,normalize vSeg,l)
+      mesh
+
+    makeObject(s:PSFUN,uSeg:SEG,vSeg:SEG,l:L DROP) ==
+      sp := space l
+      -- process color function of two variables
+      col2 : L((SF,SF) -> SF) := [xCoord]     -- dummy color function
+      pointsColored? : Boolean := false
+      if not (c2 := option(l,"colorFunction2" :: Symbol)) case "failed" then
+        pointsColored? := true
+        col2 := [retract(c2 :: Any)$ANY1((SF,SF) -> SF)]
+      fcn : L((SF,SF) -> Pt) := 
+        pointsColored? => [(x,y) +-> concat(s(x, y), (first col2)(x, y))]
+        [s]
+      -- process change of coordinates
+      if not (c := option(l,"coordinates" :: Symbol)) case "failed" then
+        cc : L(Pt -> Pt) := [retract(c :: Any)$ANY1(Pt -> Pt)]
+        fcn := [(x,y) +-> (first cc)((first fcn)(x,y))]
+      -- create mesh
+      mesh := meshPar2Var(sp,first fcn,normalize uSeg,normalize vSeg,l)
+      mesh
+
+    makeObject(s:PSF,uSeg:SEG,vSeg:SEG) ==
+      makeObject(s,uSeg,vSeg,nil())
+
+    draw(s:PSF,uSeg:SEG,vSeg:SEG,l:L DROP) ==
+      mesh := makeObject(s,uSeg,vSeg,l)
+      makeViewport3D(mesh,l)
+
+    draw(s:PSF,uSeg:SEG,vSeg:SEG) ==
+      draw(s,uSeg,vSeg,nil())
+ 
+    makeObject(s:PSFUN,uSeg:SEG,vSeg:SEG) ==
+      makeObject(s,uSeg,vSeg,nil())
+
+    draw(s:PSFUN,uSeg:SEG,vSeg:SEG,l:L DROP) ==
+      mesh := makeObject(s,uSeg,vSeg,l)
+      makeViewport3D(mesh,l)
+
+    draw(s:PSFUN,uSeg:SEG,vSeg:SEG) ==
+      draw(s,uSeg,vSeg,nil())
+ 
 \end{chunk}
-I have had to work my way around the following bug in the compiler:
-When a local variable is given a mapping as a value, e.g.
-\begin{verbatim}
-   foo : SF -> SF := makeFloatFunction(f,t),
-\end{verbatim}
-the compiler cannot distinguish that local variable from a local
-function defined elsewhere in the package.  Thus, when 'foo' is
-passed to a function, e.g.
-\begin{verbatim}
-  bird := fcn(foo),
-\end{verbatim}
-foo will often be compiled as DRAW;foo rather than foo. This,
-of course, causes a run-time error.
 
-To avoid this problem, local variables are not given mappings as
-values, but rather (singleton) lists of mappings.  The first element
-of the list can always be extracted and everything goes through
-as before.  There is no major loss in efficiency, as the computation
-of points will always dominate the computation time.\\
-\ \ \ \  - cjw,  22 June MCMXC
-\begin{chunk}{package DRAWCFUN TopLevelDrawFunctionsForCompiledFunctions}
+\begin{chunk}{COQ DRAWCFUN}
+(* package DRAWCFUN *)
+(*
 
     import PLOT
     import TwoDimensionalPlotClipping
@@ -188296,16 +237588,6 @@ of points will always dominate the computation time.\\
       a < b => segment(a,b)
       segment(b,a)
 
-\end{chunk}
-The function {\tt myTrap1} is a local function for used in creating
-maps SF -> Point SF (two dimensional). The range of this function
-is SingleFloat. As originally coded it would return {\tt \$NaNvalue\$Lisp}
-which is outside the range. Since this function is only used internallly
-by the draw package we handle the ``failed'' case by returning zero.
-We handle the out-of-range case by returning the maximum or minimum
-SingleFloat value.
-\begin{chunk}{package DRAWCFUN TopLevelDrawFunctionsForCompiledFunctions}
-
     myTrap1: (SF-> SF, SF) -> SF
     myTrap1(ff:SF-> SF, f:SF):SF ==
       s := trapNumericErrors(ff(f))$Lisp :: Union(SF, "failed")
@@ -188409,7 +237691,6 @@ SingleFloat value.
       -- create ThreeSpace
       s := sp
       -- draw Tube
---      print(pl::OutputForm)
       option?(l,"tubeRadius" :: Symbol) =>
         pts := tubePoints(l,8)
         rad := convert(tubeRadius(l,0.25))@DoubleFloat
@@ -188482,16 +237763,6 @@ SingleFloat value.
 --                     3D - Surfaces  
 ------------------------------------------------------------------------
 
-\end{chunk}
-The function {\tt myTrap2} is a local function for used in creating
-maps SF -> Point SF (three dimensional). The range of this function
-is SingleFloat. As originally coded it would return {\tt \$NaNvalue\$Lisp}
-which is outside the range. Since this function is only used internallly
-by the draw package we handle the ``failed'' case by returning zero.
-We handle the out-of-range case by returning the maximum or minimum
-SingleFloat value.
-\begin{chunk}{package DRAWCFUN TopLevelDrawFunctionsForCompiledFunctions}
-
     myTrap2: ((SF, SF) -> SF, SF, SF) -> SF
     myTrap2(ff:(SF, SF) -> SF, u:SF, v:SF):SF ==
       s := trapNumericErrors(ff(u, v))$Lisp :: Union(SF, "failed")
@@ -188605,7 +237876,6 @@ SingleFloat value.
       makeObject(s,uSeg,vSeg,nil())
 
     draw(s:PSF,uSeg:SEG,vSeg:SEG,l:L DROP) ==
-      -- draw
       mesh := makeObject(s,uSeg,vSeg,l)
       makeViewport3D(mesh,l)
 
@@ -188616,18 +237886,12 @@ SingleFloat value.
       makeObject(s,uSeg,vSeg,nil())
 
     draw(s:PSFUN,uSeg:SEG,vSeg:SEG,l:L DROP) ==
-      -- draw
       mesh := makeObject(s,uSeg,vSeg,l)
       makeViewport3D(mesh,l)
 
     draw(s:PSFUN,uSeg:SEG,vSeg:SEG) ==
       draw(s,uSeg,vSeg,nil())
  
-\end{chunk}
-
-\begin{chunk}{COQ DRAWCFUN}
-(* package DRAWCFUN *)
-(*
 *)
 
 \end{chunk}
@@ -188768,6 +238032,37 @@ TopLevelDrawFunctionsForPoints(): Exports == Implementation where
 \begin{chunk}{COQ DRAWPT}
 (* package DRAWPT *)
 (*
+
+    draw(lp:L Pt,l:L DROP):VIEW2 ==
+      makeViewport2D(makeGraphImage([lp])$GraphImage,l)$VIEW2
+
+    draw(lp:L Pt):VIEW2 == draw(lp,[])
+
+    draw(lx: L SF, ly: L SF, l:L DROP):VIEW2 ==
+      draw([point([x,y])$Pt for x in lx for y in ly],l)
+
+    draw(lx: L SF, ly: L SF):VIEW2 == draw(lx,ly,[])
+
+    draw(x:L SF,y:L SF,z:L SF):VIEW3 == draw(x,y,z,[])
+
+    draw(x:L SF,y:L SF,z:L SF,l:L DROP):VIEW3 ==
+      m  : Integer := #x
+      zero? m => error "No X values"
+      n  : Integer := #y
+      zero? n => error "No Y values"
+      zLen : Integer := #z
+      zLen ~= (m*n) => 
+        zLen > (m*n) => error "Too many Z-values to fit grid"
+        error "Not enough Z-values to fit grid"
+      points : L L Pt := []
+      for j in n..1 by -1 repeat
+        row : L Pt := []
+        for i in m..1 by -1 repeat
+          zval := (j-1)*m+i
+          row := cons(point([x.i,y.j,z.zval,z.zval]),row)
+        points := cons(row,points)
+      makeViewport3D(mesh points,l)
+
 *)
 
 \end{chunk}
@@ -188835,6 +238130,7 @@ TopLevelThreeSpace(): with
       ++ createThreeSpace() creates a \spadtype{ThreeSpace(DoubleFloat)} object 
       ++ capable of holding point, curve, mesh components and any combination.
   == add
+
     createThreeSpace() == create3Space()$ThreeSpace(DoubleFloat)
 
 \end{chunk}
@@ -188842,6 +238138,9 @@ TopLevelThreeSpace(): with
 \begin{chunk}{COQ TOPSP}
 (* package TOPSP *)
 (*
+
+    createThreeSpace() == create3Space()$ThreeSpace(DoubleFloat)
+
 *)
 
 \end{chunk}
@@ -188924,15 +238223,16 @@ TranscendentalHermiteIntegration(F, UP): Exports == Implementation where
          ++ D is the derivation to use on \spadtype{UP}.
 
   Implementation ==> add
+
     import MonomialExtensionTools(F, UP)
 
-    normalHermiteIntegrate: (RF,UP->UP) -> Record(answer:RF,lognum:UP,logden:UP)
+    normalHermiteIntegrate:(RF,UP->UP) -> Record(answer:RF,lognum:UP,logden:UP)
 
     HermiteIntegrate(f, derivation) ==
       rec := decompose(f, derivation)
       hi  := normalHermiteIntegrate(rec.normal, derivation)
       qr  := divide(hi.lognum, hi.logden)
-      [hi.answer, qr.remainder / hi.logden, rec.special, qr.quotient + rec.poly]
+      [hi.answer, qr.remainder / hi.logden, rec.special,qr.quotient + rec.poly]
 
 -- Hermite Reduction on f, every squarefree factor of denom(f) is normal wrt D
 -- this is really a "parallel" Hermite reduction, in the sense that
@@ -188964,6 +238264,42 @@ TranscendentalHermiteIntegration(F, UP): Exports == Implementation where
 \begin{chunk}{COQ INTHERTR}
 (* package INTHERTR *)
 (*
+
+    import MonomialExtensionTools(F, UP)
+
+    normalHermiteIntegrate:(RF,UP->UP) -> Record(answer:RF,lognum:UP,logden:UP)
+
+    HermiteIntegrate(f, derivation) ==
+      rec := decompose(f, derivation)
+      hi  := normalHermiteIntegrate(rec.normal, derivation)
+      qr  := divide(hi.lognum, hi.logden)
+      [hi.answer, qr.remainder / hi.logden, rec.special,qr.quotient + rec.poly]
+
+-- Hermite Reduction on f, every squarefree factor of denom(f) is normal wrt D
+-- this is really a "parallel" Hermite reduction, in the sense that
+-- every multiple factor of the denominator gets reduced at each pass
+-- so if the denominator is P1 P2**2 ... Pn**n, this requires O(n)
+-- reduction steps instead of O(n**2), like Mack's algorithm
+-- (D.Mack, On Rational Integration, Univ. of Utah C.S. Tech.Rep. UCP-38,1975)
+-- returns [g, b, d] s.t. f = g' + b/d and d is squarefree and normal wrt D
+    normalHermiteIntegrate(f, derivation) ==
+      a := numer f
+      q := denom f
+      p:UP    := 0
+      mult:UP := 1
+      qhat := (q exquo (g0 := g := gcd(q, differentiate q)))::UP
+      while(degree(qbar := g) > 0) repeat
+        qbarhat := (qbar exquo (g := gcd(qbar, differentiate qbar)))::UP
+        qtil:= - ((qhat * (derivation qbar)) exquo qbar)::UP
+        bc :=
+         extendedEuclidean(qtil, qbarhat, a)::Record(coef1:UP, coef2:UP)
+        qr := divide(bc.coef1, qbarhat)
+        a  := bc.coef2 + qtil * qr.quotient - derivation(qr.remainder)
+               * (qhat exquo qbarhat)::UP
+        p  := p + mult * qr.remainder
+        mult:= mult * qbarhat
+      [p / g0, a, qhat]
+
 *)
 
 \end{chunk}
@@ -189153,6 +238489,7 @@ TranscendentalIntegration(F, UP): Exports == Implementation where
       ++ Error if \spad{degree(t') < 2}.
 
   Implementation ==> add
+
     import SubResultantPackage(UP, UP2)
     import MonomialExtensionTools(F, UP)
     import TranscendentalHermiteIntegration(F, UP)
@@ -189210,7 +238547,6 @@ TranscendentalIntegration(F, UP): Exports == Implementation where
              UP22UPR swap primitivePart(resultvec(term.exponent),term.factor)]
                      for term in factors(rec.special)]
       dlog :=
---           one? derivation x => r.logpart
            ((derivation x) = 1) => r.logpart
            differentiate(mkAnswer(0, logs, empty()),
                          (x1:RF):RF +-> differentiate(x1, derivation))
@@ -189293,7 +238629,6 @@ TranscendentalIntegration(F, UP): Exports == Implementation where
       num := numer f
       den := denom f
       l1:List Record(logand2:RF, contrib:UP) :=
---        [[u, numer v] for u in lu | one? denom(v := den * logderiv u)]
         [[u, numer v] for u in lu | (denom(v := den * logderiv u) = 1)]
       rows := max(degree den,
                   1 + reduce(max, [degree(u.contrib) for u in l1], 0)$List(N))
@@ -189382,7 +238717,7 @@ TranscendentalIntegration(F, UP): Exports == Implementation where
             (((degree numer f)::Z - (degree denom f)::Z) * eta')::UP::RF
 
     notelementary rec ==
-      rec.ir + integral(rec.polypart::RF + rec.specpart, monomial(1,1)$UP :: RF)
+      rec.ir + integral(rec.polypart::RF + rec.specpart, monomial(1,1)$UP:: RF)
 
 -- returns
 --   (g in IR, a in F)  st f = g'+ a, and a=0 or a has no integral in UP
@@ -189499,6 +238834,346 @@ TranscendentalIntegration(F, UP): Exports == Implementation where
 \begin{chunk}{COQ INTTR}
 (* package INTTR *)
 (*
+
+    import SubResultantPackage(UP, UP2)
+    import MonomialExtensionTools(F, UP)
+    import TranscendentalHermiteIntegration(F, UP)
+    import CommuteUnivariatePolynomialCategory(F, UP, UP2)
+
+    primintegratepoly  : (UP, F -> UF, F) -> Union(UPF, UPUP)
+    expintegratepoly   : (GP, (Z, F) -> PSOL) -> Union(GPF, GPGP)
+    expextintfrac      : (RF, UP -> UP, RF) -> Union(FFR, "failed")
+    explimintfrac      : (RF, UP -> UP, List RF) -> Union(NL, "failed")
+    limitedLogs        : (RF, RF -> RF, List RF) -> Union(LLG, "failed")
+    logprmderiv        : (RF, UP -> UP)    -> RF
+    logexpderiv        : (RF, UP -> UP, F) -> RF
+    tanintegratespecial: (RF, RF -> RF, (Z, F, F) -> UF2) -> Union(RFF, RFRF)
+    UP2UP2             : UP -> UP2
+    UP2UPR             : UP -> UPR
+    UP22UPR            : UP2 -> UPR
+    notelementary      : REC -> IR
+    kappa              : (UP, UP -> UP) -> UP
+
+    dummy:RF := 0
+
+    logprmderiv(f, derivation) == differentiate(f, derivation) / f
+
+    UP2UP2 p ==
+      map(x+->x::UP, p)$UnivariatePolynomialCategoryFunctions2(F, UP, UP, UP2)
+
+    UP2UPR p ==
+      map(x+->x::UP::RF,p)$UnivariatePolynomialCategoryFunctions2(F,UP,RF,UPR)
+
+    UP22UPR p == 
+      map(x+->x::RF, p)$SparseUnivariatePolynomialFunctions2(UP, RF)
+
+-- given p in k[z] and a derivation on k[t] returns the coefficient lifting
+-- in k[z] of the restriction of D to k.
+    kappa(p, derivation) ==
+      ans:UP := 0
+      while p ^= 0 repeat
+        ans := ans + derivation(leadingCoefficient(p)::UP)*monomial(1,degree p)
+        p := reductum p
+      ans
+
+-- works in any monomial extension
+    monomialIntegrate(f, derivation) ==
+      zero? f => [0, 0, 0]
+      r := HermiteIntegrate(f, derivation)
+      zero?(inum := numer(r.logpart)) => [r.answer::IR, r.specpart, r.polypart]
+      iden  := denom(r.logpart)
+      x := monomial(1, 1)$UP
+      resultvec := subresultantVector(UP2UP2 inum -
+                               (x::UP2) * UP2UP2 derivation iden, UP2UP2 iden)
+      respoly := primitivePart leadingCoefficient resultvec 0
+      rec := splitSquarefree(respoly, x1 +-> kappa(x1, derivation))
+      logs:List(LOG) := [
+            [1, UP2UPR(term.factor),
+             UP22UPR swap primitivePart(resultvec(term.exponent),term.factor)]
+                     for term in factors(rec.special)]
+      dlog :=
+           ((derivation x) = 1) => r.logpart
+           differentiate(mkAnswer(0, logs, empty()),
+                         (x1:RF):RF +-> differentiate(x1, derivation))
+      (u := retractIfCan(p := r.logpart - dlog)@Union(UP, "failed")) case UP =>
+        [mkAnswer(r.answer, logs, empty), r.specpart, r.polypart + u::UP]
+      [mkAnswer(r.answer, logs, [[p, dummy]]), r.specpart, r.polypart]
+
+-- returns [q, r] such that p = q' + r and degree(r) < degree(dt)
+-- must have degree(derivation t) >= 2
+    monomialIntPoly(p, derivation) ==
+      (d := degree(dt := derivation monomial(1,1))::Z) < 2 =>
+        error "monomIntPoly: monomial must have degree 2 or more"
+      l := leadingCoefficient dt
+      ans:UP := 0
+      while (n := 1 + degree(p)::Z - d) > 0 repeat
+        ans := ans + (term := monomial(leadingCoefficient(p) / (n * l), n::N))
+        p   := p - derivation term      -- degree(p) must drop here
+      [ans, p]
+
+-- returns either
+--   (q in GP, a in F)  st p = q' + a, and a=0 or a has no integral in F
+-- or (q in GP, r in GP) st p = q' + r, and r has no integral elem/UP
+    expintegratepoly(p, FRDE) ==
+      coef0:F := 0
+      notelm := answr := 0$GP
+      while p ^= 0 repeat
+        ans1 := FRDE(n := degree p, a := leadingCoefficient p)
+        answr := answr + monomial(ans1.ans, n)
+        if ~ans1.sol? then         -- Risch d.e. has no complete solution
+               missing := a - ans1.right
+               if zero? n then coef0 := missing
+                          else notelm := notelm + monomial(missing, n)
+        p   := reductum p
+      zero? notelm => [answr, coef0]
+      [answr, notelm]
+
+-- f is either 0 or of the form p(t)/(1 + t**2)**n
+-- returns either
+--   (q in RF, a in F)  st f = q' + a, and a=0 or a has no integral in F
+-- or (q in RF, r in RF) st f = q' + r, and r has no integral elem/UP
+    tanintegratespecial(f, derivation, FRDE) ==
+      ans:RF := 0
+      p := monomial(1, 2)$UP + 1
+      while (n := degree(denom f) quo 2) ^= 0 repeat
+        r := numer(f) rem p
+        a := coefficient(r, 1)
+        b := coefficient(r, 0)
+        (u := FRDE(n, a, b)) case "failed" => return [ans, f]
+        l := u::List(F)
+        term:RF := (monomial(first l, 1)$UP + second(l)::UP) / denom f
+        ans := ans + term
+        f   := f - derivation term    -- the order of the pole at 1+t^2 drops
+      zero?(c0 := retract(retract(f)@UP)@F) or
+        (u := FRDE(0, c0, 0)) case "failed" => [ans, c0]
+      [ans + first(u::List(F))::UP::RF, 0::F]
+
+-- returns (v in RF, c in RF) s.t. f = v' + cg, and c' = 0, or "failed"
+-- g must have a squarefree denominator (always possible)
+-- g must have no polynomial part and no pole above t = 0
+-- f must have no polynomial part and no pole above t = 0
+    expextintfrac(f, derivation, g) ==
+      zero? f => [0, 0]
+      degree numer f >= degree denom f => error "Not a proper fraction"
+      order(denom f,monomial(1,1)) ^= 0 => error "Not integral at t = 0"
+      r := HermiteIntegrate(f, derivation)
+      zero? g =>
+        r.logpart ^= 0 => "failed"
+        [r.answer, 0]
+      degree numer g >= degree denom g => error "Not a proper fraction"
+      order(denom g,monomial(1,1)) ^= 0 => error "Not integral at t = 0"
+      differentiate(c := r.logpart / g, derivation) ^= 0 => "failed"
+      [r.answer, c]
+
+    limitedLogs(f, logderiv, lu) ==
+      zero? f => empty()
+      empty? lu => "failed"
+      empty? rest lu =>
+        logderiv(c0 := f / logderiv(u0 := first lu)) ^= 0 => "failed"
+        [[c0, u0]]
+      num := numer f
+      den := denom f
+      l1:List Record(logand2:RF, contrib:UP) :=
+        [[u, numer v] for u in lu | (denom(v := den * logderiv u) = 1)]
+      rows := max(degree den,
+                  1 + reduce(max, [degree(u.contrib) for u in l1], 0)$List(N))
+      m:Matrix(F) := zero(rows, cols := 1 + #l1)
+      for i in 0..rows-1 repeat
+        for pp in l1 for j in minColIndex m .. maxColIndex m - 1 repeat
+          qsetelt_!(m, i + minRowIndex m, j, coefficient(pp.contrib, i))
+        qsetelt_!(m,i+minRowIndex m, maxColIndex m, coefficient(num, i))
+      m := rowEchelon m
+      ans := empty()$LLG
+      for i in minRowIndex m .. maxRowIndex m |
+       qelt(m, i, maxColIndex m) ^= 0 repeat
+        OK := false
+        for pp in l1 for j in minColIndex m .. maxColIndex m - 1
+         while not OK repeat
+          if qelt(m, i, j) ^= 0 then
+            OK := true
+            c := qelt(m, i, maxColIndex m) / qelt(m, i, j)
+            logderiv(c0 := c::UP::RF) ^= 0 => return "failed"
+            ans := concat([c0, pp.logand2], ans)
+        not OK => return "failed"
+      ans
+
+-- returns q in UP s.t. p = q', or "failed"
+    primintfldpoly(p, extendedint, t') ==
+      (u := primintegratepoly(p, extendedint, t')) case UPUP => "failed"
+      u.a0 ^= 0 => "failed"
+      u.answer
+
+-- returns q in GP st p = q', or "failed"
+    expintfldpoly(p, FRDE) ==
+      (u := expintegratepoly(p, FRDE)) case GPGP => "failed"
+      u.a0 ^= 0 => "failed"
+      u.answer
+
+-- returns (v in RF, c1...cn in RF, a in F) s.t. ci' = 0,
+-- and f = v' + a + +/[ci * ui'/ui]
+--                                  and a = 0 or a has no integral in UP
+    primlimitedint(f, derivation, extendedint, lu) ==
+      qr := divide(numer f, denom f)
+      (u1 := primlimintfrac(qr.remainder / (denom f), derivation, lu))
+        case "failed" => "failed"
+      (u2 := primintegratepoly(qr.quotient, extendedint,
+               retract derivation monomial(1, 1))) case UPUP => "failed"
+      [[u1.mainpart + u2.answer::RF, u1.limitedlogs], u2.a0]
+
+-- returns (v in RF, c1...cn in RF, a in F) s.t. ci' = 0,
+-- and f = v' + a + +/[ci * ui'/ui]
+--                                   and a = 0 or a has no integral in F
+    explimitedint(f, derivation, FRDE, lu) ==
+      qr := separate(f)$GP
+      (u1 := explimintfrac(qr.fracPart,derivation, lu)) case "failed" =>
+                                                                "failed"
+      (u2 := expintegratepoly(qr.polyPart, FRDE)) case GPGP => "failed"
+      [[u1.mainpart + convert(u2.answer)@RF, u1.limitedlogs], u2.a0]
+
+-- returns [v, c1...cn] s.t. f = v' + +/[ci * ui'/ui]
+-- f must have no polynomial part (degree numer f < degree denom f)
+    primlimintfrac(f, derivation, lu) ==
+      zero? f => [0, empty()]
+      degree numer f >= degree denom f => error "Not a proper fraction"
+      r := HermiteIntegrate(f, derivation)
+      zero?(r.logpart) => [r.answer, empty()]
+      (u := limitedLogs(r.logpart, x1 +-> logprmderiv(x1, derivation), lu))
+        case "failed" => "failed"
+      [r.answer, u::LLG]
+
+-- returns [v, c1...cn] s.t. f = v' + +/[ci * ui'/ui]
+-- f must have no polynomial part (degree numer f < degree denom f)
+-- f must be integral above t = 0
+    explimintfrac(f, derivation, lu) ==
+      zero? f => [0, empty()]
+      degree numer f >= degree denom f => error "Not a proper fraction"
+      order(denom f, monomial(1,1)) > 0 => error "Not integral at t = 0"
+      r  := HermiteIntegrate(f, derivation)
+      zero?(r.logpart) => [r.answer, empty()]
+      eta' := coefficient(derivation monomial(1, 1), 1)
+      (u := limitedLogs(r.logpart, x1 +-> logexpderiv(x1,derivation,eta'), lu))
+        case "failed" => "failed"
+      [r.answer - eta'::UP *
+        +/[((degree numer(v.logand))::Z - (degree denom(v.logand))::Z) *
+                                            v.coeff for v in u], u::LLG]
+
+    logexpderiv(f, derivation, eta') ==
+      (differentiate(f, derivation) / f) -
+            (((degree numer f)::Z - (degree denom f)::Z) * eta')::UP::RF
+
+    notelementary rec ==
+      rec.ir + integral(rec.polypart::RF + rec.specpart, monomial(1,1)$UP:: RF)
+
+-- returns
+--   (g in IR, a in F)  st f = g'+ a, and a=0 or a has no integral in UP
+    primintegrate(f, derivation, extendedint) ==
+      rec := monomialIntegrate(f, derivation)
+      not elem?(i1 := rec.ir) => [notelementary rec, 0]
+      (u2 := primintegratepoly(rec.polypart, extendedint,
+                        retract derivation monomial(1, 1))) case UPUP =>
+             [i1 + u2.elem::RF::IR
+                 + integral(u2.notelem::RF, monomial(1,1)$UP :: RF), 0]
+      [i1 + u2.answer::RF::IR, u2.a0]
+
+-- returns
+--   (g in IR, a in F)  st f = g' + a, and a = 0 or a has no integral in F
+    expintegrate(f, derivation, FRDE) ==
+      rec := monomialIntegrate(f, derivation)
+      not elem?(i1 := rec.ir) => [notelementary rec, 0]
+-- rec.specpart is either 0 or of the form p(t)/t**n
+      special := rec.polypart::GP +
+                   (numer(rec.specpart)::GP exquo denom(rec.specpart)::GP)::GP
+      (u2 := expintegratepoly(special, FRDE)) case GPGP =>
+        [i1 + convert(u2.elem)@RF::IR + integral(convert(u2.notelem)@RF,
+                                                 monomial(1,1)$UP :: RF), 0]
+      [i1 + convert(u2.answer)@RF::IR, u2.a0]
+
+-- returns
+--   (g in IR, a in F)  st f = g' + a, and a = 0 or a has no integral in F
+    tanintegrate(f, derivation, FRDE) ==
+      rec := monomialIntegrate(f, derivation)
+      not elem?(i1 := rec.ir) => [notelementary rec, 0]
+      r := monomialIntPoly(rec.polypart, derivation)
+      t := monomial(1, 1)$UP
+      c := coefficient(r.polypart, 1) / leadingCoefficient(derivation t)
+      derivation(c::UP) ^= 0 =>
+        [i1 + mkAnswer(r.answer::RF, empty(),
+                       [[r.polypart::RF + rec.specpart, dummy]$NE]), 0]
+      logs:List(LOG) :=
+        zero? c => empty()
+        [[1, monomial(1,1)$UPR - (c/(2::F))::UP::RF::UPR, (1 + t**2)::RF::UPR]]
+      c0 := coefficient(r.polypart, 0)
+      (u := tanintegratespecial(rec.specpart, x+->differentiate(x, derivation),
+       FRDE)) case RFRF =>
+        [i1+mkAnswer(r.answer::RF + u.elem, logs, [[u.notelem,dummy]$NE]), c0]
+      [i1 + mkAnswer(r.answer::RF + u.answer, logs, empty()), u.a0 + c0]
+
+-- returns either (v in RF, c in RF) s.t. f = v' + cg, and c' = 0
+--             or (v in RF, a in F)  s.t. f = v' + a
+--                                  and a = 0 or a has no integral in UP
+    primextendedint(f, derivation, extendedint, g) ==
+      fqr := divide(numer f, denom f)
+      gqr := divide(numer g, denom g)
+      (u1 := primextintfrac(fqr.remainder / (denom f), derivation,
+                   gqr.remainder / (denom g))) case "failed" => "failed"
+      zero?(gqr.remainder) =>
+      -- the following FAIL cannot occur if the primitives are all logs
+         degree(gqr.quotient) > 0 => FAIL
+         (u3 := primintegratepoly(fqr.quotient, extendedint,
+               retract derivation monomial(1, 1))) case UPUP => "failed"
+         [u1.ratpart + u3.answer::RF, u3.a0]
+      (u2 := primintfldpoly(fqr.quotient - retract(u1.coeff)@UP *
+        gqr.quotient, extendedint, retract derivation monomial(1, 1)))
+          case "failed" => "failed"
+      [u2::UP::RF + u1.ratpart, u1.coeff]
+
+-- returns either (v in RF, c in RF) s.t. f = v' + cg, and c' = 0
+--             or (v in RF, a in F)  s.t. f = v' + a
+--                                   and a = 0 or a has no integral in F
+    expextendedint(f, derivation, FRDE, g) ==
+      qf := separate(f)$GP
+      qg := separate g
+      (u1 := expextintfrac(qf.fracPart, derivation, qg.fracPart))
+         case "failed" => "failed"
+      zero?(qg.fracPart) =>
+      --the following FAIL's cannot occur if the primitives are all logs
+        retractIfCan(qg.polyPart)@Union(F,"failed") case "failed"=> FAIL
+        (u3 := expintegratepoly(qf.polyPart,FRDE)) case GPGP => "failed"
+        [u1.ratpart + convert(u3.answer)@RF, u3.a0]
+      (u2 := expintfldpoly(qf.polyPart - retract(u1.coeff)@UP :: GP
+        * qg.polyPart, FRDE)) case "failed" => "failed"
+      [convert(u2::GP)@RF + u1.ratpart, u1.coeff]
+
+-- returns either
+--   (q in UP, a in F)  st p = q'+ a, and a=0 or a has no integral in UP
+-- or (q in UP, r in UP) st p = q'+ r, and r has no integral elem/UP
+    primintegratepoly(p, extendedint, t') ==
+      zero? p => [0, 0$F]
+      ans:UP := 0
+      while (d := degree p) > 0 repeat
+        (ans1 := extendedint leadingCoefficient p) case "failed" =>
+          return([ans, p])
+        p   := reductum p - monomial(d * t' * ans1.ratpart, (d - 1)::N)
+        ans := ans + monomial(ans1.ratpart, d)
+                              + monomial(ans1.coeff / (d + 1)::F, d + 1)
+      (ans1:= extendedint(rp := retract(p)@F)) case "failed" => [ans,rp]
+      [monomial(ans1.coeff, 1) + ans1.ratpart::UP + ans, 0$F]
+
+-- returns (v in RF, c in RF) s.t. f = v' + cg, and c' = 0
+-- g must have a squarefree denominator (always possible)
+-- g must have no polynomial part (degree numer g < degree denom g)
+-- f must have no polynomial part (degree numer f < degree denom f)
+    primextintfrac(f, derivation, g) ==
+      zero? f => [0, 0]
+      degree numer f >= degree denom f => error "Not a proper fraction"
+      r := HermiteIntegrate(f, derivation)
+      zero? g =>
+        r.logpart ^= 0 => "failed"
+        [r.answer, 0]
+      degree numer g >= degree denom g => error "Not a proper fraction"
+      differentiate(c := r.logpart / g, derivation) ^= 0 => "failed"
+      [r.answer, c]
+
 *)
 
 \end{chunk}
@@ -189730,7 +239405,518 @@ TranscendentalManipulations(R, F): Exports == Implementation where
         ++ getting into an infinite loop the transformations are applied
         ++ at most ten times.
 
-  Implementation ==> add
+  Implementation ==> add
+
+    import FactoredFunctions(P)
+    import PolynomialCategoryLifting(IndexedExponents K, K, R, P, F)
+    import
+      PolynomialCategoryQuotientFunctions(IndexedExponents K,K,R,P,F)
+
+    smpexp    : P -> F
+    termexp   : P -> F
+    exlog     : P -> F
+    smplog    : P -> F
+    smpexpand : P -> F
+    smp2htrigs: P -> F
+    kerexpand : K -> F
+    expandpow : K -> F
+    logexpand : K -> F
+    sup2htrigs: (UP, F) -> F
+    supexp    : (UP, F, F, Z) -> F
+    ueval     : (F, String, F -> F) -> F
+    ueval2    : (F, String, F -> F) -> F
+    powersimp : (P, List K) -> F
+    t2t       : F -> F
+    c2t       : F -> F
+    c2s       : F -> F
+    s2c       : F -> F
+    s2c2      : F -> F
+    th2th     : F -> F
+    ch2th     : F -> F
+    ch2sh     : F -> F
+    sh2ch     : F -> F
+    sh2ch2    : F -> F
+    simplify0 : F -> F
+    simplifyLog1 : F -> F
+    logArgs   : List F -> F
+
+    import F
+    import List F
+
+    if R has PatternMatchable R and R has ConvertibleTo Pattern R 
+     and F has ConvertibleTo(Pattern(R)) and F has PatternMatchable R then
+      XX : F := coerce new()$Symbol
+      YY : F := coerce new()$Symbol
+      sinCosRule : RewriteRule(R,R,F) :=
+        rule(cos(XX)*sin(YY),(sin(XX+YY)-sin(XX-YY))/2::F)
+      sinSinRule : RewriteRule(R,R,F) :=
+        rule(sin(XX)*sin(YY),(cos(XX-YY)-cos(XX+YY))/2::F)
+      cosCosRule : RewriteRule(R,R,F) :=
+        rule(cos(XX)*cos(YY),(cos(XX-YY)+cos(XX+YY))/2::F)
+      sinhSum : RewriteRule(R,R,F) :=
+        rule(sinh(XX+YY),(sinh(XX)*cosh(YY)+cosh(XX)*sinh(YY))::F)
+      coshSum : RewriteRule(R,R,F) :=
+        rule(cosh(XX+YY),(cosh(XX)*cosh(YY)+sinh(XX)*sinh(YY))::F)
+      tanhSum : RewriteRule(R,R,F) :=
+        rule(tanh(XX+YY),((tanh(XX)+tanh(YY))/(1+tanh(XX)*tanh(YY)))::F)
+      cothSum : RewriteRule(R,R,F) :=
+        rule(coth(XX+YY),((coth(XX)*coth(YY)+1)/(coth(YY)+coth(XX)))::F)
+      sinhpsinh : RewriteRule(R,R,F) :=
+        rule(sinh(XX)+sinh(YY),(2*sinh(1/2*(XX+YY))*cosh(1/2*(XX-YY)))::F)
+      sinhmsinh : RewriteRule(R,R,F) :=
+        rule(sinh(XX)-sinh(YY),(2*cosh(1/2*(XX+YY))*sinh(1/2*(XX-YY)))::F)
+      coshpcosh : RewriteRule(R,R,F) :=
+        rule(cosh(XX)+cosh(YY),(2*cosh(1/2*(XX+YY))*cosh(1/2*(XX-YY)))::F)
+      coshmcosh : RewriteRule(R,R,F) :=
+        rule(cosh(XX)-cosh(YY),(2*sinh(1/2*(XX+YY))*sinh(1/2*(XX-YY)))::F)
+      expandTrigProducts(e:F):F ==
+        applyRules([sinCosRule,sinSinRule,cosCosRule,
+                    sinhSum,coshSum,tanhSum,cothSum,
+                    sinhpsinh,sinhmsinh,coshpcosh,
+                    coshmcosh],e,10)$ApplyRules(R,R,F)
+
+    logArgs(l:List F):F ==
+      -- This function will take a list of Expressions (implicitly a sum) and
+      -- add them up, combining log terms.  It also replaces n*log(x) by
+      -- log(x^n).
+      import K
+      sum  : F := 0
+      arg  : F := 1
+      for term in l repeat
+        is?(term,"log"::Symbol) =>
+          arg := arg * simplifyLog(first(argument(first(kernels(term)))))
+        -- Now look for multiples, including negative ones.
+        prod : Union(PRODUCT, "failed") := isMult(term)
+        (prod case PRODUCT) and is?(prod.var,"log"::Symbol) =>
+            arg := arg * simplifyLog ((first argument(prod.var))**(prod.coef))
+        sum := sum+term
+      sum+log(arg)
+    
+    simplifyLog(e:F):F ==
+      simplifyLog1(numerator e)/simplifyLog1(denominator e)
+
+    simplifyLog1(e:F):F ==
+      freeOf?(e,"log"::Symbol) => e
+
+      -- Check for n*log(u)
+      prod : Union(PRODUCT, "failed") := isMult(e)
+      (prod case PRODUCT) and is?(prod.var,"log"::Symbol) =>
+        log simplifyLog ((first argument(prod.var))**(prod.coef))
+      
+      termList : Union(List(F),"failed") := isTimes(e)
+      -- I'm using two variables, termList and terms, to work round a
+      -- bug in the old compiler.
+      not (termList case "failed") =>
+        -- We want to simplify each log term in the product and then multiply
+        -- them together.  However, if there is a constant or arithmetic
+        -- expression (i.e. somwthing which looks like a Polynomial) we would
+        -- like to combine it with a log term.
+        terms :List F := [simplifyLog(term) for term in termList::List(F)]
+        exprs :List F := []
+        for i in 1..#terms repeat
+          if retractIfCan(terms.i)@Union(FPR,"failed") case FPR then
+            exprs := cons(terms.i,exprs)
+            terms := delete!(terms,i)
+        if not empty? exprs then
+          foundLog := false
+          i : NonNegativeInteger := 0
+          while (not(foundLog) and (i < #terms)) repeat
+            i := i+1
+            if is?(terms.i,"log"::Symbol) then
+              args : List F := argument(retract(terms.i)@K)
+              setelt(terms,i, log simplifyLog1(first(args)**(*/exprs)))
+              foundLog := true
+          -- The next line deals with a situation which shouldn't occur,
+          -- since we have checked whether we are freeOf log already.
+          if not foundLog then terms := append(exprs,terms)
+        */terms
+    
+      terms : Union(List(F),"failed") := isPlus(e)
+      not (terms case "failed") => logArgs(terms) 
+
+      expt : Union(POW, "failed") := isPower(e)
+      (expt case POW) and not (expt.exponent = 1) =>
+        simplifyLog(expt.val)**(expt.exponent)
+    
+      kers : List K := kernels e
+      not(((#kers) = 1)) => e -- Have a constant
+      kernel(operator first kers,[simplifyLog(u) for u in argument first kers])
+
+
+    if R has RetractableTo Integer then
+      simplify x == rootProduct(simplify0 x)$AlgebraicManipulations(R,F)
+
+    else simplify x == simplify0 x
+
+    expandpow k ==
+      a := expandPower first(arg := argument k)
+      b := expandPower second arg
+      ne:F := (((numer a) = 1) => 1; numer(a)::F ** b)
+      de:F := (((denom a) = 1) => 1; denom(a)::F ** (-b))
+      ne * de
+
+    termexp p ==
+      exponent:F := 0
+      coef := (leadingCoefficient p)::P
+      lpow := select((z:K):Boolean+->is?(z,POWER)$K, lk := variables p)$List(K)
+      for k in lk repeat
+        d := degree(p, k)
+        if is?(k, "exp"::Symbol) then
+          exponent := exponent + d * first argument k
+        else if not is?(k, POWER) then
+          -- Expand arguments to functions as well ... MCD 23/1/97
+          --coef := coef * monomial(1, k, d)
+          coef := coef * 
+           monomial(1, 
+             kernel(operator k,
+               [simplifyExp u for u in argument k], height k), d)
+      coef::F * exp exponent * powersimp(p, lpow)
+
+    expandPower f ==
+      l := select((z:K):Boolean +-> is?(z, POWER)$K, kernels f)$List(K)
+      eval(f, l, [expandpow k for k in l])
+
+-- l is a list of pure powers appearing as kernels in p
+    powersimp(p, l) ==
+      empty? l => 1
+      k := first l                           -- k = a**b
+      a := first(arg := argument k)
+      exponent := degree(p, k) * second arg
+      empty?(lk := select((z:K):Boolean +-> a = first argument z, rest l)) =>
+        (a ** exponent) * powersimp(p, rest l)
+      for k0 in lk repeat
+        exponent := exponent + degree(p, k0) * second argument k0
+      (a ** exponent) * powersimp(p, setDifference(rest l, lk))
+
+    t2t x         == sin(x) / cos(x)
+    c2t x         == cos(x) / sin(x)
+    c2s x         == inv sin x
+    s2c x         == inv cos x
+    s2c2 x        == 1 - cos(x)**2
+    th2th x       == sinh(x) / cosh(x)
+    ch2th x       == cosh(x) / sinh(x)
+    ch2sh x       == inv sinh x
+    sh2ch x       == inv cosh x
+    sh2ch2 x      == cosh(x)**2 - 1
+    ueval(x, s,f) == eval(x, s::Symbol, f)
+    ueval2(x,s,f) == eval(x, s::Symbol, 2, f)
+    cos2sec x     == ueval(x, "cos", (z1:F):F +-> inv sec z1)
+    sin2csc x     == ueval(x, "sin", (z1:F):F +-> inv csc z1)
+    csc2sin x     == ueval(x, "csc", c2s)
+    sec2cos x     == ueval(x, "sec", s2c)
+    tan2cot x     == ueval(x, "tan", (z1:F):F +-> inv cot z1)
+    cot2tan x     == ueval(x, "cot", (z1:F):F +-> inv tan z1)
+    tan2trig x    == ueval(x, "tan", t2t)
+    cot2trig x    == ueval(x, "cot", c2t)
+    cosh2sech x   == ueval(x, "cosh", (z1:F):F +-> inv sech z1)
+    sinh2csch x   == ueval(x, "sinh", (z1:F):F +-> inv csch z1)
+    csch2sinh x   == ueval(x, "csch", ch2sh)
+    sech2cosh x   == ueval(x, "sech", sh2ch)
+    tanh2coth x   == ueval(x, "tanh", (z1:F):F +-> inv coth z1)
+    coth2tanh x   == ueval(x, "coth", (z1:F):F +-> inv tanh z1)
+    tanh2trigh x  == ueval(x, "tanh", th2th)
+    coth2trigh x  == ueval(x, "coth", ch2th)
+    removeCosSq x == ueval2(x, "cos", (z1:F):F +-> 1 - (sin z1)**2)
+    removeSinSq x == ueval2(x, "sin", s2c2)
+    removeCoshSq x== ueval2(x, "cosh", (z1:F):F +-> 1 + (sinh z1)**2)
+    removeSinhSq x== ueval2(x, "sinh", sh2ch2)
+    expandLog x   == smplog(numer x) / smplog(denom x)
+    simplifyExp x == (smpexp numer x) / (smpexp denom x)
+    expand x      == (smpexpand numer x) / (smpexpand denom x)
+    smpexpand p   == map(kerexpand, (r1:R):F +-> r1::F, p)
+    smplog p      == map(logexpand, (r1:R):F +-> r1::F, p)
+    smp2htrigs p  == map((k1:K):F +-> htrigs(k1::F), (r1:R):F +-> r1::F, p)
+
+\end{chunk}
+\subsection{The htrigs function}
+The htrigs function can be used to replace and reduce hyperbolic
+trigonometric identities.
+
+The identity for $sinh(x)$ is $(exp(x) - exp(-x))/2$
+
+If we difference these we should get zero
+\begin{verbatim}
+    f := sinh(x) - (exp(x) - exp(-x))/2
+\end{verbatim}
+instead, by default, we get
+\begin{verbatim}
+                x     -x
+   2sinh(x) - %e  + %e
+   ---------------------
+              2
+\end{verbatim}
+The function htrigs(f) gives 0
+
+This works as follows:
+\begin{verbatim}   
+     m:=mainKernel f => sinh(x)
+                   Type: Union(Kernel(Expression(Integer)),...)
+\end{verbatim}   
+which is coerced to the first part of the union:
+\begin{verbatim}   
+     k:=m::Kernel(Expression(Integer))
+\end{verbatim}   
+and the operator is extracted:
+\begin{verbatim}   
+     op:=operator(k) => sinh
+                              Type: BasicOperator
+\end{verbatim}   
+The argument function extracts the variable used as arguments:
+\begin{verbatim}   
+     argument k ==> [x]
+                              Type Kernel(Expression(Integer))
+\end{verbatim}   
+At this point we have picked apart the main Kernel into its
+operator and its arguments. We now process the list of arguments.
+
+The function htrigs is called on every element of the argument list, 
+which in this case, returns a list:
+\begin{verbatim}   
+     arg:=[htrigs x for x in argument k]$List(Expression(Integer))
+           => [x]
+                       Type: List(Expression(Integer))
+\end{verbatim}   
+We form a polynomial by replacing the kernel in the numerator with ?
+\begin{verbatim}   
+     num := univariate(numer f, k)
+  
+                x      -x
+         2? - %e   + %e
+                        Type: SparseUnivariatePolynomial(
+                                SparseMultivariatePolynomial(
+                                  Integer, Kernel(Expression(Integer))))
+\end{verbatim}   
+and a polynomial of the denominator, replacing the kernel
+\begin{verbatim}   
+     den := univariate(denom f, k)
+  
+        2
+                        Type: SparseUnivariatePolynomial(
+                                SparseMultivariatePolynomial(
+                                  Integer, Kernel(Expression(Integer))))
+\end{verbatim}   
+In this case the op is not the exponential so we are doing straight
+trig substitution. We reconstruct the function call using the op
+and arg values, that is:
+\begin{verbatim}   
+     g1 := op arg ==> sinh(x)
+                                Type: Expression(Integer)
+\end{verbatim}   
+So sup2htrigs, which is a local function, is used to simplify the
+parts of the fraction. In this case, 
+\begin{verbatim}   
+    sup2htrigs(num, g1:= op arg) ==> 0
+                                Type: Expression(Integer)
+
+    sup2htrigs(den, g1) ==> 2
+                                Type: Expression(Integer)
+\end{verbatim}   
+Thus, the result is 0
+
+The identity for $cosh(x)$ is $(exp(x) + exp(-x))/2$
+
+If we difference these we should get zero
+\begin{verbatim}   
+     f := cosh(x) - (%e^x + %e^-x)/2
+\end{verbatim}   
+instead, by default, we get
+\begin{verbatim}   
+         x      - x
+     - %e   + %e    + 2cosh(x)
+     -------------------------
+                  2
+\end{verbatim}   
+and the function call $htrigs(f)$ gives 0
+
+This works as follows:
+\begin{verbatim}   
+                          x
+     m:=mainKernel f => %e
+                         Type: Union(Kernel(Expression(Integer)),...)
+\end{verbatim}   
+which is coerced to the first part of the union:
+\begin{verbatim}   
+                                            x
+     k:=m::Kernel(Expression(Integer)) => %e
+                         Type: Kernel(Expression(Integer))
+\end{verbatim}   
+and the operator is extracted:
+\begin{verbatim}   
+     op:=operator(k) => exp
+                              Type: BasicOperator
+\end{verbatim}   
+The argument function extracts the variable used as arguments:
+\begin{verbatim}   
+     argument k ==> [x]
+                              Type Kernel(Expression(Integer))
+\end{verbatim}   
+At this point we have picked apart the main Kernel into its
+operator and its arguments. We now process the list of arguments.
+
+The htrigs function 
+is called on every element of the argument list, which in this
+case, returns a list:
+\begin{verbatim}   
+     arg:=[htrigs x for x in argument k]$List(Expression(Integer))
+           => [x]
+                       Type: List(Expression(Integer))
+\end{verbatim}   
+We form polynomial by replacing the kernel in the numerator with ?
+\begin{verbatim}   
+     num := univariate(numer f, k)
+  
+               - x
+       - ? - %e    + 2cosh(x)
+                        Type: SparseUnivariatePolynomial(
+                                SparseMultivariatePolynomial(
+                                  Integer, Kernel(Expression(Integer))))
+\end{verbatim}   
+and a polynomial of the denominator, replacing the kernel
+\begin{verbatim}   
+     den := univariate(denom f, k)
+  
+        2
+                        Type: SparseUnivariatePolynomial(
+                                SparseMultivariatePolynomial(
+                                  Integer, Kernel(Expression(Integer))))
+\end{verbatim}   
+In this case, the expression
+\begin{verbatim}   
+     is?(op, "exp"::Symbol) => true
+\end{verbatim}   
+so we form 
+\begin{verbatim}   
+     a  := first arg => x
+                         Type: Expression(Integer)
+\end{verbatim}   
+since we know that 
+\begin{verbatim}   
+                          x
+     cosh(x)+sinh(x) => %e
+\end{verbatim}   
+we can form this use this expression in substitutions
+\begin{verbatim}   
+     g1 := cosh(a)+sinh(a) => sinh(x)+cosh(x)
+                        Type: Expression(Integer)
+\end{verbatim}   
+since we know that 
+\begin{verbatim}   
+                            - x
+     cosh(x)-sinh(x) => - %e
+\end{verbatim}   
+we can form this use this expression in substitutions
+\begin{verbatim}   
+     g2 := cosh(a)-sinh(a) => -sinh(x)+cosh(x)
+                         Type: Expression(Integer)
+   
+     b  := (degree num)::Integer quo 2 => 0
+                         Type: NonNegativeInteger
+\end{verbatim}   
+The supexp function is using the g1 and g2 identities to replace exp(x)
+\begin{verbatim}   
+     supexp(num,g1,g2,b) => sinh(x)-cosh(x)-sinh(x)+2cosh(x)-cosh(x)
+                         Type: Expression(Integer)
+   
+     supexp(den,g1,g2,b) => 2
+                         Type: Expression(Integer)
+\end{verbatim}   
+which is effectively
+\begin{verbatim}   
+     t1/t2 => (sinh(x)-cosh(x)-sinh(x)+2cosh(x)-cosh(x))/2
+                         Type: Expression(Integer)
+\end{verbatim}     
+the last form of which can be rearranged as:
+\begin{verbatim}   
+     (sinh(x)-sinh(x) + 2cosh(x)-cosh(x)-cosh(x) )/2 => 0
+\end{verbatim}   
+so the result is 0
+
+\begin{chunk}{package TRMANIP TranscendentalManipulations}
+    htrigs f ==
+      (m := mainKernel f) case "failed" => f
+      op  := operator(k := m::K)
+      arg := [htrigs x for x in argument k]$List(F)
+      num := univariate(numer f, k)
+      den := univariate(denom f, k)
+      is?(op, "exp"::Symbol) =>
+        g1 := cosh(a := first arg) + sinh(a)
+        g2 := cosh(a) - sinh(a)
+        supexp(num,g1,g2,b:= (degree num)::Z quo 2)/supexp(den,g1,g2,b)
+      sup2htrigs(num, g1:= op arg) / sup2htrigs(den, g1)
+
+    supexp(p, f1, f2, bse) ==
+      ans:F := 0
+      while p ^= 0 repeat
+        g := htrigs(leadingCoefficient(p)::F)
+        if ((d := degree(p)::Z - bse) >= 0) then
+             ans := ans + g * f1 ** d
+        else ans := ans + g * f2 ** (-d)
+        p := reductum p
+      ans
+
+    sup2htrigs(p, f) ==
+      (map(smp2htrigs, p)$SparseUnivariatePolynomialFunctions2(P, F)) f
+
+    exlog p == +/[r.coef * log(r.logand::F) for r in log squareFree p]
+
+    logexpand k ==
+      nullary?(op := operator k) => k::F
+      is?(op, "log"::Symbol) =>
+         exlog(numer(x := expandLog first argument k)) - exlog denom x
+      op [expandLog x for x in argument k]$List(F)
+
+    kerexpand k ==
+      nullary?(op := operator k) => k::F
+      is?(op, POWER) => expandpow k
+      arg := first argument k
+      is?(op, "sec"::Symbol) => inv expand cos arg
+      is?(op, "csc"::Symbol) => inv expand sin arg
+      is?(op, "log"::Symbol) =>
+         exlog(numer(x := expand arg)) - exlog denom x
+      num := numer arg
+      den := denom arg
+      (b := (reductum num) / den) ^= 0 =>
+        a := (leadingMonomial num) / den
+        is?(op, "exp"::Symbol) => exp(expand a) * expand(exp b)
+        is?(op, "sin"::Symbol) =>
+           sin(expand a) * expand(cos b) + cos(expand a) * expand(sin b)
+        is?(op, "cos"::Symbol) =>
+           cos(expand a) * expand(cos b) - sin(expand a) * expand(sin b)
+        is?(op, "tan"::Symbol) =>
+          ta := tan expand a
+          tb := expand tan b
+          (ta + tb) / (1 - ta * tb)
+        is?(op, "cot"::Symbol) =>
+          cta := cot expand a
+          ctb := expand cot b
+          (cta * ctb - 1) / (ctb + cta)
+        op [expand x for x in argument k]$List(F)
+      op [expand x for x in argument k]$List(F)
+
+    smpexp p ==
+      ans:F := 0
+      while p ^= 0 repeat
+        ans := ans + termexp leadingMonomial p
+        p   := reductum p
+      ans
+
+    -- this now works in 3 passes over the expression:
+    --   pass1 rewrites trigs and htrigs in terms of sin,cos,sinh,cosh
+    --   pass2 rewrites sin**2 and sinh**2 in terms of cos and cosh.
+    --   pass3 groups exponentials together
+    simplify0 x ==
+      simplifyExp eval(eval(x,
+          ["tan"::Symbol,"cot"::Symbol,"sec"::Symbol,"csc"::Symbol,
+           "tanh"::Symbol,"coth"::Symbol,"sech"::Symbol,"csch"::Symbol],
+              [t2t,c2t,s2c,c2s,th2th,ch2th,sh2ch,ch2sh]),
+                ["sin"::Symbol, "sinh"::Symbol], [2, 2], [s2c2, sh2ch2])
+
+\end{chunk}
+
+\begin{chunk}{COQ TRMANIP}
+(* package TRMANIP *)
+(*
+
     import FactoredFunctions(P)
     import PolynomialCategoryLifting(IndexedExponents K, K, R, P, F)
     import
@@ -189769,30 +239955,44 @@ TranscendentalManipulations(R, F): Exports == Implementation where
 
     if R has PatternMatchable R and R has ConvertibleTo Pattern R 
      and F has ConvertibleTo(Pattern(R)) and F has PatternMatchable R then
+
       XX : F := coerce new()$Symbol
+
       YY : F := coerce new()$Symbol
+
       sinCosRule : RewriteRule(R,R,F) :=
         rule(cos(XX)*sin(YY),(sin(XX+YY)-sin(XX-YY))/2::F)
+
       sinSinRule : RewriteRule(R,R,F) :=
         rule(sin(XX)*sin(YY),(cos(XX-YY)-cos(XX+YY))/2::F)
+
       cosCosRule : RewriteRule(R,R,F) :=
         rule(cos(XX)*cos(YY),(cos(XX-YY)+cos(XX+YY))/2::F)
+
       sinhSum : RewriteRule(R,R,F) :=
         rule(sinh(XX+YY),(sinh(XX)*cosh(YY)+cosh(XX)*sinh(YY))::F)
+
       coshSum : RewriteRule(R,R,F) :=
         rule(cosh(XX+YY),(cosh(XX)*cosh(YY)+sinh(XX)*sinh(YY))::F)
+
       tanhSum : RewriteRule(R,R,F) :=
         rule(tanh(XX+YY),((tanh(XX)+tanh(YY))/(1+tanh(XX)*tanh(YY)))::F)
+
       cothSum : RewriteRule(R,R,F) :=
         rule(coth(XX+YY),((coth(XX)*coth(YY)+1)/(coth(YY)+coth(XX)))::F)
+
       sinhpsinh : RewriteRule(R,R,F) :=
         rule(sinh(XX)+sinh(YY),(2*sinh(1/2*(XX+YY))*cosh(1/2*(XX-YY)))::F)
+
       sinhmsinh : RewriteRule(R,R,F) :=
         rule(sinh(XX)-sinh(YY),(2*cosh(1/2*(XX+YY))*sinh(1/2*(XX-YY)))::F)
+
       coshpcosh : RewriteRule(R,R,F) :=
         rule(cosh(XX)+cosh(YY),(2*cosh(1/2*(XX+YY))*cosh(1/2*(XX-YY)))::F)
+
       coshmcosh : RewriteRule(R,R,F) :=
         rule(cosh(XX)-cosh(YY),(2*sinh(1/2*(XX+YY))*sinh(1/2*(XX-YY)))::F)
+
       expandTrigProducts(e:F):F ==
         applyRules([sinCosRule,sinSinRule,cosCosRule,
                     sinhSum,coshSum,tanhSum,cothSum,
@@ -189859,16 +240059,13 @@ TranscendentalManipulations(R, F): Exports == Implementation where
       not (terms case "failed") => logArgs(terms) 
 
       expt : Union(POW, "failed") := isPower(e)
---      (expt case POW) and not one? expt.exponent =>
       (expt case POW) and not (expt.exponent = 1) =>
         simplifyLog(expt.val)**(expt.exponent)
     
       kers : List K := kernels e
---      not(one?(#kers)) => e -- Have a constant
       not(((#kers) = 1)) => e -- Have a constant
       kernel(operator first kers,[simplifyLog(u) for u in argument first kers])
 
-
     if R has RetractableTo Integer then
       simplify x == rootProduct(simplify0 x)$AlgebraicManipulations(R,F)
 
@@ -189877,9 +240074,7 @@ TranscendentalManipulations(R, F): Exports == Implementation where
     expandpow k ==
       a := expandPower first(arg := argument k)
       b := expandPower second arg
---      ne:F := (one? numer a => 1; numer(a)::F ** b)
       ne:F := (((numer a) = 1) => 1; numer(a)::F ** b)
---      de:F := (one? denom a => 1; denom(a)::F ** (-b))
       de:F := (((denom a) = 1) => 1; denom(a)::F ** (-b))
       ne * de
 
@@ -189904,7 +240099,7 @@ TranscendentalManipulations(R, F): Exports == Implementation where
       l := select((z:K):Boolean +-> is?(z, POWER)$K, kernels f)$List(K)
       eval(f, l, [expandpow k for k in l])
 
--- l is a list of pure powers appearing as kernels in p
+    -- l is a list of pure powers appearing as kernels in p
     powersimp(p, l) ==
       empty? l => 1
       k := first l                           -- k = a**b
@@ -189917,249 +240112,81 @@ TranscendentalManipulations(R, F): Exports == Implementation where
       (a ** exponent) * powersimp(p, setDifference(rest l, lk))
 
     t2t x         == sin(x) / cos(x)
+
     c2t x         == cos(x) / sin(x)
+
     c2s x         == inv sin x
+
     s2c x         == inv cos x
+
     s2c2 x        == 1 - cos(x)**2
+
     th2th x       == sinh(x) / cosh(x)
+
     ch2th x       == cosh(x) / sinh(x)
+
     ch2sh x       == inv sinh x
+
     sh2ch x       == inv cosh x
+
     sh2ch2 x      == cosh(x)**2 - 1
+
     ueval(x, s,f) == eval(x, s::Symbol, f)
+
     ueval2(x,s,f) == eval(x, s::Symbol, 2, f)
+
     cos2sec x     == ueval(x, "cos", (z1:F):F +-> inv sec z1)
+
     sin2csc x     == ueval(x, "sin", (z1:F):F +-> inv csc z1)
+
     csc2sin x     == ueval(x, "csc", c2s)
+
     sec2cos x     == ueval(x, "sec", s2c)
+
     tan2cot x     == ueval(x, "tan", (z1:F):F +-> inv cot z1)
+
     cot2tan x     == ueval(x, "cot", (z1:F):F +-> inv tan z1)
+
     tan2trig x    == ueval(x, "tan", t2t)
+
     cot2trig x    == ueval(x, "cot", c2t)
+
     cosh2sech x   == ueval(x, "cosh", (z1:F):F +-> inv sech z1)
+
     sinh2csch x   == ueval(x, "sinh", (z1:F):F +-> inv csch z1)
+
     csch2sinh x   == ueval(x, "csch", ch2sh)
+
     sech2cosh x   == ueval(x, "sech", sh2ch)
+
     tanh2coth x   == ueval(x, "tanh", (z1:F):F +-> inv coth z1)
+
     coth2tanh x   == ueval(x, "coth", (z1:F):F +-> inv tanh z1)
+
     tanh2trigh x  == ueval(x, "tanh", th2th)
+
     coth2trigh x  == ueval(x, "coth", ch2th)
-    removeCosSq x == ueval2(x, "cos", (z1:F):F +-> 1 - (sin z1)**2)
-    removeSinSq x == ueval2(x, "sin", s2c2)
-    removeCoshSq x== ueval2(x, "cosh", (z1:F):F +-> 1 + (sinh z1)**2)
-    removeSinhSq x== ueval2(x, "sinh", sh2ch2)
-    expandLog x   == smplog(numer x) / smplog(denom x)
-    simplifyExp x == (smpexp numer x) / (smpexp denom x)
-    expand x      == (smpexpand numer x) / (smpexpand denom x)
-    smpexpand p   == map(kerexpand, (r1:R):F +-> r1::F, p)
-    smplog p      == map(logexpand, (r1:R):F +-> r1::F, p)
-    smp2htrigs p  == map((k1:K):F +-> htrigs(k1::F), (r1:R):F +-> r1::F, p)
 
-\end{chunk}
-\subsection{The htrigs function}
-The htrigs function can be used to replace and reduce hyperbolic
-trigonometric identities.
+    removeCosSq x == ueval2(x, "cos", (z1:F):F +-> 1 - (sin z1)**2)
 
-The identity for $sinh(x)$ is $(exp(x) - exp(-x))/2$
+    removeSinSq x == ueval2(x, "sin", s2c2)
 
-If we difference these we should get zero
-\begin{verbatim}
-    f := sinh(x) - (exp(x) - exp(-x))/2
-\end{verbatim}
-instead, by default, we get
-\begin{verbatim}
-                x     -x
-   2sinh(x) - %e  + %e
-   ---------------------
-              2
-\end{verbatim}
-The function htrigs(f) gives 0
+    removeCoshSq x== ueval2(x, "cosh", (z1:F):F +-> 1 + (sinh z1)**2)
 
-This works as follows:
-\begin{verbatim}   
-     m:=mainKernel f => sinh(x)
-                   Type: Union(Kernel(Expression(Integer)),...)
-\end{verbatim}   
-which is coerced to the first part of the union:
-\begin{verbatim}   
-     k:=m::Kernel(Expression(Integer))
-\end{verbatim}   
-and the operator is extracted:
-\begin{verbatim}   
-     op:=operator(k) => sinh
-                              Type: BasicOperator
-\end{verbatim}   
-The argument function extracts the variable used as arguments:
-\begin{verbatim}   
-     argument k ==> [x]
-                              Type Kernel(Expression(Integer))
-\end{verbatim}   
-At this point we have picked apart the main Kernel into its
-operator and its arguments. We now process the list of arguments.
+    removeSinhSq x== ueval2(x, "sinh", sh2ch2)
 
-The function htrigs is called on every element of the argument list, 
-which in this case, returns a list:
-\begin{verbatim}   
-     arg:=[htrigs x for x in argument k]$List(Expression(Integer))
-           => [x]
-                       Type: List(Expression(Integer))
-\end{verbatim}   
-We form a polynomial by replacing the kernel in the numerator with ?
-\begin{verbatim}   
-     num := univariate(numer f, k)
-  
-                x      -x
-         2? - %e   + %e
-                        Type: SparseUnivariatePolynomial(
-                                SparseMultivariatePolynomial(
-                                  Integer, Kernel(Expression(Integer))))
-\end{verbatim}   
-and a polynomial of the denominator, replacing the kernel
-\begin{verbatim}   
-     den := univariate(denom f, k)
-  
-        2
-                        Type: SparseUnivariatePolynomial(
-                                SparseMultivariatePolynomial(
-                                  Integer, Kernel(Expression(Integer))))
-\end{verbatim}   
-In this case the op is not the exponential so we are doing straight
-trig substitution. We reconstruct the function call using the op
-and arg values, that is:
-\begin{verbatim}   
-     g1 := op arg ==> sinh(x)
-                                Type: Expression(Integer)
-\end{verbatim}   
-So sup2htrigs, which is a local function, is used to simplify the
-parts of the fraction. In this case, 
-\begin{verbatim}   
-    sup2htrigs(num, g1:= op arg) ==> 0
-                                Type: Expression(Integer)
+    expandLog x   == smplog(numer x) / smplog(denom x)
 
-    sup2htrigs(den, g1) ==> 2
-                                Type: Expression(Integer)
-\end{verbatim}   
-Thus, the result is 0
+    simplifyExp x == (smpexp numer x) / (smpexp denom x)
 
-The identity for $cosh(x)$ is $(exp(x) + exp(-x))/2$
+    expand x      == (smpexpand numer x) / (smpexpand denom x)
 
-If we difference these we should get zero
-\begin{verbatim}   
-     f := cosh(x) - (%e^x + %e^-x)/2
-\end{verbatim}   
-instead, by default, we get
-\begin{verbatim}   
-         x      - x
-     - %e   + %e    + 2cosh(x)
-     -------------------------
-                  2
-\end{verbatim}   
-and the function call $htrigs(f)$ gives 0
+    smpexpand p   == map(kerexpand, (r1:R):F +-> r1::F, p)
 
-This works as follows:
-\begin{verbatim}   
-                          x
-     m:=mainKernel f => %e
-                         Type: Union(Kernel(Expression(Integer)),...)
-\end{verbatim}   
-which is coerced to the first part of the union:
-\begin{verbatim}   
-                                            x
-     k:=m::Kernel(Expression(Integer)) => %e
-                         Type: Kernel(Expression(Integer))
-\end{verbatim}   
-and the operator is extracted:
-\begin{verbatim}   
-     op:=operator(k) => exp
-                              Type: BasicOperator
-\end{verbatim}   
-The argument function extracts the variable used as arguments:
-\begin{verbatim}   
-     argument k ==> [x]
-                              Type Kernel(Expression(Integer))
-\end{verbatim}   
-At this point we have picked apart the main Kernel into its
-operator and its arguments. We now process the list of arguments.
+    smplog p      == map(logexpand, (r1:R):F +-> r1::F, p)
 
-The htrigs function 
-is called on every element of the argument list, which in this
-case, returns a list:
-\begin{verbatim}   
-     arg:=[htrigs x for x in argument k]$List(Expression(Integer))
-           => [x]
-                       Type: List(Expression(Integer))
-\end{verbatim}   
-We form polynomial by replacing the kernel in the numerator with ?
-\begin{verbatim}   
-     num := univariate(numer f, k)
-  
-               - x
-       - ? - %e    + 2cosh(x)
-                        Type: SparseUnivariatePolynomial(
-                                SparseMultivariatePolynomial(
-                                  Integer, Kernel(Expression(Integer))))
-\end{verbatim}   
-and a polynomial of the denominator, replacing the kernel
-\begin{verbatim}   
-     den := univariate(denom f, k)
-  
-        2
-                        Type: SparseUnivariatePolynomial(
-                                SparseMultivariatePolynomial(
-                                  Integer, Kernel(Expression(Integer))))
-\end{verbatim}   
-In this case, the expression
-\begin{verbatim}   
-     is?(op, "exp"::Symbol) => true
-\end{verbatim}   
-so we form 
-\begin{verbatim}   
-     a  := first arg => x
-                         Type: Expression(Integer)
-\end{verbatim}   
-since we know that 
-\begin{verbatim}   
-                          x
-     cosh(x)+sinh(x) => %e
-\end{verbatim}   
-we can form this use this expression in substitutions
-\begin{verbatim}   
-     g1 := cosh(a)+sinh(a) => sinh(x)+cosh(x)
-                        Type: Expression(Integer)
-\end{verbatim}   
-since we know that 
-\begin{verbatim}   
-                            - x
-     cosh(x)-sinh(x) => - %e
-\end{verbatim}   
-we can form this use this expression in substitutions
-\begin{verbatim}   
-     g2 := cosh(a)-sinh(a) => -sinh(x)+cosh(x)
-                         Type: Expression(Integer)
-   
-     b  := (degree num)::Integer quo 2 => 0
-                         Type: NonNegativeInteger
-\end{verbatim}   
-The supexp function is using the g1 and g2 identities to replace exp(x)
-\begin{verbatim}   
-     supexp(num,g1,g2,b) => sinh(x)-cosh(x)-sinh(x)+2cosh(x)-cosh(x)
-                         Type: Expression(Integer)
-   
-     supexp(den,g1,g2,b) => 2
-                         Type: Expression(Integer)
-\end{verbatim}   
-which is effectively
-\begin{verbatim}   
-     t1/t2 => (sinh(x)-cosh(x)-sinh(x)+2cosh(x)-cosh(x))/2
-                         Type: Expression(Integer)
-\end{verbatim}     
-the last form of which can be rearranged as:
-\begin{verbatim}   
-     (sinh(x)-sinh(x) + 2cosh(x)-cosh(x)-cosh(x) )/2 => 0
-\end{verbatim}   
-so the result is 0
+    smp2htrigs p  == map((k1:K):F +-> htrigs(k1::F), (r1:R):F +-> r1::F, p)
 
-\begin{chunk}{package TRMANIP TranscendentalManipulations}
     htrigs f ==
       (m := mainKernel f) case "failed" => f
       op  := operator(k := m::K)
@@ -190239,11 +240266,6 @@ so the result is 0
               [t2t,c2t,s2c,c2s,th2th,ch2th,sh2ch,ch2sh]),
                 ["sin"::Symbol, "sinh"::Symbol], [2, 2], [s2c2, sh2ch2])
 
-\end{chunk}
-
-\begin{chunk}{COQ TRMANIP}
-(* package TRMANIP *)
-(*
 *)
 
 \end{chunk}
@@ -190348,6 +240370,7 @@ TranscendentalRischDE(F, UP): Exports == Implementation where
       ++ D is the derivation to use.
 
   Implementation ==> add
+
     import MonomialExtensionTools(F, UP)
 
     getBound     : (UP, UP, Z) -> Z
@@ -190362,7 +240385,6 @@ TranscendentalRischDE(F, UP): Exports == Implementation where
       n:Z
       (u := SPDE(aa, bb, cc, d, derivation)) case "failed" => [[0, true]]
       zero?(u.c) => [[u.beta, false]]
---      baseCase? := one?(dt := derivation monomial(1, 1))
       baseCase? := ((dt := derivation monomial(1, 1)) = 1)
       n := degree(dt)::Z - 1
       b0? := zero?(u.b)
@@ -190370,8 +240392,8 @@ TranscendentalRischDE(F, UP): Exports == Implementation where
           answ := SPDEnocancel1(u.b, u.c, u.m, derivation)
           [[u.alpha * answ.ans + u.beta, answ.nosol]]
       (n > 0) and (b0? or degree(u.b) < n) =>
-          uansw := SPDEnocancel2(u.b,u.c,u.m,n,leadingCoefficient dt,derivation)
-          uansw case ans=> [[u.alpha * uansw.ans.ans + u.beta, uansw.ans.nosol]]
+          uansw:= SPDEnocancel2(u.b,u.c,u.m,n,leadingCoefficient dt,derivation)
+          uansw case ans=> [[u.alpha * uansw.ans.ans + u.beta,uansw.ans.nosol]]
           [[uansw.eq.b, uansw.eq.c, uansw.eq.m,
             u.alpha * uansw.eq.alpha, u.alpha * uansw.eq.beta + u.beta]]
       b0? and baseCase? =>
@@ -190426,7 +240448,7 @@ TranscendentalRischDE(F, UP): Exports == Implementation where
     SPDEnocancel2(bb, cc, d, dtm1, lt, derivation) ==
       q:UP := 0
       while cc ^= 0 repeat
-        d < 0 or (n := (degree cc)::Z - dtm1) < 0 or n > d => return [[q, true]]
+        d < 0 or (n := (degree cc)::Z - dtm1) < 0 or n > d => return [[q,true]]
         if n > 0 then
           r  := monomial((leadingCoefficient cc) / (n * lt), n::N)
           cc := cc - bb * r - derivation r
@@ -190475,6 +240497,128 @@ TranscendentalRischDE(F, UP): Exports == Implementation where
 \begin{chunk}{COQ RDETR}
 (* package RDETR *)
 (*
+
+    import MonomialExtensionTools(F, UP)
+
+    getBound     : (UP, UP, Z) -> Z
+    SPDEnocancel1: (UP, UP, Z, UP -> UP) -> PSOL
+    SPDEnocancel2: (UP, UP, Z, Z, F, UP -> UP) -> ANS
+    SPDE         : (UP, UP, UP, Z, UP -> UP) -> Union(SPE, "failed")
+
+-- cancellation at infinity is possible, A is assumed nonzero
+-- needs tagged union because of branch choice problem
+-- always returns a PSOL in the base case (never a SPE)
+    polyRDE(aa, bb, cc, d, derivation) ==
+      n:Z
+      (u := SPDE(aa, bb, cc, d, derivation)) case "failed" => [[0, true]]
+      zero?(u.c) => [[u.beta, false]]
+      baseCase? := ((dt := derivation monomial(1, 1)) = 1)
+      n := degree(dt)::Z - 1
+      b0? := zero?(u.b)
+      (~b0?) and (baseCase? or degree(u.b) > max(0, n)) =>
+          answ := SPDEnocancel1(u.b, u.c, u.m, derivation)
+          [[u.alpha * answ.ans + u.beta, answ.nosol]]
+      (n > 0) and (b0? or degree(u.b) < n) =>
+          uansw:= SPDEnocancel2(u.b,u.c,u.m,n,leadingCoefficient dt,derivation)
+          uansw case ans=> [[u.alpha * uansw.ans.ans + u.beta,uansw.ans.nosol]]
+          [[uansw.eq.b, uansw.eq.c, uansw.eq.m,
+            u.alpha * uansw.eq.alpha, u.alpha * uansw.eq.beta + u.beta]]
+      b0? and baseCase? =>
+          degree(u.c) >= u.m => [[0, true]]
+          [[u.alpha * integrate(u.c) + u.beta, false]]
+      [u::SPE]
+
+-- cancellation at infinity is possible, A is assumed nonzero
+-- if u.b = 0 then u.a = 1 already, but no degree check is done
+-- returns "failed" if a p' + b p = c has no soln of degree at most d,
+-- otherwise [B, C, m, \alpha, \beta] such that any soln p of degree at
+-- most d of  a p' + b p = c  must be of the form p = \alpha h + \beta,
+-- where h' + B h = C and h has degree at most m
+    SPDE(aa, bb, cc, d, derivation) ==
+      zero? cc => [0, 0, 0, 0, 0]
+      d < 0 => "failed"
+      (u := cc exquo (g := gcd(aa, bb))) case "failed" => "failed"
+      aa := (aa exquo g)::UP
+      bb := (bb exquo g)::UP
+      cc := u::UP
+      (ra := retractIfCan(aa)@Union(F, "failed")) case F =>
+        a1 := inv(ra::F)
+        [a1 * bb, a1 * cc, d, 1, 0]
+      bc := extendedEuclidean(bb, aa, cc)::Record(coef1:UP, coef2:UP)
+      qr := divide(bc.coef1, aa)
+      r  := qr.remainder         -- z = bc.coef2 + b * qr.quotient
+      (v  := SPDE(aa, bb + derivation aa,
+                  bc.coef2 + bb * qr.quotient - derivation r,
+                   d - degree(aa)::Z, derivation)) case "failed" => "failed"
+      [v.b, v.c, v.m, aa * v.alpha, aa * v.beta + r]
+
+-- solves q' + b q = c  with deg(q) <= d
+-- case (B <> 0) and (D = d/dt or degree(B) > max(0, degree(Dt) - 1))
+-- this implies no cancellation at infinity, BQ term dominates
+-- returns [Q, flag] such that Q is a solution if flag is false,
+-- a partial solution otherwise.
+    SPDEnocancel1(bb, cc, d, derivation) ==
+      q:UP := 0
+      db := (degree bb)::Z
+      lb := leadingCoefficient bb
+      while cc ^= 0 repeat
+        d < 0 or (n := (degree cc)::Z - db) < 0 or n > d => return [q, true]
+        r := monomial((leadingCoefficient cc) / lb, n::N)
+        cc := cc - bb * r - derivation r
+        d := n - 1
+        q := q + r
+      [q, false]
+
+-- case (t is a nonlinear monomial) and (B = 0 or degree(B) < degree(Dt) - 1)
+-- this implies no cancellation at infinity, DQ term dominates or degree(Q) = 0
+-- dtm1 = degree(Dt) - 1
+    SPDEnocancel2(bb, cc, d, dtm1, lt, derivation) ==
+      q:UP := 0
+      while cc ^= 0 repeat
+        d < 0 or (n := (degree cc)::Z - dtm1) < 0 or n > d => return [[q,true]]
+        if n > 0 then
+          r  := monomial((leadingCoefficient cc) / (n * lt), n::N)
+          cc := cc - bb * r - derivation r
+          d  := n - 1
+          q  := q + r
+        else        -- n = 0 so solution must have degree 0
+          db:N := (zero? bb => 0; degree bb);
+          db ^= degree(cc) => return [[q, true]]
+          zero? db => return [[bb, cc, 0, 1, q]]
+          r  := leadingCoefficient(cc) / leadingCoefficient(bb)
+          cc := cc - r * bb - derivation(r::UP)
+          d  := - 1
+          q := q + r::UP
+      [[q, false]]
+
+    monomRDE(f, g, derivation) ==
+      gg := gcd(d := normalDenom(f,derivation), e := normalDenom(g,derivation))
+      tt := (gcd(e, differentiate e) exquo gcd(gg,differentiate gg))::UP
+      (u := ((tt * (aa := d * tt)) exquo e)) case "failed" => "failed"
+      [aa, aa * f - (d * derivation tt)::RF, u::UP * e * g, tt]
+
+-- solve y' + f y = g for y in RF
+-- assumes that f is weakly normalized (no finite cancellation)
+-- base case: F' = 0
+    baseRDE(f, g) ==
+      (u := monomRDE(f, g, differentiate)) case "failed" => [0, true]
+      n := getBound(u.a,bb := retract(u.b)@UP,degree(cc := retract(u.c)@UP)::Z)
+      v := polyRDE(u.a, bb, cc, n, differentiate).ans
+      [v.ans / u.t, v.nosol]
+
+-- return an a bound on the degree of a solution of A P'+ B P = C,A ^= 0
+-- cancellation at infinity is possible
+-- base case: F' = 0
+    getBound(a, b, dc) ==
+      da := (degree a)::Z
+      zero? b => max(0, dc - da + 1)
+      db := (degree b)::Z
+      da > (db + 1) => max(0, dc - da + 1)
+      da < (db + 1) => dc - db
+      (n := retractIfCan(- leadingCoefficient(b) / leadingCoefficient(a)
+                      )@Union(Z, "failed")) case Z => max(n::Z, dc - db)
+      dc - db
+
 *)
 
 \end{chunk}
@@ -190566,6 +240710,7 @@ TranscendentalRischDESystem(F, UP): Exports == Implementation where
       ++ if \spad{y_1,y_2} exist, "failed" otherwise.
  
   Implementation ==> add
+
     import MonomialExtensionTools(F, UP)
     import SmithNormalForm(UP, V, V, Matrix UP)
  
@@ -190584,7 +240729,7 @@ TranscendentalRischDESystem(F, UP): Exports == Implementation where
 -- assumes that f is weakly normalized (no finite cancellation)
     monomRDEsys(f, g1, g2, derivation) ==
       gg := gcd(d := normalDenom(f, derivation),
-                e := lcm(normalDenom(g1,derivation),normalDenom(g2,derivation)))
+               e := lcm(normalDenom(g1,derivation),normalDenom(g2,derivation)))
       tt := (gcd(e, differentiate e) exquo gcd(gg,differentiate gg))::UP
       (u := ((tt * (aa := d * tt)) exquo e)) case "failed" => "failed"
       [aa, tt * d * f, - d * derivation tt, u::UP * e * g1, u::UP * e * g2, tt]
@@ -190640,7 +240785,7 @@ TranscendentalRischDESystem(F, UP): Exports == Implementation where
         (u := diophant(a, h, b, c1, c2)) case "failed" => "failed"
         rec := u::REC
         v := SPDEsys(a, b, h + derivation a, rec.z1 - derivation(rec.r1),
-                     rec.z2 - derivation(rec.r2),n-da::Z,derivation,degradation)
+                    rec.z2 - derivation(rec.r2),n-da::Z,derivation,degradation)
         v case "failed" => "failed"
         l := v::List(UP)
         [a * first(l) + rec.r1, a * second(l) + rec.r2]
@@ -190676,7 +240821,7 @@ TranscendentalRischDESystem(F, UP): Exports == Implementation where
       ans1 := ans2 := 0::UP
       repeat
         zero? c1 and zero? c2 => return [ans1, ans2]
-        n < 0 or (u := getlc(c1,c2,lb,lh,n::N)) case "failed" => return "failed"
+        n < 0 or (u:= getlc(c1,c2,lb,lh,n::N)) case "failed" => return "failed"
         lq := u::List(UP)
         q1 := first lq
         q2 := second lq
@@ -190755,6 +240900,191 @@ TranscendentalRischDESystem(F, UP): Exports == Implementation where
 \begin{chunk}{COQ RDETRS}
 (* package RDETRS *)
 (*
+
+    import MonomialExtensionTools(F, UP)
+    import SmithNormalForm(UP, V, V, Matrix UP)
+ 
+    diophant: (UP, UP, UP, UP, UP) -> Union(REC, "failed")
+    getBound: (UP, UP, UP, UP, UP) -> Z
+    SPDEsys : (UP, UP, UP, UP, UP, Z, UP -> UP, (F, F, F, UP, UP, Z) -> U) -> U
+    DSPDEsys: (F, UP, UP, UP, UP, Z, UP -> UP) -> U
+    DSPDEmix: (UP, UP, F, F, N, Z, F) -> U
+    DSPDEhdom: (UP, UP, F, F, N, Z) -> U
+    DSPDEbdom: (UP, UP, F, F, N, Z) -> U
+    DSPDEsys0: (F, UP, UP, UP, UP, F, F, Z, UP -> UP, (UP,UP,F,F,N) -> U) -> U
+ 
+-- reduces (y1', y2') + ((0, -f), (f, 0)) (y1,y2) = (g1,g2) to
+-- A (Q1', Q2') + ((H, -B), (B, H)) (Q1,Q2) = (C1,C2), Q1 = y1 T, Q2 = y2 T
+-- where A and H are polynomials, and B,C1,C2,Q1 and Q2 have no normal poles.
+-- assumes that f is weakly normalized (no finite cancellation)
+    monomRDEsys(f, g1, g2, derivation) ==
+      gg := gcd(d := normalDenom(f, derivation),
+               e := lcm(normalDenom(g1,derivation),normalDenom(g2,derivation)))
+      tt := (gcd(e, differentiate e) exquo gcd(gg,differentiate gg))::UP
+      (u := ((tt * (aa := d * tt)) exquo e)) case "failed" => "failed"
+      [aa, tt * d * f, - d * derivation tt, u::UP * e * g1, u::UP * e * g2, tt]
+ 
+-- solve (y1', y2') + ((0, -f), (f, 0)) (y1,y2) = (g1,g2) for y1,y2 in RF
+-- assumes that f is weakly normalized (no finite cancellation) and nonzero
+-- base case: F' = 0
+    baseRDEsys(f, g1, g2) ==
+      zero? f => error "baseRDEsys: f must be nonzero"
+      zero? g1 and zero? g2 => [0, 0]
+      (u := monomRDEsys(f, g1, g2, differentiate)) case "failed" => "failed"
+      n := getBound(u.a, bb := retract(u.b), u.h,
+                    cc1 := retract(u.c1), cc2 := retract(u.c2))
+      (v := SPDEsys(u.a, bb, u.h, cc1, cc2, n, differentiate,
+                   (z1,z2,z3,z4,z5,z6) +->
+                    DSPDEsys(z1, z2::UP, z3::UP, z4, z5, z6, differentiate)))
+                          case "failed" => "failed"
+      l := v::List(UP)
+      [first(l) / u.t, second(l) / u.t]
+ 
+-- solve
+--   D1 = A Z1 + B R1 - C R2
+--   D2 = A Z2 + C R1 + B R2
+-- i.e. (D1,D2) = ((A, 0, B, -C), (0, A, C, B)) (Z1, Z2, R1, R2)
+-- for R1, R2 with degree(Ri) < degree(A)
+-- assumes (A,B,C) = (1) and A and C are nonzero
+    diophant(a, b, c, d1, d2) ==
+      (u := diophantineSystem(matrix [[a,0,b,-c], [0,a,c,b]],
+                          vector [d1,d2]).particular) case "failed" => "failed"
+      v := u::V
+      qr1 := divide(v 3, a)
+      qr2 := divide(v 4, a)
+      [v.1 + b * qr1.quotient - c * qr2.quotient,
+       v.2 + c * qr1.quotient + b * qr2.quotient, qr1.remainder, qr2.remainder]
+ 
+-- solve
+-- A (Q1', Q2') + ((H, -B), (B, H)) (Q1,Q2) = (C1,C2)
+-- for polynomials Q1 and Q2 with degree <= n
+-- A and B are nonzero
+-- cancellation at infinity is possible
+    SPDEsys(a, b, h, c1, c2, n, derivation, degradation) ==
+      zero? c1 and zero? c2 => [0, 0]
+      n < 0 => "failed"
+      g := gcd(a, gcd(b, h))
+      ((u1 := c1 exquo g) case "failed") or
+        ((u2 := c2 exquo g) case "failed") => "failed"
+      a := (a exquo g)::UP
+      b := (b exquo g)::UP
+      h := (h exquo g)::UP
+      c1 := u1::UP
+      c2 := u2::UP
+      (da := degree a) > 0 =>
+        (u := diophant(a, h, b, c1, c2)) case "failed" => "failed"
+        rec := u::REC
+        v := SPDEsys(a, b, h + derivation a, rec.z1 - derivation(rec.r1),
+                    rec.z2 - derivation(rec.r2),n-da::Z,derivation,degradation)
+        v case "failed" => "failed"
+        l := v::List(UP)
+        [a * first(l) + rec.r1, a * second(l) + rec.r2]
+      ra := retract(a)@F
+      ((rb := retractIfCan(b)@Union(F, "failed")) case "failed") or
+        ((rh := retractIfCan(h)@Union(F, "failed")) case "failed") =>
+                                DSPDEsys(ra, b, h, c1, c2, n, derivation)
+      degradation(ra, rb::F, rh::F, c1, c2, n)
+ 
+-- solve
+-- a (Q1', Q2') + ((H, -B), (B, H)) (Q1,Q2) = (C1,C2)
+-- for polynomials Q1 and Q2 with degree <= n
+-- a and B are nonzero, either B or H has positive degree
+-- cancellation at infinity is not possible
+    DSPDEsys(a, b, h, c1, c2, n, derivation) ==
+      bb := degree(b)::Z
+      hh:Z :=
+        zero? h => 0
+        degree(h)::Z
+      lb := leadingCoefficient b
+      lh := leadingCoefficient h
+      bb < hh =>
+        DSPDEsys0(a,b,h,c1,c2,lb,lh,n,derivation,
+                  (z1,z2,z3,z4,z5) +-> DSPDEhdom(z1,z2,z3,z4,z5,hh))
+      bb > hh =>
+        DSPDEsys0(a,b,h,c1,c2,lb,lh,n,derivation,
+                  (z1,z2,z3,z4,z5) +-> DSPDEbdom(z1,z2,z3,z4,z5,bb))
+      det := lb * lb + lh * lh
+      DSPDEsys0(a,b,h,c1,c2,lb,lh,n,derivation,
+                (z1,z2,z3,z4,z5) +-> DSPDEmix(z1,z2,z3,z4,z5,bb,det))
+ 
+    DSPDEsys0(a, b, h, c1, c2, lb, lh, n, derivation, getlc) ==
+      ans1 := ans2 := 0::UP
+      repeat
+        zero? c1 and zero? c2 => return [ans1, ans2]
+        n < 0 or (u:= getlc(c1,c2,lb,lh,n::N)) case "failed" => return "failed"
+        lq := u::List(UP)
+        q1 := first lq
+        q2 := second lq
+        c1 := c1 - a * derivation(q1) - h * q1 + b * q2
+        c2 := c2 - a * derivation(q2) - b * q1 - h * q2
+        n := n - 1
+        ans1 := ans1 + q1
+        ans2 := ans2 + q2
+ 
+    DSPDEmix(c1, c2, lb, lh, n, d, det) ==
+      rh1:F :=
+        zero? c1 => 0
+        (d1 := degree(c1)::Z - d) < n => 0
+        d1 > n => return "failed"
+        leadingCoefficient c1
+      rh2:F :=
+        zero? c2 => 0
+        (d2 := degree(c2)::Z - d) < n => 0
+        d2 > n => return "failed"
+        leadingCoefficient c2
+      q1 := (rh1 * lh + rh2 * lb) / det
+      q2 := (rh2 * lh - rh1 * lb) / det
+      [monomial(q1, n), monomial(q2, n)]
+ 
+ 
+    DSPDEhdom(c1, c2, lb, lh, n, d) ==
+      q1:UP :=
+        zero? c1 => 0
+        (d1 := degree(c1)::Z - d) < n => 0
+        d1 > n => return "failed"
+        monomial(leadingCoefficient(c1) / lh, n)
+      q2:UP :=
+        zero? c2 => 0
+        (d2 := degree(c2)::Z - d) < n => 0
+        d2 > n => return "failed"
+        monomial(leadingCoefficient(c2) / lh, n)
+      [q1, q2]
+ 
+    DSPDEbdom(c1, c2, lb, lh, n, d) ==
+      q1:UP :=
+        zero? c2 => 0
+        (d2 := degree(c2)::Z - d) < n => 0
+        d2 > n => return "failed"
+        monomial(leadingCoefficient(c2) / lb, n)
+      q2:UP :=
+        zero? c1 => 0
+        (d1 := degree(c1)::Z - d) < n => 0
+        d1 > n => return "failed"
+        monomial(- leadingCoefficient(c1) / lb, n)
+      [q1, q2]
+ 
+-- return a common bound on the degrees of a solution of
+-- A (Q1', Q2') + ((H, -B), (B, H)) (Q1,Q2) = (C1,C2), Q1 = y1 T, Q2 = y2 T
+-- cancellation at infinity is possible
+-- a and b are nonzero
+-- base case: F' = 0
+    getBound(a, b, h, c1, c2) ==
+      da := (degree a)::Z
+      dc :=
+        zero? c1 => degree(c2)::Z
+        zero? c2 => degree(c1)::Z
+        max(degree c1, degree c2)::Z
+      hh:Z :=
+        zero? h => 0
+        degree(h)::Z
+      db := max(hh, bb := degree(b)::Z)
+      da < db + 1 => dc - db
+      da > db + 1 => max(0, dc - da + 1)
+      bb >= hh => dc - db
+      (n := retractIfCan(leadingCoefficient(h) / leadingCoefficient(a)
+                      )@Union(Z, "failed")) case Z => max(n::Z, dc - db)
+      dc - db
+
 *)
 
 \end{chunk}
@@ -191129,6 +241459,7 @@ TransSolvePackage(R) : Exports == Implementation where
 --       ++ of equations leqs with respect to the list of kernels lker.
 
    Implementation == add
+
      import ACF
      import HomogeneousAggregate(R)
      import AlgebraicManipulations(R, RE)
@@ -191140,7 +241471,459 @@ TransSolvePackage(R) : Exports == Implementation where
      import TransSolvePackageService(R)
      import MultivariateFactorize(K, IndexedExponents K, R, SMP(R, K))
 
+        ---- Local Function Declarations ----
+
+     solveInner : (RE, S) -> L EQ RE
+     tryToTrans : ( RE , S)     ->  RE
+
+     eliminateKernRoot: (RE , K) -> RE
+     eliminateRoot: (RE , S) -> RE
+
+     combineLog : ( RE , S ) -> RE
+     testLog : ( RE , S ) -> Boolean
+     splitExpr : ( RE ) -> L RE
+     buildnexpr : ( RE , S ) -> L RE
+     logsumtolog : RE -> RE
+     logexpp : ( RE , RE ) -> RE
+
+     testRootk : ( RE, S) -> Boolean
+     testkernel : ( RE , S ) -> Boolean
+     funcinv : ( RE , RE ) -> Union(RE,"failed")
+     testTrig : ( RE , S ) -> Boolean
+     testHTrig : ( RE , S ) -> Boolean
+     tableXkernels : ( RE , S ) -> L RE
+     subsTan : ( RE , S )  -> RE
+ 
+     -- exported functions
+
+     solve(oside: RE) : L EQ RE ==
+       zero? oside => error "equation is always satisfied"
+       lv := variables oside
+       empty? lv => error "inconsistent equation"
+       #lv>1 => error "too many variables"
+       solve(oside,lv.first)
+
+     solve(equ:EQ RE) : L EQ RE ==
+       solve(lhs(equ)-rhs(equ))
+
+     solve(equ:EQ RE, x:S) : L EQ RE ==
+       oneside:=lhs(equ)-rhs(equ)
+       solve(oneside,x)
+
+     testZero?(lside:RE,sol:EQ RE):Boolean ==
+       if R has QuotientFieldCategory(Integer) then
+         retractIfCan(rhs sol)@Union(Integer,"failed") case "failed" => true
+       else
+         retractIfCan(rhs sol)@Union(Fraction Integer,"failed") _
+            case "failed" => true
+       zero? eval(lside,sol) => true
+       false
+
+     solve(lside: RE, x:S) : L EQ RE ==
+       [sol for sol in solveInner(lside,x) | testZero?(lside,sol)]
+
+     solveInner(lside: RE, x:S) : L EQ RE ==
+       lside:=eliminateRoot(lside,x)
+       ausgabe1:=tableXkernels(lside,x)
+
+       X:=new()@Symbol
+       Y:=new()@Symbol::RE
+       (#ausgabe1) = 1 =>
+          bigX:= (first ausgabe1)::RE
+          eq1:=eval(lside,bigX=(X::RE))
+              -- Type  :  Expression R
+          f:=univariate(eq1,first kernels (X::RE))
+              -- Type  :  Fraction SparseUnivariatePolynomial Expression R
+          lfatt:= factors factorPolynomial numer f
+          lr:L RE := "append" /[zerosOf(fatt.factor,x) for fatt in lfatt]
+              -- Type  :  List Expression R
+          r1:=[]::L RE
+          for i in 1..#lr repeat
+             finv := funcinv(bigX,lr(i))
+             if finv case RE then r1:=cons(finv::RE,r1)
+          bigX_back:=funcinv(bigX,bigX)::RE
+          if not testkernel(bigX_back,x) then
+            if bigX = bigX_back then return []::L EQ RE
+            return
+              "append"/[solve(bigX_back-ri, x) for ri in r1]
+          newlist:=[]::L EQ RE
+
+          for i in 1..#r1 repeat
+             elR :=  eliminateRoot((numer(bigX_back - r1(i))::RE ),x)
+             f:=univariate(elR, kernel(x))
+              -- Type  :  Fraction SparseUnivariatePolynomial Expression R
+             lfatt:= factors factorPolynomial numer f
+             secondsol:="append" /[zerosOf(ff.factor,x) for ff in lfatt]
+             for j in 1..#secondsol repeat
+                newlist:=cons((x::RE)=rootSimp( secondsol(j) ),newlist)
+          newlist
+       newlside:=tryToTrans(lside,x) ::RE
+       listofkernels:=tableXkernels(newlside,x)
+       (#listofkernels) = 1 => solve(newlside,x)
+       lfacts := factors factor(numer lside)
+       #lfacts > 1 =>
+          sols : L EQ RE := []
+          for frec in lfacts repeat
+              sols := append(solve(frec.factor :: RE, x), sols)
+          sols
+       return []::L EQ RE
+
+    -- local functions
+
+     --  This function was suggested by Manuel Bronstein as a simpler 
+     --  alternative to normalize.
+     simplifyingLog(f:RE):RE ==
+       (u:=isExpt(f,"exp"::Symbol)) case _
+              Record(var:Kernel RE,exponent:Integer) =>       
+         rec := u::Record(var:Kernel RE,exponent:Integer)
+         rec.exponent * first argument(rec.var)
+       log f
+
+
+     testkernel(var1:RE,y:S) : Boolean ==
+       var1:=eliminateRoot(var1,y)
+       listvar1:=tableXkernels(var1,y)
+       if (#listvar1 = 1) and ((listvar1(1) = (y::RE))@Boolean ) then
+            true
+       else if #listvar1 = 0 then true
+            else false
+
+     solveRetract(lexpr:L RE, lvar:L S):Union(L L EQ RE, "failed") ==
+        nlexpr : L Fraction Polynomial R := []
+        for expr in lexpr repeat
+           rf:Union(Fraction Polynomial R, "failed") := retractIfCan(expr)$RE
+           rf case "failed" => return "failed"
+           nlexpr := cons(rf, nlexpr)
+        radicalSolve(nlexpr, lvar)$RadicalSolvePackage(R)
+
+     tryToTrans(lside: RE, x:S) : RE ==
+       if testTrig(lside,x) or testHTrig(lside,x) then
+          convLside:=( simplify(lside) )::RE
+          resultLside:=convLside
+          listConvLside:=tableXkernels(convLside,x)
+          if (#listConvLside) > 1  then
+            NormConvLside:=normalize(convLside,x)
+            NormConvLside:=( NormConvLside ) :: RE
+            resultLside:=subsTan(NormConvLside , x)
+
+       else if testLog(lside,x) then
+              numlside:=numer(lside)::RE
+              resultLside:=combineLog(numlside,x)
+            else
+              NormConvLside:=normalize(lside,x)
+              NormConvLside:=( NormConvLside ) :: RE
+              resultLside:=NormConvLside
+              listConvLside:=tableXkernels(NormConvLside,x)
+              if  (#listConvLside) > 1  then
+                cnormConvLside:=complexNormalize(lside,x)
+                cnormConvLside:=cnormConvLside::RE
+                resultLside:=cnormConvLside
+                listcnorm:=tableXkernels(cnormConvLside,x)
+                if (#listcnorm) > 1 then
+                  if testLog(cnormConvLside,x) then
+                    numlside:=numer(cnormConvLside)::RE
+                    resultLside:=combineLog(numlside,x)
+       resultLside
+
+
+     subsTan(exprvar:RE,y:S) : RE ==
+       Z:=new()@Symbol
+       listofkern:=tableXkernels(exprvar,y)
+       varkern:=(first listofkern)::RE
+       Y:=(numer first argument first (kernels(varkern)))::RE
+       test : Boolean := varkern=tan(((Y::RE)/(2::RE))::RE)
+       if not( (#listofkern=1) and test) then
+         return exprvar
+       fZ:=eval(exprvar,varkern=(Z::RE))
+       fN:=(numer fZ)::RE
+       f:=univariate(fN, first kernels(Z::RE))
+       secondfun:=(-2*(Y::RE)/((Y::RE)**2-1) )::RE
+       g:=univariate(secondfun,first kernels(y::RE))
+       H:=(new()@Symbol)::RE
+       newH:=univariate(H,first kernels(Z::RE))
+       result:=decomposeFunc(f,g,newH)
+       if not ( result = f ) then
+         result1:=result( H::RE )
+         resultnew:=eval(result1,H=(( tan((Y::RE))::RE ) ))
+       else return exprvar
+
+
+     eliminateKernRoot(var: RE, varkern: K) : RE ==
+       X:=new()@Symbol
+       var1:=eval(var, (varkern::RE)=(X::RE) )
+       var2:=numer univariate(var1, first kernels(X::RE))
+       var3:= monomial(1, ( retract( second argument varkern)@I )::NNI)@SUP RE_
+              - monomial(first argument varkern, 0::NNI)@SUP RE
+       resultvar:=resultant(var2, var3)
+
+     eliminateRoot(var:RE, y:S) : RE ==
+       var1:=var
+       while testRootk(var1,y) repeat
+         varlistk1:=tableXkernels(var1,y)
+         for i in varlistk1 repeat
+            if is?(i, "nthRoot"::S) then
+              var1:=eliminateKernRoot(var1,first kernels(i::RE))
+       var1
+
+
+     logsumtolog(var:RE) : RE ==
+       (listofexpr:=isPlus(var)) case "failed" => var
+       listofexpr:= listofexpr ::L RE
+       listforgcd:=[]::L R
+       for i in listofexpr repeat
+          exprcoeff:=leadingCoefficient(numer(i))
+          listforgcd:=cons(exprcoeff, listforgcd)
+       gcdcoeff:=gcd(listforgcd)::RE
+       newexpr:RE :=0
+       for i in listofexpr repeat
+          exprlist:=splitExpr(i::RE)
+          newexpr:=newexpr + logexpp(exprlist.2, exprlist.1/gcdcoeff)
+       kernelofvar:=kernels(newexpr)
+       var2:=1::RE
+       for i in kernelofvar repeat
+          var2:=var2*(first argument i)
+       gcdcoeff * log(var2)
+
+
+     testLog(expr:RE,Z:S) : Boolean ==
+       testList:=[log]::L S
+       kernelofexpr:=tableXkernels(expr,Z)
+       if #kernelofexpr = 0 then
+         return false
+       for i in kernelofexpr repeat
+          if not member?(name(first kernels(i)),testList) or _
+             not testkernel( (first argument first kernels(i)) ,Z) then
+            return false
+       true
+
+     splitExpr(expr:RE) : L RE ==
+       lcoeff:=leadingCoefficient((numer expr))
+       exprwcoeff:=expr
+       listexpr:=isTimes(exprwcoeff)
+       if listexpr case "failed" then
+         [1::RE , expr]
+       else
+         listexpr:=remove_!(lcoeff::RE , listexpr)
+         cons(lcoeff::RE , listexpr)
+
+     buildnexpr(expr:RE, Z:S) : L RE ==
+       nlist:=splitExpr(expr)
+       n2list:=remove_!(nlist.1, nlist)
+       anscoeff:RE:=1
+       ansmant:RE:=0
+       for i in n2list repeat
+          if freeOf?(i::RE,Z) then
+            anscoeff:=(i::RE)*anscoeff
+          else
+            ansmant:=(i::RE)
+       [anscoeff, ansmant * nlist.1 ]
+
+     logexpp(expr1:RE, expr2:RE) : RE ==
+       log( (first argument first kernels(expr1))**expr2 )
+
+     combineLog(expr:RE,Y:S) : RE ==
+       exprtable:Table(RE,RE):=table()
+       (isPlus(expr)) case "failed" => expr
+       ans:RE:=0
+       while expr ^= 0 repeat
+         loopexpr:RE:=leadingMonomial(numer(expr))::RE
+         if testLog(loopexpr,Y) and (#tableXkernels(loopexpr,Y)=1) then
+           exprr:=buildnexpr(loopexpr,Y)
+           if search(exprr.1,exprtable) case "failed" then
+             exprtable.(exprr.1):=0
+           exprtable.(exprr.1):= exprtable.(exprr.1) + exprr.2
+         else
+           ans:=ans+loopexpr
+         expr:=(reductum(numer expr))::RE
+       ansexpr:RE:=0
+       for i in keys(exprtable) repeat
+          ansexpr:=ansexpr + logsumtolog(exprtable.i) * (i::RE)
+       ansexpr:=ansexpr + ans
+
+
+     testRootk(varlistk:RE,y:S) : Boolean ==
+       testList:=[nthRoot]::L S
+       kernelofeqnvar:=tableXkernels(varlistk,y)
+       if #kernelofeqnvar = 0 then
+         return false
+       for i in kernelofeqnvar repeat
+          if member?(name(first kernels(i)),testList) then
+            return true
+       false
+
+     tableXkernels(evar:RE,Z:S) : L RE ==
+       kOfvar:=kernels(evar)
+       listkOfvar:=[]::L RE
+       for i in kOfvar repeat
+          if not freeOf?(i::RE,Z) then
+              listkOfvar:=cons(i::RE,listkOfvar)
+       listkOfvar
+
+     testTrig(eqnvar:RE,Z:S) : Boolean ==
+       testList:=[sin , cos , tan , cot , sec , csc]::L S
+       kernelofeqnvar:=tableXkernels(eqnvar,Z)
+       if #kernelofeqnvar = 0 then
+         return false
+       for i in kernelofeqnvar repeat
+          if not member?(name(first kernels(i)),testList) or _
+             not testkernel( (first argument first kernels(i)) ,Z) then
+            return false
+       true
+
+
+     testHTrig(eqnvar:RE,Z:S) : Boolean ==
+       testList:=[sinh , cosh , tanh , coth , sech , csch]::L S
+       kernelofeqnvar:=tableXkernels(eqnvar,Z)
+       if #kernelofeqnvar = 0 then
+         return false
+       for i in kernelofeqnvar repeat
+          if not member?(name(first kernels(i)),testList) or _
+             not testkernel( (first argument first kernels(i)) ,Z) then
+            return false
+       true
+
+     -- Auxiliary local function for use in funcinv.
+     makeInterval(l:R):C INT F ==
+       if R has complex and R has ConvertibleTo(C F) then
+         map(interval$INT(F),convert(l)$R)$ComplexFunctions2(F,INT F)
+       else
+         error "This should never happen"
+
+     funcinv(k:RE,l:RE) : Union(RE,"failed") ==
+       is?(k, "sin"::Symbol)   => asin(l)
+       is?(k, "cos"::Symbol)   => acos(l)
+       is?(k, "tan"::Symbol)   => atan(l)
+       is?(k, "cot"::Symbol)   => acot(l)
+       is?(k, "sec"::Symbol)   =>
+           l = 0 => "failed"
+           asec(l)
+       is?(k, "csc"::Symbol)   =>
+           l = 0 => "failed"
+           acsc(l)
+       is?(k, "sinh"::Symbol)  => asinh(l)
+       is?(k, "cosh"::Symbol)  => acosh(l)
+       is?(k, "tanh"::Symbol)  => atanh(l)
+       is?(k, "coth"::Symbol)  => acoth(l)
+       is?(k, "sech"::Symbol)  => asech(l)
+       is?(k, "csch"::Symbol)  => acsch(l)
+       is?(k, "atan"::Symbol)  => tan(l)
+       is?(k, "acot"::Symbol)  =>
+           l = 0 => "failed"
+           cot(l)
+       is?(k, "asin"::Symbol)  => sin(l)
+       is?(k, "acos"::Symbol)  => cos(l)
+       is?(k, "asec"::Symbol)  => sec(l)
+       is?(k, "acsc"::Symbol)  =>
+           l = 0 => "failed"
+           csc(l)
+       is?(k, "asinh"::Symbol) => sinh(l)
+       is?(k, "acosh"::Symbol) => cosh(l)
+       is?(k, "atanh"::Symbol) => tanh(l)
+       is?(k, "acoth"::Symbol) =>
+           l = 0 => "failed"
+           coth(l)
+       is?(k, "asech"::Symbol) => sech(l)
+       is?(k, "acsch"::Symbol) =>
+           l = 0 => "failed"
+           csch(l)
+       is?(k, "exp"::Symbol)   =>
+           l = 0 => "failed"
+           simplifyingLog l
+       is?(k, "log"::Symbol)   =>
+         if R has complex and R has ConvertibleTo(C F) then
+           -- We will check to see if the imaginary part lies in [-Pi,Pi)
+           ze : Expression C INT F
+           ze := map(makeInterval,l)$ExpressionFunctions2(R,C INT F)
+           z : Union(C INT F,"failed") := retractIfCan ze
+           z case "failed" => exp l
+           im := imag z
+           fpi : Float := pi()
+           (-fpi < inf(im)) and (sup(im) <= fpi) => exp l
+           "failed"
+         else -- R not Complex or something which doesn't map to Complex Floats
+           exp l 
+       is?(k, "%power"::Symbol)   => 
+            (t:=normalize(l)) = 0 => "failed"
+            log t
+       l
+
+     import SystemSolvePackage(RE)
+
+     ker2Poly(k:Kernel RE, lvar:L S):Polynomial RE ==
+        member?(nm:=name k, lvar) => nm :: Polynomial RE
+        k :: RE :: Polynomial RE
+
+     smp2Poly(pol:SMP(R,Kernel RE), lvar:L S):Polynomial RE ==
+        map(x +-> ker2Poly(x, lvar),
+            y +-> y::RE::Polynomial RE, pol)$PolynomialCategoryLifting(
+              IndexedExponents Kernel RE, Kernel RE, R, SMP(R, Kernel RE), 
+                      Polynomial RE)
+
+     makeFracPoly(expr:RE, lvar:L S):Fraction Polynomial RE ==
+        smp2Poly(numer expr, lvar) / smp2Poly(denom expr, lvar)
+
+     makeREpol(pol:Polynomial RE):RE ==
+        lvar := variables pol
+        lval : List RE := [v::RE for v in lvar]
+        ground eval(pol,lvar,lval)
+
+     makeRE(frac:Fraction Polynomial RE):RE ==
+        makeREpol(numer frac)/makeREpol(denom frac)
+
+     solve1Pol(pol:Polynomial RE, var: S, sol:L EQ RE):L L EQ RE ==
+        repol := eval(makeREpol pol, sol)
+        vsols := solve(repol, var)
+        [cons(vsol, sol) for vsol in vsols]
+
+     solve1Sys(plist:L Polynomial RE, lvar:L S):L L EQ RE ==
+        rplist := reverse plist
+        rlvar := reverse lvar
+        sols : L L EQ RE := list(empty())
+        for p in rplist for v in rlvar repeat
+           sols := "append"/[solve1Pol(p,v,sol) for sol in sols]
+        sols
+
+\end{chunk}
+The input
+\begin{verbatim}
+  solve(sinh(z)=cosh(z),z)
+\end{verbatim}
+generates the error (reported as bug \# 102):
+\begin{verbatim}
+ >> Error detected within library code:
+    No identity element for reduce of empty list using operation append
+\end{verbatim}
+\begin{chunk}{package SOLVETRA TransSolvePackage}
+
+     solveList(lexpr:L RE, lvar:L S):L L EQ RE ==
+        ans1 := solveRetract(lexpr, lvar)
+        not(ans1 case "failed") => ans1 :: L L EQ RE
+        lfrac:L Fraction Polynomial RE :=
+           [makeFracPoly(expr, lvar) for expr in lexpr]
+        trianglist := triangularSystems(lfrac, lvar)
+        l: L L L EQ RE := [solve1Sys(plist, lvar) for plist in trianglist]
+        reduce(append, l, [])
+        
+     solve(leqs:L EQ RE, lvar:L S):L L EQ RE ==
+        lexpr:L RE := [lhs(eq)-rhs(eq) for eq in leqs]
+        solveList(lexpr, lvar)
+
+\end{chunk}
+
+\begin{chunk}{COQ SOLVETRA}
+(* package SOLVETRA *)
+(*
 
+     import ACF
+     import HomogeneousAggregate(R)
+     import AlgebraicManipulations(R, RE)
+     import TranscendentalManipulations(R, RE)
+     import TrigonometricManipulations(R, RE)
+     import ElementaryFunctionStructurePackage(R, RE)
+     import SparseUnivariatePolynomial(R)
+     import LinearSystemMatrixPackage(RE,Vector RE,Vector RE,Matrix RE)
+     import TransSolvePackageService(R)
+     import MultivariateFactorize(K, IndexedExponents K, R, SMP(R, K))
 
         ---- Local Function Declarations ----
 
@@ -191165,10 +241948,8 @@ TransSolvePackage(R) : Exports == Implementation where
      tableXkernels : ( RE , S ) -> L RE
      subsTan : ( RE , S )  -> RE
  
- 
      -- exported functions
 
-
      solve(oside: RE) : L EQ RE ==
        zero? oside => error "equation is always satisfied"
        lv := variables oside
@@ -191187,7 +241968,8 @@ TransSolvePackage(R) : Exports == Implementation where
        if R has QuotientFieldCategory(Integer) then
          retractIfCan(rhs sol)@Union(Integer,"failed") case "failed" => true
        else
-         retractIfCan(rhs sol)@Union(Fraction Integer,"failed") case "failed" => true
+         retractIfCan(rhs sol)@Union(Fraction Integer,"failed") _
+            case "failed" => true
        zero? eval(lside,sol) => true
        false
 
@@ -191245,7 +242027,8 @@ TransSolvePackage(R) : Exports == Implementation where
      --  This function was suggested by Manuel Bronstein as a simpler 
      --  alternative to normalize.
      simplifyingLog(f:RE):RE ==
-       (u:=isExpt(f,"exp"::Symbol)) case Record(var:Kernel RE,exponent:Integer) =>       
+       (u:=isExpt(f,"exp"::Symbol)) case _
+              Record(var:Kernel RE,exponent:Integer) =>       
          rec := u::Record(var:Kernel RE,exponent:Integer)
          rec.exponent * first argument(rec.var)
        log f
@@ -191554,25 +242337,12 @@ TransSolvePackage(R) : Exports == Implementation where
            sols := "append"/[solve1Pol(p,v,sol) for sol in sols]
         sols
 
-\end{chunk}
-The input
-\begin{verbatim}
-  solve(sinh(z)=cosh(z),z)
-\end{verbatim}
-generates the error (reported as bug \# 102):
-\begin{verbatim}
- >> Error detected within library code:
-    No identity element for reduce of empty list using operation append
-\end{verbatim}
-\begin{chunk}{package SOLVETRA TransSolvePackage}
-
      solveList(lexpr:L RE, lvar:L S):L L EQ RE ==
         ans1 := solveRetract(lexpr, lvar)
         not(ans1 case "failed") => ans1 :: L L EQ RE
         lfrac:L Fraction Polynomial RE :=
            [makeFracPoly(expr, lvar) for expr in lexpr]
         trianglist := triangularSystems(lfrac, lvar)
---        "append"/[solve1Sys(plist, lvar) for plist in trianglist]
         l: L L L EQ RE := [solve1Sys(plist, lvar) for plist in trianglist]
         reduce(append, l, [])
         
@@ -191580,21 +242350,6 @@ generates the error (reported as bug \# 102):
         lexpr:L RE := [lhs(eq)-rhs(eq) for eq in leqs]
         solveList(lexpr, lvar)
 
---     solve(leqs:L EQ RE, lker:L Kernel RE):L L EQ RE ==
---        lexpr:L RE := [lhs(eq)-rhs(eq) for eq in leqs]
---        lvar :L S := [new()$S for k in lker]
---        lval :L RE := [kernel v for v in lvar]
---        nlexpr := [eval(expr,lker,lval) for expr in lexpr]
---        ans := solveList(nlexpr, lvar)
---        lker2 :L Kernel RE := [v::Kernel(RE) for v in lvar]
---        lval2 := [k::RE for k in lker]
---        [[map(eval(#1,lker2,lval2), neq) for neq in sol] for sol in ans]
-
-\end{chunk}
-
-\begin{chunk}{COQ SOLVETRA}
-(* package SOLVETRA *)
-(*
 *)
 
 \end{chunk}
@@ -191708,6 +242463,7 @@ TransSolvePackageService(R) : Exports == Implementation where
 
 
    Implementation == add
+
      import ACF
      import TranscendentalManipulations(R, RE)
      import ElementaryFunctionStructurePackage(R, RE)
@@ -191717,14 +242473,14 @@ TransSolvePackageService(R) : Exports == Implementation where
 
         ---- Local Function Declarations ----
 
-     subsSolve : ( SUP RE, NonNegativeInteger, SUP RE, SUP RE, Integer, Fraction SUP RE) -> Union(SUP RE , "failed" )
+     subsSolve : ( SUP RE, NonNegativeInteger, SUP RE, SUP RE, Integer, _
+                   Fraction SUP RE) -> Union(SUP RE , "failed" )
        --++ subsSolve(f, degf, g1, g2, m, h)
 
-
     -- exported functions
 
-
-     unvectorise(vect:Vector RE, var:Fraction SUP RE,n:Integer) : Fraction SUP RE ==
+     unvectorise(vect:Vector RE, var:Fraction SUP RE,n:Integer) : _
+          Fraction SUP RE ==
        Z:=new()@Symbol
        polyvar: Fraction SUP RE :=0
        for i in 1..((n+1)::Integer) repeat
@@ -191733,7 +242489,8 @@ TransSolvePackageService(R) : Exports == Implementation where
        polyvar
 
 
-     decomposeFunc(exprf:Fraction SUP RE , exprg:Fraction SUP RE, newH:Fraction SUP RE ) : Fraction SUP RE ==
+     decomposeFunc(exprf:Fraction SUP RE , exprg:Fraction SUP RE, _
+                   newH:Fraction SUP RE ) : Fraction SUP RE ==
        X:=new()@Symbol
        f1:=numer(exprf)
        f2:=denom(exprf)
@@ -191749,19 +242506,20 @@ TransSolvePackageService(R) : Exports == Implementation where
          if f2 = 1 then
            newF2:= 1 :: SUP RE
          else newF2:=subsSolve(f2,degF,g1,g2,m,newH)
-         if ( not ( newF1 case "failed" ) ) and ( not ( newF2 case "failed" ) ) then
+         if ( not ( newF1 case "failed" ) ) and _
+            ( not ( newF2 case "failed" ) ) then
            newF:=newF1/newF2
          else return exprf
        else return exprf
 
-
     -- local functions
 
-
-     subsSolve(F:SUP RE, DegF:NonNegativeInteger, G1:SUP RE, G2:SUP RE, M:Integer, HH: Fraction SUP RE) : Union(SUP RE , "failed" ) ==
+     subsSolve(F:SUP RE, DegF:NonNegativeInteger, G1:SUP RE, G2:SUP RE, _
+               M:Integer, HH: Fraction SUP RE) : Union(SUP RE , "failed" ) ==
        coeffmat:=new((DegF+1),1,0)@Matrix RE
        for i in 0..M repeat
-          coeffmat:=horizConcat(coeffmat, (vectorise( ( ( G1**((M-i)::NonNegativeInteger) )*G2**i ), (DegF+1) )::Matrix RE) )
+          coeffmat:=horizConcat(coeffmat, (vectorise( ( ( _
+           G1**((M-i)::NonNegativeInteger) )*G2**i ), (DegF+1) )::Matrix RE) )
        vec:= vectorise(F,DegF+1)
        coeffma:=subMatrix(coeffmat,1,(DegF+1),2,(M+2))
        solvar:=solve(coeffma,vec)
@@ -191776,6 +242534,72 @@ TransSolvePackageService(R) : Exports == Implementation where
 \begin{chunk}{COQ SOLVESER}
 (* package SOLVESER *)
 (*
+
+     import ACF
+     import TranscendentalManipulations(R, RE)
+     import ElementaryFunctionStructurePackage(R, RE)
+     import SparseUnivariatePolynomial(R)
+     import LinearSystemMatrixPackage(RE,Vector RE,Vector RE,Matrix RE)
+     import HomogeneousAggregate(R)
+
+        ---- Local Function Declarations ----
+
+     subsSolve : ( SUP RE, NonNegativeInteger, SUP RE, SUP RE, Integer, _
+                   Fraction SUP RE) -> Union(SUP RE , "failed" )
+       --++ subsSolve(f, degf, g1, g2, m, h)
+
+    -- exported functions
+
+     unvectorise(vect:Vector RE, var:Fraction SUP RE,n:Integer) : _
+          Fraction SUP RE ==
+       Z:=new()@Symbol
+       polyvar: Fraction SUP RE :=0
+       for i in 1..((n+1)::Integer) repeat
+          vecti:=univariate(vect( i ),first kernels(Z::RE))
+          polyvar:=polyvar + ( vecti )*( var )**( (n-i+1)::NonNegativeInteger )
+       polyvar
+
+
+     decomposeFunc(exprf:Fraction SUP RE , exprg:Fraction SUP RE, _
+                   newH:Fraction SUP RE ) : Fraction SUP RE ==
+       X:=new()@Symbol
+       f1:=numer(exprf)
+       f2:=denom(exprf)
+       g1:=numer(exprg)
+       g2:=denom(exprg)
+       degF:=max(degree(numer(exprf)),degree(denom(exprf)))
+       degG:=max(degree(g1),degree(g2))
+       newF1,newF2 : Union(SUP RE, "failed")
+       N:= degF exquo degG
+       if not ( N case "failed" ) then
+         m:=N::Integer
+         newF1:=subsSolve(f1,degF,g1,g2,m,newH)
+         if f2 = 1 then
+           newF2:= 1 :: SUP RE
+         else newF2:=subsSolve(f2,degF,g1,g2,m,newH)
+         if ( not ( newF1 case "failed" ) ) and _
+            ( not ( newF2 case "failed" ) ) then
+           newF:=newF1/newF2
+         else return exprf
+       else return exprf
+
+    -- local functions
+
+     subsSolve(F:SUP RE, DegF:NonNegativeInteger, G1:SUP RE, G2:SUP RE, _
+               M:Integer, HH: Fraction SUP RE) : Union(SUP RE , "failed" ) ==
+       coeffmat:=new((DegF+1),1,0)@Matrix RE
+       for i in 0..M repeat
+          coeffmat:=horizConcat(coeffmat, (vectorise( ( ( _
+           G1**((M-i)::NonNegativeInteger) )*G2**i ), (DegF+1) )::Matrix RE) )
+       vec:= vectorise(F,DegF+1)
+       coeffma:=subMatrix(coeffmat,1,(DegF+1),2,(M+2))
+       solvar:=solve(coeffma,vec)
+       if not ( solvar.particular  case  "failed" ) then
+         solvevarlist:=(solvar.particular)::Vector RE
+         resul:= numer(unvectorise(solvevarlist,( HH ),M))
+         resul
+       else return "failed"
+
 *)
 
 \end{chunk}
@@ -191901,6 +242725,33 @@ TriangularMatrixOperations(R,Row,Col,M): Exports == Implementation where
 \begin{chunk}{COQ TRIMAT}
 (* package TRIMAT *)
 (*
+
+    UpTriBddDenomInv(A,denom) ==
+      AI := zero(nrows A, nrows A)$M
+      offset := minColIndex AI - minRowIndex AI
+      for i in minRowIndex AI .. maxRowIndex AI
+        for j in minColIndex AI .. maxColIndex AI repeat
+          qsetelt_!(AI,i,j,(denom exquo qelt(A,i,j))::R)
+      for i in minRowIndex AI .. maxRowIndex AI repeat
+        for j in offset + i + 1 .. maxColIndex AI repeat
+          qsetelt_!(AI,i,j, - (((+/[qelt(AI,i,k) * qelt(A,k-offset,j)
+                                   for k in i+offset..(j-1)])
+                                     exquo qelt(A, j-offset, j))::R))
+      AI
+
+    LowTriBddDenomInv(A, denom) ==
+      AI := zero(nrows A, nrows A)$M
+      offset := minColIndex AI - minRowIndex AI
+      for i in minRowIndex AI .. maxRowIndex AI
+        for j in minColIndex AI .. maxColIndex AI repeat
+          qsetelt_!(AI,i,j,(denom exquo qelt(A,i,j))::R)
+      for i in minColIndex AI .. maxColIndex AI repeat
+        for j in i - offset + 1 .. maxRowIndex AI repeat
+          qsetelt_!(AI,j,i, - (((+/[qelt(A,j,k+offset) * qelt(AI,k,i)
+                                    for k in i-offset..(j-1)])
+                                      exquo qelt(A, j, j+offset))::R))
+      AI
+
 *)
 
 \end{chunk}
@@ -192020,6 +242871,7 @@ TrigonometricManipulations(R, F): Exports == Implementation where
       ++ complexForm(f) returns \spad{[real f, imag f]}.
 
   Implementation ==> add
+
     import ElementaryFunctionSign(R, F)
     import InnerTrigonometricManipulations(R,F,FG)
     import ElementaryFunctionStructurePackage(R, F)
@@ -192115,6 +242967,97 @@ TrigonometricManipulations(R, F): Exports == Implementation where
 \begin{chunk}{COQ TRIGMNIP}
 (* package TRIGMNIP *)
 (*
+
+    import ElementaryFunctionSign(R, F)
+    import InnerTrigonometricManipulations(R,F,FG)
+    import ElementaryFunctionStructurePackage(R, F)
+    import ElementaryFunctionStructurePackage(Complex R, FG)
+
+    s1  := sqrt(-1::F)
+    ipi := pi()$F * s1
+
+    K2KG          : K -> Kernel FG
+    kcomplex      : K -> Union(F, "failed")
+    locexplogs    : F -> FG
+    localexplogs  : (F, F, List SY) -> FG
+    complexKernels: F -> Record(ker: List K, val: List F)
+
+    K2KG k           == retract(tan F2FG first argument k)@Kernel(FG)
+    real? f          == empty?(complexKernels(f).ker)
+    real f           == real complexForm f
+    imag f           == imag complexForm f
+
+-- returns [[k1,...,kn], [v1,...,vn]] such that ki should be replaced by vi
+    complexKernels f ==
+      lk:List(K) := empty()
+      lv:List(F) := empty()
+      for k in tower f repeat
+        if (u := kcomplex k) case F then
+           lk := concat(k, lk)
+           lv := concat(u::F, lv)
+      [lk, lv]
+
+-- returns f if it is certain that k is not a real kernel and k = f,
+-- "failed" otherwise
+    kcomplex k ==
+      op := operator k
+      is?(k, "nthRoot"::SY) =>
+        arg := argument k
+        even?(retract(n := second arg)@Z) and ((u := sign(first arg)) case Z)
+          and (u::Z < 0) => op(s1, n / 2::F) * op(- first arg, n)
+        "failed"
+      is?(k, "log"::SY) and ((u := sign(a := first argument k)) case Z)
+          and (u::Z < 0) => op(- a) + ipi
+      "failed"
+
+    complexForm f ==
+      empty?((l := complexKernels f).ker) => complex(f, 0)
+      explogs2trigs locexplogs eval(f, l.ker, l.val)
+
+    locexplogs f ==
+      any?(x +-> has?(x, "rtrig"),
+           operators(g := realElementary f))$List(BasicOperator) =>
+              localexplogs(f, g, variables g)
+      F2FG g
+
+    complexNormalize(f, x) ==
+      any?(y +-> has?(operator y, "rtrig"),
+       [k for k in tower(g := realElementary(f, x))
+               | member?(x, variables(k::F))]$List(K))$List(K) =>
+                   FG2F(rischNormalize(localexplogs(f, g, [x]), x).func)
+      rischNormalize(g, x).func
+
+    complexNormalize f ==
+      l := variables(g := realElementary f)
+      any?(x +-> has?(x, "rtrig"), operators g)$List(BasicOperator) =>
+        h := localexplogs(f, g, l)
+        for x in l repeat h := rischNormalize(h, x).func
+        FG2F h
+      for x in l repeat g := rischNormalize(g, x).func
+      g
+
+    complexElementary(f, x) ==
+      any?(y +-> has?(operator y, "rtrig"),
+       [k for k in tower(g := realElementary(f, x))
+                 | member?(x, variables(k::F))]$List(K))$List(K) =>
+                     FG2F localexplogs(f, g, [x])
+      g
+
+    complexElementary f ==
+      any?(x +-> has?(x, "rtrig"),
+        operators(g := realElementary f))$List(BasicOperator) =>
+          FG2F localexplogs(f, g, variables g)
+      g
+
+    localexplogs(f, g, lx) ==
+      trigs2explogs(F2FG g, [K2KG k for k in tower f
+                          | is?(k, "tan"::SY) or is?(k, "cot"::SY)], lx)
+
+    trigs f ==
+      real? f => f
+      g := explogs2trigs F2FG f
+      real g + s1 * imag g
+
 *)
 
 \end{chunk}
@@ -192249,6 +243192,7 @@ TubePlotTools(): Exports == Implementation where
       ++ defining the loop.
  
   Implementation ==> add
+
     import PointPackage(SF)
  
     point(x,y,z,c) == point(l : L SF := [x,y,z,c])
@@ -192311,6 +243255,64 @@ TubePlotTools(): Exports == Implementation where
 \begin{chunk}{COQ TUBETOOL}
 (* package TUBETOOL *)
 (*
+
+    import PointPackage(SF)
+ 
+    point(x,y,z,c) == point(l : L SF := [x,y,z,c])
+ 
+    getColor: Pt -> SF
+    getColor pt == (maxIndex pt > 3 => color pt; 0)
+ 
+    getColor2: (Pt,Pt) -> SF
+    getColor2(p0,p1) ==
+      maxIndex p0 > 3 => color p0
+      maxIndex p1 > 3 => color p1
+      0
+ 
+    a * p ==
+      l : L SF := [a * xCoord p,a * yCoord p,a * zCoord p,getColor p]
+      point l
+ 
+    p0 + p1 ==
+      l : L SF := [xCoord p0 + xCoord p1,yCoord p0 + yCoord p1,_
+                   zCoord p0 + zCoord p1,getColor2(p0,p1)]
+      point l
+ 
+    p0 - p1 ==
+      l : L SF := [xCoord p0 - xCoord p1,yCoord p0 - yCoord p1,_
+                   zCoord p0 - zCoord p1,getColor2(p0,p1)]
+      point l
+ 
+    dot(p0,p1) ==
+      (xCoord p0 * xCoord p1) + (yCoord p0 * yCoord p1) +_
+        (zCoord p0 * zCoord p1)
+ 
+    cross(p0,p1) ==
+      x0 := xCoord p0; y0 := yCoord p0; z0 := zCoord p0;
+      x1 := xCoord p1; y1 := yCoord p1; z1 := zCoord p1;
+      l : L SF := [y0 * z1 - y1 * z0,z0 * x1 - z1 * x0,_
+                   x0 * y1 - x1 * y0,getColor2(p0,p1)]
+      point l
+ 
+    unitVector p == (inv sqrt dot(p,p)) * p
+ 
+    cosSinInfo n ==
+      ans : L L SF := nil()
+      theta : SF := 2 * pi()/n
+      for i in 1..(n-1) repeat             --!! make more efficient
+        angle := i * theta
+        ans := concat([cos angle,sin angle],ans)
+      ans
+ 
+    loopPoints(ctr,pNorm,bNorm,rad,cosSin) ==
+      ans : L Pt := nil()
+      while not null cosSin repeat
+        cossin := first cosSin; cos := first cossin; sin := second cossin
+        ans := cons(ctr + rad * (cos * pNorm + sin * bNorm),ans)
+        cosSin := rest cosSin
+      pt := ctr + rad * pNorm
+      concat(pt,concat(ans,pt))
+
 *)
 
 \end{chunk}
@@ -192442,6 +243444,7 @@ TwoDimensionalPlotClipping(): Exports == Implementation where
       ++ function.
  
   Implementation ==> add
+
     import PointPackage(DoubleFloat)
     import ListFunctions2(Point DoubleFloat,DoubleFloat)
  
@@ -192457,6 +243460,7 @@ TwoDimensionalPlotClipping(): Exports == Implementation where
     Pnan?:Pt ->Boolean
 
     Fnan? x == x~=x
+
     Pnan? p == any?(Fnan?,p)
    
     iClipParametric(pointLists,fraction,scale) ==
@@ -192480,7 +243484,8 @@ TwoDimensionalPlotClipping(): Exports == Implementation where
       yMax : SF := yCoord firstPt
       -- calculate min/max for the first (1-fraction)*N points
       -- this contracts the range
-      -- this unnecessarily clips monotonic functions (step-function, x^(high power),etc.)
+      -- this unnecessarily clips monotonic functions 
+      -- (step-function, x^(high power),etc.)
       for k in 0..lastN  for pt in rest sortedList repeat
         xMin := min(xMin,xCoord pt)
         xMax := max(xMax,xCoord pt)
@@ -192514,9 +243519,6 @@ TwoDimensionalPlotClipping(): Exports == Implementation where
       yseg:SEG SF :=yMin..yMax
       -- return original
       [pointLists,xseg,yseg]@CLIPPED
-      
-
-
  
     point(xx,yy) == point(l : L SF := [xx,yy])
  
@@ -192571,7 +243573,6 @@ TwoDimensionalPlotClipping(): Exports == Implementation where
       reverse_! cons(reverse_! list,ans)
  
     clip(plot,fraction,scale) ==
---      sayBrightly(["   clip: "::OutputForm]$List(OutputForm))$Lisp
       (fraction < 0) or (fraction > 1/2) =>
         error "clipDraw: fraction should be between 0 and 1/2"
       xVals := xRange plot
@@ -192659,6 +243660,7 @@ TwoDimensionalPlotClipping(): Exports == Implementation where
     clipParametric plot == clipParametric(plot,1/2,5/1)
  
     clip(l: L Pt)   == iClipParametric(list l,1/2,5/1)
+
     clip(l: L L Pt) == iClipParametric(l,1/2,5/1)
 
 \end{chunk}
@@ -192666,6 +243668,225 @@ TwoDimensionalPlotClipping(): Exports == Implementation where
 \begin{chunk}{COQ CLIP}
 (* package CLIP *)
 (*
+
+    import PointPackage(DoubleFloat)
+    import ListFunctions2(Point DoubleFloat,DoubleFloat)
+ 
+    point:(SF,SF) -> Pt
+    intersectWithHorizLine:(SF,SF,SF,SF,SF) -> Pt
+    intersectWithVertLine:(SF,SF,SF,SF,SF) -> Pt
+    intersectWithBdry:(SF,SF,SF,SF,Pt,Pt) -> Pt
+    discardAndSplit: (L Pt,Pt -> B,SF,SF,SF,SF) -> L L Pt
+    norm: Pt -> SF
+    iClipParametric: (L L Pt,RN,RN) -> CLIPPED
+    findPt: L L Pt -> Union(Pt,"failed")
+    Fnan?: SF ->Boolean
+    Pnan?:Pt ->Boolean
+
+    Fnan? x == x~=x
+
+    Pnan? p == any?(Fnan?,p)
+   
+    iClipParametric(pointLists,fraction,scale) ==
+      -- error checks and special cases
+      (fraction < 0) or (fraction > 1) =>
+        error "clipDraw: fraction should be between 0 and 1"
+      empty? pointLists => [nil(),segment(0,0),segment(0,0)]
+      -- put all points together , sort them according to norm
+      sortedList := sort((x:Pt,y:Pt):Boolean +-> norm(x) < norm(y),
+                     select((z:Pt):Boolean +-> not Pnan? z,concat pointLists))
+      empty? sortedList => [nil(),segment(0,0),segment(0,0)]
+      n := # sortedList 
+      num := numer fraction
+      den := denom fraction
+      clipNum := (n * num) quo den
+      lastN := n - 1 - clipNum
+      firstPt := first sortedList
+      xMin : SF := xCoord firstPt
+      xMax : SF := xCoord firstPt
+      yMin : SF := yCoord firstPt 
+      yMax : SF := yCoord firstPt
+      -- calculate min/max for the first (1-fraction)*N points
+      -- this contracts the range
+      -- this unnecessarily clips monotonic functions 
+      -- (step-function, x^(high power),etc.)
+      for k in 0..lastN  for pt in rest sortedList repeat
+        xMin := min(xMin,xCoord pt)
+        xMax := max(xMax,xCoord pt)
+        yMin := min(yMin,yCoord pt)
+        yMax := max(yMax,yCoord pt)
+      xDiff := xMax - xMin; yDiff := yMax - yMin
+      xDiff = 0 =>
+        yDiff = 0 =>
+          [pointLists,segment(xMin-1,xMax+1),segment(yMin-1,yMax+1)]
+        [pointLists,segment(xMin-1,xMax+1),segment(yMin,yMax)]
+      yDiff = 0 =>
+        [pointLists,segment(xMin,xMax),segment(yMin-1,yMax+1)]
+      numm := numer scale; denn := denom scale
+      -- now expand the range by scale
+      xMin := xMin - (numm :: SF) * xDiff / (denn :: SF)
+      xMax := xMax + (numm :: SF) * xDiff / (denn :: SF)
+      yMin := yMin - (numm :: SF) * yDiff / (denn :: SF)
+      yMax := yMax + (numm :: SF) * yDiff / (denn :: SF)
+      -- clip with the calculated range
+      newclip:=clipWithRanges(pointLists,xMin,xMax,yMin,yMax)
+      -- if we split the lists use the new clip
+      # (newclip.brans) > # pointLists   => newclip
+      -- calculate extents
+      xs :L SF:= map (xCoord,sortedList)
+      ys :L SF:= map (yCoord,sortedList)
+      xMin :SF :=reduce (min,xs)
+      yMin :SF :=reduce (min,ys)
+      xMax :SF :=reduce (max,xs)
+      yMax :SF :=reduce (max,ys) 
+      xseg:SEG SF :=xMin..xMax
+      yseg:SEG SF :=yMin..yMax
+      -- return original
+      [pointLists,xseg,yseg]@CLIPPED
+ 
+    point(xx,yy) == point(l : L SF := [xx,yy])
+ 
+    intersectWithHorizLine(x1,y1,x2,y2,yy) ==
+      x1 = x2 => point(x1,yy)
+      point(x1 + (x2 - x1)*(yy - y1)/(y2 - y1),yy)
+ 
+    intersectWithVertLine(x1,y1,x2,y2,xx) ==
+      y1 = y2 => point(xx,y1)
+      point(xx,y1 + (y2 - y1)*(xx - x1)/(x2 - x1))
+ 
+    intersectWithBdry(xMin,xMax,yMin,yMax,pt1,pt2) ==
+      -- pt1 is in rectangle, pt2 is not
+      x1 := xCoord pt1; y1 := yCoord pt1
+      x2 := xCoord pt2; y2 := yCoord pt2
+      if y2 > yMax then
+        pt2 := intersectWithHorizLine(x1,y1,x2,y2,yMax)
+        x2 := xCoord pt2; y2 := yCoord pt2
+      if y2 < yMin then
+        pt2 := intersectWithHorizLine(x1,y1,x2,y2,yMin)
+        x2 := xCoord pt2; y2 := yCoord pt2
+      if x2 > xMax then
+        pt2 := intersectWithVertLine(x1,y1,x2,y2,xMax)
+        x2 := xCoord pt2; y2 := yCoord pt2
+      if x2 < xMin then
+        pt2 := intersectWithVertLine(x1,y1,x2,y2,xMin)
+      pt2
+ 
+    discardAndSplit(pointList,pred,xMin,xMax,yMin,yMax) ==
+      ans : L L Pt := nil()
+      list : L Pt  := nil()
+      lastPt? : B  := false
+      lastPt : Pt  := point(0,0)
+      while not empty? pointList repeat
+        pt := first pointList
+        pointList := rest pointList
+        pred(pt) =>
+          if (empty? list) and lastPt? then
+            bdryPt := intersectWithBdry(xMin,xMax,yMin,yMax,pt,lastPt)
+            -- print bracket [ coerce bdryPt ,coerce pt ]
+            --list := cons(bdryPt,list)
+          list := cons(pt,list)
+        if not empty? list then
+          bdryPt := intersectWithBdry(xMin,xMax,yMin,yMax,first list,pt)
+          -- print bracket [ coerce bdryPt,coerce first list]
+          --list := cons(bdryPt,list)
+          ans := cons( list,ans)
+        lastPt := pt 
+        lastPt? := true
+        list := nil()
+      empty? list => ans
+      reverse_! cons(reverse_! list,ans)
+ 
+    clip(plot,fraction,scale) ==
+      (fraction < 0) or (fraction > 1/2) =>
+        error "clipDraw: fraction should be between 0 and 1/2"
+      xVals := xRange plot
+      empty?(pointLists := listBranches plot) =>
+        [nil(),xVals,segment(0,0)]
+      more?(pointLists := listBranches plot,1) =>
+        error "clipDraw: plot has more than one branch"
+      empty?(pointList := first pointLists) =>
+        [nil(),xVals,segment(0,0)]
+      sortedList := sort((x,y)+->yCoord(x) < yCoord(y),pointList)
+      n := # sortedList; num := numer fraction; den := denom fraction
+      clipNum := (n * num) quo den
+      -- throw out points with large and small y-coordinates
+      yMin := yCoord(sortedList.clipNum)
+      yMax := yCoord(sortedList.(n - 1 - clipNum))
+      if Fnan? yMin then yMin : SF := 0
+      if Fnan? yMax then yMax : SF := 0
+      (yDiff := yMax - yMin) = 0 =>
+        [pointLists,xRange plot,segment(yMin - 1,yMax + 1)]
+      numm := numer scale; denn := denom scale
+      xMin := lo xVals; xMax := hi xVals
+      yMin := yMin - (numm :: SF) * yDiff / (denn :: SF)
+      yMax := yMax + (numm :: SF) * yDiff / (denn :: SF)
+      lists := discardAndSplit(pointList,_
+         x +-> (yCoord(x) < yMax) and (yCoord(x) > yMin),
+           xMin,xMax,yMin,yMax)
+      yMin := yCoord(sortedList.clipNum)
+      yMax := yCoord(sortedList.(n - 1 - clipNum))
+      if Fnan? yMin then yMin : SF := 0
+      if Fnan? yMax then yMax : SF := 0
+      for list in lists repeat
+        for pt in list repeat
+          if not Fnan?(yCoord pt) then
+            yMin := min(yMin,yCoord pt)
+            yMax := max(yMax,yCoord pt)
+      [lists,xVals,segment(yMin,yMax)]
+ 
+    clip(plot:PLOT) == clip(plot,1/4,5/1)
+ 
+    norm(pt) == 
+      x := xCoord(pt); y := yCoord(pt)
+      if Fnan? x then
+        if Fnan? y then
+          r:SF := 0
+        else
+          r:SF := y**2
+      else
+        if Fnan? y then
+          r:SF := x**2
+        else
+          r:SF := x**2 + y**2
+      r
+ 
+    findPt lists ==
+      for list in lists repeat
+        not empty? list => 
+             for p in list repeat 
+               not Pnan? p => return p
+      "failed"
+
+    clipWithRanges(pointLists,xMin,xMax,yMin,yMax) ==
+      lists : L L Pt := nil()
+      for pointList in pointLists repeat
+        lists := concat(lists,discardAndSplit(pointList,
+          (x:Pt):Boolean +-> (xCoord(x) <= xMax) and (xCoord(x) >= xMin) and 
+            (yCoord(x) <= yMax) and (yCoord(x) >= yMin), 
+             xMin,xMax,yMin,yMax))
+      (pt := findPt lists) case "failed" =>
+        [nil(),segment(0,0),segment(0,0)]
+      firstPt := pt :: Pt
+      xMin : SF := xCoord firstPt; xMax : SF := xCoord firstPt
+      yMin : SF := yCoord firstPt; yMax : SF := yCoord firstPt
+      for list in lists repeat
+        for pt in list repeat
+          if not Pnan? pt then
+            xMin := min(xMin,xCoord pt)
+            xMax := max(xMax,xCoord pt)
+            yMin := min(yMin,yCoord pt)
+            yMax := max(yMax,yCoord pt)
+      [lists,segment(xMin,xMax),segment(yMin,yMax)]
+ 
+    clipParametric(plot,fraction,scale) ==
+      iClipParametric(listBranches plot,fraction,scale)
+ 
+    clipParametric plot == clipParametric(plot,1/2,5/1)
+ 
+    clip(l: L Pt)   == iClipParametric(list l,1/2,5/1)
+
+    clip(l: L L Pt) == iClipParametric(l,1/2,5/1)
+
 *)
 
 \end{chunk}
@@ -192763,6 +243984,195 @@ TwoFactorize(F) : C == T
       ++ of the coefficients of p).
  
   T == add
+
+    PI ==> PositiveInteger
+    NNI ==> NonNegativeInteger
+    import CommuteUnivariatePolynomialCategory(F,R,P)
+
+                   ----  Local Functions  ----
+    computeDegree  :  (P,Integer,Integer) -> PI
+    exchangeVars   :           P          -> P
+    exchangeVarTerm:        (R, NNI)      -> P
+    pthRoot        :     (R, NNI, NNI)    -> R
+ 
+    -- compute the degree of the extension to reduce the polynomial to a
+    -- univariate one
+    computeDegree(m : P,mx:Integer,q:Integer): PI ==
+      my:=degree m
+      n1:Integer:=length(10*mx*my)
+      n2:Integer:=length(q)-1
+      n:=(n1 quo n2)+1
+      n::PI
+ 
+    exchangeVars(p : P) : P ==
+       p = 0 => 0
+       exchangeVarTerm(leadingCoefficient p, degree p) +
+          exchangeVars(reductum p)
+
+    exchangeVarTerm(c:R, e:NNI) : P ==
+       c = 0 => 0
+       monomial(monomial(leadingCoefficient c, e)$R, degree c)$P + 
+          exchangeVarTerm(reductum c, e)
+
+    pthRoot(poly:R,p:NonNegativeInteger,PthRootPow:NonNegativeInteger):R ==
+       tmp:=divideExponents(map((x:F):F+->(x::F)**PthRootPow,poly),p)
+       tmp case "failed" => error "consistency error in TwoFactor"
+       tmp
+ 
+    fUnion ==> Union("nil", "sqfr", "irred", "prime")
+    FF     ==> Record(flg:fUnion, fctr:P, xpnt:Integer)
+
+    generalSqFr(m:P): Factored P ==
+       m = 0 => 0
+       degree m = 0 =>
+         l:=squareFree(leadingCoefficient m)
+         makeFR(unit(l)::P,[[u.flg,u.fctr::P,u.xpnt] for u in factorList l])
+       cont := content m
+       m := (m exquo cont)::P
+       sqfrm := squareFree m
+       pfaclist : List FF := empty()
+       unitPart := unit sqfrm
+       for u in factorList sqfrm repeat
+          u.flg = "nil" =>
+             uexp:NNI:=(u.xpnt):NNI
+             nfacs:=squareFree(exchangeVars u.fctr)
+             for v in factorList nfacs repeat
+                pfaclist:=cons([v.flg, exchangeVars v.fctr, v.xpnt*uexp],
+                              pfaclist)
+             unitPart := unit(nfacs)**uexp * unitPart
+          pfaclist := cons(u,pfaclist)
+       cont ^= 1 =>
+           sqp := squareFree cont
+           contlist:=[[w.flg,(w.fctr)::P,w.xpnt] for w in factorList sqp]
+           pfaclist:= append(contlist, pfaclist)
+           makeFR(unit(sqp)*unitPart,pfaclist)
+       makeFR(unitPart,pfaclist)
+
+        
+    generalTwoFactor(m:P): Factored P ==
+       m = 0 => 0
+       degree m = 0 =>
+         l:=factor(leadingCoefficient m)$DistinctDegreeFactorize(F,R)
+         makeFR(unit(l)::P,[[u.flg,u.fctr::P,u.xpnt] for u in factorList l])
+       ll:List FF
+       ll:=[]
+       unitPart:P
+       cont:=content m
+       if degree(cont)>0 then 
+          m1:=m exquo cont
+          m1 case "failed" => error "content doesn't divide"
+          m:=m1
+          contfact:=factor(cont)$DistinctDegreeFactorize(F,R)
+          unitPart:=(unit contfact)::P
+          ll:=[[w.flg,(w.fctr)::P,w.xpnt] for w in factorList contfact]
+       else
+          unitPart:=cont::P
+       sqfrm:=squareFree m
+       for u in factors sqfrm repeat
+           expo:=u.exponent
+           if expo < 0 then error "negative exponent in a factorisation"
+           expon:NonNegativeInteger:=expo::NonNegativeInteger
+           fac:=u.factor
+           degree fac = 1 => ll:=[["irred",fac,expon],:ll]
+           differentiate fac = 0 =>      
+              -- the polynomial is  inseparable w.r.t. its main variable
+              map(differentiate,fac) = 0 =>
+                p:=characteristic$F
+                PthRootPow:=(size$F exquo p)::NonNegativeInteger
+                m1:=divideExponents(map(x+->pthRoot(x,p,PthRootPow),fac),p)
+                m1 case "failed" => error "consistency error in TwoFactor"
+                res:=generalTwoFactor m1
+                unitPart:=unitPart*unit(res)**((p*expon)::NNI)
+                ll:=
+                 [:[[v.flg,v.fctr,expon*p*v.xpnt] for v in factorList res],:ll]
+              m2:=generalTwoFactor swap fac
+              unitPart:=unitPart*unit(m2)**(expon::NNI)
+              ll:=
+               [:[[v.flg,swap v.fctr,expon*v.xpnt] for v in factorList m2],:ll]
+           ydeg:="max"/[degree w for w in coefficients fac]
+           twoF:=twoFactor(fac,ydeg)
+           unitPart:=unitPart*unit(twoF)**expon
+           ll:=[:[[v.flg,v.fctr,expon*v.xpnt] for v in factorList twoF],
+                :ll]
+       makeFR(unitPart,ll)
+ 
+    -- factorization of a primitive square-free bivariate polynomial --
+    twoFactor(m:P,dx:Integer):Factored P ==
+       -- choose the degree for the extension
+       n:PI:=computeDegree(m,dx,size()$F)
+       -- extend the field
+       -- find the substitution for x
+       look:Boolean:=true
+       dm:=degree m
+       try:Integer:=min(5,size()$F)
+       i:Integer:=0
+       lcm := leadingCoefficient m
+       umv : R
+       while look and i < try repeat
+          vval := random()$F
+          i:=i+1
+          zero? elt(lcm, vval) => "next value"
+          umv := map(x +-> elt(x,vval), m)$UPCF2(R, P, F, R)
+          degree(gcd(umv,differentiate umv))^=0 => "next val"
+          n := 1
+          look := false
+       extField:=FiniteFieldExtension(F,n)
+       SUEx:=SUP extField
+       TP:=SparseUnivariatePolynomial SUEx
+       mm:TP:=0
+       m1:=m
+       while m1^=0 repeat
+         mm:=mm+monomial(map(coerce,leadingCoefficient m1)$UPCF2(F,R,
+                extField,SUEx),degree m1)
+         m1:=reductum m1
+       lcmm := leadingCoefficient mm
+       val : extField
+       umex : SUEx
+       if not look then
+          val := vval :: extField
+          umex := map(coerce, umv)$UPCF2(F, R, extField, SUEx)
+       while look repeat
+         val:=random()$extField
+         i:=i+1
+         elt(lcmm,val)=0 => "next value"
+         umex := map(x +-> elt(x,val), mm)$UPCF2(SUEx, TP, extField, SUEx)
+         degree(gcd(umex,differentiate umex))^=0 => "next val"
+         look:=false
+       prime:SUEx:=monomial(1,1)-monomial(val,0)
+       fumex:=factor(umex)$DistinctDegreeFactorize(extField,SUEx)
+       lfact1:=factors fumex
+
+       #lfact1=1 => primeFactor(m,1)
+       lfact : List TP :=
+          [map(coerce,lf.factor)$UPCF2(extField,SUEx,SUEx,TP)
+           for lf in lfact1]
+       lfact:=cons(map(coerce,unit fumex)$UPCF2(extField,SUEx,SUEx,TP),
+                   lfact)
+       import GeneralHenselPackage(SUEx,TP)
+       dx1:PI:=(dx+1)::PI
+       lfacth:=completeHensel(mm,lfact,prime,dx1)
+       lfactk: List P :=[]
+       Normp := NormRetractPackage(F, extField, SUEx, TP, n)
+      
+       while not empty? lfacth repeat
+         ff := first lfacth
+         lfacth := rest lfacth
+         if (c:=leadingCoefficient leadingCoefficient ff) ^=1 then
+           ff:=((inv c)::SUEx)* ff
+         not ((ffu:= retractIfCan(ff)$Normp) case "failed") =>
+                    lfactk := cons(ffu::P, lfactk)
+         normfacs := normFactors(ff)$Normp
+         lfacth := [g for g in lfacth | not member?(g, normfacs)]
+         ffn := */normfacs
+         lfactk:=cons(retractIfCan(ffn)$Normp :: P, lfactk)
+       */[primeFactor(ff1,1) for ff1 in lfactk]
+
+\end{chunk}
+
+\begin{chunk}{COQ TWOFACT}
+(* package TWOFACT *)
+(*
+
     PI ==> PositiveInteger
     NNI ==> NonNegativeInteger
     import CommuteUnivariatePolynomialCategory(F,R,P)
@@ -192781,8 +244191,6 @@ TwoFactorize(F) : C == T
       n2:Integer:=length(q)-1
       n:=(n1 quo n2)+1
       n::PI
---      n=1 => 1$PositiveInteger
---      (nextPrime(max(n,min(mx,my)))$IntegerPrimesPackage(Integer))::PI
  
     exchangeVars(p : P) : P ==
        p = 0 => 0
@@ -192947,11 +244355,6 @@ TwoFactorize(F) : C == T
          lfactk:=cons(retractIfCan(ffn)$Normp :: P, lfactk)
        */[primeFactor(ff1,1) for ff1 in lfactk]
 
-\end{chunk}
-
-\begin{chunk}{COQ TWOFACT}
-(* package TWOFACT *)
-(*
 *)
 
 \end{chunk}
@@ -193056,6 +244459,7 @@ UnivariateFactorize(ZP) : public == private where
        ++ assumed square free.
 
   private == add
+
                  --- local functions ---
 
      henselfact  :           ZP      -> List(ZP)
@@ -193197,7 +244601,6 @@ UnivariateFactorize(ZP) : public == private where
      -- and mindeg m = 0
      henselfact1(m: ZP):List(ZP) ==
       zero? degree m =>
---          one? m => []
           (m = 1) => []
           [m]
       selected := choose(m)
@@ -193213,7 +244616,8 @@ UnivariateFactorize(ZP) : public == private where
      henselfact(m: ZP):List ZP ==
       deggcd:=degree m
       mm:= m
-      while not zero? mm repeat (deggcd:=gcd(deggcd, degree mm); mm:=reductum mm)
+      while not zero? mm _
+        repeat (deggcd:=gcd(deggcd, degree mm); mm:=reductum mm)
       deggcd>1 and deggcd<degree m =>
          faclist := henselfact1(divideExponents(m, deggcd)::ZP)
          "append"/[henselfact1 multiplyExponents(mm, deggcd) for mm in faclist]
@@ -193250,41 +244654,31 @@ UnivariateFactorize(ZP) : public == private where
      henselFact(m: ZP,test:Boolean):FinalFact ==
       factorlist : List(ParFact) := []
       c : Z
-
       -- make m primitive
       c := content m
       m := (m exquo c)::ZP
-
       -- make the lc m positive
       if leadingCoefficient m < 0 then
         c := -c
         m := -m
-
       -- is x**d factor of m?
       if (d := minimumDegree m) >0 then
         m := (monicDivide(m,monomial(1,d))).quotient
         factorlist := [[monomial(1,1),d]$ParFact]
-
       d := degree m
-
       -- is m constant?
       d=0 => [c,factorlist]$FinalFact
-
       -- is m linear?
       d=1 => [c,cons([m,1]$ParFact,factorlist)]$FinalFact
-
       -- does m satisfy Eisenstein's criterion?
       eisenstein m => [c,cons([m,1]$ParFact,factorlist)]$FinalFact
-
       lcPol : ZP := leadingCoefficient(m) :: ZP
-
       -- is m cyclotomic (x**n - 1)?
       -lcPol = reductum(m) =>    -- if true, both will = 1
         for fac in
           (cyclotomicDecomposition(degree m)$CYC : List ZP) repeat
             factorlist := cons([fac,1]$ParFact,factorlist)
         [c,factorlist]$FinalFact
-
       -- is m odd cyclotomic (x**(2*n+1) + 1)?
       odd?(d) and (lcPol = reductum(m)) =>
         for sfac in cyclotomicDecomposition(degree m)$CYC repeat
@@ -193292,13 +244686,11 @@ UnivariateFactorize(ZP) : public == private where
            if leadingCoefficient fac < 0 then fac := -fac
            factorlist := cons([fac,1]$ParFact,factorlist)
         [c,factorlist]$FinalFact
-
       -- is the poly of the form x**n + 1 with n a power of 2?
       -- if so, then irreducible
       isPowerOf2(d) and (lcPol = reductum(m)) =>
         factorlist := cons([m,1]$ParFact,factorlist)
         [c,factorlist]$FinalFact
-
       -- is m quadratic?
       d=2 =>
        lfq:List(ZP) := quadratic m
@@ -193307,16 +244699,13 @@ UnivariateFactorize(ZP) : public == private where
        if lf0=lf1 then factorlist := cons([lf0,2]$ParFact,factorlist)
        else factorlist := append([[v,1]$ParFact for v in lfq],factorlist)
        [c,factorlist]$FinalFact
-
       -- m is square-free
       test =>
         fln := henselfact(m)
         [c,append(factorlist,[[pf,1]$ParFact for pf in fln])]$FinalFact
-
       -- find the square-free decomposition of m
       irrFact := squareFree(m)
       llf := factors irrFact
-
       -- factorize the square-free primitive terms
       for l1 in llf repeat
         d1 := l1.exponent
@@ -193334,6 +244723,265 @@ UnivariateFactorize(ZP) : public == private where
 \begin{chunk}{COQ UNIFACT}
 (* package UNIFACT *)
 (*
+
+                 --- local functions ---
+
+     henselfact  :           ZP      -> List(ZP)
+     quadratic   :           ZP      -> List(ZP)
+     remp        :        (Z, PI)    -> Z
+     negShiftz   :        (Z, PI)    -> Z
+     negShiftp   :        (ZP,PI)    -> ZP
+     bound       :           ZP      -> PI
+     choose      :           ZP      -> FirstStep
+     eisenstein  :           ZP      -> Boolean
+     isPowerOf2  :           Z       -> Boolean
+     subMinusX   :          SUPZ     -> ZP
+     sqroot      :           Z       -> Z
+
+                 ---   declarations  ---
+     CYC       ==> CyclotomicPolynomialPackage()
+     DDRecord  ==> Record(factor: ZP,degree: Z)
+     DDList    ==> List DDRecord
+     FirstStep ==> Record(prime:PI,factors:DDList)
+     ContPrim  ==> Record(cont: Z,prim: ZP)
+
+     import GeneralHenselPackage(Z,ZP)
+     import ModularDistinctDegreeFactorizer ZP
+
+
+     factor(m: ZP) ==
+       flist := henselFact(m,false)
+       ctp:=unitNormal flist.contp
+       makeFR((ctp.unit)::ZP,cons(["nil",ctp.canonical::ZP,1$Z]$FFE,
+                      [["prime",u.irr,u.pow]$FFE for u in flist.factors]))
+
+     factorSquareFree(m: ZP) ==
+       flist := henselFact(m,true)
+       ctp:=unitNormal flist.contp
+       makeFR((ctp.unit)::ZP,cons(["nil",ctp.canonical::ZP,1$Z]$FFE,
+                     [["prime",u.irr,u.pow]$FFE for u in flist.factors]))
+
+
+     -- Integer square root: returns 0 if t is non-positive
+     sqroot(t: Z): Z  ==
+      t <= 0 => 0
+      s:Integer:=t::Integer
+      s:=approxSqrt(s)$IntegerRoots(Integer)
+      t:=s::Z
+      t
+
+     -- Eisenstein criterion: returns true if polynomial is
+     -- irreducible. Result of false in inconclusive.
+     eisenstein(m : ZP): Boolean ==
+       -- calculate the content of the terms after the first
+       c := content reductum m
+       c = 0 => false
+       c = 1 => false
+       -- factor the content
+       -- if there is a prime in the factorization that does not divide
+       -- the leading term and appears to multiplicity 1, and the square
+       -- of this does not divide the last coef, return true.
+       -- Otherwise reurn false.
+       lead := leadingCoefficient m
+       trail := lead
+       m := reductum m
+       while m ^= 0 repeat
+         trail := leadingCoefficient m
+         m:= reductum m
+       fc := factor(c) :: Factored(Z)
+       for r in factors fc repeat
+         if (r.exponent = 1) and (0 ^= (lead rem r.factor)) and
+           (0 ^= (trail rem (r.factor ** 2))) then return true
+       false
+
+     negShiftz(n: Z,Modulus:PI): Z ==
+       if n < 0 then n := n+Modulus
+       n > (Modulus quo 2) => n-Modulus
+       n
+
+     negShiftp(pp: ZP,Modulus:PI): ZP ==
+       map(x +-> negShiftz(x,Modulus),pp)
+
+     -- Choose the bound for the coefficients of factors
+     bound(m: ZP):PI ==
+       nm,nmq2,lcm,bin0,bin1:NNI
+       cbound,j : PI
+       k:NNI
+       lcm := abs(leadingCoefficient m)::NNI
+       nm := (degree m)::NNI
+       nmq2:NNI := nm quo 2
+       norm: Z := sqroot(+/[coefficient(m,k)**2 for k in 0..nm])
+       if nmq2^=1 then nm := (nmq2-1):NNI
+       else nm := nmq2
+       bin0 := nm
+       cbound := (bin0*norm+lcm)::PI
+       for i in 2..(nm-1)::NNI repeat
+         bin1 := bin0
+         bin0 := (bin0*(nm+1-i):NNI) quo i
+         j := (bin0*norm+bin1*lcm)::PI
+         if cbound<j then cbound := j
+       (2*cbound*lcm)::PI -- adjusted by lcm to prepare for exquo in ghensel
+
+     remp(t: Z,q:PI): Z == ((t := t rem q)<0 => t+q ;t)
+
+     numFactors(ddlist:DDList): Z ==
+       ans: Z := 0
+       for dd in ddlist repeat
+         (d := degree(dd.factor)) = 0 => nil
+         ans := ans + ((d pretend Z) exquo dd.degree):: Z
+       ans
+
+     -- select the prime,try up to 4 primes,
+     -- choose the one yielding the fewest factors, but stopping if
+     -- fewer than 9 factors
+     choose(m: ZP):FirstStep ==
+       qSave:PI := 1
+       ddSave:DDList := []
+       numberOfFactors: Z := 0
+       lcm := leadingCoefficient m
+       k: Z := 1
+       ddRep := 5
+       disc:ZP:=0
+       q:PI:=2
+       while k<ddRep repeat
+         -- q must be a new prime number at each iteration
+         q:=nextPrime(q)$IntegerPrimesPackage(Z) pretend PI
+         (rr:=lcm rem q) = 0$Z => "next prime"
+         disc:=gcd(m,differentiate m,q)
+         (degree disc)^=0 => "next prime"
+         k := k+1
+         newdd := ddFact(m,q)
+         ((n := numFactors(newdd)) < 9) =>
+           ddSave := newdd
+           qSave := q
+           k := 5
+         (numberOfFactors = 0) or (n < numberOfFactors) =>
+           ddSave := newdd
+           qSave := q
+           numberOfFactors := n
+       [qSave,ddSave]$FirstStep
+
+     -- Find the factors of m,primitive, square-free, with lc positive
+     -- and mindeg m = 0
+     henselfact1(m: ZP):List(ZP) ==
+      zero? degree m =>
+          (m = 1) => []
+          [m]
+      selected := choose(m)
+      (numFactors(selected.factors) = 1$Z) => [m]
+      q := selected.prime
+      fl := separateFactors(selected.factors,q)
+      --choose the bound
+      cbound := bound(m)
+      completeHensel(m,fl,q,cbound)
+
+     -- check for possible degree reduction
+     -- could use polynomial decomposition ?
+     henselfact(m: ZP):List ZP ==
+      deggcd:=degree m
+      mm:= m
+      while not zero? mm _
+        repeat (deggcd:=gcd(deggcd, degree mm); mm:=reductum mm)
+      deggcd>1 and deggcd<degree m =>
+         faclist := henselfact1(divideExponents(m, deggcd)::ZP)
+         "append"/[henselfact1 multiplyExponents(mm, deggcd) for mm in faclist]
+      henselfact1 m
+
+     quadratic(m: ZP):List(ZP) ==
+       d,d2: Z
+       d := coefficient(m,1)**2-4*coefficient(m,0)*coefficient(m,2)
+       d2 := sqroot(d)
+       (d-d2**2)^=0 => [m]
+       alpha: Z := coefficient(m,1)+d2
+       beta: Z := 2*coefficient(m,2)
+       d := gcd(alpha,beta)
+       if d ^=1 then
+         alpha := alpha quo d
+         beta := beta quo d
+       m0: ZP := monomial(beta,1)+monomial(alpha,0)
+       cons(m0,[(m exquo m0):: ZP])
+
+     isPowerOf2(n : Z): Boolean ==
+       n = 1 => true
+       qr : Record(quotient: Z, remainder: Z) := divide(n,2)
+       qr.remainder = 1 => false
+       isPowerOf2 qr.quotient
+
+     subMinusX(supPol : SUPZ): ZP ==
+       minusX : SUPZ := monomial(-1,1)$SUPZ
+       (elt(supPol,minusX)$SUPZ) : ZP
+
+--   Factorize the polynomial m, test=true if m is known to be
+--   square-free, false otherwise.
+--   FinalFact.contp=content m, FinalFact.factors=List of irreducible
+--   factors with exponent .
+     henselFact(m: ZP,test:Boolean):FinalFact ==
+      factorlist : List(ParFact) := []
+      c : Z
+      -- make m primitive
+      c := content m
+      m := (m exquo c)::ZP
+      -- make the lc m positive
+      if leadingCoefficient m < 0 then
+        c := -c
+        m := -m
+      -- is x**d factor of m?
+      if (d := minimumDegree m) >0 then
+        m := (monicDivide(m,monomial(1,d))).quotient
+        factorlist := [[monomial(1,1),d]$ParFact]
+      d := degree m
+      -- is m constant?
+      d=0 => [c,factorlist]$FinalFact
+      -- is m linear?
+      d=1 => [c,cons([m,1]$ParFact,factorlist)]$FinalFact
+      -- does m satisfy Eisenstein's criterion?
+      eisenstein m => [c,cons([m,1]$ParFact,factorlist)]$FinalFact
+      lcPol : ZP := leadingCoefficient(m) :: ZP
+      -- is m cyclotomic (x**n - 1)?
+      -lcPol = reductum(m) =>    -- if true, both will = 1
+        for fac in
+          (cyclotomicDecomposition(degree m)$CYC : List ZP) repeat
+            factorlist := cons([fac,1]$ParFact,factorlist)
+        [c,factorlist]$FinalFact
+      -- is m odd cyclotomic (x**(2*n+1) + 1)?
+      odd?(d) and (lcPol = reductum(m)) =>
+        for sfac in cyclotomicDecomposition(degree m)$CYC repeat
+           fac:=subMinusX sfac
+           if leadingCoefficient fac < 0 then fac := -fac
+           factorlist := cons([fac,1]$ParFact,factorlist)
+        [c,factorlist]$FinalFact
+      -- is the poly of the form x**n + 1 with n a power of 2?
+      -- if so, then irreducible
+      isPowerOf2(d) and (lcPol = reductum(m)) =>
+        factorlist := cons([m,1]$ParFact,factorlist)
+        [c,factorlist]$FinalFact
+      -- is m quadratic?
+      d=2 =>
+       lfq:List(ZP) := quadratic m
+       #lfq=1 => [c,cons([lfq.first,1]$ParFact,factorlist)]$FinalFact
+       (lf0,lf1) := (lfq.first,second lfq)
+       if lf0=lf1 then factorlist := cons([lf0,2]$ParFact,factorlist)
+       else factorlist := append([[v,1]$ParFact for v in lfq],factorlist)
+       [c,factorlist]$FinalFact
+      -- m is square-free
+      test =>
+        fln := henselfact(m)
+        [c,append(factorlist,[[pf,1]$ParFact for pf in fln])]$FinalFact
+      -- find the square-free decomposition of m
+      irrFact := squareFree(m)
+      llf := factors irrFact
+      -- factorize the square-free primitive terms
+      for l1 in llf repeat
+        d1 := l1.exponent
+        pol := l1.factor
+        degree pol=1 => factorlist := cons([pol,d1]$ParFact,factorlist)
+        degree pol=2 =>
+          fln := quadratic(pol)
+          factorlist := append([[pf,d1]$ParFact for pf in fln],factorlist)
+        fln := henselfact(pol)
+        factorlist := append([[pf,d1]$ParFact for pf in fln],factorlist)
+      [c,factorlist]$FinalFact
+
 *)
 
 \end{chunk}
@@ -193413,6 +245061,12 @@ UnivariateFormalPowerSeriesFunctions(Coef: Ring): Exports == Implementation
 \begin{chunk}{COQ UFPS1}
 (* package UFPS1 *)
 (*
+
+      hadamard(f, g) ==
+        series map((z1:Coef,z2:Coef):Coef +-> z1*z2, 
+                    coefficients f, coefficients g)
+                     $StreamFunctions3(Coef, Coef, Coef) 
+
 *)
 
 \end{chunk}
@@ -193494,8 +245148,8 @@ UnivariateLaurentSeriesFunctions2(Coef1,Coef2,var1,var2,cen1,cen2):_
 
   Exports ==> with
     map: (Coef1 -> Coef2,ULS1) -> ULS2
-      ++ \spad{map(f,g(x))} applies the map f to the coefficients of the Laurent
-      ++ series \spad{g(x)}.
+      ++ \spad{map(f,g(x))} applies the map f to the coefficients of 
+      ++ the Laurent series \spad{g(x)}.
 
   Implementation ==> add
 
@@ -193506,6 +245160,9 @@ UnivariateLaurentSeriesFunctions2(Coef1,Coef2,var1,var2,cen1,cen2):_
 \begin{chunk}{COQ ULS2}
 (* package ULS2 *)
 (*
+
+    map(f,ups) == laurent(degree ups, map(f, taylorRep ups)$UTSF2)
+
 *)
 
 \end{chunk}
@@ -193582,6 +245239,7 @@ UnivariatePolynomialCategoryFunctions2(R,PR,S,PS): Exports == Impl where
      ++ zero to zero.
 
   Impl ==> add
+
     map(f, p) ==
       ans:PS := 0
       while p ^= 0 repeat
@@ -193594,6 +245252,14 @@ UnivariatePolynomialCategoryFunctions2(R,PR,S,PS): Exports == Impl where
 \begin{chunk}{COQ UPOLYC2}
 (* package UPOLYC2 *)
 (*
+
+    map(f, p) ==
+      ans:PS := 0
+      while p ^= 0 repeat
+        ans := ans + monomial(f leadingCoefficient p, degree p)
+        p   := reductum p
+      ans
+
 *)
 
 \end{chunk}
@@ -193682,6 +245348,7 @@ UnivariatePolynomialCommonDenominator(R, Q, UP): Exports == Impl where
       ++ is a common denominator for the coefficients of q.
  
   Impl ==> add
+
     import CommonDenominator(R, Q, List Q)
  
     commonDenominator p == commonDenominator coefficients p
@@ -193699,6 +245366,19 @@ UnivariatePolynomialCommonDenominator(R, Q, UP): Exports == Impl where
 \begin{chunk}{COQ UPCDEN}
 (* package UPCDEN *)
 (*
+
+    import CommonDenominator(R, Q, List Q)
+ 
+    commonDenominator p == commonDenominator coefficients p
+ 
+    clearDenominator p ==
+      d := commonDenominator p
+      map(x +-> numer(d*x)::Q, p)
+ 
+    splitDenominator p ==
+      d := commonDenominator p
+      [map(x +-> numer(d*x)::Q, p), d]
+
 *)
 
 \end{chunk}
@@ -193887,6 +245567,64 @@ UnivariatePolynomialDecompositionPackage(R,UP): Exports == Implementation where
 \begin{chunk}{COQ UPDECOMP}
 (* package UPDECOMP *)
 (*
+
+    rightFactorIfCan(p,dq,lcq) ==
+      dp := degree p
+      zero? lcq =>
+       error "rightFactorIfCan: leading coefficient may not be zero"
+      (zero? dp) or (zero? dq) => "failed"
+      nc := dp exquo dq
+      nc case "failed" => "failed"
+      n := nc::N
+      s := subtractIfCan(dq,1)::N
+      lcp := leadingCoefficient p
+      q: UP := monomial(lcq,dq)
+      k: N 
+      for k in 1..s repeat
+        c: R := 0
+        i: N
+        for i in 0..subtractIfCan(k,1)::N repeat
+         c := c+(k::R-(n::R+1)*(i::R))*
+          coefficient(q,subtractIfCan(dq,i)::N)*
+           coefficient(p,subtractIfCan(dp+i,k)::N)
+        cquo := c exquo ((k*n)::R*lcp)
+        cquo case "failed" => return "failed"
+        q := q+monomial(cquo::R,subtractIfCan(dq,k)::N)
+      q
+
+    monicRightFactorIfCan(p,dq) == rightFactorIfCan(p,dq,1$R)
+
+    import UnivariatePolynomialDivisionPackage(R,UP)
+
+    leftFactorIfCan(f,h) ==
+      g: UP := 0
+      zero? degree h => "failed"
+      for i in 0.. while not zero? f repeat
+        qrf := divideIfCan(f,h)
+        qrf case "failed" => return "failed"
+        qr := qrf :: QR
+        r := qr.remainder
+        not ground? r => return "failed"
+        g := g+monomial(ground(r),i)
+        f := qr.quotient
+      g
+
+    monicDecomposeIfCan f ==
+      df := degree f
+      zero? df => "failed"  
+      for dh in 2..subtractIfCan(df,1)::N | zero?(df rem dh) repeat
+        h := monicRightFactorIfCan(f,dh)
+        h case UP =>
+         g := leftFactorIfCan(f,h::UP)
+         g case UP => return [g::UP,h::UP]
+      "failed"
+
+    monicCompleteDecompose f ==
+      cf := monicDecomposeIfCan f
+      cf case "failed" => [ f ]
+      lr := cf :: LR
+      append(monicCompleteDecompose lr.left,[lr.right])
+
 *)
 
 \end{chunk}
@@ -193967,7 +245705,6 @@ UnivariatePolynomialDivisionPackage(R,UP): Exports == Implementation where
 
     divideIfCan(p1:UP,p2:UP):Union(QR,"failed") ==
       zero? p2 => error "divideIfCan: division by zero"
---      one? (lc := leadingCoefficient p2) => monicDivide(p1,p2) 
       ((lc := leadingCoefficient p2) = 1) => monicDivide(p1,p2) 
       q: UP := 0
       while not ((e := subtractIfCan(degree(p1),degree(p2))) case "failed")
@@ -193984,6 +245721,20 @@ UnivariatePolynomialDivisionPackage(R,UP): Exports == Implementation where
 \begin{chunk}{COQ UPDIVP}
 (* package UPDIVP *)
 (*
+
+    divideIfCan(p1:UP,p2:UP):Union(QR,"failed") ==
+      zero? p2 => error "divideIfCan: division by zero"
+      ((lc := leadingCoefficient p2) = 1) => monicDivide(p1,p2) 
+      q: UP := 0
+      while not ((e := subtractIfCan(degree(p1),degree(p2))) case "failed")
+       repeat
+        c := leadingCoefficient(p1) exquo lc
+        c case "failed" => return "failed"
+        ee := e::N
+        q := q+monomial(c::R,ee)
+        p1 := p1-c*mapExponents(x +-> x+ee, p2)
+      [q,p1]
+
 *)
 
 \end{chunk}
@@ -194055,6 +245806,7 @@ UnivariatePolynomialFunctions2(x:Symbol, R:Ring, y:Symbol, S:Ring): with
     ++ map(func, poly) creates a new polynomial by applying func to
     ++ every non-zero coefficient of the polynomial poly.
  == add
+
   map(f, p) == map(f, p)$UnivariatePolynomialCategoryFunctions2(R,
               UnivariatePolynomial(x, R), S, UnivariatePolynomial(y, S))
 
@@ -194063,6 +245815,10 @@ UnivariatePolynomialFunctions2(x:Symbol, R:Ring, y:Symbol, S:Ring): with
 \begin{chunk}{COQ UP2}
 (* package UP2 *)
 (*
+
+  map(f, p) == map(f, p)$UnivariatePolynomialCategoryFunctions2(R,
+              UnivariatePolynomial(x, R), S, UnivariatePolynomial(y, S))
+
 *)
 
 \end{chunk}
@@ -194157,6 +245913,7 @@ UnivariatePolynomialMultiplicationPackage(R: Ring, U: UnivariatePolynomialCatego
         ++ the same third argument and \spad{k-1} as fourth argument.
 
     T == add
+
       noKaratsuba(a,b) ==
         zero? a => a
         zero? b => b
@@ -194167,6 +245924,7 @@ UnivariatePolynomialMultiplicationPackage(R: Ring, U: UnivariatePolynomialCatego
         for u in lu repeat
           res := pomopo!(res, leadingCoefficient(u), degree(u), b)
         res
+
       karatsubaOnce(a:U,b:U): U ==
         da := minimumDegree(a)
         db := minimumDegree(b)
@@ -194187,6 +245945,7 @@ UnivariatePolynomialMultiplicationPackage(R: Ring, U: UnivariatePolynomialCatego
         w := shiftLeft(w,n) + u
         zero? d => shiftLeft(v,2*n) + w
         shiftLeft(v,2*n + d) + shiftLeft(w,d)
+
       karatsuba(a:U,b:U,l:NonNegativeInteger,k:NonNegativeInteger): U ==
         zero? k => noKaratsuba(a,b)
         degree(a) < l => noKaratsuba(a,b)
@@ -194219,6 +245978,66 @@ UnivariatePolynomialMultiplicationPackage(R: Ring, U: UnivariatePolynomialCatego
 \begin{chunk}{COQ UPMP}
 (* package UPMP *)
 (*
+
+      noKaratsuba(a,b) ==
+        zero? a => a
+        zero? b => b
+        zero?(degree(a)) => leadingCoefficient(a) * b
+        zero?(degree(b)) => a * leadingCoefficient(b)
+        lu: List(U) := reverse monomials(a)
+        res: U := 0;
+        for u in lu repeat
+          res := pomopo!(res, leadingCoefficient(u), degree(u), b)
+        res
+
+      karatsubaOnce(a:U,b:U): U ==
+        da := minimumDegree(a)
+        db := minimumDegree(b)
+        if not zero? da then a := shiftRight(a,da)
+        if not zero? db then b := shiftRight(b,db)
+        d := da + db
+        n: NonNegativeInteger := min(degree(a),degree(b)) quo 2
+        rec: HL := karatsubaDivide(a, n)
+        ha := rec.quotient
+        la := rec.remainder
+        rec := karatsubaDivide(b, n)
+        hb := rec.quotient
+        lb := rec.remainder
+        w: U := (ha - la) * (lb - hb)
+        u: U := la * lb
+        v: U := ha * hb
+        w := w + (u + v)
+        w := shiftLeft(w,n) + u
+        zero? d => shiftLeft(v,2*n) + w
+        shiftLeft(v,2*n + d) + shiftLeft(w,d)
+
+      karatsuba(a:U,b:U,l:NonNegativeInteger,k:NonNegativeInteger): U ==
+        zero? k => noKaratsuba(a,b)
+        degree(a) < l => noKaratsuba(a,b)
+        degree(b) < l => noKaratsuba(a,b)
+        numberOfMonomials(a) < l => noKaratsuba(a,b)
+        numberOfMonomials(b) < l => noKaratsuba(a,b)
+        da := minimumDegree(a)
+        db := minimumDegree(b)
+        if not zero? da then a := shiftRight(a,da)
+        if not zero? db then b := shiftRight(b,db)
+        d := da + db
+        n: NonNegativeInteger := min(degree(a),degree(b)) quo 2
+        k := subtractIfCan(k,1)::NonNegativeInteger
+        rec: HL := karatsubaDivide(a, n)
+        ha := rec.quotient
+        la := rec.remainder
+        rec := karatsubaDivide(b, n)
+        hb := rec.quotient
+        lb := rec.remainder
+        w: U := karatsuba(ha - la, lb - hb, l, k)
+        u: U := karatsuba(la, lb, l, k)
+        v: U := karatsuba(ha, hb, l, k)
+        w := w + (u + v)
+        w := shiftLeft(w,n) + u
+        zero? d => shiftLeft(v,2*n) + w
+        shiftLeft(v,2*n + d) + shiftLeft(w,d)
+
 *)
 
 \end{chunk}
@@ -194328,29 +246147,36 @@ UnivariatePolynomialSquareFree(RC:IntegralDomain,P):C == T
     T == add
 
       if RC has CharacteristicZero then
+
         squareFreePart(p:P) == (p exquo gcd(p, differentiate p))::P
+
       else
+
         squareFreePart(p:P) ==
           unit(s := squareFree(p)$%) * */[f.factor for f in factors s]
 
       if RC has FiniteFieldCategory then
+
         BumInSepFFE(ffe:FF) ==
            ["sqfr", map(charthRoot,ffe.fctr), characteristic$P*ffe.xpnt]
+
       else if RC has CharacteristicNonZero then
+
          BumInSepFFE(ffe:FF) ==
-            np := multiplyExponents(ffe.fctr,characteristic$P:NonNegativeInteger)
+            np:=multiplyExponents(ffe.fctr,characteristic$P:NonNegativeInteger)
             (nthrp := charthRoot(np)) case "failed" =>
                ["nil", np, ffe.xpnt]
             ["sqfr", nthrp, characteristic$P*ffe.xpnt]
 
       else
+
         BumInSepFFE(ffe:FF) ==
           ["nil",
            multiplyExponents(ffe.fctr,characteristic$P:NonNegativeInteger),
             ffe.xpnt]
 
-
       if RC has CharacteristicZero then
+
         squareFree(p:P) ==             --Yun's algorithm - see SYMSAC '76, p.27
            --Note ci primitive is, so GCD's don't need to %do contents.
            --Change gcd to return cofctrs also?
@@ -194371,7 +246197,8 @@ UnivariatePolynomialSquareFree(RC:IntegralDomain,P):C == T
            makeFR(lcp::P,lffe)
 
       else
-        squareFree(p:P) ==           --Musser's algorithm - see SYMSAC '76, p.27
+
+        squareFree(p:P) == --Musser's algorithm - see SYMSAC '76, p.27
              --p MUST BE PRIMITIVE, Any characteristic.
              --Note ci primitive, so GCD's don't need to %do contents.
              --Change gcd to return cofctrs also?
@@ -194388,7 +246215,8 @@ UnivariatePolynomialSquareFree(RC:IntegralDomain,P):C == T
               ci:=(ci exquo di)::P
               i:=i+1
               degree(diprev) = degree(di) =>
-                 lc := (leadingCoefficient(diprev) exquo leadingCoefficient(di))::RC
+                 lc := (leadingCoefficient(diprev) exquo _
+                        leadingCoefficient(di))::RC
                  dunit := lc**i * dunit
               pi:=(diprev exquo di)::P
               lffe:=[["sqfr",pi,i],:lffe]
@@ -194404,6 +246232,88 @@ UnivariatePolynomialSquareFree(RC:IntegralDomain,P):C == T
 \begin{chunk}{COQ UPSQFREE}
 (* package UPSQFREE *)
 (*
+
+      if RC has CharacteristicZero then
+
+        squareFreePart(p:P) == (p exquo gcd(p, differentiate p))::P
+
+      else
+
+        squareFreePart(p:P) ==
+          unit(s := squareFree(p)$%) * */[f.factor for f in factors s]
+
+      if RC has FiniteFieldCategory then
+
+        BumInSepFFE(ffe:FF) ==
+           ["sqfr", map(charthRoot,ffe.fctr), characteristic$P*ffe.xpnt]
+
+      else if RC has CharacteristicNonZero then
+
+         BumInSepFFE(ffe:FF) ==
+            np:=multiplyExponents(ffe.fctr,characteristic$P:NonNegativeInteger)
+            (nthrp := charthRoot(np)) case "failed" =>
+               ["nil", np, ffe.xpnt]
+            ["sqfr", nthrp, characteristic$P*ffe.xpnt]
+
+      else
+
+        BumInSepFFE(ffe:FF) ==
+          ["nil",
+           multiplyExponents(ffe.fctr,characteristic$P:NonNegativeInteger),
+            ffe.xpnt]
+
+      if RC has CharacteristicZero then
+
+        squareFree(p:P) ==             --Yun's algorithm - see SYMSAC '76, p.27
+           --Note ci primitive is, so GCD's don't need to %do contents.
+           --Change gcd to return cofctrs also?
+           ci:=p; di:=differentiate(p); pi:=gcd(ci,di)
+           degree(pi)=0 =>
+             (u,c,a):=unitNormal(p)
+             makeFR(u,[["sqfr",c,1]])
+           i:NonNegativeInteger:=0; lffe:List FF:=[]
+           lcp := leadingCoefficient p
+           while degree(ci)^=0 repeat
+              ci:=(ci exquo pi)::P
+              di:=(di exquo pi)::P - differentiate(ci)
+              pi:=gcd(ci,di)
+              i:=i+1
+              degree(pi) > 0 =>
+                 lcp:=(lcp exquo (leadingCoefficient(pi)**i))::RC
+                 lffe:=[["sqfr",pi,i],:lffe]
+           makeFR(lcp::P,lffe)
+
+      else
+
+        squareFree(p:P) == --Musser's algorithm - see SYMSAC '76, p.27
+             --p MUST BE PRIMITIVE, Any characteristic.
+             --Note ci primitive, so GCD's don't need to %do contents.
+             --Change gcd to return cofctrs also?
+           ci := gcd(p,differentiate(p))
+           degree(ci)=0 =>
+             (u,c,a):=unitNormal(p)
+             makeFR(u,[["sqfr",c,1]])
+           di := (p exquo ci)::P
+           i:NonNegativeInteger:=0; lffe:List FF:=[]
+           dunit : P := 1
+           while degree(di)^=0 repeat
+              diprev := di
+              di := gcd(ci,di)
+              ci:=(ci exquo di)::P
+              i:=i+1
+              degree(diprev) = degree(di) =>
+                 lc := (leadingCoefficient(diprev) exquo _
+                        leadingCoefficient(di))::RC
+                 dunit := lc**i * dunit
+              pi:=(diprev exquo di)::P
+              lffe:=[["sqfr",pi,i],:lffe]
+           dunit := dunit * di ** (i+1)
+           degree(ci)=0 => makeFR(dunit*ci,lffe)
+           redSqfr:=squareFree(divideExponents(ci,characteristic$P)::P)
+           lsnil:= [BumInSepFFE(ffe) for ffe in factorList redSqfr]
+           lffe:=append(lsnil,lffe)
+           makeFR(dunit*(unit redSqfr),lffe)
+
 *)
 
 \end{chunk}
@@ -194494,6 +246404,9 @@ UnivariatePuiseuxSeriesFunctions2(Coef1,Coef2,var1,var2,cen1,cen2):_
 \begin{chunk}{COQ UPXS2}
 (* package UPXS2 *)
 (*
+
+    map(f,ups) == puiseux(rationalPower ups, map(f, laurentRep ups)$ULSP2)
+
 *)
 
 \end{chunk}
@@ -194619,6 +246532,7 @@ UnivariateSkewPolynomialCategoryOps(R, C): Exports == Implementation where
                 ++ \spad{\sigma} is the morphism to use.
  
     Implementation ==> add
+
         termPoly:         (R, N, C, MOR, R -> R) -> C
         localLeftDivide : (C, C, MOR, R) -> QUOREM
         localRightDivide: (C, C, MOR, R) -> QUOREM
@@ -194675,6 +246589,7 @@ UnivariateSkewPolynomialCategoryOps(R, C): Exports == Implementation where
             [q + qr.quotient, qr.remainder]
  
         if R has IntegralDomain then
+
             monicLeftDivide(a, b, sigma) ==
                 unit?(u := leadingCoefficient b) =>
                     localLeftDivide(a, b, sigma, recip(u)::R)
@@ -194686,6 +246601,7 @@ UnivariateSkewPolynomialCategoryOps(R, C): Exports == Implementation where
                 error "monicRightDivide: divisor is not monic"
  
         if R has Field then
+
             leftDivide(a, b, sigma) ==
                 localLeftDivide(a, b, sigma, inv leadingCoefficient b)
  
@@ -194697,6 +246613,82 @@ UnivariateSkewPolynomialCategoryOps(R, C): Exports == Implementation where
 \begin{chunk}{COQ OREPCTO}
 (* package OREPCTO *)
 (*
+
+        termPoly:         (R, N, C, MOR, R -> R) -> C
+        localLeftDivide : (C, C, MOR, R) -> QUOREM
+        localRightDivide: (C, C, MOR, R) -> QUOREM
+ 
+        times(x, y, sigma, delta) ==
+          zero? y => 0
+          z:C := 0
+          while x ^= 0 repeat
+            z := z + termPoly(leadingCoefficient x, degree x, y, sigma, delta)
+            x := reductum x
+          z
+ 
+        termPoly(a, n, y, sigma, delta) ==
+          zero? y => 0
+          (u := subtractIfCan(n, 1)) case "failed" => a * y
+          n1 := u::N
+          z:C := 0
+          while y ^= 0 repeat
+            m := degree y
+            b := leadingCoefficient y
+            z := z + termPoly(a, n1, monomial(sigma b, m + 1), sigma, delta)
+                   + termPoly(a, n1, monomial(delta b, m), sigma, delta)
+            y := reductum y
+          z
+ 
+        apply(p, c, x, sigma, delta) ==
+          w:R  := 0
+          xn:R := x
+          for i in 0..degree p repeat
+            w  := w + coefficient(p, i) * xn
+            xn := c * sigma xn + delta xn
+          w
+ 
+        -- localLeftDivide(a, b) returns [q, r] such that a = q b + r
+        -- b1 is the inverse of the leadingCoefficient of b
+        localLeftDivide(a, b, sigma, b1) ==
+            zero? b => error "leftDivide: division by 0"
+            zero? a or
+             (n := subtractIfCan(degree(a),(m := degree b))) case "failed" =>
+                    [0,a]
+            q  := monomial((sigma**(-m))(b1 * leadingCoefficient a), n::N)
+            qr := localLeftDivide(a - b * q, b, sigma, b1)
+            [q + qr.quotient, qr.remainder]
+ 
+        -- localRightDivide(a, b) returns [q, r] such that a = q b + r
+        -- b1 is the inverse of the leadingCoefficient of b
+        localRightDivide(a, b, sigma, b1) ==
+            zero? b => error "rightDivide: division by 0"
+            zero? a or
+              (n := subtractIfCan(degree(a),(m := degree b))) case "failed" =>
+                    [0,a]
+            q := monomial(leadingCoefficient(a) * (sigma**n) b1, n::N)
+            qr := localRightDivide(a - q * b, b, sigma, b1)
+            [q + qr.quotient, qr.remainder]
+ 
+        if R has IntegralDomain then
+
+            monicLeftDivide(a, b, sigma) ==
+                unit?(u := leadingCoefficient b) =>
+                    localLeftDivide(a, b, sigma, recip(u)::R)
+                error "monicLeftDivide: divisor is not monic"
+ 
+            monicRightDivide(a, b, sigma) ==
+                unit?(u := leadingCoefficient b) =>
+                    localRightDivide(a, b, sigma, recip(u)::R)
+                error "monicRightDivide: divisor is not monic"
+ 
+        if R has Field then
+
+            leftDivide(a, b, sigma) ==
+                localLeftDivide(a, b, sigma, inv leadingCoefficient b)
+ 
+            rightDivide(a, b, sigma) ==
+                localRightDivide(a, b, sigma, inv leadingCoefficient b)
+
 *)
 
 \end{chunk}
@@ -194783,6 +246775,9 @@ UnivariateTaylorSeriesFunctions2(Coef1,Coef2,UTS1,UTS2):_
 \begin{chunk}{COQ UTS2}
 (* package UTS2 *)
 (*
+
+    map(f,uts) == series map(f,coefficients uts)$ST2
+
 *)
 
 \end{chunk}
@@ -194969,10 +246964,11 @@ UnivariateTaylorSeriesODESolver(Coef,UTS):_
     simulre(cst,lsf,c) ==
       [lazyIntegrate(csti,lsfi concat(monom(1,1)$STT,c))_
           for csti in cst for lsfi in lsf]
+
     iMpsode:(L Coef,L ((L ST) -> ST)) -> L ST
     iMpsode(cs,lsts) == YS(ls +-> simulre(cs,lsts,ls),# cs)
+
     mpsode(cs,lsts) ==
---       stSol := iMpsode(cs,map(stFuncN,lsts)$L2(FN,(L ST) -> ST))
       stSol := iMpsode(cs,[stFuncN(lst) for lst in lsts])
       map(series,stSol)$L2(ST,UTS)
 
@@ -194981,6 +246977,81 @@ UnivariateTaylorSeriesODESolver(Coef,UTS):_
 \begin{chunk}{COQ UTSODE}
 (* package UTSODE *)
 (*
+
+    stFunc1 f == s +-> coefficients f series(s)
+    stFunc2 f == (s1,s2) +-> coefficients f(series(s1),series(s2))
+    stFuncN f == ls +-> coefficients f map(series,ls)$ListFunctions2(ST,UTS)
+
+    import StreamTaylorSeriesOperations(Coef)
+    divloopre:(Coef,ST,Coef,ST,ST) -> ST
+    divloopre(hx,tx,hy,ty,c) == delay(concat(hx*hy,hy*(tx-(ty*c))))
+    divloop: (Coef,ST,Coef,ST) -> ST
+    divloop(hx,tx,hy,ty) == YS(s +-> divloopre(hx,tx,hy,ty,s))
+
+    sdiv:(ST,ST) -> ST
+    sdiv(x,y) == delay
+      empty? x => empty()
+      empty? y => error "stream division by zero"
+      hx := frst x; tx := rst x
+      hy := frst y; ty := rst y
+      zero? hy =>
+        zero? hx => sdiv(tx,ty)
+        error "stream division by zero"
+      rhy := recip hy
+      rhy case "failed" => error "stream division:no reciprocal"
+      divloop(hx,tx,rhy::Coef,ty)
+
+    fixedPointExquo(f,g) == series sdiv(coefficients f,coefficients g)
+
+-- first order
+
+    ode1re: (ST -> ST,Coef,ST) -> ST
+    ode1re(f,c,y) == lazyIntegrate(c,f y)$STT
+
+    iOde1: ((ST -> ST),Coef) -> ST
+    iOde1(f,c) == YS(s +-> ode1re(f,c,s))
+
+    ode1(f,c) == series iOde1(stFunc1 f,c)
+
+-- second order
+
+    ode2re: ((ST,ST)-> ST,Coef,Coef,ST) -> ST
+    ode2re(f,c0,c1,y)==
+      yi := lazyIntegrate(c1,f(y,deriv(y)$STT))$STT
+      lazyIntegrate(c0,yi)$STT
+
+    iOde2: ((ST,ST) -> ST,Coef,Coef) -> ST
+    iOde2(f,c0,c1) == YS(s +-> ode2re(f,c0,c1,s))
+
+    ode2(f,c0,c1) == series iOde2(stFunc2 f,c0,c1)
+
+-- nth order
+
+    odeNre: (List ST -> ST,List Coef,List ST) -> List ST
+    odeNre(f,cl,yl) ==
+      -- yl is [y, y', ..., y<n>]
+      -- integrate [y',..,y<n>] to get [y,..,y<n-1>]
+      yil := [lazyIntegrate(c,y)$STT for c in cl for y in rest yl]
+      -- use y<n> = f(y,..,y<n-1>)
+      concat(yil,[f yil])
+
+    iOde: ((L ST) -> ST,List Coef) -> ST
+    iOde(f,cl) == first YS(ls +-> odeNre(f,cl,ls),#cl + 1)
+
+    ode(f,cl) == series iOde(stFuncN f,cl)
+
+    simulre:(L Coef,L ((L ST) -> ST),L ST) -> L ST
+    simulre(cst,lsf,c) ==
+      [lazyIntegrate(csti,lsfi concat(monom(1,1)$STT,c))_
+          for csti in cst for lsfi in lsf]
+
+    iMpsode:(L Coef,L ((L ST) -> ST)) -> L ST
+    iMpsode(cs,lsts) == YS(ls +-> simulre(cs,lsts,ls),# cs)
+
+    mpsode(cs,lsts) ==
+      stSol := iMpsode(cs,[stFuncN(lst) for lst in lsts])
+      map(series,stSol)$L2(ST,UTS)
+
 *)
 
 \end{chunk}
@@ -195052,12 +247123,14 @@ UniversalSegmentFunctions2(R:Type, S:Type): with
 
 
   == add
+
     map(f:R -> S, u:UniversalSegment R):UniversalSegment S ==
       s := f lo u
       hasHi u => segment(s, f hi u)
       segment s
 
     if R has OrderedRing then
+
       map(f:R -> S, u:UniversalSegment R): Stream S ==
         map(f, expand u)$StreamFunctions2(R, S)
 
@@ -195066,6 +247139,17 @@ UniversalSegmentFunctions2(R:Type, S:Type): with
 \begin{chunk}{COQ UNISEG2}
 (* package UNISEG2 *)
 (*
+
+    map(f:R -> S, u:UniversalSegment R):UniversalSegment S ==
+      s := f lo u
+      hasHi u => segment(s, f hi u)
+      segment s
+
+    if R has OrderedRing then
+
+      map(f:R -> S, u:UniversalSegment R): Stream S ==
+        map(f, expand u)$StreamFunctions2(R, S)
+
 *)
 
 \end{chunk}
@@ -195182,11 +247266,14 @@ UserDefinedPartialOrdering(S:SetCategory): with
       ++ comparable in the partial ordering.
  
  == add
+
   llow :Reference List S := ref nil()
   lhigh:Reference List S := ref nil()
  
   userOrdered?() == not(empty? deref llow) or not(empty? deref lhigh)
+
   getOrder()     == [deref llow, deref lhigh]
+
   setOrder l     == setOrder(nil(), l)
  
   setOrder(l, h) ==
@@ -195222,7 +247309,9 @@ UserDefinedPartialOrdering(S:SetCategory): with
     "failed"
  
   if S has OrderedSet then
+
     more?(a, b) == not less?(a, b, (y,z) +-> y <$S z)
+
     largest x   == largest(x, (y,z) +-> y <$S z)
 
 \end{chunk}
@@ -195230,6 +247319,54 @@ UserDefinedPartialOrdering(S:SetCategory): with
 \begin{chunk}{COQ UDPO}
 (* package UDPO *)
 (*
+
+  llow :Reference List S := ref nil()
+  lhigh:Reference List S := ref nil()
+ 
+  userOrdered?() == not(empty? deref llow) or not(empty? deref lhigh)
+
+  getOrder()     == [deref llow, deref lhigh]
+
+  setOrder l     == setOrder(nil(), l)
+ 
+  setOrder(l, h) ==
+    setref(llow, removeDuplicates l)
+    setref(lhigh, removeDuplicates h)
+    void
+ 
+  less?(a, b, f) ==
+    (u := less?(a, b)) case "failed" => f(a, b)
+    u::Boolean
+ 
+  largest(x, f) ==
+    empty? x => error "largest: empty list"
+    empty? rest x => first x
+    a := largest(rest x, f)
+    less?(first x, a, f) => a
+    first x
+ 
+  less?(a, b) ==
+    for x in deref llow repeat
+      x = a => return(a ^= b)
+      x = b => return false
+    aa := bb := false$Boolean
+    for x in deref lhigh repeat
+      if x = a then
+        bb => return false
+        aa := true
+      if x = b then
+        aa => return(a ^= b)
+        bb := true
+    aa => false
+    bb => true
+    "failed"
+ 
+  if S has OrderedSet then
+
+    more?(a, b) == not less?(a, b, (y,z) +-> y <$S z)
+
+    largest x   == largest(x, (y,z) +-> y <$S z)
+
 *)
 
 \end{chunk}
@@ -195320,10 +247457,13 @@ UserDefinedVariableOrdering(): with
     ++ resetVariableOrder() cancels any previous use of
     ++ setVariableOrder and returns to the default system ordering.
  == add
+
   import UserDefinedPartialOrdering(Symbol)
  
   setVariableOrder l       == setOrder reverse l
+
   setVariableOrder(l1, l2) == setOrder(reverse l2, reverse l1)
+
   resetVariableOrder()     == setVariableOrder(nil(), nil())
  
   getVariableOrder() ==
@@ -195335,6 +247475,19 @@ UserDefinedVariableOrdering(): with
 \begin{chunk}{COQ UDVO}
 (* package UDVO *)
 (*
+
+  import UserDefinedPartialOrdering(Symbol)
+ 
+  setVariableOrder l       == setOrder reverse l
+
+  setVariableOrder(l1, l2) == setOrder(reverse l2, reverse l1)
+
+  resetVariableOrder()     == setVariableOrder(nil(), nil())
+ 
+  getVariableOrder() ==
+    r := getOrder()
+    [reverse(r.high), reverse(r.low)]
+
 *)
 
 \end{chunk}
@@ -195426,6 +247579,7 @@ UTSodetools(F, UP, L, UTS): Exports == Implementation where
               ++ RF2UTS(f) converts \spad{f} to a Taylor series.
 
   Implementation ==> add
+
       fun: (Vector UTS, List UTS) -> UTS
 
       UP2UTS p ==
@@ -195454,6 +247608,7 @@ UTSodetools(F, UP, L, UTS): Exports == Implementation where
           ans
 
       if F has IntegralDomain then
+
           RF2UTS f == UP2UTS(numer f) * recip(UP2UTS denom f)::UTS
 
 \end{chunk}
@@ -195461,6 +247616,38 @@ UTSodetools(F, UP, L, UTS): Exports == Implementation where
 \begin{chunk}{COQ UTSODETL}
 (* package UTSODETL *)
 (*
+
+      fun: (Vector UTS, List UTS) -> UTS
+
+      UP2UTS p ==
+        q := p(monomial(1, 1) + center(0)::UP)
+        +/[monomial(coefficient(q, i), i)$UTS for i in 0..degree q]
+
+      UTS2UP(s, n) ==
+        xmc     := monomial(1, 1)$UP - center(0)::UP
+        xmcn:UP := 1
+        ans:UP  := 0
+        for i in 0..n repeat
+            ans  := ans + coefficient(s, i) * xmcn
+            xmcn := xmc * xmcn
+        ans
+
+      LODO2FUN op ==
+          a := recip(UP2UTS(- leadingCoefficient op))::UTS
+          n := (degree(op) - 1)::NonNegativeInteger
+          v := [a * UP2UTS coefficient(op, i) for i in 0..n]$Vector(UTS)
+          r := (l1: List UTS): UTS +-> fun(v, l1)
+          r
+
+      fun(v, l) ==
+          ans:UTS := 0
+          for b in l for i in 1.. repeat ans := ans + v.i * b
+          ans
+
+      if F has IntegralDomain then
+
+          RF2UTS f == UP2UTS(numer f) * recip(UP2UTS denom f)::UTS
+
 *)
 
 \end{chunk}
@@ -196081,6 +248268,424 @@ U32VectorPolynomialOperations() : Export == Implementation where
 \begin{chunk}{COQ POLYVEC}
 (* package POLYVEC *)
 (*
+
+        Qmuladdmod ==> QSMULADDMOD6432$Lisp
+        Qmuladd    ==> QSMULADD6432$Lisp
+        Qmul       ==> QSMULMOD32$Lisp
+        Qdot2      ==> QSDOT2MOD6432$Lisp
+        Qrem       ==> QSMOD6432$Lisp
+        modInverse ==> invmod
+
+        copy_first(np : PA, op : PA, n : Integer) : Void ==
+            ns := n pretend SingleInteger
+            for j in 0..(ns - 1) repeat
+                np(j) := op(j)
+
+        copy_slice(np : PA, op : PA, m : Integer, _
+                    n : Integer) : Void ==
+            ms := m pretend SingleInteger
+            ns := n pretend SingleInteger
+            for j in ms..(ms + ns - 1) repeat
+                np(j) := op(j)
+
+        eval_at(v : PA, deg : Integer, pt : Integer, _
+               p : Integer) : Integer ==
+            i : SingleInteger := deg::SingleInteger
+            res : Integer := 0
+            while not(i < 0) repeat
+                res := Qmuladdmod(pt, res, v(i), p)
+                i := i - 1
+            res
+
+        to_mod_pa(s : SparseUnivariatePolynomial Integer, p : Integer) : PA ==
+            zero?(s) => new(1, 0)$PA
+            n0 := degree(s) pretend SingleInteger
+            ncoeffs := new((n0+1) pretend NonNegativeInteger, 0)$PA
+            while not(zero?(s)) repeat
+                n := degree(s)
+                ncoeffs(n) := positiveRemainder(leadingCoefficient(s), p)
+                s := reductum(s)
+            ncoeffs
+
+        vector_add_mul(v1 : PA, v2 : PA, m : Integer, n : Integer, _
+                         c : Integer, p : Integer) : Void ==
+            ms := m pretend SingleInteger
+            ns := n pretend SingleInteger
+            for i in ms..ns repeat
+                v1(i) := Qmuladdmod(c, v2(i), v1(i), p)
+
+        mul_by_binomial(v : PA, n : Integer, pt : Integer, _
+                          p : Integer) : Void ==
+            prev_coeff : Integer := 0
+            ns := n pretend SingleInteger
+            for i in 0..(ns - 1) repeat
+                pp := v(i)
+                v(i) := Qmuladdmod(pt, pp, prev_coeff, p)
+                prev_coeff := pp
+
+        mul_by_binomial(v : PA, pt : Integer, _
+                          p : Integer) : Void ==
+            mul_by_binomial(v, #v, pt, p)
+
+        mul_by_scalar(v : PA, n : Integer, c : Integer, _
+                        p : Integer) : Void ==
+            ns := n pretend SingleInteger
+            for i in 0..ns repeat
+                v(i) := Qmul(c, v(i), p)
+
+        degree(v : PA) : Integer ==
+            n := #v
+            for i in (n - 1)..0 by -1 repeat
+                not(v(i) = 0) => return i
+            -1
+
+        vector_combination(v1 : PA, c1 : Integer, _
+                            v2 : PA, c2 : Integer, _
+                            n : Integer, delta : Integer, _
+                            p : Integer) : Void ==
+            ns := n pretend SingleInteger
+            ds := delta pretend SingleInteger
+            if not(c1 = 1) then
+                ns + 1 < ds =>
+                    for i in 0..ns repeat
+                        v1(i) := Qmul(v1(i), c1, p)
+                for i in 0..(ds - 1) repeat
+                    v1(i) := Qmul(v1(i), c1, p)
+                for i in ds..ns repeat
+                    v1(i) := Qdot2(v1(i), c1, v2(i - ds), c2, p)
+            else
+                for i in ds..ns repeat
+                    v1(i) := Qmuladdmod(c2, v2(i - ds), v1(i), p)
+
+        divide!(r0 : PA, r1 : PA, res : PA, p: Integer) : Void ==
+            dr0 := degree(r0) pretend SingleInteger
+            dr1 := degree(r1) pretend SingleInteger
+            c0 := r1(dr1)
+            c0 := modInverse(c0, p)
+            while not(dr0 < dr1) repeat
+                delta := dr0 - dr1
+                c1 := Qmul(c0, r0(dr0), p)
+                res(delta) := c1
+                c1 := p - c1
+                r0(dr0) := 0
+                dr0 := dr0 - 1
+                if dr0 < 0 then break
+                vector_combination(r0, 1, r1, c1, dr0, delta, p)
+                while r0(dr0) = 0 repeat
+                    dr0 := dr0 - 1
+                    if dr0 < 0 then break
+
+        remainder!(r0 : PA, r1 : PA, p: Integer) : Void ==
+            dr0 := degree(r0) pretend SingleInteger
+            dr1 := degree(r1) pretend SingleInteger
+            c0 := r1(dr1)
+            c0 := modInverse(c0, p)
+            while not(dr0 < dr1) repeat
+                delta := dr0 - dr1
+                c1 := Qmul(c0, r0(dr0), p)
+                c1 := p - c1
+                r0(dr0) := 0
+                dr0 := dr0 - 1
+                if dr0 < 0 then break
+                vector_combination(r0, 1, r1, c1, dr0, delta, p)
+                while r0(dr0) = 0 repeat
+                    dr0 := dr0 - 1
+                    if dr0 < 0 then break
+
+        gcd(x : PA, y : PA, p : Integer) : PA ==
+            dr0 := degree(y) pretend SingleInteger
+            dr1 : SingleInteger
+            if dr0 < 0 then
+                tmpp := x
+                x := y
+                y := tmpp
+                dr1 := dr0
+                dr0 := degree(y) pretend SingleInteger
+            else
+                dr1 := degree(x) pretend SingleInteger
+            dr0 < 0 => return new(1, 0)$PA
+            r0 := new((dr0 + 1) pretend NonNegativeInteger, 0)$PA
+            copy_first(r0, y, dr0 + 1)
+            dr1 < 0 =>
+                c := r0(dr0)
+                c := modInverse(c, p)
+                mul_by_scalar(r0, dr0, c, p)
+                return r0
+            r1 := new((dr1 + 1) pretend NonNegativeInteger, 0)$PA
+            copy_first(r1, x, dr1 + 1)
+            while 0 < dr1 repeat
+                while not(dr0 < dr1) repeat
+                    delta := dr0 - dr1
+                    c1 := sub_SI(p, r0(dr0))$Lisp
+                    c0 := r1(dr1)
+                    if c0 ~= 1 and delta > 30 then
+                        c0 :=  modInverse(c0, p)
+                        mul_by_scalar(r1, dr1, c0, p)
+                        c0 := 1
+                    r0(dr0) := 0
+                    dr0 := dr0 - 1
+                    vector_combination(r0, c0, r1, c1, dr0, delta, p)
+                    while r0(dr0) = 0 repeat
+                        dr0 := dr0 - 1
+                        if dr0 < 0 then break
+                tmpp := r0
+                tmp := dr0
+                r0 := r1
+                dr0 := dr1
+                r1 := tmpp
+                dr1 := tmp
+            not(dr1 < 0) =>
+                r1(0) := 1
+                return r1
+            c := r0(dr0)
+            c := modInverse(c, p)
+            mul_by_scalar(r0, dr0, c, p)
+            r0
+
+        gcd(a : PrimitiveArray PA, lo : Integer, hi: Integer, p: Integer) _
+              : PA ==
+            res := a(lo)
+            for i in (lo + 1)..hi repeat
+                res := gcd(a(i), res, p)
+            res
+
+        lcm2(v1 : PA, v2 : PA, p : Integer) : PA ==
+            pp := gcd(v1, v2, p)
+            dv2 := degree(v2)
+            dpp := degree(pp)
+            dv2 = dpp =>
+                v1
+            dpp = 0 => mul(v1, v2, p)
+            tmp1 := new((dv2 + 1) pretend NonNegativeInteger, 0)$PA
+            tmp2 := new((dv2 - dpp + 1) pretend NonNegativeInteger, 0)$PA
+            copy_first(tmp1, v2, dv2 + 1)
+            divide!(tmp1, pp, tmp2, p)
+            mul(v1, tmp2, p)
+
+        lcm(a : PrimitiveArray PA, lo : Integer, hi: Integer, p: Integer) _
+              : PA ==
+            res := a(lo)
+            for i in (lo + 1)..hi repeat
+                res := lcm2(a(i), res, p)
+            res
+
+        inner_mul : (PA, PA, PA,  SingleInteger, SingleInteger, _
+                      SingleInteger, Integer) -> Void
+
+        mul(x : PA, y : PA, p : Integer) : PA ==
+            xdeg := degree(x) pretend SingleInteger
+            ydeg := degree(y) pretend SingleInteger
+            if xdeg > ydeg then
+                tmpp := x
+                tmp := xdeg
+                x := y
+                xdeg := ydeg
+                y := tmpp
+                ydeg := tmp
+            xcoeffs := x
+            ycoeffs := y
+            xdeg < 0 => x
+            xdeg = 0 and xcoeffs(0) = 1 => copy(y)
+            zdeg : SingleInteger := xdeg + ydeg
+            zdeg0 := ((zdeg + 1)::Integer) pretend NonNegativeInteger
+            zcoeffs := new(zdeg0, 0)$PA
+            inner_mul(xcoeffs, ycoeffs, zcoeffs, xdeg, ydeg, zdeg, p)
+            zcoeffs
+
+        inner_mul(x, y, z, xdeg, ydeg, zdeg, p) ==
+            if ydeg < xdeg then
+                tmpp := x
+                tmp := xdeg
+                x := y
+                xdeg := ydeg
+                y := tmpp
+                ydeg := tmp
+            xdeg :=
+                zdeg < xdeg => zdeg
+                xdeg
+            ydeg :=
+                zdeg < ydeg => zdeg
+                ydeg
+            ss : Integer
+            i : SingleInteger
+            j : SingleInteger
+            for i in 0..xdeg repeat
+                ss := z(i)
+                for j in 0..i repeat
+                    ss := Qmuladd(x(i - j), y(j), ss)
+                z(i) := Qrem(ss, p)
+            for i in (xdeg+1)..ydeg repeat
+                ss := z(i)
+                for j in 0..xdeg repeat
+                    ss := Qmuladd(x(j), y(i-j), ss)
+                z(i) := Qrem(ss, p)
+            for i in (ydeg+1)..zdeg repeat
+                ss := z(i)
+                for j in (i-xdeg)..ydeg repeat
+                    ss := Qmuladd(x(i - j), y(j), ss)
+                z(i) := Qrem(ss, p)
+
+        truncated_mul_add(x, y, z, m, p) ==
+            xdeg := (#x - 1) pretend SingleInteger
+            ydeg := (#y - 1) pretend SingleInteger
+            inner_mul(x, y, z, xdeg, ydeg, m pretend SingleInteger, p)
+
+        truncated_multiplication(x, y, m, p) ==
+            xdeg := (#x - 1) pretend SingleInteger
+            ydeg := (#y - 1) pretend SingleInteger
+            z := new((m pretend SingleInteger + 1)
+                        pretend NonNegativeInteger, 0)$PA
+            inner_mul(x, y, z, xdeg, ydeg, m pretend SingleInteger, p)
+            z
+
+        pow(x : PA, n : PositiveInteger, d: NonNegativeInteger, _
+            p : Integer) : PA ==
+            one? n => x
+            odd?(n)$Integer =>
+                truncated_multiplication(x,
+                    pow(truncated_multiplication(x, x, d, p),
+                        shift(n,-1) pretend PositiveInteger,
+                        d,
+                        p),
+                    d,
+                    p)
+            pow(truncated_multiplication(x, x, d, p),
+                shift(n,-1) pretend PositiveInteger,
+                d,
+                p)
+
+        differentiate(x: PA, p: Integer): PA ==
+            d := #x - 1
+            if zero? d then empty()$PA
+            else
+                r := new(d::NonNegativeInteger, 0)$PA
+                for i in 0..d-1 repeat
+                    i1 := i+1
+                    r.i := Qmul(i1, x.i1, p)
+                r
+
+        differentiate(x: PA, n: NonNegativeInteger, p: Integer): PA ==
+            zero? n => x
+            d := #x - 1
+            if d < n then empty()$PA
+            else
+                r := new((d-n+1) pretend NonNegativeInteger, 0)$PA
+                for i in n..d repeat
+                    j := i-n
+                    f := j+1
+                    for k in j+2..i repeat f := Qmul(f, k, p)
+                    r.(j pretend NonNegativeInteger) := Qmul(f, x.i, p)
+                r
+
+        extended_gcd(x : PA, y : PA, p : Integer) : List(PA) ==
+            dr0 := degree(x) pretend SingleInteger
+            dr1 : SingleInteger
+            swapped : Boolean := false
+            t0 : PA
+            if dr0 < 0 then
+                (x, y) := (y, x)
+                dr1 := dr0
+                dr0 := degree(x) pretend SingleInteger
+                swapped := true
+            else
+                dr1 := degree(y) pretend SingleInteger
+            dr1 < 0 =>
+                dr0 < 0 =>
+                    return [new(1, 0)$PA, new(1, 0)$PA, new(1, 1)$PA]
+                r0 := new((dr0 + 1) pretend NonNegativeInteger, 0)$PA
+                copy_first(r0, x, dr0 + 1)
+                c := r0(dr0)
+                c := modInverse(c, p)
+                mul_by_scalar(r0, dr0, c, p)
+                t0 := new(1, c)$PA
+                if swapped then
+                    return [r0, new(1, 0)$PA, t0]
+                else
+                    return [r0, t0, new(1, 0)$PA]
+            swapped => error "impossible"
+            dt := (dr0 > 0 => dr0 - 1 ; 0)
+            ds := (dr1 > 0 => dr1 - 1 ; 0)
+            -- invariant: r0 = s0*x + t0*y, r1 = s1*x + t1*y
+            r0 := new((dr0 + 1) pretend NonNegativeInteger, 0)$PA
+            t0 := new((dt + 1) pretend NonNegativeInteger, 0)$PA
+            s0 := new((ds + 1) pretend NonNegativeInteger, 0)$PA
+            copy_first(r0, x, dr0 + 1)
+            s0(0) := 1
+            r1 := new((dr1 + 1) pretend NonNegativeInteger, 0)$PA
+            t1 := new((dt + 1) pretend NonNegativeInteger, 0)$PA
+            s1 := new((ds + 1) pretend NonNegativeInteger, 0)$PA
+            copy_first(r1, y, dr1 + 1)
+            t1(0) := 1
+            while dr1 > 0 repeat
+                while dr0 >= dr1 repeat
+                    delta := dr0 - dr1
+                    c1 := sub_SI(p, r0(dr0))$Lisp
+                    c0 := r1(dr1)
+                    if c0 ~= 1 and delta > 30 then
+                        c0 :=  modInverse(c0, p)
+                        mul_by_scalar(r1, dr1, c0, p)
+                        mul_by_scalar(t1, dt, c0, p)
+                        mul_by_scalar(s1, ds, c0, p)
+                        c0 := 1
+                    r0(dr0) := 0
+                    dr0 := dr0 - 1
+                    vector_combination(r0, c0, r1, c1, dr0, delta, p)
+                    vector_combination(t0, c0, t1, c1, dt, delta, p)
+                    vector_combination(s0, c0, s1, c1, ds, delta, p)
+                    while r0(dr0) = 0 repeat
+                        dr0 := dr0 - 1
+                        if dr0 < 0 then break
+                (r0, r1) := (r1, r0)
+                (dr0, dr1) := (dr1, dr0)
+                (s0, s1) := (s1, s0)
+                (t0, t1) := (t1, t0)
+            dr1 >= 0 =>
+                c := r1(0)
+                c := modInverse(c, p)
+                r1(0) := 1
+                mul_by_scalar(s1, ds, c, p)
+                mul_by_scalar(t1, dt, c, p)
+                return [r1, s1, t1]
+            c := r0(dr0)
+            c := modInverse(c, p)
+            mul_by_scalar(r0, dr0, c, p)
+            mul_by_scalar(s0, ds, c, p)
+            mul_by_scalar(t0, dt, c, p)
+            [r0, s0, t0]
+
+        resultant(x : PA, y : PA, p : Integer) : Integer ==
+            dr0 := degree(x) pretend SingleInteger
+            dr0 < 0 => 0
+            dr1 := degree(y) pretend  SingleInteger
+            dr1 < 0 => 0
+            r0 := new((dr0 + 1) pretend NonNegativeInteger, 0)$PA
+            copy_first(r0, x, dr0 + 1)
+            r1 := new((dr1 + 1) pretend NonNegativeInteger, 0)$PA
+            copy_first(r1, y, dr1 + 1)
+            res : SingleInteger := 1
+            repeat
+                dr0 < dr1 =>
+                    (r0, r1) := (r1, r0)
+                    (dr0, dr1) := (dr1, dr0)
+                c0 := r1(dr1)
+                dr1 = 0 =>
+                    while 0 < dr0 repeat
+                        res := Qmul(res, c0, p)
+                        dr0 := dr0 - 1
+                    return res
+                delta := dr0 - dr1
+                c1 := sub_SI(p, r0(dr0))$Lisp
+                if c0 ~= 1 then
+                    c1 :=  Qmul(c1, modInverse(c0, p), p)
+                r0(dr0) := 0
+                dr0 := dr0 - 1
+                vector_combination(r0, 1, r1, c1, dr0, delta, p)
+                res := Qmul(res, c0, p)
+                while r0(dr0) = 0 repeat
+                    dr0 := dr0 - 1
+                    dr0 < 0 => return 0
+                    res := Qmul(res, c0, p)
+
 *)
 
 \end{chunk}
@@ -196179,8 +248784,11 @@ VectorFunctions2(A, B): Exports == Implementation where
       ++ producing a new vector containing the values or \spad{"failed"}.
  
   Implementation ==> add
+
     scan(f, v, b)   == scan(f, v, b)$O2
+
     reduce(f, v, b) == reduce(f, v, b)$O2
+
     map(f:(A->B), v:VA):VB == map(f, v)$O2
 
     map(f:(A -> UB), a:VA):Union(VB,"failed") ==
@@ -196196,6 +248804,21 @@ VectorFunctions2(A, B): Exports == Implementation where
 \begin{chunk}{COQ VECTOR2}
 (* package VECTOR2 *)
 (*
+
+    scan(f, v, b)   == scan(f, v, b)$O2
+
+    reduce(f, v, b) == reduce(f, v, b)$O2
+
+    map(f:(A->B), v:VA):VB == map(f, v)$O2
+
+    map(f:(A -> UB), a:VA):Union(VB,"failed") ==
+     res : List B  := []
+     for u in entries(a) repeat
+       r := f u
+       r = "failed" => return "failed"
+       res := [r::B,:res]
+     vector reverse! res
+
 *)
 
 \end{chunk}
@@ -196450,11 +249073,13 @@ ViewDefaultsPackage():Exports == Implementation where
 
 --%Viewport window dimensions specifications
     viewPosDefault   == [defaultXPos(),defaultYPos()]
+
     viewPosDefault l ==
       #l < 2 => error "viewPosDefault expects a list with two elements"
       [defaultXPos() := first l,defaultYPos() := last l]
 
     viewSizeDefault   == [defaultWidth(),defaultHeight()]
+
     viewSizeDefault l ==
       #l < 2 => error "viewSizeDefault expects a list with two elements"
       [defaultWidth() := first l,defaultHeight() := last l]
@@ -196472,32 +249097,41 @@ ViewDefaultsPackage():Exports == Implementation where
 
 --%2D graphical output specifications
     pointColorDefault   == defaultPointColor()
+
     pointColorDefault p == defaultPointColor() := p
 
     lineColorDefault   == defaultLineColor()
+
     lineColorDefault p == defaultLineColor() := p
 
     axesColorDefault   == defaultAxesColor()
+
     axesColorDefault p == defaultAxesColor() := p
 
     unitsColorDefault   == defaultUnitsColor()
+
     unitsColorDefault p == defaultUnitsColor() := p
 
     pointSizeDefault   == defaultPointSize()
+
     pointSizeDefault x == defaultPointSize() := x
 
 
 --%3D specific stuff
     var1StepsDefault   == defaultVar1Steps()
+
     var1StepsDefault i == defaultVar1Steps() := i
 
     var2StepsDefault   == defaultVar2Steps()
+
     var2StepsDefault i == defaultVar2Steps() := i
 
     tubePointsDefault   == defaultTubePoints()
+
     tubePointsDefault i == defaultTubePoints() := i
 
     tubeRadiusDefault   == defaultTubeRadius()
+
     tubeRadiusDefault f == defaultTubeRadius() := convert(f)@SF
 
 --%File output stuff
@@ -196508,9 +249142,10 @@ ViewDefaultsPackage():Exports == Implementation where
     viewWriteDefault listOfThings ==
       thingsToWrite : L S := []
       for aTypeOfFile in listOfThings repeat
-        if (writeTypeInt := position(upperCase aTypeOfFile,viewWriteAvailable())) < 0 then
+        if (writeTypeInt := _
+            position(upperCase aTypeOfFile,viewWriteAvailable())) < 0 then
           sayBrightly(["  > ",concat(aTypeOfFile,
-                       " is not a valid file type for writing a viewport")])$Lisp
+                     " is not a valid file type for writing a viewport")])$Lisp
         else
           thingsToWrite := append(thingsToWrite,[aTypeOfFile])
       defaultThingsToWrite() := thingsToWrite
@@ -196520,6 +249155,106 @@ ViewDefaultsPackage():Exports == Implementation where
 \begin{chunk}{COQ VIEWDEF}
 (* package VIEWDEF *)
 (*
+
+    import Color()
+    import Palette()
+    --import StringManipulations()
+
+    defaultPointColor : Reference(PAL)  := ref bright red()
+    defaultLineColor  : Reference(PAL)  := ref pastel green() --bright blue()
+    defaultAxesColor  : Reference(PAL)  := ref dim red()
+    defaultUnitsColor : Reference(PAL)  := ref dim yellow()
+    defaultPointSize  : Reference(PI)   := ref(3::PI)
+    defaultXPos       : Reference(NNI)  := ref(0::NNI)
+    defaultYPos       : Reference(NNI)  := ref(0::NNI)
+    defaultWidth      : Reference(PI)   := ref(400::PI)
+    defaultHeight     : Reference(PI)   := ref(400::PI)
+    defaultThingsToWrite : Reference(L S) := ref([]::L S)
+    defaultVar1Steps  : Reference(PI)   := ref(27::PI)
+    defaultVar2Steps  : Reference(PI)   := ref(27::PI)
+    defaultTubePoints : Reference(PI)   := ref(6::PI)
+    defaultTubeRadius : Reference(SF)   := ref(convert(0.5)@SF)
+    defaultClosed     : Reference(B)    := ref(false)
+
+--%Viewport window dimensions specifications
+    viewPosDefault   == [defaultXPos(),defaultYPos()]
+
+    viewPosDefault l ==
+      #l < 2 => error "viewPosDefault expects a list with two elements"
+      [defaultXPos() := first l,defaultYPos() := last l]
+
+    viewSizeDefault   == [defaultWidth(),defaultHeight()]
+
+    viewSizeDefault l ==
+      #l < 2 => error "viewSizeDefault expects a list with two elements"
+      [defaultWidth() := first l,defaultHeight() := last l]
+
+    viewDefaults ==
+      defaultPointColor : Reference(PAL)  := ref bright red()
+      defaultLineColor  : Reference(PAL)  := ref pastel green() --bright blue()
+      defaultAxesColor  : Reference(PAL)  := ref dim red()
+      defaultUnitsColor : Reference(PAL)  := ref dim yellow()
+      defaultPointSize  : Reference(PI)   := ref(3::PI)
+      defaultXPos       : Reference(NNI)  := ref(0::NNI)
+      defaultYPos       : Reference(NNI)  := ref(0::NNI)
+      defaultWidth      : Reference(PI)   := ref(400::PI)
+      defaultHeight     : Reference(PI)   := ref(427::PI)
+
+--%2D graphical output specifications
+    pointColorDefault   == defaultPointColor()
+
+    pointColorDefault p == defaultPointColor() := p
+
+    lineColorDefault   == defaultLineColor()
+
+    lineColorDefault p == defaultLineColor() := p
+
+    axesColorDefault   == defaultAxesColor()
+
+    axesColorDefault p == defaultAxesColor() := p
+
+    unitsColorDefault   == defaultUnitsColor()
+
+    unitsColorDefault p == defaultUnitsColor() := p
+
+    pointSizeDefault   == defaultPointSize()
+
+    pointSizeDefault x == defaultPointSize() := x
+
+
+--%3D specific stuff
+    var1StepsDefault   == defaultVar1Steps()
+
+    var1StepsDefault i == defaultVar1Steps() := i
+
+    var2StepsDefault   == defaultVar2Steps()
+
+    var2StepsDefault i == defaultVar2Steps() := i
+
+    tubePointsDefault   == defaultTubePoints()
+
+    tubePointsDefault i == defaultTubePoints() := i
+
+    tubeRadiusDefault   == defaultTubeRadius()
+
+    tubeRadiusDefault f == defaultTubeRadius() := convert(f)@SF
+
+--%File output stuff
+    viewWriteAvailable == writeAvailable
+
+    viewWriteDefault == defaultThingsToWrite()
+
+    viewWriteDefault listOfThings ==
+      thingsToWrite : L S := []
+      for aTypeOfFile in listOfThings repeat
+        if (writeTypeInt := _
+            position(upperCase aTypeOfFile,viewWriteAvailable())) < 0 then
+          sayBrightly(["  > ",concat(aTypeOfFile,
+                     " is not a valid file type for writing a viewport")])$Lisp
+        else
+          thingsToWrite := append(thingsToWrite,[aTypeOfFile])
+      defaultThingsToWrite() := thingsToWrite
+
 *)
 
 \end{chunk}
@@ -196615,7 +249350,7 @@ ViewportPackage():Exports == Implementation where
       ++ the list of lists of points indicated by p0 through pn.
     graphCurves : (L L P,L DROP) -> GRIMAGE 
       ++ graphCurves([[p0],[p1],...,[pn]],[options]) creates a 
-      ++ \spadtype{GraphImage} from the list of lists of points, p0 throught pn,
+      ++ \spadtype{GraphImage} from the list of lists of points, p0 through pn,
       ++ using the options specified in the list \spad{options}.
     drawCurves : (L L P,PAL,PAL,PI,L DROP) -> VIEW2D
       ++ drawCurves([[p0],[p1],...,[pn]],ptColor,lineColor,ptSize,[options]) 
@@ -196627,7 +249362,7 @@ ViewportPackage():Exports == Implementation where
     drawCurves : (L L P,L DROP) -> VIEW2D 
       ++ drawCurves([[p0],[p1],...,[pn]],[options]) creates a 
       ++ \spadtype{TwoDimensionalViewport} from the list of lists of points, 
-      ++ p0 throught pn, using the options specified in the list \spad{options};
+      ++ p0 throught pn, using the options specified in the list \spad{options}
     coerce : GRIMAGE -> VIEW2D  
       ++ coerce(gi) converts the indicated \spadtype{GraphImage}, gi, into the
       ++ \spadtype{TwoDimensionalViewport} form.
@@ -196661,7 +249396,7 @@ ViewportPackage():Exports == Implementation where
       drawCurves(listOfListsOfPoints,pointColorDefault(),_
                  lineColorDefault(),pointSizeDefault(),optionsList)
 
-    drawCurves(ptLists:L L P,ptColor:PAL,lColor:PAL,ptSize:PI,optList:L DROP) ==
+    drawCurves(ptLists:L L P,ptColor:PAL,lColor:PAL,ptSize:PI,optList:L DROP)==
       v := viewport2D()
       options(v,optList)
       g :=  graphCurves(ptLists,ptColor,lColor,ptSize,optList)
@@ -196674,7 +249409,6 @@ ViewportPackage():Exports == Implementation where
       if (key graf = 0) then makeGraphImage graf
       v := viewport2D()
       title(v,"VIEW2D")
---      dimensions(v,viewPosDefault().1,viewPosDefault().2,viewSizeDefault().1,viewSizeDefault().2)
       putGraph(v,graf,1::PI)
       makeViewport2D v
 
@@ -196683,6 +249417,50 @@ ViewportPackage():Exports == Implementation where
 \begin{chunk}{COQ VIEW}
 (* package VIEW *)
 (*
+
+    import ViewDefaultsPackage
+    import DrawOptionFunctions0
+
+--% Functions that return GraphImages
+
+    graphCurves(listOfListsOfPoints) ==
+      graphCurves(listOfListsOfPoints, pointColorDefault(),_
+                  lineColorDefault(), pointSizeDefault(),nil())
+
+    graphCurves(listOfListsOfPoints,optionsList) ==
+      graphCurves(listOfListsOfPoints, pointColorDefault(),_
+                  lineColorDefault(), pointSizeDefault(),optionsList)
+
+    graphCurves(listOfListsOfPoints,ptColor,lineColor,ptSize,optionsList) ==
+      len := #listOfListsOfPoints
+      listOfPointColors : L PAL := [ptColor for i in 1..len]
+      listOfLineColors  : L PAL := [lineColor for i in 1..len]
+      listOfPointSizes  : L PI  := [ptSize  for i in 1..len]
+      makeGraphImage(listOfListsOfPoints,listOfPointColors, _
+                         listOfLineColors,listOfPointSizes,optionsList)
+
+--% Functions that return Two Dimensional Viewports
+
+    drawCurves(listOfListsOfPoints,optionsList) ==
+      drawCurves(listOfListsOfPoints,pointColorDefault(),_
+                 lineColorDefault(),pointSizeDefault(),optionsList)
+
+    drawCurves(ptLists:L L P,ptColor:PAL,lColor:PAL,ptSize:PI,optList:L DROP)==
+      v := viewport2D()
+      options(v,optList)
+      g :=  graphCurves(ptLists,ptColor,lColor,ptSize,optList)
+      putGraph(v,g,1)
+      makeViewport2D v
+
+--% Coercions
+
+    coerce(graf:GRIMAGE):VIEW2D ==
+      if (key graf = 0) then makeGraphImage graf
+      v := viewport2D()
+      title(v,"VIEW2D")
+      putGraph(v,graf,1::PI)
+      makeViewport2D v
+
 *)
 
 \end{chunk}
@@ -196818,14 +249596,17 @@ WeierstrassPreparation(R): Defn == Impl where
           ++\spad{qqq(n,s,st)} is used internally.
  
     Impl ==>  add
+
         import TaylorSeries(R)
         import StreamTaylorSeriesOperations SMP
         import StreamTaylorSeriesOperations SMPS
  
- 
         map1==>map$(ST2(SMP,SUP))
+
         map2==>map$(ST2(StS,SMP))
+
         map3==>map$(ST2(StS,StS))
+
         transback:ST SMPS->L SMPS
         transback smps==
             if null smps
@@ -196837,8 +249618,8 @@ WeierstrassPreparation(R): Defn == Impl where
                 cons(map2(first,smps:ST StS):SMPS,
                    transback(map3(rest,smps:ST StS):(ST SMPS)))$(L SMPS)
  
- 
         clikeUniv(var)==p +-> likeUniv(p,var)
+
         mind:(NNI,StS)->NNI
         mind(n, sts)==
            if null sts
@@ -196848,7 +249629,6 @@ WeierstrassPreparation(R): Defn == Impl where
                 else n
         mindegree (sts:StS):NNI== mind(0,sts)
  
- 
         streamlikeUniv:(SUP,NNI)->StS
         streamlikeUniv(p:SUP,n:NNI): StS ==
           if n=0
@@ -196869,12 +249649,17 @@ WeierstrassPreparation(R): Defn == Impl where
  
         tp:(VarSet,StS)->ST StS
         tp(v,sts)==transpose sts2stst(v,sts)
+
         map4==>map$(ST2 (StS,StS))
+
         maptake:(NNI,ST StS)->ST SMPS
         maptake(n,p)== map4(cfirst n,p) pretend ST SMPS
+
         mapdrop:(NNI,ST StS)->ST SMPS
         mapdrop(n,p)== map4(crest n,p) pretend ST SMPS
+
         YSS==>Y$ParadoxicalCombinatorsForStreams(SMPS)
+
         weier:(VarSet,StS)->ST SMPS
         weier(v,sts)==
              a:=mindegree sts
@@ -196885,8 +249670,8 @@ WeierstrassPreparation(R): Defn == Impl where
                b:StS:=rest(((first p pretend StS)),a::NNI)
                c:=retractIfCan first b
                c case "failed"=>_
- error "the coefficient of the lowest degree of the variable should _
- be a constant"
+                 error "the coefficient of the lowest degree of the variable _
+                  should be a constant"
                e:=recip b
                f:= if e case "failed"
                    then error "no reciprocal"
@@ -196895,13 +249680,18 @@ WeierstrassPreparation(R): Defn == Impl where
                maptake(a,(p*q) pretend ST StS)
  
         cfirst n == s +-> first(s,n)$StS
+
         crest n  == s +-> rest(s,n)$StS
+
         qq:(NNI,SMPS,ST SMPS,ST SMPS)->ST SMPS
         qq(a,e,p,c)==
             cons(e,(-e)*mapdrop(a,(p*c)pretend(ST StS)))
+
         qqq(a,e,p)==  s +-> qq(a,e,p,s)
+
         wei:(VarSet,SMPS)->ST SMPS
         wei(v:VarSet,s:SMPS)==weier(v,s:StS)
+
         weierstrass(v,smps)== transback wei (v,smps)
 
 \end{chunk}
@@ -196909,6 +249699,104 @@ WeierstrassPreparation(R): Defn == Impl where
 \begin{chunk}{COQ WEIER}
 (* package WEIER *)
 (*
+
+        import TaylorSeries(R)
+        import StreamTaylorSeriesOperations SMP
+        import StreamTaylorSeriesOperations SMPS
+ 
+        map1==>map$(ST2(SMP,SUP))
+
+        map2==>map$(ST2(StS,SMP))
+
+        map3==>map$(ST2(StS,StS))
+
+        transback:ST SMPS->L SMPS
+        transback smps==
+            if null smps
+            then nil()$(L SMPS)
+            else
+              if null first (smps:(ST StS))
+              then nil()$(L SMPS)
+              else
+                cons(map2(first,smps:ST StS):SMPS,
+                   transback(map3(rest,smps:ST StS):(ST SMPS)))$(L SMPS)
+ 
+        clikeUniv(var)==p +-> likeUniv(p,var)
+
+        mind:(NNI,StS)->NNI
+        mind(n, sts)==
+           if null sts
+           then error "no mindegree"
+           else if first sts=0
+                then mind(n+1,rest sts)
+                else n
+        mindegree (sts:StS):NNI== mind(0,sts)
+ 
+        streamlikeUniv:(SUP,NNI)->StS
+        streamlikeUniv(p:SUP,n:NNI): StS ==
+          if n=0
+          then cons(coef (p,0),nil()$StS)
+          else cons(coef (p,n),streamlikeUniv(p,(n-1):NNI))
+ 
+        transpose:ST StS->ST StS
+        transpose(s:ST StS)==delay(
+           if null s
+           then nil()$(ST StS)
+           else cons(map2(first,s),transpose(map3(rest,rst s))))
+ 
+        zp==>map$StreamFunctions3(SUP,NNI,StS)
+ 
+        sts2stst(var, sts)==
+           zp((x,y) +-> streamlikeUniv(x,y),
+             map1(clikeUniv var, sts),(integers 0):(ST NNI))
+ 
+        tp:(VarSet,StS)->ST StS
+        tp(v,sts)==transpose sts2stst(v,sts)
+
+        map4==>map$(ST2 (StS,StS))
+
+        maptake:(NNI,ST StS)->ST SMPS
+        maptake(n,p)== map4(cfirst n,p) pretend ST SMPS
+
+        mapdrop:(NNI,ST StS)->ST SMPS
+        mapdrop(n,p)== map4(crest n,p) pretend ST SMPS
+
+        YSS==>Y$ParadoxicalCombinatorsForStreams(SMPS)
+
+        weier:(VarSet,StS)->ST SMPS
+        weier(v,sts)==
+             a:=mindegree sts
+             if a=0
+             then error "has constant term"
+             else
+               p:=tp(v,sts) pretend (ST SMPS)
+               b:StS:=rest(((first p pretend StS)),a::NNI)
+               c:=retractIfCan first b
+               c case "failed"=>_
+                 error "the coefficient of the lowest degree of the variable _
+                  should be a constant"
+               e:=recip b
+               f:= if e case "failed"
+                   then error "no reciprocal"
+                   else e::StS
+               q:=(YSS qqq(a,f:SMPS,rest p))
+               maptake(a,(p*q) pretend ST StS)
+ 
+        cfirst n == s +-> first(s,n)$StS
+
+        crest n  == s +-> rest(s,n)$StS
+
+        qq:(NNI,SMPS,ST SMPS,ST SMPS)->ST SMPS
+        qq(a,e,p,c)==
+            cons(e,(-e)*mapdrop(a,(p*c)pretend(ST StS)))
+
+        qqq(a,e,p)==  s +-> qq(a,e,p,s)
+
+        wei:(VarSet,SMPS)->ST SMPS
+        wei(v:VarSet,s:SMPS)==weier(v,s:StS)
+
+        weierstrass(v,smps)== transback wei (v,smps)
+
 *)
 
 \end{chunk}
@@ -197029,6 +249917,7 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where
       ++ \spad{wi = sum(bij * vj, j = 1..n)}.
 
   Implementation ==> add
+
     import IntegralBasisTools(R, UP, F)
     import ModularHermitianRowReduction(R)
     import TriangularMatrixOperations(R, Vector R, Vector R, Matrix R)
@@ -197163,6 +250052,136 @@ WildFunctionFieldIntegralBasis(K,R,UP,F): Exports == Implementation where
 \begin{chunk}{COQ WFFINTBS}
 (* package WFFINTBS *)
 (*
+
+    import IntegralBasisTools(R, UP, F)
+    import ModularHermitianRowReduction(R)
+    import TriangularMatrixOperations(R, Vector R, Vector R, Matrix R)
+    import DistinctDegreeFactorize(K,R)
+
+    listSquaredFactors: R -> List R
+    listSquaredFactors px ==
+      -- returns a list of the factors of px which occur with
+      -- exponent > 1
+      ans : List R := empty()
+      factored := factor(px)$DistinctDegreeFactorize(K,R)
+      for f in factors(factored) repeat
+        if f.exponent > 1 then ans := concat(f.factor,ans)
+      ans
+
+    iLocalIntegralBasis: (Vector F,Vector F,Matrix R,Matrix R,R,R) -> IResult
+    iLocalIntegralBasis(bas,pows,tfm,matrixOut,disc,prime) ==
+      n := rank()$F; standardBasis := basis()$F
+      -- 'standardBasis' is the basis for F as a FramedAlgebra;
+      -- usually this is [1,y,y**2,...,y**(n-1)]
+      p2 := prime * prime; sae := SAE(K,R,prime)
+      p := characteristic()$F; q := size()$sae
+      lp := leastPower(q,n)
+      rb := scalarMatrix(n,1); rbinv := scalarMatrix(n,1)
+      -- rb    = basis matrix of current order
+      -- rbinv = inverse basis matrix of current order
+      -- these are wrt the orginal basis for F
+      rbden : R := 1; index : R := 1; oldIndex : R := 1
+      -- rbden = denominator for current basis matrix
+      -- index = index of original order in current order
+      repeat
+        -- pows = [(w1 * rbden) ** q,...,(wn * rbden) ** q], where
+        -- bas = [w1,...,wn] is 'rbden' times the basis for the order B = 'rb'
+        for i in 1..n repeat
+          bi : F := 0
+          for j in 1..n repeat
+            bi := bi + qelt(rb,i,j) * qelt(standardBasis,j)
+          qsetelt_!(bas,i,bi)
+          qsetelt_!(pows,i,bi ** p)
+        coor0 := transpose coordinates(pows,bas)
+        denPow := rbden ** ((p - 1) :: NNI)
+        (coMat0 := coor0 exquo denPow) case "failed" =>
+          error "can't happen"
+        -- the jth column of coMat contains the coordinates of (wj/rbden)**q
+        -- with respect to the basis [w1/rbden,...,wn/rbden]
+        coMat := coMat0 :: Matrix R
+        -- the ith column of 'pPows' contains the coordinates of the pth power
+        -- of the ith basis element for B/prime.B over 'sae' = R/prime.R
+        pPows := map(reduce,coMat)$MatrixCategoryFunctions2(R,Vector R,
+                    Vector R,Matrix R,sae,Vector sae,Vector sae,Matrix sae)
+        -- 'frob' will eventually be the Frobenius matrix for B/prime.B over
+        -- 'sae' = R/prime.R; at each stage of the loop the ith column will
+        -- contain the coordinates of p^k-th powers of the ith basis element
+        frob := copy pPows; tmpMat : Matrix sae := new(n,n,0)
+        for r in 2..leastPower(p,q) repeat
+          for i in 1..n repeat for j in 1..n repeat
+            qsetelt_!(tmpMat,i,j,qelt(frob,i,j) ** p)
+          times_!(frob,pPows,tmpMat)$MATSTOR(sae)
+        frobPow := frob ** lp
+        -- compute the p-radical
+        ns := nullSpace frobPow
+        for i in 1..n repeat for j in 1..n repeat qsetelt_!(tfm,i,j,0)
+        for vec in ns for i in 1.. repeat
+          for j in 1..n repeat
+            qsetelt_!(tfm,i,j,lift qelt(vec,j))
+        id := squareTop rowEchelon(tfm,prime)
+        -- id = basis matrix of the p-radical
+        idinv := UpTriBddDenomInv(id, prime)
+        -- id * idinv = prime * identity
+        -- no need to check for inseparability in this case
+        rbinv := idealiser(id * rb, rbinv * idinv, prime * rbden)
+        index := diagonalProduct rbinv
+        rb := rowEchelon LowTriBddDenomInv(rbinv,rbden * prime)
+        if divideIfCan_!(rb,matrixOut,prime,n) = 1
+          then rb := matrixOut
+          else rbden := rbden * prime
+        rbinv := UpTriBddDenomInv(rb,rbden)
+        indexChange := index quo oldIndex
+        oldIndex := index
+        disc := disc quo (indexChange * indexChange)
+        (not sizeLess?(1,indexChange)) or ((disc exquo p2) case "failed") =>
+          return [rb, rbden, rbinv, disc]
+
+    integralBasis() ==
+      traceMat := traceMatrix()$F; n := rank()$F
+      disc := determinant traceMat        -- discriminant of current order
+      zero? disc => error "integralBasis: polynomial must be separable"
+      singList := listSquaredFactors disc -- singularities of relative Spec
+      runningRb := scalarMatrix(n,1); runningRbinv := scalarMatrix(n,1)
+      -- runningRb    = basis matrix of current order
+      -- runningRbinv = inverse basis matrix of current order
+      -- these are wrt the original basis for F
+      runningRbden : R := 1
+      -- runningRbden = denominator for current basis matrix
+      empty? singList => [runningRb, runningRbden, runningRbinv]
+      bas : Vector F := new(n,0); pows : Vector F := new(n,0)
+      -- storage for basis elements and their powers
+      tfm : Matrix R := new(n,n,0)
+      -- 'tfm' will contain the coordinates of a lifting of the kernel
+      -- of a power of Frobenius
+      matrixOut : Matrix R := new(n,n,0)
+      for prime in singList repeat
+        lb := iLocalIntegralBasis(bas,pows,tfm,matrixOut,disc,prime)
+        rb := lb.basis; rbinv := lb.basisInv; rbden := lb.basisDen
+        disc := lb.discr
+        -- update 'running integral basis' if newly computed
+        -- local integral basis is non-trivial
+        if sizeLess?(1,rbden) then
+          mat := vertConcat(rbden * runningRb,runningRbden * rb)
+          runningRbden := runningRbden * rbden
+          runningRb := squareTop rowEchelon(mat,runningRbden)
+          runningRbinv := UpTriBddDenomInv(runningRb,runningRbden)
+      [runningRb, runningRbden, runningRbinv]
+
+    localIntegralBasis prime ==
+      traceMat := traceMatrix()$F; n := rank()$F
+      disc := determinant traceMat        -- discriminant of current order
+      zero? disc => error "localIntegralBasis: polynomial must be separable"
+      (disc exquo (prime * prime)) case "failed" =>
+        [scalarMatrix(n,1), 1, scalarMatrix(n,1)]
+      bas : Vector F := new(n,0); pows : Vector F := new(n,0)
+      -- storage for basis elements and their powers
+      tfm : Matrix R := new(n,n,0)
+      -- 'tfm' will contain the coordinates of a lifting of the kernel
+      -- of a power of Frobenius
+      matrixOut : Matrix R := new(n,n,0)
+      lb := iLocalIntegralBasis(bas,pows,tfm,matrixOut,disc,prime)
+      [lb.basis, lb.basisDen, lb.basisInv]
+
 *)
 
 \end{chunk}
@@ -197292,6 +250311,38 @@ XExponentialPackage(R, VarSet, XPOLY): Public == Private where
 \begin{chunk}{COQ XEXPPKG}
 (* package XEXPPKG *)
 (*
+  
+        log (p,n) ==
+           p1 : XPOLY := p - 1
+           not quasiRegular? p1 => 
+             error "constant term <> 1, impossible log"
+           s : XPOLY := 0       -- resultat
+           k : I := n :: I 
+           for i in 1 .. n repeat
+              k1 :RN := 1/k
+              k2 : R := k1 * 1$R
+              s := trunc( trunc(p1,i) * (k2 :: XPOLY - s) , i)
+              k := k - 1
+           s
+
+        exp (p,n) ==
+           not quasiRegular? p => 
+             error "constant term <> 0, exp impossible"
+           p = 0 => 1
+           s : XPOLY := 1$XPOLY       -- resultat
+           k : I := n :: I
+           for i in 1 .. n repeat
+              k1 :RN := 1/k
+              k2 : R := k1 * 1$R
+              s := trunc( 1 +$XPOLY k2 * trunc(p,i) * s , i)
+              k := k - 1
+           s
+
+        Hausdorff(p,q,n) ==
+           p1: XPOLY := exp(p,n)
+           q1: XPOLY := exp(q,n)
+           log(p1*q1, n)
+
 *)
 
 \end{chunk}
@@ -200690,6 +253741,7 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where
        ++ \spad{convert(st)} returns the members of \spad{st}.
 
   Implementation == add
+
      news: Symbol := last(ls2)$(List Symbol)
      newv: V2 := (variable(news)$V2)::V2
      newq: Q2 :=  newv :: Q2
@@ -200740,7 +253792,6 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where
            toSee := cons([newlq,newts]$LQ2WT,toSee)
        toSave
 
-
      triangSolve(lp: LP, info?: B, lextri?: B): List TS ==
        lq: List(Q) := [convert(p)$Q for p in lp]
        lextri? => zeroSetSplit(lq,false)$lextripack
@@ -200798,7 +253849,8 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where
            toSee := cons([cons(urcRoot,lr),lv,lq2]$WIP, toSee)
        toSave
 
-     realSolve(lp: List(P), info?:Boolean, check?:Boolean, lextri?: Boolean): List REALSOL  ==
+     realSolve(lp: List(P), info?:Boolean, check?:Boolean, _
+               lextri?: Boolean): List REALSOL  ==
        lts: List TS
        lq: List(Q) := [convert(p)$Q for p in lp]
        if lextri?
@@ -200876,7 +253928,7 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where
                toSee := cons([cons(urcRoot,lr),lv,lq2]$WIP, toSee)
        toSave
 
-     positiveSolve(lp: List(P), info?:Boolean, lextri?: Boolean): List REALSOL  ==
+     positiveSolve(lp: List(P),info?:Boolean,lextri?: Boolean):List REALSOL  ==
        lts: List TS
        lq: List(Q) := [convert(p)$Q for p in lp]
        if lextri?
@@ -200925,11 +253977,12 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where
          lus: List ST := rur(st,true)$rurpack 
          for us in lus repeat
            g: U  := univariate(select(us,newv)::Q2)$Q2
-           lc: LP := [convert(q2)@P for q2 in parts(collectUpper(us,newv)$ST)$ST]
+           lc: LP:=[convert(q2)@P for q2 in parts(collectUpper(us,newv)$ST)$ST]
            toSave := cons([g,lc]$RUR, toSave)
        toSave
 
-     univariateSolve(lp: List(P), info?:Boolean, check?:Boolean, lextri?: Boolean): List RUR ==
+     univariateSolve(lp: List(P), info?:Boolean, check?:Boolean, _
+                     lextri?: Boolean): List RUR ==
        lts: List TS
        lq: List(Q) := [convert(p)$Q for p in lp]
        if lextri?
@@ -200976,6 +254029,289 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where
 \begin{chunk}{COQ ZDSOLVE}
 (* package ZDSOLVE *)
 (*
+
+     news: Symbol := last(ls2)$(List Symbol)
+     newv: V2 := (variable(news)$V2)::V2
+     newq: Q2 :=  newv :: Q2
+
+     convert(q:Q):Q2 ==
+       ground? q => (ground(q))::Q2
+       q2: Q2 := 0
+       while not ground?(q) repeat
+         v: V := mvar(q)
+         d: N := mdeg(q)
+         v2: V2 := (variable(convert(v)@Symbol)$V2)::V2
+         iq2: Q2 := convert(init(q))@Q2 
+         lq2: Q2 := (v2 :: Q2)
+         lq2 := lq2 ** d
+         q2 := iq2 * lq2 + q2
+         q := tail(q)
+       q2 + (ground(q))::Q2
+
+     squareFree(ts:TS):List(ST) == 
+       irred?: Boolean := false
+       st: ST := [[newq]$(List Q2)]      
+       lq: List(Q2) := [convert(p)@Q2 for p in parts(ts)]
+       lq := sort(infRittWu?,lq)
+       toSee: List LQ2WT := []
+       if irred?
+         then
+           lf := irreducibleFactors([first lq])$polsetpack
+           lq := rest lq
+           for f in lf repeat
+             toSee := cons([cons(f,lq),st]$LQ2WT, toSee)
+         else
+           toSee := [[lq,st]$LQ2WT]
+       toSave: List ST := []
+       while not empty? toSee repeat
+         lqwt := first toSee; toSee := rest toSee
+         lq := lqwt.val; st := lqwt.tower
+         empty? lq => 
+           toSave := cons(st,toSave)
+         q := first lq; lq := rest lq
+         lsfqwt: List Q2WT := squareFreePart(q,st)$ST
+         for sfqwt in lsfqwt repeat
+           q := sfqwt.val; st := sfqwt.tower
+           if not ground? init(q)
+             then
+               q := normalizedAssociate(q,st)$normpack
+           newts := internalAugment(q,st)$ST      
+           newlq := [remainder(q,newts).polnum for q in lq]
+           toSee := cons([newlq,newts]$LQ2WT,toSee)
+       toSave
+
+     triangSolve(lp: LP, info?: B, lextri?: B): List TS ==
+       lq: List(Q) := [convert(p)$Q for p in lp]
+       lextri? => zeroSetSplit(lq,false)$lextripack
+       zeroSetSplit(lq,true,info?)$TS
+
+     triangSolve(lp: LP, info?: B): List TS == triangSolve(lp,info?,false)
+
+     triangSolve(lp: LP): List TS == triangSolve(lp,false)
+
+     convert(u: U): URC ==
+       zero? u => 0
+       ground? u => ((ground(u) :: K)::RC)::URC
+       uu: URC := 0
+       while not ground? u repeat
+         uu := monomial((leadingCoefficient(u) :: K):: RC,degree(u)) + uu
+         u := reductum u
+       uu + ((ground(u) :: K)::RC)::URC
+
+     coerceFromRtoRC(r:R): RC ==
+       (r::K)::RC
+
+     convert(p:P): PRC ==
+       map(coerceFromRtoRC,p)$PolynomialFunctions2(R,RC)
+
+     convert(q2:Q2): PRC ==
+       p: P := coerce(q2)$Q2
+       convert(p)@PRC
+       
+     convert(sts:ST): List Q2 ==
+       lq2: List(Q2) := parts(sts)$ST
+       lq2 := sort(infRittWu?,lq2)
+       rest(lq2)
+
+     realSolve(ts: TS): List REALSOL ==
+       lsts: List ST := squareFree(ts)
+       lr: REALSOL := []
+       lv: List Symbol := []
+       toSee := [[lr,lv,convert(sts)@(List Q2)]$WIP for sts in lsts]
+       toSave: List REALSOL := []
+       while not empty? toSee repeat
+         wip := first toSee; toSee := rest toSee
+         lr := wip.reals; lv := wip.vars; lq2 := wip.pols
+         (empty? lq2) and (not empty? lr) => 
+            toSave := cons(reverse(lr),toSave)
+         q2 := first lq2; lq2 := rest lq2
+         qrc := convert(q2)@PRC
+         if not empty? lr 
+           then
+             for r in reverse(lr) for v in reverse(lv) repeat
+               qrc := eval(qrc,v,r)
+         lv := cons((mainVariable(qrc) :: Symbol),lv)
+         urc: URC := univariate(qrc)@URC
+         urcRoots := allRootsOf(urc)$RC
+         for urcRoot in urcRoots repeat
+           toSee := cons([cons(urcRoot,lr),lv,lq2]$WIP, toSee)
+       toSave
+
+     realSolve(lp: List(P), info?:Boolean, check?:Boolean, _
+               lextri?: Boolean): List REALSOL  ==
+       lts: List TS
+       lq: List(Q) := [convert(p)$Q for p in lp]
+       if lextri?
+         then
+           lts := zeroSetSplit(lq,false)$lextripack
+         else
+           lts := zeroSetSplit(lq,true,info?)$TS
+       lsts:  List ST := []
+       for ts in lts repeat 
+         lsts := concat(squareFree(ts), lsts)
+       lsts := removeSuperfluousQuasiComponents(lsts)$quasicomppack   
+       lr: REALSOL := []
+       lv: List Symbol := []
+       toSee := [[lr,lv,convert(sts)@(List Q2)]$WIP for sts in lsts]
+       toSave: List REALSOL := []
+       while not empty? toSee repeat
+         wip := first toSee; toSee := rest toSee
+         lr := wip.reals; lv := wip.vars; lq2 := wip.pols
+         (empty? lq2) and (not empty? lr) => 
+            toSave := cons(reverse(lr),toSave)
+         q2 := first lq2; lq2 := rest lq2
+         qrc := convert(q2)@PRC
+         if not empty? lr 
+           then
+             for r in reverse(lr) for v in reverse(lv) repeat
+               qrc := eval(qrc,v,r)
+         lv := cons((mainVariable(qrc) :: Symbol),lv)
+         urc: URC := univariate(qrc)@URC
+         urcRoots := allRootsOf(urc)$RC
+         for urcRoot in urcRoots repeat
+           toSee := cons([cons(urcRoot,lr),lv,lq2]$WIP, toSee)
+       if check?
+         then
+           for p in lp repeat
+             for realsol in toSave repeat
+               prc: PRC := convert(p)@PRC
+               for rr in realsol for symb in reverse(ls) repeat
+                 prc := eval(prc,symb,rr)
+               not zero? prc =>
+                 error "realSolve$ZDSOLVE: bad result"
+       toSave
+
+     realSolve(lp: List(P), info?:Boolean, check?:Boolean): List REALSOL  ==
+       realSolve(lp,info?,check?,false)
+         
+     realSolve(lp: List(P), info?:Boolean): List REALSOL  ==
+       realSolve(lp,info?,false,false)
+
+     realSolve(lp: List(P)): List REALSOL  ==
+       realSolve(lp,false,false,false)
+
+     positiveSolve(ts: TS): List REALSOL ==
+       lsts: List ST := squareFree(ts)
+       lr: REALSOL := []
+       lv: List Symbol := []
+       toSee := [[lr,lv,convert(sts)@(List Q2)]$WIP for sts in lsts]
+       toSave: List REALSOL := []
+       while not empty? toSee repeat
+         wip := first toSee; toSee := rest toSee
+         lr := wip.reals; lv := wip.vars; lq2 := wip.pols
+         (empty? lq2) and (not empty? lr) => 
+            toSave := cons(reverse(lr),toSave)
+         q2 := first lq2; lq2 := rest lq2
+         qrc := convert(q2)@PRC
+         if not empty? lr 
+           then
+             for r in reverse(lr) for v in reverse(lv) repeat
+               qrc := eval(qrc,v,r)
+         lv := cons((mainVariable(qrc) :: Symbol),lv)
+         urc: URC := univariate(qrc)@URC
+         urcRoots := allRootsOf(urc)$RC
+         for urcRoot in urcRoots repeat
+           if positive? urcRoot
+             then 
+               toSee := cons([cons(urcRoot,lr),lv,lq2]$WIP, toSee)
+       toSave
+
+     positiveSolve(lp: List(P),info?:Boolean,lextri?: Boolean):List REALSOL  ==
+       lts: List TS
+       lq: List(Q) := [convert(p)$Q for p in lp]
+       if lextri?
+         then
+           lts := zeroSetSplit(lq,false)$lextripack
+         else
+           lts := zeroSetSplit(lq,true,info?)$TS
+       lsts:  List ST := []
+       for ts in lts repeat 
+         lsts := concat(squareFree(ts), lsts)
+       lsts := removeSuperfluousQuasiComponents(lsts)$quasicomppack   
+       lr: REALSOL := []
+       lv: List Symbol := []
+       toSee := [[lr,lv,convert(sts)@(List Q2)]$WIP for sts in lsts]
+       toSave: List REALSOL := []
+       while not empty? toSee repeat
+         wip := first toSee; toSee := rest toSee
+         lr := wip.reals; lv := wip.vars; lq2 := wip.pols
+         (empty? lq2) and (not empty? lr) => 
+            toSave := cons(reverse(lr),toSave)
+         q2 := first lq2; lq2 := rest lq2
+         qrc := convert(q2)@PRC
+         if not empty? lr 
+           then
+             for r in reverse(lr) for v in reverse(lv) repeat
+               qrc := eval(qrc,v,r)
+         lv := cons((mainVariable(qrc) :: Symbol),lv)
+         urc: URC := univariate(qrc)@URC
+         urcRoots := allRootsOf(urc)$RC
+         for urcRoot in urcRoots repeat
+           if positive? urcRoot
+             then 
+               toSee := cons([cons(urcRoot,lr),lv,lq2]$WIP, toSee)
+       toSave
+
+     positiveSolve(lp: List(P), info?:Boolean): List REALSOL  ==
+       positiveSolve(lp, info?, false)
+
+     positiveSolve(lp: List(P)): List REALSOL  ==
+       positiveSolve(lp, false, false)
+
+     univariateSolve(ts: TS): List RUR ==
+       toSee: List ST := squareFree(ts)
+       toSave: List RUR := []
+       for st in toSee repeat
+         lus: List ST := rur(st,true)$rurpack 
+         for us in lus repeat
+           g: U  := univariate(select(us,newv)::Q2)$Q2
+           lc: LP:=[convert(q2)@P for q2 in parts(collectUpper(us,newv)$ST)$ST]
+           toSave := cons([g,lc]$RUR, toSave)
+       toSave
+
+     univariateSolve(lp: List(P), info?:Boolean, check?:Boolean, _
+                     lextri?: Boolean): List RUR ==
+       lts: List TS
+       lq: List(Q) := [convert(p)$Q for p in lp]
+       if lextri?
+         then
+           lts := zeroSetSplit(lq,false)$lextripack
+         else
+           lts := zeroSetSplit(lq,true,info?)$TS
+       toSee:  List ST := []
+       for ts in lts repeat 
+         toSee := concat(squareFree(ts), toSee)
+       toSee := removeSuperfluousQuasiComponents(toSee)$quasicomppack   
+       toSave: List RUR := []
+       if check?
+         then
+           lq2: List(Q2) := [convert(p)$Q2 for p in lp]
+       for st in toSee repeat
+         lus: List ST := rur(st,true)$rurpack 
+         for us in lus repeat
+            if check?
+              then
+                rems: List(Q2) := [removeZero(q2,us)$ST for q2 in lq2]
+                not every?(zero?,rems) =>
+                  output(st::OutputForm)$OutputPackage
+                  output("Has a bad RUR component:")$OutputPackage
+                  output(us::OutputForm)$OutputPackage
+                  error "univariateSolve$ZDSOLVE: bad RUR"
+            g: U  := univariate(select(us,newv)::Q2)$Q2
+            lc: LP := _
+              [convert(q2)@P for q2 in parts(collectUpper(us,newv)$ST)$ST]
+            toSave := cons([g,lc]$RUR, toSave)
+       toSave
+
+     univariateSolve(lp: List(P), info?:Boolean, check?:Boolean): List RUR ==
+       univariateSolve(lp,info?,check?,false)
+
+     univariateSolve(lp: List(P), info?:Boolean): List RUR ==
+       univariateSolve(lp,info?,false,false)
+
+     univariateSolve(lp: List(P)): List RUR ==
+       univariateSolve(lp,false,false,false)
+
 *)
 
 \end{chunk}
@@ -200989,8 +254325,8 @@ ZeroDimensionalSolvePackage(R,ls,ls2): Exports == Implementation where
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \chapter{Chunk collections}
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-Module Packages
 \begin{chunk}{coq}
+Module Packages
 \getchunk{COQ AFALGGRO}
 \getchunk{COQ AFALGRES}
 \getchunk{COQ AF}
diff --git a/books/bookvolbib.pamphlet b/books/bookvolbib.pamphlet
index 248861b..ac43a4b 100644
--- a/books/bookvolbib.pamphlet
+++ b/books/bookvolbib.pamphlet
@@ -13127,6 +13127,21 @@ Ph.D Thesis, Univ. Delaware (1999)
 
 \subsection{C} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
+\index{Cantor, D.}
+\begin{chunk}{axiom.bib}
+@article{Cant87,
+  author = "Cantor, D.",
+  title = "Computing in the Jacobian of a HyperellipticCurve",
+  journal = "Mathematics of Computation",
+  volume = "48",
+  number = "177",
+  month = "January",
+  year = "1987",
+  pages = "95-101",
+}
+
+\end{chunk}
+
 \index{Carlson, B. C.}
 \begin{chunk}{ignore}
 \bibitem[Carlson 65]{Car65} Carlson, B C
diff --git a/changelog b/changelog
index b47de77..7733a80 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,8 @@
+20150815 tpd src/axiom-website/patches.html 20150815.01.tpd.patch
+20150815 tpd books/bookvolbib add additional references
+20150815 tpd books/bookvol10.4 extract code for COQ proof system
+20150815 tpd books/bookvol10.3 extract code for COQ proof system
+20150815 tpd books/bookvol10.2 extract code for COQ proof system
 20150804 tpd src/axiom-website/patches.html 20150804.02.tpd.patch
 20150804 tpd buglist bug 7303: Duplicate signature in )show ALIST 
 20150804 tpd src/axiom-website/patches.html 20150804.01.tpd.patch
diff --git a/patch b/patch
index 845c195..b11eb59 100644
--- a/patch
+++ b/patch
@@ -1,7 +1,8 @@
-buglist bug 7303: Duplicate signature in )show ALIST
+books/bookvol10.* extract code for COQ proof system
 
 Goal: Proving Axiom Correct
 
-This signature appears to be a duplicate in the )show command.
-The reason is unclear and is marked as a bug.
+Collect all of the functions in the categories, domains, and packages
+into obj/sys/proofs/coq.v
+
 
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 9588756..1f55f62 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -5116,6 +5116,8 @@ buglist: add TODO for erf-related conversion to Float<br/>
 books/bookvol10.* add COQ stanzas<br/>
 <a href="patches/20150804.02.tpd.patch">20150804.02.tpd.patch</a>
 buglist bug 7303: Duplicate signature in )show ALIST <br/>
+<a href="patches/20150815.01.tpd.patch">20150815.01.tpd.patch</a>
+books/bookvol10.* extract code for COQ proof system<br/>
  </body>
 </html>
 
-- 
1.7.5.4