(* Copyright (C) 1989, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* Last modified on Sat Jun 27 15:30:26 PDT 1992 by muller     *)
(*      modified on Thu Sep 19 17:46:24 1991 by kalsow         *)
(*      modified on Thu Sep 14 12:17:30 1989 by ellis          *)
(*      modified on Thu Jul 14 16:19:52 PDT 1988 by mhb        *)

UNSAFE MODULE List;

IMPORT Text, Thread;

PROCEDURE New( first: REFANY; tail: T ): T RAISES {} =
VAR
    new: T;
BEGIN
    new := NEW (T);
    new^.first := first;
    new^.tail  := tail;
    RETURN new;
    END New;

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


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


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

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

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

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

PROCEDURE Fourth( l: T ): REFANY RAISES {} =
BEGIN
    RETURN l^.tail^.tail^.tail^.first;
    END Fourth;

PROCEDURE Fifth( l: T ): REFANY RAISES {} =
BEGIN
    RETURN l^.tail^.tail^.tail^.tail^.first;
    END Fifth;

PROCEDURE Sixth( l: T ): REFANY RAISES {} =
BEGIN
    RETURN l^.tail^.tail^.tail^.tail^.tail^.first;
    END Sixth;


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


PROCEDURE NthTail(  l: T; n: INTEGER ): T RAISES {} =
VAR
    i:    INTEGER;
    rest: T;
BEGIN
    rest := l;
    i    := 0;
    WHILE i < n DO
        rest := rest^.tail;
        i    := i + 1;
        END;
    RETURN rest;
    END NthTail;


PROCEDURE SetNthTail( l: T; n: CARDINAL; x: T ) RAISES {} =
BEGIN
    WHILE n > 1 DO 
        n := n - 1;
        l := l^.tail;
        END;
    l^.tail := x;
    END SetNthTail;            


PROCEDURE Nth( l: T; n: INTEGER ): REFANY RAISES {} =
VAR
    i:    INTEGER;
    rest: T;
BEGIN
    i    := 0;
    rest := l;
    WHILE i < n DO
        rest := rest^.tail;
        i    := i + 1;
        END;
    RETURN rest^.first;
    END Nth;


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


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


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


PROCEDURE FirstN( l: T; n: INTEGER ): T RAISES {} =
VAR
    i:  INTEGER;
    result, resultEnd, rest:
        T;
BEGIN
    IF n <= 0 THEN RETURN NIL; END;

    resultEnd := NEW (T);
    resultEnd^.first := l^.first;
    result           := resultEnd;
    rest             := l^.tail;
    i                := 2;
    LOOP
        IF i > n THEN EXIT; END;
        resultEnd.tail := NEW (T);
        resultEnd        := resultEnd^.tail;
        resultEnd^.first := rest^.first; 
        rest             := rest^.tail;
        i                := i + 1;
        END;
    RETURN result;
    END FirstN;


PROCEDURE Equal( x1: REFANY; x2: REFANY ): BOOLEAN RAISES {} =
VAR
    list2:     T;
    rest1,     rest2:     T;
    vector2:   REF ARRAY OF REFANY;
    boolean2:  REF BOOLEAN;
    integer2:  REF INTEGER;
    char2:     REF CHAR;
    longReal2: REF LONGREAL;
    text2:     Text.T;       
