Module DebugAbMachineEnv


Require Import
  Utf8 String ToString
  AdomLib
  AbMachineEnv
  DebugLib DebugCminor.

Section S.

  Local Open Scope string_scope.

  Context {var t iter_t: Type}
          {VS: ToString var}
          {TS: ToString t}
          (verbose: bool)
          `(D: ab_machine_env var t iter_t)
          {TSI: ToString iter_t}.

  Definition string_of_mach_num_ty ty :=
    match ty with
      | MNTint => "%int"
      | MNTint64 => "%int64"
      | MNTfloat => "%float"
      | MNTsingle => "%single"
    end.

  Instance MN_ToString : ToString mach_num := fun itv =>
    match itv with
      | MNint i => to_string i ++ "%int"
      | MNint64 i => to_string i ++ "%int64"
      | MNfloat f => to_string f ++ "%float"
      | MNsingle f => to_string f ++ "%single"
    end.

  Instance MNI_ToString : ToString mach_num_itv := fun itv =>
    match itv with
      | MNIint itv => to_string itv ++ "%int"
      | MNIint64 itv => to_string itv ++ "%int64"
      | MNIfloat itv => to_string itv ++ "%float"
      | MNIsingle itv => to_string itv ++ "%single"
    end.

  Fixpoint string_of_nexpr (e: mexpr var) {struct e} : string :=
    match e with
    | MEvar ty v => to_string v ++ string_of_mach_num_ty ty
    | MEconst c => to_string c
    | MEunop op e' => string_of_unop op ++ string_of_nexpr e'
    | MEbinop op x y => "(" ++ string_of_nexpr x ++ string_of_binop op ++ string_of_nexpr y ++ ")"
    end.

  Global Instance MExprToString : ToString (mexpr var) := string_of_nexpr.

  Definition trace_get_itv e res :=
    "get_itv " ++ e ++ " → " ++ res.

  Definition trace_concretize_int e res :=
    "concretize_int " ++ e ++ " → " ++ res.

  Definition trace_assign x e (r:t+⊥) :=
    "assign " ++ x ++ " := " ++ e ++ if verbose then " → " ++ to_string r else "".

  Definition trace_forget x (r:t+⊥) :=
    "forget " ++ x ++ if verbose then " → " ++ to_string r else "".

  Definition trace_assume e b (r:t+⊥) :=
    "assume " ++ e ++ " " ++ b ++ if verbose then " → " ++ to_string r else "".

  Definition trace_noerror e r :=
    "noerror " ++ e ++ " → " ++ r.

  Program Definition debug_ab_machine_env : ab_machine_env t iter_t :=
    {| mach_leb := leb_print
    ; mach_join := join_print
    ; mach_widen := widen_print
    ; get_itv e ab :=
        let r := get_itv e ab in
        let s := trace_get_itv (to_string e) (to_string r) in
        print s r
    ; concretize_int n e ab :=
        let r := concretize_int n e ab in
        let s := trace_concretize_int (to_string e) (to_string r) in
        print s r
    ; assign x e ab :=
        let r := assign x e ab in
        let s := trace_assign (to_string x) (to_string e) r in
        print s r
    ; assume e b ab :=
        let r := assume e b ab in
        let s := trace_assume (to_string e) (to_string b) r in
        print s r
    ; forget b ab :=
        let r := forget b ab in
        let s := trace_forget (to_string b) r in
        print s r
    ; noerror e ab :=
        let r := noerror e ab in
        let s := trace_noerror (string_of_nexpr e) (to_string r) in
        print s r
    |}.
Next Obligation.
rewrite print_id; eapply assign_correct; eauto. Qed.
Next Obligation.
rewrite print_id; eapply forget_correct; eauto. Qed.
Next Obligation.
rewrite print_id; eapply assume_correct; eauto. Qed.
Next Obligation.
rewrite print_id; eapply get_itv_correct; eauto. Qed.
Next Obligation.
rewrite print_id; eapply concretize_int_correct; eauto. Qed.
Next Obligation.
rewrite print_id in H1; eapply noerror_correct; eauto. Qed.

End S.