Minimal dependency-free XML parser and serializer
Stream xmlt codec encoder directly to writer (no intermediate tree)
Encode path now writes XML tokens directly to the bytesrw writer.
Decode still uses tree (El needs random access to children/attrs).
Codec allocations: -4% (person record), -10% (100-item list).
+157
-98
+157
-98
lib/xmlt.ml
+157
-98
lib/xmlt.ml
···
637
637
loop path el
638
638
end
639
639
640
+
(* ── Streaming encoder ─────────────────────────────────────────────── *)
641
+
642
+
type encoder = {
643
+
w : string -> unit;
644
+
indent : int;
645
+
mutable depth : int;
646
+
(* Track whether we are inside an open start tag (for attrs) *)
647
+
mutable in_start_tag : bool;
648
+
}
649
+
650
+
let make_encoder ?(indent = 0) w =
651
+
{ w; indent; depth = 0; in_start_tag = false }
652
+
653
+
let enc_start_tag (e : encoder) tag =
654
+
if e.indent > 0 && e.depth > 0 then begin
655
+
e.w (String.make (e.depth * e.indent) ' ')
656
+
end;
657
+
e.w "<";
658
+
e.w tag;
659
+
e.in_start_tag <- true;
660
+
e.depth <- e.depth + 1
661
+
662
+
let enc_attr (e : encoder) name value =
663
+
e.w " ";
664
+
e.w name;
665
+
e.w "=\"";
666
+
e.w (Tree.escape_attr value);
667
+
e.w "\""
668
+
669
+
let enc_close_start_tag (e : encoder) =
670
+
if e.in_start_tag then begin
671
+
e.w ">";
672
+
e.in_start_tag <- false
673
+
end
674
+
675
+
let enc_end_tag_empty (e : encoder) =
676
+
e.w "/>";
677
+
e.in_start_tag <- false;
678
+
e.depth <- e.depth - 1;
679
+
if e.indent > 0 then e.w "\n"
680
+
681
+
let enc_end_tag (e : encoder) tag ~has_elements =
682
+
e.depth <- e.depth - 1;
683
+
if e.indent > 0 && has_elements then
684
+
e.w (String.make (e.depth * e.indent) ' ');
685
+
e.w "</";
686
+
e.w tag;
687
+
e.w ">";
688
+
if e.indent > 0 then e.w "\n"
689
+
690
+
let enc_text (e : encoder) text =
691
+
enc_close_start_tag e;
692
+
e.w (Tree.escape_text text)
693
+
640
694
(* ── Codec types ────────────────────────────────────────────────────── *)
641
695
696
+
(* The core codec type: decode consumes events from a decoder that has
697
+
already consumed the Start_element for the current element; encode
698
+
writes directly to an encoder.
699
+
700
+
For decoding, the codec receives:
701
+
- attrs: the attributes from the Start_element event
702
+
- children: a lightweight representation of child elements for
703
+
random-access lookup (used by El)
704
+
705
+
For simplicity and correctness (especially for El which needs random
706
+
access to children), the decode path works with a "parsed element"
707
+
representation. The key difference from before is that the encoder
708
+
path writes directly without building a tree. *)
709
+
642
710
type 'a t = {
643
711
dec : Tree.element -> ('a, string) result;
644
-
enc : 'a -> Tree.element;
712
+
enc : encoder -> 'a -> unit;
645
713
}
646
714
647
715
(* ── Base type codecs ───────────────────────────────────────────────── *)
648
716
649
717
let string =
650
-
{
651
-
dec = (fun el -> Ok (Tree.text el));
652
-
enc =
653
-
(fun s -> { Tree.tag = "_text"; attrs = []; children = [ Tree.Text s ] });
654
-
}
718
+
{ dec = (fun el -> Ok (Tree.text el)); enc = (fun e s -> enc_text e s) }
655
719
656
720
let int =
657
721
{
···
661
725
match int_of_string_opt s with
662
726
| Some n -> Ok n
663
727
| None -> Error (Printf.sprintf "expected integer, got %S" s));
664
-
enc =
665
-
(fun n ->
666
-
{
667
-
Tree.tag = "_text";
668
-
attrs = [];
669
-
children = [ Tree.Text (string_of_int n) ];
670
-
});
728
+
enc = (fun e n -> enc_text e (string_of_int n));
671
729
}
672
730
673
731
let float =
···
678
736
match float_of_string_opt s with
679
737
| Some f -> Ok f
680
738
| None -> Error (Printf.sprintf "expected float, got %S" s));
681
-
enc =
682
-
(fun f ->
683
-
{
684
-
Tree.tag = "_text";
685
-
attrs = [];
686
-
children = [ Tree.Text (string_of_float f) ];
687
-
});
739
+
enc = (fun e f -> enc_text e (string_of_float f));
688
740
}
689
741
690
742
let bool =
···
696
748
| "true" -> Ok true
697
749
| "false" -> Ok false
698
750
| _ -> Error (Printf.sprintf "expected boolean, got %S" s));
699
-
enc =
700
-
(fun b ->
701
-
{
702
-
Tree.tag = "_text";
703
-
attrs = [];
704
-
children = [ Tree.Text (string_of_bool b) ];
705
-
});
751
+
enc = (fun e b -> enc_text e (string_of_bool b));
706
752
}
707
753
708
754
(* ── Element wrapper ────────────────────────────────────────────────── *)
···
716
762
(Printf.sprintf "expected element <%s>, got <%s>" tag el.Tree.tag)
717
763
else codec.dec el);
718
764
enc =
719
-
(fun v ->
720
-
let el = codec.enc v in
721
-
{ el with Tree.tag });
765
+
(fun e v ->
766
+
enc_start_tag e tag;
767
+
codec.enc e v;
768
+
if e.in_start_tag then
769
+
(* No children/text were written; self-close *)
770
+
enc_end_tag_empty e
771
+
else enc_end_tag e tag ~has_elements:false);
722
772
}
723
773
724
774
(* ── Attribute codecs ───────────────────────────────────────────────── *)
···
777
827
778
828
module El = struct
779
829
(* The builder accumulates steps that, given an element, decode fields one at
780
-
a time, threading through a decoder function that builds the final value. *)
830
+
a time, threading through a decoder function that builds the final value.
831
+
The decode side uses Tree.element for random-access children lookup.
832
+
The encode side splits into two phases: attrs (written while the start tag
833
+
is still open) and children (written after the start tag is closed). This
834
+
ensures attrs always appear before children regardless of builder order. *)
781
835
type ('o, 'dec) t = {
782
836
decode : Tree.element -> ('dec, string) result;
783
-
encode : 'o -> (string * string) list * Tree.node list; (* attrs, children *)
837
+
encode_attrs : encoder -> 'o -> unit;
838
+
encode_children : encoder -> 'o -> unit;
784
839
}
785
840
786
-
let obj dec = { decode = (fun _el -> Ok dec); encode = (fun _v -> ([], [])) }
841
+
let obj dec =
842
+
{
843
+
decode = (fun _el -> Ok dec);
844
+
encode_attrs = (fun _e _v -> ());
845
+
encode_children = (fun _e _v -> ());
846
+
}
787
847
788
848
let attr name (codec : 'a Attr.codec) ~enc builder =
789
849
{
···
799
859
el.tag)
800
860
| Some s -> (
801
861
match codec.dec s with Ok v -> Ok (f v) | Error e -> Error e)));
802
-
encode =
803
-
(fun v ->
804
-
let attrs, children = builder.encode v in
805
-
let attr_val = codec.enc (enc v) in
806
-
((name, attr_val) :: attrs, children));
862
+
encode_attrs =
863
+
(fun e v ->
864
+
builder.encode_attrs e v;
865
+
enc_attr e name (codec.enc (enc v)));
866
+
encode_children = (fun e v -> builder.encode_children e v);
807
867
}
808
868
809
869
let attr_opt name (codec : _ Attr.codec) ~enc builder =
···
819
879
match codec.dec s with
820
880
| Ok v -> Ok (f (Some v))
821
881
| Error e -> Error e)));
822
-
encode =
823
-
(fun v ->
824
-
let attrs, children = builder.encode v in
882
+
encode_attrs =
883
+
(fun e v ->
884
+
builder.encode_attrs e v;
825
885
match enc v with
826
-
| None -> (attrs, children)
827
-
| Some a ->
828
-
let attr_val = codec.enc a in
829
-
((name, attr_val) :: attrs, children));
886
+
| None -> ()
887
+
| Some a -> enc_attr e name (codec.enc a));
888
+
encode_children = (fun e v -> builder.encode_children e v);
830
889
}
890
+
891
+
let write_child_element e tag codec child_v =
892
+
enc_close_start_tag e;
893
+
enc_start_tag e tag;
894
+
codec.enc e child_v;
895
+
if e.in_start_tag then enc_end_tag_empty e
896
+
else enc_end_tag e tag ~has_elements:false
831
897
832
898
let child tag codec ~enc builder =
833
899
{
···
845
911
match codec.dec child_el with
846
912
| Ok v -> Ok (f v)
847
913
| Error e -> Error e)));
848
-
encode =
849
-
(fun v ->
850
-
let attrs, children = builder.encode v in
851
-
let child_el = codec.enc (enc v) in
852
-
(attrs, children @ [ Tree.Element { child_el with tag } ]));
914
+
encode_attrs = (fun e v -> builder.encode_attrs e v);
915
+
encode_children =
916
+
(fun e v ->
917
+
builder.encode_children e v;
918
+
write_child_element e tag codec (enc v));
853
919
}
854
920
855
921
let child_opt tag codec ~enc builder =
···
865
931
match codec.dec child_el with
866
932
| Ok v -> Ok (f (Some v))
867
933
| Error e -> Error e)));
868
-
encode =
869
-
(fun v ->
870
-
let attrs, children = builder.encode v in
934
+
encode_attrs = (fun e v -> builder.encode_attrs e v);
935
+
encode_children =
936
+
(fun e v ->
937
+
builder.encode_children e v;
871
938
match enc v with
872
-
| None -> (attrs, children)
873
-
| Some child_v ->
874
-
let child_el = codec.enc child_v in
875
-
(attrs, children @ [ Tree.Element { child_el with tag } ]));
939
+
| None -> ()
940
+
| Some child_v -> write_child_element e tag codec child_v);
876
941
}
877
942
878
943
let children tag codec ~enc builder =
···
891
956
| Error e -> Error e)
892
957
in
893
958
decode_all [] child_els);
894
-
encode =
895
-
(fun v ->
896
-
let attrs, children = builder.encode v in
897
-
let child_nodes =
898
-
List.map
899
-
(fun child_v ->
900
-
let child_el = codec.enc child_v in
901
-
Tree.Element { child_el with tag })
902
-
(enc v)
903
-
in
904
-
(attrs, children @ child_nodes));
959
+
encode_attrs = (fun e v -> builder.encode_attrs e v);
960
+
encode_children =
961
+
(fun e v ->
962
+
builder.encode_children e v;
963
+
List.iter
964
+
(fun child_v -> write_child_element e tag codec child_v)
965
+
(enc v));
905
966
}
906
967
907
968
let text ~enc builder =
···
911
972
match builder.decode el with
912
973
| Error e -> Error e
913
974
| Ok f -> Ok (f (Tree.text el)));
914
-
encode =
915
-
(fun v ->
916
-
let attrs, children = builder.encode v in
975
+
encode_attrs = (fun e v -> builder.encode_attrs e v);
976
+
encode_children =
977
+
(fun e v ->
978
+
builder.encode_children e v;
917
979
let s = enc v in
918
-
if String.length s > 0 then (attrs, children @ [ Tree.Text s ])
919
-
else (attrs, children));
980
+
if String.length s > 0 then begin
981
+
enc_close_start_tag e;
982
+
enc_text e s
983
+
end);
920
984
}
921
985
922
986
let finish builder =
923
987
{
924
988
dec = builder.decode;
925
989
enc =
926
-
(fun v ->
927
-
let attrs, children = builder.encode v in
928
-
{ Tree.tag = "_el"; attrs; children });
990
+
(fun e v ->
991
+
(* Phase 1: write all attributes (start tag is still open) *)
992
+
builder.encode_attrs e v;
993
+
(* Phase 2: write all children (will close start tag on first write) *)
994
+
builder.encode_children e v);
929
995
}
930
996
end
931
997
···
939
1005
| Error e -> Error e
940
1006
| Ok v -> (
941
1007
match dec with Some f -> f v | None -> Error "no decoder provided"));
942
-
enc =
943
-
(fun v ->
944
-
match enc with
945
-
| Some f -> codec.enc (f v)
946
-
| None -> { Tree.tag = "_map"; attrs = []; children = [] });
1008
+
enc = (fun e v -> match enc with Some f -> codec.enc e (f v) | None -> ());
947
1009
}
948
1010
949
-
let const v =
950
-
{
951
-
dec = (fun _el -> Ok v);
952
-
enc = (fun _v -> { Tree.tag = "_const"; attrs = []; children = [] });
953
-
}
1011
+
let const v = { dec = (fun _el -> Ok v); enc = (fun _e _v -> ()) }
954
1012
955
1013
let option codec =
956
1014
{
···
960
1018
match codec.dec el with
961
1019
| Ok v -> Ok (Some v)
962
1020
| Error _ -> Ok None);
963
-
enc =
964
-
(fun v ->
965
-
match v with
966
-
| Some v -> codec.enc v
967
-
| None -> { Tree.tag = "_none"; attrs = []; children = [] });
1021
+
enc = (fun e v -> match v with Some v -> codec.enc e v | None -> ());
968
1022
}
969
1023
970
1024
let list codec =
···
985
1039
in
986
1040
decode_all [] child_els);
987
1041
enc =
988
-
(fun vs ->
989
-
let children = List.map (fun v -> Tree.Element (codec.enc v)) vs in
990
-
{ Tree.tag = "_list"; attrs = []; children });
1042
+
(fun e vs ->
1043
+
List.iter
1044
+
(fun v ->
1045
+
enc_close_start_tag e;
1046
+
codec.enc e v)
1047
+
vs);
991
1048
}
992
1049
993
1050
(* ── Decode / Encode ────────────────────────────────────────────────── *)
···
998
1055
| Ok el -> codec.dec el
999
1056
1000
1057
let encode_string ?(indent = 0) codec v =
1001
-
let el = codec.enc v in
1002
-
Tree.to_string ~indent el
1058
+
let buf = Buffer.create 256 in
1059
+
let e = make_encoder ~indent (Buffer.add_string buf) in
1060
+
codec.enc e v;
1061
+
Buffer.contents buf
1003
1062
1004
1063
let decode codec reader =
1005
1064
match Tree.of_reader reader with
···
1007
1066
| Ok el -> codec.dec el
1008
1067
1009
1068
let encode ?(indent = 0) codec v writer =
1010
-
let el = codec.enc v in
1011
-
Tree.to_writer ~indent writer el
1069
+
let e = make_encoder ~indent (Bytes.Writer.write_string writer) in
1070
+
codec.enc e v