[@tailcall] statements

Basis/AtomicShell.ml

@@ -27,7 +27,7 @@ let make ?(index=0) contr =
   let center = Cs.center contr.(0) in
   let rec unique_center = function
   | 0 -> true
-  | i -> if Cs.center contr.(i) = center then unique_center (i-1) else false
+  | i -> if Cs.center contr.(i) = center then (unique_center [@tailcall]) (i-1) else false
   in
   if not (unique_center (Array.length contr - 1)) then
     invalid_arg "ContractedAtomicShell.make Coordinate.t differ";
@@ -35,7 +35,7 @@ let make ?(index=0) contr =
   let ang_mom = Cs.ang_mom contr.(0) in
   let rec unique_angmom = function
   | 0 -> true
-  | i -> if Cs.ang_mom contr.(i) = ang_mom then unique_angmom (i-1) else false
+  | i -> if Cs.ang_mom contr.(i) = ang_mom then (unique_angmom [@tailcall]) (i-1) else false
   in
   if not (unique_angmom (Array.length contr - 1)) then
     invalid_arg "ContractedShell.make: AngularMomentum.t differ";

Basis/ContractedShell.ml

@@ -27,7 +27,7 @@ let make ?(index=0) lc =
   let center = Ps.center prim.(0) in
   let rec unique_center = function
   | 0 -> true
-  | i -> if Ps.center prim.(i) = center then unique_center (i-1) else false
+  | i -> if Ps.center prim.(i) = center then (unique_center [@tailcall]) (i-1) else false
   in
   if not (unique_center (Array.length prim - 1)) then
     invalid_arg "ContractedShell.make Coordinate.t differ";
@@ -35,7 +35,7 @@ let make ?(index=0) lc =
   let ang_mom = Ps.ang_mom prim.(0) in
   let rec unique_angmom = function
   | 0 -> true
-  | i -> if Ps.ang_mom prim.(i) = ang_mom then unique_angmom (i-1) else false
+  | i -> if Ps.ang_mom prim.(i) = ang_mom then (unique_angmom [@tailcall]) (i-1) else false
   in
   if not (unique_angmom (Array.length prim - 1)) then
     invalid_arg "ContractedShell.make: AngularMomentum.t differ";

Basis/ContractedShellPair.ml

@@ -125,7 +125,7 @@ let of_contracted_shell_array ?(cutoff=Constants.epsilon) basis =
   | (s_a :: rest) as l ->
     let new_accu = 
       (List.map (fun s_b -> make ~cutoff s_a s_b) l) :: accu
-    in loop new_accu rest
+    in (loop [@tailcall]) new_accu rest
   in
   loop [] (List.rev (Array.to_list basis))
   |> List.concat
@@ -138,7 +138,7 @@ let equivalent x y =
   let rec eqv = function
   | 0 -> true
   | k -> if Psp.equivalent x.(k) y.(k) then
-            eqv (k-1)
+            (eqv [@tailcall]) (k-1)
          else false
   in eqv (Array.length x - 1)
 
@@ -153,8 +153,13 @@ let unique sp =
   let rec aux accu = function
   | [] -> accu
   | x::rest -> 
-      try ignore @@ List.find (fun y -> equivalent x y) accu; aux accu rest
+      let newaccu = 
-      with Not_found -> aux (x::accu) rest
+        try
+          ignore @@ List.find (fun y -> equivalent x y) accu;
+          accu
+        with Not_found -> (x::accu)
+      in
+      (aux [@tailcall]) newaccu rest
   in
   aux [] sp
 

Basis/ERI.ml

@@ -28,7 +28,7 @@ module Zm = struct
         begin
           result.(k) <- result.(k) *. accu;
           let new_accu = -. accu *. exp_pq in
-          aux new_accu (k+1) (l-1)
+          (aux [@tailcall]) new_accu (k+1) (l-1)
         end
     in
     let f = two_over_sq_pi *. (sqrt exp_pq) in

Basis/F12RR.ml

@@ -167,7 +167,7 @@ let rec hvrr angMom_a angMom_b angMom_c angMom_d
     in
     let rec aux accu = function
       | 0 -> accu +. coef_g.(0) *. x.(0) *. y.(0) *. z.(0)