BEGIN
    IF x1 = x2 THEN 
      RETURN TRUE; END;
    IF TYPECODE (x1) # TYPECODE (x2) THEN 
        IF x1 = NIL THEN
            TYPECASE x2 OF Text.T( text2 ) =>
                RETURN Text.Empty( text2 );
            ELSE
                RETURN FALSE;
                END;
            END;
        IF x2 = NIL THEN
            TYPECASE x1 OF Text.T( text1 ) =>
                RETURN Text.Empty( text1 );
            ELSE
                RETURN FALSE;
                END;
            END;
        TYPECASE x1 OF 
        | REF INTEGER ( integer1 ) =>
            TYPECASE x2 OF REF LONGREAL( longReal2 ) =>
                RETURN FLOAT( integer1^, LONGREAL ) = longReal2^;
            ELSE
                RETURN FALSE;            
                END;
        | REF LONGREAL ( longReal1 ) =>
            TYPECASE x2 OF REF INTEGER( integer2 ) =>
                RETURN longReal1^ = FLOAT( integer2^, LONGREAL );
            ELSE
                RETURN FALSE;
                END;
        ELSE                
            RETURN FALSE;
            END;
        END;
    TYPECASE x1 OF
    | T( list1 ) =>
        list2 := NARROW( x2, T );
        rest1 := list1;
        rest2 := list2;
        LOOP
            IF rest1 = NIL THEN
                IF rest2 = NIL THEN RETURN TRUE; ELSE RETURN FALSE; END;
            ELSIF rest2 = NIL THEN
                RETURN FALSE;
                END;
            IF rest1^.first = rest2^.first THEN 
            ELSIF NOT Equal( rest1^.first, rest2^.first ) THEN 
                RETURN FALSE;
                END;
            rest1 := rest1^.tail;
            rest2 := rest2^.tail;
            END;
    | REF ARRAY OF REFANY ( vector1 ) =>
        vector2 := NARROW( x2, REF ARRAY OF REFANY );
        IF NUMBER ( vector1^ ) # NUMBER ( vector2^ ) THEN RETURN FALSE; END;
        FOR i := 0 TO LAST ( vector1^ ) DO
            IF vector1^[ i ] = vector2^[ i ] THEN
	    ELSIF NOT Equal( vector1^[ i ], vector2^[ i ] ) THEN
	        RETURN FALSE;
		END;
	    END;
	RETURN TRUE;
    | REF BOOLEAN( boolean1 ) =>
        boolean2 := NARROW( x2, REF BOOLEAN );
	RETURN boolean1^ = boolean2^;
    | REF CHAR( char1 ) =>
        char2 := NARROW( x2, REF CHAR );
	RETURN char1^ = char2^;
    | REF INTEGER( integer1 ) =>
        integer2 := NARROW( x2, REF INTEGER );
	RETURN integer1^ = integer2^;
    | REF LONGREAL( longReal1 ) =>
        longReal2 := NARROW( x2, REF LONGREAL );
	RETURN longReal1^ = longReal2^;
    | Text.T( text1 ) =>
        text2 := NARROW( x2, Text.T );
        RETURN Text.Equal( text1, text2);
    ELSE
        RETURN FALSE;
	END;
    END Equal;


PROCEDURE EqualQ( x1: REFANY; x2: REFANY ): BOOLEAN RAISES {} =
BEGIN
    RETURN x1 = x2;
    END EqualQ;
    

PROCEDURE Compare( arg: REFANY; x1: REFANY; x2: REFANY ): [-1..1] =
VAR
    i:         CARDINAL;
    result:               [-1..1];
    list2:     T;
    rest1, rest2:     T;
    vector2:   REF ARRAY OF REFANY;
    boolean2:  REF BOOLEAN;
    integer2:  REF INTEGER;
    char2:     REF CHAR;
    longReal2: REF LONGREAL;
    text2:     Text.T;       
(*
    symbol1,   symbol2:   SxTypesImpl.Symbol;
    module1,   module2:   SxTypesImpl.Module;
*)
    lr1,       lr2:       LONGREAL;
