(* 
 File: HashTable.sml

 Structure which provides abbreviations for identifiers used in 
 PEPA models by the modeller. 

 Note: this table can only store 2756 (=53*52) distinct identifiers
*)

structure HashTable :> HashTable = 
struct
  (* The abstract type for hashed strings *)
  type hashedstring = string

  (* gcla*)
  exception notinhashtable;
  exception defaultunhashfnused;

  (* The datatype for hash tables *)
  datatype hash_table = 
      empty 
    | node of (hash_table ref) * (string * string) * (hash_table ref)

  (* Two tables are used: one for hashing (ht) 
     and one for unhashing (ut) *)
  val ht = ref empty
  val ut = ref empty

  val chars = explode 
      ("abcdefghijklmnopqrstuvxwyz"^
       "ABCDEFGHIJKLMNOPQRSTUVXWYZ")
  val first_letter = ref (#" " :: chars)
  val second_letter = ref chars
  
  fun symconcat (#" ", symb) = str symb
    | symconcat (syma, symb) = implode [syma, symb]

  fun gensym () =
      case !second_letter of
        []     => (second_letter := chars; 
                   first_letter := tl (!first_letter);
                   gensym ())
      | h :: t =>  (second_letter := t; 
                    symconcat (hd (!first_letter), h))

  fun add gensym =
  let
     fun add_hash_table (t as ref empty) s = 
	 let val next_id = gensym ()
	  in t := node (ref empty, (s, next_id), ref empty);
	     next_id
	 end
       | add_hash_table (t as ref (node (l, (k, v), r))) s =
	   if s = k 
	   then v
	   else if s < k 
		then add_hash_table l s
		else add_hash_table r s
  in add_hash_table
  end

  fun print_hash_table (ref empty) = []
    | print_hash_table (ref (node (l, (k, v), r))) =
	(print_hash_table l @
       [print_key_value_pair (k, v)] @
	 print_hash_table r)
  and print_key_value_pair (k, v) = k^"->"^v
  and list_hash_table [] = ""
    | list_hash_table [x] = x ^ "\n"
    | list_hash_table (h::t) = h ^ ",\n" ^ list_hash_table t

  (* This function is exported from this structure *)
  fun hash s =
    if !Options.nohashing then s else 
    let val v = add gensym ht s
     in add (fn () => s) ut v; v
    end
 
  (* gcla - this is a hack to break a dependency loop, which mosml
  doesn't seem to like. This function is called to translate the
  returned hashtable value - but by default, it allows throws an
  exception, to allow the old code to kick in *)

  val translatefn = ref (fn s:string => (raise defaultunhashfnused; s));

  (* This function is exported from this structure *)
  fun literal s = s

  local
    val hd = hd o explode
    val tl = implode o tl o explode
    fun upto c "" = "" 
      | upto c s = if hd s = c then "" else str (hd s) ^ upto c (tl s)
    fun after c "" = "" 
      | after c s = if hd s = c then tl s else after c (tl s)
    fun ismin s = upto #"(" s = "min"
    fun ishidden s = upto #"{" s = "tau"
    val fst = upto #"," o after #"("
    val snd = upto #")" o after #","
  in
    (* This function is exported from this structure *)
    fun unhash s = 
       if !Options.nohashing then s else 
	  if s = "infty" 
	     then (Error.warning "`infty' found in rates"; "infty")
	  else 
	     if ismin s then
		(Error.warning ("active-active synchronisation found: "^s); expand s)
	     else if ishidden s then s
		  else 
		     (* gcla *)
		     let
			val uhs = add (fn () => s^"??error??") ut s
		     in
			(((!translatefn) uhs) handle _ =>
			   uhs)
		     end
    and expand s = "min(" ^ unhash (fst s) ^ "," ^ unhash (snd s) ^ ")"
  end

  (* This function is exported from this structure *)
  fun show s = s

  (* This function is exported from this structure *)
  fun hide a = "tau{" ^ unhash a ^ "}"

  (* This function is exported from this structure *)
  fun min (s, "infty") = s
    | min ("infty", s) = s
    | min (s,t)        = "min(" ^ show s ^ "," ^ show t ^ ")"

  (* This function is exported from this structure *)
  fun show_hash_table () = list_hash_table (print_hash_table ht)

  (* This function is exported from this structure *)
  fun show_unhash_table () = list_hash_table (print_hash_table ut)

end;
