Skip to content

Commit

Permalink
try some piping
Browse files Browse the repository at this point in the history 
see #9359
  • Loading branch information
@Simn
Simn committed Mar 17, 2022
1 parent 6caeab9 commit d97ce07
Show file tree
Hide file tree
Showing 4 changed files with 100 additions and 51 deletions.
32 changes: 0 additions & 32 deletions src/compiler/compiler.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -451,38 +451,6 @@ let get_std_class_paths () =
Path.add_trailing_slash (Filename.concat base_path "extraLibs")
]

let setup_common_context ctx =
let com = ctx.com in
Common.define_value com Define.HaxeVer (Printf.sprintf "%.3f" (float_of_int Globals.version /. 1000.));
Common.raw_define com "haxe3";
Common.raw_define com "haxe4";
Common.define_value com Define.Haxe s_version;
Common.raw_define com "true";
Common.define_value com Define.Dce "std";
com.info <- (fun msg p -> message ctx (CMInfo(msg,p)));
com.warning <- (fun w options msg p ->
match Warning.get_mode w (com.warning_options @ options) with
| WMEnable ->
message ctx (CMWarning(msg,p))
| WMDisable ->
()
);
com.error <- error ctx;
let filter_messages = (fun keep_errors predicate -> (List.filter (fun msg ->
(match msg with
| CMError(_,_) -> keep_errors;
| CMInfo(_,_) | CMWarning(_,_) -> predicate msg;)
) (List.rev ctx.messages))) in
com.get_messages <- (fun () -> (List.map (fun msg ->
(match msg with
| CMError(_,_) -> die "" __LOC__;
| CMInfo(_,_) | CMWarning(_,_) -> msg;)
) (filter_messages false (fun _ -> true))));
com.filter_messages <- (fun predicate -> (ctx.messages <- (List.rev (filter_messages true predicate))));
if CompilationServer.runs() then com.run_command <- run_command ctx;
com.class_path <- get_std_class_paths ();
com.std_path <- List.filter (fun p -> ExtString.String.ends_with p "std/" || ExtString.String.ends_with p "std\\") com.class_path

let compile ctx actx =
let com = ctx.com in
(* Set up display configuration *)
Expand Down
73 changes: 56 additions & 17 deletions src/compiler/server.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -169,13 +169,18 @@ class virtual server_communication
= object(self)
method virtual out : string -> unit (* like stdout *)
method virtual err : string -> unit (* like stderr *)
method virtual finish : compilation_context -> unit
method virtual do_finish : compilation_context -> unit

method maybe_cache_context com =
if com.display.dms_full_typing then begin
CommonCache.cache_context sctx.cs com;
ServerMessage.cached_modules com "" (List.length com.modules);
end

method finish (ctx : compilation_context) =
ctx.com.client_stdout#close self#out;
ctx.com.client_stderr#close self#err;
self#do_finish ctx
end

class stdio_communication
Expand All @@ -185,18 +190,16 @@ class stdio_communication

method out (s : string) =
print_string s;
flush stdout (* TODO: is this ok? *)
flush stdout;

method err (s : string) =
prerr_string s

method finish (ctx : compilation_context) =
List.iter
(fun msg -> match msg with
method do_finish (ctx : compilation_context) =
List.iter (fun msg -> match msg with
| CMInfo _ -> print_endline (compiler_message_string msg)
| CMWarning _ | CMError _ -> prerr_endline (compiler_message_string msg)
)
(List.rev ctx.messages);
) (List.rev ctx.messages);
if ctx.has_error && !Helper.prompt then begin
print_endline "Press enter to exit...";
ignore(read_line());
Expand All @@ -217,7 +220,7 @@ class other_communication
method err (s : string) =
write s

method finish (ctx : compilation_context) =
method do_finish (ctx : compilation_context) =
sctx.compilation_step <- sctx.compilation_step + 1;
sctx.compilation_mark <- sctx.mark_loop;
check_display_flush ctx (fun () ->
Expand Down Expand Up @@ -516,7 +519,6 @@ let create sctx (comm : server_communication) params =
has_error = false;
server_mode = SMNone;
} in
ctx.com.print <- comm#out;
ctx

(* Resets the state for a new compilation *)
Expand Down Expand Up @@ -645,13 +647,8 @@ let process_params create pl =
(* Push the --cwd arg so the arg processor know we did something. *)
loop (dir :: "--cwd" :: acc) l
| "--connect" :: hp :: l ->
(match CompilationServer.get() with
| None ->
let host, port = (try ExtString.String.split hp ":" with _ -> "127.0.0.1", hp) in
Server_old.do_connect host (try int_of_string port with _ -> raise (Arg.Bad "Invalid port")) ((List.rev acc) @ l)
| Some _ ->
(* already connected : skip *)
loop acc l)
let host, port = (try ExtString.String.split hp ":" with _ -> "127.0.0.1", hp) in
Server_old.do_connect host (try int_of_string port with _ -> raise (Arg.Bad "Invalid port")) ((List.rev acc) @ l)
| "--run" :: cl :: args ->
let acc = cl :: "-x" :: acc in
let ctx = add_context (!each_params @ (List.rev acc)) in
Expand All @@ -676,6 +673,45 @@ let parse_host_port hp =
let port = try int_of_string port with _ -> raise (Arg.Bad "Invalid port") in
host, port

