Переглянути джерело

[eval] more minor cleanups

Simon Krajewski 7 роки тому
батько
коміт
83d559605b

+ 23 - 38
src/macro/eval/evalEmitter.ml

@@ -28,10 +28,6 @@ open EvalExceptions
 open EvalField
 open EvalField
 open EvalMisc
 open EvalMisc
 
 
-type varacc =
-	| Local of int
-	| Env of int
-
 (* Helper *)
 (* Helper *)
 
 
 let unexpected_value_p v s p =
 let unexpected_value_p v s p =
@@ -99,7 +95,7 @@ let emit_mk_pos exec1 exec2 exec3 env =
 	encode_pos { pfile = decode_string file; pmin = decode_int min; pmax = decode_int max }
 	encode_pos { pfile = decode_string file; pmin = decode_int min; pmax = decode_int max }
 
 
 let emit_enum_construction key i execs p env =
 let emit_enum_construction key i execs p env =
-	encode_enum_value key i (Array.map (fun exec -> exec env) execs) p
+	encode_enum_value key i (Array.map (apply env) execs) p
 
 
 (* Branching *)
 (* Branching *)
 
 
@@ -163,22 +159,13 @@ let emit_try exec catches env =
 			with Not_found ->
 			with Not_found ->
 				raise exc
 				raise exc
 		in
 		in
-		begin match varacc with
-			| Local slot -> env.env_locals.(slot) <- v
-			| Env slot -> env.env_captures.(slot) <- ref v
-		end;
+		varacc (fun _ -> v) env;
 		exec env
 		exec env
 	in
 	in
 	v
 	v
 
 
 (* Control flow *)
 (* Control flow *)
 
 
-let emit_block execs l env =
-	for i = 0 to l - 2 do
-		ignore((Array.unsafe_get execs i) env)
-	done;
-	(Array.unsafe_get execs (l -1)) env
-
 let emit_value exec env =
 let emit_value exec env =
 	exec env
 	exec env
 
 
@@ -208,7 +195,7 @@ let emit_safe_cast exec t p env =
 let emit_super_field_call slot proto i execs p env =
 let emit_super_field_call slot proto i execs p env =
 	let vthis = env.env_locals.(slot) in
 	let vthis = env.env_locals.(slot) in
 	let vf = proto.pfields.(i) in
 	let vf = proto.pfields.(i) in
-	let vl = List.map (fun f -> f env) execs in
+	let vl = List.map (apply env) execs in
 	call_value_on vthis vf vl
 	call_value_on vthis vf vl
 
 
 (* Type.call() - immediate *)
 (* Type.call() - immediate *)