BEGIN
    IF x1 = x2 THEN RETURN 0; END;
    IF TYPECODE( x1 ) # TYPECODE( x2 ) THEN 
        IF x1 = NIL THEN
            TYPECASE x2 OF Text.T( text2 ) =>
                RETURN Text.Compare( NIL, text2 );
            ELSE
                RETURN -1;
                END;
            END;
        IF x2 = NIL THEN
            TYPECASE x1 OF Text.T( text1 ) =>
                RETURN Text.Compare( text1, NIL );
            ELSE
                RETURN 1;
                END;
            END;
        TYPECASE x1 OF 
        | REF INTEGER( integer1 ) =>
            TYPECASE x2 OF REF LONGREAL( longReal2 ) =>
                lr1 := FLOAT( integer1^, LONGREAL );
                IF    lr1 < longReal2^ THEN RETURN -1;
                ELSIF lr1 = longReal2^ THEN RETURN 0;
                ELSE                        RETURN +1; END;
            ELSE
                RETURN +1;
                END;
        | REF LONGREAL( longReal1 ) =>
            TYPECASE x2 OF REF INTEGER( integer2 ) =>
                lr2 := FLOAT( integer2^, LONGREAL );
                IF    longReal1^ < lr2 THEN RETURN -1;
                ELSIF longReal1^ = lr2 THEN RETURN 0;
                ELSE                        RETURN +1; END;
            ELSE
                RETURN +1;
                END;
        ELSE                
            RETURN +1;
            END;
        END;
    TYPECASE x1 OF
    | T( list1 ) =>
        list2 := NARROW( x2, T );
        rest1 := list1;
        rest2 := list2;
        LOOP
            IF rest1 = NIL THEN
                IF rest2 = NIL THEN RETURN 0; ELSE RETURN -1; END;
            ELSIF rest2 = NIL THEN
                RETURN + 1;
                END;
            IF rest1^.first = rest2^.first THEN 
            ELSE
                result := Compare( arg, rest1^.first, rest2^.first );
                IF result # 0 THEN RETURN result; END;
                END;
            rest1 := rest1^.tail;
            rest2 := rest2^.tail;
            END;
    | REF ARRAY OF REFANY ( vector1 ) =>
        vector2 := NARROW( x2, REF ARRAY OF REFANY );
        i := 0;
        LOOP
            IF i >= NUMBER( vector1^ ) THEN
                IF i >= NUMBER( vector2^ ) THEN 
                    RETURN 0;
                ELSE 
                    RETURN -1;
                    END;
            ELSIF i >= NUMBER( vector2^ ) THEN
                RETURN +1;
                END;
            IF vector1^[ i ] = vector2^[ i ] THEN
            ELSE
                result := Compare( arg, vector1^[ i ], vector2^[ i ] );
                IF result # 0 THEN RETURN result; END;
                END;
            i := i + 1;
	    END;
    | REF BOOLEAN( boolean1 ) =>
        boolean2 := NARROW( x2, REF BOOLEAN );
        IF    boolean1^ < boolean2^ THEN RETURN -1;
        ELSIF boolean1^ = boolean2^ THEN RETURN 0;
        ELSE                             RETURN +1; END;
    | REF CHAR( char1 ) =>
        char2 := NARROW( x2, REF CHAR );
        IF    char1^ < char2^ THEN RETURN -1;
        ELSIF char1^ = char2^ THEN RETURN 0;
        ELSE                       RETURN +1; END;
    | REF INTEGER( integer1 ) =>
        integer2 := NARROW( x2, REF INTEGER );
        IF    integer1^ < integer2^ THEN RETURN -1;
        ELSIF integer1^ = integer2^ THEN RETURN 0;
        ELSE                             RETURN +1; END;
    | REF LONGREAL( longReal1 ) =>
        longReal2 := NARROW( x2, REF LONGREAL );
        IF    longReal1^ < longReal2^ THEN RETURN -1;
        ELSIF longReal1^ = longReal2^ THEN RETURN 0;
        ELSE                               RETURN +1; END;
    | Text.T( text1 ) =>
        text2 := NARROW( x2, Text.T );
        RETURN Text.Compare( text1, text2 ); 
(* 
    | SxTypesImpl.Symbol( symbol1 ) =>
        symbol2 := NARROW( x2, SxTypesImpl.Symbol );
        IF symbol1^.module = NIL THEN 
            text1 := NIL;
        ELSE 
            text1 := symbol1^.module^.name;
            END;
        IF symbol2^.module = NIL THEN 
            text2 := NIL;
        ELSE 
            text2 := symbol2^.module^.name;
            END;
        CASE Text.Compare( text1, text2 ) OF
        | -1 => RETURN -1;
        | 0  => RETURN Text.Compare( symbol1^.name, symbol2^.name );
        | +1 => RETURN +1;
            END;
    | SxTypesImpl.Module( module1 ):
        module2 := NARROW( x2, SxTypesImpl.Module );
        RETURN Text.Compare( module1^.name, module2^.name ); 
*)
    ELSE
        RETURN +1;
	END;
    END Compare;

    
PROCEDURE CompareQ (<*UNUSED*> arg: REFANY; x1: REFANY; x2: REFANY ): [-1..1] =
BEGIN 
    IF x1 = x2 THEN
        RETURN 0;
    ELSE
        RETURN +1;
        END;
    END CompareQ;


PROCEDURE Member( l: T; x: REFANY ): BOOLEAN RAISES {} =
VAR
    rest: T;
