mirror of https://gitlab.com/scemama/QCaml.git
Added build_doc
This commit is contained in:
parent
5244b2dba8
commit
0838da5bcc
7
Makefile
7
Makefile
|
|
@ -4,12 +4,13 @@
|
|||
|
||||
default: build
|
||||
|
||||
tangle:
|
||||
|
||||
doc:
|
||||
|
||||
build:
|
||||
dune build
|
||||
|
||||
doc:
|
||||
dune build @doc
|
||||
|
||||
test:
|
||||
dune runtest -f
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,27 @@
|
|||
#!/bin/bash
|
||||
# Usage: $0 [DIR]
|
||||
|
||||
if [[ -z $1 ]] ; then
|
||||
echo "Usage: $0 [DIR]"
|
||||
exit -1
|
||||
fi
|
||||
|
||||
|
||||
if [[ $(basename $PWD) != "QCaml" ]] ; then
|
||||
echo "This script needs to be run in the QCaml directory"
|
||||
exit -1
|
||||
fi
|
||||
|
||||
DIR=${1%/}
|
||||
|
||||
rm -f docs/${DIR}.org
|
||||
for i in ${DIR}/README.org ${DIR}/[a-z]*.org
|
||||
do
|
||||
cat $i >> docs/${DIR}.org
|
||||
done
|
||||
|
||||
CONFIG="--load docs/htmlize.el --load docs/config.el"
|
||||
|
||||
emacs --batch $CONFIG docs/${DIR}.org -f org-html-export-to-html
|
||||
|
||||
|
||||
|
|
@ -1,13 +1,10 @@
|
|||
#+TITLE: Common
|
||||
#+SETUPFILE: https://fniessen.github.io/org-html-themes/org/theme-readtheorg.setup
|
||||
|
||||
[[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
|
||||
* Dune files :noexport:
|
||||
:PROPERTIES:
|
||||
:dune: lib/dune
|
||||
:dune-test: test/dune
|
||||
|
|
@ -52,6 +49,7 @@ This directory contains many utility functions used by all the other directories
|
|||
qcaml.common
|
||||
)
|
||||
#+end_src
|
||||
|
||||
*** Extra C files
|
||||
|
||||
The ~math_functions~ file contains small C snippets to add missing
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#+begin_src elisp tangle: no :results none
|
||||
#+begin_src elisp tangle: no :results none :exports none
|
||||
(setq pwd (file-name-directory buffer-file-name))
|
||||
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
|
||||
(setq lib (concat pwd "lib/"))
|
||||
|
|
@ -7,17 +7,15 @@
|
|||
(setq ml (concat lib name ".ml"))
|
||||
(setq test-ml (concat testdir name ".ml"))
|
||||
(org-babel-tangle)
|
||||
#+end_src
|
||||
#+end_src
|
||||
|
||||
|
||||
* 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,...$.
|
||||
Azimuthal quantum number, repsesented as \( s,p,d,\dots \) .
|
||||
|
||||
** Type
|
||||
|
||||
|
|
@ -43,7 +41,7 @@ type kind =
|
|||
The ~kind~ is used to build shells, shell doublets, triplets or
|
||||
quartets, use in the two-electron operators.
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
<<types>>
|
||||
open Powers
|
||||
#+end_src
|
||||
|
|
@ -65,7 +63,7 @@ Angular_momentum.of_char 'p' -> Angular_momentum.P
|
|||
val of_char : char -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let of_char = function
|
||||
| 's' | 'S' -> S | 'p' | 'P' -> P
|
||||
| 'd' | 'D' -> D | 'f' | 'F' -> F
|
||||
|
|
@ -89,7 +87,7 @@ Angular_momentum.(to_string D) -> "D"
|
|||
val to_string : t -> string
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let to_string = function
|
||||
| S -> "S" | P -> "P"
|
||||
| D -> "D" | F -> "F"
|
||||
|
|
@ -112,7 +110,7 @@ Angular_momentum.(to_char D) -> 'D'
|
|||
val to_char : t -> char
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let to_char = function
|
||||
| S -> 'S' | P -> 'P'
|
||||
| D -> 'D' | F -> 'F'
|
||||
|
|
@ -135,7 +133,7 @@ Angular_momentum.(to_char D) -> 2
|
|||
val to_int : t -> int
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let to_int = function
|
||||
| S -> 0 | P -> 1
|
||||
| D -> 2 | F -> 3
|
||||
|
|
@ -158,7 +156,7 @@ Angular_momentum.of_int 3 -> Angular_momentum.F
|
|||
val of_int : int -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let of_int = function
|
||||
| 0 -> S | 1 -> P
|
||||
| 2 -> D | 3 -> F
|
||||
|
|
@ -185,7 +183,7 @@ Angular_momentum.n_functions D -> 6
|
|||
val n_functions : t -> int
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let n_functions a =
|
||||
let a =
|
||||
to_int a
|
||||
|
|
@ -221,7 +219,7 @@ let n_functions a =
|
|||
val zkey_array : kind -> Zkey.t array
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let zkey_array_memo : (kind, Zkey.t array) Hashtbl.t =
|
||||
Hashtbl.create 13
|
||||
|
||||
|
|
@ -307,7 +305,7 @@ val ( + ) : t -> t -> t
|
|||
val ( - ) : t -> t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let ( + ) a b =
|
||||
of_int ( (to_int a) + (to_int b) )
|
||||
|
||||
|
|
@ -325,7 +323,7 @@ val pp_string : Format.formatter -> t -> unit
|
|||
val pp_int : Format.formatter -> t -> unit
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let pp_string ppf x =
|
||||
Format.fprintf ppf "@[%s@]" (to_string x)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#+begin_src elisp tangle: no :results none
|
||||
#+begin_src elisp tangle: no :results none :exports none
|
||||
(setq pwd (file-name-directory buffer-file-name))
|
||||
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
|
||||
(setq lib (concat pwd "lib/"))
|
||||
|
|
@ -7,13 +7,10 @@
|
|||
(setq ml (concat lib name ".ml"))
|
||||
(setq test-ml (concat testdir name ".ml"))
|
||||
(org-babel-tangle)
|
||||
#+end_src
|
||||
#+end_src
|
||||
|
||||
* Bit string
|
||||
:PROPERTIES:
|
||||
:ml: lib/bitstring.ml
|
||||
:mli: lib/bitstring.mli
|
||||
:test-ml: test/bitstring.ml
|
||||
:header-args: :noweb yes :comments both
|
||||
:END:
|
||||
|
||||
|
|
@ -23,10 +20,10 @@
|
|||
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 (eval ml)
|
||||
** Single-integer implementation :noexport:
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
module One = struct
|
||||
|
||||
let of_int x =
|
||||
|
|
@ -38,9 +35,9 @@ module One = struct
|
|||
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 testbit x i = ( (x lsr i) land 1 ) = 1
|
||||
let logor a b = a lor b
|
||||
let neg a = - a
|
||||
let neg a = - a
|
||||
let logxor a b = a lxor b
|
||||
let logand a b = a land b
|
||||
let lognot a = lnot a
|
||||
|
|
@ -49,31 +46,31 @@ module One = struct
|
|||
|
||||
let popcount = function
|
||||
| 0 -> 0
|
||||
| r -> Util.popcnt (Int64.of_int r)
|
||||
| r -> Util.popcnt (Int64.of_int r)
|
||||
|
||||
let trailing_zeros r =
|
||||
Util.trailz (Int64.of_int r)
|
||||
let trailing_zeros r =
|
||||
Util.trailz (Int64.of_int r)
|
||||
|
||||
let hamdist a b =
|
||||
a lxor b
|
||||
|> popcount
|
||||
|> popcount
|
||||
|
||||
let pp ppf s =
|
||||
Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring 64)
|
||||
let pp ppf s =
|
||||
Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring 64)
|
||||
(Z.of_int s)
|
||||
|
||||
end
|
||||
#+end_src
|
||||
|
||||
** Zarith implementation
|
||||
** Zarith implementation :noexport:
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
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_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
|
||||
|
|
@ -88,10 +85,10 @@ module Many = struct
|
|||
let hamdist = Z.hamdist
|
||||
let numbits i = max (Z.numbits i) 64
|
||||
|
||||
let popcount z =
|
||||
let popcount z =
|
||||
if z = Z.zero then 0 else Z.popcount z
|
||||
|
||||
let pp ppf s =
|
||||
let pp ppf s =
|
||||
Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring (Z.numbits s)) s
|
||||
|
||||
end
|
||||
|
|
@ -103,13 +100,13 @@ end
|
|||
type t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
type t =
|
||||
| One of int
|
||||
| Many of Z.t
|
||||
#+end_src
|
||||
|
||||
** Tests header
|
||||
** Tests header :noexport:
|
||||
|
||||
#+begin_src ocaml :tangle (eval test-ml)
|
||||
open Common.Bitstring
|
||||
|
|
@ -120,51 +117,52 @@ let test_all () =
|
|||
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 (eval mli)
|
||||
val of_int : int -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let of_int x =
|
||||
One (One.of_int x)
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval test-ml)
|
||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
||||
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 (eval mli)
|
||||
val of_z : Z.t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
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 (eval test-ml)
|
||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
||||
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 (eval mli)
|
||||
val zero : int -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let zero = function
|
||||
| n when n < 64 -> One (One.zero)
|
||||
| _ -> Many (Many.zero)
|
||||
|
|
@ -173,12 +171,12 @@ let zero = function
|
|||
*** ~numbits~
|
||||
|
||||
Returns the number of bits used to represent the bit string.
|
||||
|
||||
|
||||
#+begin_src ocaml :tangle (eval mli)
|
||||
val numbits : t -> int
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let numbits = function
|
||||
| One x -> One.numbits x
|
||||
| Many x -> Many.numbits x
|
||||
|
|
@ -187,12 +185,12 @@ let numbits = function
|
|||
*** ~is_zero~
|
||||
|
||||
True if all the bits of the bit string are zero.
|
||||
|
||||
|
||||
#+begin_src ocaml :tangle (eval mli)
|
||||
val is_zero : t -> bool
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let is_zero = function
|
||||
| One x -> One.is_zero x
|
||||
| Many x -> Many.is_zero x
|
||||
|
|
@ -210,7 +208,7 @@ neg (of_int x) = neg (of_int (-x))
|
|||
val neg : t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let neg = function
|
||||
| One x -> One (One.neg x)
|
||||
| Many x -> Many (Many.neg x)
|
||||
|
|
@ -220,18 +218,18 @@ let neg = function
|
|||
|
||||
~shift_left t n~ returns a new bit strings with all the bits
|
||||
shifted ~n~ positions to the left.
|
||||
|
||||
|
||||
#+begin_src ocaml :tangle (eval mli)
|
||||
val shift_left : t -> int -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
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 (eval test-ml)
|
||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
||||
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);
|
||||
|
|
@ -241,18 +239,18 @@ let shift_left x i = match x with
|
|||
|
||||
~shift_right t n~ returns a new bit strings with all the bits
|
||||
shifted ~n~ positions to the right.
|
||||
|
||||
|
||||
#+begin_src ocaml :tangle (eval mli)
|
||||
val shift_right : t -> int -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
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 (eval test-ml)
|
||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
||||
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
|
||||
|
|
@ -263,19 +261,19 @@ let shift_right x i = match x with
|
|||
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 (eval mli)
|
||||
val shift_left_one : int -> int -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
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 (eval test-ml)
|
||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
||||
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
|
||||
|
|
@ -284,18 +282,18 @@ let shift_left_one = function
|
|||
|
||||
~testbit t n~ is true if the ~n~-th bit of the bit string ~t~ is
|
||||
set to ~1~.
|
||||
|
||||
|
||||
#+begin_src ocaml :tangle (eval mli)
|
||||
val testbit : t -> int -> bool
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let testbit = function
|
||||
| One x -> One.testbit x
|
||||
| Many x -> Many.testbit x
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval test-ml)
|
||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
||||
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);
|
||||
|
|
@ -312,15 +310,15 @@ let testbit = function
|
|||
val logor : t -> t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
let logor a b =
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
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 (eval test-ml)
|
||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
||||
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
|
||||
|
|
@ -333,8 +331,8 @@ let logor a b =
|
|||
val logxor : t -> t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
let logxor a b =
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
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)
|
||||
|
|
@ -342,7 +340,7 @@ let logxor a b =
|
|||
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval test-ml)
|
||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
||||
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
|
||||
|
|
@ -355,8 +353,8 @@ let logxor a b =
|
|||
val logand : t -> t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
let logand a b =
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
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)
|
||||
|
|
@ -364,7 +362,7 @@ let logand a b =
|
|||
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval test-ml)
|
||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
||||
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
|
||||
|
|
@ -374,10 +372,10 @@ let logand a b =
|
|||
Bitwise logical negation.
|
||||
|
||||
#+begin_src ocaml :tangle (eval mli)
|
||||
val lognot : t -> t
|
||||
val lognot : t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let lognot = function
|
||||
| One x -> One (One.lognot x)
|
||||
| Many x -> Many (Many.lognot x)
|
||||
|
|
@ -395,7 +393,7 @@ minus_one (of_int 10) = of_int 9
|
|||
val minus_one : t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let minus_one = function
|
||||
| One x -> One (One.minus_one x)
|
||||
| Many x -> Many (Many.minus_one x)
|
||||
|
|
@ -413,7 +411,7 @@ plus_one (of_int 10) = of_int 11
|
|||
val plus_one : t -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let plus_one = function
|
||||
| One x -> One (One.plus_one x)
|
||||
| Many x -> Many (Many.plus_one x)
|
||||
|
|
@ -422,12 +420,12 @@ let plus_one = function
|
|||
*** ~trailing_zeros~
|
||||
|
||||
Returns the number of trailing zeros in the bit string.
|
||||
|
||||
|
||||
#+begin_src ocaml :tangle (eval mli)
|
||||
val trailing_zeros : t -> int
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let trailing_zeros = function
|
||||
| One x -> One.trailing_zeros x
|
||||
| Many x -> Many.trailing_zeros x
|
||||
|
|
@ -437,12 +435,12 @@ let trailing_zeros = function
|
|||
|
||||
Returns the Hamming distance, i.e. the number of bits differing
|
||||
between two bit strings.
|
||||
|
||||
|
||||
#+begin_src ocaml :tangle (eval mli)
|
||||
val hamdist : t -> t -> int
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let hamdist a b = match a, b with
|
||||
| One a, One b -> One.hamdist a b
|
||||
| Many a, Many b -> Many.hamdist a b
|
||||
|
|
@ -452,33 +450,33 @@ let hamdist a b = match a, b with
|
|||
*** ~popcount~
|
||||
|
||||
Returns the number of bits set to one in the bit string.
|
||||
|
||||
|
||||
#+begin_src ocaml :tangle (eval mli)
|
||||
val popcount : t -> int
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
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 (eval mli)
|
||||
val to_list : ?accu:(int list) -> t -> int list
|
||||
val to_list : ?accu:(int list) -> t -> int list
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let rec to_list ?(accu=[]) = function
|
||||
| t when (is_zero t) -> List.rev accu
|
||||
| t -> let newlist =
|
||||
|
|
@ -488,7 +486,7 @@ let rec to_list ?(accu=[]) = function
|
|||
|> (to_list [@tailcall]) ~accu:newlist
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval test-ml)
|
||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
||||
Alcotest.(check bool) "to_list" true ([ 1 ; 3 ; 4 ; 6 ] = (to_list (of_int 45)));
|
||||
#+end_src
|
||||
|
||||
|
|
@ -497,7 +495,7 @@ let rec to_list ?(accu=[]) = function
|
|||
~permutations 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.permutations 2 4
|
||||
|> List.map (fun x -> Format.asprintf "%a" Bitstring.pp x) ;;
|
||||
|
|
@ -509,13 +507,13 @@ Bitstring.permutations 2 4
|
|||
"-+-+------------------------------------------------------------";
|
||||
"--++------------------------------------------------------------"]
|
||||
#+end_example
|
||||
|
||||
|
||||
#+begin_src ocaml :tangle (eval mli)
|
||||
val permutations : int -> int -> t list
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
let permutations m n =
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let permutations m n =
|
||||
|
||||
let rec aux k u rest =
|
||||
if k=1 then
|
||||
|
|
@ -534,7 +532,7 @@ let permutations m n =
|
|||
aux (Util.binom n m) (minus_one (shift_left_one n m)) []
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval test-ml)
|
||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
||||
check "permutations"
|
||||
(permutations 2 4 = List.map of_int
|
||||
[ 3 ; 5 ; 6 ; 9 ; 10 ; 12 ]);
|
||||
|
|
@ -542,25 +540,22 @@ check "permutations"
|
|||
|
||||
** Printers
|
||||
|
||||
Printers can print as a string (~pp_string~) or as an integer (~pp_int~).
|
||||
|
||||
#+begin_src ocaml :tangle (eval mli)
|
||||
val pp : Format.formatter -> t -> unit
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let pp ppf = function
|
||||
| One x -> One.pp ppf x
|
||||
| Many x -> Many.pp ppf x
|
||||
#+end_src
|
||||
|
||||
** Tests
|
||||
** Tests :noexport:
|
||||
|
||||
#+begin_src ocaml :tangle (eval test-ml)
|
||||
#+begin_src ocaml :tangle (eval test-ml) :exports none
|
||||
()
|
||||
|
||||
|
||||
let tests = [
|
||||
"all", `Quick, test_all;
|
||||
]
|
||||
#+end_src
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#+begin_src elisp tangle: no :results none
|
||||
#+begin_src elisp tangle: no :results none :exports none
|
||||
(setq pwd (file-name-directory buffer-file-name))
|
||||
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
|
||||
(setq lib (concat pwd "lib/"))
|
||||
|
|
@ -23,7 +23,7 @@
|
|||
type t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
type t = float
|
||||
#+end_src
|
||||
|
||||
|
|
@ -36,7 +36,7 @@ val of_float : float -> t
|
|||
val to_float : t -> float
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
external of_float : float -> t = "%identity"
|
||||
external to_float : t -> float = "%identity"
|
||||
#+end_src
|
||||
|
|
@ -48,7 +48,7 @@ val of_int : int -> t
|
|||
val to_int : t -> int
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let of_int = float_of_int
|
||||
let to_int = int_of_float
|
||||
#+end_src
|
||||
|
|
@ -60,7 +60,7 @@ val of_string: string -> t
|
|||
val to_string: t -> string
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let of_string = float_of_string
|
||||
|
||||
let to_string x =
|
||||
|
|
@ -81,7 +81,7 @@ val ( * ) : t -> float -> t
|
|||
val ( / ) : t -> float -> t
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let gen_op op =
|
||||
fun a b ->
|
||||
op (to_float a) (to_float b)
|
||||
|
|
@ -99,7 +99,7 @@ let ( / ) = gen_op ( /. )
|
|||
val pp : Format.formatter -> t -> unit
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let pp ppf x =
|
||||
Format.fprintf ppf "@[+%s@]" (to_string x)
|
||||
#+end_src
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
#+begin_src elisp tangle: no :results none
|
||||
#+begin_src elisp tangle: no :results none :exports none
|
||||
(setq pwd (file-name-directory buffer-file-name))
|
||||
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
|
||||
(setq lib (concat pwd "lib/"))
|
||||
|
|
@ -7,7 +7,7 @@
|
|||
(setq ml (concat lib name ".ml"))
|
||||
(setq test-ml (concat testdir name ".ml"))
|
||||
(org-babel-tangle)
|
||||
#+end_src
|
||||
#+end_src
|
||||
|
||||
* Command line
|
||||
:PROPERTIES:
|
||||
|
|
@ -32,14 +32,14 @@ begin
|
|||
{ short='b' ; long="basis" ; opt=Mandatory;
|
||||
arg=With_arg "<string>";
|
||||
doc="Name of the file containing the basis set"; } ;
|
||||
|
||||
|
||||
{ short='m' ; long="multiplicity" ; opt=Optional;
|
||||
arg=With_arg "<int>";
|
||||
doc="Spin multiplicity (2S+1). Default is singlet"; } ;
|
||||
]
|
||||
end;
|
||||
#+end_src
|
||||
|
||||
|
||||
Then, define what to do with the arguments:
|
||||
#+begin_src ocaml :tangle no
|
||||
let c =
|
||||
|
|
@ -58,7 +58,7 @@ let multiplicity =
|
|||
| Some n -> int_of_string n
|
||||
in
|
||||
#+end_src
|
||||
|
||||
|
||||
** Type
|
||||
|
||||
- Short option: in the command line, a dash with a single character
|
||||
|
|
@ -70,12 +70,12 @@ in
|
|||
- Some options require an argument (~ls --ignore="*.ml"~ ), some
|
||||
don't (~ls -l~) and for some arguments the argument is optional
|
||||
(~git --log[=<n>]~)
|
||||
|
||||
|
||||
#+NAME:type
|
||||
#+begin_src ocaml :tangle (eval mli)
|
||||
type short_opt = char
|
||||
type long_opt = string
|
||||
type optional = Mandatory | Optional
|
||||
type long_opt = string
|
||||
type optional = Mandatory | Optional
|
||||
type documentation = string
|
||||
type argument = With_arg of string | Without_arg | With_opt_arg of string
|
||||
|
||||
|
|
@ -89,7 +89,7 @@ type description = {
|
|||
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
<<type>>
|
||||
#+end_src
|
||||
|
||||
|
|
@ -98,13 +98,13 @@ type description = {
|
|||
All the options are stored in the hash table ~dict~ where the key
|
||||
is the long option and the value is a value of type ~description~.
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let header_doc = ref ""
|
||||
let description_doc = ref ""
|
||||
let footer_doc = ref ""
|
||||
let anon_args_ref = ref []
|
||||
let specs = ref []
|
||||
let dict = Hashtbl.create 67
|
||||
let dict = Hashtbl.create 67
|
||||
#+end_src
|
||||
|
||||
Functions to set the header, footer and main description of the
|
||||
|
|
@ -115,28 +115,28 @@ val set_header_doc : string -> unit
|
|||
val set_description_doc : string -> unit
|
||||
val set_footer_doc : string -> unit
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let set_header_doc s = header_doc := s
|
||||
let set_description_doc s = description_doc := s
|
||||
let set_footer_doc s = footer_doc := s
|
||||
#+end_src
|
||||
|
||||
|
||||
Function to create an anonymous argument:
|
||||
|
||||
#+begin_src ocaml :tangle (eval mli)
|
||||
val anonymous : long_opt -> optional -> documentation -> description
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let anonymous name opt doc =
|
||||
{ short=' ' ; long=name; opt; doc; arg=Without_arg; }
|
||||
#+end_src
|
||||
|
||||
** Text formatting functions
|
||||
** Text formatting functions :noexport:
|
||||
|
||||
Function to print some text such that it fits on the screen
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let output_text t =
|
||||
Format.printf "@[<v 0>";
|
||||
begin
|
||||
|
|
@ -147,7 +147,7 @@ let output_text t =
|
|||
|> List.iter (fun y -> Format.printf "@[%s@]@ " y) ;
|
||||
Format.printf "@]"
|
||||
| t ->
|
||||
List.iter (fun x ->
|
||||
List.iter (fun x ->
|
||||
Format.printf "@[<hov 0>";
|
||||
Str.split (Str.regexp " ") x
|
||||
|> List.iter (fun y -> Format.printf "@[%s@]@ " y) ;
|
||||
|
|
@ -156,7 +156,7 @@ let output_text t =
|
|||
end;
|
||||
Format.printf "@]"
|
||||
#+end_src
|
||||
|
||||
|
||||
|
||||
Function to build the short description of the command-line
|
||||
arguments, such as
|
||||
|
|
@ -164,7 +164,7 @@ let output_text t =
|
|||
my_program -b <string> [-h] [-u <float>] -x <string> [--]
|
||||
#+end_example
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let output_short x =
|
||||
match x.short, x.opt, x.arg with
|
||||
| ' ', Mandatory, _ -> Format.printf "@[%s@]" x.long
|
||||
|
|
@ -176,16 +176,16 @@ let output_short x =
|
|||
| _ , Mandatory, With_opt_arg arg -> Format.printf "@[-%c [%s]@]" x.short arg
|
||||
| _ , Optional , With_opt_arg arg -> Format.printf "@[[-%c [%s]]@]" x.short arg
|
||||
#+end_src
|
||||
|
||||
|
||||
|
||||
Function to build the long description of the command-line
|
||||
arguments, such as
|
||||
#+begin_example
|
||||
-x --xyz=<string> Name of the file containing the nuclear
|
||||
coordinates in xyz format
|
||||
coordinates in xyz format
|
||||
#+end_example
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let output_long max_width x =
|
||||
let arg =
|
||||
match x.short, x.arg with
|
||||
|
|
@ -209,7 +209,7 @@ let output_long max_width x =
|
|||
#+end_src
|
||||
|
||||
** Query functions
|
||||
|
||||
|
||||
*** ~anon_args~
|
||||
|
||||
Returns the list of anonymous arguments
|
||||
|
|
@ -218,7 +218,7 @@ let output_long max_width x =
|
|||
val anon_args : unit -> string list
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let anon_args () = !anon_args_ref
|
||||
#+end_src
|
||||
|
||||
|
|
@ -226,7 +226,7 @@ let anon_args () = !anon_args_ref
|
|||
|
||||
Prints the documentation of the program.
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let help () =
|
||||
|
||||
(* Print the header *)
|
||||
|
|
@ -246,7 +246,7 @@ let help () =
|
|||
|
||||
(* Find column lengths *)
|
||||
let max_width =
|
||||
List.map (fun x ->
|
||||
List.map (fun x ->
|
||||
( match x.arg with
|
||||
| Without_arg -> String.length x.long
|
||||
| With_arg arg -> String.length x.long + String.length arg
|
||||
|
|
@ -302,7 +302,7 @@ let help () =
|
|||
val get : long_opt -> string option
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let get x =
|
||||
try Some (Hashtbl.find dict x)
|
||||
with Not_found -> None
|
||||
|
|
@ -316,10 +316,10 @@ let get x =
|
|||
val get_bool : long_opt -> bool
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let get_bool x = Hashtbl.mem dict x
|
||||
#+end_src
|
||||
|
||||
|
||||
** Specification
|
||||
|
||||
Gives the specifications of the current program as a list of
|
||||
|
|
@ -329,7 +329,7 @@ let get_bool x = Hashtbl.mem dict x
|
|||
val set_specs : description list -> unit
|
||||
#+end_src
|
||||
|
||||
#+begin_src ocaml :tangle (eval ml)
|
||||
#+begin_src ocaml :tangle (eval ml) :exports none
|
||||
let set_specs specs_in =
|
||||
specs := { short = 'h' ;
|
||||
long = "help" ;
|
||||
|
|
@ -359,7 +359,7 @@ let set_specs specs_in =
|
|||
|
||||
(* Check that all mandatory arguments are set *)
|
||||
List.filter (fun x -> x.short <> ' ' && x.opt = Mandatory) !specs
|
||||
|> List.iter (fun x ->
|
||||
|> List.iter (fun x ->
|
||||
match get x.long with
|
||||
| Some _ -> ()
|
||||
| None -> failwith ("Error: --"^x.long^" option is missing.")
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
(* Single-integer implementation *)
|
||||
(* Single-integer implementation :noexport: *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*Single-integer implementation][Single-integer implementation:1]] *)
|
||||
|
|
@ -13,9 +13,9 @@ module One = struct
|
|||
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 testbit x i = ( (x lsr i) land 1 ) = 1
|
||||
let logor a b = a lor b
|
||||
let neg a = - a
|
||||
let neg a = - a
|
||||
let logxor a b = a lxor b
|
||||
let logand a b = a land b
|
||||
let lognot a = lnot a
|
||||
|
|
@ -24,23 +24,23 @@ module One = struct
|
|||
|
||||
let popcount = function
|
||||
| 0 -> 0
|
||||
| r -> Util.popcnt (Int64.of_int r)
|
||||
| r -> Util.popcnt (Int64.of_int r)
|
||||
|
||||
let trailing_zeros r =
|
||||
Util.trailz (Int64.of_int r)
|
||||
let trailing_zeros r =
|
||||
Util.trailz (Int64.of_int r)
|
||||
|
||||
let hamdist a b =
|
||||
a lxor b
|
||||
|> popcount
|
||||
|> popcount
|
||||
|
||||
let pp ppf s =
|
||||
Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring 64)
|
||||
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 *)
|
||||
(* Zarith implementation :noexport: *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*Zarith implementation][Zarith implementation:1]] *)
|
||||
|
|
@ -49,7 +49,7 @@ 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_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
|
||||
|
|
@ -64,10 +64,10 @@ module Many = struct
|
|||
let hamdist = Z.hamdist
|
||||
let numbits i = max (Z.numbits i) 64
|
||||
|
||||
let popcount z =
|
||||
let popcount z =
|
||||
if z = Z.zero then 0 else Z.popcount z
|
||||
|
||||
let pp ppf s =
|
||||
let pp ppf s =
|
||||
Format.fprintf ppf "@[@[%a@]@]" (Util.pp_bitstring (Z.numbits s)) s
|
||||
|
||||
end
|
||||
|
|
@ -138,7 +138,7 @@ let testbit = function
|
|||
(* ~testbit~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~logor~][~logor~:2]] *)
|
||||
let logor a b =
|
||||
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)
|
||||
|
|
@ -146,7 +146,7 @@ let logor a b =
|
|||
(* ~logor~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~logxor~][~logxor~:2]] *)
|
||||
let logxor a b =
|
||||
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)
|
||||
|
|
@ -154,7 +154,7 @@ let logxor a b =
|
|||
(* ~logxor~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~logand~][~logand~:2]] *)
|
||||
let logand a b =
|
||||
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)
|
||||
|
|
@ -209,7 +209,7 @@ let rec to_list ?(accu=[]) = function
|
|||
(* ~to_list~:2 ends here *)
|
||||
|
||||
(* [[file:../bitstring.org::*~permutations~][~permutations~:2]] *)
|
||||
let permutations m n =
|
||||
let permutations m n =
|
||||
|
||||
let rec aux k u rest =
|
||||
if k=1 then
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ type t
|
|||
(* Type:1 ends here *)
|
||||
|
||||
(* ~of_int~
|
||||
*
|
||||
*
|
||||
* Creates a bit string from an ~int~. *)
|
||||
|
||||
|
||||
|
|
@ -15,7 +15,7 @@ val of_int : int -> t
|
|||
(* ~of_int~:1 ends here *)
|
||||
|
||||
(* ~of_z~
|
||||
*
|
||||
*
|
||||
* Creates a bit string from an ~Z.t~ multi-precision integer. *)
|
||||
|
||||
|
||||
|
|
@ -26,7 +26,7 @@ val of_z : Z.t -> t
|
|||
(* ~zero~
|
||||
*
|
||||
* ~zero n~ creates a zero bit string with ~n~ bits. *)
|
||||
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~zero~][~zero~:1]] *)
|
||||
val zero : int -> t
|
||||
|
|
@ -35,7 +35,7 @@ val zero : int -> t
|
|||
(* ~numbits~
|
||||
*
|
||||
* Returns the number of bits used to represent the bit string. *)
|
||||
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~numbits~][~numbits~:1]] *)
|
||||
val numbits : t -> int
|
||||
|
|
@ -44,7 +44,7 @@ val numbits : t -> int
|
|||
(* ~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
|
||||
|
|
@ -67,7 +67,7 @@ val neg : t -> t
|
|||
*
|
||||
* ~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
|
||||
|
|
@ -77,7 +77,7 @@ val shift_left : t -> int -> t
|
|||
*
|
||||
* ~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
|
||||
|
|
@ -89,7 +89,7 @@ val shift_right : t -> int -> t
|
|||
* 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
|
||||
|
|
@ -99,7 +99,7 @@ val shift_left_one : int -> int -> t
|
|||
*
|
||||
* ~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
|
||||
|
|
@ -170,7 +170,7 @@ val plus_one : t -> t
|
|||
(* ~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
|
||||
|
|
@ -180,7 +180,7 @@ val trailing_zeros : t -> int
|
|||
*
|
||||
* 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
|
||||
|
|
@ -189,7 +189,7 @@ val hamdist : t -> t -> int
|
|||
(* ~popcount~
|
||||
*
|
||||
* Returns the number of bits set to one in the bit string. *)
|
||||
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~popcount~][~popcount~:1]] *)
|
||||
val popcount : t -> int
|
||||
|
|
@ -200,7 +200,7 @@ val popcount : t -> int
|
|||
* 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]
|
||||
|
|
@ -216,7 +216,7 @@ val to_list : ?accu:(int list) -> t -> int list
|
|||
* ~permutations 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.permutations 2 4
|
||||
* |> List.map (fun x -> Format.asprintf "%a" Bitstring.pp x) ;;
|
||||
|
|
@ -228,15 +228,13 @@ val to_list : ?accu:(int list) -> t -> int list
|
|||
* "-+-+------------------------------------------------------------";
|
||||
* "--++------------------------------------------------------------"]
|
||||
* #+end_example *)
|
||||
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*~permutations~][~permutations~:1]] *)
|
||||
val permutations : int -> int -> t list
|
||||
(* ~permutations~:1 ends here *)
|
||||
|
||||
(* Printers
|
||||
*
|
||||
* Printers can print as a string (~pp_string~) or as an integer (~pp_int~). *)
|
||||
(* Printers *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*Printers][Printers:1]] *)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
(* [[file:../command_line.org::*Type][Type:2]] *)
|
||||
type short_opt = char
|
||||
type long_opt = string
|
||||
type optional = Mandatory | Optional
|
||||
type long_opt = string
|
||||
type optional = Mandatory | Optional
|
||||
type documentation = string
|
||||
type argument = With_arg of string | Without_arg | With_opt_arg of string
|
||||
|
||||
|
|
@ -55,7 +55,7 @@ let output_text t =
|
|||
|> List.iter (fun y -> Format.printf "@[%s@]@ " y) ;
|
||||
Format.printf "@]"
|
||||
| t ->
|
||||
List.iter (fun x ->
|
||||
List.iter (fun x ->
|
||||
Format.printf "@[<hov 0>";
|
||||
Str.split (Str.regexp " ") x
|
||||
|> List.iter (fun y -> Format.printf "@[%s@]@ " y) ;
|
||||
|
|
@ -66,7 +66,7 @@ let output_text t =
|
|||
(* Text formatting functions:1 ends here *)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(* Function to build the short description of the command-line
|
||||
* arguments, such as
|
||||
|
|
@ -95,7 +95,7 @@ let output_short x =
|
|||
* arguments, such as
|
||||
* #+begin_example
|
||||
* -x --xyz=<string> Name of the file containing the nuclear
|
||||
* coordinates in xyz format
|
||||
* coordinates in xyz format
|
||||
* #+end_example *)
|
||||
|
||||
|
||||
|
|
@ -151,7 +151,7 @@ let help () =
|
|||
|
||||
(* Find column lengths *)
|
||||
let max_width =
|
||||
List.map (fun x ->
|
||||
List.map (fun x ->
|
||||
( match x.arg with
|
||||
| Without_arg -> String.length x.long
|
||||
| With_arg arg -> String.length x.long + String.length arg
|
||||
|
|
@ -239,7 +239,7 @@ let set_specs specs_in =
|
|||
|
||||
(* Check that all mandatory arguments are set *)
|
||||
List.filter (fun x -> x.short <> ' ' && x.opt = Mandatory) !specs
|
||||
|> List.iter (fun x ->
|
||||
|> List.iter (fun x ->
|
||||
match get x.long with
|
||||
| Some _ -> ()
|
||||
| None -> failwith ("Error: --"^x.long^" option is missing.")
|
||||
|
|
|
|||
|
|
@ -9,13 +9,13 @@
|
|||
* - Some options require an argument (~ls --ignore="*.ml"~ ), some
|
||||
* don't (~ls -l~) and for some arguments the argument is optional
|
||||
* (~git --log[=<n>]~)
|
||||
*
|
||||
*
|
||||
* #+NAME:type *)
|
||||
|
||||
(* [[file:../command_line.org::type][type]] *)
|
||||
type short_opt = char
|
||||
type long_opt = string
|
||||
type optional = Mandatory | Optional
|
||||
type long_opt = string
|
||||
type optional = Mandatory | Optional
|
||||
type documentation = string
|
||||
type argument = With_arg of string | Without_arg | With_opt_arg of string
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
(* Tests header *)
|
||||
(* Tests header :noexport: *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*Tests header][Tests header:1]] *)
|
||||
|
|
@ -69,12 +69,12 @@ check "permutations"
|
|||
[ 3 ; 5 ; 6 ; 9 ; 10 ; 12 ]);
|
||||
(* ~permutations~:3 ends here *)
|
||||
|
||||
(* Tests *)
|
||||
(* Tests :noexport: *)
|
||||
|
||||
|
||||
(* [[file:../bitstring.org::*Tests][Tests:1]] *)
|
||||
()
|
||||
|
||||
|
||||
let tests = [
|
||||
"all", `Quick, test_all;
|
||||
]
|
||||
|
|
|
|||
|
|
@ -0,0 +1,74 @@
|
|||
;; Thanks to Tobias's answer on Emacs Stack Exchange:
|
||||
;; https://emacs.stackexchange.com/questions/38437/org-mode-batch-export-missing-syntax-highlighting
|
||||
|
||||
(package-initialize)
|
||||
(require 'htmlize)
|
||||
(require 'font-lock)
|
||||
(require 'subr-x) ;; for `when-let'
|
||||
|
||||
(unless (boundp 'maximal-integer)
|
||||
(defconst maximal-integer (lsh -1 -1)
|
||||
"Maximal integer value representable natively in emacs lisp."))
|
||||
|
||||
(defun face-spec-default (spec)
|
||||
"Get list containing at most the default entry of face SPEC.
|
||||
Return nil if SPEC has no default entry."
|
||||
(let* ((first (car-safe spec))
|
||||
(display (car-safe first)))
|
||||
(when (eq display 'default)
|
||||
(list (car-safe spec)))))
|
||||
|
||||
(defun face-spec-min-color (display-atts)
|
||||
"Get min-color entry of DISPLAY-ATTS pair from face spec."
|
||||
(let* ((display (car-safe display-atts)))
|
||||
(or (car-safe (cdr (assoc 'min-colors display)))
|
||||
maximal-integer)))
|
||||
|
||||
(defun face-spec-highest-color (spec)
|
||||
"Search face SPEC for highest color.
|
||||
That means the DISPLAY entry of SPEC
|
||||
with class 'color and highest min-color value."
|
||||
(let ((color-list (cl-remove-if-not
|
||||
(lambda (display-atts)
|
||||
(when-let ((display (car-safe display-atts))
|
||||
(class (and (listp display)
|
||||
(assoc 'class display)))
|
||||
(background (assoc 'background display)))
|
||||
(and (member 'light (cdr background))
|
||||
(member 'color (cdr class)))))
|
||||
spec)))
|
||||
(cl-reduce (lambda (display-atts1 display-atts2)
|
||||
(if (> (face-spec-min-color display-atts1)
|
||||
(face-spec-min-color display-atts2))
|
||||
display-atts1
|
||||
display-atts2))
|
||||
(cdr color-list)
|
||||
:initial-value (car color-list))))
|
||||
|
||||
(defun face-spec-t (spec)
|
||||
"Search face SPEC for fall back."
|
||||
(cl-find-if (lambda (display-atts)
|
||||
(eq (car-safe display-atts) t))
|
||||
spec))
|
||||
|
||||
(defun my-face-attribute (face attribute &optional frame inherit)
|
||||
"Get FACE ATTRIBUTE from `face-user-default-spec' and not from `face-attribute'."
|
||||
(let* ((face-spec (face-user-default-spec face))
|
||||
(display-attr (or (face-spec-highest-color face-spec)
|
||||
(face-spec-t face-spec)))
|
||||
(attr (cdr display-attr))
|
||||
(val (or (plist-get attr attribute) (car-safe (cdr (assoc attribute attr))))))
|
||||
;; (message "attribute: %S" attribute) ;; for debugging
|
||||
(when (and (null (eq attribute :inherit))
|
||||
(null val))
|
||||
(let ((inherited-face (my-face-attribute face :inherit)))
|
||||
(when (and inherited-face
|
||||
(null (eq inherited-face 'unspecified)))
|
||||
(setq val (my-face-attribute inherited-face attribute)))))
|
||||
(or val 'unspecified)))
|
||||
|
||||
(advice-add 'face-attribute :override #'my-face-attribute)
|
||||
|
||||
(setq ml "ml")
|
||||
(setq mli "mli")
|
||||
(setq test-ml "test-ml")
|
||||
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue