Refactor used attributes (#6795)

cristianoc · cknitt · web-flow · commit 6ec02b140fd8 · 2024-05-31T20:51:07.000+02:00
* Refactor used attributes * Mark "as" attribute as used when processed in untagged variants. * Mark @as used early in constructor declarations, and turn on unused check. A couple of test files were mis-using `@as`. * Fix format * CHANGELOG --------- Co-authored-by: Christoph Knittel <ck@cca.io>
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -29,6 +29,7 @@
 
 - Fix unhandled cases for exotic idents (allow to use exotic PascalCased identifiers for types). https://github.com/rescript-lang/rescript-compiler/pull/6777
 - PPX v4: mark props type in externals as `@live` to avoid dead code warnings for prop fields in the editor tooling. https://github.com/rescript-lang/rescript-compiler/pull/6796
+- Fix unused attribute check for `@as`. https://github.com/rescript-lang/rescript-compiler/pull/6795
 
 #### :house: Internal
 
diff --git a/jscomp/frontend/ast_attributes.ml b/jscomp/frontend/ast_attributes.ml
@@ -212,7 +212,7 @@ let iter_process_bs_string_int_unwrap_uncurry (attrs : t) =
   let st = ref `Nothing in
   let assign v (({loc; _}, _) as attr : attr) =
     if !st = `Nothing then (
-      Bs_ast_invariant.mark_used_bs_attribute attr;
+      Used_attributes.mark_used_attribute attr;
       st := v)
     else Bs_syntaxerr.err loc Conflict_attributes
   in
@@ -235,7 +235,7 @@ let iter_process_bs_string_as (attrs : t) : string option =
           match Ast_payload.is_single_string payload with
           | None -> Bs_syntaxerr.err loc Expect_string_literal
           | Some (v, _dec) ->
-            Bs_ast_invariant.mark_used_bs_attribute attr;
+            Used_attributes.mark_used_attribute attr;
             st := Some v)
         else raise (Ast_untagged_variants.Error (loc, Duplicated_bs_as))
       | _ -> ());
@@ -244,7 +244,7 @@ let has_bs_optional (attrs : t) : bool =
   Ext_list.exists attrs (fun (({txt}, _) as attr) ->
       match txt with
       | "optional" ->
-        Bs_ast_invariant.mark_used_bs_attribute attr;
+        Used_attributes.mark_used_attribute attr;
         true
       | _ -> false)
 
@@ -257,7 +257,7 @@ let iter_process_bs_int_as (attrs : t) =
           match Ast_payload.is_single_int payload with
           | None -> Bs_syntaxerr.err loc Expect_int_literal
           | Some _ as v ->
-            Bs_ast_invariant.mark_used_bs_attribute attr;
+            Used_attributes.mark_used_attribute attr;
             st := v)
         else raise (Ast_untagged_variants.Error (loc, Duplicated_bs_as))
       | _ -> ());
