(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Tue Jun 16 10:12:27 PDT 1992 by muller                   *)
(*      modified on Tue Mar 17  0:49:33 PST 1992 by meehan                   *)
(*      modified on Thu Sep 14 12:17:30 1989 by ellis                        *)
(*      modified on Thu Jul 14 16:19:52 PDT 1988 by mhb                      *)

GENERIC MODULE GenList (Elt);

IMPORT Range, Thread;

PROCEDURE New (first: Elt.T; tail: T): T RAISES {} =
  BEGIN
    RETURN NEW(T, first := first, tail := tail)
  END New;

PROCEDURE Push (VAR (* out *) l: T; x: Elt.T) RAISES {} =
  BEGIN
    l := New(x, l)
  END Push;

PROCEDURE Pop (VAR (* out *) l: T): Elt.T RAISES {} =
  BEGIN
    WITH x = l.first DO l := l.tail; RETURN x END
  END Pop;

PROCEDURE Length (l: T): CARDINAL RAISES {} =
  VAR i: CARDINAL := 0;
  BEGIN
    WHILE l # NIL DO INC(i); l := l.tail END;
    RETURN i
  END Length;

PROCEDURE First (l: T): Elt.T RAISES {} =
  BEGIN
    RETURN l.first
  END First;

PROCEDURE Second (l: T): Elt.T RAISES {} =
  BEGIN
    RETURN l.tail.first
  END Second;

PROCEDURE Third (l: T): Elt.T RAISES {} =
  BEGIN
    RETURN l.tail.tail.first
  END Third;

PROCEDURE Tail (l: T): T RAISES {} =
  BEGIN
    RETURN l.tail
  END Tail;

PROCEDURE NthTail (l: T; n: CARDINAL): T RAISES {} =
  BEGIN
    WHILE n > 0 DO l := l.tail; DEC(n) END;
    RETURN l
  END NthTail;

PROCEDURE SetNthTail (l: T; n: [1 .. LAST(CARDINAL)]; x: T) RAISES {} =
  BEGIN
    WHILE n > 1 DO DEC(n); l := l.tail END;
    l.tail := x
  END SetNthTail;

PROCEDURE Nth (l: T; n: CARDINAL): Elt.T RAISES {} =
  BEGIN
    WHILE n > 0 DO l := l.tail; DEC(n) END;
    RETURN l.first
  END Nth;

PROCEDURE SetNth (l: T; n: CARDINAL; x: Elt.T) RAISES {} =
  BEGIN
    WHILE n > 0 DO l := l.tail; DEC(n) END;
    l.first := x
  END SetNth;

PROCEDURE Last (l: T): Elt.T RAISES {} =
  BEGIN
    WHILE l.tail # NIL DO l := l.tail END;
    RETURN l.first
  END Last;

PROCEDURE LastTail (l: T): T RAISES {} =
  BEGIN
    WHILE l.tail # NIL DO l := l.tail END;
    RETURN l
  END LastTail;

PROCEDURE FirstN (l: T; n: CARDINAL): T RAISES {} =
  VAR
    i:                 CARDINAL := 2;
    result, resultEnd: T;
  BEGIN
    IF n = 0 THEN RETURN NIL END;
    resultEnd := NEW(T, first := l.first);
    result := resultEnd;
    l := l.tail;
    LOOP
      IF i > n THEN EXIT END;
      resultEnd.tail := NEW(T, first := l.first);
      resultEnd := resultEnd.tail;
      l := l.tail;
      INC(i)
    END;
    RETURN result
  END FirstN;

PROCEDURE List3 (x1, x2, x3: Elt.T): T RAISES {} =
  BEGIN
    RETURN (NEW(T, first := x1,
                tail := NEW(T, first := x2,
                            tail := NEW(T, first := x3, tail := NIL))))
  END List3;

