LCPQ/QCaml
10
1
Fork 0
mirror of https://gitlab.com/scemama/QCaml.git synced 2024-11-06 22:23:42 +01:00
Code Releases Activity

Added build_doc

Browse Source
This commit is contained in:
Anthony Scemama 2020-12-27 16:36:25 +01:00
parent 5244b2dba8
commit 0838da5bcc
14 changed files with 2177 additions and 204 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
Makefile
View File

@ -4,11 +4,12 @@
default: build default: build
build: tangle:
dune build
doc: doc:
dune build @doc
build:
dune build
test: test:
dune runtest -f dune runtest -f

27
bin/build_doc.sh Executable file
View File

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

8
common/README.org
View File

@ -1,13 +1,10 @@
#+TITLE: Common #+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. This directory contains many utility functions used by all the other directories.
- [[./angular_momentum.org][Angular Momentum]] * Dune files :noexport:
- [[./bitstring.org][Bit string]]
* Dune files
:PROPERTIES: :PROPERTIES:
:dune: lib/dune :dune: lib/dune
:dune-test: test/dune :dune-test: test/dune
@ -52,6 +49,7 @@ This directory contains many utility functions used by all the other directories
qcaml.common qcaml.common
) )
#+end_src #+end_src
*** Extra C files *** Extra C files
The ~math_functions~ file contains small C snippets to add missing The ~math_functions~ file contains small C snippets to add missing

26
common/angular_momentum.org
View File

@ -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 pwd (file-name-directory buffer-file-name))
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) (setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
(setq lib (concat pwd "lib/")) (setq lib (concat pwd "lib/"))
@ -12,12 +12,10 @@
* Angular Momentum * Angular Momentum
:PROPERTIES: :PROPERTIES:
:ml: lib/angular_momentum.ml
:mli: lib/angular_momentum.mli
:header-args: :noweb yes :comments both :header-args: :noweb yes :comments both
:END: :END:
Azimuthal quantum number, repsesented as $s,p,d,...$. Azimuthal quantum number, repsesented as \( s,p,d,\dots \) .
** Type ** Type
@ -43,7 +41,7 @@ type kind =
The ~kind~ is used to build shells, shell doublets, triplets or The ~kind~ is used to build shells, shell doublets, triplets or
quartets, use in the two-electron operators. quartets, use in the two-electron operators.
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
<<types>> <<types>>
open Powers open Powers
#+end_src #+end_src
@ -65,7 +63,7 @@ Angular_momentum.of_char 'p' -> Angular_momentum.P
val of_char : char -> t val of_char : char -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let of_char = function let of_char = function
| 's' | 'S' -> S | 'p' | 'P' -> P | 's' | 'S' -> S | 'p' | 'P' -> P
| 'd' | 'D' -> D | 'f' | 'F' -> F | 'd' | 'D' -> D | 'f' | 'F' -> F
@ -89,7 +87,7 @@ Angular_momentum.(to_string D) -> "D"
val to_string : t -> string val to_string : t -> string
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let to_string = function let to_string = function
| S -> "S" | P -> "P" | S -> "S" | P -> "P"
| D -> "D" | F -> "F" | D -> "D" | F -> "F"
@ -112,7 +110,7 @@ Angular_momentum.(to_char D) -> 'D'
val to_char : t -> char val to_char : t -> char
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let to_char = function let to_char = function
| S -> 'S' | P -> 'P' | S -> 'S' | P -> 'P'
| D -> 'D' | F -> 'F' | D -> 'D' | F -> 'F'
@ -135,7 +133,7 @@ Angular_momentum.(to_char D) -> 2
val to_int : t -> int val to_int : t -> int
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let to_int = function let to_int = function
| S -> 0 | P -> 1 | S -> 0 | P -> 1
| D -> 2 | F -> 3 | D -> 2 | F -> 3
@ -158,7 +156,7 @@ Angular_momentum.of_int 3 -> Angular_momentum.F
val of_int : int -> t val of_int : int -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let of_int = function let of_int = function
| 0 -> S | 1 -> P | 0 -> S | 1 -> P
| 2 -> D | 3 -> F | 2 -> D | 3 -> F
@ -185,7 +183,7 @@ Angular_momentum.n_functions D -> 6
val n_functions : t -> int val n_functions : t -> int
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let n_functions a = let n_functions a =
let a = let a =
to_int a to_int a
@ -221,7 +219,7 @@ let n_functions a =
val zkey_array : kind -> Zkey.t array val zkey_array : kind -> Zkey.t array
#+end_src #+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 = let zkey_array_memo : (kind, Zkey.t array) Hashtbl.t =
Hashtbl.create 13 Hashtbl.create 13
@ -307,7 +305,7 @@ val ( + ) : t -> t -> t
val ( - ) : t -> t -> t val ( - ) : t -> t -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let ( + ) a b = let ( + ) a b =
of_int ( (to_int a) + (to_int 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 val pp_int : Format.formatter -> t -> unit
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let pp_string ppf x = let pp_string ppf x =
Format.fprintf ppf "@[%s@]" (to_string x) Format.fprintf ppf "@[%s@]" (to_string x)

91
common/bitstring.org
View File

@ -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 pwd (file-name-directory buffer-file-name))
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) (setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
(setq lib (concat pwd "lib/")) (setq lib (concat pwd "lib/"))
@ -11,9 +11,6 @@
* Bit string * Bit string
:PROPERTIES: :PROPERTIES:
:ml: lib/bitstring.ml
:mli: lib/bitstring.mli
:test-ml: test/bitstring.ml
:header-args: :noweb yes :comments both :header-args: :noweb yes :comments both
:END: :END:
@ -24,9 +21,9 @@
consider the bit string as a multi-precision integer. consider the bit string as a multi-precision integer.
** Single-integer implementation ** Single-integer implementation :noexport:
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
module One = struct module One = struct
let of_int x = let of_int x =
@ -65,9 +62,9 @@ module One = struct
end end
#+end_src #+end_src
** Zarith implementation ** Zarith implementation :noexport:
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
module Many = struct module Many = struct
let of_z x = x let of_z x = x
@ -103,13 +100,13 @@ end
type t type t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
type t = type t =
| One of int | One of int
| Many of Z.t | Many of Z.t
#+end_src #+end_src
** Tests header ** Tests header :noexport:
#+begin_src ocaml :tangle (eval test-ml) #+begin_src ocaml :tangle (eval test-ml)
open Common.Bitstring open Common.Bitstring
@ -120,6 +117,7 @@ let test_all () =
let z = Z.shift_left (Z.of_int x) 64 in let z = Z.shift_left (Z.of_int x) 64 in
let many_x = of_z z in let many_x = of_z z in
#+end_src #+end_src
** General implementation ** General implementation
*** ~of_int~ *** ~of_int~
@ -130,12 +128,12 @@ let test_all () =
val of_int : int -> t val of_int : int -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let of_int x = let of_int x =
One (One.of_int x) One (One.of_int x)
#+end_src #+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)); Alcotest.(check bool) "of_x" true (one_x = (of_int x));
#+end_src #+end_src
@ -147,12 +145,12 @@ let of_int x =
val of_z : Z.t -> t val of_z : Z.t -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let of_z x = let of_z x =
if Z.numbits x < 64 then One (Z.to_int x) else Many (Many.of_z x) if Z.numbits x < 64 then One (Z.to_int x) else Many (Many.of_z x)
#+end_src #+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))); Alcotest.(check bool) "of_z" true (one_x = (of_z (Z.of_int x)));
#+end_src #+end_src
@ -164,7 +162,7 @@ let of_z x =
val zero : int -> t val zero : int -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let zero = function let zero = function
| n when n < 64 -> One (One.zero) | n when n < 64 -> One (One.zero)
| _ -> Many (Many.zero) | _ -> Many (Many.zero)
@ -178,7 +176,7 @@ let zero = function
val numbits : t -> int val numbits : t -> int
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let numbits = function let numbits = function
| One x -> One.numbits x | One x -> One.numbits x
| Many x -> Many.numbits x | Many x -> Many.numbits x
@ -192,7 +190,7 @@ let numbits = function
val is_zero : t -> bool val is_zero : t -> bool
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let is_zero = function 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
@ -210,7 +208,7 @@ neg (of_int x) = neg (of_int (-x))
val neg : t -> t val neg : t -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let neg = function 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)
@ -225,13 +223,13 @@ let neg = function
val shift_left : t -> int -> t val shift_left : t -> int -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let shift_left x i = match x with let shift_left x i = match x with
| One x -> One (One.shift_left x i) | One x -> One (One.shift_left x i)
| Many x -> Many (Many.shift_left x i) | Many x -> Many (Many.shift_left x i)
#+end_src #+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_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_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); Alcotest.(check bool) "shift_left3" true (of_z (Z.shift_left z 100) = shift_left many_x 100);
@ -246,13 +244,13 @@ let shift_left x i = match x with
val shift_right : t -> int -> t val shift_right : t -> int -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let shift_right x i = match x with let shift_right x i = match x with
| One x -> One (One.shift_right x i) | One x -> One (One.shift_right x i)
| Many x -> Many (Many.shift_right x i) | Many x -> Many (Many.shift_right x i)
#+end_src #+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_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); Alcotest.(check bool) "shift_right2" true (of_z (Z.shift_right z 3) = shift_right many_x 3);
#+end_src #+end_src
@ -268,14 +266,14 @@ let shift_right x i = match x with
val shift_left_one : int -> int -> t val shift_left_one : int -> int -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let shift_left_one = function let shift_left_one = function
| n when n < 64 -> fun i -> One (One.shift_left_one i) | n when n < 64 -> fun i -> One (One.shift_left_one i)
| _ -> fun i -> Many (Many.shift_left_one i) | _ -> fun i -> Many (Many.shift_left_one i)
#+end_src #+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_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); Alcotest.(check bool) "shift_left_one2" true (of_z (Z.shift_left Z.one 200) = shift_left_one 300 200);
#+end_src #+end_src
@ -289,13 +287,13 @@ let shift_left_one = function
val testbit : t -> int -> bool val testbit : t -> int -> bool
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let testbit = function let testbit = function
| One x -> One.testbit x | One x -> One.testbit x
| Many x -> Many.testbit x | Many x -> Many.testbit x
#+end_src #+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) "testbit1" true (testbit (of_int 8) 3);
Alcotest.(check bool) "testbit2" false (testbit (of_int 8) 2); Alcotest.(check bool) "testbit2" false (testbit (of_int 8) 2);
Alcotest.(check bool) "testbit3" false (testbit (of_int 8) 4); Alcotest.(check bool) "testbit3" false (testbit (of_int 8) 4);
@ -312,7 +310,7 @@ let testbit = function
val logor : t -> t -> t val logor : t -> t -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let logor a b = let logor a b =
match a,b with match a,b with
| One a, One b -> One (One.logor a b) | One a, One b -> One (One.logor a b)
@ -320,7 +318,7 @@ let logor a b =
| _ -> invalid_arg "Bitstring.logor" | _ -> invalid_arg "Bitstring.logor"
#+end_src #+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) "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))); 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 #+end_src
@ -333,7 +331,7 @@ let logor a b =
val logxor : t -> t -> t val logxor : t -> t -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let logxor a b = let logxor a b =
match a,b with match a,b with
| One a, One b -> One (One.logxor a b) | One a, One b -> One (One.logxor a b)
@ -342,7 +340,7 @@ let logxor a b =
#+end_src #+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) "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))); 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 #+end_src
@ -355,7 +353,7 @@ let logxor a b =
val logand : t -> t -> t val logand : t -> t -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let logand a b = let logand a b =
match a,b with match a,b with
| One a, One b -> One (One.logand a b) | One a, One b -> One (One.logand a b)
@ -364,7 +362,7 @@ let logand a b =
#+end_src #+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) "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))); 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 #+end_src
@ -377,7 +375,7 @@ let logand a b =
val lognot : t -> t val lognot : t -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let lognot = function let lognot = function
| One x -> One (One.lognot x) | One x -> One (One.lognot x)
| Many x -> Many (Many.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 val minus_one : t -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let minus_one = function let minus_one = function
| One x -> One (One.minus_one x) | One x -> One (One.minus_one x)
| Many x -> Many (Many.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 val plus_one : t -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let plus_one = function let plus_one = function
| One x -> One (One.plus_one x) | One x -> One (One.plus_one x)
| Many x -> Many (Many.plus_one x) | Many x -> Many (Many.plus_one x)
@ -427,7 +425,7 @@ let plus_one = function
val trailing_zeros : t -> int val trailing_zeros : t -> int
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let trailing_zeros = function let trailing_zeros = function
| One x -> One.trailing_zeros x | One x -> One.trailing_zeros x
| Many x -> Many.trailing_zeros x | Many x -> Many.trailing_zeros x
@ -442,7 +440,7 @@ let trailing_zeros = function
val hamdist : t -> t -> int val hamdist : t -> t -> int
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let hamdist a b = match a, b with let hamdist a b = match a, b with
| One a, One b -> One.hamdist a b | One a, One b -> One.hamdist a b
| Many a, Many b -> Many.hamdist a b | Many a, Many b -> Many.hamdist a b
@ -457,7 +455,7 @@ let hamdist a b = match a, b with
val popcount : t -> int val popcount : t -> int
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let popcount = function let popcount = function
| One x -> One.popcount x | One x -> One.popcount x
| Many x -> Many.popcount x | Many x -> Many.popcount x
@ -478,7 +476,7 @@ Bitstring.to_list (of_int 5);;
val to_list : ?accu:(int list) -> t -> int list val to_list : ?accu:(int list) -> t -> int list
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let rec to_list ?(accu=[]) = function let rec to_list ?(accu=[]) = function
| t when (is_zero t) -> List.rev accu | t when (is_zero t) -> List.rev accu
| t -> let newlist = | t -> let newlist =
@ -488,7 +486,7 @@ let rec to_list ?(accu=[]) = function
|> (to_list [@tailcall]) ~accu:newlist |> (to_list [@tailcall]) ~accu:newlist
#+end_src #+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))); Alcotest.(check bool) "to_list" true ([ 1 ; 3 ; 4 ; 6 ] = (to_list (of_int 45)));
#+end_src #+end_src
@ -514,7 +512,7 @@ Bitstring.permutations 2 4
val permutations : int -> int -> t list val permutations : int -> int -> t list
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let permutations m n = let permutations m n =
let rec aux k u rest = let rec aux k u rest =
@ -534,7 +532,7 @@ let permutations m n =
aux (Util.binom n m) (minus_one (shift_left_one n m)) [] aux (Util.binom n m) (minus_one (shift_left_one n m)) []
#+end_src #+end_src
#+begin_src ocaml :tangle (eval test-ml) #+begin_src ocaml :tangle (eval test-ml) :exports none
check "permutations" check "permutations"
(permutations 2 4 = List.map of_int (permutations 2 4 = List.map of_int
[ 3 ; 5 ; 6 ; 9 ; 10 ; 12 ]); [ 3 ; 5 ; 6 ; 9 ; 10 ; 12 ]);
@ -542,25 +540,22 @@ check "permutations"
** Printers ** Printers
Printers can print as a string (~pp_string~) or as an integer (~pp_int~).
#+begin_src ocaml :tangle (eval mli) #+begin_src ocaml :tangle (eval mli)
val pp : Format.formatter -> t -> unit val pp : Format.formatter -> t -> unit
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let pp ppf = function let pp ppf = function
| One x -> One.pp ppf x | One x -> One.pp ppf x
| Many x -> Many.pp ppf x | Many x -> Many.pp ppf x
#+end_src #+end_src
** Tests ** Tests :noexport:
#+begin_src ocaml :tangle (eval test-ml) #+begin_src ocaml :tangle (eval test-ml) :exports none
() ()
let tests = [ let tests = [
"all", `Quick, test_all; "all", `Quick, test_all;
] ]
#+end_src #+end_src

14
common/charge.org
View File

@ -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 pwd (file-name-directory buffer-file-name))
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) (setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
(setq lib (concat pwd "lib/")) (setq lib (concat pwd "lib/"))
@ -23,7 +23,7 @@
type t type t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
type t = float type t = float
#+end_src #+end_src
@ -36,7 +36,7 @@ val of_float : float -> t
val to_float : t -> float val to_float : t -> float
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
external of_float : float -> t = "%identity" external of_float : float -> t = "%identity"
external to_float : t -> float = "%identity" external to_float : t -> float = "%identity"
#+end_src #+end_src
@ -48,7 +48,7 @@ val of_int : int -> t
val to_int : t -> int val to_int : t -> int
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let of_int = float_of_int let of_int = float_of_int
let to_int = int_of_float let to_int = int_of_float
#+end_src #+end_src
@ -60,7 +60,7 @@ val of_string: string -> t
val to_string: t -> string val to_string: t -> string
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let of_string = float_of_string let of_string = float_of_string
let to_string x = let to_string x =
@ -81,7 +81,7 @@ val ( * ) : t -> float -> t
val ( / ) : t -> float -> t val ( / ) : t -> float -> t
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let gen_op op = let gen_op op =
fun a b -> fun a b ->
op (to_float a) (to_float b) op (to_float a) (to_float b)
@ -99,7 +99,7 @@ let ( / ) = gen_op ( /. )
val pp : Format.formatter -> t -> unit val pp : Format.formatter -> t -> unit
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let pp ppf x = let pp ppf x =
Format.fprintf ppf "@[+%s@]" (to_string x) Format.fprintf ppf "@[+%s@]" (to_string x)
#+end_src #+end_src

28
common/command_line.org
View File

@ -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 pwd (file-name-directory buffer-file-name))
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) (setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
(setq lib (concat pwd "lib/")) (setq lib (concat pwd "lib/"))
@ -89,7 +89,7 @@ type description = {
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
<<type>> <<type>>
#+end_src #+end_src
@ -98,7 +98,7 @@ type description = {
All the options are stored in the hash table ~dict~ where the key 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~. 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 header_doc = ref ""
let description_doc = ref "" let description_doc = ref ""
let footer_doc = ref "" let footer_doc = ref ""
@ -116,7 +116,7 @@ val set_description_doc : string -> unit
val set_footer_doc : string -> unit val set_footer_doc : string -> unit
#+end_src #+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_header_doc s = header_doc := s
let set_description_doc s = description_doc := s let set_description_doc s = description_doc := s
let set_footer_doc s = footer_doc := s let set_footer_doc s = footer_doc := s
@ -128,15 +128,15 @@ let set_footer_doc s = footer_doc := s
val anonymous : long_opt -> optional -> documentation -> description val anonymous : long_opt -> optional -> documentation -> description
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let anonymous name opt doc = let anonymous name opt doc =
{ short=' ' ; long=name; opt; doc; arg=Without_arg; } { short=' ' ; long=name; opt; doc; arg=Without_arg; }
#+end_src #+end_src
** Text formatting functions ** Text formatting functions :noexport:
Function to print some text such that it fits on the screen 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 = let output_text t =
Format.printf "@[<v 0>"; Format.printf "@[<v 0>";
begin begin
@ -164,7 +164,7 @@ let output_text t =
my_program -b <string> [-h] [-u <float>] -x <string> [--] my_program -b <string> [-h] [-u <float>] -x <string> [--]
#+end_example #+end_example
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let output_short x = let output_short x =
match x.short, x.opt, x.arg with match x.short, x.opt, x.arg with
| ' ', Mandatory, _ -> Format.printf "@[%s@]" x.long | ' ', Mandatory, _ -> Format.printf "@[%s@]" x.long
@ -185,7 +185,7 @@ let output_short x =
coordinates in xyz format coordinates in xyz format
#+end_example #+end_example
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let output_long max_width x = let output_long max_width x =
let arg = let arg =
match x.short, x.arg with match x.short, x.arg with
@ -218,7 +218,7 @@ let output_long max_width x =
val anon_args : unit -> string list val anon_args : unit -> string list
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let anon_args () = !anon_args_ref let anon_args () = !anon_args_ref
#+end_src #+end_src
@ -226,7 +226,7 @@ let anon_args () = !anon_args_ref
Prints the documentation of the program. Prints the documentation of the program.
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let help () = let help () =
(* Print the header *) (* Print the header *)
@ -302,7 +302,7 @@ let help () =
val get : long_opt -> string option val get : long_opt -> string option
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let get x = let get x =
try Some (Hashtbl.find dict x) try Some (Hashtbl.find dict x)
with Not_found -> None with Not_found -> None
@ -316,7 +316,7 @@ let get x =
val get_bool : long_opt -> bool val get_bool : long_opt -> bool
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let get_bool x = Hashtbl.mem dict x let get_bool x = Hashtbl.mem dict x
#+end_src #+end_src
@ -329,7 +329,7 @@ let get_bool x = Hashtbl.mem dict x
val set_specs : description list -> unit val set_specs : description list -> unit
#+end_src #+end_src
#+begin_src ocaml :tangle (eval ml) #+begin_src ocaml :tangle (eval ml) :exports none
let set_specs specs_in = let set_specs specs_in =
specs := { short = 'h' ; specs := { short = 'h' ;
long = "help" ; long = "help" ;

4
common/lib/bitstring.ml
View File

@ -1,4 +1,4 @@
(* Single-integer implementation *) (* Single-integer implementation :noexport: *)
(* [[file:../bitstring.org::*Single-integer implementation][Single-integer implementation:1]] *) (* [[file:../bitstring.org::*Single-integer implementation][Single-integer implementation:1]] *)
@ -40,7 +40,7 @@ module One = struct
end end
(* Single-integer implementation:1 ends here *) (* Single-integer implementation:1 ends here *)
(* Zarith implementation *) (* Zarith implementation :noexport: *)
(* [[file:../bitstring.org::*Zarith implementation][Zarith implementation:1]] *) (* [[file:../bitstring.org::*Zarith implementation][Zarith implementation:1]] *)

4
common/lib/bitstring.mli
View File

@ -234,9 +234,7 @@ val to_list : ?accu:(int list) -> t -> int list
val permutations : int -> int -> t list val permutations : int -> int -> t list
(* ~permutations~:1 ends here *) (* ~permutations~:1 ends here *)
(* Printers (* Printers *)
*
* Printers can print as a string (~pp_string~) or as an integer (~pp_int~). *)
(* [[file:../bitstring.org::*Printers][Printers:1]] *) (* [[file:../bitstring.org::*Printers][Printers:1]] *)

4
common/test/bitstring.ml
View File

@ -1,4 +1,4 @@
(* Tests header *) (* Tests header :noexport: *)
(* [[file:../bitstring.org::*Tests header][Tests header:1]] *) (* [[file:../bitstring.org::*Tests header][Tests header:1]] *)
@ -69,7 +69,7 @@ check "permutations"
[ 3 ; 5 ; 6 ; 9 ; 10 ; 12 ]); [ 3 ; 5 ; 6 ; 9 ; 10 ; 12 ]);
(* ~permutations~:3 ends here *) (* ~permutations~:3 ends here *)
(* Tests *) (* Tests :noexport: *)
(* [[file:../bitstring.org::*Tests][Tests:1]] *) (* [[file:../bitstring.org::*Tests][Tests:1]] *)

74
docs/config.el Executable file
View File

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

1882
docs/htmlize.el Normal file
View File

File diff suppressed because it is too large Load Diff