BEGIN
    rest := l;
    WHILE rest # NIL DO
        IF Equal( rest^.first, x ) THEN RETURN TRUE; END;
        rest := rest^.tail;
        END;
    RETURN FALSE;
    END Member;

PROCEDURE MemberQ( l: T; x: REFANY ): BOOLEAN RAISES {} =
VAR
    rest: T;
BEGIN
    rest := l;
    WHILE rest # NIL DO
        IF rest^.first = x THEN RETURN TRUE; END;
        rest := rest^.tail;
        END;
    RETURN FALSE;
    END MemberQ;


PROCEDURE Assoc( l: T; x: REFANY ): T RAISES {} =
VAR
    rest: T;
BEGIN
    rest := l;
    WHILE rest # NIL DO
        TYPECASE rest^.first OF
        | T( pair ) =>
            IF Equal( pair^.first, x ) THEN RETURN pair; END;
        ELSE
            END;
        rest := rest^.tail;
        END;
    RETURN NIL;
    END Assoc;

PROCEDURE AssocQ( l: T; x: REFANY ): T RAISES {} =
VAR
    rest: T;
BEGIN
    rest := l;
    WHILE rest # NIL DO
        TYPECASE rest^.first OF
        | T( pair ) =>
            IF pair^.first = x THEN RETURN pair; END;
        ELSE
            END;
        rest := rest^.tail;
        END;
    RETURN NIL;
    END AssocQ;


PROCEDURE AssocPutD( l: T; key: REFANY; valueTail: T ): T
    RAISES {} =
VAR
    tuple: T;
BEGIN
    tuple := Assoc( l, key );
    IF tuple = NIL THEN
        RETURN New (New (key, valueTail ), l );
    ELSE
        tuple^.tail := valueTail;
        RETURN l;
        END;
    END AssocPutD;


PROCEDURE AssocQPutD( l: T; key: REFANY; valueTail: T ): T
    RAISES {} =
VAR
    tuple: T;
BEGIN
    tuple := AssocQ( l, key );
    IF tuple = NIL THEN
        RETURN New( New( key, valueTail ), l );
    ELSE
        tuple^.tail := valueTail;
        RETURN l;
        END;
    END AssocQPutD;


PROCEDURE List9( x1, x2, x3, x4, x5, x6, x7, x8, x9: REFANY ): T RAISES {} =
BEGIN
  RETURN (NEW (T,              first := x1, 
               tail := NEW (T, first := x2,
               tail := NEW (T, first := x3,
               tail := NEW (T, first := x4,
               tail := NEW (T, first := x5,
               tail := NEW (T, first := x6,
               tail := NEW (T, first := x7,
               tail := NEW (T, first := x8,
               tail := NEW (T, first := x9, tail := NIL))))))))));
END List9;
    
PROCEDURE List8( x1, x2, x3, x4, x5, x6, x7, x8: REFANY ): T RAISES {} =
BEGIN
  RETURN (NEW (T,              first := x1, 
               tail := NEW (T, first := x2,
               tail := NEW (T, first := x3,
               tail := NEW (T, first := x4,
               tail := NEW (T, first := x5,
               tail := NEW (T, first := x6,
               tail := NEW (T, first := x7,
               tail := NEW (T, first := x8, tail := NIL)))))))));
END List8;
    
PROCEDURE List7( x1, x2, x3, x4, x5, x6, x7: REFANY ): T RAISES {} =
BEGIN
  RETURN (NEW (T,              first := x1, 
               tail := NEW (T, first := x2,
               tail := NEW (T, first := x3,
               tail := NEW (T, first := x4,
               tail := NEW (T, first := x5,
               tail := NEW (T, first := x6,
               tail := NEW (T, first := x7, tail := NIL))))))));
END List7;
    
PROCEDURE List6( x1, x2, x3, x4, x5, x6: REFANY ): T RAISES {} =
BEGIN
  RETURN (NEW (T,              first := x1, 
               tail := NEW (T, first := x2,
               tail := NEW (T, first := x3,
               tail := NEW (T, first := x4,
               tail := NEW (T, first := x5,
               tail := NEW (T, first := x6, tail := NIL)))))));
END List6;
    
