(* 
 File: Semantic.sml

 The structure which performs semantic analysis of PEPA models.
 Errors include component definitions which are missing or duplicated.
 Warnings include components which are defined but never used and
 occurrences of taus or wholly unused activity identifiers in any set 
 (hiding or cooperation).

*)


structure Semantic :> Semantic =
struct

  local
    fun act (Pepa.PREFIX ((a, _), C)) = HashTable.unhash a :: act C
      | act (Pepa.VAR _) = []
      | act (Pepa.CHOICE (P, Q)) = act P @ act Q
      (* gcla - remove later *)
      | act (Pepa.COOP ((P::t), l)) = act P @ (act (Pepa.COOP(t, l)))
      | act (Pepa.COOP ([], _)) = []
(*       | act (Pepa.COOP (P, Q, _)) = act P @ act Q *)
      | act (Pepa.HIDING (P, _)) = act P
      | act (Pepa.CONSTS (_, P, C)) = act P @ act C

    fun used (Pepa.VAR I) = [HashTable.unhash I]
      | used (Pepa.PREFIX (_, C)) = used C
      | used (Pepa.CHOICE (P, Q)) = used P @ used Q
      (* gcla - remove later *)
(*       | used (Pepa.COOP (P, Q, _)) = used P @ used Q *)
      | used (Pepa.COOP ((P::t), l)) = used P @ (used (Pepa.COOP (t, l)))
      (* gcla *)
      | used (Pepa.COOP ([], _)) = []
      | used (Pepa.HIDING (P, _)) = used P
      | used (Pepa.CONSTS (_, P, C)) = used P @ used C

    fun defined (Pepa.CONSTS (I, _, C)) = HashTable.unhash I :: defined C
      | defined _ = []
  in
    val activities = Sort.quicksort o act
    val used = Sort.quicksort o used
    val defined = Sort.quicksort o defined
  end

  fun rmDup [] = []
    | rmDup [x] = ([x] : string list)
    | rmDup (x1 :: (t as (x2 :: _))) =
        let val tail = rmDup t
         in if x1 = x2 then tail else x1 :: tail
        end

  local 
    fun fstNotSnd ([], _) = []
      | fstNotSnd (fst, []) = (fst : string list)
      | fstNotSnd (h1::fst, h2::snd) =
	if h1 < h2 
	then h1 :: fstNotSnd (fst, h2::snd)
	else if h1 = h2 then fstNotSnd (fst, h2::snd)
	     else fstNotSnd (h1::fst, snd)
  in
    fun firstNotSecond (fst, snd) = fstNotSnd (rmDup fst, rmDup snd)
  end

  fun checkDup [] = ()
    | checkDup [_] = ()
    | checkDup (x1 :: (t as (x2 :: _))) =
      if x1 = x2 
      then 
         Error.fatal_error ("Component multiply defined: " ^ x1)
      else checkDup t

  fun reportNotUsed C = 
      Error.warning ("Component definition unused: " ^ C)

  fun reportNotDefined C = 
      Error.fatal_error ("Component not defined: " ^ C)

  (* This version of member works on sorted string lists *)
  fun member (s : string) =
    let
      fun mem [] = false
        | mem (h::t) =
          not (h > s) andalso (h = s orelse mem t)          
    in mem end

  fun purifylist act class =
    let
      fun pL [] = []
        | pL (h :: t) = 
           case HashTable.unhash h of
             "tau" =>
               (Error.warning ("tau found in " ^ class ^ " set, ignoring");
                pL t)
           | id  => 
               if member id act
               then id :: pL t
               else (Error.warning ("unused activity name `" ^
                  id ^ "' found in " ^ class ^ " set, ignoring");
                pL t)

    in (map HashTable.hash) o pL end

  fun purify act =
    let 
       (* gcla - remove later *)
(*        fun p (Pepa.COOP (P, Q, L)) =  *)
(*           Pepa.COOP (p P, p Q, purifylist act "cooperation" L) *)
       fun p (Pepa.COOP ([P, Q], L)) = 
          Pepa.COOP ([p P, p Q], purifylist act "cooperation" L)
	 | p (Pepa.HIDING (P, L)) =
	   Pepa.HIDING (p P, purifylist act "hiding" L)
	 | p (Pepa.CONSTS (I, P, C)) =
	   Pepa.CONSTS (I, p P, p C)
	 | p C = C
    in p end

  fun analyse C = 
    let
      val usedActivities = rmDup (activities C)
      val usedNames = used C
      val definedNames = defined C
      val defNotUsed = firstNotSecond (definedNames, usedNames)
      val _ = map reportNotUsed defNotUsed
      val usedNotDefined = firstNotSecond (usedNames, definedNames)
      val _ = map reportNotDefined usedNotDefined
      val _ = checkDup definedNames
    in
      purify usedActivities C
    end

end;
