Merge pull request ocaml#38 from Gbury/flambda2.0-stable-uncp-fix

Bugfixes for Un_cps

Author: mshinwell

middle_end/flambda2.0/basic/coeffects.ml

@@ -29,3 +29,10 @@ let compare co1 co2 =
   | No_coeffects, Has_coeffects -> -1
   | Has_coeffects, Has_coeffects -> 0
   | Has_coeffects, No_coeffects -> 1
+
+let join co1 co2 =
+  match co1, co2 with
+  | No_coeffects, No_coeffects -> No_coeffects
+  | No_coeffects, Has_coeffects
+  | Has_coeffects, Has_coeffects
+  | Has_coeffects, No_coeffects -> Has_coeffects

middle_end/flambda2.0/basic/coeffects.mli

@@ -34,3 +34,8 @@ val print : Format.formatter -> t -> unit
 
 val compare : t -> t -> int
 (** Comparison function. *)
+
+val join : t -> t -> t
+(** Join two coeffects. *)
+
+

middle_end/flambda2.0/basic/effects.ml

@@ -34,6 +34,12 @@ let compare_mutable_or_immutable mut1 mut2 =
   | Immutable, Mutable -> -1
   | Mutable, Immutable -> 1
 
+let join_mutable_or_immutable mut1 mut2 =
+  match mut1, mut2 with
+  | Immutable, Immutable -> Immutable
+  | Mutable, Mutable
+  | Immutable, Mutable
+  | Mutable, Immutable -> Mutable
 
 (* Effects *)
 
@@ -64,4 +70,17 @@ let compare eff1 eff2 =
   | Arbitrary_effects, Arbitrary_effects -> 0
   | Arbitrary_effects, (No_effects | Only_generative_effects _) -> 1
 
+let join eff1 eff2 =
+  match eff1, eff2 with
+  | No_effects, No_effects
+  | No_effects, Only_generative_effects _
+  | No_effects, Arbitrary_effects -> eff2
+  | Only_generative_effects _, No_effects -> eff1
+  | Only_generative_effects mut1,
+    Only_generative_effects mut2 ->
+      Only_generative_effects (join_mutable_or_immutable mut1 mut2)
+  | Only_generative_effects _, Arbitrary_effects -> eff2
+  | Arbitrary_effects, No_effects
+  | Arbitrary_effects, Only_generative_effects _
+  | Arbitrary_effects, Arbitrary_effects -> eff1
 

middle_end/flambda2.0/basic/effects.mli

@@ -66,3 +66,7 @@ val print : Format.formatter -> t -> unit
 
 val compare : t -> t -> int
 (** Comparison function. *)
+
+val join : t -> t -> t
+(** join two effects, effectively computing the maximum of the two
+    given effects. *)

middle_end/flambda2.0/basic/effects_and_coeffects.ml

@@ -23,8 +23,15 @@ let compare (e1, c1) (e2, c2) =
   | 0 -> Coeffects.compare c1 c2
   | res -> res
 
+(* Some useful constants *)
 let pure : t = No_effects, No_coeffects
 let all : t = Arbitrary_effects, Has_coeffects
+let read : t = No_effects, Has_coeffects
+
+(* Joining effects and coeffects *)
+let join (eff1, coeff1) (eff2, coeff2) =
+  Effects.join eff1 eff2, Coeffects.join coeff1 coeff2
+
 
 (* For the purpose of commuting (i.e. there is no duplication),
    generative effects do not count. *)

middle_end/flambda2.0/basic/effects_and_coeffects.mli

@@ -31,6 +31,10 @@ val all : t
 (** The value stating that any effects and/or coeffects may take
     place. This is exactly [Arbitrary_effects, Has_coeffects]. *)
 
+val read : t
+(** The calue stating that a read (i.e only a coeffect) takes place.
+    This is [No_effects, Has_coeffects]. *)
+
 val is_pure : t -> bool
 (** Is the expression with the given effects and coeffects pure ?
     In other words, can it commute with any expression ? *)
@@ -43,3 +47,12 @@ val has_commuting_effects : t -> bool
 (** Does the given effects and coeffects has observable effects ?
     Rather, does it have some effects with regards to whether it can
     commute with other expressions. *)
+
+val has_commuting_coeffects : t -> bool
+(** Does the given effects and coeffects has observable coeffects ?
+    Rather, does it have some coeffects with regards to whether it can
+    commute with other expressions. *)
+
+val join : t -> t -> t
+(** Join two effects and coeffects. *)
+