@@ -217,7 +204,7 @@ let emit_proto_field_call proto i execs p =
 	let vf = lazy (match proto.pfields.(i) with VFunction (f,_) -> f | v -> cannot_call v p) in
 	let vf = lazy (match proto.pfields.(i) with VFunction (f,_) -> f | v -> cannot_call v p) in
 	(fun env ->
 	(fun env ->
 		let f = Lazy.force vf in
 		let f = Lazy.force vf in
-		let vl = List.map (fun exec -> exec env) execs in
+		let vl = List.map (apply env) execs in
 		env.env_leave_pmin <- p.pmin;
 		env.env_leave_pmin <- p.pmin;
 		env.env_leave_pmax <- p.pmax;
 		env.env_leave_pmax <- p.pmax;
 		f vl
 		f vl
@@ -253,30 +240,20 @@ let emit_field_call exec name execs p env =
 
 
 (* new() - immediate + this-binding *)
 (* new() - immediate + this-binding *)
 
 
-let emit_constructor_callN proto vf execs p env =
-	let f = Lazy.force vf in
-	let vthis = create_instance_direct proto in
-	let vl = List.map (fun exec -> exec env) execs in
-	env.env_leave_pmin <- p.pmin;
-	env.env_leave_pmax <- p.pmax;
-	ignore(f (vthis :: vl));
-	vthis
-
 let emit_constructor_call proto fnew execs p =
 let emit_constructor_call proto fnew execs p =
 	let vf = lazy (match Lazy.force fnew with VFunction (f,_) -> f | v -> cannot_call v p) in
 	let vf = lazy (match Lazy.force fnew with VFunction (f,_) -> f | v -> cannot_call v p) in
-	emit_constructor_callN proto vf execs p
+	(fun env ->
+		let f = Lazy.force vf in
+		let vthis = create_instance_direct proto in
+		let vl = List.map (apply env) execs in
+		env.env_leave_pmin <- p.pmin;
+		env.env_leave_pmax <- p.pmax;
+		ignore(f (vthis :: vl));
+		vthis
+	)
 
 
 (* super() - immediate + this-binding *)
 (* super() - immediate + this-binding *)
 
 
-let emit_super_callN vf execs p env =
-	let f = Lazy.force vf in
-	let vthis = env.env_locals.(0) in
-	let vl = List.map (fun exec -> exec env) execs in
-	env.env_leave_pmin <- p.pmin;
-	env.env_leave_pmax <- p.pmax;
-	ignore(f (vthis :: vl));
-	vthis
-
 let emit_special_super_call fnew execs env =
 let emit_special_super_call fnew execs env =
 	let vl = List.map (apply env) execs in
 	let vl = List.map (apply env) execs in
 	let vi' = fnew vl in
 	let vi' = fnew vl in
@@ -290,7 +267,15 @@ let emit_special_super_call fnew execs env =
 
 
 let emit_super_call fnew execs p =
 let emit_super_call fnew execs p =
 	let vf = lazy (match Lazy.force fnew with VFunction (f,_) -> f | v -> cannot_call v p) in
 	let vf = lazy (match Lazy.force fnew with VFunction (f,_) -> f | v -> cannot_call v p) in
-	emit_super_callN vf execs p
+	(fun env ->
+		let f = Lazy.force vf in
+		let vthis = env.env_locals.(0) in
+		let vl = List.map (apply env) execs in
+		env.env_leave_pmin <- p.pmin;
+		env.env_leave_pmax <- p.pmax;
+		ignore(f (vthis :: vl));
+		vthis
+	)
 
 
 (* unknown call - full lookup *)
 (* unknown call - full lookup *)
 
 
@@ -664,7 +649,7 @@ let execute_set_local env i v =
 			env.env_locals.(i) <- v
 			env.env_locals.(i) <- v
 
 
 let emit_function_ret ctx get_env refs exec vl =
 let emit_function_ret ctx get_env refs exec vl =
-		let env = get_env refs in
+	let env = get_env refs in
 	List.iteri (execute_set_local env) vl;
 	List.iteri (execute_set_local env) vl;
 	let v = run_function exec env in
 	let v = run_function exec env in
 	pop_environment ctx env;
 	pop_environment ctx env;

+ 5 - 1
src/macro/eval/evalJit.ml

@@ -248,7 +248,11 @@ and jit_expr jit return e =
 			let exec = jit_expr jit return e in
 			let exec = jit_expr jit return e in
 			pop_scope jit;
 			pop_scope jit;
 			let key = hash (rope_path var.v_type) in
 			let key = hash (rope_path var.v_type) in
-			exec,key,varacc
+			let f = match varacc with
+				| Local slot -> emit_local_write slot
+				| Env slot -> emit_capture_write slot
+			in
+			exec,key,f
 		) catches in
 		) catches in
 		emit_try exec catches
 		emit_try exec catches
 	(* control flow *)
 	(* control flow *)

+ 4 - 1
src/macro/eval/evalJitContext.ml

@@ -1,6 +1,9 @@
 open Type
 open Type
 open EvalContext
 open EvalContext
-open EvalEmitter
+
+type varacc =
+	| Local of int
+	| Env of int
 
 
 (*
 (*
 	JitContext keeps track of allocated local variables and closures. Scopes can be pushed
 	JitContext keeps track of allocated local variables and closures. Scopes can be pushed