[eval] add a bunch of positions

closes #7744

src/macro/eval/evalEmitter.ml

@@ -34,6 +34,27 @@ let unexpected_value_p v s p =
 	let str = Printf.sprintf "Unexpected value %s, expected %s" (value_string v) s in
 	throw_string str p
 
+let as_array p = function
+	| VArray va -> va
+	| v -> unexpected_value_p v "Array" p
+
+let as_bytes p = function
+	| VInstance {ikind = IBytes s} -> s
+	| v -> unexpected_value_p v "Bytes" p
+
+let as_enum_value p = function
+	| VEnumValue ve -> ve
+	| v -> unexpected_value_p v "enum value" p
+
+let as_int p = function
+	| VInt32 i -> Int32.to_int i
+	| VFloat f -> int_of_float f
+	| v -> unexpected_value_p v "int" p
+
+let as_vector p = function
+	| VVector vv -> vv
+	| v -> unexpected_value_p v "Vector" p
+
 let cannot_call v p =
 	throw (EvalString.create_unknown ("Cannot call " ^ (value_string v))) p
 
@@ -317,25 +338,20 @@ let emit_local_read i env = env.env_locals.(i)
 
 let emit_capture_read i env = !(env.env_captures.(i))
 
-let emit_array_length_read exec env = match exec env with
-	| VArray va -> vint (va.alength)
-	| v -> unexpected_value v "Array"
+let emit_array_length_read exec p env = vint (as_array p (exec env)).alength
 
-let emit_vector_length_read exec env = match exec env with
-	| VVector vv -> vint (Array.length vv)
-	| v -> unexpected_value v "Vector"
+let emit_vector_length_read exec p env = vint (Array.length (as_vector p (exec env)))
 
-let emit_bytes_length_read exec env = match exec env with
-	| VInstance {ikind = IBytes s} -> vint (Bytes.length s)
-	| v -> unexpected_value v "Bytes"
+let emit_bytes_length_read exec p env = vint (Bytes.length (as_bytes p (exec env)))
 
 let emit_proto_field_read proto i env =
 	proto.pfields.(i)
 
-let emit_instance_field_read exec i env = match exec env with
+let emit_instance_field_read exec p i env = match exec env with
 	| VInstance vi -> vi.ifields.(i)
 	| VString s -> vint (s.slength)
-	| v -> unexpected_value v "instance"
+	| VNull -> throw_string "field access on null" p
+	| v -> unexpected_value_p v "instance" p
 
 let emit_this_field_read iv i env = match env.env_locals.(iv) with
 	| VInstance vi -> vi.ifields.(i)
@@ -357,23 +373,19 @@ let emit_field_read exec name p env = match exec env with
 	| VNull -> throw_string "field access on null" p
 	| v -> field v name
 
-let emit_array_read exec1 exec2 p env =
-	let va = exec1 env in
-	let vi = exec2 env in
-	let i = decode_int_p vi p in
+let emit_array_read exec1 p1 exec2 p2 env =
+	let a = as_array p1 (exec1 env) in
+	let i = as_int p2 (exec2 env) in
 	if i < 0 then vnull
-	else EvalArray.get (decode_varray va) i
+	else EvalArray.get a i
 
-let emit_vector_read exec1 exec2 p env =
-	let vv = exec1 env in
-	let vi = exec2 env in
-	let i = decode_int_p vi p in
+let emit_vector_read exec1 p1 exec2 p2 env =
+	let v = as_vector p1 (exec1 env) in
+	let i = as_int p2 (exec2 env) in
 	if i < 0 then vnull
-	else Array.unsafe_get (decode_vector vv) i
+	else Array.unsafe_get v i
 
-let emit_enum_index exec env = match exec env with
-	| VEnumValue ev -> vint ev.eindex
-	| v -> unexpected_value v "enum value"
+let emit_enum_index exec p env = vint (as_enum_value p (exec env)).eindex
 
 let emit_enum_parameter_read exec i env = match exec env with
 	| VEnumValue ev -> (try ev.eargs.(i) with Not_found -> vnull)
@@ -408,14 +420,14 @@ let emit_proto_field_write proto i exec2 env =
 	proto.pfields.(i) <- v;
 	v
 
