Waldek,

Attached and below is the patch rebased to revision 730 that adds
Comparable to the XPOLY and Tensor domains (and others that depend on
FreeModuleCategory). Among other things this change permits these
domains to participate with domains like Expression again, although
there are some additional extensions and corrections needed in
Expression to make this work properly.  Also related to this and
included is the patch to constantOperator to remove dependence on
OrderedSet. I have tested this fairly well but I think it would be
prudent if you (or anyone else) also give it a try.

If you agree it is ok, I will commit it ASAP.

One reason I am anxious now to complete this is that I have other
things in my local patch queue that need to make independent changes
to 'src/algebra/Makefile.in'. It is a (serious!) limitation of the
changelist functionality in subversion that a change to a single file
is the smallest atomic change and a modified file can be a member of
only one changelist. I have not efficient way to keep independent
changes separate if I try to merge more of what's waiting.

> On Wed, Oct 28, 2009 at 2:06 PM, Waldek Hebisch wrote:
>> Well, first I prefer to have good patches committed quickly instead
>> of sitting in the patch queue.  Second, it would be good if person
>> working on a patch explicitely said that he/she supends it.  For
>> example, you Bill had patch adding 'Comparable' to some domains.
>> The patch looks good but I do not know if you hit some problems
>> during testing and are busy solving them or you are occupied with
>> something else...
>>

On Wed, Oct 28, 2009 at 5:05 PM, Bill Page  wrote:
> About Comparable:  Yes, it was important for some things I was working
> on at the time and I did commit at least part of these changes. But
> they were also became part of something more ambitious involving
> changing Void to a domain in SetCategory which did not work out so
> well and I have set aside for now. I guess I still do not really know
> how to properly organize and discipline my "play" so that it results
> in some things that can be easily salvaged. I am inclined to blame the
> tools such as limitations of svn but really it just comes down again
> to a lack of time and excess of ambition.  BTW, maybe I will start
> using darcs again locally as a way of more easily staging patches.
>

Well for now I am still trying to live with changelists in subversion ... :-(

wsp...@debian:~/fricas-sources$ svn status
?      src/share/spadhelp

--- Changelist 'free':
M      src/algebra/free.spad.pamphlet

--- Changelist 'hash':
M      src/algebra/list.spad.pamphlet

--- Changelist 'comparable':
M      src/algebra/op.spad.pamphlet
M      src/algebra/Makefile.in
M      src/algebra/variable.spad.pamphlet
M      src/algebra/poly.spad.pamphlet

--- Changelist 'combfunc':
M      src/algebra/combfunc.spad.pamphlet
M      src/algebra/tex.spad.pamphlet
M      src/interp/i-output.boot

--- Changelist 'unparse':
M      src/interp/format.boot

Here is the patch:

wsp...@debian:~/fricas-sources$ svn diff --changelist comparable >
~/algebra-comparable-1.patch

wsp...@debian:~/fricas-sources$ cat ~/algebra-comparable-1.patchIndex:
src/algebra/op.spad.pamphlet
===================================================================
--- src/algebra/op.spad.pamphlet        (revision 730)
+++ src/algebra/op.spad.pamphlet        (working copy)
@@ -234,11 +234,11 @@
       ++ derivative(op) returns the value of the "%diff" property of
       ++ op if it has one, and "failed" otherwise.
     constantOperator: A -> OP
-        ++ constantOperator(a) returns a nullary operator op
-        ++ such that \spad{op()} always evaluate to \spad{a}.
+      ++ constantOperator(a) returns a nullary operator op
+      ++ such that \spad{op()} always evaluate to \spad{a}.
     constantOpIfCan : OP -> Union(A, "failed")
-        ++ constantOpIfCan(op) returns \spad{a} if op is the constant
-        ++ nullary operator always returning \spad{a}, "failed" otherwise.
+      ++ constantOpIfCan(op) returns \spad{a} if op is the constant
+      ++ nullary operator always returning \spad{a}, "failed" otherwise.

   Implementation ==> add

@@ -271,43 +271,44 @@
         derivative(op, [(l1: List(A)): A +-> f first l1]$List(List A -> A))
       error "Operator is not unary"

-    if A has OrderedSet then
-      cdisp   : (OutputForm, List OutputForm) -> OutputForm
-      csex    : (InputForm,  List InputForm) -> InputForm
-      eqconst?: (OP, OP) -> Boolean
-      ltconst?: (OP, OP) -> Boolean
-      constOp : A -> OP
+    cdisp   : (OutputForm, List OutputForm) -> OutputForm
+    csex    : (InputForm,  List InputForm) -> InputForm
+    eqconst?: (OP, OP) -> Boolean
+    constOp : A -> OP

-      opconst:OP :=
-        comparison(equality(operator('constant, 0), eqconst?),
-                                                               ltconst?)
+    cdisp(a, l) == a
+    csex(a, l)  == a

-      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)
-
+    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)
+    opconst:OP
+    if A has Comparable then
+      ltconst?: (OP, OP) -> Boolean
       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)
