inital commit

2026-02-11 17:24:09 +00:00
commit 42cde2128a
32 changed files with 1997 additions and 0 deletions
@@ -0,0 +1,81 @@
+let obligation_kind_to_string = function
+  | Pipeline.Preserve_relation -> "preserve_relation"
+  | Pipeline.Exposed_representation -> "exposed_representation"
+  | Pipeline.Strictness_risk -> "strictness_risk"
+  | Pipeline.Worker_wrapper_proof -> "worker_wrapper_proof"
+
+let string_of_source_outcome = function
+  | Source.Value v -> "value " ^ Source.string_of_value v
+  | Source.Stuck msg -> "stuck " ^ msg
+  | Source.Diverged n -> "diverged after " ^ string_of_int n ^ " steps"
+
+let string_of_target_outcome = function
+  | Target.Value v -> "value " ^ Target.string_of_value v
+  | Target.Stuck msg -> "stuck " ^ msg
+  | Target.Diverged n -> "diverged after " ^ string_of_int n ^ " steps"
+
+let string_of_relation = function
+  | Relation.Baseline -> "baseline"
+  | Relation.Boxed_unboxed -> "boxed_unboxed"
+  | Relation.Ground_only -> "ground_only"
+
+let verdict_to_string = function
+  | Relation.Related -> "related"
+  | Relation.Unrelated msg -> "unrelated: " ^ msg
+
+let take_steps limit steps =
+  let rec go acc n rest =
+    match rest with
+    | [] -> (List.rev acc, 0)
+    | _ when n = 0 -> (List.rev acc, List.length rest)
+    | x :: xs -> go (x :: acc) (n - 1) xs
+  in
+  go [] limit steps
+
+let emit_obligations (obligations : Pipeline.obligation list) =
+  if obligations = [] then "- none"
+  else
+    obligations
+    |> List.map (fun o ->
+           "- [" ^ obligation_kind_to_string o.Pipeline.kind ^ "] " ^ o.Pipeline.pass ^
+           " / " ^ o.Pipeline.subject ^ ": " ^ o.Pipeline.detail)
+    |> String.concat "\n"
+
+let emit_case_header (case : Corpus.case) (comparison : Relation.comparison) (compiled : Pipeline.compiled) =
+  String.concat "\n"
+    [
+      "## " ^ case.Corpus.name;
+      "";
+      "| field | value |";
+      "| --- | --- |";
+      "| summary | " ^ case.Corpus.summary ^ " |";
+      "| claim | " ^ case.Corpus.claim ^ " |";
+      "| relation | `" ^ string_of_relation case.Corpus.relation ^ "` |";
+      "| source type | `" ^ Types.string_of_typ case.Corpus.ty ^ "` |";
+      "| verdict | `" ^ verdict_to_string comparison.Relation.verdict ^ "` |";
+      "| obligations | " ^ string_of_int (List.length compiled.Pipeline.obligations) ^ " |";
+      "";
+    ]
+
+let emit_steps pp steps =
+  steps
+  |> List.mapi (fun i t -> string_of_int i ^ ": " ^ pp t)
+  |> String.concat "\n"
+
+let emit_counterexample title (src_trace : Source.trace) (tgt_trace : Target.trace) (obligations : Pipeline.obligation list) =
+  let _ = title in
+  let src_steps, src_hidden = take_steps 32 src_trace.Source.steps in
+  let tgt_steps, tgt_hidden = take_steps 48 tgt_trace.Target.steps in
+  let src_suffix =
+    if src_hidden = 0 then ""
+    else "\n... " ^ string_of_int src_hidden ^ " more source steps omitted"
+  in
+  let tgt_suffix =
+    if tgt_hidden = 0 then ""
+    else "\n... " ^ string_of_int tgt_hidden ^ " more target steps omitted"
+  in
+  "source trace:\n" ^ emit_steps Source.string_of_term src_steps ^
+  src_suffix ^ "\n\nsource outcome: " ^ string_of_source_outcome src_trace.Source.outcome ^
+  "\n\ntarget trace:\n" ^ emit_steps Target.string_of_term tgt_steps ^
+  tgt_suffix ^ "\n\ntarget outcome: " ^ string_of_target_outcome tgt_trace.Target.outcome ^
+  "\n\nobligations:\n" ^ emit_obligations obligations ^ "\n"