-let emit_instance_field_write exec1 i exec2 env = match exec1 env with
+let emit_instance_field_write exec1 p i exec2 env = match exec1 env with
 	| VInstance vi ->
 		let v = exec2 env in
 		vi.ifields.(i) <- v;
 		v
-	| v -> unexpected_value v "instance"
+	| v -> unexpected_value_p v "instance" p
 
-let emit_anon_field_write exec1 proto i name exec2 env =
+let emit_anon_field_write exec1 p proto i name exec2 env =
 	let v1 = exec1 env in
 	let v2 = exec2 env in
 	begin match vresolve v1 with
@@ -423,33 +435,32 @@ let emit_anon_field_write exec1 proto i name exec2 env =
 			if proto == o.oproto then begin
 				o.ofields.(i) <- v2;
 			end else set_object_field o name v2
+		| VNull -> throw_string "field access on null" p
 		| _ ->
 			set_field v1 name v2;
 	end;
 	v2
 
-let emit_field_write exec1 name exec2 p env =
+let emit_field_write exec1 p1 name exec2 env =
 	let v1 = exec1 env in
 	let v2 = exec2 env in
-	(try set_field v1 name v2 with RunTimeException(v,stack,_) -> raise_notrace (RunTimeException(v,stack,p)));
+	(try set_field v1 name v2 with RunTimeException(v,stack,_) -> raise_notrace (RunTimeException(v,stack,p1)));
 	v2
 
-let emit_array_write exec1 exec2 exec3 p env =
-	let va = exec1 env in
-	let vi = exec2 env in
+let emit_array_write exec1 p1 exec2 p2 exec3 p env =
+	let a = as_array p1 (exec1 env) in
+	let i = as_int p2 (exec2 env) in
 	let v3 = exec3 env in
-	let i = decode_int_p vi p in
 	if i < 0 then throw_string (Printf.sprintf "Negative array index: %i" i) p;
-	EvalArray.set (decode_varray va) i v3;
+	EvalArray.set a i v3;
 	v3
 
-let emit_vector_write exec1 exec2 exec3 p env =
-	let vv = exec1 env in
-	let vi = exec2 env in
+let emit_vector_write exec1 p1 exec2 p2 exec3 p env =
+	let vv = as_vector p1 (exec1 env) in
+	let i = as_int p2 (exec2 env) in
 	let v3 = exec3 env in
-	let i = decode_int_p vi p in
 	if i < 0 then throw_string (Printf.sprintf "Negative vector index: %i" i) p;
-	Array.unsafe_set (decode_vector vv) i v3;
+	Array.unsafe_set vv i v3;
 	v3
 
 (* Read + write *)
@@ -482,11 +493,11 @@ let instance_field_read_write vi i exec2 fop prefix env =
 	vi.ifields.(i) <- v;
 	if prefix then v else vf
 
-let emit_instance_field_read_write exec1 i exec2 fop prefix env = match exec1 env with
+let emit_instance_field_read_write exec1 p1 i exec2 fop prefix env = match exec1 env with
 	| VInstance vi -> instance_field_read_write vi i exec2 fop prefix env
-	| v -> unexpected_value v "instance"
+	| v -> unexpected_value_p v "instance" p1
 
-let emit_field_read_write exec1 name exec2 fop prefix p env =
+let emit_field_read_write exec1 p1 name exec2 fop prefix env =
 	let v1 = exec1 env in
 	match vresolve v1 with
 	| VObject o ->
@@ -505,27 +516,23 @@ let emit_field_read_write exec1 name exec2 fop prefix p env =
 		let vf = field v1 name in
 		let v2 = exec2 env in
 		let v = fop vf v2 in
-		(try set_field v1 name v with RunTimeException(v,stack,_) -> raise_notrace (RunTimeException(v,stack,p)));
+		(try set_field v1 name v with RunTimeException(v,stack,_) -> raise_notrace (RunTimeException(v,stack,p1)));
 		if prefix then v else vf
 
