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

(--DOC
  Tables map from keys to values (in other words, a table is a set of
  key/value pairs) such that a given key maps to at most one value. A
  table can be viewed as a collection of values, in some unspecified
  order. As such, operations like `length', `is_empty', `do', `pick_any',
  `includes', `find', `copy', etc., are inherited from `collection', and
  operate on the values part of the table.

  A `table' is `comparable' if both its keys and values are
  `comparable'.  Two tables are equal (`=') if they have the same set of
  keys and corresponding keys map to equal values.
--)

abstract object table[Key, Value] isa collection[Value];
extend type table[`Key,`Value] subtypes table[Key, `Value1 >= Value];


----------
-- Iteration behavior
----------

--DOC The control structure `do_associations[_allowing_updates]' forms
--DOC the heart of a table, iterating through the keys and values of the
--DOC table in pairs. The `keys_do[_allowing_updates]' methods iterate
--DOC through just the keys.

signature do_associations(table[`Key,`Value], &(Key,Value):void):void;
method do_associations_allowing_updates(t@:table[`Key,`Value],
					c:&(Key,Value):void):void {
    do_associations(t, c);
}
method do(t@:table[`Key,`Value], c:&(Value):void):void (** inline **) {
    do_associations(t, &(k:Key, v:Value){ eval(c, v); });
}
method do_allowing_updates(t@:table[`Key,`Value],
			   c:&(Value):void):void (** inline **) {
    do_associations_allowing_updates(t, &(k:Key, v:Value){ eval(c, v); });
}

method keys_do(t@:table[`Key,`Value], c:&(Key):void):void {
    t.do_associations(&(k:Key, v:Value){ eval(c, k); });
}
method keys_do_allowing_updates(t@:table[`Key,`Value], c:&(Key):void):void {
    t.do_associations_allowing_updates(&(k:Key, v:Value){ eval(c, k); });
}


----------
-- Key/Value accessing behavior
----------

--DOC The `fetch' methods support table lookup; the optional closure
--DOC argument is invoked if the key isn't found. The infix `!' operator can
--DOC be used instead of `fetch', e.g.:
--DOC <EXAMPLE>
--DOC   t!n1 + t!n2
--DOC <ENDEXAMPLE>

signature fetch(table[`Key,`Value], key:Key, if_absent:&():Value):Value;
implementation fetch(t@:table[`Key <= comparable[Key], `Value], key:Key,
		     if_absent:&():Value):Value {
    do_associations(t, &(k:Key, v:Value){ if(key = k, { ^ v }); });
    eval(if_absent) }
method fetch(t@:table[`Key,`Value], key:Key):Value {
    fetch(t, key, { error("key not found in table") }) }

-- factor this short-hand out, primarily for things like env that aren't
-- full tables but that still support the fetch/store, !/set_! interface
abstract object table_like[Key,Value];
  signature fetch(table_like[`Key,`Value], Key):Value;
  method !(t@:table_like[`Key,`Value], key:Key):Value { fetch(t, key) }
  precedence ! left_associative above *;
extend type table_like[`Key,`Value] subtypes table_like[Key, `Value1 >= Value];
extend table[`Key,`Value] isa table_like[Key,Value];


--DOC The `find_key' method does reverse table lookup:  given a value, find
--DOC a key that maps to that value. The `includes_key' method tests
--DOC whether a key is defined, and the `keys[_{set,list}]' operations
--DOC return the collection of keys in the table.

method find_key(t@:table[`Key,`Value <= comparable[Value]], value:Value):Key {
    find_key(t, value, { error("value not found") }) }
method find_key(t@:table[`Key,`Value <= comparable[Value]],
		value:Value, if_absent:&():Key):Key {
    do_associations(t, &(k:Key, v:Value){ if(value = v, { ^ k }); });
    eval(if_absent) }

method pick_any_key(t@:table[`Key,`Value]):Key {
    pick_any_key(t, { error("table is empty") }) }
method pick_any_key(t@:table[`Key,`Value], if_empty:&():`T):Key|T {
    t.do_associations(&(k:Key,v:Value){ ^ k });
    eval(if_empty) }

method includes_key(t@:table[`Key,`Value], key:Key):bool {
    t.fetch(key, { ^ false });
    true }

method keys(t@:table[`Key,`Value]):collection[Key] {
    -- can't return a set, since Key isn't necessarily comparable
    let keys:m_bag[Key] := new_list_bag[Key]();
    t.keys_do(&(k:Key){ keys.add(k); });
    keys }

method keys_set(t@:table[`Key <= comparable[Key],`Value]):set[Key] {
    let keys:m_set[Key] := new_list_set[Key]();
    t.keys_do(&(k:Key){ keys.add_nonmember(k); });
    keys }

-- this method imposes an ordering on the (possibly unordered) set of keys
method keys_list(t@:table[`Key,`Value]):ordered_collection[Key] {
    let keys:extensible_sequence[Key] := new_m_list[Key]();
    t.keys_do(&(k:Key){ keys.add_last(k) });
    keys }


extend table[`Key, `Value <= comparable[Value]]
					isa comparable[table[Key,Value]];
method =(t1@:table[`Key, `Value <= comparable[Value]],
	 t2@:table[Key, Value]):bool {
    t1 == t2 |
    { t1.length = t2.length & {
	do_associations(t1, &(k:Key, v:Value){
	    if(fetch(t2, k, { ^ false }) !=  v, { ^ false }); });
	true } } }

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

method values_print_string(t@:table[`Key,`Value]):string {
    let var str:string := "";
    let var first:bool := true;
    do(t, &(v:Value){
	if_false(first, { str := str || t.elem_separator; });
    	str := str || v.print_string;
	first := false;
    });
    str }
