|
@@ -958,6 +958,104 @@ let rec make_constant_expression ctx e =
|
|
with Not_found -> None)
|
|
with Not_found -> None)
|
|
| _ -> None
|
|
| _ -> None
|
|
|
|
|
|
|
|
+(* ---------------------------------------------------------------------- *)
|
|
|
|
+(* INLINE CONSTRUCTORS *)
|
|
|
|
+
|
|
|
|
+(*
|
|
|
|
+ First pass :
|
|
|
|
+ We will look at local variables in the form var v = new ....
|
|
|
|
+ we only capture the ones which have constructors marked as inlined
|
|
|
|
+ then we make sure that these locals are no more referenced except for fields accesses
|
|
|
|
+
|
|
|
|
+ Second pass :
|
|
|
|
+ We replace the variables by their fields lists, and the corresponding fields accesses as well
|
|
|
|
+*)
|
|
|
|
+
|
|
|
|
+let inline_constructors ctx e =
|
|
|
|
+ let vars = ref PMap.empty in
|
|
|
|
+ let rec find_locals e =
|
|
|
|
+ match e.eexpr with
|
|
|
|
+ | TVars vl ->
|
|
|
|
+ Type.iter find_locals e;
|
|
|
|
+ List.iter (fun (v,e) ->
|
|
|
|
+ match e with
|
|
|
|
+ | Some ({ eexpr = TNew ({ cl_constructor = Some ({ cf_kind = Method MethInline; cf_expr = Some { eexpr = TFunction f } } as cst) },_,pl) } as n) ->
|
|
|
|
+ (* inline the constructor *)
|
|
|
|
+ (match (try type_inline ctx cst f (mk (TLocal v) v.v_type n.epos) pl v.v_type None n.epos true with Error (Custom _,_) -> None) with
|
|
|
|
+ | None -> ()
|
|
|
|
+ | Some ecst ->
|
|
|
|
+ let assigns = ref [] in
|
|
|
|
+ (* make sure we only have v.field = expr calls *)
|
|
|
|
+ let rec get_assigns e =
|
|
|
|
+ match e.eexpr with
|
|
|
|
+ | TBlock el ->
|
|
|
|
+ List.iter get_assigns el
|
|
|
|
+ | TBinop (OpAssign, { eexpr = TField ({ eexpr = TLocal vv },FInstance(_,cf)) }, e) when v == vv ->
|
|
|
|
+ assigns := (cf.cf_name,e) :: !assigns
|
|
|
|
+ | _ ->
|
|
|
|
+ raise Exit
|
|
|
|
+ in
|
|
|
|
+ try
|
|
|
|
+ get_assigns ecst;
|
|
|
|
+ (* mark variable as candidate for inlining *)
|
|
|
|
+ vars := PMap.add v.v_id (v,List.rev !assigns) !vars;
|
|
|
|
+ v.v_id <- -v.v_id; (* mark *)
|
|
|
|
+ (* recurse with the constructor code which will be inlined here *)
|
|
|
|
+ find_locals ecst
|
|
|
|
+ with Exit ->
|
|
|
|
+ ())
|
|
|
|
+ | _ -> ()
|
|
|
|
+ ) vl
|
|
|
|
+ | TField ({ eexpr = TLocal _ },_) ->
|
|
|
|
+ ()
|
|
|
|
+ | TLocal v when v.v_id < 0 ->
|
|
|
|
+ v.v_id <- -v.v_id;
|
|
|
|
+ vars := PMap.remove v.v_id !vars;
|
|
|
|
+ | _ ->
|
|
|
|
+ Type.iter find_locals e
|
|
|
|
+ in
|
|
|
|
+ find_locals e;
|
|
|
|
+ let vars = !vars in
|
|
|
|
+ if PMap.is_empty vars then
|
|
|
|
+ e
|
|
|
|
+ else begin
|
|
|
|
+ let vfields = PMap.map (fun (v,assigns) ->
|
|
|
|
+ List.fold_left (fun (acc,map) (name,e) ->
|
|
|
|
+ let vf = alloc_var (v.v_name ^ "_" ^ name) e.etype in
|
|
|
|
+ ((vf,e) :: acc, PMap.add name vf map)
|
|
|
|
+ ) ([],PMap.empty) assigns
|
|
|
|
+ ) vars in
|
|
|
|
+ let rec subst e =
|
|
|
|
+ match e.eexpr with
|
|
|
|
+ | TVars vl ->
|
|
|
|
+ let rec loop acc vl =
|
|
|
|
+ match vl with
|
|
|
|
+ | [] -> List.rev acc
|
|
|
|
+ | (v,None) :: vl -> loop ((v,None) :: acc) vl
|
|
|
|
+ | (v,Some e) :: vl when v.v_id < 0 ->
|
|
|
|
+ let vars, _ = PMap.find (-v.v_id) vfields in
|
|
|
|
+ loop (List.map (fun (v,e) -> v, Some (subst e)) vars @ acc) vl
|
|
|
|
+ | (v,Some e) :: vl ->
|
|
|
|
+ loop ((v,Some (subst e)) :: acc) vl
|
|
|
|
+ in
|
|
|
|
+ let vl = loop [] vl in
|
|
|
|
+ mk (TVars vl) e.etype e.epos
|
|
|
|
+ | TField ({ eexpr = TLocal v },FInstance (_,cf)) when v.v_id < 0 ->
|
|
|
|
+ let _, vars = PMap.find (-v.v_id) vfields in
|
|
|
|
+ (try
|
|
|
|
+ let v = PMap.find cf.cf_name vars in
|
|
|
|
+ mk (TLocal v) v.v_type e.epos
|
|
|
|
+ with Not_found ->
|
|
|
|
+ (* the variable was not set in the constructor, assume null *)
|
|
|
|
+ mk (TConst TNull) e.etype e.epos)
|
|
|
|
+ | _ ->
|
|
|
|
+ Type.map_expr subst e
|
|
|
|
+ in
|
|
|
|
+ let e = (try subst e with Not_found -> assert false) in
|
|
|
|
+ PMap.iter (fun _ (v,_) -> v.v_id <- -v.v_id) vars;
|
|
|
|
+ e
|
|
|
|
+ end
|
|
|
|
+
|
|
(* ---------------------------------------------------------------------- *)
|
|
(* ---------------------------------------------------------------------- *)
|
|
(* COMPLETION *)
|
|
(* COMPLETION *)
|
|
|
|
|