From 72307bcec886aba26dad496e60ded19f0bd59323 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 10 Sep 2019 18:39:14 +0200 Subject: [PATCH] [@tailcall] statements --- Basis/AtomicShell.ml | 4 +-- Basis/ContractedShell.ml | 4 +-- Basis/ContractedShellPair.ml | 13 +++++++--- Basis/ERI.ml | 2 +- Basis/F12RR.ml | 2 +- CI/CI.ml | 12 ++++----- CI/CIMatrixElement.ml | 4 +-- CI/CIMatrixElementF12.ml | 4 +-- CI/DeterminantSpace.ml | 2 +- CI/F12CI.ml | 2 +- CI/Spindeterminant.ml | 6 ++--- MOBasis/MOBasis.ml | 2 +- Parallel_mpi/Farm.ml | 6 ++--- Parallel_serial/Farm.ml | 2 +- SCF/HartreeFock.ml | 4 +-- Utils/AngularMomentum.ml | 4 +-- Utils/Bitstring.ml | 5 ++-- Utils/Cholesky.ml | 4 +-- Utils/DIIS.ml | 2 +- Utils/Davidson.ml | 2 +- Utils/FourIdxStorage.ml | 8 +++--- Utils/Matrix.ml | 2 +- Utils/Util.ml | 48 ++++++++++++++++++++++-------------- Utils/Vector.ml | 20 +++++++-------- 24 files changed, 89 insertions(+), 75 deletions(-) diff --git a/Basis/AtomicShell.ml b/Basis/AtomicShell.ml index a0d9c7c..68c005f 100644 --- a/Basis/AtomicShell.ml +++ b/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"; diff --git a/Basis/ContractedShell.ml b/Basis/ContractedShell.ml index 96725a6..43fc43f 100644 --- a/Basis/ContractedShell.ml +++ b/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"; diff --git a/Basis/ContractedShellPair.ml b/Basis/ContractedShellPair.ml index 85c1f82..b967313 100644 --- a/Basis/ContractedShellPair.ml +++ b/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 - with Not_found -> aux (x::accu) rest + let newaccu = + try + ignore @@ List.find (fun y -> equivalent x y) accu; + accu + with Not_found -> (x::accu) + in + (aux [@tailcall]) newaccu rest in aux [] sp diff --git a/Basis/ERI.ml b/Basis/ERI.ml index 697abb9..9d742ed 100644 --- a/Basis/ERI.ml +++ b/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 diff --git a/Basis/F12RR.ml b/Basis/F12RR.ml index 3f61c06..90fc56a 100644 --- a/Basis/F12RR.ml +++ b/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) diff --git a/CI/CI.ml b/CI/CI.ml index 2f19a68..65d648f 100644 --- a/CI/CI.ml +++ b/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);) - | 1 -> if (j' < Array.length j_dets) then aux singles (j'+1) + (aux [@tailcall]) r_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);) - | 1 -> if (j' < Array.length j_dets) then aux doubles (j'+1) + (aux [@tailcall]) r_doubles (j'+1);) + | 1 -> if (j' < Array.length j_dets) then (aux [@tailcall]) doubles (j'+1) | _ -> assert false end in aux doubles 0 diff --git a/CI/CIMatrixElement.ml b/CI/CIMatrixElement.ml index bce6b59..e5b65d7 100644 --- a/CI/CIMatrixElement.ml +++ b/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) diff --git a/CI/CIMatrixElementF12.ml b/CI/CIMatrixElementF12.ml index 3b7c7c6..47019f1 100644 --- a/CI/CIMatrixElementF12.ml +++ 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) diff --git a/CI/DeterminantSpace.ml b/CI/DeterminantSpace.ml index 024e32b..d9d1e24 100644 --- a/CI/DeterminantSpace.ml +++ 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 diff --git a/CI/F12CI.ml b/CI/F12CI.ml index ee6c923..ea87548 100644 --- a/CI/F12CI.ml +++ b/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 diff --git a/CI/Spindeterminant.ml b/CI/Spindeterminant.ml index 3bce41e..275d869 100644 --- a/CI/Spindeterminant.ml +++ b/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 diff --git a/MOBasis/MOBasis.ml b/MOBasis/MOBasis.ml index 796bbbe..800a58b 100644 --- a/MOBasis/MOBasis.ml +++ b/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 diff --git a/Parallel_mpi/Farm.ml b/Parallel_mpi/Farm.ml index 5c404e2..e7508eb 100644 --- a/Parallel_mpi/Farm.ml +++ b/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 (); diff --git a/Parallel_serial/Farm.ml b/Parallel_serial/Farm.ml index 4f88e8b..ff3e777 100644 --- a/Parallel_serial/Farm.ml +++ b/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) diff --git a/SCF/HartreeFock.ml b/SCF/HartreeFock.ml index e2039a6..7ea890f 100644 --- a/SCF/HartreeFock.ml +++ b/SCF/HartreeFock.ml @@ -593,9 +593,7 @@ let make | Some result -> Some result | None -> begin - let data = - (iteration (n-1)) - in + let data = iteration (n-1) in match data with | None -> None | Some data -> diff --git a/Utils/AngularMomentum.ml b/Utils/AngularMomentum.ml index 1e219a1..2c5e53d 100644 --- a/Utils/AngularMomentum.ml +++ b/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 diff --git a/Utils/Bitstring.ml b/Utils/Bitstring.ml index 1497136..feec615 100644 --- a/Utils/Bitstring.ml +++ b/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)) [] diff --git a/Utils/Cholesky.ml b/Utils/Cholesky.ml index 586f304..a1924f7 100644 --- a/Utils/Cholesky.ml +++ b/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 diff --git a/Utils/DIIS.ml b/Utils/DIIS.ml index e3b5acc..bc9afc2 100644 --- a/Utils/DIIS.ml +++ b/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 diff --git a/Utils/Davidson.ml b/Utils/Davidson.ml index d930ede..df3634b 100644 --- a/Utils/Davidson.ml +++ b/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 diff --git a/Utils/FourIdxStorage.ml b/Utils/FourIdxStorage.ml index f3ede9a..5fa0053 100644 --- a/Utils/FourIdxStorage.ml +++ b/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 diff --git a/Utils/Matrix.ml b/Utils/Matrix.ml index b11dec5..95188f8 100644 --- a/Utils/Matrix.ml +++ b/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) diff --git a/Utils/Util.ml b/Utils/Util.ml index aae6faf..8601aea 100644 --- a/Utils/Util.ml +++ b/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 - | _ -> aux (i-1) (a::accu1) accu2 rest + | 0 -> (aux [@tailcall]) (n-1) [] ((List.rev (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 - Stream.Failure -> List.rev accu - in aux [] + let new_accu = + try + 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 element = Stream.next stream in - let new_accu = f accu element in - aux new_accu - with Stream.Failure -> accu + let new_accu = + try + let element = Stream.next stream in + Some (f accu element) + 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 diff --git a/Utils/Vector.ml b/Utils/Vector.ml index 8905680..6833397 100644 --- a/Utils/Vector.ml +++ b/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=j ; value=y}::r2) -> aux ({index=j ; value=y}::accu) [] r2 + | ({index=i ; value=x}::r1), [] -> (aux [@tailcall]) ({index=i ; value=alpha *. x}::accu) r1 [] + | [] , ({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 accu (s1, r2) - | 0 -> aux (accu +. v1 *. v2) (r1, r2) + | -1 -> (aux [@tailcall]) accu (r1, s2) + | 1 -> (aux [@tailcall]) accu (s1, r2) + | 0 -> (aux [@tailcall]) (accu +. v1 *. v2) (r1, r2) | _ -> assert false end | ([], _ )