refactor: threads an extra 'implicit label' through types

christoph-dfinity · christoph-dfinity · commit 3656304c25fe · 2025-11-20T13:16:39.000+01:00
diff --git a/src/docs/html.ml b/src/docs/html.ml
@@ -172,7 +172,8 @@ and html_of_typ_field : env -> Syntax.typ_field -> t =
  fun env field ->
   (* TODO mut might be wrong here *)
   match field.Source.it with
-  | Syntax.ValF (id, typ, mut) ->
+  (* TODO display implicit name *)
+  | Syntax.ValF (id, _, typ, mut) ->
       html_of_mut mut ++ string (id.Source.it ^ " : ") ++ html_of_type env typ
   | Syntax.TypF (id, tbs, typ) ->
       let ty_args = html_of_typ_binders env tbs in
diff --git a/src/docs/plain.ml b/src/docs/plain.ml
@@ -190,7 +190,8 @@ and plain_of_typ_field :
     Buffer.t -> render_functions -> Syntax.typ_field -> unit =
  fun buf rf field ->
   match field.Source.it with
-  | Syntax.ValF (id, typ, mut) ->
+  (* TODO display implicit name *)
+  | Syntax.ValF (id, _, typ, mut) ->
       plain_of_mut buf mut;
       bprintf buf "%s : " id.it;
       plain_of_typ buf rf typ
diff --git a/src/ir_def/check_ir.ml b/src/ir_def/check_ir.ml
@@ -497,7 +497,7 @@ let rec check_exp env (exp:Ir.exp) : unit =
     | OptPrim, [exp1] ->
       T.Opt (typ exp1) <: t
     | TagPrim i, [exp1] ->
-      T.Variant [{T.lab = i; typ = typ exp1; src = T.empty_src}] <: t
+      T.Variant [{T.lab = i; implicit_lab = None; typ = typ exp1; src = T.empty_src}] <: t
     | ActorDotPrim n, [exp1]
     | DotPrim n, [exp1] ->
       begin
@@ -1102,7 +1102,7 @@ and check_pat_fields env t = List.iter (check_pat_field env t)
 
 and check_pat_field env t (pf : pat_field) =
   let lab = pf.it.name in
-  let tf = T.{lab; typ = pf.it.pat.note; src = empty_src} in
+  let tf = T.{lab; implicit_lab = None; typ = pf.it.pat.note; src = empty_src} in
   let s, tfs = T.as_obj_sub [lab] t in
   let (<:) = check_sub env pf.it.pat.at in
   t <: T.Obj (s, [tf]);
@@ -1137,7 +1137,7 @@ and type_exp_field env s f : T.field =
     check env f.at ((s = T.Actor) ==> T.is_shared_func t)
       "public actor field must have shared function type";
   end;
-  T.{lab = name; typ = t; src = empty_src}
+  T.{lab = name; implicit_lab = None; typ = t; src = empty_src}
 
 (* Declarations *)
 
diff --git a/src/ir_def/construct.ml b/src/ir_def/construct.ml
@@ -239,7 +239,7 @@ let optE e =
 
 let tagE i e =
  { it = PrimE (TagPrim i, [e]);
-   note = Note.{ def with typ = T.Variant [{T.lab = i; typ = typ e; src = T.empty_src}]; eff = eff e };
+   note = Note.{ def with typ = T.Variant [{T.lab = i; implicit_lab = None; typ = typ e; src = T.empty_src}]; eff = eff e };
    at = no_region;
  }
 
diff --git a/src/ir_passes/async.ml b/src/ir_passes/async.ml
@@ -238,8 +238,8 @@ let transform prog =
 
   and t_prim p = Ir.map_prim t_typ (fun id -> id) p
 
-  and t_field {lab; typ; src} =
-    { lab; typ = t_typ typ; src }
+  and t_field {lab; implicit_lab; typ; src} =
+    { lab; implicit_lab; typ = t_typ typ; src }
   in
 
   let rec t_exp (exp: exp) =
diff --git a/src/ir_passes/erase_typ_field.ml b/src/ir_passes/erase_typ_field.ml
@@ -88,8 +88,8 @@ let transform prog =
 
   and t_prim p = Ir.map_prim t_typ Fun.id p
 
-  and t_field {lab; typ; src} =
-    { lab; typ = t_typ typ; src }
+  and t_field {lab; implicit_lab; typ; src} =
+    { lab; implicit_lab; typ = t_typ typ; src }
   in
 
   let rec t_exp (exp : exp) =
