Initial population.

1 files changed, 404 insertions, 0 deletions

diff --git a/src/algebra/patmatch2.spad.pamphlet b/src/algebra/patmatch2.spad.pamphlet
new file mode 100644
index 00000000..0c86c747
--- /dev/null
+++ b/src/algebra/patmatch2.spad.pamphlet
@@ -0,0 +1,404 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/algebra patmatch2.spad}
+\author{Manuel Bronstein}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{package PMINS PatternMatchIntegerNumberSystem}
+<<package PMINS PatternMatchIntegerNumberSystem>>=
+)abbrev package PMINS PatternMatchIntegerNumberSystem
+++ Pattern matching on integer number systems
+++ Author: Manuel Bronstein
+++ Date Created: 29 Nov 1989
+++ Date Last Updated: 22 Mar 1990
+++ Description:
+++   This package provides pattern matching functions on integers.
+++ Keywords: pattern, matching, integer.
+PatternMatchIntegerNumberSystem(I:IntegerNumberSystem): with
+  patternMatch: (I, Pattern Integer, PatternMatchResult(Integer, I)) ->
+                                          PatternMatchResult(Integer, I)
+    ++ patternMatch(n, pat, res) matches the pattern pat to the
+    ++ integer n; res contains the variables of pat which
+    ++ are already matched and their matches.
+ == add
+   import IntegerRoots(I)
+
+   PAT ==> Pattern Integer
+   PMR ==> PatternMatchResult(Integer, I)
+
+   patternMatchInner     : (I, PAT, PMR) -> PMR
+   patternMatchRestricted: (I, PAT, PMR, I) -> PMR
+   patternMatchSumProd   :
+     (I, List PAT, PMR, (I, I) -> Union(I, "failed"), I) -> PMR
+
+   patternMatch(x, p, l) ==
+     generic? p => addMatch(p, x, l)
+     patternMatchInner(x, p, l)
+
+   patternMatchRestricted(x, p, l, y) ==
+     generic? p => addMatchRestricted(p, x, l, y)
+     patternMatchInner(x, p, l)
+
+   patternMatchSumProd(x, lp, l, invOp, ident) ==
+     #lp = 2 =>
+       p2 := last lp
+       if ((r:= retractIfCan(p1 := first lp)@Union(Integer,"failed"))
+                          case "failed") then (p1 := p2; p2 := first lp)
+       (r := retractIfCan(p1)@Union(Integer, "failed")) case "failed" =>
+                                                                failed()
+       (y := invOp(x, r::Integer::I)) case "failed" => failed()
+       patternMatchRestricted(y::I, p2, l, ident)
+     failed()
+
+   patternMatchInner(x, p, l) ==
+     constant? p =>
+       (r := retractIfCan(p)@Union(Integer, "failed")) case Integer =>
+         convert(x)@Integer = r::Integer => l
+         failed()
+       failed()
+     (u := isExpt p) case Record(val:PAT,exponent:NonNegativeInteger) =>
+       ur := u::Record(val:PAT, exponent:NonNegativeInteger)
+       (v := perfectNthRoot(x, ur.exponent)) case "failed" => failed()
+       patternMatchRestricted(v::I, ur.val, l, 1)
+     (uu := isPower p) case Record(val:PAT, exponent:PAT) =>
+       uur := uu::Record(val:PAT, exponent: PAT)
+       pr := perfectNthRoot x
+       failed?(l := patternMatchRestricted(pr.exponent::Integer::I,
+                                         uur.exponent, l,1)) => failed()
+       patternMatchRestricted(pr.base, uur.val, l, 1)
+     (w := isTimes p) case List(PAT) =>
+       patternMatchSumProd(x, w::List(PAT), l, #1 exquo #2, 1)
+     (w := isPlus p) case List(PAT) =>
+      patternMatchSumProd(x,w::List(PAT),l,(#1-#2)::Union(I,"failed"),0)
+     (uv := isQuotient p) case Record(num:PAT, den:PAT) =>
+       uvr := uv::Record(num:PAT, den:PAT)
+       (r := retractIfCan(uvr.num)@Union(Integer,"failed")) case Integer
+         and (v := r::Integer::I exquo x) case I =>
+           patternMatchRestricted(v::I, uvr.den, l, 1)
+       (r := retractIfCan(uvr.den)@Union(Integer,"failed")) case Integer
+         => patternMatch(r::Integer * x, uvr.num, l)
+       failed()
+     failed()
+
+@
+\section{package PMQFCAT PatternMatchQuotientFieldCategory}
+<<package PMQFCAT PatternMatchQuotientFieldCategory>>=
+)abbrev package PMQFCAT PatternMatchQuotientFieldCategory
+++ Pattern matching on quotient objects
+++ Author: Manuel Bronstein
+++ Date Created: 1 Dec 1989
+++ Date Last Updated: 20 June 1991
+++ Description:
+++   This package provides pattern matching functions on quotients.
+++ Keywords: pattern, matching, quotient, field.
+PatternMatchQuotientFieldCategory(S,R,Q):Exports == Implementation where
+  S: SetCategory
+  R: Join(IntegralDomain, PatternMatchable S, ConvertibleTo Pattern S)
+  Q: QuotientFieldCategory R
+
+  PAT ==> Pattern S
+  PRQ ==> PatternMatchResult(S, Q)
+
+  Exports ==> with
+    patternMatch: (Q, PAT, PRQ) -> PRQ
+      ++ patternMatch(a/b, pat, res) matches the pattern pat to the
+      ++ quotient a/b; res contains the variables of pat which
+      ++ are already matched and their matches.
+
+  Implementation ==> add
+    import PatternMatchPushDown(S, R, Q)
+
+    patternMatch(x, p, l) ==
+      generic? p => addMatch(p, x, l)
+      (r := retractIfCan x)@Union(R, "failed") case R =>
+        patternMatch(r::R, p, l)
+      (u := isQuotient p) case Record(num:PAT, den:PAT) =>
+        ur := u::Record(num:PAT, den:PAT)
+        failed?(l := patternMatch(numer x, ur.num, l)) => l
+        patternMatch(denom x, ur.den, l)
+      failed()
+
+@
+\section{package PMPLCAT PatternMatchPolynomialCategory}
+<<package PMPLCAT PatternMatchPolynomialCategory>>=
+)abbrev package PMPLCAT PatternMatchPolynomialCategory
+++ Pattern matching on polynomial objects
+++ Author: Manuel Bronstein
+++ Date Created: 9 Jan 1990
+++ Date Last Updated: 20 June 1991
+++ Description:
+++   This package provides pattern matching functions on polynomials.
+++ Keywords: pattern, matching, polynomial.
+PatternMatchPolynomialCategory(S,E,V,R,P):Exports== Implementation where
+  S: SetCategory
+  E: OrderedAbelianMonoidSup
+  V: OrderedSet
+  R: Join(Ring, OrderedSet, PatternMatchable S)
+  P: Join(PolynomialCategory(R, E, V), ConvertibleTo Pattern S)
+
+  N   ==> NonNegativeInteger
+  PAT ==> Pattern S
+  PRS ==> PatternMatchResult(S, P)
+  RCP ==> Record(val:PAT, exponent:N)
+  RCX ==> Record(var:V, exponent:N)
+
+  Exports ==> with
+    patternMatch: (P, PAT, PRS, (V, PAT, PRS) -> PRS) -> PRS
+      ++ patternMatch(p, pat, res, vmatch) matches the pattern pat to
+      ++ the polynomial p. res contains the variables of pat which
+      ++ are already matched and their matches; vmatch is the matching
+      ++ function to use on the variables.
+      -- This can be more efficient than pushing down when the variables
+      -- are recursive over P (e.g. kernels)
+    if V has PatternMatchable S then
+      patternMatch: (P, PAT, PRS) -> PRS
+        ++ patternMatch(p, pat, res) matches the pattern pat to
+        ++ the polynomial p; res contains the variables of pat which
+        ++ are already matched and their matches.
+
+  Implementation ==> add
+    import PatternMatchTools(S, R, P)
+    import PatternMatchPushDown(S, R, P)
+
+    if V has PatternMatchable S then
+      patternMatch(x, p, l) ==
+        patternMatch(x, p, l, patternMatch$PatternMatchPushDown(S,V,P))
+
+    patternMatch(x, p, l, vmatch) ==
+      generic? p => addMatch(p, x, l)
+      (r := retractIfCan(x)@Union(R, "failed")) case R =>
+        patternMatch(r::R, p, l)
+      (v := retractIfCan(x)@Union(V, "failed")) case V =>
+        vmatch(v::V, p, l)
+      (u := isPlus p) case List(PAT) =>
+        (lx := isPlus x) case List(P) =>
+          patternMatch(lx::List(P), u::List(PAT), +/#1, l,
+                                       patternMatch(#1, #2, #3, vmatch))
+        (u := optpair(u::List(PAT))) case List(PAT) =>
+          failed?(l := addMatch(first(u::List(PAT)), 0, l)) => failed()
+          patternMatch(x, second(u::List(PAT)), l, vmatch)
+        failed()
+      (u := isTimes p) case List(PAT) =>
+        (lx := isTimes x) case List(P) =>
+          patternMatchTimes(lx::List(P), u::List(PAT), l,
+                                       patternMatch(#1, #2, #3, vmatch))
+        (u := optpair(u::List(PAT))) case List(PAT) =>
+          failed?(l := addMatch(first(u::List(PAT)), 1, l)) => failed()
+          patternMatch(x, second(u::List(PAT)), l, vmatch)
+        failed()
+      (uu := isPower p) case Record(val:PAT, exponent:PAT) =>
+        uur := uu::Record(val:PAT, exponent: PAT)
+        (ex := isExpt x) case RCX =>
+          failed?(l := patternMatch((ex::RCX).exponent::Integer::P,
+                                   uur.exponent, l, vmatch)) => failed()
+          vmatch((ex::RCX).var, uur.val, l)
+        optional?(uur.exponent) =>
+          failed?(l := addMatch(uur.exponent, 1, l)) => failed()
+          patternMatch(x, uur.val, l, vmatch)
+        failed()
+      ((ep := isExpt p) case RCP) and ((ex := isExpt x) case RCX) and
+           (ex::RCX).exponent = (ep::RCP).exponent =>
+               vmatch((ex::RCX).var, (ep::RCP).val, l)
+      failed()
+
+@
+\section{package PMFS PatternMatchFunctionSpace}
+<<package PMFS PatternMatchFunctionSpace>>=
+)abbrev package PMFS PatternMatchFunctionSpace
+++ Pattern matching on function spaces
+++ Author: Manuel Bronstein
+++ Date Created: 15 Mar 1990
+++ Date Last Updated: 20 June 1991
+++ Description:
+++  This package provides pattern matching functions on function spaces.
+++ Keywords: pattern, matching, function, space.
+PatternMatchFunctionSpace(S, R, F): Exports== Implementation where
+  S: SetCategory
+  R: Join(IntegralDomain, OrderedSet, PatternMatchable S)
+  F: Join(FunctionSpace R, ConvertibleTo Pattern S, PatternMatchable S,
+          RetractableTo Kernel %)  -- that one is redundant but won't
+                                   -- compile without it
+
+  N   ==> NonNegativeInteger
+  K   ==> Kernel F
+  PAT ==> Pattern S
+  PRS ==> PatternMatchResult(S, F)
+  RCP ==> Record(val:PAT, exponent:N)
+  RCX ==> Record(var:K, exponent:Integer)
+
+  Exports ==> with
+    patternMatch: (F, PAT, PRS) -> PRS
+      ++ patternMatch(expr, pat, res) matches the pattern pat to the
+      ++ expression expr; res contains the variables of pat which
+      ++ are already matched and their matches.
+
+  Implementation ==> add
+    import PatternMatchKernel(S, F)
+    import PatternMatchTools(S, R, F)
+    import PatternMatchPushDown(S, R, F)
+
+    patternMatch(x, p, l) ==
+      generic? p => addMatch(p, x, l)
+      (r := retractIfCan(x)@Union(R, "failed")) case R =>
+        patternMatch(r::R, p, l)
+      (v := retractIfCan(x)@Union(K, "failed")) case K =>
+        patternMatch(v::K, p, l)
+      (q := isQuotient p) case Record(num:PAT, den:PAT) =>
+        uq := q::Record(num:PAT, den:PAT)
+        failed?(l := patternMatch(numer(x)::F, uq.num, l)) => l
+        patternMatch(denom(x)::F, uq.den, l)
+      (u := isPlus p) case List(PAT) =>
+        (lx := isPlus x) case List(F) =>
+          patternMatch(lx::List(F), u::List(PAT), +/#1, l, patternMatch)
+        (u := optpair(u::List(PAT))) case List(PAT) =>
+          failed?(l := addMatch(first(u::List(PAT)), 0, l)) => failed()
+          patternMatch(x, second(u::List(PAT)), l)
+        failed()
+      (u := isTimes p) case List(PAT) =>
+        (lx := isTimes x) case List(F) =>
+          patternMatchTimes(lx::List(F), u::List(PAT), l, patternMatch)
+        (u := optpair(u::List(PAT))) case List(PAT) =>
+          failed?(l := addMatch(first(u::List(PAT)), 1, l)) => failed()
+          patternMatch(x, second(u::List(PAT)), l)
+        failed()
+      (uu := isPower p) case Record(val:PAT, exponent:PAT) =>
+        uur := uu::Record(val:PAT, exponent: PAT)
+        (ex := isExpt x) case RCX =>
+          failed?(l := patternMatch((ex::RCX).exponent::Integer::F,
+                                           uur.exponent, l)) => failed()
+          patternMatch((ex::RCX).var, uur.val, l)
+        optional?(uur.exponent) =>
+          failed?(l := addMatch(uur.exponent, 1, l)) => failed()
+          patternMatch(x, uur.val, l)
+        failed()
+      ((ep := isExpt p) case RCP) and ((ex := isExpt x) case RCX) and
+           (ex::RCX).exponent = ((ep::RCP).exponent)::Integer =>
+               patternMatch((ex::RCX).var, (ep::RCP).val, l)
+      failed()
+
+@
+\section{package PATMATCH PatternMatch}
+<<package PATMATCH PatternMatch>>=
+)abbrev package PATMATCH PatternMatch
+++ Top-level pattern matching functions
+++ Author: Manuel Bronstein
+++ Date Created: 3 Dec 1989
+++ Date Last Updated: 29 Jun 1990
+++ Description:
+++   This package provides the top-level pattern macthing functions.
+++ Keywords: pattern, matching.
+PatternMatch(Base, Subject, Pat): Exports == Implementation where
+  Base   : SetCategory
+  Subject: PatternMatchable Base
+  Pat    : ConvertibleTo Pattern Base
+
+  Exports ==> with
+    is?: (Subject, Pat)      -> Boolean
+      ++ is?(expr, pat) tests if the expression expr matches
+      ++ the pattern pat.
+    is?: (List Subject, Pat) -> Boolean
+      ++ is?([e1,...,en], pat) tests if the list of
+      ++ expressions \spad{[e1,...,en]} matches
+      ++ the pattern pat.
+    Is : (List Subject, Pat) ->
+                     PatternMatchListResult(Base, Subject, List Subject)
+      ++ Is([e1,...,en], pat) matches the pattern pat on the list of
+      ++ expressions \spad{[e1,...,en]} and returns the result.
+    if Subject has RetractableTo(Symbol) then
+      Is: (Subject, Pat) -> List Equation Subject
+        ++ Is(expr, pat) matches the pattern pat on the expression
+        ++ expr and returns a list of matches \spad{[v1 = e1,...,vn = en]};
+        ++ returns an empty list if either expr is exactly equal to
+        ++ pat or if pat does not match expr.
+    else
+      if Subject has Ring then
+        Is: (Subject, Pat) -> List Equation Polynomial Subject
+          ++ Is(expr, pat) matches the pattern pat on the expression
+          ++ expr and returns a list of matches \spad{[v1 = e1,...,vn = en]};
+          ++ returns an empty list if either expr is exactly equal to
+          ++ pat or if pat does not match expr.
+      else
+        Is: (Subject, Pat) -> PatternMatchResult(Base, Subject)
+          ++ Is(expr, pat) matches the pattern pat on the expression
+          ++ expr and returns a match of the form \spad{[v1 = e1,...,vn = en]};
+          ++ returns an empty match if expr is exactly equal to pat.
+          ++ returns a \spadfun{failed} match if pat does not match expr.
+
+  Implementation ==> add
+    import PatternMatchListAggregate(Base, Subject, List Subject)
+
+    ist: (Subject, Pat) -> PatternMatchResult(Base, Subject)
+
+    ist(s, p)                  == patternMatch(s, convert p, new())
+    is?(s:     Subject, p:Pat) == not failed? ist(s, p)
+    is?(s:List Subject, p:Pat) == not failed? Is(s, p)
+    Is(s:List Subject,  p:Pat) == patternMatch(s, convert p, new())
+
+    if Subject has RetractableTo(Symbol) then
+      Is(s:Subject, p:Pat):List(Equation Subject) ==
+        failed?(r := ist(s, p)) => empty()
+        [rec.key::Subject = rec.entry for rec in destruct r]
+
+    else
+      if Subject has Ring then
+        Is(s:Subject, p:Pat):List(Equation Polynomial Subject) ==
+          failed?(r := ist(s, p)) => empty()
+          [rec.key::Polynomial(Subject) =$Equation(Polynomial Subject)
+           rec.entry::Polynomial(Subject) for rec in destruct r]
+
+      else
+        Is(s:Subject,p:Pat):PatternMatchResult(Base,Subject) == ist(s,p)
+
+@
+\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 PMINS PatternMatchIntegerNumberSystem>>
+<<package PMQFCAT PatternMatchQuotientFieldCategory>>
+<<package PMPLCAT PatternMatchPolynomialCategory>>
+<<package PMFS PatternMatchFunctionSpace>>
+<<package PATMATCH PatternMatch>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}