method elems_print_string(t@:table[`Key,`Value]):string {
    let var str:string := "";
    let var first:bool := true;
    do_associations(t, &(k:Key,v:Value){
	if_false(first, { str := str || t.elem_separator; });
    	str := str || k.print_string || ": " || v.print_string;
	first := false;
    });
    str }
method elems_print(t@:table[`Key,`Value]):void {
    let var first:bool := true;
    do_associations(t, &(k:Key,v:Value){
	if_false(first, { t.elem_separator.print; });
    	k.print; ": ".print; v.print;
	first := false;
    });
}


----------
-- immutable table
----------

--DOC Tables are refined into immutable and mutable varieties. An
--DOC `i_table' is immutable.

abstract object i_table[Key, Value] isa table[Key, Value];
  extend type i_table[`Key, `Value] subtypes i_table[Key, `Value1 >= Value];
  method copy(t@:`T <= i_table[`Key,`Value]):T { t }


----------
-- mutable table
----------

--DOC An `m_table' supports changing bindings of keys to values through
--DOC the `store' or `set_!' method, but not necessarily adding new
--DOC keys or removing old ones.  (See `removable_table' for operations
--DOC for removing keys from tables.)

-- subclass ip_node_mappings relies on the fact that all element
-- mutators are implemented in terms of store(key, value, if_absent)

abstract object m_table[Key, Value] isa table[Key, Value];
signature store(m_table[`Key,`Value], key:Key, value:Value,
		if_absent:&():void):void;
method store(t@:m_table[`Key,`Value], key:Key, value:Value):void {
    store(t, key, value, { error("key not defined in table") });
}
method store_no_dup(t@:m_table[`Key,`Value], key:Key, value:Value):void {
    store(t, key, value);
}

-- factor this short-hand out, primarily for things like env that aren't
-- full tables but that still support the fetch/store, !/set_! interface
abstract object m_table_like[Key,Value] isa table_like[Key,Value];
  signature store(m_table_like[`Key,`Value], Key, Value):void;
  method set_!(t@:m_table_like[`Key,`Value], key:Key, value:Value):void {
      store(t, key, value);
  }
extend m_table[`Key,`Value] isa m_table_like[Key,Value];

--DOC An `m_table' also supports a variation of `fetch',
--DOC `fetch_or_init', that, if the key is not found, computes and
--DOC adds a default value to the table and returns that value;
--DOC `fetch_or_init' abstracts a very common table-manipulation
--DOC idiom. Method `copy_empty', given a (mutable) table, returns
--DOC an empty mutable table of the same kind.

method fetch_or_init(t@:m_table[`Key,`Value], key:Key,
		     if_init:&():Value):Value {
    t.fetch(key, {
	let v:Value := eval(if_init);
	t!key := v;
	v
    }) }
method copy(t@:m_table[`Key,`Value]):m_table[Key,Value] {
    let copy:m_table[Key,Value] := t.copy_empty;
    t.do_associations(&(key:Key,value:Value){ copy!key := value; });
    copy }
signature copy_empty(m_table[`Key,`Value]):m_table[Key,Value];


----------
-- removable table
----------

--DOC A `removable_table' supports removing bindings from the table,
--DOC given the key to remove. (A table that inherits from
--DOC `removable_collection', on the other hand, supports removing bindings
--DOC from the table, given the value.)

-- subclass ip_node_mappings relies on the fact that all key removals
-- are implementedin terms of remove_key(key, if_absent)

abstract object removable_table[Key, Value] isa table[Key, Value];
extend type removable_table[`Key,`Value]
			subtypes removable_table[Key, `Value1 >= Value];
signature remove_key(removable_table[`Key,`Value], key:Key,
		     if_absent:&():`Value):Value;
method remove_key(t@:removable_table[`Key,`Value], key:Key):Value {
    remove_key(t, key, { error("key not defined in table") }) }
method remove_all(t@:removable_table[`Key,`Value]):void {
    t.keys_do_allowing_updates(&(k:Key){ t.remove_key(k); });
}
method remove_keys_if(t@:removable_table[`Key,`Value],
       	    	    	pred:&(Key):bool):int {
    let var count:int := 0;
    t.do_associations_allowing_updates(&(k:Key, v:Value){
	if(eval(pred, k),
	   { t.remove_key(k);
	     count := count + 1; });
    });
    count
}
method remove_if(t@:removable_table[`Key,`Value],
		 pred:&(Value):bool):int {
    let var count:int := 0;
    t.do_associations_allowing_updates(&(k:Key, v:Value){
        if(eval(pred, v),
	   { t.remove_key(k);
	     count := count + 1; });
    });
    count
}
signature copy_empty(removable_table[`Key,`Value]):removable_table[Key,Value];


----------
-- removable mutable table
----------

(--DOC
  `m_removable_table' is the commonly used kind of table, which
  supports addition, removal,  and modification of key-to-value
  bindings. Both addition and modification of bindings is done via
  `store' or `set_!'.  (For non-table collections, addition of
  elements is done via `add' methods.)  The `set_!' method can be
  invoked using the assignment message sugar:
  <EXAMPLE>
    t ! key := value;
  <ENDEXAMPLE>
  Removal of bindings is done via the inherited `remove_key' et al. methods.
--)

abstract object m_removable_table[Key, Value]
	isa m_table[Key, Value], removable_table[Key, Value];
  signature copy(m_removable_table[`Key,`Value]):m_removable_table[Key,Value];
  signature copy_empty(m_removable_table[`Key,`Value]
		       ):m_removable_table[Key,Value];