|
@@ -23,6 +23,7 @@ open Type
|
|
|
open As3
|
|
|
open As3hl
|
|
|
open Common
|
|
|
+open FlashProps
|
|
|
|
|
|
type read = Read
|
|
|
type write = Unused__ | Write
|
|
@@ -305,7 +306,7 @@ let make_class_ns c =
|
|
|
|
|
|
let is_cf_protected cf = Meta.has Meta.Protected cf.cf_meta
|
|
|
|
|
|
-let ns_access cf =
|
|
|
+let ns_access cf =
|
|
|
try
|
|
|
let (_,params,_) = Meta.get Meta.Ns cf.cf_meta in
|
|
|
match params with
|
|
@@ -1533,7 +1534,57 @@ and gen_call ctx retval e el r =
|
|
|
write ctx HThis;
|
|
|
List.iter (gen_expr ctx true) el;
|
|
|
write ctx (HConstructSuper (List.length el));
|
|
|
- | TField ({ eexpr = TConst TSuper },f) , _ ->
|
|
|
+ | TField (e1,f) , _ ->
|
|
|
+ begin
|
|
|
+ let default () = gen_field_call ctx retval e1 f el r in
|
|
|
+ let mk_prop_acccess prop_cl prop_tl prop_cf = mk (TField (e1, FInstance (prop_cl, prop_tl, prop_cf))) prop_cf.cf_type e.epos in
|
|
|
+ let mk_static_acccess cl prop_cf = mk (TField (e1, FStatic (cl, prop_cf))) prop_cf.cf_type e.epos in
|
|
|
+ match f, el with
|
|
|
+ | FInstance (cl, tl, cf), [] ->
|
|
|
+ (match is_extern_instance_accessor ~isget:true cl tl cf with
|
|
|
+ | Some (prop_cl, prop_tl, prop_cf) ->
|
|
|
+ let efield = mk_prop_acccess prop_cl prop_tl prop_cf in
|
|
|
+ getvar ctx (gen_access ctx efield Read)
|
|
|
+ | None ->
|
|
|
+ default ())
|
|
|
+
|
|
|
+ | FInstance (cl, tl, cf), [evalue] ->
|
|
|
+ (match is_extern_instance_accessor ~isget:false cl tl cf with
|
|
|
+ | Some (prop_cl, prop_tl, prop_cf) ->
|
|
|
+ let efield = mk_prop_acccess prop_cl prop_tl prop_cf in
|
|
|
+ gen_assign ctx efield evalue retval
|
|
|
+ | None ->
|
|
|
+ default ())
|
|
|
+
|
|
|
+ | FStatic (cl, cf), [] ->
|
|
|
+ (match is_extern_static_accessor ~isget:true cl cf with
|
|
|
+ | Some prop_cf ->
|
|
|
+ let efield = mk_static_acccess cl prop_cf in
|
|
|
+ getvar ctx (gen_access ctx efield Read)
|
|
|
+ | None ->
|
|
|
+ default ())
|
|
|
+
|
|
|
+ | FStatic (cl, cf), [evalue] ->
|
|
|
+ (match is_extern_static_accessor ~isget:false cl cf with
|
|
|
+ | Some prop_cf ->
|
|
|
+ let efield = mk_static_acccess cl prop_cf in
|
|
|
+ gen_assign ctx efield evalue retval
|
|
|
+ | None ->
|
|
|
+ default ())
|
|
|
+
|
|
|
+ | _ ->
|
|
|
+ default ()
|
|
|
+ end
|
|
|
+ | _ ->
|
|
|
+ gen_expr ctx true e;
|
|
|
+ write ctx HGetGlobalScope;
|
|
|
+ List.iter (gen_expr ctx true) el;
|
|
|
+ write ctx (HCallStack (List.length el));
|
|
|
+ coerce ctx (classify ctx r)
|
|
|
+
|
|
|
+and gen_field_call ctx retval eobj f el r =
|
|
|
+ match eobj with
|
|
|
+ | { eexpr = TConst TSuper } ->
|
|
|
let id = this_property f in
|
|
|
write ctx (HFindPropStrict id);
|
|
|
List.iter (gen_expr ctx true) el;
|
|
@@ -1542,20 +1593,20 @@ and gen_call ctx retval e el r =
|
|
|
coerce ctx (classify ctx r);
|
|
|
end else
|
|
|
write ctx (HCallSuperVoid (id,List.length el))
|
|
|
- | TField ({ eexpr = TConst TThis },f) , _ when not ctx.in_static ->
|
|
|
+ | { eexpr = TConst TThis } when not ctx.in_static ->
|
|
|
let id = this_property f in
|
|
|
- write ctx (HFindProp id);
|
|
|
+ write ctx (HFindProp id); (* not sure why we don't use HFindPropStrict here too *)
|
|
|
List.iter (gen_expr ctx true) el;
|
|
|
if retval then begin
|
|
|
write ctx (HCallProperty (id,List.length el));
|
|
|
coerce ctx (classify ctx r);
|
|
|
end else
|
|
|
write ctx (HCallPropVoid (id,List.length el))
|
|
|
- | TField (e1,f) , _ ->
|
|
|
+ | _ ->
|
|
|
let old = ctx.for_call in
|
|
|
ctx.for_call <- true;
|
|
|
- gen_expr ctx true e1;
|
|
|
- let id , _, _ = property ctx f e1.etype in
|
|
|
+ gen_expr ctx true eobj;
|
|
|
+ let id , _, _ = property ctx f eobj.etype in
|
|
|
ctx.for_call <- old;
|
|
|
List.iter (gen_expr ctx true) el;
|
|
|
if retval then begin
|
|
@@ -1563,12 +1614,6 @@ and gen_call ctx retval e el r =
|
|
|
coerce ctx (classify ctx r);
|
|
|
end else
|
|
|
write ctx (HCallPropVoid (id,List.length el))
|
|
|
- | _ ->
|
|
|
- gen_expr ctx true e;
|
|
|
- write ctx HGetGlobalScope;
|
|
|
- List.iter (gen_expr ctx true) el;
|
|
|
- write ctx (HCallStack (List.length el));
|
|
|
- coerce ctx (classify ctx r)
|
|
|
|
|
|
and gen_unop ctx retval op flag e =
|
|
|
let k = classify ctx e.etype in
|
|
@@ -1620,6 +1665,11 @@ and check_binop ctx e1 e2 =
|
|
|
| _ -> false) in
|
|
|
if invalid then abort "Comparison of Int and UInt might lead to unexpected results" (punion e1.epos e2.epos);
|
|
|
|
|
|
+and gen_assign ctx lhs rhs retval =
|
|
|
+ let acc = gen_access ctx lhs Write in
|
|
|
+ gen_expr ctx true rhs;
|
|
|
+ setvar ctx acc (if retval then Some (classify ctx lhs.etype) else None)
|
|
|
+
|
|
|
and gen_binop ctx retval op e1 e2 t p =
|
|
|
let write_op op =
|
|
|
let iop = (match op with
|
|
@@ -1675,9 +1725,7 @@ and gen_binop ctx retval op e1 e2 t p =
|
|
|
in
|
|
|
match op with
|
|
|
| OpAssign ->
|
|
|
- let acc = gen_access ctx e1 Write in
|
|
|
- gen_expr ctx true e2;
|
|
|
- setvar ctx acc (if retval then Some (classify ctx e1.etype) else None)
|
|
|
+ gen_assign ctx e1 e2 retval
|
|
|
| OpBoolAnd ->
|
|
|
write ctx HFalse;
|
|
|
let j = jump_expr ctx e1 false in
|
|
@@ -2022,10 +2070,14 @@ let generate_field_kind ctx f c stat =
|
|
|
| _ ->
|
|
|
let name, kind = method_kind() in
|
|
|
let m = generate_method ctx fdata stat f.cf_meta in
|
|
|
+ let is_override = not stat && (
|
|
|
+ if kind = MK3Normal then List.memq f c.cl_overrides
|
|
|
+ else (loop c name || loop c f.cf_name)
|
|
|
+ ) in
|
|
|
Some (HFMethod {
|
|
|
hlm_type = m;
|
|
|
hlm_final = stat || (has_class_field_flag f CfFinal);
|
|
|
- hlm_override = not stat && (loop c name || loop c f.cf_name);
|
|
|
+ hlm_override = is_override;
|
|
|
hlm_kind = kind;
|
|
|
})
|
|
|
);
|
|
@@ -2083,6 +2135,264 @@ let check_constructor ctx c f =
|
|
|
let has_protected_meta = Meta.Custom ":has_protected"
|
|
|
let mark_has_protected c = c.cl_meta <- (has_protected_meta,[],null_pos) :: c.cl_meta
|
|
|
|
|
|
+let find_first_nonextern_accessor_implementor cl name =
|
|
|
+ let rec loop cl cl_found =
|
|
|
+ match cl.cl_super with
|
|
|
+ | Some ({ cl_extern = true }, _) | None -> cl_found
|
|
|
+ | Some (cl_super, _) ->
|
|
|
+ let has_field = PMap.exists name cl_super.cl_fields in
|
|
|
+ let cl_found = if has_field then cl_super else cl_found in
|
|
|
+ loop cl_super cl_found
|
|
|
+ in
|
|
|
+ loop cl cl
|
|
|
+
|
|
|
+let maybe_gen_instance_accessor ctx cl tl accessor_cf acc alloc_slot kind f_impl f_iface =
|
|
|
+ match find_property_for_accessor ~isget:(kind = MK3Getter) cl tl accessor_cf.cf_name with
|
|
|
+ | Some (_, _, prop_cf) ->
|
|
|
+ let accessor_cl = find_first_nonextern_accessor_implementor cl accessor_cf.cf_name in
|
|
|
+ if accessor_cl == cl then begin
|
|
|
+ let was_override = ref false in
|
|
|
+ cl.cl_overrides <- List.filter (fun f2 ->
|
|
|
+ if f2 == accessor_cf then
|
|
|
+ (was_override := true; false)
|
|
|
+ else
|
|
|
+ true
|
|
|
+ ) cl.cl_overrides;
|
|
|
+
|
|
|
+ let name, mtype =
|
|
|
+ if cl.cl_interface then begin
|
|
|
+ let (args,tret) = f_iface prop_cf in
|
|
|
+ let mtype = end_fun ctx args None tret in
|
|
|
+ HMName (reserved prop_cf.cf_name, HNNamespace (make_class_ns cl)), mtype
|
|
|
+ end else begin
|
|
|
+ let func = f_impl prop_cf in
|
|
|
+ let mtype = generate_method ctx func false accessor_cf.cf_meta in
|
|
|
+ ident prop_cf.cf_name, mtype
|
|
|
+ end
|
|
|
+ in
|
|
|
+
|
|
|
+ let getter = {
|
|
|
+ hlf_name = name;
|
|
|
+ hlf_slot = alloc_slot ();
|
|
|
+ hlf_kind = HFMethod {
|
|
|
+ hlm_type = mtype;
|
|
|
+ hlm_final = has_class_field_flag accessor_cf CfFinal;
|
|
|
+ hlm_override = !was_override;
|
|
|
+ hlm_kind = kind;
|
|
|
+ };
|
|
|
+ hlf_metas = None;
|
|
|
+ } in
|
|
|
+ getter :: acc
|
|
|
+ end else
|
|
|
+ acc
|
|
|
+ | None ->
|
|
|
+ acc
|
|
|
+
|
|
|
+let mk_instance_getter_func c tl accessor_cl accessor_tl accessor_cf prop_cf =
|
|
|
+ {
|
|
|
+ tf_args = [];
|
|
|
+ tf_type = prop_cf.cf_type;
|
|
|
+ tf_expr = begin
|
|
|
+ let ethis = mk (TConst TThis) (TInst (c, tl)) null_pos in
|
|
|
+ let efield = mk (TField (ethis, FInstance (accessor_cl, accessor_tl, accessor_cf))) accessor_cf.cf_type null_pos in
|
|
|
+ let ecall = mk (TCall (efield, [])) prop_cf.cf_type null_pos in
|
|
|
+ mk (TReturn (Some ecall)) t_dynamic null_pos;
|
|
|
+ end
|
|
|
+ }
|
|
|
+
|
|
|
+let maybe_gen_instance_getter ctx c f acc alloc_slot =
|
|
|
+ let tl = List.map snd c.cl_params in
|
|
|
+ maybe_gen_instance_accessor ctx c tl f acc alloc_slot MK3Getter
|
|
|
+ (mk_instance_getter_func c tl c tl f)
|
|
|
+ (fun prop_cf -> ([],prop_cf.cf_type))
|
|
|
+
|
|
|
+let mk_varg t = alloc_var (VUser TVOArgument) "value" t null_pos
|
|
|
+
|
|
|
+let mk_instance_setter_func com c tl accessor_cl accessor_tl accessor_cf prop_cf =
|
|
|
+ let varg = mk_varg prop_cf.cf_type in
|
|
|
+ {
|
|
|
+ tf_args = [(varg,None)];
|
|
|
+ tf_type = com.basic.tvoid;
|
|
|
+ tf_expr = begin
|
|
|
+ let ethis = mk (TConst TThis) (TInst (c, tl)) null_pos in
|
|
|
+ let efield = mk (TField (ethis, FInstance (accessor_cl, accessor_tl, accessor_cf))) accessor_cf.cf_type null_pos in
|
|
|
+ let earg = mk (TLocal varg) prop_cf.cf_type null_pos in
|
|
|
+ mk (TCall (efield, [earg])) prop_cf.cf_type null_pos
|
|
|
+ end
|
|
|
+ }
|
|
|
+
|
|
|
+let maybe_gen_instance_setter ctx c f acc alloc_slot =
|
|
|
+ let tl = List.map snd c.cl_params in
|
|
|
+ maybe_gen_instance_accessor ctx c tl f acc alloc_slot MK3Setter
|
|
|
+ (mk_instance_setter_func ctx.com c tl c tl f)
|
|
|
+ (fun prop_cf -> ([(mk_varg prop_cf.cf_type,None)],ctx.com.basic.tvoid))
|
|
|
+
|
|
|
+
|
|
|
+let maybe_gen_static_accessor ctx cl accessor_cf acc alloc_slot kind f_impl =
|
|
|
+ match find_static_property_for_accessor ~isget:(kind = MK3Getter) cl accessor_cf.cf_name with
|
|
|
+ | Some prop_cf ->
|
|
|
+ let func = f_impl prop_cf in
|
|
|
+ let getter = {
|
|
|
+ hlf_name = ident prop_cf.cf_name;
|
|
|
+ hlf_slot = alloc_slot ();
|
|
|
+ hlf_kind = HFMethod {
|
|
|
+ hlm_type = generate_method ctx func true accessor_cf.cf_meta;
|
|
|
+ hlm_final = true;
|
|
|
+ hlm_override = false;
|
|
|
+ hlm_kind = kind;
|
|
|
+ };
|
|
|
+ hlf_metas = None;
|
|
|
+ } in
|
|
|
+ getter :: acc
|
|
|
+ | None ->
|
|
|
+ acc
|
|
|
+
|
|
|
+let maybe_gen_static_getter ctx c f acc alloc_slot =
|
|
|
+ maybe_gen_static_accessor ctx c f acc alloc_slot MK3Getter (fun prop_cf -> {
|
|
|
+ tf_args = [];
|
|
|
+ tf_type = prop_cf.cf_type;
|
|
|
+ tf_expr = begin
|
|
|
+ let ethis = Texpr.Builder.make_static_this c null_pos in
|
|
|
+ let efield = mk (TField (ethis, FStatic (c, f))) f.cf_type null_pos in
|
|
|
+ let ecall = mk (TCall (efield, [])) prop_cf.cf_type null_pos in
|
|
|
+ mk (TReturn (Some ecall)) t_dynamic null_pos;
|
|
|
+ end
|
|
|
+ })
|
|
|
+
|
|
|
+let maybe_gen_static_setter ctx c f acc alloc_slot =
|
|
|
+ maybe_gen_static_accessor ctx c f acc alloc_slot MK3Setter (fun prop_cf ->
|
|
|
+ let varg = alloc_var (VUser TVOArgument) "value" prop_cf.cf_type null_pos in
|
|
|
+ {
|
|
|
+ tf_args = [(varg,None)];
|
|
|
+ tf_type = ctx.com.basic.tvoid;
|
|
|
+ tf_expr = begin
|
|
|
+ let ethis = Texpr.Builder.make_static_this c null_pos in
|
|
|
+ let efield = mk (TField (ethis, FStatic (c, f))) f.cf_type null_pos in
|
|
|
+ let earg = mk (TLocal varg) prop_cf.cf_type null_pos in
|
|
|
+ mk (TCall (efield, [earg])) prop_cf.cf_type null_pos
|
|
|
+ end
|
|
|
+ }
|
|
|
+ )
|
|
|
+
|
|
|
+let realize_required_accessors ctx cl =
|
|
|
+ let is_implemented_by_super ci =
|
|
|
+ Option.map_default (fun (csup,_) ->
|
|
|
+ (* heavily stripped-down version from Type.unify *)
|
|
|
+ let rec loop c =
|
|
|
+ c == ci
|
|
|
+ ||
|
|
|
+ Option.map_default (fun (cs,_) -> loop cs) false c.cl_super
|
|
|
+ ||
|
|
|
+ List.exists (fun (cs,_) -> loop cs) c.cl_implements
|
|
|
+ in
|
|
|
+ loop csup
|
|
|
+ ) false cl.cl_super
|
|
|
+ in
|
|
|
+ let interface_props =
|
|
|
+ begin
|
|
|
+ let h = Hashtbl.create 0 in
|
|
|
+ let rec collect cl =
|
|
|
+ let loop (ci,_) =
|
|
|
+ if not (is_implemented_by_super ci) then begin
|
|
|
+ List.iter (fun cf ->
|
|
|
+ match cf.cf_kind with
|
|
|
+ | Var { v_read = (AccCall | AccNever) as read; v_write = (AccCall | AccNever) as write } ->
|
|
|
+ begin try
|
|
|
+ let read', write', native = Hashtbl.find h cf.cf_name in
|
|
|
+ let read = if read = AccNever then read' else true in
|
|
|
+ let write = if write = AccNever then write' else true in
|
|
|
+ Hashtbl.replace h cf.cf_name (read, write, native)
|
|
|
+ with Not_found ->
|
|
|
+ Hashtbl.add h cf.cf_name (read = AccCall, write = AccCall, if is_flash_property cf then Some ci else None)
|
|
|
+ end
|
|
|
+ | _ -> ()
|
|
|
+ ) ci.cl_ordered_fields;
|
|
|
+ collect ci;
|
|
|
+ end
|
|
|
+ in
|
|
|
+ List.iter loop cl.cl_implements;
|
|
|
+ in
|
|
|
+ collect cl;
|
|
|
+ h
|
|
|
+ end
|
|
|
+ in
|
|
|
+
|
|
|
+ let rec has_nonextern_field cl name =
|
|
|
+ if PMap.exists name cl.cl_fields then true
|
|
|
+ else match cl.cl_super with
|
|
|
+ | Some ({ cl_extern = false } as csup, _) -> has_nonextern_field csup name
|
|
|
+ | _ -> false
|
|
|
+ in
|
|
|
+
|
|
|
+ let tl = List.map snd cl.cl_params in
|
|
|
+ let fields = ref [] in
|
|
|
+ Hashtbl.iter (fun name (read, write, native) ->
|
|
|
+ match Type.class_field cl tl name with
|
|
|
+ | Some (actual_cl, actual_tl), _, cf ->
|
|
|
+ Option.may (fun iface ->
|
|
|
+ if not (is_flash_property cf) then
|
|
|
+ abort (Printf.sprintf "Interface %s requires property %s to be marked with @:flash.property" (s_type_path iface.cl_path) cf.cf_name) cf.cf_pos
|
|
|
+ ) native;
|
|
|
+ if actual_cl.cl_extern then begin
|
|
|
+ let mk_field_access () =
|
|
|
+ let ethis = mk (TConst TThis) (TInst (cl,tl)) null_pos in
|
|
|
+ mk (TField (ethis, FInstance (actual_cl, actual_tl, cf))) cf.cf_type null_pos
|
|
|
+ in
|
|
|
+ if read then begin
|
|
|
+ let getter_name = "get_" ^ name in
|
|
|
+ if not (has_nonextern_field cl getter_name) then begin
|
|
|
+ let getter_func = {
|
|
|
+ tf_args = [];
|
|
|
+ tf_type = cf.cf_type;
|
|
|
+ tf_expr = mk (TReturn (Some (mk_field_access ()))) t_dynamic null_pos;
|
|
|
+ } in
|
|
|
+ let getter = {
|
|
|
+ hlf_name = ident getter_name;
|
|
|
+ hlf_slot = 0;
|
|
|
+ hlf_kind = HFMethod {
|
|
|
+ hlm_type = generate_method ctx getter_func false [];
|
|
|
+ hlm_final = false;
|
|
|
+ hlm_override = false;
|
|
|
+ hlm_kind = MK3Normal;
|
|
|
+ };
|
|
|
+ hlf_metas = None;
|
|
|
+ } in
|
|
|
+ fields := getter :: !fields;
|
|
|
+ end
|
|
|
+ end;
|
|
|
+ if write then begin
|
|
|
+ let setter_name = "set_" ^ name in
|
|
|
+ if not (has_nonextern_field cl setter_name) then begin
|
|
|
+ let varg = alloc_var (VUser TVOArgument) "value" cf.cf_type null_pos in
|
|
|
+ let setter_func = {
|
|
|
+ tf_args = [(varg,None)];
|
|
|
+ tf_type = cf.cf_type;
|
|
|
+ tf_expr = begin
|
|
|
+ let efield = mk_field_access () in
|
|
|
+ let earg = mk (TLocal varg) varg.v_type null_pos in
|
|
|
+ let eassign = mk (TBinop (OpAssign, efield, earg)) cf.cf_type null_pos in
|
|
|
+ mk (TReturn (Some eassign)) t_dynamic null_pos;
|
|
|
+ end;
|
|
|
+ } in
|
|
|
+ let setter = {
|
|
|
+ hlf_name = ident setter_name;
|
|
|
+ hlf_slot = 0;
|
|
|
+ hlf_kind = HFMethod {
|
|
|
+ hlm_type = generate_method ctx setter_func false [];
|
|
|
+ hlm_final = false;
|
|
|
+ hlm_override = false;
|
|
|
+ hlm_kind = MK3Normal;
|
|
|
+ };
|
|
|
+ hlf_metas = None;
|
|
|
+ } in
|
|
|
+ fields := setter :: !fields;
|
|
|
+ end
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ | _ -> assert false
|
|
|
+ ) interface_props;
|
|
|
+ !fields
|
|
|
+
|
|
|
let generate_class ctx c =
|
|
|
let name = type_path ctx c.cl_path in
|
|
|
ctx.cur_class <- c;
|
|
@@ -2146,16 +2456,74 @@ let generate_class ctx c =
|
|
|
else
|
|
|
loop_meta (find_meta c)
|
|
|
in
|
|
|
- let generate_prop f acc alloc_slot =
|
|
|
+ let generate_prop stat f acc alloc_slot =
|
|
|
match f.cf_kind with
|
|
|
- | Method _ -> acc
|
|
|
- | Var v ->
|
|
|
- (* let p = f.cf_pos in *)
|
|
|
- (* let ethis = mk (TConst TThis) (TInst (c,[])) p in *)
|
|
|
- acc
|
|
|
+ | Method _ when is_getter_name f.cf_name ->
|
|
|
+ if not stat then
|
|
|
+ maybe_gen_instance_getter ctx c f acc alloc_slot
|
|
|
+ else
|
|
|
+ maybe_gen_static_getter ctx c f acc alloc_slot
|
|
|
+ | Method _ when is_setter_name f.cf_name ->
|
|
|
+ if not stat then
|
|
|
+ maybe_gen_instance_setter ctx c f acc alloc_slot
|
|
|
+ else
|
|
|
+ maybe_gen_static_setter ctx c f acc alloc_slot
|
|
|
+ | Var { v_read = (AccCall | AccNever) as read; v_write = (AccCall | AccNever) as write } when not c.cl_interface && not (Meta.has Meta.IsVar f.cf_meta) ->
|
|
|
+ (* if the accessor methods were defined in super classes, we still need to generate native getter/setter *)
|
|
|
+ let acc =
|
|
|
+ if read = AccCall then begin
|
|
|
+ try
|
|
|
+ begin
|
|
|
+ let tl = List.map snd c.cl_params in
|
|
|
+ match Type.class_field c tl ("get_" ^ f.cf_name) with
|
|
|
+ | Some (actual_cl, actual_tl), _, getter_cf when actual_cl != c ->
|
|
|
+ let func = mk_instance_getter_func c tl actual_cl actual_tl getter_cf f in
|
|
|
+ {
|
|
|
+ hlf_name = ident f.cf_name;
|
|
|
+ hlf_slot = alloc_slot ();
|
|
|
+ hlf_kind = HFMethod {
|
|
|
+ hlm_type = generate_method ctx func false [];
|
|
|
+ hlm_final = false;
|
|
|
+ hlm_override = false;
|
|
|
+ hlm_kind = MK3Getter;
|
|
|
+ };
|
|
|
+ hlf_metas = None;
|
|
|
+ } :: acc
|
|
|
+ | _ ->
|
|
|
+ acc
|
|
|
+ end
|
|
|
+ with Not_found ->
|
|
|
+ acc
|
|
|
+ end else acc
|
|
|
+ in
|
|
|
+ if write = AccCall then begin
|
|
|
+ try
|
|
|
+ begin
|
|
|
+ let tl = List.map snd c.cl_params in
|
|
|
+ match Type.class_field c tl ("set_" ^ f.cf_name) with
|
|
|
+ | Some (actual_cl, actual_tl), _, setter_cf when actual_cl != c ->
|
|
|
+ let func = mk_instance_setter_func ctx.com c tl actual_cl actual_tl setter_cf f in
|
|
|
+ {
|
|
|
+ hlf_name = ident f.cf_name;
|
|
|
+ hlf_slot = alloc_slot ();
|
|
|
+ hlf_kind = HFMethod {
|
|
|
+ hlm_type = generate_method ctx func false [];
|
|
|
+ hlm_final = false;
|
|
|
+ hlm_override = false;
|
|
|
+ hlm_kind = MK3Setter;
|
|
|
+ };
|
|
|
+ hlf_metas = None;
|
|
|
+ } :: acc
|
|
|
+ | _ ->
|
|
|
+ acc
|
|
|
+ end
|
|
|
+ with Not_found ->
|
|
|
+ acc
|
|
|
+ end else acc
|
|
|
+ | Method _ | Var _ -> acc
|
|
|
in
|
|
|
let fields = PMap.fold (fun f acc ->
|
|
|
- let acc = generate_prop f acc (fun() -> 0) in
|
|
|
+ let acc = generate_prop false f acc (fun() -> 0) in
|
|
|
match generate_field_kind ctx f c false with
|
|
|
| None -> acc
|
|
|
| Some k ->
|
|
@@ -2183,10 +2551,11 @@ let generate_class ctx c =
|
|
|
hlf_metas = None;
|
|
|
} :: fields
|
|
|
end in
|
|
|
+ let fields = if not c.cl_interface then fields @ realize_required_accessors ctx c else fields in
|
|
|
let st_field_count = ref 0 in
|
|
|
let st_meth_count = ref 0 in
|
|
|
let statics = List.rev (List.fold_left (fun acc f ->
|
|
|
- let acc = generate_prop f acc (fun() -> incr st_meth_count; !st_meth_count) in
|
|
|
+ let acc = generate_prop true f acc (fun() -> incr st_meth_count; !st_meth_count) in
|
|
|
match generate_field_kind ctx f c true with
|
|
|
| None -> acc
|
|
|
| Some k ->
|