(* 
 File: Table.sml

 Structure for the table which stores states of a PEPA model. 
*)

(* structure Table :> Table = *)
structure Table =
struct
  (* A local data structure which stores (number, state) pairs
     in an updateable ordered binary tree.
  *)
  datatype tree = 
    empty 
  (* gcla later - lots of mem! *)
  | node of tree ref * (int * string * Pepa.Component * bool ref) * tree ref

  val table as (size, data) = 
      (ref 0, ref empty)

  val tableOut = ref TextIO.stdOut

  fun initialize () = 
      (size := 0; data := empty; 
       tableOut := TextIO.openOut (Files.jobName() ^ ".table"))

  fun finalize () = TextIO.closeOut (!tableOut)

  fun showtree (data) = 
      (case !data of
        empty => []
      | (node (l, (n, d, reald, seen), r)) => showtree l @ [(n, d)] @ showtree r)
  fun show () = showtree (data)
  fun show_size () = !size

  fun extend_table() = size := !size + 1

  (* gcla - not a real map, output discarded *)
  fun treemap empty f = ()
    | treemap (node (l, (m as (key, P, realP, seen)), r)) f =
      (treemap (!l) f;
       f m;
       treemap (!r) f)

  fun printState (n, st) = 
      TextIO.output (!tableOut, Int.toString n ^ "\t" ^ st ^ "\n") 

  (* abstract code for referring to states *)
  (* gcla later - lots of mem! *)
  type stateCode = int * string * Pepa.Component
  datatype stateResult = 
    NotYetSeen of stateCode
  | AlreadySeen of stateCode

  fun addStateResult (P, realP, data) =
      case !data of
	empty => 
           (extend_table(); 
            data := node(ref empty, (!size, P, realP, ref false), ref empty);
            printState (!size, P);
            NotYetSeen (!size, P, realP))
      | node (l, (key, Q, realQ, ref seen), r) => 
	    if P < Q 
	    then addStateResult (P, realP, l)
	    else if Q < P 
		 then addStateResult (P, realP, r)
		 else if seen 
                      then AlreadySeen (key, P, realP)
                      else NotYetSeen (key, P, realP)

  fun addState P = addStateResult 
      (Prettyprinter.print Prettyprinter.compressed P, P, data)

  fun markAsSeen (P, data) =
      case !data of
	empty => 
           (Error.internal_error "invalid state code forged")
      | node (l, (key, Q, realQ, seen), r) => 
	    if P < Q 
	    then markAsSeen (P, l)
	    else if Q < P 
		 then markAsSeen (P, r)
		 else seen := true

  fun markSeen (_, P, realP) = markAsSeen (P, data)

(* gcla *)
(*   fun addSt (P, data) = *)
(*       case !data of *)
(* 	empty =>  *)
(*            (extend_table();  *)
(*             data := node(ref empty, (!size, P, ref false), ref empty)) *)
(*       | node (l, (_, Q, _), r) =>  *)
(* 	    if P < Q  *)
(* 	    then addSt (P, l) *)
(* 	    else if Q < P  *)
(* 		 then addSt (P, r) *)
(* 		 else () *)

(*   fun addifmissing P = addSt (P, data) *)

  fun getCode P = 
     case addState P of
	 AlreadySeen (key, _, _) => key
       | NotYetSeen (key, _, _) => key

  fun getc x (empty)    = (0, false)
    | getc x (node (l, (m, h, h2, _), r)) = 
      if x < h then getc x (!l) else 
      if x > h then getc x (!r) else (m, true)

  fun getcode x = getc x (!data)
end;
