@@ -89,15 +89,21 @@ let write_valtype buf vt =
89
89
let c = get_char_valtype vt in
90
90
Buffer. add_char buf c
91
91
92
- let encode_vector buf datas encode_func =
92
+ let encode_vector length iter buf datas encode_func =
93
93
let vector_buf = Buffer. create 16 in
94
- let len = List. length datas in
95
- List. iter (encode_func vector_buf) datas;
94
+ let len = length datas in
95
+ iter (encode_func vector_buf) datas;
96
96
write_u32_of_int buf len;
97
97
Buffer. add_buffer buf vector_buf
98
98
99
+ let encode_vector_list buf datas encode_func =
100
+ encode_vector List. length List. iter buf datas encode_func
101
+
102
+ let encode_vector_array buf datas encode_func =
103
+ encode_vector Array. length Array. iter buf datas encode_func
104
+
99
105
let write_resulttype buf (rt : _ result_type ) =
100
- encode_vector buf rt write_valtype
106
+ encode_vector_list buf rt write_valtype
101
107
102
108
let write_paramtype buf (pt : _ param_type ) =
103
109
let vt = List. map snd pt in
@@ -111,11 +117,10 @@ let write_block_type buf (typ : binary block_type option) =
111
117
match typ with
112
118
| None | Some (Bt_raw (None, ([] , [] ))) -> Buffer. add_char buf '\x40'
113
119
| Some (Bt_raw (None, ([] , [ vt ]))) -> write_valtype buf vt
114
- | Some (Bt_raw (None, (pt , _ ))) ->
115
- write_paramtype buf pt
116
- (* TODO: memo
117
- will this pattern matching be enough with the use of the new modul.types field?
118
- *)
120
+ | Some (Bt_raw (None, (pt , _ ))) -> write_paramtype buf pt
121
+ (* TODO: memo
122
+ will this pattern matching be enough with the use of the new modul.types field?
123
+ *)
119
124
| _ -> assert false (* TODO: same, new pattern matching cases ? *)
120
125
121
126
let write_block_type_idx buf (typ : binary block_type ) =
@@ -200,9 +205,8 @@ let rec write_instr buf instr =
200
205
| Br idx -> write_char_indice buf '\x0C' idx
201
206
| Br_if idx -> write_char_indice buf '\x0D' idx
202
207
| Br_table (idxs , idx ) ->
203
- let idxs = Array. to_list idxs in
204
208
add_char '\x0E' ;
205
- encode_vector buf idxs write_indice;
209
+ encode_vector_array buf idxs write_indice;
206
210
write_indice buf idx
207
211
| Return -> add_char '\x0F'
208
212
| Call idx -> write_char_indice buf '\x10' idx
@@ -540,12 +544,11 @@ let write_locals buf locals =
540
544
let write_element buf ({ typ = _ , ht ; init; mode; _ } : elem ) =
541
545
let write_init buf init =
542
546
let is_ref_func = ref true in
543
- encode_vector buf init (fun buf expr ->
544
- match expr with
545
- | [ Ref_func idx ] -> write_indice buf idx
546
- | expr ->
547
- write_expr buf expr ~end_op_code: None ;
548
- is_ref_func := false );
547
+ encode_vector_list buf init (fun buf -> function
548
+ | [ Ref_func idx ] -> write_indice buf idx
549
+ | expr ->
550
+ write_expr buf expr ~end_op_code: None ;
551
+ is_ref_func := false );
549
552
! is_ref_func
550
553
in
551
554
match mode with
@@ -626,24 +629,21 @@ let encode_section buf id encode_func data =
626
629
end
627
630
628
631
(* type: section 1 *)
629
- let encode_types buf (rec_types : binary rec_type Named.t ) =
630
- encode_vector buf rec_types.values
631
- (fun buf (typ : binary rec_type Indexed.t ) ->
632
- let typ = Indexed. get typ in
632
+ let encode_types buf rec_types =
633
+ encode_vector_array buf rec_types (fun buf -> function
634
+ | [] -> assert false
635
+ | _ :: _ :: _ ->
636
+ (* TODO rec types *)
637
+ assert false
638
+ | [ typ ] -> (
633
639
match typ with
634
- | [] -> assert false
635
- | _ :: _ :: _ ->
636
- (* TODO rec types *)
637
- assert false
638
- | [ typ ] -> (
639
- match typ with
640
- | _name , (Final, _idx , Def_func_t (pt , rt )) ->
641
- Buffer. add_char buf '\x60' ;
642
- write_paramtype buf pt;
643
- write_resulttype buf rt
644
- | _ ->
645
- (* TODO non final types and other type declarations *)
646
- assert false ) )
640
+ | _name , (Final, _idx , Def_func_t (pt , rt )) ->
641
+ Buffer. add_char buf '\x60' ;
642
+ write_paramtype buf pt;
643
+ write_resulttype buf rt
644
+ | _ ->
645
+ (* TODO non final types and other type declarations *)
646
+ assert false ) )
647
647
648
648
(* import: section 2 *)
649
649
let encode_imports buf (funcs , tables , memories , globals ) =
@@ -662,20 +662,18 @@ let encode_imports buf (funcs, tables, memories, globals) =
662
662
(* function: section 3 *)
663
663
let encode_functions buf (funcs : binary func list ) =
664
664
let idx = ref 0 in
665
- encode_vector buf funcs (fun buf func ->
665
+ encode_vector_list buf funcs (fun buf func ->
666
666
write_block_type_idx buf func.type_f;
667
667
incr idx )
668
668
669
669
(* table: section 4 *)
670
- let encode_tables buf tables = encode_vector buf tables write_table
670
+ let encode_tables buf tables = encode_vector_list buf tables write_table
671
671
672
672
(* memory: section 5 *)
673
- let encode_memories buf memories = encode_vector buf memories write_memory
673
+ let encode_memories buf memories = encode_vector_list buf memories write_memory
674
674
675
675
(* global: section 6 *)
676
- let encode_globals buf globals =
677
- let globals = List. rev globals in
678
- encode_vector buf globals write_global
676
+ let encode_globals buf globals = encode_vector_list buf globals write_global
679
677
680
678
(* export: section 7 *)
681
679
let encode_exports buf ({ global; mem; table; func } : exports ) =
@@ -699,74 +697,66 @@ let encode_start buf int_opt =
699
697
match int_opt with None -> () | Some funcidx -> write_u32_of_int buf funcidx
700
698
701
699
(* element: section 9 *)
702
- let encode_elements buf { Named. values = elems ; _ } =
703
- encode_vector buf elems (fun buf elem ->
704
- let elem = Indexed. get elem in
705
- write_element buf elem )
700
+ let encode_elements buf elems = encode_vector_array buf elems write_element
706
701
707
702
(* datacount: section 12 *)
708
- let encode_datacount buf { Named. values = datas ; _ } =
709
- let len = List . length datas in
703
+ let encode_datacount buf datas =
704
+ let len = Array . length datas in
710
705
write_u32_of_int buf len
711
706
712
707
(* code: section 10 *)
713
708
let encode_codes buf funcs =
714
- encode_vector buf funcs (fun buf { locals; body; _ } ->
709
+ encode_vector_list buf funcs (fun buf { locals; body; _ } ->
715
710
let code_buf = Buffer. create 16 in
716
711
write_locals code_buf locals;
717
712
write_expr code_buf body ~end_op_code: None ;
718
713
write_u32_of_int buf (Buffer. length code_buf);
719
714
Buffer. add_buffer buf code_buf )
720
715
721
716
(* data: section 11 *)
722
- let encode_datas buf { Named. values = datas ; _ } =
723
- encode_vector buf datas (fun buf data ->
724
- let data = Indexed. get data in
725
- write_data buf data )
717
+ let encode_datas buf datas = encode_vector_array buf datas write_data
726
718
727
- let keep_local { Named. values; _ } =
719
+ let keep_local values =
728
720
List. filter_map
729
- (fun data ->
730
- match Indexed. get data with
731
- | Runtime. Local data -> Some data
732
- | Runtime. Imported _data -> None )
733
- (List. rev values)
721
+ (function Runtime. Local data -> Some data | Runtime. Imported _data -> None )
722
+ (Array. to_list values)
734
723
735
- let keep_imported { Named. values; _ } =
724
+ let keep_imported values =
736
725
List. filter_map
737
- (fun data ->
738
- match Indexed. get data with
739
- | Runtime. Local _data -> None
740
- | Runtime. Imported data -> Some data )
741
- (List. rev values)
726
+ (function Runtime. Local _data -> None | Runtime. Imported data -> Some data)
727
+ (Array. to_list values)
742
728
743
- let encode (modul : Binary.modul ) =
729
+ let encode
730
+ ({ func; table; global; exports; start; data; mem; types; elem; _ } :
731
+ Binary.modul ) =
744
732
let buf = Buffer. create 256 in
745
- let local_funcs = keep_local modul.func in
746
- let local_tables = keep_local modul.table in
747
- let local_memories = keep_local modul.mem in
748
- let local_globales = keep_local modul.global in
749
- let imported_funcs = keep_imported modul.func in
750
- let imported_tables = keep_imported modul.table in
751
- let imported_memories = keep_imported modul.mem in
752
- let imported_globals = keep_imported modul.global in
733
+
734
+ let local_funcs = keep_local func in
735
+ let local_tables = keep_local table in
736
+ let local_memories = keep_local mem in
737
+ let local_globales = keep_local global in
738
+ let imported_funcs = keep_imported func in
739
+ let imported_tables = keep_imported table in
740
+ let imported_memories = keep_imported mem in
741
+ let imported_globals = keep_imported global in
742
+
753
743
Buffer. add_string buf " \x00\x61\x73\x6d " ;
754
744
(* magic *)
755
745
Buffer. add_string buf " \x01\x00\x00\x00 " ;
756
746
(* version *)
757
- encode_section buf '\x01' encode_types modul. types;
747
+ encode_section buf '\x01' encode_types types;
758
748
encode_section buf '\x02' encode_imports
759
749
(imported_funcs, imported_tables, imported_memories, imported_globals);
760
750
encode_section buf '\x03' encode_functions local_funcs;
761
751
encode_section buf '\x04' encode_tables local_tables;
762
752
encode_section buf '\x05' encode_memories local_memories;
763
753
encode_section buf '\x06' encode_globals local_globales;
764
- encode_section buf '\x07' encode_exports modul. exports;
765
- encode_section buf '\x08' encode_start modul. start;
766
- encode_section buf '\x09' encode_elements modul. elem;
767
- encode_section buf '\x0C' encode_datacount modul. data;
754
+ encode_section buf '\x07' encode_exports exports;
755
+ encode_section buf '\x08' encode_start start;
756
+ encode_section buf '\x09' encode_elements elem;
757
+ encode_section buf '\x0C' encode_datacount data;
768
758
encode_section buf '\x0A' encode_codes local_funcs;
769
- encode_section buf '\x0B' encode_datas modul. data;
759
+ encode_section buf '\x0B' encode_datas data;
770
760
Buffer. contents buf
771
761
772
762
let write_file filename content =
0 commit comments