-
Notifications
You must be signed in to change notification settings - Fork 0
/
parser_hack.ml
3810 lines (3469 loc) · 113 KB
/
parser_hack.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(**
* Copyright (c) 2014, Facebook, Inc.
* All rights reserved.
*
* This source code is licensed under the BSD-style license found in the
* LICENSE file in the "hack" directory of this source tree. An additional grant
* of patent rights can be found in the PATENTS file in the same directory.
*
*)
open Lexer_hack
open Ast
module L = Lexer_hack
(*****************************************************************************)
(* Environment *)
(*****************************************************************************)
type env = {
file : Relative_path.t;
mode : FileInfo.mode;
priority : int;
lb : Lexing.lexbuf;
errors : (Pos.t * string) list ref;
in_generator : bool ref;
}
let init_env file lb = {
file = file;
mode = FileInfo.Mpartial;
priority = 0;
lb = lb;
errors = ref [];
in_generator = ref false;
}
type parser_return = {
file_mode : FileInfo.mode option; (* None if PHP *)
comments : (Pos.t * string) list;
ast : Ast.program;
error : (Pos.t * string) option;
}
(*****************************************************************************)
(* Lexer (with backtracking) *)
(*****************************************************************************)
type saved_lb = {
(* no need to save refill_buff because it's constant *)
lex_abs_pos : int;
lex_start_pos : int;
lex_curr_pos : int;
lex_last_pos : int;
lex_last_action : int;
lex_eof_reached : bool;
lex_mem : int array;
lex_start_p : Lexing.position;
lex_curr_p : Lexing.position;
}
let save_lexbuf_state (lb : Lexing.lexbuf) : saved_lb =
{
lex_abs_pos = lb.Lexing.lex_abs_pos;
lex_start_pos = lb.Lexing.lex_start_pos;
lex_curr_pos = lb.Lexing.lex_curr_pos;
lex_last_pos = lb.Lexing.lex_last_pos;
lex_last_action = lb.Lexing.lex_last_action;
lex_eof_reached = lb.Lexing.lex_eof_reached;
lex_mem = lb.Lexing.lex_mem;
lex_start_p = lb.Lexing.lex_start_p;
lex_curr_p = lb.Lexing.lex_curr_p;
}
let restore_lexbuf_state (lb : Lexing.lexbuf) (saved : saved_lb) : unit =
begin
lb.Lexing.lex_abs_pos <- saved.lex_abs_pos;
lb.Lexing.lex_start_pos <- saved.lex_start_pos;
lb.Lexing.lex_curr_pos <- saved.lex_curr_pos;
lb.Lexing.lex_last_pos <- saved.lex_last_pos;
lb.Lexing.lex_last_action <- saved.lex_last_action;
lb.Lexing.lex_eof_reached <- saved.lex_eof_reached;
lb.Lexing.lex_mem <- saved.lex_mem;
lb.Lexing.lex_start_p <- saved.lex_start_p;
lb.Lexing.lex_curr_p <- saved.lex_curr_p;
end
(*
* Call a function with a forked lexing environment, and return its
* result.
*)
let look_ahead (env : env) (f : env -> 'a) : 'a =
let saved = save_lexbuf_state env.lb in
let ret = f env in
restore_lexbuf_state env.lb saved;
ret
(*
* Conditionally parse, saving lexer state in case we need to backtrack.
* The function parameter returns any optional type. If it's None, pop
* lexer state on the way out.
*
* Note that you shouldn't add any errors to the environment before
* you've committed to returning Some something. The error state is not
* popped.
*)
let try_parse (env : env) (f : env -> 'a option) : 'a option =
let saved = save_lexbuf_state env.lb in
match f env with
| Some x -> Some x
| None -> (restore_lexbuf_state env.lb saved; None)
(* Return the next token without updating lexer state *)
let peek env =
let saved = save_lexbuf_state env.lb in
let ret = L.token env.file env.lb in
restore_lexbuf_state env.lb saved;
ret
(* Checks if the next token matches a given word without updating lexer state*)
let peek_check_word env word =
let saved = save_lexbuf_state env.lb in
let ret = L.token env.file env.lb = Tword && Lexing.lexeme env.lb = word in
restore_lexbuf_state env.lb saved;
ret
(* Drop the next token unconditionally *)
let drop (env : env) : unit = match L.token env.file env.lb with _ -> ()
let btw (p1, _) (p2, _) = Pos.btw p1 p2
(*****************************************************************************)
(* Errors *)
(*****************************************************************************)
let error_at env pos msg =
env.errors := (pos, msg) :: !(env.errors)
let error env msg =
error_at env (Pos.make env.file env.lb) msg
let error_continue env =
error env
"Yeah...we're not going to support continue/break N. \
It makes static analysis tricky and it's not really essential"
let error_back env msg =
let pos = Pos.make env.file env.lb in
L.back env.lb;
error_at env pos msg
let error_expect env expect =
error_back env ("Expected "^expect)
let expect env x =
if L.token env.file env.lb = x
then ()
else error_expect env (L.token_to_string x)
let expect_word env name =
let tok = L.token env.file env.lb in
let value = Lexing.lexeme env.lb in
if tok <> Tword || value <> name
then error_expect env ("'"^name^ "' (not '"^value^"')");
()
(*****************************************************************************)
(* Modifiers checks (public private, final abstract etc ...) *)
(*****************************************************************************)
let rec check_modifiers env pos abstract final = function
| [] -> ()
| Final :: _ when abstract ->
error_at env pos "Parse error. Cannot mix final and abstract"
| Abstract :: _ when final ->
error_at env pos "Parse error. Cannot mix final and abstract"
| Final :: rl -> check_modifiers env pos abstract true rl
| Abstract :: rl -> check_modifiers env pos true final rl
| _ :: rl -> check_modifiers env pos abstract final rl
let check_visibility env pos l =
if List.exists begin function
| Private | Public | Protected | Static -> true
| _ -> false
end l
then ()
else error_at env pos
"Parse error. You are missing public, private or protected."
let rec check_mix_visibility env pos last_vis = function
| [] -> ()
| (Private | Public | Protected as vis) :: rl ->
(match last_vis with
| Some vis2 when vis <> vis2 ->
error_at env pos
"Parse error. Cannot mix different visibilities."
| _ ->
check_mix_visibility env pos (Some vis) rl
)
| _ :: rl -> check_mix_visibility env pos last_vis rl
let rec check_duplicates env pos = function
| [_] | [] -> ()
| Private :: rl -> check_duplicates env pos rl
| x :: (y :: _) when x = y ->
error_at env pos "Parse error. Duplicate modifier"
| _ :: rl -> check_duplicates env pos rl
let check_modifiers env pos l =
check_visibility env pos l;
check_modifiers env pos false false l;
check_duplicates env pos (List.sort compare l);
check_mix_visibility env pos None l;
()
let check_not_final env pos modifiers =
if List.exists (function Final -> true | _ -> false) modifiers
then error_at env pos "class variable cannot be final";
()
let check_toplevel env pos =
if env.mode = FileInfo.Mstrict
then error_at env pos "Remove all toplevel statements except for requires"
(*****************************************************************************)
(* Check expressions. *)
(*****************************************************************************)
let rec check_lvalue env = function
| pos, Obj_get (_, (_, Id (_, name)), OG_nullsafe) ->
error_at env pos "?-> syntax is not supported for lvalues"
| pos, Obj_get (_, (_, Id (_, name)), _) when name.[0] = ':' ->
error_at env pos "->: syntax is not supported for lvalues"
| _, (Lvar _ | Obj_get _ | Array_get _ | Class_get _ | Unsafeexpr _) -> ()
| pos, Call ((_, Id (_, "tuple")), _, _) ->
error_at env pos
"Tuple cannot be used as an lvalue. Maybe you meant List?"
| _, List el -> List.iter (check_lvalue env) el
| pos, (Array _ | Shape _ | Collection _
| Null | True | False | Id _ | Clone _
| Class_const _ | Call _ | Int _ | Float _
| String _ | String2 _ | Yield _ | Yield_break
| Await _ | Expr_list _ | Cast _ | Unop _
| Binop _ | Eif _ | InstanceOf _ | New _ | Efun _ | Lfun _ | Xml _
| Import _ | Ref _) ->
error_at env pos "Invalid lvalue"
(* The bound variable of a foreach can be a reference (but not inside
a list expression. *)
let check_foreach_lvalue env = function
| (_, Ref e) | e -> check_lvalue env e
(*****************************************************************************)
(* Operator priorities.
*
* It is annoying to deal with priorities by hand (although it's possible).
* This list mimics what would typically look like yacc rules, defining
* the operators priorities (from low to high), and associativity (left, right
* or non-assoc).
*
* The priorities are then used by the "reducer" to auto-magically parse
* expressions in the right order (left, right, non-assoc) and with the right
* priority. Checkout the function "reduce" for more details.
*)
(*****************************************************************************)
type assoc =
| Left (* a <op> b <op> c = ((a <op> b) <op> c) *)
| Right (* a <op> b <op> c = (a <op> (b <op> c)) *)
| NonAssoc (* a <op> b <op> c = error *)
let priorities = [
(* Lowest priority *)
(NonAssoc, [Tyield]);
(NonAssoc, [Tawait]);
(Left, [Timport; Teval;]);
(Left, [Tcomma]);
(Right, [Tprint]);
(Left, [Tqm; Tcolon]);
(Left, [Tbarbar]);
(Left, [Txor]);
(Left, [Tampamp]);
(Left, [Tbar]);
(Left, [Tamp]);
(NonAssoc, [Teqeq; Tdiff; Teqeqeq; Tdiff2]);
(NonAssoc, [Tlt; Tlte; Tgt; Tgte]);
(Left, [Tltlt; Tgtgt]);
(Left, [Tplus; Tminus; Tdot]);
(Left, [Tstar; Tslash; Tpercent]);
(Right, [Tem]);
(NonAssoc, [Tinstanceof]);
(Right, [Ttild; Tincr; Tdecr; Tcast]);
(Right, [Tstarstar]);
(Right, [Tat; Tref]);
(Left, [Tlp]);
(NonAssoc, [Tnew; Tclone]);
(Left, [Tlb]);
(Right, [Teq; Tpluseq; Tminuseq; Tstareq;
Tslasheq; Tdoteq; Tpercenteq;
Tampeq; Tbareq; Txoreq; Tlshifteq; Trshifteq]);
(Left, [Tarrow; Tnsarrow]);
(Left, [Telseif]);
(Left, [Telse]);
(Left, [Tendif]);
(Left, [Tcolcol]);
(Left, [Tdollar]);
(* Highest priority *)
]
let get_priority =
(* Creating the table of assocs/priorities at initialization time. *)
let ptable = Hashtbl.create 23 in
(* Lowest priority = 0 *)
let priority = ref 0 in
List.iter begin fun (assoc, tokl) ->
List.iter begin fun token ->
(* Associates operator => (associativity, priority) *)
Hashtbl.add ptable token (assoc, !priority)
end tokl;
(* This is a bit subtle:
*
* The difference in priority between 2 lines should be 2, not 1.
*
* It's because of a trick we use in the reducer.
* For something to be left-associative, we just pretend
* that the right hand side expression has a higher priority.
*
* An example:
* expr "1 + 2 + 3"
* reduce (e1 = 1) "2 + 3" // priority = 0
* reduce (e1 = 1) (expr "2 + 3" with priority+1)
* reduce (e1 = 1) (2, "+ 3") <--- this is where the trick is:
* because we made the priority higher
* the reducer stops when it sees the
* "+" sign.
*)
priority := !priority + 2
end priorities;
fun tok ->
assert (Hashtbl.mem ptable tok);
Hashtbl.find ptable tok
let with_priority env op f =
let _, prio = get_priority op in
let env = { env with priority = prio } in
f env
let with_base_priority env f =
let env = { env with priority = 0 } in
f env
(*****************************************************************************)
(* References *)
(*****************************************************************************)
let ref_opt env =
match L.token env.file env.lb with
| Tamp when env.mode = FileInfo.Mstrict ->
error env "Don't use references!";
true
| Tamp ->
true
| _ ->
L.back env.lb;
false
(*****************************************************************************)
(* Identifiers *)
(*****************************************************************************)
let xhp_identifier env =
(match L.xhpname env.file env.lb with
| Txhpname ->
Pos.make env.file env.lb, ":"^Lexing.lexeme env.lb
| _ ->
error_expect env "identifier";
Pos.make env.file env.lb, "*Unknown*"
)
(* identifier *)
let identifier env =
match L.token env.file env.lb with
| Tword ->
let pos = Pos.make env.file env.lb in
let name = Lexing.lexeme env.lb in
pos, name
| Tcolon ->
let start = Pos.make env.file env.lb in
let end_, name = xhp_identifier env in
Pos.btw start end_, name
| _ ->
error_expect env "identifier";
Pos.make env.file env.lb, "*Unknown*"
(* $variable *)
let variable env =
match L.token env.file env.lb with
| Tlvar ->
Pos.make env.file env.lb, Lexing.lexeme env.lb
| _ ->
error_expect env "variable";
Pos.make env.file env.lb, "$_" (* SpecialIdents.placeholder *)
(* &$variable *)
let ref_variable env =
let is_ref = ref_opt env in
(variable env, is_ref)
(* &...$arg *)
let ref_param env =
let is_ref = ref_opt env in
let is_variadic = match L.token env.file env.lb with
| Tellipsis -> true
| _ -> L.back env.lb; false
in
let var = variable env in
is_ref, is_variadic, var
(*****************************************************************************)
(* Entry point *)
(*****************************************************************************)
let rec program ?(elaborate_namespaces = true) file content =
L.comment_list := [];
L.fixmes := Utils.IMap.empty;
let lb = Lexing.from_string content in
let env = init_env file lb in
let ast, file_mode = header env in
let comments = !L.comment_list in
let fixmes = !L.fixmes in
L.comment_list := [];
L.fixmes := Utils.IMap.empty;
Parser_heap.HH_FIXMES.add env.file fixmes;
let error = if !(env.errors) <> []
then
let error = List.hd (List.rev !(env.errors)) in
Errors.parsing_error error;
Some error
else None
in
let ast = if elaborate_namespaces
then Namespaces.elaborate_defs ast
else ast in
{file_mode; comments; ast; error}
(*****************************************************************************)
(* Hack headers (strict, decl, partial) *)
(*****************************************************************************)
and header env =
let file_type, head = get_header env in
match file_type, head with
| FileInfo.PhpFile, _
| _, Some FileInfo.Mdecl ->
let env = { env with mode = FileInfo.Mdecl } in
let attr = [] in
let result = ignore_toplevel ~attr [] env (fun x -> x = Teof) in
expect env Teof;
result, head
| _, Some mode ->
let result = toplevel [] { env with mode = mode } (fun x -> x = Teof) in
expect env Teof;
result, head
| _ ->
[], head
and get_header env =
match L.header env.file env.lb with
| `error -> FileInfo.HhFile, None
| `default_mode -> FileInfo.HhFile, Some FileInfo.Mpartial
| `php_decl_mode -> FileInfo.PhpFile, Some FileInfo.Mdecl
| `php_mode -> FileInfo.PhpFile, None
| `explicit_mode ->
let _token = L.token env.file env.lb in
(match Lexing.lexeme env.lb with
| "strict" (*when !(Ide.is_ide_mode)*) ->
FileInfo.HhFile, Some FileInfo.Mpartial
(*| "strict" -> FileInfo.HhFile, Some FileInfo.Mstrict*)
| ("decl"|"only-headers") -> FileInfo.HhFile, Some FileInfo.Mdecl
| "partial" -> FileInfo.HhFile, Some FileInfo.Mpartial
| _ ->
error env
"Incorrect comment; possible values include strict, decl, partial or empty";
FileInfo.HhFile, Some FileInfo.Mdecl
)
(*****************************************************************************)
(* Decl mode *)
(*****************************************************************************)
and ignore_toplevel ~attr acc env terminate =
match L.token env.file env.lb with
| x when terminate x ->
L.back env.lb;
acc
| Tltlt ->
(* Parsing attribute << .. >> *)
let attr = attribute_remain env in
ignore_toplevel ~attr acc env terminate
| Tlcb ->
let acc = ignore_toplevel ~attr acc env terminate in
ignore_toplevel ~attr acc env terminate
| Tquote ->
let pos = Pos.make env.file env.lb in
let abs_pos = env.lb.Lexing.lex_curr_pos in
ignore (expr_string env pos abs_pos);
ignore_toplevel ~attr acc env terminate
| Tdquote ->
let pos = Pos.make env.file env.lb in
ignore (expr_encapsed env pos);
ignore_toplevel ~attr acc env terminate
| Theredoc ->
ignore (expr_heredoc env);
ignore_toplevel ~attr acc env terminate
| Tlt when is_xhp env ->
ignore (xhp env);
ignore_toplevel ~attr acc env terminate
| Tword ->
(match Lexing.lexeme env.lb with
| "function" ->
(match L.token env.file env.lb with
| Tword ->
L.back env.lb;
let def = toplevel_word ~attr env "function" in
ignore_toplevel ~attr:[] (def @ acc) env terminate
(* function &foo(...), we still want them in decl mode *)
| Tamp ->
(match L.token env.file env.lb with
| Tword ->
L.back env.lb;
let def = toplevel_word ~attr env "function" in
ignore_toplevel ~attr:[] (def @ acc) env terminate
| _ ->
ignore_toplevel ~attr acc env terminate
)
| _ ->
ignore_toplevel ~attr acc env terminate
)
| "abstract" | "final"
| "class"| "trait" | "interface"
| "namespace"
| "async" | "newtype"| "type"| "const" ->
(* Parsing toplevel declarations (class, function etc ...) *)
let def = toplevel_word ~attr env (Lexing.lexeme env.lb) in
ignore_toplevel ~attr:[] (def @ acc) env terminate
| _ -> ignore_toplevel ~attr acc env terminate
)
| Tclose_php ->
error env "Hack does not allow the closing ?> tag";
acc
| _ -> ignore_toplevel ~attr acc env terminate
(*****************************************************************************)
(* Toplevel statements. *)
(*****************************************************************************)
and toplevel acc env terminate =
match L.token env.file env.lb with
| x when terminate x ->
L.back env.lb;
List.rev acc
| Tsc ->
(* Ignore extra semicolons at toplevel (important so we don't yell about
* them in strict mode). *)
toplevel acc env terminate
| Tltlt ->
(* Parsing attribute << .. >> *)
let attr = attribute_remain env in
let _ = L.token env.file env.lb in
let def = toplevel_word ~attr env (Lexing.lexeme env.lb) in
toplevel (def @ acc) env terminate
| Tword ->
(* Parsing toplevel declarations (class, function etc ...) *)
let def = toplevel_word ~attr:[] env (Lexing.lexeme env.lb) in
toplevel (def @ acc) env terminate
| Tclose_php ->
error env "Hack does not allow the closing ?> tag";
List.rev acc
| _ ->
(* All the other statements. *)
let pos = Pos.make env.file env.lb in
L.back env.lb;
let error_state = !(env.errors) in
let stmt = Stmt (statement env) in
check_toplevel env pos;
if error_state != !(env.errors)
then ignore_toplevel ~attr:[] (stmt :: acc) env terminate
else toplevel (stmt :: acc) env terminate
and toplevel_word ~attr env = function
| "abstract" ->
let final = (match L.token env.file env.lb with
| Tword when Lexing.lexeme env.lb = "final" -> true
| _ -> begin L.back env.lb; false end
) in
expect_word env "class";
let class_ = class_ ~attr ~final ~kind:Cabstract env in
[Class class_]
| "final" ->
expect_word env "class";
let class_ = class_ ~attr ~final:true ~kind:Cnormal env in
[Class class_]
| "class" ->
let class_ = class_ ~attr ~final:false ~kind:Cnormal env in
[Class class_]
| "trait" ->
let class_ = class_ ~attr ~final:false ~kind:Ctrait env in
[Class class_]
| "interface" ->
let class_ = class_ ~attr ~final:false ~kind:Cinterface env in
[Class class_]
| "enum" ->
let class_ = enum_ ~attr env in
[Class class_]
| "async" ->
expect_word env "function";
let fun_ = fun_ ~attr ~sync:FDeclAsync env in
[Fun fun_]
| "function" ->
let fun_ = fun_ ~attr ~sync:FDeclSync env in
[Fun fun_]
| "newtype" ->
let typedef_ = typedef ~attr ~is_abstract:true env in
[Typedef typedef_]
| "type" ->
let typedef_ = typedef ~attr ~is_abstract:false env in
[Typedef typedef_]
| "namespace" ->
let id, body = namespace env in
[Namespace (id, body)]
| "use" ->
let usel = namespace_use_list env [] in
[NamespaceUse usel]
| "const" ->
let consts = class_const_def env in
(match consts with
| Const (h, cstl) ->
List.map (fun (x, y) -> Constant {
cst_mode = env.mode;
cst_kind = Cst_const;
cst_name = x;
cst_type = h;
cst_value = y;
cst_namespace = Namespace_env.empty;
}) cstl
| _ -> assert false)
| r when is_import r ->
let pos = Pos.make env.file env.lb in
let e = expr_import r env pos in
expect env Tsc;
[Stmt (Expr e)]
| _ ->
let pos = Pos.make env.file env.lb in
L.back env.lb;
let stmt = statement env in
check_toplevel env pos;
[define_or_stmt env stmt]
and define_or_stmt env = function
| Expr (_, Call ((_, Id (_, "define")), [(_, String name); value], [])) ->
Constant {
cst_mode = env.mode;
cst_kind = Cst_define;
cst_name = name;
cst_type = None;
cst_value = value;
cst_namespace = Namespace_env.empty;
}
| stmt ->
Stmt stmt
(*****************************************************************************)
(* Attributes: <<_>> *)
(*****************************************************************************)
(* <<_>> *)
and attribute env =
if look_ahead env (fun env -> L.token env.file env.lb = Tltlt)
then begin
expect env Tltlt;
attribute_remain env;
end
else []
(* _>> *)
and attribute_remain env =
match L.token env.file env.lb with
| Tword ->
(* Temporary backwards compat for renaming these attributes.
* TODO #4890694 remove this. *)
let attr_compat = function
| "ConsistentConstruct" -> "__ConsistentConstruct"
| "Override" -> "__Override"
| "UNSAFE_Construct" -> "__UNSAFE_Construct"
| x -> x in
let pos = Pos.make env.file env.lb in
let ua_name = pos, attr_compat (Lexing.lexeme env.lb) in
let ua_params = attribute_parameters env in
let attr = { ua_name; ua_params } in
attr :: attribute_list_remain env
| _ ->
error_expect env "attribute name";
[]
(* empty | (parameter_list) *)
and attribute_parameters env =
match L.token env.file env.lb with
| Tlp -> expr_list_remain env
| _ -> L.back env.lb; []
(* ,_,>> *)
and attribute_list_remain env =
match L.token env.file env.lb with
| Tgtgt -> []
| Tcomma -> attribute_remain env
| _ ->
error_expect env ">>";
[]
(*****************************************************************************)
(* Functions *)
(*****************************************************************************)
and fun_ ~attr ~(sync:fun_decl_kind) env =
let is_ref = ref_opt env in
if is_ref && sync = FDeclAsync
then error env ("Asynchronous function cannot return reference");
let name = identifier env in
let tparams = class_params env in
let params = parameter_list env in
let ret = hint_return_opt env in
let is_generator, body_stmts = function_body env in
{ f_name = name;
f_tparams = tparams;
f_params = params;
f_ret = ret;
f_ret_by_ref = is_ref;
f_body = body_stmts;
f_user_attributes = attr;
f_fun_kind = fun_kind sync is_generator;
f_mode = env.mode;
f_mtime = 0.0;
f_namespace = Namespace_env.empty;
}
(*****************************************************************************)
(* Classes *)
(*****************************************************************************)
and class_ ~attr ~final ~kind env =
let cname = identifier env in
let is_xhp = (snd cname).[0] = ':' in
let tparams = class_params env in
let cextends =
if kind = Ctrait then []
else class_extends ~single:(kind <> Cinterface) env in
let cimplements = class_implements kind env in
let cbody = class_body env in
let result =
{ c_mode = env.mode;
c_final = final;
c_kind = kind;
c_is_xhp = is_xhp;
c_implements = cimplements;
c_tparams = tparams;
c_user_attributes = attr;
c_name = cname;
c_extends = cextends;
c_body = cbody;
c_namespace = Namespace_env.empty;
c_enum = None;
}
in
class_implicit_fields result
(*****************************************************************************)
(* Enums *)
(*****************************************************************************)
and enum_base_ty env =
expect env Tcolon;
let h = hint env in
h
and enum_ ~attr env =
let cname = identifier env in
let basety = enum_base_ty env in
let constraint_ = typedef_constraint env in
let cbody = enum_body env in
let result =
{ c_mode = env.mode;
c_final = false;
c_kind = Cenum;
c_is_xhp = false;
c_implements = [];
c_tparams = [];
c_user_attributes = attr;
c_name = cname;
c_extends = [];
c_body = cbody;
c_namespace = Namespace_env.empty;
c_enum = Some
{ e_base = basety;
e_constraint = constraint_;
}
}
in
result
(* { ... *)
and enum_body env =
expect env Tlcb;
enum_defs env
and enum_defs env =
match peek env with
(* ... } *)
| Trcb ->
drop env;
[]
| Tword ->
let const = class_const env in
let elem = Const (None, [const]) in
expect env Tsc;
let rest = enum_defs env in
elem :: rest
| _ ->
error_expect env "enum const declaration";
[]
(*****************************************************************************)
(* Extends/Implements *)
(*****************************************************************************)
and class_extends ~single env =
match L.token env.file env.lb with
| Tword ->
(match Lexing.lexeme env.lb with
| "extends" -> if single then [class_hint env] else class_extends_list env
| "implements" -> L.back env.lb; []
| s -> error env ("Expected: extends; Got: "^s); []
)
| Tlcb ->
L.back env.lb;
[]
| _ ->
error_expect env "{";
[]
and class_implements kind env =
match L.token env.file env.lb with
| Tword ->
(match Lexing.lexeme env.lb with
| "implements" ->
let impl = class_extends_list env in
if kind = Cinterface then begin
error env "Expected: extends; Got implements"; []
end else
impl
| "extends" -> L.back env.lb; []
| s -> error env ("Expected: implements; Got: "^s); []
)
| Tlcb ->
L.back env.lb;
[]
| _ ->
error_expect env "{";
[]
and class_extends_list env =
let error_state = !(env.errors) in
let c = class_hint env in
match L.token env.file env.lb with
| Tlcb ->
L.back env.lb; [c]
| Tcomma ->
if !(env.errors) != error_state
then [c]
else c :: class_extends_list env
| Tword ->
(match Lexing.lexeme env.lb with
| "implements" | "extends" -> L.back env.lb; [c]
| _ -> error_expect env "{"; []
)
| _ -> error_expect env "{"; []
(*****************************************************************************)
(* Class parameters class A<T as X ..> *)
(*****************************************************************************)
and class_params env =
match L.token env.file env.lb with
| Tlt -> class_param_list env
| _ -> L.back env.lb; []
and class_param_list env =
let error_state = !(env.errors) in
let cst = class_param env in
match L.gt_or_comma env.file env.lb with
| Tgt ->
[cst]
| Tcomma ->
if !(env.errors) != error_state
then [cst]
else cst :: class_param_list env
| _ ->
error_expect env ">";
[cst]
and class_param env =
match L.token env.file env.lb with
| Tplus ->
if L.token env.file env.lb <> Tword
then class_param_error env
else
let parameter_name, parameter_constraint = class_param_name env in
Covariant, parameter_name, parameter_constraint
| Tminus ->
if L.token env.file env.lb <> Tword
then class_param_error env
else
let parameter_name, parameter_constraint = class_param_name env in
Contravariant, parameter_name, parameter_constraint
| Tword ->
let parameter_name, parameter_constraint = class_param_name env in
let variance = Invariant in
variance, parameter_name, parameter_constraint
| _ ->
class_param_error env
and class_param_error env =
error_expect env "type parameter";
let parameter_name = Pos.make env.file env.lb, "T*unknown*" in
Invariant, parameter_name, None
and class_param_name env =
let parameter_name = Pos.make env.file env.lb, Lexing.lexeme env.lb in
let parameter_constraint = class_parameter_constraint env in
parameter_name, parameter_constraint
and class_parameter_constraint env =
match L.token env.file env.lb with
| Tword when Lexing.lexeme env.lb = "as" -> Some (Constraint_as, hint env)
| Tword when Lexing.lexeme env.lb = "super" ->
Some (Constraint_super, hint env)
| _ -> L.back env.lb; None
(*****************************************************************************)
(* Class hints (A<T> etc ...) *)
(*****************************************************************************)
and class_hint env =
let pname = identifier env in
class_hint_with_name env pname
and class_hint_with_name env pname =
let params = class_hint_params env in
(fst pname), Happly (pname, params)
and class_hint_params env =
match L.token env.file env.lb with
| Tlt -> class_hint_param_list env
| _ -> L.back env.lb; []
and class_hint_param_list env =
let error_state = !(env.errors) in
let h = hint env in
match L.gt_or_comma env.file env.lb with
| Tgt ->
[h]
| Tcomma ->
if !(env.errors) != error_state
then [h]
else h :: class_hint_param_list env
| _ ->
error_expect env ">"; [h]
(*****************************************************************************)
(* Type hints: int, ?int, A<T>, array<...> etc ... *)
(*****************************************************************************)
and hint env =
match L.token env.file env.lb with
(* ?_ *)
| Tqm ->
let start = Pos.make env.file env.lb in
let e = hint env in
Pos.btw start (fst e), Hoption e
(* A<_> *)(* :XHPNAME *)
| Tword when Lexing.lexeme env.lb = "shape" ->
let pos = Pos.make env.file env.lb in
pos, Hshape (hint_shape_field_list env pos)
| Tword | Tcolon when Lexing.lexeme env.lb <> "function" ->
L.back env.lb;
hint_apply_or_access env []
| Tword ->
let h = hint_function env in
error_at env (fst h) "Function hints must be parenthesized";
h
(* (_) | (function(_): _) *)