diff --git a/src/lowering/desugar.ml b/src/lowering/desugar.ml
@@ -442,9 +442,9 @@ and call_system_func_opt name es obj_typ =
           let msg = fresh_var "msg" msg_typ in
           let record_typ =
             T.Obj (T.Object, List.sort T.compare_field
-             [{T.lab = "caller"; T.typ = typ_of_var caller; T.src = T.empty_src};
-               {T.lab = "arg"; T.typ = typ_of_var arg; T.src = T.empty_src};
-               {T.lab = "msg"; T.typ = typ_of_var msg; T.src = T.empty_src}])
+             [{T.lab = "caller"; implicit_lab = None; T.typ = typ_of_var caller; T.src = T.empty_src};
+               {T.lab = "arg"; implicit_lab = None; T.typ = typ_of_var arg; T.src = T.empty_src};
+               {T.lab = "msg"; implicit_lab = None; T.typ = typ_of_var msg; T.src = T.empty_src}])
           in
           let record = fresh_var "record" record_typ in
           let msg_variant =
@@ -511,7 +511,7 @@ and export_footprint self_id expr =
   let scope_con2 = Cons.fresh "T2" (Abs ([], Any)) in
   let bind1  = typ_arg scope_con1 Scope scope_bound in
   let bind2 = typ_arg scope_con2 Scope scope_bound in
