Skip to content

Commit c915c69

Browse files
cristianoccristianoc
committed
Move logic for dynamic check inside untagged variants file.
1 parent e46118b commit c915c69

File tree

2 files changed

+107
-74
lines changed

2 files changed

+107
-74
lines changed

‎jscomp/core/js_exp_make.ml

Lines changed: 22 additions & 74 deletions
Original file line numberDiff line numberDiff line change
@@ -776,80 +776,28 @@ let tag_type = function
776776
(* TODO: this should not happen *)
777777
assert false
778778

779-
let rec is_a_literal_case ~(literal_cases : Ast_untagged_variants.tag_type list) ~block_cases (e:t) : t =
780-
let literals_overlaps_with_string () =
781-
Ext_list.exists literal_cases (function
782-
| String _ -> true
783-
| l -> false ) in
784-
let literals_overlaps_with_number () =
785-
Ext_list.exists literal_cases (function
786-
| Int _ | Float _ -> true
787-
| l -> false ) in
788-
let literals_overlaps_with_object () =
789-
Ext_list.exists literal_cases (function
790-
| Null -> true
791-
| l -> false ) in
792-
let (==) x y = bin EqEqEq x y in
793-
let (!=) x y = bin NotEqEq x y in
794-
let (||) x y = bin Or x y in
795-
let (&&) x y = bin And x y in
796-
let is_literal_case (t: Ast_untagged_variants.tag_type) : t = e == (tag_type t) in
797-
let is_not_block_case (c: Ast_untagged_variants.block_type) : t = match c with
798-
| StringType when literals_overlaps_with_string () = false (* No overlap *) ->
799-
(typeof e) != (str "string")
800-
| IntType when literals_overlaps_with_number () = false ->
801-
(typeof e) != (str "number")
802-
| FloatType when literals_overlaps_with_number () = false ->
803-
(typeof e) != (str "number")
804-
| ArrayType ->
805-
not (is_array e)
806-
| ObjectType when literals_overlaps_with_object () = false ->
807-
(typeof e) != (str "object")
808-
| ObjectType (* overlap *) ->
809-
e == nil || (typeof e) != (str "object")
810-
| StringType (* overlap *)
811-
| IntType (* overlap *)
812-
| FloatType (* overlap *)
813-
| UnknownType ->
814-
(* We don't know the type of unknown, so we need to express:
815-
this is not one of the literals *)
816-
(match literal_cases with
817-
| [] ->
818-
(* this should not happen *)
819-
assert false
820-
| l1 :: others ->
821-
let is_literal_1 = is_literal_case l1 in
822-
Ext_list.fold_right others is_literal_1 (fun literal_n acc ->
823-
(is_literal_case literal_n) || acc
824-
)
825-
)
826-
in
827-
match block_cases with
828-
| [c] -> is_not_block_case c
829-
| c1 :: (_::_ as rest) ->
830-
(is_not_block_case c1) && (is_a_literal_case ~literal_cases ~block_cases:rest e)
831-
| [] -> assert false
832-
833-
let is_int_tag ?(has_null_undefined_other=(false, false, false)) (e : t) : t =
834-
let (has_null, has_undefined, has_other) = has_null_undefined_other in
835-
if has_null && (has_undefined = false) && (has_other = false) then (* null *)
836-
{ expression_desc = Bin (EqEqEq, e, nil); comment=None }
837-
else if has_null && has_undefined && has_other=false then (* null + undefined *)
838-
{ J.expression_desc = Bin
839-
(Or,
840-
{ expression_desc = Bin (EqEqEq, e, nil); comment=None },
841-
{ expression_desc = Bin (EqEqEq, e, undefined); comment=None }
842-
); comment=None }
843-
else if has_null=false && has_undefined && has_other=false then (* undefined *)
844-
{ expression_desc = Bin (EqEqEq, e, undefined); comment=None }
845-
else if has_null then (* (null + undefined + other) || (null + other) *)
846-
{ J.expression_desc = Bin
847-
(Or,
848-
{ expression_desc = Bin (EqEqEq, e, nil); comment=None },
849-
{ expression_desc = Bin (NotEqEq, typeof e, str "object"); comment=None }
850-
); comment=None }
851-
else (* (undefiled + other) || other *)
852-
{ expression_desc = Bin (NotEqEq, typeof e, str "object"); comment=None }
779+
let rec emit_check (check : t Ast_untagged_variants.DynamiChecks.t) = match check with
780+
| TagType t -> tag_type t
781+
| BinOp(op, x, y) ->
782+
let op = match op with
783+
| EqEqEq -> Js_op.EqEqEq
784+
| NotEqEq -> NotEqEq
785+
| And -> And
786+
| Or -> Or
787+
in
788+
bin op (emit_check x) (emit_check y)
789+
| TypeOf x -> typeof (emit_check x)
790+
| IsArray x -> is_array (emit_check x)
791+
| Not x -> not (emit_check x)
792+
| Expr x -> x
793+
794+
let is_a_literal_case ~literal_cases ~block_cases (e:t) =
795+
let check = Ast_untagged_variants.DynamiChecks.is_a_literal_case ~literal_cases ~block_cases (Expr e) in
796+
emit_check check
797+
798+
let is_int_tag ?has_null_undefined_other e =
799+
let check = Ast_untagged_variants.DynamiChecks.is_int_tag ?has_null_undefined_other (Expr e) in
800+
emit_check check
853801

