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

\documentclass{article}
\usepackage{open-axiom}
\begin{document}
\title{\$SPAD/src/algebra kl.spad}
\author{Manuel Bronstein}
\maketitle
\begin{abstract}
\end{abstract}
\eject
\tableofcontents
\eject
\section{category CACHSET CachableSet}
<<category CACHSET CachableSet>>=
)abbrev category CACHSET CachableSet
++ Sets whose elements can cache an integer
++ Author: Manuel Bronstein
++ Date Created: 31 Oct 1988
++ Date Last Updated: 14 May 1991
++ Description:
++   A cachable set is a set whose elements keep an integer as part
++   of their structure.
CachableSet: Category == SetCategory with
  position   : % -> NonNegativeInteger
    ++ position(x) returns the integer n associated to x.
  setPosition: (%, NonNegativeInteger) -> Void
    ++ setPosition(x, n) associates the integer n to x.

@
\section{package SCACHE SortedCache}
<<package SCACHE SortedCache>>=
)abbrev package SCACHE SortedCache
++ Cache of elements in a set
++ Author: Manuel Bronstein
++ Date Created: 31 Oct 1988
++ Date Last Updated: 14 May 1991
++   A sorted cache of a cachable set S is a dynamic structure that
++   keeps the elements of S sorted and assigns an integer to each
++   element of S once it is in the cache. This way, equality and ordering
++   on S are tested directly on the integers associated with the elements
++   of S, once they have been entered in the cache.
SortedCache(S:CachableSet): Exports == Implementation where
  N    ==> NonNegativeInteger
  DIFF ==> 1024

  Exports ==> with
    clearCache  : () -> Void
      ++ clearCache() empties the cache.
    cache       : () -> List S
      ++ cache() returns the current cache as a list.
    enterInCache: (S, S -> Boolean) -> S
      ++ enterInCache(x, f) enters x in the cache, calling \spad{f(y)} to
      ++ determine whether x is equal to y. It returns x with an integer
      ++ associated with it.
    enterInCache: (S, (S, S) -> Integer) -> S
      ++ enterInCache(x, f) enters x in the cache, calling \spad{f(x, y)} to
      ++ determine whether \spad{x < y (f(x,y) < 0), x = y (f(x,y) = 0)}, or
      ++ \spad{x > y (f(x,y) > 0)}.
      ++ It returns x with an integer associated with it.

  Implementation ==> add
    import Reference List S
    shiftCache   : (List S, N) -> Void
    insertInCache: (List S, List S, S, N) -> S

    cach := ref(nil$List(S))

    cache() == deref cach

    shiftCache(l, n) ==
      for x in l repeat
        setPosition(x, n + position x)

    clearCache() ==
      for x in cache() repeat
        setPosition(x, 0)
      setref(cach,nil$List(S))

    enterInCache(x:S, equal?:S -> Boolean) ==
      scan := cache()
      while not null scan repeat
        equal?(y := first scan) =>
          setPosition(x, position y)
          return y
        scan := rest scan
      setPosition(x, 1 + #cache())
      setref(cach,concat(cache(), x))
      x

    enterInCache(x:S, triage:(S, S) -> Integer) ==
      scan := cache()
      pos:N:= 0
      for i in 1..#scan repeat
        zero?(n := triage(x, y := first scan)) =>
          setPosition(x, position y)
          return y
        negative? n => return insertInCache(first(cache(),(i-1)::N),scan,x,pos)
        scan := rest scan
        pos  := position y
      setPosition(x, pos + DIFF)
      setref(cach, concat(cache(), x))
      x

    insertInCache(before, after, x, pos) ==
      if ((pos+1) = position first after) then shiftCache(after, DIFF)
      setPosition(x, pos + (((position first after) - pos)::N quo 2))
      setref(cach, concat(before, concat(x, after)))
      x

@

\section{domain KERNEL Kernel}
<<domain KERNEL Kernel>>=
)abbrev domain KERNEL Kernel
++ Operators applied to elements of a set
++ Author: Manuel Bronstein
++ Date Created: 22 March 1988
++ Date Last Updated: May 09, 2009
++ Description:
++ A kernel over a set S is an operator applied to a given list
++ of arguments from S.
Kernel(S: SetCategory): Exports == Implementation where
  macro O  == OutputForm
  macro N  == NonNegativeInteger
  macro OP == BasicOperator


  Exports == Join(CachableSet, OrderedSet, Patternable S) with
    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

  Implementation ==> add
    macro SYMBOL == '%symbol
    macro PMPRED == '%pmpredicate
    macro PMOPT == '%pmoptional
    macro PMMULT == '%pmmultiple
    macro PMCONST == '%pmconstant
    macro SPECIALDISP == '%specialDisp
    macro SPECIALEQUAL == '%specialEqual
    macro SPECIALINPUT == '%specialInput
    import SortedCache(%)

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

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

    is?(k:%, s:Symbol) == is?(operator k, s)
    is?(k:%, o:OP)     == (operator k) = o
    height k           == rep(k).nest
    operator k         == rep(k).op
    argument k         == rep(k).arg
    position k         == rep(k).posit
    setPosition(k, n)  == rep(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 nothing => nil()
      (u@None) pretend List(Any)

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

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

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

    kernel(fn, x, n) ==
      (#x)::Arity ~= arity fn and (arity fn ~= arbitrary()) => 
        error "Wrong number of arguments"
      enterInCache(per [fn, x, n, 0], 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 nothing => prefix(name(o)::OutputForm, l)
      (u::(List OutputForm -> OutputForm)) l

    triage(k1, k2) ==
      rep(k1).nest   ~= rep(k2).nest   => B2Z(rep(k1).nest < rep(k2).nest)
      rep(k1).op ~= rep(k2).op => B2Z(rep(k1).op < rep(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 before?(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 nothing =>
          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 rep(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 rep(k).arg]$List(Pattern Float)

@
\section{package KERNEL2 KernelFunctions2}
<<package KERNEL2 KernelFunctions2>>=
)abbrev package KERNEL2 KernelFunctions2
++ Description:
++ This package exports some auxiliary functions on kernels
KernelFunctions2(R: SetCategory, S: SetCategory): with
  constantKernel: R -> Kernel S
	++ constantKernel(r) \undocumented
  constantIfCan : Kernel S -> Union(R, "failed")
	++ constantIfCan(k) \undocumented

 == add
  import BasicOperatorFunctions1(R)

  constantKernel r == kernel(constantOperator r, nil(), 1)
  constantIfCan k  == constantOpIfCan operator k

@
\section{License}
<<license>>=
--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
--Copyright (C) 2007-2010, Gabriel Dos Reis.
--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>>

-- SPAD files for the functional world should be compiled in the
-- following order:
--
--   op  KL  expr function

<<category CACHSET CachableSet>>
<<package SCACHE SortedCache>>
<<domain KERNEL Kernel>>
<<package KERNEL2 KernelFunctions2>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}