-      | i -> aux (accu +. coef_g.(i) *. x.(i) *. y.(i) *. z.(i)) (i-1)
+      | i -> (aux [@tailcall]) (accu +. coef_g.(i) *. x.(i) *. y.(i) *. z.(i)) (i-1)
     in
     aux 0. (Array.length x - 1)
 

CI/CI.ml

@@ -156,15 +156,15 @@ let create_matrix_arbitrary f det_space =
                     | (js, j_beta)::r_singles ->
                       begin
                         match compare js j_dets.(j') with
-                        | -1 -> aux r_singles j'
+                        | -1 -> (aux [@tailcall]) r_singles j'
                         |  0 ->
                           let kj =
                             Determinant.of_spindeterminants j_alfa j_beta
                           in (update
                                 (index_start.(i) + i') (index_start.(j) + j' + 1)
                                 1 (Determinant.degree_beta ki kj) ki kj;
-                              aux r_singles (j'+1);)
+                              (aux [@tailcall]) r_singles (j'+1);)
-                        |  1 -> if (j' < Array.length j_dets) then aux singles (j'+1)
+                        |  1 -> if (j' < Array.length j_dets) then (aux [@tailcall]) singles (j'+1)
                         |  _ -> assert false
                       end
                   in aux singles 0 
@@ -180,15 +180,15 @@ let create_matrix_arbitrary f det_space =
                     | (js, j_beta)::r_doubles ->
                       begin
                         match compare js j_dets.(j') with
-                        | -1 -> aux r_doubles j'
+                        | -1 -> (aux [@tailcall]) r_doubles j'
                         |  0 ->
                           let kj =
                             Determinant.of_spindeterminants j_alfa j_beta
                           in (update
                                 (index_start.(i) + i') (index_start.(j) + j' + 1)
                                 0 (Determinant.degree_beta ki kj) ki kj;
-                              aux r_doubles (j'+1);)
+                              (aux [@tailcall]) r_doubles (j'+1);)
-                        |  1 -> if (j' < Array.length j_dets) then aux doubles (j'+1)
+                        |  1 -> if (j' < Array.length j_dets) then (aux [@tailcall]) doubles (j'+1)
                         |  _ -> assert false
                       end
                   in aux doubles 0 

CI/CIMatrixElement.ml

@@ -41,7 +41,7 @@ let non_zero integrals degree_a degree_b ki kj =
             let new_accu = 
               List.fold_left (fun accu j -> accu +. two_e i j i j spin spin) accu rest
             in
-            aux_same spin new_accu rest
+            (aux_same [@tailcall]) spin new_accu rest
         in
         let rec aux_opposite accu other = function
           | [] -> accu
@@ -49,7 +49,7 @@ let non_zero integrals degree_a degree_b ki kj =
             let new_accu =
               List.fold_left (fun accu j -> accu +. two_e i j i j Spin.Alfa Spin.Beta) accu other
             in
-            aux_opposite new_accu other rest
+            (aux_opposite [@tailcall]) new_accu other rest
         in
         (aux_same Spin.Alfa 0. mo_a)  +.  (aux_same Spin.Beta 0. mo_b)  +.
         (aux_opposite 0. mo_a mo_b)

CI/CIMatrixElementF12.ml

@@ -28,7 +28,7 @@ let non_zero integrals degree_a degree_b ki kj =
             let new_accu = 
               List.fold_left (fun accu j -> accu +. two_e i j i j spin spin) accu rest
             in
-            aux_same spin new_accu rest
+            (aux_same [@tailcall]) spin new_accu rest
         in
         let rec aux_opposite accu other = function
           | [] -> accu
@@ -36,7 +36,7 @@ let non_zero integrals degree_a degree_b ki kj =
             let new_accu =
               List.fold_left (fun accu j -> accu +. two_e i j i j Spin.Alfa Spin.Beta) accu other
             in
-            aux_opposite new_accu other rest
+            (aux_opposite [@tailcall]) new_accu other rest
         in
         (aux_same Spin.Alfa 0. mo_a)  +.  (aux_same Spin.Beta 0. mo_b)  +.
         (aux_opposite 0. mo_a mo_b)

CI/DeterminantSpace.ml

@@ -135,7 +135,7 @@ let determinant t i =
         let index_start = a.index_start in
         let rec loop i_alfa =
           if index_start.(i_alfa) <= i then
-            loop (i_alfa+1) 
+            (loop [@tailcall]) (i_alfa+1) 
           else i_alfa
         in loop 0
       in

CI/F12CI.ml

@@ -130,9 +130,9 @@ let p12 det_space =
                   (Spindeterminant.of_bitstring  @@
                     Bitstring.(logor a (logand not_aux_mask beta))
                   ) )
+(*
       | 1, 0 
       | 0, 1 -> Some (Determinant.negate_phase k)
-(*
       | 0, 1 -> Some (Determinant.vac 1)
 *)
       | _ -> None

CI/Spindeterminant.ml

@@ -109,17 +109,17 @@ let of_list n l =
   |> List.fold_left (fun accu p -> creation p accu) (vac n)
 
 
-let rec to_list = function
+let to_list = function
   | None -> []
   | Some spindet ->
     let rec aux accu z =
       if not (Bitstring.is_zero z) then
         let element = ((Bitstring.trailing_zeros z)+1) in
-        aux (element::accu) (Bitstring.logand z (Bitstring.minus_one z) )
+        (aux [@tailcall]) (element::accu) (Bitstring.logand z (Bitstring.minus_one z) )
       else List.rev accu
     in aux [] spindet.bitstring
 
-let rec to_array t = 
+let to_array t = 
   to_list t
   |> Array.of_list
 

MOBasis/MOBasis.ml

@@ -188,7 +188,7 @@ let pp_mo ?(start=1) ?finish ppf t =
               ~print_foot:false
               () ) (lacpy ~ac:first ~n:(min 5 (cols-first+1)) (t.mo_coef)) ;
           Format.fprintf ppf "@]@;@;@]";
-          aux (first+5) 
+          (aux [@tailcall]) (first+5) 
         end
     in
     aux start 

Parallel_mpi/Farm.ml

@@ -52,7 +52,7 @@ let run_parallel_server ~comm ~ordered stream =
       let rec wait_and_receive () = 
         match Mpi.iprobe Mpi.any_source Mpi.any_tag comm with
         | Some _ -> Mpi.receive_status  Mpi.any_source  Mpi.any_tag  comm
-        | None   -> (Unix.sleepf 0.001 ; wait_and_receive ())
+        | None   -> (Unix.sleepf 0.001 ; (wait_and_receive [@tailcall]) ())
       in
       wait_and_receive ()
     in
@@ -158,7 +158,7 @@ let run_parallel_server ~comm ~ordered stream =
               | None -> None
               | Some (task_id, result) -> 
                 if task_id = i then Some result
-                else (Hashtbl.add buffer task_id result; loop () )
+                else (Hashtbl.add buffer task_id result; (loop [@tailcall]) () )
             in loop ()
         end
 
@@ -204,7 +204,7 @@ let run_parallel_client ~comm f =
         debug @@ Printf.sprintf "Before send task_id %d" task_id ;
         Mpi.send  (Some (task_id, result))  0  0  comm;
         debug @@ Printf.sprintf "After send task_id %d" task_id ;
-        run ()
+        (run [@tailcall]) ()
       end
   in
   run ();

Parallel_serial/Farm.ml

@@ -1,7 +1,7 @@
 (* Single process function *)
 let run_sequential f stream =
 
-  let rec next _ =
+  let next _ =
     try
       let task = Stream.next stream in
       Some (f task) 

SCF/HartreeFock.ml

@@ -593,9 +593,7 @@ let make
           | Some result -> Some result
           | None ->
             begin
-              let data =
+              let data = iteration (n-1) in
-                (iteration (n-1)) 
-              in
               match data with
               | None -> None
               | Some data -> 

Utils/AngularMomentum.ml

@@ -84,7 +84,7 @@ let zkey_array a =
       match y with
       | 0 -> (create_z xyz)::accu
       | i -> let ynew = y-1 in
-        create_y ( (create_z xyz)::accu) (Powers.of_int_tuple (x,ynew,z))
+        (create_y [@tailcall]) ( (create_z xyz)::accu) (Powers.of_int_tuple (x,ynew,z))
     in
     let rec create_x accu xyz =
       let { x ; y ; z } = xyz in
@@ -92,7 +92,7 @@ let zkey_array a =
       | 0 -> (create_y [] xyz)@accu
       | i -> let xnew = x-1 in
         let ynew = l-xnew in
-        create_x ((create_y [] xyz)@accu) (Powers.of_int_tuple (xnew, ynew, z))
+        (create_x [@tailcall]) ((create_y [] xyz)@accu) (Powers.of_int_tuple (xnew, ynew, z))
     in
     create_x [] (Powers.of_int_tuple (l,0,0))
     |> List.rev

Utils/Bitstring.ml

@@ -164,7 +164,8 @@ let rec to_list ?(accu=[]) = function
   | t -> let newlist =
            (trailing_zeros t + 1)::accu
          in
-         to_list ~accu:newlist (logand t (minus_one t))
+         logand t @@ minus_one t
+         |> (to_list [@tailcall]) ~accu:newlist
 
 
 (** [permtutations m n] generates the list of all possible [n]-bit
@@ -186,7 +187,7 @@ let permtutations m n =
       let t   = (logor u (minus_one u)) in
       let t'  = plus_one t in
       let t'' = shift_right (minus_one (logand (lognot t) t')) (trailing_zeros u + 1) in
-      aux (k-1) (logor t' t'') (u :: rest)
+      (aux [@tailcall]) (k-1) (logor t' t'') (u :: rest)
   in
   aux (Util.binom n m) (minus_one (shift_left_one n m)) []
 

Utils/Cholesky.ml

@@ -96,9 +96,9 @@ let pivoted_ldl threshold m_A =
       if i > n then
         pos
       else if v_D.{i} > value then
-        aux i v_D.{i}  (i+1)
+        (aux [@tailcall]) i v_D.{i}  (i+1)
       else
-        aux pos value (i+1)
+        (aux [@tailcall]) pos value (i+1)
     in
     aux i v.{i} (i+1)
   in

Utils/DIIS.ml

@@ -45,7 +45,7 @@ let next diis =
       a.{m+1,m+1} <- 0.;
       ignore @@ lacpy ~b:a (gemm ~transa:`T ~m ~n:m e e);
       if m > 1 && sycon (lacpy a) > 1.e-14 then 
-        aux (m-1)
+        (aux [@tailcall]) (m-1)
       else a
     in
     aux diis.m

Utils/Davidson.ml

@@ -152,7 +152,7 @@ let make
         else
           u_next, w_next, (iter+1), macro
       in
-      iteration u_next u_proposed w_next iter macro
+      (iteration [@tailcall]) u_next u_proposed w_next iter macro
     else
       (m_new_U |> pick_new |> Mat.of_col_vecs_list), lambda
 

Utils/FourIdxStorage.ml

@@ -315,7 +315,7 @@ let to_stream d =
   and k = ref 1
   and l = ref 1
   in
-  let rec f_dense _ =
+  let f_dense _ =
     incr i;
     if !i > !k then begin
       i := 1;
@@ -362,7 +362,7 @@ let of_file ~size ~sparsity filename =
       with End_of_file -> None
     in
     match result with
-    | Some () -> read_line ()
+    | Some () -> (read_line [@tailcall]) ()
     | None    -> ()
   in
   read_line ();
@@ -381,7 +381,7 @@ let to_list data =
     in
     match d with
     | None -> List.rev accu
-    | Some d -> append (d :: accu) 
+    | Some d -> (append [@tailcall]) (d :: accu) 
   in
   append [] 
 
@@ -415,7 +415,7 @@ t
             | Some {i_r1 ; j_r2 ; k_r1 ; l_r2 ; value} ->
                   set_phys t i_r1 j_r2 k_r1 l_r2 value
             | None -> () ) buffer;
-        iterate ()
+        (iterate [@tailcall]) ()
       end
   in iterate ();
   t

Utils/Matrix.ml

@@ -566,7 +566,7 @@ let ax_eq_b_conj_grad ?x a b =
         let p =
           Vector.add r (Vector.scale (rsnew /. (rsold +. 1.e-12) ) p)
         in
-        aux rsnew r p x (i-1)
+        (aux [@tailcall]) rsnew r p x (i-1)
   in
   aux rsold r p x (Vector.dim b *2)
 

Utils/Util.ml

@@ -68,7 +68,7 @@ let incomplete_gamma ~alpha x =
         else if prev = res then res
         else
           let term = term *. x /. (a +. k) in
-          pg_loop res (res +. term) term (k +. 1.)
+          (pg_loop [@tailcall]) res (res +. term) term (k +. 1.)
       in
       let r0 =  exp (a *. log x -. x -. loggamma_a) *. a_inv in
       pg_loop min_float r0 r0 1.
@@ -87,7 +87,7 @@ let incomplete_gamma ~alpha x =
           in
           let w = w *. kma  in
           let prev, res = res, res +. w /. (la *. lb) in
-          qg_loop prev res la lb w (k +. 1.)
+          (qg_loop [@tailcall]) prev res la lb w (k +. 1.)
       in
       let w = exp (a *. log x -. x -. loggamma_a) in
       let lb = (1. +. x -. a) in
@@ -101,12 +101,12 @@ let incomplete_gamma ~alpha x =
 
 let fact_memo =
   let rec aux accu_l accu = function
-    | 0 ->  aux [1.] 1. 1
+    | 0 ->  (aux [@tailcall]) [1.] 1. 1
     | i when (i = factmax) ->
       let x = (float_of_int factmax) *. accu in
       List.rev (x::accu_l)
     | i ->  let x = (float_of_int i) *. accu in
-      aux (x::accu_l) x (i+1)
+      (aux [@tailcall]) (x::accu_l) x (i+1)
   in
   aux [] 0. 0
   |> Array.of_list
@@ -141,7 +141,7 @@ let rec pow a = function
   | n when  n > 0  ->
     let b = pow a (n / 2) in
     b *. b *. (if n mod 2 = 0 then 1. else a)
-  | n when  n < 0  -> pow (1./.a) (-n)
+  | n when  n < 0  -> (pow [@tailcall]) (1./.a) (-n)
   | _ -> assert false
 
 
@@ -212,7 +212,7 @@ let list_range first last =
   if last < first then [] else
   let rec aux accu = function
   | 0 -> first :: accu
-  | i -> aux ( (first+i)::accu ) (i-1)
+  | i -> (aux [@tailcall]) ( (first+i)::accu ) (i-1)
   in
   aux [] (last-first)
 
@@ -225,8 +225,8 @@ let list_pack n l =
              List.rev ((List.rev accu1) :: accu2)
   | a :: rest ->
     match i with
-    | 0 -> aux (n-1)  [] ((List.rev (a::accu1)) :: accu2) rest
+    | 0 -> (aux [@tailcall]) (n-1)  [] ((List.rev (a::accu1)) :: accu2) rest
-    | _ -> aux (i-1)  (a::accu1) accu2 rest
+    | _ -> (aux [@tailcall]) (i-1)  (a::accu1) accu2 rest
   in
   aux (n-1) [] [] l
 
@@ -243,18 +243,28 @@ let stream_range first last =
 
 let stream_to_list stream = 
   let rec aux accu =
-    try aux (Stream.next stream :: accu) with
+    let new_accu = 
-    Stream.Failure -> List.rev accu
+      try
-  in aux []
+        Some (Stream.next stream :: accu)
+      with Stream.Failure -> None
+    in
+    match new_accu with
+    | Some new_accu -> (aux [@tailcall]) new_accu
+    | None -> accu
+  in List.rev @@ aux []
 
 
 let stream_fold f init stream =
   let rec aux accu =
-    try
+    let new_accu = 
-      let element = Stream.next stream in
+      try
-      let new_accu = f accu element in
+        let element = Stream.next stream in
-      aux new_accu
+        Some (f accu element)
-    with Stream.Failure -> accu
+    with Stream.Failure -> None
+    in  
+    match new_accu with
+    | Some new_accu -> (aux [@tailcall]) new_accu
+    | None -> accu
   in
   aux init
 
@@ -335,7 +345,7 @@ let bit_permtutations m n =
       let t   = Z.(logor u (u-one)) in
       let t'  = Z.(t+one) in
       let t'' = Z.(shift_right ((logand (lognot t) t') - one)) (Z.trailing_zeros u + 1) in
-      aux (k-1) (Z.logor t' t'') (u :: rest)
+      (aux [@tailcall]) (k-1) (Z.logor t' t'') (u :: rest)
   in
   aux (binom n m) Z.(shift_left one m - one) []
       
@@ -377,7 +387,7 @@ let pp_matrix ppf m =
           ~print_right:false
           ~print_foot:false
           () ) (lacpy ~ac:first ~n:(min 5 (cols-first+1)) m);
-        aux (first+5) last
+        (aux [@tailcall]) (first+5) last
     end
   in
   aux 1 cols
@@ -407,7 +417,7 @@ let matrix_of_file filename =
       with End_of_file -> None
     in
     match result with
-    | Some accu -> read_line accu
+    | Some accu -> (read_line [@tailcall]) accu
     | None      -> List.rev accu
   in
   let data = read_line [] in

Utils/Vector.ml

@@ -60,9 +60,9 @@ let sparse_of_dense ?(threshold=epsilon) = function
       | i ->
         let x = v.{i} in
         if abs_float x < threshold then
-          aux accu (i-1)
+          (aux [@tailcall]) accu (i-1)
         else
-          aux ({index=i ; value=x}::accu) (i-1)
+          (aux [@tailcall]) ({index=i ; value=x}::accu) (i-1)
     in
     let n = Vec.dim v in
     Sparse { n ; v=aux [] n }
@@ -153,14 +153,14 @@ let axpy ?(threshold=epsilon) ?(alpha=1.) x y =
                 {index=i ; value=z} :: accu
               else
                 accu
-            in aux new_accu r1 v2
+            in (aux [@tailcall]) new_accu r1 v2
           | 1 ->
             let new_accu = 
               if abs_float y > threshold then
                 {index=j ; value=y} :: accu
               else
                 accu
-            in aux new_accu v1 r2
+            in (aux [@tailcall]) new_accu v1 r2
           | 0 ->
             let z = alpha *. x +. y in
             let new_accu =
@@ -168,11 +168,11 @@ let axpy ?(threshold=epsilon) ?(alpha=1.) x y =
                 {index=i ; value=z} :: accu
               else
                 accu
-            in aux new_accu r1 r2
+            in (aux [@tailcall]) new_accu r1 r2
           | _ -> assert false
           end
-        | ({index=i ; value=x}::r1), []  -> aux ({index=i ; value=alpha *. x}::accu) r1 []
+        | ({index=i ; value=x}::r1), []  -> (aux [@tailcall]) ({index=i ; value=alpha *. x}::accu) r1 []
-        | [] , ({index=j ; value=y}::r2) -> aux ({index=j ; value=y}::accu) [] r2
+        | [] , ({index=j ; value=y}::r2) -> (aux [@tailcall]) ({index=j ; value=y}::accu) [] r2
         | [] , [] -> {n ; v=List.rev accu}
       in
       Sparse (aux [] v v')
@@ -213,9 +213,9 @@ let dot v v' =
       | (({index=i ; value=v1} :: r1) as s1), (({index=j ; value=v2}::r2) as s2)-> 
         begin
           match compare i j with
-          | -1 -> aux  accu  (r1, s2)
+          | -1 -> (aux [@tailcall])  accu  (r1, s2)
-          |  1 -> aux  accu  (s1, r2)
+          |  1 -> (aux [@tailcall])  accu  (s1, r2)
-          |  0 -> aux (accu +. v1 *. v2) (r1, r2)
+          |  0 -> (aux [@tailcall]) (accu +. v1 *. v2) (r1, r2)
           |  _ -> assert false
         end
       | ([], _ )