\documentclass{article}
\usepackage{axiom}
\begin{document}
\title{\$SPAD/src/algebra mappkg.spad}
\author{Stephen M. Watt, William Burge}
\maketitle
\begin{abstract}
\end{abstract}
\eject
\tableofcontents
\eject
\section{package MAPHACK1 MappingPackageInternalHacks1}
<<package MAPHACK1 MappingPackageInternalHacks1>>=
)abbrev package MAPHACK1 MappingPackageInternalHacks1
++ Author: S.M.Watt and W.H.Burge
++ Date Created:Jan 87
++ Date Last Updated:Feb 92
++ Basic Operations:
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ Examples:
++ References:
++ Description: various Currying operations.
MappingPackageInternalHacks1(A: SetCategory): MPcat == MPdef where
    NNI ==> NonNegativeInteger

    MPcat == with
        iter:  ((A -> A), NNI, A) -> A
          ++\spad{iter(f,n,x)} applies \spad{f n} times to \spad{x}.
        recur: ((NNI, A)->A, NNI, A) -> A
          ++\spad{recur(n,g,x)} is \spad{g(n,g(n-1,..g(1,x)..))}.

    MPdef == add
        iter(g,n,x)  ==
            for i in 1..n repeat x := g x     -- g(g(..(x)..))
            x
        recur(g,n,x) ==
            for i in 1..n repeat x := g(i,x)  -- g(n,g(n-1,..g(1,x)..))
            x

@
\section{package MAPHACK2 MappingPackageInternalHacks2}
<<package MAPHACK2 MappingPackageInternalHacks2>>=
)abbrev package MAPHACK2 MappingPackageInternalHacks2
++ Description: various Currying operations.
MappingPackageInternalHacks2(A: SetCategory, C: SetCategory):_
  MPcat == MPdef where
    NNI ==> NonNegativeInteger

    MPcat == with
        arg1:  (A, C) -> A
          ++\spad{arg1(a,c)} selects its first argument.
        arg2:  (A, C) -> C
          ++\spad{arg2(a,c)} selects its second argument.

    MPdef == add
        arg1(a, c)   == a
        arg2(a, c)   == c

@
\section{package MAPHACK3 MappingPackageInternalHacks3}
<<package MAPHACK3 MappingPackageInternalHacks3>>=
)abbrev package MAPHACK3 MappingPackageInternalHacks3
++ Description: various Currying operations.
MappingPackageInternalHacks3(A: SetCategory, B: SetCategory, C: SetCategory):_
  MPcat == MPdef where
    NNI ==> NonNegativeInteger

    MPcat == with
        comp:  (B->C, A->B, A) -> C
          ++\spad{comp(f,g,x)} is \spad{f(g x)}.

    MPdef == add
        comp(g,h,x)  == g h x

@
\section{package MAPPKG1 MappingPackage1}
<<package MAPPKG1 MappingPackage1>>=
)abbrev package MAPPKG1 MappingPackage1
++ Author: S.M.Watt and W.H.Burge
++ Date Created:Jan 87
++ Date Last Updated: January 10, 2008
++ Basic Operations:
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ Examples:
++ References:
++ Description: various Currying operations.
MappingPackage1(A:SetCategory): MPcat == MPdef where
    NNI   ==>  NonNegativeInteger

    MPcat ==  with
        nullary: A           -> (()->A)
          ++\spad{nullary A} changes its argument into a
          ++ nullary function.
        coerce:  A           -> (()->A)
          ++\spad{coerce A} changes its argument into a
          ++ nullary function.

        fixedPoint: (A->A) -> A
          ++\spad{fixedPoint f} is the fixed point of function \spad{f}.
          ++ i.e. such that \spad{fixedPoint f = f(fixedPoint f)}.
          ++ Unused and buggy.
        fixedPoint: (List A->List A, Integer) -> List A
          ++\spad{fixedPoint(f,n)} is the fixed point of function
          ++ \spad{f} which is assumed to transform a list of length
          ++ \spad{n}.
          ++ Unused and buggy.


        id:    A -> A
          ++\spad{id x} is \spad{x}.
        "^":  (A->A, NNI)  -> (A->A)
          ++\spad{f^n} is the  function which is the n-fold application
          ++ of \spad{f}.

        recur: ((NNI, A)->A) -> ((NNI, A)->A)
          ++\spad{recur(g)} is the function \spad{h} such that
          ++ \spad{h(n,x)= g(n,g(n-1,..g(1,x)..))}.


    MPdef == add

        import MappingPackageInternalHacks1(A)

        a: A
        faa:  A -> A
        f0a:  ()-> A

        nullary a   == a
        coerce  a   == nullary a
        fixedPoint faa ==
            g0 := GENSYM()$Lisp
            g1 := faa g0
            EQ(g0, g1)$Lisp => error "All points are fixed points"
            GEQNSUBSTLIST([g0]$Lisp, [g1]$Lisp, g1)$Lisp

        fixedPoint(fll, n) ==
            g0 := [(GENSYM()$Lisp) pretend A for i in 1..n]
            g1 := fll g0
            or/[EQ(e0,e1)$Lisp for e0 in g0 for e1 in g1] =>
                error "All points are fixed points"
            GEQNSUBSTLIST(g0, g1, g1)$Lisp

        -- Composition and recursion.
        id a        == a
        g^n        == (a1: A): A +-> iter(g, n, a1)

        recur fnaa  == (n1: NNI, a2: A): A +-> recur(fnaa, n1, a2)

