S-expression parsing library with typed codecs for OCaml
Upgrade to ocamlformat 0.29.0; fix csvt/sexpt streaming; reformat
- Update .ocamlformat to 0.29.0 across all 591 files
- csvt: reuse single Buffer.t for field reads (no alloc per field)
- sexpt: Obj members decoded from stream into Dict, typed Variant GADT
- Reformat all source files for 0.29.0
+48
-9
+47
-8
lib/sexpt.ml
+47
-8
lib/sexpt.ml
···
157
157
project : 'a -> 'b option;
158
158
}
159
159
-> 'a vcase
160
+
| Vcasev : {
161
+
tag : string;
162
+
codec : 'b t;
163
+
inject : 'b -> 'a;
164
+
project : 'a -> 'b option;
165
+
}
166
+
-> 'a vcase
160
167
161
168
(* ---- Kind/doc accessors ---- *)
162
169
···
404
411
and vcase_tag : type a. a vcase -> string = function
405
412
| Vcase0 c -> c.tag
406
413
| Vcase1 c -> c.tag
414
+
| Vcasev c -> c.tag
407
415
408
416
and decode_variant : type a. a vcase list -> Sexp.t -> (a, codec_error) result =
409
417
fun cases v ->
···
412
420
| Sexp.Atom tag -> (
413
421
match List.assoc_opt tag case_map with
414
422
| Some (Vcase0 c) -> Ok c.value
415
-
| Some (Vcase1 _) -> value_error ("expected arguments for variant " ^ tag)
423
+
| Some (Vcase1 _) | Some (Vcasev _) ->
424
+
value_error ("expected arguments for variant " ^ tag)
416
425
| None -> value_error ("unknown variant tag: " ^ tag))
417
426
| Sexp.List (Sexp.Atom tag :: args) -> (
418
427
match List.assoc_opt tag case_map with
···
424
433
match of_sexp c.codec sexp_val with
425
434
| Ok v -> Ok (c.inject v)
426
435
| Error e -> Error e)
436
+
| Some (Vcasev c) -> (
437
+
(* casev: args are flat, wrap as list for the codec *)
438
+
match of_sexp c.codec (Sexp.List args) with
439
+
| Ok v -> Ok (c.inject v)
440
+
| Error e -> Error e)
427
441
| None -> value_error ("unknown variant tag: " ^ tag))
428
442
| _ -> type_error ~expected:"variant (tag ...)" v
429
443
···
504
518
| [] -> failwith "no matching variant case"
505
519
| Vcase0 c :: rest -> if c.project v then Sexp.Atom c.tag else find rest
506
520
| Vcase1 c :: rest -> (
521
+
match c.project v with
522
+
| Some x -> Sexp.List [ Sexp.Atom c.tag; to_sexp c.codec x ]
523
+
| None -> find rest)
524
+
| Vcasev c :: rest -> (
507
525
match c.project v with
508
526
| Some x -> (
509
527
let encoded = to_sexp c.codec x in
···
913
931
914
932
let case0 tag value project = Vcase0 { tag; value; project }
915
933
let case1 tag codec inject project = Vcase1 { tag; codec; inject; project }
916
-
let casev tag codec inject project = Vcase1 { tag; codec; inject; project }
934
+
let casev tag codec inject project = Vcasev { tag; codec; inject; project }
917
935
918
936
let variant ?kind ?doc cases =
919
937
Variant
···
1401
1419
let _ = P.next s in
1402
1420
Ok (m.dec_finish builder)
1403
1421
| Ok _ -> (
1404
-
if m.dec_skip i builder then begin
1422
+
if m.dec_skip i builder then
1405
1423
(* Skip this element by consuming the token(s) *)
1406
-
match skip_sexp_stream s with
1424
+
begin match skip_sexp_stream s with
1407
1425
| Ok () -> loop builder (i + 1)
1408
1426
| Error e -> Error e
1409
-
end
1427
+
end
1410
1428
else
1411
1429
match decode_stream m.elt s with
1412
1430
| Ok elt -> loop (m.dec_add i elt builder) (i + 1)
···
1537
1555
| Ok (P.Atom tag) -> (
1538
1556
match List.assoc_opt tag case_map with
1539
1557
| Some (Vcase0 c) -> Ok c.value
1540
-
| Some (Vcase1 _) ->
1558
+
| Some (Vcase1 _) | Some (Vcasev _) ->
1541
1559
value_error ("expected arguments for variant " ^ tag)
1542
1560
| None -> value_error ("unknown variant tag: " ^ tag))
1543
1561
| _ -> assert false)
···
1556
1574
| Error e -> Error e
1557
1575
| Ok () -> Ok c.value)
1558
1576
| Some (Vcase1 c) -> (
1559
-
(* Decode the payload directly from the stream *)
1577
+
(* Decode the single payload directly from the stream *)
1560
1578
match decode_stream c.codec s with
1561
1579
| Error e -> Error e
1562
1580
| Ok v -> (
1563
1581
(* Skip any remaining values and consume Close *)
1564
1582
match skip_until_close s with
1565
1583
| Error e -> Error e
1566
-
| Ok () -> Ok (c.inject v))))
1584
+
| Ok () -> Ok (c.inject v)))
1585
+
| Some (Vcasev c) -> (
1586
+
(* casev: args are flat in the variant list.
1587
+
Collect remaining elements as Sexp.t and wrap as List
1588
+
for the codec that expects list-shaped input. *)
1589
+
let rec collect_args acc =
1590
+
match P.peek s with
1591
+
| Error e -> Error (Parse_error e)
1592
+
| Ok P.Close ->
1593
+
let _ = P.next s in
1594
+
Ok (List.rev acc)
1595
+
| Ok _ -> (
1596
+
match sexp_of_stream s with
1597
+
| Ok v -> collect_args (v :: acc)
1598
+
| Error e -> Error e)
1599
+
in
1600
+
match collect_args [] with
1601
+
| Error e -> Error e
1602
+
| Ok args -> (
1603
+
match of_sexp c.codec (Sexp.List args) with
1604
+
| Ok v -> Ok (c.inject v)
1605
+
| Error e -> Error e)))
1567
1606
| Ok _ -> Error (Parse_error "expected variant tag (atom)"))
1568
1607
| Ok P.Eof -> Error (Parse_error "unexpected end of input, expected variant")
1569
1608
| Ok P.Close -> Error (Parse_error "unexpected ')' where variant expected")