-
-
Notifications
You must be signed in to change notification settings - Fork 661
/
typeloadFields.ml
1726 lines (1673 loc) · 67.5 KB
/
typeloadFields.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
(*
The Haxe Compiler
Copyright (C) 2005-2019 Haxe Foundation
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*)
(* Logic for building fields. *)
open Globals
open Ast
open Type
open Typecore
open Typeload
open DisplayTypes
open DisplayMode
open CompletionItem.ClassFieldOrigin
open Common
open Error
class context_init = object(self)
val mutable l = []
method add (f : unit -> unit) =
l <- f :: l
method run =
let l' = l in
l <- [];
List.iter (fun f -> f()) (List.rev l')
end
type class_init_ctx = {
tclass : tclass; (* I don't trust ctx.curclass because it's mutable. *)
is_lib : bool;
is_native : bool;
is_core_api : bool;
is_class_debug : bool;
extends_public : bool;
abstract : tabstract option;
context_init : context_init;
mutable has_display_field : bool;
mutable delayed_expr : (typer * tlazy ref option) list;
mutable force_constructor : bool;
mutable uninitialized_final : tclass_field list;
}
type field_kind =
| FKNormal
| FKConstructor
| FKInit
type field_init_ctx = {
is_inline : bool;
is_final : bool;
is_static : bool;
override : pos option;
overload : pos option;
is_extern : bool;
is_abstract : bool;
is_macro : bool;
is_abstract_member : bool;
is_display_field : bool;
is_field_debug : bool;
is_generic : bool;
field_kind : field_kind;
display_modifier : placed_access option;
mutable do_bind : bool;
mutable do_add : bool;
(* If true, cf_expr = None makes a difference in the logic. We insert a dummy expression in
display mode in order to address this. *)
mutable expr_presence_matters : bool;
}
let dump_class_context cctx =
Printer.s_record_fields "" [
"tclass",Printer.s_tclass "\t" cctx.tclass;
"is_lib",string_of_bool cctx.is_lib;
"is_native",string_of_bool cctx.is_native;
"is_core_api",string_of_bool cctx.is_core_api;
"is_class_debug",string_of_bool cctx.is_class_debug;
"extends_public",string_of_bool cctx.extends_public;
"abstract",Printer.s_opt (Printer.s_tabstract "\t") cctx.abstract;
"force_constructor",string_of_bool cctx.force_constructor;
]
let s_field_kind = function
| FKNormal -> "FKNormal"
| FKConstructor -> "FKConstructor"
| FKInit -> "FKInit"
let dump_field_context fctx =
Printer.s_record_fields "" [
"is_inline",string_of_bool fctx.is_inline;
"is_static",string_of_bool fctx.is_static;
"is_extern",string_of_bool fctx.is_extern;
"is_macro",string_of_bool fctx.is_macro;
"is_abstract_member",string_of_bool fctx.is_abstract_member;
"is_display_field",string_of_bool fctx.is_display_field;
"is_field_debug",string_of_bool fctx.is_field_debug;
"field_kind",s_field_kind fctx.field_kind;
"do_bind",string_of_bool fctx.do_bind;
"do_add",string_of_bool fctx.do_add;
"expr_presence_matters",string_of_bool fctx.expr_presence_matters;
]
let is_java_native_function ctx meta pos = try
match Meta.get Meta.Native meta with
| (Meta.Native,[],_) ->
ctx.com.warning "@:native metadata for jni functions is deprecated. Use @:java.native instead." pos;
true
| _ -> false
with | Not_found -> Meta.has Meta.NativeJni meta
(**** end of strict meta handling *****)
let get_method_args field =
match field.cf_expr with
| Some { eexpr = TFunction { tf_args = args } } -> args
| _ -> raise Not_found
(**
Get super constructor data required for @:structInit descendants.
*)
let get_struct_init_super_info ctx c p =
match c.cl_super with
| Some ({ cl_constructor = Some ctor } as csup, cparams) ->
let args = (try get_method_args ctor with Not_found -> []) in
let tl_rev,el_rev =
List.fold_left (fun (args,exprs) (v,value) ->
let opt = match value with
| Some _ -> true
| None -> Meta.has Meta.Optional v.v_meta
in
let t = if opt then ctx.t.tnull v.v_type else v.v_type in
(v.v_name,opt,t) :: args,(mk (TLocal v) v.v_type p) :: exprs
) ([],[]) args
in
let super_expr = mk (TCall (mk (TConst TSuper) (TInst (csup,cparams)) p, List.rev el_rev)) ctx.t.tvoid p in
(args,Some super_expr,List.rev tl_rev)
| _ ->
[],None,[]
(**
Generates a constructor for a @:structInit class `c` if it does not have one yet.
*)
let ensure_struct_init_constructor ctx c ast_fields p =
match c.cl_constructor with
| Some _ ->
()
| None ->
let field_has_default_expr field_name =
List.exists
(fun ast_field ->
match ast_field.cff_name with
| (name, _) when name <> field_name -> false
| _ ->
match ast_field.cff_kind with
| FVar (_, Some _) | FProp (_, _, _, Some _) -> true
| _ -> false
)
ast_fields
in
let super_args,super_expr,super_tl = get_struct_init_super_info ctx c p in
let params = List.map snd c.cl_params in
let ethis = mk (TConst TThis) (TInst(c,params)) p in
let doc_buf = Buffer.create 0 in
let args,el,tl = List.fold_left (fun (args,el,tl) cf -> match cf.cf_kind with
| Var { v_write = AccNever } -> args,el,tl
| Var _ ->
let has_default_expr = field_has_default_expr cf.cf_name in
let opt = has_default_expr || (Meta.has Meta.Optional cf.cf_meta) in
let t = if opt then ctx.t.tnull cf.cf_type else cf.cf_type in
let v = alloc_var VGenerated cf.cf_name t p in
let ef = mk (TField(ethis,FInstance(c,params,cf))) cf.cf_type p in
let ev = mk (TLocal v) v.v_type p in
if opt && not (Meta.has Meta.Optional v.v_meta) then
v.v_meta <- (Meta.Optional,[],null_pos) :: v.v_meta;
(* this.field = <constructor_argument> *)
let assign_expr = mk (TBinop(OpAssign,ef,ev)) cf.cf_type p in
let e =
if has_default_expr then
begin
(* <constructor_argument> != null *)
let condition = mk (TBinop(OpNotEq, ev, (null t p))) ctx.t.tbool p in
(* if(<constructor_argument> != null) this.field = <constructor_argument> *)
mk (TIf(condition, assign_expr, None)) ctx.t.tvoid p
end
else
assign_expr
in
begin match gen_doc_text_opt cf.cf_doc with
| None ->
()
| Some doc ->
Buffer.add_string doc_buf "@param ";
Buffer.add_string doc_buf cf.cf_name;
Buffer.add_string doc_buf " ";
let doc = ExtString.String.trim doc in
Buffer.add_string doc_buf doc;
Buffer.add_string doc_buf "\n";
end;
(v,None) :: args,e :: el,(cf.cf_name,opt,t) :: tl
| Method _ ->
args,el,tl
) ([],[],[]) (List.rev c.cl_ordered_fields) in
let el = match super_expr with Some e -> e :: el | None -> el in
let tf = {
tf_args = args @ super_args;
tf_type = ctx.t.tvoid;
tf_expr = mk (TBlock el) ctx.t.tvoid p
} in
let e = mk (TFunction tf) (TFun(tl @ super_tl,ctx.t.tvoid)) p in
let cf = mk_field "new" e.etype p null_pos in
cf.cf_doc <- doc_from_string (Buffer.contents doc_buf);
cf.cf_expr <- Some e;
cf.cf_type <- e.etype;
cf.cf_meta <- [Meta.CompilerGenerated,[],null_pos; Meta.InheritDoc,[],null_pos];
cf.cf_kind <- Method MethNormal;
c.cl_constructor <- Some cf;
delay ctx PTypeField (fun() -> InheritDoc.build_class_field_doc ctx (Some c) cf)
let transform_abstract_field com this_t a_t a f =
let stat = List.mem_assoc AStatic f.cff_access in
let p = f.cff_pos in
match f.cff_kind with
| FProp ((("get" | "never"),_),(("set" | "never"),_),_,_) when not stat ->
f
| FProp _ when not stat && not (Meta.has Meta.Enum f.cff_meta) ->
error "Member property accessors must be get/set or never" p;
| FFun fu when fst f.cff_name = "new" && not stat ->
let init p = (EVars [mk_evar ~t:this_t ("this",null_pos)],p) in
let cast e = (ECast(e,None)),pos e in
let ret p = (EReturn (Some (cast (EConst (Ident "this"),p))),p) in
let meta = (Meta.NoCompletion,[],null_pos) :: f.cff_meta in
if Meta.has Meta.MultiType a.a_meta then begin
if List.mem_assoc AInline f.cff_access then error "MultiType constructors cannot be inline" f.cff_pos;
if fu.f_expr <> None then error "MultiType constructors cannot have a body" f.cff_pos;
f.cff_access <- (AExtern,null_pos) :: f.cff_access;
end;
(try
let _, p = List.find (fun (acc, _) -> acc = AMacro) f.cff_access in
error "Macro abstract constructors are not supported" p
with Not_found -> ());
(* We don't want the generated expression positions to shadow the real code. *)
let p = { p with pmax = p.pmin } in
let fu = {
fu with
f_expr = (match fu.f_expr with
| None -> None
| Some (EBlock el,_) -> Some (EBlock (init p :: el @ [ret p]),p)
| Some e -> Some (EBlock [init p;e;ret p],p)
);
f_type = Some a_t;
} in
{ f with cff_name = "_new",pos f.cff_name; cff_kind = FFun fu; cff_meta = meta }
| FFun fu when not stat ->
if Meta.has Meta.From f.cff_meta then error "@:from cast functions must be static" f.cff_pos;
{ f with cff_kind = FFun fu }
| _ ->
f
let patch_class ctx c fields =
let path = match c.cl_kind with
| KAbstractImpl a -> a.a_path
| _ -> c.cl_path
in
let h = (try Some (Hashtbl.find ctx.g.type_patches path) with Not_found -> None) in
match h with
| None -> fields
| Some (h,hcl) ->
c.cl_meta <- c.cl_meta @ hcl.tp_meta;
let patch_getter t fn =
{ fn with f_type = t }
in
let patch_setter t fn =
match fn.f_args with
| [(name,opt,meta,_,expr)] ->
{ fn with f_args = [(name,opt,meta,t,expr)]; f_type = t }
| _ -> fn
in
let rec loop acc accessor_acc = function
| [] -> acc, accessor_acc
| f :: l ->
(* patch arguments types *)
(match f.cff_kind with
| FFun ff ->
let param (((n,pn),opt,m,_,e) as p) =
try
let t2 = (try Hashtbl.find h (("$" ^ (fst f.cff_name) ^ "__" ^ n),false) with Not_found -> Hashtbl.find h (("$" ^ n),false)) in
(n,pn), opt, m, (match t2.tp_type with None -> None | Some t -> Some (t,null_pos)), e
with Not_found ->
p
in
f.cff_kind <- FFun { ff with f_args = List.map param ff.f_args }
| _ -> ());
(* other patches *)
match (try Some (Hashtbl.find h (fst f.cff_name,List.mem_assoc AStatic f.cff_access)) with Not_found -> None) with
| None -> loop (f :: acc) accessor_acc l
| Some { tp_remove = true } -> loop acc accessor_acc l
| Some p ->
f.cff_meta <- f.cff_meta @ p.tp_meta;
let accessor_acc =
match p.tp_type with
| None -> accessor_acc
| Some t ->
match f.cff_kind with
| FVar (_,e) ->
f.cff_kind <- FVar (Some (t,null_pos),e); accessor_acc
| FProp (get,set,_,eo) ->
let typehint = Some (t,null_pos) in
let accessor_acc = if fst get = "get" then ("get_" ^ fst f.cff_name, patch_getter typehint) :: accessor_acc else accessor_acc in
let accessor_acc = if fst set = "set" then ("set_" ^ fst f.cff_name, patch_setter typehint) :: accessor_acc else accessor_acc in
f.cff_kind <- FProp (get,set,typehint,eo); accessor_acc
| FFun fn ->
f.cff_kind <- FFun { fn with f_type = Some (t,null_pos) }; accessor_acc
in
loop (f :: acc) accessor_acc l
in
let fields, accessor_patches = loop [] [] fields in
List.iter (fun (accessor_name, patch) ->
try
let f_accessor = List.find (fun f -> fst f.cff_name = accessor_name) fields in
match f_accessor.cff_kind with
| FFun fn -> f_accessor.cff_kind <- FFun (patch fn)
| _ -> ()
with Not_found ->
()
) accessor_patches;
List.rev fields
let lazy_display_type ctx f =
(* if ctx.is_display_file then begin
let r = exc_protect ctx (fun r ->
let t = f () in
r := lazy_processing (fun () -> t);
t
) "" in
TLazy r
end else *)
f ()
type enum_abstract_mode =
| EAString
| EAInt of int ref
| EAOther
type enum_constructor_visibility =
| VUnknown
| VPublic of placed_access
| VPrivate of placed_access
let build_enum_abstract ctx c a fields p =
let mode =
if does_unify a.a_this ctx.t.tint then EAInt (ref 0)
else if does_unify a.a_this ctx.t.tstring then EAString
else EAOther
in
List.iter (fun field ->
match field.cff_kind with
| FVar(ct,eo) when not (List.mem_assoc AStatic field.cff_access) ->
let check_visibility_conflict visibility p1 =
match visibility with
| VUnknown ->
()
| VPublic(access,p2) | VPrivate(access,p2) ->
display_error ctx (Printf.sprintf "Conflicting access modifier %s" (Ast.s_access access)) p1;
display_error ctx "Conflicts with this" p2;
in
let rec loop visibility acc = match acc with
| (AExtern,p) :: acc ->
display_error ctx "extern modifier is not allowed on enum abstract fields" p;
loop visibility acc
| (APrivate,p) as access :: acc ->
check_visibility_conflict visibility p;
loop (VPrivate access) acc
| (APublic,p) as access :: acc ->
check_visibility_conflict visibility p;
loop (VPublic access) acc
| _ :: acc ->
loop visibility acc
| [] ->
visibility
in
let visibility = loop VUnknown field.cff_access in
field.cff_access <- [match visibility with VPublic acc | VPrivate acc -> acc | VUnknown -> (APublic,null_pos)];
field.cff_meta <- (Meta.Enum,[],null_pos) :: field.cff_meta;
let ct = match ct with
| Some _ -> ct
| None -> Some (TExprToExpr.convert_type (TAbstract(a,List.map snd a.a_params)),null_pos)
in
let set_field e =
field.cff_access <- (AInline,null_pos) :: field.cff_access;
let e = (ECast(e,None),(pos e)) in
field.cff_kind <- FVar(ct,Some e)
in
begin match eo with
| None ->
if not (has_class_flag c CExtern) then begin match mode with
| EAString ->
set_field (EConst (String (fst field.cff_name,SDoubleQuotes)),null_pos)
| EAInt i ->
set_field (EConst (Int (string_of_int !i)),null_pos);
incr i;
| EAOther ->
error "Value required" field.cff_pos
end else field.cff_kind <- FProp(("default",null_pos),("never",null_pos),ct,None)
| Some e ->
begin match mode,e with
| EAInt i,(EConst(Int s),_) ->
begin try
let i' = int_of_string s in
i := (i' + 1)
with _ ->
()
end
| _ -> ()
end;
set_field e
end
| _ ->
()
) fields;
EVars [mk_evar ~t:(CTAnonymous fields,p) ("",null_pos)],p
let apply_macro ctx mode path el p =
let cpath, meth = (match List.rev (ExtString.String.nsplit path ".") with
| meth :: name :: pack -> (List.rev pack,name), meth
| _ -> error "Invalid macro path" p
) in
ctx.g.do_macro ctx mode cpath meth el p
let build_module_def ctx mt meta fvars context_init fbuild =
let is_typedef = match mt with TTypeDecl _ -> true | _ -> false in
let loop f_build = function
| Meta.Build,args,p when not is_typedef -> (fun () ->
let epath, el = (match args with
| [ECall (epath,el),p] -> epath, el
| _ -> error "Invalid build parameters" p
) in
let s = try String.concat "." (List.rev (string_list_of_expr_path epath)) with Error (_,p) -> error "Build call parameter must be a class path" p in
if ctx.in_macro then error "You cannot use @:build inside a macro : make sure that your type is not used in macro" p;
let old = ctx.get_build_infos in
ctx.get_build_infos <- (fun() -> Some (mt, List.map snd (t_infos mt).mt_params, fvars()));
context_init#run;
let r = try apply_macro ctx MBuild s el p with e -> ctx.get_build_infos <- old; raise e in
ctx.get_build_infos <- old;
(match r with
| None -> error "Build failure" p
| Some e -> fbuild e)
) :: f_build
| Meta.Using,el,p -> (fun () ->
List.iter (fun e ->
try
let path = List.rev (string_pos_list_of_expr_path_raise e) in
let types,filter_classes = handle_using ctx path (pos e) in
let ti =
match mt with
| TClassDecl { cl_kind = KAbstractImpl a } -> t_infos (TAbstractDecl a)
| _ -> t_infos mt
in
ti.mt_using <- (filter_classes types) @ ti.mt_using;
with Exit ->
error "dot path expected" (pos e)
) el;
) :: f_build
| _ ->
f_build
in
(* let errors go through to prevent resume if build fails *)
let f_build = List.fold_left loop [] meta in
(* Go for @:using in parents and interfaces *)
let f_enum = match mt with
| TClassDecl ({cl_kind = KAbstractImpl a} as c) when a.a_enum ->
Some (fun () ->
(* if p <> null_pos && not (Define.is_haxe3_compat ctx.com.defines) then
ctx.com.warning "`@:enum abstract` is deprecated in favor of `enum abstract`" p; *)
context_init#run;
let e = build_enum_abstract ctx c a (fvars()) a.a_name_pos in
fbuild e;
)
| TClassDecl { cl_super = csup; cl_implements = interfaces; cl_kind = kind } ->
let ti = t_infos mt in
let inherit_using (c,_) =
ti.mt_using <- ti.mt_using @ (t_infos (TClassDecl c)).mt_using
in
Option.may inherit_using csup;
List.iter inherit_using interfaces;
None
| _ ->
None
in
List.iter (fun f -> f()) (List.rev f_build);
(match f_enum with None -> () | Some f -> f())
let create_class_context ctx c context_init p =
locate_macro_error := true;
incr stats.s_classes_built;
let abstract = match c.cl_kind with
| KAbstractImpl a -> Some a
| _ -> None
in
let ctx = {
ctx with
curclass = c;
type_params = c.cl_params;
pass = PBuildClass;
tthis = (match abstract with
| Some a ->
(match a.a_this with
| TMono r when r.tm_type = None -> TAbstract (a,List.map snd c.cl_params)
| t -> t)
| None -> TInst (c,List.map snd c.cl_params));
on_error = (fun ctx msg ep ->
ctx.com.error msg ep;
(* macros expressions might reference other code, let's recall which class we are actually compiling *)
let open TFunctions in
if not (ExtString.String.starts_with msg "...") && !locate_macro_error && (is_pos_outside_class c ep) && not (is_module_fields_class c) then ctx.com.error (compl_msg "Defined in this class") c.cl_pos
);
} in
(* a lib type will skip most checks *)
let is_lib = Meta.has Meta.LibType c.cl_meta in
if is_lib && not (has_class_flag c CExtern) then ctx.com.error "@:libType can only be used in extern classes" c.cl_pos;
(* a native type will skip one check: the static vs non-static field *)
let is_native = Meta.has Meta.JavaNative c.cl_meta || Meta.has Meta.CsNative c.cl_meta in
if Meta.has Meta.Macro c.cl_meta then display_error ctx "Macro classes are no longer allowed in haxe 3" c.cl_pos;
let rec extends_public c =
Meta.has Meta.PublicFields c.cl_meta ||
match c.cl_super with
| None -> false
| Some (c,_) -> extends_public c
in
let cctx = {
tclass = c;
is_lib = is_lib;
is_native = is_native;
is_core_api = Meta.has Meta.CoreApi c.cl_meta;
is_class_debug = Meta.has (Meta.Custom ":debug.typeload") c.cl_meta;
extends_public = extends_public c;
abstract = abstract;
context_init = context_init;
force_constructor = false;
uninitialized_final = [];
delayed_expr = [];
has_display_field = false;
} in
ctx,cctx
let create_field_context (ctx,cctx) c cff =
DeprecationCheck.check_is ctx.com (fst cff.cff_name) cff.cff_meta (snd cff.cff_name);
let ctx = {
ctx with
pass = PBuildClass; (* will be set later to PTypeExpr *)
locals = PMap.empty;
opened = [];
monomorphs = {
perfunction = [];
};
} in
let display_modifier = Typeload.check_field_access ctx cff in
let is_static = List.mem_assoc AStatic cff.cff_access in
let is_static,is_abstract_member = if cctx.abstract <> None && not is_static then true,true else is_static,false in
let is_extern = ref (List.mem_assoc AExtern cff.cff_access) in
let is_abstract = List.mem_assoc AAbstract cff.cff_access in
let is_final = ref (List.mem_assoc AFinal cff.cff_access) in
List.iter (fun (m,_,p) ->
match m with
| Meta.Final ->
is_final := true;
(* if p <> null_pos && not (Define.is_haxe3_compat ctx.com.defines) then
ctx.com.warning "`@:final` is deprecated in favor of `final`" p; *)
| Meta.Extern ->
(* if not (Define.is_haxe3_compat ctx.com.defines) then
ctx.com.warning "`@:extern` on fields is deprecated in favor of `extern`" (pos cff.cff_name); *)
is_extern := true;
| _ ->
()
) cff.cff_meta;
let is_inline = List.mem_assoc AInline cff.cff_access in
if (is_abstract && not (has_meta Meta.LibType c.cl_meta)) then begin
if is_static then
display_error ctx "Static methods may not be abstract" (pos cff.cff_name)
else if !is_final then
display_error ctx "Abstract methods may not be final" (pos cff.cff_name)
else if is_inline then
display_error ctx "Abstract methods may not be inline" (pos cff.cff_name)
else if not (has_class_flag c CAbstract) then begin
display_error ctx "This class should be declared abstract because it has at least one abstract field" c.cl_name_pos;
display_error ctx "First abstract field was here" (pos cff.cff_name);
add_class_flag c CAbstract;
end;
end;
let override = try Some (List.assoc AOverride cff.cff_access) with Not_found -> None in
let overload = try Some (List.assoc AOverload cff.cff_access) with Not_found -> None in
let is_macro = List.mem_assoc AMacro cff.cff_access in
let field_kind = match fst cff.cff_name with
| "new" -> FKConstructor
| "__init__" when is_static -> FKInit
| _ -> FKNormal
in
let fctx = {
is_inline = is_inline;
is_static = is_static;
override = override;
overload = overload;
is_macro = is_macro;
is_extern = !is_extern;
is_abstract = is_abstract;
is_final = !is_final;
is_display_field = ctx.is_display_file && DisplayPosition.display_position#enclosed_in cff.cff_pos;
is_field_debug = cctx.is_class_debug || Meta.has (Meta.Custom ":debug.typeload") cff.cff_meta;
display_modifier = display_modifier;
is_abstract_member = is_abstract_member;
is_generic = Meta.has Meta.Generic cff.cff_meta;
field_kind = field_kind;
do_bind = (((not ((has_class_flag c CExtern) || !is_extern) || is_inline) && not is_abstract && not (has_class_flag c CInterface)) || field_kind = FKInit);
do_add = true;
expr_presence_matters = false;
} in
if fctx.is_display_field then cctx.has_display_field <- true;
ctx,fctx
let is_public (ctx,cctx) access parent =
let c = cctx.tclass in
if List.mem_assoc APrivate access then
false
else if List.mem_assoc APublic access then
true
else match parent with
| Some cf -> (has_class_field_flag cf CfPublic)
| _ -> (has_class_flag c CExtern) || (has_class_flag c CInterface) || cctx.extends_public || (match c.cl_kind with KModuleFields _ -> true | _ -> false)
let rec get_parent c name =
match c.cl_super with
| None -> None
| Some (csup,_) ->
try
Some (PMap.find name csup.cl_fields)
with
Not_found -> get_parent csup name
let transform_field (ctx,cctx) c f fields p =
let f = match cctx.abstract with
| Some a ->
let a_t = TExprToExpr.convert_type' (TAbstract(a,List.map snd a.a_params)) in
let this_t = TExprToExpr.convert_type' a.a_this in (* TODO: better pos? *)
transform_abstract_field ctx.com this_t a_t a f
| None ->
f
in
if List.mem_assoc AMacro f.cff_access then
(match ctx.g.macros with
| Some (_,mctx) when Hashtbl.mem mctx.g.types_module c.cl_path ->
(* assume that if we had already a macro with the same name, it has not been changed during the @:build operation *)
if not (List.exists (fun f2 -> f2.cff_name = f.cff_name && List.mem_assoc AMacro f2.cff_access) (!fields)) then
error "Class build macro cannot return a macro function when the class has already been compiled into the macro context" p
| _ -> ());
f
let type_var_field ctx t e stat do_display p =
if stat then ctx.curfun <- FunStatic else ctx.curfun <- FunMember;
let e = if do_display then Display.ExprPreprocessing.process_expr ctx.com e else e in
let e = type_expr ctx e (WithType.with_type t) in
let e = AbstractCast.cast_or_unify ctx t e p in
match t with
| TType ({ t_path = ([],"UInt") },[]) | TAbstract ({ a_path = ([],"UInt") },[]) when stat -> { e with etype = t }
| _ -> e
let type_var_field ctx t e stat do_display p =
let save = TypeloadFunction.save_field_state ctx in
Std.finally save (type_var_field ctx t e stat do_display) p
let build_fields (ctx,cctx) c fields =
let fields = ref fields in
let get_fields() = !fields in
let pending = ref [] in
c.cl_build <- (fun() -> BuildMacro pending);
build_module_def ctx (TClassDecl c) c.cl_meta get_fields cctx.context_init (fun (e,p) ->
match e with
| EVars [{ ev_type = Some (CTAnonymous f,p); ev_expr = None }] ->
let f = List.map (fun f -> transform_field (ctx,cctx) c f fields p) f in
fields := f
| _ -> error "Class build macro must return a single variable with anonymous fields" p
);
c.cl_build <- (fun() -> Building [c]);
List.iter (fun f -> f()) !pending;
!fields
let check_field_display ctx fctx c cf =
if fctx.is_display_field then begin
let scope, cf = match c.cl_kind with
| KAbstractImpl _ ->
if has_class_field_flag cf CfImpl then
(if cf.cf_name = "_new" then
CFSConstructor, {cf with cf_name = "new"}
else
CFSMember, cf)
else
CFSStatic, cf;
| _ ->
(if fctx.is_static then
CFSStatic
else if fctx.field_kind = FKConstructor then
CFSConstructor
else
CFSMember), cf;
in
let origin = match c.cl_kind with
| KAbstractImpl a -> Self (TAbstractDecl a)
| _ -> Self (TClassDecl c)
in
DisplayEmitter.maybe_display_field ctx origin scope cf cf.cf_name_pos;
DisplayEmitter.check_field_modifiers ctx c cf fctx.override fctx.display_modifier;
end
module TypeBinding = struct
let bind_type ctx cctx fctx cf r p =
let c = cctx.tclass in
let rec is_full_type t =
match t with
| TFun (args,ret) -> is_full_type ret && List.for_all (fun (_,_,t) -> is_full_type t) args
| TMono r -> (match r.tm_type with None -> false | Some t -> is_full_type t)
| TAbstract _ | TInst _ | TEnum _ | TLazy _ | TDynamic _ | TAnon _ | TType _ -> true
in
let force_macro () =
(* force macro system loading of this class in order to get completion *)
delay ctx PTypeField (fun() -> try ignore(ctx.g.do_macro ctx MDisplay c.cl_path cf.cf_name [] p) with Exit | Error _ -> ())
in
let handle_display_field () =
if fctx.is_macro && not ctx.in_macro then
force_macro()
else begin
cf.cf_type <- TLazy r;
cctx.delayed_expr <- (ctx,Some r) :: cctx.delayed_expr;
end
in
if ctx.com.display.dms_full_typing then begin
if fctx.is_macro && not ctx.in_macro then
force_macro ()
else begin
cf.cf_type <- TLazy r;
(* is_lib ? *)
cctx.delayed_expr <- (ctx,Some r) :: cctx.delayed_expr;
end
end else if ctx.com.display.dms_force_macro_typing && fctx.is_macro && not ctx.in_macro then
force_macro()
else begin
if fctx.is_display_field then begin
handle_display_field()
end else begin
if not (is_full_type cf.cf_type) then begin
cctx.delayed_expr <- (ctx, None) :: cctx.delayed_expr;
cf.cf_type <- TLazy r;
end else if fctx.expr_presence_matters then
cf.cf_expr <- Some (mk (TConst TNull) t_dynamic null_pos)
end
end
let check_redefinition ctx cctx fctx cf =
let c = cctx.tclass in
let rec get_declared f = function
| None -> None
| Some (c,a) when PMap.exists f c.cl_fields ->
Some (c,a)
| Some (c,_) ->
let ret = get_declared f c.cl_super in
match ret with
| Some r -> Some r
| None ->
let rec loop ifaces = match ifaces with
| [] -> None
| i :: ifaces -> match get_declared f (Some i) with
| Some r -> Some r
| None -> loop ifaces
in
loop c.cl_implements
in
if not fctx.is_static && not cctx.is_lib then begin match get_declared cf.cf_name c.cl_super with
| None -> ()
| Some (csup,_) ->
(* this can happen on -net-lib generated classes if a combination of explicit interfaces and variables with the same name happens *)
if not ((has_class_flag csup CInterface) && Meta.has Meta.CsNative c.cl_meta) then
error ("Redefinition of variable " ^ cf.cf_name ^ " in subclass is not allowed. Previously declared at " ^ (s_type_path csup.cl_path) ) cf.cf_name_pos
end
let bind_var_expression ctx cctx fctx cf e =
let c = cctx.tclass in
let t = cf.cf_type in
let p = cf.cf_pos in
if (has_class_flag c CInterface) then display_error ctx "Default values on interfaces are not allowed" (pos e);
cf.cf_meta <- ((Meta.Value,[e],null_pos) :: cf.cf_meta);
let check_cast e =
(* insert cast to keep explicit field type (issue #1901) *)
if type_iseq e.etype cf.cf_type then
e
else begin match e.eexpr,follow cf.cf_type with
| TConst (TInt i),TAbstract({a_path=[],"Float"},_) ->
(* turn int constant to float constant if expected type is float *)
{e with eexpr = TConst (TFloat (Int32.to_string i)); etype = cf.cf_type}
| _ ->
mk_cast e cf.cf_type e.epos
end
in
let r = exc_protect ~force:false ctx (fun r ->
(* type constant init fields (issue #1956) *)
if not !return_partial_type || (match fst e with EConst _ -> true | _ -> false) then begin
r := lazy_processing (fun() -> t);
cctx.context_init#run;
if ctx.com.verbose then Common.log ctx.com ("Typing " ^ (if ctx.in_macro then "macro " else "") ^ s_type_path c.cl_path ^ "." ^ cf.cf_name);
let e = type_var_field ctx t e fctx.is_static fctx.is_display_field p in
let maybe_run_analyzer e = match e.eexpr with
| TConst _ | TLocal _ | TFunction _ -> e
| _ -> !analyzer_run_on_expr_ref ctx.com e
in
let require_constant_expression e msg =
if ctx.com.display.dms_kind <> DMNone && ctx.com.display.dms_error_policy <> EPCollect then
e
else match Optimizer.make_constant_expression ctx (maybe_run_analyzer e) with
| Some e -> e
| None -> display_error ctx msg p; e
in
let e = (match cf.cf_kind with
| Var v when (has_class_flag c CExtern) || fctx.is_extern ->
if not fctx.is_static then begin
display_error ctx "Extern non-static variables may not be initialized" p;
e
end else if not fctx.is_inline then begin
display_error ctx "Extern non-inline variables may not be initialized" p;
e
end else require_constant_expression e "Extern variable initialization must be a constant value"
| Var v when not (is_physical_field cf) ->
(* disallow initialization of non-physical fields (issue #1958) *)
display_error ctx "This field cannot be initialized because it is not a real variable" p; e
| Var v when not fctx.is_static ->
let e = if ctx.com.display.dms_display && ctx.com.display.dms_error_policy <> EPCollect then
e
else begin
let e = Optimizer.reduce_loop ctx (maybe_run_analyzer e) in
let e = (match Optimizer.make_constant_expression ctx e with
| Some e -> e
| None -> e
) in
let rec check_this e = match e.eexpr with
| TConst TThis ->
display_error ctx "Cannot access this or other member field in variable initialization" e.epos;
raise Exit
| TLocal v when (match ctx.vthis with Some v2 -> v == v2 | None -> false) ->
display_error ctx "Cannot access this or other member field in variable initialization" e.epos;
raise Exit
| _ ->
Type.iter check_this e
in
(try check_this e with Exit -> ());
e
end in
e
| Var v when v.v_read = AccInline ->
let e = require_constant_expression e "Inline variable initialization must be a constant value" in
begin match c.cl_kind with
| KAbstractImpl a when has_class_field_flag cf CfEnum && a.a_enum ->
unify ctx t (TAbstract(a,(Monomorph.spawn_constrained_monos (fun t -> t) a.a_params))) p;
let e1 = match e.eexpr with TCast(e1,None) -> e1 | _ -> e in
unify ctx e1.etype a.a_this e1.epos
| _ ->
()
end;
e
| _ ->
e
) in
let e = check_cast e in
cf.cf_expr <- Some e;
cf.cf_type <- t;
check_field_display ctx fctx c cf;
end;
t
) "bind_var" in
if not fctx.is_static then cctx.force_constructor <- true;
bind_type ctx cctx fctx cf r (snd e)
let bind_var ctx cctx fctx cf e =
let c = cctx.tclass in
check_redefinition ctx cctx fctx cf;
match e with
| None ->
check_field_display ctx fctx c cf;
| Some e ->
bind_var_expression ctx cctx fctx cf e
let bind_method ctx cctx fctx cf t args ret e p =
let c = cctx.tclass in
let bind r =
r := lazy_processing (fun() -> t);
cctx.context_init#run;
incr stats.s_methods_typed;
if ctx.com.verbose then Common.log ctx.com ("Typing " ^ (if ctx.in_macro then "macro " else "") ^ s_type_path c.cl_path ^ "." ^ cf.cf_name);
let fmode = (match cctx.abstract with
| Some _ ->
if fctx.is_abstract_member then FunMemberAbstract else FunStatic
| None ->
if fctx.field_kind = FKConstructor then FunConstructor else if fctx.is_static then FunStatic else FunMember
) in
begin match ctx.com.platform with
| Java when is_java_native_function ctx cf.cf_meta cf.cf_pos ->
if e <> None then
ctx.com.warning "@:java.native function definitions shouldn't include an expression. This behaviour is deprecated." cf.cf_pos;
cf.cf_expr <- None;
cf.cf_type <- t
| _ ->
if Meta.has Meta.DisplayOverride cf.cf_meta then DisplayEmitter.check_field_modifiers ctx c cf fctx.override fctx.display_modifier;
let e = TypeloadFunction.type_function ctx args ret fmode e fctx.is_display_field p in
begin match fctx.field_kind with
| FKNormal when not fctx.is_static -> TypeloadCheck.check_overriding ctx c cf
| _ -> ()
end;
(* Disabled for now, see https://github.com/HaxeFoundation/haxe/issues/3033 *)
(* List.iter (fun (v,_) ->
if v.v_name <> "_" && has_mono v.v_type then ctx.com.warning "Uninferred function argument, please add a type-hint" v.v_pos;
) fargs; *)
let tf = {
tf_args = args#for_expr;
tf_type = ret;
tf_expr = e;
} in
if fctx.field_kind = FKInit then
(match e.eexpr with
| TBlock [] | TBlock [{ eexpr = TConst _ }] | TConst _ | TObjectDecl [] -> ()
| _ -> c.cl_init <- Some e);
cf.cf_expr <- Some (mk (TFunction tf) t p);
cf.cf_type <- t;
check_field_display ctx fctx c cf;
end;
in
let maybe_bind r =
if not !return_partial_type then bind r;
t
in
let r = exc_protect ~force:false ctx maybe_bind "type_fun" in
bind_type ctx cctx fctx cf r p
end
let create_variable (ctx,cctx,fctx) c f t eo p =
let is_abstract_enum_field = Meta.has Meta.Enum f.cff_meta in
if fctx.is_abstract_member && not is_abstract_enum_field then error (fst f.cff_name ^ ": Cannot declare member variable in abstract") p;
if fctx.is_inline && not fctx.is_static then error (fst f.cff_name ^ ": Inline variable must be static") p;
if fctx.is_inline && eo = None then error (fst f.cff_name ^ ": Inline variable must be initialized") p;
let missing_initialization =
fctx.is_final
&& not (fctx.is_extern || (has_class_flag c CExtern) || (has_class_flag c CInterface))
&& eo = None
in
if missing_initialization && fctx.is_static && fctx.is_final then
error (fst f.cff_name ^ ": Static final variable must be initialized") p;
let t = (match t with
| None when eo = None ->
error ("Variable requires type-hint or initialization") (pos f.cff_name);
| None ->
mk_mono()
| Some t ->
lazy_display_type ctx (fun () -> load_type_hint ctx p (Some t))
) in
let kind = if fctx.is_inline then
{ v_read = AccInline ; v_write = AccNever }
else if fctx.is_final then
{ v_read = AccNormal ; v_write = if fctx.is_static then AccNever else AccCtor }
else
{ v_read = AccNormal ; v_write = AccNormal }
in
let cf = {
(mk_field (fst f.cff_name) ~public:(is_public (ctx,cctx) f.cff_access None) t f.cff_pos (pos f.cff_name)) with
cf_doc = f.cff_doc;
cf_meta = f.cff_meta;
cf_kind = Var kind;
} in
if fctx.is_final then begin
if missing_initialization && not fctx.is_static then
cctx.uninitialized_final <- cf :: cctx.uninitialized_final;
add_class_field_flag cf CfFinal;
end;
if fctx.is_extern then add_class_field_flag cf CfExtern;
if fctx.is_abstract_member then begin
cf.cf_meta <- ((Meta.Custom ":impl"),[],null_pos) :: cf.cf_meta;
add_class_field_flag cf CfImpl;
end;
if is_abstract_enum_field then add_class_field_flag cf CfEnum;
ctx.curfield <- cf;