open-axiom-source 1.4.1+svn~2626-2ubuntu2 / usr / lib / open-axiom / src / algebra / mathml.spad

--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
--
--Redistribution and use in source and binary forms, with or without
--modification, are permitted provided that the following conditions are
--met:
--
--    - Redistributions of source code must retain the above copyright
--      notice, this list of conditions and the following disclaimer.
--
--    - Redistributions in binary form must reproduce the above copyright
--      notice, this list of conditions and the following disclaimer in
--      the documentation and/or other materials provided with the
--      distribution.
--
--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--      names of its contributors may be used to endorse or promote products
--      derived from this software without specific prior written permission.
--
--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
)abbrev domain MMLFORM MathMLFormat
++ Author: Arthur C. Ralfs
++ Date: January 2007
++ This package is based on the TeXFormat domain by Robert S. Sutor
++ without which I wouldn't have known where to start.
++ Basic Operations: coerce, coerceS, coerceL, exprex, display
++ Description:
++    \spadtype{MathMLFormat} provides a coercion from \spadtype{OutputForm}
++    to MathML format.

MathMLFormat(): public == private where
  E      ==> OutputForm
  I      ==> Integer
  L      ==> List
  S      ==> String
  US     ==> UniversalSegment(Integer)

  public == SetCategory with
    coerce:    E -> S
      ++ coerceS(o) changes o in the standard output format to MathML
      ++ format.
    coerceS:   E -> S
      ++ coerceS(o) changes o in the standard output format to MathML
      ++ format and displays formatted result.
    coerceL:   E -> S
      ++ coerceS(o) changes o in the standard output format to MathML
      ++ format and displays result as one long string.
    exprex:    E -> S
      ++ coverts \spadtype{OutputForm} to \spadtype{String} with the
      ++ structure preserved with braces.  Actually this is not quite
      ++ accurate.  The function \spadfun{precondition} is first 
      ++ applied to the
      ++ \spadtype{OutputForm} expression before \spadfun{exprex}.  
      ++ The raw \spadtype{OutputForm} and
      ++ the nature of the \spadfun{precondition} function is 
      ++ still obscure to me
      ++ at the time of this writing (2007-02-14).
    display:   S -> Void
      ++ prints the string returned by coerce, adding <math ...> tags.

  private == add
    import OutputForm
    import Character
    import Integer
    import List OutputForm
    import List String

    -- local variable 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 ","&","</mtd></mtr><mtr><mtd>"]$(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)

    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" ]

    -- the next two lists provide translations for some strings for
    -- which MML provides special macros.

    specialStrings : L S :=
      ["cos", "cot", "csc", "log", "sec", "sin", "tan",
        "cosh", "coth", "csch", "sech", "sinh", "tanh",
          "acos","asin","atan","erf","...","$","infinity","Gamma"]
    specialStringsInMML : L S :=
      ["<mo>cos</mo>","<mo>cot</mo>","<mo>csc</mo>","<mo>log</mo>","<mo>sec</mo>","<mo>sin</mo>","<mo>tan</mo>",
        "<mo>cosh</mo>","<mo>coth</mo>","<mo>csch</mo>","<mo>sech</mo>","<mo>sinh</mo>","<mo>tanh</mo>",
          "<mo>arccos</mo>","<mo>arcsin</mo>","<mo>arctan</mo>","<mo>erf</mo>","<mo>&#x2026;</mo>","<mo>$</mo>","<mo>&#x221E;</mo>","<mo>&#x0413;</mo>"]

    -- local function signatures

    addBraces:      S -> S
    addBrackets:    S -> S
    atomize:        E -> L E
    displayElt:     S -> Void
      ++ function for recursively displaying mathml nicely formatted
    eltLimit:       (S,I,S) -> I
      ++ demarcates end postion of mathml element with name:S starting at
      ++ position i:I in mathml string s:S and returns end of end tag as
      ++  i:I position in mathml string, i.e. find start and end of
      ++  substring:  <name ...>...</name>
    eltName:        (I,S) -> S
      ++ find name of mathml element starting at position i:I in string s:S
    group:          S -> S
    formatBinary:   (S,L E, I) -> S
    formatFunction: (S,L E, I) -> S
    formatIntSign:  (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
    formatSub:      (E, L E, I) -> S
    formatSuperSub: (E, L E, I) -> S
    formatSuperSub1: (E, L E, I) -> S
    formatUnary:    (S,  E, I) -> S
    formatMml:      (E,I) -> S
    formatZag:      L E -> S
    formatZag1:     L E -> S
    newWithNum:     I -> $
    parenthesize:   S -> S
    precondition:   E -> E
    postcondition:  S -> S
    stringify:      E -> S
    tagEnd:         (S,I,S) -> I
      ++  finds closing ">" of start or end tag for mathML element
    ungroup:        S -> S

    -- public function definitions

    coerce(expr : E): S ==
      s : S := postcondition formatMml(precondition expr, minPrec)
      s

    coerceS(expr : E): S ==
      s : S := postcondition formatMml(precondition expr, minPrec)
      sayTeX$Lisp "<math xmlns=_"http://www.w3.org/1998/Math/MathML_" mathsize=_"big_" display=_"block_">"
      displayElt(s)
      sayTeX$Lisp "</math>"
      s

    coerceL(expr : E): S ==
      s : S := postcondition formatMml(precondition expr, minPrec)
      sayTeX$Lisp "<math xmlns=_"http://www.w3.org/1998/Math/MathML_" mathsize=_"big_" display=_"block_">"
      sayTeX$Lisp s
      sayTeX$Lisp "</math>"
      s

    display(mathml : S): Void ==
      sayTeX$Lisp "<math xmlns=_"http://www.w3.org/1998/Math/MathML_" mathsize=_"big_" display=_"block_">"
      sayTeX$Lisp mathml
      sayTeX$Lisp "</math>"



    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.
      expr := precondition expr
--      sayTeX$Lisp "0: "stringify expr
      (not %pair?(expr)$Foreign(Builtin)) 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
--      sayTeX$Lisp concat ["1: ",stringify first le," : ",string(nargs)$S]
      s : S := concat ["{",sop]
      if positive? nargs  then
        for a in args repeat
--        sayTeX$Lisp concat ["2: ",stringify a]
          s1 : S := exprex a
          s := concat [s,s1]
      s := concat [s,"}"]


    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)


    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 positive? level 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()
      letmp : L E
      (not %pair?(expr)$Foreign(Builtin)) 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 ==
