Skip to content

Improve cppo usage #105

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
fantazio merged 2 commits into from
Sep 12, 2026
Merged

Improve cppo usage #105

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
13bc083
[src] improve cppo usage
fantazio Sep 10, 2026
20dd0e0
[src][utils] improve the compat getters
fantazio Sep 11, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 3 additions & 3 deletions check/src/io.cppo.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,12 +9,12 @@ let isatty fd =
#endscope


#if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 1, 0)
#if OCAML_VERSION >= (5, 1, 0)
let input_lines = In_channel.input_lines
#else
let [@tail_mod_cons] rec input_lines ic =
(* reproduce https://github.com/ocaml/ocaml/blob/5.3.0/stdlib/in_channel.ml#L195 *)
match In_channel.input_line ic with
| Some line -> line :: input_lines ic
| None -> []
#elif OCAML_VERSION >= (5, 1, 0) && OCAML_VERSION < (5, 6, 0)
let input_lines = In_channel.input_lines
#endif
98 changes: 42 additions & 56 deletions src/deadArg.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -70,22 +70,6 @@ let deferrable_register_use label expr builddir loc last_loc count_tbl =
else register_use ()
else register_use ()

let options_of_args args =
#if OCAML_VERSION >= (5, 4, 0) && OCAML_VERSION < (5, 6, 0)
(* Texp_apply's args changed in OCaml 5.4, from expression option
to arg_or_omitted. This does the reverse conversion *)
let args =
List.map
(fun (lab, arg) ->
match arg with
| Arg expr -> lab, Some expr
| Omitted _ -> lab, None
)
args
in
#endif
args

let rec register_uses builddir loc args =
List.iter
(fun (_, e) -> Option.iter (register_higher_order_uses builddir) e)
Expand Down Expand Up @@ -148,10 +132,10 @@ and register_higher_order_uses builddir e =
in
let$ (c_lhs, c_rhs) =
match expr.exp_desc with
#if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0)
| Texp_function {cases = [case]; _} ->
#elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0)
#if OCAML_VERSION >= (5, 2, 0)
| Texp_function (_, Tfunction_cases {cases = [case]; _}) ->
#else
| Texp_function {cases = [case]; _} ->
#endif
Some (case.c_lhs, case.c_rhs)
| _ -> None
Expand All @@ -161,7 +145,7 @@ and register_higher_order_uses builddir e =
if c_lhs.pat_loc.loc_ghost && c_rhs.exp_loc.loc_ghost
&& expr.exp_loc.loc_ghost
then
let args = options_of_args args in
let args = Utils.Compat.options_of_args args in
register_uses builddir ident_loc args
| _ -> ()
)
Expand All @@ -178,7 +162,9 @@ let register_uses val_loc args =
let rec bind loc expr =
let state = State.get_current () in
match expr.exp_desc with
#if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0)
#if OCAML_VERSION >= (5, 2, 0)
| Texp_function (params, body) -> bind_function loc params body
#else
| Texp_function {arg_label; cases; _} ->
let expr_loc = expr.exp_loc.Location.loc_start in
bind_function loc expr_loc arg_label cases
Expand All @@ -203,9 +189,6 @@ let rec bind loc expr =
expr.exp_attributes
in
if is_default expr then bind loc in_expr
#elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0)
| Texp_function (params, body) ->
bind_function loc params body
#endif
| exp_desc
when Config.must_report_opt_args state.config
Expand All @@ -222,34 +205,26 @@ let rec bind loc expr =
VdNode.merge_locs loc loc2
| _ -> ()

and bind_function loc =
and register_optional_param state loc = function
| Asttypes.Optional s
when Config.must_report_opt_args state.State.config ->
let (opts, next) = VdNode.get loc in
VdNode.update loc (s :: opts, next)
| _ -> ()

