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

)abbrev domain KERNEL Kernel
++ Author: Manuel Bronstein
++ Date Created: 22 March 1988
++ Date Last Updated: 10 August 1994
++ Description:
++ A kernel over a set S is an operator applied to a given list
++ of arguments from S.

Kernel(S) : SIG == CODE where
  S : OrderedSet

  O  ==> OutputForm
  N  ==> NonNegativeInteger
  OP ==> BasicOperator
  SYMBOL  ==> "%symbol"
  PMPRED  ==> "%pmpredicate"
  PMOPT   ==> "%pmoptional"
  PMMULT  ==> "%pmmultiple"
  PMCONST ==> "%pmconstant"
  SPECIALDISP  ==> "%specialDisp"
  SPECIALEQUAL ==> "%specialEqual"
  SPECIALINPUT ==> "%specialInput"

  SIG ==> Join(CachableSet, Patternable S) with

    name : % -> Symbol
      ++ name(op(a1,...,an)) returns the name of op.

    operator : % -> OP
      ++ operator(op(a1,...,an)) returns the operator op.

    argument : % -> List S
      ++ argument(op(a1,...,an)) returns \spad{[a1,...,an]}.

    height : % -> N
      ++ height(k) returns the nesting level of k.

    kernel : (OP, List S, N) -> %
      ++ kernel(op, [a1,...,an], m) returns the kernel \spad{op(a1,...,an)}
      ++ of nesting level m.
      ++ Error: if op is k-ary for some k not equal to m.

    kernel : Symbol -> %
      ++ kernel(x) returns x viewed as a kernel.

    symbolIfCan : % -> Union(Symbol, "failed")
      ++ symbolIfCan(k) returns k viewed as a symbol if k is a symbol, and
      ++ "failed" otherwise.

    is? : (%, OP) -> Boolean
      ++ is?(op(a1,...,an), f) tests if op = f.

    is? : (%, Symbol) -> Boolean
      ++ is?(op(a1,...,an), s) tests if the name of op is s.

    if S has ConvertibleTo InputForm then ConvertibleTo InputForm

  CODE ==> add

    import SortedCache(%)

    Rep := Record(op:OP, arg:List S, nest:N, posit:N)

    clearCache()

    B2Z   : Boolean -> Integer
    triage: (%, %)  -> Integer
    preds : OP      -> List Any

    is?(k:%, s:Symbol) == is?(operator k, s)

    is?(k:%, o:OP)     == (operator k) = o

    name k             == name operator k

    height k           == k.nest

    operator k         == k.op

    argument k         == k.arg

    position k         == k.posit

    setPosition(k, n)  == k.posit := n

    B2Z flag           == (flag => -1; 1)

    kernel s           == kernel(assert(operator(s,0),SYMBOL), nil(), 1)

    preds o ==
      (u := property(o, PMPRED)) case "failed" => nil()
      (u::None) pretend List(Any)

    symbolIfCan k ==
      has?(operator k, SYMBOL) => name operator k
      "failed"

    k1 = k2 ==
      if k1.posit = 0 then enterInCache(k1, triage)
      if k2.posit = 0 then enterInCache(k2, triage)
      k1.posit = k2.posit

    k1 < k2 ==
      if k1.posit = 0 then enterInCache(k1, triage)
      if k2.posit = 0 then enterInCache(k2, triage)
      k1.posit < k2.posit

    kernel(fn, x, n) ==
      ((u := arity fn) case N) and (#x ^= u::N)
                                    => error "Wrong number of arguments"
      enterInCache([fn, x, n, 0]$Rep, triage)

    -- SPECIALDISP contains a map List S -> OutputForm
    -- it is used when the converting the arguments first is not good,
    -- for instance with formal derivatives.
    coerce(k:%):OutputForm ==
      (v := symbolIfCan k) case Symbol => v::Symbol::OutputForm
      (f := property(o := operator k, SPECIALDISP)) case None =>
        ((f::None) pretend (List S -> OutputForm)) (argument k)
      l := [x::OutputForm for x in argument k]$List(OutputForm)
      (u := display o) case "failed" => prefix(name(o)::OutputForm, l)
      (u::(List OutputForm -> OutputForm)) l

    triage(k1, k2) ==
      k1.nest   ^= k2.nest   => B2Z(k1.nest   < k2.nest)
      k1.op ^= k2.op => B2Z(k1.op < k2.op)
      (n1 := #(argument k1)) ^= (n2 := #(argument k2)) => B2Z(n1 < n2)
      ((func := property(operator k1, SPECIALEQUAL)) case None) and
        (((func::None) pretend ((%, %) -> Boolean)) (k1, k2)) => 0
      for x1 in argument(k1) for x2 in argument(k2) repeat
        x1 ^= x2 => return B2Z(x1 < x2)
      0

    if S has ConvertibleTo InputForm then
      convert(k:%):InputForm ==
        (v := symbolIfCan k) case Symbol => convert(v::Symbol)@InputForm
        (f := property(o := operator k, SPECIALINPUT)) case None =>
          ((f::None) pretend (List S -> InputForm)) (argument k)
        l := [convert x for x in argument k]$List(InputForm)
        (u := input operator k) case "failed" =>
          convert concat(convert name operator k, l)
        (u::(List InputForm -> InputForm)) l

    if S has ConvertibleTo Pattern Integer then
      convert(k:%):Pattern(Integer) ==
        o := operator k
        (v := symbolIfCan k) case Symbol =>
          s  := patternVariable(v::Symbol,
                      has?(o, PMCONST), has?(o, PMOPT), has?(o, PMMULT))
          empty?(l := preds o) => s
          setPredicates(s, l)
        o [convert x for x in k.arg]$List(Pattern Integer)

    if S has ConvertibleTo Pattern Float then
      convert(k:%):Pattern(Float) ==
        o := operator k
        (v := symbolIfCan k) case Symbol =>
          s  := patternVariable(v::Symbol,
                      has?(o, PMCONST), has?(o, PMOPT), has?(o, PMMULT))
          empty?(l := preds o) => s
          setPredicates(s, l)
        o [convert x for x in k.arg]$List(Pattern Float)