@@ -271,7 +271,7 @@ let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) =
       match txt with
       | "as" ->
         if !st = None then (
-          Bs_ast_invariant.mark_used_bs_attribute attr;
+          Used_attributes.mark_used_attribute attr;
           match Ast_payload.is_single_int payload with
           | None -> (
             match payload with
diff --git a/jscomp/frontend/ast_config.ml b/jscomp/frontend/ast_config.ml
@@ -59,7 +59,7 @@ let rec iter_on_bs_config_str (x : Parsetree.structure) =
   | [] -> ()
   | {pstr_desc = Pstr_attribute (({txt = "config"; loc}, payload) as attr)} :: _
     ->
-    Bs_ast_invariant.mark_used_bs_attribute attr;
+    Used_attributes.mark_used_attribute attr;
     Ext_list.iter
       (Ast_payload.ident_or_record_as_config loc payload)
       (Ast_payload.table_dispatch !structural_config_table)
@@ -75,7 +75,7 @@ let rec iter_on_bs_config_sig (x : Parsetree.signature) =
   | [] -> ()
   | {psig_desc = Psig_attribute (({txt = "config"; loc}, payload) as attr)} :: _
     ->
-    Bs_ast_invariant.mark_used_bs_attribute attr;
+    Used_attributes.mark_used_attribute attr;
     Ext_list.iter
       (Ast_payload.ident_or_record_as_config loc payload)
       (Ast_payload.table_dispatch !signature_config_table)
diff --git a/jscomp/frontend/bs_ast_invariant.ml b/jscomp/frontend/bs_ast_invariant.ml
@@ -28,33 +28,16 @@
 *)
 let is_bs_attribute txt =
   match txt with
-  (* TODO #6636: | "as "| "int" *)
-  | "bs" | "config" | "ignore" | "optional" | "string" | "uncurry" | "unwrap" ->
+  (* TODO #6636: "int" *)
+  | "as" | "bs" | "config" | "ignore" | "optional" | "string" | "uncurry"
+  | "unwrap" ->
     true
   | _ -> false
 
-let used_attributes : string Asttypes.loc Hash_set_poly.t =
-  Hash_set_poly.create 16
-
-(*
-  let dump_attribute fmt = (fun ( (sloc : string Asttypes.loc),payload) -> 
-      Format.fprintf fmt "@[%s %a@]" sloc.txt (Printast.payload 0 ) payload
-    )
-
-let dump_used_attributes fmt = 
-  Format.fprintf fmt "Used attributes Listing Start:@.";
-  Hash_set_poly.iter  used_attributes (fun attr -> dump_attribute fmt attr) ;
-  Format.fprintf fmt "Used attributes Listing End:@."
- *)
-
-(* only mark non-ghost used bs attribute *)
-let mark_used_bs_attribute ((x, _) : Parsetree.attribute) =
-  if not x.loc.loc_ghost then Hash_set_poly.add used_attributes x
-
 let warn_unused_attribute ((({txt; loc} as sloc), _) : Parsetree.attribute) =
   if
     is_bs_attribute txt && (not loc.loc_ghost)
-    && not (Hash_set_poly.mem used_attributes sloc)
+    && not (Used_attributes.is_used_attribute sloc)
   then
     (*
          dump_used_attributes Format.err_formatter;
@@ -126,11 +109,15 @@ let emit_external_warnings : iterator =
       (fun self lbl ->
         Ext_list.iter lbl.pld_attributes (fun attr ->
             match attr with
-            | {txt = "as"}, _ -> mark_used_bs_attribute attr
+            | {txt = "as"}, _ -> Used_attributes.mark_used_attribute attr
             | _ -> ());
         super.label_declaration self lbl);
     constructor_declaration =
       (fun self ({pcd_name = {txt; loc}} as ctr) ->
+        let _ =
+          Ast_untagged_variants.process_tag_type
+            ctr.pcd_attributes (* mark @as used in variant cases *)
+        in
         (match txt with
         | "false" | "true" | "()" ->
           Location.raise_errorf ~loc "%s can not be redefined " txt
diff --git a/jscomp/frontend/bs_ast_invariant.mli b/jscomp/frontend/bs_ast_invariant.mli
@@ -24,8 +24,6 @@
 
 type iterator = Ast_iterator.iterator
 
-val mark_used_bs_attribute : Parsetree.attribute -> unit
-
 (** [warn_discarded_unused_attributes discarded]
     warn if [discarded] has unused bs attribute
 *)
diff --git a/jscomp/frontend/bs_builtin_ppx.ml b/jscomp/frontend/bs_builtin_ppx.ml
@@ -55,7 +55,7 @@ let succeed attr attrs =
   match attrs with
   | [_] -> ()
   | _ ->
-    Bs_ast_invariant.mark_used_bs_attribute attr;
+    Used_attributes.mark_used_attribute attr;
     Bs_ast_invariant.warn_discarded_unused_attributes attrs
 
 type mapper = Bs_ast_mapper.mapper
diff --git a/jscomp/ml/ast_untagged_variants.ml b/jscomp/ml/ast_untagged_variants.ml
@@ -111,7 +111,7 @@ let expand_head: (Env.t -> Types.type_expr -> Types.type_expr) ref = ref (Obj.ma
 
 let process_tag_type (attrs : Parsetree.attributes) =
   let st : tag_type option ref = ref None in
-  Ext_list.iter attrs (fun ({txt; loc}, payload) ->
+  Ext_list.iter attrs (fun (({txt; loc}, payload) as attr) ->
       match txt with
       | "as" ->
         if !st = None then (
@@ -135,7 +135,8 @@ let process_tag_type (attrs : Parsetree.attributes) =
           | Some (Lident "null") -> st := Some Null
           | Some (Lident "undefined") -> st := Some Undefined
           | Some _ -> raise (Error (loc, InvalidVariantAsAnnotation)));
-          if !st = None then raise (Error (loc, InvalidVariantAsAnnotation)))
+          if !st = None then raise (Error (loc, InvalidVariantAsAnnotation))
+          else Used_attributes.mark_used_attribute attr)
         else raise (Error (loc, Duplicated_bs_as))
       | _ -> ());
   !st
diff --git a/jscomp/ml/used_attributes.ml b/jscomp/ml/used_attributes.ml
@@ -0,0 +1,19 @@
+let used_attributes : string Asttypes.loc Hash_set_poly.t =
+  Hash_set_poly.create 16
+
+
+(* let dump_attribute fmt = (fun ( (sloc : string Asttypes.loc)) -> 
+    Format.fprintf fmt "@[%s@]" sloc.txt
+  )
+
+let dump_used_attributes fmt = 
+  Format.fprintf fmt "Used attributes Listing Start:@.";
+  Hash_set_poly.iter  used_attributes (fun attr -> dump_attribute fmt attr) ;
+  Format.fprintf fmt "Used attributes Listing End:@." *)
+
+
+(* only mark non-ghost used bs attribute *)
+let mark_used_attribute ((x, _) : Parsetree.attribute) =
+  if not x.loc.loc_ghost then Hash_set_poly.add used_attributes x
+
+let is_used_attribute (sloc : string Asttypes.loc) = Hash_set_poly.mem used_attributes sloc
diff --git a/jscomp/ml/used_attributes.mli b/jscomp/ml/used_attributes.mli
@@ -0,0 +1,3 @@
+val mark_used_attribute : Parsetree.attribute -> unit
+
+val is_used_attribute : string Asttypes.loc -> bool
diff --git a/jscomp/test/AsInUncurriedExternals.res b/jscomp/test/AsInUncurriedExternals.res
@@ -12,5 +12,5 @@ let mo = makeOptions
 
 let options = mo(~name="foo", ())
 
-let shouldNotFail: (~objectMode: @as(json`false`) _, ~name: string) => int = (~objectMode, ~name) =>
+let shouldNotFail: (~objectMode: _, ~name: string) => int = (~objectMode, ~name) =>
   3
diff --git a/jscomp/test/polyvar_convert.res b/jscomp/test/polyvar_convert.res
@@ -1,5 +1,5 @@
 type t = [
-  | @as("x") #a
+  | #a
   | #b
 ]
 

Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,3 @@`
	`1`	`+val mark_used_attribute : Parsetree.attribute -> unit`
	`2`	`+`
	`3`	`+val is_used_attribute : string Asttypes.loc -> bool`
Original file line number	Diff line number	Diff line change
`@@ -12,5 +12,5 @@ let mo = makeOptions`
`12`	`12`
`13`	`13`	`let options = mo(~name="foo", ())`
`14`	`14`
`15`		-let shouldNotFail: (~objectMode: @as(json`false`) _, ~name: string) => int = (~objectMode, ~name) =>
	`15`	`+let shouldNotFail: (~objectMode: _, ~name: string) => int = (~objectMode, ~name) =>`
`16`	`16`	`3`
Original file line number	Diff line number	Diff line change
`@@ -1,5 +1,5 @@`
`1`	`1`	`type t = [`
`2`		`- \| @as("x") #a`
	`2`	`+ \| #a`
`3`	`3`	`\| #b`
`4`	`4`	`]`
`5`	`5`