Switch to tail-recursive versions of List functions

NOTICE

@@ -1,6 +1,6 @@
 
 The Piqi project
-Copyright 2009, 2010, 2011, 2012, 2013 Anton Lavrik
+Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015 Anton Lavrik
 
 This distribution includes software originally developed by Anton Lavrik as a
 part of the Piqi project (http://piqi.org).
@@ -82,3 +82,24 @@ src/descriptor.proto
     (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
     OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
+
+piqilib/piqi_piqirun.ml
+piqilib/piqi_util.ml
+=======================
+
+    Implementation of the following functions is based on the Core_kernel
+    library:
+
+        Piqi_piqirun.list_map
+        Piqi_util.list_append
+
+    Homepage: https://github.com/janestreet/core_kernel
+
+    Copyright (C) 2008-
+      Jane Street Group, LLC
+      1 New York Plaza, 33rd Floor
+      New York, NY 10004
+      USA
+
+    Licensed under the terms of the Apache License Version 2.
+

piqilib/Makefile

@@ -18,8 +18,8 @@ SOURCES = \
 	piqi_piqirun.ml \
 	piqi_piqi.ml \
 	\
-	piqloc.ml \
 	piqi_util.ml \
+	piqloc.ml \
 	piq_ast.ml \
 	\
 	piqi_impl_piqi.ml \

piqilib/piq_ast.ml

@@ -18,6 +18,9 @@
  * Piq AST (abstract syntax tree)
  *)
 
+module U = Piqi_util
+open U.Std
+
 
 module rec Piq_ast :
              sig
@@ -97,7 +100,7 @@ let transform_ast path f (ast:ast) =
   let rec aux p = function
     | `list l when p = [] -> (* leaf node *)
         (* f replaces, removes element, or splices elements of the list *)
-        let res = Piqi_util.flatmap f l in
+        let res = U.flatmap f l in
         `list res
     | x when p = [] -> (* leaf node *)
         (* expecting f to replace the existing value, no other modifications

piqilib/piq_gen.ml

@@ -15,7 +15,8 @@
 *)
 
 
-open Piqi_common
+module C = Piqi_common
+open C
 open Iolist 
 
 

piqilib/piq_lexer.ml

@@ -15,6 +15,9 @@
    limitations under the License.
 *)
 
+module C = Piqi_common
+open C.Std
+
 
 exception Error0 of string (* internally used error exception *)
 

piqilib/piq_parser.ml

@@ -15,7 +15,8 @@
 *)
 
 
-open Piqi_common
+module C = Piqi_common
+open C
 
 
 module L = Piq_lexer
@@ -465,7 +466,7 @@ let read_next ?(expand_abbr=true) (fname, lexstream) =
     (match name with
       | #Piq_ast.form_name -> () (* this is valid form *)
       | obj when args <> [] ->
-          Piqi_common.error obj
+          C.error obj
             "invalid form name: only words, names and typenames are allowed"
       | _ ->
           (* this is an ast element in parenthesis -- passing it through; we

piqilib/piqi_command.ml

@@ -21,6 +21,7 @@
 
 
 module C = Piqi_common
+open C.Std
 
 
 (* command-line parameters *)
@@ -214,9 +215,9 @@ let run_command f =
     | C.Piqi_error s ->
         cleanup_on_error ();
         die s
-    | Piqi_common.Error (loc, s) ->
+    | C.Error (loc, s) ->
         cleanup_on_error ();
-        die (Piqi_common.strerr loc s)
+        die (C.strerr loc s)
     | Sys_error s ->
         cleanup_on_error ();
         die ("uncaught system error: " ^ s)

piqilib/piqi_common.ml

@@ -51,6 +51,11 @@ module Iolist = Piqi_iolist
 
 module U = Piqi_util
 
+(* NOTE: Std can be opened explicitly as U.Std or C.Std or included implicitly
+ * by opening Piqi_common *)
+module Std = U.Std
+include Std
+
 
 type piq_ast = Piq_ast.ast
 

piqilib/piqi_config.ml

@@ -14,6 +14,9 @@
    limitations under the License.
 *)
 
+module U = Piqi_util
+open U.Std
+
 
 (* .piqi search paths *)
 let paths = ref []
@@ -31,7 +34,7 @@ let piqi_path =
         | "Win32" -> ';'
         | _ -> ':'
     in
-    let l = Piqi_util.string_split s sep in
+    let l = U.string_split s sep in
     List.filter (fun s -> s <> "") l (* remove empty segments *)
   with
     Not_found -> []

piqilib/piqi_file.ml

@@ -99,11 +99,11 @@ let find_piqi_file ?(extra_paths=[]) modname =
        *)
       if String.contains base_name '_'
       then
