Fixed bytecode C binding

CI/Determinant.ml

@@ -90,11 +90,11 @@ let double_excitation spin h p spin' h' p' t =
 
 
 
-let pp_det n ppf t =
+let pp n ppf t =
   Format.fprintf ppf "@[<v>@[phase:%a@]@;@[a:%a@]@;@[b:%a@]@]@."
-    Phase.pp_phase (phase t)
+    Phase.pp (phase t)
-    (Spindeterminant.pp_spindet n) t.alfa
+    (Spindeterminant.pp n) t.alfa
-    (Spindeterminant.pp_spindet n) t.beta
+    (Spindeterminant.pp n) t.beta
 
 
 

CI/Determinant.mli

@@ -76,7 +76,7 @@ val negate_phase : t -> t
 
 (** {1 Printers} *)
 
-val pp_det : int -> Format.formatter -> t -> unit
+val pp : int -> Format.formatter -> t -> unit
 (** First [int] is the number of MOs to print. *)
 
 (** {1 Unit tests} *)

CI/DeterminantSpace.ml

@@ -348,11 +348,11 @@ let cas_f12_of_mo_basis mo_basis ~frozen_core n m mo_num =
 
 
 
-let pp_det_space ppf t =
+let pp ppf t =
   Format.fprintf ppf "@[<v 2>[ ";
   let i = ref 0 in
   determinant_stream t
   |> Stream.iter (fun d -> Format.fprintf ppf "@[<v>@[%8d@]@;@[%a@]@]@;" !i
-                    (Determinant.pp_det (MOBasis.size (mo_basis t))) d; incr i) ;
+                    (Determinant.pp (MOBasis.size (mo_basis t))) d; incr i) ;
   Format.fprintf ppf "]@]"
 

CI/DeterminantSpace.mli

@@ -71,4 +71,4 @@ val cas_f12_of_mo_basis : MOBasis.t -> frozen_core:bool -> int -> int -> int ->
 
 (** {2 Printing} *)
 
-val pp_det_space : Format.formatter -> t -> unit
+val pp : Format.formatter -> t -> unit

CI/Phase.ml

@@ -25,7 +25,7 @@ let add_nperm phase = function
   | 0 -> phase
   | nperm -> add phase (of_nperm nperm)
 
-let pp_phase ppf = function
+let pp ppf = function
   | Pos -> Format.fprintf ppf "@[<h>+1@]"
   | Neg -> Format.fprintf ppf "@[<h>-1@]"
 

CI/Phase.mli

@@ -19,4 +19,4 @@ val neg : t -> t
 
 (** {1 Printers} *)
 
-val pp_phase : Format.formatter -> t -> unit
+val pp : Format.formatter -> t -> unit

CI/Spindeterminant.ml

@@ -128,10 +128,10 @@ let n_electrons = function
   | None -> 0
 
 
-let pp_spindet n ppf = function
+let pp n ppf = function
   | None -> Format.fprintf ppf "@[<h>None@]"
   | Some s -> 
-      Format.fprintf ppf "@[<h>%a %a@]" Phase.pp_phase s.phase Bitstring.pp
+      Format.fprintf ppf "@[<h>%a %a@]" Phase.pp s.phase Bitstring.pp
       s.bitstring
 
 
@@ -204,9 +204,9 @@ let test_case () =
     let det = of_list 10 l_a in
     let l_b = [ 1 ; 7 ; 3 ; 5 ] in
     let det2 = of_list 10 l_b in
-    Format.printf "%a@." (pp_spindet 7) det;
+    Format.printf "%a@." (pp 7) det;
-    Format.printf "%a@." (pp_spindet 7) det2;
+    Format.printf "%a@." (pp 7) det2;
-    Format.printf "%a@." (pp_spindet 7) (single_excitation_reference 2 7 det);
+    Format.printf "%a@." (pp 7) (single_excitation_reference 2 7 det);
     Alcotest.(check bool) "single 1" true (single_excitation_reference 2 7 det = det2);
     Alcotest.(check bool) "single 2" true (single_excitation 2 7 det = single_excitation_reference 2 7 det);
     Alcotest.(check bool) "single 3" true (single_excitation_reference 4 7 det |> is_none);

CI/Spindeterminant.mli

@@ -81,7 +81,7 @@ val to_array : t -> int array
 
 (** {1 Printers}. *)
 
-val pp_spindet : int -> Format.formatter -> t -> unit
+val pp : int -> Format.formatter -> t -> unit
 (** First [int] is the number of MOs to print *)
 
 

CI/SpindeterminantSpace.ml

@@ -61,10 +61,12 @@ let cas_of_mo_basis mo_basis ~frozen_core elec_num n m =
 
 
 
-let pp_spindet_space ppf t =
+let pp ppf t =
-  Format.fprintf ppf "@[<v 2>[ ";
+  Format.fprintf ppf "@[<v 2> [";
-  Array.iteri (fun i d -> Format.fprintf ppf "@[<v>@[%8d@] @[%a@]@]@;" i
+  let pp = Spindeterminant.pp @@ MOBasis.size (mo_basis t) in
-                  (Spindeterminant.pp_spindet (MOBasis.size (mo_basis t))) d) (spin_determinants t) ;
+  Array.iteri (fun i d ->
+    Format.fprintf ppf "@[<v>@[%8d@] @[%a@]@]@;" i pp d)
+    (spin_determinants t) ;
   Format.fprintf ppf "]@]"
 
 

CI/SpindeterminantSpace.mli

@@ -38,7 +38,7 @@ val cas_of_mo_basis : MOBasis.t -> frozen_core:bool -> int -> int -> int -> t
 
 (** {2 Printing} *)
 
