gazagnaire.org
OCaml wire format DSL with EverParse 3D output for verified parsers
1(** Dependent Data Descriptions for binary wire formats.
2
3 Wire is a GADT-based DSL for describing binary wire formats compatible with
4 EverParse's 3D language. Define your format once, then:
5
6 - Use {!to_3d} to emit EverParse 3D format for verified C parser generation
7
8 {b EverParse 3D Language Support}
9
10 This module supports the full EverParse 3D language including:
11 - Base types: UINT8, UINT16, UINT32, UINT64 (LE and BE)
12 - Bitfields with constraints
13 - Enumerations
14 - Structs with dependent fields
15 - Tagged unions (casetype)
16 - Arrays (fixed-size, byte-size, variable)
17 - Parameterized types
18 - Constraints (where clauses)
19 - Actions (:on-success, :act)
20 - Extern declarations *)
21
22(** {1 Staged Computations}
23
24 Following the pattern from
25 {{:https://mirage.github.io/repr/repr/Repr/index.html}Irmin's repr}, staged
26 functions make specialization explicit. The cost of building a specialized
27 encoder/decoder is paid once when [unstage] is called, then subsequent calls
28 to the resulting function are fast.
29
30 Example:
31 {[
32 let codec = Record.record "Packet" ~default ...
33 let encode = Staged.unstage (Record.encode codec) (* pay cost here *)
34 for _ = 1 to n do
35 let _ = encode packet in (* fast - no interpretation overhead *)
36 ...
37 done
38 ]} *)
39module Staged : sig
40 type +'a t
41 (** A staged computation of type ['a]. *)
42
43 val stage : 'a -> 'a t
44 (** [stage x] wraps [x] in a staged computation. *)
45
46 val unstage : 'a t -> 'a
47 (** [unstage t] extracts the value from a staged computation. This is where
48 the cost of specialization is paid. *)
49end
50
51(** {1 Unboxed Integer Types}
52
53 On 64-bit platforms, these types are unboxed (immediate) for zero-allocation
54 parsing. On 32-bit platforms, the module will fail at initialization. *)
55
56module UInt32 : sig
57 type t = int
58 (** Unsigned 32-bit integer. Unboxed on 64-bit platforms (fits in 63-bit int).
59 *)
60
61 val get_le : bytes -> int -> t
62 (** [get_le buf off] reads a little-endian unsigned 32-bit integer from [buf]
63 at offset [off]. *)
64
65 val get_be : bytes -> int -> t
66 (** [get_be buf off] reads a big-endian unsigned 32-bit integer from [buf] at
67 offset [off]. *)
68
69 val set_le : bytes -> int -> t -> unit
70 (** [set_le buf off v] writes [v] as a little-endian unsigned 32-bit integer
71 into [buf] at offset [off]. *)
72
73 val set_be : bytes -> int -> t -> unit
74 (** [set_be buf off v] writes [v] as a big-endian unsigned 32-bit integer into
75 [buf] at offset [off]. *)
76
77 val to_int : t -> int
78 (** [to_int v] converts [v] to a native integer. *)
79
80 val of_int : int -> t
81 (** [of_int n] converts [n] to an unsigned 32-bit integer, masking to 32 bits.
82 *)
83end
84
85module UInt63 : sig
86 type t = int
87 (** Unsigned 63-bit integer. Reads 8 bytes but masks to 63 bits. *)
88
89 val get_le : bytes -> int -> t
90 (** [get_le buf off] reads a little-endian unsigned 63-bit integer from [buf]
91 at offset [off]. *)
92
93 val get_be : bytes -> int -> t
94 (** [get_be buf off] reads a big-endian unsigned 63-bit integer from [buf] at
95 offset [off]. *)
96
97 val set_le : bytes -> int -> t -> unit
98 (** [set_le buf off v] writes [v] as a little-endian unsigned 63-bit integer
99 into [buf] at offset [off]. *)
100
101 val set_be : bytes -> int -> t -> unit
102 (** [set_be buf off v] writes [v] as a big-endian unsigned 63-bit integer into
103 [buf] at offset [off]. *)
104
105 val to_int : t -> int
106 (** [to_int v] converts [v] to a native integer. *)
107
108 val of_int : int -> t
109 (** [of_int n] converts [n] to an unsigned 63-bit integer, masking to 63 bits.
110 *)
111end
112
113(** {1 Endianness} *)
114
115type endian =
116 | Little (** Little-endian (native for most systems) *)
117 | Big (** Big-endian (network byte order) *)
118
119(** {1 Types} *)
120
121type _ typ
122(** ['a typ] describes how to parse/serialize values of type ['a]. *)
123
124type _ expr
125(** ['a expr] represents a computation yielding type ['a]. *)
126
127type action
128(** An imperative action. *)
129
130type action_stmt
131(** An action statement. *)
132
133type _ record_codec
134(** A record codec for encoding/decoding fixed-size binary records of type ['a].
135 Use the {!Record} module to create and use codecs. *)
136
137type ('a, 'r) field_codec
138(** A field codec for a field of type ['a] in record type ['r]. *)
139
140type _ field_codec_packed
141(** A type-erased field codec for a record of type ['r]. *)
142
143(** {1 Expressions}
144
145 Expressions for constraints, array sizes, and computations. *)
146
147(** {2 Literals} *)
148
149val int : int -> int expr
150(** [int n] is the constant integer [n]. *)
151
152val int64 : int64 -> int64 expr
153(** [int64 n] is the constant 64-bit integer [n]. *)
154
155val true_ : bool expr
156(** [true_] is the constant [true] expression. *)
157
158val false_ : bool expr
159(** [false_] is the constant [false] expression. *)
160
161(** {2 Field References} *)
162
163val ref : string -> int expr
164(** [ref name] references the integer value of field [name] from the current
165 struct. Field values are converted to [int] via {!val_to_int}. *)
166
167(** {2 Sizeof} *)
168
169val sizeof : 'a typ -> int expr
170(** [sizeof t] is the size of type [t] in bytes. *)
171
172val sizeof_this : int expr
173(** [sizeof_this] is the size of the non-variable prefix of the current struct.
174*)
175
176val field_pos : int expr
177(** [field_pos] is the current field position. *)
178
179(** {2 Arithmetic Operators} *)
180
181module Expr : sig
182 (** {2 Arithmetic operators} *)
183
184 val ( + ) : int expr -> int expr -> int expr
185 (** [x + y] is the sum of [x] and [y]. *)
186
187 val ( - ) : int expr -> int expr -> int expr
188 (** [x - y] is [x] minus [y]. *)
189
190 val ( * ) : int expr -> int expr -> int expr
191 (** [x * y] is the product of [x] and [y]. *)
192
193 val ( / ) : int expr -> int expr -> int expr
194 (** [x / y] is [x] divided by [y]. *)
195
196 val ( mod ) : int expr -> int expr -> int expr
197 (** [x mod y] is the remainder of [x] divided by [y]. *)
198
199 (** {2 Bitwise operators} *)
200
201 val ( land ) : int expr -> int expr -> int expr
202 (** [x land y] is the bitwise AND of [x] and [y]. *)
203
204 val ( lor ) : int expr -> int expr -> int expr
205 (** [x lor y] is the bitwise OR of [x] and [y]. *)
206
207 val ( lxor ) : int expr -> int expr -> int expr
208 (** [x lxor y] is the bitwise XOR of [x] and [y]. *)
209
210 val lnot : int expr -> int expr
211 (** [lnot x] is the bitwise complement of [x]. *)
212
213 val ( lsl ) : int expr -> int expr -> int expr
214 (** [x lsl n] is [x] shifted left by [n] bits. *)
215
216 val ( lsr ) : int expr -> int expr -> int expr
217 (** [x lsr n] is [x] shifted right by [n] bits (logical). *)
218
219 (** {2 Comparison operators} *)
220
221 val ( = ) : 'a expr -> 'a expr -> bool expr
222 (** [x = y] is [true] if [x] equals [y]. *)
223
224 val ( <> ) : 'a expr -> 'a expr -> bool expr
225 (** [x <> y] is [true] if [x] does not equal [y]. *)
226
227 val ( < ) : int expr -> int expr -> bool expr
228 (** [x < y] is [true] if [x] is less than [y]. *)
229
230 val ( <= ) : int expr -> int expr -> bool expr
231 (** [x <= y] is [true] if [x] is less than or equal to [y]. *)
232
233 val ( > ) : int expr -> int expr -> bool expr
234 (** [x > y] is [true] if [x] is greater than [y]. *)
235
236 val ( >= ) : int expr -> int expr -> bool expr
237 (** [x >= y] is [true] if [x] is greater than or equal to [y]. *)
238
239 (** {2 Logical operators} *)
240
241 val ( && ) : bool expr -> bool expr -> bool expr
242 (** [x && y] is the logical AND of [x] and [y]. *)
243
244 val ( || ) : bool expr -> bool expr -> bool expr
245 (** [x || y] is the logical OR of [x] and [y]. *)
246
247 val not : bool expr -> bool expr
248 (** [not x] is the logical negation of [x]. *)
249
250 (** {2 Casts} *)
251
252 val to_uint8 : int expr -> int expr
253 (** [to_uint8 e] casts [e] to an 8-bit unsigned integer. *)
254
255 val to_uint16 : int expr -> int expr
256 (** [to_uint16 e] casts [e] to a 16-bit unsigned integer. *)
257
258 val to_uint32 : int expr -> int expr
259 (** [to_uint32 e] casts [e] to a 32-bit unsigned integer. *)
260
261 val to_uint64 : int expr -> int expr
262 (** [to_uint64 e] casts [e] to a 64-bit unsigned integer. *)
263end
264
265(** {1 Type Constructors} *)
266
267(** {2 Integer Types} *)
268
269val uint8 : int typ
270(** Unsigned 8-bit integer. *)
271
272val uint16 : int typ
273(** Unsigned 16-bit integer, little-endian. *)
274
275val uint16be : int typ
276(** Unsigned 16-bit integer, big-endian. *)
277
278val uint32 : UInt32.t typ
279(** Unsigned 32-bit integer, little-endian. Unboxed on 64-bit. *)
280
281val uint32be : UInt32.t typ
282(** Unsigned 32-bit integer, big-endian. Unboxed on 64-bit. *)
283
284val uint63 : UInt63.t typ
285(** Unsigned 63-bit integer, little-endian. Unboxed on 64-bit. Reads 8 bytes. *)
286
287val uint63be : UInt63.t typ
288(** Unsigned 63-bit integer, big-endian. Unboxed on 64-bit. Reads 8 bytes. *)
289
290val uint64 : int64 typ
291(** Unsigned 64-bit integer, little-endian. Boxed (full 64-bit precision). *)
292
293val uint64be : int64 typ
294(** Unsigned 64-bit integer, big-endian. Boxed (full 64-bit precision). *)
295
296(** {2 Bitfields} *)
297
298type bitfield_base
299(** Base type for bitfields (UINT8, UINT16, UINT32). *)
300
301val bf_uint8 : bitfield_base
302(** 8-bit bitfield base. *)
303
304val bf_uint16 : bitfield_base
305(** 16-bit bitfield base, little-endian. *)
306
307val bf_uint16be : bitfield_base
308(** 16-bit bitfield base, big-endian. *)
309
310val bf_uint32 : bitfield_base
311(** 32-bit bitfield base, little-endian. *)
312
313val bf_uint32be : bitfield_base
314(** 32-bit bitfield base, big-endian. *)
315
316val bits : width:int -> bitfield_base -> int typ
317(** [bits ~width base] extracts [width] bits from a bitfield base type. *)
318
319(** {2 Type Combinators} *)
320
321val map : ('w -> 'a) -> ('a -> 'w) -> 'w typ -> 'a typ
322(** [map dec enc t] maps wire type [t] through [dec] and [enc].
323 {[
324 let status = map status_of_int int_of_status (bits ~width:3 bf_uint32be)
325 ]} *)
326
327val bool : int typ -> bool typ
328(** [bool t] maps integer type [t] to boolean (0 = false).
329 {[
330 let flag = bool (bits ~width:1 bf_uint16be)
331 ]} *)
332
333val cases : 'a list -> int typ -> 'a typ
334(** [cases variants t] maps integer type [t] through a list of variants.
335 Position in the list determines the integer value (0-indexed). Raises
336 [Invalid_argument] on unknown values.
337 {[
338 let ptype = cases [ Telemetry; Telecommand ] (bits ~width:1 bf_uint16be)
339 ]} *)
340
341(** {2 Special Types} *)
342
343val unit : unit typ
344(** Empty type (zero bytes). *)
345
346val all_bytes : string typ
347(** Consume all remaining bytes. *)
348
349val all_zeros : string typ
350(** Consume all remaining bytes, validating they are zeros. *)
351
352(** {2 Constraints} *)
353
354val where : bool expr -> 'a typ -> 'a typ
355(** [where cond t] adds constraint [cond] to type [t]. *)
356
357(** {2 Arrays} *)
358
359val array : len:int expr -> 'a typ -> 'a list typ
360(** [array ~len t] is a fixed-count array of [len] elements. *)
361
362val byte_array : size:int expr -> string typ
363(** [byte_array ~size] is [UINT8[:byte-size size]] in 3D. *)
364
365val single_elem_array : size:int expr -> 'a typ -> 'a typ
366(** [single_elem_array ~size t] is a single element consuming exactly [size]
367 bytes. Emits as [[:byte-size-single-element-array size]] in 3D. *)
368
369val single_elem_array_at_most : size:int expr -> 'a typ -> 'a typ
370(** [single_elem_array_at_most ~size t] is a single element consuming at most
371 [size] bytes with padding. *)
372
373(** {2 Enumerations} *)
374
375val enum : string -> (string * int) list -> int typ -> int typ
376(** [enum name cases base] defines an enumeration. *)
377
378(** {2 Tagged Unions (casetype)} *)
379
380type ('tag, 'a) case
381(** A case in a tagged union. *)
382
383val case : 'tag -> 'a typ -> ('tag, 'a) case
384(** [case tag t] matches when the discriminant equals [tag]. *)
385
386val default : 'a typ -> ('tag, 'a) case
387(** [default t] is the default case. *)
388
389val casetype : string -> 'tag typ -> ('tag, 'a) case list -> 'a typ
390(** [casetype name tag cases] defines a tagged union. *)
391
392(** {2 Structs} *)
393
394type field
395(** A struct field (type-erased). *)
396
397val field :
398 string -> ?constraint_:bool expr -> ?action:action -> 'a typ -> field
399(** [field name ?constraint_ ?action t] defines a named field. *)
400
401val anon_field : 'a typ -> field
402(** [anon_field t] defines a padding field. *)
403
404type struct_
405(** A struct definition. *)
406
407val struct_ : string -> field list -> struct_
408(** [struct_ name fields] defines a struct type. *)
409
410val struct_name : struct_ -> string
411(** [struct_name s] returns the name of struct [s]. *)
412
413val struct_typ : struct_ -> unit typ
414(** [struct_typ s] converts a struct to a type. *)
415
416(** {2 Parameterized Types} *)
417
418type param
419(** A type parameter. *)
420
421val param : string -> 'a typ -> param
422(** [param name t] declares a parameter with type [t]. *)
423
424val mutable_param : string -> 'a typ -> param
425(** [mutable_param name t] declares a mutable output parameter. *)
426
427val param_struct :
428 string -> param list -> ?where:bool expr -> field list -> struct_
429(** [param_struct name params ?where fields] defines a parameterized struct. *)
430
431val apply : 'a typ -> int expr list -> 'a typ
432(** [apply t args] applies arguments to a parameterized type. *)
433
434(** {2 Type References} *)
435
436val type_ref : string -> 'a typ
437(** [type_ref name] references a type by name. *)
438
439val qualified_ref : string -> string -> 'a typ
440(** [qualified_ref module_ name] references [Module::Type]. *)
441
442(** {1 Actions}
443
444 Actions execute during validation. *)
445
446val on_success : action_stmt list -> action
447(** [on_success stmts] creates an [:on-success] action from [stmts]. *)
448
449val on_act : action_stmt list -> action
450(** [on_act stmts] creates an [:act] action that always succeeds. *)
451
452val assign : string -> int expr -> action_stmt
453(** [assign ptr expr] is [*ptr = expr]. *)
454
455val return_bool : bool expr -> action_stmt
456(** [return_bool e] is [return e]. *)
457
458val abort : action_stmt
459(** [abort] aborts validation. *)
460
461val action_if :
462 bool expr -> action_stmt list -> action_stmt list option -> action_stmt
463(** [action_if cond then_ else_] is a conditional. *)
464
465val var : string -> int expr -> action_stmt
466(** [var name e] binds a local variable. *)
467
468(** {1 Declarations} *)
469
470type decl
471(** A top-level declaration. *)
472
473val typedef : ?entrypoint:bool -> ?export:bool -> ?doc:string -> struct_ -> decl
474(** [typedef ?entrypoint ?export ?doc s] declares a type. *)
475
476val define : string -> int -> decl
477(** [define name value] is [#define name value]. *)
478
479val extern_fn : string -> param list -> 'a typ -> decl
480(** [extern_fn name params ret] declares an external function. *)
481
482val extern_probe : ?init:bool -> string -> decl
483(** [extern_probe ?init name] declares an external probe. *)
484
485val enum_decl : string -> (string * int) list -> 'a typ -> decl
486(** [enum_decl name cases base] declares a top-level enum. *)
487
488type decl_case
489(** A case in a top-level casetype declaration. *)
490
491val decl_case : int -> 'a typ -> decl_case
492(** [decl_case tag t] matches when the discriminant equals [tag]. *)
493
494val decl_default : 'a typ -> decl_case
495(** [decl_default t] is the default case. *)
496
497val casetype_decl : string -> param list -> 'a typ -> decl_case list -> decl
498(** [casetype_decl name params tag cases] declares a top-level casetype. *)
499
500(** {1 Modules} *)
501
502type module_
503(** A 3D module (file). *)
504
505val module_ : ?doc:string -> string -> decl list -> module_
506(** [module_ ?doc name decls] creates a module. *)
507
508(** {1 3D Output} *)
509
510val to_3d : module_ -> string
511(** [to_3d m] emits the module as EverParse 3D format text. *)
512
513val to_3d_file : string -> module_ -> unit
514(** [to_3d_file path m] writes the module to a .3d file. *)
515
516(** {1 Pretty Printing} *)
517
518val pp_typ : Format.formatter -> 'a typ -> unit
519(** [pp_typ ppf t] pretty-prints type [t] to formatter [ppf]. *)
520
521val pp_module : Format.formatter -> module_ -> unit
522(** [pp_module ppf m] pretty-prints module [m] to formatter [ppf]. *)
523
524(** {1 Binary Parsing (bytesrw)}
525
526 Parse binary data according to type schemas. This parser is designed to be
527 semantically equivalent to EverParse-generated C parsers, enabling
528 differential fuzzing. *)
529
530type parse_error =
531 | Unexpected_eof of { expected : int; got : int }
532 | Constraint_failed of string
533 | Invalid_enum of { value : int; valid : int list }
534 | Invalid_tag of int
535 | All_zeros_failed of { offset : int }
536
537val pp_parse_error : Format.formatter -> parse_error -> unit
538(** [pp_parse_error ppf e] pretty-prints parse error [e] to formatter [ppf]. *)
539
540exception Parse_error of parse_error
541(** Exception raised by [_exn] decode functions on parse errors. *)
542
543(** {2 Parsing Context}
544
545 The parsing context tracks field values for dependent type evaluation. *)
546
547type ctx
548(** Parsing context with field bindings. *)
549
550val empty_ctx : ctx
551(** Empty parsing context. *)
552
553(** {2 Parsing Functions} *)
554
555val parse : 'a typ -> Bytesrw.Bytes.Reader.t -> ('a, parse_error) result
556(** [parse typ reader] parses a value of type [typ] from [reader]. *)
557
558val parse_string : 'a typ -> string -> ('a, parse_error) result
559(** [parse_string typ s] parses a value from a string. *)
560
561val parse_bytes : 'a typ -> bytes -> ('a, parse_error) result
562(** [parse_bytes typ b] parses a value from bytes. *)
563
564(** {1 Binary Encoding (bytesrw)}
565
566 Encode OCaml values to binary according to type schemas. *)
567
568val encode : 'a typ -> 'a -> Bytesrw.Bytes.Writer.t -> unit
569(** [encode typ v writer] encodes [v] to [writer]. *)
570
571val encode_to_bytes : 'a typ -> 'a -> bytes
572(** [encode_to_bytes typ v] encodes [v] to bytes. *)
573
574val encode_to_string : 'a typ -> 'a -> string
575(** [encode_to_string typ v] encodes [v] to a string. *)
576
577(** {1 Record Codec (Legacy API)}
578
579 The legacy record codec API using explicit field_codec, pack_field, and
580 record_codec. For new code, prefer the {!Codec} module. *)
581
582val field_codec :
583 string ->
584 ?constraint_:bool expr ->
585 'a typ ->
586 get:('r -> 'a) ->
587 set:('a -> 'r -> 'r) ->
588 ('a, 'r) field_codec
589(** [field_codec name ?constraint_ typ ~get ~set] creates a field codec. *)
590
591val pack_field : ('a, 'r) field_codec -> 'r field_codec_packed
592(** [pack_field fc] type-erases a field codec for use in a list. *)
593
594val record_codec :
595 string -> default:'r -> 'r field_codec_packed list -> 'r record_codec
596(** [record_codec name ~default fields] creates a record codec from packed
597 fields. *)
598
599val record_to_struct : 'r record_codec -> struct_
600(** [record_to_struct codec] converts a record codec to a struct for 3D
601 generation. *)
602
603val encode_record_to_slice :
604 'r record_codec -> ('r -> Bytesrw.Bytes.Slice.t) Staged.t
605(** [encode_record_to_slice codec] returns a staged encoder that writes a record
606 to a new slice. *)
607
608val decode_record_from_slice :
609 'r record_codec -> (Bytesrw.Bytes.Slice.t -> 'r) Staged.t
610(** [decode_record_from_slice codec] returns a staged decoder that reads a
611 record from a slice. *)
612
613type 'r encode_context = {
614 buffer : bytes;
615 wire_size : int;
616 encode : 'r -> unit;
617}
618(** Context for zero-copy encoding to a pre-allocated buffer. *)
619
620val encode_record_to_bytes : 'r record_codec -> 'r encode_context option
621(** [encode_record_to_bytes codec] returns a context for encoding records to a
622 shared buffer, or [None] if the codec has variable size. *)
623
624val decode_record_from_bytes : 'r record_codec -> (bytes -> int -> 'r) Staged.t
625(** [decode_record_from_bytes codec] returns a staged decoder that reads a
626 record from bytes at a given offset. *)
627
628(** {2 Record Module (Convenience API)}
629
630 A convenience module that wraps the legacy record codec API for cleaner
631 syntax. *)
632
633module Record : sig
634 type ('a, 'r) field = ('a, 'r) field_codec
635 (** A field in a record of type ['r]. *)
636
637 type 'r t = 'r record_codec
638 (** A record codec. *)
639
640 val field :
641 string ->
642 ?constraint_:bool expr ->
643 'a typ ->
644 get:('r -> 'a) ->
645 set:('a -> 'r -> 'r) ->
646 ('a, 'r) field
647 (** [field name ?constraint_ typ ~get ~set] creates a field specification. *)
648
649 val record : string -> default:'r -> ('a, 'r) field list -> 'r t
650 (** [record name ~default fields] creates a record codec. *)
651
652 val encode : 'r t -> ('r -> Bytesrw.Bytes.Slice.t) Staged.t
653 (** [encode codec] returns a staged encoder for records. *)
654
655 val decode : 'r t -> (Bytesrw.Bytes.Slice.t -> 'r) Staged.t
656 (** [decode codec] returns a staged decoder for records. *)
657
658 val encode_bytes : 'r t -> 'r encode_context option
659 (** [encode_bytes codec] returns a context for encoding to bytes. *)
660
661 val decode_bytes : 'r t -> (bytes -> int -> 'r) Staged.t
662 (** [decode_bytes codec] returns a staged decoder from bytes. *)
663
664 val to_struct : 'r t -> struct_
665 (** [to_struct codec] converts to a struct for 3D generation. *)
666end
667
668(** {1 Direct Decoders}
669
670 Zero-allocation decoders built from type specifications. These compile field
671 readers at construction time for maximum decode performance. *)
672
673val decode_make1 : 'a1 typ -> make:('a1 -> 'r) -> (bytes -> int -> 'r) Staged.t
674(** Build decoder for 1-field record. *)
675
676val decode_make2 :
677 'a1 typ -> 'a2 typ -> make:('a1 -> 'a2 -> 'r) -> (bytes -> int -> 'r) Staged.t
678(** Build decoder for 2-field record. *)
679
680val decode_make3 :
681 'a1 typ ->
682 'a2 typ ->
683 'a3 typ ->
684 make:('a1 -> 'a2 -> 'a3 -> 'r) ->
685 (bytes -> int -> 'r) Staged.t
686(** Build decoder for 3-field record. *)
687
688val decode_make4 :
689 'a1 typ ->
690 'a2 typ ->
691 'a3 typ ->
692 'a4 typ ->
693 make:('a1 -> 'a2 -> 'a3 -> 'a4 -> 'r) ->
694 (bytes -> int -> 'r) Staged.t
695(** Build decoder for 4-field record. *)
696
697(** {2 Bounds-checked Decoders}
698
699 Same as [decode_make*] but with bounds checking that raises {!Parse_error}.
700*)
701
702val decode_make1_exn :
703 'a1 typ -> make:('a1 -> 'r) -> (bytes -> int -> 'r) Staged.t
704(** Build bounds-checked decoder for 1-field record. *)
705
706val decode_make2_exn :
707 'a1 typ -> 'a2 typ -> make:('a1 -> 'a2 -> 'r) -> (bytes -> int -> 'r) Staged.t
708(** Build bounds-checked decoder for 2-field record. *)
709
710val decode_make3_exn :
711 'a1 typ ->
712 'a2 typ ->
713 'a3 typ ->
714 make:('a1 -> 'a2 -> 'a3 -> 'r) ->
715 (bytes -> int -> 'r) Staged.t
716(** Build bounds-checked decoder for 3-field record. *)
717
718val decode_make4_exn :
719 'a1 typ ->
720 'a2 typ ->
721 'a3 typ ->
722 'a4 typ ->
723 make:('a1 -> 'a2 -> 'a3 -> 'a4 -> 'r) ->
724 (bytes -> int -> 'r) Staged.t
725(** Build bounds-checked decoder for 4-field record. *)
726
727(** {1 Typed Record Codec}
728
729 Define typed record schemas for encoding and decoding fixed-size binary
730 structs. Uses a Bunzli-style compositional API with closure chaining for
731 zero intermediate allocations.
732
733 {2 Example}
734
735 {[
736 type packet = { version : int; length : int }
737
738 let codec =
739 let open Wire.Codec in
740 record "Packet" (fun version length -> { version; length })
741 |+ field "version" uint8 (fun p -> p.version)
742 |+ field "length" uint16be (fun p -> p.length)
743 |> seal
744
745 let decode = Wire.Codec.decode codec
746 let encode = Wire.Codec.encode codec
747 let struct_ = Wire.Codec.to_struct codec
748 ]} *)
749
750module Codec : sig
751 type ('a, 'r) field
752 (** A field specification for a value of type ['a] in a record of type ['r].
753 *)
754
755 type ('f, 'r) record
756 (** A record codec under construction. ['f] is the remaining constructor
757 arguments, ['r] is the final record type. *)
758
759 type 'r t
760 (** A sealed record codec for type ['r]. *)
761
762 val record : string -> 'f -> ('f, _) record
763 (** [record name make] starts building a codec named [name] with constructor
764 [make]. *)
765
766 val field : string -> 'a typ -> ('r -> 'a) -> ('a, 'r) field
767 (** [field name typ get] defines a field with type [typ] and getter [get]. Use
768 {!val:Wire.map} or {!val:Wire.bool} on the type for conversions. *)
769
770 val ( |+ ) : ('a -> 'b, 'r) record -> ('a, 'r) field -> ('b, 'r) record
771 (** [r |+ f] adds field [f] to record codec [r]. *)
772
773 val seal : ('r, 'r) record -> 'r t
774 (** [seal r] finalizes the record codec, adding bounds checking. *)
775
776 val wire_size : 'r t -> int
777 (** [wire_size codec] returns the fixed wire size of the codec in bytes. *)
778
779 val decode : 'r t -> bytes -> int -> 'r
780 (** [decode codec buf off] decodes a record from [buf] at offset [off]. Raises
781 {!Parse_error} if the buffer is too short. *)
782
783 val encode : 'r t -> 'r -> bytes -> int -> unit
784 (** [encode codec v buf off] encodes [v] into [buf] at offset [off]. *)
785
786 val to_struct : 'r t -> struct_
787 (** [to_struct codec] converts the codec to a struct for 3D generation. *)
788end
789
790(** {1 FFI Code Generation}
791
792 Generate OCaml/C FFI stubs for roundtrip testing and interop with C parsers
793 generated by EverParse. *)
794
795val size_of_struct : struct_ -> int option
796(** [size_of_struct s] computes the fixed wire size of struct [s] in bytes.
797 Returns [None] if the struct contains variable-length fields. *)
798
799val ml_type_of : 'a typ -> string
800(** [ml_type_of typ] returns the OCaml type name for a wire type (e.g., ["int"],
801 ["int32"], ["int64"]). *)
802
803val to_c_stubs : struct_ list -> string
804(** [to_c_stubs structs] generates a C file with OCaml FFI stubs for
805 differential roundtrip testing. For each struct [Foo], it generates a
806 [caml_wire_roundtrip_foo] function that reads bytes via [Foo_read], writes
807 them back via [Foo_write], and returns the result as an OCaml
808 [string option]. *)
809
810val to_ml_stubs : struct_ list -> string
811(** [to_ml_stubs structs] generates OCaml [external] declarations matching the C
812 stubs from {!to_c_stubs}. For each struct [Foo], generates a module:
813 {[
814 module Foo : sig
815 val read : string -> (t1 * t2 * ...) option
816 val write : (t1 * t2 * ...) -> string option
817 end
818 ]} *)
819
820val to_ml_stub_name : struct_ -> string
821(** [to_ml_stub_name s] returns the OCaml module name for the generated stub
822 file (e.g., ["foo"] for struct [Foo]). *)
823
824val to_ml_stub : struct_ -> string
825(** [to_ml_stub s] generates a flat OCaml stub module for a single struct:
826 {[
827 type t = int * int * int32
828
829 external read : string -> t option = "caml_wire_Foo_read"
830 external write : t -> string option = "caml_wire_Foo_write"
831 ]} *)
832
833(** {1 Struct-level Read/Write}
834
835 Parse and re-encode struct field values without requiring a typed record
836 codec. Field values are retained in an opaque existential representation. *)
837
838type parsed_struct
839(** Opaque representation of parsed struct field values. *)
840
841val read_struct : struct_ -> string -> (parsed_struct, parse_error) result
842(** [read_struct s buf] parses struct [s] from [buf], retaining field values for
843 re-encoding via {!write_struct}. *)
844
845val write_struct : struct_ -> parsed_struct -> (string, parse_error) result
846(** [write_struct s ps] encodes previously-parsed field values [ps] back to
847 bytes using the schema of struct [s]. *)