+           smaller?((va::None) pretend A,(vb::None) pretend A)
+      opconst :=
+        comparison(equality(operator('constant, 0), eqconst?), ltconst?)
+    else
+      opconst := equality(operator('constant, 0), eqconst?)

-      constOp a ==
-        setProperty(display(copy opconst, (l1: List(OutputForm)):
OutputForm +-> cdisp(a::OutputForm, l1)),
+    constOp a ==
+      setProperty(display(copy opconst,
+        (l1: List(OutputForm)): OutputForm +-> cdisp(a::OutputForm, l1)),
                                                   CONST, a pretend None)

-      constantOpIfCan op ==
-        is?(op, 'constant) and
-          ((u := property(op, CONST)) case None) => (u::None) pretend A
-        "failed"
+    constantOpIfCan op ==
+      is?(op, 'constant) and
+        ((u := property(op, CONST)) case None) => (u::None) pretend A
+      "failed"

-      if A has ConvertibleTo InputForm then
-        constantOperator a == input(constOp a,  (l1:
List(InputForm)): InputForm +-> csex(convert a, l1))
-      else
-        constantOperator a == constOp a
+    if A has ConvertibleTo InputForm then
+      constantOperator a == input(constOp a,  (l1: List(InputForm)):
InputForm +-> csex(convert a, l1))
+    else
+      constantOperator a == constOp a

 @
 \section{package COMMONOP CommonOperators}
Index: src/algebra/Makefile.in
===================================================================
--- src/algebra/Makefile.in     (revision 730)
+++ src/algebra/Makefile.in     (working copy)
@@ -323,10 +323,10 @@
         ATRIG BASTYPE BGAGG BRAGG BTAGG BTCAT CLAGG COMPCAT DIAGG \
         DIFEXT DIFRING DIOPS DIRPCAT DIVRING DPOLCAT DVARCAT ELAGG \
         ELEMFUN ELTAGG ES EUCDOM EVALAB FAMR FAXF FDIVCAT FEVALAB \
-        FFCAT FFIELDC FIELD FINAALG FINITE FINRALG FLAGG FLINEXP FPC FPS \
-        FRAMALG FRETRCT FRNAALG FSAGG FS GCDDOM GRALG GRMOD GROUP \
-        HOAGG HYPCAT IEVALAB INS INTDOM IXAGG KDAGG LALG LIECAT LNAGG \
-        LODOCAT LOGIC LSAGG LZSTAGG MATCAT MODULE MONAD MONADWU \
+        FFCAT FFIELDC FIELD FINAALG FINITE FINRALG FLAGG FLINEXP FMCAT \
+        FPC FPS FRAMALG FRETRCT FRNAALG FSAGG FS GCDDOM GRALG GRMOD \
+        GROUP HOAGG HYPCAT IEVALAB INS INTDOM IXAGG KDAGG LALG LIECAT \
+        LNAGG LODOCAT LOGIC LSAGG LZSTAGG MATCAT MODULE MONAD MONADWU \
         MONOGEN MONOID MTSCAT NAALG NARNG NASRING OC ORDRING ORDSET OREPCAT \
         PDRING PFECAT POLYCAT PSCAT PSETCAT QFCAT QUATCAT RADCAT \
         RCAGG RCFIELD RETRACT RING RMATCAT RNS RPOLCAT RRCC RSETCAT \
Index: src/algebra/variable.spad.pamphlet
===================================================================
--- src/algebra/variable.spad.pamphlet  (revision 730)
+++ src/algebra/variable.spad.pamphlet  (working copy)
@@ -35,7 +35,7 @@
             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
        s1 = s2 == s1 =$Rep s2
        latex(x:%):String      == latex(convert(x)@Symbol)

Index: src/algebra/poly.spad.pamphlet
===================================================================
--- src/algebra/poly.spad.pamphlet      (revision 730)
+++ src/algebra/poly.spad.pamphlet      (working copy)
@@ -78,14 +78,23 @@
           ++ \spad{monom(s,r)} returns the product of the basis
element \spad{s} by the coefficient \spad{r}.
         coefficient :(%,S) -> R
           ++ \spad{coefficient(x,s)} returns the coefficient of the
basis element s
-      -- attributs
+        -- attributs
         if R has CommutativeRing then
              Module(R)
              linearExtend:(S->R,%)->R
           ++ \spad{linearExtend:(f,x)} returns the linear extension
           ++ of a map defined on the basis applied to a linear combination
+        if R has Comparable then Comparable
+      add
+        if R has Comparable then
+          smaller?(p:%,q:%):Boolean ==
+            if leadingMonomial(p)=leadingMonomial(q) then
+              if leadingCoefficient(p)=leadingCoefficient(q) then
+                smaller?(reductum p, reductum q)
+              else
+                smaller?(leadingCoefficient(p),leadingCoefficient(q))
+            leadingMonomial(p)<leadingMonomial(q)

-
 @
 \section{domain FM FreeModule}
 <<domain FM FreeModule>>=
wsp...@debian:~/fricas-sources$

---

The next patch shown in 'svn status' above contains the changes to
InputForm and unparse I have discussed with Martin Rubey for product
and summation.

--- Changelist 'combfunc':
M      src/algebra/combfunc.spad.pamphlet
M      src/algebra/tex.spad.pamphlet
M      src/interp/i-output.boot

wsp...@debian:~/fricas-sources$ svn diff --changelist combfunc >
~/algebra-combfunc-2.patch
wsp...@debian:~/fricas-sources$ cat ~/algebra-combfunc-2.patchIndex:
src/algebra/combfunc.spad.pamphlet
===================================================================
--- src/algebra/combfunc.spad.pamphlet  (revision 730)
+++ src/algebra/combfunc.spad.pamphlet  (working copy)
@@ -62,6 +62,7 @@
   K   ==> Kernel F
   SE  ==> Symbol
   O   ==> OutputForm
+  I   ==> InputForm
   SMP ==> SparseMultivariatePolynomial(R, K)
   Z   ==> Integer

@@ -70,6 +71,7 @@
   SPECIALDIFF  ==> '%specialDiff
   SPECIALDISP  ==> '%specialDisp
   SPECIALEQUAL ==> '%specialEqual
+  SPECIALINPUT ==> '%specialInput

   Exports ==> with
     belong?    : OP -> Boolean
@@ -184,6 +186,8 @@
     ddsum     : List F -> O
     dprod     : List F -> O
     ddprod    : List F -> O
+    indprod   : List F -> I
+    indsum    : List F -> I
     equalsumprod  : (K, K) -> Boolean
     equaldsumprod : (K, K) -> Boolean
     fourth    : List F -> F
@@ -408,6 +412,22 @@
     ddsum l ==
       sum(summand(l)::O, third(l)::O = fourth(l)::O, fourth(rest l)::O)

+    if F has ConvertibleTo(I) then
+      indprod l ==
+        convert([convert(_product)$I, convert(summand l)@I, _
+          convert([convert("="::Symbol)$I, convert(third l)@I, _
+            convert([convert('SEGMENT)$I, _
+            convert(fourth l)@I, convert(fourth rest l)@I]$List(I)) _
+            ]$List(I)) _
+          ]$List(I))
+      indsum l ==
+        convert([convert(_summation)$I, convert(summand l)@I, _
+          convert([convert("="::Symbol)$I, convert(third l)@I, _
+            convert([convert('SEGMENT)$I, _
+            convert(fourth l)@I, convert(fourth rest l)@I]$List(I))@I _
+            ]$List(I))@I _
+          ]$List(I))@I
+
 @

 The next two operations handle the testing for equality of sums and
@@ -680,6 +700,10 @@
     setProperty(opprod,  SPECIALEQUAL, equalsumprod@((K,K) ->
Boolean) pretend None)
     setProperty(opdprod, SPECIALEQUAL, equaldsumprod@((K,K) ->
Boolean) pretend None)

+    if F has ConvertibleTo(I) then
+      setProperty(opdprod, SPECIALINPUT, indprod@(List F -> I) pretend None)
+      setProperty(opdsum,  SPECIALINPUT, indsum@(List F -> I) pretend None)
+
 @


Index: src/algebra/tex.spad.pamphlet
===================================================================
--- src/algebra/tex.spad.pamphlet       (revision 730)
+++ src/algebra/tex.spad.pamphlet       (working copy)
@@ -37,8 +37,8 @@
 \end{verbatim}
 it now reads:
 <<product(product(i*j,i=a..b),j=c..d) fix>>=
-    plexOps       : L S :=
["SIGMA","SIGMA2","PI","PI2","INTSIGN","INDEFINTEGRAL"]$(L S)
-    plexPrecs     : L I := [    700, 800,     700, 800 , 700,      700]$(L I)
+    plexOps       : L S := ["SIGMA","SIGMA2", "PI",
"PI2","INTSIGN","INDEFINTEGRAL"]$(L S)
+    plexPrecs     : L I := [   1000,    1000, 1000,  1000,      700,
          700]$(L I)
 @
 in addition we need to add a line defining [[PI2]] in [[formatPlex]]:
 <<define PI2>>=
@@ -493,7 +493,7 @@
           if hold ~= "" then
             s := concat [s," \sp",group concat ["\displaystyle ",hold]]
           args := rest args
-        s := concat [s," ",formatTex(first args,minPrec)]
+        s := concat [s," ",formatTex(first args,opPrec)]
       else
         hold := group concat [hold," ",formatTex(first args,minPrec)]
         s := concat [s," ",hold]
Index: src/interp/i-output.boot
===================================================================
--- src/interp/i-output.boot    (revision 730)
+++ src/interp/i-output.boot    (working copy)
@@ -1107,7 +1107,11 @@
     3
   maxWidth := MAX(opWidth,botWidth,topWidth)
   xCenter := (maxWidth-1)/ 2 + x
-  d:=APP(arg,x+2+maxWidth,y,d)
+
+  --d:=APP(arg,x+2+maxWidth,y,d)
+  prec := 1000  -- binding power of ! -1
+  [d,x1]:=appInfixArg(arg,x+maxWidth,y,d, prec,"left",nil)
+
   d:=
       atom bot and SIZE atom2String bot = 1 => APP(bot,xCenter,y-2,d)
       APP(bot,x + (maxWidth - botWidth)/2,y-2-superspan bot,d)
wsp...@debian:~/fricas-sources$

The 'combfunc' changes depend on a small part of the changes labelled
'unparse'.  But  the changes in 'format.boot' are quite extensive and
possibly controversial since in fixing a problem that caused unparse
to abort, I was strongly motivated to re-organize significant parts
that result in some small and some larger changes in the way FriCAS
displays types and expressions involving functions.

--- Changelist 'unparse':
M      src/interp/format.boot

Specifically, it returns to the Axiom way of eliminating redundant
parenthesis. For example,

wsp...@debian:~/fricas-sources$ fricas -nox
Checking for foreign routines
AXIOM="/usr/local/lib/fricas/target/i686-pc-linux"
spad-lib="/usr/local/lib/fricas/target/i686-pc-linux/lib/libspad.so"
foreign routines found
openServer result 0
                 FriCAS (AXIOM fork) Computer Algebra System
                         Version: FriCAS 2009-10-26
              Timestamp: Tuesday November 10, 2009 at 02:46:16
-----------------------------------------------------------------------------
   Issue )copyright to view copyright notices.
   Issue )summary for a summary of useful system commands.
   Issue )quit to leave FriCAS and return to shell.
-----------------------------------------------------------------------------

   Re-reading compress.daase   Re-reading interp.daase
   Re-reading operation.daase
   Re-reading category.daase
   Re-reading browse.daase
(1) ->
(1) -> sin cos tan x

   (1)  sin(cos(tan(x)))
                                                     Type: Expression Integer
(2) -> %::InputForm

   (2)  (sin (cos (tan x)))
                                                              Type: InputForm
(3) -> unparse %

   (3)  "sin cos tan x"
                                                                 Type: String

---

Notice the lack of redundant parenthesis in 'Expression Integer' and
in the output of unparse.

Having experimented with this for the last week or so, as in Axiom
user I find I do prefer it this way.  But the change to revert unparse
and Type: output to the old FriCAS style is a very simple one.  I
wonder if maybe we should not have an option somewhere for people (and
other computer systems, e.g. Sage) that might prefer the extra
parenthesis?

Here is the rest of the patch in case anyone wants to play with it
before commenting:

wsp...@debian:~/fricas-sources$ svn diff --changelist unparse >
~/interp-format-2.patch
wsp...@debian:~/fricas-sources$ cat ~/interp-format-2.patchIndex:
src/interp/format.boot
===================================================================
--- src/interp/format.boot      (revision 730)
+++ src/interp/format.boot      (working copy)
@@ -240,7 +240,6 @@
     op
   STRINGP op or GETL(op,"Led") or GETL(op,"Nud") =>
     n = 3 =>
-      if op = 'SEGMENT then op := '".."
       op = 'in => [quad,'" ",op,'" ",quad]
 -- stop exquo from being displayed as infix (since it is not accepted
 -- as such by the interpreter)
@@ -344,11 +343,6 @@
   $whereList => concat(s,'%b,'"where",'%d,"%i",$whereList,"%u")
   s

-form2StringWithPrens form ==
-  null (argl := rest form) => [first form]
-  null rest argl => [first form,"(",first argl,")"]
-  form2String form
-
 formString u ==
   x := form2String u
   atom x => STRINGIMAGE x
@@ -356,7 +350,6 @@

 unparseInputForm u ==
   $formatSigAsTeX: local := 1
-  $InteractiveMode: local := false
   form2StringLocal u

 form2String u ==
@@ -368,7 +361,6 @@
   form2StringLocal u

 form2StringLocal u ==
---+
   $NRTmonitorIfTrue : local := nil
   $fortInts2Floats  : local := nil
   form2String1 u
@@ -390,25 +382,9 @@
   op := CAR u
   argl := CDR u
   op='Join or op= 'mkCategory => formJoin1(op,argl)
-  $InteractiveMode and (u:= constructor? op) =>
-    null argl => app2StringWrap(formWrapId constructorName op, u1)
-    op = "NTuple"  => [ form2String1 first argl, "*"]
-    op = "Map"     => ["(",:formatSignature0 [argl.1,argl.0],")"]
-    op = 'Record => record2String(argl)
-    null (conSig := getConstructorSignature op) =>
-      application2String(constructorName op,[form2String1(a) for a in
argl], u1)
-    ml := rest conSig
-    if not freeOfSharpVars ml then
-      ml:=SUBLIS([[pvar,:val] for pvar in $FormalMapVariableList
-        for val in argl], ml)
-    argl:= formArguments2String(argl,ml)
-      -- extra null check to handle mutable domain hack.
-    null argl => constructorName op
-    application2String(constructorName op,argl, u1)
   op = "Mapping" => ["(",:formatSignature argl,")"]
   op = "Record" => record2String(argl)
-  op = 'Union  =>
-    application2String(op,[form2String1 x for x in argl], u1)
+  op = 'Union  =>  application2String(op, argl, u1)
   op = ":" =>
       null argl => [ '":" ]
       null rest argl => [ '":", form2String1 first argl ]
@@ -430,25 +406,23 @@
   op = 'construct =>
     concat(lbrkSch(),
            tuple2String [form2String1 x for x in argl],rbrkSch())
-  op = "SEGMENT" =>
-    null argl => '".."
-    lo := form2String1 first argl
-    argl := rest argl
-    (null argl) or null (first argl) => [lo, '".."]
-    [lo, '"..", form2String1 first argl]
+  u1 is ["SEGMENT", arg1] =>
+     concat [appOrParen(arg1), '".."]
+  u1 is ["SEGMENT", arg1, arg2] =>
+     concat(appOrParen(arg1),"..",appOrParen(arg2))
   op = "MATRIX" => matrix2String argl
   u1 is ["ROOT", arg1] =>
      concat("sqrt(", appOrParen(arg1),")")
   u1 is ["ROOT", arg1, arg2] =>
      concat("nthRoot(", appOrParen(arg1),",",appOrParen(arg2),")")
      --concat(appOrParen(arg1), '"^", appOrParen(["OVER",1,arg2]))
-  u1 is ["$elt", t, f] =>
+  u1 is ['"$elt", t, f] =>
      concat(form2String1 f, '"$", form2String1 t)
   #argl = 2 and (isBinaryInfix op or op = "::" or op = '"::"_
      or op = "@" or op = '"@" or op = "pretend" or op = '"pretend"_
      or op = "OVER" or op = '"OVER") =>
           binop2String [op,:argl]
-  application2String(op,[form2String1 x for x in argl], u1)
+  application2String(op,argl,u1)

 matrix2String x ==
   concat(lbrkSch(),
@@ -460,13 +434,13 @@
 binop2String x ==
     $curExpr : local := x
     x is ["=", arg1, arg2] or x is ['"=", arg1, arg2] =>
-        concat(sumOrParen(arg1), '"=", sumOrParen(arg2))
+        concat(form2String1(arg1), '"=", form2String1(arg2))
     sumOrParen(x)

 sumOrParen(x) ==
    x is [op, arg1, arg2] =>
        op = "+" or op = '"+" =>
-          concat(sumOrParen(arg1), '"+", productOrParen(arg2))
+          concat(sumOrParen(arg1), '"+", sumOrParen(arg2))
        op = "-" or op = '"-" =>
            concat(sumOrParen(arg1), '"-", productOrParen(arg2))
        op = "/" or op = '"/" or op = "OVER" or op = '"OVER" =>
@@ -509,12 +483,11 @@
    [op, :argl] := x
    (op = "-" or op = '"-") and #argl = 1 =>
        concat('"(", '"-", appOrParen(first argl), '")")
-   EQ(x, $curExpr) => BREAK()
-   op is ["$elt", f, t] =>
-       form2String1 x
+   -- EQ(x, $curExpr) => BREAK()
+   op is ["$elt", f, t] => form2String1 x
    -- Put parenthesis around anything special
    not(SYMBOLP op) or GET(op, "Led") or GET(op, "Nud")_
-     or op= 'mkCategory or op = "SEGMENT" _
+     or op= 'mkCategory _
      or op = 'construct or op = 'COLLECT or op = "SIGNATURE"_
      or op = 'BRACKET or op = 'AGGLST or op = "ATTRIBUTE"_
      or op = "#" =>
@@ -523,7 +496,6 @@
    op = "One" => '"1"
    form2String1 x

-
 formWrapId id ==
   $formatSigAsTeX = 1 => id
   $formatSigAsTeX = 2 =>
@@ -590,14 +562,14 @@
 -- argl is a list of categories NOT containing a "with"
   null argl => '""
   1=#argl => form2StringLocal argl.0
-  application2String('Join,[form2StringLocal x for x in argl], NIL)
+  application2String('Join,argl, NIL)

 formJoin2String (u:=[:argl,last]) ==
   last is ["CATEGORY",.,:atsigList] =>
     postString:= concat("_(",formTuple2String atsigList,"_)")
     #argl=1 => concat(first argl,'" with ",postString)
     concat(application2String('Join,argl, NIL)," with ",postString)
-  application2String('Join,u, NIL)
+  application2String('Join, u, NIL)

 formCollect2String [:itl,body] ==
   ["_(",body,:"append"/[formIterator2String x for x in itl],"_)"]
@@ -704,28 +676,14 @@
   SUBSTRING(op',s,e-s)

 application2String(op,argl, linkInfo) ==
-  op is ["$elt", t, f] =>
-      concat(application2String(f, argl, linkInfo), '"$", _
-             form2String1 t)
+  op is ["$elt", t, f] => concat(appOrParen [f,:argl],'"$", form2String1 t)
   null argl =>
     (op' := isInternalFunctionName(op)) => op'
     app2StringWrap(formWrapId op, linkInfo)
   1=#argl =>
-    first argl is ["<",:.] => concat(op,first argl)
-    concat(app2StringWrap(formWrapId op, linkInfo), '"(", first argl, '")")
---op in '(UP SM) =>
---  newop:= (op = "UP" => "P";"M")
---  concat(newop,concat(lbrkSch(),argl.0,rbrkSch(),argl.1))
---op='RM  =>concat("M",concat(lbrkSch(),
---                     argl.0,",",argl.1,rbrkSch(),argl.2))
---op='MP =>concat("P",concat(argl.0,argl.1))
-  op='SEGMENT =>
-    null argl => '".."
-    (null rest argl) or (null first rest argl) =>
-      concat(first argl, '"..")
-    concat(first argl, concat('"..", first rest argl))
+    concat(app2StringWrap(formWrapId op, linkInfo), " ", appOrParen first argl)
   concat(app2StringWrap(formWrapId op, linkInfo) ,
-                        concat("_(",concat(tuple2String argl,"_)")))
+         concat("(",concat(tuple2String [form2String1 x for x in argl],")")))

 app2StringConcat0(x,y) ==
   FORMAT(NIL, '"~a ~a", x, y)
wsp...@debian:~/fricas-sources$

Regards,
Bill Page.

--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups 
"FriCAS - computer algebra system" group.
To post to this group, send email to fricas-devel@googlegroups.com
To unsubscribe from this group, send email to 
fricas-devel+unsubscr...@googlegroups.com
For more options, visit this group at 
http://groups.google.com/group/fricas-devel?hl=en
-~----------~----~----~----~------~----~------~--~---

Index: src/algebra/op.spad.pamphlet
===================================================================
--- src/algebra/op.spad.pamphlet	(revision 730)
+++ src/algebra/op.spad.pamphlet	(working copy)
@@ -234,11 +234,11 @@
       ++ derivative(op) returns the value of the "%diff" property of
       ++ op if it has one, and "failed" otherwise.
     constantOperator: A -> OP
-        ++ constantOperator(a) returns a nullary operator op
-        ++ such that \spad{op()} always evaluate to \spad{a}.
+      ++ constantOperator(a) returns a nullary operator op
+      ++ such that \spad{op()} always evaluate to \spad{a}.
     constantOpIfCan : OP -> Union(A, "failed")
-        ++ constantOpIfCan(op) returns \spad{a} if op is the constant
-        ++ nullary operator always returning \spad{a}, "failed" otherwise.
+      ++ constantOpIfCan(op) returns \spad{a} if op is the constant
+      ++ nullary operator always returning \spad{a}, "failed" otherwise.
 
   Implementation ==> add
 
@@ -271,43 +271,44 @@
         derivative(op, [(l1: List(A)): A +-> f first l1]$List(List A -> A))
       error "Operator is not unary"
 
-    if A has OrderedSet then
-      cdisp   : (OutputForm, List OutputForm) -> OutputForm
-      csex    : (InputForm,  List InputForm) -> InputForm
-      eqconst?: (OP, OP) -> Boolean
-      ltconst?: (OP, OP) -> Boolean
-      constOp : A -> OP
+    cdisp   : (OutputForm, List OutputForm) -> OutputForm
+    csex    : (InputForm,  List InputForm) -> InputForm
+    eqconst?: (OP, OP) -> Boolean
+    constOp : A -> OP
 
-      opconst:OP :=
-        comparison(equality(operator('constant, 0), eqconst?),
-                                                               ltconst?)
+    cdisp(a, l) == a
+    csex(a, l)  == a
 
-      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)
-
+    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)
+    opconst:OP
+    if A has Comparable then
+      ltconst?: (OP, OP) -> Boolean
       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)
+           smaller?((va::None) pretend A,(vb::None) pretend A)
+      opconst :=
+        comparison(equality(operator('constant, 0), eqconst?), ltconst?)
+    else
+      opconst := equality(operator('constant, 0), eqconst?)
 
-      constOp a ==
-        setProperty(display(copy opconst, (l1: List(OutputForm)): OutputForm +-> cdisp(a::OutputForm, l1)),
+    constOp a ==
+      setProperty(display(copy opconst,
+        (l1: List(OutputForm)): OutputForm +-> cdisp(a::OutputForm, l1)),
                                                   CONST, a pretend None)
 
-      constantOpIfCan op ==
-        is?(op, 'constant) and
-          ((u := property(op, CONST)) case None) => (u::None) pretend A
-        "failed"
+    constantOpIfCan op ==
+      is?(op, 'constant) and
+        ((u := property(op, CONST)) case None) => (u::None) pretend A
+      "failed"
 
-      if A has ConvertibleTo InputForm then
-        constantOperator a == input(constOp a,  (l1: List(InputForm)): InputForm +-> csex(convert a, l1))
-      else
-        constantOperator a == constOp a
+    if A has ConvertibleTo InputForm then
+      constantOperator a == input(constOp a,  (l1: List(InputForm)): InputForm +-> csex(convert a, l1))
+    else
+      constantOperator a == constOp a
 
 @
 \section{package COMMONOP CommonOperators}
Index: src/algebra/Makefile.in
===================================================================
--- src/algebra/Makefile.in	(revision 730)
+++ src/algebra/Makefile.in	(working copy)
@@ -323,10 +323,10 @@
         ATRIG BASTYPE BGAGG BRAGG BTAGG BTCAT CLAGG COMPCAT DIAGG \
         DIFEXT DIFRING DIOPS DIRPCAT DIVRING DPOLCAT DVARCAT ELAGG \
         ELEMFUN ELTAGG ES EUCDOM EVALAB FAMR FAXF FDIVCAT FEVALAB \
-        FFCAT FFIELDC FIELD FINAALG FINITE FINRALG FLAGG FLINEXP FPC FPS \
-        FRAMALG FRETRCT FRNAALG FSAGG FS GCDDOM GRALG GRMOD GROUP \
-        HOAGG HYPCAT IEVALAB INS INTDOM IXAGG KDAGG LALG LIECAT LNAGG \
-        LODOCAT LOGIC LSAGG LZSTAGG MATCAT MODULE MONAD MONADWU \
+        FFCAT FFIELDC FIELD FINAALG FINITE FINRALG FLAGG FLINEXP FMCAT \
+        FPC FPS FRAMALG FRETRCT FRNAALG FSAGG FS GCDDOM GRALG GRMOD \
+        GROUP HOAGG HYPCAT IEVALAB INS INTDOM IXAGG KDAGG LALG LIECAT \
+        LNAGG LODOCAT LOGIC LSAGG LZSTAGG MATCAT MODULE MONAD MONADWU \
         MONOGEN MONOID MTSCAT NAALG NARNG NASRING OC ORDRING ORDSET OREPCAT \
         PDRING PFECAT POLYCAT PSCAT PSETCAT QFCAT QUATCAT RADCAT \
         RCAGG RCFIELD RETRACT RING RMATCAT RNS RPOLCAT RRCC RSETCAT \
Index: src/algebra/variable.spad.pamphlet
===================================================================
--- src/algebra/variable.spad.pamphlet	(revision 730)
+++ src/algebra/variable.spad.pamphlet	(working copy)
@@ -35,7 +35,7 @@
             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
        s1 = s2 == s1 =$Rep s2
        latex(x:%):String      == latex(convert(x)@Symbol)
 
Index: src/algebra/poly.spad.pamphlet
===================================================================
--- src/algebra/poly.spad.pamphlet	(revision 730)
+++ src/algebra/poly.spad.pamphlet	(working copy)
@@ -78,14 +78,23 @@
           ++ \spad{monom(s,r)} returns the product of the basis element \spad{s} by the coefficient \spad{r}.
         coefficient :(%,S) -> R
           ++ \spad{coefficient(x,s)} returns the coefficient of the basis element s
-      -- attributs
+        -- attributs
         if R has CommutativeRing then
              Module(R)
              linearExtend:(S->R,%)->R
           ++ \spad{linearExtend:(f,x)} returns the linear extension
           ++ of a map defined on the basis applied to a linear combination
+        if R has Comparable then Comparable
+      add
+        if R has Comparable then
+          smaller?(p:%,q:%):Boolean ==
+            if leadingMonomial(p)=leadingMonomial(q) then
+              if leadingCoefficient(p)=leadingCoefficient(q) then
+                smaller?(reductum p, reductum q)
+              else
+                smaller?(leadingCoefficient(p),leadingCoefficient(q))
+            leadingMonomial(p)<leadingMonomial(q)
 
-
 @
 \section{domain FM FreeModule}
 <<domain FM FreeModule>>=
Index: src/algebra/combfunc.spad.pamphlet
===================================================================
--- src/algebra/combfunc.spad.pamphlet	(revision 730)
+++ src/algebra/combfunc.spad.pamphlet	(working copy)
@@ -62,6 +62,7 @@
   K   ==> Kernel F
   SE  ==> Symbol
   O   ==> OutputForm
+  I   ==> InputForm
   SMP ==> SparseMultivariatePolynomial(R, K)
   Z   ==> Integer
 
@@ -70,6 +71,7 @@
   SPECIALDIFF  ==> '%specialDiff
   SPECIALDISP  ==> '%specialDisp
   SPECIALEQUAL ==> '%specialEqual
+  SPECIALINPUT ==> '%specialInput
 
   Exports ==> with
     belong?    : OP -> Boolean
@@ -184,6 +186,8 @@
     ddsum     : List F -> O
     dprod     : List F -> O
     ddprod    : List F -> O
+    indprod   : List F -> I
+    indsum    : List F -> I
     equalsumprod  : (K, K) -> Boolean
     equaldsumprod : (K, K) -> Boolean
     fourth    : List F -> F
@@ -408,6 +412,22 @@
     ddsum l ==
       sum(summand(l)::O, third(l)::O = fourth(l)::O, fourth(rest l)::O)
 
+    if F has ConvertibleTo(I) then
+      indprod l ==
+        convert([convert(_product)$I, convert(summand l)@I, _
+          convert([convert("="::Symbol)$I, convert(third l)@I, _
+            convert([convert('SEGMENT)$I, _
+            convert(fourth l)@I, convert(fourth rest l)@I]$List(I)) _
+            ]$List(I)) _
+          ]$List(I))
+      indsum l ==
+        convert([convert(_summation)$I, convert(summand l)@I, _
+          convert([convert("="::Symbol)$I, convert(third l)@I, _
+            convert([convert('SEGMENT)$I, _
+            convert(fourth l)@I, convert(fourth rest l)@I]$List(I))@I _
+            ]$List(I))@I _
+          ]$List(I))@I
+
 @
 
 The next two operations handle the testing for equality of sums and
@@ -680,6 +700,10 @@
     setProperty(opprod,  SPECIALEQUAL, equalsumprod@((K,K) -> Boolean) pretend None)
     setProperty(opdprod, SPECIALEQUAL, equaldsumprod@((K,K) -> Boolean) pretend None)
 
+    if F has ConvertibleTo(I) then
+      setProperty(opdprod, SPECIALINPUT, indprod@(List F -> I) pretend None)
+      setProperty(opdsum,  SPECIALINPUT, indsum@(List F -> I) pretend None)
+
 @
 
 
Index: src/algebra/tex.spad.pamphlet
===================================================================
--- src/algebra/tex.spad.pamphlet	(revision 730)
+++ src/algebra/tex.spad.pamphlet	(working copy)
@@ -37,8 +37,8 @@
 \end{verbatim}
 it now reads:
 <<product(product(i*j,i=a..b),j=c..d) fix>>=
-    plexOps       : L S := ["SIGMA","SIGMA2","PI","PI2","INTSIGN","INDEFINTEGRAL"]$(L S)
-    plexPrecs     : L I := [    700, 800,     700, 800 , 700,      700]$(L I)
+    plexOps       : L S := ["SIGMA","SIGMA2", "PI", "PI2","INTSIGN","INDEFINTEGRAL"]$(L S)
+    plexPrecs     : L I := [   1000,    1000, 1000,  1000,      700,            700]$(L I)
 @
 in addition we need to add a line defining [[PI2]] in [[formatPlex]]:
 <<define PI2>>=
@@ -493,7 +493,7 @@
           if hold ~= "" then
             s := concat [s," \sp",group concat ["\displaystyle ",hold]]
           args := rest args
-        s := concat [s," ",formatTex(first args,minPrec)]
+        s := concat [s," ",formatTex(first args,opPrec)]
       else
         hold := group concat [hold," ",formatTex(first args,minPrec)]
         s := concat [s," ",hold]
Index: src/interp/i-output.boot
===================================================================
--- src/interp/i-output.boot	(revision 730)
+++ src/interp/i-output.boot	(working copy)
@@ -1107,7 +1107,11 @@
     3
   maxWidth := MAX(opWidth,botWidth,topWidth)
   xCenter := (maxWidth-1)/ 2 + x
-  d:=APP(arg,x+2+maxWidth,y,d)
+
+  --d:=APP(arg,x+2+maxWidth,y,d)
+  prec := 1000  -- binding power of ! -1
+  [d,x1]:=appInfixArg(arg,x+maxWidth,y,d, prec,"left",nil)
+
   d:=
       atom bot and SIZE atom2String bot = 1 => APP(bot,xCenter,y-2,d)
       APP(bot,x + (maxWidth - botWidth)/2,y-2-superspan bot,d)
Index: src/interp/format.boot
===================================================================
--- src/interp/format.boot	(revision 730)
+++ src/interp/format.boot	(working copy)
@@ -240,7 +240,6 @@
     op
   STRINGP op or GETL(op,"Led") or GETL(op,"Nud") =>
     n = 3 =>
-      if op = 'SEGMENT then op := '".."
       op = 'in => [quad,'" ",op,'" ",quad]
 -- stop exquo from being displayed as infix (since it is not accepted
 -- as such by the interpreter)
@@ -344,11 +343,6 @@
   $whereList => concat(s,'%b,'"where",'%d,"%i",$whereList,"%u")
   s
 
-form2StringWithPrens form ==
-  null (argl := rest form) => [first form]
-  null rest argl => [first form,"(",first argl,")"]
-  form2String form
-
 formString u ==
   x := form2String u
   atom x => STRINGIMAGE x
@@ -356,7 +350,6 @@
 
 unparseInputForm u ==
   $formatSigAsTeX: local := 1
-  $InteractiveMode: local := false
   form2StringLocal u
 
 form2String u ==
@@ -368,7 +361,6 @@
   form2StringLocal u
 
 form2StringLocal u ==
---+
   $NRTmonitorIfTrue : local := nil
   $fortInts2Floats  : local := nil
   form2String1 u
@@ -390,25 +382,9 @@
   op := CAR u
   argl := CDR u
   op='Join or op= 'mkCategory => formJoin1(op,argl)
-  $InteractiveMode and (u:= constructor? op) =>
-    null argl => app2StringWrap(formWrapId constructorName op, u1)
-    op = "NTuple"  => [ form2String1 first argl, "*"]
-    op = "Map"     => ["(",:formatSignature0 [argl.1,argl.0],")"]
-    op = 'Record => record2String(argl)
-    null (conSig := getConstructorSignature op) =>
-      application2String(constructorName op,[form2String1(a) for a in argl], u1)
-    ml := rest conSig
-    if not freeOfSharpVars ml then
-      ml:=SUBLIS([[pvar,:val] for pvar in $FormalMapVariableList
-        for val in argl], ml)
-    argl:= formArguments2String(argl,ml)
-      -- extra null check to handle mutable domain hack.
-    null argl => constructorName op
-    application2String(constructorName op,argl, u1)
   op = "Mapping" => ["(",:formatSignature argl,")"]
   op = "Record" => record2String(argl)
-  op = 'Union  =>
-    application2String(op,[form2String1 x for x in argl], u1)
+  op = 'Union  =>  application2String(op, argl, u1)
   op = ":" =>
       null argl => [ '":" ]
       null rest argl => [ '":", form2String1 first argl ]
@@ -430,25 +406,23 @@
   op = 'construct =>
     concat(lbrkSch(),
            tuple2String [form2String1 x for x in argl],rbrkSch())
-  op = "SEGMENT" =>
-    null argl => '".."
-    lo := form2String1 first argl
-    argl := rest argl
-    (null argl) or null (first argl) => [lo, '".."]
-    [lo, '"..", form2String1 first argl]
+  u1 is ["SEGMENT", arg1] =>
+     concat [appOrParen(arg1), '".."]
+  u1 is ["SEGMENT", arg1, arg2] =>
+     concat(appOrParen(arg1),"..",appOrParen(arg2))
   op = "MATRIX" => matrix2String argl
   u1 is ["ROOT", arg1] =>
      concat("sqrt(", appOrParen(arg1),")")
   u1 is ["ROOT", arg1, arg2] =>
      concat("nthRoot(", appOrParen(arg1),",",appOrParen(arg2),")")
      --concat(appOrParen(arg1), '"^", appOrParen(["OVER",1,arg2]))
-  u1 is ["$elt", t, f] =>
+  u1 is ['"$elt", t, f] =>
      concat(form2String1 f, '"$", form2String1 t)
   #argl = 2 and (isBinaryInfix op or op = "::" or op = '"::"_
      or op = "@" or op = '"@" or op = "pretend" or op = '"pretend"_
      or op = "OVER" or op = '"OVER") =>
           binop2String [op,:argl]
-  application2String(op,[form2String1 x for x in argl], u1)
+  application2String(op,argl,u1)
 
 matrix2String x ==
   concat(lbrkSch(),
@@ -460,13 +434,13 @@
 binop2String x ==
     $curExpr : local := x
     x is ["=", arg1, arg2] or x is ['"=", arg1, arg2] =>
-        concat(sumOrParen(arg1), '"=", sumOrParen(arg2))
+        concat(form2String1(arg1), '"=", form2String1(arg2))
     sumOrParen(x)
 
 sumOrParen(x) ==
    x is [op, arg1, arg2] =>
        op = "+" or op = '"+" =>
-	   concat(sumOrParen(arg1), '"+", productOrParen(arg2))
+	   concat(sumOrParen(arg1), '"+", sumOrParen(arg2))
        op = "-" or op = '"-" =>
            concat(sumOrParen(arg1), '"-", productOrParen(arg2))
        op = "/" or op = '"/" or op = "OVER" or op = '"OVER" =>
@@ -509,12 +483,11 @@
    [op, :argl] := x
    (op = "-" or op = '"-") and #argl = 1 =>
        concat('"(", '"-", appOrParen(first argl), '")")
-   EQ(x, $curExpr) => BREAK()
-   op is ["$elt", f, t] =>
-       form2String1 x
+   -- EQ(x, $curExpr) => BREAK()
+   op is ["$elt", f, t] => form2String1 x
    -- Put parenthesis around anything special
    not(SYMBOLP op) or GET(op, "Led") or GET(op, "Nud")_
-     or op= 'mkCategory or op = "SEGMENT" _
+     or op= 'mkCategory _
      or op = 'construct or op = 'COLLECT or op = "SIGNATURE"_
      or op = 'BRACKET or op = 'AGGLST or op = "ATTRIBUTE"_
      or op = "#" =>
@@ -523,7 +496,6 @@
    op = "One" => '"1"
    form2String1 x
 
-
 formWrapId id ==
   $formatSigAsTeX = 1 => id
   $formatSigAsTeX = 2 =>
@@ -590,14 +562,14 @@
 -- argl is a list of categories NOT containing a "with"
   null argl => '""
   1=#argl => form2StringLocal argl.0
-  application2String('Join,[form2StringLocal x for x in argl], NIL)
+  application2String('Join,argl, NIL)
 
 formJoin2String (u:=[:argl,last]) ==
   last is ["CATEGORY",.,:atsigList] =>
     postString:= concat("_(",formTuple2String atsigList,"_)")
     #argl=1 => concat(first argl,'" with ",postString)
     concat(application2String('Join,argl, NIL)," with ",postString)
-  application2String('Join,u, NIL)
+  application2String('Join, u, NIL)
 
 formCollect2String [:itl,body] ==
   ["_(",body,:"append"/[formIterator2String x for x in itl],"_)"]
@@ -704,28 +676,14 @@
   SUBSTRING(op',s,e-s)
 
 application2String(op,argl, linkInfo) ==
-  op is ["$elt", t, f] =>
-      concat(application2String(f, argl, linkInfo), '"$", _
-             form2String1 t)
+  op is ["$elt", t, f] => concat(appOrParen [f,:argl],'"$", form2String1 t)
   null argl =>
     (op' := isInternalFunctionName(op)) => op'
     app2StringWrap(formWrapId op, linkInfo)
   1=#argl =>
-    first argl is ["<",:.] => concat(op,first argl)
-    concat(app2StringWrap(formWrapId op, linkInfo), '"(", first argl, '")")
---op in '(UP SM) =>
---  newop:= (op = "UP" => "P";"M")
---  concat(newop,concat(lbrkSch(),argl.0,rbrkSch(),argl.1))
---op='RM  =>concat("M",concat(lbrkSch(),
---                     argl.0,",",argl.1,rbrkSch(),argl.2))
---op='MP =>concat("P",concat(argl.0,argl.1))
-  op='SEGMENT =>
-    null argl => '".."
-    (null rest argl) or (null first rest argl) =>
-      concat(first argl, '"..")
-    concat(first argl, concat('"..", first rest argl))
+    concat(app2StringWrap(formWrapId op, linkInfo), " ", appOrParen first argl)
   concat(app2StringWrap(formWrapId op, linkInfo) ,
-                        concat("_(",concat(tuple2String argl,"_)")))
+         concat("(",concat(tuple2String [form2String1 x for x in argl],")")))
 
 app2StringConcat0(x,y) ==
   FORMAT(NIL, '"~a ~a", x, y)

Reply via email to