)abbrev package OMEXPR ExpressionToOpenMath
++ Author: Mike Dewar & Vilya Harvey
++ Basic Functions:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description: \spadtype{ExpressionToOpenMath} provides support for
++ converting objects of type \spadtype{Expression} into OpenMath.
ExpressionToOpenMath(R : Join(OpenMath, OrderedSet, Ring)) : with
  OMwrite  : Expression R -> String
  OMwrite  : (Expression R, Boolean) -> String
  OMwrite  : (OpenMathDevice, Expression R) -> Void
  OMwrite  : (OpenMathDevice, Expression R, Boolean) -> Void
 == add
  import from Expression R
  SymInfo ==> Record(cd : String, name : String)
  import from SymInfo
  import from Record(key : Symbol, entry : SymInfo)
  import from AssociationList(Symbol, SymInfo)

  ----------------------------
  -- 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 ", string 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 ", string 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 relevant 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, wholeObj : Boolean) : String ==
    s : String := ""
    sp : None := OM_-STRINGTOSTRINGPTR(s)$Lisp
    dev : OpenMathDevice := OMopenString(sp pretend String, OMencodingXML())
    OMwrite(dev, ex, wholeObj)
    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)

  OMwrite(dev : OpenMathDevice, ex : Expression R) : Void ==
      OMwrite(dev, ex, true)

  OMwrite(ex : Expression R) : String ==
      OMwrite(ex, true)

--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.