@
\section{package MAPPKG2 MappingPackage2}
<<package MAPPKG2 MappingPackage2>>=
)abbrev package MAPPKG2 MappingPackage2
++ Description: various Currying operations.
MappingPackage2(A:SetCategory, C:SetCategory): MPcat == MPdef where
    NNI   ==>  NonNegativeInteger

    MPcat ==  with
        const:   C           -> (A ->C)
          ++\spad{const c} is a function which produces \spad{c} when
          ++ applied to its argument.

        curry:    (A ->C, A)    -> (()->C)
          ++\spad{cu(f,a)} is the function \spad{g}
          ++ such that \spad{g ()= f a}.
        constant:    (()->C)       -> (A ->C)
          ++\spad{vu(f)} is the function \spad{g}
          ++ such that \spad{g a= f ()}.

        diag:  ((A,A)->C)    -> (A->C)
          ++\spad{diag(f)} is the function \spad{g}
          ++ such that \spad{g a = f(a,a)}.


    MPdef == add

        import MappingPackageInternalHacks2(A, C)

        a: A
        c: C
        faa:  A -> A
        f0c:  ()-> C
        fac:  A -> C
        faac: (A,A)->C

        const c       == (a1: A): C +-> arg2(a1, c)
        curry(fac, a) == fac a
        constant f0c  == (a1: A): C +-> arg2(a1, f0c())
        diag faac     == (a1: A): C +-> faac(a1, a1)

@
\section{package MAPPKG3 MappingPackage3}
<<package MAPPKG3 MappingPackage3>>=
)abbrev package MAPPKG3 MappingPackage3
++ Description: various Currying operations.
MappingPackage3(A:SetCategory, B:SetCategory, C:SetCategory):_
  MPcat == MPdef where
    NNI   ==>  NonNegativeInteger

    MPcat ==  with
        curryRight:   ((A,B)->C, B) -> (A ->C)
          ++\spad{curryRight(f,b)} is the function \spad{g} such that
          ++ \spad{g a = f(a,b)}.
        curryLeft:   ((A,B)->C, A) -> (B ->C)
          ++\spad{curryLeft(f,a)} is the function \spad{g}
          ++ such that \spad{g b = f(a,b)}.

        constantRight:   (A -> C)      -> ((A,B)->C)
          ++\spad{constantRight(f)} is the function \spad{g}
          ++ such that \spad{g (a,b)= f a}.
        constantLeft:   (B -> C)      -> ((A,B)->C)
          ++\spad{constantLeft(f)} is the function \spad{g}
          ++ such that \spad{g (a,b)= f b}.

        twist: ((A,B)->C)    -> ((B,A)->C)
          ++\spad{twist(f)} is the function \spad{g}
          ++ such that \spad{g (a,b)= f(b,a)}.

        "*":   (B->C, A->B) -> (A->C)
          ++\spad{f*g} is the function \spad{h}
          ++ such that \spad{h x= f(g x)}.


    MPdef == add

        import MappingPackageInternalHacks3(A, B, C)

        a: A
        b: B
        c: C
        faa:  A -> A
        f0c:  ()-> C
        fac:  A -> C
        fbc:  B -> C
        fab:  A -> B
        fabc: (A,B)->C
        faac: (A,A)->C

        -- Fix left and right arguments as constants.
        curryRight(fabc,b) == (a: A): C +-> fabc(a,b)
        curryLeft(fabc,a)  == (b: B): C +-> fabc(a, b)

        -- Add left and right arguments which are ignored.
        constantRight fac     == (a: A, b: B): C +-> fac a
        constantLeft fbc      == (a: A, b: B): C +-> fbc b

        -- Combinators to rearrange arguments.
        twist fabc  == (b: B, a: A): C +-> fabc(a, b)
        -- Functional composition
        fbc*fab == (a: A): C +-> comp(fbc,fab,a)

@
\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 MAPHACK1 MappingPackageInternalHacks1>>
<<package MAPHACK2 MappingPackageInternalHacks2>>
<<package MAPHACK3 MappingPackageInternalHacks3>>
<<package MAPPKG1 MappingPackage1>>
<<package MAPPKG2 MappingPackage2>>
<<package MAPPKG3 MappingPackage3>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}