let setup_common_context ctx comm =
let com = ctx.com in
let out = new server_pipe (Unix.pipe()) in
ctx.com.client_stdout <- out;
ctx.com.client_stderr <- new server_pipe (Unix.pipe());
ctx.com.print <- (fun s ->
out#write s;
out#read comm#out;
);
Common.define_value com Define.HaxeVer (Printf.sprintf "%.3f" (float_of_int Globals.version /. 1000.));
Common.raw_define com "haxe3";
Common.raw_define com "haxe4";
Common.define_value com Define.Haxe s_version;
Common.raw_define com "true";
Common.define_value com Define.Dce "std";
com.info <- (fun msg p -> message ctx (CMInfo(msg,p)));
com.warning <- (fun w options msg p ->
match Warning.get_mode w (com.warning_options @ options) with
| WMEnable ->
message ctx (CMWarning(msg,p))
| WMDisable ->
()
);
com.error <- error ctx;
let filter_messages = (fun keep_errors predicate -> (List.filter (fun msg ->
(match msg with
| CMError(_,_) -> keep_errors;
| CMInfo(_,_) | CMWarning(_,_) -> predicate msg;)
) (List.rev ctx.messages))) in
com.get_messages <- (fun () -> (List.map (fun msg ->
(match msg with
| CMError(_,_) -> die "" __LOC__;
| CMInfo(_,_) | CMWarning(_,_) -> msg;)
) (filter_messages false (fun _ -> true))));
com.filter_messages <- (fun predicate -> (ctx.messages <- (List.rev (filter_messages true predicate))));
if CompilationServer.runs() then com.run_command <- run_command ctx;
com.class_path <- get_std_class_paths ();
com.std_path <- List.filter (fun p -> ExtString.String.ends_with p "std/" || ExtString.String.ends_with p "std\\") com.class_path

let rec process sctx comm args =
let t0 = get_time() in
ServerMessage.arguments args;
Expand All @@ -689,7 +725,10 @@ let rec process sctx comm args =
[ctx]
in
let run ctx =
Compiler.setup_common_context ctx;
(* Close any leftover descriptors from previous compilation *)
ctx.com.client_stdout#close (fun _ -> ());
ctx.com.client_stderr#close (fun _ -> ());
setup_common_context ctx comm;
Compiler.compile_safe ctx (fun () ->
let actx = Args.parse_args ctx in
begin match ctx.server_mode with
Expand Down
38 changes: 38 additions & 0 deletions src/context/common.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -287,6 +287,40 @@ type compiler_stage =
| CGenerationStart (* Generation is about to begin. *)
| CGenerationDone (* Generation just finished. *)


class server_pipe (r,w) =
let buf_size = 1024 in
object(self)
val mutable was_closed = false
val ch_in = Unix.in_channel_of_descr r
val ch_out = Unix.out_channel_of_descr w
val buf = Bytes.create buf_size

method write (s: string) =
output_string ch_out s;
flush ch_out

method read (f : string -> unit) =
let rec read () =
let i = input ch_in buf 0 1024 in
if i > 0 then begin
f (Bytes.unsafe_to_string (Bytes.sub buf 0 i));
if i = 1024 then read();
end;
in
read();

method close (f : string -> unit) =
if not was_closed then begin
was_closed <- true;
close_out ch_out;
self#read f;
close_in ch_in
end

method out = ch_out
end

type context = {
mutable stage : compiler_stage;
mutable cache : context_cache option;
Expand Down Expand Up @@ -316,6 +350,8 @@ type context = {
callbacks : compiler_callbacks;
defines : Define.define;
mutable print : string -> unit;
mutable client_stdout : server_pipe;
mutable client_stderr : server_pipe;
mutable get_macros : unit -> context option;
mutable run_command : string -> int;
file_lookup_cache : (string,string option) Hashtbl.t;
Expand Down Expand Up @@ -719,6 +755,8 @@ let create version args =
platform = Cross;
config = default_config;
print = (fun s -> print_string s; flush stdout);
client_stdout = new server_pipe (Unix.pipe());
client_stderr = new server_pipe (Unix.pipe());
run_command = Sys.command;
std_path = [];
class_path = [];
Expand Down
8 changes: 6 additions & 2 deletions src/macro/eval/evalStdLib.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2663,15 +2663,19 @@ module StdSys = struct
)

let stderr = vfun0 (fun () ->
encode_instance key_sys_io_FileOutput ~kind:(IOutChannel stderr)
let ctx = get_ctx() in
let com = ctx.curapi.get_com() in
encode_instance key_sys_io_FileOutput ~kind:(IOutChannel com.client_stderr#out)
)

let stdin = vfun0 (fun () ->
encode_instance key_sys_io_FileInput ~kind:(IInChannel(stdin,ref false))
)

let stdout = vfun0 (fun () ->
encode_instance key_sys_io_FileOutput ~kind:(IOutChannel stdout)
let ctx = get_ctx() in
let com = ctx.curapi.get_com() in
encode_instance key_sys_io_FileOutput ~kind:(IOutChannel com.client_stdout#out)
)

let systemName =
Expand Down

0 comments on commit d97ce07

Please sign in to comment.