From 258d5306fbfe20cb529c793be56584b648a6e85f Mon Sep 17 00:00:00 2001
From: Josh Berdine <jjb@fb.com>
Date: Sat, 15 Aug 2020 02:19:44 -0700
Subject: [PATCH] [sledge] Refactor: Revise external Context printing API

Summary:
The default printer is `pp_classes`, while `pp` is for debugging the
internal representation manipulation, so it is renamed to `pp_raw`.

Reviewed By: jvillard

Differential Revision: D22571135

fbshipit-source-id: 2d624e279
---
 sledge/src/fol.ml      | 6 ++++--
 sledge/src/fol.mli     | 3 ++-
 sledge/src/fol_test.ml | 8 ++++----
 sledge/src/sh.ml       | 6 ++----
 4 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/sledge/src/fol.ml b/sledge/src/fol.ml
index 6d521335f..3696fe639 100644
--- a/sledge/src/fol.ml
+++ b/sledge/src/fol.ml
@@ -1253,7 +1253,6 @@ let f_ses_map : (Ses.Term.t -> Ses.Term.t) -> fml -> fml =
 module Context = struct
   type t = Ses.Equality.t [@@deriving sexp]
 
-  let pp = Ses.Equality.pp
   let invariant = Ses.Equality.invariant
   let empty = Ses.Equality.true_
 
@@ -1306,6 +1305,9 @@ module Context = struct
         | [] -> None
         | cls -> Some cls )
 
+  (* Pretty printing *)
+
+  let pp_raw = Ses.Equality.pp
   let ppx_cls x = List.pp "@ = " (Term.ppx x)
 
   let ppx_classes x fs clss =
@@ -1315,7 +1317,7 @@ module Context = struct
           (List.sort ~compare:Term.compare cls) )
       fs (Term.Map.to_alist clss)
 
-  let pp_classes fs r = ppx_classes (fun _ -> None) fs (classes r)
+  let pp fs r = ppx_classes (fun _ -> None) fs (classes r)
 
   let ppx_diff var_strength fs parent_ctx fml ctx =
     let clss = diff_classes ctx parent_ctx in
diff --git a/sledge/src/fol.mli b/sledge/src/fol.mli
index 960ee3a4d..4e9cb4d17 100644
--- a/sledge/src/fol.mli
+++ b/sledge/src/fol.mli
@@ -189,7 +189,6 @@ module Context : sig
   type t [@@deriving sexp]
 
   val pp : t pp
-  val pp_classes : t pp
 
   val ppx_diff :
     Var.strength -> Format.formatter -> t -> Formula.t -> t -> bool
@@ -280,6 +279,8 @@ module Context : sig
 
   (**/**)
 
+  val pp_raw : t pp
+
   val replay : string -> unit
   (** Replay debugging *)
 end
diff --git a/sledge/src/fol_test.ml b/sledge/src/fol_test.ml
index ab41f3e99..b1aa08f56 100644
--- a/sledge/src/fol_test.ml
+++ b/sledge/src/fol_test.ml
@@ -20,8 +20,8 @@ let%test_module _ =
      * [@@@warning "-32"] *)
 
     let printf pp = Format.printf "@\n%a@." pp
-    let pp = printf pp
-    let pp_classes = Format.printf "@\n@[<hv>  %a@]@." pp_classes
+    let pp_raw = printf pp_raw
+    let pp = Format.printf "@\n@[<hv>  %a@]@." pp
     let ( ! ) i = Term.integer (Z.of_int i)
     let ( + ) = Term.add
     let ( - ) = Term.sub
@@ -75,8 +75,8 @@ let%test_module _ =
     let r9 = of_eqs [(x, z - !16)]
 
     let%expect_test _ =
-      pp_classes r9 ;
       pp r9 ;
+      pp_raw r9 ;
       [%expect
         {|
         (-16 + %z_5) = %x_3
@@ -89,8 +89,8 @@ let%test_module _ =
     let r10 = of_eqs [(!16, z - x)]
 
     let%expect_test _ =
-      pp_classes r10 ;
       pp r10 ;
+      pp_raw r10 ;
       Format.printf "@.%a@." Term.pp (z - (x + !8)) ;
       Format.printf "@.%a@." Term.pp (normalize r10 (z - (x + !8))) ;
       Format.printf "@.%a@." Term.pp (x + !8 - z) ;
diff --git a/sledge/src/sh.ml b/sledge/src/sh.ml
index d2eca95c6..58a8d0e17 100644
--- a/sledge/src/sh.ml
+++ b/sledge/src/sh.ml
@@ -682,8 +682,7 @@ let rec freshen_nested_xs q =
     invariant q']
 
 let rec propagate_context_ ancestor_vs ancestor_ctx q =
-  [%Trace.call fun {pf} ->
-    pf "(%a)@ %a" Context.pp_classes ancestor_ctx pp q]
+  [%Trace.call fun {pf} -> pf "(%a)@ %a" Context.pp ancestor_ctx pp q]
   ;
   (* extend vocabulary with variables in scope above *)
   let ancestor_vs = Var.Set.union ancestor_vs (Var.Set.union q.us q.xs) in
@@ -714,8 +713,7 @@ let rec propagate_context_ ancestor_vs ancestor_ctx q =
     invariant q']
 
 let propagate_context ancestor_vs ancestor_ctx q =
-  [%Trace.call fun {pf} ->
-    pf "(%a)@ %a" Context.pp_classes ancestor_ctx pp q]
+  [%Trace.call fun {pf} -> pf "(%a)@ %a" Context.pp ancestor_ctx pp q]
   ;
   propagate_context_ ancestor_vs ancestor_ctx q
   |>