(*
    Title: 	Strings - Implementation
    LastEdit:   "Thu Nov  1 15:55:09 1984"
    Author: 	Mick Jordan/Lee Smith
                Acorn Computers.
*)
IMPLEMENTATION MODULE Strings;
(* $T-, $R- *)  (* T+ switched on as necessary throughout *)

FROM SYSTEM IMPORT ADR, MAXCARD;
FROM SystemTypes IMPORT Comparison;
FROM Exceptions IMPORT RAISEC, ArrayIndexOutOfRange;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM CharCodes IMPORT CapitalCh;

PROCEDURE New(n: CARDINAL): String;
(*  allocate a string of length 'l' terminated with 0C *)
VAR  s: String;
BEGIN
    INC(n);
    ALLOCATE(s,n);
    REPEAT
      DEC(n);
      s^[n]:= 0C;
    UNTIL n=0;
    RETURN s;
END New;

PROCEDURE LengthC(chars: ARRAY OF CHAR): CARDINAL;
(* Return the number of characters in 'chars' *)
VAR len: CARDINAL;
BEGIN
    len:= 0;
    WHILE (len <= HIGH(chars)) AND (chars[len] # 0C) DO INC(len) END;
    RETURN len
END LengthC;

PROCEDURE LengthS(s: String): CARDINAL;
VAR len: CARDINAL;
BEGIN
    len:= 0;
    WHILE s^[len] # 0C DO INC(len) END;
    RETURN len
END LengthS;

PROCEDURE Dispose (VAR s: String);
BEGIN
    DEALLOCATE (s, LengthS(s)+1)
END Dispose;

PROCEDURE CopyXX(from, to: String; hFrom, hTo: CARDINAL);
VAR
    i: CARDINAL;
BEGIN
(*  generic copy procedure, with explicit index check *)
    i := 0;
    WHILE (i <= hFrom) AND (from^[i] # 0C) DO
        IF i > hTo THEN
            RAISEC(ArrayIndexOutOfRange)
        ELSE
            to^[i] := from^[i];
        END (* if *);
        INC(i);
    END (* while *);
    IF i <= hTo THEN
        to^[i] := 0C;
    END (* if *);
END CopyXX;

PROCEDURE CopyCC(from: ARRAY OF CHAR; VAR to: ARRAY OF CHAR);
BEGIN
    CopyXX(String(ADR(from)), String(ADR(to)), HIGH(from), HIGH(to));
END CopyCC;

PROCEDURE CopyCS(from: ARRAY OF CHAR): String;
VAR  to: String;  l: CARDINAL;
BEGIN
    l:= LengthC(from);
    to:= New(l);
    IF l # 0 THEN
        DEC(l)
    END (* if *);
    CopyXX(String(ADR(from)), to, l, l);
    RETURN to;
END CopyCS;

PROCEDURE CopySC(from: String;  VAR to: ARRAY OF CHAR);
BEGIN
    CopyXX(from, String(ADR(to)), MAXCARD, HIGH(to));
END CopySC;

PROCEDURE CopySS(from: String): String;
VAR  l: CARDINAL;  to: String;
BEGIN
    l:= LengthS(from);
    to:= New(l);
    IF l # 0 THEN
        DEC(l);
    END (* if *);
    CopyXX(from, to, l, l);
    RETURN to;
END CopySS;

PROCEDURE ConcatXX(head, tail: String; hHead, hTail: CARDINAL): String;
VAR  lHead, lTail, lTo: CARDINAL;  i: CARDINAL;  to: String;
BEGIN
(*  generic procedures for ConcatSS, ConcatCS, ConcatSC *)
(*  cannot use LengthS, since original C array may not be null terminated *)
    lHead := 0; lTail := 0;
    WHILE (lHead <= hHead) AND (head^[lHead] # 0C) DO
        INC(lHead)
    END (* while *);
    WHILE (lTail <= hTail) AND (tail^[lTail] # 0C) DO
        INC(lTail)
    END (* while *);
    
    lTo := lHead + lTail;
    to:= New(lTo);
    i:= 0;
    WHILE i < lHead DO to^[i]:= head^[i];      INC(i) END;
    WHILE i < lTo DO to^[i]:= tail^[i-lHead];  INC(i) END;
    RETURN to;
END ConcatXX;

PROCEDURE ConcatSS(head, tail: String): String;
BEGIN
    RETURN ConcatXX(head, tail, MAXCARD, MAXCARD);
END ConcatSS;

PROCEDURE ConcatCS(head: ARRAY OF CHAR;  tail: String): String;
BEGIN
    RETURN ConcatXX(String(ADR(head)), tail, HIGH(head), MAXCARD);
END ConcatCS;

PROCEDURE ConcatSC(head: String; tail: ARRAY OF CHAR): (* to *) String;
BEGIN
    RETURN ConcatXX(head, String(ADR(tail)), MAXCARD, HIGH(tail));
END ConcatSC;

PROCEDURE ConcatCC(head, tail: ARRAY OF CHAR; VAR to: ARRAY OF CHAR);
VAR i, j, highTail: CARDINAL;
    tailCopy: String;
BEGIN
(*  care needed, since to=head or to=tail is ok but compiler
    might optimise to call by reference
*)
    IF ADR(tail) = ADR(to) THEN   (* same array (call by reference) *)
        tailCopy := CopyCS(tail); highTail := MAXCARD;
    ELSE
        tailCopy := String(ADR(tail)); highTail := HIGH(tail)
    END (* if *);
    IF ADR(head) # ADR(to) THEN
        CopyCC(head, to);
    END (* if *);

    i := 0; j := LengthC(head);
    WHILE (i <= highTail) AND (tailCopy^[i] # 0C) DO
        IF (i+j) > HIGH(to) THEN
            RAISEC(ArrayIndexOutOfRange);
        ELSE
            to[i+j] := tailCopy^[i];
        END (* if *);
        INC(i);
    END (* while *);
    IF i+j <= HIGH(to) THEN
        to[i+j] := 0C;
    END (* if *);
    
    IF ADR(tail) = ADR(to) THEN
      Dispose(tailCopy);
    END;
END ConcatCC;

(* *** comparison and equality primitives *** *)

PROCEDURE EqualCC(l, r: ARRAY OF CHAR): BOOLEAN;
VAR  i: CARDINAL;
BEGIN
    i:= 0;
    WHILE (i <= HIGH(l)) AND (i <= HIGH(r)) DO
        IF l[i] # r[i] THEN
            RETURN FALSE;
        ELSIF l[i] = 0C THEN
            RETURN TRUE; (* cos r[i] = 0C by above equality *)
        ELSE
            INC(i);
        END (* if *);
    END (* while *);
    (* fallen off the end of one, equal so far *)
    IF i > HIGH(l) THEN
        RETURN (i > HIGH(r)) OR (r[i] = 0C);
    ELSE
        RETURN (i > HIGH(l)) OR (l[i] = 0C);
    END (* if *);
END EqualCC;

PROCEDURE EqualSS(l, r: String): BOOLEAN;
VAR
    i: CARDINAL;
BEGIN
    i := 0;
    LOOP
        IF l^[i] # r^[i] THEN
            RETURN FALSE;
        ELSIF l^[i] = 0C THEN
            RETURN TRUE (* cos r^[i] = 0C by above equality *)
        ELSE
            INC(i);
        END (* if *);
    END (* loop *);
END EqualSS;

PROCEDURE EqualCS(chars: ARRAY OF CHAR; s: String): BOOLEAN;
VAR
    i: CARDINAL;
BEGIN
    i := 0;
    LOOP
        IF (i > HIGH(chars)) THEN
            RETURN s^[i] = 0C;
        ELSIF chars[i] # s^[i] THEN
            RETURN FALSE;
        ELSIF s^[i] = 0C THEN
            RETURN chars[i] = 0C;
        ELSE
            INC(i);
        END (* if *);
    END (* loop *);
END EqualCS;

PROCEDURE CompareXX(l, r: String; hl, hr: CARDINAL;
                    c: CaseMode): Comparison;
(* Compare two strings *)
VAR  i: CARDINAL;  c1, c2: CHAR;
BEGIN
    i:= 0;
    WHILE (i <= hl) AND (i <= hr) DO
        c1:= l^[i];  c2:= r^[i];
        IF (c1 = 0C) AND (c2 = 0C) THEN RETURN EQ END;
        IF c = IgnoreCase THEN
            c1 := CapitalCh(c1); c2 := CapitalCh(c2);
        END (* if *);
        IF c1 = c2 THEN 
            INC(i)
        ELSE
            IF c1 < c2 THEN RETURN LT ELSE RETURN GT END;
        END;
    END (* while *);
    (* fallen off the end of one, equal so far *)
    IF hl = hr THEN
        RETURN EQ
    ELSIF i > hl THEN
        IF (i > hr) OR (r^[i] = 0C) THEN
            RETURN EQ
        ELSE
            RETURN LT
        END (* if *);
    ELSE
        IF (i > hl) OR (l^[i] = 0C) THEN
            RETURN EQ
        ELSE
            RETURN GT
        END (* if *);
    END (* if *);
END CompareXX;

PROCEDURE CompareCC(l, r: ARRAY OF CHAR; c: CaseMode): Comparison;
BEGIN
    RETURN CompareXX(String(ADR(l)), String(ADR(r)), HIGH(l), HIGH(r), c);
END CompareCC;

PROCEDURE CompareSS(l, r: String; c: CaseMode): Comparison;
BEGIN
    RETURN CompareXX(l, r, MAXCARD, MAXCARD, c);
END CompareSS;

PROCEDURE CompareCS(l: ARRAY OF CHAR;  r: String; c: CaseMode): Comparison;
BEGIN
    RETURN CompareXX(String(ADR(l)), r, HIGH(l), MAXCARD, c);
END CompareCS;

PROCEDURE FindC(s: ARRAY OF CHAR; ch: CHAR; VAR index: CARDINAL): BOOLEAN;
BEGIN
    WHILE (index <= HIGH(s)) AND (s[index] # 0C) DO
        IF s[index] = ch THEN RETURN TRUE ELSE INC(index) END;
    END;
    (* Assert: index > HIGH(s) OR s[index] = 0C *)
    RETURN FALSE;
END FindC;

PROCEDURE FindS(s: String;  ch: CHAR;  VAR index: CARDINAL): BOOLEAN;
BEGIN
    WHILE (s^[index] # 0C) DO
        IF s^[index] = ch THEN RETURN TRUE ELSE INC(index) END;
    END;
    (* Assert: s[index] = 0C *)
    RETURN FALSE;
END FindS;

PROCEDURE ExtractCC(from: ARRAY OF CHAR;  lwb, upb: CARDINAL;
                    VAR to: ARRAY OF CHAR);
    (* *** includes from[lwb];  excludes from[upb] *** *)
VAR j: CARDINAL;
BEGIN
    j:=0;
    WHILE (lwb < upb) DO
    (* $T+ *)
        to[j]:= from[lwb];  INC(j);  INC(lwb);
    (* $T= *)
    END (* while *);
    IF j <= HIGH(to) THEN
        to[j]:= 0C;
    END (* if *);
END ExtractCC;

PROCEDURE ExtractSS(from: String;  lwb, upb: CARDINAL): String;
VAR j: CARDINAL;
    to: String;
BEGIN
    j:=0;
    IF lwb < upb THEN
        to := New(upb-lwb);
    ELSE
        to := New(0);
    END (* if *);
    WHILE (lwb < upb) DO
        to^[j]:= from^[lwb];  INC(j);  INC(lwb);
    END (* while *);
    RETURN to;
END ExtractSS;

PROCEDURE ExtractSC(from: String;  lwb, upb: CARDINAL;
                    VAR to: ARRAY OF CHAR);
    (* *** includes from^[lwb];  excludes from[upb] *** *)
VAR j: CARDINAL;
BEGIN
    j:=0;
    WHILE (lwb < upb) DO
    (* $T+ *)
        to[j]:= from^[lwb];  INC(j);  INC(lwb);
    (* $T= *)
    END (* while *);
    IF j <= HIGH(to) THEN
        to[j]:= 0C;
    END (* if *);
END ExtractSC;    

END Strings.