mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 11:15:31 -05:00
4-ary and 5-ary tuples in Bij
This commit is contained in:
parent
9d1843ecf8
commit
a893e6c0eb
2 changed files with 45 additions and 0 deletions
43
bij.ml
43
bij.ml
|
|
@ -36,6 +36,8 @@ type _ t =
|
|||
| Opt : 'a t -> 'a option t
|
||||
| Pair : 'a t * 'b t -> ('a * 'b) t
|
||||
| Triple : 'a t * 'b t * 'c t -> ('a * 'b * 'c) t
|
||||
| Quad : 'a t * 'b t * 'c t * 'd t -> ('a * 'b * 'c * 'd) t
|
||||
| Quint : 'a t * 'b t * 'c t * 'd t * 'e t -> ('a * 'b * 'c * 'd * 'e) t
|
||||
| Guard : ('a -> bool) * 'a t -> 'a t
|
||||
| Map : ('a -> 'b) * ('b -> 'a) * 'b t -> 'a t
|
||||
| Switch : ('a -> char * 'a inject_branch) * (char -> 'a extract_branch) -> 'a t
|
||||
|
|
@ -58,6 +60,8 @@ let many l = Many l
|
|||
let opt t = Opt t
|
||||
let pair a b = Pair(a,b)
|
||||
let triple a b c = Triple (a,b,c)
|
||||
let quad a b c d = Quad (a, b, c, d)
|
||||
let quint a b c d e = Quint (a, b, c, d, e)
|
||||
let guard f t = Guard (f, t)
|
||||
|
||||
let map ~inject ~extract b = Map (inject, extract, b)
|
||||
|
|
@ -289,6 +293,28 @@ module SexpEncode(Sink : SINK) = struct
|
|||
Sink.write_char sink ' ';
|
||||
encode bij_c c;
|
||||
Sink.write_char sink ')'
|
||||
| Quad (bij_a, bij_b, bij_c, bij_d), (a, b, c, d) ->
|
||||
Sink.write_char sink '(';
|
||||
encode bij_a a;
|
||||
Sink.write_char sink ' ';
|
||||
encode bij_b b;
|
||||
Sink.write_char sink ' ';
|
||||
encode bij_c c;
|
||||
Sink.write_char sink ' ';
|
||||
encode bij_d d;
|
||||
Sink.write_char sink ')'
|
||||
| Quint (bij_a, bij_b, bij_c, bij_d, bij_e), (a, b, c, d, e) ->
|
||||
Sink.write_char sink '(';
|
||||
encode bij_a a;
|
||||
Sink.write_char sink ' ';
|
||||
encode bij_b b;
|
||||
Sink.write_char sink ' ';
|
||||
encode bij_c c;
|
||||
Sink.write_char sink ' ';
|
||||
encode bij_d d;
|
||||
Sink.write_char sink ' ';
|
||||
encode bij_e e;
|
||||
Sink.write_char sink ')'
|
||||
| Map (inject, _, bij'), x ->
|
||||
let y = inject x in
|
||||
encode bij' y
|
||||
|
|
@ -362,6 +388,23 @@ module SexpDecode(Source : SOURCE) = struct
|
|||
let c = decode bijc in
|
||||
decode_close ();
|
||||
a, b, c
|
||||
| Quad (bija, bijb, bijc, bijd) ->
|
||||
decode_open ();
|
||||
let a = decode bija in
|
||||
let b = decode bijb in
|
||||
let c = decode bijc in
|
||||
let d = decode bijd in
|
||||
decode_close ();
|
||||
a, b, c, d
|
||||
| Quint (bija, bijb, bijc, bijd, bije) ->
|
||||
decode_open ();
|
||||
let a = decode bija in
|
||||
let b = decode bijb in
|
||||
let c = decode bijc in
|
||||
let d = decode bijd in
|
||||
let e = decode bije in
|
||||
decode_close ();
|
||||
a, b, c, d, e
|
||||
| Guard (check, bij') ->
|
||||
let x = decode bij' in
|
||||
(if not (check x) then raise (DecodingError "check failed"));
|
||||
|
|
|
|||
2
bij.mli
2
bij.mli
|
|
@ -40,6 +40,8 @@ val many : 'a t -> 'a list t (* non empty *)
|
|||
val opt : 'a t -> 'a option t
|
||||
val pair : 'a t -> 'b t -> ('a * 'b) t
|
||||
val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
|
||||
val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
|
||||
val quint : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> ('a * 'b * 'c * 'd * 'e) t
|
||||
val guard : ('a -> bool) -> 'a t -> 'a t
|
||||
(** Validate values at encoding and decoding *)
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue