|
@@ -32,11 +32,12 @@ open Typecore
|
|
let has_side_effect e =
|
|
let has_side_effect e =
|
|
let rec loop e =
|
|
let rec loop e =
|
|
match e.eexpr with
|
|
match e.eexpr with
|
|
- | TConst _ | TLocal _ | TField _ | TTypeExpr _ | TFunction _ -> ()
|
|
|
|
|
|
+ | TConst _ | TLocal _ | TTypeExpr _ | TFunction _ -> ()
|
|
| TCall ({ eexpr = TField(_,FStatic({ cl_path = ([],"Std") },{ cf_name = "string" })) },args) -> Type.iter loop e
|
|
| TCall ({ eexpr = TField(_,FStatic({ cl_path = ([],"Std") },{ cf_name = "string" })) },args) -> Type.iter loop e
|
|
| TNew _ | TCall _ | TBinop ((OpAssignOp _ | OpAssign),_,_) | TUnop ((Increment|Decrement),_,_) -> raise Exit
|
|
| TNew _ | TCall _ | TBinop ((OpAssignOp _ | OpAssign),_,_) | TUnop ((Increment|Decrement),_,_) -> raise Exit
|
|
| TReturn _ | TBreak | TContinue | TThrow _ | TCast (_,Some _) -> raise Exit
|
|
| TReturn _ | TBreak | TContinue | TThrow _ | TCast (_,Some _) -> raise Exit
|
|
- | TArray _ | TEnumParameter _ | TCast (_,None) | TBinop _ | TUnop _ | TParenthesis _ | TMeta _ | TWhile _ | TFor _ | TIf _ | TTry _ | TSwitch _ | TArrayDecl _ | TVar _ | TBlock _ | TObjectDecl _ -> Type.iter loop e
|
|
|
|
|
|
+ | TArray _ | TEnumParameter _ | TCast (_,None) | TBinop _ | TUnop _ | TParenthesis _ | TMeta _ | TWhile _ | TFor _
|
|
|
|
+ | TField _ | TIf _ | TTry _ | TSwitch _ | TArrayDecl _ | TVar _ | TBlock _ | TObjectDecl _ -> Type.iter loop e
|
|
in
|
|
in
|
|
try
|
|
try
|
|
loop e; false
|
|
loop e; false
|
|
@@ -45,7 +46,7 @@ let has_side_effect e =
|
|
|
|
|
|
let mk_untyped_call name p params =
|
|
let mk_untyped_call name p params =
|
|
{
|
|
{
|
|
- eexpr = TCall({ eexpr = TLocal(alloc_var name t_dynamic); etype = t_dynamic; epos = p }, params);
|
|
|
|
|
|
+ eexpr = TCall({ eexpr = TLocal(alloc_unbound_var name t_dynamic); etype = t_dynamic; epos = p }, params);
|
|
etype = t_dynamic;
|
|
etype = t_dynamic;
|
|
epos = p;
|
|
epos = p;
|
|
}
|
|
}
|
|
@@ -96,7 +97,14 @@ let api_inline ctx c field params p =
|
|
| _ ->
|
|
| _ ->
|
|
None)
|
|
None)
|
|
| ([],"Std"),"is",[o;t] | (["js"],"Boot"),"__instanceof",[o;t] when ctx.com.platform = Js ->
|
|
| ([],"Std"),"is",[o;t] | (["js"],"Boot"),"__instanceof",[o;t] when ctx.com.platform = Js ->
|
|
- let mk_local ctx n t pos = mk (TLocal (try PMap.find n ctx.locals with _ -> add_local ctx n t)) t pos in
|
|
|
|
|
|
+ let mk_local ctx n t pos =
|
|
|
|
+ mk (TLocal (try
|
|
|
|
+ PMap.find n ctx.locals
|
|
|
|
+ with _ ->
|
|
|
|
+ let v = add_local ctx n t in
|
|
|
|
+ v.v_meta <- [Meta.Unbound,[],p];
|
|
|
|
+ v
|
|
|
|
+ )) t pos in
|
|
|
|
|
|
let tstring = ctx.com.basic.tstring in
|
|
let tstring = ctx.com.basic.tstring in
|
|
let tbool = ctx.com.basic.tbool in
|
|
let tbool = ctx.com.basic.tbool in
|
|
@@ -230,9 +238,11 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f
|
|
try
|
|
try
|
|
Hashtbl.find locals v.v_id
|
|
Hashtbl.find locals v.v_id
|
|
with Not_found ->
|
|
with Not_found ->
|
|
|
|
+ let v' = alloc_var v.v_name v.v_type in
|
|
|
|
+ if Meta.has Meta.Unbound v.v_meta then v'.v_meta <- [Meta.Unbound,[],p];
|
|
let i = {
|
|
let i = {
|
|
i_var = v;
|
|
i_var = v;
|
|
- i_subst = alloc_var v.v_name v.v_type;
|
|
|
|
|
|
+ i_subst = v';
|
|
i_captured = false;
|
|
i_captured = false;
|
|
i_write = false;
|
|
i_write = false;
|
|
i_force_temp = false;
|
|
i_force_temp = false;
|
|
@@ -1040,6 +1050,20 @@ let optimize_binop e op e1 e2 =
|
|
| _ ->
|
|
| _ ->
|
|
e)
|
|
e)
|
|
|
|
|
|
|
|
+let optimize_unop e op flag esub =
|
|
|
|
+ match op, esub.eexpr with
|
|
|
|
+ | Not, (TConst (TBool f) | TParenthesis({eexpr = TConst (TBool f)})) -> { e with eexpr = TConst (TBool (not f)) }
|
|
|
|
+ | Neg, TConst (TInt i) -> { e with eexpr = TConst (TInt (Int32.neg i)) }
|
|
|
|
+ | NegBits, TConst (TInt i) -> { e with eexpr = TConst (TInt (Int32.lognot i)) }
|
|
|
|
+ | Neg, TConst (TFloat f) ->
|
|
|
|
+ let v = 0. -. float_of_string f in
|
|
|
|
+ let vstr = float_repres v in
|
|
|
|
+ if float_of_string vstr = v then
|
|
|
|
+ { e with eexpr = TConst (TFloat vstr) }
|
|
|
|
+ else
|
|
|
|
+ e
|
|
|
|
+ | _ -> e
|
|
|
|
+
|
|
let rec reduce_loop ctx e =
|
|
let rec reduce_loop ctx e =
|
|
let e = Type.map_expr (reduce_loop ctx) e in
|
|
let e = Type.map_expr (reduce_loop ctx) e in
|
|
sanitize_expr ctx.com (match e.eexpr with
|
|
sanitize_expr ctx.com (match e.eexpr with
|
|
@@ -1052,19 +1076,7 @@ let rec reduce_loop ctx e =
|
|
| TBinop (op,e1,e2) ->
|
|
| TBinop (op,e1,e2) ->
|
|
optimize_binop e op e1 e2
|
|
optimize_binop e op e1 e2
|
|
| TUnop (op,flag,esub) ->
|
|
| TUnop (op,flag,esub) ->
|
|
- (match op, esub.eexpr with
|
|
|
|
- | Not, TConst (TBool f) -> { e with eexpr = TConst (TBool (not f)) }
|
|
|
|
- | Neg, TConst (TInt i) -> { e with eexpr = TConst (TInt (Int32.neg i)) }
|
|
|
|
- | NegBits, TConst (TInt i) -> { e with eexpr = TConst (TInt (Int32.lognot i)) }
|
|
|
|
- | Neg, TConst (TFloat f) ->
|
|
|
|
- let v = 0. -. float_of_string f in
|
|
|
|
- let vstr = float_repres v in
|
|
|
|
- if float_of_string vstr = v then
|
|
|
|
- { e with eexpr = TConst (TFloat vstr) }
|
|
|
|
- else
|
|
|
|
- e
|
|
|
|
- | _ -> e
|
|
|
|
- )
|
|
|
|
|
|
+ optimize_unop e op flag esub
|
|
| TCall ({ eexpr = TField ({ eexpr = TTypeExpr (TClassDecl c) },field) },params) ->
|
|
| TCall ({ eexpr = TField ({ eexpr = TTypeExpr (TClassDecl c) },field) },params) ->
|
|
(match api_inline ctx c (field_name field) params e.epos with
|
|
(match api_inline ctx c (field_name field) params e.epos with
|
|
| None -> reduce_expr ctx e
|
|
| None -> reduce_expr ctx e
|