PROCEDURE List2 (x1, x2: Elt.T): T RAISES {} =
  BEGIN
    RETURN (NEW(T, first := x1, tail := NEW(T, first := x2, tail := NIL)))
  END List2;

PROCEDURE List1 (x1: Elt.T): T RAISES {} =
  BEGIN
    RETURN (NEW(T, first := x1, tail := NIL))
  END List1;

PROCEDURE Append (l1: T; l2: T): T RAISES {} =
  VAR last, rest, result: T;
  BEGIN
    IF l1 = NIL THEN RETURN l2 END;
    IF l2 = NIL THEN RETURN l1 END;
    result := New(l1.first, NIL);
    last := result;
    rest := l1.tail;
    WHILE rest # NIL DO
      last.tail := New(rest.first, NIL);
      last := last.tail;
      rest := rest.tail
    END;
    last.tail := l2;
    RETURN result
  END Append;

PROCEDURE AppendD (l1: T; l2: T): T RAISES {} =
  VAR last: T;
  BEGIN
    IF l1 = NIL THEN RETURN l2 END;
    IF l2 = NIL THEN RETURN l1 END;
    last := l1;
    WHILE last.tail # NIL DO last := last.tail END;
    last.tail := l2;
    RETURN l1
  END AppendD;

PROCEDURE Append1 (l1: T; x: Elt.T): T RAISES {} =
  BEGIN
    RETURN Append(l1, New(x, NIL))
  END Append1;

PROCEDURE Append1D (l1: T; x: Elt.T): T RAISES {} =
  BEGIN
    RETURN AppendD(l1, New(x, NIL))
  END Append1D;

PROCEDURE Copy (l: T): T RAISES {} =
  VAR last, result: T;
  BEGIN
    IF l = NIL THEN RETURN NIL END;
    result := New(l.first, NIL);
    last := result;
    l := l.tail;
    WHILE l # NIL DO
      last.tail := New(l.first, NIL);
      last := last.tail;
      l := l.tail;
    END;
    RETURN result;
  END Copy;
    
PROCEDURE Reverse (l: T): T RAISES {} =
  VAR result: T := NIL;
  BEGIN
    WHILE l # NIL DO
      result := New(l.first, result);
      l := l.tail
    END;
    RETURN result
  END Reverse;

PROCEDURE ReverseD (l: T): T RAISES {} =
  VAR current, next, nextTail: T;
  BEGIN
    IF l = NIL THEN RETURN NIL END;
    current := l;
    next := l.tail;
    current.tail := NIL;
    WHILE next # NIL DO
      nextTail := next.tail;
      next.tail := current;
      current := next;
      next := nextTail
    END;
    RETURN current
  END ReverseD;

PROCEDURE Map (l: T; p: MapProc): T (* RAISES ANY *) =
  VAR result: T := NIL;
  BEGIN
    WHILE l # NIL DO result := New(p(l.first), result); l := l.tail END;
    RETURN ReverseD(result)
  END Map;

PROCEDURE Walk (l: T; p: WalkProc) (* RAISES ANY *) =
  BEGIN
    WHILE l # NIL DO p(l.first); l := l.tail END
  END Walk;

PROCEDURE Sort (l: T; c: CompareProc): T RAISES {Thread.Alerted} =
  BEGIN
    RETURN SortD(Copy(l), c)
  END Sort;