and arg_type arg_label pat_type =
match arg_label with
| Asttypes.Optional _ ->
(* The type of optional arguments is wrapped in option *)
begin match get_deep_desc pat_type with
| Tconstr (_, [typ], _) -> typ
| _ -> pat_type
end
| _ -> pat_type

#if OCAML_VERSION >= (5, 2, 0)
and bind_function loc params body =
let state = State.get_current () in
let register_optional_param = function
| Asttypes.Optional s
when Config.must_report_opt_args state.config ->
let (opts, next) = VdNode.get loc in
VdNode.update loc (s :: opts, next)
| _ -> ()
in
let arg_type arg_label pat_type =
match arg_label with
| Asttypes.Optional _ ->
(* The type of optional arguments is wrapped in option *)
begin match get_deep_desc pat_type with
| Tconstr (_, [typ], _) -> typ
| _ -> pat_type
end
| _ -> pat_type
in
#if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0)
fun expr_loc arg_label -> function
| {c_lhs = {pat_type; _}; c_rhs; _}::[] ->
let arg_type = arg_type arg_label pat_type in
DeadType.check_style arg_type expr_loc;
register_optional_param arg_label;
bind loc c_rhs
| _ -> ()
#elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0)
let process_params params =
let check_param_style arg_loc arg_label = function
| Tparam_pat {pat_type; _}
Expand All @@ -260,7 +235,7 @@ and bind_function loc =
List.iter
(fun {fp_kind; fp_arg_label; fp_loc; _} ->
check_param_style fp_loc fp_arg_label fp_kind;
register_optional_param fp_arg_label
register_optional_param state loc fp_arg_label
)
params
in
Expand All @@ -270,10 +245,21 @@ and bind_function loc =
bind loc exp
| _ -> ()
in
fun params body ->
process_params params;
process_body body
#endif
process_params params;
process_body body
#elif OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0)

@kit-ty-kate kit-ty-kate Sep 12, 2026

Copy link
Copy Markdown

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Suggested change
#elif OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0)
#elif OCAML_VERSION >= (4, 14, 0)

and bind_function loc expr_loc arg_label cases =
let state = State.get_current () in
match cases with
| {c_lhs = {pat_type; _}; c_rhs; _}::[] ->
let arg_type = arg_type arg_label pat_type in
DeadType.check_style arg_type expr_loc;
register_optional_param state loc arg_label;
bind loc c_rhs
| _ -> ()
#else
#error "unsupported version"
Comment on lines +260 to +261

@kit-ty-kate kit-ty-kate Sep 12, 2026

Copy link
Copy Markdown

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

is this preferred over having just a #else case instead of the elif right above? Does this mean the code would compile on 4.13?

@fantazio fantazio Sep 12, 2026

Copy link
Copy Markdown
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I prefer this when the conditions are far apart (in this case the #if and #elif are 25 lines apart). This way, when reaching the #elif, its condition provides all the necessary information to read its branch without having to remember the previous condition.
The #else is a safeguard against forgetting a version.

However, when the conditions are sufficiently localized for the previous condition to be in sight, I feel comfortable using an #else.

There is no plan to support OCaml < 4.14 at the moment.
The code would actually not compile because preprocessing would fail with the "unsupported version" error message (and probably for other reasons).

#endif

(******** WRAPPING ********)

Expand Down
12 changes: 0 additions & 12 deletions src/deadArg.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,18 +27,6 @@ val eocb : unit -> unit
locations, their respective files.
[eocb] = end of code base. *)

val options_of_args :
#if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 4, 0)
(Asttypes.arg_label * expression option) list
#elif OCAML_VERSION >= (5, 4, 0) && OCAML_VERSION < (5, 6, 0)
(Asttypes.arg_label * (expression, unit) arg_or_omitted) list
#endif
-> (Asttypes.arg_label * expression option) list
(** Convert Texp_apply's args representation to its OCaml 5.3 representation.
In particular, the type of a single arg changed in OCaml 5.4, from
expression option to arg_or_omitted. This does the reverse conversion.
*)

