Artifact 0b8ca6fee725c4596edca4044781699af94d02560da34582b1c2896b254e8c08:

• File psl-1983/3-1/util/sm.red — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 1011) [annotate] [blame] [check-ins using] [more...]

• File psl-1983/util/sm.red — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 1011) [annotate] [blame] [check-ins using]

% SM.RED - String match to replace find
% M.L.G

procedure sm(p,s);
  Sm1(p,0,size(p),s,0,size(s));

procedure sm1(p,p1,p2,s,s1,s2);
 Begin scalar c;
  L1: % test Range
    if p1>p2 then
        return (if s1>s2 then T else NIL)
      else if s1>s2 then return NIL;

      % test if % something
     if (c:=p[p1]) eq char !% then goto L3;

  L2: % exact match
     if c eq s[s1] then <<p1:=p1+1;
                            s1:=s1+1;
                            goto L1>>;
      return NIL;

  L3: % special cases
      p1:=p1+1;
      if p1>p2 then return stderror "pattern ran out in % case of sm";
      c:=p[p1];
      if c eq char !% then goto L2;
      if c eq char !? then <<p1:=p1+1;
                             s1:=s1+1;
                             goto L1>>;

      if c eq char !* then  % 0 or more vs 1 or more
       return <<while not(c:=sm1(p,p1+1,p2,s,s1,s2)) and s1<=s2
                  do s1:=s1+1;
                c>>;
      Return Stderror Bldmsg(" %% %r not known in sm",int2id c);
 end;