854802
let is_type_string ?comment (e : t) : t =
855803
string_equal ?comment (typeof e) (str "string")

‎jscomp/ml/ast_untagged_variants.ml

Lines changed: 85 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -241,3 +241,88 @@ let names_from_type_variant ?(isUntaggedDef=false) ~env (cstrs : Types.construct
241241

242242
let check_well_formed ~env ~isUntaggedDef (cstrs: Types.constructor_declaration list) =
243243
ignore (names_from_type_variant ~env ~isUntaggedDef cstrs)
244+
245+
module DynamiChecks = struct
246+
247+
type op = EqEqEq | NotEqEq | Or | And
248+
type 'a t = BinOp of op * 'a t * 'a t | TagType of tag_type | TypeOf of 'a t | IsArray of 'a t | Not of 'a t | Expr of 'a
249+
250+
let bin op x y = BinOp(op, x, y)
251+
let tag_type t = TagType t
252+
let typeof x = TypeOf x
253+
let str s = String s |> tag_type
254+
let is_array x = IsArray x
255+
let not x = Not x
256+
let nil = Null |> tag_type
257+
let undefined = Undefined |> tag_type
258+
let object_ = Untagged ObjectType |> tag_type
259+
260+
let (==) x y = bin EqEqEq x y
261+
let (!=) x y = bin NotEqEq x y
262+
let (|||) x y = bin Or x y
263+
let (&&&) x y = bin And x y
264+
265+
266+
let rec is_a_literal_case ~(literal_cases : tag_type list) ~block_cases (e: _ t) =
267+
let literals_overlaps_with_string () =
268+
Ext_list.exists literal_cases (function
269+
| String _ -> true
270+
| _ -> false ) in
271+
let literals_overlaps_with_number () =
272+
Ext_list.exists literal_cases (function
273+
| Int _ | Float _ -> true
274+
| _ -> false ) in
275+
let literals_overlaps_with_object () =
276+
Ext_list.exists literal_cases (function
277+
| Null -> true
278+
| _ -> false ) in
279+
let is_literal_case (t: tag_type) : _ t = e == (tag_type t) in
280+
let is_not_block_case (c: block_type) : _ t = match c with
281+
| StringType when literals_overlaps_with_string () = false (* No overlap *) ->
282+
(typeof e) != (str "string")
283+
| IntType when literals_overlaps_with_number () = false ->
284+
(typeof e) != (str "number")
285+
| FloatType when literals_overlaps_with_number () = false ->
286+
(typeof e) != (str "number")
287+
| ArrayType ->
288+
not (is_array e)
289+
| ObjectType when literals_overlaps_with_object () = false ->
290+
(typeof e) != (str "object")
291+
| ObjectType (* overlap *) ->
292+
e == nil ||| (typeof e != str "object")
293+
| StringType (* overlap *)
294+
| IntType (* overlap *)
295+
| FloatType (* overlap *)
296+
| UnknownType ->
297+
(* We don't know the type of unknown, so we need to express:
298+
this is not one of the literals *)
299+
(match literal_cases with
300+
| [] ->
301+
(* this should not happen *)
302+
assert false
303+
| l1 :: others ->
304+
let is_literal_1 = is_literal_case l1 in
305+
Ext_list.fold_right others is_literal_1 (fun literal_n acc ->
306+
(is_literal_case literal_n) ||| acc
307+
)
308+
)
309+
in
310+
match block_cases with
311+
| [c] -> is_not_block_case c
312+
| c1 :: (_::_ as rest) ->
313+
(is_not_block_case c1) &&& (is_a_literal_case ~literal_cases ~block_cases:rest e)
314+
| [] -> assert false
315+
316+
let is_int_tag ?(has_null_undefined_other=(false, false, false)) (e : _ t) : _ t =
317+
let (has_null, has_undefined, has_other) = has_null_undefined_other in
318+
if has_null && (has_undefined = false) && (has_other = false) then (* null *)
319+
bin EqEqEq e nil
320+
else if has_null && has_undefined && has_other=false then (* null + undefined *)
321+
e == nil ||| e == undefined
322+
else if has_null=false && has_undefined && has_other=false then (* undefined *)
323+
e == undefined
324+
else if has_null then (* (null + undefined + other) || (null + other) *)
325+
e == nil ||| typeof e != object_
326+
else (* (undefiled + other) || other *)
327+
typeof e != object_
328+
end

0 commit comments

Comments
 (0)