--      str := ungroup str
      len : I := #str
      plusminus : S := "<mo>+</mo><mo>-</mo>"
      pos : I := position(plusminus,str,1)
      if positive? pos 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 = "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 positive? j 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
      atomE : L E := atomize(expr)      
      op : S := stringify first atomE
      op ~= "SUPERSUB" => "<mtext>Mistake in formatSuperSub: no SUPERSUB1</mtext>"
      not one?(#args) => "<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
      bvarS : S := stringify first args
      -- count the number of commas
      commaS : S := stringify first rest rest rest atomE
      commaTest : S := ","
      i : I := 0
      while positive? position(commaTest,commaS,1) repeat
        i := i+1
        commaTest := commaTest","
      s : S := "<msup><mi>"funcS"</mi><mrow>"
      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
      atomE : L E := atomize(expr)      
      op : S := stringify first atomE
      op ~= "SUPERSUB" => "<mtext>Mistake in formatSuperSub: no SUPERSUB</mtext>"
      not one?(#args) => "<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 positive? position(commaTest,commaS,1) 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 positive?(i := position(varRS,integrand,i+1)) 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 not %pair?(first args)$Foreign(Builtin) 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 positive? position("ZAG",stringify first rest args,1) =>
           tmpS : S := stringify first args
           positive? position("ZAG",tmpS,1) => formatZag(args)
--         positive? position("ZAG",tmpS,1) => 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-12-21
      op :=
        op = ","     => "<mo>,</mo>" --originally , \:
        op = ";"     => "<mo>;</mo>" --originally ; \: should figure these out
        op = "*"     =>
            checkargs := true
            "<mo>&#x02062;</mo>"
        -- 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
        if checkargs then
          if count < #args then
            -- check here for sum or product
            if not %pair?(a)$Foreign(Builtin) 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>"
      (first args = "...":: E)@Boolean => "<mo>&#x2026;</mo>"
      op:S := stringify first args
      positive? position("ZAG",op,1) =>
        "<mfrac>"formatMml(first rest tmpZag,minPrec)formatMml(first rest rest tmpZag,minPrec)"</mfrac>"
      error "formatZag: Last argument in ZAG construct has unknown operator: "op

    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
      not %pair?(expr)$Foreign(Builtin) =>
        str := stringify expr
        len := #str
        -- this bit seems to deal with integers
        %integer?(expr)$Foreign(Builtin) =>
          i := expr pretend Integer
          if negative? i 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
        positive? len and str.1 = char "%" => concat(concat("<mi>",str),"</mi>")
        len > 1 and digit? str.1 => concat ["<mn>",str,"</mn>"] -- should handle floats
        -- presumably this is a literal string
        positive? len and str.1 = char "_"" =>
          concat(concat("<mtext>",str),"</mtext>")
        len = 1 and str.1 = char " " => " "
        positive?(i := position(str,specialStrings)) =>
          specialStringsInMML.i
        positive?(i := position(char " ",str)) =>
          -- 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.
      positive? position("SUPERSUB",op,1) =>
        formatSuperSub(first l,args,minPrec)
      -- now test for SUB
      positive? position("SUB",op,1) =>
        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)