haskal
/
utop
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

follow the changes of LTerm_history, perf regression fixed

This commit is contained in:
ZAN DoYe 2019-04-02 00:51:01 +08:00
parent 7df33e500a
commit fa6f1ee90f
1 changed files with 16 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
src/lib/uTop_main.ml
View File

@ -136,11 +136,11 @@ let parse_and_check input eos_is_error =
(result, Buffer.contents buf) (result, Buffer.contents buf)
let add_terminator s = let add_terminator s =
let terminator = UTop.get_phrase_terminator () in let terminator = UTop.get_phrase_terminator () |> Zed_string.unsafe_of_utf8 in
if Zed_utf8.ends_with s terminator then if Zed_string.ends_with s terminator then
s s
else else
s ^ terminator Zed_string.append s terminator
let is_accept : LTerm_read_line.action -> bool = function let is_accept : LTerm_read_line.action -> bool = function
| Accept -> true | Accept -> true
@ -150,7 +150,7 @@ let is_accept : LTerm_read_line.action -> bool = function
valid phrase (i.e. typable and compilable). It also returns valid phrase (i.e. typable and compilable). It also returns
warnings printed parsing. *) warnings printed parsing. *)
class read_phrase ~term = object(self) class read_phrase ~term = object(self)
inherit [Parsetree.toplevel_phrase UTop.result * string] LTerm_read_line.engine ~history:(LTerm_history.zed_contents UTop.history) () as super inherit [Parsetree.toplevel_phrase UTop.result * string] LTerm_read_line.engine ~history:(LTerm_history.contents UTop.history) () as super
inherit [Parsetree.toplevel_phrase UTop.result * string] LTerm_read_line.term term as super_term inherit [Parsetree.toplevel_phrase UTop.result * string] LTerm_read_line.term term as super_term
method create_temporary_file_for_external_editor = method create_temporary_file_for_external_editor =
@ -180,28 +180,28 @@ class read_phrase ~term = object(self)
is_accept action -> begin is_accept action -> begin
Zed_macro.add self#macro action; Zed_macro.add self#macro action;
let input = Zed_rope.to_string (Zed_edit.text self#edit) in let input = Zed_rope.to_string (Zed_edit.text self#edit) in
let input= Zed_string_UTF8.of_t input in
let input = let input =
if action == UTop.end_and_accept_current_phrase then if action == UTop.end_and_accept_current_phrase then
add_terminator input add_terminator input
else else
input input
in in
let input_utf8= Zed_string.to_utf8 input in
(* Toploop does that: *) (* Toploop does that: *)
Location.reset (); Location.reset ();
let eos_is_error = not !UTop.smart_accept in let eos_is_error = not !UTop.smart_accept in
try try
let result = parse_and_check input eos_is_error in let result = parse_and_check input_utf8 eos_is_error in
return_value <- Some result; return_value <- Some result;
LTerm_history.add UTop.history input; LTerm_history.add UTop.history input;
let out, warnings = result in let out, warnings = result in
begin begin
match out with match out with
| UTop.Value _ -> | UTop.Value _ ->
UTop_history.add_input UTop.stashable_session_history input; UTop_history.add_input UTop.stashable_session_history input_utf8;
UTop_history.add_warnings UTop.stashable_session_history warnings; UTop_history.add_warnings UTop.stashable_session_history warnings;
| (UTop.Error (_, msg)) -> | (UTop.Error (_, msg)) ->
UTop_history.add_bad_input UTop.stashable_session_history input; UTop_history.add_bad_input UTop.stashable_session_history input_utf8;
UTop_history.add_warnings UTop.stashable_session_history warnings; UTop_history.add_warnings UTop.stashable_session_history warnings;
UTop_history.add_error UTop.stashable_session_history msg; UTop_history.add_error UTop.stashable_session_history msg;
end; end;
@ -224,7 +224,7 @@ class read_phrase ~term = object(self)
styled.(i) <- (ch, LTerm_style.merge token_style style) styled.(i) <- (ch, LTerm_style.merge token_style style)
done done
in in
UTop_styles.stylise stylise (UTop_lexer.lex_string (UTop.get_syntax ()) (Zed_string_UTF8.of_t (LTerm_text.to_string styled))); UTop_styles.stylise stylise (UTop_lexer.lex_string (UTop.get_syntax ()) (Zed_string.to_utf8 (LTerm_text.to_string styled)));
if not last then if not last then
(* Parenthesis matching. *) (* Parenthesis matching. *)
@ -251,10 +251,10 @@ class read_phrase ~term = object(self)
UTop_complete.complete UTop_complete.complete
~syntax:(UTop.get_syntax ()) ~syntax:(UTop.get_syntax ())
~phrase_terminator:(UTop.get_phrase_terminator ()) ~phrase_terminator:(UTop.get_phrase_terminator ())
~input:(Zed_string_UTF8.of_t (Zed_rope.to_string self#input_prev)) ~input:(Zed_string.to_utf8 (Zed_rope.to_string self#input_prev))
in in
let words= words |> List.map (fun (k, v)-> let words= words |> List.map (fun (k, v)->
(Zed_string_UTF8.to_t_exn k, Zed_string_UTF8.to_t_exn v)) in (Zed_string.unsafe_of_utf8 k, Zed_string.unsafe_of_utf8 v)) in
self#set_completion pos words self#set_completion pos words
method! show_box = S.value self#mode <> LTerm_read_line.Edition || UTop.get_show_box () method! show_box = S.value self#mode <> LTerm_read_line.Edition || UTop.get_show_box ()
@ -958,17 +958,18 @@ module Emacs(M : sig end) = struct
let process_input add_to_history eos_is_error = let process_input add_to_history eos_is_error =
let input = read_data () in let input = read_data () in
let input_zed= Zed_string.unsafe_of_utf8 input in
let result, warnings = parse_and_check input eos_is_error in let result, warnings = parse_and_check input eos_is_error in
match result with match result with
| UTop.Value phrase -> | UTop.Value phrase ->
send "accept" ""; send "accept" "";
List.iter (send "stderr") (split_at ~trim:true '\n' warnings); List.iter (send "stderr") (split_at ~trim:true '\n' warnings);
if add_to_history then LTerm_history.add UTop.history input; if add_to_history then LTerm_history.add UTop.history input_zed;
ignore (process_checked_phrase phrase) ignore (process_checked_phrase phrase)
| UTop.Error (locs, msg) -> | UTop.Error (locs, msg) ->
send "accept" (String.concat "," (List.map (fun (a, b) -> Printf.sprintf "%d,%d" a b) locs)); send "accept" (String.concat "," (List.map (fun (a, b) -> Printf.sprintf "%d,%d" a b) locs));
List.iter (send "stderr") (split_at ~trim:true '\n' warnings); List.iter (send "stderr") (split_at ~trim:true '\n' warnings);
if add_to_history then LTerm_history.add UTop.history input; if add_to_history then LTerm_history.add UTop.history input_zed;
List.iter (send "stderr") (split_at ~trim:true '\n' msg) List.iter (send "stderr") (split_at ~trim:true '\n' msg)
let send_error locs msg warnings = let send_error locs msg warnings =
@ -1100,7 +1101,7 @@ module Emacs(M : sig end) = struct
send "history-bound" ""; send "history-bound" "";
loop_commands history_prev history_next loop_commands history_prev history_next
| entry :: history_prev -> | entry :: history_prev ->
List.iter (send "history-data") (split_at '\n' entry); List.iter (send "history-data") (split_at '\n' (Zed_string.to_utf8 entry));
send "history-end" ""; send "history-end" "";
loop_commands history_prev (input :: history_next) loop_commands history_prev (input :: history_next)
end end
@ -1113,7 +1114,7 @@ module Emacs(M : sig end) = struct
| entry :: history_next -> | entry :: history_next ->
List.iter (send "history-data") (split_at '\n' entry); List.iter (send "history-data") (split_at '\n' entry);
send "history-end" ""; send "history-end" "";
loop_commands (input :: history_prev) history_next loop_commands ((Zed_string.unsafe_of_utf8 input) :: history_prev) history_next
end end
| Some ("exit", code) -> | Some ("exit", code) ->
exit (int_of_string code) exit (int_of_string code)