IMPLEMENTATION MODULE List ;

FROM SYSTEM IMPORT WORD ;
FROM Memory IMPORT ALLOCATE , DEALLOCATE ;
FROM Universe IMPORT BYTE ;	    
IMPORT Buffers , Windows , StringData , Errors ;
IMPORT Debug ;

PROCEDURE Dispose( VAR Arg : ListP ) ;
BEGIN
END Dispose ;


PROCEDURE MakeAtom( T : WORD ; Type : ListType ) : ListP ;
VAR
   Atom 			: ListP ;
BEGIN
   NEW( Atom ) ;
   Atom^.Word := T ;
   Atom^.Type := Type ;
   RETURN Atom ;
END MakeAtom ;


PROCEDURE Cons( Head , Tail : ListP ) : ListP ;
VAR
   Cell 		    : ListP ;
BEGIN
   NEW( Cell ) ;
   IF Cell <> NIL THEN
      Cell^.Type := ListT ;
      Cell^.Head := Head ;
      Cell^.Tail := Tail ;
   END (* if *) ;
   RETURN Cell ;
END Cons ;


(* *:
PROCEDURE WriteType( T : ListType ) ;
BEGIN
   CASE T OF
      NoneT :
	 Debug.WriteS( "NoneT" ) ;
   |
      BooleanT :
	 Debug.WriteS( "BooleanT" ) ;
   |
      NumberT :
	 Debug.WriteS( "NumberT" ) ;
   |
      ByteT :
	 Debug.WriteS( "ByteT" ) ;
   |
      StringT :
	 Debug.WriteS( "StringT" ) ;
   |
      NameT :
	 Debug.WriteS( "NameT" ) ;
   |
      WindowT :
	 Debug.WriteS( "WindowT" ) ;
   |
      MarkerT :
	 Debug.WriteS( "MarkerT" ) ;
   |
      ListT :
	 Debug.WriteS( "ListT" ) ;
   ELSE
      Debug.WriteS( "?????" ) ;
   END (* case *) ;
END WriteType ;
*: *)


PROCEDURE Check( L : ListP ; T : ListType ) : BOOLEAN ;
BEGIN
   IF ( L <> NIL ) AND ( L^.Type = T ) THEN
      RETURN TRUE ;
   ELSE

(* :*
Debug.WriteS( "Check failed, wanted type " ) ;
WriteType( T ) ;
Debug.WriteS( " but " ) ;
IF L = NIL THEN
Debug.WriteS( "L = NIL" ) ;
ELSE
Debug.WriteS( "type is " ) ;
WriteType( L^.Type ) ;
END;
Debug.Writeln;
*: *)

      Errors.Panic( "List.Check failed" ) ;
   END (* if *) ;
END Check ;


(* Atom extractors, the type of the list must be correct *)
PROCEDURE BooleanOfList( L : ListP ) : BOOLEAN ;
BEGIN
   IF Check( L , BooleanT ) THEN
      RETURN L^.Boolean ;
   END (* if *) ;
END BooleanOfList ;


PROCEDURE NumberOfList( L : ListP ) : CARDINAL ;
BEGIN
   IF Check( L , NumberT ) THEN
      RETURN L^.Number ;
   END (* if *) ;
END NumberOfList ;


PROCEDURE ByteOfList( L : ListP ) : BYTE ;   
BEGIN
   IF Check( L , ByteT ) THEN
      RETURN L^.Byte ;
   END (* if *) ;
END ByteOfList ;


PROCEDURE StringOfList( L : ListP ) : StringData.StringP ;
BEGIN
   IF Check( L , StringT ) THEN
      RETURN L^.String ;
   END (* if *) ;
END StringOfList ;


PROCEDURE NameOfList( L : ListP ) : NameListP ;
BEGIN
   IF Check( L , NameT ) THEN
      RETURN L^.Name ;
   END (* if *) ;
END NameOfList ;


PROCEDURE WindowOfList( L : ListP ) : Windows.WindowP ;
BEGIN
   IF Check( L , WindowT ) THEN
      RETURN L^.Window ;
   END (* if *) ;
END WindowOfList ;


PROCEDURE MarkerOfList( L : ListP ) : Buffers.MarkerP ;
BEGIN
   IF Check( L , MarkerT ) THEN
      RETURN L^.Marker ;
   END (* if *) ;
END MarkerOfList ;

(*------------------------------------------------------------------------*)

PROCEDURE OneByteOfList (VAR byte   : BYTE;
			     index  : CARDINAL;
			     list   : ListP    ): BOOLEAN;

   (* Returns index'th byte (1st at index = 0) of a list of ByteT, NumberT
   or StringT atoms. Returns FALSE if not present *)

   VAR atom: ListP;

   BEGIN
      LOOP
         IF list = NIL THEN RETURN FALSE END;
         IF list^.Type # ListT THEN Errors.Panic ("OneByteOfList: Bad list") END;
         atom := list^.Head;
         CASE atom^.Type OF
            ByteT:
               IF index = 0 THEN
                  byte := atom^.Byte;
                  RETURN TRUE
               ELSE DEC (index)
               END (* if *)

         |  NumberT:
               IF index = 0 THEN
                  byte := BYTE (atom^.Number MOD 256);
                  RETURN TRUE
               ELSE DEC (index)
               END (* if *)

         | StringT:
               IF index < atom^.String^.Array.Size THEN
                  byte := atom^.String^.Array.Data^ [index];
                  RETURN TRUE
               ELSE DEC (index, atom^.String^.Array.Size)
               END (* if *)

         ELSE Errors.Panic ("OneByteOfList: Bad atom type")
         END (* case *);
         list := list^.Tail
      END (* loop *)
   END OneByteOfList;

(*------------------------------------------------------------------------*)

(* List extractors, the type of the list must be ListT *)
PROCEDURE Head( L : ListP ) : ListP ;
BEGIN
   IF Check( L , ListT ) THEN
      RETURN L^.Head ;
   END (* if *) ;
END Head ;


PROCEDURE Tail( L : ListP ) : ListP ;
BEGIN
   IF Check( L , ListT ) THEN
      RETURN L^.Tail ;
   END (* if *) ;
END Tail ;


PROCEDURE TailOfHead( L : ListP ) : ListP ;  (* = Tail(Head(L))  *)
BEGIN
   RETURN Tail( Head( L ) ) ;
END TailOfHead ;


PROCEDURE HeadOfTail( L : ListP ) : ListP ;  (* = Head(Tail(L))  *)
BEGIN
   RETURN Head( Tail( L ) ) ;
END HeadOfTail ;


PROCEDURE TailOfTail( L : ListP ) : ListP ;  (* = Tail(Tail(L))  *)
BEGIN
   RETURN Tail( Tail( L ) ) ;
END TailOfTail ;


PROCEDURE Initialise ;
BEGIN
END Initialise ;


PROCEDURE Terminate ;
BEGIN
END Terminate ;


BEGIN
   NEW( True ) ;
   NEW( False ) ;
   NEW( Self ) ;
   True^.Type := BooleanT ;
   True^.Boolean := TRUE ;
   False^.Type := BooleanT ;
   False^.Boolean := FALSE ;
   Self^.Type := ByteT ;
END List.