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


-- These implement wrappers around table data structures that implement
-- a kind of copy-on-write: copy is cheap (sharing the old structure),
-- stores don't modify the old structure, and reads may or may not make copies
-- into the local structure, depending on whether the read-caching version is
-- used or not.

-- A wrapper is used so that copied tables can freeze the shared part of the
-- table, and other tables will be able to introduce new local tables as
-- needed.


(** debug **)

-- first, some statistics-gathering code
let var num_fetches:int := 0;
let var num_local_fetches:int := 0;
let var num_recursive_fetches:int := 0;
let var num_caching_fetches:int := 0;

let var num_stores:int := 0;

let var num_removes:int := 0;
let var num_remove_copies:int := 0;

let var num_copies:int := 0;
let var num_copy_saves:int := 0;
let var num_freezes:int := 0;

method clear_copy_on_write_table_stats():void {
    num_fetches := 0;
    num_local_fetches := 0;
    num_recursive_fetches := 0;
    num_caching_fetches := 0;
    num_stores := 0;
    num_removes := 0;
    num_remove_copies := 0;
    num_copies := 0;
    num_copy_saves := 0;
    num_freezes := 0;
}
method print_copy_on_write_table_stats():void {
    print(["Out of ", num_fetches.print_string, " fetches, ",
	   num_local_fetches.print_string, " were local hits;\n",
	   "  the others required an average of ",
	   (num_recursive_fetches /_float (num_fetches - num_local_fetches))
	     .print_string(1), " recursive probes.\n",
	   num_caching_fetches.print_string,
	   " recursive fetches were cached.\n",
	   num_stores.print_string, " stores occurred.\n",
	   "During ", num_removes.print_string, " removes, ",
	   num_remove_copies.print_string,
	   " elements were copied from frozen tables.\n",
	   "During ", num_copies.print_string, " copies, ",
	   num_copy_saves.print_string,
	   " elements were avoided being copied;\n",
	   "  ", num_freezes.print_string, " copies required freezes.\n"
	   ].flatten);
}


-- now, the implementations:

