OberonCore

MODULE List;
   
   IMPORT  Out;
   
   TYPE
      List = POINTER TO RECORD
         prev, next: List;
      END;
      
   VAR
      list: List;
      creates: ARRAY 2 OF PROCEDURE (l: List): List;
      
   PROCEDURE CreateSingle(l: List): List;
   BEGIN
      NEW(l.next);
      RETURN l.next
   END CreateSingle;

   PROCEDURE CreateDouble(l: List): List;
   BEGIN
      NEW(l.next);
      l.next.prev := l;
      RETURN l.next
   END CreateDouble;

   PROCEDURE NewList(count: INTEGER; create: PROCEDURE (l: List): List): List;
      VAR l, n: List;
   BEGIN
      NEW(n);
      l := n;
      WHILE count > 0 DO
         l := create(l);
         DEC(count)
      END;
      Out.String("Ok"); Out.Ln;
      RETURN n
   END NewList;
   
   PROCEDURE Do*(method, count: INTEGER);
   BEGIN
      list := NIL;
      list := NewList(count, creates[method MOD 2]);
   END Do;

BEGIN
   creates[0] := CreateSingle;
   creates[1] := CreateDouble;
END List.

"List.Do(1, 10000000)"

   TYPE
      IteratorItem* = POINTER TO ABSTRACT RECORD
         root: Iterator;
         prev-, next-: IteratorItem
      END;

      Iterator* = POINTER TO LIMITED RECORD(IteratorItem)
         first-, last-, this-: IteratorItem;
         length-: INTEGER
      END;