-val pp_spindet_space : Format.formatter -> t -> unit
+val pp : Format.formatter -> t -> unit
 
 
 

MOBasis/MOClass.ml

@@ -9,7 +9,7 @@ type mo_class =
 type t = mo_class list
 
 
-let pp_mo_occ ppf = function
+let pp_mo_class ppf = function
   | Core      i -> Format.fprintf ppf "@[Core %d@]" i
   | Inactive  i -> Format.fprintf ppf "@[Inactive %d@]" i
   | Active    i -> Format.fprintf ppf "@[Active %d@]" i
@@ -17,6 +17,15 @@ let pp_mo_occ ppf = function
   | Deleted   i -> Format.fprintf ppf "@[Deleted %d@]" i
   | Auxiliary i -> Format.fprintf ppf "@[Auxiliary %d@]" i
 
+let pp ppf t = 
+  Format.fprintf ppf "@[[@,";
+  let rec aux = function
+  | [] -> Format.fprintf ppf "]@]" 
+  | x :: [] -> Format.fprintf ppf "%a@,]@]" pp_mo_class x
+  | x :: rest -> ( Format.fprintf ppf "%a@,;@," pp_mo_class x; aux rest ) 
+  in
+  aux t
+
 
 
 let of_list t = t

MOBasis/MOClass.mli

@@ -52,5 +52,7 @@ val mo_class_array : t -> mo_class array
 
 (** {2 Printers} *)
 
-val pp_mo_occ : Format.formatter -> mo_class -> unit
+val pp_mo_class : Format.formatter -> mo_class -> unit
+
+val pp : Format.formatter -> t -> unit
 

Utils/Bitstring.ml

@@ -13,6 +13,7 @@ module One = struct
   let shift_left_one i = 1 lsl i
   let testbit x i = ( (x lsr i) land 1 ) = 1  
   let logor a b = a lor b
+  let neg a = - a 
   let logxor a b = a lxor b
   let logand a b = a land b
   let lognot a = lnot a
@@ -34,7 +35,7 @@ module One = struct
 
 
   let pp ppf s = 
-    Format.fprintf ppf "@[@[%a@]i@]" (Util.pp_bitstring 64) 
+    Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring 64) 
       (Z.of_int s)
 
 end
@@ -58,6 +59,7 @@ module Many = struct
   let logxor = Z.logxor
   let logand = Z.logand
   let lognot = Z.lognot
+  let neg = Z.neg
   let minus_one = Z.pred
   let plus_one = Z.succ
   let trailing_zeros = Z.trailing_zeros
@@ -68,7 +70,7 @@ module Many = struct
     if z = Z.zero then 0 else Z.popcount z
 
   let pp ppf s = 
-    Format.fprintf ppf "@[@[%a@]m@]" (Util.pp_bitstring (Z.numbits s))  s
+    Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring (Z.numbits s))  s
 
 end
 
@@ -95,6 +97,10 @@ let is_zero = function
 | One x -> One.is_zero x
 | Many x -> Many.is_zero x
 
+let neg = function
+| One x -> One (One.neg x)
+| Many x -> Many (Many.neg x)
+
 let shift_left x i = match x with
 | One x -> One (One.shift_left x i)
 | Many x -> Many (Many.shift_left x i)
@@ -184,9 +190,14 @@ let permtutations m n =
     if k=1 then
       List.rev (u :: rest)
     else
-      let t   = (logor u (minus_one u)) in
+      let t   = logor u @@ minus_one u in
       let t'  = plus_one t in
+      let not_t = lognot t in
+      let neg_not_t = neg not_t in
+      let t'' = shift_right (minus_one @@ logand not_t neg_not_t) (trailing_zeros u + 1) in
+      (*
       let t'' = shift_right (minus_one (logand (lognot t) t')) (trailing_zeros u + 1) in
+      *)
       (aux [@tailcall]) (k-1) (logor t' t'') (u :: rest)
   in
   aux (Util.binom n m) (minus_one (shift_left_one n m)) []

Utils/Electrons.ml

@@ -27,4 +27,5 @@ let charge e =
 
 let n_alfa t = t.n_alfa
 let n_beta t = t.n_beta
+let n_elec t = t.n_alfa + t.n_beta
 let multiplicity t = t.multiplicity

Utils/Electrons.mli

@@ -14,6 +14,9 @@ val make : ?multiplicity:int -> ?charge:int -> Nuclei.t -> t
 val charge : t -> Charge.t
 (** Sum of the charges of the electrons. *)
 
+val n_elec : t -> int
+(** Number of electrons *)
+
 val n_alfa : t -> int
 (** Number of alpha electrons *)
 

Utils/math_functions.c

@@ -46,7 +46,7 @@ CAMLprim int32_t popcnt(int64_t i)
 
 CAMLprim value popcnt_bytecode(value i)
 {
-  return copy_int32(__builtin_popcountll (i));
+  return caml_copy_int32(__builtin_popcountll (Int64_val(i)));
 }
 
 
@@ -58,7 +58,7 @@ CAMLprim int32_t trailz(int64_t i)
 
 CAMLprim value trailz_bytecode(value i)
 {
-  return copy_int32(__builtin_ctzll (i));
+  return caml_copy_int32(__builtin_ctzll (Int64_val(i)));
 }
 
 CAMLprim int32_t leadz(int64_t i)
@@ -69,7 +69,7 @@ CAMLprim int32_t leadz(int64_t i)
 
 CAMLprim value leadz_bytecode(value i)
 {
-  return copy_int32(__builtin_clzll (i));
+  return caml_copy_int32(__builtin_clzll (Int64_val(i)));
 }