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

Make more functions tail-recursive, and use tail-rec List functions (#251)

This commit is contained in:
Guillaume Petiot 2018-08-23 18:53:07 +02:00 committed by Jérémie Dimino
parent 74749bb720
commit 081e49d882
5 changed files with 114 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/lib/uTop.ml
View File

@ -104,7 +104,7 @@ let default_keywords = [
"when"; "while"; "with"; "try_lwt"; "finally"; "for_lwt"; "lwt";
]
let keywords = ref (List.fold_right String_set.add default_keywords String_set.empty)
let keywords = ref (String_set.of_list default_keywords)
let add_keyword kwd = keywords := String_set.add kwd !keywords
(* +-----------------------------------------------------------------+
@ -750,24 +750,24 @@ let split_words str =
| ' ' | '\t' | '\r' | '\n' | ',' -> true
| _ -> false
in
let rec skip i =
let rec skip acc i =
if i = len then
[]
acc
else
if is_sep str.[i] then
skip (i + 1)
skip acc (i + 1)
else
extract i (i + 1)
and extract i j =
extract acc i (i + 1)
and extract acc i j =
if j = len then
[String.sub str i (j - i)]
(String.sub str i (j - i)) :: acc
else
if is_sep str.[j] then
String.sub str i (j - i) :: skip (j + 1)
skip (String.sub str i (j - i) :: acc) (j + 1)
else
extract i (j + 1)
extract acc i (j + 1)
in
skip 0
List.rev (skip [] 0)
let require packages =
try

14
src/lib/uTop_complete.ml
View File

@ -771,12 +771,14 @@ let labels_of_newclass longident =
+-----------------------------------------------------------------+ *)
(* Filter blanks and comments except for the last token. *)
let rec filter tokens =
match tokens with
| [] -> []
| [((Blanks | Comment (_, true)), loc)] -> [(Blanks, loc)]
| ((Blanks | Comment (_, true)), _) :: rest -> filter rest
| x :: rest -> x :: filter rest
let filter tokens =
let rec aux acc = function
| [] -> acc
| [((Blanks | Comment (_, true)), loc)] -> (Blanks, loc) :: acc
| ((Blanks | Comment (_, true)), _) :: rest -> aux acc rest
| x :: rest -> aux (x :: acc) rest
in
List.rev (aux [] tokens)
(* Reverse and filter blanks and comments except for the last
token. *)

23
src/lib/uTop_history.ml
View File

@ -33,18 +33,21 @@ let strip_colors s =
with
| Not_found -> None
in
let rec find_color_escapes offset =
match find_escape offset with
| None -> [offset, len]
| Some esc_offset ->
try
let i = String.index_from s esc_offset 'm' in
(offset, esc_offset) :: find_color_escapes (i + 1)
with
| Not_found -> [offset, len]
let find_color_escapes offset =
let rec aux acc offset =
match find_escape offset with
| None -> (offset, len) :: acc
| Some esc_offset ->
try
let i = String.index_from s esc_offset 'm' in
aux ((offset, esc_offset) :: acc) (i + 1)
with
| Not_found -> (offset, len) :: acc
in
aux [] offset
in
find_color_escapes 0
|> List.map (fun (i, j) -> String.sub s i (j - i))
|> List.rev_map (fun (i, j) -> String.sub s i (j - i))
|> String.concat ""
let add history v =

143
src/lib/uTop_main.ml
View File

@ -316,75 +316,76 @@ let is_implicit_name name =
with
Failure _ -> false
let rec map_items unwrap wrap items =
match items with
| [] ->
[]
| item :: items ->
let sig_item, _ = unwrap item in
let name, rec_status =
match sig_item with
| Outcometree.Osig_class (_, name, _, _, rs)
| Outcometree.Osig_class_type (_, name, _, _, rs)
| Outcometree.Osig_module (name, _, rs)
| Outcometree.Osig_type ({ Outcometree.otype_name = name }, rs) ->
(name, rs)
| Outcometree.Osig_typext ({ Outcometree.oext_name = name}, _)
| Outcometree.Osig_modtype (name, _)
let map_items unwrap wrap items =
let rec aux acc = function
| [] ->
acc
| item :: items ->
let sig_item, _ = unwrap item in
let name, rec_status =
match sig_item with
| Outcometree.Osig_class (_, name, _, _, rs)
| Outcometree.Osig_class_type (_, name, _, _, rs)
| Outcometree.Osig_module (name, _, rs)
| Outcometree.Osig_type ({ Outcometree.otype_name = name }, rs) ->
(name, rs)
| Outcometree.Osig_typext ({ Outcometree.oext_name = name}, _)
| Outcometree.Osig_modtype (name, _)
#if OCAML_VERSION < (4, 03, 0)
| Outcometree.Osig_value (name, _, _) ->
(name, Outcometree.Orec_not)
| Outcometree.Osig_value (name, _, _) ->
(name, Outcometree.Orec_not)
#else
| Outcometree.Osig_value { oval_name = name; _ } ->
(name, Outcometree.Orec_not)
| Outcometree.Osig_ellipsis -> ("", Outcometree.Orec_not)
| Outcometree.Osig_value { oval_name = name; _ } ->
(name, Outcometree.Orec_not)
| Outcometree.Osig_ellipsis -> ("", Outcometree.Orec_not)
#endif
in
let keep =
name = "" || name.[0] <> '_' ||
(UTop.get_create_implicits () && is_implicit_name name)
in
if keep then
item :: map_items unwrap wrap items
else
(* Replace the [Orec_next] at the head of items by [Orec_first] *)
let items =
match items with
| [] ->
[]
| item :: items' ->
let sig_item, extra = unwrap item in
match sig_item with
| Outcometree.Osig_class (a, name, b, c, rs) ->
if rs = Outcometree.Orec_next then
wrap (Outcometree.Osig_class (a, name, b, c, Outcometree.Orec_first)) extra :: items'
else
items
| Outcometree.Osig_class_type (a, name, b, c, rs) ->
if rs = Outcometree.Orec_next then
wrap (Outcometree.Osig_class_type (a, name, b, c, Outcometree.Orec_first)) extra :: items'
else
items
| Outcometree.Osig_module (name, a, rs) ->
if rs = Outcometree.Orec_next then
wrap (Outcometree.Osig_module (name, a, Outcometree.Orec_first)) extra :: items'
else
items
| Outcometree.Osig_type (oty, rs) ->
if rs = Outcometree.Orec_next then
wrap (Outcometree.Osig_type (oty, Outcometree.Orec_first)) extra :: items'
else
items
| Outcometree.Osig_typext _
in
let keep =
name = "" || name.[0] <> '_' ||
(UTop.get_create_implicits () && is_implicit_name name)
in
if keep then
aux (item :: acc) items
else
(* Replace the [Orec_next] at the head of items by [Orec_first] *)
let items =
match items with
| [] ->
[]
| item :: items' ->
let sig_item, extra = unwrap item in
match sig_item with
| Outcometree.Osig_class (a, name, b, c, rs) ->
if rs = Outcometree.Orec_next then
wrap (Outcometree.Osig_class (a, name, b, c, Outcometree.Orec_first)) extra :: items'
else
items
| Outcometree.Osig_class_type (a, name, b, c, rs) ->
if rs = Outcometree.Orec_next then
wrap (Outcometree.Osig_class_type (a, name, b, c, Outcometree.Orec_first)) extra :: items'
else
items
| Outcometree.Osig_module (name, a, rs) ->
if rs = Outcometree.Orec_next then
wrap (Outcometree.Osig_module (name, a, Outcometree.Orec_first)) extra :: items'
else
items
| Outcometree.Osig_type (oty, rs) ->
if rs = Outcometree.Orec_next then
wrap (Outcometree.Osig_type (oty, Outcometree.Orec_first)) extra :: items'
else
items
| Outcometree.Osig_typext _
#if OCAML_VERSION >= (4, 03, 0)
| Outcometree.Osig_ellipsis
| Outcometree.Osig_ellipsis
#endif
| Outcometree.Osig_modtype _
| Outcometree.Osig_value _ ->
items
in
map_items unwrap wrap items
| Outcometree.Osig_modtype _
| Outcometree.Osig_value _ ->
items
in
aux acc items
in
List.rev (aux [] items)
let print_out_signature pp items =
if UTop.get_hide_reserved () then
@ -535,7 +536,7 @@ let is_eval = function
| _ -> false
(* Returns the rewrite rule associated to a type, if any. *)
let rec rule_of_type typ =
let rule_of_type typ =
match (Ctype.expand_head !Toploop.toplevel_env typ).Types.desc with
| Types.Tconstr (path, _, _) -> begin
try
@ -768,18 +769,18 @@ module Emacs(M : sig end) = struct
let command_oc = Unix.out_channel_of_descr (Unix.dup Unix.stdout)
let split_at ?(trim=false) ch str =
let rec aux i j =
let rec aux acc i j =
if j = String.length str then
if trim && i = j then
[]
acc
else
[String.sub str i (j - i)]
(String.sub str i (j - i)) :: acc
else if str.[j] = ch then
String.sub str i (j - i) :: aux (j + 1) (j + 1)
aux (String.sub str i (j - i) :: acc) (j + 1) (j + 1)
else
aux i (j + 1)
aux acc i (j + 1)
in
aux 0 0
List.rev (aux [] 0 0)
(* +---------------------------------------------------------------+
| Sending commands to Emacs |

23
src/lib/uTop_styles.ml
View File

@ -98,21 +98,20 @@ let load () =
Lwt_log.error_f "cannot load styles from %S: %s: %s" fn func (Unix.error_message error)
| exn -> Lwt.fail exn)
let rec stylise_filter_layout stylise tokens =
match tokens with
| [] ->
[]
| (Comment (Comment_reg, _), loc) :: tokens ->
let stylise_filter_layout stylise tokens =
let aux acc = function
| (Comment (Comment_reg, _), loc) ->
stylise loc styles.style_comment;
stylise_filter_layout stylise tokens
| (Comment (Comment_doc, _), loc) :: tokens ->
acc
| (Comment (Comment_doc, _), loc) ->
stylise loc styles.style_doc;
stylise_filter_layout stylise tokens
| (Blanks, loc) :: tokens ->
acc
| (Blanks, loc) ->
stylise loc styles.style_blanks;
stylise_filter_layout stylise tokens
| x :: tokens ->
x :: stylise_filter_layout stylise tokens
acc
| x -> x :: acc
in
List.rev (List.fold_left aux [] tokens)
let rec stylise_rec stylise tokens =
match tokens with