|
|
@@ -529,9 +529,6 @@ let type_function ctx args ret static constr f p =
|
|
|
ctx.opened <- old_opened;
|
|
|
e , fargs
|
|
|
|
|
|
-(* nothing *)
|
|
|
-let type_meta ctx meta = meta
|
|
|
-
|
|
|
let init_core_api ctx c =
|
|
|
let ctx2 = (match ctx.g.core_api with
|
|
|
| None ->
|
|
|
@@ -590,38 +587,33 @@ let patch_class ctx c fields =
|
|
|
let h = (try Some (Hashtbl.find ctx.g.type_patches c.cl_path) with Not_found -> None) in
|
|
|
match h with
|
|
|
| None -> fields
|
|
|
- | Some h ->
|
|
|
+ | Some (h,hcl) ->
|
|
|
+ c.cl_meta <- c.cl_meta @ hcl.tp_meta;
|
|
|
let rec loop acc = function
|
|
|
| [] -> List.rev acc
|
|
|
- | (f,p) :: l ->
|
|
|
- let acc = (try
|
|
|
- match f with
|
|
|
- | FVar (name,doc,meta,access,t,e) ->
|
|
|
- (match Hashtbl.find h (name,List.mem AStatic access) with
|
|
|
- | None -> acc
|
|
|
- | Some t -> (FVar (name,doc,meta,access,Some t,e),p) :: acc)
|
|
|
- | FProp (name,doc,meta,access,get,set,t) ->
|
|
|
- (match Hashtbl.find h (name,List.mem AStatic access) with
|
|
|
- | None -> acc
|
|
|
- | Some t -> (FProp (name,doc,meta,access,get,set,t),p) :: acc)
|
|
|
- | FFun (name,doc,meta,access,pl,f) ->
|
|
|
- (match Hashtbl.find h (name,List.mem AStatic access) with
|
|
|
- | None -> acc
|
|
|
- | Some t -> (FFun (name,doc,meta,access,pl,{ f with f_type = Some t }),p) :: acc)
|
|
|
- with Not_found ->
|
|
|
- let f = (match f with
|
|
|
- | FFun (name,doc,meta,access,params,f) ->
|
|
|
- let param ((n,opt,t,e) as p) =
|
|
|
- try
|
|
|
- n, opt, Hashtbl.find h (("$" ^ n),false), e
|
|
|
- with Not_found ->
|
|
|
- p
|
|
|
- in
|
|
|
- FFun (name,doc,meta,access,params,{ f with f_args = List.map param f.f_args })
|
|
|
- | _ -> f) in
|
|
|
- (f,p) :: acc
|
|
|
- ) in
|
|
|
- loop acc l
|
|
|
+ | f :: l ->
|
|
|
+ (* patch arguments types *)
|
|
|
+ (match f.cff_kind with
|
|
|
+ | FFun (pl,ff) ->
|
|
|
+ let param ((n,opt,t,e) as p) =
|
|
|
+ try n, opt, (Hashtbl.find h (("$" ^ n),false)).tp_type, e with Not_found -> p
|
|
|
+ in
|
|
|
+ f.cff_kind <- FFun (pl,{ ff with f_args = List.map param ff.f_args })
|
|
|
+ | _ -> ());
|
|
|
+ (* other patches *)
|
|
|
+ match (try Some (Hashtbl.find h (f.cff_name,List.mem AStatic f.cff_access)) with Not_found -> None) with
|
|
|
+ | None -> loop (f :: acc) l
|
|
|
+ | Some { tp_remove = true } -> loop acc l
|
|
|
+ | Some p ->
|
|
|
+ f.cff_meta <- f.cff_meta @ p.tp_meta;
|
|
|
+ (match p.tp_type with
|
|
|
+ | None -> ()
|
|
|
+ | Some t ->
|
|
|
+ f.cff_kind <- match f.cff_kind with
|
|
|
+ | FVar (_,e) -> FVar (Some t,e)
|
|
|
+ | FProp (get,set,_) -> FProp (get,set,t)
|
|
|
+ | FFun (pl,f) -> FFun (pl,{ f with f_type = Some t }));
|
|
|
+ loop (f :: acc) l
|
|
|
in
|
|
|
List.rev (loop [] fields)
|
|
|
|
|
|
@@ -635,7 +627,7 @@ let init_class ctx c p herits fields meta =
|
|
|
let is_macro = has_meta ":macro" meta in
|
|
|
let fields, herits = if is_macro && not ctx.in_macro then begin
|
|
|
c.cl_extern <- true;
|
|
|
- List.filter (function (FFun (_,_,_,acc,_,_),_) -> List.mem AStatic acc | _ -> false) fields, []
|
|
|
+ List.filter (fun f -> List.mem AStatic f.cff_access) fields, []
|
|
|
end else fields, herits in
|
|
|
if core_api then delay ctx ((fun() -> init_core_api ctx c));
|
|
|
let tthis = TInst (c,List.map snd c.cl_types) in
|
|
|
@@ -680,11 +672,13 @@ let init_class ctx c p herits fields meta =
|
|
|
| Some (c,_) ->
|
|
|
PMap.exists f c.cl_fields || has_field f c.cl_super || List.exists (fun i -> has_field f (Some i)) c.cl_implements
|
|
|
in
|
|
|
- let loop_cf f p =
|
|
|
- match f with
|
|
|
- | FVar (name,doc,meta,access,t,e) ->
|
|
|
- let stat = List.mem AStatic access in
|
|
|
- let inline = List.mem AInline access in
|
|
|
+ let loop_cf f =
|
|
|
+ let name = f.cff_name in
|
|
|
+ let p = f.cff_pos in
|
|
|
+ let stat = List.mem AStatic f.cff_access in
|
|
|
+ let inline = List.mem AInline f.cff_access in
|
|
|
+ match f.cff_kind with
|
|
|
+ | FVar (t,e) ->
|
|
|
if not stat && has_field name c.cl_super then error ("Redefinition of variable " ^ name ^ " in subclass is not allowed") p;
|
|
|
if inline && not stat then error "Inline variable must be static" p;
|
|
|
if inline && e = None then error "Inline variable must be initialized" p;
|
|
|
@@ -701,12 +695,12 @@ let init_class ctx c p herits fields meta =
|
|
|
) in
|
|
|
let cf = {
|
|
|
cf_name = name;
|
|
|
- cf_doc = doc;
|
|
|
- cf_meta = type_meta ctx meta;
|
|
|
+ cf_doc = f.cff_doc;
|
|
|
+ cf_meta = f.cff_meta;
|
|
|
cf_type = t;
|
|
|
cf_kind = Var (if inline then { v_read = AccInline ; v_write = AccNever } else { v_read = AccNormal; v_write = AccNormal });
|
|
|
cf_expr = None;
|
|
|
- cf_public = is_public access None;
|
|
|
+ cf_public = is_public f.cff_access None;
|
|
|
cf_params = [];
|
|
|
} in
|
|
|
let delay = (match e with
|
|
|
@@ -722,38 +716,36 @@ let init_class ctx c p herits fields meta =
|
|
|
cf.cf_type <- TLazy r;
|
|
|
(fun () -> ignore(!r()))
|
|
|
) in
|
|
|
- access, false, cf, delay
|
|
|
- | FFun (name,doc,meta,access,params,f) ->
|
|
|
+ f, false, cf, delay
|
|
|
+ | FFun (params,fd) ->
|
|
|
let params = List.map (fun (n,flags) ->
|
|
|
match flags with
|
|
|
| [] ->
|
|
|
type_type_params ctx ([],name) p (n,[])
|
|
|
| _ -> error "This notation is not allowed because it can't be checked" p
|
|
|
) params in
|
|
|
- let stat = List.mem AStatic access in
|
|
|
- let inline = List.mem AInline access in
|
|
|
if inline && c.cl_interface then error "You can't declare inline methods in interfaces" p;
|
|
|
let is_macro = (is_macro && stat) || has_meta ":macro" meta in
|
|
|
if is_macro && not stat then error "Only static methods can be macros" p;
|
|
|
- let f = if not is_macro then
|
|
|
- f
|
|
|
+ let fd = if not is_macro then
|
|
|
+ fd
|
|
|
else if ctx.in_macro then
|
|
|
let texpr = CTPath { tpackage = ["haxe";"macro"]; tname = "Expr"; tparams = []; tsub = None } in
|
|
|
{
|
|
|
- f_type = (match f.f_type with None -> Some texpr | t -> t);
|
|
|
- f_args = List.map (fun (a,o,t,e) -> a,o,(match t with None -> Some texpr | _ -> t),e) f.f_args;
|
|
|
- f_expr = f.f_expr;
|
|
|
+ f_type = (match fd.f_type with None -> Some texpr | t -> t);
|
|
|
+ f_args = List.map (fun (a,o,t,e) -> a,o,(match t with None -> Some texpr | _ -> t),e) fd.f_args;
|
|
|
+ f_expr = fd.f_expr;
|
|
|
}
|
|
|
else
|
|
|
let tdyn = Some (CTPath { tpackage = []; tname = "Dynamic"; tparams = []; tsub = None }) in
|
|
|
{
|
|
|
f_type = tdyn;
|
|
|
- f_args = List.map (fun (a,o,_,_) -> a,o,tdyn,None) f.f_args;
|
|
|
+ f_args = List.map (fun (a,o,_,_) -> a,o,tdyn,None) fd.f_args;
|
|
|
f_expr = (EBlock [],p)
|
|
|
}
|
|
|
in
|
|
|
let parent = (if not stat then get_parent c name else None) in
|
|
|
- let dynamic = List.mem ADynamic access || (match parent with Some { cf_kind = Method MethDynamic } -> true | _ -> false) in
|
|
|
+ let dynamic = List.mem ADynamic f.cff_access || (match parent with Some { cf_kind = Method MethDynamic } -> true | _ -> false) in
|
|
|
if inline && dynamic then error "You can't have both 'inline' and 'dynamic'" p;
|
|
|
let ctx = { ctx with
|
|
|
curclass = c;
|
|
|
@@ -761,33 +753,33 @@ let init_class ctx c p herits fields meta =
|
|
|
tthis = tthis;
|
|
|
type_params = if stat then params else params @ ctx.type_params;
|
|
|
} in
|
|
|
- let ret = type_opt ctx p f.f_type in
|
|
|
+ let ret = type_opt ctx p fd.f_type in
|
|
|
let args = List.map (fun (name,opt,t,c) ->
|
|
|
let t, c = type_function_param ctx (type_opt ctx p t) c opt p in
|
|
|
name, c, t
|
|
|
- ) f.f_args in
|
|
|
+ ) fd.f_args in
|
|
|
let t = TFun (fun_args args,ret) in
|
|
|
let constr = (name = "new") in
|
|
|
if constr && c.cl_interface then error "An interface cannot have a constructor" p;
|
|
|
- if c.cl_interface && not stat && (match f.f_expr with EBlock [] , _ -> false | _ -> true) then error "An interface method cannot have a body" p;
|
|
|
- if constr then (match f.f_type with
|
|
|
+ if c.cl_interface && not stat && (match fd.f_expr with EBlock [] , _ -> false | _ -> true) then error "An interface method cannot have a body" p;
|
|
|
+ if constr then (match fd.f_type with
|
|
|
| None | Some (CTPath { tpackage = []; tname = "Void" }) -> ()
|
|
|
| _ -> error "A class constructor can't have a return value" p
|
|
|
);
|
|
|
let cf = {
|
|
|
cf_name = name;
|
|
|
- cf_doc = doc;
|
|
|
- cf_meta = type_meta ctx meta;
|
|
|
+ cf_doc = f.cff_doc;
|
|
|
+ cf_meta = f.cff_meta;
|
|
|
cf_type = t;
|
|
|
cf_kind = Method (if is_macro then MethMacro else if inline then MethInline else if dynamic then MethDynamic else MethNormal);
|
|
|
cf_expr = None;
|
|
|
- cf_public = is_public access parent;
|
|
|
+ cf_public = is_public f.cff_access parent;
|
|
|
cf_params = params;
|
|
|
} in
|
|
|
let r = exc_protect (fun r ->
|
|
|
r := (fun() -> t);
|
|
|
if ctx.com.verbose then print_endline ("Typing " ^ s_type_path c.cl_path ^ "." ^ name);
|
|
|
- let e , fargs = type_function ctx args ret stat constr f p in
|
|
|
+ let e , fargs = type_function ctx args ret stat constr fd p in
|
|
|
let f = {
|
|
|
tf_args = fargs;
|
|
|
tf_type = ret;
|
|
|
@@ -808,14 +800,14 @@ let init_class ctx c p herits fields meta =
|
|
|
(fun() -> ignore((!r)()))
|
|
|
end
|
|
|
) in
|
|
|
- access, constr, cf, delay
|
|
|
- | FProp (name,doc,meta,access,get,set,t) ->
|
|
|
+ f, constr, cf, delay
|
|
|
+ | FProp (get,set,t) ->
|
|
|
let ret = load_complex_type ctx p t in
|
|
|
let check_get = ref (fun() -> ()) in
|
|
|
let check_set = ref (fun() -> ()) in
|
|
|
let check_method m t () =
|
|
|
try
|
|
|
- let t2 = (if List.mem AStatic access then (PMap.find m c.cl_statics).cf_type else fst (class_field c m)) in
|
|
|
+ let t2 = (if stat then (PMap.find m c.cl_statics).cf_type else fst (class_field c m)) in
|
|
|
unify_raise ctx t2 t p;
|
|
|
with
|
|
|
| Error (Unify l,_) -> raise (Error (Stack (Custom ("In method " ^ m ^ " required by property " ^ name),Unify l),p))
|
|
|
@@ -847,19 +839,19 @@ let init_class ctx c p herits fields meta =
|
|
|
if set = AccNormal && (match get with AccCall _ -> true | _ -> false) then error "Unsupported property combination" p;
|
|
|
let cf = {
|
|
|
cf_name = name;
|
|
|
- cf_doc = doc;
|
|
|
- cf_meta = type_meta ctx meta;
|
|
|
+ cf_doc = f.cff_doc;
|
|
|
+ cf_meta = f.cff_meta;
|
|
|
cf_kind = Var { v_read = get; v_write = set };
|
|
|
cf_expr = None;
|
|
|
cf_type = ret;
|
|
|
- cf_public = is_public access None;
|
|
|
+ cf_public = is_public f.cff_access None;
|
|
|
cf_params = [];
|
|
|
} in
|
|
|
- access, false, cf, (fun() -> (!check_get)(); (!check_set)())
|
|
|
+ f, false, cf, (fun() -> (!check_get)(); (!check_set)())
|
|
|
in
|
|
|
- let fl = List.map (fun (f,p) ->
|
|
|
- let access , constr, f , delayed = loop_cf f p in
|
|
|
- let is_static = List.mem AStatic access in
|
|
|
+ let fl = List.map (fun f ->
|
|
|
+ let fd , constr, f , delayed = loop_cf f in
|
|
|
+ let is_static = List.mem AStatic fd.cff_access in
|
|
|
if is_static && f.cf_name = "name" && Common.defined ctx.com "js" then error "This identifier cannot be used in Javascript for statics" p;
|
|
|
if (is_static || constr) && c.cl_interface && f.cf_name <> "__init__" then error "You can't declare static fields in interfaces" p;
|
|
|
if constr then begin
|
|
|
@@ -874,7 +866,7 @@ let init_class ctx c p herits fields meta =
|
|
|
end else begin
|
|
|
c.cl_fields <- PMap.add f.cf_name f c.cl_fields;
|
|
|
c.cl_ordered_fields <- f :: c.cl_ordered_fields;
|
|
|
- if List.mem AOverride access then c.cl_overrides <- f.cf_name :: c.cl_overrides;
|
|
|
+ if List.mem AOverride fd.cff_access then c.cl_overrides <- f.cf_name :: c.cl_overrides;
|
|
|
end;
|
|
|
end;
|
|
|
delayed
|
|
|
@@ -933,7 +925,7 @@ let init_class ctx c p herits fields meta =
|
|
|
) in
|
|
|
a,opt,t,def
|
|
|
) f.f_args } in
|
|
|
- let _, _, cf, delayed = loop_cf (FFun ("new",None,[],acc,pl,fnew)) p in
|
|
|
+ let _, _, cf, delayed = loop_cf { cff_name = "new"; cff_pos = p; cff_doc = None; cff_meta = []; cff_access = acc; cff_kind = FFun (pl,fnew) } in
|
|
|
c.cl_constructor <- Some cf;
|
|
|
Hashtbl.add ctx.g.constructs c.cl_path (acc,pl,f);
|
|
|
delay ctx delayed;
|
|
|
@@ -978,11 +970,11 @@ let type_module ctx m tdecls loadp =
|
|
|
let c = mk_class path p in
|
|
|
c.cl_private <- priv;
|
|
|
c.cl_doc <- d.d_doc;
|
|
|
- c.cl_meta <- type_meta ctx d.d_meta;
|
|
|
+ c.cl_meta <- d.d_meta;
|
|
|
(* store the constructor for later usage *)
|
|
|
- List.iter (fun (cf,_) ->
|
|
|
+ List.iter (fun cf ->
|
|
|
match cf with
|
|
|
- | FFun ("new",_,_,acc,pl,f) -> Hashtbl.add ctx.g.constructs path (acc,pl,f)
|
|
|
+ | { cff_name = "new"; cff_kind = FFun (pl,f) } -> Hashtbl.add ctx.g.constructs path (cf.cff_access,pl,f)
|
|
|
| _ -> ()
|
|
|
) d.d_data;
|
|
|
decls := TClassDecl c :: !decls
|
|
|
@@ -993,7 +985,7 @@ let type_module ctx m tdecls loadp =
|
|
|
e_path = path;
|
|
|
e_pos = p;
|
|
|
e_doc = d.d_doc;
|
|
|
- e_meta = type_meta ctx d.d_meta;
|
|
|
+ e_meta = d.d_meta;
|
|
|
e_types = [];
|
|
|
e_private = priv;
|
|
|
e_extern = List.mem EExtern d.d_flags;
|
|
|
@@ -1011,7 +1003,7 @@ let type_module ctx m tdecls loadp =
|
|
|
t_private = priv;
|
|
|
t_types = [];
|
|
|
t_type = mk_mono();
|
|
|
- t_meta = type_meta ctx d.d_meta;
|
|
|
+ t_meta = d.d_meta;
|
|
|
} in
|
|
|
decls := TTypeDecl t :: !decls
|
|
|
) tdecls;
|
|
|
@@ -1147,7 +1139,7 @@ let type_module ctx m tdecls loadp =
|
|
|
ef_pos = p;
|
|
|
ef_doc = doc;
|
|
|
ef_index = !index;
|
|
|
- ef_meta = type_meta ctx meta;
|
|
|
+ ef_meta = meta;
|
|
|
} e.e_constrs;
|
|
|
incr index;
|
|
|
names := c :: !names;
|
Nicolas Cannasse