Browse Source

first commit

master
zapashcanon 3 years ago
commit
354979624e
Signed by: zapashcanon GPG Key ID: 8981C3C62D1D28F1
  1. 3
      .gitignore
  2. 16
      .ocamlformat
  3. 8
      LICENSE.md
  4. 77
      README.md
  5. 3
      dune-project
  6. 23
      hashcons.opam
  7. 7
      scripts/build.sh
  8. 7
      scripts/clean.sh
  9. 12
      scripts/coverage.sh
  10. 7
      scripts/doc.sh
  11. 8
      scripts/format.sh
  12. 7
      scripts/test.sh
  13. 9
      scripts/view_coverage.sh
  14. 7
      scripts/view_doc.sh
  15. 5
      src/dune
  16. 45
      src/hashcons.ml
  17. 3
      test/dune
  18. 64
      test/test.ml

3
.gitignore

@ -0,0 +1,3 @@
*.merlin
_build/
_coverage/

16
.ocamlformat

@ -0,0 +1,16 @@
version=0.11.0
break-sequences=true
doc-comments=before
field-space=loose
let-and=sparse
sequence-style=terminator
type-decl=sparse
wrap-comments=true
if-then-else=k-r
let-and=sparse
space-around-records
space-around-lists
space-around-arrays
cases-exp-indent=2
max-indent=2
break-cases=all

8
LICENSE.md

@ -0,0 +1,8 @@
The ISC License (ISC)
=====================
Copyright © 2019, Léo Andrès
Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies.
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

77
README.md

@ -0,0 +1,77 @@
# Hashcons
Hashcons is an [OCaml] library for [hash consing].
## Usage
TODO
## Build
To build the library:
```sh
scripts/build.sh
```
To clean after building:
```sh
scripts/clean.sh
```
## Documentation
To build the documentation:
```sh
scripts/doc.sh
```
You can open it in your browser using:
```sh
scripts/view_doc.sh
```
## Tests
To run the tests:
```sh
scripts/test.sh
```
To run the tests with coverage report:
```sh
scripts/coverage.sh
```
You can open the tests coverage report in your web browser using:
```sh
scripts/view_coverage.sh
```
## Format
You can format the code using:
```sh
scripts/format.sh
```
## License
See [LICENSE].
## Changelog
See [CHANGELOG].
[CHANGELOG]: ./CHANGELOG.md
[LICENSE]: ./LICENSE.md
[hash consing]: https://en.wikipedia.org/wiki/Hash_consing
[OCaml]: https://en.wikipedia.org/wiki/OCaml

3
dune-project

@ -0,0 +1,3 @@
(lang dune 1.11)
(name memo)
(explicit_js_mode)

23
hashcons.opam

@ -0,0 +1,23 @@
opam-version: "2.0"
synopsis: "Hash consing library"
version: "dev"
license: "ISC"
homepage: "https://git.zapashcanon.fr/zapashcanon/hashcons"
bug-reports: "https://git.zapashcanon.fr/zapashcanon/hashcons/issues"
authors: "Léo Andrès (zapashcanon) <leo@ndrs.fr>"
maintainer: "Léo Andrès (zapashcanon) <leo@ndrs.fr>"
dev-repo: "git+https://git.zapashcanon.fr/zapashcanon/hashcons.git"
depends: [
"ocaml"
"dune" {>= "1.11.0"}
]
build: [
["dune" "build" "-p" name "-j" jobs]
]
description: "Hashcons is a library for hash consing."

7
scripts/build.sh

@ -0,0 +1,7 @@
#!/bin/sh
set -eu
( cd "$(dirname "$0")/../"
eval "$(opam env)"
dune build @all )

7
scripts/clean.sh

@ -0,0 +1,7 @@
#!/bin/sh
set -eu
( cd "$(dirname "$0")/../"
eval "$(opam env)"
dune clean )

12
scripts/coverage.sh

@ -0,0 +1,12 @@
#!/bin/sh
set -eu
( cd "$(dirname "$0")/../"
scripts/clean.sh
eval "$(opam env)"
coverage=_coverage
rm -f "$(find . -name 'bisect*.out')" || true
rm -rf $coverage
BISECT_ENABLE=YES dune runtest --no-buffer --force > /dev/null
bisect-ppx-report -html $coverage/ "$(find . -name 'bisect*.out')" )

