LCPQ
/
QCaml
mirror of https://gitlab.com/scemama/QCaml.git
10
1
Fork 0
Code Releases Activity

[@tailcall] statements

This commit is contained in:
Anthony Scemama 2019-09-10 18:39:14 +02:00
parent 316a3df20d
commit 72307bcec8
24 changed files with 89 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Basis/AtomicShell.ml
View File

@ -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";

4
Basis/ContractedShell.ml
View File

@ -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";

13
Basis/ContractedShellPair.ml
View File

@ -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

2
Basis/ERI.ml
View File

@ -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

2
Basis/F12RR.ml
View File

@ -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)

12
CI/CI.ml
View File

@ -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

4
CI/CIMatrixElement.ml
View File

@ -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)

4
CI/CIMatrixElementF12.ml
View File

@ -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)

2
CI/DeterminantSpace.ml
View File

@ -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

2
CI/F12CI.ml
View File

@ -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

6
CI/Spindeterminant.ml
View File

@ -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

2
MOBasis/MOBasis.ml
View File

@ -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

6
Parallel_mpi/Farm.ml
View File

@ -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 ();

2
Parallel_serial/Farm.ml
View File

@ -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)

4
SCF/HartreeFock.ml
View File

@ -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 ->

4
Utils/AngularMomentum.ml
View File

@ -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

5
Utils/Bitstring.ml
View File

@ -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)) []

4
Utils/Cholesky.ml
View File

@ -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

2
Utils/DIIS.ml
View File

@ -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

2
Utils/Davidson.ml
View File

@ -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

8
Utils/FourIdxStorage.ml
View File

@ -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

2
Utils/Matrix.ml
View File

@ -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)

48
Utils/Util.ml
View File

@ -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

20
Utils/Vector.ml
View File

@ -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
| ([], _ )