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

src/lib/uTop.ml

@@ -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)
+        extract acc i (i + 1)
-  and extract i j =
+  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

src/lib/uTop_complete.ml

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

src/lib/uTop_history.ml

@@ -33,18 +33,21 @@ let strip_colors s =
     with
     | Not_found -> None
   in
-  let rec find_color_escapes offset =
+  let find_color_escapes offset =
+    let rec aux acc offset =
       match find_escape offset with
-    | None -> [offset, len]
+      | None -> (offset, len) :: acc
       | Some esc_offset ->
          try
            let i = String.index_from s esc_offset 'm' in
-        (offset, esc_offset) :: find_color_escapes (i + 1)
+           aux ((offset, esc_offset) :: acc) (i + 1)
          with
-      | Not_found -> [offset, len]
+         | 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 =

src/lib/uTop_main.ml

@@ -316,10 +316,10 @@ let is_implicit_name name =
   with
     Failure _ -> false
 
-let rec map_items unwrap wrap items =
+let map_items unwrap wrap items =
-  match items with
+  let rec aux acc = function
     | [] ->
-    []
+       acc
     | item :: items ->
        let sig_item, _ = unwrap item in
        let name, rec_status =
@@ -340,13 +340,12 @@ let rec map_items unwrap wrap items =
          | 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
+         aux (item :: acc) items
        else
          (* Replace the [Orec_next] at the head of items by [Orec_first] *)
          let items =
@@ -384,7 +383,9 @@ let rec map_items unwrap wrap items =
               | Outcometree.Osig_value _ ->
                  items
          in
-      map_items unwrap wrap items
+         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                                     |

src/lib/uTop_styles.ml

@@ -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 =
+let stylise_filter_layout stylise tokens =
-  match tokens with
+  let aux acc = function
-    | [] ->
+    | (Comment (Comment_reg, _), loc) ->
-        []
-    | (Comment (Comment_reg, _), loc) :: tokens ->
         stylise loc styles.style_comment;
-        stylise_filter_layout stylise tokens
+        acc
-    | (Comment (Comment_doc, _), loc) :: tokens ->
+    | (Comment (Comment_doc, _), loc) ->
         stylise loc styles.style_doc;
-        stylise_filter_layout stylise tokens
+        acc
-    | (Blanks, loc) :: tokens ->
+    | (Blanks, loc) ->
         stylise loc styles.style_blanks;
-        stylise_filter_layout stylise tokens
+        acc
-    | x :: tokens ->
+    | x -> x :: acc
-        x :: stylise_filter_layout stylise tokens
+  in
+  List.rev (List.fold_left aux [] tokens)
 
 let rec stylise_rec stylise tokens =
   match tokens with