Skip to content

Commit

Permalink
chore: address code review items
Browse files Browse the repository at this point in the history
  • Loading branch information
@anmonteiro
anmonteiro committed Jan 25, 2024
1 parent 489cdc7 commit 88a9bbe
Show file tree
Hide file tree
Showing 4 changed files with 39 additions and 34 deletions.
38 changes: 20 additions & 18 deletions ppx/ast_attributes.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,7 @@ let assert_bool_lit (e : expression) =
Location.raise_errorf ~loc:e.pexp_loc
"expected this expression to be a boolean literal (`true` or `false`)"

let warn_if_bs_or_non_namespaced ~loc txt =
let error_if_bs_or_non_namespaced ~loc txt =
match txt with
| "bs" ->
Location.raise_errorf ~loc
Expand All @@ -59,7 +59,7 @@ let process_method_attributes_rev attrs =
->
match txt with
| "mel.get" | "bs.get" | "get" ->
warn_if_bs_or_non_namespaced ~loc txt;
error_if_bs_or_non_namespaced ~loc txt;
let result =
match Ast_payload.ident_or_record_as_config payload with
| Error s -> raise (Local (loc, s))
Expand Down Expand Up @@ -88,7 +88,7 @@ let process_method_attributes_rev attrs =
in
({ st with get = Some result }, acc)
| "mel.set" | "bs.set" | "set" ->
warn_if_bs_or_non_namespaced ~loc txt;
error_if_bs_or_non_namespaced ~loc txt;
let result =
match Ast_payload.ident_or_record_as_config payload with
| Error s -> raise (Local (loc, s))
Expand Down Expand Up @@ -127,10 +127,10 @@ let process_attributes_rev attrs : attr_kind * attribute list =
| "u", (Nothing | Uncurry _) ->
(Uncurry attr, acc) (* TODO: warn unused/duplicated attribute *)
| ("mel.this" | "bs.this" | "this"), (Nothing | Meth_callback _) ->
warn_if_bs_or_non_namespaced ~loc txt;
error_if_bs_or_non_namespaced ~loc txt;
(Meth_callback attr, acc)
| ("mel.meth" | "bs.meth" | "meth"), (Nothing | Method _) ->
warn_if_bs_or_non_namespaced ~loc txt;
error_if_bs_or_non_namespaced ~loc txt;
(Method attr, acc)
| ("u" | "mel.this" | "this"), _ ->
Error.err ~loc Conflict_u_mel_this_mel_meth
Expand All @@ -139,9 +139,11 @@ let process_attributes_rev attrs : attr_kind * attribute list =

