\documentclass{article}
\usepackage{open-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: November 12, 2007
++ 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)}.
        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}.
 
 
        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)
        import %peq: (A,A) -> Boolean from Foreign Builtin
 
        a: A
        faa:  A -> A
        f0a:  ()-> A
 
        nullary a   == a
        coerce  a   == nullary a
        fixedPoint faa ==
            g0 := GENSYM()$Lisp
            g1 := faa g0
            %peq(g0,g1) => error "All points are fixed points"
            GEQNSUBSTLIST([g0]$Lisp, [g1]$Lisp, g1)$Lisp
 
        fixedPoint(fll, n) ==
            g0 := [(GENSYM()$Lisp):A for i in 1..n]
            g1 := fll g0
            or/[%peq(e0,e1) 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        == iter(g, n, #1)
 
        recur fnaa  == recur(fnaa, #1, #2)

@
\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     == arg2(#1, c)
        curry(fac, a)  == fac a
        constant f0c      == arg2(#1, f0c())
 
        diag  faac  == faac(#1, #1)

@
\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) == fabc(#1,b)
        curryLeft(fabc,a) == fabc(a, #1)
 
        -- Add left and right arguments which are ignored.
        constantRight fac     == fac #1
        constantLeft fbc     == fbc #2
 
        -- Combinators to rearrange arguments.
        twist fabc  == fabc(#2, #1)
        -- Functional composition
        fbc*fab == comp(fbc,fab,#1)

@
\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}