Fresh Fish 8/FreshFishVol8-CD1.bin/useful/dev/obero/oberon-a/source/library/lists.mod

Text File | 1994-08-08 | 5.1 KB | 212 lines

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

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

   Created by: fjc (Frank Copeland)
    $Revision: 1.5 $
      $Author: fjc $
        $Date: 1994/08/08 16:25:10 $

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

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

MODULE Lists;

(*
** $C= CaseChk       $I= IndexChk  $L+ LongAdr   $N= NilChk
** $P= PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
** $V= OvflChk       $Z= ZeroVars
*)

IMPORT E := Exec, Str := Strings, SYSTEM;

TYPE

  (* A simple doubly linked node *)

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

  (* An extended node with name and ordering information *)

  ExtNodePtr * = POINTER TO ExtNode;
  ExtNode * = RECORD (Node)
    name * : E.STRPTR;
    key *  : LONGINT;
  END; (* ExtNode *)

  (* A list header *)

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


(* --- ExtNode procedures ----------------------------------------------- *)


(*------------------------------------*)
(* $D- disable copying of open arrays *)
PROCEDURE AttachName * (VAR node : ExtNode; name : ARRAY OF CHAR);

BEGIN (* AttachName *)
  SYSTEM.NEW (node.name, SYSTEM.STRLEN (name) + 1);
  COPY (name, node.name^)
END AttachName;


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


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

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

(*------------------------------------*)
PROCEDURE AddHead * (VAR list : List; 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 AddTail * (VAR list : List; 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 Insert * (VAR list : List; node, prevNode : NodePtr);

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

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

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


(*------------------------------------*)
PROCEDURE RemHead * (VAR list : List) : 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; (* IF *)
  RETURN node
END RemHead;

(*------------------------------------*)
PROCEDURE RemTail * (VAR list : List) : 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; (* IF *)
  RETURN node
END RemTail;


(*------------------------------------*)
PROCEDURE Remove * (VAR list : List; 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;


(* --- List procedures requiring ExtNodes ------------------------------- *)


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

  VAR next : NodePtr;

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

(*------------------------------------*)
(* $D- disable copying of open arrays *)
PROCEDURE FindName * (VAR list : List; name : ARRAY OF CHAR) : NodePtr;

  VAR next : NodePtr;

BEGIN (* FindName *)
  next := list.head;
  WHILE (next # NIL) & (next (ExtNodePtr).name^ # name) DO
    next := next.succ
  END; (* WHILE *)
  RETURN next
END FindName;

(*------------------------------------*)
(* $D- disable copying of open arrays *)
PROCEDURE FindNameNoCase *
  (VAR list : List; name : ARRAY OF CHAR)
  : NodePtr;

  VAR next : NodePtr;

BEGIN (* FindNameNoCase *)
  next := list.head;
  WHILE
    (next # NIL) & (Str.CompareCAP (next (ExtNodePtr).name^, name) # 0)
  DO
    next := next.succ
  END;
  RETURN next
END FindNameNoCase;

END Lists.