PROCEDURE List5( x1, x2, x3, x4, x5: REFANY ): T RAISES {} =
BEGIN
  RETURN (NEW (T,              first := x1, 
               tail := NEW (T, first := x2,
               tail := NEW (T, first := x3,
               tail := NEW (T, first := x4,
               tail := NEW (T, first := x5, tail := NIL))))));
END List5;
    
PROCEDURE List4( x1, x2, x3, x4: REFANY ): T RAISES {} =
BEGIN
  RETURN (NEW (T,              first := x1, 
               tail := NEW (T, first := x2,
               tail := NEW (T, first := x3,
               tail := NEW (T, first := x4, tail := NIL)))));
END List4;
    
PROCEDURE List3( x1, x2, x3: REFANY ): 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: REFANY ): T RAISES {} =
BEGIN
  RETURN (NEW (T,              first := x1, 
               tail := NEW (T, first := x2, tail := NIL)));
END List2;
    
PROCEDURE List1( x1: REFANY ): 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: REFANY ): T RAISES {} =
BEGIN
    RETURN Append( l1, New( x, NIL ) );
    END Append1;

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

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

PROCEDURE CopyRecursively( l: T ): T RAISES {} =
VAR
    last, rest, result: T;
BEGIN
    IF l = NIL THEN RETURN NIL; END;
    TYPECASE l^.first OF
    | T( first ) =>
        result := New( CopyRecursively( first ), NIL );
    ELSE
        result := New( l^.first, NIL );
        END;
    last := result;
    rest := l^.tail;
    WHILE rest # NIL DO
        TYPECASE rest^.first OF
        | T( first ) =>
            last^.tail := New( CopyRecursively( first ), NIL );
        ELSE
            last^.tail := New( rest^.first, NIL );
            END;
        last := last^.tail;
        rest := rest^.tail;
        END;
    RETURN result;
    END CopyRecursively;
    
PROCEDURE Reverse( l: T ): T RAISES {} =
VAR
    result, rest: T;
BEGIN
    result := NIL;
    rest   := l;
    WHILE rest # NIL DO
        result := New( rest^.first, result );
        rest   := rest^.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; arg: REFANY := NIL ): T RAISES ANY =
VAR
    rest, result: T;
BEGIN
    rest   := l;
    result := NIL;
    WHILE rest # NIL DO
        result := New( p( arg, rest^.first ), result );
        rest   := rest^.tail;
        END;
    RETURN ReverseD( result );
    END Map;


PROCEDURE Walk( l: T; p: WalkProc; arg: REFANY := NIL ) RAISES ANY =
VAR
    rest: T;
BEGIN
    rest := l;
    WHILE rest # NIL DO
        p( arg, rest^.first );
        rest := rest^.tail;
        END;
    END Walk;


TYPE 
  ParWalkBlock = Thread.Closure OBJECT
          proc:  WalkProc;
          arg:   REFANY;
          first: REFANY;
    END;


PROCEDURE ParWalk (
    l:   T; 
    p:   WalkProc; 
    arg: REFANY := NIL
    ) RAISES ANY =
VAR
    rest:     T;
    result:   T;
    cl:       ParWalkBlock;
    thread:   Thread.T;
    ignoreMe: REFANY;
BEGIN
    rest   := l;
    result := NIL;
    WHILE rest # NIL DO
        cl := NEW (ParWalkBlock,
                   apply := ForkedParWalk,
                   proc := p,  arg := arg, first := rest.first);
        result := New (Thread.Fork (cl), result);
        rest   := rest^.tail;
        END;

    rest := result;
    WHILE rest # NIL DO
        thread   := NARROW( rest^.first, Thread.T );
        ignoreMe := Thread.Join( thread );
        rest     := rest^.tail;
        END;
    END ParWalk;


PROCEDURE ForkedParWalk (self: ParWalkBlock): REFANY RAISES {} =
  <*FATAL ANY*>
  BEGIN
    self.proc (self.arg, self.first);
    RETURN NIL;
  END ForkedParWalk;


PROCEDURE Union( l1: T; l2: T ): T RAISES {} =
VAR
    result, rest: T;
