Hello there,
I work as a Delphi developer but I decided I would learn Lisp at home after
it was mentioned on my scrabble site. After a few false starts I ended up
with CLISP and GNU Emacs. I love the parenthesis matching in the latter!
We could do with something like that in Delphi, to match begins and ends.
I also got "ANSI Common Lisp" by Paul Graham, and I am finding it very
helpful. I was totally gobsmacked and impressed by the ray tracing example!
I have one question: how do I print a string at given coordinates on the
screen? I am using CLISP 2.33.1 in full screen mode on a Windows XP
machine.
--
Thanks,
Martin
Martin Houlton wrote:
> I have one question: how do I print a string at given coordinates on the
> screen? I am using CLISP 2.33.1 in full screen mode on a Windows XP
> machine.
>
> --
> Thanks,
> Martin
>
>
I don't know if this will work on Windows--it relies on the 'curses'
facility on Unix, but CLISP has a package called SCREEN that supports
curses:
(defun print-at (ws x y msg)
(screen:set-window-cursor-position ws y x)
(format t "~A" msg) )
(let ((w (screen:make-window)))
(print-at w 10 20 "Hello, world!")
(print-at w 20 30 "Over here..."))
(sleep 5) ; This is just to delay return of control to shell.
Hi David
Thanks very much for your reply, but no, it doesn't seem to work in Windows.
The screen:make-window command just turns the main CLISP display blue, no
text, nothing, and I have to close it. However, the
screen:set-window-cursor-position function is in the Windows version of
CLISP, I have done a describe. I would assume the developers had some
purpose in putting it there. That's interesting.
--
Regards,
Martin
"David Sletten" <·····@slytobias.com> wrote in message
··························@twister.socal.rr.com...
> Martin Houlton wrote:
>
>
> > I have one question: how do I print a string at given coordinates on the
> > screen? I am using CLISP 2.33.1 in full screen mode on a Windows XP
> > machine.
> >
> > --
> > Thanks,
> > Martin
> >
> >
> I don't know if this will work on Windows--it relies on the 'curses'
> facility on Unix, but CLISP has a package called SCREEN that supports
> curses:
> (defun print-at (ws x y msg)
> (screen:set-window-cursor-position ws y x)
> (format t "~A" msg) )
>
> (let ((w (screen:make-window)))
> (print-at w 10 20 "Hello, world!")
> (print-at w 20 30 "Over here..."))
>
> (sleep 5) ; This is just to delay return of control to shell.
"Martin Houlton" <·······@tenfoot.karoo.co.uk> writes:
> it doesn't seem to work in Windows.
It works here on Windows XP, albeit running CLISP within Cygwin.
--
Steven E. Harris
Dear Steven
> It works here on Windows XP, albeit running CLISP within Cygwin.
Thanks for the info. I understand Cygwin is a Linux emulator within
Windows. I never could get on with Linux so I suppose I'll have to be
content with sequential output for now.
Regards,
Martin
"Martin Houlton" <·······@tenfoot.karoo.co.uk> writes:
> I understand Cygwin is a Linux emulator within Windows. I never
> could get on with Linux so I suppose I'll have to be content with
> sequential output for now.
The user experience running CLISP on Windows within Cygwin is no
different from running CLISP on Windows without Cygwin. In both cases,
CLISP is a console-based program. For the Cygwin-augmented version,
you can run CLISP from within a different command shell than the
typical Windows cmd (say, bash), but you don't need to face up to a
would-be Linux takeover.
--
Steven E. Harris
Martin Houlton wrote:
> I also got "ANSI Common Lisp" by Paul Graham, and I am finding it very
> helpful. I was totally gobsmacked and impressed by the ray tracing example!
You might also like the enhanced version of Graham's ray tracing code at
http://dynamiclearningcenter.com/samples/ray-tracing/index.html
which is actually part of the Franz Inc web site. I wrote this as a
pedagiogic example on the assumption it is easier to learn a new language
by modifying existing code rather than writing yet another hello world
from scratch. There are some improvements to Grahham's code and several
suggestions for further experiments. The code runs in a web server (which
is an interesting pedagogic extension in itself) and you can run it at low
resolution in our server. All you need is a web browser.
Dear Steven
Thanks for the info., I will have a look at that. I too have been trying to
improve on Paul Graham's code, in my case the string substitution example
towards the end of chapter 7 of "ANSI Common Lisp". This is just a simple
thing to read in a text file and write it out again, substituting a new
string for an old string wherever it occurs. Graham uses a ring buffer to
store the characters already matched, but I noticed that it is not necessary
to store these characters, as they are in the old string already. So I
wrote another version as follows:
(defun file-subst (old new file1 file2)
(with-open-file (in file1 :direction :input)
(with-open-file (out file2 :direction :output
:if-exists :supersede)
(stream-subst old new in out))))
(defun stream-subst (old new in out)
(let ((pos 0)
(len (length old)))
(do ((c (read-char in nil :eof)
(read-char in nil :eof)))
((eql c :eof))
(cond ((char= c (char old pos))
(incf pos)
(if (= pos len)
(progn
(princ new out)
(setf pos 0))))
((zerop pos)
(princ c out))
(t
(dotimes (n pos)
(princ (char old n) out))
(princ c out)
(setf pos 0))))
(dotimes (n pos)
(princ (char old n) out))))
The problem is that my version doesn't cope with the situation where, for
example, the input file contains 'ababac' and the search string is 'abac'.
A partial match will fail at the second b, but the fact that a match exists,
beginning at the second a, will be missed because the file pointer has
already passed this. Graham can just pop characters off his buffer to deal
with this, but I will have to get them out of the old string. If I could
put an update expression in the do that would get the characters from the
old string in this situation, I would be laughing, but I don't know how to
do this. I tried putting in an if statement and was told I had to put in a
lambda expression. Can anyone help?
--
Regards,
Martin
"Steven M. Haflich" <·················@alum.mit.edu> wrote in message
·························@newssvr14.news.prodigy.com...
> Martin Houlton wrote:
>
> > I also got "ANSI Common Lisp" by Paul Graham, and I am finding it very
> > helpful. I was totally gobsmacked and impressed by the ray tracing
example!
>
> You might also like the enhanced version of Graham's ray tracing code at
>
> http://dynamiclearningcenter.com/samples/ray-tracing/index.html
>
> which is actually part of the Franz Inc web site. I wrote this as a
> pedagiogic example on the assumption it is easier to learn a new language
> by modifying existing code rather than writing yet another hello world
> from scratch. There are some improvements to Grahham's code and several
> suggestions for further experiments. The code runs in a web server (which
> is an interesting pedagogic extension in itself) and you can run it at low
> resolution in our server. All you need is a web browser.
Martin Houlton wrote:
> Dear Steven
>
> Thanks for the info., I will have a look at that. I too have been
> trying to improve on Paul Graham's code, in my case the string
> substitution example towards the end of chapter 7 of "ANSI Common
> Lisp". This is just a simple thing to read in a text file and write
> it out again, substituting a new string for an old string wherever it
> occurs. Graham uses a ring buffer to store the characters already
> matched, but I noticed that it is not necessary to store these
> characters, as they are in the old string already. So I wrote
> another version as follows:
>
> (defun file-subst (old new file1 file2)
> (with-open-file (in file1 :direction :input)
> (with-open-file (out file2 :direction :output
> :if-exists :supersede)
> (stream-subst old new in out))))
>
> (defun stream-subst (old new in out)
> (let ((pos 0)
> (len (length old)))
> (do ((c (read-char in nil :eof)
> (read-char in nil :eof)))
> ((eql c :eof))
> (cond ((char= c (char old pos))
> (incf pos)
> (if (= pos len)
> (progn
> (princ new out)
> (setf pos 0))))
> ((zerop pos)
> (princ c out))
> (t
> (dotimes (n pos)
> (princ (char old n) out))
> (princ c out)
> (setf pos 0))))
> (dotimes (n pos)
> (princ (char old n) out))))
>
> The problem is that my version doesn't cope with the situation where,
> for example, the input file contains 'ababac' and the search string
> is 'abac'. A partial match will fail at the second b, but the fact
> that a match exists, beginning at the second a, will be missed
> because the file pointer has already passed this.
You can use FILE-POSITION to save the current position in the stream if
you happen to match the first character again, somewhere during your
test. If the test fails, use FILE-POSITION again to reset the position
of the stream. Likewise, you can use UNREAD-CHAR the same way Graham
uses a POP.
--
(surf-to "http://www.retrobyte.org/")
(mail-to (concatenate 'string "massung" ·@" "gmail.com"))
Martin Houlton wrote:
> Can anyone help?
Likewise, I forgot to mention that you could also use READ-LINE and
SUBSEQ to find the match and then CONCATENATE a new string to write out.
--
(surf-to "http://www.retrobyte.org/")
(mail-to (concatenate 'string "massung" ·@" "gmail.com"))
"Martin Houlton" <·······@tenfoot.karoo.co.uk> writes:
> The problem is that my version doesn't cope with the situation where, for
> example, the input file contains 'ababac' and the search string is 'abac'.
> A partial match will fail at the second b, but the fact that a match exists,
> beginning at the second a, will be missed because the file pointer has
> already passed this. Graham can just pop characters off his buffer to deal
> with this, but I will have to get them out of the old string. If I could
> put an update expression in the do that would get the characters from the
> old string in this situation, I would be laughing, but I don't know how to
> do this. I tried putting in an if statement and was told I had to put in a
> lambda expression. Can anyone help?
You may get inspiration from the Fast String Search
algorithm. Reference in the header comment. Sorry for the Modula-2
source and the long lines, it was written a long time ago...
(******************************************************************************
FILE: FastStr.md
LANGUAGE: Modula-2
SYSTEM: None
USER-INTERFACE: None
DESCRIPTION
This module defines a fast string search procedure.
The algorithm is decribed in
Fast String Searching Algorithm
Robert S. Boyer Standford Research Institute
J Strother Moore Xerox Palo Alto Research Center
Communications of ACM Vol.20,Num.10,Oct.1977
AUTHOR
<PJB> Pascal J. Bourguignon
MODIFICATIONS
1990/09/15 <PJB> Creation.
LEGAL
GPL
Copyright Pascal J. Bourguignon 1990 - 1992
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
This program is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public
License along with this program; if not, write to the Free
Software Foundation, Inc., 59 Temple Place, Suite 330,
Boston, MA 02111-1307 USA
******************************************************************************)
DEFINITION MODULE FastStr;
FROM Types IMPORT INT16,INT32,CARD32;
CONST
StringMax= 14000;
PatternMax= 2000;
LARGE= 16200;
VALID= LARGE>StringMax+VAL(CARD32,PatternMax);
(*
This module cannot be used if VALID is FALSE.
*)
TYPE
CStringP= POINTER TO CHAR;
(* in fact, ARRAY [_0_ .. _xxxxMax_ ] OF CHAR *)
Delta1T= ARRAY [0C .. 377C] OF INT32;
Delta2T= ARRAY [0 .. PatternMax+1] OF INT16;
Delta2P= POINTER TO Delta2T;
PROCEDURE ComputeDelta(pat:CStringP;plen:INT16;
VAR delta1:Delta1T;delta2:Delta2P);
(*
Compute the deltas for searching the pattern pat (of length plen).
delta2 must point to a Delta2T array.
The size of delta2^ must be >= plen.
*)
PROCEDURE Search(str:CStringP;slen:INT32;pat:CStringP;plen:INT16;
(*OPT*)VAR delta1:Delta1T;delta2:Delta2P):INT32;
(*
Search the first occurence of the pattern pat in the string str.
Return -1 if not found, or the offset from str where the occurence
is found.
*)
TYPE
WrStrPr= PROCEDURE(ARRAY OF CHAR);
WrCStrPr= PROCEDURE(CStringP);
WrLongPr= PROCEDURE(INT32,CARDINAL);
WrIntPr= PROCEDURE(INT16,CARDINAL);
WrChPr= PROCEDURE(CHAR);
WrLnPr= PROCEDURE();
PROCEDURE TraceSearch(wrstr:WrStrPr;wrcstr:WrCStrPr;wrlong:WrLongPr;
wrint:WrIntPr;wrch:WrChPr;wrln:WrLnPr;
dowrstr:BOOLEAN;
str:CStringP;slen:INT32;pat:CStringP;plen:INT16;
(*OPT*)VAR delta1:Delta1T;delta2:Delta2P):INT32;
(*
Search the first occurence of the pattern pat in the string str.
Return -1 if not found, or the offset from str where the occurence
is found.
*)
END FastStr.
(******************************************************************************
FILE: FastStr.mi
LANGUAGE: Modula-2
SYSTEM: None
USER-INTERFACE: None
DESCRIPTION
This module defines a fast string search procedure.
The algorithm is decribed in
Fast String Searching Algorithm
Robert S. Boyer Standford Research Institute
J Strother Moore Xerox Palo Alto Research Center
Communications of ACM Vol.20,Num.10,Oct.1977
AUTHOR
<PJB> Pascal J. Bourguignon
MODIFICATIONS
1990/09/15 <PJB> Creation.
1991/04/16 <PJB> Some changes for compatibility with both
TML-Modula-2-MPW and Metrowerk-Modula-2-PSE.
LEGAL
GPL
Copyright Pascal J. Bourguignon 1990 - 1992
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version
2 of the License, or (at your option) any later version.
This program is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public
License along with this program; if not, write to the Free
Software Foundation, Inc., 59 Temple Place, Suite 330,
Boston, MA 02111-1307 USA
******************************************************************************)
IMPLEMENTATION MODULE FastStr;
FROM SYSTEM IMPORT ADDRESS;
FROM Types IMPORT INT8,INT16,INT32,CARD8,CARD16,CARD32;
(***********
delta1(for each char in alphabet)
delta1(char):= if char does not occur in pat
then patlen
else patlen-j, where j is the maximum integer such that pat(j)=char
delta2(for each position in pat) is the SUM OF the distance of char we
can slide pat down so as to align the discovered occurence n
string of the last palen-j characters of pat with its rightmost
plausible reoccurence AND the additionnal distance we must
slide the pointer down so as to restart the process at the right
end of pat.
delta2(j):=patlen+1-rpr(j)
rpr(j) is the rightmost plausible reoccurence of a terminal substring of pat
(substring begining from j+1)
Let $ be a char that does not occur in pat and let us say that
if i<1 then pat(i)=$.
Two sequences of char [c1...cn] and [d1...dn] unify iff
for all i from 1 to n either ci=di or ci=$ or di=$.
rpr(j) is defined for j from 1 to patlen to be the greatest k less than or
equal to patlen such that [pat(j+1)...pat(patlen)] and
[pat(k)...pat(k+patlen-j-1)] unify and either k1 or pat(k-1)pat(j)
The algorithm for string numbered from 0 to n-1:
the pattern must have more than 1 character (patlen>=2).
FastSearch(string,pat)
patlen:=Length(pat)
stringlen:=Length(string)
(* i=last position of pat in string *)
i:=patlen-1;
if i>=stringlen then return false end;
(* fast *)
loop
(* for each n in [0..i-patlen],
string[n..n+patlen-1]#pat[0..patlen-1] *)
while i<stringlen do
i:=i+delta0[string[i]];
end;
(* undo *)
if i<large then return false end;
(* I=i-1, for each n in [0..I-patlen],
string[n..n+patlen-1]#pat[0..patlen-1] *)
i:=i-large-1;
j:=patlen-2
(* slow *)
while string(i)=pat(j) do
if j=0 then return i end;
j:=j-1
i:=i-1
end
i:=i+max( delta1[string[i]]-(patlen-1)+j,delta2[j])
end;
delta1(for each char in alphabet)
delta1(char):= if char does not occur in pat
then patlen
else patlen-j-1, where j is the maximum integer such that pat(j)=char
pat b o n j o u r
patlen 7 7 7 7 7 7 7
j 0 1 2 3 4 5 6
j+1 1 2 3 4 5 6 7
patlen-j 7 6 5 4 3 2 1
patlen-j-1 6 5 4 3 2 1 0
delta1 6 2 4 3 2 1 0
^
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
string x y z x y z x y z o x y z n x y z o y z x y z
b o n j o u r
i=patlen-1=6
string[i]=x is not in pat -> inc(i,patlen);i=13
b o n j o u r
string[i]=n is in pat -> inc(i,delta1[n]=4);i=17
b o n j o u r
string[i]=o is in pat -> inc(i,delta1[o]=4);i=2
b o n j o u r
note: delta1[pat[patlen-1]]=0
pat r o n r o u r
delta1 0 2 4 0 2 1 0
^ ^ are not used in the fast loop
delta0(char)=delta1(char)
delta0(pat(patlen))=large>stringlen+patlen
pat b o n j o u r
delta0 6 2 4 3 2 1 99
pat r o n r o u r
delta0 99 2 4 99 2 1 99
^ ^ are not used in the fast loop
delta2(for each position in pat) is the SUM OF the distance of char we can slide
pat down so as to align the discovered occurence in string of the
last palen-j-1 characters of pat with its rightmost plausible
reoccurence AND the additionnal distance we must slide the pointer
down so as to restart the process at the right end of pat.
delta2(j):=patlen-rpr(j)
rpr(j) is the rightmost plausible reoccurence of a terminal substring of pat (substring begining from j+1)
Let $ be a char that does not occur in pat and let us say that if i<0 then pat(i)=$.
Two sequences of char [c1...cn] and [d1...dn] unify iff for all i from 1 to n either ci=di or ci=$ or di=$.
rpr(j) is defined for j from 0 to patlen-1 to be
the greatest k less than or equal to patlen such that
[pat(j+1)...pat(patlen)] and [pat(k)...pat(k+patlen-j-1)] unify
and either k1 or pat(k-1)pat(j)
k:=patlen;
WHILE NOT (Unify(pat,j+1,patlen,k,k+patlen-j-1) AND ((k<=1) OR (pat[k-1]#pat[j]))) DO
DEC(k);
END;
open {home}bib:th:fa
x _ _ _ _ _ _ _ _ _
A A B C B A C B A C
2=10 A A B C B A C B A C
x _ _ _ _ _ _ _ _
A A B C B A C B A C
2=10 A A B C B A C B A C
x _ _ _ _ _ _ _
A A B C B A C B A C
2=10 A A B C B A C B A C
x _ _ _ _ _ _
A A B C B A C B A C
2=10 A A B C B A C B A C
x _ _ _ _ _
A A B C B A C B A C
2=10 A A B C B A C B A C
x _ _ _ _
A A B C B A C B A C
2=3 A A B C B A C B A C
x _ _ _
A A B C B A C B A C
2=10 A A B C B A C B A C
x _ _
A A B C B A C B A C
2=10 A A B C B A C B A C
************)
PROCEDURE Get(str:CStringP;index:INT32):CHAR;
(*
asm -l -o Dev:Null
main
move.l (sp)+,d0
move.l (sp)+,a0
move.b 0(a0,d0.l),(sp)
end
*)
(* CODE 0201FH,0205FH,01EB0H,00800H; *)
VAR
address: ADDRESS;
BEGIN
address:=str; INC(address,index); str:=address;
RETURN(str^);
END Get;
PROCEDURE ComputeDelta1(pat:CStringP;plen:INT16;VAR delta1:Delta1T);
(*
delta1(for each char in alphabet)
delta1(char):= if char does not occur in pat
then patlen
else patlen-j, where j is the maximum integer such that pat(j)=char
delta0(char)=delta1(char)
delta0(pat(patlen))=large>stringlen+patlen
(* delta1(pat(patlen))=1 *)
*)
VAR
c: CHAR;
len: INT32;
count: INT16;
last: INT16;
BEGIN
last:=ORD(MAX(CHAR))-ORD(MIN(CHAR))+1;
len:=VAL(INT32,plen);
FOR c:=MIN(CHAR) TO MAX(CHAR) DO
delta1[c]:=len;
END;
count:=0;
DEC(plen);
WHILE plen>=0 DO
c:=Get(pat,plen);
IF delta1[c]=len THEN
delta1[c]:=len-1-VAL(INT32,plen);
INC(count);
IF count=last THEN
plen:=-1;
END;
END;
DEC(plen);
END;
(* delta1[Get(pat,len-1)] = 0 *)
delta1[Get(pat,len-1)]:=LARGE;
END ComputeDelta1;
PROCEDURE ComputeDelta2(pat:CStringP;plen:INT16;VAR delta2:Delta2T);
(*
rpr(j) is the rightmost plausible reoccurence of a terminal substring of pat (substring begining from j+1)
Let $ be a char that does not occur in pat and let us say that if i<0 then pat(i)=$.
Two sequences of char [c1...cn] and [d1...dn] unify iff for all i from 1 to n either ci=di or ci=$ or di=$.
rpr(j) is defined for j from 0 to patlen-1 to be
the greatest k less than or equal to patlen such that
pat[ j+1 .. patlen-1 ] and pat[ k .. (patlen-1)-(j-1) ] unify
and either k<=1 or pat(k-1)pat(j)
*)
PROCEDURE unifequal(pat:CStringP;i,j:INT16):BOOLEAN;
BEGIN
IF (i<0) OR (j<0) THEN
RETURN(TRUE);
ELSE
RETURN(Get(pat,i)=Get(pat,j));
END;
END unifequal;
PROCEDURE unify(pat:CStringP;l1,h1,l2:INT16):BOOLEAN;
BEGIN
WHILE (l1<=h1) AND unifequal(pat,l1,l2) DO
INC(l1);
INC(l2);
END;
RETURN(l1>h1);
END unify;
PROCEDURE rpr(j:INT16):INT16;
(*
PRE: j IN [0..plen-1]
Definition for pat[1..patlen]:
rpr(j) is defined for j from 0 to patlen-1 to be
the greatest k less than or equal to patlen such that
[pat(j+1)...pat(patlen)] and [pat(k)...pat(k+patlen-j-1)] unify
and either k1 or pat(k-1)pat(j)
*)
VAR
k: INT16;
c: CHAR;
BEGIN
c:=Get(pat,j);
k:=plen;
WHILE NOT (unify(pat,j+1,plen-1,k-1) AND ((k<=1) OR (Get(pat,k-2)#c))) DO
DEC(k);
END;
RETURN(k);
END rpr;
VAR
j: INT16;
BEGIN
FOR j:=0 TO plen-1 DO
delta2[j]:=1+plen-rpr(j);
END;
END ComputeDelta2;
PROCEDURE ComputeDelta(pat:CStringP;plen:INT16;
VAR delta1:Delta1T;delta2:Delta2P);
(*
Compute the deltas for searching the pattern pat (of length plen).
delta2 must point to a Delta2T array.
The size of delta2^ must be >= plen.
*)
BEGIN
ComputeDelta1(pat,plen,delta1);
ComputeDelta2(pat,plen,delta2^);
END ComputeDelta;
PROCEDURE Maximum(a,b:INT32):INT32;
BEGIN
IF a>b THEN
RETURN(a);
ELSE
RETURN(b);
END;
END Maximum;
PROCEDURE TraceSearch(wrstr:WrStrPr;wrcstr:WrCStrPr;wrlong:WrLongPr;wrint:WrIntPr;wrch:WrChPr;wrln:WrLnPr;
dowrstr:BOOLEAN;
str:CStringP;slen:INT32;pat:CStringP;plen:INT16;
(*OPT*)VAR delta1:Delta1T;delta2:Delta2P):INT32;
(*
Search the first occurence of the pattern pat in the string str.
Return -1 if not found, or the offset from str where the occurence
is found.
*)
VAR
i: INT32;
j: INT16;
c: CHAR;
lastchar: CHAR;
col: INT16;
BEGIN
i:=plen-1;
IF i>=slen THEN
RETURN (-1);
END;
lastchar:=Get(pat,i);
wrstr("lastchar=");
wrch(lastchar);
wrln;
LOOP
(* fast *)
wrstr("==> FAST <==");wrln;
REPEAT
IF dowrstr THEN
wrcstr(str);
wrln;
FOR col:=0 TO VAL(INT16,i)-plen DO
wrch(' ');
END;
wrcstr(pat);
wrln;
END;
wrstr(" i= ");wrlong(i,0);
wrstr(" str[i]= ");wrch(Get(str,i));
wrstr(" delta0[str[i]]= ");wrlong(delta1[Get(str,i)],0);
wrln;
INC(i,delta1[Get(str,i)]);
UNTIL i>slen;
wrstr(" i= ");wrlong(i,0);
wrstr(" > slen= ");wrlong(slen,0);
wrln;
(* undo *)
wrstr("==> UNDO <==");wrln;
IF i<LARGE THEN
wrstr(" i= ");wrlong(i,0);
wrstr(" < LARGE= ");wrlong(LARGE,0);
wrln;
wrstr("RETURN -1");
wrln;
RETURN(-1);
END;
DEC(i,LARGE+1);
wrstr(" i= ");wrlong(i,0);
wrln;
j:=plen-2;
wrstr("==> SLOW <==");wrln;
wrstr(" j= ");wrlong(j,0);
wrln;
IF j<0 THEN
wrstr("RETURN i+1");
wrln;
RETURN(i+1);
END;
(* slow *)
wrstr(" i= ");wrlong(i,0);
wrstr(" str[i]= ");wrch(Get(str,i));
wrstr(" j= ");wrlong(j,0);
wrstr(" pat[j]= ");wrch(Get(pat,j));
wrln;
WHILE Get(str,i)=Get(pat,j) DO
IF j<=0 THEN
wrstr("RETURN i");
wrln;
RETURN(i);
END;
DEC(i);
DEC(j);
wrstr(" i= ");wrlong(i,0);
wrstr(" str[i]= ");wrch(Get(str,i));
wrstr(" j= ");wrlong(j,0);
wrstr(" pat[j]= ");wrch(Get(pat,j));
wrln;
END;
c:=Get(str,i);
wrstr("c =");wrch(c);wrln;
wrstr("lastchar=");wrch(lastchar);wrln;
IF c=lastchar THEN
wrstr(" (last) delta1[str[i]]= 0");
INC(i,VAL(INT32,delta2^[j]));
ELSE
wrstr(" delta1[str[i]]= ");wrlong(delta1[Get(str,i)],0);
INC(i,Maximum(delta1[c],delta2^[j]));
END;
wrstr(" delta2[j]= ");wrlong(delta2^[j],0);
wrln;
wrstr(" INC(i,Max(delta1[str[i]],delta2[j]) ");
wrstr(" i= ");wrlong(i,0);
wrln;
END;(*LOOP*)
END TraceSearch;
PROCEDURE Search(str:CStringP;slen:INT32;pat:CStringP;plen:INT16;
(*OPT*)VAR delta1:Delta1T;delta2:Delta2P):INT32;
(*
Search the first occurence of the pattern pat in the string str.
Return -1 if not found, or the offset from str where the occurence
is found.
*)
VAR
i: INT32;
j: INT16;
c: CHAR;
lastchar: CHAR;
BEGIN
i:=plen-1;
IF i>=slen THEN
RETURN (-1);
END;
lastchar:=Get(pat,i);
LOOP
(* fast *)
REPEAT
INC(i,delta1[Get(str,i)]);
UNTIL i>slen;
(* undo *)
IF i<LARGE THEN
RETURN(-1);
END;
DEC(i,LARGE+1);
j:=plen-2;
IF j<0 THEN
RETURN(i+1);
END;
(* slow *)
WHILE Get(str,i)=Get(pat,j) DO
IF j<=0 THEN
RETURN(i);
END;
DEC(i);
DEC(j);
END;
c:=Get(str,i);
IF c=lastchar THEN
INC(i,VAL(INT32,delta2^[j]));
ELSE
INC(i,Maximum(delta1[c],VAL(INT32,delta2^[j])));
END;
END;(*LOOP*)
END Search;
END FastStr.
--
__Pascal Bourguignon__
Dear Jeff and Pascal
Thanks very much for your suggestions. Using them, I have come up with a
version of the function that seems to answer all the problems:
(defun file-subst (old new file1 file2)
(with-open-file (in file1 :direction :input)
(with-open-file (out file2 :direction :output
:if-exists :supersede)
(stream-subst old new in out))))
(defun stream-subst (old new in out)
(let ((pos 0)
(from 0)
(len (length old)))
(do ((c (read-char in nil :eof)
(read-char in nil :eof)))
((eql c :eof))
(cond ((char= c (char old pos))
(incf pos)
(case pos
(1 (setf from 0))
(2 (setf from (file-position in))))
(if (= pos len)
(progn
(princ new out)
(setf pos 0))))
((zerop pos)
(princ c out))
(t
(princ (char old 0) out)
(if (zerop from)
(princ c out)
(progn
(princ (char old 1) out)
(file-position in from)))
(setf pos 0))))
(dotimes (n pos)
(princ (char old n) out))))
If you or anyone else has suggestions to make this better, I would be very
interested.
--
Regards,
Martin
"Pascal Bourguignon" <····@mouse-potato.com> wrote in message
···················@naiad.informatimago.com...
> "Martin Houlton" <·······@tenfoot.karoo.co.uk> writes:
> > The problem is that my version doesn't cope with the situation where,
for
> > example, the input file contains 'ababac' and the search string is
'abac'.
> > A partial match will fail at the second b, but the fact that a match
exists,
> > beginning at the second a, will be missed because the file pointer has
> > already passed this. Graham can just pop characters off his buffer to
deal
> > with this, but I will have to get them out of the old string. If I
could
> > put an update expression in the do that would get the characters from
the
> > old string in this situation, I would be laughing, but I don't know how
to
> > do this. I tried putting in an if statement and was told I had to put
in a
> > lambda expression. Can anyone help?
>
> You may get inspiration from the Fast String Search
> algorithm. Reference in the header comment. Sorry for the Modula-2
> source and the long lines, it was written a long time ago...
>
>
>
(***************************************************************************
***
> FILE: FastStr.md
> LANGUAGE: Modula-2
> SYSTEM: None
> USER-INTERFACE: None
> DESCRIPTION
> This module defines a fast string search procedure.
> The algorithm is decribed in
> Fast String Searching Algorithm
> Robert S. Boyer Standford Research Institute
> J Strother Moore Xerox Palo Alto Research Center
> Communications of ACM Vol.20,Num.10,Oct.1977
> AUTHOR
> <PJB> Pascal J. Bourguignon
> MODIFICATIONS
> 1990/09/15 <PJB> Creation.
> LEGAL
> GPL
>
> Copyright Pascal J. Bourguignon 1990 - 1992
>
> This program is free software; you can redistribute it and/or
> modify it under the terms of the GNU General Public License
> as published by the Free Software Foundation; either version
> 2 of the License, or (at your option) any later version.
>
> This program is distributed in the hope that it will be
> useful, but WITHOUT ANY WARRANTY; without even the implied
> warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
> PURPOSE. See the GNU General Public License for more details.
>
> You should have received a copy of the GNU General Public
> License along with this program; if not, write to the Free
> Software Foundation, Inc., 59 Temple Place, Suite 330,
> Boston, MA 02111-1307 USA
>
****************************************************************************
**)
> DEFINITION MODULE FastStr;
>
> FROM Types IMPORT INT16,INT32,CARD32;
>
> CONST
> StringMax= 14000;
> PatternMax= 2000;
> LARGE= 16200;
> VALID= LARGE>StringMax+VAL(CARD32,PatternMax);
> (*
> This module cannot be used if VALID is FALSE.
> *)
> TYPE
> CStringP= POINTER TO CHAR;
> (* in fact, ARRAY [_0_ .. _xxxxMax_ ] OF CHAR *)
>
> Delta1T= ARRAY [0C .. 377C] OF INT32;
> Delta2T= ARRAY [0 .. PatternMax+1] OF INT16;
> Delta2P= POINTER TO Delta2T;
>
> PROCEDURE ComputeDelta(pat:CStringP;plen:INT16;
> VAR delta1:Delta1T;delta2:Delta2P);
> (*
> Compute the deltas for searching the pattern pat (of length
plen).
> delta2 must point to a Delta2T array.
> The size of delta2^ must be >= plen.
> *)
>
> PROCEDURE Search(str:CStringP;slen:INT32;pat:CStringP;plen:INT16;
> (*OPT*)VAR delta1:Delta1T;delta2:Delta2P):INT32;
> (*
> Search the first occurence of the pattern pat in the string
str.
> Return -1 if not found, or the offset from str where the
occurence
> is found.
> *)
>
> TYPE
> WrStrPr= PROCEDURE(ARRAY OF CHAR);
> WrCStrPr= PROCEDURE(CStringP);
> WrLongPr= PROCEDURE(INT32,CARDINAL);
> WrIntPr= PROCEDURE(INT16,CARDINAL);
> WrChPr= PROCEDURE(CHAR);
> WrLnPr= PROCEDURE();
>
> PROCEDURE TraceSearch(wrstr:WrStrPr;wrcstr:WrCStrPr;wrlong:WrLongPr;
> wrint:WrIntPr;wrch:WrChPr;wrln:WrLnPr;
> dowrstr:BOOLEAN;
> str:CStringP;slen:INT32;pat:CStringP;plen:INT16;
> (*OPT*)VAR delta1:Delta1T;delta2:Delta2P):INT32;
> (*
> Search the first occurence of the pattern pat in the string
str.
> Return -1 if not found, or the offset from str where the
occurence
> is found.
> *)
>
> END FastStr.
>
>
(***************************************************************************
***
> FILE: FastStr.mi
> LANGUAGE: Modula-2
> SYSTEM: None
> USER-INTERFACE: None
> DESCRIPTION
> This module defines a fast string search procedure.
> The algorithm is decribed in
> Fast String Searching Algorithm
> Robert S. Boyer Standford Research Institute
> J Strother Moore Xerox Palo Alto Research Center
> Communications of ACM Vol.20,Num.10,Oct.1977
> AUTHOR
> <PJB> Pascal J. Bourguignon
> MODIFICATIONS
> 1990/09/15 <PJB> Creation.
> 1991/04/16 <PJB> Some changes for compatibility with both
> TML-Modula-2-MPW and Metrowerk-Modula-2-PSE.
> LEGAL
> GPL
>
> Copyright Pascal J. Bourguignon 1990 - 1992
>
> This program is free software; you can redistribute it and/or
> modify it under the terms of the GNU General Public License
> as published by the Free Software Foundation; either version
> 2 of the License, or (at your option) any later version.
>
> This program is distributed in the hope that it will be
> useful, but WITHOUT ANY WARRANTY; without even the implied
> warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
> PURPOSE. See the GNU General Public License for more details.
>
> You should have received a copy of the GNU General Public
> License along with this program; if not, write to the Free
> Software Foundation, Inc., 59 Temple Place, Suite 330,
> Boston, MA 02111-1307 USA
>
****************************************************************************
**)
> IMPLEMENTATION MODULE FastStr;
>
> FROM SYSTEM IMPORT ADDRESS;
> FROM Types IMPORT INT8,INT16,INT32,CARD8,CARD16,CARD32;
> (***********
>
> delta1(for each char in alphabet)
> delta1(char):= if char does not occur in pat
> then patlen
> else patlen-j, where j is the maximum integer such that
pat(j)=char
> delta2(for each position in pat) is the SUM OF the distance of char we
> can slide pat down so as to align the discovered occurence n
> string of the last palen-j characters of pat with its
rightmost
> plausible reoccurence AND the additionnal distance we must
> slide the pointer down so as to restart the process at the
right
> end of pat.
> delta2(j):=patlen+1-rpr(j)
> rpr(j) is the rightmost plausible reoccurence of a terminal substring of
pat
> (substring begining from j+1)
> Let $ be a char that does not occur in pat and let us say that
> if i<1 then pat(i)=$.
> Two sequences of char [c1...cn] and [d1...dn] unify iff
> for all i from 1 to n either ci=di or ci=$ or di=$.
> rpr(j) is defined for j from 1 to patlen to be the greatest k less
than or
> equal to patlen such that [pat(j+1)...pat(patlen)] and
> [pat(k)...pat(k+patlen-j-1)] unify and either k1 or pat(k-1)pat(j)
>
>
>
> The algorithm for string numbered from 0 to n-1:
> the pattern must have more than 1 character (patlen>=2).
>
> FastSearch(string,pat)
> patlen:=Length(pat)
> stringlen:=Length(string)
>
> (* i=last position of pat in string *)
> i:=patlen-1;
> if i>=stringlen then return false end;
>
> (* fast *)
> loop
> (* for each n in [0..i-patlen],
> string[n..n+patlen-1]#pat[0..patlen-1] *)
> while i<stringlen do
> i:=i+delta0[string[i]];
> end;
> (* undo *)
> if i<large then return false end;
> (* I=i-1, for each n in [0..I-patlen],
> string[n..n+patlen-1]#pat[0..patlen-1] *)
>
> i:=i-large-1;
> j:=patlen-2
>
> (* slow *)
> while string(i)=pat(j) do
> if j=0 then return i end;
> j:=j-1
> i:=i-1
> end
>
> i:=i+max( delta1[string[i]]-(patlen-1)+j,delta2[j])
> end;
>
> delta1(for each char in alphabet)
> delta1(char):= if char does not occur in pat
> then patlen
> else patlen-j-1, where j is the maximum integer such that
pat(j)=char
>
> pat b o n j o u r
> patlen 7 7 7 7 7 7 7
> j 0 1 2 3 4 5 6
> j+1 1 2 3 4 5 6 7
> patlen-j 7 6 5 4 3 2 1
> patlen-j-1 6 5 4 3 2 1 0
> delta1 6 2 4 3 2 1 0
> ^
> 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
16 17 18 19 20 21 22
> string x y z x y z x y z o x y z n x y
z o y z x y z
> b o n j o u r
> i=patlen-1=6
> string[i]=x is not in pat -> inc(i,patlen);i=13
> b o n j o u r
> string[i]=n is in pat -> inc(i,delta1[n]=4);i=17
> b o n j o
u r
> string[i]=o is in pat -> inc(i,delta1[o]=4);i=2
> b o n
j o u r
>
> note: delta1[pat[patlen-1]]=0
>
> pat r o n r o u r
> delta1 0 2 4 0 2 1 0
> ^ ^ are not used in the fast loop
>
>
> delta0(char)=delta1(char)
> delta0(pat(patlen))=large>stringlen+patlen
>
> pat b o n j o u r
> delta0 6 2 4 3 2 1 99
> pat r o n r o u r
> delta0 99 2 4 99 2 1 99
> ^ ^ are not used in the fast loop
>
>
> delta2(for each position in pat) is the SUM OF the distance of char we can
slide
> pat down so as to align the discovered occurence in string of the
> last palen-j-1 characters of pat with its rightmost plausible
> reoccurence AND the additionnal distance we must slide the pointer
> down so as to restart the process at the right end of pat.
> delta2(j):=patlen-rpr(j)
>
> rpr(j) is the rightmost plausible reoccurence of a terminal substring
of pat (substring begining from j+1)
> Let $ be a char that does not occur in pat and let us say that if i<0
then pat(i)=$.
> Two sequences of char [c1...cn] and [d1...dn] unify iff for all i from
1 to n either ci=di or ci=$ or di=$.
>
> rpr(j) is defined for j from 0 to patlen-1 to be
> the greatest k less than or equal to patlen such that
> [pat(j+1)...pat(patlen)] and [pat(k)...pat(k+patlen-j-1)] unify
> and either k1 or pat(k-1)pat(j)
>
> k:=patlen;
> WHILE NOT (Unify(pat,j+1,patlen,k,k+patlen-j-1) AND ((k<=1) OR
(pat[k-1]#pat[j]))) DO
> DEC(k);
> END;
> open {home}bib:th:fa
>
> x _ _ _ _ _ _ _ _ _
> A A B C B A C B A C
> 2=10 A A B C B A
C B A C
>
> x _ _ _ _ _ _ _ _
> A A B C B A C B A C
> 2=10 A A B C B A
C B A C
>
> x _ _ _ _ _ _ _
> A A B C B A C B A C
> 2=10 A A B C B A
C B A C
>
> x _ _ _ _ _ _
> A A B C B A C B A C
> 2=10 A A B C B A
C B A C
>
> x _ _ _ _ _
> A A B C B A C B A C
> 2=10 A A B C B A
C B A C
>
> x _ _ _ _
> A A B C B A C B A C
> 2=3 A A B C B A C B A C
>
> x _ _ _
> A A B C B A C B A C
> 2=10 A A B C B A
C B A C
>
> x _ _
> A A B C B A C B A C
> 2=10 A A B C B A
C B A C
>
> ************)
>
>
>
> PROCEDURE Get(str:CStringP;index:INT32):CHAR;
> (*
> asm -l -o Dev:Null
> main
> move.l (sp)+,d0
> move.l (sp)+,a0
> move.b 0(a0,d0.l),(sp)
> end
> *)
> (* CODE 0201FH,0205FH,01EB0H,00800H; *)
> VAR
> address: ADDRESS;
> BEGIN
> address:=str; INC(address,index); str:=address;
> RETURN(str^);
> END Get;
>
> PROCEDURE ComputeDelta1(pat:CStringP;plen:INT16;VAR delta1:Delta1T);
> (*
> delta1(for each char in alphabet)
> delta1(char):= if char does not occur in pat
> then patlen
> else patlen-j, where j is the maximum integer such
that pat(j)=char
>
> delta0(char)=delta1(char)
> delta0(pat(patlen))=large>stringlen+patlen
> (* delta1(pat(patlen))=1 *)
> *)
> VAR
> c: CHAR;
> len: INT32;
> count: INT16;
> last: INT16;
> BEGIN
> last:=ORD(MAX(CHAR))-ORD(MIN(CHAR))+1;
> len:=VAL(INT32,plen);
> FOR c:=MIN(CHAR) TO MAX(CHAR) DO
> delta1[c]:=len;
> END;
> count:=0;
> DEC(plen);
> WHILE plen>=0 DO
> c:=Get(pat,plen);
> IF delta1[c]=len THEN
> delta1[c]:=len-1-VAL(INT32,plen);
> INC(count);
> IF count=last THEN
> plen:=-1;
> END;
> END;
> DEC(plen);
> END;
> (* delta1[Get(pat,len-1)] = 0 *)
> delta1[Get(pat,len-1)]:=LARGE;
> END ComputeDelta1;
>
>
> PROCEDURE ComputeDelta2(pat:CStringP;plen:INT16;VAR delta2:Delta2T);
> (*
> rpr(j) is the rightmost plausible reoccurence of a terminal
substring of pat (substring begining from j+1)
> Let $ be a char that does not occur in pat and let us say that
if i<0 then pat(i)=$.
> Two sequences of char [c1...cn] and [d1...dn] unify iff for
all i from 1 to n either ci=di or ci=$ or di=$.
>
> rpr(j) is defined for j from 0 to patlen-1 to be
> the greatest k less than or equal to patlen such that
> pat[ j+1 .. patlen-1 ] and pat[ k .. (patlen-1)-(j-1) ]
unify
> and either k<=1 or pat(k-1)pat(j)
> *)
>
>
> PROCEDURE unifequal(pat:CStringP;i,j:INT16):BOOLEAN;
> BEGIN
> IF (i<0) OR (j<0) THEN
> RETURN(TRUE);
> ELSE
> RETURN(Get(pat,i)=Get(pat,j));
> END;
> END unifequal;
>
> PROCEDURE unify(pat:CStringP;l1,h1,l2:INT16):BOOLEAN;
> BEGIN
> WHILE (l1<=h1) AND unifequal(pat,l1,l2) DO
> INC(l1);
> INC(l2);
> END;
> RETURN(l1>h1);
> END unify;
>
> PROCEDURE rpr(j:INT16):INT16;
> (*
> PRE: j IN [0..plen-1]
>
> Definition for pat[1..patlen]:
> rpr(j) is defined for j from 0 to patlen-1 to be
> the greatest k less than or equal to patlen such that
> [pat(j+1)...pat(patlen)] and
[pat(k)...pat(k+patlen-j-1)] unify
> and either k1 or pat(k-1)pat(j)
> *)
>
> VAR
> k: INT16;
> c: CHAR;
> BEGIN
> c:=Get(pat,j);
> k:=plen;
> WHILE NOT (unify(pat,j+1,plen-1,k-1) AND ((k<=1) OR
(Get(pat,k-2)#c))) DO
> DEC(k);
> END;
> RETURN(k);
> END rpr;
>
> VAR
> j: INT16;
> BEGIN
> FOR j:=0 TO plen-1 DO
> delta2[j]:=1+plen-rpr(j);
> END;
> END ComputeDelta2;
>
> PROCEDURE ComputeDelta(pat:CStringP;plen:INT16;
> VAR delta1:Delta1T;delta2:Delta2P);
> (*
> Compute the deltas for searching the pattern pat (of length
plen).
> delta2 must point to a Delta2T array.
> The size of delta2^ must be >= plen.
> *)
> BEGIN
> ComputeDelta1(pat,plen,delta1);
> ComputeDelta2(pat,plen,delta2^);
> END ComputeDelta;
>
> PROCEDURE Maximum(a,b:INT32):INT32;
> BEGIN
> IF a>b THEN
> RETURN(a);
> ELSE
> RETURN(b);
> END;
> END Maximum;
>
> PROCEDURE
TraceSearch(wrstr:WrStrPr;wrcstr:WrCStrPr;wrlong:WrLongPr;wrint:WrIntPr;wrch
:WrChPr;wrln:WrLnPr;
> dowrstr:BOOLEAN;
> str:CStringP;slen:INT32;pat:CStringP;plen:INT16;
> (*OPT*)VAR delta1:Delta1T;delta2:Delta2P):INT32;
> (*
> Search the first occurence of the pattern pat in the string
str.
> Return -1 if not found, or the offset from str where the
occurence
> is found.
> *)
> VAR
> i: INT32;
> j: INT16;
> c: CHAR;
> lastchar: CHAR;
> col: INT16;
> BEGIN
> i:=plen-1;
> IF i>=slen THEN
> RETURN (-1);
> END;
> lastchar:=Get(pat,i);
> wrstr("lastchar=");
> wrch(lastchar);
> wrln;
> LOOP
> (* fast *)
> wrstr("==> FAST <==");wrln;
> REPEAT
> IF dowrstr THEN
> wrcstr(str);
> wrln;
> FOR col:=0 TO VAL(INT16,i)-plen DO
> wrch(' ');
> END;
> wrcstr(pat);
> wrln;
> END;
> wrstr(" i= ");wrlong(i,0);
> wrstr(" str[i]= ");wrch(Get(str,i));
> wrstr(" delta0[str[i]]= ");wrlong(delta1[Get(str,i)],0);
> wrln;
> INC(i,delta1[Get(str,i)]);
> UNTIL i>slen;
> wrstr(" i= ");wrlong(i,0);
> wrstr(" > slen= ");wrlong(slen,0);
> wrln;
> (* undo *)
> wrstr("==> UNDO <==");wrln;
> IF i<LARGE THEN
> wrstr(" i= ");wrlong(i,0);
> wrstr(" < LARGE= ");wrlong(LARGE,0);
> wrln;
> wrstr("RETURN -1");
> wrln;
> RETURN(-1);
> END;
> DEC(i,LARGE+1);
> wrstr(" i= ");wrlong(i,0);
> wrln;
> j:=plen-2;
> wrstr("==> SLOW <==");wrln;
> wrstr(" j= ");wrlong(j,0);
> wrln;
> IF j<0 THEN
> wrstr("RETURN i+1");
> wrln;
> RETURN(i+1);
> END;
> (* slow *)
> wrstr(" i= ");wrlong(i,0);
> wrstr(" str[i]= ");wrch(Get(str,i));
> wrstr(" j= ");wrlong(j,0);
> wrstr(" pat[j]= ");wrch(Get(pat,j));
> wrln;
> WHILE Get(str,i)=Get(pat,j) DO
> IF j<=0 THEN
> wrstr("RETURN i");
> wrln;
> RETURN(i);
> END;
> DEC(i);
> DEC(j);
> wrstr(" i= ");wrlong(i,0);
> wrstr(" str[i]= ");wrch(Get(str,i));
> wrstr(" j= ");wrlong(j,0);
> wrstr(" pat[j]= ");wrch(Get(pat,j));
> wrln;
> END;
> c:=Get(str,i);
> wrstr("c =");wrch(c);wrln;
> wrstr("lastchar=");wrch(lastchar);wrln;
> IF c=lastchar THEN
> wrstr(" (last) delta1[str[i]]= 0");
> INC(i,VAL(INT32,delta2^[j]));
> ELSE
> wrstr(" delta1[str[i]]=
");wrlong(delta1[Get(str,i)],0);
> INC(i,Maximum(delta1[c],delta2^[j]));
> END;
> wrstr(" delta2[j]= ");wrlong(delta2^[j],0);
> wrln;
> wrstr(" INC(i,Max(delta1[str[i]],delta2[j]) ");
> wrstr(" i= ");wrlong(i,0);
> wrln;
> END;(*LOOP*)
> END TraceSearch;
>
> PROCEDURE Search(str:CStringP;slen:INT32;pat:CStringP;plen:INT16;
> (*OPT*)VAR delta1:Delta1T;delta2:Delta2P):INT32;
> (*
> Search the first occurence of the pattern pat in the string
str.
> Return -1 if not found, or the offset from str where the
occurence
> is found.
> *)
> VAR
> i: INT32;
> j: INT16;
> c: CHAR;
> lastchar: CHAR;
> BEGIN
> i:=plen-1;
> IF i>=slen THEN
> RETURN (-1);
> END;
> lastchar:=Get(pat,i);
> LOOP
> (* fast *)
> REPEAT
> INC(i,delta1[Get(str,i)]);
> UNTIL i>slen;
> (* undo *)
> IF i<LARGE THEN
> RETURN(-1);
> END;
> DEC(i,LARGE+1);
> j:=plen-2;
> IF j<0 THEN
> RETURN(i+1);
> END;
> (* slow *)
> WHILE Get(str,i)=Get(pat,j) DO
> IF j<=0 THEN
> RETURN(i);
> END;
> DEC(i);
> DEC(j);
> END;
> c:=Get(str,i);
> IF c=lastchar THEN
> INC(i,VAL(INT32,delta2^[j]));
> ELSE
> INC(i,Maximum(delta1[c],VAL(INT32,delta2^[j])));
> END;
> END;(*LOOP*)
> END Search;
>
>
> END FastStr.
>
> --
> __Pascal Bourguignon__