template object copy_on_write_table[Key <= comparable[Key], Value] 
						isa m_table[Key, Value];
  var field frozen_table(@:copy_on_write_table[`Key,`Value]):table[Key,Value];
  var field local_table(@:copy_on_write_table[`Key,`Value]):m_table[Key,Value];

  method do_associations(t@:copy_on_write_table[`Key,`Value],
			 c:&(Key,Value):void):void {
      t.local_table.do_associations(c);
      -- only visit those elements of frozen_table that aren't overridden in
      -- local table
      t.frozen_table.do_associations(&(k:Key,v:Value){
	  if_false(t.local_table.includes_key(k), {
	      eval(c, k, v);
	  });
      });
  }
  method do_associations_allowing_updates(t@:copy_on_write_table[`Key,`Value],
					  c:&(Key,Value):void):void {
      -- mark this as being in the middle of iteration
      allowing_updates.begin_allowing_updates(t);
      unwind_protect({
          -- remember the tables before iterating, in case some
	  -- remove_keys are done which can modify them in weird ways
          let local_table := t.local_table;
	  let frozen_table := t.frozen_table;
          local_table.do_associations_allowing_updates(c);
          -- only visit those elements of frozen_table that aren't overridden
	  -- in local table.  and don't need to worry about allowing updates
	  -- to the frozen table.
          frozen_table.do_associations(&(k:Key,v:Value){
	      if_false(local_table.includes_key(k), {
	          eval(c, k, v);
	      });
          });
      }, {
	  allowing_updates.done_allowing_updates(t);
      });
  }

  method length(t@:copy_on_write_table[`Key,`Value]):int {
      if(t.frozen_table.is_empty, {
	  ^ t.local_table.length
      });
      -- can't just sum lengths, since local table can shadow entries in frozen
      -- table
      let var length:int := 0;
      t.do_associations(&(k:Key, v:Value){ length := length.succ; });
      length }
  method is_empty(t@:copy_on_write_table[`Key,`Value]):bool {
      t.local_table.is_empty & { t.frozen_table.is_empty } }

  method elems_print_string(t@:copy_on_write_table[`Key,`Value]):string {
      let var str:string := t.local_table.elems_print_string || " | ";
      -- only visit those elements of frozen_table that aren't overridden in
      -- local table
      let var first:bool := false;
      t.frozen_table.do_associations(&(k:Key, v:Value){
	  if_false(t.local_table.includes_key(k), {
	      if(first, { first := false; },
		 { str := str || t.elem_separator; });
	      str := str || k.print_string || ": " || v.print_string;
	  });
      });
      str }

  method fetch(t@:copy_on_write_table[`Key,`Value], key:Key,
	       if_absent:&():Value):Value {
      num_fetches := num_fetches.succ;
      let value:Value := t.local_table.fetch(key, {
	  ^ t.frozen_table.recursive_fetch(key, if_absent)
      });
      num_local_fetches := num_local_fetches.succ;
      value }
  private method recursive_fetch(t@:table[`Key,`Value], key:Key,
				 if_absent:&():Value):Value {
      num_recursive_fetches := num_recursive_fetches.succ;
      t.fetch(key, if_absent) }
  private method recursive_fetch(t@:copy_on_write_table[`Key,`Value], key:Key,
				 if_absent:&():Value):Value {
      num_recursive_fetches := num_recursive_fetches.succ;
      t.local_table.fetch(key, {
	  t.frozen_table.recursive_fetch(key, if_absent) }) }


  method store(t@:copy_on_write_table[`Key,`Value], key:Key, value:Value,
	       if_absent:&():void):void {
      num_stores := num_stores.succ;
      t.local_table.store(key, value, if_absent);
  }
  method store_no_dup(t@:copy_on_write_table[`Key,`Value], key:Key,
		      value:Value):void {
      num_stores := num_stores.succ;
      t.local_table.store_no_dup(key, value);
  }

  method copy(t@:copy_on_write_table[`Key,`Value]
	      ):copy_on_write_table[Key,Value] {
      num_copies := num_copies.succ;
      if(t.local_table.non_empty, {
	  -- need to freeze local table first, so that modifications to this
	  -- table after the copy don't mess up the copy's state
	  num_freezes := num_freezes.succ;
	  t.frozen_table := t.copy(t.frozen_table, t.local_table);
	  t.local_table := t.local_table.copy_empty;
      });
      num_copy_saves := num_copy_saves + t.frozen_table.length;
      -- now share the frozen table
      t.copy(t.frozen_table, t.local_table.copy_empty) }

  method copy_empty(t@:copy_on_write_table[`Key,`Value]
		    ):copy_on_write_table[Key,Value] {
      t.copy(new_assoc_table[Key,Value](), t.local_table.copy_empty) }

  -- overridden in subclasses to provide a different result class
  private method copy(t@:copy_on_write_table[`Key,`Value],
		      frozen:table[Key,Value], local:m_table[Key,Value]
		      ):copy_on_write_table[Key,Value] {
      concrete object isa copy_on_write_table[Key,Value] {
	  frozen_table := frozen, local_table := local } }

  method new_copy_on_write_table(t:m_table[`Key <= comparable[Key],`Value]
				 ):copy_on_write_table[Key,Value] {
      concrete object isa copy_on_write_table[Key,Value] {
	  frozen_table := t.copy, local_table := t.copy_empty } }


-- this version caches fetched values in the local table, for faster future
-- fetches at a cost in duplicated space

template object caching_copy_on_write_table[Key <= comparable[Key], Value]
					isa copy_on_write_table[Key, Value];
  method do_associations(t@:caching_copy_on_write_table[`Key,`Value],
			 c:&(Key,Value):void):void {
      -- mark this as being in the middle of iteration, so we disable caching
      -- (which can have weird side-effects that break iterating through all
      --  elements exactly once)
      allowing_updates.begin_allowing_updates(t);
      unwind_protect({
          resend;
      }, {
	  allowing_updates.done_allowing_updates(t);
      });
  }

  method fetch(t@:caching_copy_on_write_table[`Key,`Value], key:Key,
	       if_absent:&():Value):Value {
      num_fetches := num_fetches.succ;
      let value:Value := t.local_table.fetch_or_init(key, {
	  let v:Value := t.frozen_table.recursive_fetch(key, if_absent);
	  num_caching_fetches := num_caching_fetches.succ;
	  if(allowing_updates.updates_allowed(t), {
	      -- we're iterating through this collection, so don't cache
	      ^ v
	  });
	  num_local_fetches := num_local_fetches.pred; -- undo later increment
	  v });
      num_local_fetches := num_local_fetches.succ;
      value }

  -- an alternative interface to disable caching,
  -- if the argument is a caching table
  method fetch_no_cache(t@:table[`Key,`Value], key:Key,
			if_absent:&():Value):Value {
      t.fetch(key, if_absent) }
  method fetch_no_cache(t@:caching_copy_on_write_table[`Key,`Value], key:Key,
			if_absent:&():Value):Value {
      -- don't cache, just lookup
      resend }

  private method copy(t@:caching_copy_on_write_table[`Key,`Value],
		      frozen:table[Key,Value], local:m_table[Key,Value]
		      ):caching_copy_on_write_table[Key,Value] {
      concrete object isa caching_copy_on_write_table[Key,Value] {
	  frozen_table := frozen, local_table := local } }

  method new_caching_copy_on_write_table(
	t:m_table[`Key <= comparable[Key],`Value]
	):caching_copy_on_write_table[Key,Value] {
      concrete object isa caching_copy_on_write_table[Key,Value] {
	  frozen_table := t.copy, local_table := t.copy_empty } }


