Skip to content

Commit 4cec137

Browse files
avsmavsm
authored
Merge pull request #231 from emillon/ignore-unused-sizeof
Suppress unused warning on "sizeof" & cenum functions
2 parents a6a768d + aef90c7 commit 4cec137

File tree

3 files changed

+150
-93
lines changed

3 files changed

+150
-93
lines changed

‎ppx/ppx_cstruct.ml

Lines changed: 140 additions & 93 deletions
Original file line numberDiff line numberDiff line change
@@ -329,98 +329,139 @@ let output_struct_sig loc s =
329329
(op_typ op)))
330330
(ops_for s)
331331

332-
let output_enum _loc name fields width ~sexp =
333-
let intfn,pattfn = match ty_of_string width with
334-
|None -> loc_err _loc "enum: unknown width specifier %s" width
335-
|Some Char ->
336-
(fun i -> Exp.constant (Pconst_char (Char.chr @@ Int64.to_int i))),
337-
(fun i -> Pat.constant (Pconst_char (Char.chr @@ Int64.to_int i)))
338-
|Some (UInt8 | UInt16) ->
339-
(fun i -> Exp.constant (Pconst_integer(Int64.to_string i, None))),
340-
(fun i -> Pat.constant (Pconst_integer(Int64.to_string i, None)))
341-
|Some UInt32 ->
342-
(fun i -> Exp.constant (Pconst_integer (Int32.to_string (Int64.to_int32 i), Some 'l'))),
343-
(fun i -> Pat.constant (Pconst_integer (Int32.to_string (Int64.to_int32 i), Some 'l')))
344-
|Some UInt64 ->
345-
(fun i -> Exp.constant (Pconst_integer (Int64.to_string i, Some 'L'))),
346-
(fun i -> Pat.constant (Pconst_integer (Int64.to_string i, Some 'L')))
332+
type enum_op =
333+
| Enum_to_sexp
334+
| Enum_of_sexp
335+
| Enum_get
336+
| Enum_set
337+
| Enum_print
338+
| Enum_parse
339+
340+
type cenum =
341+
{ name : string Loc.loc;
342+
fields : (string Loc.loc * int64) list;
343+
prim : prim;
344+
sexp : bool;
345+
}
346+
347+
let enum_op_name cenum =
348+
let s = cenum.name.txt in
349+
function
350+
| Enum_to_sexp -> sprintf "sexp_of_%s" s
351+
| Enum_of_sexp -> sprintf "%s_of_sexp" s
352+
| Enum_get -> sprintf "int_to_%s" s
353+
| Enum_set -> sprintf "%s_to_int" s
354+
| Enum_print -> sprintf "%s_to_string" s
355+
| Enum_parse -> sprintf "string_to_%s" s
356+
357+
let enum_pattern {prim; _} =
358+
let pat_integer f suffix i =
359+
Pat.constant (Pconst_integer(f i, suffix))
347360
in
348-
let decls = List.map (fun (f,_) -> Type.constructor f) fields in
349-
let getters = (List.map (fun ({txt = f; _},i) ->
350-
{pc_lhs = pattfn i; pc_guard = None; pc_rhs = Ast.constr "Some" [Ast.constr f []]}
351-
) fields) @ [{pc_lhs = Pat.any (); pc_guard = None; pc_rhs = Ast.constr "None" []}] in
352-
let setters = List.map (fun ({txt = f; _},i) ->
353-
{pc_lhs = Ast.pconstr f []; pc_guard = None; pc_rhs = intfn i}
354-
) fields in
355-
let printers = List.map (fun ({txt = f; _},_) ->
356-
{pc_lhs = Ast.pconstr f []; pc_guard = None; pc_rhs = Ast.str f}) fields in
357-
let parsers = List.map (fun ({txt = f; _},_) ->
358-
{pc_lhs = Ast.pstr f; pc_guard = None; pc_rhs = Ast.constr "Some" [Ast.constr f []]}) fields in
359-
let getter {txt = x; _} = sprintf "int_to_%s" x in
360-
let setter {txt = x; _} = sprintf "%s_to_int" x in
361-
let printer {txt = x; _} = sprintf "%s_to_string" x in
362-
let parse {txt = x; _} = sprintf "string_to_%s" x in
363-
let of_sexp {txt = x; _} = sprintf "%s_of_sexp" x in
364-
let to_sexp {txt = x; _} = sprintf "sexp_of_%s" x in
365-
let output_sexp_struct =
366-
[
367-
[%stri
368-
let [%p Ast.pvar (to_sexp name)] = fun x ->
369-
Sexplib.Sexp.Atom ([%e Ast.evar (printer name)] x)];
370-
[%stri
371-
let [%p Ast.pvar (of_sexp name)] = fun x ->
372-
match x with
373-
| Sexplib.Sexp.List _ ->
374-
raise (Sexplib.Pre_sexp.Of_sexp_error (Failure "expected Atom, got List", x))
375-
| Sexplib.Sexp.Atom v ->
376-
match [%e Ast.evar (parse name)] v with
377-
| None ->
378-
raise (Sexplib.Pre_sexp.Of_sexp_error (Failure "unable to parse enum string", x))
379-
| Some r -> r
380-
]
381-
] in
382-
Str.type_ Recursive [Type.mk ~kind:(Ptype_variant decls) name] ::
383-
[%stri
384-
let [%p Ast.pvar (getter name)] = fun x -> [%e Exp.match_ [%expr x] getters]] ::
385-
[%stri
386-
let [%p Ast.pvar (setter name)] = fun x -> [%e Exp.match_ [%expr x] setters]] ::
387-
[%stri
388-
let [%p Ast.pvar (printer name)] = fun x -> [%e Exp.match_ [%expr x] printers]] ::
389-
[%stri
390-
let [%p Ast.pvar (parse name)] = fun x ->
391-
[%e Exp.match_ [%expr x]
392-
(parsers @ [{pc_lhs = Pat.any (); pc_guard = None; pc_rhs = Ast.constr "None" []}])]] ::
393-
if sexp then output_sexp_struct else []
394-
395-
let output_enum_sig _loc name fields width ~sexp =
396-
let oty = match ty_of_string width with
397-
|None -> loc_err _loc "enum: unknown width specifier %s" width
398-
|Some Char -> [%type: char]
399-
|Some (UInt8|UInt16) -> [%type: int]
400-
|Some UInt32 -> [%type: int32]
401-
|Some UInt64 -> [%type: int64]
361+
match prim with
362+
| Char ->
363+
(fun i -> Ast.pchar (Char.chr (Int64.to_int i)))
364+
| (UInt8 | UInt16) -> pat_integer Int64.to_string None
365+
| UInt32 -> pat_integer (fun i -> Int32.to_string (Int64.to_int32 i)) (Some 'l')
366+
| UInt64 -> pat_integer Int64.to_string (Some 'L')
367+
368+
let enum_integer {prim; _} =
369+
let expr_integer f suffix i =
370+
Exp.constant (Pconst_integer(f i, suffix))
402371
in
372+
match prim with
373+
| Char -> (fun i -> Ast.char (Char.chr (Int64.to_int i)))
374+
| (UInt8 | UInt16) -> expr_integer Int64.to_string None
375+
| UInt32 -> expr_integer (fun i -> Int32.to_string (Int64.to_int32 i)) (Some 'l')
376+
| UInt64 -> expr_integer Int64.to_string (Some 'L')
377+
378+
let declare_enum_expr ({fields; _} as cenum) = function
379+
| Enum_to_sexp ->
380+
[%expr Sexplib.Sexp.Atom ([%e Ast.evar (enum_op_name cenum Enum_print)] x) ]
381+
| Enum_of_sexp ->
382+
[%expr
383+
match x with
384+
| Sexplib.Sexp.List _ ->
385+
raise (Sexplib.Pre_sexp.Of_sexp_error (Failure "expected Atom, got List", x))
386+
| Sexplib.Sexp.Atom v ->
387+
match [%e Ast.evar (enum_op_name cenum Enum_parse)] v with
388+
| None ->
389+
raise (Sexplib.Pre_sexp.Of_sexp_error (Failure "unable to parse enum string", x))
390+
| Some r -> r
391+
]
392+
| Enum_get ->
393+
let getters = (List.map (fun ({txt = f; _},i) ->
394+
Exp.case (enum_pattern cenum i) [%expr Some [%e Ast.constr f []]]
395+
) fields) @ [Exp.case [%pat? _] [%expr None]]
396+
in
397+
Exp.match_ [%expr x] getters
398+
| Enum_set ->
399+
let setters = List.map (fun ({txt = f; _},i) ->
400+
Exp.case (Ast.pconstr f []) (enum_integer cenum i)
401+
) fields in
402+
Exp.match_ [%expr x] setters
403+
| Enum_print ->
404+
let printers = List.map (fun ({txt = f; _},_) ->
405+
Exp.case (Ast.pconstr f []) (Ast.str f)
406+
) fields in
407+
Exp.match_ [%expr x] printers
408+
| Enum_parse ->
409+
let parsers = List.map (fun ({txt = f; _},_) ->
410+
Exp.case (Ast.pstr f) [%expr Some [%e Ast.constr f []]]
411+
) fields in
412+
Exp.match_ [%expr x]
413+
(parsers @ [Exp.case [%pat? _] [%expr None]])
414+
415+
let enum_ops_for {sexp; _} =
416+
Enum_get ::
417+
Enum_set ::
418+
Enum_print ::
419+
Enum_parse ::
420+
if sexp then
421+
[ Enum_to_sexp
422+
; Enum_of_sexp
423+
]
424+
else
425+
[]
426+
427+
let enum_type_decl {name; fields; _} =
403428
let decls = List.map (fun (f,_) -> Type.constructor f) fields in
404-
let getter {txt = x; _} = sprintf "int_to_%s" x in
405-
let setter {txt = x; _} = sprintf "%s_to_int" x in
406-
let printer {txt = x; _} = sprintf "%s_to_string" x in
407-
let parse {txt = x; _} = sprintf "string_to_%s" x in
408-
let of_sexp {txt = x; _} = sprintf "%s_of_sexp" x in
409-
let to_sexp {txt = x; _} = sprintf "sexp_of_%s" x in
410-
let ctyo = [%type: [%t Ast.tconstr name.txt []] option] in
429+
Type.mk ~kind:(Ptype_variant decls) name
430+
431+
let output_enum cenum =
432+
Str.type_ Recursive [enum_type_decl cenum] ::
433+
List.map
434+
(fun op ->
435+
[%stri
436+
let[@ocaml.warning "-32"] [%p Ast.pvar (enum_op_name cenum op)] =
437+
fun x -> [%e declare_enum_expr cenum op]
438+
])
439+
(enum_ops_for cenum)
440+
441+
let enum_op_type {name; prim; _} =
411442
let cty = Ast.tconstr name.txt [] in
412-
let output_sexp_sig =
413-
[
414-
Sig.value (Val.mk (Loc.mkloc (to_sexp name) _loc) [%type: [%t cty] -> Sexplib.Sexp.t]);
415-
Sig.value (Val.mk (Loc.mkloc (of_sexp name) _loc) [%type: Sexplib.Sexp.t -> [%t cty]])
416-
]
443+
let oty = match prim with
444+
| Char -> [%type: char]
445+
| (UInt8|UInt16) -> [%type: int]
446+
| UInt32 -> [%type: int32]
447+
| UInt64 -> [%type: int64]
417448
in
418-
Sig.type_ Recursive [Type.mk ~kind:(Ptype_variant decls) name] ::
419-
Sig.value (Val.mk (Loc.mkloc (getter name) _loc) [%type: [%t oty] -> [%t ctyo]]) ::
420-
Sig.value (Val.mk (Loc.mkloc (setter name) _loc) [%type: [%t cty] -> [%t oty]]) ::
421-
Sig.value (Val.mk (Loc.mkloc (printer name) _loc) [%type: [%t cty] -> string]) ::
422-
Sig.value (Val.mk (Loc.mkloc (parse name) _loc) [%type: string -> [%t cty] option]) ::
423-
if sexp then output_sexp_sig else []
449+
function
450+
| Enum_get -> [%type: [%t oty] -> [%t cty] option]
451+
| Enum_set -> [%type: [%t cty] -> [%t oty]]
452+
| Enum_print -> [%type: [%t cty] -> string]
453+
| Enum_parse -> [%type: string -> [%t cty] option]
454+
| Enum_to_sexp -> [%type: [%t cty] -> Sexplib.Sexp.t]
455+
| Enum_of_sexp -> [%type: Sexplib.Sexp.t -> [%t cty]]
456+
457+
let output_enum_sig loc (cenum:cenum) =
458+
Sig.type_ Recursive [enum_type_decl cenum] ::
459+
List.map
460+
(fun op ->
461+
let name = enum_op_name cenum op in
462+
let typ = enum_op_type cenum op in
463+
Sig.value (Val.mk (Loc.mkloc name loc) typ))
464+
(enum_ops_for cenum)
424465

