Refactor lattice flipping for modes (#3949)

Author: riaqn

typing/allowance.ml

@@ -22,6 +22,10 @@ type right_only = disallowed * allowed
 
 type both = allowed * allowed
 
+type 'a pos = 'b * 'c constraint 'a = 'b * 'c
+
+type 'a neg = 'c * 'b constraint 'a = 'b * 'c
+
 module type Allow_disallow = sig
   type ('a, 'b, 'd) sided constraint 'd = 'l * 'r
 

typing/allowance.mli

@@ -47,6 +47,14 @@ type right_only = disallowed * allowed
 
 type both = allowed * allowed
 
+(** Arrange the permissions appropriately for a positive lattice, by
+doing nothing. *)
+type 'a pos = 'b * 'c constraint 'a = 'b * 'c
+
+(** Arrange the permissions appropriately for a negative lattice, by
+    swapping left and right. *)
+type 'a neg = 'c * 'b constraint 'a = 'b * 'c
+
 module type Allow_disallow = sig
   type ('a, 'b, 'd) sided constraint 'd = 'l * 'r
 

typing/includecore.ml

@@ -692,9 +692,9 @@ module Record_diffing = struct
           | Immutable, Mutable _ -> Some Second
           | Mutable m1, Mutable m2 ->
             let open Mode.Alloc.Comonadic.Const in
-            (if not (eq m1 legacy) then
+            (if not (Misc.Le_result.equal ~le m1 legacy) then
               Misc.fatal_errorf "Unexpected mutable(%a)" print m1);
-            (if not (eq m2 legacy) then
+            (if not (Misc.Le_result.equal ~le m2 legacy) then
               Misc.fatal_errorf "Unexpected mutable(%a)" print m2);
             None
         in

typing/jkind_axis.ml

@@ -177,7 +177,7 @@ module Axis = struct
   end
 
   type 'a t =
-    | Modal : ('m, 'a, 'd) Mode.Alloc.axis -> 'a t
+    | Modal : ('a, _, _) Mode.Alloc.Axis.t -> 'a t
     | Nonmodal : 'a Nonmodal.t -> 'a t
 
   type packed = Pack : 'a t -> packed [@@unboxed]
@@ -197,7 +197,7 @@ module Axis = struct
 
   let get (type a) : a t -> (module Axis_ops with type t = a) = function
     | Modal axis ->
-      (module Accent_lattice ((val Mode.Alloc.lattice_of_axis axis)))
+      (module Accent_lattice ((val Mode.Alloc.Const.lattice_of_axis axis)))
     | Nonmodal Externality -> (module Externality)
     | Nonmodal Nullability -> (module Nullability)
     | Nonmodal Separability -> (module Separability)
@@ -216,7 +216,7 @@ module Axis = struct
       Pack (Nonmodal Separability) ]
 
   let name (type a) : a t -> string = function
-    | Modal axis -> Format.asprintf "%a" Mode.Alloc.print_axis axis
+    | Modal axis -> Format.asprintf "%a" Mode.Alloc.Axis.print axis
     | Nonmodal Externality -> "externality"
     | Nonmodal Nullability -> "nullability"
     | Nonmodal Separability -> "separability"

typing/jkind_axis.mli

@@ -59,7 +59,7 @@ module Axis : sig
 
   (** Represents an axis of a jkind *)
   type 'a t =
-    | Modal : ('m, 'a, 'd) Mode.Alloc.axis -> 'a t
+    | Modal : ('a, _, _) Mode.Alloc.Axis.t -> 'a t
     | Nonmodal : 'a Nonmodal.t -> 'a t
 
   type packed = Pack : 'a t -> packed [@@unboxed]