-- removable copy-on-write table

template object copy_on_write_removable_table[Key <= comparable[Key], Value]
	isa copy_on_write_table[Key, Value], m_removable_table[Key, Value];
  -- [need to fix this to make the type of local_table be a parameter of
  --  the copy_on_write_*_table object, as in mapped/filtered_table.]
  signature local_table(copy_on_write_removable_table[`Key, `Value]
			):m_removable_table[Key, Value];

  -- note that a key may be defined in both the local and the frozen table,
  -- e.g. due to overwriting stores in the local table or caching on fetches
  method remove_key(t@:copy_on_write_removable_table[`Key,`Value], key:Key,
		    if_absent:&():`Else):Value|Else {
      num_removes := num_removes.succ;
      if(t.frozen_table.includes_key(key), {
	  -- we can either copy the frozen table & then remove,
	  -- or we can remember that this key is removed; we do the former,
	  -- to avoid having to override a bunch of code that iterates through
	  -- the frozen table to skip removed keys.  plus it provides a kind of
	  -- caching for free.  but with frequent removes, copy-on-write tables
	  -- may not be very fast.
	  let var i:int := 0;
	  if(allowing_updates.updates_allowed(t) |
	     { allowing_updates.updates_allowed(t.local_table) }, {
	      -- we can't modify the local table in place, so
	      -- copy first and then update into the copy
	      t.local_table := t.local_table.copy;
	      i := i + t.local_table.length;
	  });
	  t.frozen_table.do_associations(&(k:Key,v:Value){
	      if_false(t.local_table.includes_key(k), {
		  t.local_table.store_no_dup(k, v);
		  i := i.succ;
	      });
	  });
	  num_remove_copies := num_remove_copies + i;
	  t.frozen_table := new_assoc_table[Key,Value]();
      });
      -- now remove and return the local key
      t.local_table.remove_key(key, if_absent) }

  method remove_all(t@:copy_on_write_removable_table[`Key,`Value]):void {
      t.frozen_table := new_assoc_table[Key,Value]();
      t.local_table.remove_all;
  }

  private method copy(t@:copy_on_write_removable_table[`Key,`Value],
		      frozen:table[Key,Value],
		      local:m_removable_table[Key,Value]
		      ):copy_on_write_removable_table[Key,Value] {
      concrete object isa copy_on_write_removable_table[Key,Value] {
	  frozen_table := frozen, local_table := local } }

  method new_copy_on_write_removable_table(
	t:m_removable_table[`Key <= comparable[Key],`Value]
	):copy_on_write_removable_table[Key,Value] {
      concrete object isa copy_on_write_removable_table[Key,Value] {
	  frozen_table := t.copy, local_table := t.copy_empty } }


template object caching_copy_on_write_removable_table[Key <= comparable[Key],
						      Value]
			isa copy_on_write_removable_table[Key, Value],
  			    caching_copy_on_write_table[Key, Value];
  private method copy(t@:caching_copy_on_write_removable_table[`Key,`Value],
		      frozen:table[Key,Value],
		      local:m_removable_table[Key,Value]
		      ):caching_copy_on_write_removable_table[Key,Value] {
      concrete object isa caching_copy_on_write_removable_table[Key,Value] {
	  frozen_table := frozen, local_table := local } }

  method new_caching_copy_on_write_removable_table(
	t:m_removable_table[`Key <= comparable[Key],`Value]
	):caching_copy_on_write_removable_table[Key,Value] {
      concrete object isa caching_copy_on_write_removable_table[Key,Value] {
	  frozen_table := t.copy, local_table := t.copy_empty } }