-  let ret_typ = T.Obj(Object,[{lab = "size"; typ = T.nat64; src = empty_src}]) in
+  let ret_typ = T.Obj(Object,[{lab = "size"; implicit_lab = None; typ = T.nat64; src = empty_src}]) in
   let caller = fresh_var "caller" caller in
   ([ letD (var v typ) (
        funcE v (Shared Query) Promises [bind1] [] [ret_typ] (
@@ -620,7 +620,7 @@ and build_actor at ts (exp_opt : Ir.exp option) self_id es obj_typ =
   let idss = List.map fst pairs in
   let ids = List.concat idss in
   let stab_fields = List.sort T.compare_field
-    (List.map (fun (i, t) -> T.{lab = i; typ = t; src = empty_src}) ids)
+    (List.map (fun (i, t) -> T.{lab = i; implicit_lab = None; typ = t; src = empty_src}) ids)
   in
   let mem_fields =
     List.map
diff --git a/src/mo_def/arrange.ml b/src/mo_def/arrange.ml
@@ -244,7 +244,8 @@ module Make (Cfg : Config) = struct
       | Stable -> Atom "Stable")
 
   and typ_field (tf : typ_field) = source tf.at (match tf.it with
-    | ValF (lab, t, m) -> "ValF" $$ [id lab; typ t; mut m]
+    (* TODO *)
+    | ValF (lab, implicit_lab, t, m) -> "ValF" $$ [id lab; typ t; mut m]
     | TypF (lab, tbs, t) -> "TypF" $$ id lab :: List.map typ_bind tbs @ [typ t])
 
   and typ_item ((id, ty) : typ_item) =
diff --git a/src/mo_def/syntax.ml b/src/mo_def/syntax.ml
@@ -66,7 +66,7 @@ and typ' =
 and scope = typ
 and typ_field = typ_field' Source.phrase
 and typ_field' =
-  | ValF of id * typ * mut
+  | ValF of id * id option * typ * mut
   | TypF of typ_id * typ_bind list * typ
 
 and typ_tag = typ_tag' Source.phrase
diff --git a/src/mo_frontend/parser.mly b/src/mo_frontend/parser.mly
@@ -145,7 +145,7 @@ let share_typ t =
 
 let share_typfield' = function
   | TypF (c, tps, t) -> TypF (c, tps, t)
-  | ValF (x, t, m) -> ValF (x, share_typ t, m)
+  | ValF (x, ix, t, m) -> ValF (x, ix, share_typ t, m)
 
 let share_typfield (tf : typ_field) = { tf with it = share_typfield' tf.it }
 
@@ -518,11 +518,12 @@ typ_field :
   | TYPE c=typ_id  tps=type_typ_params_opt EQ t=typ
     { TypF (c, tps, t) @@ at $sloc }
   | mut=var_opt x=id COLON t=typ
-    { ValF (x, t, mut) @@ at $sloc }
+    { ValF (x, None, t, mut) @@ at $sloc }
   | x=id tps=typ_params_opt t1=typ_nullary COLON t2=typ
     { let t = funcT(Type.Local @@ no_region, tps, t1, t2)
               @! span x.at t2.at in
-      ValF (x, t, Const @@ no_region) @@ at $sloc }
+      (* TODO *)
+      ValF (x, None, t, Const @@ no_region) @@ at $sloc }
 
 typ_tag :
   | HASH x=id t=annot_opt
@@ -1089,11 +1090,11 @@ typ_dec :
 
 stab_field :
   | STABLE mut=var_opt x=id COLON t=typ
-    { ValF (x, t, mut) @@ at $sloc }
+    { ValF (x, None, t, mut) @@ at $sloc }
 
 pre_stab_field :
   | r=req mut=var_opt x=id COLON t=typ
-    { (r, ValF (x, t, mut) @@ at $sloc) }
+    { (r, ValF (x, None, t, mut) @@ at $sloc) }
 
 %inline req :
   | STABLE { false @@ at $sloc }
diff --git a/src/mo_frontend/scope.ml b/src/mo_frontend/scope.ml
@@ -9,7 +9,7 @@ module S = Mo_def.Syntax
    - The field identifier in a field pattern cannot be renamed but can be bound to a new pattern. *)
 type val_kind = Declaration | FieldReference
 
-type val_env = (T.typ * Source.region * val_kind) T.Env.t
+type val_env = (T.lab option * T.typ * Source.region * val_kind) T.Env.t
 type lib_env = T.typ T.Env.t
 type typ_env = T.con T.Env.t
 type con_env = T.ConSet.t
diff --git a/src/mo_frontend/scope.mli b/src/mo_frontend/scope.mli
@@ -1,7 +1,7 @@
 open Mo_types.Type
 
 type val_kind = Declaration | FieldReference
-type val_env = (typ * Source.region * val_kind) Env.t
+type val_env = (lab option * typ * Source.region * val_kind) Env.t
 type lib_env = Mo_types.Type.typ Env.t
 type typ_env = con Env.t
 type con_env = ConSet.t
diff --git a/src/mo_frontend/suggest.ml b/src/mo_frontend/suggest.ml
@@ -71,7 +71,7 @@ let suggest_conversion libs vals ty1 ty2 =
       else
       let imported_name =
         (* try to determine imported name, if any *)
-        Env.fold (fun id (ty1, _, _, _) acc ->
+        Env.fold (fun id (_, ty1, _, _, _) acc ->
             if ty == ty1 (*HACK*)
             then Some id
             else acc)
diff --git a/src/mo_frontend/suggest.mli b/src/mo_frontend/suggest.mli
@@ -2,7 +2,7 @@ open Mo_types
 
 val suggest_id : string (* desc *) -> string (* id *) -> string list (* ids *) -> string
 
-val suggest_conversion : Scope.lib_env -> (Type.typ * _ * _ * _) Type.Env.t -> Type.typ -> Type.typ -> string
+val suggest_conversion : Scope.lib_env -> (_ * Type.typ * _ * _ * _) Type.Env.t -> Type.typ -> Type.typ -> string
 
 val module_name_as_url : string -> string
 
diff --git a/src/mo_frontend/typing.ml b/src/mo_frontend/typing.ml
diff --git a/src/mo_idl/idl_to_mo.ml b/src/mo_idl/idl_to_mo.ml
diff --git a/src/mo_idl/mo_to_idl.ml b/src/mo_idl/mo_to_idl.ml
diff --git a/src/mo_types/arrange_type.ml b/src/mo_types/arrange_type.ml
diff --git a/src/mo_types/type.ml b/src/mo_types/type.ml
diff --git a/src/mo_types/type.mli b/src/mo_types/type.mli
diff --git a/src/pipeline/pipeline.ml b/src/pipeline/pipeline.ml

Original file line number	Diff line number	Diff line change
`@@ -239,7 +239,7 @@ let optE e =`
`239`	`239`
`240`	`240`	`let tagE i e =`
`241`	`241`	`{ it = PrimE (TagPrim i, [e]);`
`242`		`- note = Note.{ def with typ = T.Variant [{T.lab = i; typ = typ e; src = T.empty_src}]; eff = eff e };`
	`242`	`+ note = Note.{ def with typ = T.Variant [{T.lab = i; implicit_lab = None; typ = typ e; src = T.empty_src}]; eff = eff e };`
`243`	`243`	`at = no_region;`
`244`	`244`	`}`
`245`	`245`