Gold Fish 3/goldfish_volume_3.bin/files/dev/obero/oberon-a/source/library/lists.mod

Text File | 1995-06-29 | 7.2 KB | 306 lines

(***************************************************************************

     $RCSfile: Lists.mod $
  Description: Doubly-linked lists similar to Exec lists

   Created by: fjc (Frank Copeland)
    $Revision: 1.11 $
      $Author: fjc $
        $Date: 1995/06/04 23:22:41 $

  Copyright © 1994-1995, Frank Copeland.
  This file is part of the Oberon-A Library.
  See Oberon-A.doc for conditions of use and distribution.

***************************************************************************)

MODULE Lists;

IMPORT SYS := SYSTEM, Errors, Strings, Strings2;

TYPE

  (* A simple doubly linked node *)

  NodePtr * = POINTER TO Node;
  Node * = RECORD
    succ * : NodePtr;
    pred * : NodePtr;
  END; (* Node *)

  (* An named node. *)

  NameNodePtr * = POINTER TO NameNode;
  NameNode * = RECORD (Node)
    name - : POINTER TO ARRAY OF CHAR;
  END; (* NameNode *)

  (* An node with a key *)

  KeyNodePtr * = POINTER TO KeyNode;
  KeyNode * = RECORD (Node)
    key *  : LONGINT;
  END; (* KeyNode *)

  (* A list header *)

  ListPtr * = POINTER TO List;
  List * = RECORD
    head * : NodePtr;
    tail * : NodePtr;
  END; (* List *)

  (* A header for a list of NameNodes *)

  NameListPtr * = POINTER TO NameList;
  NameList * = RECORD (List) END;

  (* A header for a list of KeyNodes *)

  KeyListPtr * = POINTER TO KeyList;
  KeyList * = RECORD (List) END;

(* --- NameNode procedures ----------------------------------------------- *)


(*------------------------------------*)
PROCEDURE (VAR node : NameNode) Name * (name : ARRAY OF CHAR);

<*$CopyArrays-*>
BEGIN (* Name *)
  NEW (node.name, Strings.Length (name) + 1);
  COPY (name, node.name^)
END Name;


(* --- List procedures -------------------------------------------------- *)


(*------------------------------------*)
PROCEDURE (VAR list : List) NewList*;

BEGIN (* NewList *)
  list.head := NIL; list.tail := NIL
END NewList;

(*------------------------------------*)
PROCEDURE (VAR list : List)  AddHead * (node : NodePtr);

BEGIN (* AddHead *)
  node.succ := list.head; node.pred := NIL;
  IF list.head # NIL THEN list.head.pred := node END;
  list.head := node;
  IF list.tail = NIL THEN list.tail := node END
END AddHead;

(*------------------------------------*)
PROCEDURE (VAR list : List)  AddTail * (node : NodePtr);

BEGIN (* AddTail *)
  node.succ := NIL; node.pred := list.tail;
  IF list.tail # NIL THEN list.tail.succ := node END;
  list.tail := node;
  IF list.head = NIL THEN list.head := node END
END AddTail;

(*------------------------------------*)
PROCEDURE (VAR list : List)  Insert * (node, prevNode : NodePtr);

BEGIN (* Insert *)
  IF prevNode = NIL THEN list.AddHead (node)
  ELSIF prevNode = list.tail THEN list.AddTail (node)
  ELSE
    node.succ := prevNode.succ;
    IF node.succ # NIL THEN node.succ.pred := node END;
    node.pred := prevNode; prevNode.succ := node
  END
END Insert;

(*------------------------------------*)
PROCEDURE (VAR list : List)  IsListEmpty * () : BOOLEAN;

BEGIN (* IsListEmpty *)
  RETURN (list.head = NIL)
END IsListEmpty;


(*------------------------------------*)
PROCEDURE (VAR list : List)  RemHead * () : NodePtr;

  VAR node : NodePtr;

BEGIN (* RemHead *)
  node := list.head;
  IF node # NIL THEN
    list.head := node.succ;
    IF list.tail = node THEN list.tail := NIL END;
    node.pred := NIL; node.succ := NIL
  END;
  RETURN node
END RemHead;

(*------------------------------------*)
PROCEDURE (VAR list : List)  RemTail * () : NodePtr;

  VAR node : NodePtr;

BEGIN (* RemTail *)
  node := list.tail;
  IF node # NIL THEN
    list.tail := node.pred;
    IF list.head = node THEN list.head := NIL END;
    node.pred := NIL; node.succ := NIL
  END;
  RETURN node