val register_uses :
Lexing.position -> (Asttypes.arg_label * expression option) list -> unit
(** An optional argument is used if it is required match a signature, or if it
Expand Down
99 changes: 34 additions & 65 deletions src/deadCode.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -35,19 +35,15 @@ let main_files = Hashtbl.create 256 (* names -> paths *)
let rec treat_exp exp args =
match exp.exp_desc with
| Texp_apply (exp, in_args) ->
let in_args = DeadArg.options_of_args in_args in
let in_args = Utils.Compat.options_of_args in_args in
treat_exp exp (in_args @ args)

| Texp_ident (_, _, {Types.val_loc = {Location.loc_start = loc; _}; _})
| Texp_field (_, _, {lbl_loc = {Location.loc_start = loc; _}; _}) ->
DeadArg.register_uses loc args

#if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 3, 0)
| Texp_match (_, comp_l, _) ->
let val_l = [] in (* effect cases appear in OCaml 5.3 *)
#elif OCAML_VERSION >= (5, 3, 0) && OCAML_VERSION < (5, 6, 0)
| Texp_match (_, comp_l, val_l, _) ->
#endif
| Texp_match _ as exp_desc ->
let (_, comp_l, val_l, _) = Utils.Compat.get_match_data_exn exp_desc in
let process_cases l =
List.iter (fun {c_rhs = exp; _} -> treat_exp exp args) l
in
Expand All @@ -68,24 +64,18 @@ let value_binding super self x =
let at_eof_saved = !DeadArg.at_eof in
DeadArg.at_eof := [];
incr depth;
let open Asttypes in
begin match x.vb_pat.pat_desc with
#if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0)
| Tpat_var (_, {loc; _})
#elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0)
| Tpat_var (_, {loc; _}, _)
#endif
when not loc.Location.loc_ghost ->
let loc = loc.Location.loc_start in
begin match Utils.Compat.get_var_data x.vb_pat.pat_desc with
| Ok (_, {loc=pat_loc; _}, _) when not pat_loc.Location.loc_ghost ->
let pat_loc = pat_loc.Location.loc_start in
begin match x.vb_expr.exp_desc with
| Texp_ident (_, _, {val_loc; _}) when not val_loc.Location.loc_ghost ->
let val_loc = val_loc.Location.loc_start in
VdNode.merge_locs loc val_loc;
DeadObj.add_equal loc val_loc
VdNode.merge_locs pat_loc val_loc;
DeadObj.add_equal pat_loc val_loc
| _ ->
let exp = x.vb_expr in
DeadArg.bind loc exp;
DeadObj.add_var loc exp
DeadArg.bind pat_loc exp;
DeadObj.add_var pat_loc exp
end
| _ -> ()
end;
Expand Down Expand Up @@ -125,25 +115,12 @@ let structure_item super self i =
r


let id_of_var : type k . k pattern_desc -> Ident.t option = function
let id_of_var pat_desc =
(* helper function to extract the var's id in tpat_var and
tpat_alias(tpat_any) patterns for all OCaml versions *)
#if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0)
| Tpat_var (id, _)
#elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0)
| Tpat_var (id, _, _)
#endif
(* x *)
#if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0)
| Tpat_alias ({pat_desc=Tpat_any; _}, id, _)
#elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 4, 0)
| Tpat_alias ({pat_desc=Tpat_any; _}, id, _, _)
#elif OCAML_VERSION >= (5, 4, 0) && OCAML_VERSION < (5, 6, 0)
| Tpat_alias ({pat_desc=Tpat_any; _}, id, _, _, _)
#endif
(* (x: t) *)
-> Some id
| _ -> None
Utils.Compat.get_var_data pat_desc
|> Result.to_option
|> Option.map (fun (id, _, _) -> id)


let pat: type k. Tast_mapper.mapper -> Tast_mapper.mapper -> k general_pattern -> k general_pattern =
Expand All @@ -154,38 +131,32 @@ let pat: type k. Tast_mapper.mapper -> Tast_mapper.mapper -> k general_pattern -
let u s =
register_style pat_loc (Printf.sprintf "unit pattern %s" s)
in
let open Asttypes in
if DeadType.is_unit p.pat_type && sections.style.unit_pat then begin
match p.pat_desc with
| Tpat_construct _ -> ()
#if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 2, 0)
| Tpat_var (_, {txt = "eta"; _})
#elif OCAML_VERSION >= (5, 2, 0) && OCAML_VERSION < (5, 6, 0)
| Tpat_var (_, {txt = "eta"; _}, _)
#endif
when p.pat_loc = Location.none -> ()
| Tpat_any -> if state.config.underscore then u "_"
| Tpat_value tpat_arg ->
begin match (tpat_arg :> value general_pattern) with
| {pat_desc=(Tpat_construct _ | Tpat_var _ | Tpat_any); _} -> ()
| _ -> u "!!pattern!!"
end
| var ->
match id_of_var var with
match id_of_var var with
| Some id ->
let txt = Ident.name id in
if check_underscore txt then u txt
if txt = "eta" && p.pat_loc = Location.none then ()
else if check_underscore txt then u txt
| None -> u "!!pattern!!"
end;
begin match p.pat_desc with
| Tpat_record (l, _) ->
List.iter
(fun (_, lab, _) ->
#if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 4, 0)
let lab : Types.label_description = lab in
#elif OCAML_VERSION >= (5, 4, 0) && OCAML_VERSION < (5, 6, 0)
#if OCAML_VERSION >= (5, 4, 0)
(* The type of lab moved in OCaml 5.4 *)
let lab : Data_types.label_description = lab in
#else
let lab : Types.label_description = lab in
#endif
let lab_loc = lab.lbl_loc.Location.loc_start in
if exported ~is_type:true sections.types lab_loc then
Expand Down Expand Up @@ -229,7 +200,7 @@ let expr super self e =


| Texp_apply (exp, args) ->
let args = DeadArg.options_of_args args in
let args = Utils.Compat.options_of_args args in
if Config.must_report_opt_args state.config then
treat_exp exp args;
begin match exp.exp_desc with
Expand All @@ -254,21 +225,19 @@ let expr super self e =
"let () = ... in ... (=> use sequence)"
end

#if OCAML_VERSION >= (4, 14, 0) && OCAML_VERSION < (5, 3, 0)
| Texp_match (_, [{c_lhs; _}], _)
#elif OCAML_VERSION >= (5, 3, 0) && OCAML_VERSION < (5, 6, 0)
| Texp_match (_, [{c_lhs; _}], [], _)
#endif
when DeadType.is_unit c_lhs.pat_type && sections.style.seq ->
begin match c_lhs.pat_desc with
| Tpat_value tpat_arg ->
begin match (tpat_arg :> value general_pattern) with
| {pat_desc=Tpat_construct _; _} ->
register_style
c_lhs.pat_loc.Location.loc_start
"let () = ... in ... (=> use sequence)"
| _ -> ()
end
| Texp_match _ as exp_desc when sections.style.seq ->
let (_, comp_l, val_l, _) = Utils.Compat.get_match_data_exn exp_desc in
begin match comp_l, val_l with
| {c_lhs={pat_desc=Tpat_value v_pat; _} as c_lhs; _}::[], []
when DeadType.is_unit c_lhs.pat_type ->
(* split pattern matching for type checking *)
begin match (v_pat :> value general_pattern) with
| {pat_desc=Tpat_construct _; _} ->
register_style
c_lhs.pat_loc.Location.loc_start
"let () = ... in ... (=> use sequence)"
| _ -> ()
end
| _ -> ()
end

Expand Down
Loading