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

src/lib/uTop_main.ml

@@ -316,75 +316,76 @@ 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 ->
+    | item :: items ->
-    let sig_item, _ = unwrap item in
+       let sig_item, _ = unwrap item in
-    let name, rec_status =
+       let name, rec_status =
-      match sig_item with
+         match sig_item with
-      | Outcometree.Osig_class (_, name, _, _, rs)
+         | Outcometree.Osig_class (_, name, _, _, rs)
-      | Outcometree.Osig_class_type (_, name, _, _, rs)
+         | Outcometree.Osig_class_type (_, name, _, _, rs)
-      | Outcometree.Osig_module (name, _, rs)
+         | Outcometree.Osig_module (name, _, rs)
-      | Outcometree.Osig_type ({ Outcometree.otype_name = name }, rs) ->
+         | Outcometree.Osig_type ({ Outcometree.otype_name = name }, rs) ->
-        (name, rs)
+            (name, rs)
-      | Outcometree.Osig_typext ({ Outcometree.oext_name = name}, _)
+         | Outcometree.Osig_typext ({ Outcometree.oext_name = name}, _)
-      | Outcometree.Osig_modtype (name, _)
+         | Outcometree.Osig_modtype (name, _)
 #if OCAML_VERSION < (4, 03, 0)
-      | Outcometree.Osig_value (name, _, _) ->
+         | Outcometree.Osig_value (name, _, _) ->
-        (name, Outcometree.Orec_not)
+            (name, Outcometree.Orec_not)
 #else
-      | Outcometree.Osig_value { oval_name = name; _ } ->
+         | Outcometree.Osig_value { oval_name = name; _ } ->
-        (name, Outcometree.Orec_not)
+            (name, Outcometree.Orec_not)
-      | Outcometree.Osig_ellipsis -> ("", Outcometree.Orec_not)
+         | Outcometree.Osig_ellipsis -> ("", Outcometree.Orec_not)
 #endif
-    in
+       in
-
+       let keep =
-    let keep =
+         name = "" || name.[0] <> '_' ||
-      name = "" || name.[0] <> '_' ||
+           (UTop.get_create_implicits () && is_implicit_name name)
-      (UTop.get_create_implicits () && is_implicit_name name)
+       in
-    in
+       if keep then
-    if keep then
+         aux (item :: acc) items
-      item :: map_items unwrap wrap items
+       else
-    else
+         (* Replace the [Orec_next] at the head of items by [Orec_first] *)
-      (* Replace the [Orec_next] at the head of items by [Orec_first] *)
+         let items =
-      let items =
+           match items with
-        match items with
+           | [] ->
-        | [] ->
+              []
-          []
+           | item :: items' ->
-        | item :: items' ->
+              let sig_item, extra = unwrap item in
-          let sig_item, extra = unwrap item in
+              match sig_item with
-          match sig_item with
+              | Outcometree.Osig_class (a, name, b, c, rs) ->
-          | Outcometree.Osig_class (a, name, b, c, rs) ->
+                 if rs = Outcometree.Orec_next then
-            if rs = Outcometree.Orec_next then
+                   wrap (Outcometree.Osig_class (a, name, b, c, Outcometree.Orec_first)) extra :: items'
-              wrap (Outcometree.Osig_class (a, name, b, c, Outcometree.Orec_first)) extra :: items'
+                 else
-            else
+                   items
-              items
+              | Outcometree.Osig_class_type (a, name, b, c, rs) ->
-          | Outcometree.Osig_class_type (a, name, b, c, rs) ->
+                 if rs = Outcometree.Orec_next then
-            if rs = Outcometree.Orec_next then
+                   wrap (Outcometree.Osig_class_type (a, name, b, c, Outcometree.Orec_first)) extra :: items'
-              wrap (Outcometree.Osig_class_type (a, name, b, c, Outcometree.Orec_first)) extra :: items'
+                 else
-            else
+                   items
-              items
+              | Outcometree.Osig_module (name, a, rs) ->
-          | Outcometree.Osig_module (name, a, rs) ->
+                 if rs = Outcometree.Orec_next then
-            if rs = Outcometree.Orec_next then
+                   wrap (Outcometree.Osig_module (name, a, Outcometree.Orec_first)) extra :: items'
-              wrap (Outcometree.Osig_module (name, a, Outcometree.Orec_first)) extra :: items'
+                 else
-            else
+                   items
-              items
+              | Outcometree.Osig_type (oty, rs) ->
-          | Outcometree.Osig_type (oty, rs) ->
+                 if rs = Outcometree.Orec_next then
-            if rs = Outcometree.Orec_next then
+                   wrap (Outcometree.Osig_type (oty, Outcometree.Orec_first)) extra :: items'
-              wrap (Outcometree.Osig_type (oty, Outcometree.Orec_first)) extra :: items'
+                 else
-            else
+                   items
-              items
+              | Outcometree.Osig_typext _
-          | Outcometree.Osig_typext _
 #if OCAML_VERSION >= (4, 03, 0)
-          | Outcometree.Osig_ellipsis
+              | Outcometree.Osig_ellipsis
 #endif
-          | Outcometree.Osig_modtype _
+              | Outcometree.Osig_modtype _
-          | Outcometree.Osig_value _ ->
+              | Outcometree.Osig_value _ ->
-            items
+                 items
-      in
+         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