improve mode printing

ocaml-flambda · Jun 28, 2024 · 9e890a8 · 9e890a8
1 parent 2c91084
commit 9e890a8
Show file tree

Hide file tree

Showing 4 changed files with 15 additions and 15 deletions.
diff --git a/ocaml/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference b/ocaml/testsuite/tests/formatting/test_locations.dlocations.ocamlc.reference
@@ -88,14 +88,14 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
       <def_rec>
         pattern (test_locations.ml[17,534+8]..test_locations.ml[17,534+11])
           Tpat_var "fib"
-          value_mode global,many,nonportable,join_shared,contended(1[shared,uncontended,unique,uncontended])
+          value_mode global,many,nonportable;unique,uncontended
         expression (test_locations.ml[17,534+14]..test_locations.ml[19,572+34])
           Texp_function
           region true
-          alloc_mode global,many,nonportable,id(7[shared,contended,unique,uncontended])
+          alloc_mode global,many,nonportable;id(modevar#7[shared,contended ... unique,uncontended])
           []
           Tfunction_cases (test_locations.ml[17,534+14]..test_locations.ml[19,572+34])
-          alloc_mode global,many,nonportable,shared,uncontended
+          alloc_mode global,many,nonportable;shared,uncontended
           value
             [
               <case>
@@ -110,7 +110,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
               <case>
                 pattern (test_locations.ml[19,572+4]..test_locations.ml[19,572+5])
                   Tpat_var "n"
-                  value_mode global,many,portable,unique,uncontended
+                  value_mode global,many,portable;unique,uncontended
                 expression (test_locations.ml[19,572+9]..test_locations.ml[19,572+34])
                   Texp_apply
                   apply_mode Tail

diff --git a/ocaml/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference b/ocaml/testsuite/tests/formatting/test_locations.dno-locations.ocamlc.reference
@@ -88,14 +88,14 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
       <def_rec>
         pattern 
           Tpat_var "fib"
-          value_mode global,many,nonportable,join_shared,contended(1[shared,uncontended,unique,uncontended])
+          value_mode global,many,nonportable;unique,uncontended
         expression 
           Texp_function
           region true
-          alloc_mode global,many,nonportable,id(7[shared,contended,unique,uncontended])
+          alloc_mode global,many,nonportable;id(modevar#7[shared,contended ... unique,uncontended])
           []
           Tfunction_cases 
-          alloc_mode global,many,nonportable,shared,uncontended
+          alloc_mode global,many,nonportable;shared,uncontended
           value
             [
               <case>
@@ -110,7 +110,7 @@ let rec fib = function | 0 | 1 -> 1 | n -> (fib (n - 1)) + (fib (n - 2))
               <case>
                 pattern 
                   Tpat_var "n"
-                  value_mode global,many,portable,unique,uncontended
+                  value_mode global,many,portable;unique,uncontended
                 expression 
                   Texp_apply
                   apply_mode Tail

diff --git a/ocaml/typing/mode.ml b/ocaml/typing/mode.ml
@@ -842,9 +842,9 @@ module Lattices_mono = struct
       type a b d. b obj -> Format.formatter -> (a, b, d) morph -> unit =
    fun dst ppf -> function
     | Id -> Format.fprintf ppf "id"
-    | Join_with c -> Format.fprintf ppf "join_%a" (print dst) c
-    | Meet_with c -> Format.fprintf ppf "meet_%a" (print dst) c
-    | Imply c -> Format.fprintf ppf "imply_%a" (print dst) c
+    | Join_with c -> Format.fprintf ppf "join(%a)" (print dst) c
+    | Meet_with c -> Format.fprintf ppf "meet(%a)" (print dst) c
+    | Imply c -> Format.fprintf ppf "imply(%a)" (print dst) c
     | Subtract c -> Format.fprintf ppf "subtract_%a" (print dst) c
     | Proj (_, ax) -> Format.fprintf ppf "proj_%a" Axis.print ax
     | Max_with ax -> Format.fprintf ppf "max_with_%a" Axis.print ax
@@ -1726,7 +1726,7 @@ module Value_with (Areality : Areality) = struct
     { areality; linearity; portability; uniqueness; contention }
 
   let print ?verbose () ppf { monadic; comonadic } =
-    Format.fprintf ppf "%a,%a"
+    Format.fprintf ppf "%a;%a"
       (Comonadic.print ?verbose ())
       comonadic
       (Monadic.print ?verbose ())
@@ -2502,7 +2502,7 @@ module Modality = struct
     let equate m0 m1 = try_with_log (equate_from_submode sub_log m0 m1)
 
     let print ppf ({ monadic; comonadic } : t) =
-      Format.fprintf ppf "%a,%a" Monadic.print monadic Comonadic.print comonadic
+      Format.fprintf ppf "%a;%a" Monadic.print monadic Comonadic.print comonadic
 
     let infer ~md_mode ~mode : t =
       let comonadic =

diff --git a/ocaml/typing/solver.ml b/ocaml/typing/solver.ml
@@ -154,8 +154,8 @@ module Solver_mono (C : Lattices_mono) = struct
   let rec print_var : type a. ?traversed:VarSet.t -> a C.obj -> _ -> a var -> _
       =
    fun ?traversed obj ppf v ->
-    Format.fprintf ppf "%x[%a,%a]" v.id (C.print obj) v.lower (C.print obj)
-      v.upper;
+    Format.fprintf ppf "modevar#%x[%a ... %a]" v.id (C.print obj) v.lower
+      (C.print obj) v.upper;
     match traversed with
     | None -> ()
     | Some traversed ->