« back to all changes in this revision
Viewing changes to haxe/typer.ml
- browse files at revision 7
- compare with another revision
- download diff
- download tarball
- view history from revision 7
- Committer: Bazaar Package Importer
- Author(s): Jens Peter Secher
- Date: 2009-08-03 21:29:45 UTC
- mfrom: (5.1.1 squeeze)
- Revision ID: james.westby@ubuntu.com-20090803212945-hy4s0okm36gtqzz5
Tags: 1:2.4-1
* New upstream version (CVS 2009-08-01).
* Removed obsolete parts of the copyright file now that ExtLib is
not included anymore.
* Included patch for Ubuntu location of zlib, thanks to Alessio Treglia.
(Closes: #533159)
* Removed haxe-mode to get it into its own package.
(Closes: #521222)
* Included new commands in bash_completion.
* Removed obsolete Lintian overrides.
* Bumped Standards-Version to 3.8.2, no change.
* Removed obsolete parts of the copyright file now that ExtLib is
not included anymore.
* Included patch for Ubuntu location of zlib, thanks to Alessio Treglia.
(Closes: #533159)
* Removed haxe-mode to get it into its own package.
(Closes: #521222)
* Included new commands in bash_completion.
* Removed obsolete Lintian overrides.
* Bumped Standards-Version to 3.8.2, no change.
- files added:
- haxe/std/php/IteratorAggregate.hx
- files removed:
- debian/emacsen-install
- files modified:
- debian/bash_completion
added
removed
haxe/typer.ml
28
28
| CMatch of (tenum_field * (string option * t) list option)
29
29
| CExpr of texpr
30
30
31
type access_mode =
32
| MGet
33
| MSet
34
| MCall
35
31
36
exception Display of t
32
37
33
38
type access_kind =
35
40
| AccExpr of texpr
36
41
| AccSet of texpr * string * t * string
37
42
| AccInline of texpr * tclass_field * t
43
| AccUsing of texpr * texpr
38
44
39
45
let mk_infos ctx p params =
40
46
(EObjectDecl (
89
95
| TDynamic _ -> KDyn
90
96
| _ -> KOther
91
97
98
let type_field_rec = ref (fun _ _ _ _ _ -> assert false)
99
92
100
(* ---------------------------------------------------------------------- *)
93
101
(* PASS 3 : type expression & check structure *)
94
102
114
122
let argstr = "Function " ^ (match name with None -> "" | Some n -> "'" ^ n ^ "' ") ^ "requires " ^ (if args = [] then "no arguments" else "arguments : " ^ String.concat ", " (List.map format_arg args)) in
115
123
display_error ctx (txt ^ " arguments\n" ^ argstr) p
116
124
in
117
let arg_error ul name opt =
125
let arg_error ul name opt p =
118
126
raise (Error (Stack (Unify ul,Custom ("For " ^ (if opt then "optional " else "") ^ "function argument '" ^ name ^ "'")), p))
119
127
in
120
128
let rec no_opt = function
159
167
| _ , [] ->
160
168
(match List.rev skip with
161
169
| [] -> error "Too many"
162
| [name,ul] -> arg_error ul name true
170
| [name,ul] -> arg_error ul name true p
163
171
| _ -> error "Invalid");
164
172
[]
165
173
| ee :: l, (name,opt,t) :: l2 ->
171
179
Error (Unify ul,_) ->
172
180
if opt then
173
181
loop (default_value t :: acc) (ee :: l) l2 ((name,ul) :: skip)
174
else
175
arg_error ul name false
182
else
183
arg_error ul name false e.epos
176
184
in
177
185
loop [] el args []
178
186
182
190
let i = (try PMap.find i ctx.locals_map with Not_found -> i) in
183
191
mk (TLocal i) t p
184
192
185
let type_type ctx tpath p =
186
let rec loop t tparams =
193
let rec type_module_type ctx t tparams p =
187
194
match t with
188
195
| TClassDecl c ->
189
196
let t_tmp = {
197
204
t_private = true;
198
205
t_types = [];
199
206
} in
200
mk (TTypeExpr (TClassDecl c)) (TType (t_tmp,[])) p
207
let e = mk (TTypeExpr (TClassDecl c)) (TType (t_tmp,[])) p in
208
check_locals_masking ctx e;
209
e
201
210
| TEnumDecl e ->
202
211
let types = (match tparams with None -> List.map (fun _ -> mk_mono()) e.e_types | Some l -> l) in
203
212
let fl = PMap.fold (fun f acc ->
206
215
cf_public = true;
207
216
cf_type = f.ef_type;
208
217
cf_get = NormalAccess;
209
cf_set = NoAccess;
218
cf_set = (match follow f.ef_type with TFun _ -> MethodAccess false | _ -> NoAccess);
210
219
cf_doc = None;
211
220
cf_expr = None;
212
221
cf_params = [];
223
232
t_private = true;
224
233
t_types = e.e_types;
225
234
} in
226
mk (TTypeExpr (TEnumDecl e)) (TType (t_tmp,types)) p
235
let e = mk (TTypeExpr (TEnumDecl e)) (TType (t_tmp,types)) p in
236
check_locals_masking ctx e;
237
e
227
238
| TTypeDecl s ->
228
239
let t = apply_params s.t_types (List.map (fun _ -> mk_mono()) s.t_types) s.t_type in
229
240
match follow t with
230
241
| TEnum (e,params) ->
231
loop (TEnumDecl e) (Some params)
242
type_module_type ctx (TEnumDecl e) (Some params) p
232
243
| TInst (c,params) ->
233
loop (TClassDecl c) (Some params)
244
type_module_type ctx (TClassDecl c) (Some params) p
234
245
| _ ->
235
error (s_type_path tpath ^ " is not a value") p
236
in
237
let e = loop (Typeload.load_type_def ctx p tpath) None in
238
check_locals_masking ctx e;
239
e
246
error (s_type_path s.t_path ^ " is not a value") p
247
248
let type_type ctx tpath p =
249
type_module_type ctx (Typeload.load_type_def ctx p tpath) None p
240
250
241
251
let get_constructor c p =
242
252
let rec loop c =
254
264
with Not_found ->
255
265
error (s_type_path c.cl_path ^ " does not have a constructor") p
256
266
257
let acc_get g p =
267
let make_call ctx e params t p =
268
try
269
if not ctx.doinline then raise Exit;
270
let ethis, fname = (match e.eexpr with TField (ethis,fname) -> ethis, fname | _ -> raise Exit) in
271
let f = (match follow ethis.etype with
272
| TInst (c,params) -> snd (try class_field c fname with Not_found -> raise Exit)
273
| TAnon a -> (try PMap.find fname a.a_fields with Not_found -> raise Exit)
274
| _ -> raise Exit
275
) in
276
if f.cf_get <> InlineAccess then raise Exit;
277
ignore(follow f.cf_type); (* force evaluation *)
278
(match f.cf_expr with
279
| Some { eexpr = TFunction fd } ->
280
(match Optimizer.type_inline ctx f fd ethis params t p with
281
| None -> raise Exit
282
| Some e -> e)
283
| _ ->
284
error "Recursive inline is not supported" p)
285
with Exit ->
286
mk (TCall (e,params)) t p
287
288
let rec acc_get ctx g p =
258
289
match g with
259
290
| AccNo f -> error ("Field " ^ f ^ " cannot be accessed for reading") p
260
291
| AccExpr e -> e
261
292
| AccSet _ -> assert false
293
| AccUsing (et,e) ->
294
(* build a closure with first parameter applied *)
295
(match follow et.etype with
296
| TFun (_ :: args,ret) ->
297
let tcallb = TFun (args,ret) in
298
let twrap = TFun ([("_e",false,e.etype)],tcallb) in
299
let ecall = make_call ctx et (List.map (fun (n,_,t) -> mk (TLocal n) t p) (("_e",false,e.etype) :: args)) ret p in
300
let ecallb = mk (TFunction {
301
tf_args = List.map (fun (n,_,t) -> n,None,t) args;
302
tf_type = ret;
303
tf_expr = mk (TReturn (Some ecall)) t_dynamic p;
304
}) tcallb p in
305
let ewrap = mk (TFunction {
306
tf_args = [("_e",None,e.etype)];
307
tf_type = tcallb;
308
tf_expr = mk (TReturn (Some ecallb)) t_dynamic p;
309
}) twrap p in
310
make_call ctx ewrap [e] tcallb p
311
| _ -> assert false)
262
312
| AccInline (e,f,t) ->
263
313
ignore(follow f.cf_type); (* force computing *)
264
314
match f.cf_expr with
265
315
| None -> error "Recursive inline is not supported" p
266
| Some { eexpr = TFunction _ } -> mk (TField (e,f.cf_name)) t p
316
| Some { eexpr = TFunction _ } -> mk (TClosure (e,f.cf_name)) t p
267
317
| Some e ->
268
318
let rec loop e = Type.map_expr loop { e with epos = p } in
269
319
loop e
270
320
271
let field_access ctx get f t e p =
272
match if get then f.cf_get else f.cf_set with
321
let field_access ctx mode f t e p =
322
match (match mode with MGet | MCall -> f.cf_get | MSet -> f.cf_set) with
273
323
| NoAccess ->
274
324
let normal = AccExpr (mk (TField (e,f.cf_name)) t p) in
275
325
(match follow e.etype with
280
330
| _ -> if ctx.untyped then normal else AccNo f.cf_name)
281
331
| _ ->
282
332
if ctx.untyped then normal else AccNo f.cf_name)
283
| MethodCantAccess when not ctx.untyped ->
333
| MethodAccess false when not ctx.untyped ->
284
334
error "Cannot rebind this method : please use 'dynamic' before method declaration" p
285
| NormalAccess | MethodCantAccess ->
286
AccExpr (mk (TField (e,f.cf_name)) t p)
287
| MethodAccess m ->
335
| NormalAccess | MethodAccess _ ->
336
(*
337
creates a closure if we're reading a normal method
338
or a read-only variable (which could be a method)
339
*)
340
(match mode, f.cf_set with
341
| MGet, MethodAccess _ -> AccExpr (mk (TClosure (e,f.cf_name)) t p)
342
| MGet, NoAccess | MGet, NeverAccess when (match follow t with TFun _ -> true | _ -> false) -> AccExpr (mk (TClosure (e,f.cf_name)) t p)
343
| _ -> AccExpr (mk (TField (e,f.cf_name)) t p))
344
| CallAccess m ->
288
345
if m = ctx.curmethod && (match e.eexpr with TConst TThis -> true | TTypeExpr (TClassDecl c) when c == ctx.curclass -> true | _ -> false) then
289
let prefix = if Common.defined ctx.com "as3gen" then "$" else "" in
346
let prefix = if Common.defined ctx.com "as3" then "$" else "" in
290
347
AccExpr (mk (TField (e,prefix ^ f.cf_name)) t p)
291
else if get then
292
AccExpr (mk (TCall (mk (TField (e,m)) (tfun [] t) p,[])) t p)
293
else
348
else if mode = MSet then
294
349
AccSet (e,m,t,f.cf_name)
350
else
351
AccExpr (make_call ctx (mk (TField (e,m)) (tfun [] t) p) [] t p)
295
352
| ResolveAccess ->
296
353
let fstring = mk (TConst (TString f.cf_name)) ctx.api.tstring p in
297
354
let tresolve = tfun [ctx.api.tstring] t in
298
AccExpr (mk (TCall (mk (TField (e,"resolve")) tresolve p,[fstring])) t p)
355
AccExpr (make_call ctx (mk (TField (e,"resolve")) tresolve p) [fstring] t p)
299
356
| NeverAccess ->
300
357
AccNo f.cf_name
301
358
| InlineAccess ->
302
359
AccInline (e,f,t)
303
360
304
let type_ident ctx i is_type p get =
361
let type_ident ctx i is_type p mode =
305
362
match i with
306
363
| "true" ->
307
if get then
364
if mode = MGet then
308
365
AccExpr (mk (TConst (TBool true)) ctx.api.tbool p)
309
366
else
310
367
AccNo i
311
368
| "false" ->
312
if get then
369
if mode = MGet then
313
370
AccExpr (mk (TConst (TBool false)) ctx.api.tbool p)
314
371
else
315
372
AccNo i
316
373
| "this" ->
317
374
if not ctx.untyped && ctx.in_static then error "Cannot access this from a static function" p;
318
if get then
375
if mode = MGet then
319
376
AccExpr (mk (TConst TThis) ctx.tthis p)
320
377
else
321
378
AccNo i
322
379
| "super" ->
323
if not ctx.super_call then
324
AccNo i
325
else
326
380
let t = (match ctx.curclass.cl_super with
327
| None -> error "Current class does not have a superclass" p
328
| Some (c,params) -> TInst(c,params)
381
| None -> error "Current class does not have a superclass" p
382
| Some (c,params) -> TInst(c,params)
329
383
) in
330
384
if ctx.in_static then error "Cannot access super from a static function" p;
331
ctx.super_call <- false;
332
if get then
385
if mode = MSet || not ctx.super_call then
386
AccNo i
387
else begin
388
ctx.super_call <- false;
333
389
AccExpr (mk (TConst TSuper) t p)
334
else
335
AccNo i
390
end
336
391
| "null" ->
337
if get then
392
if mode = MGet then
338
393
AccExpr (null (mk_mono()) p)
339
394
else
340
395
AccNo i
341
396
| "here" ->
342
397
let infos = mk_infos ctx p [] in
343
398
let e = type_expr ctx infos true in
344
if get then
399
if mode = MGet then
345
400
AccExpr { e with etype = Typeload.load_normal_type ctx { tpackage = ["haxe"]; tname = "PosInfos"; tparams = [] } p false }
346
401
else
347
402
AccNo i
353
408
(* member variable lookup *)
354
409
if ctx.in_static then raise Not_found;
355
410
let t , f = class_field ctx.curclass i in
356
field_access ctx get f t (mk (TConst TThis) ctx.tthis p) p
411
field_access ctx mode f t (mk (TConst TThis) ctx.tthis p) p
357
412
with Not_found -> try
358
413
(* static variable lookup *)
359
414
let f = PMap.find i ctx.curclass.cl_statics in
360
415
let e = type_type ctx ctx.curclass.cl_path p in
361
field_access ctx get f (field_type f) e p
416
field_access ctx mode f (field_type f) e p
362
417
with Not_found -> try
363
418
(* lookup imported *)
364
419
let rec loop l =
377
432
in
378
433
let e = loop ctx.local_types in
379
434
check_locals_masking ctx e;
380
if get then
435
if mode = MSet then
436
AccNo i
437
else
381
438
AccExpr e
382
else
383
AccNo i
384
439
with Not_found -> try
385
440
(* lookup type *)
386
441
if not is_type then raise Not_found;
437
492
| _ ->
438
493
invalid()
439
494
440
let type_field ctx e i p get =
495
let rec type_field ctx e i p mode =
496
let using_field() =
497
if mode = MSet then raise Not_found;
498
let rec loop = function
499
| [] ->
500
raise Not_found
501
| TEnumDecl _ :: l | TTypeDecl _ :: l ->
502
loop l
503
| TClassDecl c :: l ->
504
try
505
let f = PMap.find i c.cl_statics in
506
let t = field_type f in
507
(match follow t with
508
| TFun ((_,_,t0) :: args,r) ->
509
(try unify_raise ctx e.etype t0 p with Error (Unify _,_) -> raise Not_found);
510
let et = type_module_type ctx (TClassDecl c) None p in
511
AccUsing (mk (TField (et,i)) t p,e)
512
| _ -> raise Not_found)
513
with Not_found ->
514
loop l
515
in
516
loop ctx.local_using
517
in
441
518
let no_field() =
442
519
if not ctx.untyped then display_error ctx (s_type (print_context()) e.etype ^ " has no field " ^ i) p;
443
520
AccExpr (mk (TField (e,i)) (mk_mono()) p)
448
525
match c.cl_dynamic with
449
526
| Some t ->
450
527
let t = apply_params c.cl_types params t in
451
if get && PMap.mem "resolve" c.cl_fields then
452
AccExpr (mk (TCall (mk (TField (e,"resolve")) (tfun [ctx.api.tstring] t) p,[Typeload.type_constant ctx (String i) p])) t p)
528
if mode = MGet && PMap.mem "resolve" c.cl_fields then
529
AccExpr (make_call ctx (mk (TField (e,"resolve")) (tfun [ctx.api.tstring] t) p) [Typeload.type_constant ctx (String i) p] t p)
453
530
else
454
531
AccExpr (mk (TField (e,i)) t p)
455
532
| None ->
461
538
let t , f = class_field c i in
462
539
if e.eexpr = TConst TSuper && f.cf_set = NormalAccess && Common.platform ctx.com Flash9 then error "Cannot access superclass variable for calling : needs to be a proper method" p;
463
540
if not f.cf_public && not (is_parent c ctx.curclass) && not ctx.untyped then display_error ctx ("Cannot access to private field " ^ i) p;
464
field_access ctx get f (apply_params c.cl_types params t) e p
541
field_access ctx mode f (apply_params c.cl_types params t) e p
542
with Not_found -> try
543
using_field()
465
544
with Not_found -> try
466
545
loop_dyn c params
467
546
with Not_found ->
478
557
| Statics c when is_parent c ctx.curclass -> ()
479
558
| _ -> display_error ctx ("Cannot access to private field " ^ i) p
480
559
end;
481
field_access ctx get f (field_type f) e p
560
field_access ctx mode f (field_type f) e p
482
561
with Not_found ->
483
if is_closed a then
562
if is_closed a then try
563
using_field()
564
with Not_found ->
484
565
no_field()
485
566
else
486
567
let f = {
489
570
cf_doc = None;
490
571
cf_public = true;
491
572
cf_get = NormalAccess;
492
cf_set = if get then NoAccess else NormalAccess;
573
cf_set = (match mode with MSet -> NormalAccess | MGet | MCall -> NoAccess);
493
574
cf_expr = None;
494
575
cf_params = [];
495
576
} in
496
577
a.a_fields <- PMap.add i f a.a_fields;
497
field_access ctx get f (field_type f) e p
578
field_access ctx mode f (field_type f) e p
498
579
)
499
580
| TMono r ->
500
581
if ctx.untyped && Common.defined ctx.com "swf-mark" && Common.defined ctx.com "flash" then ctx.com.warning "Mark" p;
504
585
cf_doc = None;
505
586
cf_public = true;
506
587
cf_get = NormalAccess;
507
cf_set = if get then NoAccess else NormalAccess;
588
cf_set = (match mode with MSet -> NormalAccess | MGet | MCall -> NoAccess);
508
589
cf_expr = None;
509
590
cf_params = [];
510
591
} in
512
593
let t = TAnon { a_fields = PMap.add i f PMap.empty; a_status = x } in
513
594
ctx.opened <- x :: ctx.opened;
514
595
r := Some t;
515
field_access ctx get f (field_type f) e p
596
field_access ctx mode f (field_type f) e p
516
597
| t ->
517
no_field()
598
try using_field() with Not_found -> no_field()
518
599
519
600
(*
520
601
We want to try unifying as an integer and apply side effects.
563
644
let rec type_binop ctx op e1 e2 p =
564
645
match op with
565
646
| OpAssign ->
566
let e1 = type_access ctx (fst e1) (snd e1) false in
567
let e2 = type_expr_with_type ctx e2 (match e1 with AccNo _ | AccInline _ -> None | AccExpr e | AccSet(e,_,_,_) -> Some e.etype) in
647
let e1 = type_access ctx (fst e1) (snd e1) MSet in
648
let e2 = type_expr_with_type ctx e2 (match e1 with AccNo _ | AccInline _ | AccUsing _ -> None | AccExpr e | AccSet(e,_,_,_) -> Some e.etype) in
568
649
(match e1 with
569
650
| AccNo s -> error ("Cannot access field or identifier " ^ s ^ " for writing") p
570
651
| AccExpr e1 ->
578
659
mk (TBinop (op,e1,e2)) e1.etype p
579
660
| AccSet (e,m,t,_) ->
580
661
unify ctx e2.etype t p;
581
mk (TCall (mk (TField (e,m)) (tfun [t] t) p,[e2])) t p
582
| AccInline _ ->
662
make_call ctx (mk (TField (e,m)) (tfun [t] t) p) [e2] t p
663
| AccInline _ | AccUsing _ ->
583
664
assert false)
584
665
| OpAssignOp op ->
585
(match type_access ctx (fst e1) (snd e1) false with
666
(match type_access ctx (fst e1) (snd e1) MSet with
586
667
| AccNo s -> error ("Cannot access field or identifier " ^ s ^ " for writing") p
587
668
| AccExpr e ->
588
669
let eop = type_binop ctx op e1 e2 p in
589
670
(match eop.eexpr with
590
671
| TBinop (_,_,e2) ->
591
unify ctx e2.etype e.etype p;
672
unify ctx eop.etype e.etype p;
592
673
check_assign ctx e;
593
674
mk (TBinop (OpAssignOp op,e,e2)) e.etype p;
594
675
| _ ->
602
683
l();
603
684
mk (TBlock [
604
685
mk (TVars [v,e.etype,Some e]) ctx.api.tvoid p;
605
mk (TCall (mk (TField (ev,m)) (tfun [t] t) p,[get])) t p
686
make_call ctx (mk (TField (ev,m)) (tfun [t] t) p) [get] t p
606
687
]) t p
607
| AccInline _ ->
688
| AccInline _ | AccUsing _ ->
608
689
assert false)
609
690
| _ ->
610
691
let e1 = type_expr ctx e1 in
748
829
749
830
and type_unop ctx op flag e p =
750
831
let set = (op = Increment || op = Decrement) in
751
let acc = type_access ctx (fst e) (snd e) (not set) in
832
let acc = type_access ctx (fst e) (snd e) (if set then MSet else MGet) in
752
833
let access e =
753
834
let t = (match op with
754
835
| Not ->
773
854
in
774
855
match acc with
775
856
| AccExpr e -> access e
776
| AccInline _ when not set -> access (acc_get acc p)
857
| AccInline _ | AccUsing _ when not set -> access (acc_get ctx acc p)
777
858
| AccNo s ->
778
859
error ("The field or identifier " ^ s ^ " is not accessible for " ^ (if set then "writing" else "reading")) p
779
| AccInline _ ->
860
| AccInline _ | AccUsing _ ->
780
861
error "This kind of operation is not supported" p
781
862
| AccSet (e,m,t,f) ->
782
863
let l = save_locals ctx in
792
873
l();
793
874
mk (TBlock [
794
875
mk (TVars [v,e.etype,Some e]) ctx.api.tvoid p;
795
mk (TCall (mk (TField (ev,m)) (tfun [t] t) p,[get])) t p
876
make_call ctx (mk (TField (ev,m)) (tfun [t] t) p) [get] t p
796
877
]) t p
797
878
| Postfix ->
798
879
let v2 = gen_local ctx t in
803
884
l();
804
885
mk (TBlock [
805
886
mk (TVars [v,e.etype,Some e; v2,t,Some get]) ctx.api.tvoid p;
806
mk (TCall (mk (TField (ev,m)) (tfun [plusone.etype] t) p,[plusone])) t p;
887
make_call ctx (mk (TField (ev,m)) (tfun [plusone.etype] t) p) [plusone] t p;
807
888
ev2
808
889
]) t p
809
890
818
899
| (EConst (Ident name),p) :: l
819
900
| (EConst (Type name),p) :: l ->
820
901
(try
821
let e = acc_get (type_ident ctx name false p true) p in
902
let e = acc_get ctx (type_ident ctx name false p MGet) p in
822
903
(match e.eexpr with
823
904
| TEnumField (e,_) -> Some (e, List.map (fun _ -> mk_mono()) e.e_types)
824
905
| _ -> None)
957
1038
let cases = List.map matchs cases in
958
1039
mk (TMatch (e,(en,enparams),List.map indexes cases,def)) t p
959
1040
960
and type_access ctx e p get =
1041
and type_access ctx e p mode =
961
1042
match e with
962
1043
| EConst (Ident s) ->
963
type_ident ctx s false p get
1044
type_ident ctx s false p mode
964
1045
| EConst (Type s) ->
965
type_ident ctx s true p get
1046
type_ident ctx s true p mode
966
1047
| EField _
967
1048
| EType _ ->
968
1049
let fields path e =
969
1050
List.fold_left (fun e (f,_,p) ->
970
let e = acc_get (e true) p in
1051
let e = acc_get ctx (e MGet) p in
971
1052
type_field ctx e f p
972
1053
) e path
973
1054
in
1027
1108
| _ ->
1028
1109
fields acc (type_access ctx (fst e) (snd e))
1029
1110
in
1030
loop [] (e,p) get
1111
loop [] (e,p) mode
1031
1112
| EArray (e1,e2) ->
1032
1113
let e1 = type_expr ctx e1 in
1033
1114
let e2 = type_expr ctx e2 in
1061
1142
| EArray _
1062
1143
| EConst (Ident _)
1063
1144
| EConst (Type _) ->
1064
acc_get (type_access ctx e p true) p
1145
acc_get ctx (type_access ctx e p MGet) p
1065
1146
| EConst (Regexp (r,opt)) ->
1066
1147
let str = mk (TConst (TString r)) ctx.api.tstring p in
1067
1148
let opt = mk (TConst (TString opt)) ctx.api.tstring p in
1169
1250
unify_raise ctx e1.etype t e1.epos;
1170
1251
e1
1171
1252
with Error (Unify _,_) ->
1172
let acc = acc_get (type_field ctx e1 "iterator" e1.epos true) e1.epos in
1253
let acc = acc_get ctx (type_field ctx e1 "iterator" e1.epos MCall) e1.epos in
1173
1254
match follow acc.etype with
1174
1255
| TFun ([],it) ->
1175
1256
unify ctx it t e1.epos;
1176
mk (TCall (acc,[])) t e1.epos
1257
make_call ctx acc [] t e1.epos
1177
1258
| _ ->
1178
1259
error "The field iterator is not a method" e1.epos
1179
1260
)
1402
1483
| _ -> t)
1403
1484
| t -> t
1404
1485
) in
1486
(*
1487
add 'using' methods compatible with this type
1488
*)
1489
let rec loop acc = function
1490
| [] -> acc
1491
| x :: l ->
1492
let acc = ref (loop acc l) in
1493
(match x with
1494
| TClassDecl c ->
1495
let rec dup t = Type.map dup t in
1496
List.iter (fun f ->
1497
match follow (field_type f) with
1498
| TFun ((_,_,t) :: args, ret) when (try unify_raise ctx (dup e.etype) t e.epos; true with _ -> false) ->
1499
let f = { f with cf_type = TFun (args,ret); cf_params = [] } in
1500
acc := PMap.add f.cf_name f (!acc)
1501
| _ -> ()
1502
) c.cl_ordered_statics
1503
| _ -> ());
1504
!acc
1505
in
1506
let use_methods = loop PMap.empty ctx.local_using in
1507
let t = (if PMap.is_empty use_methods then t else match follow t with
1508
| TFun _ -> t (* don't provide use methods for functions *)
1509
| TAnon a -> TAnon { a_fields = PMap.fold (fun f acc -> PMap.add f.cf_name f acc) a.a_fields use_methods; a_status = ref Closed; }
1510
| _ -> TAnon { a_fields = use_methods; a_status = ref Closed }
1511
) in
1405
1512
raise (Display t)
1406
1513
| EDisplayNew t ->
1407
1514
let t = Typeload.load_normal_type ctx t p true in
1439
1546
tf_args = missing_args;
1440
1547
tf_type = ret;
1441
1548
tf_expr = mk (TReturn (Some (
1442
mk (TCall (vexpr fun_arg,List.map vexpr (first_args @ missing_args))) ret p
1549
make_call ctx (vexpr fun_arg) (List.map vexpr (first_args @ missing_args)) ret p
1443
1550
))) ret p;
1444
1551
}) (TFun (fun_args missing_args,ret)) p in
1445
1552
let func = mk (TFunction {
1483
1590
| _ ->
1484
1591
(match e with
1485
1592
| EField ((EConst (Ident "super"),_),_) , _ | EType ((EConst (Ident "super"),_),_) , _ -> ctx.super_call <- true
1486
| _ -> ());
1487
match type_access ctx (fst e) (snd e) true with
1593
| _ -> ());
1594
match type_access ctx (fst e) (snd e) MCall with
1488
1595
| AccInline (ethis,f,t) ->
1489
1596
let params, tret = (match follow t with
1490
1597
| TFun (args,r) -> unify_call_params ctx (Some f.cf_name) el args p true, r
1491
1598
| _ -> error (s_type (print_context()) t ^ " cannot be called") p
1492
1599
) in
1493
ignore(follow f.cf_type); (* force evaluation *)
1494
(match f.cf_expr with
1495
| Some { eexpr = TFunction fd } ->
1496
let i = if ctx.doinline then Optimizer.type_inline ctx f fd ethis params tret p else None in
1497
(match i with
1498
| None -> mk (TCall (mk (TField (ethis,f.cf_name)) t p,params)) tret p
1499
| Some e -> e)
1500
| _ -> error "Recursive inline is not supported" p)
1600
make_call ctx (mk (TField (ethis,f.cf_name)) t p) params tret p
1601
| AccUsing (et,eparam) ->
1602
let fname = (match et.eexpr with TField (_,f) -> f | _ -> assert false) in
1603
let params, tret = (match follow et.etype with
1604
| TFun ( _ :: args,r) -> unify_call_params ctx (Some fname) el args p false, r
1605
| _ -> assert false
1606
) in
1607
make_call ctx et (eparam::params) tret p
1501
1608
| acc ->
1502
let e = acc_get acc p in
1609
let e = acc_get ctx acc p in
1503
1610
let el , t = (match follow e.etype with
1504
1611
| TFun (args,r) ->
1505
1612
let el = unify_call_params ctx (match e.eexpr with TField (_,f) -> Some f | _ -> None) el args p false in
1717
1824
locals_map = PMap.empty;
1718
1825
locals_map_inv = PMap.empty;
1719
1826
local_types = [];
1827
local_using = [];
1720
1828
type_params = [];
1721
1829
curmethod = "";
1722
1830
curclass = null_class;
1765
1873
| [TClassDecl c] -> ctx.api.tarray <- (fun t -> TInst (c,[t]))
1766
1874
| _ -> assert false);
1767
1875
ctx
1876
1877
;;
1878
type_field_rec := type_field
b'\\ No newline at end of file'
Loggerhead is a web-based interface for Breezy
Version: 2.0.1