(* 
 File: RewLang.sml

 Interface to the logic of the reward language
 e.g.

   reward name = formula => expression

   attachment name = rewspec => (processname, integer)
*)

structure RewLang :> RewLang =
struct
  type Identifier = HashTable.hashedstring 

  datatype Formula =  
     Delta of Identifier
   | Nabla of Identifier
   | And of (Formula * Formula)
   | Or of (Formula * Formula)
   | Not of Formula
   | Mtt
   | Mff
   | Dia of (Identifier * Expressions.Aexp * Formula)
   | Box of (Identifier * Expressions.Aexp * Formula)

  type RewSpec = Formula * Expressions.Aexp

  type Attachment = RewSpec * (Pepa.Component * int)

  val hasAttachments = ref false;

  fun makeRewSpec (f, e) = (f,e):RewSpec

  fun makeAttachment (s, (p, i)) = (s,(p,i)):Attachment


  fun formulaToString (Delta i) = "/\\{" ^ (HashTable.unhash i) ^"}"
    | formulaToString (Nabla i) = "\\/{" ^ (HashTable.unhash i) ^"}"
    | formulaToString (And(f1,f2)) = (formulaToString(f1)) ^ " & " ^ (formulaToString(f2))
    | formulaToString (Or(f1,f2)) = (formulaToString(f1)) ^ " | " ^ (formulaToString(f2))
    | formulaToString (Not(f)) = "~" ^ (formulaToString(f))
    | formulaToString (Mtt) = "tt"
    | formulaToString (Mff) = "ff"
    | formulaToString (Dia(i,e,f)) = "<"^(HashTable.unhash(i))^","^(Expressions.toString(e))^">"^(formulaToString(f))
    | formulaToString (Box(i,e,f)) = "["^(HashTable.unhash(i))^","^(Expressions.toString(e))^"]"^(formulaToString(f))
     

  fun rewSpecToString (r:RewSpec) =
     (formulaToString(#1 r)) ^ " => " ^
	(Expressions.toString(#2 r))

  fun attachmentToString (r:Attachment) =
     (rewSpecToString (#1 r)) ^ " attached to " ^
	"(" ^ (Prettyprinter.print Prettyprinter.uncompressed (#1 (#2 r)))
	^ "," ^ (Int.toString (#2 (#2 r))) ^")"


  fun member x [] = false
    | member x (h::t) = if (x = h) then true else (member x t)

  fun filter f [] = []
    | filter f (h::t) = if (f h) then (h::(filter f t)) else (filter f t)

  fun subForRates P (Expressions.PLUS(e1,e2)) =
     (Expressions.PLUS((subForRates P e1), (subForRates P e2)))
    | subForRates P (Expressions.DIFF(e1,e2)) =
      (Expressions.DIFF((subForRates P e1), (subForRates P e2)))
    | subForRates P (Expressions.PROD(e1,e2)) =
      (Expressions.PROD((subForRates P e1), (subForRates P e2)))
    | subForRates P (Expressions.QUOT(e1,e2)) =
      (Expressions.QUOT((subForRates P e1), (subForRates P e2)))
    | subForRates P (Expressions.MIN(e1,e2)) =
      (Expressions.MIN((subForRates P e1), (subForRates P e2)))
    | subForRates P (e as (Expressions.RATE i)) =
      let
	 val dP = Derivatives.oldderivative [] P
	 val dPa = filter (fn ((a,r), n, P) => (i=a)) dP
	 val rs = map (fn ((a,r), n, P) => r) dPa
	 val rsum = foldl (fn (a,b) => Expressions.PLUS(a,b))
	    (Expressions.INTNUM(0)) rs
      in
	 Expressions.eval rsum
      end
    | subForRates P x = x
      
  fun evalReward P e = Expressions.eval (subForRates P e)


  fun prepl (Pepa.CONSTS(i,c,c')) p =
     Pepa.CONSTS(i,c,(prepl c' p))
    | prepl _ p = p

  fun modelCheck (Delta i) P = 
     let
	val dP = Derivatives.derivative [] P
	val acts = map (fn ((a,r), n, P) => a) dP
     in
	member i acts
     end
    | modelCheck (Nabla i) P = not (modelCheck (Delta i) P)
    | modelCheck (And(f1,f2)) P = (modelCheck f1 P) andalso (modelCheck f2 P)
    | modelCheck (Or(f1,f2)) P = (modelCheck f1 P) orelse (modelCheck f2 P)
    | modelCheck (Not(f)) P = not (modelCheck f P)
    | modelCheck (Mtt) P = true
    | modelCheck (Mff) P = false
    | modelCheck (Dia(i,e,f)) P =
      let
(* 	 val _ = (TextIO.output (TextIO.stdOut, "here's the model rl: "^(Prettyprinter.print Prettyprinter.verbose P)^"\n"); *)
(* 	  TextIO.flushOut TextIO.stdOut) *)
	    
	 val dP = Derivatives.oldderivative [] P
	 val dP' = map (fn (a,n,P) => (a,n,prepl (!Derivatives.proc) P)) dP
	 val dPa = filter (fn ((a,r), n, P) => (i=a)) dP'
	 val dPf = filter (fn ((a,r), n, P) => (modelCheck f P)) dPa
	 val rs = map (fn ((a,r), n, P) => r) dPf
	 val rsum = foldl (fn (a,b) => Expressions.PLUS(a,b))
	    (Expressions.INTNUM(0)) rs
      in
	 not (Expressions.lt (rsum, e))
      end
    | modelCheck (Box(i,e,f)) P = not (modelCheck (Dia(i,e,(Not(f)))) P)


  fun attachmentFileName id = (Files.jobName())^"-"^id^".rew"

  fun attachmentFileState (n, s) = "+P["^(Int.toString(n))^"]*"^s^"\n"
  fun attachmentFileInit id = id^" := 0\n"
  val attachmentFileEnd = ";\n"


  fun doAttachment h (rs as (f,e)) (key, P, realP, seen) =
     (let val newP = prepl (!Derivatives.proc) realP
      in
	 if (modelCheck f newP) then
	    TextIO.output(h, attachmentFileState(key, Expressions.toString(evalReward newP e)))
	 else
	    ()
      end
     )


  (* don't actually need the P any more *)
  fun processAttachment P (id, a:Attachment) =
     let
	val h = TextIO.openOut (attachmentFileName id)
	(* gcla later - ignore attachment data for now *)
	val _ = TextIO.output(h, attachmentFileInit(id))
	val _ = TextIO.output(TextIO.stdOut, "Processing attachment "^id^"...")
	val rs = (#1 a)
     in
	Table.treemap (!(#2 Table.table)) (doAttachment h rs) ;
	TextIO.output(h, attachmentFileEnd);
	TextIO.closeOut h;
	TextIO.output(TextIO.stdOut, "done.\n")
     end




end;

