open Syntax
;;

let rec gather_rules character = 
  let taille = (List.length character) * 3 + 2 in
  let h = Hashtbl.create taille in
  let f rule = 
    ( match rule with
      Rule(state_list,st) ->
	try 
	  let tmp = Hashtbl.find h st in
	  Hashtbl.remove h st;
	  Hashtbl.add h st (state_list :: tmp)
	with Not_found ->
	  Hashtbl.add h st [state_list] )
  in
  List.iter f character;
  let new_character = ref [] in
  let f st state_list = 
    new_character := Rule(List.flatten state_list, st)::!new_character
  in
  Hashtbl.iter f h;
  !new_character

let rec map_statement f st =
  ( match st with
    If(c, st, el, st') -> 
      f (If(c, map_statement f st, 
	    List.map (map_statement_elsif f) el, 
	    map_statement f st'))
  | Decision(ns, d) as a -> f a
  | Case(s, al, st) -> 
      f (Case (s, List.map (map_statement_arm f) al, map_statement f st)))
    
and map_statement_elsif f = function
    Elseif(c, st) -> Elseif(c, map_statement f st)

and map_statement_arm f = function
    Arm(il, st) -> Arm(il, map_statement f st)


let decision_substitute_underscore state st =
  ( match st with
    Decision(new_state, s) ->
      if new_state=Some state
      then Decision(None, s)
      else st
  | _ -> st )

let statement_substitute_underscore state = 
  map_statement (decision_substitute_underscore state)
      
let rule_subst_underscore rule =
  ( match rule with
    Rule([state], st) ->
      Rule([state], statement_substitute_underscore state st)
  | _ -> rule )


let character_substitute_underscore = List.map rule_subst_underscore

exception Stop_true
exception Stop_false
exception Found_arm of statement

let rec propagate_info info st =
  ( match st with
    If(s,st,elsifl,stelse) ->
      let rec optimize_conjonction info partial_list s =
	( match s with
	  Or cl -> 
            ( try
              let new_s = List.fold_left (optimize_disjonction info) [] cl in
              ( match new_s with
                [] -> raise Stop_false
              | [x] -> optimize_conjonction info partial_list x
              | _ -> info, ((Or new_s) :: partial_list) )
            with
              Stop_true ->
                info, partial_list )
	| And cl -> 
	    optimize_conjonction_list info partial_list cl
	| Equals(var,n) ->
	    ( try
	      let varval = List.assoc var info in
	      if varval = n
	      then
		info, partial_list
	      else
		raise Stop_false
	    with
	      Not_found ->
		((var,n) :: info), (Equals(var,n)::partial_list) ) )
      and optimize_conjonction_list info partial_list cl =
	( match cl with
	  [] -> info, partial_list
	| h :: t ->
	    let new_info, new_list = optimize_conjonction info partial_list h in
	    optimize_conjonction_list new_info new_list t )
      and optimize_disjonction info partial_list s =
        ( match s with
          Or cl -> List.fold_left (optimize_disjonction info) partial_list cl
        | And cl ->
            ( try 
              let throwaway_info, new_s = optimize_conjonction_list info [] cl in
              ( match new_s with
                []  -> raise Stop_true
              | [x] -> x :: partial_list
              | _ -> (And new_s)::partial_list )
            with
              Stop_false -> (* false has been deduced from the available information,
                         this part of the disjonction can be removed *)
                partial_list)
        | Equals(var,n) ->
            ( try
	      let varval = List.assoc var info in
	      if varval = n
	      then
                raise Stop_true
	      else
		partial_list		
	    with
	      Not_found ->
	       (Equals(var,n)::partial_list) ) )
            
      in
      ( try
	let info_then, new_s_l = optimize_conjonction info [] s in
	let new_st = propagate_info info_then st in
	( match new_s_l with
          [] ->  (* the condition is always true *)
	    new_st
        | _ -> (* the condition might be true or false *)
            let new_s = 
              ( match new_s_l with
                [x] -> x
              | _ -> And(new_s_l) )
            in
	    ( match elsifl with
	      [] -> 
	        let new_stelse = propagate_info info stelse in 
	        If(new_s, new_st, [], new_stelse)
	    | Elseif(cond1,st1) :: t ->
	        let new_stelse = If(cond1,st1,t,stelse) in
	        let new_stelse_opt = propagate_info info new_stelse in
	        If(new_s, new_st, [], new_stelse_opt) ) )
      with
	Stop_false -> (* the condition is always false *)
	  ( match elsifl with
	    [] -> propagate_info info stelse
	  | Elseif(cond1,st1) :: t -> 
	      propagate_info info (If(cond1,st1,t,stelse) ) )   )
  | Decision _ -> st
  | Case(var, arm_list, st_default) ->
      ( try 
        let varval = List.assoc var info in
        let f_arm (Arm(il,st1)) =
          if List.mem varval il
          then raise (Found_arm st1)
        in
        ( try
          List.iter f_arm arm_list;
          st_default 
        with
          Found_arm st1 -> st1 ) 
      with
        Not_found -> 
          let f_arm (Arm(il,st1)) = 
            ( match il with
              [n] ->
                Arm(il,propagate_info ((var,n)::info) st1) 
            | _ ->
                Arm(il,propagate_info info st1) )
          in
          Case(var, List.map f_arm arm_list, propagate_info info st_default ) ) )
		  
let character_optimize_ifs =
  let f_rule partial_list (Rule(state_list,st)) =
    ( match state_list with
      [] -> partial_list
    | [n] -> Rule(state_list, propagate_info ["state",n] st) :: partial_list
    | _ -> Rule(state_list, propagate_info [] st) :: partial_list )
  in
  List.fold_left f_rule []