type condition =
    Cequals of string * int
  | Cand of condition list
  | Cor of condition list

type next_state =
    NSdefault
  | NSfixed of int
  | NSchoose of int

type decision =
  { mutable next: next_state; utterance: string }

type stmt =
    Eif of condition * stmt * stmt
  | Edecision of decision
  | Ecase of string * (int list * stmt) list * stmt

type rule = (int list * stmt)

type character = rule list

let rec size_list fn = function
    [] -> 0
  | h::t -> fn h + size_list fn t

let rec size_cond = function
    Cequals(_, _) -> 6
  | Cor cl -> size_list size_cond cl
  | Cand cl -> size_list size_cond cl

let span arms =
  let min = ref max_int and max = ref min_int in
  List.iter
    (fun (lbls, stmt) ->
      List.iter
        (fun n ->
          if n < !min then min := n;
          if n > !max then max := n)
        lbls)
    arms;
  !max - !min + 1

let rec size_stmt = function
    Eif(cond, ifso, ifnot) ->
      size_cond cond + size_stmt ifso + size_stmt ifnot
  | Edecision dec ->
      begin match dec.next with
        NSdefault -> 3
      | NSfixed _ -> 4
      | NSchoose _ -> 3 (* assume _ will be chosen *)
      end
  | Ecase(v, arms, default) ->
      10 + span arms + size_list size_arm arms + size_stmt default

and size_arm (lbls, stmt) = size_stmt stmt

let size_character rulelist = size_list size_arm rulelist

(*****

open Format

let pretty_list fn l =
  open_box 0;
  begin match l with
    [] -> ()
  | [item] -> fn item
  | hd :: tl -> fn hd; List.iter (fun item -> print_space(); fn item) tl
  end;
  close_box()

let pretty_var s =
  print_string "(VAR \""; print_string s; print_string "\")"

let rec pretty_cond = function
    Cequals(v, n) ->
      open_box 2; print_string "("; print_string "EQUALS";
      print_space(); pretty_var v;
      print_space(); print_int n;
      print_string ")"; close_box()
  | Cor cl ->
      open_box 2; print_string "("; print_string "OR";
      print_space(); pretty_list pretty_cond cl;
      print_string ")"; close_box()
  | Cand cl ->
      open_box 2; print_string "("; print_string "AND";
      print_space(); pretty_list pretty_cond cl;
      print_string ")"; close_box()
    
let rec pretty_stmt = function
    Eif(cond, ifso, ifnot) ->
      open_box 2; print_string "("; print_string "IF";
      print_space(); pretty_cond cond; print_space();
      pretty_stmt ifso; print_space();
      print_string "()"; print_space();
      pretty_stmt ifnot; print_string ")";
      close_box()
  | Edecision d ->
      open_box 2; print_string "("; print_string "DECISION";
      print_space();
      begin match d.next with
        NSdefault -> print_string "_"
      | NSfixed n -> print_int n
      | NSchoose n -> print_string "_" (* cheaper alternative *)
      end; print_space();
      print_string "\""; print_string d.utterance; print_string "\")";
      close_box()
  | Ecase(v, arms, default) ->
      open_box 2; print_string "("; print_string "CASE";
      print_space(); pretty_var v;
      print_space();
      print_string "("; pretty_list pretty_arm arms; print_string ")";
      print_space(); pretty_stmt default; print_string ")";
      close_box()

and pretty_arm (labels, stmt) =
      open_box 2; print_string "("; print_string "ARM"; print_space();
      print_string "("; pretty_list print_int labels; print_string ")";
      print_space(); pretty_stmt stmt; print_string ")"; close_box()

let pretty_rule (labels, stmt) =
      open_box 2; print_string "("; pretty_list print_int labels;
      print_space(); pretty_stmt stmt; print_string ")"; close_box()

let pretty_character c =
      open_box 2; print_string "("; pretty_list pretty_rule c;
      print_space(); print_string ")"; close_box()

let save_character filename c =
  let oc = open_out filename in
  set_formatter_out_channel oc;
  pretty_character c;
  print_newline();
  set_formatter_out_channel stdout;
  close_out oc

*****)

let nrspaces = ref 0

let incrbase = 2 

let spinc () =
  nrspaces := !nrspaces + incrbase


let spdec () =
  nrspaces := !nrspaces - incrbase


let newline_spaces () =
  print_newline ();
  for i=1 to !nrspaces do
    print_string " "
  done


let rec pretty_character c = 
  print_string "(";
  spinc ();
  newline_spaces ();
  pretty_rule_list c;
  spdec ();
  newline_spaces ();
  print_string ")";
  newline_spaces ()

and pretty_rule_list = function
  | [] -> ()
  | (state_list, statement) :: [] -> 
      pretty_rule state_list statement;
  | (state_list, statement) :: l -> 
      pretty_rule state_list statement;
      newline_spaces ();
      newline_spaces ();
      pretty_rule_list l
	

and pretty_rule state_list statement = 
  print_string "(";
  pretty_state_list state_list;
  spinc ();
  newline_spaces ();
  pretty_stmt statement;
  spdec ();
  newline_spaces ();
  print_string ")"
    
and pretty_state_list = function
    [] -> ()
  | i :: l -> print_int i; print_string " "; pretty_state_list l
	
and pretty_stmt = function
    Eif (c, s, s') -> pretty_if c s s'
  | Edecision d -> pretty_decision d
  | Ecase (s, al, s') -> pretty_case s al s'
	
and pretty_if c s s' =
  print_string "(IF ";
  pretty_cond c;
  spinc ();
  spinc ();
  newline_spaces ();
  pretty_stmt s;
  newline_spaces ();
  print_string "()";
  newline_spaces ();
  pretty_stmt s';
  spdec ();
  spdec ();
  newline_spaces ();
  print_string ")"
    
and pretty_cond = function
    Cequals (s, i) -> pretty_equals s i
  | Cand cl -> pretty_and cl
  | Cor cl -> pretty_or cl
       
and pretty_equals s i =
  print_string ("(EQUALS (VAR \""^s^"\") "^(string_of_int i)^")")
    
and pretty_and cl =
  print_string "(AND";
  pretty_cond_list cl;
  print_string ")"
    
and pretty_cond_list = function
    [] -> ()
  | c :: l -> print_string " "; pretty_cond c; pretty_cond_list l
	
and pretty_or cl =
  print_string "(OR";
  pretty_cond_list cl;
  print_string ")"
    
and pretty_decision d =
  print_string "(DECISION ";
  ( match d.next with
    NSdefault -> print_string "_ "
  | NSfixed i -> print_int i; print_string " "
  | NSchoose i -> print_string "_ ");
  print_string ("\""^d.utterance^"\")")
    
and pretty_case s al st =
  print_string ("(CASE (VAR \""^s^"\") (");
  spinc ();
  newline_spaces ();
  pretty_arm_list al;
  pretty_stmt st;
  spdec ();
  newline_spaces ();
  print_string ")"
    
and pretty_arm_list = function
    [] -> print_string ")"
  | a :: [] -> pretty_arm a; print_string " )"; newline_spaces ()
  | a :: al -> pretty_arm a; newline_spaces (); pretty_arm_list al
	
and pretty_arm = function
    (il, st) ->
      print_string "(ARM (";
      pretty_int_list il;
      print_string ")";
      spinc ();
      newline_spaces ();
      pretty_stmt st;
      spdec ();
      newline_spaces ();
      print_string ")"

and pretty_int_list = function
    [] -> ()
  | i :: [] -> print_int i
  | i :: l -> print_int i; print_string " "; pretty_int_list l