\documentclass{article} \usepackage{open-axiom} \begin{document} \title{\$SPAD/src/algebra pattern.spad} \author{Manuel Bronstein} \maketitle \begin{abstract} \end{abstract} \eject \tableofcontents \eject \section{domain PATTERN Pattern} <>= )abbrev domain PATTERN Pattern ++ Patterns for use by the pattern matcher ++ Author: Manuel Bronstein ++ Date Created: 10 Nov 1988 ++ Date Last Updated: 20 June 1991 ++ Description: Patterns for use by the pattern matcher. ++ Keywords: pattern, matching. -- Not exposed. -- Patterns are optimized for quick answers to structural questions. Pattern(R:SetCategory): Exports == Implementation where B ==> Boolean SI ==> SingleInteger Z ==> Integer SY ==> Symbol O ==> OutputForm BOP ==> BasicOperator QOT ==> Record(num:%, den:%) REC ==> Record(val:%, exponent:NonNegativeInteger) RSY ==> Record(tag:SI, val: SY, pred:List Any, bad:List Any) KER ==> Record(tag:SI, op:BOP, arg:List %) PAT ==> Union(ret:R, ker: KER, exp:REC, qot: QOT, sym:RSY) -- the following MUST be the name of the formal exponentiation operator POWER ==> '%power -- the 4 SYM_ constants must be disting powers of 2 (bitwise arithmetic) SYM_GENERIC ==> 1::SI SYM_MULTIPLE ==> 2::SI SYM_OPTIONAL ==> 4::SI PAT_PLUS ==> 1::SI PAT_TIMES ==> 2::SI PAT_LIST ==> 3::SI PAT_ZERO ==> 4::SI PAT_ONE ==> 5::SI PAT_EXPT ==> 6::SI Exports ==> Join(SetCategory, RetractableTo R, RetractableTo SY) with 0 : constant -> % ++ 0 1 : constant -> % ++ 1 isPlus : % -> Union(List %, "failed") ++ isPlus(p) returns \spad{[a1,...,an]} if \spad{n > 1} ++ and \spad{p = a1 + ... + an}, ++ and "failed" otherwise. isTimes : % -> Union(List %, "failed") ++ isTimes(p) returns \spad{[a1,...,an]} if \spad{n > 1} and ++ \spad{p = a1 * ... * an}, and ++ "failed" otherwise. isOp : (%, BOP) -> Union(List %, "failed") ++ isOp(p, op) returns \spad{[a1,...,an]} if \spad{p = op(a1,...,an)}, and ++ "failed" otherwise. isOp : % -> Union(Record(op:BOP, arg:List %), "failed") ++ isOp(p) returns \spad{[op, [a1,...,an]]} if ++ \spad{p = op(a1,...,an)}, and ++ "failed" otherwise; isExpt : % -> Union(REC, "failed") ++ isExpt(p) returns \spad{[q, n]} if \spad{n > 0} and \spad{p = q ** n}, ++ and "failed" otherwise. isQuotient : % -> Union(QOT, "failed") ++ isQuotient(p) returns \spad{[a, b]} if \spad{p = a / b}, and ++ "failed" otherwise. isList : % -> Union(List %, "failed") ++ isList(p) returns \spad{[a1,...,an]} if \spad{p = [a1,...,an]}, ++ "failed" otherwise; isPower : % -> Union(Record(val:%, exponent:%), "failed") ++ isPower(p) returns \spad{[a, b]} if \spad{p = a ** b}, and ++ "failed" otherwise. elt : (BOP, List %) -> % ++ \spad{elt(op, [a1,...,an])} returns \spad{op(a1,...,an)}. + : (%, %) -> % ++ \spad{a + b} returns the pattern \spad{a + b}. * : (%, %) -> % ++ \spad{a * b} returns the pattern \spad{a * b}. ** : (%, NonNegativeInteger) -> % ++ \spad{a ** n} returns the pattern \spad{a ** n}. ** : (%, %) -> % ++ \spad{a ** b} returns the pattern \spad{a ** b}. / : (%, %) -> % ++ \spad{a / b} returns the pattern \spad{a / b}. depth : % -> NonNegativeInteger ++ depth(p) returns the nesting level of p. convert : List % -> % ++ \spad{convert([a1,...,an])} returns the pattern \spad{[a1,...,an]}. copy : % -> % ++ copy(p) returns a recursive copy of p. inR? : % -> B ++ inR?(p) tests if p is an atom (i.e. an element of R). quoted? : % -> B ++ quoted?(p) tests if p is of the form 's for a symbol s. symbol? : % -> B ++ symbol?(p) tests if p is a symbol. constant? : % -> B ++ constant?(p) tests if p contains no matching variables. generic? : % -> B ++ generic?(p) tests if p is a single matching variable. multiple? : % -> B ++ multiple?(p) tests if p is a single matching variable ++ allowing list matching or multiple term matching in a ++ sum or product. optional? : % -> B ++ optional?(p) tests if p is a single matching variable ++ which can match an identity. hasPredicate?: % -> B ++ hasPredicate?(p) tests if p has predicates attached to it. predicates : % -> List Any ++ predicates(p) returns \spad{[p1,...,pn]} such that the predicate ++ attached to p is p1 and ... and pn. setPredicates: (%, List Any) -> % ++ \spad{setPredicates(p, [p1,...,pn])} attaches the predicate ++ p1 and ... and pn to p. withPredicates:(%, List Any) -> % ++ \spad{withPredicates(p, [p1,...,pn])} makes a copy of p and attaches ++ the predicate p1 and ... and pn to the copy, which is ++ returned. patternVariable: (SY, B, B, B) -> % ++ patternVariable(x, c?, o?, m?) creates a pattern variable x, ++ which is constant if \spad{c? = true}, optional if \spad{o? = true}, ++ and multiple if \spad{m? = true}. setTopPredicate: (%, List SY, Any) -> % ++ \spad{setTopPredicate(x, [a1,...,an], f)} returns x with ++ the top-level predicate set to \spad{f(a1,...,an)}. topPredicate: % -> Record(var:List SY, pred:Any) ++ topPredicate(x) returns \spad{[[a1,...,an], f]} where the top-level ++ predicate of x is \spad{f(a1,...,an)}. ++ Note: n is 0 if x has no top-level ++ predicate. hasTopPredicate?: % -> B ++ hasTopPredicate?(p) tests if p has a top-level predicate. resetBadValues: % -> % ++ resetBadValues(p) initializes the list of "bad values" for p ++ to \spad{[]}. ++ Note: p is not allowed to match any of its "bad values". addBadValue: (%, Any) -> % ++ addBadValue(p, v) adds v to the list of "bad values" for p. ++ Note: p is not allowed to match any of its "bad values". getBadValues: % -> List Any ++ getBadValues(p) returns the list of "bad values" for p. ++ Note: p is not allowed to match any of its "bad values". variables: % -> List % ++ variables(p) returns the list of matching variables ++ appearing in p. optpair: List % -> Union(List %, "failed") ++ optpair(l) returns l has the form \spad{[a, b]} and ++ a is optional, and ++ "failed" otherwise; Implementation ==> add Rep := Record(cons?: B, pat:PAT, lev: NonNegativeInteger, topvar: List SY, toppred: Any) dummy:BOP := operator(new()$Symbol) nopred := coerce(0$Integer)$AnyFunctions1(Integer) mkPat : (B, PAT, NonNegativeInteger) -> % mkrsy : (SY, B, B, B) -> RSY SYM2O : RSY -> O PAT2O : PAT -> O patcopy : PAT -> PAT bitSet? : (SI , SI) -> B pateq? : (PAT, PAT) -> B LPAT2O : ((O, O) -> O, List %) -> O taggedElt : (SI, List %) -> % isTaggedOp: (%, SI) -> Union(List %, "failed") incmax : List % -> NonNegativeInteger coerce(r:R):% == mkPat(true, [r], 0) mkPat(c, p, l) == [c, p, l, empty(), nopred] hasTopPredicate? x == not empty?(x.topvar) topPredicate x == [x.topvar, x.toppred] setTopPredicate(x, l, f) == (x.topvar := l; x.toppred := f; x) constant? p == p.cons? depth p == p.lev inR? p == p.pat case ret symbol? p == p.pat case sym isPlus p == isTaggedOp(p, PAT_PLUS) isTimes p == isTaggedOp(p, PAT_TIMES) isList p == isTaggedOp(p, PAT_LIST) isExpt p == (p.pat case exp => p.pat.exp; "failed") isQuotient p == (p.pat case qot => p.pat.qot; "failed") hasPredicate? p == not empty? predicates p quoted? p == symbol? p and zero?(p.pat.sym.tag) generic? p == symbol? p and bitSet?(p.pat.sym.tag, SYM_GENERIC) multiple? p == symbol? p and bitSet?(p.pat.sym.tag,SYM_MULTIPLE) optional? p == symbol? p and bitSet?(p.pat.sym.tag,SYM_OPTIONAL) bitSet?(a, b) == (a /\ b) ~= 0 coerce(p:%):O == PAT2O(p.pat) p1:% ** p2:% == taggedElt(PAT_EXPT, [p1, p2]) LPAT2O(f, l) == reduce(f, [x::O for x in l])$List(O) retract(p:%):R == (inR? p => p.pat.ret; error "Not retractable") convert(l:List %):% == taggedElt(PAT_LIST, l) retractIfCan(p:%):Union(R,"failed") ==(inR? p => p.pat.ret;"failed") withPredicates(p, l) == setPredicates(copy p, l) coerce(sy:SY):% == patternVariable(sy, false, false, false) copy p == [constant? p, patcopy(p.pat), p.lev, p.topvar, p.toppred] -- returns [a, b] if #l = 2 and optional? a, "failed" otherwise optpair l == empty? rest rest l => b := first rest l optional?(a := first l) => l optional? b => reverse l "failed" "failed" incmax l == 1 + reduce("max", [p.lev for p in l], 0)$List(NonNegativeInteger) p1 = p2 == (p1.cons? = p2.cons?) and (p1.lev = p2.lev) and (p1.topvar = p2.topvar) and ((%peq(p1.toppred,p2.toppred)$Foreign(Builtin)) pretend B) and pateq?(p1.pat, p2.pat) isPower p == (u := isTaggedOp(p, PAT_EXPT)) case "failed" => "failed" [first(u::List(%)), second(u::List(%))] taggedElt(n, l) == mkPat(every?(constant?, l), [[n, dummy, l]$KER], incmax l) elt(o, l) == is?(o, POWER) and #l = 2 => first(l) ** last(l) mkPat(every?(constant?, l), [[0, o, l]$KER], incmax l) isOp p == (p.pat case ker) and zero?(p.pat.ker.tag) => [p.pat.ker.op, p.pat.ker.arg] "failed" isTaggedOp(p,t) == (p.pat case ker) and (p.pat.ker.tag = t) => p.pat.ker.arg "failed" if R has Monoid then 1 == 1::R::% else 1 == taggedElt(PAT_ONE, empty()) if R has AbelianMonoid then 0 == 0::R::% else 0 == taggedElt(PAT_ZERO, empty()) p:% ** n:NonNegativeInteger == p = 0 and positive? n => 0 p = 1 or zero? n => 1 one? n => p mkPat(constant? p, [[p, n]$REC], 1 + (p.lev)) p1 / p2 == p2 = 1 => p1 mkPat(constant? p1 and constant? p2, [[p1, p2]$QOT], 1 + max(p1.lev, p2.lev)) p1 + p2 == p1 = 0 => p2 p2 = 0 => p1 (u1 := isPlus p1) case List(%) => (u2 := isPlus p2) case List(%) => taggedElt(PAT_PLUS, concat(u1::List %, u2::List %)) taggedElt(PAT_PLUS, concat(u1::List %, p2)) (u2 := isPlus p2) case List(%) => taggedElt(PAT_PLUS, concat(p1, u2::List %)) taggedElt(PAT_PLUS, [p1, p2]) p1 * p2 == p1 = 0 or p2 = 0 => 0 p1 = 1 => p2 p2 = 1 => p1 (u1 := isTimes p1) case List(%) => (u2 := isTimes p2) case List(%) => taggedElt(PAT_TIMES, concat(u1::List %, u2::List %)) taggedElt(PAT_TIMES, concat(u1::List %, p2)) (u2 := isTimes p2) case List(%) => taggedElt(PAT_TIMES, concat(p1, u2::List %)) taggedElt(PAT_TIMES, [p1, p2]) isOp(p, o) == (p.pat case ker) and zero?(p.pat.ker.tag) and (p.pat.ker.op =o) => p.pat.ker.arg "failed" predicates p == symbol? p => p.pat.sym.pred empty() setPredicates(p, l) == generic? p => (p.pat.sym.pred := l; p) error "Can only attach predicates to generic symbol" resetBadValues p == generic? p => (p.pat.sym.bad := empty()$List(Any); p) error "Can only attach bad values to generic symbol" addBadValue(p, a) == generic? p => if not member?(a, p.pat.sym.bad) then p.pat.sym.bad := concat(a, p.pat.sym.bad) p error "Can only attach bad values to generic symbol" getBadValues p == generic? p => p.pat.sym.bad error "Not a generic symbol" SYM2O p == sy := (p.val)::O empty?(p.pred) => sy paren infix(" | "::O, sy, reduce("and",[sub("f"::O, i::O) for i in 1..#(p.pred)])$List(O)) variables p == constant? p => empty() generic? p => [p] q := p.pat q case ret => empty() q case exp => variables(q.exp.val) q case qot => concat!(variables(q.qot.num), variables(q.qot.den)) q case ker => concat [variables r for r in q.ker.arg] empty() PAT2O p == p case ret => (p.ret)::O p case sym => SYM2O(p.sym) p case exp => (p.exp.val)::O ** (p.exp.exponent)::O p case qot => (p.qot.num)::O / (p.qot.den)::O p.ker.tag = PAT_PLUS => LPAT2O("+", p.ker.arg) p.ker.tag = PAT_TIMES => LPAT2O("*", p.ker.arg) p.ker.tag = PAT_LIST => (p.ker.arg)::O p.ker.tag = PAT_ZERO => 0::Integer::O p.ker.tag = PAT_ONE => 1::Integer::O l := [x::O for x in p.ker.arg]$List(O) (u:=display(p.ker.op)) case nothing =>prefix(name(p.ker.op)::O,l) (u::(List O -> O)) l patcopy p == p case ret => [p.ret] p case sym => [[p.sym.tag, p.sym.val, copy(p.sym.pred), copy(p.sym.bad)]$RSY] p case ker=>[[p.ker.tag,p.ker.op,[copy x for x in p.ker.arg]]$KER] p case qot => [[copy(p.qot.num), copy(p.qot.den)]$QOT] [[copy(p.exp.val), p.exp.exponent]$REC] pateq?(p1, p2) == p1 case ret => (p2 case ret) and (p1.ret = p2.ret) p1 case qot => (p2 case qot) and (p1.qot.num = p2.qot.num) and (p1.qot.den = p2.qot.den) p1 case sym => (p2 case sym) and (p1.sym.val = p2.sym.val) and {p1.sym.pred} =$Set(Any) {p2.sym.pred} and {p1.sym.bad} =$Set(Any) {p2.sym.bad} p1 case ker => (p2 case ker) and (p1.ker.tag = p2.ker.tag) and (p1.ker.op = p2.ker.op) and (p1.ker.arg = p2.ker.arg) (p2 case exp) and (p1.exp.exponent = p2.exp.exponent) and (p1.exp.val = p2.exp.val) retractIfCan(p:%):Union(SY, "failed") == symbol? p => p.pat.sym.val "failed" mkrsy(t, c?, o?, m?) == c? => [0, t, empty(), empty()] mlt := (m? => SYM_MULTIPLE; 0) opt := (o? => SYM_OPTIONAL; 0) [(SYM_GENERIC \/ mlt) \/ opt, t, empty(), empty()] patternVariable(sy, c?, o?, m?) == rsy := mkrsy(sy, c?, o?, m?) mkPat(zero?(rsy.tag), [rsy], 0) @ \section{package PATTERN1 PatternFunctions1} <>= )abbrev package PATTERN1 PatternFunctions1 ++ Utilities for handling patterns ++ Author: Manuel Bronstein ++ Date Created: 28 Nov 1989 ++ Date Last Updated: 5 Jul 1990 ++ Description: Tools for patterns; ++ Keywords: pattern, matching. PatternFunctions1(R:SetCategory, D:Type): with suchThat : (Pattern R, D -> Boolean) -> Pattern R ++ suchThat(p, f) makes a copy of p and adds the predicate ++ f to the copy, which is returned. suchThat : (Pattern R, List(D -> Boolean)) -> Pattern R ++ \spad{suchThat(p, [f1,...,fn])} makes a copy of p and adds the ++ predicate f1 and ... and fn to the copy, which is returned. suchThat : (Pattern R, List Symbol, List D -> Boolean) -> Pattern R ++ \spad{suchThat(p, [a1,...,an], f)} returns a copy of p with ++ the top-level predicate set to \spad{f(a1,...,an)}. predicate : Pattern R -> (D -> Boolean) ++ predicate(p) returns the predicate attached to p, the ++ constant function true if p has no predicates attached to it. satisfy? : (D, Pattern R) -> Boolean ++ satisfy?(v, p) returns f(v) where f is the predicate ++ attached to p. satisfy? : (List D, Pattern R) -> Boolean ++ \spad{satisfy?([v1,...,vn], p)} returns \spad{f(v1,...,vn)} ++ where f is the ++ top-level predicate attached to p. addBadValue: (Pattern R, D) -> Pattern R ++ addBadValue(p, v) adds v to the list of "bad values" for p; ++ p is not allowed to match any of its "bad values". badValues : Pattern R -> List D ++ badValues(p) returns the list of "bad values" for p; ++ p is not allowed to match any of its "bad values". == add A1D ==> AnyFunctions1(D) A1 ==> AnyFunctions1(D -> Boolean) A1L ==> AnyFunctions1(List D -> Boolean) applyAll: (List Any, D) -> Boolean st : (Pattern R, List Any) -> Pattern R st(p, l) == withPredicates(p, concat(predicates p, l)) predicate p == applyAll(predicates p, #1) addBadValue(p, v) == addBadValue(p, coerce(v)$A1D) badValues p == [retract(v)$A1D for v in getBadValues p] suchThat(p, l, f) == setTopPredicate(copy p, l, coerce(f)$A1L) suchThat(p:Pattern R, f:D -> Boolean) == st(p, [coerce(f)$A1]) satisfy?(d:D, p:Pattern R) == applyAll(predicates p, d) satisfy?(l:List D, p:Pattern R) == empty?((rec := topPredicate p).var) => true retract(rec.pred)$A1L l applyAll(l, d) == for f in l repeat not(retract(f)$A1 d) => return false true suchThat(p:Pattern R, l:List(D -> Boolean)) == st(p, [coerce(f)$A1 for f in l]) @ \section{package PATTERN2 PatternFunctions2} <>= )abbrev package PATTERN2 PatternFunctions2 ++ Lifting of maps to patterns ++ Author: Manuel Bronstein ++ Date Created: 28 Nov 1989 ++ Date Last Updated: 12 Jan 1990 ++ Description: Lifts maps to patterns; ++ Keywords: pattern, matching. PatternFunctions2(R:SetCategory, S:SetCategory): with map: (R -> S, Pattern R) -> Pattern S ++ map(f, p) applies f to all the leaves of p and ++ returns the result as a pattern over S. == add map(f, p) == (r := (retractIfCan p)@Union(R, "failed")) case R => f(r::R)::Pattern(S) (u := isOp p) case Record(op:BasicOperator, arg:List Pattern R) => ur := u::Record(op:BasicOperator, arg:List Pattern R) (ur.op) [map(f, x) for x in ur.arg] (v := isQuotient p) case Record(num:Pattern R, den:Pattern R) => vr := v::Record(num:Pattern R, den:Pattern R) map(f, vr.num) / map(f, vr.den) (l := isPlus p) case List(Pattern R) => reduce("+", [map(f, x) for x in l::List(Pattern R)]) (l := isTimes p) case List(Pattern R) => reduce("*", [map(f, x) for x in l::List(Pattern R)]) (x := isPower p) case Record(val:Pattern R, exponent: Pattern R) => xr := x::Record(val:Pattern R, exponent: Pattern R) map(f, xr.val) ** map(f, xr.exponent) (w := isExpt p) case Record(val:Pattern R, exponent: NonNegativeInteger) => wr := w::Record(val:Pattern R, exponent: NonNegativeInteger) map(f, wr.val) ** wr.exponent sy := retract(p)@Symbol setPredicates(sy::Pattern(S), copy predicates p) @ \section{category PATAB Patternable} <>= )abbrev category PATAB Patternable ++ Category of sets that can be converted to useful patterns ++ Author: Manuel Bronstein ++ Date Created: 29 Nov 1989 ++ Date Last Updated: 29 Nov 1989 ++ Description: ++ An object S is Patternable over an object R if S can ++ lift the conversions from R into \spadtype{Pattern(Integer)} and ++ \spadtype{Pattern(Float)} to itself; ++ Keywords: pattern, matching. Patternable(R:Type): Category == with if R has ConvertibleTo Pattern Integer then ConvertibleTo Pattern Integer if R has ConvertibleTo Pattern Float then ConvertibleTo Pattern Float @ \section{License} <>= --Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --All rights reserved. --Copyright (C) 2007-2009, 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. @ <<*>>= <> <> <> <> <> @ \eject \begin{thebibliography}{99} \bibitem{1} nothing \end{thebibliography} \end{document}