?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Remove support for variable variables from parser, typechecker and frontend
[hiphop-php.git] / hphp / hack / src / hhbc / hhbc_hhas.ml
blobf1112a807f4cb4401e7bc720eb6aaf2bcddc2d3c
1 (**
2 * Copyright (c) 2017, Facebook, Inc.
3 * All rights reserved.
4 *
5 * This source code is licensed under the MIT license found in the
6 * LICENSE file in the "hack" directory of this source tree.
7 *
8 *)
9
10 open Core_kernel
11 module Acc = Mutable_accumulator
12 module H = Hhbc_ast
13 module A = Ast
14 module SU = Hhbc_string_utils
15 module SN = Naming_special_names
16 module ULS = Unique_list_string
17 open H
18
19 (* Generic helpers *)
20 let sep pieces = String.concat ~sep:" " pieces
21
22 let indent_text = " "
23
24 let string_of_optional_value f v =
25 Option.value_map v
26 ~default:""
27 ~f:(fun s -> " " ^ (f s))
28
29 let string_of_class_id id =
30 SU.quote_string (Hhbc_id.Class.to_raw_string id)
31 let string_of_function_id id =
32 SU.quote_string (Hhbc_id.Function.to_raw_string id)
33 let string_of_method_id id =
34 SU.quote_string (Hhbc_id.Method.to_raw_string id)
35 let string_of_const_id id =
36 SU.quote_string (Hhbc_id.Const.to_raw_string id)
37 let string_of_prop_id id =
38 SU.quote_string (Hhbc_id.Prop.to_raw_string id)
39 let string_of_class_num id =
40 string_of_int id
41 let string_of_function_num id =
42 string_of_int id
43 let string_of_typedef_num id =
44 string_of_int id
45 let string_of_pos pos =
46 let {line_begin; line_end; col_begin; col_end} = pos in
47 Printf.sprintf "%d:%d,%d:%d" line_begin col_begin line_end col_end
48 let string_of_span (line_begin, line_end) =
49 Printf.sprintf "(%d,%d)" line_begin line_end
50
51 (* Naming convention for functions below:
52 * string_of_X converts an X to a string
53 * add_X takes a buffer and an X, and appends to the buffer
54 *)
55 let string_of_basic instruction =
56 match instruction with
57 | Nop -> "Nop"
58 | EntryNop -> "EntryNop"
59 | PopC -> "PopC"
60 | PopV -> "PopV"
61 | PopU -> "PopU"
62 | Dup -> "Dup"
63 | Box -> "Box"
64 | Unbox -> "Unbox"
65
66 let string_of_list_of_shape_fields sl =
67 String.concat ~sep:" " @@ List.map ~f:SU.quote_string sl
68
69 let string_of_stack_index si = string_of_int si
70
71 let string_of_classref id = string_of_int id
72
73 let string_of_adata_id id = "@" ^ id
74
75 let string_of_param_id x =
76 match x with
77 | Param_unnamed i -> string_of_int i
78 | Param_named s -> s
79
80 let string_of_param_num i = string_of_int i
81
82 let string_of_local_id x =
83 match x with
84 | Local.Unnamed i -> "_" ^ (string_of_int i)
85 | Local.Named s -> s
86
87 let string_of_lit_const instruction =
88 match instruction with
89 | Null -> "Null"
90 | Int i -> sep ["Int"; Int64.to_string i]
91 | String str -> sep ["String"; SU.quote_string str]
92 | True -> "True"
93 | False -> "False"
94 | Double d -> sep ["Double"; d]
95 | AddElemC -> "AddElemC"
96 | AddNewElemC -> "AddNewElemC"
97 | Array id -> sep ["Array"; string_of_adata_id id]
98 | Dict id -> sep ["Dict"; string_of_adata_id id]
99 | Keyset id -> sep ["Keyset"; string_of_adata_id id]
100 | Vec id -> sep ["Vec"; string_of_adata_id id]
101 | TypedValue _tv -> failwith "string_of_lit_const: TypedValue"
102 | ColFromArray t -> sep ["ColFromArray"; CollectionType.to_string t]
103 | NewCol t -> sep ["NewCol"; CollectionType.to_string t]
104 | NewDictArray i -> sep ["NewDictArray"; string_of_int i]
105 | NewKeysetArray i -> sep ["NewKeysetArray"; string_of_int i]
106 | NewVecArray i -> sep ["NewVecArray"; string_of_int i]
107 | NewVArray i -> sep ["NewVArray"; string_of_int i]
108 | NewDArray i -> sep ["NewDArray"; string_of_int i]
109 | NewMixedArray i -> sep ["NewMixedArray"; string_of_int i]
110 | NewPackedArray i -> sep ["NewPackedArray"; string_of_int i]
111 | NewStructArray l ->
112 sep ["NewStructArray"; "<" ^ string_of_list_of_shape_fields l ^ ">"]
113 | NewStructDArray l ->
114 sep ["NewStructDArray"; "<" ^ string_of_list_of_shape_fields l ^ ">"]
115 | NewStructDict l ->
116 sep ["NewStructDict"; "<" ^ string_of_list_of_shape_fields l ^ ">"]
117 | NewPair -> "NewPair"
118 | ClsCns (cnsid, cr) ->
119 sep ["ClsCns"; string_of_const_id cnsid; string_of_classref cr]
120 | ClsCnsD (cnsid, cid) ->
121 sep ["ClsCnsD"; string_of_const_id cnsid; string_of_class_id cid]
122 | File -> "File"
123 | Dir -> "Dir"
124 | NullUninit -> "NullUninit"
125 | AddElemV -> "AddElemV"
126 | AddNewElemV -> "AddNewElemV"
127 | Method -> "Method"
128 | NewArray n -> sep ["NewArray"; string_of_int n]
129 | NewLikeArrayL (id, n) ->
130 sep ["NewLikeArrayL"; string_of_local_id id; string_of_int n]
131 | Cns cnsid -> sep ["Cns"; string_of_const_id cnsid]
132 | CnsE cnsid -> sep ["CnsE"; string_of_const_id cnsid]
133 | CnsU (id1, id2) ->
134 sep ["CnsU"; string_of_const_id id1; SU.quote_string id2]
135 | CnsUE (id1, id2) ->
136 sep ["CnsUE"; string_of_const_id id1; SU.quote_string id2]
137
138
139 let string_of_typestruct_resolve_op = function
140 | Resolve -> "Resolve"
141 | DontResolve -> "DontResolve"
142
143 let string_of_reifiedgeneric_op = function
144 | ClsGeneric -> "ClsGeneric"
145 | FunGeneric -> "FunGeneric"
146
147 let string_of_has_generics_op = function
148 | NoGenerics -> "NoGenerics"
149 | HasGenerics -> "HasGenerics"
150 | MaybeGenerics -> "MaybeGenerics"
151
152 let string_of_operator instruction =
153 match instruction with
154 | Concat -> "Concat"
155 | ConcatN n -> sep ["ConcatN"; string_of_int n]
156 | Abs -> "Abs"
157 | Add -> "Add"
158 | Sub -> "Sub"
159 | Mul -> "Mul"
160 | AddO -> "AddO"
161 | SubO -> "SubO"
162 | MulO -> "MulO"
163 | Div -> "Div"
164 | Mod -> "Mod"
165 | Pow -> "Pow"
166 | Sqrt -> "Sqrt"
167 | Xor -> "Xor"
168 | Not -> "Not"
169 | Same -> "Same"
170 | NSame -> "NSame"
171 | Eq -> "Eq"
172 | Neq -> "Neq"
173 | Lt -> "Lt"
174 | Lte -> "Lte"
175 | Gt -> "Gt"
176 | Gte -> "Gte"
177 | Cmp -> "Cmp"
178 | BitAnd -> "BitAnd"
179 | BitOr -> "BitOr"
180 | BitXor -> "BitXor"
181 | BitNot -> "BitNot"
182 | Shl -> "Shl"
183 | Shr -> "Shr"
184 | Floor -> "Floor"
185 | Ceil -> "Ceil"
186 | CastBool -> "CastBool"
187 | CastInt -> "CastInt"
188 | CastDouble -> "CastDouble"
189 | CastString -> "CastString"
190 | CastArray -> "CastArray"
191 | CastObject -> "CastObject"
192 | CastVec -> "CastVec"
193 | CastDict -> "CastDict"
194 | CastKeyset -> "CastKeyset"
195 | CastVArray -> "CastVArray"
196 | CastDArray -> "CastDArray"
197 | InstanceOf -> "InstanceOf"
198 | InstanceOfD id -> sep ["InstanceOfD"; string_of_class_id id]
199 | IsTypeStructC op ->
200 sep ["IsTypeStructC"; string_of_typestruct_resolve_op op]
201 | AsTypeStructC op ->
202 sep ["AsTypeStructC"; string_of_typestruct_resolve_op op]
203 | CombineAndResolveTypeStruct n ->
204 sep ["CombineAndResolveTypeStruct"; string_of_int n]
205 | Print -> "Print"
206 | Clone -> "Clone"
207 | H.Exit -> "Exit"
208 | ResolveFunc id -> sep ["ResolveFunc"; string_of_function_id id]
209 | ResolveObjMethod -> sep ["ResolveObjMethod"]
210 | ResolveClsMethod -> sep ["ResolveClsMethod"]
211 | Fatal op -> sep ["Fatal"; FatalOp.to_string op]
212
213 let string_of_get x =
214 match x with
215 | CGetL id -> sep ["CGetL"; string_of_local_id id]
216 | CGetQuietL id -> sep ["CGetQuietL"; string_of_local_id id]
217 | CGetL2 id -> sep ["CGetL2"; string_of_local_id id]
218 | CUGetL id -> sep ["CUGetL"; string_of_local_id id]
219 | PushL id -> sep ["PushL"; string_of_local_id id]
220 | CGetN -> "CGetN"
221 | CGetQuietN -> "CGetQuietN"
222 | CGetG -> "CGetG"
223 | CGetQuietG -> "CGetQuietG"
224 | CGetS id -> sep ["CGetS"; string_of_classref id]
225 | VGetN -> "VGetN"
226 | VGetG -> "VGetG"
227 | VGetS id -> sep ["VGetS"; string_of_classref id]
228 | VGetL id -> sep ["VGetL"; string_of_local_id id]
229 | ClsRefGetL (id, cr) ->
230 sep ["ClsRefGetL"; string_of_local_id id; string_of_int cr]
231 | ClsRefGetC cr -> sep ["ClsRefGetC"; string_of_int cr]
232 | ClsRefGetTS cr -> sep ["ClsRefGetTS"; string_of_int cr]
233
234 let string_of_member_key mk =
235 let open MemberKey in
236 match mk with
237 | EC i -> "EC:" ^ string_of_stack_index i
238 | EL id -> "EL:" ^ string_of_local_id id
239 | ET str -> "ET:" ^ SU.quote_string str
240 | EI i -> "EI:" ^ Int64.to_string i
241 | PC i -> "PC:" ^ string_of_stack_index i
242 | PL id -> "PL:" ^ string_of_local_id id
243 | PT id -> "PT:" ^ string_of_prop_id id
244 | QT id -> "QT:" ^ string_of_prop_id id
245 | W -> "W"
246
247 let string_of_setrange_op = function
248 | Forward -> "Forward"
249 | Reverse -> "Reverse"
250
251 let string_of_eq_op op =
252 match op with
253 | PlusEqual -> "PlusEqual"
254 | MinusEqual -> "MinusEqual"
255 | MulEqual -> "MulEqual"
256 | ConcatEqual -> "ConcatEqual"
257 | DivEqual -> "DivEqual"
258 | PowEqual -> "PowEqual"
259 | ModEqual -> "ModEqual"
260 | AndEqual -> "AndEqual"
261 | OrEqual -> "OrEqual"
262 | XorEqual -> "XorEqual"
263 | SlEqual -> "SlEqual"
264 | SrEqual -> "SrEqual"
265 | PlusEqualO -> "PlusEqualO"
266 | MinusEqualO -> "MinusEqualO"
267 | MulEqualO -> "MulEqualO"
268
269 let string_of_incdec_op op =
270 match op with
271 | PreInc -> "PreInc"
272 | PostInc -> "PostInc"
273 | PreDec -> "PreDec"
274 | PostDec -> "PostDec"
275 | PreIncO -> "PreIncO"
276 | PostIncO -> "PostIncO"
277 | PreDecO -> "PreDecO"
278 | PostDecO -> "PostDecO"
279
280 let string_of_istype_op op =
281 match op with
282 | OpNull -> "Null"
283 | OpBool -> "Bool"
284 | OpInt -> "Int"
285 | OpDbl -> "Dbl"
286 | OpStr -> "Str"
287 | OpArr -> "Arr"
288 | OpObj -> "Obj"
289 | OpRes -> "Res"
290 | OpScalar -> "Scalar"
291 | OpVec -> "Vec"
292 | OpDict -> "Dict"
293 | OpKeyset -> "Keyset"
294 | OpArrLike -> "ArrLike"
295 | OpVArray -> "VArray"
296 | OpDArray -> "DArray"
297
298 let string_of_initprop_op op =
299 match op with
300 | NonStatic -> "NonStatic"
301 | Static -> "Static"
302
303 let string_of_mutator x =
304 match x with
305 | SetL id -> sep ["SetL"; string_of_local_id id]
306 | PopL id -> sep ["PopL"; string_of_local_id id]
307 | SetN -> "SetN"
308 | SetG -> "SetG"
309 | SetS id -> sep ["SetS"; string_of_classref id]
310 | SetOpL (id, op) ->
311 sep ["SetOpL"; string_of_local_id id; string_of_eq_op op]
312 | SetOpN op -> sep ["SetOpN"; string_of_eq_op op]
313 | SetOpG op -> sep ["SetOpG"; string_of_eq_op op]
314 | SetOpS (op, id) -> sep ["SetOpS"; string_of_eq_op op; string_of_classref id]
315 | IncDecL (id, op) ->
316 sep ["IncDecL"; string_of_local_id id; string_of_incdec_op op]
317 | IncDecN op -> sep ["IncDecN"; string_of_incdec_op op]
318 | IncDecG op -> sep ["IncDecG"; string_of_incdec_op op]
319 | IncDecS (op, id) ->
320 sep ["IncDecS"; string_of_incdec_op op; string_of_classref id]
321 | BindL id -> sep ["BindL"; string_of_local_id id]
322 | BindN -> "BindN"
323 | BindG -> "BindG"
324 | BindS id -> sep ["BindS"; string_of_classref id]
325 | UnsetL id -> sep ["UnsetL"; string_of_local_id id]
326 | UnsetN -> "UnsetN"
327 | UnsetG -> "UnsetG"
328 | CheckProp id -> sep ["CheckProp"; string_of_prop_id id]
329 | InitProp (id, op) -> sep ["InitProp"; string_of_prop_id id;
330 string_of_initprop_op op]
331
332 let string_of_label = function
333 | Label.Regular id -> "L" ^ (string_of_int id)
334 | Label.Catch id -> "C" ^ (string_of_int id)
335 | Label.Fault id -> "F" ^ (string_of_int id)
336 | Label.DefaultArg id -> "DV" ^ (string_of_int id)
337 | Label.Named id -> id
338
339 let string_of_optional_label opt_label =
340 match opt_label with
341 | None -> "-"
342 | Some label -> string_of_label label
343
344 let string_of_fcall_flags fl =
345 let fl = [
346 if fl.has_unpack then "Unpack" else "";
347 if fl.supports_async_eager_return then "SupportsAER" else "";
348 ] in
349 "<" ^ (String.concat ~sep:" " @@ List.filter ~f:(fun f -> f <> "") fl) ^ ">"
350
351 let string_of_fcall_args fcall_args =
352 let flags, num_args, num_rets, async_eager_label = fcall_args in
353 sep [
354 string_of_fcall_flags flags;
355 string_of_int num_args;
356 string_of_int num_rets;
357 string_of_optional_label async_eager_label
358 ]
359
360 let string_of_switch_kind = function
361 | H.Unbounded -> "Unbounded"
362 | H.Bounded -> "Bounded"
363
364 let string_of_switch kind base labels =
365 let kind = string_of_switch_kind kind in
366 let labels = String.concat ~sep:" " @@ List.map ~f:string_of_label labels in
367 Printf.sprintf "Switch %s %d <%s>" kind base labels
368
369 let string_of_sswitch cases =
370 let revcases = List.rev cases in
371 match revcases with
372 | [] -> failwith "sswitch should have at least one case"
373 | (_dummystring, lastlabel) :: revrest ->
374 let reststring =
375 String.concat ~sep:" " @@
376 List.rev_map ~f:(function (s,l) -> SU.quote_string s ^ ":" ^ string_of_label l) revrest in
377 let laststring = "-:" ^ string_of_label lastlabel in
378 Printf.sprintf "SSwitch <%s %s>" reststring laststring
379
380 let string_of_control_flow instruction =
381 match instruction with
382 | Jmp l -> "Jmp " ^ string_of_label l
383 | JmpNS l -> "JmpNS " ^ string_of_label l
384 | JmpZ l -> "JmpZ " ^ string_of_label l
385 | JmpNZ l -> "JmpNZ " ^ string_of_label l
386 | RetC -> "RetC"
387 | RetCSuspended -> "RetCSuspended"
388 | RetM p -> "RetM " ^ string_of_int p
389 | Throw -> "Throw"
390 | Unwind -> "Unwind"
391 | Switch (kind, base, labels) -> string_of_switch kind base labels
392 | SSwitch cases -> string_of_sswitch cases
393
394 let string_of_iterator_id i = Iterator.to_string i
395 let string_of_null_flavor nf =
396 match nf with
397 | Ast.OG_nullthrows -> "NullThrows"
398 | Ast.OG_nullsafe -> "NullSafe"
399
400 let string_of_class_kind ck =
401 match ck with
402 | KClass -> "Class"
403 | KInterface -> "Interface"
404 | KTrait -> "Trait"
405
406 let string_of_isset instruction =
407 match instruction with
408 | IssetC -> "IssetC"
409 | IssetL id -> "IssetL " ^ string_of_local_id id
410 | IssetN -> "IssetN"
411 | IssetG -> "IssetG"
412 | IssetS cls -> "IssetS " ^ string_of_int cls
413 | EmptyL id -> "EmptyL " ^ string_of_local_id id
414 | EmptyN -> "EmptyN"
415 | EmptyG -> "EmptyG"
416 | EmptyS cls -> "EmptyS " ^ string_of_int cls
417 | IsTypeC op -> "IsTypeC " ^ string_of_istype_op op
418 | IsTypeL (id, op) ->
419 "IsTypeL " ^ string_of_local_id id ^ " " ^ string_of_istype_op op
420
421 let string_of_base x =
422 match x with
423 | BaseNC (si, m) ->
424 sep ["BaseNC"; string_of_stack_index si; MemberOpMode.to_string m]
425 | BaseNL (id, m) ->
426 sep ["BaseNL"; string_of_local_id id; MemberOpMode.to_string m]
427 | BaseGC (si, m) ->
428 sep ["BaseGC"; string_of_stack_index si; MemberOpMode.to_string m]
429 | BaseGL (id, m) ->
430 sep ["BaseGL"; string_of_local_id id; MemberOpMode.to_string m]
431 | BaseSC (si, id, m) ->
432 sep ["BaseSC";
433 string_of_stack_index si; string_of_classref id; MemberOpMode.to_string m]
434 | BaseSL (lid, si, m) ->
435 sep ["BaseSL";
436 string_of_local_id lid; string_of_stack_index si; MemberOpMode.to_string m]
437 | BaseL (lid, m) ->
438 sep ["BaseL"; string_of_local_id lid; MemberOpMode.to_string m]
439 | BaseC (si, m) ->
440 sep ["BaseC"; string_of_stack_index si; MemberOpMode.to_string m]
441 | BaseH ->
442 "BaseH"
443 | Dim (m, mk) ->
444 sep ["Dim"; MemberOpMode.to_string m; string_of_member_key mk]
445
446 let string_of_final instruction =
447 match instruction with
448 | QueryM (n, op, mk) ->
449 sep ["QueryM";
450 string_of_int n; QueryOp.to_string op; string_of_member_key mk]
451 | VGetM (n, mk) ->
452 sep ["VGetM";
453 string_of_int n; string_of_member_key mk]
454 | UnsetM (n, mk) ->
455 sep ["UnsetM";
456 string_of_int n; string_of_member_key mk]
457 | BindM (n, mk) ->
458 sep ["BindM";
459 string_of_int n; string_of_member_key mk]
460 | SetM (i, mk) ->
461 sep ["SetM";
462 string_of_param_num i; string_of_member_key mk]
463 | SetOpM (i, op, mk) ->
464 sep ["SetOpM";
465 string_of_param_num i; string_of_eq_op op; string_of_member_key mk]
466 | IncDecM (i, op, mk) ->
467 sep ["IncDecM";
468 string_of_param_num i; string_of_incdec_op op; string_of_member_key mk]
469 | SetRangeM (i, op, s) ->
470 sep ["SetRangeM";
471 string_of_int i; string_of_setrange_op op; string_of_int s]
472
473 (*
474 | IncDecM of num_params * incdec_op * MemberKey.t
475 | SetOpM of num_params * eq_op * MemberKey.t
476 *)
477
478 let string_of_param_locations pl =
479 if List.length pl = 0 then "" else
480 "<" ^ (String.concat ~sep:", " (List.map ~f:string_of_int pl)) ^ ">"
481
482 let string_of_list_of_bools l =
483 if List.length l = 0 then "" else
484 let bool_to_str b = if b then "1" else "0" in
485 "\"" ^ (String.concat ~sep:"" (List.map ~f:bool_to_str l)) ^ "\""
486
487 let string_of_call instruction =
488 match instruction with
489 | FPushFunc (n, pl) ->
490 sep ["FPushFunc"; string_of_int n; string_of_param_locations pl]
491 | FPushFuncD (n, id) ->
492 sep ["FPushFuncD"; string_of_int n; string_of_function_id id]
493 | FPushFuncU (n, id1, id2) ->
494 sep ["FPushFuncU"; string_of_int n; string_of_function_id id1; SU.quote_string id2]
495 | FPushObjMethod (n, nf, pl) ->
496 sep ["FPushObjMethod"; string_of_int n; string_of_null_flavor nf; string_of_param_locations pl]
497 | FPushObjMethodD (n, id, nf) ->
498 sep ["FPushObjMethodD";
499 string_of_int n; string_of_method_id id; string_of_null_flavor nf]
500 | FPushClsMethod (n, id, pl) ->
501 sep ["FPushClsMethod"; string_of_int n; string_of_classref id; string_of_param_locations pl]
502 | FPushClsMethodD (n, id, cid) ->
503 sep ["FPushClsMethodD";
504 string_of_int n;
505 string_of_method_id id; string_of_class_id cid]
506 | FPushClsMethodS (n, r) ->
507 sep ["FPushClsMethodS";
508 string_of_int n;
509 SpecialClsRef.to_string r]
510 | FPushClsMethodSD (n, r, id) ->
511 sep ["FPushClsMethodSD";
512 string_of_int n;
513 SpecialClsRef.to_string r;
514 string_of_method_id id]
515 | NewObj (id, op) ->
516 sep ["NewObj"; string_of_int id; string_of_has_generics_op op]
517 | NewObjD cid ->
518 sep ["NewObjD"; string_of_class_id cid]
519 | NewObjI id ->
520 sep ["NewObjI"; string_of_classref id]
521 | NewObjS r ->
522 sep ["NewObjS"; SpecialClsRef.to_string r]
523 | FPushCtor n ->
524 sep ["FPushCtor"; string_of_int n]
525 | FThrowOnRefMismatch l ->
526 sep ["FThrowOnRefMismatch"; string_of_list_of_bools l]
527 | FCall (fcall_args, c, f) ->
528 sep ["FCall";
529 string_of_fcall_args fcall_args;
530 string_of_class_id c; string_of_function_id f]
531 | FCallBuiltin (n1, n2, id) ->
532 sep ["FCallBuiltin"; string_of_int n1; string_of_int n2; SU.quote_string id]
533
534 let string_of_barethis_op i =
535 match i with
536 | Notice -> "Notice"
537 | NoNotice -> "NoNotice"
538 | NeverNull -> "NeverNull"
539
540 let string_of_op_silence op =
541 match op with
542 | Start -> "Start"
543 | End -> "End"
544
545 let string_of_misc instruction =
546 match instruction with
547 | This -> "This"
548 | BareThis op -> sep ["BareThis"; string_of_barethis_op op]
549 | Self id -> sep ["Self"; string_of_classref id]
550 | Parent id -> sep ["Parent"; string_of_classref id]
551 | LateBoundCls id -> sep ["LateBoundCls"; string_of_classref id]
552 | ClsRefName id -> sep ["ClsRefName"; string_of_classref id]
553 | ReifiedName (n, op) ->
554 sep ["ReifiedName"; string_of_int n; string_of_reifiedgeneric_op op]
555 | ReifiedGeneric (op, n) ->
556 sep ["ReifiedGeneric"; string_of_reifiedgeneric_op op; string_of_int n]
557 | RecordReifiedGeneric n -> sep ["RecordReifiedGeneric"; string_of_int n]
558 | CheckReifiedGenericMismatch -> "CheckReifiedGenericMismatch"
559 | VerifyParamType id -> sep ["VerifyParamType"; string_of_param_id id]
560 | VerifyParamTypeTS id -> sep ["VerifyParamTypeTS"; string_of_param_id id]
561 | VerifyOutType id -> sep ["VerifyOutType"; string_of_param_id id]
562 | VerifyRetTypeC -> "VerifyRetTypeC"
563 | Catch -> "Catch"
564 | ChainFaults -> "ChainFaults"
565 | CheckThis -> "CheckThis"
566 | CGetCUNop -> "CGetCUNop"
567 | UGetCUNop -> "UGetCUNop"
568 | StaticLocCheck (local, text) ->
569 sep ["StaticLocCheck"; string_of_local_id local; "\"" ^ text ^ "\""]
570 | StaticLocDef (local, text) ->
571 sep ["StaticLocDef"; string_of_local_id local; "\"" ^ text ^ "\""]
572 | StaticLocInit (local, text) ->
573 sep ["StaticLocInit"; string_of_local_id local; "\"" ^ text ^ "\""]
574 | MemoGet (label, Some (Local.Unnamed first, local_count)) ->
575 Printf.sprintf "MemoGet %s L:%d+%d"
576 (string_of_label label) first local_count
577 | MemoGet (label, None) ->
578 Printf.sprintf "MemoGet %s L:0+0" (string_of_label label)
579 | MemoGet _ -> failwith "MemoGet needs an unnamed local"
580 | MemoGetEager (label1, label2, Some (Local.Unnamed first, local_count)) ->
581 Printf.sprintf "MemoGetEager %s %s L:%d+%d"
582 (string_of_label label1) (string_of_label label2) first local_count
583 | MemoGetEager (label1, label2, None) ->
584 Printf.sprintf "MemoGetEager %s %s L:0+0" (string_of_label label1) (string_of_label label2)
585 | MemoGetEager _ -> failwith "MemoGetEager needs an unnamed local"
586 | MemoSet (Some (Local.Unnamed first, local_count)) ->
587 Printf.sprintf "MemoSet L:%d+%d" first local_count
588 | MemoSet None ->
589 Printf.sprintf "MemoSet L:0+0"
590 | MemoSet _ -> failwith "MemoSet needs an unnamed local"
591 | MemoSetEager (Some (Local.Unnamed first, local_count)) ->
592 Printf.sprintf "MemoSetEager L:%d+%d" first local_count
593 | MemoSetEager None ->
594 Printf.sprintf "MemoSetEager L:0+0"
595 | MemoSetEager _ -> failwith "MemoSetEager needs an unnamed local"
596 | GetMemoKeyL local ->
597 sep ["GetMemoKeyL"; string_of_local_id local]
598 | CreateCl (n, cid) ->
599 sep ["CreateCl"; string_of_int n; string_of_int cid]
600 | Idx -> "Idx"
601 | ArrayIdx -> "ArrayIdx"
602 | InitThisLoc id -> sep ["InitThisLoc"; string_of_local_id id]
603 | AKExists -> "AKExists"
604 | OODeclExists ck -> sep ["OODeclExists"; string_of_class_kind ck]
605 | Silence (local, op) ->
606 sep ["Silence"; string_of_local_id local; string_of_op_silence op]
607 | AssertRATL (local, s) ->
608 sep ["AssertRATL"; string_of_local_id local; s]
609 | AssertRATStk (n, s) ->
610 sep ["AssertRATStk"; string_of_int n; s]
611 | NativeImpl -> "NativeImpl"
612 | BreakTraceHint -> "BreakTraceHint"
613
614 let iterator_instruction_name_prefix instruction =
615 let iterator_instruction_name =
616 match instruction with
617 | IterInit _ -> "IterInit"
618 | LIterInit _ -> "LIterInit"
619 | IterInitK _ -> "IterInitK"
620 | LIterInitK _ -> "LIterInitK"
621 | IterNext _ -> "IterNext"
622 | LIterNext _ -> "LIterNext"
623 | IterNextK _ -> "IterNextK"
624 | LIterNextK _ -> "LIterNextK"
625 | IterFree _ -> "IterFree"
626 | LIterFree _ -> "LIterFree"
627 | _ -> failwith "invalid iterator instruction"
628 in
629 iterator_instruction_name ^ " "
630
631 let string_of_iterator instruction =
632 match instruction with
633 | IterInit (id, label, value) ->
634 (iterator_instruction_name_prefix instruction) ^
635 (string_of_iterator_id id) ^ " " ^
636 (string_of_label label) ^ " " ^
637 (string_of_local_id value)
638 | LIterInit (id, base, label, value) ->
639 (iterator_instruction_name_prefix instruction) ^
640 (string_of_iterator_id id) ^ " " ^
641 (string_of_local_id base) ^ " " ^
642 (string_of_label label) ^ " " ^
643 (string_of_local_id value)
644 | IterInitK (id, label, key, value) ->
645 (iterator_instruction_name_prefix instruction) ^
646 (string_of_iterator_id id) ^ " " ^
647 (string_of_label label) ^ " " ^
648 (string_of_local_id key) ^ " " ^
649 (string_of_local_id value)
650 | LIterInitK (id, base, label, key, value) ->
651 (iterator_instruction_name_prefix instruction) ^
652 (string_of_iterator_id id) ^ " " ^
653 (string_of_local_id base) ^ " " ^
654 (string_of_label label) ^ " " ^
655 (string_of_local_id key) ^ " " ^
656 (string_of_local_id value)
657 | IterNext (id, label, value) ->
658 (iterator_instruction_name_prefix instruction) ^
659 (string_of_iterator_id id) ^ " " ^
660 (string_of_label label) ^ " " ^
661 (string_of_local_id value)
662 | LIterNext (id, base, label, value) ->
663 (iterator_instruction_name_prefix instruction) ^
664 (string_of_iterator_id id) ^ " " ^
665 (string_of_local_id base) ^ " " ^
666 (string_of_label label) ^ " " ^
667 (string_of_local_id value)
668 | IterNextK (id, label, key, value) ->
669 (iterator_instruction_name_prefix instruction) ^
670 (string_of_iterator_id id) ^ " " ^
671 (string_of_label label) ^ " " ^
672 (string_of_local_id key) ^ " " ^
673 (string_of_local_id value)
674 | LIterNextK (id, base, label, key, value) ->
675 (iterator_instruction_name_prefix instruction) ^
676 (string_of_iterator_id id) ^ " " ^
677 (string_of_local_id base) ^ " " ^
678 (string_of_label label) ^ " " ^
679 (string_of_local_id key) ^ " " ^
680 (string_of_local_id value)
681 | IterFree id ->
682 (iterator_instruction_name_prefix instruction) ^
683 (string_of_iterator_id id)
684 | LIterFree (id, base) ->
685 (iterator_instruction_name_prefix instruction) ^
686 (string_of_iterator_id id) ^ " " ^
687 (string_of_local_id base)
688 | IterBreak (label, iterlist) ->
689 let map_item (kind, id) =
690 let id = string_of_iterator_id id in
691 match kind with
692 | Iter -> "(Iter) " ^ id
693 | LIter -> "(LIter) " ^ id
694 in
695 let values =
696 String.concat ~sep:", " (List.rev_map ~f:map_item iterlist) in
697 "IterBreak " ^ (string_of_label label) ^ " <" ^ values ^ ">"
698
699 let string_of_try instruction =
700 match instruction with
701 | TryFaultBegin label ->
702 ".try_fault " ^ (string_of_label label) ^ " {"
703 | TryCatchLegacyBegin label ->
704 ".try_catch " ^ (string_of_label label) ^ " {"
705 | TryFaultEnd
706 | TryCatchLegacyEnd -> "}"
707 | TryCatchBegin -> ".try {"
708 | TryCatchMiddle -> "} .catch {"
709 | TryCatchEnd -> "}"
710
711 let string_of_async = function
712 | Await -> "Await"
713 | WHResult -> "WHResult"
714 | AwaitAll (Some (Local.Unnamed local, count)) ->
715 Printf.sprintf "AwaitAll L:%d+%d" local count
716 | AwaitAll None ->
717 Printf.sprintf "AwaitAll L:0+0"
718 | AwaitAll _ -> failwith "AwaitAll needs an unnamed local"
719
720 let string_of_generator = function
721 | CreateCont -> "CreateCont"
722 | ContEnter -> "ContEnter"
723 | ContRaise -> "ContRaise"
724 | Yield -> "Yield"
725 | YieldK -> "YieldK"
726 | ContCheck IgnoreStarted -> "ContCheck IgnoreStarted"
727 | ContCheck CheckStarted -> "ContCheck CheckStarted"
728 | ContValid -> "ContValid"
729 | ContKey -> "ContKey"
730 | ContGetReturn -> "ContGetReturn"
731 | ContCurrent -> "ContCurrent"
732
733 let string_of_include_eval_define = function
734 | H.Incl -> "Incl"
735 | InclOnce -> "InclOnce"
736 | Req -> "Req"
737 | ReqOnce -> "ReqOnce"
738 | ReqDoc -> "ReqDoc"
739 | Eval -> "Eval"
740 | AliasCls (c1, c2) ->
741 sep ["AliasCls"; SU.quote_string c1; SU.quote_string c2]
742 | DefFunc id -> sep ["DefFunc"; string_of_function_num id]
743 | DefCls id -> sep ["DefCls"; string_of_class_num id]
744 | DefClsNop id -> sep ["DefClsNop"; string_of_class_num id]
745 | DefCns id -> sep ["DefCns"; string_of_const_id id]
746 | DefTypeAlias id -> sep ["DefTypeAlias"; string_of_typedef_num id]
747
748 let string_of_free_iterator = function
749 | IgnoreIter -> "IgnoreIter"
750 | FreeIter -> "FreeIter"
751
752 let string_of_gen_delegation = function
753 | ContAssignDelegate i -> sep ["ContAssignDelegate"; string_of_iterator_id i]
754 | ContEnterDelegate -> "ContEnterDelegate"
755 | YieldFromDelegate (i, l) ->
756 sep ["YieldFromDelegate"; string_of_iterator_id i; string_of_label l]
757 | ContUnsetDelegate (free, i) ->
758 sep ["ContUnsetDelegate";
759 string_of_free_iterator free;
760 string_of_iterator_id i]
761
762 let string_of_instruction instruction =
763 let s = match instruction with
764 | IIterator i -> string_of_iterator i
765 | IBasic i -> string_of_basic i
766 | ILitConst i -> string_of_lit_const i
767 | IOp i -> string_of_operator i
768 | IContFlow i -> string_of_control_flow i
769 | ICall i -> string_of_call i
770 | IMisc i -> string_of_misc i
771 | IGet i -> string_of_get i
772 | IMutator i -> string_of_mutator i
773 | ILabel l -> string_of_label l ^ ":"
774 | IIsset i -> string_of_isset i
775 | IBase i -> string_of_base i
776 | IFinal i -> string_of_final i
777 | ITry i -> string_of_try i
778 | IComment s -> "# " ^ s
779 | ISrcLoc p -> ".srcloc " ^ string_of_pos p ^ ";"
780 | IAsync i -> string_of_async i
781 | IGenerator i -> string_of_generator i
782 | IIncludeEvalDefine i -> string_of_include_eval_define i
783 | IGenDelegation i -> string_of_gen_delegation i
784 | _ -> failwith "invalid instruction" in
785 s ^ "\n"
786
787 let adjusted_indent instruction indent =
788 match instruction with
789 | IComment _ -> 0
790 | ILabel _
791 | ITry TryFaultEnd
792 | ITry TryCatchLegacyEnd
793 | ITry TryCatchMiddle
794 | ITry TryCatchEnd -> indent - 2
795 | _ -> indent
796
797 let new_indent instruction indent =
798 match instruction with
799 | ITry (TryFaultBegin _)
800 | ITry (TryCatchLegacyBegin _)
801 | ITry TryCatchBegin -> indent + 2
802 | ITry TryFaultEnd
803 | ITry TryCatchLegacyEnd
804 | ITry TryCatchEnd -> indent - 2
805 | _ -> indent
806
807 let add_instruction_list buffer indent instructions =
808 let rec aux instructions indent =
809 match instructions with
810 | [] -> ()
811 | ISpecialFlow _ :: t ->
812 let fatal =
813 Emit_fatal.emit_fatal_runtime Pos.none "Cannot break/continue 1 level"
814 in
815 let fatal = Instruction_sequence.instr_seq_to_list fatal in
816 aux fatal indent;
817 aux t indent
818 | instruction :: t ->
819 begin
820 let actual_indent = adjusted_indent instruction indent in
821 Acc.add buffer (String.make actual_indent ' ');
822 Acc.add buffer (string_of_instruction instruction);
823 aux t (new_indent instruction indent)
824 end in
825 aux instructions indent
826
827 (* HHVM uses `N` to denote absence of type information. Otherwise the type
828 * is a quoted string *)
829 let quote_str_option s =
830 match s with
831 | None -> "N"
832 | Some s -> SU.quote_string s
833
834 let string_of_type_flags flags =
835 let flag_strs = List.map ~f:Hhas_type_constraint.string_of_flag flags in
836 let flags_text = String.concat ~sep:" " flag_strs in
837 flags_text
838
839 let string_of_type_info ?(is_enum = false) ti =
840 let user_type = Hhas_type_info.user_type ti in
841 let type_constraint = Hhas_type_info.type_constraint ti in
842 let flags = Hhas_type_constraint.flags type_constraint in
843 let flags_text = string_of_type_flags flags in
844 let name = Hhas_type_constraint.name type_constraint in
845 "<" ^ quote_str_option user_type ^ " "
846 ^ (if not is_enum then quote_str_option name ^ " " else "")
847 ^ flags_text
848 ^ " >"
849
850 let string_of_typedef_info ti =
851 let type_constraint = Hhas_type_info.type_constraint ti in
852 let name = Hhas_type_constraint.name type_constraint in
853 let flags = Hhas_type_constraint.flags type_constraint in
854 (* TODO: check if other flags are emitted for type aliases *)
855 let flags =
856 List.filter ~f:(fun f -> f = Hhas_type_constraint.Nullable) flags in
857 let flags_text = string_of_type_flags flags in
858 "<" ^ SU.quote_string (Option.value ~default:"" name)
859 ^ " " ^ flags_text ^ " >"
860
861 let string_of_type_info_option tio =
862 match tio with
863 | None -> ""
864 | Some ti -> string_of_type_info ti ^ " "
865
866 type default_value_printing_env = {
867 codegen_env : Emit_env.t option;
868 in_xhp: bool;
869 }
870
871 let rec string_of_afield ~env = function
872 | A.AFvalue e ->
873 string_of_param_default_value ~env e
874 | A.AFkvalue (k, v) ->
875 string_of_param_default_value ~env k ^
876 " => " ^ string_of_param_default_value ~env v
877
878 and string_of_afield_list ~env afl =
879 if List.length afl = 0
880 then ""
881 else String.concat ~sep:", " @@ List.map ~f:(string_of_afield ~env) afl
882
883 and shape_field_name_to_expr = function
884 | A.SFlit_int (pos, s) -> (pos, A.Int s)
885 | A.SFlit_str (pos, s)
886 | A.SFclass_const (_, (pos, s)) -> (pos, A.String s)
887
888 and string_of_bop = function
889 | A.Plus -> "+"
890 | A.Minus -> "-"
891 | A.Star -> "*"
892 | A.Slash -> "/"
893 | A.Eqeq -> "=="
894 | A.Eqeqeq -> "==="
895 | A.Starstar -> "**"
896 | A.Eq None -> "="
897 | A.Eq (Some bop) -> "=" ^ string_of_bop bop
898 | A.Ampamp -> "&&"
899 | A.Barbar -> "||"
900 | A.Lt -> "<"
901 | A.Lte -> "<="
902 | A.Cmp -> "<=>"
903 | A.Gt -> ">"
904 | A.Gte -> ">="
905 | A.Dot -> "."
906 | A.Amp -> "&"
907 | A.Bar -> "|"
908 | A.Ltlt -> "<<"
909 | A.Gtgt -> ">>"
910 | A.Percent -> "%"
911 | A.Xor -> "^"
912 | A.LogXor -> "xor"
913 | A.Diff -> "!="
914 | A.Diff2 -> "!=="
915 | A.QuestionQuestion -> "\\?\\?"
916
917 and string_of_uop = function
918 | A.Utild -> "~"
919 | A.Unot -> "!"
920 | A.Uplus -> "+"
921 | A.Uminus -> "-"
922 | A.Uincr -> "++"
923 | A.Udecr -> "--"
924 | A.Uref -> "&"
925 | A.Usilence -> "@"
926 | A.Upincr
927 | A.Updecr
928 -> failwith "string_of_uop - should have been captures earlier"
929
930 and string_of_hint ~ns h =
931 let h =
932 Emit_type_hint.fmt_hint
933 ~tparams:[]
934 ~namespace:Namespace_env.empty_with_default_popt
935 h
936 in
937 let h = if ns then h else SU.strip_ns h in
938 Php_escaping.escape h
939
940 and string_of_import_flavor = function
941 | A.Include -> "include"
942 | A.Require -> "require"
943 | A.IncludeOnce -> "include_once"
944 | A.RequireOnce -> "require_once"
945
946 and string_of_is_variadic b =
947 if b then "..." else ""
948 and string_of_is_reference b =
949 if b then "&" else ""
950
951 and string_of_fun ~env f use_list =
952 let string_of_args p =
953 match snd @@ p.A.param_id with
954 | "" | "..." -> None
955 | name ->
956 let inout = if p.A.param_callconv = Some A.Pinout then "inout " else "" in
957 let hint =
958 Option.value_map p.A.param_hint ~default:"" ~f:(string_of_hint ~ns:true)
959 in
960 let default_val =
961 Option.value_map
962 p.A.param_expr
963 ~default:""
964 ~f:(fun e -> " = " ^ (string_of_param_default_value ~env e)) in
965 let param_text =
966 inout ^ string_of_is_variadic p.A.param_is_variadic ^ hint in
967 let param_text =
968 if String.length param_text = 0
969 then param_text
970 else param_text ^ " " in
971 let param_text =
972 param_text ^ string_of_is_reference p.A.param_is_reference ^ name in
973 Some (param_text ^ default_val)
974 in
975 let args = String.concat ~sep:", " @@ List.filter_map ~f:string_of_args f.A.f_params in
976 let use_list_helper ((_, id), b) = (if b then "&" else "") ^ id in
977 let use_statement = match use_list with
978 | [] -> ""
979 | _ ->
980 "use ("
981 ^ (String.concat ~sep:", " @@ List.map ~f:use_list_helper use_list)
982 ^ ") "
983 in
984 (if f.A.f_static then "static " else "")
985 ^ (if f.A.f_fun_kind = A.FAsync || f.A.f_fun_kind = A.FAsyncGenerator then "async " else "")
986 ^ "function ("
987 ^ args
988 ^ ") "
989 ^ use_statement
990 ^ (string_of_statement ~env ~indent:"" (Pos.none, A.Block f.A.f_body))
991
992 and string_of_optional_expr ~env e =
993 string_of_optional_value (string_of_expression ~env) e
994
995 and string_of_block_ ~env ~start_indent ~block_indent ~end_indent block =
996 let lines =
997 (String.concat ~sep:"" @@
998 List.map ~f:(string_of_statement ~env ~indent:block_indent) block) in
999 start_indent ^ "{\\n" ^ lines ^ end_indent ^ "}\\n"
1000
1001 and string_of_block ~env ~indent (block:A.stmt list) =
1002 match block with
1003 | [] | [_, A.Noop] -> ""
1004 | [(_, A.Block ([_] as block))]
1005 | (_::_::_ as block)->
1006 string_of_block_
1007 ~env
1008 ~start_indent:""
1009 ~block_indent:(indent ^ indent_text)
1010 ~end_indent:indent
1011 block
1012 | [stmt] ->
1013 string_of_statement ~env ~indent:"" stmt
1014
1015 and string_of_statement ~env ~indent ((_, stmt_) : A.stmt) =
1016 let text, is_single_line =
1017 match stmt_ with
1018 | A.Return e ->
1019 "return" ^ (string_of_optional_expr ~env e), true
1020 | A.Expr e ->
1021 string_of_expression ~env e, true
1022 | A.Break level_opt ->
1023 "break" ^ (string_of_optional_expr ~env level_opt), true
1024 | A.Continue level_opt ->
1025 "continue" ^ (string_of_optional_expr ~env level_opt), true
1026 | A.Throw e ->
1027 "throw " ^ (string_of_expression ~env e), true
1028 | A.Block block ->
1029 string_of_block_
1030 ~env
1031 ~start_indent:indent
1032 ~block_indent:(indent ^ indent_text)
1033 ~end_indent:indent
1034 block,
1035 false
1036 | A.While (cond, body) ->
1037 let header_text =
1038 indent ^ "while (" ^ (string_of_expression ~env cond) ^ ") " in
1039 let body_text =
1040 string_of_block
1041 ~env
1042 ~indent
1043 body in
1044 header_text ^ body_text, false
1045
1046 | A.If (cond, then_block, else_block) ->
1047 let header_text =
1048 indent ^ "if (" ^ (string_of_expression ~env cond) ^ ") " in
1049 let then_text = string_of_block
1050 ~env
1051 ~indent
1052 then_block in
1053 let else_text = string_of_block
1054 ~env
1055 ~indent
1056 else_block in
1057 header_text ^ then_text ^
1058 (if String.length else_text <> 0 then " else " ^ else_text else ""),
1059 false
1060 | A.Noop -> "", false
1061 | _ -> (* TODO(T29869930) *) "NYI: Default value printing", false in
1062 let text =
1063 if is_single_line then indent ^ text ^ ";\\n"
1064 else text in
1065 text
1066
1067 and string_of_expression ~env e =
1068 string_of_param_default_value ~env e
1069
1070 and string_of_xml ~env (_, id) attributes children =
1071 let env = { env with in_xhp = true } in
1072 let p = Pos.none in
1073 let name = SU.Xhp.mangle id in
1074 let _, attributes =
1075 List.fold_right ~f:(string_of_xhp_attr p) attributes ~init:(0, [])
1076 in
1077 let attributes = string_of_param_default_value ~env (p, A.Darray attributes) in
1078 let children = string_of_param_default_value ~env
1079 (p, A.Varray children)
1080 in
1081 "new "
1082 ^ name
1083 ^ "("
1084 ^ attributes
1085 ^ ", "
1086 ^ children
1087 ^ ", __FILE__, __LINE__)"
1088
1089 and string_of_xhp_attr p attr (spread_id, attrs) = match attr with
1090 | A.Xhp_simple ((_, s), e) -> (spread_id, ((p, A.String s), e)::attrs)
1091 | A.Xhp_spread e ->
1092 let s = "...$" ^ (string_of_int spread_id) in
1093 (spread_id + 1, ((p, A.String s), e)::attrs)
1094
1095 and string_of_param_default_value ~env expr =
1096 let p = Pos.none in
1097 let middle_aux e1 s e2 =
1098 let e1 = string_of_param_default_value ~env e1 in
1099 let e2 = string_of_param_default_value ~env e2 in
1100 e1 ^ s ^ e2
1101 in
1102 let fmt_class_name ~is_class_constant cn =
1103 let cn = if SU.Xhp.is_xhp (Utils.strip_ns cn)
1104 then SU.Xhp.mangle cn else cn in
1105 let cn = (Php_escaping.escape (SU.strip_global_ns cn)) in
1106 if is_class_constant then "\\\\" ^ cn else cn in
1107 let get_special_class_name ~env ~is_class_constant id =
1108 let scope = match env with
1109 | None -> Ast_scope.Scope.toplevel
1110 | Some env -> Emit_env.get_scope env in
1111 let module ACE = Ast_class_expr in
1112 let e =
1113 let p0 = Pos.none in
1114 (p0, (A.Id (p0, id))) in
1115 fmt_class_name ~is_class_constant @@
1116 match ACE.expr_to_class_expr ~check_traits:true ~resolve_self:true scope e with
1117 | ACE.Class_id (_, name) -> name
1118 | _ -> id
1119 in
1120 let get_class_name_from_id ~env ~should_format ~is_class_constant id =
1121 if id = SN.Classes.cSelf || id = SN.Classes.cParent || id = SN.Classes.cStatic
1122 then get_special_class_name ~env ~is_class_constant id
1123 else
1124 let id =
1125 match env with
1126 | Some env ->
1127 Hhbc_id.Class.to_raw_string @@ fst @@
1128 Hhbc_id.Class.elaborate_id
1129 (Emit_env.get_namespace env) (p, id)
1130 | _ -> id
1131 in
1132 if should_format then fmt_class_name ~is_class_constant id else id
1133 in
1134 let handle_possible_colon_colon_class_expr ~env ~is_array_get = function
1135 | _, A.Class_const ((_, A.Id (p, s1)), (_, s2))
1136 when SU.is_class s2 && not
1137 (SU.is_self s1 || SU.is_parent s1 || SU.is_static s1) ->
1138
1139 let s1 = get_class_name_from_id
1140 ~env:env.codegen_env ~should_format:false ~is_class_constant:false s1 in
1141 let e =
1142 (fst expr, if is_array_get then A.Id (p, s1) else A.String s1) in
1143 Some (string_of_param_default_value ~env e)
1144 | _ -> None
1145 in
1146 let escape_char_for_printing = function
1147 | '\\' | '$' | '"' -> "\\\\"
1148 | '\n' | '\r' | '\t' -> "\\"
1149 | c when not (Php_escaping.is_lit_printable c) -> "\\"
1150 | _ -> ""
1151 in
1152 let escape_fn c = escape_char_for_printing c ^ Php_escaping.escape_char c in
1153 match snd expr with
1154 | A.Id (p, id) ->
1155 let id = match env.codegen_env with
1156 | Some env when SU.has_ns id ->
1157 let id, _, _ =
1158 Hhbc_id.Const.elaborate_id
1159 (Emit_env.get_namespace env) (p, id)
1160 in
1161 "\\" ^ Hhbc_id.Const.to_raw_string id
1162 | _ -> id
1163 in
1164 Php_escaping.escape id
1165 | A.Lvar (_, litstr) -> Php_escaping.escape litstr
1166 | A.Float litstr -> SU.Float.with_scientific_notation litstr
1167 | A.Int litstr -> SU.Integer.to_decimal litstr
1168 | A.String litstr ->
1169 SU.quote_string_with_escape ~f:escape_fn litstr
1170 | A.Null -> "NULL"
1171 | A.True -> "true"
1172 | A.False -> "false"
1173 (* For arrays and collections, we are making a conscious decision to not
1174 * match HHMV has HHVM's emitter has inconsistencies in the pretty printer
1175 * https://fburl.com/tzom2qoe *)
1176 | A.Array afl ->
1177 "array(" ^ string_of_afield_list ~env afl ^ ")"
1178 | A.Collection ((_, name), afl) when
1179 name = "vec" || name = "dict" || name = "keyset" ->
1180 name ^ "[" ^ string_of_afield_list ~env afl ^ "]"
1181 | A.Collection ((_, name), afl) ->
1182 let name = SU.Types.fix_casing @@ SU.strip_ns name in
1183 begin match name with
1184 | "Set" | "Pair" | "Vector" | "Map"
1185 | "ImmSet" | "ImmVector" | "ImmMap" ->
1186 let elems = string_of_afield_list ~env afl in
1187 let elems =
1188 if String.length elems <> 0 then " " ^ elems ^ " " else elems in
1189 "HH\\\\" ^ name ^ " {" ^ elems ^ "}"
1190 | _ ->
1191 failwith ("Default value for an unknown collection - " ^ name)
1192 end
1193 | A.Shape fl ->
1194 let fl =
1195 List.map
1196 ~f:(fun (f_name, e) ->
1197 (shape_field_name_to_expr f_name, e))
1198 fl
1199 in
1200 string_of_param_default_value ~env (fst expr, A.Darray fl)
1201 | A.Binop (bop, e1, e2) ->
1202 let bop = string_of_bop bop in
1203 let e1 = string_of_param_default_value ~env e1 in
1204 let e2 = string_of_param_default_value ~env e2 in
1205 e1 ^ " " ^ bop ^ " " ^ e2
1206 | A.New (e, _, es, ues)
1207 | A.Call (e, _, es, ues) ->
1208 let e = String_utils.lstrip (string_of_param_default_value ~env e) "\\\\" in
1209 let es = List.map ~f:(string_of_param_default_value ~env) (es @ ues) in
1210 let prefix = match snd expr with A.New (_, _, _, _) -> "new " | _ -> "" in
1211 prefix
1212 ^ e
1213 ^ "("
1214 ^ String.concat ~sep:", " es
1215 ^ ")"
1216 | A.NewAnonClass (es, ues, _) ->
1217 let es = List.map ~f:(string_of_param_default_value ~env) (es @ ues) in
1218 "new class"
1219 ^ "("
1220 ^ String.concat ~sep:", " es
1221 ^ ")"
1222 | A.Class_get (e1, e2) ->
1223 let s1 = match snd e1 with
1224 | A.Id (_, s1) ->
1225 get_class_name_from_id
1226 ~env:env.codegen_env ~should_format:true ~is_class_constant:false s1
1227 | _ -> string_of_param_default_value ~env e1 in
1228 let s2 = string_of_param_default_value ~env e2 in
1229 s1 ^ "::" ^ s2
1230 | A.Class_const (e1, (_, s2)) ->
1231 let cexpr_o =
1232 handle_possible_colon_colon_class_expr ~env ~is_array_get:false expr in
1233 begin match snd e1, cexpr_o with
1234 | _, Some cexpr_o -> cexpr_o
1235 | A.Id (_, s1), _ ->
1236 let s1 = get_class_name_from_id
1237 ~env:env.codegen_env ~should_format:true ~is_class_constant:true s1 in
1238 s1 ^ "::" ^ s2
1239 | _ ->
1240 let s1 = string_of_param_default_value ~env e1 in
1241 s1 ^ "::" ^ s2
1242 end
1243 | A.Unop (uop, e) -> begin
1244 let e = string_of_param_default_value ~env e in
1245 match uop with
1246 | A.Upincr -> e ^ "++"
1247 | A.Updecr -> e ^ "--"
1248 | _ -> string_of_uop uop ^ e
1249 end
1250 | A.Obj_get (e1, e2, f) ->
1251 let e1 = string_of_param_default_value ~env e1 in
1252 let e2 = string_of_param_default_value ~env e2 in
1253 let f = match f with A.OG_nullthrows -> "->" | A.OG_nullsafe -> "\\?->" in
1254 e1 ^ f ^ e2
1255 | A.Clone e -> "clone " ^ string_of_param_default_value ~env e
1256 | A.Array_get (e, eo) ->
1257 let e = string_of_param_default_value ~env e in
1258 let eo =
1259 Option.value_map eo ~default:""
1260 ~f:(fun e ->
1261 let cexpr_o =
1262 handle_possible_colon_colon_class_expr
1263 ~env ~is_array_get:true e in
1264 match cexpr_o with
1265 | Some s -> s
1266 | None -> string_of_param_default_value ~env e)
1267 in
1268 e ^ "[" ^ eo ^ "]"
1269 | A.String2 es ->
1270 String.concat ~sep:" . " @@ List.map ~f:(string_of_param_default_value ~env) es
1271 | A.PrefixedString (name, e) ->
1272 String.concat ~sep:" . " @@ [name; string_of_param_default_value ~env e]
1273 | A.Execution_operator es ->
1274 let s =
1275 String.concat ~sep:" . " @@ List.map ~f:(string_of_param_default_value ~env) es in
1276 "shell_exec(" ^ s ^ ")"
1277 | A.Eif (cond, etrue, efalse) ->
1278 let cond = string_of_param_default_value ~env cond in
1279 let etrue =
1280 Option.value_map etrue ~default:"" ~f:(string_of_param_default_value ~env)
1281 in
1282 let efalse = string_of_param_default_value ~env efalse in
1283 cond ^ " \\? " ^ etrue ^ " : " ^ efalse
1284 | A.Unsafeexpr e -> string_of_param_default_value ~env e
1285 | A.BracedExpr e -> "{" ^ string_of_param_default_value ~env e ^ "}"
1286 | A.ParenthesizedExpr e -> "(" ^ string_of_param_default_value ~env e ^ ")"
1287 | A.Cast (h, e) ->
1288 let h = string_of_hint ~ns: false h in
1289 let e = string_of_param_default_value ~env e in
1290 "(" ^ h ^ ")" ^ e
1291 | A.Pipe (e1, e2) -> middle_aux e1 " |> " e2
1292 | A.InstanceOf (e1, e2) -> middle_aux e1 " instanceof " e2
1293 | A.Is (e, h) ->
1294 let e = string_of_param_default_value ~env e in
1295 let h = string_of_hint ~ns:true h in
1296 e ^ " is " ^ h
1297 | A.As (e, h, b) ->
1298 let e = string_of_param_default_value ~env e in
1299 let o = if b then " ?as " else " as " in
1300 let h = string_of_hint ~ns:true h in
1301 e ^ o ^ h
1302 | A.Varray es ->
1303 let es = List.map ~f:(string_of_param_default_value ~env) es in
1304 "varray[" ^ (String.concat ~sep:", " es) ^ "]"
1305 | A.Darray es ->
1306 let es = List.map ~f:(fun (e1, e2) -> A.AFkvalue (e1, e2)) es in
1307 "darray[" ^ (string_of_afield_list ~env es) ^ "]"
1308 | A.List l ->
1309 let l = List.map ~f:(string_of_param_default_value ~env) l in
1310 "list(" ^ (String.concat ~sep:", " l) ^ ")"
1311 | A.Yield y ->
1312 "yield " ^ (string_of_afield ~env y)
1313 | A.Await a ->
1314 "await " ^ (string_of_param_default_value ~env a)
1315 | A.Yield_break ->
1316 "return"
1317 | A.Yield_from e ->
1318 "yield from " ^ (string_of_param_default_value ~env e)
1319 | A.Import (fl, e) ->
1320 let fl = string_of_import_flavor fl in
1321 let e = string_of_param_default_value ~env e in
1322 fl ^ " " ^ e
1323 | A.Xml (id, attributes, children) ->
1324 string_of_xml ~env id attributes children
1325 | A.Efun (f, use_list) -> string_of_fun ~env f use_list
1326 | A.Omitted -> ""
1327 | A.Lfun _ ->
1328 failwith "expected Lfun to be converted to Efun during closure conversion"
1329 | A.Suspend _
1330 | A.Callconv _
1331 | A.Expr_list _ -> failwith "illegal default value"
1332
1333 let string_of_param_default_value_option env = function
1334 | None -> ""
1335 | Some (label, expr) ->
1336 let env = { codegen_env = env; in_xhp = false } in
1337 " = "
1338 ^ (string_of_label label)
1339 ^ "(\"\"\""
1340 ^ (string_of_param_default_value ~env expr)
1341 ^ "\"\"\")"
1342
1343 let string_of_param_user_attributes p =
1344 match Hhas_param.user_attributes p with
1345 | [] -> ""
1346 | user_attrs ->
1347 let attrs = Emit_adata.attributes_to_strings user_attrs in
1348 "[" ^ (String.concat ~sep:" " attrs) ^ "]"
1349
1350 let string_of_is_inout b = if b then "inout " else ""
1351
1352 let string_of_param env p =
1353 let param_type_info = Hhas_param.type_info p in
1354 let param_name = Hhas_param.name p in
1355 let param_default_value = Hhas_param.default_value p in
1356 string_of_param_user_attributes p
1357 ^ string_of_is_inout (Hhas_param.is_inout p)
1358 ^ string_of_is_variadic (Hhas_param.is_variadic p)
1359 ^ string_of_type_info_option param_type_info
1360 ^ string_of_is_reference (Hhas_param.is_reference p)
1361 ^ param_name
1362 ^ string_of_param_default_value_option env param_default_value
1363
1364 let string_of_params env ps =
1365 "(" ^ String.concat ~sep:", " (List.map ~f:(string_of_param env) ps) ^ ")"
1366
1367 let add_indent buf indent = Acc.add buf (String.make indent ' ')
1368 let add_indented_line buf indent str =
1369 Acc.add buf "\n";
1370 add_indent buf indent;
1371 Acc.add buf str
1372
1373 let add_num_cls_ref_slots buf indent num_cls_ref_slots =
1374 if num_cls_ref_slots <> 0
1375 then add_indented_line buf indent
1376 (Printf.sprintf ".numclsrefslots %d;" num_cls_ref_slots)
1377
1378 let is_bareword_char c =
1379 match Char.lowercase c with
1380 | '_' | '.' | '$' | '\\' -> true
1381 | c -> (c >= '0' && c <= '9') || (c >= 'a' && c <= 'z')
1382
1383 let is_bareword_string s =
1384 let rec aux i =
1385 i >= String.length s || (is_bareword_char (String.get s i) && aux (i + 1)) in
1386 aux 0
1387
1388 let add_decl_vars buf indent decl_vars =
1389 let decl_vars = List.map ~f:(fun s ->
1390 if is_bareword_string s
1391 then s
1392 else "\"" ^ (Php_escaping.escape s) ^ "\""
1393 ) decl_vars in
1394 if decl_vars <> []
1395 then add_indented_line buf indent
1396 (".declvars " ^ String.concat ~sep:" " decl_vars ^ ";")
1397
1398 let add_num_iters buf indent num_iters =
1399 if num_iters <> 0
1400 then add_indented_line buf indent
1401 (Printf.sprintf ".numiters %d;" num_iters)
1402
1403 let add_static_default_value_option buf indent label =
1404 add_indented_line buf indent (".static " ^ label ^ ";")
1405
1406 let add_static_values buf indent lst =
1407 Hh_core.List.iter lst
1408 (fun label -> add_static_default_value_option buf indent label)
1409
1410 let add_doc buf indent doc_comment =
1411 match doc_comment with
1412 | Some cmt ->
1413 add_indented_line buf indent @@
1414 Printf.sprintf ".doc %s;" (SU.triple_quote_string cmt)
1415 | None -> ()
1416
1417 let add_body buf indent body =
1418 add_doc buf indent (Hhas_body.doc_comment body);
1419 if Hhas_body.is_memoize_wrapper body
1420 then add_indented_line buf indent ".ismemoizewrapper;";
1421 if Hhas_body.is_memoize_wrapper_lsb body
1422 then add_indented_line buf indent ".ismemoizewrapperlsb;";
1423 add_num_iters buf indent (Hhas_body.num_iters body);
1424 add_num_cls_ref_slots buf indent (Hhas_body.num_cls_ref_slots body);
1425 add_decl_vars buf indent (Hhas_body.decl_vars body);
1426 add_static_values buf indent (Hhas_body.static_inits body);
1427 Acc.add buf "\n";
1428 add_instruction_list buf indent
1429 (Instruction_sequence.instr_seq_to_list (Hhas_body.instrs body))
1430
1431 let function_attributes f =
1432 let user_attrs = Hhas_function.attributes f in
1433 let attrs = Emit_adata.attributes_to_strings user_attrs in
1434 let attrs = if Emit_env.is_systemlib ()
1435 then "unique" :: "builtin" :: "persistent" :: attrs else attrs in
1436 let attrs =
1437 if Emit_env.is_systemlib () ||
1438 ((Hhas_attribute.has_dynamically_callable user_attrs) &&
1439 not (Hhas_function.is_memoize_impl f))
1440 then "dyn_callable" :: attrs else attrs
1441 in
1442 let attrs =
1443 if Hhas_attribute.is_reads_caller_frame user_attrs && not (Hhas_function.inout_wrapper f) then "reads_frame" :: attrs else attrs in
1444 let attrs =
1445 if Hhas_attribute.is_writes_caller_frame user_attrs && not (Hhas_function.inout_wrapper f) then "writes_frame" :: attrs else attrs in
1446 let attrs =
1447 if not (Hhas_function.is_top f) then "nontop" :: attrs else attrs in
1448 let attrs =
1449 if Hhas_function.inout_wrapper f then "inout_wrapper" :: attrs else attrs in
1450 let attrs =
1451 if Hhas_function.no_injection f then "no_injection" :: attrs else attrs in
1452 let attrs =
1453 if Hhas_attribute.has_native user_attrs then "skip_frame" :: attrs else attrs in
1454 let attrs =
1455 if Hhas_attribute.has_foldable user_attrs then "foldable" :: attrs else attrs in
1456 let attrs =
1457 if Hhas_function.is_interceptable f then "interceptable" :: attrs else attrs in
1458 let attrs = match Rx.rx_level_to_attr_string (Hhas_function.rx_level f) with
1459 | Some s -> s :: attrs
1460 | None -> attrs
1461 in
1462 let text = String.concat ~sep:" " attrs in
1463 if text = "" then "" else "[" ^ text ^ "] "
1464
1465 let add_fun_def buf fun_def =
1466 let function_name = Hhas_function.name fun_def in
1467 let function_body = Hhas_function.body fun_def in
1468 let function_span = Hhas_function.span fun_def in
1469 let function_return_type = Hhas_body.return_type function_body in
1470 let env = Hhas_body.env function_body in
1471 let function_params = Hhas_body.params function_body in
1472 let function_is_async = Hhas_function.is_async fun_def in
1473 let function_is_generator = Hhas_function.is_generator fun_def in
1474 let function_is_pair_generator = Hhas_function.is_pair_generator fun_def in
1475 let function_rx_disabled = Hhas_function.rx_disabled fun_def in
1476 Acc.add buf "\n.function ";
1477 Acc.add buf (function_attributes fun_def);
1478 if Hhbc_options.source_mapping !Hhbc_options.compiler_options
1479 then Acc.add buf (string_of_span function_span ^ " ");
1480 Acc.add buf (string_of_type_info_option function_return_type);
1481 Acc.add buf (Hhbc_id.Function.to_raw_string function_name);
1482 Acc.add buf (string_of_params env function_params);
1483 if function_is_generator then Acc.add buf " isGenerator";
1484 if function_is_async then Acc.add buf " isAsync";
1485 if function_is_pair_generator then Acc.add buf " isPairGenerator";
1486 if function_rx_disabled then Acc.add buf " isRxDisabled";
1487 Acc.add buf " {";
1488 add_body buf 2 function_body;
1489 Acc.add buf "}\n"
1490
1491 let attributes_to_string attrs =
1492 let text = String.concat ~sep:" " attrs in
1493 let text = if text = "" then "" else "[" ^ text ^ "] " in
1494 text
1495
1496 let method_attributes m =
1497 let user_attrs = Hhas_method.attributes m in
1498 let attrs = Emit_adata.attributes_to_strings user_attrs in
1499 let is_native_opcode_impl = Hhas_attribute.is_native_opcode_impl user_attrs in
1500 let is_native = not is_native_opcode_impl && Hhas_attribute.has_native user_attrs in
1501 let is_systemlib = Emit_env.is_systemlib () in
1502 let attrs =
1503 if Emit_env.is_systemlib () ||
1504 ((Hhas_attribute.has_dynamically_callable user_attrs) &&
1505 not (Hhas_method.is_memoize_impl m))
1506 then "dyn_callable" :: attrs else attrs
1507 in
1508 let attrs = if is_systemlib && is_native then "persistent" :: attrs else attrs in
1509 let attrs = if is_systemlib then "builtin" :: attrs else attrs in
1510 let attrs = if is_systemlib && is_native then "unique" :: attrs else attrs in
1511 let attrs =
1512 if Hhas_attribute.is_reads_caller_frame user_attrs && not (Hhas_method.inout_wrapper m) then "reads_frame" :: attrs else attrs in
1513 let attrs =
1514 if Hhas_attribute.is_writes_caller_frame user_attrs && not (Hhas_method.inout_wrapper m) then "writes_frame" :: attrs else attrs in
1515 let attrs = if Hhas_method.inout_wrapper m then "inout_wrapper" :: attrs else attrs in
1516 let attrs = if Hhas_method.no_injection m then "no_injection" :: attrs else attrs in
1517 let attrs = if is_systemlib && is_native then "skip_frame" :: attrs else attrs in
1518 let attrs =
1519 if Hhas_attribute.has_foldable user_attrs then "foldable" :: attrs else attrs in
1520 let attrs = if Hhas_method.is_abstract m then "abstract" :: attrs else attrs in
1521 let attrs = if Hhas_method.is_final m then "final" :: attrs else attrs in
1522 let attrs = if Hhas_method.is_static m then "static" :: attrs else attrs in
1523 let attrs = if Hhas_method.is_public m then "public" :: attrs else attrs in
1524 let attrs = if Hhas_method.is_protected m then "protected" :: attrs else attrs in
1525 let attrs = if Hhas_method.is_private m then "private" :: attrs else attrs in
1526 let attrs = if Hhas_method.is_interceptable m then "interceptable" :: attrs else attrs in
1527 let attrs = match Rx.rx_level_to_attr_string (Hhas_method.rx_level m) with
1528 | Some s -> s :: attrs
1529 | None -> attrs
1530 in
1531 attributes_to_string attrs
1532
1533 let typedef_attributes t =
1534 let user_attrs = Hhas_typedef.attributes t in
1535 let attrs = Emit_adata.attributes_to_strings user_attrs in
1536 let attrs =
1537 if Emit_env.is_systemlib () then "persistent" :: attrs else attrs in
1538 attributes_to_string attrs
1539
1540 let add_method_def buf method_def =
1541 let method_name = Hhas_method.name method_def in
1542 let method_body = Hhas_method.body method_def in
1543 let method_return_type = Hhas_body.return_type method_body in
1544 let method_params = Hhas_body.params method_body in
1545 let env = Hhas_body.env method_body in
1546 let method_span = Hhas_method.span method_def in
1547 let method_is_async = Hhas_method.is_async method_def in
1548 let method_is_generator = Hhas_method.is_generator method_def in
1549 let method_is_pair_generator = Hhas_method.is_pair_generator method_def in
1550 let method_is_closure_body = Hhas_method.is_closure_body method_def in
1551 let method_rx_disabled = Hhas_method.rx_disabled method_def in
1552 Acc.add buf "\n .method ";
1553 Acc.add buf (method_attributes method_def);
1554 if Hhbc_options.source_mapping !Hhbc_options.compiler_options
1555 then Acc.add buf (string_of_span method_span ^ " ");
1556 Acc.add buf (string_of_type_info_option method_return_type);
1557 Acc.add buf (Hhbc_id.Method.to_raw_string method_name);
1558 Acc.add buf (string_of_params env method_params);
1559 if method_is_generator then Acc.add buf " isGenerator";
1560 if method_is_async then Acc.add buf " isAsync";
1561 if method_is_pair_generator then Acc.add buf " isPairGenerator";
1562 if method_is_closure_body then Acc.add buf " isClosureBody";
1563 if method_rx_disabled then Acc.add buf " isRxDisabled";
1564 Acc.add buf " {";
1565 add_body buf 4 method_body;
1566 Acc.add buf " }"
1567
1568 let class_special_attributes c =
1569 let user_attrs = Hhas_class.attributes c in
1570 let attrs = Emit_adata.attributes_to_strings user_attrs in
1571 let attrs = if Hhas_class.needs_no_reifiedinit c
1572 then "noreifiedinit" :: attrs else attrs in
1573 let attrs = if Hhas_class.no_dynamic_props c
1574 then "no_dynamic_props" :: attrs else attrs in
1575 let attrs =
1576 if Hhas_class.has_immutable c then "has_immutable" :: attrs else attrs in
1577 let attrs =
1578 if Hhas_class.is_immutable c then "is_immutable" :: attrs else attrs in
1579 let attrs =
1580 if Hhas_attribute.has_foldable user_attrs then "foldable" :: attrs else attrs in
1581 let attrs = if Emit_env.is_systemlib ()
1582 then "unique" :: "builtin" :: "persistent" :: attrs else attrs in
1583 let attrs =
1584 if Hhas_attribute.has_dynamically_constructible user_attrs
1585 then "dyn_constructible" :: attrs else attrs
1586 in
1587 let attrs = if not (Hhas_class.is_top c) then "nontop" :: attrs else attrs in
1588 let attrs =
1589 if Hhas_class.is_closure_class c && not @@ Emit_env.is_systemlib ()
1590 then "unique" :: attrs else attrs in
1591 let attrs =
1592 if Hhas_class.is_closure_class c then "no_override" :: attrs else attrs in
1593 let attrs = if Hhas_class.is_trait c then "trait" :: attrs else attrs in
1594 let attrs =
1595 if Hhas_class.is_interface c then "interface" :: attrs else attrs
1596 in
1597 let attrs = if Hhas_class.is_final c then "final" :: attrs else attrs in
1598 let attrs = if Hhas_class.is_sealed c then "sealed" :: attrs else attrs in
1599 let attrs =
1600 if Hhas_class.enum_type c <> None then "enum" :: attrs else attrs
1601 in
1602 let attrs = if Hhas_class.is_abstract c then "abstract" :: attrs else attrs in
1603 let text = String.concat ~sep:" " attrs in
1604 let text = if text = "" then "" else "[" ^ text ^ "] " in
1605 text
1606
1607 let add_extends buf class_base =
1608 match class_base with
1609 | None -> ()
1610 | Some name ->
1611 begin
1612 Acc.add buf " extends ";
1613 Acc.add buf (Hhbc_id.Class.to_raw_string name);
1614 end
1615
1616 let add_implements buf class_implements =
1617 match class_implements with
1618 | [] -> ()
1619 | _ ->
1620 begin
1621 Acc.add buf " implements (";
1622 Acc.add buf (String.concat ~sep:" "
1623 (List.map ~f:Hhbc_id.Class.to_raw_string class_implements));
1624 Acc.add buf ")";
1625 end
1626
1627 let property_attributes p =
1628 let module P = Hhas_property in
1629 let user_attrs = P.attributes p in
1630 let attrs = Emit_adata.attributes_to_strings user_attrs in
1631 let attrs = if P.is_late_init p then "late_init" :: attrs else attrs in
1632 let attrs = if P.is_soft_late_init p then "late_init_soft" :: attrs else attrs in
1633 let attrs = if P.is_no_bad_redeclare p then "no_bad_redeclare" :: attrs else attrs in
1634 let attrs = if P.initial_satisfies_tc p then "initial_satisfies_tc" :: attrs else attrs in
1635 let attrs = if P.no_implicit_null p then "no_implicit_null" :: attrs else attrs in
1636 let attrs = if P.has_system_initial p then "sys_initial_val" :: attrs else attrs in
1637 let attrs = if P.is_immutable p then "is_immutable" :: attrs else attrs in
1638 let attrs = if P.is_deep_init p then "deep_init" :: attrs else attrs in
1639 let attrs = if P.is_lsb p then "lsb" :: attrs else attrs in
1640 let attrs = if P.is_static p then "static" :: attrs else attrs in
1641 let attrs = if P.is_public p then "public" :: attrs else attrs in
1642 let attrs = if P.is_protected p then "protected" :: attrs else attrs in
1643 let attrs = if P.is_private p then "private" :: attrs else attrs in
1644 let text = String.concat ~sep:" " attrs in
1645 let text = if text = "" then "" else "[" ^ text ^ "] " in
1646 text
1647
1648 let property_type_info p =
1649 let tinfo = Hhas_property.type_info p in
1650 (string_of_type_info ~is_enum:false tinfo) ^ " "
1651
1652 let property_doc_comment p =
1653 match Hhas_property.doc_comment p with
1654 | None -> ""
1655 | Some s -> Printf.sprintf "%s " (SU.triple_quote_string s)
1656
1657 let add_property class_def buf property =
1658 Acc.add buf "\n .property ";
1659 Acc.add buf (property_attributes property);
1660 Acc.add buf (property_doc_comment property);
1661 Acc.add buf (property_type_info property);
1662 Acc.add buf (Hhbc_id.Prop.to_raw_string (Hhas_property.name property));
1663 Acc.add buf " =\n ";
1664 let initial_value = Hhas_property.initial_value property in
1665 if Hhas_class.is_closure_class class_def
1666 || initial_value = Some Typed_value.Uninit
1667 then Acc.add buf "uninit;"
1668 else begin
1669 Acc.add buf "\"\"\"";
1670 begin match initial_value with
1671 | None -> Acc.add buf "N;"
1672 | Some value -> Emit_adata.adata_to_buffer buf value
1673 end;
1674 Acc.add buf "\"\"\";"
1675 end
1676
1677 let add_constant buf c =
1678 let name = Hhas_constant.name c in
1679 let value = Hhas_constant.value c in
1680 Acc.add buf "\n .const ";
1681 Acc.add buf name;
1682 begin match value with
1683 | Some Typed_value.Uninit ->
1684 Acc.add buf " = uninit"
1685 | Some value ->
1686 Acc.add buf " = \"\"\"";
1687 Emit_adata.adata_to_buffer buf value;
1688 Acc.add buf "\"\"\""
1689 | None -> ()
1690 end;
1691 Acc.add buf ";"
1692
1693 let add_type_constant buf c =
1694 Acc.add buf "\n .const ";
1695 Acc.add buf (Hhas_type_constant.name c);
1696 let initializer_t = Hhas_type_constant.initializer_t c in
1697 Acc.add buf " isType";
1698 match initializer_t with
1699 | Some init ->
1700 Acc.add buf " = \"\"\"";
1701 Emit_adata.adata_to_buffer buf init;
1702 Acc.add buf "\"\"\";"
1703 | None -> Acc.add buf ";"
1704
1705 let add_requirement buf r =
1706 Acc.add buf "\n .require ";
1707 match r with
1708 | (Ast.MustExtend, name) ->
1709 Acc.add buf ("extends <" ^ name ^ ">;")
1710 | (Ast.MustImplement, name) ->
1711 Acc.add buf ("implements <" ^ name ^ ">;")
1712
1713 let add_enum_ty buf c =
1714 match Hhas_class.enum_type c with
1715 | Some et ->
1716 Acc.add buf "\n .enum_ty ";
1717 Acc.add buf @@ string_of_type_info ~is_enum:true et;
1718 Acc.add buf ";"
1719 | _ -> ()
1720
1721 let add_use_precedence buf (id1, id2, ids) =
1722 let name = id1 ^ "::" ^ id2 in
1723 let unique_ids = List.fold_left ~f:ULS.add ~init:ULS.empty ids in
1724 let ids = String.concat ~sep:" " @@ ULS.items unique_ids in
1725 Acc.add buf @@ Printf.sprintf "\n %s insteadof %s;" name ids
1726
1727 let add_use_alias buf (ido1, id, ido2, kindl) =
1728 let aliasing_id =
1729 Option.value_map ~f:(fun id1 -> id1 ^ "::" ^ id) ~default:id ido1
1730 in
1731 let kind =
1732 match kindl with
1733 | [] -> None
1734 | x -> Some ("[" ^ (String.concat ~sep:" " @@ List.map ~f:Ast.string_of_kind x ) ^ "]")
1735 in
1736 let rest = Option.merge kind ido2 ~f:(fun x y -> x ^ " " ^ y) in
1737 let rest = Option.value ~default:"" rest in
1738 Acc.add buf @@ Printf.sprintf "\n %s as %s;" aliasing_id rest
1739
1740 let add_replace buf (trait, id, new_id, kindl, fun_kind) =
1741 Acc.add buf @@ Printf.sprintf
1742 "\n %s::%s as strict "
1743 trait id;
1744 if fun_kind = Ast_defs.FAsync || fun_kind = Ast_defs.FAsyncGenerator
1745 then Acc.add buf "async ";
1746 Acc.add buf "[";
1747 let rec concat kindl =
1748 match kindl with
1749 | [] -> ()
1750 | kind :: [] ->
1751 Acc.add buf (Printf.sprintf "%s" (Ast.string_of_kind kind))
1752 | kind :: kindl ->
1753 Acc.add buf (Printf.sprintf "%s " (Ast.string_of_kind kind));
1754 concat kindl in
1755 concat kindl;
1756 Acc.add buf "] ";
1757 Acc.add buf (Printf.sprintf "%s;" new_id)
1758
1759 let add_uses buf c =
1760 let use_l = Hhas_class.class_uses c in
1761 let use_alias_list = Hhas_class.class_use_aliases c in
1762 let use_precedence_list = Hhas_class.class_use_precedences c in
1763 let class_method_trait_resolutions = Hhas_class.class_method_trait_resolutions c in
1764 if use_l = [] && class_method_trait_resolutions = [] then () else
1765 begin
1766 let unique_ids =
1767 List.fold_left ~f:(fun l e -> ULS.add l (Utils.strip_ns e)) ~init:ULS.empty use_l
1768 in
1769 let use_l = String.concat ~sep:" " @@ ULS.items unique_ids in
1770 Acc.add buf @@ Printf.sprintf "\n .use %s" use_l;
1771 if use_alias_list = [] && use_precedence_list = [] && class_method_trait_resolutions = []
1772 then Acc.add buf ";" else
1773 begin
1774 Acc.add buf " {";
1775 List.iter ~f:(add_use_precedence buf) use_precedence_list;
1776 List.iter ~f:(add_use_alias buf) use_alias_list;
1777 List.iter ~f:(add_replace buf) class_method_trait_resolutions;
1778 Acc.add buf "\n }";
1779 end
1780 end
1781
1782 let add_class_def buf class_def =
1783 let class_name = Hhas_class.name class_def in
1784 (* TODO: user attributes *)
1785 Acc.add buf "\n.class ";
1786 Acc.add buf (class_special_attributes class_def);
1787 Acc.add buf (Hhbc_id.Class.to_raw_string class_name);
1788 if Hhbc_options.source_mapping !Hhbc_options.compiler_options
1789 then Acc.add buf (" " ^ string_of_span (Hhas_class.span class_def));
1790 add_extends buf (Hhas_class.base class_def);
1791 add_implements buf (Hhas_class.implements class_def);
1792 Acc.add buf " {";
1793 add_doc buf 2 (Hhas_class.doc_comment class_def);
1794 add_uses buf class_def;
1795 add_enum_ty buf class_def;
1796 List.iter ~f:(add_requirement buf) (Hhas_class.requirements class_def);
1797 List.iter ~f:(add_constant buf) (Hhas_class.constants class_def);
1798 List.iter ~f:(add_type_constant buf) (Hhas_class.type_constants class_def);
1799 List.iter ~f:(add_property class_def buf) (Hhas_class.properties class_def);
1800 List.iter ~f:(add_method_def buf) (Hhas_class.methods class_def);
1801 (* TODO: other members *)
1802 Acc.add buf "\n}\n"
1803
1804 let add_data_region_element buf argument =
1805 Acc.add buf ".adata ";
1806 Acc.add buf @@ (Hhas_adata.id argument);
1807 Acc.add buf " = \"\"\"";
1808 Emit_adata.adata_to_buffer buf (Hhas_adata.value argument);
1809 Acc.add buf "\"\"\";\n"
1810
1811 let add_data_region buf adata =
1812 List.iter ~f:(add_data_region_element buf) adata;
1813 Acc.add buf "\n"
1814
1815 let add_top_level buf body =
1816 Acc.add buf ".main ";
1817 if Hhbc_options.source_mapping !Hhbc_options.compiler_options
1818 then Acc.add buf "(1,1) ";
1819 Acc.add buf "{";
1820 add_body buf 2 body;
1821 Acc.add buf "}\n"
1822
1823 let add_typedef buf typedef =
1824 let name = Hhas_typedef.name typedef in
1825 let type_info = Hhas_typedef.type_info typedef in
1826 let opt_ts = Hhas_typedef.type_structure typedef in
1827 Acc.add buf "\n.alias ";
1828 Acc.add buf (typedef_attributes typedef);
1829 Acc.add buf (Hhbc_id.Class.to_raw_string name);
1830 Acc.add buf (" = " ^ string_of_typedef_info type_info);
1831 match opt_ts with
1832 | Some ts ->
1833 Acc.add buf " \"\"\"";
1834 Emit_adata.adata_to_buffer buf ts;
1835 Acc.add buf "\"\"\";"
1836 | None ->
1837 Acc.add buf ";"
1838
1839 let add_file_attributes buf file_attributes =
1840 match file_attributes with
1841 | [] -> ()
1842 | _ ->
1843 let attrs = Emit_adata.attributes_to_strings file_attributes in
1844 let attrs = attributes_to_string attrs in
1845 Acc.add buf "\n.file_attributes ";
1846 Acc.add buf attrs;
1847 Acc.add buf ";\n"
1848
1849 let add_include_region
1850 ?path ?doc_root ?search_paths ?include_roots ?(check_paths_exist=true)
1851 buf includes =
1852 let write_if_exists p =
1853 if not check_paths_exist || Sys.file_exists p
1854 then (Acc.add buf ("\n " ^ p); true)
1855 else false in
1856 let write_include inc =
1857 let include_roots = Option.value include_roots ~default:SMap.empty in
1858 match Hhas_symbol_refs.resolve_to_doc_root_relative inc ~include_roots with
1859 | Hhas_symbol_refs.Absolute p -> ignore @@ write_if_exists p
1860 | Hhas_symbol_refs.SearchPathRelative p ->
1861 if not check_paths_exist
1862 then Acc.add buf ("\n " ^ p)
1863 else
1864 let rec try_paths = function
1865 | [] -> ()
1866 | prefix :: rest ->
1867 if write_if_exists (Filename.concat prefix p)
1868 then ()
1869 else try_paths rest in
1870 let dirname =
1871 Option.value_map path ~default:[] ~f:(fun p -> [Filename.dirname p]) in
1872 try_paths (dirname @ Option.value search_paths ~default:[])
1873 | Hhas_symbol_refs.IncludeRootRelative (v, p) -> if p <> "" then
1874 Option.iter (SMap.find_opt v include_roots) (fun ir ->
1875 let doc_root = Option.value doc_root ~default:"" in
1876 let resolved = Filename.concat doc_root (Filename.concat ir p) in
1877 ignore @@ write_if_exists resolved)
1878 | Hhas_symbol_refs.DocRootRelative p -> ignore @@
1879 let doc_root = Option.value doc_root ~default:"" in
1880 let resolved = Filename.concat doc_root p in
1881 write_if_exists resolved
1882 in
1883 if not (Hhas_symbol_refs.IncludePathSet.is_empty includes) then begin
1884 Acc.add buf "\n.includes {";
1885 Hhas_symbol_refs.IncludePathSet.iter write_include includes;
1886 Acc.add buf "\n}\n"
1887 end
1888
1889 let add_symbol_ref_regions buf symbol_refs =
1890 let add_region name refs =
1891 if not (SSet.is_empty refs) then begin
1892 Acc.add buf ("\n." ^ name);
1893 Acc.add buf " {";
1894 SSet.iter (fun s -> Acc.add buf ("\n " ^ s)) refs;
1895 Acc.add buf "\n}\n";
1896 end in
1897 add_region "constant_refs" symbol_refs.Hhas_symbol_refs.constants;
1898 add_region "function_refs" symbol_refs.Hhas_symbol_refs.functions;
1899 add_region "class_refs" symbol_refs.Hhas_symbol_refs.classes
1900
1901 let add_program_content ?path dump_symbol_refs buf hhas_prog =
1902 let is_hh = if Hhas_program.is_hh hhas_prog then "1" else "0" in
1903 Acc.add buf @@ "\n.hh_file " ^ is_hh ^ ";\n";
1904 let functions = Hhas_program.functions hhas_prog in
1905 let top_level_body = Hhas_program.main hhas_prog in
1906 let classes = Hhas_program.classes hhas_prog in
1907 let adata = Hhas_program.adata hhas_prog in
1908 let symbol_refs = Hhas_program.symbol_refs hhas_prog in
1909 add_data_region buf adata;
1910 add_top_level buf top_level_body;
1911 List.iter ~f:(add_fun_def buf) functions;
1912 List.iter ~f:(add_class_def buf) classes;
1913 List.iter ~f:(add_typedef buf) (Hhas_program.typedefs hhas_prog);
1914 add_file_attributes buf (Hhas_program.file_attributes hhas_prog);
1915 if dump_symbol_refs then begin
1916 let opts = !Hhbc_options.compiler_options in
1917 add_include_region ?path buf symbol_refs.Hhas_symbol_refs.includes
1918 ~doc_root:(Hhbc_options.doc_root opts)
1919 ~search_paths:(Hhbc_options.include_search_paths opts)
1920 ~include_roots:(Hhbc_options.include_roots opts);
1921 add_symbol_ref_regions buf symbol_refs
1922 end
1923
1924 let add_program ?path dump_symbol_refs buf hhas_prog =
1925 let strict_types =
1926 match Hhas_program.strict_types hhas_prog with
1927 | Some true -> ".strict 1;\n\n"
1928 | Some false -> ".strict 0;\n\n"
1929 | None -> "" in
1930 match path with
1931 | Some p ->
1932 let p = Php_escaping.escape @@ Relative_path.to_absolute p in
1933 Acc.add buf
1934 (Printf.sprintf "# %s starts here\n\n%s.filepath \"%s\";\n" p strict_types p);
1935 add_program_content ~path:p dump_symbol_refs buf hhas_prog;
1936 Acc.add buf (Printf.sprintf "\n# %s ends here\n" p)
1937 | None ->
1938 Acc.add buf "#starts here\n";
1939 Acc.add buf strict_types;
1940 add_program_content dump_symbol_refs buf hhas_prog;
1941 Acc.add buf "\n#ends here\n"
1942
1943 let to_segments ?path ?(dump_symbol_refs=false) hhas_prog =
1944 let buf = Acc.create () in
1945 add_program ?path dump_symbol_refs buf hhas_prog;
1946 Acc.segments buf
1947
1948 let to_string ?path ?dump_symbol_refs =
1949 Fn.compose (String.concat ~sep:"") (to_segments ?path ?dump_symbol_refs)