425466
let constr_enum = function
426467
| {pcd_name = f; pcd_args = Pcstr_tuple []; pcd_attributes = attrs; _} ->
@@ -500,7 +541,15 @@ let cenum decl =
500541
| (f, None) -> incr_n (); (f, !n)
501542
| (f, Some i) -> n := i; (f, i)
502543
) fields in
503-
name, fields, width, sexp
544+
let prim = match ty_of_string width with
545+
| None -> loc_err loc "enum: unknown width specifier %s" width
546+
| Some p -> p
547+
in
548+
{ name;
549+
fields;
550+
prim;
551+
sexp;
552+
}
504553

505554
let signature_item' mapper = function
506555
| {psig_desc =
@@ -510,8 +559,7 @@ let signature_item' mapper = function
510559
| {psig_desc =
511560
Psig_extension (({txt = "cenum"; _}, PStr [{pstr_desc = Pstr_type(_, [decl]); _}]), _);
512561
psig_loc = loc} ->
513-
let name, fields, width, sexp = cenum decl in
514-
output_enum_sig loc name fields width ~sexp
562+
output_enum_sig loc (cenum decl)
515563
| other ->
516564
[default_mapper.signature_item mapper other]
517565

@@ -525,9 +573,8 @@ let structure_item' mapper = function
525573
output_struct loc (cstruct decl)
526574
| {pstr_desc =
527575
Pstr_extension (({txt = "cenum"; _}, PStr [{pstr_desc = Pstr_type(_, [decl]); _}]), _);
528-
pstr_loc = loc} ->
529-
let name, fields, width, sexp = cenum decl in
530-
output_enum loc name fields width ~sexp
576+
_ } ->
577+
output_enum (cenum decl)
531578
| other ->
532579
[default_mapper.structure_item mapper other]
533580

‎ppx_test/basic.ml

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -86,6 +86,16 @@ type with_ignored_field = {
8686

8787
let _ : bool = set_with_ignored_field__b
8888

89+
(** This should not emit any warnings either *)
90+
[%%cenum
91+
type unused_cenum =
92+
| DROPPED [@id 0xfffe]
93+
| ERROR [@id 0xffff]
94+
| OKAY [@id 0]
95+
| NULL [@id 1]
96+
[@@int16_t] [@@sexp]
97+
]
98+
8999
let tests () =
90100
(* Test basic set/get functions *)
91101
let be = Cstruct.of_bigarray (Bigarray.(Array1.create char c_layout sizeof_foo)) in

‎ppx_test/basic.mli

Whitespace-only changes.

0 commit comments

Comments
 (0)