Added org-mode files in common

common/README.org

@@ -0,0 +1,79 @@
+#+TITLE: Common
+
+[[elisp:(org-babel-tangle)]]
+
+This directory contains many utility functions used by all the other directories.
+
+- [[./angular_momentum.org][Angular Momentum]]
+- [[./bitstring.org][Bit string]]
+
+* Dune files
+  :PROPERTIES:
+  :dune:       lib/dune
+  :dune-test:  test/dune
+  :header-args: :noweb yes 
+  :END:
+  
+** Headers
+   #+begin_src elisp :tangle (org-entry-get nil "dune" t)
+(library
+   #+end_src
+
+   #+begin_src elisp :tangle (org-entry-get nil "dune-test" t)
+(library
+   #+end_src
+
+** Library
+   
+*** General information
+     #+begin_src elisp :tangle (org-entry-get nil "dune" t)
+ (name common)
+ (public_name qcaml.common)
+ (synopsis "General utilities used in all QCaml libraries.")
+     #+end_src
+
+     #+begin_src elisp :tangle (org-entry-get nil "dune-test" t)
+ (name test_common)
+ (synopsis "Test for common library")
+     #+end_src
+
+*** Dependencies
+     #+begin_src elisp :tangle (org-entry-get nil "dune" t)
+ (libraries
+        str
+        zarith
+        getopt
+ )
+     #+end_src
+
+     #+begin_src elisp :tangle (org-entry-get nil "dune-test" t)
+ (libraries
+  alcotest
+  qcaml.common
+ )
+     #+end_src
+*** Extra C files
+
+    The ~math_functions~ file contains small C snippets to add missing
+    functionalities to OCaml, such as support for the ~popcnt~ instruction.
+
+     #+begin_src elisp :tangle (org-entry-get nil "dune" t)
+ (c_names
+    math_functions
+ )
+ (c_flags (:standard)
+   -Ofast -march=native -fPIC
+ )
+     #+end_src
+
+** Footers
+
+   #+begin_src elisp :tangle (org-entry-get nil "dune" t)
+)
+   #+end_src
+
+   #+begin_src elisp :tangle (org-entry-get nil "dune-test" t)
+)
+   #+end_src
+
+   

common/angular_momentum.org