END RemTail;


(*------------------------------------*)
PROCEDURE (VAR list : List)  Remove * (node : NodePtr);

BEGIN (* Remove *)
  IF node.succ # NIL THEN node.succ.pred := node.pred END;
  IF node.pred # NIL THEN node.pred.succ := node.succ END;
  IF list.head = node THEN list.head := node.succ END;
  IF list.tail = node THEN list.tail := node.pred END;
  node.succ := NIL; node.pred := NIL
END Remove;


(*------------------------------------*)
PROCEDURE (VAR list : List) Enqueue * (node : NodePtr);

BEGIN (* Enqueue *)
  HALT (Errors.notImplemented)
END Enqueue;

(* --- List procedures requiring NameNodes ------------------------------- *)


(*------------------------------------*)
PROCEDURE (VAR list : NameList) AddHead * (node : NodePtr);

BEGIN (* AddHead *)
  WITH node : NameNodePtr DO list.AddHead^ (node) END
END AddHead;

(*------------------------------------*)
PROCEDURE (VAR list : NameList) AddTail * (node : NodePtr);

BEGIN (* AddTail *)
  WITH node : NameNodePtr DO list.AddTail^ (node) END
END AddTail;

(*------------------------------------*)
PROCEDURE (VAR list : NameList) Insert * (node, prevNode : NodePtr);

BEGIN (* Insert *)
  WITH node : NameNodePtr DO list.Insert^ (node, prevNode) END
END Insert;

(*------------------------------------*)
PROCEDURE (VAR list : NameList) Enqueue * (node : NodePtr);

  VAR next : NodePtr;

BEGIN (* Enqueue *)
  WITH node : NameNodePtr DO
    next := list.head;
    WHILE (next # NIL) & (next(NameNodePtr).name^ <= node.name^) DO
      next := next.succ
    END;
    IF next = NIL THEN list.AddTail (node)
    ELSE list.Insert (node, next.pred)
    END
  END;
END Enqueue;

(*------------------------------------*)
PROCEDURE (VAR list : NameList) Find *
  (name : ARRAY OF CHAR) : NodePtr;

  VAR next : NodePtr;

<*$CopyArrays-*>
BEGIN (* Find *)
  next := list.head;
  WHILE (next # NIL) & (next(NameNodePtr).name^ # name) DO
    next := next.succ
  END;
  RETURN next
END Find;

(*------------------------------------*)
PROCEDURE (VAR list : NameList) FindCap *
  (name : ARRAY OF CHAR) : NodePtr;

  VAR next : NodePtr;

<*$CopyArrays-*>
BEGIN (* FindCap *)
  next := list.head;
  WHILE
    (next # NIL) & (Strings2.CompareCAP (next(NameNodePtr).name^, name) # 0)
  DO
    next := next.succ
  END;
  RETURN next
END FindCap;


(* --- List procedures requiring KeyNodes ------------------------------- *)

(*------------------------------------*)
PROCEDURE (VAR list : KeyList)  AddHead * (node : NodePtr);

BEGIN (* AddHead *)
  WITH node : KeyNodePtr DO list.AddHead^ (node) END
END AddHead;

(*------------------------------------*)
PROCEDURE (VAR list : KeyList)  AddTail * (node : NodePtr);

BEGIN (* AddTail *)
  WITH node : KeyNodePtr DO list.AddTail^ (node) END
END AddTail;

(*------------------------------------*)
PROCEDURE (VAR list : KeyList)  Insert * (node, prevNode : NodePtr);

BEGIN (* Insert *)
  WITH node : KeyNodePtr DO list.Insert^ (node, prevNode) END
END Insert;

(*------------------------------------*)
PROCEDURE (VAR list : KeyList) Enqueue * (node : NodePtr);

  VAR next : NodePtr;

BEGIN (* Enqueue *)
  WITH node : KeyNodePtr DO
    next := list.head;
    WHILE (next # NIL) & (next(KeyNodePtr).key <= node.key) DO
      next := next.succ
    END;
    IF next = NIL THEN list.AddTail (node)
    ELSE list.Insert (node, next.pred)
    END
  END;
END Enqueue;

(*------------------------------------*)
PROCEDURE (VAR list : KeyList) Find * (key : LONGINT) : NodePtr;

  VAR next : NodePtr;

<*$CopyArrays-*>
BEGIN (* Find *)
  next := list.head;
  WHILE (next # NIL) & (next(KeyNodePtr).key # key) DO
    next := next.succ
  END;
  RETURN next
END Find;

END Lists.