open Ast

(* Evaluate a statement *)

let rec eval_cond env = function
    Cequals(v, n) -> List.assoc v env = n
  | Cand l -> List.for_all (eval_cond env) l
  | Cor l -> List.exists (eval_cond env) l

let rec eval_stmt env = function
    Eif(cond, ifso, ifnot) ->
      if eval_cond env cond then eval_stmt env ifso else eval_stmt env ifnot
  | Edecision d ->
      (begin match d.next with
          NSdefault -> List.assoc "state" env
        | NSfixed n -> n
        | NSchoose n -> n
       end,
       d.utterance)
  | Ecase(v, arms, default) ->
      eval_case env (List.assoc v env) default arms

and eval_case env n default = function
    [] -> eval_stmt env default
  | (csts, stmt) :: rem ->
      if List.mem n csts
      then eval_stmt env stmt
      else eval_case env n default rem

let eval_rule env rulelist =
  let state = List.assoc "state" env in
  let rec eval_rl = function
    [] -> failwith "unmatched state in character"
  | (csts, stmt) :: rem ->
      if List.mem state csts
      then eval_stmt env stmt
      else eval_rl rem in
  eval_rl rulelist

(* Determine all values of interest of all variables *)

let possible_values = (Hashtbl.create 17 : (string, int list ref) Hashtbl.t)

let add_val_aux v n =
  try
    let r = Hashtbl.find possible_values v in
    if not (List.mem n !r) then r := n :: !r
  with Not_found ->
    Hashtbl.add possible_values v (ref [n])  

let add_val v n =
  if v <> "state" then add_val_aux v n

let rec collect_cond = function
    Cequals(v, n) -> add_val v n
  | Cand cl -> List.iter collect_cond cl
  | Cor cl -> List.iter collect_cond cl

let rec collect_stmt = function
    Eif(cond, ifso, ifnot) ->
      collect_cond cond; collect_stmt ifso; collect_stmt ifnot
  | Edecision d -> ()
  | Ecase(v, cases, default) ->
      collect_cases v cases; collect_stmt default

and collect_cases v = function
    [] -> ()
  | (ns, stmt) :: rem ->
      List.iter (add_val v) ns; collect_stmt stmt; collect_cases v rem

let rec collect_states = function
    [] -> ()
  | (ns, stmt) :: rem ->
      List.iter (add_val_aux "state") ns; collect_stmt stmt; collect_states rem

let collect_possible_values rulelist1 rulelist2 =
  Hashtbl.clear possible_values;
  collect_states rulelist1;
  let st1 = !(Hashtbl.find possible_values "state") in
  collect_states rulelist2;
  let st2 = !(Hashtbl.find possible_values "state") in
  if Sort.list (<=) st1 <> Sort.list (<=) st2 then begin
    print_string "The two characters have different sets of states";
    print_newline();
    exit 2
  end;
  let res = ref [] in
  let add_one_val v rl =
    let l = if v = "state" then !rl else max_int :: !rl in
    res := (v, Array.of_list l) :: !res in
  Hashtbl.iter add_one_val possible_values;
  !res

(* Randomly assign values to variables *)

let rec variable_assignment = function
    [] -> []
  | (v, values) :: rem ->
      (v, values.(Random.int (Array.length values))) :: variable_assignment rem

(* Evaluate two characters on a random input *)

let eval_random poss_val ch1 ch2 =
  let env = variable_assignment poss_val in
  let (n1,u1 as v1) = eval_rule env ch1
  and (n2,u2 as v2) = eval_rule env ch2 in
  if v1 <> v2 then begin
    print_string "Different behavior found with"; print_newline();
    List.iter (fun (v, n) -> Printf.printf "\t%s = %d\n" v n) env;
    Printf.printf "First character returns %d, \"%s\"\n" n1 u1;
    Printf.printf "Second character returns %d, \"%s\"\n" n2 u2;
    print_newline();
    exit 2
  end

(* Main program *)

let parse_file name =
  let ic = open_in name in
  let lb = Lexing.from_channel ic in
  try
    let ch = Parser.character Lexer.token lb in
    close_in ic;
    ch
  with Parsing.Parse_error ->
         Printf.printf "%s: Syntax error near character %d\n"
                       name (Lexing.lexeme_start lb);
         flush stdout; exit 2
     | Lexer.Error n ->
         Printf.printf "%s: Lexical error near character %d\n"
                       name n;
         flush stdout; exit 2

let main() =
  let ch1 = parse_file Sys.argv.(1) in
  let ch2 = parse_file Sys.argv.(2) in
  let poss_val = collect_possible_values ch1 ch2 in
  for i = 1 to 100000 do
(*
    if i mod 1000 = 0 then begin
      print_int i; print_string "... "; flush stdout
    end;
*)
    eval_random poss_val ch1 ch2
  done

let _ = if not !Sys.interactive then Printexc.catch main ()