path: root/src/algebra/openmath.spad.pamphlet

\documentclass{article}
\usepackage{open-axiom}
\begin{document}
\title{\$SPAD/src/algebra openmath.spad}
\author{Mike Dewar, Vilya Harvey}
\maketitle
\begin{abstract}
\end{abstract}
\eject
\tableofcontents
\eject
\section{package OMEXPR ExpressionToOpenMath}
<<package OMEXPR ExpressionToOpenMath>>=
)abbrev package OMEXPR ExpressionToOpenMath
++ Author: Mike Dewar & Vilya Harvey
++ Date Created:
++ Date Last Updated:
++ 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, Ring)): with
  OMwrite  : Expression R -> String
  OMwrite  : (Expression R, Boolean) -> String
  OMwrite  : (OpenMathDevice, Expression R) -> Void
  OMwrite  : (OpenMathDevice, Expression R, Boolean) -> Void
 == add
  import Expression R
  SymInfo ==> Record(cd:String, name:String)
  import SymInfo
  import Record(key: Symbol, entry: SymInfo)
  import AssociationList(Symbol, SymInfo)
  import OMENC

  ----------------------------
  -- Local translation tables.
  ----------------------------

  nullaryFunctionAList : AssociationList(Symbol, SymInfo) := construct [_
    [pi, ["nums1", "pi"]] ]

  unaryFunctionAList : AssociationList(Symbol, SymInfo) := construct [_
    [exp,  ["transc1", "exp"]],_
    [log,  ["transc1", "ln"]],_
    [sin,  ["transc1", "sin"]],_
    [cos,  ["transc1", "cos"]],_
    [tan,  ["transc1", "tan"]],_
    [cot,  ["transc1", "cot"]],_
    [sec,  ["transc1", "sec"]],_
    [csc,  ["transc1", "csc"]],_
    [asin, ["transc1", "arcsin"]],_
    [acos, ["transc1", "arccos"]],_
    [atan, ["transc1", "arctan"]],_
    [acot, ["transc1", "arccot"]],_
    [asec, ["transc1", "arcsec"]],_
    [acsc, ["transc1", "arccsc"]],_
    [sinh, ["transc1", "sinh"]],_
    [cosh, ["transc1", "cosh"]],_
    [tanh, ["transc1", "tanh"]],_
    [coth, ["transc1", "coth"]],_
    [sech, ["transc1", "sech"]],_
    [csch, ["transc1", "csch"]],_
    [asinh, ["transc1", "arcsinh"]],_
    [acosh, ["transc1", "arccosh"]],_
    [atanh, ["transc1", "arctanh"]],_
    [acoth, ["transc1", "arccoth"]],_
    [asech, ["transc1", "arcsech"]],_
    [acsch, ["transc1", "arccsch"]],_
    [factorial, ["integer1", "factorial"]],_
    [abs, ["arith1", "abs"]] ]

    -- Still need the following unary functions:
    --  digamma
    --  Gamma
    --  airyAi
    --  airyBi
    --  erf
    --  Ei
    --  Si
    --  Ci
    --  li
    --  dilog

    -- Still need the following binary functions:
    --      Gamma(a, x)
    --      Beta(x,y) 
    --      polygamma(k,x)
    --      besselJ(v,x)
    --      besselY(v,x)
    --      besselI(v,x)
    --      besselK(v,x)
    --      permutation(n, m)
    --      summation(x:%, n:Symbol) : as opposed to "definite" sum
    --      product(x:%, n:Symbol)   : ditto

  ------------------------
  -- Forward declarations.
  ------------------------

  outputOMExpr  : (OpenMathDevice, Expression R) -> Void

  -------------------------
  -- Local helper functions
  -------------------------

  outputOMArith1(dev: OpenMathDevice, sym: String, args: List Expression R): Void ==
    OMputApp(dev)
    OMputSymbol(dev, "arith1", sym)
    for arg in args repeat
      OMwrite(dev, arg, false)
    OMputEndApp(dev)

  outputOMLambda(dev: OpenMathDevice, ex: Expression R, var: Expression R): Void ==
    OMputBind(dev)
    OMputSymbol(dev, "fns1", "lambda")
    OMputBVar(dev)
    OMwrite(dev, var, false)
    OMputEndBVar(dev)
    OMwrite(dev, ex, false)
    OMputEndBind(dev)

  outputOMInterval(dev: OpenMathDevice, lo: Expression R, hi: Expression R): Void ==
    OMputApp(dev)
    OMputSymbol(dev, "interval1", "interval")
    OMwrite(dev, lo, false)
    OMwrite(dev, hi, false)
    OMputEndApp(dev)

  outputOMIntInterval(dev: OpenMathDevice, lo: Expression R, hi: Expression R): Void ==
    OMputApp(dev)
    OMputSymbol(dev, "interval1", "integer__interval")
    OMwrite(dev, lo, false)
    OMwrite(dev, hi, false)
    OMputEndApp(dev)

  outputOMBinomial(dev: OpenMathDevice, args: List Expression R): Void ==
    not #args=2 => error "Wrong number of arguments to binomial"
    OMputApp(dev)
    OMputSymbol(dev, "combinat1", "binomial")
    for arg in args repeat
      OMwrite(dev, arg, false)
    OMputEndApp(dev)

  outputOMPower(dev: OpenMathDevice, args: List Expression R): Void ==
    not #args=2 => error "Wrong number of arguments to power"
    outputOMArith1(dev, "power", args)

  outputOMDefsum(dev: OpenMathDevice, args: List Expression R): Void ==
    #args ~= 5 => error "Unexpected number of arguments to a defsum"
    OMputApp(dev)
    OMputSymbol(dev, "arith1", "sum")
    outputOMIntInterval(dev, args.4, args.5)
    outputOMLambda(dev, eval(args.1, args.2, args.3), args.3)
    OMputEndApp(dev)

  outputOMDefprod(dev: OpenMathDevice, args: List Expression R): Void ==
    #args ~= 5 => error "Unexpected number of arguments to a defprod"
    OMputApp(dev)
    OMputSymbol(dev, "arith1", "product")
    outputOMIntInterval(dev, args.4, args.5)
    outputOMLambda(dev, eval(args.1, args.2, args.3), args.3)
    OMputEndApp(dev)

  outputOMDefint(dev: OpenMathDevice, args: List Expression R): Void ==
    #args ~= 5 => error "Unexpected number of arguments to a defint"
    OMputApp(dev)
    OMputSymbol(dev, "calculus1", "defint")
    outputOMInterval(dev, args.4, args.5)
    outputOMLambda(dev, eval(args.1, args.2, args.3), args.3)
    OMputEndApp(dev)

  outputOMInt(dev: OpenMathDevice, args: List Expression R): Void ==
    #args ~= 3 => error "Unexpected number of arguments to a defint"
    OMputApp(dev)
    OMputSymbol(dev, "calculus1", "int")
    outputOMLambda(dev, eval(args.1, args.2, args.3), args.3)
    OMputEndApp(dev)

  outputOMFunction(dev: OpenMathDevice, op: Symbol, args: List Expression R): Void ==
    nargs := #args
    zero? nargs =>
      omOp: Union(SymInfo, "failed") := search(op, nullaryFunctionAList)
      omOp case "failed" =>
        msg := concat ["No OpenMath definition for nullary function ", string op]
        error msg
      OMputSymbol(dev, omOp.cd, omOp.name)
    one? nargs =>
      omOp: Union(SymInfo, "failed") := search(op, unaryFunctionAList)
      omOp case "failed" =>
        msg := concat ["No OpenMath definition for unary function ", string op]
        error msg
      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)
    msg := concat ["No OpenMath definition for function ", string op]
    error msg
 
  outputOMExpr(dev: OpenMathDevice, ex: Expression R): Void ==
    ground? ex => OMwrite(dev, ground ex, false)
    not((v := retractIfCan(ex)@Union(Symbol,"failed")) case "failed") =>
      OMputVariable(dev, v)
    not((w := isPlus ex) case "failed") => outputOMArith1(dev, "plus", w)
    not((w := isTimes ex) case "failed") => outputOMArith1(dev, "times", w)
    --not((y := isMult ex) case "failed") =>
    --  outputOMArith("times", [OMwrite(y.coef)$Integer,
    --          OMwrite(coerce y.var)])
    -- At the time of writing we don't need both isExpt and isPower
    -- here but they may be relevent when we integrate this stuff into
    -- the main Expression code.  Note that if we don't check that
    -- the exponent is non-trivial we get thrown into an infinite recursion.
    not (((x := isExpt ex) case "failed") or one? x.exponent) =>
      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 one? z.exponent) =>
      outputOMPower(dev, [ z.val, z.exponent::Expression R ])
      --OMputApp(dev)
      --OMputSymbol(dev, "arith1", "power")
      --outputOMExpr(dev, z.val)
      --OMputInteger(dev, z.exponent)
      --OMputEndApp(dev)
    -- Must only be one top-level Kernel by this point
    k : Kernel Expression R := first kernels ex
    outputOMFunction(dev, name operator k, argument k)


  ----------
  -- Exports
  ----------

  OMwrite(ex: Expression R): String ==
    s: String := ""
    sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
    dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML())
    OMputObject(dev)
    outputOMExpr(dev, ex)
    OMputEndObject(dev)
    OMclose(dev)
    s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
    s

  OMwrite(ex: Expression R, wholeObj: Boolean): String ==
    s: String := ""
    sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
    dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML())
    if wholeObj then
      OMputObject(dev)
    outputOMExpr(dev, ex)
    if wholeObj then
      OMputEndObject(dev)
    OMclose(dev)
    s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
    s

  OMwrite(dev: OpenMathDevice, ex: Expression R): Void ==
    OMputObject(dev)
    outputOMExpr(dev, ex)
    OMputEndObject(dev)

  OMwrite(dev: OpenMathDevice, ex: Expression R, wholeObj: Boolean): Void ==
    if wholeObj then
      OMputObject(dev)
    outputOMExpr(dev, ex)
    if wholeObj then
      OMputEndObject(dev)

@
\section{License}
<<license>>=
--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.
@
<<*>>=
<<license>>

<<package OMEXPR ExpressionToOpenMath>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}