(** Итератор **)

   PROCEDURE (i: Iterator) Next* (), NEW;
   BEGIN
      ASSERT(i.this # NIL, 20);
      i.this := i.this.next
   END Next;

   PROCEDURE (i: Iterator) Prev* (), NEW;
   BEGIN
      ASSERT(i.this # NIL);
      i.this := i.this.prev
   END Prev;

   PROCEDURE (i: Iterator) First* (), NEW;
   BEGIN
      i.this := i.first
   END First;

   PROCEDURE (i: Iterator) Last* (), NEW;
   BEGIN
      i.this := i.last
   END Last;

   PROCEDURE (i: Iterator) Add* (item: IteratorItem), NEW;
   BEGIN
      ASSERT(item # NIL, 20);
      item.root := i;
      IF (i.last # NIL) & (i.first # NIL) THEN
         i.last.next := item;
         item.prev := i.last;
         item.next := NIL;
         i.last := item
      ELSE
         i.first := item;
         i.last := item;
         item.next := NIL;
         item.prev := NIL
      END;
      INC(i.length)
   END Add;

   PROCEDURE (i: Iterator) Remove* (item: IteratorItem), NEW;
   BEGIN
      ASSERT(item # NIL, 20);
      ASSERT(item.root = i, 21);
      IF item = i.this THEN i.this := NIL END;
      IF item = i.first THEN
         i.first := item.next;
         IF item.next # NIL THEN item.next.prev := NIL END
      ELSIF item = i.last THEN
         i.last := item.prev;
         IF item.prev # NIL THEN item.prev.next := NIL END
      ELSE
         item.next.prev := item.prev;
         item.prev.next := item.next
      END;
      item.next := NIL; item.prev := NIL; item.root := NIL;
      DEC(i.length)
   END Remove;

   PROCEDURE (i: Iterator) Insert* (this, before: IteratorItem), NEW;
   BEGIN
      ASSERT(this # NIL, 20);
      IF before = NIL THEN
         IF i.first # NIL THEN
            i.first.prev := this
         END;
         i.first := this
      ELSE
         ASSERT(before.root = i, 21);
         ASSERT(before # this, 22);
         this.root := i;
         this.prev := before.prev; IF before.prev # NIL THEN before.prev.next := this END; before.prev := this;
         this.next := before
      END;
      INC(i.length)
   END Insert;

   PROCEDURE (i: Iterator)Replace* (this, with: IteratorItem), NEW;
   BEGIN
      ASSERT(this # NIL, 20);
      ASSERT(with # NIL, 21);
      ASSERT(this.root = i, 22);
      ASSERT(with # this, 24);
      with.next := this.next;
      with.prev := this.prev;
      with.root := i; this.root := NIL; this.next := NIL; this.prev := NIL
   END Replace;

   PROCEDURE NewIterator* (): Iterator;
   VAR it: Iterator;
   BEGIN
      NEW(it);
      RETURN(it)
   END NewIterator;

TYPE
      List* = POINTER TO LIMITED RECORD
         length-: INTEGER;
         first, last: Item;
         p: Parent
      END;

      Parent = POINTER TO RECORD END;

      Item* = POINTER TO EXTENSIBLE RECORD
         p: Parent;
         _x: ANYPTR;
         next: Item
      END;

   PROCEDURE (i: Item) SetData (x: ANYPTR), NEW;
   BEGIN
      i._x := x
   END SetData;

   PROCEDURE (i: Item) GetData (): ANYPTR, NEW;
   BEGIN
      RETURN i._x
   END GetData;
   
   PROCEDURE (l: List) FINALIZE-;
   BEGIN
      l.last := NIL;
      l.first := NIL
   END FINALIZE;

   PROCEDURE (l: List) Last* (): Item, NEW;
   BEGIN
      RETURN l.last
   END Last;

   PROCEDURE (l: List) First* (): Item, NEW;
   BEGIN
      RETURN l.first
   END First;

   PROCEDURE (l: List) Next* (this: Item): Item, NEW;
   BEGIN
      ASSERT(this # NIL, 20); ASSERT(this.p = l.p, 21);
      RETURN this.next
   END Next;

   PROCEDURE (l: List) Prev* (this: Item): Item, NEW;
      VAR x, res: Item;
   BEGIN
      ASSERT(this # NIL, 20); ASSERT(this.p = l.p, 21);
      IF x # l.first THEN
         x := l.first;
         WHILE (x # NIL) & (res = NIL) DO
            IF x.next = this THEN res := x END;
            x := x.next
         END
      END;
      RETURN res
   END Prev;

   PROCEDURE (l: List) InsertAfter* (prev, this: Item), NEW; (* добавить this после prev, если prev=NIL, то в начало *)
   BEGIN
      ASSERT(this # NIL, 20); ASSERT(this.p = NIL, 21);
      IF prev # NIL THEN ASSERT((l.first # NIL), 22); ASSERT(l.p = prev.p, 23) END;
      IF (prev = NIL) & (l.first = NIL) THEN l.first := this; l.last := this
      ELSIF (prev = NIL) & (l.first # NIL) THEN this.next := l.first; l.first := this
      ELSE this.next := prev.next; prev.next := this END;
      IF prev = l.last THEN l.last := this END;
      INC(l.length); this.p := l.p
   END InsertAfter;

   PROCEDURE (l: List) Add* (this: Item), NEW;
   BEGIN
      ASSERT(this # NIL, 20); ASSERT(this.p = NIL, 21);
      l.InsertAfter(l.last, this)
   END Add;

   PROCEDURE (l: List) Remove* (this: Item), NEW;
      VAR prev: Item;
   BEGIN
      ASSERT(this # NIL, 20); ASSERT(this.p = l.p, 21);
      prev := l.Prev(this);
      IF prev = NIL THEN l.first := this.next
      ELSE
         prev.next := this.next;
         IF this = l.last THEN l.last := prev END
      END;
      DEC(l.length); this.p := NIL; this.next := NIL
   END Remove;
   
   PROCEDURE (l: List) Index* (this: Item);
   BEGIN
   
   END Index;
   
   PROCEDURE New* (): List;
      VAR l: List;
   BEGIN
      NEW(l); l.length := 0; NEW(l.p);
      RETURN (l)
   END New;
   
   PROCEDURE Join* (this, with: List): List;
      VAR x, x0: Item;
   BEGIN
      ASSERT(this#NIL, 20); ASSERT(with#NIL, 21); ASSERT(with#this, 22); ASSERT(this.p#with.p, 23);
      INC(this.length, with.length);
      x:=with.first;
      WHILE x#NIL DO
         x0:=x; x:=with.Next(x);
         x0.p:=this.p;
      END;
      IF this.first=NIL THEN this.first:=with.first
      ELSIF (this.last#NIL) & (with.first#NIL) & (with.last#NIL) THEN this.last.next:=with.first; this.last:=with.last END;
      with.length:=0; with.first:=NIL; with.last:=NIL;
      RETURN this;
   END Join;

   PROCEDURE (l: List) FINALIZE-;
   BEGIN
      l.last := NIL;
      l.first := NIL
   END FINALIZE;