PROCEDURE SortD (l: T; c: CompareProc): T RAISES {Thread.Alerted} =
  VAR
    l1, l2, lm, lmHead: T;
    i, iHigh:           CARDINAL;
    a:                  ARRAY [0 .. 27] OF T;
  (* a[i] is a sorted list of length 0 or 2^(i+1). Hence when a fills up,
     there are 2^(HIGH(a)+2)-1 list cells allocated, at least 8 bytes
     each. *)
  BEGIN
    iHigh := 0;
    lmHead := NEW(T);

    (* dismantle l, filling a *)
    LOOP
      (* merge two length-one lists into l1 *)
      l1 := l;
      IF l1 = NIL THEN EXIT END;
      l2 := l1.tail;
      IF l2 = NIL THEN EXIT END;
      l := l2.tail;
      IF c(l1.first, l2.first) = -1 THEN
        l1.tail := l2;
        l2.tail := NIL
      ELSE
        l2.tail := l1;
        l1.tail := NIL;
        l1 := l2
      END;

      (* l1 is a sorted length-two list; merge into a *)
      i := 0;
      LOOP
        l2 := a[i];
        IF l2 = NIL THEN
          a[i] := l1;
          EXIT
        ELSE
          (* merge equal-length sorted lists l1 and l2 *)
          a[i] := NIL;
          lm := lmHead;
          LOOP
            (* ASSERT l1 # NIL, l2 # NIL *)
            IF c(l1.first, l2.first) = -1 THEN
              lm.tail := l1;
              lm := l1;
              l1 := l1.tail;
              IF l1 = NIL THEN lm.tail := l2; EXIT END
            ELSE
              lm.tail := l2;
              lm := l2;
              l2 := l2.tail;
              IF l2 = NIL THEN lm.tail := l1; EXIT END
            END
          END (* LOOP*);
          l1 := lmHead.tail;
          INC(i);
          IF i > iHigh THEN iHigh := i END
        END                     (* LOOP*)
      END
    END (* LOOP*);

    (* l1 is a list of length 0 or 1; merge l1 and a[0..iHigh] into l1 *)
    i := 0;
    IF l1 = NIL THEN
      WHILE a[i] = NIL AND i # iHigh DO INC(i) END;
      l1 := a[i];
      INC(i)
    END;

    (* l1 # NIL or i > iHigh *)
    WHILE i <= iHigh DO
      l2 := a[i];
      IF l2 # NIL THEN
        lm := lmHead;
        LOOP
          IF c(l1.first, l2.first) = -1 THEN
            lm.tail := l1;
            lm := l1;
            l1 := l1.tail;
            IF l1 = NIL THEN lm.tail := l2; EXIT END
          ELSE
            lm.tail := l2;
            lm := l2;
            l2 := l2.tail;
            IF l2 = NIL THEN lm.tail := l1; EXIT END
          END
        END (* LOOP*);
        l1 := lmHead.tail
      END;
      INC(i)
    END;

    RETURN l1
  END SortD;


PROCEDURE FromVector (v: REF ARRAY OF Elt.T): T RAISES {} =
  VAR l, last: T;
  BEGIN
    IF NUMBER(v^) = 0 THEN RETURN NIL END;
    last := NEW(T, first := v[0]);
    l := last;
    FOR i := 1 TO LAST(v^) DO
      last.tail := NEW(T, first := v[i]);
      last := last.tail
    END;
    RETURN l
  END FromVector;

PROCEDURE ToVector (l: T): REF ARRAY OF Elt.T RAISES {} =
  VAR
    end := Length(l);
    v   := NEW(REF ARRAY OF Elt.T, end);
  BEGIN
    FOR i := 0 TO end - 1 DO v[i] := l.first; l := l.tail END;
    RETURN v
  END ToVector;

<* FATAL Range.Error *>

PROCEDURE Find (l            : T;
                item         : Elt.T;
                test, testNot: TestProc := NIL;
                start        : CARDINAL := 0;
                end          : CARDINAL := LAST (CARDINAL);
                fromEnd                 := FALSE            ): Elt.T =
  VAR
    length: CARDINAL := end - start;
    i     : CARDINAL := 0;
    val   : Elt.T    := NIL;
    found            := FALSE;
  BEGIN
    <* ASSERT NOT (test # NIL AND testNot # NIL) *>
    end := Range.End (start, length, Length (l));
    WHILE i < start DO INC (i); l := l.tail END;
    WHILE i < end DO
      WITH x = l.first DO
        IF test # NIL THEN
          IF test (item, x) THEN val := x; found := TRUE END
        ELSIF testNot # NIL THEN
          IF NOT testNot (item, x) THEN val := x; found := TRUE END
        ELSIF item = x THEN
          val := x;
          found := TRUE
        END
      END;
      IF found AND NOT fromEnd THEN RETURN val END;
      INC (i);
      l := l.tail
    END;
    RETURN val
  END Find;

PROCEDURE FindIf (l      : T;
                  pred   : Predicate;
                  start  : CARDINAL    := 0;
                  end    : CARDINAL    := LAST (CARDINAL);
                  fromEnd              := FALSE            ): Elt.T =
  VAR
    length: CARDINAL := end - start;
    i     : CARDINAL := 0;
    val   : Elt.T    := NIL;
  BEGIN
    end := Range.End (start, length, Length (l));
    WHILE i < start DO INC (i); l := l.tail END;
    WHILE i < end DO
      IF pred (l.first) THEN
        IF fromEnd THEN val := l.first ELSE RETURN l.first END
      END;
      INC (i);
      l := l.tail
    END;
    RETURN val
  END FindIf;

PROCEDURE Position (l            : T;
                    item         : Elt.T;
                    test, testNot: TestProc := NIL;
                    start        : CARDINAL := 0;
                    end          : CARDINAL := LAST (CARDINAL);
                    fromEnd                 := FALSE            ):
  [-1 .. LAST (CARDINAL)] =
  VAR
    length: CARDINAL                := end - start;
    i     : CARDINAL                := 0;
    val   : [-1 .. LAST (CARDINAL)] := -1;
  BEGIN
    <* ASSERT NOT (test # NIL AND testNot # NIL) *>
    end := Range.End (start, length, Length (l));
    WHILE i < start DO INC (i); l := l.tail END;
    WHILE i < end DO
      WITH x = l.first DO
        IF test # NIL THEN
          IF test (item, x) THEN val := i END
        ELSIF testNot # NIL THEN
          IF NOT testNot (item, x) THEN val := i END
        ELSIF item = x THEN
          val := i
        END
      END;
      IF val >= 0 AND NOT fromEnd THEN RETURN val END;
      INC (i);
      l := l.tail
    END;
    RETURN val
  END Position;

PROCEDURE PositionIf (l      : T;
                      pred   : Predicate;
                      start  : CARDINAL    := 0;
                      end    : CARDINAL    := LAST (CARDINAL);
                      fromEnd              := FALSE            ):
  [-1 .. LAST (CARDINAL)] =
  VAR
    length: CARDINAL                := end - start;
    i     : CARDINAL                := 0;
    val   : [-1 .. LAST (CARDINAL)] := -1;
  BEGIN
    end := Range.End (start, length, Length (l));
    WHILE i < start DO INC (i); l := l.tail END;
    WHILE i < end DO
      IF pred (l.first) THEN
        IF fromEnd THEN val := i ELSE RETURN i END
      END;
      INC (i);
      l := l.tail
    END;
    RETURN val
  END PositionIf;

PROCEDURE Delete (l: T; item: Elt.T): T =
  VAR z: T := NIL;
  BEGIN
    WHILE l # NIL DO
      IF l.first # item THEN Push (z, l.first) END
    END;
    RETURN ReverseD (z)
  END Delete;

PROCEDURE DeleteD (VAR (* inOut *) l: T; item: Elt.T) =
  VAR z: T;
  BEGIN
    LOOP
      IF l = NIL THEN
        RETURN
      ELSIF l.first = item THEN
        l := l.tail
      ELSE
        EXIT
      END
    END;
    z := l;
    WHILE z.tail # NIL DO
      IF z.tail.first = item THEN
        z.tail := z.tail.tail
      ELSE
        z := z.tail
      END
    END
  END DeleteD;

BEGIN
END GenList.