let process_pexp_fun_attributes_rev attrs =
List.fold_left
~f:(fun (st, acc) ({ attr_name = { txt; _ }; _ } as attr) ->
~f:(fun (st, acc) ({ attr_name = { txt; loc }; _ } as attr) ->
match txt with
| "mel.open" | "bs.open" -> (true, acc)
| "mel.open" | "bs.open" ->
error_if_bs_or_non_namespaced ~loc txt;
(true, acc)
| _ -> (st, attr :: acc))
~init:(false, []) attrs

Expand Down Expand Up @@ -245,7 +247,7 @@ let iter_process_mel_string_or_int_as (attrs : attributes) =
~f:(fun ({ attr_name = { txt; loc }; attr_payload = payload; _ } as attr) ->
match txt with
| "mel.as" | "bs.as" | "as" ->
warn_if_bs_or_non_namespaced ~loc txt;
error_if_bs_or_non_namespaced ~loc txt;
if !st = None then (
Mel_ast_invariant.mark_used_mel_attribute attr;
match Ast_payload.is_single_int payload with
Expand Down Expand Up @@ -306,19 +308,19 @@ let iter_process_mel_string_int_unwrap_uncurry attrs =
~f:(fun ({ attr_name = { txt; loc }; attr_payload = payload; _ } as attr) ->
match txt with
| "mel.string" | "bs.string" | "string" ->
warn_if_bs_or_non_namespaced ~loc txt;
error_if_bs_or_non_namespaced ~loc txt;
assign `String attr
| "mel.int" | "bs.int" | "int" ->
warn_if_bs_or_non_namespaced ~loc txt;
error_if_bs_or_non_namespaced ~loc txt;
assign `Int attr
| "mel.ignore" | "bs.ignore" | "ignore" ->
warn_if_bs_or_non_namespaced ~loc txt;
error_if_bs_or_non_namespaced ~loc txt;
assign `Ignore attr
| "mel.unwrap" | "bs.unwrap" | "unwrap" ->
warn_if_bs_or_non_namespaced ~loc txt;
error_if_bs_or_non_namespaced ~loc txt;
assign `Unwrap attr
| "mel.uncurry" | "bs.uncurry" | "uncurry" ->
warn_if_bs_or_non_namespaced ~loc txt;
error_if_bs_or_non_namespaced ~loc txt;
assign (`Uncurry (Ast_payload.is_single_int payload)) attr
| _ -> ())
attrs;
Expand All @@ -330,7 +332,7 @@ let iter_process_mel_string_as attrs : string option =
~f:(fun ({ attr_name = { txt; loc }; attr_payload = payload; _ } as attr) ->
match txt with
| "mel.as" | "bs.as" | "as" ->
warn_if_bs_or_non_namespaced ~loc txt;
error_if_bs_or_non_namespaced ~loc txt;
if !st = None then (
match Ast_payload.is_single_string payload with
| None -> Error.err ~loc Expect_string_literal
Expand Down Expand Up @@ -393,7 +395,7 @@ let iter_process_mel_int_as attrs =
~f:(fun ({ attr_name = { txt; loc }; attr_payload = payload; _ } as attr) ->
match txt with
| "mel.as" | "bs.as" | "as" ->
warn_if_bs_or_non_namespaced ~loc txt;
error_if_bs_or_non_namespaced ~loc txt;
if !st = None then (
match Ast_payload.is_single_int payload with
| None -> Error.err ~loc Expect_int_literal
Expand All @@ -410,7 +412,7 @@ let has_mel_optional attrs : bool =
~f:(fun ({ attr_name = { txt; loc }; _ } as attr) ->
match txt with
| "mel.optional" | "bs.optional" | "optional" ->
warn_if_bs_or_non_namespaced ~loc txt;
error_if_bs_or_non_namespaced ~loc txt;
Mel_ast_invariant.mark_used_mel_attribute attr;
true
| _ -> false)
Expand All @@ -421,7 +423,7 @@ let is_inline : attribute -> bool =
match txt with
| "mel.inline" -> true
| "bs.inline" ->
warn_if_bs_or_non_namespaced ~loc txt;
error_if_bs_or_non_namespaced ~loc txt;
false
| _ -> false

Expand All @@ -431,7 +433,7 @@ let is_mel_as { attr_name = { txt; loc }; _ } =
match txt with
| "mel.as" -> true
| "bs.as" | "as" ->
warn_if_bs_or_non_namespaced ~loc txt;
error_if_bs_or_non_namespaced ~loc txt;
false
| _ -> false

Expand Down
2 changes: 1 addition & 1 deletion ppx/ast_attributes.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@ type attr_kind =
| Uncurry of attribute
| Method of attribute

val warn_if_bs_or_non_namespaced : loc:location -> label -> unit
val error_if_bs_or_non_namespaced : loc:location -> label -> unit
val process_attributes_rev : attribute list -> attr_kind * attribute list
val process_pexp_fun_attributes_rev : attribute list -> bool * attribute list
val process_uncurried : attribute list -> bool * attribute list
Expand Down
29 changes: 16 additions & 13 deletions ppx/ast_external_process.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -295,7 +295,7 @@ let parse_external_attributes (prim_name_check : string)
let action () =
match txt with
| "mel.module" | "bs.module" | "module" -> (
Ast_attributes.warn_if_bs_or_non_namespaced ~loc txt;
Ast_attributes.error_if_bs_or_non_namespaced ~loc txt;
match Ast_payload.assert_strings loc payload with
| [ bundle ] ->
{
Expand Down Expand Up @@ -326,22 +326,25 @@ let parse_external_attributes (prim_name_check : string)
"`[%@mel.module ..]' expects, at most, a tuple of two \
strings (module name, variable name)")
| "mel.scope" | "bs.scope" | "scope" -> (
Ast_attributes.warn_if_bs_or_non_namespaced ~loc txt;
Ast_attributes.error_if_bs_or_non_namespaced ~loc txt;
match Ast_payload.assert_strings loc payload with
| [] ->
Location.raise_errorf ~loc
"`[%@mel.scope ..]' expects a tuple of strings in its payload"
(* We need err on empty scope, so we can tell the difference
between unset/set *)
| scopes -> { st with scopes })
| "mel.splice" | "bs.splice" | "splice" ->
Location.raise_errorf ~loc
"`%s' has been removed. Use `@mel.variadic' instead." txt
| "mel.variadic" | "bs.variadic" | "variadic" ->
Ast_attributes.warn_if_bs_or_non_namespaced ~loc txt;
Ast_attributes.error_if_bs_or_non_namespaced ~loc txt;
{ st with variadic = true }
| "mel.send" | "bs.send" | "send" ->
Ast_attributes.warn_if_bs_or_non_namespaced ~loc txt;
Ast_attributes.error_if_bs_or_non_namespaced ~loc txt;
{ st with val_send = name_from_payload_or_prim ~loc payload }
| "mel.send.pipe" | "bs.send.pipe" | "send.pipe" ->
Ast_attributes.warn_if_bs_or_non_namespaced ~loc txt;
Ast_attributes.error_if_bs_or_non_namespaced ~loc txt;
{
st with
val_send_pipe =
Expand All @@ -353,33 +356,33 @@ let parse_external_attributes (prim_name_check : string)
`[%@mel.send.pipe: t]'");
}
| "mel.set" | "bs.set" | "set" ->
Ast_attributes.warn_if_bs_or_non_namespaced ~loc txt;
Ast_attributes.error_if_bs_or_non_namespaced ~loc txt;
{ st with set_name = name_from_payload_or_prim ~loc payload }
| "mel.get" | "bs.get" | "get" ->
Ast_attributes.warn_if_bs_or_non_namespaced ~loc txt;
Ast_attributes.error_if_bs_or_non_namespaced ~loc txt;
{ st with get_name = name_from_payload_or_prim ~loc payload }
| "mel.new" | "bs.new" | "new" ->
Ast_attributes.warn_if_bs_or_non_namespaced ~loc txt;
Ast_attributes.error_if_bs_or_non_namespaced ~loc txt;
{ st with new_name = name_from_payload_or_prim ~loc payload }
| "mel.set_index" | "bs.set_index" | "set_index" ->
Ast_attributes.warn_if_bs_or_non_namespaced ~loc txt;
Ast_attributes.error_if_bs_or_non_namespaced ~loc txt;
if String.length prim_name_check <> 0 then
Location.raise_errorf ~loc
"`%@mel.set_index' requires its `external' payload to be the \
empty string";
{ st with set_index = true }
| "mel.get_index" | "bs.get_index" | "get_index" ->
Ast_attributes.warn_if_bs_or_non_namespaced ~loc txt;
Ast_attributes.error_if_bs_or_non_namespaced ~loc txt;
if String.length prim_name_check <> 0 then
Location.raise_errorf ~loc
"`%@mel.get_index' requires its `external' payload to be the \
empty string";
{ st with get_index = true }
| "mel.obj" | "bs.obj" | "obj" ->
Ast_attributes.warn_if_bs_or_non_namespaced ~loc txt;
Ast_attributes.error_if_bs_or_non_namespaced ~loc txt;
{ st with mk_obj = true }
| "mel.return" | "bs.return" | "return" -> (
Ast_attributes.warn_if_bs_or_non_namespaced ~loc txt;
Ast_attributes.error_if_bs_or_non_namespaced ~loc txt;
match Ast_payload.ident_or_record_as_config payload with
| Ok [ ({ txt; _ }, None) ] ->
{ st with return_wrapper = return_wrapper loc txt }
Expand All @@ -397,7 +400,7 @@ let has_mel_uncurry (attrs : attribute list) =
match txt with
| "mel.uncurry" -> true
| "bs.uncurry" | "uncurry" ->
Ast_attributes.warn_if_bs_or_non_namespaced ~loc txt;
Ast_attributes.error_if_bs_or_non_namespaced ~loc txt;
false
| _ -> false)
attrs
Expand Down
4 changes: 2 additions & 2 deletions ppx/melange_ppx.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -732,7 +732,7 @@ module Mapper = struct
{ txt = ("mel.config" | "bs.config" | "config") as txt; loc };
_;
} as attr) ->
Ast_attributes.warn_if_bs_or_non_namespaced ~loc txt;
Ast_attributes.error_if_bs_or_non_namespaced ~loc txt;
Mel_ast_invariant.mark_used_mel_attribute attr;
str
| Pstr_module
Expand Down Expand Up @@ -938,7 +938,7 @@ module Mapper = struct
{ txt = ("mel.config" | "bs.config" | "config") as txt; loc };
_;
} as attr) ->
Ast_attributes.warn_if_bs_or_non_namespaced ~loc txt;
Ast_attributes.error_if_bs_or_non_namespaced ~loc txt;
Mel_ast_invariant.mark_used_mel_attribute attr;
sigi
| Psig_module
Expand Down

0 comments on commit 88a9bbe

Please sign in to comment.