@@ -0,0 +1,330 @@
+#+TITLE: Angular Momentum
+
+[[elisp:(org-babel-tangle)]]
+
+* Angular Momentum
+  :PROPERTIES:
+  :ml:       lib/angular_momentum.ml
+  :mli:      lib/angular_momentum.mli
+  :header-args: :noweb yes :comments both
+  :END:
+
+  Azimuthal quantum number, repsesented as $s,p,d,...$.
+
+** Type
+
+   #+NAME: types
+   #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+type t =
+  | S | P | D | F | G | H | I | J | K | L | M | N | O
+  | Int of int
+
+exception Angular_momentum_error of string
+
+type kind =
+    Singlet of t
+  | Doublet of (t * t)
+  | Triplet of (t * t * t)
+  | Quartet of (t * t * t * t)
+
+   #+end_src
+
+   An exception is raised when the ~Angular_momentum.t~ element can't
+   be created.
+
+   The ~kind~ is used to build shells, shell doublets, triplets or
+   quartets, use in the two-electron operators.
+
+   #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+<<types>>
+open Powers
+   #+end_src
+
+
+** Conversions
+
+
+*** ~of_char~
+
+    Returns an ~Angular_momentum.t~ when a shell is given as a character
+    (case insensitive):
+
+    #+begin_example
+Angular_momentum.of_char 'p' -> Angular_momentum.P
+    #+end_example
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val of_char : char -> t
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let of_char = function
+  | 's' | 'S' -> S      | 'p' | 'P' -> P
+  | 'd' | 'D' -> D      | 'f' | 'F' -> F
+  | 'g' | 'G' -> G      | 'h' | 'H' -> H
+  | 'i' | 'I' -> I      | 'j' | 'J' -> J
+  | 'k' | 'K' -> K      | 'l' | 'L' -> L
+  | 'm' | 'M' -> M      | 'n' | 'N' -> N
+  | 'o' | 'O' -> O
+  | c -> raise (Angular_momentum_error (String.make 1 c))
+    #+end_src
+
+*** ~to_string~
+
+    Converts the angular momentum into a string:
+
+    #+begin_example
+Angular_momentum.(to_string D) -> "D"
+    #+end_example
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val to_string : t -> string
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let to_string = function
+  | S -> "S"       | P -> "P"
+  | D -> "D"       | F -> "F"
+  | G -> "G"       | H -> "H"
+  | I -> "I"       | J -> "J"
+  | K -> "K"       | L -> "L"
+  | M -> "M"       | N -> "N"
+  | O -> "O"       | Int i -> string_of_int i
+    #+end_src
+
+*** ~to_char~
+
+    Converts the angular momentum into a char:
+
+    #+begin_example
+Angular_momentum.(to_char D) -> 'D'
+    #+end_example
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val to_char : t -> char
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let to_char = function
+  | S -> 'S'       | P -> 'P'
+  | D -> 'D'       | F -> 'F'
+  | G -> 'G'       | H -> 'H'
+  | I -> 'I'       | J -> 'J'
+  | K -> 'K'       | L -> 'L'
+  | M -> 'M'       | N -> 'N'
+  | O -> 'O'       | Int _ -> '_'
+    #+end_src
+
+*** ~to_int~
+
+    Returns the $l_{max}$ value of the shell:
+
+    #+begin_example
+Angular_momentum.(to_char D) -> 2
+    #+end_example
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val to_int : t -> int
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let to_int = function
+  | S -> 0         | P -> 1
+  | D -> 2         | F -> 3
+  | G -> 4         | H -> 5
+  | I -> 6         | J -> 7
+  | K -> 8         | L -> 9
+  | M -> 10        | N -> 11
+  | O -> 12        | Int i -> i
+    #+end_src
+
+*** ~of_int~
+
+    Returns a shell given an $l$ value.
+
+    #+begin_example
+Angular_momentum.of_int 3 -> Angular_momentum.F
+    #+end_example
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val of_int : int -> t
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let of_int = function
+  | 0 -> S         | 1 -> P
+  | 2 -> D         | 3 -> F
+  | 4 -> G         | 5 -> H
+  | 6 -> I         | 7 -> J
+  | 8 -> K         | 9 -> L
+  | 10 -> M        | 11 -> N
+  | 12 -> O        | i -> Int i
+    #+end_src
+
+
+** Shell functions
+
+
+*** ~n_functions~
+
+    Returns the number of cartesian functions in a shell.
+
+    #+begin_example
+Angular_momentum.n_functions D -> 6
+    #+end_example
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val n_functions : t -> int
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let n_functions a =
+  let a =
+    to_int a
+  in
+  (a*a + 3*a + 2)/2
+    #+end_src
+
+
+*** ~zkey_array~
+
+    Array of ~Zkey.t~, where each element is a a key associated with the
+    the powers of $x,y,z$.
+
+    #+begin_example
+  Angular_momentum.( zkey_array Doublet (P,S) ) ->
+    [| {Zkey.left = 0; right = 1125899906842624} ;
+       {Zkey.left = 0; right = 1099511627776}    ;
+       {Zkey.left = 0; right = 1073741824}       |]
+  =
+
+  let s,x,y,z =
+      Powers.( of_int_tuple (0,0,0),
+               of_int_tuple (1,0,0),
+               of_int_tuple (0,1,0),
+               of_int_tuple (0,0,1) )
+  in
+  Array.map (fun (a,b) -> {!Zkey.of_powers_six} a b)
+      [| (x,s) ; (y,s) ; (z,s) |]
+
+    #+end_example
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val zkey_array : kind -> Zkey.t array
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let zkey_array_memo : (kind, Zkey.t array) Hashtbl.t =
+  Hashtbl.create 13
+
+let zkey_array a =
+
+  let keys_1d l =
+    let create_z { x ; y ; _ } =
+      Powers.of_int_tuple (x,y,l-(x+y))
+    in
+    let rec create_y accu xyz =
+      let { x ; y ; z ;_ } = xyz in
+      match y with
+      | 0 -> (create_z xyz)::accu
+      | _ -> let ynew = y-1 in
+          (create_y [@tailcall]) ( (create_z xyz)::accu) (Powers.of_int_tuple (x,ynew,z))
+    in
+    let rec create_x accu xyz =
+      let { x ; z ;_ } = xyz in
+      match x with
+      | 0 -> (create_y [] xyz)@accu
+      | _ -> let xnew = x-1 in
+          let ynew = l-xnew in
+          (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
+  in
+
+  try
+    Hashtbl.find zkey_array_memo a
+
+  with Not_found ->
+
+    let result =
+      begin
+        match a with
+        | Singlet l1 ->
+            List.rev_map (fun x -> Zkey.of_powers_three x) (keys_1d @@ to_int l1)
+
+        | Doublet (l1, l2) ->
+            List.rev_map (fun a ->
+              List.rev_map (fun b -> Zkey.of_powers_six a b) (keys_1d @@ to_int l2)
+            ) (keys_1d @@ to_int l1)
+            |> List.concat
+
+        | Triplet (l1, l2, l3) ->
+
+            List.rev_map (fun a ->
+              List.rev_map (fun b ->
+                List.rev_map (fun c ->
+                  Zkey.of_powers_nine a b c) (keys_1d @@ to_int l3)
+              ) (keys_1d @@ to_int l2)
+              |> List.concat
+            ) (keys_1d @@ to_int l1)
+            |> List.concat
+
+        | Quartet (l1, l2, l3, l4) ->
+
+            List.rev_map (fun a ->
+              List.rev_map (fun b ->
+                List.rev_map (fun c ->
+                  List.rev_map (fun d ->
+                    Zkey.of_powers_twelve a b c d) (keys_1d @@ to_int l4)
+                ) (keys_1d @@ to_int l3)
+                |> List.concat
+              ) (keys_1d @@ to_int l2)
+              |> List.concat
+            ) (keys_1d @@ to_int l1)
+            |> List.concat
+      end
+      |> List.rev
+      |> Array.of_list
+    in
+    Hashtbl.add zkey_array_memo a result;
+    result
+    #+end_src
+
+
+** Arithmetic
+
+   #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val ( + ) : t -> t -> t
+val ( - ) : t -> t -> t
+   #+end_src
+
+   #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let ( + ) a b =
+  of_int ( (to_int a) + (to_int b) )
+
+let ( - ) a b =
+  of_int ( (to_int a) - (to_int b) )
+   #+end_src
+
+
+** Printers
+
+   Printers can print as a string (~pp_string~) or as an integer (~pp_int~).
+
+   #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val pp_string : Format.formatter -> t -> unit
+val pp_int : Format.formatter -> t -> unit
+   #+end_src
+
+   #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let pp_string ppf x =
+  Format.fprintf ppf "@[%s@]" (to_string x)
+
+let pp_int ppf x =
+  Format.fprintf ppf "@[%d@]" (to_int x)
+   #+end_src
+
+
+
+** TODO Tests

common/bitstring.org

@@ -0,0 +1,559 @@
+#+TITLE: Bit string
+
+[[elisp:(org-babel-tangle)]]
+
+* Bit string
+  :PROPERTIES:
+  :ml:       lib/bitstring.ml
+  :mli:      lib/bitstring.mli
+  :test-ml:  test/bitstring.ml
+  :header-args: :noweb yes :comments both
+  :END:
+
+  We define here a data type to handle bit strings efficiently.
+  When the bit string contains less than 64 bits, it is stored
+  internally in a 63-bit integer and uses bitwise instructions.
+  When more than 63 bits are required, the =zarith= library is used to
+  consider the bit string as a multi-precision integer.
+
+  
+** Single-integer implementation
+
+   #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+module One = struct
+
+  let of_int x =
+    assert (x > 0); x
+
+  let numbits _ = 63
+  let zero = 0
+  let is_zero x = x = 0
+  let shift_left x i = x lsl i
+  let shift_right x i = x lsr i
+  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
+  let minus_one a = a - 1
+  let plus_one a = a + 1
+
+  let popcount = function
+    | 0 -> 0
+    | r  -> Util.popcnt (Int64.of_int r) 
+
+  let trailing_zeros r = 
+    Util.trailz (Int64.of_int r) 
+
+  let hamdist a b =
+    a lxor b
+    |> popcount 
+
+  let pp ppf s = 
+    Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring 64) 
+      (Z.of_int s)
+
+end
+   #+end_src
+
+** Zarith implementation
+
+   #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+module Many = struct
+
+  let of_z x = x
+  let zero = Z.zero
+  let is_zero x = x = Z.zero
+  let shift_left = Z.shift_left 
+  let shift_right = Z.shift_right
+  let shift_left_one i = Z.shift_left Z.one i
+  let testbit = Z.testbit
+  let logor = Z.logor
+  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
+  let hamdist = Z.hamdist
+  let numbits i = max (Z.numbits i) 64
+
+  let popcount z = 
+    if z = Z.zero then 0 else Z.popcount z
+
+  let pp ppf s = 
+    Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring (Z.numbits s))  s
+
+end
+   #+end_src
+
+** Type
+
+   #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+type t
+   #+end_src
+
+   #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+type t =
+  | One of int
+  | Many of Z.t
+   #+end_src
+
+** Tests header
+
+   #+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
+open Common.Bitstring
+let check msg x = Alcotest.(check bool) msg true x
+let test_all () =
+    let x = 8745687 in
+    let one_x  = of_int x in
+    let z = Z.shift_left (Z.of_int x) 64 in
+    let many_x = of_z z in
+   #+end_src
+** General implementation
+   
+*** ~of_int~
+    
+    Creates a bit string from an ~int~.
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val of_int : int -> t
+    #+end_src
+   
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let of_int x =
+  One (One.of_int x)
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
+    Alcotest.(check bool) "of_x" true (one_x = (of_int x));
+    #+end_src
+
+*** ~of_z~
+    
+    Creates a bit string from an ~Z.t~ multi-precision integer.
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val of_z : Z.t -> t
+    #+end_src
+   
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let of_z x =
+  if Z.numbits x < 64 then One (Z.to_int x) else Many (Many.of_z x)
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
+    Alcotest.(check bool) "of_z" true (one_x = (of_z (Z.of_int x)));
+    #+end_src
+
+*** ~zero~
+
+ ~zero n~ creates a zero bit string with ~n~ bits.
+    
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val zero : int -> t
+    #+end_src
+   
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let zero = function
+| n when n < 64 -> One (One.zero)
+| _ -> Many (Many.zero)
+    #+end_src
+
+*** ~numbits~
+
+    Returns the number of bits used to represent the bit string.
+    
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val numbits : t -> int
+    #+end_src
+   
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let numbits = function
+| One x -> One.numbits x
+| Many x -> Many.numbits x
+    #+end_src
+
+*** ~is_zero~
+
+    True if all the bits of the bit string are zero.
+    
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val is_zero : t -> bool
+    #+end_src
+   
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let is_zero = function
+  | One x -> One.is_zero x
+  | Many x -> Many.is_zero x
+    #+end_src
+
+*** ~neg~
+
+    Returns the negative of the integer interpretation of the bit string.
+
+    #+begin_example
+neg (of_int x) = neg (of_int (-x))
+    #+end_example
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val neg : t -> t
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let neg = function
+  | One x -> One (One.neg x)
+  | Many x -> Many (Many.neg x)
+    #+end_src
+
+*** ~shift_left~
+
+ ~shift_left t n~ returns a new bit strings with all the bits
+    shifted ~n~ positions to the left.
+    
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val shift_left : t -> int -> t
+    #+end_src
+    
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let shift_left x i = match x with
+| One x -> One (One.shift_left x i)
+| Many x -> Many (Many.shift_left x i)
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
+    Alcotest.(check bool) "shift_left1" true (of_int (x lsl 3) = shift_left one_x 3);
+    Alcotest.(check bool) "shift_left2" true (of_z (Z.shift_left z 3) = shift_left many_x 3);
+    Alcotest.(check bool) "shift_left3" true (of_z (Z.shift_left z 100) = shift_left many_x 100);
+    #+end_src
+
+*** ~shift_right~
+
+ ~shift_right t n~ returns a new bit strings with all the bits
+    shifted ~n~ positions to the right.
+    
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val shift_right : t -> int -> t
+    #+end_src
+    
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let shift_right x i = match x with
+| One x -> One (One.shift_right x i)
+| Many x -> Many (Many.shift_right x i)
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
+    Alcotest.(check bool) "shift_right1" true (of_int (x lsr 3) = shift_right one_x 3);
+    Alcotest.(check bool) "shift_right2" true (of_z (Z.shift_right z 3) = shift_right many_x 3);
+    #+end_src
+
+*** ~shift_left_one~
+
+ ~shift_left_one size n~ returns a new bit strings with the ~n~-th
+    bit set to one.
+    It is equivalent as shifting ~1~ by ~n~ bits to the left.
+ ~size~ is the total number of bits of the bit string.
+    
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val shift_left_one : int -> int -> t
+    #+end_src
+    
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let shift_left_one = function
+| n when n < 64 -> fun i -> One (One.shift_left_one i)
+| _ -> fun i -> Many (Many.shift_left_one i)
+
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
+    Alcotest.(check bool) "shift_left_one1" true (of_int (1 lsl 3) = shift_left_one 4 3);
+    Alcotest.(check bool) "shift_left_one2" true (of_z (Z.shift_left Z.one 200) = shift_left_one 300 200);
+    #+end_src
+
+*** ~testbit~
+
+ ~testbit t n~ is true if the ~n~-th bit of the bit string ~t~ is
+    set to ~1~.
+    
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val testbit : t -> int -> bool
+    #+end_src
+   
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let testbit = function
+| One x -> One.testbit x
+| Many x -> Many.testbit x
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
+    Alcotest.(check bool) "testbit1" true  (testbit (of_int 8) 3);
+    Alcotest.(check bool) "testbit2" false (testbit (of_int 8) 2);
+    Alcotest.(check bool) "testbit3" false (testbit (of_int 8) 4);
+    Alcotest.(check bool) "testbit4" true  (testbit (of_z (Z.of_int 8)) 3);
+    Alcotest.(check bool) "testbit5" false (testbit (of_z (Z.of_int 8)) 2);
+    Alcotest.(check bool) "testbit6" false (testbit (of_z (Z.of_int 8)) 4);
+    #+end_src
+
+*** ~logor~
+
+    Bitwise logical or.
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val logor : t -> t -> t
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let logor a b = 
+  match a,b with
+  | One a, One b -> One (One.logor a b)
+  | Many a, Many b -> Many (Many.logor a b)
+  | _ -> invalid_arg "Bitstring.logor"
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
+    Alcotest.(check bool) "logor1" true (of_int (1 lor 2) = logor (of_int 1) (of_int 2));
+    Alcotest.(check bool) "logor2" true (of_z (Z.of_int (1 lor 2)) = logor (of_z Z.one) (of_z (Z.of_int 2)));
+    #+end_src
+
+*** ~logxor~
+
+    Bitwise logical exclusive or.
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val logxor : t -> t -> t
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let logxor a b = 
+  match a,b with
+  | One a, One b -> One (One.logxor a b)
+  | Many a, Many b -> Many (Many.logxor a b)
+  | _ -> invalid_arg "Bitstring.logxor"
+
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
+    Alcotest.(check bool) "logxor1" true (of_int (1 lxor 2) = logxor (of_int 1) (of_int 2));
+    Alcotest.(check bool) "logxor2" true (of_z (Z.of_int (1 lxor 2)) = logxor (of_z Z.one) (of_z (Z.of_int 2)));
+    #+end_src
+
+*** ~logand~
+
+    Bitwise logical and.
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val logand : t -> t -> t
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let logand a b = 
+  match a,b with
+  | One a, One b -> One (One.logand a b)
+  | Many a, Many b -> Many (Many.logand a b)
+  | _ -> invalid_arg "Bitstring.logand"
+
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
+    Alcotest.(check bool) "logand1" true (of_int (1 land 3) = logand (of_int 1) (of_int 3));
+    Alcotest.(check bool) "logand2" true (of_z (Z.of_int (1 land 3)) = logand (of_z Z.one) (of_z (Z.of_int 3)));
+    #+end_src
+
+*** ~lognot~
+
+    Bitwise logical negation.
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val lognot : t -> t 
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let lognot = function
+| One x -> One (One.lognot x)
+| Many x -> Many (Many.lognot x)
+    #+end_src
+
+*** ~minus_one~
+
+    Takes the integer representation of the bit string and removes one.
+
+    #+begin_example
+minus_one (of_int 10) = of_int 9
+    #+end_example
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val minus_one : t -> t
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let minus_one = function
+| One x -> One (One.minus_one x)
+| Many x -> Many (Many.minus_one x)
+    #+end_src
+
+*** ~plus_one~
+
+    Takes the integer representation of the bit string and adds one.
+
+    #+begin_example
+plus_one (of_int 10) = of_int 11
+    #+end_example
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val plus_one : t -> t
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let plus_one = function
+| One x -> One (One.plus_one x)
+| Many x -> Many (Many.plus_one x)
+    #+end_src
+
+*** ~trailing_zeros~
+
+    Returns the number of trailing zeros in the bit string.
+    
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val trailing_zeros : t -> int
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let trailing_zeros = function
+| One x -> One.trailing_zeros x
+| Many x -> Many.trailing_zeros x
+    #+end_src
+
+*** ~hamdist~
+
+    Returns the Hamming distance, i.e. the number of bits differing
+    between two bit strings.
+    
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val hamdist : t -> t -> int
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let hamdist a b = match a, b with
+| One a, One b -> One.hamdist a b
+| Many a, Many b -> Many.hamdist a b
+| _ -> invalid_arg "Bitstring.hamdist"
+    #+end_src
+
+*** ~popcount~
+
+    Returns the number of bits set to one in the bit string.
+    
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val popcount : t -> int
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let popcount = function
+| One x -> One.popcount x
+| Many x -> Many.popcount x
+    #+end_src
+    
+*** ~to_list~
+
+    Converts a bit string into a list of integers indicating the
+    positions where the bits are set to ~1~. The first value for the
+    position is not ~0~ but ~1~.
+    
+    #+begin_example
+Bitstring.to_list (of_int 5);;
+- : int list = [1; 3]
+    #+end_example
+
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val to_list : ?accu:(int list) -> t -> int list                                                              
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let rec to_list ?(accu=[]) = function
+  | t when (is_zero t) -> List.rev accu
+  | t -> let newlist =
+           (trailing_zeros t + 1)::accu
+         in
+         logand t @@ minus_one t
+         |> (to_list [@tailcall]) ~accu:newlist
+    #+end_src
+
+   #+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
+    Alcotest.(check bool) "to_list" true ([ 1 ; 3 ; 4 ; 6 ] = (to_list (of_int 45)));
+   #+end_src
+
+*** ~permtutations~
+
+ ~permtutations m n~ generates the list of all possible ~n~-bit
+    strings with ~m~ bits set to ~1~.
+    Algorithm adapted from [[https://graphics.stanford.edu/~seander/bithacks.html#NextBitPermutation][Bit twiddling hacks]].
+    
+    #+begin_example
+Bitstring.permtutations 2 4                                                                   |> List.map (fun x -> Format.asprintf "%a" Bitstring.pp x) ;;
+|> List.map (fun x -> Format.asprintf "%a" Bitstring.pp x) ;;
+- : string list =
+["++--------------------------------------------------------------";
+ "+-+-------------------------------------------------------------";
+ "-++-------------------------------------------------------------";
+ "+--+------------------------------------------------------------";
+ "-+-+------------------------------------------------------------";
+ "--++------------------------------------------------------------"]
+    #+end_example
+    
+    #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val permtutations : int -> int -> t list
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let permtutations m n =                                                                   
+
+  let rec aux k u rest =
+    if k=1 then
+      List.rev (u :: rest)
+    else
+      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)) []
+    #+end_src
+
+    #+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
+check "permutations"
+  (permtutations 2 4 = List.map of_int
+     [ 3 ; 5 ; 6 ; 9 ; 10 ; 12 ]);
+    #+end_src
+
+** Printers
+
+   Printers can print as a string (~pp_string~) or as an integer (~pp_int~).
+
+   #+begin_src ocaml :tangle (org-entry-get nil "mli" t)
+val pp : Format.formatter -> t -> unit
+   #+end_src
+
+   #+begin_src ocaml :tangle (org-entry-get nil "ml" t)
+let pp ppf = function
+| One x -> One.pp ppf x
+| Many x -> Many.pp ppf x
+   #+end_src
+
+** Tests
+
+   #+begin_src ocaml :tangle (org-entry-get nil "test-ml" t)
+   ()
+   
+let tests = [
+    "all", `Quick, test_all;
+  ]
+   #+end_src
+

common/lib/angular_momentum.ml

@@ -1,11 +1,29 @@
-open Powers
+
+
+(* An exception is raised when the ~Angular_momentum.t~ element can't
+ * be created.
+ * 
+ * The ~kind~ is used to build shells, shell doublets, triplets or
+ * quartets, use in the two-electron operators. *)
+
+
+(* [[file:../angular_momentum.org::*Type][Type:2]] *)
+type t =
+  | S | P | D | F | G | H | I | J | K | L | M | N | O
+  | Int of int
 
 exception Angular_momentum_error of string
 
-type t =
+type kind =
-   | S | P | D | F | G | H | I | J | K | L | M | N | O 
+    Singlet of t
-   | Int of int
+  | Doublet of (t * t)
+  | Triplet of (t * t * t)
+  | Quartet of (t * t * t * t)
 
+open Powers
+(* Type:2 ends here *)
+
+(* [[file:../angular_momentum.org::*~of_char~][~of_char~:2]] *)
 let of_char = function
   | 's' | 'S' -> S      | 'p' | 'P' -> P
   | 'd' | 'D' -> D      | 'f' | 'F' -> F
@@ -15,7 +33,9 @@ let of_char = function
   | 'm' | 'M' -> M      | 'n' | 'N' -> N
   | 'o' | 'O' -> O
   | c -> raise (Angular_momentum_error (String.make 1 c))
+(* ~of_char~:2 ends here *)
 
+(* [[file:../angular_momentum.org::*~to_string~][~to_string~:2]] *)
 let to_string = function
   | S -> "S"       | P -> "P"
   | D -> "D"       | F -> "F"
@@ -24,7 +44,9 @@ let to_string = function
   | K -> "K"       | L -> "L"
   | M -> "M"       | N -> "N"
   | O -> "O"       | Int i -> string_of_int i
+(* ~to_string~:2 ends here *)
 
+(* [[file:../angular_momentum.org::*~to_char~][~to_char~:2]] *)
 let to_char = function
   | S -> 'S'       | P -> 'P'
   | D -> 'D'       | F -> 'F'
@@ -33,7 +55,9 @@ let to_char = function
   | K -> 'K'       | L -> 'L'
   | M -> 'M'       | N -> 'N'
   | O -> 'O'       | Int _ -> '_'
+(* ~to_char~:2 ends here *)
 
+(* [[file:../angular_momentum.org::*~to_int~][~to_int~:2]] *)
 let to_int = function
   | S -> 0         | P -> 1
   | D -> 2         | F -> 3
@@ -42,8 +66,9 @@ let to_int = function
   | K -> 8         | L -> 9
   | M -> 10        | N -> 11
   | O -> 12        | Int i -> i
+(* ~to_int~:2 ends here *)
 
-
+(* [[file:../angular_momentum.org::*~of_int~][~of_int~:2]] *)
 let of_int = function
   | 0 -> S         | 1 -> P
   | 2 -> D         | 3 -> F
@@ -52,27 +77,20 @@ let of_int = function
   | 8 -> K         | 9 -> L
   | 10 -> M        | 11 -> N
   | 12 -> O        | i -> Int i
+(* ~of_int~:2 ends here *)
 
-
+(* [[file:../angular_momentum.org::*~n_functions~][~n_functions~:2]] *)
-
-type kind =
-| Singlet of  t
-| Doublet of (t*t)
-| Triplet of (t*t*t)
-| Quartet of (t*t*t*t)
-
-
 let n_functions a =
   let a =
     to_int a
   in
   (a*a + 3*a + 2)/2
+(* ~n_functions~:2 ends here *)
 
-
+(* [[file:../angular_momentum.org::*~zkey_array~][~zkey_array~:2]] *)
 let zkey_array_memo : (kind, Zkey.t array) Hashtbl.t =
   Hashtbl.create 13
 
-(** Returns an array of Zkeys corresponding to all possible angular momenta *)
 let zkey_array a =
 
   let keys_1d l =
@@ -84,15 +102,15 @@ let zkey_array a =
       match y with
       | 0 -> (create_z xyz)::accu
       | _ -> let ynew = y-1 in
-        (create_y [@tailcall]) ( (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 ; z ;_ } = xyz in
       match x with
       | 0 -> (create_y [] xyz)@accu
       | _ -> let xnew = x-1 in
-        let ynew = l-xnew in
+          let ynew = l-xnew in
-        (create_x [@tailcall]) ((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
@@ -107,58 +125,58 @@ let zkey_array a =
       begin
         match a with
         | Singlet l1 ->
-          List.rev_map (fun x -> Zkey.of_powers_three x) (keys_1d @@ to_int l1)
+            List.rev_map (fun x -> Zkey.of_powers_three x) (keys_1d @@ to_int l1)
 
         | Doublet (l1, l2) ->
-          List.rev_map (fun a ->
+            List.rev_map (fun a ->
               List.rev_map (fun b -> Zkey.of_powers_six a b) (keys_1d @@ to_int l2)
             ) (keys_1d @@ to_int l1)
-          |> List.concat
+            |> List.concat
 
         | Triplet (l1, l2, l3) ->
 
-          List.rev_map (fun a ->
+            List.rev_map (fun a ->
               List.rev_map (fun b ->
-                  List.rev_map (fun c ->
+                List.rev_map (fun c ->
-                      Zkey.of_powers_nine a b c) (keys_1d @@ to_int l3)
+                  Zkey.of_powers_nine a b c) (keys_1d @@ to_int l3)
-                ) (keys_1d @@ to_int l2)
+              ) (keys_1d @@ to_int l2)
               |> List.concat
             ) (keys_1d @@ to_int l1)
-          |> List.concat
+            |> List.concat
 
         | Quartet (l1, l2, l3, l4) ->
 
-          List.rev_map (fun a ->
+            List.rev_map (fun a ->
               List.rev_map (fun b ->
-                  List.rev_map (fun c ->
+                List.rev_map (fun c ->
-                      List.rev_map (fun d ->
+                  List.rev_map (fun d ->
-                          Zkey.of_powers_twelve a b c d) (keys_1d @@ to_int l4)
+                    Zkey.of_powers_twelve a b c d) (keys_1d @@ to_int l4)
-                    ) (keys_1d @@ to_int l3)
+                ) (keys_1d @@ to_int l3)
-                  |> List.concat
+                |> List.concat
-                ) (keys_1d @@ to_int l2)
+              ) (keys_1d @@ to_int l2)
               |> List.concat
             ) (keys_1d @@ to_int l1)
-          |> List.concat
+            |> List.concat
       end
       |> List.rev
       |> Array.of_list
     in
     Hashtbl.add zkey_array_memo a result;
     result
+(* ~zkey_array~:2 ends here *)
 
-
+(* [[file:../angular_momentum.org::*Arithmetic][Arithmetic:2]] *)
 let ( + ) a b =
   of_int ( (to_int a) + (to_int b) )
 
 let ( - ) a b =
   of_int ( (to_int a) - (to_int b) )
+(* Arithmetic:2 ends here *)
 
-
+(* [[file:../angular_momentum.org::*Printers][Printers:2]] *)
-(** {2 Printers} *)
-
 let pp_string ppf x =
   Format.fprintf ppf "@[%s@]" (to_string x)
 
 let pp_int ppf x =
   Format.fprintf ppf "@[%d@]" (to_int x)
-
+(* Printers:2 ends here *)

common/lib/angular_momentum.mli

@@ -1,115 +1,142 @@
-(** Azimuthal quantum number, represented as {% $s,p,d,\dots$ %} *)
+(* Type
+ * 
+ *    #+NAME: types *)
 
+(* [[file:../angular_momentum.org::types][types]] *)
 type t =
- | S | P | D | F | G | H | I | J | K | L | M | N | O
+  | S | P | D | F | G | H | I | J | K | L | M | N | O
- | Int of int
+  | Int of int
 
 exception Angular_momentum_error of string
-(** Raised when the {!Angular_momentum.t} element can't be created.
-  *)
-
-
-val of_char : char -> t
-(** Returns an {!Angular_momentum.t} when a shell is given as a character (case
-  insensitive).
-
-  Example:
-
-{[
-  Angular_momentum.of_char 'p' -> Angular_momentum.P
-]}
- *)
-
-val to_string : t -> string
-(** 
-{[
-  Angular_momentum.(to_string D) -> "D"
-]}
- *)
-
-
-val to_char : t -> char
-(** 
-{[
-  Angular_momentum.(to_char D) -> 'D'
-]}
- *)
-
-
-val to_int : t -> int
-(** 
-  Returns the l{_max} value of the shell.
-
-  Example:
-
-{[
-  Angular_momentum.to_int D -> 2
-]}
- *)
-
-val of_int : int -> t
-(** 
-  Opposite of {!of_int}.
-
-  Example:
-
-{[
-  Angular_momentum.of_int 3 -> Angular_momentum.F
-]}
- *)
 
 type kind =
     Singlet of t
   | Doublet of (t * t)
   | Triplet of (t * t * t)
   | Quartet of (t * t * t * t)
+(* types ends here *)
+
+(* ~of_char~
+ * 
+ *     Returns an ~Angular_momentum.t~ when a shell is given as a character
+ *     (case insensitive):
+ * 
+ *     #+begin_example
+ * Angular_momentum.of_char 'p' -> Angular_momentum.P
+ *     #+end_example *)
 
 
+(* [[file:../angular_momentum.org::*~of_char~][~of_char~:1]] *)
+val of_char : char -> t
+(* ~of_char~:1 ends here *)
+
+(* ~to_string~
+ * 
+ *     Converts the angular momentum into a string:
+ * 
+ *     #+begin_example
+ * Angular_momentum.(to_string D) -> "D"
+ *     #+end_example *)
+
+
+(* [[file:../angular_momentum.org::*~to_string~][~to_string~:1]] *)
+val to_string : t -> string
+(* ~to_string~:1 ends here *)
+
+(* ~to_char~
+ * 
+ *     Converts the angular momentum into a char:
+ * 
+ *     #+begin_example
+ * Angular_momentum.(to_char D) -> 'D'
+ *     #+end_example *)
+
+
+(* [[file:../angular_momentum.org::*~to_char~][~to_char~:1]] *)
+val to_char : t -> char
+(* ~to_char~:1 ends here *)
+
+(* ~to_int~
+ * 
+ *     Returns the $l_{max}$ value of the shell:
+ * 
+ *     #+begin_example
+ * Angular_momentum.(to_char D) -> 2
+ *     #+end_example *)
+
+
+(* [[file:../angular_momentum.org::*~to_int~][~to_int~:1]] *)
+val to_int : t -> int
+(* ~to_int~:1 ends here *)
+
+(* ~of_int~
+ * 
+ *     Returns a shell given an $l$ value.
+ * 
+ *     #+begin_example
+ * Angular_momentum.of_int 3 -> Angular_momentum.F
+ *     #+end_example *)
+
+
+(* [[file:../angular_momentum.org::*~of_int~][~of_int~:1]] *)
+val of_int : int -> t
+(* ~of_int~:1 ends here *)
+
+(* ~n_functions~
+ * 
+ *     Returns the number of cartesian functions in a shell.
+ * 
+ *     #+begin_example
+ * Angular_momentum.n_functions D -> 6
+ *     #+end_example *)
+
+
+(* [[file:../angular_momentum.org::*~n_functions~][~n_functions~:1]] *)
 val n_functions : t -> int
-(** Number of cartesian functions in shell.
+(* ~n_functions~:1 ends here *)
 
-  Example:
+(* ~zkey_array~
-
+ * 
-{[
+ *     Array of ~Zkey.t~, where each element is a a key associated with the
-  Angular_momentum.n_functions D -> 6
+ *     the powers of $x,y,z$.
-]}
+ * 
-  *)
+ *     #+begin_example
+ *   Angular_momentum.( zkey_array Doublet (P,S) ) ->
+ *     [| {Zkey.left = 0; right = 1125899906842624} ;
+ *        {Zkey.left = 0; right = 1099511627776}    ;
+ *        {Zkey.left = 0; right = 1073741824}       |]
+ *   =
+ * 
+ *   let s,x,y,z =
+ *       Powers.( of_int_tuple (0,0,0),
+ *                of_int_tuple (1,0,0),
+ *                of_int_tuple (0,1,0),
+ *                of_int_tuple (0,0,1) )
+ *   in
+ *   Array.map (fun (a,b) -> {!Zkey.of_powers_six} a b)
+ *       [| (x,s) ; (y,s) ; (z,s) |]
+ * 
+ *     #+end_example *)
 
 
+(* [[file:../angular_momentum.org::*~zkey_array~][~zkey_array~:1]] *)
 val zkey_array : kind -> Zkey.t array
-(** Array of {!Zkey.t}, where each element is a a key associated with the
+(* ~zkey_array~:1 ends here *)
-  the powers of x,y,z.
 
-  Example:
+(* Arithmetic *)
 
-{[
-  Angular_momentum.( zkey_array Doublet (P,S) ) ->
-    [| {Zkey.left = 0; right = 1125899906842624} ;
-       {Zkey.left = 0; right = 1099511627776}    ;
-       {Zkey.left = 0; right = 1073741824}       |] 
-  =
- 
-  let s,x,y,z =
-      Powers.( of_int_tuple (0,0,0),
-               of_int_tuple (1,0,0),
-               of_int_tuple (0,1,0), 
-               of_int_tuple (0,0,1) ) 
-  in
-  Array.map (fun (a,b) -> {!Zkey.of_powers_six} a b)
-      [| (x,s) ; (y,s) ; (z,s) |]
-]}
-
-*)
 
+(* [[file:../angular_momentum.org::*Arithmetic][Arithmetic:1]] *)
 val ( + ) : t -> t -> t
 val ( - ) : t -> t -> t
+(* Arithmetic:1 ends here *)
+
+(* Printers
+ * 
+ *    Printers can print as a string (~pp_string~) or as an integer (~pp_int~). *)
 
 
-(** {2 Printers} *)
+(* [[file:../angular_momentum.org::*Printers][Printers:1]] *)
-  
 val pp_string : Format.formatter -> t -> unit
-(** Prints as a string S, P, D, ... *)
-
 val pp_int : Format.formatter -> t -> unit
-(** Prints as an integer 0, 1, 2, ... *)
+(* Printers:1 ends here *)
-

common/lib/bitstring.ml

@@ -1,7 +1,9 @@
-module One = struct
+(* Single-integer implementation *)
-  type t = int
 
 
+(* [[file:../bitstring.org::*Single-integer implementation][Single-integer implementation:1]] *)
+module One = struct
+
   let of_int x =
     assert (x > 0); x
 
@@ -24,30 +26,26 @@ module One = struct
     | 0 -> 0
     | r  -> Util.popcnt (Int64.of_int r) 
 
-
   let trailing_zeros r = 
     Util.trailz (Int64.of_int r) 
 
-
   let hamdist a b =
     a lxor b
     |> popcount 
 
-
   let pp ppf s = 
     Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring 64) 
       (Z.of_int s)
 
 end
+(* Single-integer implementation:1 ends here *)
+
+(* Zarith implementation *)
 
 
-
+(* [[file:../bitstring.org::*Zarith implementation][Zarith implementation:1]] *)
-
 module Many = struct
 
-  type t = Z.t
-
-  let of_int = Z.of_int
   let of_z x = x
   let zero = Z.zero
   let is_zero x = x = Z.zero
@@ -73,98 +71,134 @@ module Many = struct
     Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring (Z.numbits s))  s
 
 end
+(* Zarith implementation:1 ends here *)
 
-
+(* [[file:../bitstring.org::*Type][Type:2]] *)
 type t =
-| One of int
+  | One of int
-| Many of Z.t
+  | Many of Z.t
+(* Type:2 ends here *)
 
+(* [[file:../bitstring.org::*~of_int~][~of_int~:2]] *)
 let of_int x =
   One (One.of_int x)
+(* ~of_int~:2 ends here *)
 
+(* [[file:../bitstring.org::*~of_z~][~of_z~:2]] *)
 let of_z x =
   if Z.numbits x < 64 then One (Z.to_int x) else Many (Many.of_z x)
+(* ~of_z~:2 ends here *)
 
+(* [[file:../bitstring.org::*~zero~][~zero~:2]] *)
 let zero = function
 | n when n < 64 -> One (One.zero)
 | _ -> Many (Many.zero)
+(* ~zero~:2 ends here *)
 
+(* [[file:../bitstring.org::*~numbits~][~numbits~:2]] *)
 let numbits = function
 | One x -> One.numbits x
 | Many x -> Many.numbits x
+(* ~numbits~:2 ends here *)
 
+(* [[file:../bitstring.org::*~is_zero~][~is_zero~:2]] *)
 let is_zero = function
-| One x -> One.is_zero x
+  | One x -> One.is_zero x
-| Many x -> Many.is_zero x
+  | Many x -> Many.is_zero x
+(* ~is_zero~:2 ends here *)
 
+(* [[file:../bitstring.org::*~neg~][~neg~:2]] *)
 let neg = function
-| One x -> One (One.neg x)
+  | One x -> One (One.neg x)
-| Many x -> Many (Many.neg x)
+  | Many x -> Many (Many.neg x)
+(* ~neg~:2 ends here *)
 
+(* [[file:../bitstring.org::*~shift_left~][~shift_left~:2]] *)
 let shift_left x i = match x with
 | One x -> One (One.shift_left x i)
 | Many x -> Many (Many.shift_left x i)
+(* ~shift_left~:2 ends here *)
 
+(* [[file:../bitstring.org::*~shift_right~][~shift_right~:2]] *)
 let shift_right x i = match x with
 | One x -> One (One.shift_right x i)
 | Many x -> Many (Many.shift_right x i)
+(* ~shift_right~:2 ends here *)
 
+(* [[file:../bitstring.org::*~shift_left_one~][~shift_left_one~:2]] *)
 let shift_left_one = function
 | n when n < 64 -> fun i -> One (One.shift_left_one i)
 | _ -> fun i -> Many (Many.shift_left_one i)
+(* ~shift_left_one~:2 ends here *)
 
+(* [[file:../bitstring.org::*~testbit~][~testbit~:2]] *)
 let testbit = function
 | One x -> One.testbit x
 | Many x -> Many.testbit x
+(* ~testbit~:2 ends here *)
 
+(* [[file:../bitstring.org::*~logor~][~logor~:2]] *)
 let logor a b = 
   match a,b with
   | One a, One b -> One (One.logor a b)
   | Many a, Many b -> Many (Many.logor a b)
   | _ -> invalid_arg "Bitstring.logor"
+(* ~logor~:2 ends here *)
 
+(* [[file:../bitstring.org::*~logxor~][~logxor~:2]] *)
 let logxor a b = 
   match a,b with
   | One a, One b -> One (One.logxor a b)
   | Many a, Many b -> Many (Many.logxor a b)
   | _ -> invalid_arg "Bitstring.logxor"
+(* ~logxor~:2 ends here *)
 
+(* [[file:../bitstring.org::*~logand~][~logand~:2]] *)
 let logand a b = 
   match a,b with
   | One a, One b -> One (One.logand a b)
   | Many a, Many b -> Many (Many.logand a b)
   | _ -> invalid_arg "Bitstring.logand"
+(* ~logand~:2 ends here *)
 
+(* [[file:../bitstring.org::*~lognot~][~lognot~:2]] *)
 let lognot = function
 | One x -> One (One.lognot x)
 | Many x -> Many (Many.lognot x)
+(* ~lognot~:2 ends here *)
 
+(* [[file:../bitstring.org::*~minus_one~][~minus_one~:2]] *)
 let minus_one = function
 | One x -> One (One.minus_one x)
 | Many x -> Many (Many.minus_one x)
+(* ~minus_one~:2 ends here *)
 
+(* [[file:../bitstring.org::*~plus_one~][~plus_one~:2]] *)
 let plus_one = function
 | One x -> One (One.plus_one x)
 | Many x -> Many (Many.plus_one x)
+(* ~plus_one~:2 ends here *)
 
+(* [[file:../bitstring.org::*~trailing_zeros~][~trailing_zeros~:2]] *)
 let trailing_zeros = function
 | One x -> One.trailing_zeros x
 | Many x -> Many.trailing_zeros x
+(* ~trailing_zeros~:2 ends here *)
 
+(* [[file:../bitstring.org::*~hamdist~][~hamdist~:2]] *)
 let hamdist a b = match a, b with
 | One a, One b -> One.hamdist a b
 | Many a, Many b -> Many.hamdist a b
 | _ -> invalid_arg "Bitstring.hamdist"
+(* ~hamdist~:2 ends here *)
 
+(* [[file:../bitstring.org::*~popcount~][~popcount~:2]] *)
 let popcount = function
 | One x -> One.popcount x
 | Many x -> Many.popcount x
+(* ~popcount~:2 ends here *)
 
-let pp ppf = function
+(* [[file:../bitstring.org::*~to_list~][~to_list~:2]] *)
-| One x -> One.pp ppf x
-| Many x -> Many.pp ppf x
-
-
 let rec to_list ?(accu=[]) = function
   | t when (is_zero t) -> List.rev accu
   | t -> let newlist =
@@ -172,18 +206,9 @@ let rec to_list ?(accu=[]) = function
          in
          logand t @@ minus_one t
          |> (to_list [@tailcall]) ~accu:newlist
+(* ~to_list~:2 ends here *)
 
-
+(* [[file:../bitstring.org::*~permtutations~][~permtutations~:2]] *)
-(** [permtutations m n] generates the list of all possible [n]-bit
-    strings with [m] bits set to 1.
-    Algorithm adapted from
-    {{:https://graphics.stanford.edu/~seander/bithacks.html#NextBitPermutation}
-    Bit twiddling hacks}.
-    Example:
-{[
-    permtutations 2 4 = [ 0011 ; 0101 ; 0110 ; 1001 ; 1010 ; 1100 ]
-]}
-*)
 let permtutations m n =                                                                   
 
   let rec aux k u rest =
@@ -201,6 +226,10 @@ let permtutations m n =
       (aux [@tailcall]) (k-1) (logor t' t'') (u :: rest)
   in
   aux (Util.binom n m) (minus_one (shift_left_one n m)) []
+(* ~permtutations~:2 ends here *)
 
-
+(* [[file:../bitstring.org::*Printers][Printers:2]] *)
-
+let pp ppf = function
+| One x -> One.pp ppf x
+| Many x -> Many.pp ppf x
+(* Printers:2 ends here *)

common/lib/bitstring.mli

@@ -0,0 +1,244 @@
+(* Type *)
+
+
+(* [[file:../bitstring.org::*Type][Type:1]] *)
+type t
+(* Type:1 ends here *)
+
+(* ~of_int~
+ *     
+ *     Creates a bit string from an ~int~. *)
+
+
+(* [[file:../bitstring.org::*~of_int~][~of_int~:1]] *)
+val of_int : int -> t
+(* ~of_int~:1 ends here *)
+
+(* ~of_z~
+ *     
+ *     Creates a bit string from an ~Z.t~ multi-precision integer. *)
+
+
+(* [[file:../bitstring.org::*~of_z~][~of_z~:1]] *)
+val of_z : Z.t -> t
+(* ~of_z~:1 ends here *)
+
+(* ~zero~
+ * 
+ *     ~zero n~ creates a zero bit string with ~n~ bits. *)
+    
+
+(* [[file:../bitstring.org::*~zero~][~zero~:1]] *)
+val zero : int -> t
+(* ~zero~:1 ends here *)
+
+(* ~numbits~
+ * 
+ *     Returns the number of bits used to represent the bit string. *)
+    
+
+(* [[file:../bitstring.org::*~numbits~][~numbits~:1]] *)
+val numbits : t -> int
+(* ~numbits~:1 ends here *)
+
+(* ~is_zero~
+ * 
+ *     True if all the bits of the bit string are zero. *)
+    
+
+(* [[file:../bitstring.org::*~is_zero~][~is_zero~:1]] *)
+val is_zero : t -> bool
+(* ~is_zero~:1 ends here *)
+
+(* ~neg~
+ * 
+ *     Returns the negative of the integer interpretation of the bit string.
+ * 
+ *     #+begin_example
+ * neg (of_int x) = neg (of_int (-x))
+ *     #+end_example *)
+
+
+(* [[file:../bitstring.org::*~neg~][~neg~:1]] *)
+val neg : t -> t
+(* ~neg~:1 ends here *)
+
+(* ~shift_left~
+ * 
+ *     ~shift_left t n~ returns a new bit strings with all the bits
+ *     shifted ~n~ positions to the left. *)
+    
+
+(* [[file:../bitstring.org::*~shift_left~][~shift_left~:1]] *)
+val shift_left : t -> int -> t
+(* ~shift_left~:1 ends here *)
+
+(* ~shift_right~
+ * 
+ *     ~shift_right t n~ returns a new bit strings with all the bits
+ *     shifted ~n~ positions to the right. *)
+    
+
+(* [[file:../bitstring.org::*~shift_right~][~shift_right~:1]] *)
+val shift_right : t -> int -> t
+(* ~shift_right~:1 ends here *)
+
+(* ~shift_left_one~
+ * 
+ *     ~shift_left_one size n~ returns a new bit strings with the ~n~-th
+ *     bit set to one.
+ *     It is equivalent as shifting ~1~ by ~n~ bits to the left.
+ *     ~size~ is the total number of bits of the bit string. *)
+    
+
+(* [[file:../bitstring.org::*~shift_left_one~][~shift_left_one~:1]] *)
+val shift_left_one : int -> int -> t
+(* ~shift_left_one~:1 ends here *)
+
+(* ~testbit~
+ * 
+ *     ~testbit t n~ is true if the ~n~-th bit of the bit string ~t~ is
+ *     set to ~1~. *)
+    
+
+(* [[file:../bitstring.org::*~testbit~][~testbit~:1]] *)
+val testbit : t -> int -> bool
+(* ~testbit~:1 ends here *)
+
+(* ~logor~
+ * 
+ *     Bitwise logical or. *)
+
+
+(* [[file:../bitstring.org::*~logor~][~logor~:1]] *)
+val logor : t -> t -> t
+(* ~logor~:1 ends here *)
+
+(* ~logxor~
+ * 
+ *     Bitwise logical exclusive or. *)
+
+
+(* [[file:../bitstring.org::*~logxor~][~logxor~:1]] *)
+val logxor : t -> t -> t
+(* ~logxor~:1 ends here *)
+
+(* ~logand~
+ * 
+ *     Bitwise logical and. *)
+
+
+(* [[file:../bitstring.org::*~logand~][~logand~:1]] *)
+val logand : t -> t -> t
+(* ~logand~:1 ends here *)
+
+(* ~lognot~
+ * 
+ *     Bitwise logical negation. *)
+
+
+(* [[file:../bitstring.org::*~lognot~][~lognot~:1]] *)
+val lognot : t -> t
+(* ~lognot~:1 ends here *)
+
+(* ~minus_one~
+ * 
+ *     Takes the integer representation of the bit string and removes one.
+ * 
+ *     #+begin_example
+ * minus_one (of_int 10) = of_int 9
+ *     #+end_example *)
+
+
+(* [[file:../bitstring.org::*~minus_one~][~minus_one~:1]] *)
+val minus_one : t -> t
+(* ~minus_one~:1 ends here *)
+
+(* ~plus_one~
+ * 
+ *     Takes the integer representation of the bit string and adds one.
+ * 
+ *     #+begin_example
+ * plus_one (of_int 10) = of_int 11
+ *     #+end_example *)
+
+
+(* [[file:../bitstring.org::*~plus_one~][~plus_one~:1]] *)
+val plus_one : t -> t
+(* ~plus_one~:1 ends here *)
+
+(* ~trailing_zeros~
+ * 
+ *     Returns the number of trailing zeros in the bit string. *)
+    
+
+(* [[file:../bitstring.org::*~trailing_zeros~][~trailing_zeros~:1]] *)
+val trailing_zeros : t -> int
+(* ~trailing_zeros~:1 ends here *)
+
+(* ~hamdist~
+ * 
+ *     Returns the Hamming distance, i.e. the number of bits differing
+ *     between two bit strings. *)
+    
+
+(* [[file:../bitstring.org::*~hamdist~][~hamdist~:1]] *)
+val hamdist : t -> t -> int
+(* ~hamdist~:1 ends here *)
+
+(* ~popcount~
+ * 
+ *     Returns the number of bits set to one in the bit string. *)
+    
+
+(* [[file:../bitstring.org::*~popcount~][~popcount~:1]] *)
+val popcount : t -> int
+(* ~popcount~:1 ends here *)
+
+(* ~to_list~
+ * 
+ *     Converts a bit string into a list of integers indicating the
+ *     positions where the bits are set to ~1~. The first value for the
+ *     position is not ~0~ but ~1~.
+ *     
+ *     #+begin_example
+ * Bitstring.to_list (of_int 5);;
+ * - : int list = [1; 3]
+ *     #+end_example *)
+
+
+(* [[file:../bitstring.org::*~to_list~][~to_list~:1]] *)
+val to_list : ?accu:(int list) -> t -> int list
+(* ~to_list~:1 ends here *)
+
+(* ~permtutations~
+ * 
+ *     ~permtutations m n~ generates the list of all possible ~n~-bit
+ *     strings with ~m~ bits set to ~1~.
+ *     Algorithm adapted from [[https://graphics.stanford.edu/~seander/bithacks.html#NextBitPermutation][Bit twiddling hacks]].
+ *     
+ *     #+begin_example
+ * Bitstring.permtutations 2 4                                                                   |> List.map (fun x -> Format.asprintf "%a" Bitstring.pp x) ;;
+ * |> List.map (fun x -> Format.asprintf "%a" Bitstring.pp x) ;;
+ * - : string list =
+ * ["++--------------------------------------------------------------";
+ *  "+-+-------------------------------------------------------------";
+ *  "-++-------------------------------------------------------------";
+ *  "+--+------------------------------------------------------------";
+ *  "-+-+------------------------------------------------------------";
+ *  "--++------------------------------------------------------------"]
+ *     #+end_example *)
+    
+
+(* [[file:../bitstring.org::*~permtutations~][~permtutations~:1]] *)
+val permtutations : int -> int -> t list
+(* ~permtutations~:1 ends here *)
+
+(* Printers
+ * 
+ *    Printers can print as a string (~pp_string~) or as an integer (~pp_int~). *)
+
+
+(* [[file:../bitstring.org::*Printers][Printers:1]] *)
+val pp : Format.formatter -> t -> unit
+(* Printers:1 ends here *)

common/lib/dune

@@ -1,18 +1,20 @@
-; name = name of the supermodule that will wrap all source files as submodules
-; public_name = name of the library for ocamlfind and opam
 (library
+
  (name common)
  (public_name qcaml.common)
+ (synopsis "General utilities used in all QCaml libraries.")
+
  (libraries
         str
         zarith
         getopt
  )
+
  (c_names
     math_functions
  )
- (c_flags
+ (c_flags (:standard)
-   (:standard)
    -Ofast -march=native -fPIC
  )
- (synopsis "General utilities used in all QCaml libraries."))
+
+)

common/test/bitstring.ml

@@ -1,49 +1,81 @@
+(* Tests header *)
+
+
+(* [[file:../bitstring.org::*Tests header][Tests header:1]] *)
 open Common.Bitstring
-
 let check msg x = Alcotest.(check bool) msg true x
-
+let test_all () =
-let test_one () =
     let x = 8745687 in
-    let one_x  = One x in
+    let one_x  = of_int x in
+    let z = Z.shift_left (Z.of_int x) 64 in
+    let many_x = of_z z in
+(* Tests header:1 ends here *)
+
+(* [[file:../bitstring.org::*~of_int~][~of_int~:3]] *)
     Alcotest.(check bool) "of_x" true (one_x = (of_int x));
-    Alcotest.(check bool) "shift_left1" true (One (x lsl 3) = shift_left one_x 3);
+(* ~of_int~:3 ends here *)
-    Alcotest.(check bool) "shift_right1" true (One (x lsr 3) = shift_right one_x 3);
+
-    Alcotest.(check bool) "shift_left_one1" true (One (1 lsl 3) = shift_left_one 4 3);
+(* [[file:../bitstring.org::*~of_z~][~of_z~:3]] *)
-    Alcotest.(check bool) "testbit1" true  (testbit (One 8) 3);
+    Alcotest.(check bool) "of_z" true (one_x = (of_z (Z.of_int x)));
-    Alcotest.(check bool) "testbit2" false (testbit (One 8) 2);
+(* ~of_z~:3 ends here *)
-    Alcotest.(check bool) "testbit3" false (testbit (One 8) 4);
+
-    Alcotest.(check bool) "logor1" true (One (1 lor 2) = logor (One 1) (One 2));
+(* [[file:../bitstring.org::*~shift_left~][~shift_left~:3]] *)
-    Alcotest.(check bool) "logxor1" true (One (1 lxor 2) = logxor (One 1) (One 2));
+    Alcotest.(check bool) "shift_left1" true (of_int (x lsl 3) = shift_left one_x 3);
-    Alcotest.(check bool) "logand1" true (One (1 land 2) = logand (One 1) (One 2));
+    Alcotest.(check bool) "shift_left2" true (of_z (Z.shift_left z 3) = shift_left many_x 3);
-    Alcotest.(check bool) "to_list" true ([ 1 ; 3 ; 4 ; 6 ] = (to_list (One 45)))
+    Alcotest.(check bool) "shift_left3" true (of_z (Z.shift_left z 100) = shift_left many_x 100);
+(* ~shift_left~:3 ends here *)
+
+(* [[file:../bitstring.org::*~shift_right~][~shift_right~:3]] *)
+    Alcotest.(check bool) "shift_right1" true (of_int (x lsr 3) = shift_right one_x 3);
+    Alcotest.(check bool) "shift_right2" true (of_z (Z.shift_right z 3) = shift_right many_x 3);
+(* ~shift_right~:3 ends here *)
+
+(* [[file:../bitstring.org::*~shift_left_one~][~shift_left_one~:3]] *)
+    Alcotest.(check bool) "shift_left_one1" true (of_int (1 lsl 3) = shift_left_one 4 3);
+    Alcotest.(check bool) "shift_left_one2" true (of_z (Z.shift_left Z.one 200) = shift_left_one 300 200);
+(* ~shift_left_one~:3 ends here *)
+
+(* [[file:../bitstring.org::*~testbit~][~testbit~:3]] *)
+    Alcotest.(check bool) "testbit1" true  (testbit (of_int 8) 3);
+    Alcotest.(check bool) "testbit2" false (testbit (of_int 8) 2);
+    Alcotest.(check bool) "testbit3" false (testbit (of_int 8) 4);
+    Alcotest.(check bool) "testbit4" true  (testbit (of_z (Z.of_int 8)) 3);
+    Alcotest.(check bool) "testbit5" false (testbit (of_z (Z.of_int 8)) 2);
+    Alcotest.(check bool) "testbit6" false (testbit (of_z (Z.of_int 8)) 4);
+(* ~testbit~:3 ends here *)
+
+(* [[file:../bitstring.org::*~logor~][~logor~:3]] *)
+    Alcotest.(check bool) "logor1" true (of_int (1 lor 2) = logor (of_int 1) (of_int 2));
+    Alcotest.(check bool) "logor2" true (of_z (Z.of_int (1 lor 2)) = logor (of_z Z.one) (of_z (Z.of_int 2)));
+(* ~logor~:3 ends here *)
+
+(* [[file:../bitstring.org::*~logxor~][~logxor~:3]] *)
+    Alcotest.(check bool) "logxor1" true (of_int (1 lxor 2) = logxor (of_int 1) (of_int 2));
+    Alcotest.(check bool) "logxor2" true (of_z (Z.of_int (1 lxor 2)) = logxor (of_z Z.one) (of_z (Z.of_int 2)));
+(* ~logxor~:3 ends here *)
+
+(* [[file:../bitstring.org::*~logand~][~logand~:3]] *)
+    Alcotest.(check bool) "logand1" true (of_int (1 land 3) = logand (of_int 1) (of_int 3));
+    Alcotest.(check bool) "logand2" true (of_z (Z.of_int (1 land 3)) = logand (of_z Z.one) (of_z (Z.of_int 3)));
+(* ~logand~:3 ends here *)
+
+(* [[file:../bitstring.org::*~to_list~][~to_list~:3]] *)
+    Alcotest.(check bool) "to_list" true ([ 1 ; 3 ; 4 ; 6 ] = (to_list (of_int 45)));
+(* ~to_list~:3 ends here *)
+
+(* [[file:../bitstring.org::*~permtutations~][~permtutations~:3]] *)
+check "permutations"
+  (permtutations 2 4 = List.map of_int
+     [ 3 ; 5 ; 6 ; 9 ; 10 ; 12 ]);
+(* ~permtutations~:3 ends here *)
+
+(* Tests *)
 
 
-let test_many () =
+(* [[file:../bitstring.org::*Tests][Tests:1]] *)
-    let x = 8745687 in
+   ()
-    let z = Z.of_int x in
-    let one_x  = One x in
-    let many_x = Many z in
-    Alcotest.(check bool) "of_z" true (one_x = (of_z z));
-    Alcotest.(check bool) "shift_left2" true (Many (Z.shift_left z 3) = shift_left many_x 3);
-    Alcotest.(check bool) "shift_left3" true (Many (Z.shift_left z 100) = shift_left many_x 100);
-    Alcotest.(check bool) "shift_right2" true (Many (Z.shift_right z 3) = shift_right many_x 3);
-    Alcotest.(check bool) "shift_left_one2" true (Many (Z.shift_left Z.one 200) = shift_left_one 300 200);
-    Alcotest.(check bool) "testbit4" true  (testbit (Many (Z.of_int 8)) 3);
-    Alcotest.(check bool) "testbit5" false (testbit (Many (Z.of_int 8)) 2);
-    Alcotest.(check bool) "testbit6" false (testbit (Many (Z.of_int 8)) 4);
-    Alcotest.(check bool) "logor2" true (Many (Z.of_int (1 lor 2)) = logor (Many Z.one) (Many (Z.of_int 2)));
-    Alcotest.(check bool) "logxor2" true (Many (Z.of_int (1 lxor 2)) = logxor (Many Z.one) (Many (Z.of_int 2)));
-    Alcotest.(check bool) "logand2" true (Many (Z.of_int (1 land 2)) = logand (Many Z.one) (Many (Z.of_int 2)))
-
-
-let test_permutations () =
-  check "permutations"
-    (permtutations 2 4 = List.map of_int
-       [ 3 ; 5 ; 6 ; 9 ; 10 ; 12 ])
    
 let tests = [
-    "One",  `Quick, test_one;
+    "all", `Quick, test_all;
-    "Many", `Quick, test_many;
-    "permutations", `Quick, test_permutations;
   ]
-
+(* Tests:1 ends here *)

common/test/dune

@@ -1,7 +1,11 @@
 (library
+
  (name test_common)
+ (synopsis "Test for common library")
+
  (libraries
   alcotest
   qcaml.common
  )
- (synopsis "Tests for common library"))
+
+)