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

\documentclass{article}
\usepackage{open-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, 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, 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}