2 * Copyright (c) Facebook, Inc. and its affiliates.
4 * This source code is licensed under the MIT license found in the
5 * LICENSE file in the "hack" directory of this source tree.
10 open Shape_analysis_types
11 module HT
= Hips_types
13 type 'constraint_ show_constraint_
=
14 Typing_env_types.env
-> 'constraint_
-> string
16 let mk_shape field_map
=
17 T.(mk
(Typing_reason.Rnone
, Tshape
(Closed_shape
, field_map
)))
19 let show_entity = function
20 | Literal pos
-> Format.asprintf
"%a" Pos.pp pos
21 | Variable var
-> Format.sprintf
"?%d" var
22 | Inter ent
-> HT.show_entity ent
24 let show_ty env
= Typing_print.full env
26 let show_constraint env
=
27 let show_ty = show_ty env
in
29 | Marks
(kind
, pos
) ->
30 Format.asprintf
"%s at %a" (show_marker_kind kind
) Pos.pp pos
31 | Has_static_key
(entity
, key
, ty
) ->
33 T.TShapeMap.singleton key
T.{ sft_ty
= ty
; sft_optional
= false }
35 let shape = mk_shape field_map in
36 Format.asprintf
"SK %s : %s" (show_entity entity
) (show_ty shape)
37 | Has_optional_key
(entity
, key
) ->
41 (Typing_utils.get_printable_shape_field_name key
)
42 | Has_dynamic_key entity
-> "DK " ^
show_entity entity ^
" : dyn"
43 | Subsets
(sub
, sup
) -> show_entity sub ^
" ⊆ " ^
show_entity sup
44 | Joins
{ left
; right
; join
} ->
45 show_entity left ^
" ∪ " ^
show_entity right ^
" = " ^
show_entity join
47 let show_inter_constraint _
= function
48 | HT.Arg
((f_id
, arg_idx
, _
), ent
) ->
49 Format.asprintf
"Arg(%s, %i, %s)" f_id arg_idx
(show_entity ent
)
51 let show_decorated_constraint_general
55 ({ hack_pos
; origin
; constraint_
} : 'constraint_ decorated
) =
56 let line = Pos.line hack_pos
in
57 let constraint_ = show_constr env
constraint_ in
59 Format.asprintf
"%4d: %4d: %s" line origin
constraint_
61 Format.asprintf
"%4d: %s" line constraint_
63 let show_decorated_constraint =
64 show_decorated_constraint_general ~show_constr
:show_constraint
66 let show_decorated_inter_constraint =
67 show_decorated_constraint_general ~show_constr
:show_inter_constraint
69 let show_shape_result env
= function
70 | Shape_like_dict
(pos
, kind
, keys_and_types
) ->
71 let show_ty = show_ty env
in
72 let shape = mk_shape keys_and_types
in
75 (Format.asprintf
"%a" Pos.pp pos
)
76 (show_marker_kind kind
)
78 | Dynamically_accessed_dict entity
->
79 Format.asprintf
"%s : dynamic" (show_entity entity
)