diff --git a/ocaml/typing/env.ml b/ocaml/typing/env.ml index 69c9b9247ce..536f9131c1e 100644 --- a/ocaml/typing/env.ml +++ b/ocaml/typing/env.ml @@ -877,12 +877,15 @@ let md md_type = (** The caller is not interested in modes, and thus [val_modalities] is invalidated. *) +(* CR zqian: this is not needed *) let vda_description vda = let vda_description = vda.vda_description in {vda_description with val_modalities = Mode.Modality.Value.undefined} (** The caller wants the mode of the [value_data] *) +(* CR zqian: call this [normalize_vda_mode] *) let apply_val_modalities vda = + (* CR zqian: either inline this, or move to [types.ml] *) let decouple_val_modalities (vd : Subst.Lazy.value_description) = let modalities = vd.val_modalities in let vd = {vd with val_modalities = Mode.Modality.Value.id |> Mode.Modality.Value.internalize} in @@ -1295,6 +1298,8 @@ let find_cltype path env = (NameMap.find s sc.comp_cltypes).cltda_declaration | Papply _ | Pextra_ty _ -> raise Not_found +(* Have two versions, one takes path, one takes identity. The first doesn't run + locks, the second does. *) let find_value path env = let data, locks = find_value_full path env in let data = apply_val_modalities data in @@ -1823,6 +1828,7 @@ let rec components_of_module_maker Lazy_backtrack.create addr in (* structures are always legacy *) + (* CR zqian: rename this to [module_mode] *) let mmode = Mode.Value.legacy |> Mode.Value.disallow_right in List.iter (fun ((item : Subst.Lazy.signature_item), path) -> match item with @@ -3429,6 +3435,7 @@ let lookup_value ~errors ~use ~loc lid env = let path, locks, vda = lookup_value_lazy ~errors ~use ~loc lid env in + (* CR zqian: add comments about the ordering the applying modality and walk_locks *) let vda = apply_val_modalities vda in let vd = Subst.Lazy.force_value_description vda.vda_description in let vmode = @@ -3774,6 +3781,7 @@ let fold_modules f lid env acc = acc end +(* CR zqian: also passes mode in additional vda_description *) let fold_values f = find_all wrap_value (fun env -> env.values) (fun sc -> sc.comp_values) (fun k p ve acc -> diff --git a/ocaml/typing/mode_intf.mli b/ocaml/typing/mode_intf.mli index 800b69b2be3..817928d0955 100644 --- a/ocaml/typing/mode_intf.mli +++ b/ocaml/typing/mode_intf.mli @@ -447,6 +447,7 @@ module type S = sig val value_to_alloc_r2g : ('l * 'r) Value.t -> ('l * 'r) Alloc.t module Modality : sig + (* CR zqian: have [const] and [var], and an injection from [const] to [var]. *) type _user = private User type _internal = private Internal @@ -498,6 +499,7 @@ module type S = sig val apply_left : 'd t -> (allowed * 'r) Value.t -> Value.l (** [cons m t] returns the modality that is [m] after [t]. *) + (* CR zqian: call this [compose]. *) val cons : atom -> user -> user (** [singleton m] returns the modality containing only [m]. *) @@ -505,6 +507,7 @@ module type S = sig (** Returns the list of [atom] in the given modality. The list is commutative. *) + (* CR zqian: return record, then we don't need [Exist.t]. *) val to_list : user -> atom list type error = @@ -528,6 +531,7 @@ module type S = sig (** Printing for debugging. *) val print : Format.formatter -> 'd t -> unit + (* CR zqian: consider spliting the [lr]. Also, label the arguments. *) val infer : Value.lr -> Value.l -> internal (** Returns a user modality weaker than the given modality. The returned @@ -544,6 +548,7 @@ module type S = sig (** Returns a user modality by asserting the given modality is already user modality and returning it. *) + (* CR zqian: rename to [to_const_exn]. *) val zap_assert : 'd t -> user (** The top modality; [sub x max] succeeds for any [x]. *) diff --git a/ocaml/typing/typemod.ml b/ocaml/typing/typemod.ml index aae7179e92f..d0bfb7ef943 100644 --- a/ocaml/typing/typemod.ml +++ b/ocaml/typing/typemod.ml @@ -2875,6 +2875,7 @@ and type_structure ?(toplevel = None) funct_body anchor env sstr = let vd, mode = Env.find_value (Pident id) newenv in let vd = Subst.Lazy.force_value_description vd in (* structures are always legacy *) + (* CR zqian: rename this to [module_mode] *) let mmode = Mode.Value.legacy in begin match Mode.Value.Comonadic.submode mode.Mode.comonadic