-        let base_name = Piqi_util.underscores_to_dashes base_name in
+        let base_name = U.underscores_to_dashes base_name in
         check_exact_file dir_name base_name ext
       else if String.contains base_name '-'
       then
-        let base_name = Piqi_util.dashes_to_underscores base_name in
+        let base_name = U.dashes_to_underscores base_name in
         check_exact_file dir_name base_name ext
       else false
   in

piqilib/piqi_json_gen.ml

@@ -45,6 +45,9 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
+module C = Piqi_common
+open C.Std
+
 
 type json = Piqi_json_type.json
 

piqilib/piqi_json_parser.mll

@@ -46,6 +46,9 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
 {
+  module C = Piqi_common
+  open C.Std
+
   type json = Piqi_json_type.json
 
   module Lexing =
@@ -120,7 +123,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
   let custom_error descr v lexbuf =
     let loc = location v lexbuf in
-    Piqi_common.error_at loc descr
+    C.error_at loc descr
 
 
   let lexer_error descr v lexbuf =

piqilib/piqi_name.ml

@@ -15,6 +15,7 @@
 *)
 
 module U = Piqi_util
+open U.Std
 
 
 let has_parent name =

piqilib/piqi_piqirun.ml

@@ -59,6 +59,58 @@ type string_slice =
   }
 
 
+(* the below alternative tail-recursive implementation of stdlib's List.map is
+ * copied from Core (https://github.com/janestreet/core_kernel)
+ *
+ * note that the order of arguments was changed back to match the one of
+ * stdlib's
+ *)
+
+let list_map_slow f l = List.rev (List.rev_map f l)
+
+let rec list_count_map f l ctr =
+  match l with
+  | [] -> []
+  | [x1] ->
+    let f1 = f x1 in
+    [f1]
+  | [x1; x2] ->
+    let f1 = f x1 in
+    let f2 = f x2 in
+    [f1; f2]
+  | [x1; x2; x3] ->
+    let f1 = f x1 in
+    let f2 = f x2 in
+    let f3 = f x3 in
+    [f1; f2; f3]
+  | [x1; x2; x3; x4] ->
+    let f1 = f x1 in
+    let f2 = f x2 in
+    let f3 = f x3 in
+    let f4 = f x4 in
+    [f1; f2; f3; f4]
+  | x1 :: x2 :: x3 :: x4 :: x5 :: tl ->
+    let f1 = f x1 in
+    let f2 = f x2 in
+    let f3 = f x3 in
+    let f4 = f x4 in
+    let f5 = f x5 in
+    f1 :: f2 :: f3 :: f4 :: f5 ::
+      (if ctr > 1000
+        then list_map_slow f tl
+        else list_count_map f tl (ctr + 1))
+
+let list_map f l = list_count_map f l 0
+
+
+module List =
+  struct
+    include List
+
+    let map = list_map
+  end
+
+
 module IBuf =
   struct
     type t =

piqilib/piqi_pp.ml

@@ -15,7 +15,8 @@
 *)
 
 
-open Piqi_common 
+module C = Piqi_common
+open C
 
 
 let prettyprint_ast ch ast =

