CCSDS TM Transfer Frames (CCSDS 132.0-B-3)
feat(wire): add type combinators to Wire.Codec API
Add Map variant to the typ GADT enabling type-level conversions:
- Wire.map dec enc t: general type combinator (positional, type-last)
- Wire.bool t: maps int typ to bool typ
- Wire.cases variants t: cmdliner-style positional enum mapping
- Wire.true_/false_: replace Wire.bool expression constructor
- Remove Wire.Codec.cfield (use field with map/bool/cases instead)
- Remove Wire.is_set/bit from public API
Update all protocol codecs (CLCW, Space Packet, TM) to use typed
packed fields with the new combinators. Packed records now use bool
for flag fields and domain types (status, packet_type, sequence_flags)
instead of raw ints.
+30
-33
+25
-28
lib/tm.ml
+25
-28
lib/tm.ml
···
424
424
version : int;
425
425
scid : int;
426
426
vcid : int;
427
-
ocf_flag : int;
427
+
ocf_flag : bool;
428
428
mcfc : int;
429
429
vcfc : int;
430
-
sec_hdr : int;
431
-
sync_flag : int;
432
-
pkt_order : int;
430
+
sec_hdr : bool;
431
+
sync_flag : bool;
432
+
pkt_order : bool;
433
433
seg_len_id : int;
434
434
first_hdr_ptr : int;
435
435
}
···
445
445
(* Wire Codec *)
446
446
let codec =
447
447
let open Wire.Codec in
448
+
let bits n = Wire.bits ~width:n Wire.bf_uint16be in
449
+
let bool = Wire.bool (bits 1) in
448
450
record "TmHeader"
449
451
(fun
450
452
version
···
472
474
seg_len_id;
473
475
first_hdr_ptr;
474
476
})
475
-
|+ field "version" (Wire.bits ~width:2 Wire.bf_uint16be) (fun t -> t.version)
476
-
|+ field "scid" (Wire.bits ~width:10 Wire.bf_uint16be) (fun t -> t.scid)
477
-
|+ field "vcid" (Wire.bits ~width:3 Wire.bf_uint16be) (fun t -> t.vcid)
478
-
|+ field "ocf_flag" (Wire.bits ~width:1 Wire.bf_uint16be) (fun t ->
479
-
t.ocf_flag)
480
-
|+ field "mcfc" (Wire.bits ~width:8 Wire.bf_uint16be) (fun t -> t.mcfc)
481
-
|+ field "vcfc" (Wire.bits ~width:8 Wire.bf_uint16be) (fun t -> t.vcfc)
482
-
|+ field "sec_hdr" (Wire.bits ~width:1 Wire.bf_uint16be) (fun t -> t.sec_hdr)
483
-
|+ field "sync_flag" (Wire.bits ~width:1 Wire.bf_uint16be) (fun t ->
484
-
t.sync_flag)
485
-
|+ field "pkt_order" (Wire.bits ~width:1 Wire.bf_uint16be) (fun t ->
486
-
t.pkt_order)
487
-
|+ field "seg_len_id" (Wire.bits ~width:2 Wire.bf_uint16be) (fun t ->
488
-
t.seg_len_id)
489
-
|+ field "first_hdr_ptr" (Wire.bits ~width:11 Wire.bf_uint16be) (fun t ->
490
-
t.first_hdr_ptr)
477
+
|+ field "version" (bits 2) (fun t -> t.version)
478
+
|+ field "scid" (bits 10) (fun t -> t.scid)
479
+
|+ field "vcid" (bits 3) (fun t -> t.vcid)
480
+
|+ field "ocf_flag" bool (fun t -> t.ocf_flag)
481
+
|+ field "mcfc" (bits 8) (fun t -> t.mcfc)
482
+
|+ field "vcfc" (bits 8) (fun t -> t.vcfc)
483
+
|+ field "sec_hdr" bool (fun t -> t.sec_hdr)
484
+
|+ field "sync_flag" bool (fun t -> t.sync_flag)
485
+
|+ field "pkt_order" bool (fun t -> t.pkt_order)
486
+
|+ field "seg_len_id" (bits 2) (fun t -> t.seg_len_id)
487
+
|+ field "first_hdr_ptr" (bits 11) (fun t -> t.first_hdr_ptr)
491
488
|> seal
492
489
493
490
let struct_ = Wire.Codec.to_struct codec
···
506
503
version = h.version;
507
504
scid = scid_to_int h.scid;
508
505
vcid = vcid_to_int h.vcid;
509
-
ocf_flag = Wire.bit h.ocf_flag;
506
+
ocf_flag = h.ocf_flag;
510
507
mcfc = h.mcfc;
511
508
vcfc = h.vcfc;
512
-
sec_hdr = Wire.bit h.sec_hdr;
513
-
sync_flag = Wire.bit h.sync_flag;
514
-
pkt_order = Wire.bit h.pkt_order;
509
+
sec_hdr = h.sec_hdr;
510
+
sync_flag = h.sync_flag;
511
+
pkt_order = h.pkt_order;
515
512
seg_len_id = h.seg_len_id;
516
513
first_hdr_ptr = h.first_hdr_ptr;
517
514
}
···
529
526
version = t.version;
530
527
scid = scid_val;
531
528
vcid = vcid_val;
532
-
ocf_flag = Wire.is_set t.ocf_flag;
529
+
ocf_flag = t.ocf_flag;
533
530
mcfc = t.mcfc;
534
531
vcfc = t.vcfc;
535
-
sec_hdr = Wire.is_set t.sec_hdr;
536
-
sync_flag = Wire.is_set t.sync_flag;
537
-
pkt_order = Wire.is_set t.pkt_order;
532
+
sec_hdr = t.sec_hdr;
533
+
sync_flag = t.sync_flag;
534
+
pkt_order = t.pkt_order;
538
535
seg_len_id = t.seg_len_id;
539
536
first_hdr_ptr = t.first_hdr_ptr;
540
537
})
+5
-5
lib/tm.mli
+5
-5
lib/tm.mli
···
264
264
version : int; (** Transfer frame version (2 bits). *)
265
265
scid : int; (** Spacecraft ID (10 bits). *)
266
266
vcid : int; (** Virtual channel ID (3 bits). *)
267
-
ocf_flag : int; (** OCF flag (1 bit). *)
267
+
ocf_flag : bool; (** OCF present flag. *)
268
268
mcfc : int; (** Master channel frame count (8 bits). *)
269
269
vcfc : int; (** Virtual channel frame count (8 bits). *)
270
-
sec_hdr : int; (** Secondary header flag (1 bit). *)
271
-
sync_flag : int; (** Synchronization flag (1 bit). *)
272
-
pkt_order : int; (** Packet order flag (1 bit). *)
270
+
sec_hdr : bool; (** Secondary header present flag. *)
271
+
sync_flag : bool; (** Synchronization flag. *)
272
+
pkt_order : bool; (** Packet order flag. *)
273
273
seg_len_id : int; (** Segment length identifier (2 bits). *)
274
274
first_hdr_ptr : int; (** First header pointer (11 bits). *)
275
275
}
276
-
(** Raw TM header with bitfields decoded into named record fields (6 bytes). *)
276
+
(** TM header with typed fields (6 bytes wire). *)
277
277
278
278
val to_packed_header : header -> packed_header
279
279
(** [to_packed_header h] converts a TM header to its packed representation. *)