BEGIN
    result := NIL;
    rest   := l1;
    WHILE rest # NIL DO
        IF NOT Member( result, rest^.first ) THEN
            result := New( rest^.first, result );
            END;
        rest := rest^.tail;
        END;
    rest := l2;
    WHILE rest # NIL DO
        IF NOT Member( result, rest^.first ) THEN
            result := New( rest^.first, result );
            END;
        rest := rest^.tail;
        END;
    RETURN ReverseD( result );
    END Union;
        
PROCEDURE UnionQ( l1: T; l2: T ): T RAISES {} =
VAR
    result, rest: T;
BEGIN
    result := NIL;
    rest   := l1;
    WHILE rest # NIL DO
        IF NOT MemberQ( result, rest^.first ) THEN
            result := New( rest^.first, result );
            END;
        rest := rest^.tail;
        END;
    rest := l2;
    WHILE rest # NIL DO
        IF NOT MemberQ( result, rest^.first ) THEN
            result := New( rest^.first, result );
            END;
        rest := rest^.tail;
        END;
    RETURN ReverseD( result );
    END UnionQ;
        
PROCEDURE Union1( l: T; x: REFANY ): T RAISES {} =
BEGIN
    IF NOT Member( l, x ) THEN
        RETURN New( x, l );
    ELSE
        RETURN l;
        END;
    END Union1;

PROCEDURE Union1Q( l: T; x: REFANY ): T RAISES {} =
BEGIN
    IF NOT MemberQ( l, x ) THEN
        RETURN New( x, l );
    ELSE
        RETURN l;
        END;
    END Union1Q;


PROCEDURE Intersection( l1: T; l2: T ): T RAISES {} =
VAR
    result, rest: T;
BEGIN
    result := NIL;
    rest   := l1;
    WHILE rest # NIL DO
        IF (NOT Member( result, rest^.first )) AND Member( l2, rest^.first )
        THEN
            result := New( rest^.first, result );
            END;
        rest := rest^.tail;
        END;
    RETURN ReverseD( result );
    END Intersection;

PROCEDURE IntersectionQ( l1: T; l2: T ): T RAISES {} =
VAR
    result, rest: T;
BEGIN
    result := NIL;
    rest   := l1;
    WHILE rest # NIL DO
        IF (NOT MemberQ( result, rest^.first )) AND MemberQ( l2, rest^.first )
        THEN
            result := New( rest^.first, result );
            END;
        rest := rest^.tail;
        END;
    RETURN ReverseD( result );
    END IntersectionQ;

PROCEDURE Difference(  l1: T; l2: T ): T RAISES {} =
VAR
    result, rest: T;
BEGIN
    result := NIL;
    rest   := l1;
    WHILE rest # NIL DO
        IF NOT Member( l2, rest^.first ) THEN
            result := New( rest^.first, result );
            END;
        rest := rest^.tail;
        END;
    RETURN ReverseD( result );
    END Difference;
        
PROCEDURE DifferenceQ( l1: T; l2: T ): T RAISES {} =
VAR
    result, rest: T;
BEGIN
    result := NIL;
    rest   := l1;
    WHILE rest # NIL DO
        IF NOT MemberQ( l2, rest^.first ) THEN
            result := New( rest^.first, result );
            END;
        rest := rest^.tail;
        END;
    RETURN ReverseD( result );
    END DifferenceQ;
        

PROCEDURE Delete( l: T; x: REFANY ): T RAISES {}=
VAR
    result: T;
    rest:   T;
BEGIN
    result := NIL;
    rest   := l;    
    WHILE rest # NIL DO
        IF NOT Equal( rest^.first, x ) THEN
            result := New( rest^.first, result );
            END;
        rest := rest^.tail;
        END;
    RETURN ReverseD( result );
    END Delete;        


PROCEDURE DeleteQ( l: T; x: REFANY ): T RAISES {} =
VAR
    result: T;
    rest:   T;
BEGIN
    result := NIL;
    rest   := l;    
    WHILE rest # NIL DO
        IF rest^.first # x THEN
            result := New( rest^.first, result );
            END;
        rest := rest^.tail;
        END;
    RETURN ReverseD( result );
    END DeleteQ;        


PROCEDURE Subset(  l1: T; l2: T ): BOOLEAN RAISES {} =
VAR
    rest: T;
BEGIN
    rest := l2;
    WHILE rest # NIL DO
        IF NOT Member( l1, rest^.first ) THEN RETURN FALSE; END;
        rest := rest^.tail;
        END;
    RETURN TRUE;
    END Subset;