-let emit_array_read_write exec1 exec2 exec3 fop prefix p env =
-	let va1 = exec1 env in
-	let va2 = exec2 env in
-	let va = decode_varray va1 in
-	let i = decode_int_p va2 p in
-	if i < 0 then throw_string (Printf.sprintf "Negative array index: %i" i) p;
+let emit_array_read_write exec1 p1 exec2 p2 exec3 fop prefix env =
+	let va = as_array p1 (exec1 env) in
+	let i = as_int p2 (exec2 env) in
+	if i < 0 then throw_string (Printf.sprintf "Negative array index: %i" i) p2;
 	let v = EvalArray.get va i in
 	let v2 = exec3 env in
 	let v3 = fop v v2 in
 	EvalArray.set va i v3;
 	if prefix then v3 else v
 
-let emit_vector_read_write exec1 exec2 exec3 fop prefix p env =
-	let va1 = exec1 env in
-	let va2 = exec2 env in
-	let va = decode_vector va1 in
-	let i = decode_int_p va2 p in
-	if i < 0 then throw_string (Printf.sprintf "Negative vector index: %i" i) p;
+let emit_vector_read_write exec1 p1 exec2 p2 exec3 fop prefix env =
+	let va = as_vector p1 (exec1 env) in
+	let i = as_int p2 (exec2 env) in
+	if i < 0 then throw_string (Printf.sprintf "Negative vector index: %i" i) p2;
 	let v = Array.unsafe_get va i in
 	let v2 = exec3 env in
 	let v3 = fop v v2 in

src/macro/eval/evalJit.ml

@@ -71,19 +71,19 @@ let rec op_assign ctx jit e1 e2 = match e1.eexpr with
 			| FInstance(c,_,_) when not c.cl_interface ->
 				let proto = get_instance_prototype jit.ctx (path_hash c.cl_path) ef.epos in
 				let i = get_instance_field_index proto name ef.epos in
-				emit_instance_field_write exec1 i exec2
+				emit_instance_field_write exec1 ef.epos i exec2
 			| FAnon cf ->
 				begin match follow ef.etype with
 					| TAnon an ->
 						let l = PMap.foldi (fun k _ acc -> (hash k,()) :: acc) an.a_fields [] in
 						let proto,_ = ctx.get_object_prototype ctx l in
 						let i = get_instance_field_index proto name ef.epos in
-						emit_anon_field_write exec1 proto i name exec2
+						emit_anon_field_write exec1 ef.epos proto i name exec2
 					| _ ->
-						emit_field_write exec1 name exec2 e1.epos
+						emit_field_write exec1 e1.epos name exec2
 				end
 			| _ ->
-				emit_field_write exec1 name exec2 e1.epos
+				emit_field_write exec1 e1.epos name exec2
 		end
 	| TArray(ea1,ea2) ->
 		begin match (follow ea1.etype) with
@@ -91,12 +91,12 @@ let rec op_assign ctx jit e1 e2 = match e1.eexpr with
 				let exec1 = jit_expr jit false ea1 in
 				let exec2 = jit_expr jit false ea2 in
 				let exec3 = jit_expr jit false e2 in
-				emit_vector_write exec1 exec2 exec3 ea2.epos
+				emit_vector_write exec1 ea1.epos exec2 ea2.epos exec3 ea2.epos
 			| _ ->
 				let exec1 = jit_expr jit false ea1 in
 				let exec2 = jit_expr jit false ea2 in
 				let exec3 = jit_expr jit false e2 in
-				emit_array_write exec1 exec2 exec3 ea2.epos
+				emit_array_write exec1 ea1.epos exec2 ea2.epos exec3 ea2.epos
 		end
 
 	| _ ->
@@ -118,9 +118,9 @@ and op_assign_op jit op e1 e2 prefix = match e1.eexpr with
 			| FInstance(c,_,_) when not c.cl_interface ->
 				let proto = get_instance_prototype jit.ctx (path_hash c.cl_path) ef.epos in
 				let i = get_instance_field_index proto name ef.epos in
-				emit_instance_field_read_write exec1 i exec2 op prefix
+				emit_instance_field_read_write exec1 ef.epos i exec2 op prefix
 			| _ ->
