axiom-source 20170501-3 / usr / share / axiom-20170501 / src / algebra / FEXPR.spad

)abbrev domain FEXPR FortranExpression
++ Author: Mike Dewar
++ Date Created:  December 1993
++ Date Last Updated: 12 July 1994 added RetractableTo(R)
++ Description: 
++ A domain of expressions involving functions which can be
++ translated into standard Fortran-77, with some extra extensions from
++ the NAG Fortran Library.  

FortranExpression(basicSymbols,subscriptedSymbols,R) : SIG == CODE where
  basicSymbols : List Symbol
  subscriptedSymbols : List Symbol
  R : FortranMachineTypeCategory

  EXPR ==> Expression
  EXF2 ==> ExpressionFunctions2
  S    ==> Symbol
  L    ==> List
  BO   ==> BasicOperator
  FRAC ==> Fraction
  POLY ==> Polynomial

  SIG ==> Join(ExpressionSpace,Algebra(R),RetractableTo(R),
                   PartialDifferentialRing(Symbol)) with

    retract : EXPR R -> $
      ++ retract(e) takes e and transforms it into a 
      ++ FortranExpression checking that it contains no non-Fortran
      ++ functions, and that it only contains the given basic symbols
      ++ and subscripted symbols which correspond to scalar and array
      ++ parameters respectively.

    retractIfCan : EXPR R -> Union($,"failed")
      ++ retractIfCan(e) takes e and tries to transform it into a 
      ++ FortranExpression checking that it contains no non-Fortran
      ++ functions, and that it only contains the given basic symbols
      ++ and subscripted symbols which correspond to scalar and array
      ++ parameters respectively.

    retract : S -> $
      ++ retract(e) takes e and transforms it into a FortranExpression
      ++ checking that it is one of the given basic symbols
      ++ or subscripted symbols which correspond to scalar and array
      ++ parameters respectively.

    retractIfCan : S -> Union($,"failed")
      ++ retractIfCan(e) takes e and tries to transform it into a 
      ++ FortranExpression checking that it is one of the given basic symbols
      ++ or subscripted symbols which correspond to scalar and array
      ++ parameters respectively.

    coerce : $ -> EXPR R
      ++ coerce(x) is not documented

    if (R has RetractableTo(Integer)) then

      retract : EXPR Integer -> $
        ++ retract(e) takes e and transforms it into a 
        ++ FortranExpression checking that it contains no non-Fortran
        ++ functions, and that it only contains the given basic symbols
        ++ and subscripted symbols which correspond to scalar and array
        ++ parameters respectively.

      retractIfCan : EXPR Integer -> Union($,"failed")
        ++ retractIfCan(e) takes e and tries to transform it into a 
        ++ FortranExpression checking that it contains no non-Fortran
        ++ functions, and that it only contains the given basic symbols
        ++ and subscripted symbols which correspond to scalar and array
        ++ parameters respectively.

      retract : FRAC POLY  Integer -> $
        ++ retract(e) takes e and transforms it into a 
        ++ FortranExpression checking that it contains no non-Fortran
        ++ functions, and that it only contains the given basic symbols
        ++ and subscripted symbols which correspond to scalar and array
        ++ parameters respectively.

      retractIfCan : FRAC POLY  Integer -> Union($,"failed")
        ++ retractIfCan(e) takes e and tries to transform it into a 
        ++ FortranExpression checking that it contains no non-Fortran
        ++ functions, and that it only contains the given basic symbols
        ++ and subscripted symbols which correspond to scalar and array
        ++ parameters respectively.

      retract : POLY  Integer -> $
        ++ retract(e) takes e and transforms it into a 
        ++ FortranExpression checking that it contains no non-Fortran
        ++ functions, and that it only contains the given basic symbols
        ++ and subscripted symbols which correspond to scalar and array
        ++ parameters respectively.

      retractIfCan : POLY  Integer -> Union($,"failed")
        ++ retractIfCan(e) takes e and tries to transform it into a 
        ++ FortranExpression checking that it contains no non-Fortran
        ++ functions, and that it only contains the given basic symbols
        ++ and subscripted symbols which correspond to scalar and array
        ++ parameters respectively.

    if (R has RetractableTo(Float)) then

      retract : EXPR Float -> $
        ++ retract(e) takes e and transforms it into a 
        ++ FortranExpression checking that it contains no non-Fortran
        ++ functions, and that it only contains the given basic symbols
        ++ and subscripted symbols which correspond to scalar and array
        ++ parameters respectively.

      retractIfCan : EXPR Float -> Union($,"failed")
        ++ retractIfCan(e) takes e and tries to transform it into a 
        ++ FortranExpression checking that it contains no non-Fortran
        ++ functions, and that it only contains the given basic symbols
        ++ and subscripted symbols which correspond to scalar and array
        ++ parameters respectively.

      retract : FRAC POLY  Float -> $
        ++ retract(e) takes e and transforms it into a 
        ++ FortranExpression checking that it contains no non-Fortran
        ++ functions, and that it only contains the given basic symbols
        ++ and subscripted symbols which correspond to scalar and array
        ++ parameters respectively.

      retractIfCan : FRAC POLY  Float -> Union($,"failed")
        ++ retractIfCan(e) takes e and tries to transform it into a 
        ++ FortranExpression checking that it contains no non-Fortran
        ++ functions, and that it only contains the given basic symbols
        ++ and subscripted symbols which correspond to scalar and array
        ++ parameters respectively.

      retract : POLY  Float -> $
        ++ retract(e) takes e and transforms it into a 
        ++ FortranExpression checking that it contains no non-Fortran
        ++ functions, and that it only contains the given basic symbols
        ++ and subscripted symbols which correspond to scalar and array
        ++ parameters respectively.

      retractIfCan : POLY  Float -> Union($,"failed")
        ++ retractIfCan(e) takes e and tries to transform it into a 
        ++ FortranExpression checking that it contains no non-Fortran
        ++ functions, and that it only contains the given basic symbols
        ++ and subscripted symbols which correspond to scalar and array
        ++ parameters respectively.

    abs : $ -> $
      ++ abs(x) represents the Fortran intrinsic function ABS

    sqrt : $ -> $
      ++ sqrt(x) represents the Fortran intrinsic function SQRT

    exp : $ -> $
      ++ exp(x) represents the Fortran intrinsic function EXP

    log : $ -> $
      ++ log(x) represents the Fortran intrinsic function LOG

    log10 : $ -> $
      ++ log10(x) represents the Fortran intrinsic function LOG10

    sin : $ -> $
      ++ sin(x) represents the Fortran intrinsic function SIN

    cos : $ -> $
      ++ cos(x) represents the Fortran intrinsic function COS

    tan : $ -> $
      ++ tan(x) represents the Fortran intrinsic function TAN

    asin : $ -> $
      ++ asin(x) represents the Fortran intrinsic function ASIN

    acos : $ -> $
      ++ acos(x) represents the Fortran intrinsic function ACOS

    atan : $ -> $
      ++ atan(x) represents the Fortran intrinsic function ATAN

    sinh : $ -> $
      ++ sinh(x) represents the Fortran intrinsic function SINH

    cosh : $ -> $
      ++ cosh(x) represents the Fortran intrinsic function COSH

    tanh : $ -> $
      ++ tanh(x) represents the Fortran intrinsic function TANH

    pi : () -> $
      ++ pi(x) represents the NAG Library function X01AAF which returns 
      ++  an approximation to the value of pi

    variables : $ -> L S
      ++ variables(e) return a list of all the variables in \spad{e}.

    useNagFunctions : () -> Boolean
      ++ useNagFunctions() indicates whether NAG functions are being used
      ++  for mathematical and machine constants.

    useNagFunctions : Boolean -> Boolean
      ++ useNagFunctions(v) sets the flag which controls whether NAG functions 
      ++  are being used for mathematical and machine constants.  The previous
      ++  value is returned.

  CODE ==> EXPR R add

    -- The standard FORTRAN-77 intrinsic functions, plus nthRoot which
    -- can be translated into an arithmetic expression:
    f77Functions : L S := [abs,sqrt,exp,log,log10,sin,cos,tan,asin,acos,
                           atan,sinh,cosh,tanh,nthRoot,%power]

    nagFunctions : L S := [pi, X01AAF]

    useNagFunctionsFlag : Boolean := true

    -- Local functions to check for "unassigned" symbols etc.

    mkEqn(s1:Symbol,s2:Symbol):Equation EXPR(R) ==
      equation(s2::EXPR(R),script(s1,scripts(s2))::EXPR(R))

    fixUpSymbols(u:EXPR R):Union(EXPR R,"failed") ==
      -- If its a univariate expression then just fix it up:
      syms   : L S := variables(u)
      (#basicSymbols = 1) and zero?(#subscriptedSymbols) =>
        not (#syms = 1) => "failed"
        subst(u,equation(first(syms)::EXPR(R),first(basicSymbols)::EXPR(R)))
      -- We have one variable but it is subscripted:
      zero?(#basicSymbols) and (#subscriptedSymbols = 1) =>
        -- Make sure we don't have both X and X_i
        for s in syms repeat
          not scripted?(s) => return "failed"
        not ((#(syms:=removeDuplicates! [name(s) for s in syms]))=1)=> "failed"
        sym : Symbol := first subscriptedSymbols
        subst(u,[mkEqn(sym,i) for i in variables(u)]) 
      "failed"

    extraSymbols?(u:EXPR R):Boolean ==
      syms   : L S := [name(v) for v in variables(u)]
      extras : L S := setDifference(syms,
                                    setUnion(basicSymbols,subscriptedSymbols))
      not empty? extras

    checkSymbols(u:EXPR R):EXPR(R) ==
      syms   : L S := [name(v) for v in variables(u)]
      extras : L S := setDifference(syms,
                                    setUnion(basicSymbols,subscriptedSymbols))
      not empty? extras => 
        m := fixUpSymbols(u)
        m case EXPR(R) => m::EXPR(R)
        error("Extra symbols detected:",[string(v) for v in extras]$L(String))
      u

    notSymbol?(v:BO):Boolean ==
      s : S := name v
      member?(s,basicSymbols) or 
        scripted?(s) and member?(name s,subscriptedSymbols) => false
      true

    extraOperators?(u:EXPR R):Boolean ==
      ops    : L S := [name v for v in operators(u) | notSymbol?(v)]
      if useNagFunctionsFlag then
        fortranFunctions : L S := append(f77Functions,nagFunctions)
      else
        fortranFunctions : L S := f77Functions
      extras : L S := setDifference(ops,fortranFunctions)
      not empty? extras

    checkOperators(u:EXPR R):Void ==
      ops    : L S := [name v for v in operators(u) | notSymbol?(v)]
      if useNagFunctionsFlag then
        fortranFunctions : L S := append(f77Functions,nagFunctions)
      else
        fortranFunctions : L S := f77Functions
      extras : L S := setDifference(ops,fortranFunctions)
      not empty? extras => 
        error("Non FORTRAN-77 functions detected:",[string(v) for v in extras])
      void()

    checkForNagOperators(u:EXPR R):$ ==
      useNagFunctionsFlag =>
        import Pi
        import PiCoercions(R)
        piOp : BasicOperator := operator X01AAF
        piSub : Equation EXPR R :=
          equation(pi()$Pi::EXPR(R),kernel(piOp,0::EXPR(R))$EXPR(R))
        subst(u,piSub) pretend $
      u pretend $

    -- Conditional retractions:

    if R has RetractableTo(Integer) then 

      retractIfCan(u:POLY Integer):Union($,"failed") ==
        retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed")

      retract(u:POLY Integer):$ ==
        retract((u::EXPR Integer)$EXPR(Integer))@$

      retractIfCan(u:FRAC POLY Integer):Union($,"failed") ==
        retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed")

      retract(u:FRAC POLY  Integer):$ ==
        retract((u::EXPR Integer)$EXPR(Integer))@$

      int2R(u:Integer):R == u::R

      retractIfCan(u:EXPR Integer):Union($,"failed") ==
        retractIfCan(map(int2R,u)$EXF2(Integer,R))@Union($,"failed")

      retract(u:EXPR Integer):$ ==
        retract(map(int2R,u)$EXF2(Integer,R))@$

    if R has RetractableTo(Float) then 

      retractIfCan(u:POLY Float):Union($,"failed") ==
        retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed")

      retract(u:POLY Float):$ ==
        retract((u::EXPR Float)$EXPR(Float))@$

      retractIfCan(u:FRAC POLY Float):Union($,"failed") ==
        retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed")

      retract(u:FRAC POLY  Float):$ ==
        retract((u::EXPR Float)$EXPR(Float))@$

      float2R(u:Float):R == (u::R)

      retractIfCan(u:EXPR Float):Union($,"failed") ==
        retractIfCan(map(float2R,u)$EXF2(Float,R))@Union($,"failed")

      retract(u:EXPR Float):$ ==
        retract(map(float2R,u)$EXF2(Float,R))@$

    -- Exported Functions

    useNagFunctions():Boolean == useNagFunctionsFlag

    useNagFunctions(v:Boolean):Boolean == 
      old := useNagFunctionsFlag
      useNagFunctionsFlag := v
      old
 
    log10(x:$):$ ==
      kernel(operator log10,x)

    pi():$ == kernel(operator X01AAF,0)

    coerce(u:$):EXPR R == u pretend EXPR(R)

    retractIfCan(u:EXPR R):Union($,"failed") ==
      if (extraSymbols? u) then 
        m := fixUpSymbols(u)
        m case "failed" => return "failed"
        u := m::EXPR(R)
      extraOperators? u => "failed"
      checkForNagOperators(u)

    retract(u:EXPR R):$ ==
      u:=checkSymbols(u)
      checkOperators(u)
      checkForNagOperators(u)

    retractIfCan(u:Symbol):Union($,"failed") ==
      not (member?(u,basicSymbols) or
           scripted?(u) and member?(name u,subscriptedSymbols)) => "failed"
      (((u::EXPR(R))$(EXPR R))pretend Rep)::$

    retract(u:Symbol):$ ==
      res : Union($,"failed") := retractIfCan(u)
      res case "failed" => error("Illegal Symbol Detected:",u::String)
      res::$