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

(--DOC
  Keyed sets are a space-saving cross between a table and a set.  A keyed set
  is a table where the keys are stored as part of the elements of the table;
  if the key was already part of the value, then this is more efficient than
  extracting the key from the value, then storing it separately in a table.
--)


--DOC Keyed set elements must be subtypes of `keyed_comparable':
abstract object keyed_comparable[Key <= comparable[Key]];
  signature key(keyed_comparable[`Key]):Key;
  method has_key(k1@:keyed_comparable[`Key], k2:Key):bool { k1.key = k2 }
  method is_same_key(k1@:keyed_comparable[`Key],
		     k2@:keyed_comparable[`Key]):bool { k1.key = k2.key }


--DOC Keyed sets also support `removable_' and `extensible_collection'
--DOC operations such as `remove', `add', `add_all', `add_no_dup'.
--DOC Keyed sets also support table behavior, plus an associative lookup
--DOC operation, `match', which returns the element of the set that has the
--DOC same key (using `=') as the second argument (invoking the `if_absent'
--DOC closure if no such matching element is found).

abstract object keyed_set[Key <= comparable[Key],
			  Value <= keyed_comparable[Key]]
		isa table[Key,Value];
  extend type keyed_set[`Key,`Value] subtypes keyed_set[Key, `Value1 >= Value];

  method do_associations(t@:keyed_set[`Key,`Value], c:&(Key,Value):void):void {
      do(t, &(e:Value){ eval(c, e.key, e); });
  }
  method do_associations_allowing_updates(t@:keyed_set[`Key,`Value],
					  c:&(Key,Value):void):void {
      do_allowing_updates(t, &(e:Value){ eval(c, e.key, e); });
  }

  method fetch(t@:keyed_set[`Key,`Value], key:Key, if_absent:&():Value):Value {
      do(t, &(e:Value){ if(e.has_key(key), { ^ e }); });
      eval(if_absent) }

  method match(t@:keyed_set[`Key,`Value], v:Value, if_absent:&():Value):Value {
      do(t, &(e:Value){ if(e.is_same_key(v), { ^ e }); });
      eval(if_absent) }
  method match(t@:keyed_set[`Key,`Value], v:Value):Value {
      match(t, v, { error("value not matched in table") }) }

  method find_key(t@:keyed_set[`Key,`Value <= comparable[Value]], value:Value,
		  if_absent:&():Key):Key {
      let k:Key := value.key;
      if(t.includes_key(k), { ^ k }, if_absent) }


  --DOC If values are `comparable' or `hashable', then so is the
  --DOC collection. Two keyed sets are equal when they include the same
  --DOC elements (regular set equality operations).

  extend keyed_set[`Key, `Value <= comparable[Value]]
  	isa unordered_collection[Value], comparable[keyed_set[Key,Value]];
  method =(t1@:keyed_set[`Key, `Value <= comparable[Value]],
	   t2@:keyed_set[Key, Value]):bool {
      resend(t1@unordered_collection[Value1], t2@unordered_collection[Value2])}

  extend keyed_set[`Key, `Value <= hashable[Value]]
					isa hashable[keyed_set[Key,Value]];
  method hash(t@:keyed_set[`Key,`Value <= hashable[Value]], range:int):int {
      resend(t@unordered_collection[Value], range) }

  method elems_print_string(t@:keyed_set[`Key,`Value]):string {
      resend(t@collection[Value]) }
  method elems_print(t@:keyed_set[`Key,`Value]):void {
      resend(t@collection[Value]);
  }


--DOC As usual, immutable and mutable varieties are defined. Mutable
--DOC keyed sets also support the adding and removing operations of
--DOC `extensible_collection', thereby acting a lot like sets (hence their
--DOC name), and the storing and removing operations of
--DOC `m_removable_table'. The store operation for keyed sets is restricted,
--DOC however, in that the key of the value being stored must match the
--DOC key where it's being stored, i.e., `store(k, v)' must be identical in
--DOC effect to `add(v)'.

abstract object i_keyed_set[Key <= comparable[Key],
			    Value <= keyed_comparable[Key]]
		    isa keyed_set[Key,Value], i_table[Key,Value];
  extend i_keyed_set[`Key, `Value <= comparable[Value]]
  	isa i_unordered_collection[Value];
  extend type i_keyed_set[`Key,`Value]
	subtypes i_keyed_set[Key, `Value1 >= Value];

  method copy(t@:i_keyed_set[`Key,`Value]):i_keyed_set[Key,Value] { t }

abstract object m_keyed_set[Key <= comparable[Key],
			    Value <= keyed_comparable[Key]]
		isa keyed_set[Key,Value], m_removable_table[Key,Value],
  		    extensible_collection[Value];
  extend m_keyed_set[`Key, `Value <= comparable[Value]]
  	isa m_unordered_collection[Value], removable_collection[Value];

  method fetch_or_init(t@:m_keyed_set[`Key,`Value], key:Key,
		       if_init:&():Value):Value {
      t.fetch(key, {
	  let v:Value := eval(if_init);
	  t.add(v);
	  v
      }) }
  -- provide a store interface just for compatibility with existing tables
  method store(t@:m_keyed_set[`Key,`Value], key:Key, value:Value,
	       if_absent:&():void):void {
      assert(value.has_key(key), "should have the right key");
      t.add(value);
  }

  --DOC Mutable keyed sets also support a `remove_match' operation that
  --DOC removes the element of the table whose key matches that of the
  --DOC argument element.
  signature remove_match(m_keyed_set[`Key,`Value], value:Value,
			 if_absent:&():`Else):Value|Else;
  method remove_match(t@:m_keyed_set[`Key,`Value], value:Value):Value {
      remove_match(t, value, {
	  error("value with matching key not found in table") }) }
  signature copy_empty(m_keyed_set[`Key,`Value]):m_keyed_set[Key,Value];
  method copy(t@:m_keyed_set[`Key,`Value]):m_keyed_set[Key,Value] {
      let copy:m_keyed_set[Key,Value] := t.copy_empty;
      t.do(&(x:Value){ copy.add_nonmember(x); });
      copy }
  signature add_nonmember(m_keyed_set[`Key,`Value], Value):void;


----------
-- A list-based implementation of keyed_sets
----------

--DOC A linked-list based implementation of `m_keyed_sets'.
template object list_keyed_set[Key <= comparable[Key],
			       Value <= keyed_comparable[Key]]
						isa m_keyed_set[Key,Value];
  private field elems(@:list_keyed_set[`Key,`Value]):m_list[Value]
  	:= new_m_list[Value]();

  method collection_name(@:list_keyed_set[`Key,`Value]):string {
      "list_keyed_set" }

  method length(t@:list_keyed_set[`Key,`Value]):int { t.elems.length }
  method is_empty(t@:list_keyed_set[`Key,`Value]):bool { t.elems.is_empty }

  method do(t@:list_keyed_set[`Key,`Value], c:&(Value):void):void {
      do(t.elems, &(e:Value){ eval(c, e); });
  }

  method add(m@:list_keyed_set[`Key,`Value], x:Value):void {
      -- (this code walks lists in an implementation-dependent way; yuck)
      let l:m_list[Value] := m.elems;
      let var link:simple_list[Value] := l.front;
      while({ non_empty(link) }, {
	  if(link.first.is_same_key(x), {
	      -- found the old elem; replace it with the new one
	      link.first := x;
	      ^;
	  });
	  link := link.rest;
      });
      -- not already present; just add it
      l.add(x);
  }
  method add_nonmember(m@:list_keyed_set[`Key,`Value], x:Value):void {
      -- assume the element isn't already present.  (but what about the key?!)
      m.elems.add(x);
  }

  -- remove the element whose key is the same as the argument key
  method remove_key(t@:list_keyed_set[`Key,`Value], key:Key,
		    if_absent:&():`Else):Value|Else {
      t.elems.remove_and_return_one(&(x:Value){ x.has_key(key) }, if_absent) }

  -- remove the element with the same key as the argument value
  method remove_match(t@:list_keyed_set[`Key,`Value], x:Value,
			 if_absent:&():`Else):Value|Else {
      t.remove_key(x.key, if_absent) }

  -- remove the element that's equal to the argument value
  method remove(t@:list_keyed_set[`Key,`Value <= comparable[Value]], x:Value,
		if_absent:&():void):void {
      t.elems.remove(x, if_absent) }

  method remove_any(t@:list_keyed_set[`Key,`Value],
		    if_empty:&():`Else):Value|Else {
      t.elems.remove_any(if_empty) }

  method remove_all(t@:list_keyed_set[`Key,`Value]):void {
      t.elems.remove_all;
  }

  method new_list_keyed_set[Key <= comparable[Key],
			    Value <= keyed_comparable[Key]](
	):list_keyed_set[Key,Value] {
      concrete object isa list_keyed_set[Key,Value] }

  method copy_empty(c@:list_keyed_set[`Key,`Value]):list_keyed_set[Key,Value] {
      new_list_keyed_set[Key,Value]() }