-				emit_field_read_write exec1 name exec2 op prefix e1.epos
+				emit_field_read_write exec1 e1.epos name exec2 op prefix
 		end
 	| TArray(ea1,ea2) ->
 		begin match (follow ea1.etype) with
@@ -128,12 +128,12 @@ and op_assign_op jit op e1 e2 prefix = match e1.eexpr with
 				let exec1 = jit_expr jit false ea1 in
 				let exec2 = jit_expr jit false ea2 in
 				let exec3 = jit_expr jit false e2 in
-				emit_vector_read_write exec1 exec2 exec3 op prefix ea2.epos
+				emit_vector_read_write exec1 ea1.epos exec2 ea2.epos exec3 op prefix
 			| _ ->
 				let exec1 = jit_expr jit false ea1 in
 				let exec2 = jit_expr jit false ea2 in
 				let exec3 = jit_expr jit false e2 in
-				emit_array_read_write exec1 exec2 exec3 op prefix ea2.epos
+				emit_array_read_write exec1 ea1.epos exec2 ea2.epos exec3 op prefix
 		end
 	| _ ->
 		assert false
@@ -476,9 +476,9 @@ and jit_expr jit return e =
 	| TField(e1,fa) ->
 		let name = hash (field_name fa) in
 		begin match fa with
-			| FInstance({cl_path=([],"Array")},_,{cf_name="length"}) -> emit_array_length_read (jit_expr jit false e1)
-			| FInstance({cl_path=(["eval"],"Vector")},_,{cf_name="length"}) -> emit_vector_length_read (jit_expr jit false e1)
-			| FInstance({cl_path=(["haxe";"io"],"Bytes")},_,{cf_name="length"}) -> emit_bytes_length_read (jit_expr jit false e1)
+			| FInstance({cl_path=([],"Array")},_,{cf_name="length"}) -> emit_array_length_read (jit_expr jit false e1) e1.epos
+			| FInstance({cl_path=(["eval"],"Vector")},_,{cf_name="length"}) -> emit_vector_length_read (jit_expr jit false e1) e1.epos
+			| FInstance({cl_path=(["haxe";"io"],"Bytes")},_,{cf_name="length"}) -> emit_bytes_length_read (jit_expr jit false e1) e1.epos
 			| FStatic({cl_path=path},_) | FEnum({e_path=path},_)
 			| FInstance({cl_path=path},_,{cf_kind = Method (MethNormal | MethInline)}) ->
 				let proto = get_static_prototype ctx (path_hash path) e1.epos in
@@ -488,7 +488,7 @@ and jit_expr jit return e =
 				let i = get_instance_field_index proto name e1.epos in
 				begin match e1.eexpr with
 					| TConst TThis -> emit_this_field_read (get_slot jit 0 e.epos) i
-					| _ -> emit_instance_field_read (jit_expr jit false e1) i
+					| _ -> emit_instance_field_read (jit_expr jit false e1) e1.epos i
 				end
 			| FAnon _ ->
 				begin match follow e1.etype with
@@ -512,18 +512,18 @@ and jit_expr jit return e =
 			| TInst({cl_path=(["eval"],"Vector")}, _) ->
 				let exec1 = jit_expr jit false e1 in
 				let exec2 = jit_expr jit false e2 in
-				emit_vector_read exec1 exec2 e2.epos
+				emit_vector_read exec1 e1.epos exec2 e2.epos
 			| _ ->
 				let exec1 = jit_expr jit false e1 in
 				let exec2 = jit_expr jit false e2 in
-				emit_array_read exec1 exec2 e2.epos
+				emit_array_read exec1 e1.epos exec2 e2.epos
 		end
 	| TEnumParameter(e1,_,i) ->
 		let exec = jit_expr jit false e1 in
 		emit_enum_parameter_read exec i
 	| TEnumIndex e1 ->
 		let exec = jit_expr jit false e1 in
-		emit_enum_index exec
+		emit_enum_index exec e1.epos
 	(* ops *)
 	| TBinop(OpEq,e1,{eexpr = TConst TNull}) | TBinop(OpEq,{eexpr = TConst TNull},e1) ->
 		let exec = jit_expr jit false e1 in