-- Copyright 1993-1998, by the Cecil Project
-- Department of Computer Science and Engineering, University of Washington
-- See the LICENSE file for license information.

(--
  Skip Lists provide an efficient implementation of a mutable sorted
  collection.  Like balanced tree algorithms (RB trees, etc), skip lists
  won't degenerate to worst-cased behavior for any particular sequence of
  operations (as do simple binary trees after a sequence of in-order
  insertions).  Skip lists balance themselves probabilistically and
  offer significant constant-time speed improvements over balanced
  trees.  They are also quite space efficient, requiring only 1.33
  pointers per element and no additional balancing information.

  Skip lists were invented by William Pugh and described in the
  June 1990 issue of CACM.

  template object skip_list;
  template object skip_list_node;
    concrete representation skip_list_nil;
  concrete representation skip_list_nil_value;
  concrete representation rand_sl_level_stream;
--)


--DOC Skip lists are an alternative implementation of mutable sorted
--DOC collections that perform probabilistically better than balanced
--DOC trees. Skip lists can be sorted using either the element type's
--DOC natural ordering or using a user-supplied ordering function.

template object skip_list[T <= comparable[T]] isa m_sorted_collection[T],
						  removable_collection[T];
  private field header(@:skip_list[`T]):skip_list_node[T] :=
			new_skip_list_node[T](1, cast[T](skip_list_nil_value));
  private var field level(@:skip_list[`T]):int := 1;
  private field cmp_cl(@:skip_list[`T]):&(T,T):bool
      := &&(t1:T,t2:T){ cast[dynamic](t1) < cast[dynamic](t2) };

  method less_than(t@:skip_list[`T], e1:T, e2:T):bool { eval(t.cmp_cl, e1, e2) }
  method less_than(t@:skip_list[`T],
		   e1:T, e2@:skip_list_nil_value):bool { true }
  method less_than(t@:skip_list[`T],
		   e1@:skip_list_nil_value, e2:T):bool { false }
  method less_than(t@:skip_list[`T],
		   e1@:skip_list_nil_value,e2@:skip_list_nil_value):bool {
      false }

  method new_skip_list[T <= partially_ordered[T]]():skip_list[T] {
      concrete object isa skip_list[T] }
  method new_predicate_skip_list[T <= comparable[T]](cmp:&(T,T):bool
						     ):skip_list[T] {
      concrete object isa skip_list[T] { cmp_cl := cmp } }

  method add(l@:skip_list[`T], new_value:T):void {
      -- question this array constructor
      let update:array[skip_list_node[T]] :=
          new_array_init[skip_list_node[T]](l.level.succ,
					    &(i:int){ skip_list_nil[T] });
      let var x:skip_list_node[T] := l.header;
      let var iv:interval := new_interval(l.level.pred, 0, -1);
      let var new_level:int := 0;

      -- Skip forward, starting at top level forward pointer and
      -- working down through lower-level pointer,  until new_value\'s
      -- place in the list is found.
      iv.do(&(i:int){
	  while({ l.less_than((x.forward!i).value, new_value) }, {
              x := x.forward!i;
	  });
	  update!i := x;
      });
      x := x.forward!0;

      -- If object not already in the list, create a skip_list_node
      -- for it and add it, fixing up forward pointers as necessary.
      if(x.value != new_value, {
          new_level := rand_sl_level_stream.next(l.level);
	  if( new_level > l.level, {          -- if new_level = l.level + 1
              l.header.forward.add_last(skip_list_nil[T]); -- grow header by 1
	      update!l.level := l.header;
	      l.level := new_level;
	  });

	  x := new_skip_list_node[T](new_level, new_value);
	  iv := new_interval(0, new_level.pred);
	  iv.do(&(i:int){
	      x.forward!i := (update!i).forward!i;
	      (update!i).forward!i := x;
	  });
      });
  }

  method includes(l@:skip_list[`T], elem:T):bool {
      let var x:skip_list_node[T] := l.header;
      let iv:interval := new_interval(l.level.pred, 0, -1);
      iv.do(&(i:int){
	  while({ l.less_than((x.forward!i).value, elem) }, {
              x := x.forward!i;
	  });
      });
      x := x.forward!0;
      x.value = elem }

  method do(l@:skip_list[`T], c:&(T):void):void {
      let var x:skip_list_node[T] := l.header.forward!0;
      while({ not(x.is_nil) }, {
          eval(c, x.value);
          x := x.forward!0;
      });
  }

  method remove(l@:skip_list[`T], value:T, if_absent:&():void):void {
      let update:array[skip_list_node[T]] :=
          new_array_init[skip_list_node[T]](l.level,
					    &(i:int){ skip_list_nil[T] });
      let var x:skip_list_node[T] := l.header;
      let var iv:interval := new_interval(l.level.pred, 0, -1);

      if( value !== skip_list_nil_value, {

          -- Skip forward, starting at top level forward pointer and
          -- working down through lower-level pointer,  until new_value s
          -- place in the list is found.
          iv.do(&(i:int){
	      while({ l.less_than((x.forward!i).value, value) }, {
	          x := x.forward!i;
              });
	      update!i := x;
          });
	  x := x.forward!0;

	  -- If object is in the list, delete its skip_list_node and fix
	  -- up forward pointers as necessary.
	  if( x.value = value, {
	      let var i:int := 0;
	      while( { i < l.level &
		       { (update!i).forward!i == x } }, {
	          (update!i).forward!i := x.forward!i;
                  i := i.succ;
              });

	      -- Shrink header until top forward pointer points to non-NIL
              while( { l.level > 1 &
		       { l.header.forward!(l.level.pred)
			 == skip_list_nil[T] } }, {
                  l.level := l.level.pred;
	          remove_last(l.header.forward);  -- shrink header by 1
              });
	  }, {
	      -- not found in list
	      eval(if_absent);
	  });
      });
  }

  method length(l@:skip_list[`T]):int {
    let var len:int := 0;
    l.do(&(t:T){ len := len.succ; });
    len }
  method is_empty(l@:skip_list[`T]):bool {
    (l.header.forward!0).is_nil }

  method first(l@:skip_list[`T]):T {
    (l.header.forward!0).value }

  method last(l@:skip_list[`T]):T {
    let iv:interval := new_interval(l.level.pred, 0, -1);
    let var x:skip_list_node[T] := l.header;

    -- Skip forward, starting at top level forward pointer and
    -- working down through lower-level pointer,  until the last skip
    -- list node in the list is found.
    iv.do(&(i:int){
        while({ l.less_than((x.forward!i).value, skip_list_nil_value) }, {
            x := x.forward!i;
        });
    });
    x.value }

  method remove_first(l@:skip_list[`T], if_empty:&():`S):T|S {
    if(l.is_empty, { ^ eval(if_empty); });
    let first:T := l.first;
    l.remove(first);
    first }

  method remove_last(l@:skip_list[`T], if_empty:&():`S):T|S {
    if(l.is_empty, { ^ eval(if_empty); });
    let last:T := l.last;
    l.remove(last);
    last }

  method collection_name(@:skip_list[`T]):string { "skip_list" }

  method copy(l@:skip_list[`T]):skip_list[T] {
      concrete object isa skip_list[T] {
	  header := l.header.copy, level := l.level, cmp_cl := l.cmp_cl } }


-- A skip_list_node has a value and an array of forward pointers
-- to other skip list nodes
template object skip_list_node[T];
  field value(@:skip_list_node[`T]):T;
  field forward(@:skip_list_node[`T]):array[skip_list_node[T]];

  method new_skip_list_node[`T](level:int, new_value:T):skip_list_node[T] {
      concrete object isa skip_list_node[T] {
          value := new_value,
	  forward := new_array_init[skip_list_node[T]](level, &(i:int){
	      skip_list_nil[T] }) } }

  method is_nil(sln@:skip_list_node[`T]):bool { false }

  method print_string(sln@:skip_list_node[`T]):string {
      "( val= " || sln.value.print_string ||
	", " || sln.forward.length.print_string || " forward ptrs)" }

  method copy(sln@:skip_list_node[`T]):skip_list_node[T] {
      concrete object isa skip_list_node[T] {
          value := sln.value,
	  forward := sln.forward.copy }}

-- NIL object with which skip lists are terminated;
-- inherits no code from skip_list_node, so only subtypes it
concrete representation skip_list_nil[T] subtypes skip_list_node[T];
  method value(@:skip_list_nil[`T]):T { cast[T](skip_list_nil_value) }
  method is_nil(@:skip_list_nil[`T]):bool { true }
  method print_string(@:skip_list_nil[`T]):string { "(skip_list_nil)" }
  method copy(l@:skip_list_nil[`T]):skip_list_nil[T] { l }


-- A value larger than any other for skip_list_nil
concrete representation skip_list_nil_value isa ordered[`T];
  method = (x1@:skip_list_nil_value, x2@:skip_list_nil_value):bool { true }
  method = (x1@:skip_list_nil_value, x2@:comparable[`T]):bool { false }
  method = (x1@:comparable[`T], x2@:skip_list_nil_value):bool { false }

  method < (x1@:skip_list_nil_value, x2@:skip_list_nil_value):bool { false }
  method < (x1@:skip_list_nil_value, x2@:ordered[`T]):bool { false }
  method < (x1@:ordered[`T], x2@:skip_list_nil_value):bool { true }


-- This is the stream that provides random skip list node levels
concrete representation rand_sl_level_stream;
  field rs(@:rand_sl_level_stream):random_stream := new_rand_stream(10000);

  -- Returns random node levels between 1 and current_level + 1, not
  -- exceeding max_level.  p is set to 1/4 for nearly optimal search
  -- time and only 1.33 forward pointers per node.  This implements Pughs
  -- suggested hack of not letting the current_level increase by more
  -- than one to avoid the rare case of having to walk down from
  -- unusually high-level nodes.
  method next(r@:rand_sl_level_stream, current_level:int):int {
      let var new_level:int := 1;
      while({ r.rs.next < 2500 & { new_level < current_level.succ } }, {
          new_level := new_level.succ;
      });
      new_level }