@@ -372,6 +372,14 @@ module DynamicChecks = struct
372
372
| Not of 'a t
373
373
| Expr of 'a
374
374
375
+ let rec size = function
376
+ | BinOp (_ , x , y ) -> 1 + size x + size y
377
+ | TagType _ -> 1
378
+ | TypeOf x -> 1 + size x
379
+ | IsInstanceOf (_ , x ) -> 1 + size x
380
+ | Not x -> 1 + size x
381
+ | Expr _ -> 1
382
+
375
383
let bin op x y = BinOp (op, x, y)
376
384
let tag_type t = TagType t
377
385
let typeof x = TypeOf x
@@ -396,7 +404,7 @@ module DynamicChecks = struct
396
404
let ( &&& ) x y = bin And x y
397
405
398
406
let rec is_a_literal_case ~(literal_cases : tag_type list ) ~block_cases
399
- (e : _ t ) =
407
+ ~ list_literal_cases (e : _ t ) =
400
408
let literals_overlaps_with_string () =
401
409
Ext_list. exists literal_cases (function
402
410
| String _ -> true
@@ -458,7 +466,6 @@ module DynamicChecks = struct
458
466
Ext_list. fold_right others is_literal_1 (fun literal_n acc ->
459
467
is_literal_case literal_n ||| acc))
460
468
in
461
- let list_literal_cases = true in
462
469
if list_literal_cases then
463
470
let rec mk cases =
464
471
match cases with
@@ -472,9 +479,21 @@ module DynamicChecks = struct
472
479
| [c] -> is_not_block_case c
473
480
| c1 :: (_ :: _ as rest ) ->
474
481
is_not_block_case c1
475
- &&& is_a_literal_case ~literal_cases ~block_cases: rest e
482
+ &&& is_a_literal_case ~literal_cases ~block_cases: rest
483
+ ~list_literal_cases e
476
484
| [] -> assert false
477
485
486
+ let is_a_literal_case ~literal_cases ~block_cases e =
487
+ let with_literal_cases =
488
+ is_a_literal_case ~literal_cases ~block_cases ~list_literal_cases: true e
489
+ in
490
+ let without_literal_cases =
491
+ is_a_literal_case ~literal_cases ~block_cases ~list_literal_cases: false e
492
+ in
493
+ if size with_literal_cases < = size without_literal_cases then
494
+ with_literal_cases
495
+ else without_literal_cases
496
+
478
497
let is_int_tag ?(has_null_undefined_other = (false , false , false )) (e : _ t ) :
479
498
_ t =
480
499
let has_null, has_undefined, has_other = has_null_undefined_other in
0 commit comments