(*
  File: Derivatives.sml

  Given an environment of definitions and a component, compute the one-step
  ((activity, rate), name) transitions leading to new components
*)
structure Derivatives :> Derivatives =
struct

   val proc = ref (Pepa.VAR(HashTable.hash("dummy")))
       

  local 
(*     fun lookup I [] =  *)
(*         Error.internal_error ("undeclared identifier: " ^ HashTable.unhash I) *)
(*       | lookup I ((Id, P) :: t) = if I = Id then P else *)
(* 	(TextIO.output(TextIO.stdOut, "have "^(HashTable.show I)^", rejected: "^(HashTable.show Id)^" \n"); *)
(* 	 TextIO.flushOut(TextIO.stdOut); *)
(* 	 (lookup I t) *)
(* 	 ) *)

    fun lookup I [] = Error.internal_error ("undeclared identifier: " ^ HashTable.unhash I)
      | lookup I ((Id, P) :: t) = if I = Id then P else (lookup I t)

    fun member x [] =  false
      | member x (h::t) = (x=h) orelse (member x t)

    fun filter [] [] = [] 
      | filter x []  = x
      | filter [] l  = []
      | filter (((a, r), n, P)::t) l = 
	    (if member a l 
	     then (HashTable.hide a, r)
	     else (a, r), n, P) :: (filter t l)

    and filterout [] [] = []
      | filterout x []  = x
      | filterout [] l  = []
      | filterout (((a, r), n, P)::t) l = 
	    if member a l 
	    then filterout t l
	    else ((a, r), n, P) :: (filterout t l)

    fun cooperations n [] dQ L = []
      | cooperations n dP [] L = []
      | cooperations n dP dQ [] = []
      | cooperations n (((a, r1), _, P as Pepa.COOP (P', _)) :: t1) 
	(((b, r2), _, Q as Pepa.COOP (Q', _)) :: t2) L =
	(if a = b andalso member a L 
(* 	    then [((a, HashTable.min(r1, r2)), n, Pepa.COOP (P' @ Q', L))]  *)
	    then [((a, Expressions.MIN(r1, r2)), n, Pepa.COOP (P' @ Q', L))] 
	 else [])  @  
	    (cooperations n [((a, r1), n, P)]  t2                 L) @
	    (cooperations n t1                 [((b, r2), n, Q)]  L) @
	    (cooperations n t1                 t2                 L)

    (* gcla - remove later *)
(*     fun cooperations n [] dQ L = [] *)
(*       | cooperations n dP [] L = [] *)
(*       | cooperations n dP dQ [] = [] *)
(*       | cooperations n (((a, r1), _, P) :: t1) (((b, r2), _, Q) :: t2) L = *)
(* 	  (if a = b andalso member a L  *)
(* 	      (* gcla - remove later *) *)
(* 	      (* then [((a, HashTable.min(r1, r2)), n, Pepa.COOP (P, Q, L))] *) *)
(* 	   then [((a, HashTable.min(r1, r2)), n, Pepa.COOP ([P, Q], L))]  *)
(* 	   else [])  @   *)
(* 	  (cooperations n [((a, r1), n, P)]  t2                 L) @ *)
(* 	  (cooperations n t1                 [((b, r2), n, Q)]  L) @ *)
(* 	  (cooperations n t1                 t2                 L) *)


    fun myand (a,b) = a andalso b
    fun myor (a,b) = a orelse b


(*     val procEnv = ref ([]:((Pepa.Identifier * Pepa.Component) list)) *)

(*     fun getProcEnv (Pepa.CONSTS (I, P, L)) = ((I, P) :: (getProcEnv L)) *)
(*       | getProcEnv _ = [] *)


    fun derivative E n (Pepa.PREFIX (a as (alpha, rate), P)) =  
		    [(a, n, P)]
      | derivative E n (Pepa.CHOICE (P, Q)) = 
		    (derivative E n P) @ (derivative E n Q)
      | derivative E n (Pepa.COOP ([], L)) = []
      | derivative E n (Pepa.COOP ([P], L)) = 
              map (fn (a, n, P') => (a, n, Pepa.COOP ([P'], L)))
	      (derivative E n P)
      | derivative E n (Pepa.COOP (P :: Q, L)) = 
	(* gcla - the component labelling will break now! *)
	      let  val dP = derivative E (2*n + 1) (Pepa.COOP ([P], L))
		   val dQ = derivative E (2*n + 2) (Pepa.COOP (Q,   L))
		   val fP = filterout dP L
		   val fQ = filterout dQ L
		   val dme = cooperations n dP dQ L
		   val rs = map (fn ((a,r),n,P) => r) dme
		   val rss = map (fn ((a,r),n,P) =>
 				 (Expressions.toString r)^",") dme
		   val fl = foldl (fn (r,ot) => (myand((Expressions.flat r),ot))) true rs
		   val _ = if (not fl) then
		      (Error.warning("non flat expr found\n");
		       map (fn s => Error.warning s) rss;
		       ()) else ()
	      in
		   (map (fn (a, n, Pepa.COOP(P', L)) =>
			 (a, n, Pepa.COOP (P'  @  Q,  L)))   fP)
		 @ (map (fn (a, n, Pepa.COOP(Q', L)) =>
			 (a, n, Pepa.COOP (P  ::  Q', L)))   fQ)
		 @ cooperations n dP dQ L
	      end
      (* gcla - remove later *)
(*       | derivative E n (Pepa.COOP (P, Q, L)) =  *)
(* 	      let  val dP = derivative E (2*n + 1) P *)
(* 		   val dQ = derivative E (2*n + 2) Q *)
(* 		   val fP = filterout dP L *)
(* 		   val fQ = filterout dQ L *)
(* 	      in *)
(* 		   (map (fn (a, n, P') => (a, n, Pepa.COOP (P', Q, L))) fP) *)
(* 		 @ (map (fn (a, n, Q') => (a, n, Pepa.COOP (P, Q', L))) fQ) *)
(* 		 @ cooperations n dP dQ L *)
(* 	      end *)
      | derivative E n (Pepa.HIDING (P, L)) = filter (derivative E n P) L
      | derivative E n (Pepa.VAR I) = derivative E n (lookup I E)
      | derivative E n (Pepa.CONSTS (I, P, L)) = derivative ((I, P) :: E) n L
  in
     infix oo 
     fun f oo g = fn arg1 => fn arg2 => f (g arg1 arg2)
     val derivative' = fn E => fn A =>
	case derivative E 0 A of
	   [] => (Error.warning ("deadlock found at\n\t" ^ 
				 Prettyprinter.print Prettyprinter.verbose A);
		  [])
	 | v => v

     val oldderivative = derivative'
(*      val derivative = derivative' *)
  end

  fun derivative E A =
     if (!Options.noagg) then
	derivative' E A
     else
	Min.minimize (derivative' E A)
end;