----------
-- An implementation of keyed_sets for hashable keys
----------

--DOC The hashing-based keyed sets require the keys to be hashable,
--DOC implying that the elements of the keyed set must be subtypes of
--DOC `keyed_hashable', not just `keyed_comparable'.
--DOC `chained_hash_keyed_set' is an implementation of
--DOC mutable keyed sets using closed hashing; `hash_keyed_set' is an
--DOC implementation of mutable keyed sets based on open hashing.
--DOC The hashing-based keyed set implementations allow a guess at a
--DOC maximum size to be provided when the collection is created. As with
--DOC all hashing-based implementations, however, the keyed set will
--DOC automatically resize itself if it grows too large or small.

module ChainedKeyedSet {

abstract object keyed_hashable[Key <= hashable[Key]] isa keyed_comparable[Key];
  method hash_key(k@:keyed_hashable[`Key], range:int):int {
      hash(k.key, range) }


template object chained_hash_keyed_set[Key <= hashable[Key],
				       Value <= keyed_hashable[Key]]
					    isa m_keyed_set[Key,Value];
  private var field buckets(t@:chained_hash_keyed_set[`Key,`Value]
			    ):m_indexed[m_keyed_set[Key,Value]] :=
	     t.new_buckets(default_chained_hash_keyed_set_size);
  private put var field length(t@:chained_hash_keyed_set[`Key,`Value]):int := 0;

  method collection_name(@:chained_hash_keyed_set[`Key,`Value]):string {
      "chained_hash_keyed_set" }

  private method bucket_key(t@:chained_hash_keyed_set[`Key,`Value], key:Key
			    ):m_keyed_set[Key,Value] {
      t.buckets ! hash(key, t.buckets.length) }
  private method bucket_with_key(t@:chained_hash_keyed_set[`Key,`Value], x:Value
				 ):m_keyed_set[Key,Value] {
      t.buckets ! hash_key(x, t.buckets.length) }

  method do(t@:chained_hash_keyed_set[`Key,`Value], c:&(Value):void):void {
      do(t.buckets, &(b:m_keyed_set[Key,Value]){ do(b, c); });
  }

  method do_allowing_updates(t@:chained_hash_keyed_set[`Key,`Value],
			     c:&(Value):void):void {
      -- disable resizing during iteration
      allowing_updates.begin_allowing_updates(t);
      unwind_protect({
	  do(t, c);
      }, {
	  allowing_updates.done_allowing_updates(t);
	  if(t.should_grow, {
	      t.resize(t.grown_size);
	  }, {
	      if(t.should_shrink, {
		  t.resize(t.shrunk_size);
	      });
	  });
      });
  }

  method includes(t@:chained_hash_keyed_set[`Key,`Value <= comparable[Value]],
		  x:Value):bool {
      t.bucket_with_key(x).includes(x) }

  method fetch(t@:chained_hash_keyed_set[`Key,`Value], key:Key,
	       if_absent:&():Value):Value {
      fetch(bucket_key(t, key), key, if_absent) }

  method match(t@:chained_hash_keyed_set[`Key,`Value], v:Value,
	       if_absent:&():Value):Value {
      match(bucket_with_key(t, v), v, if_absent) }

  method add(t@:chained_hash_keyed_set[`Key,`Value], x:Value):void {
      let b:m_keyed_set[Key,Value] := bucket_with_key(t, x);
      let old_length:int := b.length;
      b.add(x);
      t.length := t.length - old_length + b.length;
      if(t.should_grow, { t.resize(t.grown_size); });
  }
  method add_nonmember(t@:chained_hash_keyed_set[`Key,`Value], x:Value):void {
      -- assume the element isn't already present
      let b:m_keyed_set[Key,Value] := bucket_with_key(t, x);
      b.add_nonmember(x);
      t.length := t.length.succ;
      if(t.should_grow, { t.resize(t.grown_size); });
  }

  method remove_key(t@:chained_hash_keyed_set[`Key,`Value], key:Key,
		    if_absent:&():`Else):Value|Else {
      let b:m_keyed_set[Key,Value] := bucket_key(t, key);
      let old_length:int := b.length;
      let x:Value := b.remove_key(key, { ^ eval(if_absent) });
      t.length := t.length - old_length + b.length;
      if(t.should_shrink, { t.resize(t.shrunk_size); });
      x }
  method remove_match(t@:chained_hash_keyed_set[`Key,`Value], x:Value,
		      if_absent:&():`Else):Value|Else {
      let b:m_keyed_set[Key,Value] := bucket_with_key(t, x);
      let old_length:int := b.length;
      let v:Value := b.remove_match(x, { ^ eval(if_absent) });
      t.length := t.length - old_length + b.length;
      if(t.should_shrink, { t.resize(t.shrunk_size); });
      v }
  method remove(t@:chained_hash_keyed_set[`Key,`Value <= comparable[Value]],
		x:Value, if_absent:&():void):void {
      let b:m_keyed_set[Key,Value] := bucket_with_key(t, x);
      let old_length:int := b.length;
      b.remove(x, { eval(if_absent); ^ });
      t.length := t.length - old_length + b.length;
      if(t.should_shrink, { t.resize(t.shrunk_size); });
  }

  method remove_any(t@:chained_hash_keyed_set[`Key,`Value],
		    if_empty:&():`Else):Value|Else {
      t.buckets.do(&(ms:m_keyed_set[Key,Value]){
	  if(ms.non_empty, {
	      t.length := t.length.pred;
	      let result:Value := remove_any(ms);
	      if(t.should_shrink, { t.resize(t.shrunk_size); });
	      ^ result
	  });
      });
      eval(if_empty) }

  method remove_all(t@:chained_hash_keyed_set[`Key,`Value]):void {
      t.length := 0;
      if(t.should_shrink, {
	  -- will create fresh, empty buckets
	  t.resize(t.shrunk_size);
      }, {
	  -- need to clear those buckets that remain
	  t.buckets.do(&(ms:m_keyed_set[Key,Value]){ ms.remove_all; });
      });
  }

  method remove_if(t@:chained_hash_keyed_set[`Key,`Value],
		   pred:&(Value):bool):int {
      let var count:int := 0;
      t.buckets.do(&(b:m_keyed_set[Key,Value]){
	  count := count + b.remove_if(pred);
      });
      t.length := t.length - count;
      if(t.should_shrink, { t.resize(t.shrunk_size); });
      count
  }

  method remove_keys_if(t@:chained_hash_keyed_set[`Key,`Value],
			 pred:&(Key):bool):int {
      let var count:int := 0;
      t.buckets.do(&(b:m_keyed_set[Key,Value]){
	  count = count + b.remove_keys_if(pred);
      });
      t.length = t.length - count;
      if(t.should_shrink, { t.resize(t.shrunk_size); });
      count;
  }

  private method should_grow(t@:chained_hash_keyed_set[`Key,`Value]):bool {
      -- more than one elem per bucket...
      allowing_updates.updates_allowed(t).not &
	{ t.length > 5 & { t.length > t.buckets.length } } }
  private method grown_size(t@:chained_hash_keyed_set[`Key,`Value]):int {
      average(t.buckets.length * 2, t.length) }

  private method should_shrink(t@:chained_hash_keyed_set[`Key,`Value]):bool {
      -- less than 1/5 full...
      allowing_updates.updates_allowed(t).not &
	{ t.buckets.length > 8 & { t.length * 5 < t.buckets.length } } }
  private method shrunk_size(t@:chained_hash_keyed_set[`Key,`Value]):int {
      average(t.buckets.length / 2, t.length) }

  private method resize(t@:chained_hash_keyed_set[`Key,`Value],
			new_size:int):void {
      let old_len:int := t.length;
      let old_buckets:m_indexed[m_keyed_set[Key,Value]] := t.buckets;
      t.buckets := t.new_buckets(new_size);
      t.length := 0;	-- initially empty
      if(old_len > 0, {
	  old_buckets.do(&(s:m_keyed_set[Key,Value]){
	      s.do(&(x:Value){ t.add_nonmember(x); });
	  });
      });
      assert(old_len = t.length, "should have the same elements");
  }

  protected method new_buckets(t@:chained_hash_keyed_set[`Key,`Value], size:int
			       ):m_indexed[m_keyed_set[Key,Value]] {
      new_m_vector_init[m_keyed_set[Key,Value]](max(1,size),
					      &(i:int){ t.new_bucket }) }
  protected method new_bucket(t@:chained_hash_keyed_set[`Key,`Value]
			      ):m_keyed_set[Key,Value] {
      new_list_keyed_set[Key,Value]() }

  let var default_chained_hash_keyed_set_size:int := 1;

  method new_chained_hash_keyed_set[Key <= hashable[Key],
				    Value <= keyed_hashable[Key]](
	):chained_hash_keyed_set[Key,Value] {
      new_chained_hash_keyed_set[Key,Value](
	    default_chained_hash_keyed_set_size) }
  method new_chained_hash_keyed_set[Key <= hashable[Key],
				    Value <= keyed_hashable[Key]](
	size:int):chained_hash_keyed_set[Key,Value] {
      let t:chained_hash_keyed_set[Key,Value] :=
	concrete object isa chained_hash_keyed_set[Key,Value];
      t.buckets := t.new_buckets(size);
      t }

  method copy_empty(c@:chained_hash_keyed_set[`Key,`Value])
     :chained_hash_keyed_set[Key,Value] {
      new_chained_hash_keyed_set[Key,Value](c.buckets.length) }

} -- end module ChainedKeyedSet