|
@@ -374,482 +374,4 @@ let rec make_constant_expression ctx ?(concat_strings=false) e =
|
|
| None -> None
|
|
| None -> None
|
|
| Some e -> make_constant_expression ctx e)
|
|
| Some e -> make_constant_expression ctx e)
|
|
with Not_found -> None) *)
|
|
with Not_found -> None) *)
|
|
- | _ -> None
|
|
|
|
-
|
|
|
|
-(* ---------------------------------------------------------------------- *)
|
|
|
|
-(* INLINE CONSTRUCTORS *)
|
|
|
|
-(* This version is disabled by default, use -D old-constructor-inline to use this *)
|
|
|
|
-
|
|
|
|
-(*
|
|
|
|
- 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
|
|
|
|
-*)
|
|
|
|
-
|
|
|
|
-type inline_info_kind =
|
|
|
|
- | IKCtor of tclass_field * bool
|
|
|
|
- | IKStructure
|
|
|
|
- | IKArray of int
|
|
|
|
-
|
|
|
|
-type inline_info = {
|
|
|
|
- ii_var : tvar;
|
|
|
|
- ii_expr : texpr;
|
|
|
|
- ii_kind : inline_info_kind;
|
|
|
|
- mutable ii_fields : (string,tvar) PMap.t;
|
|
|
|
-}
|
|
|
|
-
|
|
|
|
-let inline_constructors ctx e =
|
|
|
|
- let vars = ref IntMap.empty in
|
|
|
|
- let cancel v p =
|
|
|
|
- try
|
|
|
|
- let ii = IntMap.find v.v_id !vars in
|
|
|
|
- vars := IntMap.remove v.v_id !vars;
|
|
|
|
- v.v_id <- -v.v_id;
|
|
|
|
- begin match ii.ii_kind with
|
|
|
|
- | IKCtor(cf,true) ->
|
|
|
|
- display_error ctx "Extern constructor could not be inlined" p;
|
|
|
|
- error (compl_msg "Variable is used here") p;
|
|
|
|
- | _ ->
|
|
|
|
- ()
|
|
|
|
- end;
|
|
|
|
- with Not_found ->
|
|
|
|
- ()
|
|
|
|
- in
|
|
|
|
- let add v e kind =
|
|
|
|
- let ii = {
|
|
|
|
- ii_var = v;
|
|
|
|
- ii_fields = PMap.empty;
|
|
|
|
- ii_expr = e;
|
|
|
|
- ii_kind = kind
|
|
|
|
- } in
|
|
|
|
- v.v_id <- -v.v_id;
|
|
|
|
- vars := IntMap.add v.v_id ii !vars;
|
|
|
|
- in
|
|
|
|
- let get_field_var v s =
|
|
|
|
- let ii = IntMap.find v.v_id !vars in
|
|
|
|
- PMap.find s ii.ii_fields
|
|
|
|
- in
|
|
|
|
- let add_field_var v s t =
|
|
|
|
- let ii = IntMap.find v.v_id !vars in
|
|
|
|
- let v' = alloc_var VInlinedConstructorVariable (Printf.sprintf "%s_%s" v.v_name s) t v.v_pos in
|
|
|
|
- ii.ii_fields <- PMap.add s v' ii.ii_fields;
|
|
|
|
- v'
|
|
|
|
- in
|
|
|
|
- let int_field_name i =
|
|
|
|
- if i < 0 then "n" ^ (string_of_int (-i))
|
|
|
|
- else (string_of_int i)
|
|
|
|
- in
|
|
|
|
- let is_extern_ctor c cf = c.cl_extern || has_class_field_flag cf CfExtern in
|
|
|
|
- let rec find_locals e = match e.eexpr with
|
|
|
|
- | TVar(v,Some e1) ->
|
|
|
|
- find_locals e1;
|
|
|
|
- let rec loop el_init e1 = match e1.eexpr with
|
|
|
|
- | TBlock el ->
|
|
|
|
- begin match List.rev el with
|
|
|
|
- | e1 :: el ->
|
|
|
|
- loop (el @ el_init) e1
|
|
|
|
- | [] ->
|
|
|
|
- ()
|
|
|
|
- end
|
|
|
|
- | TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some ({eexpr = TFunction tf})} as cf)} as c,tl,pl) when type_iseq v.v_type e1.etype ->
|
|
|
|
- begin match type_inline_ctor ctx c cf tf (mk (TLocal v) (TInst (c,tl)) e1.epos) pl e1.epos with
|
|
|
|
- | Some e ->
|
|
|
|
- let e' = match el_init with
|
|
|
|
- | [] -> e
|
|
|
|
- | _ -> mk (TBlock (List.rev (e :: el_init))) e.etype e.epos
|
|
|
|
- in
|
|
|
|
- add v e' (IKCtor(cf,is_extern_ctor c cf));
|
|
|
|
- find_locals e
|
|
|
|
- | None ->
|
|
|
|
- ()
|
|
|
|
- end
|
|
|
|
- | TObjectDecl fl when fl <> [] ->
|
|
|
|
- begin try
|
|
|
|
- let ev = mk (TLocal v) v.v_type e.epos in
|
|
|
|
- let el = List.fold_left (fun acc ((s,_,_),e) ->
|
|
|
|
- if not (Lexer.is_valid_identifier s) then raise Exit;
|
|
|
|
- let ef = mk (TField(ev,FDynamic s)) e.etype e.epos in
|
|
|
|
- let e = mk (TBinop(OpAssign,ef,e)) e.etype e.epos in
|
|
|
|
- e :: acc
|
|
|
|
- ) el_init fl in
|
|
|
|
- let e = mk (TBlock (List.rev el)) ctx.t.tvoid e.epos in
|
|
|
|
- add v e IKStructure
|
|
|
|
- with Exit ->
|
|
|
|
- ()
|
|
|
|
- end
|
|
|
|
- | TArrayDecl el ->
|
|
|
|
- let ev = mk (TLocal v) v.v_type e.epos in
|
|
|
|
- let el,_ = List.fold_left (fun (acc,i) e ->
|
|
|
|
- let ef = mk (TField(ev,FDynamic (string_of_int i))) e.etype e.epos in
|
|
|
|
- let e = mk (TBinop(OpAssign,ef,e)) e.etype e.epos in
|
|
|
|
- e :: acc,i + 1
|
|
|
|
- ) (el_init,0) el in
|
|
|
|
- let e = mk (TBlock (List.rev el)) ctx.t.tvoid e.epos in
|
|
|
|
- add v e (IKArray (List.length el))
|
|
|
|
- | TCast(e1,None) | TParenthesis e1 ->
|
|
|
|
- loop el_init e1
|
|
|
|
- | _ ->
|
|
|
|
- ()
|
|
|
|
- in
|
|
|
|
- loop [] e1
|
|
|
|
- | TBinop(OpAssign,({eexpr = TField({eexpr = TLocal v},fa)} as e1),e2) when v.v_id < 0 ->
|
|
|
|
- let s = field_name fa in
|
|
|
|
- (try ignore(get_field_var v s) with Not_found -> ignore(add_field_var v s e1.etype));
|
|
|
|
- find_locals e2
|
|
|
|
- | TField({eexpr = TLocal v},fa) when v.v_id < 0 ->
|
|
|
|
- begin match extract_field fa with
|
|
|
|
- | Some ({cf_kind = Var _} as cf) ->
|
|
|
|
- (* Arrays are not supposed to have public var fields, besides "length" (which we handle when inlining),
|
|
|
|
- however, its inlined methods may generate access to private implementation fields (such as internal
|
|
|
|
- native array), in this case we have to cancel inlining.
|
|
|
|
- *)
|
|
|
|
- if cf.cf_name <> "length" then
|
|
|
|
- begin match (IntMap.find v.v_id !vars).ii_kind with
|
|
|
|
- | IKArray _ -> cancel v e.epos
|
|
|
|
- | _ -> (try ignore(get_field_var v cf.cf_name) with Not_found -> ignore(add_field_var v cf.cf_name e.etype));
|
|
|
|
- end
|
|
|
|
- | _ -> cancel v e.epos
|
|
|
|
- end
|
|
|
|
- | TArray({eexpr = TLocal v},{eexpr = TConst (TInt i)}) when v.v_id < 0 ->
|
|
|
|
- let i = Int32.to_int i in
|
|
|
|
- begin try
|
|
|
|
- let ii = IntMap.find v.v_id !vars in
|
|
|
|
- let l = match ii.ii_kind with
|
|
|
|
- | IKArray l -> l
|
|
|
|
- | _ -> raise Not_found
|
|
|
|
- in
|
|
|
|
- if i < 0 || i >= l then raise Not_found;
|
|
|
|
- with Not_found ->
|
|
|
|
- cancel v e.epos
|
|
|
|
- end
|
|
|
|
- | TLocal v when v.v_id < 0 ->
|
|
|
|
- cancel v e.epos;
|
|
|
|
- | _ ->
|
|
|
|
- Type.iter find_locals e
|
|
|
|
- in
|
|
|
|
- find_locals e;
|
|
|
|
- (* Pass 2 *)
|
|
|
|
- let inline v p =
|
|
|
|
- try
|
|
|
|
- let ii = IntMap.find v.v_id !vars in
|
|
|
|
- let el = PMap.fold (fun v acc -> (mk (TVar(v,None)) ctx.t.tvoid p) :: acc) ii.ii_fields [] in
|
|
|
|
- let e = {ii.ii_expr with eexpr = TBlock (el @ [ii.ii_expr])} in
|
|
|
|
- Some e
|
|
|
|
- with Not_found ->
|
|
|
|
- None
|
|
|
|
- in
|
|
|
|
- let assign_or_declare v name e2 t p =
|
|
|
|
- try
|
|
|
|
- let v = get_field_var v name in
|
|
|
|
- let e1 = mk (TLocal v) t p in
|
|
|
|
- mk (TBinop(OpAssign,e1,e2)) e1.etype p
|
|
|
|
- with Not_found ->
|
|
|
|
- let v = add_field_var v name t in
|
|
|
|
- mk (TVar(v,Some e2)) ctx.t.tvoid e.epos
|
|
|
|
- in
|
|
|
|
- let use_local_or_null v name t p =
|
|
|
|
- try
|
|
|
|
- let v' = get_field_var v name in
|
|
|
|
- mk (TLocal v') t p
|
|
|
|
- with Not_found -> try
|
|
|
|
- if name <> "length" then raise Not_found;
|
|
|
|
- let ii = IntMap.find v.v_id !vars in
|
|
|
|
- begin match ii.ii_kind with
|
|
|
|
- | IKArray l -> mk (TConst (TInt (Int32.of_int l))) ctx.t.tint p
|
|
|
|
- | _ -> raise Not_found
|
|
|
|
- end
|
|
|
|
- with Not_found ->
|
|
|
|
- mk (TConst TNull) t p
|
|
|
|
- in
|
|
|
|
- let flatten e =
|
|
|
|
- let el = ref [] in
|
|
|
|
- let rec loop e = match e.eexpr with
|
|
|
|
- | TBlock el ->
|
|
|
|
- List.iter loop el
|
|
|
|
- | _ ->
|
|
|
|
- el := e :: !el
|
|
|
|
- in
|
|
|
|
- loop e;
|
|
|
|
- let e = mk (TBlock (List.rev !el)) e.etype e.epos in
|
|
|
|
- mk (TMeta((Meta.MergeBlock,[],e.epos),e)) e.etype e.epos
|
|
|
|
- in
|
|
|
|
- let rec loop e = match e.eexpr with
|
|
|
|
- | TVar(v,_) when v.v_id < 0 ->
|
|
|
|
- begin match inline v e.epos with
|
|
|
|
- | Some e ->
|
|
|
|
- let e = flatten e in
|
|
|
|
- loop e
|
|
|
|
- | None ->
|
|
|
|
- cancel v e.epos;
|
|
|
|
- e
|
|
|
|
- end
|
|
|
|
- | TBinop(OpAssign,({eexpr = TField({eexpr = TLocal v},fa)} as e1),e2) when v.v_id < 0 ->
|
|
|
|
- let e2 = loop e2 in
|
|
|
|
- assign_or_declare v (field_name fa) e2 e1.etype e.epos
|
|
|
|
- | TField({eexpr = TLocal v},fa) when v.v_id < 0 ->
|
|
|
|
- use_local_or_null v (field_name fa) e.etype e.epos
|
|
|
|
- | TBinop(OpAssign,({eexpr = TArray({eexpr = TLocal v},{eexpr = TConst (TInt i)})} as e1),e2) when v.v_id < 0 ->
|
|
|
|
- let e2 = loop e2 in
|
|
|
|
- let name = int_field_name (Int32.to_int i) in
|
|
|
|
- assign_or_declare v name e2 e1.etype e.epos
|
|
|
|
- | TArray({eexpr = TLocal v},{eexpr = TConst (TInt i)}) when v.v_id < 0 ->
|
|
|
|
- use_local_or_null v (int_field_name (Int32.to_int i)) e.etype e.epos
|
|
|
|
- | TBlock el ->
|
|
|
|
- let rec block acc el = match el with
|
|
|
|
- | e1 :: el ->
|
|
|
|
- begin match loop e1 with
|
|
|
|
- | {eexpr = TMeta((Meta.MergeBlock,_,_),{eexpr = TBlock el2})} ->
|
|
|
|
- let acc = block acc el2 in
|
|
|
|
- block acc el
|
|
|
|
- | e -> block (e :: acc) el
|
|
|
|
- end
|
|
|
|
- | [] ->
|
|
|
|
- acc
|
|
|
|
- in
|
|
|
|
- let el = block [] el in
|
|
|
|
- mk (TBlock (List.rev el)) e.etype e.epos
|
|
|
|
- | TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some ({eexpr = TFunction _})} as cf)} as c,_,_) when is_extern_ctor c cf ->
|
|
|
|
- display_error ctx "Extern constructor could not be inlined" e.epos;
|
|
|
|
- Type.map_expr loop e
|
|
|
|
- | _ ->
|
|
|
|
- Type.map_expr loop e
|
|
|
|
- in
|
|
|
|
- loop e
|
|
|
|
-
|
|
|
|
-(* ---------------------------------------------------------------------- *)
|
|
|
|
-(* COMPLETION *)
|
|
|
|
-
|
|
|
|
-exception Return of Ast.expr
|
|
|
|
-
|
|
|
|
-type compl_locals = {
|
|
|
|
- mutable r : (string, (complex_type option * (int * Ast.expr * compl_locals) option)) PMap.t;
|
|
|
|
-}
|
|
|
|
-
|
|
|
|
-let optimize_completion_expr e args =
|
|
|
|
- let iid = ref 0 in
|
|
|
|
- let typing_side_effect = ref false in
|
|
|
|
- let locals : compl_locals = { r = PMap.empty } in
|
|
|
|
- let save() = let old = locals.r in (fun() -> locals.r <- old) in
|
|
|
|
- let get_local n = PMap.find n locals.r in
|
|
|
|
- let maybe_typed e =
|
|
|
|
- match fst e with
|
|
|
|
- | EConst (Ident "null") -> false
|
|
|
|
- | _ -> true
|
|
|
|
- in
|
|
|
|
- let decl n t e =
|
|
|
|
- typing_side_effect := true;
|
|
|
|
- locals.r <- PMap.add n (t,(match e with Some e when maybe_typed e -> incr iid; Some (!iid,e,{ r = locals.r }) | _ -> None)) locals.r
|
|
|
|
- in
|
|
|
|
- let rec hunt_idents e = match fst e with
|
|
|
|
- | EConst (Ident i) -> decl i None None
|
|
|
|
- | _ -> Ast.iter_expr hunt_idents e
|
|
|
|
- in
|
|
|
|
- let e0 = e in
|
|
|
|
- let rec loop e =
|
|
|
|
- let p = snd e in
|
|
|
|
- match fst e with
|
|
|
|
- | EConst (Ident n) ->
|
|
|
|
- (try
|
|
|
|
- (match get_local n with
|
|
|
|
- | Some _ , _ -> ()
|
|
|
|
- | _ -> typing_side_effect := true)
|
|
|
|
- with Not_found ->
|
|
|
|
- ());
|
|
|
|
- e
|
|
|
|
- | EBinop (OpAssign,(EConst (Ident n),_),esub) ->
|
|
|
|
- (try
|
|
|
|
- (match get_local n with
|
|
|
|
- | None, None when maybe_typed esub -> decl n None (Some esub)
|
|
|
|
- | _ -> ())
|
|
|
|
- with Not_found ->
|
|
|
|
- ());
|
|
|
|
- map e
|
|
|
|
- | EVars vl ->
|
|
|
|
- let vl = List.map (fun v ->
|
|
|
|
- let e = (match v.ev_expr with None -> None | Some e -> Some (loop e)) in
|
|
|
|
- decl (fst v.ev_name) (Option.map fst v.ev_type) e;
|
|
|
|
- { v with ev_expr = e }
|
|
|
|
- ) vl in
|
|
|
|
- (EVars vl,p)
|
|
|
|
- | EBlock el ->
|
|
|
|
- let old = save() in
|
|
|
|
- let told = ref (!typing_side_effect) in
|
|
|
|
- let el = List.fold_left (fun acc e ->
|
|
|
|
- typing_side_effect := false;
|
|
|
|
- let e = loop e in
|
|
|
|
- if !typing_side_effect || DisplayPosition.display_position#enclosed_in (pos e) then begin told := true; e :: acc end else acc
|
|
|
|
- ) [] el in
|
|
|
|
- old();
|
|
|
|
- typing_side_effect := !told;
|
|
|
|
- (EBlock (List.rev el),p)
|
|
|
|
- | EFunction (kind,f) ->
|
|
|
|
- (match kind with
|
|
|
|
- | FKNamed ((name,_),_) ->
|
|
|
|
- decl name None (Some e)
|
|
|
|
- | _ -> ());
|
|
|
|
- let old = save() in
|
|
|
|
- List.iter (fun ((n,_),_,_,t,e) -> decl n (Option.map fst t) e) f.f_args;
|
|
|
|
- let e = map e in
|
|
|
|
- old();
|
|
|
|
- e
|
|
|
|
- | EFor (header,body) ->
|
|
|
|
- let idents = ref []
|
|
|
|
- and has_in = ref false in
|
|
|
|
- let rec collect_idents e =
|
|
|
|
- match e with
|
|
|
|
- | EConst (Ident name), p ->
|
|
|
|
- idents := (name,p) :: !idents;
|
|
|
|
- e
|
|
|
|
- | EBinop (OpIn, e, it), p ->
|
|
|
|
- has_in := true;
|
|
|
|
- (EBinop (OpIn, collect_idents e, loop it), p)
|
|
|
|
- | _ ->
|
|
|
|
- Ast.map_expr collect_idents e
|
|
|
|
- in
|
|
|
|
- let header = collect_idents header in
|
|
|
|
- (match !idents,!has_in with
|
|
|
|
- | [],_ | _,false -> map e
|
|
|
|
- | idents,true ->
|
|
|
|
- let old = save() in
|
|
|
|
- List.iter
|
|
|
|
- (fun (name, pos) ->
|
|
|
|
- let etmp = (EConst (Ident "`tmp"),pos) in
|
|
|
|
- decl name None (Some (EBlock [
|
|
|
|
- (EVars [mk_evar ("`tmp",null_pos)],p);
|
|
|
|
- (EFor(header,(EBinop (OpAssign,etmp,(EConst (Ident name),p)),p)), p);
|
|
|
|
- etmp
|
|
|
|
- ],p));
|
|
|
|
- )
|
|
|
|
- idents;
|
|
|
|
- let body = loop body in
|
|
|
|
- old();
|
|
|
|
- (EFor(header,body),p)
|
|
|
|
- )
|
|
|
|
- | EReturn _ ->
|
|
|
|
- typing_side_effect := true;
|
|
|
|
- map e
|
|
|
|
- | ESwitch (e1,cases,def) when DisplayPosition.display_position#enclosed_in p ->
|
|
|
|
- let e1 = loop e1 in
|
|
|
|
- hunt_idents e1;
|
|
|
|
- (* Prune all cases that aren't our display case *)
|
|
|
|
- let cases = List.filter (fun (_,_,_,p) -> DisplayPosition.display_position#enclosed_in p) cases in
|
|
|
|
- (* Don't throw away the switch subject when we optimize in a case expression because we might need it *)
|
|
|
|
- let cases = List.map (fun (el,eg,eo,p) ->
|
|
|
|
- List.iter hunt_idents el;
|
|
|
|
- el,eg,(try Option.map loop eo with Return e -> Some e),p
|
|
|
|
- ) cases in
|
|
|
|
- let def = match def with
|
|
|
|
- | None -> None
|
|
|
|
- | Some (None,p) -> Some (None,p)
|
|
|
|
- | Some (Some e,p) -> Some (Some (loop e),p)
|
|
|
|
- in
|
|
|
|
- (ESwitch (e1,cases,def),p)
|
|
|
|
- | ESwitch (e,cases,def) ->
|
|
|
|
- let e = loop e in
|
|
|
|
- let cases = List.map (fun (el,eg,eo,p) -> match eo with
|
|
|
|
- | None ->
|
|
|
|
- el,eg,eo,p
|
|
|
|
- | Some e ->
|
|
|
|
- let el = List.map loop el in
|
|
|
|
- let old = save() in
|
|
|
|
- List.iter hunt_idents el;
|
|
|
|
- let e = loop e in
|
|
|
|
- old();
|
|
|
|
- el, eg, Some e, p
|
|
|
|
- ) cases in
|
|
|
|
- let def = match def with
|
|
|
|
- | None -> None
|
|
|
|
- | Some (None,p) -> Some (None,p)
|
|
|
|
- | Some (Some e,p) -> Some (Some (loop e),p)
|
|
|
|
- in
|
|
|
|
- (ESwitch (e,cases,def),p)
|
|
|
|
- | ETry (et,cl) ->
|
|
|
|
- let et = loop et in
|
|
|
|
- let cl = List.map (fun ((n,pn),th,e,p) ->
|
|
|
|
- let old = save() in
|
|
|
|
- decl n (Option.map fst th) None;
|
|
|
|
- let e = loop e in
|
|
|
|
- old();
|
|
|
|
- (n,pn), th, e, p
|
|
|
|
- ) cl in
|
|
|
|
- (ETry (et,cl),p)
|
|
|
|
- | ECall(e1,el) when DisplayPosition.display_position#enclosed_in p ->
|
|
|
|
- let e1 = loop e1 in
|
|
|
|
- let el = List.map (fun e ->
|
|
|
|
- if DisplayPosition.display_position#enclosed_in (pos e) then
|
|
|
|
- (try loop e with Return e -> e)
|
|
|
|
- else
|
|
|
|
- (EConst (Ident "null"),(pos e))
|
|
|
|
- ) el in
|
|
|
|
- (ECall(e1,el),p)
|
|
|
|
- | ECheckType(e1,th) ->
|
|
|
|
- typing_side_effect := true;
|
|
|
|
- let e1 = loop e1 in
|
|
|
|
- (ECheckType(e1,th),p)
|
|
|
|
- | EMeta(m,e1) ->
|
|
|
|
- begin try
|
|
|
|
- let e1 = loop e1 in
|
|
|
|
- (EMeta(m,e1),(pos e))
|
|
|
|
- with Return e1 ->
|
|
|
|
- let e1 = (EMeta(m,e1),(pos e)) in
|
|
|
|
- raise (Return e1)
|
|
|
|
- end
|
|
|
|
- | EDisplay(_,DKStructure) ->
|
|
|
|
- raise (Return e0)
|
|
|
|
- | EDisplay (s,call) ->
|
|
|
|
- typing_side_effect := true;
|
|
|
|
- let tmp_locals = ref [] in
|
|
|
|
- let tmp_hlocals = ref PMap.empty in
|
|
|
|
- let rec subst_locals locals e =
|
|
|
|
- match fst e with
|
|
|
|
- | EConst (Ident n) ->
|
|
|
|
- let p = snd e in
|
|
|
|
- (try
|
|
|
|
- (match PMap.find n locals.r with
|
|
|
|
- | Some t , _ -> (ECheckType ((EConst (Ident "null"),p),(t,p)),p)
|
|
|
|
- | _, Some (id,e,lc) ->
|
|
|
|
- let name = (try
|
|
|
|
- PMap.find id (!tmp_hlocals)
|
|
|
|
- with Not_found ->
|
|
|
|
- let eo = subst_locals lc e in
|
|
|
|
- let name = "`tmp_" ^ string_of_int id in
|
|
|
|
- tmp_locals := (mk_evar ~eo (name,null_pos)) :: !tmp_locals;
|
|
|
|
- tmp_hlocals := PMap.add id name !tmp_hlocals;
|
|
|
|
- name
|
|
|
|
- ) in
|
|
|
|
- (EConst (Ident name),p)
|
|
|
|
- | None, None ->
|
|
|
|
- (* we can't replace the var *)
|
|
|
|
- raise Exit)
|
|
|
|
- with Not_found ->
|
|
|
|
- (* not found locals are most likely to be member/static vars *)
|
|
|
|
- e)
|
|
|
|
- | EFunction (_,f) ->
|
|
|
|
- Ast.map_expr (subst_locals { r = PMap.foldi (fun n i acc -> if List.exists (fun ((a,_),_,_,_,_) -> a = n) f.f_args then acc else PMap.add n i acc) locals.r PMap.empty }) e
|
|
|
|
- | EObjectDecl [] ->
|
|
|
|
- (* this probably comes from { | completion so we need some context} *)
|
|
|
|
- raise Exit
|
|
|
|
- | _ ->
|
|
|
|
- Ast.map_expr (subst_locals locals) e
|
|
|
|
- in
|
|
|
|
- (try
|
|
|
|
- let e = subst_locals locals s in
|
|
|
|
- let e = (EBlock [(EVars (List.rev !tmp_locals),p);(EDisplay (e,call),p)],p) in
|
|
|
|
- raise (Return e)
|
|
|
|
- with Exit ->
|
|
|
|
- map e)
|
|
|
|
- | EDisplayNew _ ->
|
|
|
|
- raise (Return e)
|
|
|
|
- | _ ->
|
|
|
|
- map e
|
|
|
|
- and map e =
|
|
|
|
- Ast.map_expr loop e
|
|
|
|
- in
|
|
|
|
- List.iter (fun ((n,_),_,_,t,e) -> decl n (Option.map fst t) e) args;
|
|
|
|
- (try loop e with Return e -> e)
|
|
|
|
-
|
|
|
|
-(* ---------------------------------------------------------------------- *)
|
|
|
|
|
|
+ | _ -> None
|