aboutsummaryrefslogtreecommitdiff
path: root/src/interp/match.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-08-14 05:14:52 +0000
committerdos-reis <gdr@axiomatics.org>2007-08-14 05:14:52 +0000
commitab8cc85adde879fb963c94d15675783f2cf4b183 (patch)
treec202482327f474583b750b2c45dedfc4e4312b1d /src/interp/match.boot.pamphlet
downloadopen-axiom-ab8cc85adde879fb963c94d15675783f2cf4b183.tar.gz
Initial population.
Diffstat (limited to 'src/interp/match.boot.pamphlet')
-rw-r--r--src/interp/match.boot.pamphlet242
1 files changed, 242 insertions, 0 deletions
diff --git a/src/interp/match.boot.pamphlet b/src/interp/match.boot.pamphlet
new file mode 100644
index 00000000..132b99f9
--- /dev/null
+++ b/src/interp/match.boot.pamphlet
@@ -0,0 +1,242 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp match.boot}
+\author{The Axiom Team}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\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>>
+
+SETANDFILEQ($wildCard,char "*")
+
+maskMatch?(mask,subject) ==
+ null mask => true
+ if null STRINGP subject then subject := PNAME subject
+ or/[match?(pattern,subject) for pattern in mask]
+
+substring?(part, whole, startpos) ==
+--This function should be replaced by STRING<
+ np := SIZE part
+ nw := SIZE whole
+ np > nw - startpos => false
+ and/[CHAR_-EQUAL(ELT(part, ip), ELT(whole, iw))
+ for ip in 0..np-1 for iw in startpos.. ]
+
+anySubstring?(part,whole,startpos) ==
+ np := SIZE part
+ nw := SIZE whole
+ or/[((k := i) and and/[CHAR_-EQUAL(ELT(part, ip),ELT(whole, iw))
+ for ip in 0..np - 1 for iw in i..]) for i in startpos..nw - np] => k
+
+charPosition(c,t,startpos) ==
+ n := SIZE t
+ startpos < 0 or startpos > n => n
+ k:= startpos
+ for i in startpos .. n-1 repeat
+ c = ELT(t,i) => return nil
+ k := k+1
+ k
+
+rightCharPosition(c,t,startpos) == --startpos often equals MAXINDEX t (rightmost)
+ k := startpos
+ for i in startpos..0 by -1 while c ^= ELT(t,i) repeat (k := k - 1)
+ k
+
+stringPosition(s,t,startpos) ==
+ n := SIZE t
+ if startpos < 0 or startpos > n then error "index out of range"
+ if SIZE s = 0 then return startpos -- bug in STRPOS
+ r := STRPOS(s,t,startpos,NIL)
+ if EQ(r,NIL) then n else r
+
+superMatch?(opattern,subject) == --subject assumed to be DOWNCASEd
+ $wildCard : local := char '_*
+ pattern := patternCheck opattern
+ logicalMatch?(pattern,subject)
+
+logicalMatch?(pattern,subject) == --subject assumed to be DOWNCASEd
+ pattern is [op,:argl] =>
+ op = "and" => and/[superMatch?(p,subject) for p in argl]
+ op = "or" => or/[superMatch?(p,subject) for p in argl]
+ op = "not" => not superMatch?(first argl,subject)
+ systemError '"unknown pattern form"
+ basicMatch?(pattern,subject)
+
+patternCheck pattern == main where
+ --checks for escape characters, maybe new $wildCard
+ main ==
+-- pattern := pmTransFilter pattern --should no longer need this (rdj:10/1/91)
+ u := pos(char '__,pattern)
+ null u => pattern
+ not(and/[equal(pattern,i + 1,$wildCard) for i in u]) =>
+ sayBrightly ['"Invalid use of underscores in pattern: ",pattern]
+ '"!!!!!!!!!!!!!!"
+ c := wild(pattern,'(_$ _# _% _& _@))
+-- sayBrightlyNT ['"Choosing new wild card"]
+-- pp c
+ $oldWild :local := $wildCard
+ $wildCard := c
+ pattern := mknew(pattern,first u,rest u,SUBSTRING(pattern,0,first u))
+-- sayBrightlyNT ['"Replacing pattern by"]
+-- pp pattern
+ pattern
+ mknew(old,i,r,new) ==
+ new := STRCONC(new,old.(i + 1)) --add underscored character to string
+ null r => STRCONC(new,subWild(SUBSTRING(old,i + 2,nil),0))
+ mknew(old,first r,rest r,
+ STRCONC(new,subWild(SUBSTRING(old,i + 2,(first r) - i - 1),i + 1)))
+ subWild(s,i) ==
+ (k := charPosition($oldWild,s,i)) < #s =>
+ STRCONC(SUBSTRING(s,i,k - i),$wildCard,subWild(s,k + 1))
+ SUBSTRING(s,i,nil)
+ pos(c,s) ==
+ i := 0
+ n := MAXINDEX s
+ acc := nil
+ repeat
+ k := charPosition(c,s,i)
+ k > n => return NREVERSE acc
+ acc := [k,:acc]
+ i := k + 1
+ equal(p,n,c) ==
+ n > MAXINDEX p => false
+ p.n = c
+ wild(p,u) ==
+ for id in u repeat
+ c := char id
+ not(or/[p.i = c for i in 0..MAXINDEX(p)]) => return c
+
+match?(pattern,subject) == --returns index of first character that matches
+ basicMatch?(pattern,DOWNCASE subject)
+
+stringMatch(pattern,subject,wildcard) ==
+ not CHARP wildcard =>
+ systemError '"Wildcard must be a character"
+ $wildCard : local := wildcard
+ subject := DOWNCASE subject
+ k := basicMatch?(pattern,DOWNCASE subject) => k + 1
+ 0
+
+basicMatch?(pattern,target) ==
+ n := #pattern
+ p := charPosition($wildCard,pattern,0)
+ p = n => (pattern = target) and 0
+ if p ^= 0 then
+ -- pattern does not begin with a wild card
+ ans := 0
+ s := SUBSTRING(pattern,0,p) --[pattern.i for i in 0..p-1]
+ not substring?(s,target,0) => return false
+ else if n = 1 then return 0
+ i := p -- starting position for searching the target
+ q := charPosition($wildCard,pattern,p+1)
+ ltarget := #target
+ while q ^= n repeat
+ s := SUBSTRING(pattern,p+1,q-p-1) --[pattern.i for i in (p+1..q-1)]
+ i := stringPosition(s,target,i)
+ if null ans then ans := stringPosition(s,target,p)
+ -- for patterns beginning with wildcard, ans gives position of first match
+ if i = ltarget then return (returnFlag := true)
+ i := i + #s
+ p := q
+ q := charPosition($wildCard,pattern,q+1)
+ returnFlag => false
+ if p ^= q-1 then
+ -- pattern does not end with a wildcard
+ s := SUBSTRING(pattern,p+1,q-p-1) --[pattern.i for i in (p+1..q-1)]
+ if not suffix?(s,target) then return false
+ if null ans then ans := 1 --pattern is a word preceded by a *
+ ans
+
+matchSegment?(pattern,subject,k) ==
+ matchAnySegment?(pattern,DOWNCASE subject,k,nil)
+
+matchAnySegment?(pattern,target,k,nc) == --k = start position; nc=#chars or NIL
+ n := #pattern
+ p := charPosition($wildCard,pattern,0)
+ p = n =>
+ m := stringPosition(pattern,target,k)
+ m = #target => nil
+ null nc => true
+ m <= k + nc - n
+ if k ^= 0 and nc then
+ target := SUBSTRING(target,k,nc)
+ k := 0
+ if p ^= 0 then
+ -- pattern does not begin with a wild card
+ ans := 0
+ s := SUBSTRING(pattern,0,p) --[pattern.i for i in 0..p-1]
+ not substring?(s,target,k) => return false
+ else if n = 1 then return true
+ i := p + k -- starting position for searching the target
+ q := charPosition($wildCard,pattern,p+1)
+ ltarget := #target
+ while q ^= n repeat
+ s := SUBSTRING(pattern,p+1,q-p-1) --[pattern.i for i in (p+1..q-1)]
+ i := stringPosition(s,target,i)
+ if i = ltarget then return (returnFlag := true)
+ i := i + #s
+ p := q
+ q := charPosition($wildCard,pattern,q+1)
+ returnFlag => false
+ if p ^= q-1 then
+ -- pattern does not end with a '&
+ s := SUBSTRING(pattern,p+1,q-p-1) --[pattern.i for i in (p+1..q-1)]
+ if not suffix?(s,target) then return false
+ if null ans then ans := 1 --pattern is a word preceded by a *
+ true
+
+infix?(s,t,x) == #s + #t >= #x and prefix?(s,x) and suffix?(t,x)
+
+prefix?(s,t) == substring?(s,t,0)
+
+suffix?(s,t) ==
+ m := #s; n := #t
+ if m > n then return false
+ substring?(s,t,(n-m))
+
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}