Mac-Source 1994 July/Mac-Source_July_1994.iso/Modula/Source/StringLib0/StringLib0.MOD

Modula Implementation | 1988-01-24 | 5.2 KB | 205 lines | [TEXT/????]

IMPLEMENTATION MODULE StringLib0;
(* F. Paquet 17-Apr-86 / C. Pfister 9-Apr-86 *)


CONST NUL = 0C; FirstDigit = '0';


  PROCEDURE Length(s: ARRAY OF CHAR): INTEGER;
  VAR cnt, max: INTEGER;
  BEGIN
    cnt:= 0; max:= HIGH(s);
    LOOP
      IF (cnt > max) OR (s[cnt] = NUL) THEN RETURN cnt END;
      INC(cnt)
    END (* LOOP *)
  END Length;


  PROCEDURE Equal(s1, s2: ARRAY OF CHAR): BOOLEAN;
(*  VAR i, h1, h2: INTEGER;*)
  BEGIN
 (*    h1:= HIGH(s1); h2:= HIGH(s2); i:= 0;
     LOOP
       IF (i > h1) OR (s1[i] = NUL) THEN EXIT END;
       IF (i > h2) OR (s2[i] = NUL) THEN EXIT END;
       IF s1[i] <> s2[i] THEN RETURN (FALSE) END;
       INC(i);
     END; *)
     (* now the strings are equal up to here, i *)