PROCEDURE SubsetQ( l1: T; l2: T ): BOOLEAN RAISES {} =
VAR
    rest: T;
BEGIN
    rest := l2;
    WHILE rest # NIL DO
        IF NOT MemberQ( l1, rest^.first ) THEN RETURN FALSE; END;
        rest := rest^.tail;
        END;
    RETURN TRUE;
    END SubsetQ;

PROCEDURE NoDuplicates(  l: T ): T RAISES {} =
VAR
    result, rest: T;
BEGIN
    result := NIL;
    rest   := l;
    WHILE rest # NIL DO
        IF NOT Member( result, rest^.first ) THEN
            result := New( rest^.first, result );
            END;
        rest := rest^.tail;
        END;
    RETURN ReverseD( result );
    END NoDuplicates;

PROCEDURE NoDuplicatesQ( l: T ): T RAISES {} =
VAR
    result, rest: T;
BEGIN
    result := NIL;
    rest   := l;
    WHILE rest # NIL DO
        IF NOT MemberQ( result, rest^.first ) THEN
            result := New( rest^.first, result );
            END;
        rest := rest^.tail;
        END;
    RETURN ReverseD( result );
    END NoDuplicatesQ;


PROCEDURE Sort( l: T; c: CompareProc := NIL; arg: REFANY := NIL ): T RAISES {} =
BEGIN
    RETURN SortD( Copy( l ), c, arg );
    END Sort;


PROCEDURE SortD( l: T; c: CompareProc := NIL; arg: REFANY := NIL ): T 
    RAISES {} =
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
    IF c = NIL THEN c := Compare; END;

    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( arg, 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( arg, 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( arg, 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 REFANY ): T RAISES {} =
VAR
    last: T;
    l:    T;
BEGIN
    IF NUMBER( v^ ) = 0 THEN RETURN NIL; END;
     last  := NEW (T); 
    last^.first := v^[ 0 ];
    l           := last;
    FOR i := 1 TO LAST ( v^ ) DO
        last.tail := NEW (T);
        last        := last^.tail;
        last^.first := v^[ i ];
        END;
    RETURN l;
    END FromVector;


PROCEDURE ToVector( l: T ): REF ARRAY OF REFANY RAISES {} =
VAR
    v: REF ARRAY OF REFANY;
    i: CARDINAL;
BEGIN
    v := NEW (REF ARRAY OF REFANY, Length( l ) );
    i := 0;
    WHILE l # NIL DO
        v^[ i ] := l^.first;
        l       := l^.tail;
        i       := i + 1;
        END;
    RETURN v;
    END ToVector;
    
    
PROCEDURE Hash( arg: REFANY; x: REFANY ): INTEGER =
VAR
    result:   INTEGER;
    i:        INTEGER;
BEGIN
    IF x = NIL THEN RETURN 0; END;
    result := 0;
    TYPECASE x OF
    | T( list ) =>
        i := 1;
        WHILE list # NIL DO
            result := i * result + Hash( arg, list^.first );
            i      := i + 1;
            list   := list^.tail;
            END;
    | REF ARRAY OF REFANY ( vector ) =>
        FOR i := 0 TO LAST ( vector^ ) DO
            result := i * result + Hash( arg, vector^[ i ] );
            END;
    | REF BOOLEAN ( boolean ) =>
        result := ORD( boolean^ );
    | REF CHAR ( ch ) =>
        result := ORD( ch^ );
    | REF INTEGER( integer ) =>
        result := LOOPHOLE( FLOAT( integer^ ), INTEGER );
    | REF LONGREAL ( longReal ) =>
        result := LOOPHOLE( FLOAT( longReal^ ), INTEGER );
    | Text.T( text ) =>
        FOR i := 0 TO Text.Length (text) - 1 DO
            result := i * result + ORD (Text.GetChar (text, i));
            END;
    ELSE
        result := LOOPHOLE( x, INTEGER );
        END;

    RETURN result;        
    END Hash;
        

PROCEDURE HashQ (<*UNUSED*> arg: REFANY; x: REFANY ): INTEGER =
BEGIN 
    RETURN LOOPHOLE( x, INTEGER );
    END HashQ;

BEGIN
END List.