vanity/bin/main.ml

open Vanity

type profile = {
  name : string;
  flags : Pipeline.optimisation_flags;
  relation : Relation.relation;
}

let safe_flags =
  { Pipeline.default_flags with unsafe_repr_eq = false; unsafe_strict_unroll = false; unsafe_effect_drop = false }

let profiles =
  [
    { name = "safe"; flags = safe_flags; relation = Relation.Boxed_unboxed };
    { name = "specialise-only"; flags = { safe_flags with inline = false; repr_lower = false }; relation = Relation.Baseline };
    { name = "inline-no-repr-leak"; flags = { safe_flags with inline = true }; relation = Relation.Boxed_unboxed };
    { name = "unsafe-inline"; flags = { safe_flags with unsafe_repr_eq = true }; relation = Relation.Boxed_unboxed };
    { name = "unsafe-unbox"; flags = Pipeline.default_flags; relation = Relation.Boxed_unboxed };
    { name = "unsafe-strictness"; flags = { safe_flags with inline = false; unsafe_strict_unroll = true }; relation = Relation.Boxed_unboxed };
    { name = "unsafe-effects"; flags = { safe_flags with unsafe_effect_drop = true }; relation = Relation.Boxed_unboxed };
  ]

let run_case (case : Corpus.case) =
  let audit = Audit.audit_case case in
  let failed_invariants =
    audit.Audit.invariants
    |> List.filter (fun result -> not result.Audit.passed)
    |> List.map (fun result -> Audit.invariant_kind_to_string result.Audit.kind)
  in
  Printf.printf
    "case %s\nclassification %s\nverdict %s\nsource %s\ntarget %s\nfailed invariants %s\n\n"
    case.Corpus.name
    (Audit.failure_mode_to_string audit.Audit.failure_mode)
    (Reporting.verdict_to_string audit.Audit.comparison.Relation.verdict)
    (Reporting.string_of_source_trace audit.Audit.source_trace)
    (Reporting.string_of_target_trace audit.Audit.target_trace)
    (if failed_invariants = [] then "none" else String.concat ", " failed_invariants);
  if audit.Audit.failure_mode <> Audit.Preserved then begin
    Printf.printf "%s\n\n" (Reporting.emit_pipeline_visualisation audit.Audit.compiled);
    Printf.printf "%s\n\n" (Audit.emit_pass_boundaries audit)
  end

let run_profile profile =
  let result = Gen.run_campaign profile.flags profile.relation ~count:160 ~max_depth:4 () in
  Printf.printf
    "profile %s\nrelated %d/%d\nviolations %d\n\n"
    profile.name
    result.Gen.related
    result.Gen.total
    (result.Gen.total - result.Gen.related)

let () =
  Printf.printf "corpus\n\n";
  List.iter run_case Corpus.all;
  Printf.printf "profiles\n\n";
  List.iter run_profile profiles