(*     IF (i > h1) OR (s1[i] = NUL) THEN *)(* s1 possibly shorter, and s2 possibly longer *)
(*       LOOP
         IF (i > h2) OR (s2[i] = NUL) THEN EXIT END;
         IF s2[i] <> ' ' THEN RETURN FALSE END;
         INC(i)
       END
     ELSE    *)                      (* s2 is shorter, s1 is longer *)
 (*      LOOP
         IF (i > h1) OR (s1[i] = NUL) THEN EXIT END;
         IF s1[i] <> ' ' THEN RETURN FALSE END;
         INC(i)
       END
     END;
     RETURN(TRUE); *)   (* s1 = s2 *)
     RETURN Compare(s1, s2 ) = EqualTo;
  END Equal;

  PROCEDURE Compare(s1, s2: ARRAY OF CHAR): Result;
  (* Added, jnp *)
  VAR i, h1, h2: INTEGER;
  BEGIN
     h1:= HIGH(s1); h2:= HIGH(s2); i:= 0;
     LOOP
       IF (i > h1) OR (s1[i] = NUL) THEN EXIT END;
       IF (i > h2) OR (s2[i] = NUL) THEN EXIT END;
       IF s1[i] < s2[i] THEN
         RETURN LessThan
       ELSIF s1[i] > s2[i] THEN
         RETURN GreaterThan
       END;
       INC(i);
     END; (* LOOP *)
     (* now the strings are equal up to here, i *)
     IF (i > h1) OR (s1[i] = NUL) THEN
       (* s1 possibly shorter, and s2 possibly longer *)
       LOOP
         IF (i > h2) OR (s2[i] = NUL) THEN EXIT END;
         IF s2[i] <> ' ' THEN RETURN LessThan END;
         INC(i)
       END (* LOOP *)
     ELSE
       (* s2 is shorter, s1 is longer *)
       LOOP
         IF (i > h1) OR (s1[i] = NUL) THEN EXIT END;
         IF s1[i] <> ' ' THEN RETURN GreaterThan END;
         INC(i)
       END (* LOOP *)
     END; (* IF *)
     RETURN EqualTo;    (* s1 = s2 *)
  END Compare;

  PROCEDURE Occurs(s, p: ARRAY OF CHAR): BOOLEAN;
  VAR sl, pl, i, k: INTEGER;

    PROCEDURE Same(): BOOLEAN;
    BEGIN
      FOR k := 0 TO pl - 1 DO
        IF s[k+i] # p[k] THEN RETURN FALSE END
      END; (* FOR *)
      RETURN TRUE
    END Same;

  BEGIN
    sl:= Length(s);
    pl:= Length(p);
    IF sl >= pl THEN
      FOR i := 0 TO sl - pl DO
        IF Same() THEN RETURN TRUE END
      END (* FOR *)
    END; (* IF *)
    RETURN FALSE
  END Occurs;


  PROCEDURE Copy(from: ARRAY OF CHAR; VAR to: ARRAY OF CHAR);
  VAR i: INTEGER;
  BEGIN
    i := 0;
    LOOP
       IF i > HIGH(to) THEN EXIT END;
       IF (i > HIGH(from)) OR (from[i] = NUL) THEN
      to[i] := NUL;
      EXIT
       END; (* IF *)
       to[i] := from[i];
       INC (i)
    END (* LOOP *)
  END Copy;

  PROCEDURE Concat(VAR dest: ARRAY OF CHAR;
                       pat:  ARRAY OF CHAR);
  VAR i, j: INTEGER;
  BEGIN
    i := 0;
    WHILE (i <= HIGH(dest)) & (dest[i] # NUL) DO INC(i) END;
    j := 0;
    LOOP
      IF (i > HIGH(dest)) OR (j > HIGH(pat)) OR (pat[j] = NUL) THEN EXIT END;
      dest[i] := pat[j]; INC(i); INC(j)
    END; (* LOOP *)
    IF i <= HIGH(dest) THEN dest[i] := NUL END
  END Concat;


  PROCEDURE Min(x, y: INTEGER): INTEGER;
  BEGIN
    IF x > y THEN RETURN y ELSE RETURN x END
  END Min;


   (* GeneralCopyString *)

  PROCEDURE GCS(VAR ts: ARRAY OF CHAR;   (* destination string         *)
                    tp: INTEGER;         (* start position destination *)
                    fs: ARRAY OF CHAR;   (* source string              *)
                    fp,                  (* start position source      *)
                    l:  INTEGER);        (* length                     *)
  VAR max: INTEGER;
  BEGIN
    IF ((fp + l) > HIGH(fs) + 1) OR ((tp + l) > HIGH(ts) + 1) THEN
      HALT    (* Error ('GeneralCopyString', 'array bounds error') *)
    END; (* IF *)
    max:= fp + l;
    LOOP
      IF fp >= max THEN EXIT END;
      ts[tp] := fs[fp]; INC(tp); INC(fp)
    END (* LOOP *)
  END GCS;


  PROCEDURE Insert(VAR bs:  ARRAY OF CHAR;
                       pat: ARRAY OF CHAR;
                       i:   INTEGER);
  VAR ol, nl, rl, ssl: INTEGER;
  BEGIN
    ol := Length(bs);
    IF ol >= i THEN
      ssl := Min(Length(pat), HIGH(bs) + 1 - i);
      IF ssl > 0 THEN
        rl := Min(ol, HIGH(bs) + 1 - ssl) - i;
        IF rl > 0 THEN
          GCS(bs,i+ssl,bs,i,rl)
        END; (* IF *)
        GCS(bs,i,pat,0,ssl)
      END; (* IF *)
      nl:= i + ssl + rl;
      IF nl <= HIGH(bs) THEN
        bs[nl]:= NUL
      END (* IF *)
    END (* IF *)
  END Insert;


  PROCEDURE Delete(VAR bs: ARRAY OF CHAR;
                       fp,
                       l:  INTEGER);
  VAR ol, nl, rl: INTEGER;
  BEGIN
    ol := Length(bs);
    IF ol > fp THEN
      rl := ol - fp;
      IF rl > l THEN
        GCS(bs,fp,bs,fp + l,rl - l);
        nl := ol - l;
      ELSE
        nl := fp;
      END; (* IF *)
      IF nl <= HIGH (bs) THEN
        bs[nl] := NUL
      END (* IF *)
    END (* IF *)
  END Delete;


END StringLib0.