7
scripts/doc.sh

@ -0,0 +1,7 @@
#!/bin/sh
set -eu
( cd "$(dirname "$0")/../"
eval "$(opam env)"
dune build @doc )

8
scripts/format.sh

@ -0,0 +1,8 @@
#!/bin/sh
set -eu
( cd "$(dirname "$0")/../"
eval "$(opam env)"
ocamlformat -i src/*.ml
ocamlformat -i test/*.ml )

7
scripts/test.sh

@ -0,0 +1,7 @@
#!/bin/sh
set -eu
( cd "$(dirname "$0")/../"
eval "$(opam env)"
dune runtest )

9
scripts/view_coverage.sh

@ -0,0 +1,9 @@
#!/bin/sh
set -eu
( cd "$(dirname "$0")/../"
scripts/clean.sh
eval "$(opam env)"
coverage=_coverage
xdg-open $coverage/index.html )

7
scripts/view_doc.sh

@ -0,0 +1,7 @@
#!/bin/sh
set -eu
( cd "$(dirname "$0")/../"
doc=_build/default/_doc/_html
xdg-open $doc/index.html )

5
src/dune

@ -0,0 +1,5 @@
(library
(name hashcons)
(public_name hashcons)
(wrapped false)
(preprocess (pps bisect_ppx -conditional)))

45
src/hashcons.ml

@ -0,0 +1,45 @@
type 'a hash_consed =
{ node : 'a
; tag : int
}
let get_initial_cache_size, set_initial_cache_size, reset_initial_cache_size =
let default = 512 in
let initial_cache_size = ref default in
( (fun () -> !initial_cache_size)
, (fun size -> initial_cache_size := size)
, fun () -> initial_cache_size := default )
module Mk (Cache : Hashtbl.S) = struct
type t = Cache.key hash_consed Cache.t
let tbl = Cache.create (get_initial_cache_size ())
let clear () = Cache.clear tbl
let iter f = Cache.iter f tbl
let stats () = Cache.stats tbl
let hashcons =
let gen =
let count = ref (-1) in
fun () ->
incr count;
!count
in
fun k ->
try Cache.find tbl k
with Not_found ->
let v = { tag = gen (); node = k } in
Cache.add tbl k v;
v
end
module Make (H : Hashtbl.HashedType) = struct
include Mk (Ephemeron.K1.Make (H))
end
module MakeStrong (H : Hashtbl.HashedType) = struct
include Mk (Hashtbl.Make (H))
end

3
test/dune

@ -0,0 +1,3 @@
(test
(name test)
(libraries hashcons))

64
test/test.ml

@ -0,0 +1,64 @@
open Hashcons
type hidden = view hash_consed
and view =
| Leaf of int
| Node of int * hidden * hidden
module H = struct
type t = view
let equal x y =
match (x, y) with
| Leaf m, Leaf n -> m = n
| Node (m, l1, r1), Node (n, l2, r2) -> m = n && l1 == l2 && r1 == r2
| _ -> false
let hash = function
| Leaf n -> n
| Node (n, l, r) -> (19 * ((19 * n) + l.tag)) + r.tag + 2
end
module HTree = Make (H)
let leaf n = HTree.hashcons (Leaf n)
let node v l h = HTree.hashcons (Node (v, l, h))
let extract x =
match x.node with
| Leaf x
|Node (x, _, _) ->
x
let rec get_fibo n =
if n < 0 then failwith "get_fibo";
if n < 2 then
leaf n
else
let a = get_fibo (n - 1) in
let b = get_fibo (n - 2) in
node (extract a + extract b) a b
let _ =
(* 1 *)
let n1 = leaf 1 in
let n2 = leaf 2 in
let n3 = node 3 n1 n2 in
let n3' = node 3 n1 n2 in
assert (n3 == n3');
let n4 = node 4 n3 n3' in
let n4' = node 4 n3' n3 in
assert (n4 == n4');
let s = HTree.stats () in
assert (s.num_bindings = 4);
(* 2 *)
HTree.clear ();
let n = 30 in
let g = get_fibo n in
let s = HTree.stats () in
assert (s.num_bindings = n + 1);
let res = extract g in
assert (res = 832040);
Format.printf "Tests are OK !@."
Loading…
Cancel
Save