|
@@ -95,9 +95,9 @@ type context = {
|
|
|
cfunctions : fundecl DynArray.t;
|
|
|
cconstants : (constval, (global * int array)) lookup;
|
|
|
optimize : bool;
|
|
|
+ w_null_compare : bool;
|
|
|
overrides : (string * path, bool) Hashtbl.t;
|
|
|
defined_funs : (int,unit) Hashtbl.t;
|
|
|
- is_macro : bool;
|
|
|
mutable dump_out : (unit IO.output) option;
|
|
|
mutable cached_types : (string list, ttype) PMap.t;
|
|
|
mutable m : method_context;
|
|
@@ -263,7 +263,7 @@ let global_type ctx g =
|
|
|
DynArray.get ctx.cglobals.arr g
|
|
|
|
|
|
let is_overridden ctx c f =
|
|
|
- ctx.is_macro || Hashtbl.mem ctx.overrides (f.cf_name,c.cl_path)
|
|
|
+ Hashtbl.mem ctx.overrides (f.cf_name,c.cl_path)
|
|
|
|
|
|
let alloc_float ctx f =
|
|
|
lookup ctx.cfloats f (fun() -> f)
|
|
@@ -339,7 +339,7 @@ let make_debug ctx arr =
|
|
|
with Not_found ->
|
|
|
p.pfile
|
|
|
in
|
|
|
- let pos = ref (0,0) in
|
|
|
+ let pos = ref (0,0,Globals.null_pos) in
|
|
|
let cur_file = ref 0 in
|
|
|
let cur_line = ref 0 in
|
|
|
let cur = ref Globals.null_pos in
|
|
@@ -347,12 +347,12 @@ let make_debug ctx arr =
|
|
|
for i = 0 to DynArray.length arr - 1 do
|
|
|
let p = DynArray.unsafe_get arr i in
|
|
|
if p != !cur then begin
|
|
|
- let file = if p.pfile == (!cur).pfile then !cur_file else lookup ctx.cdebug_files p.pfile (fun() -> if ctx.is_macro then p.pfile else get_relative_path p) in
|
|
|
- let line = if ctx.is_macro then p.pmin lor ((p.pmax - p.pmin) lsl 20) else Lexer.get_error_line p in
|
|
|
+ let file = if p.pfile == (!cur).pfile then !cur_file else lookup ctx.cdebug_files p.pfile (fun() -> get_relative_path p) in
|
|
|
+ let line = Lexer.get_error_line p in
|
|
|
if line <> !cur_line || file <> !cur_file then begin
|
|
|
cur_file := file;
|
|
|
cur_line := line;
|
|
|
- pos := (file,line);
|
|
|
+ pos := (file,line,p);
|
|
|
end;
|
|
|
cur := p;
|
|
|
end;
|
|
@@ -569,10 +569,17 @@ and class_type ?(tref=None) ctx c pl statics =
|
|
|
let t = HVirtual vp in
|
|
|
ctx.cached_types <- PMap.add key_path t ctx.cached_types;
|
|
|
let rec loop c =
|
|
|
- let fields = List.fold_left (fun acc (i,_) -> loop i @ acc) [] c.cl_implements in
|
|
|
- PMap.fold (fun cf acc -> cfield_type ctx cf :: acc) c.cl_fields fields
|
|
|
+ let rec concat_uniq fields pfields =
|
|
|
+ match pfields with
|
|
|
+ | (n,_,_) as pf::pfl -> if List.exists (fun (n1,_,_) -> n1 = n) fields then concat_uniq fields pfl else concat_uniq (pf::fields) pfl
|
|
|
+ | [] -> fields
|
|
|
+ in
|
|
|
+ let pfields = List.fold_left (fun acc (i,_) -> loop i @ acc) [] c.cl_implements in
|
|
|
+ let fields = PMap.fold (fun cf acc -> cfield_type ctx cf :: acc) c.cl_fields [] in
|
|
|
+ concat_uniq fields pfields
|
|
|
in
|
|
|
let fields = loop c in
|
|
|
+ let fields = List.sort (fun (n1,_,_) (n2,_,_) -> compare n1 n2) fields in
|
|
|
vp.vfields <- Array.of_list fields;
|
|
|
Array.iteri (fun i (n,_,_) -> vp.vindex <- PMap.add n i vp.vindex) vp.vfields;
|
|
|
t
|
|
@@ -951,34 +958,39 @@ let write_mem ctx bytes index t r =
|
|
|
| _ ->
|
|
|
die "" __LOC__
|
|
|
|
|
|
+let common_type_number ctx t1 t2 p =
|
|
|
+ if t1 == t2 then t1 else
|
|
|
+ match t1, t2 with
|
|
|
+ | HUI8, (HUI16 | HI32 | HI64 | HF32 | HF64) -> t2
|
|
|
+ | HUI16, (HI32 | HI64 | HF32 | HF64) -> t2
|
|
|
+ | (HI32 | HI64), HF32 -> t2 (* possible loss of precision *)
|
|
|
+ | (HI32 | HI64 | HF32), HF64 -> t2
|
|
|
+ | (HUI8|HUI16|HI32|HI64|HF32|HF64), (HUI8|HUI16|HI32|HI64|HF32|HF64) -> t1
|
|
|
+ | _ ->
|
|
|
+ die "" __LOC__
|
|
|
+
|
|
|
let common_type ctx e1 e2 for_eq p =
|
|
|
let t1 = to_type ctx e1.etype in
|
|
|
let t2 = to_type ctx e2.etype in
|
|
|
- let rec loop t1 t2 =
|
|
|
- if t1 == t2 then t1 else
|
|
|
- match t1, t2 with
|
|
|
- | HUI8, (HUI16 | HI32 | HI64 | HF32 | HF64) -> t2
|
|
|
- | HUI16, (HI32 | HI64 | HF32 | HF64) -> t2
|
|
|
- | (HI32 | HI64), HF32 -> t2 (* possible loss of precision *)
|
|
|
- | (HI32 | HI64 | HF32), HF64 -> t2
|
|
|
- | (HUI8|HUI16|HI32|HI64|HF32|HF64), (HUI8|HUI16|HI32|HI64|HF32|HF64) -> t1
|
|
|
- | (HUI8|HUI16|HI32|HI64|HF32|HF64), (HNull t2) -> if for_eq then HNull (loop t1 t2) else loop t1 t2
|
|
|
- | (HNull t1), (HUI8|HUI16|HI32|HI64|HF32|HF64) -> if for_eq then HNull (loop t1 t2) else loop t1 t2
|
|
|
- | (HNull t1), (HNull t2) -> if for_eq then HNull (loop t1 t2) else loop t1 t2
|
|
|
- | HDyn, (HUI8|HUI16|HI32|HI64|HF32|HF64) -> HF64
|
|
|
- | (HUI8|HUI16|HI32|HI64|HF32|HF64), HDyn -> HF64
|
|
|
- | HDyn, _ -> HDyn
|
|
|
- | _, HDyn -> HDyn
|
|
|
- | _ when for_eq && safe_cast t1 t2 -> t2
|
|
|
- | _ when for_eq && safe_cast t2 t1 -> t1
|
|
|
- | HBool, HNull HBool when for_eq -> t2
|
|
|
- | HNull HBool, HBool when for_eq -> t1
|
|
|
- | HObj _, HVirtual _ | HVirtual _, HObj _ | HVirtual _ , HVirtual _ -> HDyn
|
|
|
- | HFun _, HFun _ -> HDyn
|
|
|
- | _ ->
|
|
|
- abort ("Don't know how to compare " ^ tstr t1 ^ " and " ^ tstr t2) p
|
|
|
- in
|
|
|
- loop t1 t2
|
|
|
+ if t1 == t2 then t1 else
|
|
|
+ match t1, t2 with
|
|
|
+ | (HUI8|HUI16|HI32|HI64|HF32|HF64), (HUI8|HUI16|HI32|HI64|HF32|HF64) -> common_type_number ctx t1 t2 p
|
|
|
+ | (HUI8|HUI16|HI32|HI64|HF32|HF64 as t1), (HNull t2)
|
|
|
+ | (HNull t1), (HUI8|HUI16|HI32|HI64|HF32|HF64 as t2)
|
|
|
+ | (HNull t1), (HNull t2)
|
|
|
+ -> if for_eq then HNull (common_type_number ctx t1 t2 p) else common_type_number ctx t1 t2 p
|
|
|
+ | HDyn, (HUI8|HUI16|HI32|HI64|HF32|HF64) -> HF64
|
|
|
+ | (HUI8|HUI16|HI32|HI64|HF32|HF64), HDyn -> HF64
|
|
|
+ | HDyn, _ -> HDyn
|
|
|
+ | _, HDyn -> HDyn
|
|
|
+ | _ when for_eq && safe_cast t1 t2 -> t2
|
|
|
+ | _ when for_eq && safe_cast t2 t1 -> t1
|
|
|
+ | HBool, HNull HBool when for_eq -> t2
|
|
|
+ | HNull HBool, HBool when for_eq -> t1
|
|
|
+ | HObj _, HVirtual _ | HVirtual _, HObj _ | HVirtual _ , HVirtual _ -> HDyn
|
|
|
+ | HFun _, HFun _ -> HDyn
|
|
|
+ | _ ->
|
|
|
+ abort ("Can't find common type " ^ tstr t1 ^ " and " ^ tstr t2) p
|
|
|
|
|
|
let captured_index ctx v =
|
|
|
if not (has_var_flag v VCaptured) then None else try Some (PMap.find v.v_id ctx.m.mcaptured.c_map) with Not_found -> None
|
|
@@ -991,14 +1003,17 @@ let real_name v =
|
|
|
in
|
|
|
match loop v.v_meta with
|
|
|
| "_gthis" -> "this"
|
|
|
- | name -> name
|
|
|
+ | name -> match v.v_kind with
|
|
|
+ | VInlinedConstructorVariable sl -> String.concat "." sl
|
|
|
+ | _ -> name
|
|
|
|
|
|
-let is_gen_local ctx v = match v.v_kind with
|
|
|
+let not_debug_var ctx v = match v.v_kind with
|
|
|
| VUser _ -> false
|
|
|
+ | VInlinedConstructorVariable _ -> false
|
|
|
| _ -> true
|
|
|
|
|
|
-let add_assign ctx v =
|
|
|
- if is_gen_local ctx v then () else
|
|
|
+let add_assign ?(force=false) ctx v =
|
|
|
+ if not force && not_debug_var ctx v then () else
|
|
|
let name = real_name v in
|
|
|
ctx.m.massign <- (alloc_string ctx name, current_pos ctx - 1) :: ctx.m.massign
|
|
|
|
|
@@ -1460,7 +1475,7 @@ and jump_expr ctx e jcond =
|
|
|
jump_expr ctx e jcond
|
|
|
| TUnop (Not,_,e) ->
|
|
|
jump_expr ctx e (not jcond)
|
|
|
- | TBinop (OpEq,{ eexpr = TConst(TNull) },e) | TBinop (OpEq,e,{ eexpr = TConst(TNull) }) ->
|
|
|
+ | TBinop ((OpEq | OpGte | OpLte),{ eexpr = TConst(TNull) },e) | TBinop ((OpEq | OpGte | OpLte),e,{ eexpr = TConst(TNull) }) ->
|
|
|
let r = eval_expr ctx e in
|
|
|
if is_nullable(rtype ctx r) then
|
|
|
jump ctx (fun i -> if jcond then OJNull (r,i) else OJNotNull (r,i))
|
|
@@ -1476,24 +1491,99 @@ and jump_expr ctx e jcond =
|
|
|
jump ctx (fun i -> OJAlways i)
|
|
|
else
|
|
|
(fun i -> ())
|
|
|
- | TBinop (OpEq | OpNotEq | OpGt | OpGte | OpLt | OpLte as jop, e1, e2) ->
|
|
|
- let t = common_type ctx e1 e2 (match jop with OpEq | OpNotEq -> true | _ -> false) e.epos in
|
|
|
- let r1 = eval_to ctx e1 t in
|
|
|
- hold ctx r1;
|
|
|
- let r2 = eval_to ctx e2 t in
|
|
|
- free ctx r1;
|
|
|
- let unsigned = unsigned_op e1 e2 in
|
|
|
- jump ctx (fun i ->
|
|
|
- let lt a b = if unsigned then OJULt (a,b,i) else if not jcond && is_float t then OJNotGte (a,b,i) else OJSLt (a,b,i) in
|
|
|
- let gte a b = if unsigned then OJUGte (a,b,i) else if not jcond && is_float t then OJNotLt (a,b,i) else OJSGte (a,b,i) in
|
|
|
+ | TBinop (OpEq | OpNotEq as jop, e1, e2) ->
|
|
|
+ let jumpeq r1 r2 = jump ctx (fun i ->
|
|
|
match jop with
|
|
|
| OpEq -> if jcond then OJEq (r1,r2,i) else OJNotEq (r1,r2,i)
|
|
|
| OpNotEq -> if jcond then OJNotEq (r1,r2,i) else OJEq (r1,r2,i)
|
|
|
- | OpGt -> if jcond then lt r2 r1 else gte r2 r1
|
|
|
- | OpGte -> if jcond then gte r1 r2 else lt r1 r2
|
|
|
- | OpLt -> if jcond then lt r1 r2 else gte r1 r2
|
|
|
- | OpLte -> if jcond then gte r2 r1 else lt r2 r1
|
|
|
| _ -> die "" __LOC__
|
|
|
+ ) in
|
|
|
+ let nullisfalse = match jop with
|
|
|
+ | OpEq -> jcond
|
|
|
+ | OpNotEq -> not jcond
|
|
|
+ | _ -> die "" __LOC__
|
|
|
+ in
|
|
|
+ let t1 = to_type ctx e1.etype in
|
|
|
+ let t2 = to_type ctx e2.etype in
|
|
|
+ (match t1, t2 with
|
|
|
+ | HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
|
|
|
+ | (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
|
|
|
+ | HNull (HBool as ti1), (HBool as ti2)
|
|
|
+ | (HBool as ti1), HNull (HBool as ti2)
|
|
|
+ ->
|
|
|
+ let t1,t2,e1,e2 = if is_nullt t2 then t2,t1,e2,e1 else t1,t2,e1,e2 in
|
|
|
+ let r1 = eval_expr ctx e1 in
|
|
|
+ hold ctx r1;
|
|
|
+ let jnull = if is_nullt t1 then jump ctx (fun i -> OJNull (r1, i)) else (fun i -> ()) in
|
|
|
+ let t = common_type_number ctx ti1 ti2 e.epos in (* HBool has t==ti1==ti2 *)
|
|
|
+ let a = cast_to ctx r1 t e1.epos in
|
|
|
+ hold ctx a;
|
|
|
+ let b = eval_to ctx e2 t in
|
|
|
+ free ctx a;
|
|
|
+ free ctx r1;
|
|
|
+ let j = jumpeq a b in
|
|
|
+ if nullisfalse then (jnull(););
|
|
|
+ (fun() -> if not nullisfalse then (jnull();); j());
|
|
|
+ | _ ->
|
|
|
+ let t = common_type ctx e1 e2 true e.epos in
|
|
|
+ let a = eval_to ctx e1 t in
|
|
|
+ hold ctx a;
|
|
|
+ let b = eval_to ctx e2 t in
|
|
|
+ free ctx a;
|
|
|
+ let j = jumpeq a b in
|
|
|
+ (fun() -> j());
|
|
|
+ )
|
|
|
+ | TBinop (OpGt | OpGte | OpLt | OpLte as jop, e1, e2) ->
|
|
|
+ let t1 = to_type ctx e1.etype in
|
|
|
+ let t2 = to_type ctx e2.etype in
|
|
|
+ let unsigned = unsigned_op e1 e2 in
|
|
|
+ let jumpcmp t r1 r2 = jump ctx (fun i ->
|
|
|
+ let lt a b = if unsigned then OJULt (a,b,i) else if not jcond && is_float t then OJNotGte (a,b,i) else OJSLt (a,b,i) in
|
|
|
+ let gte a b = if unsigned then OJUGte (a,b,i) else if not jcond && is_float t then OJNotLt (a,b,i) else OJSGte (a,b,i) in
|
|
|
+ match jop with
|
|
|
+ | OpGt -> if jcond then lt r2 r1 else gte r2 r1
|
|
|
+ | OpGte -> if jcond then gte r1 r2 else lt r1 r2
|
|
|
+ | OpLt -> if jcond then lt r1 r2 else gte r1 r2
|
|
|
+ | OpLte -> if jcond then gte r2 r1 else lt r2 r1
|
|
|
+ | _ -> die "" __LOC__
|
|
|
+ ) in
|
|
|
+ (match t1, t2 with
|
|
|
+ | (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
|
|
|
+ | HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
|
|
|
+ | (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
|
|
|
+ | HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
|
|
|
+ ->
|
|
|
+ if ctx.w_null_compare && (is_nullt t1 || is_nullt t2) then
|
|
|
+ ctx.com.warning WGenerator [] (Printf.sprintf "Null compare: %s %s %s" (tstr t1) (s_binop jop) (tstr t2)) e.epos;
|
|
|
+ let r1 = eval_expr ctx e1 in
|
|
|
+ hold ctx r1;
|
|
|
+ let jnull1 = if is_nullt t1 then jump ctx (fun i -> OJNull (r1, i)) else (fun i -> ()) in
|
|
|
+ let r2 = eval_expr ctx e2 in
|
|
|
+ hold ctx r2;
|
|
|
+ let jnull2 = if is_nullt t2 then jump ctx (fun i -> OJNull (r2, i)) else (fun i -> ()) in
|
|
|
+ let t = common_type_number ctx ti1 ti2 e.epos in
|
|
|
+ let a = cast_to ctx r1 t e1.epos in
|
|
|
+ hold ctx a;
|
|
|
+ let b = cast_to ctx r2 t e2.epos in
|
|
|
+ free ctx a;
|
|
|
+ free ctx r1;
|
|
|
+ free ctx r2;
|
|
|
+ let j = jumpcmp t a b in
|
|
|
+ if jcond then (jnull1(); jnull2(););
|
|
|
+ (fun() -> if not jcond then (jnull1(); jnull2();); j());
|
|
|
+ | HObj { pname = "String" }, HObj { pname = "String" }
|
|
|
+ | HDyn, _
|
|
|
+ | _, HDyn
|
|
|
+ ->
|
|
|
+ let t = common_type ctx e1 e2 false e.epos in
|
|
|
+ let a = eval_to ctx e1 t in
|
|
|
+ hold ctx a;
|
|
|
+ let b = eval_to ctx e2 t in
|
|
|
+ free ctx a;
|
|
|
+ let j = jumpcmp t a b in
|
|
|
+ (fun() -> j());
|
|
|
+ | _ ->
|
|
|
+ abort ("Don't know how to compare " ^ tstr t1 ^ " and " ^ tstr t2) e.epos
|
|
|
)
|
|
|
| TBinop (OpBoolAnd, e1, e2) ->
|
|
|
let j = jump_expr ctx e1 false in
|
|
@@ -2338,23 +2428,9 @@ and eval_expr ctx e =
|
|
|
jexit());
|
|
|
out
|
|
|
| TBinop (bop, e1, e2) ->
|
|
|
- let is_unsigned() = unsigned_op e1 e2 in
|
|
|
- let boolop r f =
|
|
|
- let j = jump ctx f in
|
|
|
- op ctx (OBool (r,false));
|
|
|
- op ctx (OJAlways 1);
|
|
|
- j();
|
|
|
- op ctx (OBool (r, true));
|
|
|
- in
|
|
|
- let binop r a b =
|
|
|
+ let arithbinop r a b =
|
|
|
let rec loop bop =
|
|
|
match bop with
|
|
|
- | OpLte -> boolop r (fun d -> if is_unsigned() then OJUGte (b,a,d) else OJSLte (a,b,d))
|
|
|
- | OpGt -> boolop r (fun d -> if is_unsigned() then OJULt (b,a,d) else OJSGt (a,b,d))
|
|
|
- | OpGte -> boolop r (fun d -> if is_unsigned() then OJUGte (a,b,d) else OJSGte (a,b,d))
|
|
|
- | OpLt -> boolop r (fun d -> if is_unsigned() then OJULt (a,b,d) else OJSLt (a,b,d))
|
|
|
- | OpEq -> boolop r (fun d -> OJEq (a,b,d))
|
|
|
- | OpNotEq -> boolop r (fun d -> OJNotEq (a,b,d))
|
|
|
| OpAdd ->
|
|
|
(match rtype ctx r with
|
|
|
| HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 ->
|
|
@@ -2401,23 +2477,13 @@ and eval_expr ctx e =
|
|
|
loop bop
|
|
|
in
|
|
|
(match bop with
|
|
|
- | OpLte | OpGt | OpGte | OpLt ->
|
|
|
+ | OpLte | OpGt | OpGte | OpLt | OpEq | OpNotEq ->
|
|
|
let r = alloc_tmp ctx HBool in
|
|
|
- let t = common_type ctx e1 e2 false e.epos in
|
|
|
- let a = eval_to ctx e1 t in
|
|
|
- hold ctx a;
|
|
|
- let b = eval_to ctx e2 t in
|
|
|
- free ctx a;
|
|
|
- binop r a b;
|
|
|
- r
|
|
|
- | OpEq | OpNotEq ->
|
|
|
- let r = alloc_tmp ctx HBool in
|
|
|
- let t = common_type ctx e1 e2 true e.epos in
|
|
|
- let a = eval_to ctx e1 t in
|
|
|
- hold ctx a;
|
|
|
- let b = eval_to ctx e2 t in
|
|
|
- free ctx a;
|
|
|
- binop r a b;
|
|
|
+ let j = jump_expr ctx e false in
|
|
|
+ op ctx (OBool (r, true));
|
|
|
+ op ctx (OJAlways 1);
|
|
|
+ j();
|
|
|
+ op ctx (OBool (r, false));
|
|
|
r
|
|
|
| OpAdd | OpSub | OpMult | OpDiv | OpMod | OpShl | OpShr | OpUShr | OpAnd | OpOr | OpXor ->
|
|
|
let t = (match to_type ctx e.etype with HNull t -> t | t -> t) in
|
|
@@ -2434,7 +2500,7 @@ and eval_expr ctx e =
|
|
|
hold ctx a;
|
|
|
let b = eval e2 in
|
|
|
free ctx a;
|
|
|
- binop r a b;
|
|
|
+ arithbinop r a b;
|
|
|
r
|
|
|
| OpAssign ->
|
|
|
let value() = eval_to ctx e2 (real_type ctx e1) in
|
|
@@ -2552,7 +2618,7 @@ and eval_expr ctx e =
|
|
|
hold ctx r;
|
|
|
let b = if bop = OpAdd && is_string (rtype ctx r) then to_string ctx (eval_expr ctx e2) e2.epos else eval_to ctx e2 (rtype ctx r) in
|
|
|
free ctx r;
|
|
|
- binop r r b;
|
|
|
+ arithbinop r r b;
|
|
|
r))
|
|
|
| OpInterval | OpArrow | OpIn | OpNullCoal ->
|
|
|
die "" __LOC__)
|
|
@@ -2965,6 +3031,7 @@ and eval_expr ctx e =
|
|
|
op ctx (OCall2 (rb, alloc_fun_path ctx (["hl"],"BaseType") "check",r,rtrap));
|
|
|
let jnext = jump ctx (fun n -> OJFalse (rb,n)) in
|
|
|
op ctx (OMov (rv, unsafe_cast_to ~debugchk:false ctx rtrap (to_type ctx v.v_type) ec.epos));
|
|
|
+ add_assign ctx v;
|
|
|
jnext
|
|
|
in
|
|
|
let r = eval_expr ctx ec in
|
|
@@ -3230,7 +3297,7 @@ and make_fun ?gen_content ctx name fidx f cthis cparent =
|
|
|
let args = List.map (fun (v,o) ->
|
|
|
let t = to_type ctx v.v_type in
|
|
|
let r = alloc_var ctx (if o = None then v else { v with v_type = if not (is_nullable t) then TAbstract(ctx.ref_abstract,[v.v_type]) else v.v_type }) true in
|
|
|
- add_assign ctx v; (* record var name *)
|
|
|
+ add_assign ~force:true ctx v; (* record var name *)
|
|
|
rtype ctx r
|
|
|
) f.tf_args in
|
|
|
|
|
@@ -3612,7 +3679,7 @@ let generate_static_init ctx types main =
|
|
|
|
|
|
free ctx rc;
|
|
|
|
|
|
- | TEnumDecl e when not e.e_extern ->
|
|
|
+ | TEnumDecl e when not (has_enum_flag e EnExtern) ->
|
|
|
|
|
|
let et = enum_class ctx e in
|
|
|
let t = enum_type ctx e in
|
|
@@ -3978,7 +4045,7 @@ let write_code ch code debug =
|
|
|
end
|
|
|
end
|
|
|
in
|
|
|
- Array.iter (fun (f,p) ->
|
|
|
+ Array.iter (fun (f,p,_) ->
|
|
|
if f <> !curfile then begin
|
|
|
flush_repeat(p);
|
|
|
curfile := f;
|
|
@@ -4033,7 +4100,7 @@ let write_code ch code debug =
|
|
|
|
|
|
(* --------------------------------------------------------------------------------------------------------------------- *)
|
|
|
|
|
|
-let create_context com is_macro dump =
|
|
|
+let create_context com dump =
|
|
|
let get_type name =
|
|
|
try
|
|
|
List.find (fun t -> (t_infos t).mt_path = (["hl"],name)) com.types
|
|
@@ -4054,8 +4121,8 @@ let create_context com is_macro dump =
|
|
|
in
|
|
|
let ctx = {
|
|
|
com = com;
|
|
|
- is_macro = is_macro;
|
|
|
optimize = not (Common.raw_defined com "hl_no_opt");
|
|
|
+ w_null_compare = Common.raw_defined com "hl_w_null_compare";
|
|
|
dump_out = if dump then Some (IO.output_channel (open_out_bin "dump/hlopt.txt")) else None;
|
|
|
m = method_context 0 HVoid null_capture false;
|
|
|
cints = new_lookup();
|
|
@@ -4115,7 +4182,7 @@ let add_types ctx types =
|
|
|
| _ ->
|
|
|
false
|
|
|
in
|
|
|
- if not ctx.is_macro then List.iter (fun f -> if has_class_field_flag f CfOverride then ignore(loop c.cl_super f)) c.cl_ordered_fields;
|
|
|
+ List.iter (fun f -> if has_class_field_flag f CfOverride then ignore(loop c.cl_super f)) c.cl_ordered_fields;
|
|
|
List.iter (fun (m,args,p) ->
|
|
|
if m = Meta.HlNative then
|
|
|
let lib, prefix = (match args with
|
|
@@ -4185,7 +4252,7 @@ let generate com =
|
|
|
close_out ch;
|
|
|
end else
|
|
|
|
|
|
- let ctx = create_context com false dump in
|
|
|
+ let ctx = create_context com dump in
|
|
|
add_types ctx com.types;
|
|
|
let code = build_code ctx com.types com.main.main_expr in
|
|
|
Array.sort (fun (lib1,_,_,_) (lib2,_,_,_) -> lib1 - lib2) code.natives;
|
|
@@ -4208,7 +4275,7 @@ let generate com =
|
|
|
end;*)
|
|
|
if hl_check then begin
|
|
|
check ctx;
|
|
|
- Hlinterp.check code false;
|
|
|
+ Hlinterp.check com.error code;
|
|
|
end;
|
|
|
let t = Timer.timer ["generate";"hl";"write"] in
|
|
|
|