piqilib/piqi_util.ml

@@ -18,6 +18,68 @@
  * commonly used utility functions
  *)
 
+
+(* the below alternative tail-recursive implementation of stdlib's List.append
+ * was copied from Core (https://github.com/janestreet/core_kernel)
+ *)
+
+let list_slow_append l1 l2 = List.rev_append (List.rev l1) l2
+
+
+let rec list_count_append l1 l2 count =
+  match l2 with
+  | [] -> l1
+  | _ ->
+    match l1 with
+    | []               ->                         l2
+    | [x1]             -> x1                   :: l2
+    | [x1; x2]         -> x1 :: x2             :: l2
+    | [x1; x2; x3]     -> x1 :: x2 :: x3       :: l2
+    | [x1; x2; x3; x4] -> x1 :: x2 :: x3 :: x4 :: l2
+    | x1 :: x2 :: x3 :: x4 :: x5 :: tl ->
+      x1 :: x2 :: x3 :: x4 :: x5 ::
+        (if count > 1000
+         then list_slow_append tl l2
+         else list_count_append tl l2 (count + 1))
+
+let list_append l1 l2 = list_count_append l1 l2 0
+
+
+let list_concat l =
+  let rec aux accu = function
+    | [] -> List.rev accu
+    | h::t -> aux (List.rev_append h accu) t
+  in
+  aux [] l
+
+
+module Std =
+  struct
+    module List =
+      struct
+        include List
+
+        let map = Piqi_piqirun.list_map
+        let append = list_append
+        let concat = list_concat
+      end
+
+    let ( @ ) = List.append
+  end
+
+
+open Std
+
+
+(* list flatmap *)
+let flatmap f l =
+  let rec aux accu = function
+    | [] -> List.rev accu
+    | h::t -> aux (List.rev_append (f h) accu) t
+  in
+  aux [] l
+
+
 (* substitute character [x] with [y] in string [s] *)
 let string_subst_char s x y =
   if not (String.contains s x)
@@ -99,10 +161,6 @@ let with_bool bool_ref value f =
      raise exn
 
 
-(* list flatmap *)
-let flatmap f l =  List.concat (List.map f l)
-
-
 let find_dups l =
   let rec aux = function
     | [] -> None

piqilib/piqi_xml.ml

@@ -26,6 +26,7 @@
 
 
 module C = Piqi_common
+open C.Std
 
 
 type xml = Piqi_xml_type.xml

piqilib/piqloc.ml

@@ -15,6 +15,9 @@
    limitations under the License.
 *)
 
+module U = Piqi_util
+open U.Std
+
 
 type loc = string * int * int (* file, line, column *)
 

piqilib/piqobj.ml

@@ -137,6 +137,8 @@ and Any:
 
 
 module C = Piqi_common
+module U = C.U
+open C.Std
 
 
 let default_any =
@@ -264,7 +266,7 @@ let resolve_obj ?(piqtype: Piqi_impl_piqi.piqtype option) (any :Piqobj.any) :uni
       (* cache typename
        * XXX: do not use fully qualified names for locally defined types? *)
       if any.typename = None
-      then any.typename <- Some (Piqi_common.full_piqi_typename piqtype);
+      then any.typename <- Some (C.full_piqi_typename piqtype);
 
       let obj = of_any piqtype any in
       any.obj <- obj
@@ -329,7 +331,7 @@ let json_of_any (any: Piqobj.any) :Piqi_json_type.json option =
          * that we can print it nicely while preserving the original int, float
          * and string literals *)
         Piqloc.pause (); (* no need to preserve location information here *)
-        let json_ast = Piqi_util.with_bool Piqi_config.pp_mode true (fun () -> !json_of_string s) in
+        let json_ast = U.with_bool Piqi_config.pp_mode true (fun () -> !json_of_string s) in
         Piqloc.resume ();
         Some json_ast
     | (Some _) as res -> res