@@ -89,6 +89,7 @@ module L = struct
89
89
let strict_directive = " 'use strict';"
90
90
91
91
let curry = " curry" (* curry arbitrary args *)
92
+ let tag = " tag"
92
93
end
93
94
let return_indent = (String. length L. return / Ext_pp. indent_length)
94
95
@@ -420,17 +421,17 @@ and
420
421
if l > 15 then P. paren_group f 1 action
421
422
else action ()
422
423
423
- | Tag_ml_obj e ->
424
- P. group f 1 (fun _ ->
425
- P. string f " Object.defineProperty" ;
426
- P. paren_group f 1 (fun _ ->
427
- let cxt = expression 1 cxt f e in
428
- P. string f L. comma;
429
- P. space f ;
430
- P. string f {| " ##ml" | };
431
- P. string f L. comma;
432
- P. string f {| {" value" : true , " writable" : false }| } ;
433
- cxt ))
424
+ (* | Tag_ml_obj e -> *)
425
+ (* P.group f 1 (fun _ -> *)
426
+ (* P.string f "Object.defineProperty"; *)
427
+ (* P.paren_group f 1 (fun _ -> *)
428
+ (* let cxt = expression 1 cxt f e in *)
429
+ (* P.string f L.comma; *)
430
+ (* P.space f ; *)
431
+ (* P.string f {|"##ml"|}; *)
432
+ (* P.string f L.comma; *)
433
+ (* P.string f {|{"value" : true, "writable" : false}|} ; *)
434
+ (* cxt )) * )
434
435
435
436
| FlatCall (e ,el ) ->
436
437
P. group f 1 (fun _ ->
580
581
P. string f " typeof" ;
581
582
P. space f;
582
583
expression 13 cxt f e
584
+ | Caml_block_set_tag (a ,b ) ->
585
+ expression_desc cxt l f
586
+ (Bin (Eq ,
587
+ {expression_desc = Caml_block_tag a; comment = None },
588
+ b
589
+ ))
590
+ | Caml_block_set_length (a ,b ) ->
591
+ expression_desc cxt l f
592
+ (Bin (Eq ,
593
+ {expression_desc = Caml_block_length a; comment = None },
594
+ b
595
+ ))
583
596
| Bin (Eq , {expression_desc = Var i },
584
597
{expression_desc =
585
598
(
744
757
| [] | [ _ ] -> P. bracket_group f 1 @@ fun _ -> array_element_list cxt f el
745
758
| _ -> P. bracket_vgroup f 1 @@ fun _ -> array_element_list cxt f el
746
759
end
760
+ | Caml_uninitialized_obj (tag, size)
761
+ ->
762
+ expression_desc cxt l f (Object [Length , size ; Tag , tag])
763
+ | Caml_block ( el, mutable_flag, tag, tag_info)
764
+ ->
765
+ (* Note that, if we ignore more than tag [0] we loose some information
766
+ with regard tag *)
767
+ begin match tag.expression_desc, tag_info with
768
+
769
+ | Number (Int { i = 0 ; _}) ,
770
+ (Tuple | Array | Variant _ | Record | NA
771
+ | Constructor (" Some" | " ::" ))
772
+ (* Hack to optimize option which is really pervasive in ocaml,
773
+ we need concrete benchmark to support this
774
+ *)
775
+ -> expression_desc cxt l f (Array (el, mutable_flag))
776
+ (* TODO: for numbers like 248, 255 we can reverse engineer to make it
777
+ [Obj.xx_flag], but we can not do this in runtime libraries
778
+ *)
747
779
780
+ | _, _
781
+ ->
782
+ expression_desc cxt l f
783
+ (J. Object (
784
+ let length, rev_list =
785
+ List. fold_left (fun (i ,acc ) v ->
786
+ (i+ 1 , (Js_op. Int_key i, v) :: acc)
787
+ ) (0 , [] ) el in
788
+ List. rev_append rev_list
789
+ [(Js_op. Length , E. int length) ; (Js_op. Tag , tag)]
790
+ )
791
+ )
792
+ end
793
+ | Caml_block_tag e ->
794
+ P. group f 1 (fun _ ->
795
+ let cxt = expression 15 cxt f e in
796
+ P. string f L. dot ;
797
+ P. string f L. tag ;
798
+ cxt)
748
799
| Access (e, e')
749
800
750
801
| String_access (e,e')
757
808
in
758
809
if l > 15 then P. paren_group f 1 action else action ()
759
810
760
- | Array_length e | String_length e | Bytes_length e | Function_length e ->
811
+ | Array_length e | String_length e | Bytes_length e
812
+ | Function_length e | Caml_block_length e ->
761
813
let action () = (* * Todo: check parens *)
762
814
let cxt = expression 15 cxt f e in
763
815
P. string f L. dot;
@@ -840,24 +892,27 @@ and
840
892
P. brace_vgroup f 1 @@ fun _ ->
841
893
property_name_and_value_list cxt f lst
842
894
843
- and property_name cxt f (s : J.property_name ) : Ext_pp_scope.t =
844
- pp_string f ~utf: true ~quote: (best_string_quote s) s; cxt
895
+ and property_name cxt f (s : J.property_name ) : unit =
896
+ match s with
897
+ | Tag -> P. string f L. tag
898
+ | Length -> P. string f L. length
899
+ | Key s ->
900
+ pp_string f ~utf: true ~quote: (best_string_quote s) s
901
+ | Int_key i -> P. string f (string_of_int i)
845
902
846
903
and property_name_and_value_list cxt f l : Ext_pp_scope.t =
847
904
match l with
848
905
| [] -> cxt
849
906
| [(pn, e)] ->
850
- P. group f 0 @@ fun _ ->
851
- let cxt = property_name cxt f pn in
852
- P. string f L. colon;
853
- P. space f;
854
- expression 1 cxt f e
907
+ property_name cxt f pn ;
908
+ P. string f L. colon;
909
+ P. space f;
910
+ expression 1 cxt f e
855
911
| (pn , e ) :: r ->
856
- let cxt = P. group f 0 @@ fun _ ->
857
- let cxt = property_name cxt f pn in
858
- P. string f L. colon;
859
- P. space f;
860
- expression 1 cxt f e in
912
+ property_name cxt f pn ;
913
+ P. string f L. colon;
914
+ P. space f;
915
+ let cxt = expression 1 cxt f e in
861
916
P. string f L. comma;
862
917
P. newline f;
863
918
property_name_and_value_list cxt f r
@@ -973,14 +1028,18 @@ and statement_desc top cxt f (s : J.statement_desc) : Ext_pp_scope.t =
973
1028
let rec need_paren (e : J.expression ) =
974
1029
match e.expression_desc with
975
1030
| Call ({expression_desc = Fun _ ; } ,_ ,_ ) -> true
976
-
1031
+ | Caml_uninitialized_obj _
977
1032
| Fun _ | Object _ -> true
1033
+ | Caml_block_set_tag _
1034
+ | Caml_block_length _
1035
+ | Caml_block_set_length _
978
1036
| Anything_to_string _
979
1037
| String_of_small_int_array _
980
1038
| Call _
981
1039
| Array_append _
982
1040
| Array_copy _
983
- | Tag_ml_obj _
1041
+ (* | Tag_ml_obj _ *)
1042
+ | Caml_block_tag _
984
1043
| Seq _
985
1044
| Dot _
986
1045
| Cond _
@@ -1000,6 +1059,7 @@ and statement_desc top cxt f (s : J.statement_desc) : Ext_pp_scope.t =
1000
1059
| Var _
1001
1060
| Str _
1002
1061
| Array _
1062
+ | Caml_block _
1003
1063
| FlatCall _
1004
1064
| Typeof _
1005
1065
| Function_length _
0 commit comments