Merge branch 'master' into stable

.merlin

@@ -15,4 +15,4 @@ PKG benchmark
 PKG threads
 PKG threads.posix
 PKG lwt
-FLG -w +K,+Y,+X
+FLG -w +a -w -4 -w -44

AUTHORS.md

@@ -0,0 +1,7 @@
+# Authors and contributors
+
+- Simon Cruanes
+- Drup (Gabriel Radanne)
+- Jacques-Pascal Deplaix
+- Nicolas Braud-Santoni
+- Whitequark (Peter Zotov)

Makefile

@@ -42,7 +42,7 @@ configure:
 
 EXAMPLES = examples/mem_size.native examples/collatz.native \
 	examples/bencode_write.native # examples/crawl.native
-OPTIONS = -use-ocamlfind
+OPTIONS = -use-ocamlfind -I _build
 
 examples: all
 	ocamlbuild $(OPTIONS) -package unix -I . $(EXAMPLES)
@@ -53,9 +53,10 @@ push_doc: doc
 	scp -r containers_advanced.docdir/* cedeela.fr:~/simon/root/software/containers/advanced
 	scp -r containers_misc.docdir/* cedeela.fr:~/simon/root/software/containers/misc/
 
-DONTTEST=myocamlbuild.ml setup.ml
+DONTTEST=myocamlbuild.ml setup.ml $(wildcard **/*.cppo*)
 QTESTABLE=$(filter-out $(DONTTEST), \
 	$(wildcard core/*.ml) $(wildcard core/*.mli) \
+	$(wildcard core/*.cppo.ml) $(wildcard core/*.cppo.mli) \
 	$(wildcard misc/*.ml) $(wildcard misc/*.mli) \
 	$(wildcard string/*.ml) $(wildcard string/*.mli) \
 	)
@@ -65,16 +66,20 @@ qtest-clean:
 
 QTEST_PREAMBLE='open CCFun;; '
 
-qtest-build: qtest-clean build
+#qtest-build: qtest-clean build
-	@mkdir -p qtest
+#	@mkdir -p qtest
-	@qtest extract --preamble $(QTEST_PREAMBLE) -o qtest/qtest_all.ml $(QTESTABLE) 2> /dev/null
+#	@qtest extract --preamble $(QTEST_PREAMBLE) \
-	@ocamlbuild $(OPTIONS) -pkg oUnit,QTest2Lib \
+#		-o qtest/qtest_all.ml \
-		-I core -I misc -I string \
+#		$(QTESTABLE) 2> /dev/null
-		qtest/qtest_all.native
+#	@ocamlbuild $(OPTIONS) -pkg oUnit,QTest2Lib,ocamlbuildlib \
+#		-I core -I misc -I string \
+#		qtest/qtest_all.native
 
-qtest: qtest-build
+qtest-gen: qtest-clean
-	@echo 
+	@mkdir -p qtest
-	./qtest_all.native
+	@qtest extract --preamble $(QTEST_PREAMBLE) \
+		-o qtest/run_qtest.cppo.ml \
+		$(QTESTABLE) 2> /dev/null
 
 push-stable:
 	git checkout stable
@@ -87,11 +92,11 @@ push-stable:
 clean-generated:
 	rm **/*.{mldylib,mlpack,mllib} myocamlbuild.ml -f
 
-run-test: build qtest-build
+run-test: build
-	./qtest_all.native
+	./run_qtest.native
 	./run_tests.native
 
-test-all: run-test qtest
+test-all: run-test
 
 tags:
 	otags *.ml *.mli

README.md

@@ -23,7 +23,7 @@ ocaml-containers
     least) are unfinished or don't really work.
 
 Some of the modules have been moved to their own repository (e.g. `sequence`,
-`gen`, `qcheck` and are on opam for great fun and profit (or not)).
+`gen`, `qcheck`) and are on opam for great fun and profit.
 
 [![Build Status](http://ci.cedeela.fr/buildStatus/icon?job=containers)](http://ci.cedeela.fr/job/containers/)
 

_oasis

@@ -47,8 +47,9 @@ Library "containers"
                     CCHeap, CCList, CCOpt, CCPair, CCFun, CCHash,
                     CCKList, CCInt, CCBool, CCArray, CCOrd, CCIO,
                     CCRandom, CCKTree, CCTrie, CCString, CCHashtbl,
-                    CCFlatHashtbl, CCSexp
+                    CCFlatHashtbl, CCSexp, CCMap
-  FindlibName:      containers
+  BuildDepends:     bytes
+  XMETARequires:    cppo
 
 Library "containers_string"
   Path:             string
@@ -78,11 +79,9 @@ Library "containers_misc"
   Modules:          Cache, FHashtbl, FlatHashtbl, Hashset,
                     Heap, LazyGraph, PersistentGraph,
                     PHashtbl, SkipList, SplayTree, SplayMap, Univ,
-                    Bij, PiCalculus, Bencode, RAL,
+                    Bij, PiCalculus, RAL, UnionFind, SmallSet, AbsSet, CSM,
-                    UnionFind, SmallSet, AbsSet, CSM,
+                    TTree, PrintBox, HGraph, Automaton, Conv, Bidir, Iteratee,
-                    ActionMan, BencodeOnDisk, TTree, PrintBox,
+                    BTree, Ty, Cause, AVL, ParseReact
-                    HGraph, Automaton, Conv, Bidir, Iteratee, BTree,
-                    Ty, Tell, BencodeStream, RatTerm, Cause, AVL, ParseReact
   BuildDepends:     unix,containers
   FindlibName:      misc
   FindlibParent:    containers
@@ -206,10 +205,16 @@ Executable test_threads
   MainIs: test_Future.ml
   BuildDepends: containers,threads,oUnit,containers.lwt
 
-Test all
+PreBuildCommand: make qtest-gen
-  Command: make test-all
+
-  TestTools: run_tests
+Executable run_qtest
-  Run$: flag(tests)
+  Path:             qtest/
+  Install:          false
+  CompiledObject:   native
+  MainIs:           run_qtest.ml
+  Build$:           flag(tests)
+  BuildDepends:     containers, containers.misc, containers.string,
+                    oUnit, QTest2Lib
 
 Executable run_tests
   Path: tests/
@@ -217,7 +222,12 @@ Executable run_tests
   CompiledObject: native
   MainIs: run_tests.ml
   Build$: flag(tests) && flag(misc)
-  BuildDepends: containers,oUnit,qcheck,containers.misc
+  BuildDepends: containers, oUnit, qcheck, containers.misc
+
+Test all
+  Command:      make test-all
+  TestTools:    run_tests, run_qtest
+  Run$:         flag(tests) && flag(misc)
 
 Executable web_pwd
   Path: examples/cgi/

_tags

@@ -1,8 +1,9 @@
 # OASIS_START
-# DO NOT EDIT (digest: 126bedd0d6759f38e9b7190eebb08140)
+# DO NOT EDIT (digest: c052544c3d7576d929b768e46a58e0a9)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
+true: annot, bin_annot
 <**/.svn>: -traverse
 <**/.svn>: not_hygienic
 ".bzr": -traverse
@@ -15,6 +16,7 @@
 "_darcs": not_hygienic
 # Library containers
 "core/containers.cmxs": use_containers
+<core/*.ml{,i,y}>: package(bytes)
 # Library containers_string
 "string/containers_string.cmxs": use_containers_string
 "string/KMP.cmx": for-pack(Containers_string)
@@ -24,10 +26,12 @@
 "advanced/CCLinq.cmx": for-pack(Containers_advanced)
 "advanced/CCBatch.cmx": for-pack(Containers_advanced)
 "advanced/CCCat.cmx": for-pack(Containers_advanced)
-<advanced/*.ml{,i}>: use_containers
+<advanced/*.ml{,i,y}>: package(bytes)
+<advanced/*.ml{,i,y}>: use_containers
 # Library containers_pervasives
 "pervasives/containers_pervasives.cmxs": use_containers_pervasives
-<pervasives/*.ml{,i}>: use_containers
+<pervasives/*.ml{,i,y}>: package(bytes)
+<pervasives/*.ml{,i,y}>: use_containers
 # Library containers_misc
 "misc/containers_misc.cmxs": use_containers_misc
 "misc/cache.cmx": for-pack(Containers_misc)
@@ -44,14 +48,11 @@
 "misc/univ.cmx": for-pack(Containers_misc)
 "misc/bij.cmx": for-pack(Containers_misc)
 "misc/piCalculus.cmx": for-pack(Containers_misc)
-"misc/bencode.cmx": for-pack(Containers_misc)
 "misc/RAL.cmx": for-pack(Containers_misc)
 "misc/unionFind.cmx": for-pack(Containers_misc)
 "misc/smallSet.cmx": for-pack(Containers_misc)
 "misc/absSet.cmx": for-pack(Containers_misc)
 "misc/CSM.cmx": for-pack(Containers_misc)
-"misc/actionMan.cmx": for-pack(Containers_misc)
-"misc/bencodeOnDisk.cmx": for-pack(Containers_misc)
 "misc/tTree.cmx": for-pack(Containers_misc)
 "misc/printBox.cmx": for-pack(Containers_misc)
 "misc/hGraph.cmx": for-pack(Containers_misc)
@@ -61,61 +62,69 @@
 "misc/iteratee.cmx": for-pack(Containers_misc)
 "misc/bTree.cmx": for-pack(Containers_misc)
 "misc/ty.cmx": for-pack(Containers_misc)
-"misc/tell.cmx": for-pack(Containers_misc)
-"misc/bencodeStream.cmx": for-pack(Containers_misc)
-"misc/ratTerm.cmx": for-pack(Containers_misc)
 "misc/cause.cmx": for-pack(Containers_misc)
 "misc/AVL.cmx": for-pack(Containers_misc)
 "misc/parseReact.cmx": for-pack(Containers_misc)
-<misc/*.ml{,i}>: package(unix)
+<misc/*.ml{,i,y}>: package(bytes)
-<misc/*.ml{,i}>: use_containers
+<misc/*.ml{,i,y}>: package(unix)
+<misc/*.ml{,i,y}>: use_containers
 # Library containers_thread
 "threads/containers_thread.cmxs": use_containers_thread
-<threads/*.ml{,i}>: package(threads)
+<threads/*.ml{,i,y}>: package(bytes)
-<threads/*.ml{,i}>: use_containers
+<threads/*.ml{,i,y}>: package(threads)
+<threads/*.ml{,i,y}>: use_containers
 # Library containers_lwt
 "lwt/containers_lwt.cmxs": use_containers_lwt
 "lwt/behavior.cmx": for-pack(Containers_lwt)
 "lwt/lwt_automaton.cmx": for-pack(Containers_lwt)
-<lwt/*.ml{,i}>: package(lwt)
+<lwt/*.ml{,i,y}>: package(bytes)
-<lwt/*.ml{,i}>: package(lwt.unix)
+<lwt/*.ml{,i,y}>: package(lwt)
-<lwt/*.ml{,i}>: package(unix)
+<lwt/*.ml{,i,y}>: package(lwt.unix)
-<lwt/*.ml{,i}>: use_containers
+<lwt/*.ml{,i,y}>: package(unix)
-<lwt/*.ml{,i}>: use_containers_misc
+<lwt/*.ml{,i,y}>: use_containers
+<lwt/*.ml{,i,y}>: use_containers_misc
 # Library containers_cgi
 "cgi/containers_cgi.cmxs": use_containers_cgi
-<cgi/*.ml{,i}>: package(CamlGI)
+<cgi/*.ml{,i,y}>: package(CamlGI)
-<cgi/*.ml{,i}>: use_containers
+<cgi/*.ml{,i,y}>: package(bytes)
+<cgi/*.ml{,i,y}>: use_containers
 # Executable benchs
 "benchs/benchs.native": package(bench)
+"benchs/benchs.native": package(bytes)
 "benchs/benchs.native": package(unix)
 "benchs/benchs.native": use_containers
 "benchs/benchs.native": use_containers_advanced
 "benchs/benchs.native": use_containers_misc
 "benchs/benchs.native": use_containers_string
-<benchs/*.ml{,i}>: package(bench)
+<benchs/*.ml{,i,y}>: package(bench)
-<benchs/*.ml{,i}>: use_containers_advanced
+<benchs/*.ml{,i,y}>: use_containers_advanced
-<benchs/*.ml{,i}>: use_containers_string
+<benchs/*.ml{,i,y}>: use_containers_string
 # Executable bench_conv
 "benchs/bench_conv.native": package(benchmark)
+"benchs/bench_conv.native": package(bytes)
 "benchs/bench_conv.native": use_containers
 # Executable bench_batch
 "benchs/bench_batch.native": package(benchmark)
+"benchs/bench_batch.native": package(bytes)
 "benchs/bench_batch.native": use_containers
-<benchs/*.ml{,i}>: package(benchmark)
+<benchs/*.ml{,i,y}>: package(benchmark)
 # Executable bench_hash
+"benchs/bench_hash.native": package(bytes)
 "benchs/bench_hash.native": package(unix)
 "benchs/bench_hash.native": use_containers
 "benchs/bench_hash.native": use_containers_misc
-<benchs/*.ml{,i}>: package(unix)
+<benchs/*.ml{,i,y}>: package(bytes)
-<benchs/*.ml{,i}>: use_containers
+<benchs/*.ml{,i,y}>: package(unix)
-<benchs/*.ml{,i}>: use_containers_misc
+<benchs/*.ml{,i,y}>: use_containers
+<benchs/*.ml{,i,y}>: use_containers_misc
 # Executable test_levenshtein
+"tests/test_levenshtein.native": package(bytes)
 "tests/test_levenshtein.native": package(qcheck)
 "tests/test_levenshtein.native": use_containers
 "tests/test_levenshtein.native": use_containers_string
-<tests/*.ml{,i}>: use_containers_string
+<tests/*.ml{,i,y}>: use_containers_string
 # Executable test_lwt
+<tests/lwt/test_Behavior.{native,byte}>: package(bytes)
 <tests/lwt/test_Behavior.{native,byte}>: package(lwt)
 <tests/lwt/test_Behavior.{native,byte}>: package(lwt.unix)
 <tests/lwt/test_Behavior.{native,byte}>: package(oUnit)
@@ -124,6 +133,7 @@
 <tests/lwt/test_Behavior.{native,byte}>: use_containers_lwt
 <tests/lwt/test_Behavior.{native,byte}>: use_containers_misc
 # Executable test_threads
+<tests/lwt/test_Future.{native,byte}>: package(bytes)
 <tests/lwt/test_Future.{native,byte}>: package(lwt)
 <tests/lwt/test_Future.{native,byte}>: package(lwt.unix)
 <tests/lwt/test_Future.{native,byte}>: package(oUnit)
@@ -132,45 +142,69 @@
 <tests/lwt/test_Future.{native,byte}>: use_containers
 <tests/lwt/test_Future.{native,byte}>: use_containers_lwt
 <tests/lwt/test_Future.{native,byte}>: use_containers_misc
-<tests/lwt/*.ml{,i}>: package(lwt)
+<tests/lwt/*.ml{,i,y}>: package(bytes)
-<tests/lwt/*.ml{,i}>: package(lwt.unix)
+<tests/lwt/*.ml{,i,y}>: package(lwt)
-<tests/lwt/*.ml{,i}>: package(oUnit)
+<tests/lwt/*.ml{,i,y}>: package(lwt.unix)
-<tests/lwt/*.ml{,i}>: package(threads)
+<tests/lwt/*.ml{,i,y}>: package(oUnit)
-<tests/lwt/*.ml{,i}>: package(unix)
+<tests/lwt/*.ml{,i,y}>: package(threads)
-<tests/lwt/*.ml{,i}>: use_containers
+<tests/lwt/*.ml{,i,y}>: package(unix)
-<tests/lwt/*.ml{,i}>: use_containers_lwt
+<tests/lwt/*.ml{,i,y}>: use_containers
-<tests/lwt/*.ml{,i}>: use_containers_misc
+<tests/lwt/*.ml{,i,y}>: use_containers_lwt
+<tests/lwt/*.ml{,i,y}>: use_containers_misc
+# Executable run_qtest
+"qtest/run_qtest.native": package(QTest2Lib)
+"qtest/run_qtest.native": package(bytes)
+"qtest/run_qtest.native": package(oUnit)
+"qtest/run_qtest.native": package(unix)
+"qtest/run_qtest.native": use_containers
+"qtest/run_qtest.native": use_containers_misc
+"qtest/run_qtest.native": use_containers_string
+<qtest/*.ml{,i,y}>: package(QTest2Lib)
+<qtest/*.ml{,i,y}>: package(bytes)
+<qtest/*.ml{,i,y}>: package(oUnit)
+<qtest/*.ml{,i,y}>: package(unix)
+<qtest/*.ml{,i,y}>: use_containers
+<qtest/*.ml{,i,y}>: use_containers_misc
+<qtest/*.ml{,i,y}>: use_containers_string
 # Executable run_tests
+"tests/run_tests.native": package(bytes)
 "tests/run_tests.native": package(oUnit)
 "tests/run_tests.native": package(qcheck)
 "tests/run_tests.native": package(unix)
 "tests/run_tests.native": use_containers
 "tests/run_tests.native": use_containers_misc
-<tests/*.ml{,i}>: package(oUnit)
+<tests/*.ml{,i,y}>: package(bytes)
-<tests/*.ml{,i}>: package(qcheck)
+<tests/*.ml{,i,y}>: package(oUnit)
-<tests/*.ml{,i}>: package(unix)
+<tests/*.ml{,i,y}>: package(qcheck)
-<tests/*.ml{,i}>: use_containers
+<tests/*.ml{,i,y}>: package(unix)
-<tests/*.ml{,i}>: use_containers_misc
+<tests/*.ml{,i,y}>: use_containers
+<tests/*.ml{,i,y}>: use_containers_misc
 # Executable web_pwd
 "examples/cgi/web_pwd.byte": package(CamlGI)
+"examples/cgi/web_pwd.byte": package(bytes)
 "examples/cgi/web_pwd.byte": package(threads)
 "examples/cgi/web_pwd.byte": use_containers
 "examples/cgi/web_pwd.byte": use_containers_cgi
-<examples/cgi/*.ml{,i}>: package(CamlGI)
+<examples/cgi/*.ml{,i,y}>: package(CamlGI)
-<examples/cgi/*.ml{,i}>: package(threads)
+<examples/cgi/*.ml{,i,y}>: package(bytes)
-<examples/cgi/*.ml{,i}>: use_containers
+<examples/cgi/*.ml{,i,y}>: package(threads)
-<examples/cgi/*.ml{,i}>: use_containers_cgi
+<examples/cgi/*.ml{,i,y}>: use_containers
+<examples/cgi/*.ml{,i,y}>: use_containers_cgi
 # Executable lambda
+"examples/lambda.byte": package(bytes)
 "examples/lambda.byte": package(unix)
 "examples/lambda.byte": use_containers
 "examples/lambda.byte": use_containers_misc
-<examples/*.ml{,i}>: package(unix)
+<examples/*.ml{,i,y}>: package(unix)
-<examples/*.ml{,i}>: use_containers_misc
+<examples/*.ml{,i,y}>: use_containers_misc
 # Executable id_sexp
+"examples/id_sexp.native": package(bytes)
 "examples/id_sexp.native": use_containers
-<examples/*.ml{,i}>: use_containers
+<examples/*.ml{,i,y}>: package(bytes)
+<examples/*.ml{,i,y}>: use_containers
 # OASIS_STOP
 <tests/*.ml{,i}>: thread
 <threads/*.ml{,i}>: thread
 <sequence>: -traverse
-<{string,core}/**/*.ml>: warn_K, warn_Y, warn_X
+<core/CCVector.cmx>: inline(25)
+<{string,core}/**/*.ml>: warn_A, warn(-4), warn(-44)

containers.odocl

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: f2008fc227a68cb26812ab37438e52a8)
+# DO NOT EDIT (digest: e1f5b42bfafae735d510742c5ac3cefd)
 core/CCVector
 core/CCDeque
 core/CCGen
@@ -30,6 +30,7 @@ core/CCString
 core/CCHashtbl
 core/CCFlatHashtbl
 core/CCSexp
+core/CCMap
 string/KMP
 string/Levenshtein
 # OASIS_STOP

containers_advanced.odocl

@@ -0,0 +1,6 @@
+# OASIS_START
+# DO NOT EDIT (digest: 49f87e2d7015c5adc472ae3cf76a5351)
+advanced/CCLinq
+advanced/CCBatch
+advanced/CCCat
+# OASIS_STOP

containers_misc.odocl

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 5c08a0bf51a82d21179a12753e47acff)
+# DO NOT EDIT (digest: 3c4c75622413b2b99679e7439134f037)
 misc/Cache
 misc/FHashtbl
 misc/FlatHashtbl
@@ -14,14 +14,11 @@ misc/SplayMap
 misc/Univ
 misc/Bij
 misc/PiCalculus
-misc/Bencode
 misc/RAL
 misc/UnionFind
 misc/SmallSet
 misc/AbsSet
 misc/CSM
-misc/ActionMan
-misc/BencodeOnDisk
 misc/TTree
 misc/PrintBox
 misc/HGraph
@@ -31,9 +28,6 @@ misc/Bidir
 misc/Iteratee
 misc/BTree
 misc/Ty
-misc/Tell
-misc/BencodeStream
-misc/RatTerm
 misc/Cause
 misc/AVL
 misc/ParseReact

core/CCArray.ml

@@ -225,7 +225,7 @@ let _shuffle _rand_int a i j =
 
 let _choose a i j st =
   if i>=j then raise Not_found;
-  a.(i+Random.int (j-i))
+  a.(i+Random.State.int st (j-i))
 
 let _pp ~sep pp_item buf a i j =
   for k = i to j - 1 do
@@ -283,7 +283,7 @@ let iteri = Array.iteri
 let blit = Array.blit
 
 let reverse_in_place a =
-  _reverse_in_place a 0 (Array.length a)
+  _reverse_in_place a 0 ~len:(Array.length a)
 
 (*$T
   reverse_in_place [| |]; true
@@ -464,7 +464,7 @@ module Sub = struct
 
   let copy a = Array.sub a.arr a.i (length a)
 
-  let sub a i len = make a.arr (a.i + i) len
+  let sub a i len = make a.arr ~len:(a.i + i) len
 
   let equal eq a b =
     length a = length b && _equal eq a.arr a.i a.j b.arr b.i b.j

core/CCError.ml

@@ -34,9 +34,9 @@ type 'a formatter = Format.formatter -> 'a -> unit
 
 (** {2 Basics} *)
 
-type +'a t =
+type (+'good, +'bad) t =
-  [ `Ok of 'a
+  [ `Ok of 'good
-  | `Error of string
+  | `Error of 'bad
   ]
 
 let return x = `Ok x
@@ -68,6 +68,10 @@ let map f e = match e with
   | `Ok x -> `Ok (f x)
   | `Error s -> `Error s
 
+let map_err f e = match e with
+  | `Ok _ as res -> res
+  | `Error y -> `Error (f y)
+
 let map2 f g e = match e with
   | `Ok x -> `Ok (f x)
   | `Error s -> `Error (g s)
@@ -88,16 +92,16 @@ let (>|=) e f = map f e
 
 let (>>=) e f = flat_map f e
 
-let equal eq a b = match a, b with
+let equal ?(err=Pervasives.(=)) eq a b = match a, b with
   | `Ok x, `Ok y -> eq x y
-  | `Error s, `Error s' -> s = s'
+  | `Error s, `Error s' -> err s s'
   | _ -> false
 
-let compare cmp a b = match a, b with
+let compare ?(err=Pervasives.compare) cmp a b = match a, b with
   | `Ok x, `Ok y -> cmp x y
   | `Ok _, _  -> 1
   | _, `Ok _ -> -1
-  | `Error s, `Error s' -> String.compare s s'
+  | `Error s, `Error s' -> err s s'
 
 let fold ~success ~failure x = match x with
   | `Ok x -> success x
@@ -106,21 +110,24 @@ let fold ~success ~failure x = match x with
 (** {2 Wrappers} *)
 
 let guard f =
-  try
+  try `Ok (f ())
-    return (f ())
+  with e -> `Error e
+
+let guard_str f =
+  try `Ok (f())
   with e -> of_exn e
 
 let wrap1 f x =
   try return (f x)
-  with e -> of_exn e
+  with e -> `Error e
 
 let wrap2 f x y =
   try return (f x y)
-  with e -> of_exn e
+  with e -> `Error e
 
 let wrap3 f x y z =
   try return (f x y z)
-  with e -> of_exn e
+  with e -> `Error e
 
 (** {2 Applicative} *)
 
@@ -141,18 +148,20 @@ let map_l f l =
       | `Ok y -> map (y::acc) l'
   in map [] l
 
-exception LocalExit of string
+exception LocalExit
 
 let fold_seq f acc seq =
+  let err = ref None in
   try
     let acc = ref acc in
     seq
       (fun x -> match f !acc x with
-        | `Error s -> raise (LocalExit s)
+      | `Error s -> err := Some s; raise LocalExit
         | `Ok y -> acc := y
       );
     `Ok !acc
-  with LocalExit s -> `Error s
+  with LocalExit ->
+    match !err with None -> assert false | Some s -> `Error s
 
 let fold_l f acc l = fold_seq f acc (fun k -> List.iter k l)
 
@@ -166,26 +175,17 @@ let choose l =
   in
   try _find l
   with Not_found ->
-    let buf = Buffer.create 32 in
+    let l' = List.map (function `Error s -> s | `Ok _ -> assert false) l in
-    (* print errors on the buffer *)
+    `Error l'
-    let rec print buf l = match l with
-      | `Ok _ :: _ -> assert false
-      | (`Error x)::((y::xs) as l) ->
-        Buffer.add_string buf x;
-        Buffer.add_string buf ", ";
-        print buf l
-      | `Error x::[] -> Buffer.add_string buf x
-      | [] -> ()
-    in
-    Printf.bprintf buf "CCError.choice failed: [%a]" print l;
-    fail (Buffer.contents buf)
 
-let rec retry n f = match n with
+let retry n f =
-  | 0 -> fail "retry failed"
+  let rec retry n acc = match n with
+  | 0 -> fail (List.rev acc)
   | _ ->
       match f () with
       | `Ok _ as res -> res
-      | `Error _ -> retry (n-1) f
+      | `Error e -> retry (n-1) (e::acc)
+  in retry n []
 
 (** {2 Monadic Operations} *)
 
@@ -205,16 +205,17 @@ module Traverse(M : MONAD) = struct
   let sequence_m m = map_m (fun x->x) m
 
   let fold_m f acc e = match e with
-    | `Error s -> M.return acc
+    | `Error _ -> M.return acc
     | `Ok x -> f acc x >>= fun y -> M.return y
 
-  let rec retry_m n f = match n with
+  let retry_m n f =
-    | 0 -> M.return (fail "retry failed")
+    let rec retry n acc = match n with
+    | 0 -> M.return (fail (List.rev acc))
     | _ ->
-        let x = f () in
+        f () >>= function
-        x >>= function
+        | `Ok x -> M.return (`Ok x)
-        | `Ok _ -> x
+        | `Error e -> retry (n-1) (e::acc)
-        | `Error _ -> retry_m (n-1) f
+    in retry n []
 end
 
 (** {2 Conversions} *)

core/CCError.mli

@@ -24,7 +24,9 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
-(** {1 Error Monad} *)
+(** {1 Error Monad}
+
+The variant is polymorphic in the error type since NEXT_RELEASE *)
 
 type 'a sequence = ('a -> unit) -> unit
 type 'a equal = 'a -> 'a -> bool
@@ -34,90 +36,104 @@ type 'a formatter = Format.formatter -> 'a -> unit
 
 (** {2 Basics} *)
 
-type +'a t =
+type (+'good, +'bad) t =
-  [ `Ok of 'a
+  [ `Ok of 'good
-  | `Error of string
+  | `Error of 'bad
   ]
 
-val return : 'a -> 'a t
+val return : 'a -> ('a,'err) t
+(** Successfully return a value *)
 
-val fail : string -> 'a t
+val fail : 'err -> ('a,'err) t
+(** Fail with an error *)
 
-val of_exn : exn -> 'a t
+val of_exn : exn -> ('a, string) t
+(** [of_exn e] uses {!Printexc} to print the exception as a string *)
 
-val fail_printf : ('a, Buffer.t, unit, 'a t) format4 -> 'a
+val fail_printf : ('a, Buffer.t, unit, ('a,string) t) format4 -> 'a
 (** [fail_printf format] uses [format] to obtain an error message
     and then returns [`Error msg]
     @since 0.3.3 *)
 
-val map : ('a -> 'b) -> 'a t -> 'b t
+val map : ('a -> 'b) -> ('a, 'err) t -> ('b, 'err) t
+(** Map on success *)
 
-val map2 : ('a -> 'b) -> (string -> string) -> 'a t -> 'b t
+val map_err : ('err1 -> 'err2) -> ('a, 'err1) t -> ('a, 'err2) t
+(** Map on error.
+    @since NEXT_RELEASE *)
+
+val map2 : ('a -> 'b) -> ('err -> 'err) -> ('a, 'err) t -> ('b, 'err) t
 (** Same as {!map}, but also with a function that can transform
     the error message in case of failure *)
 
-val iter : ('a -> unit) -> 'a t -> unit
+val iter : ('a -> unit) -> ('a, _) t -> unit
 (** Apply the function only in case of `Ok *)
 
-val get_exn : 'a t -> 'a
+val get_exn : ('a, _) t -> 'a
 (** Extract the value [x] from [`Ok x], fails otherwise.
     You should be careful with this function, and favor other combinators
     whenever possible.
     @raise Invalid_argument if the value is an error. *)
 
-val flat_map : ('a -> 'b t) -> 'a t -> 'b t
+val flat_map : ('a -> ('b, 'err) t) -> ('a, 'err) t -> ('b, 'err) t
 
-val (>|=) : 'a t -> ('a -> 'b) -> 'b t
+val (>|=) : ('a, 'err) t -> ('a -> 'b) -> ('b, 'err) t
 
-val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+val (>>=) : ('a, 'err) t -> ('a -> ('b, 'err) t) -> ('b, 'err) t
 
-val equal : 'a equal -> 'a t equal
+val equal : ?err:'err equal -> 'a equal -> ('a, 'err) t equal
 
-val compare : 'a ord -> 'a t ord
+val compare : ?err:'err ord -> 'a ord -> ('a, 'err) t ord
 
-val fold : success:('a -> 'b) -> failure:(string -> 'b) -> 'a t -> 'b
+val fold : success:('a -> 'b) -> failure:('err -> 'b) -> ('a, 'err) t -> 'b
 (** [fold ~success ~failure e] opens [e] and, if [e = `Ok x], returns
     [success x], otherwise [e = `Error s] and it returns [failure s]. *)
 
-(** {2 Wrappers} *)
+(** {2 Wrappers}
 
-val guard : (unit -> 'a) -> 'a t
+The functions {!guard}, {!wrap1}, {!wrap2} and {!wrap3} now return
+exceptions in case of failure, @since NEXT_RELEASE *)
+
+val guard : (unit -> 'a) -> ('a, exn) t
 (** [guard f] runs [f ()] and returns its result wrapped in [`Ok]. If
-    [f ()] raises some exception [e], then it fails with [`Error msg]
+    [f ()] raises some exception [e], then it fails with [`Error e] *)
-    where [msg] is some printing of [e] (see {!register_printer}). *)
 
-val wrap1 : ('a -> 'b) -> 'a -> 'b t
+val guard_str : (unit -> 'a) -> ('a, string) t
+(** Same as {!guard} but uses {!of_exn} to print the exception.
+    See {!register_printer} *)
+
+val wrap1 : ('a -> 'b) -> 'a -> ('b, exn) t
 (** Same as {!guard} but gives the function one argument. *)
 
-val wrap2 : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c t
+val wrap2 : ('a -> 'b -> 'c) -> 'a -> 'b -> ('c, exn) t
 (** Same as {!guard} but gives the function two arguments. *)
 
-val wrap3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> 'd t
+val wrap3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> ('d, exn) t
 
 (** {2 Applicative} *)
 
-val pure : 'a -> 'a t
+val pure : 'a -> ('a, 'err) t
 
-val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
+val (<*>) : ('a -> 'b, 'err) t -> ('a, 'err) t -> ('b, 'err) t
 
 (** {2 Collections} *)
 
-val map_l : ('a -> 'b t) -> 'a list -> 'b list t
+val map_l : ('a -> ('b, 'err) t) -> 'a list -> ('b list, 'err) t
 
-val fold_l : ('b -> 'a -> 'b t) -> 'b -> 'a list -> 'b t
+val fold_l : ('b -> 'a -> ('b, 'err) t) -> 'b -> 'a list -> ('b, 'err) t
 
-val fold_seq : ('b -> 'a -> 'b t) -> 'b -> 'a sequence -> 'b t
+val fold_seq : ('b -> 'a -> ('b, 'err) t) -> 'b -> 'a sequence -> ('b, 'err) t
 
 (** {2 Misc} *)
 
-val choose : 'a t list -> 'a t
+val choose : ('a, 'err) t list -> ('a, 'err list) t
 (** [choose l] selects a member of [l] that is a [`Ok _] value,
-    or returns [`Error msg] otherwise, where [msg] is obtained by
+    or returns [`Error l] otherwise, where [l] is the list of errors. *)
-    combining the error messages of all elements of [l] *)
 
-val retry : int -> (unit -> 'a t) -> 'a t
+val retry : int -> (unit -> ('a, 'err) t) -> ('a, 'err list) t
 (** [retry n f] calls [f] at most [n] times, returning the first result
-    of [f ()] that doesn't fail. If [f] fails [n] times, [retry n f] fails. *)
+    of [f ()] that doesn't fail. If [f] fails [n] times, [retry n f] fails
+    with the list of successive errors. *)
 
 (** {2 Monadic Operations} *)
 module type MONAD = sig
@@ -127,28 +143,28 @@ module type MONAD = sig
 end
 
 module Traverse(M : MONAD) : sig
-  val sequence_m : 'a M.t t -> 'a t M.t
+  val sequence_m : ('a M.t, 'err) t -> ('a, 'err) t M.t
 
-  val fold_m : ('b -> 'a -> 'b M.t) -> 'b -> 'a t -> 'b M.t
+  val fold_m : ('b -> 'a -> 'b M.t) -> 'b -> ('a, 'err) t -> 'b M.t
 
-  val map_m : ('a -> 'b M.t) -> 'a t -> 'b t M.t
+  val map_m : ('a -> 'b M.t) -> ('a, 'err) t -> ('b, 'err) t M.t
 
-  val retry_m : int -> (unit -> 'a t M.t) -> 'a t M.t
+  val retry_m : int -> (unit -> ('a, 'err) t M.t) -> ('a, 'err list) t M.t
 end
 
 (** {2 Conversions} *)
 
-val to_opt : 'a t -> 'a option
+val to_opt : ('a, _) t -> 'a option
 
-val of_opt : 'a option -> 'a t
+val of_opt : 'a option -> ('a, string) t
 
-val to_seq : 'a t -> 'a sequence
+val to_seq : ('a, _) t -> 'a sequence
 
 (** {2 IO} *)
 
-val pp : 'a printer -> 'a t printer
+val pp : 'a printer -> ('a, string) t printer
 
-val print : 'a formatter -> 'a t formatter
+val print : 'a formatter -> ('a, string) t formatter
 
 (** {2 Global Exception Printers}
 

core/CCFQueue.ml

@@ -68,7 +68,7 @@ let rec cons : 'a. 'a -> 'a t -> 'a t
   | Shallow (Two (y,z)) -> Shallow (Three (x,y,z))
   | Shallow (Three (y,z,z')) ->
       _deep 4 (Two (x,y)) _empty (Two (z,z'))
-  | Deep (_, Zero, middle, tl) -> assert false
+  | Deep (_, Zero, _middle, _tl) -> assert false
   | Deep (n,One y, middle, tl) -> _deep (n+1) (Two (x,y)) middle tl
   | Deep (n,Two (y,z), middle, tl) -> _deep (n+1)(Three (x,y,z)) middle tl
   | Deep (n,Three (y,z,z'), lazy q', tail) ->
@@ -81,7 +81,7 @@ let rec snoc : 'a. 'a t -> 'a -> 'a t
   | Shallow (Two (y,z)) -> Shallow (Three (y,z,x))
   | Shallow (Three (y,z,z')) ->
       _deep 4 (Two (y,z)) _empty (Two (z',x))
-  | Deep (_,hd, middle, Zero) -> assert false
+  | Deep (_,_hd, _middle, Zero) -> assert false
   | Deep (n,hd, middle, One y) -> _deep (n+1) hd middle (Two(y,x))
   | Deep (n,hd, middle, Two (y,z)) -> _deep (n+1) hd middle (Three(y,z,x))
   | Deep (n,hd, lazy q', Three (y,z,z')) ->
@@ -131,7 +131,7 @@ let rec take_back_exn : 'a. 'a t -> 'a t * 'a
   | Shallow (One x) -> empty, x
   | Shallow (Two (x,y)) -> _single x, y
   | Shallow (Three (x,y,z)) -> Shallow (Two(x,y)), z
-  | Deep (_, hd, middle, Zero) -> assert false
+  | Deep (_, _hd, _middle, Zero) -> assert false
   | Deep (n, hd, lazy q', One x) ->
       if is_empty q'
         then Shallow hd, x
@@ -206,7 +206,7 @@ let rec nth_exn : 'a. int -> 'a t -> 'a
   | 1, Shallow (Three (_,x,_)) -> x
   | 2, Shallow (Three (_,_,x)) -> x
   | _, Shallow _ -> raise Not_found
-  | _, Deep (n, l, q, r) ->
+  | _, Deep (_, l, q, r) ->
       if i<_size_digit l
       then _nth_digit i l
       else

core/CCFlatHashtbl.ml

@@ -170,7 +170,7 @@ module Make(X : HASHABLE) = struct
     | Empty -> ()
     | Key (_, _, h_k) when _dib tbl h_k i = 0 ->
         ()  (* stop *)
-    | Key (k, v, h_k) as bucket ->
+    | Key (_k, _v, h_k) as bucket ->
         assert (_dib tbl h_k i > 0);
         (* shift backward *)
         tbl.arr.(_pred tbl i) <- bucket;

core/CCFun.cppo.ml

@@ -26,7 +26,17 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 (** {1 Basic Functions} *)
 
+#if OCAML_MAJOR >= 4 && OCAML_MINOR >= 2
+
+external (|>) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+external (@@) : ('a -> 'b) -> 'a -> 'b = "%apply"
+
+#else
+
 let (|>) x f = f x
+let (@@) f x = f x
+
+#endif
 
 let compose f g x = g (f x)
 

core/CCFun.mli

@@ -27,7 +27,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 (** {1 Basic Functions} *)
 
 val (|>) : 'a -> ('a -> 'b) -> 'b
-(** Pipeline (naive implementation) *)
+(** Pipeline. [x |> f] is the same as [f x]. *)
 
 val compose : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
 (** Composition *)
@@ -35,6 +35,10 @@ val compose : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
 val (%>) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
 (** Alias to [compose] *)
 
+val (@@) : ('a -> 'b) -> 'a -> 'b
+(** [f @@ x] is the same as [f x], but right-associative.
+    @since NEXT_RELEASE *)
+
 val id : 'a -> 'a
 (** Identity function *)
 

core/CCGen.ml

@@ -671,7 +671,7 @@ let drop_while p gen =
     | Yield ->
         begin match gen () with
         | None -> state := Stop; None
-        | (Some x) as res -> res
+        | Some _ as res -> res
         end
   in next
 
@@ -1088,7 +1088,7 @@ let sorted_merge_n ?(cmp=Pervasives.compare) l =
 
 let round_robin ?(n=2) gen =
   (* array of queues, together with their index *)
-  let qs = Array.init n (fun i -> Queue.create ()) in
+  let qs = Array.init n (fun _ -> Queue.create ()) in
   let cur = ref 0 in
   (* get next element for the i-th queue *)
   let rec next i =
@@ -1128,7 +1128,7 @@ let round_robin ?(n=2) gen =
    when they are consumed evenly *)
 let tee ?(n=2) gen =
   (* array of queues, together with their index *)
-  let qs = Array.init n (fun i -> Queue.create ()) in
+  let qs = Array.init n (fun _ -> Queue.create ()) in
   let finished = ref false in (* is [gen] exhausted? *)
   (* get next element for the i-th queue *)
   let rec next i =
@@ -1139,7 +1139,7 @@ let tee ?(n=2) gen =
       else Queue.pop qs.(i)
   (* consume one more element *)
   and get_next i = match gen() with
-    | (Some x) as res ->
+    | Some _ as res ->
       for j = 0 to n-1 do
         if j <> i then Queue.push res qs.(j)
       done;

core/CCGen.mli

@@ -28,7 +28,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 Values of type ['a Gen.t] represent a possibly infinite sequence of values
 of type 'a. One can only iterate once on the sequence, as it is consumed
 by iteration/deconstruction/access. [None] is returned when the generator
-is exhausted.
+is exhausted. Most functions consume elements.
 
 The submodule {!Restart} provides utilities to work with
 {b restartable generators}, that is, functions [unit -> 'a Gen.t] that
@@ -78,25 +78,27 @@ module type S = sig
   (** {2 Basic combinators} *)
 
   val is_empty : _ t -> bool
-    (** Check whether the enum is empty. *)
+    (** Check whether the genertor is empty. Consumes one element if the
+        generator isn't empty. *)
 
   val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
-    (** Fold on the generator, tail-recursively *)
+    (** Fold on the generator, tail-recursively; consumes it *)
 
   val reduce : ('a -> 'a -> 'a) -> 'a t -> 'a
-    (** Fold on non-empty sequences (otherwise raise Invalid_argument) *)
+    (** Fold on non-empty sequences
+        @raise Invalid_argument if the generator is empty *)
 
   val scan : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b t
     (** Like {!fold}, but keeping successive values of the accumulator *)
 
   val iter : ('a -> unit) -> 'a t -> unit
-    (** Iterate on the enum *)
+    (** Iterate on the generator, consuming it *)
 
   val iteri : (int -> 'a -> unit) -> 'a t -> unit
-    (** Iterate on elements with their index in the enum, from 0 *)
+    (** Iterate on elements with their index in the enum, from 0. Consumes it. *)
 
   val length : _ t -> int
-    (** Length of an enum (linear time) *)
+    (** Length of a generator (linear time, consumes its input) *)
 
   val map : ('a -> 'b) -> 'a t -> 'b t
     (** Lazy map. No iteration is performed now, the function will be called

core/CCIO.ml

@@ -415,7 +415,7 @@ module Seq = struct
     try _yield (input_line ic)
     with End_of_file -> _stop()
 
-  let words g =
+  let words _g =
     failwith "words: not implemented yet"
     (* TODO: state machine that goes:
         - 0: read input chunk

core/CCInt.ml

@@ -37,6 +37,8 @@ let sign i =
   else if i>0 then 1
   else 0
 
+let neg i = -i
+
 type 'a printer = Buffer.t -> 'a -> unit
 type 'a formatter = Format.formatter -> 'a -> unit
 type 'a random_gen = Random.State.t -> 'a

core/CCInt.mli

@@ -37,6 +37,10 @@ val hash : t -> int
 val sign : t -> int
 (** [sign i] is one of [-1, 0, 1] *)
 
+val neg : t -> t
+(** [neg i = - i]
+    @since NEXT_RELEASE *)
+
 type 'a printer = Buffer.t -> 'a -> unit
 type 'a formatter = Format.formatter -> 'a -> unit
 type 'a random_gen = Random.State.t -> 'a

core/CCKTree.ml

@@ -199,14 +199,14 @@ module Dot = struct
   let mk_id format =
     let buf = Buffer.create 64 in
     Printf.kbprintf
-      (fun fmt -> `Id (Buffer.contents buf))
+      (fun _ -> `Id (Buffer.contents buf))
       buf
       format
 
   let mk_label format =
     let buf = Buffer.create 64 in
     Printf.kbprintf
-      (fun fmt -> `Label(Buffer.contents buf))
+      (fun _ -> `Label(Buffer.contents buf))
       buf
       format
 
@@ -287,6 +287,6 @@ module Dot = struct
     Printf.bprintf buf "}\n";
     ()
 
-  let pp_single name buf t = pp buf (singleton name t)
+  let pp_single name buf t = pp buf (singleton ~name t)
 end
 

core/CCList.ml

@@ -51,6 +51,8 @@ let map f l =
     List.rev (List.rev_map f l) = map f l)
 *)
 
+let (>|=) l f = map f l
+
 let append l1 l2 =
   let rec direct i l1 l2 = match l1 with
     | [] -> l2
@@ -497,7 +499,7 @@ module Zipper = struct
     | l, x::r ->
         begin match f (Some x) with
         | None -> l,r
-        | Some x' -> l, x::r
+        | Some _ -> l, x::r
         end
 
   let focused = function
@@ -661,7 +663,7 @@ let of_klist l =
 
 let pp ?(start="[") ?(stop="]") ?(sep=", ") pp_item buf l =
   let rec print l = match l with
-    | x::((y::xs) as l) ->
+    | x::((_::_) as l) ->
       pp_item buf x;
       Buffer.add_string buf sep;
       print l
@@ -675,7 +677,7 @@ let pp ?(start="[") ?(stop="]") ?(sep=", ") pp_item buf l =
 
 let print ?(start="[") ?(stop="]") ?(sep=", ") pp_item fmt l =
   let rec print fmt l = match l with
-    | x::((y::xs) as l) ->
+    | x::((_::_) as l) ->
       pp_item fmt x;
       Format.pp_print_string fmt sep;
       Format.pp_print_cut fmt ();

core/CCList.mli

@@ -33,6 +33,10 @@ val empty : 'a t
 val map : ('a -> 'b) -> 'a t -> 'b t
 (** Safe version of map *)
 
+val (>|=) : 'a t -> ('a -> 'b) -> 'b t
+(** Infix version of [map] with reversed arguments
+    @since NEXT_RELEASE *)
+
 val append : 'a t -> 'a t -> 'a t
 (** Safe version of append *)
 

core/CCMap.ml

@@ -0,0 +1,116 @@
+
+(*
+copyright (c) 2013-2014, simon cruanes
+all rights reserved.
+
+redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(** {1 Extensions of Standard Map} *)
+
+type 'a sequence = ('a -> unit) -> unit
+type 'a printer = Buffer.t -> 'a -> unit
+type 'a formatter = Format.formatter -> 'a -> unit
+
+module type S = sig
+  include Map.S
+
+  val get : key -> 'a t -> 'a option
+  (** Safe version of {!find} *)
+
+  val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
+  (** [update k f m] calls [f (Some v)] if [find k m = v],
+      otherwise it calls [f None]. In any case, if the result is [None]
+      [k] is removed from [m], and if the result is [Some v'] then
+      [add k v' m] is returned. *)
+
+  val of_seq : (key * 'a) sequence -> 'a t
+
+  val to_seq : 'a t -> (key * 'a) sequence
+
+  val of_list : (key * 'a) list -> 'a t
+
+  val to_list : 'a t -> (key * 'a) list
+
+  val pp : ?start:string -> ?stop:string -> ?arrow:string -> ?sep:string ->
+            key printer -> 'a printer -> 'a t printer
+
+  val print : ?start:string -> ?stop:string -> ?arrow:string -> ?sep:string ->
+              key formatter -> 'a formatter -> 'a t formatter
+end
+
+module Make(O : Map.OrderedType) = struct
+  include Map.Make(O)
+
+  let get k m =
+    try Some (find k m)
+    with Not_found -> None
+
+  let update k f m =
+    let x =
+      try f (Some (find k m))
+      with Not_found -> f None
+    in
+    match x with
+      | None -> remove k m
+      | Some v' -> add k v' m
+
+  let of_seq s =
+    let m = ref empty in
+    s (fun (k,v) -> m := add k v !m);
+    !m
+
+  let to_seq m yield =
+    iter (fun k v -> yield (k,v)) m
+
+  let of_list l =
+    List.fold_left
+      (fun m (k,v) -> add k v m) empty l
+
+  let to_list m =
+    fold (fun k v acc -> (k,v)::acc) m []
+
+  let pp ?(start="{") ?(stop="}") ?(arrow="->") ?(sep=", ") pp_k pp_v buf m =
+    let first = ref true in
+    Buffer.add_string buf start;
+    iter
+      (fun k v ->
+        if !first then first := false else Buffer.add_string buf sep;
+        pp_k buf k;
+        Buffer.add_string buf arrow;
+        pp_v buf v
+      ) m;
+    Buffer.add_string buf stop
+
+  let print ?(start="[") ?(stop="]") ?(arrow="->") ?(sep=", ") pp_k pp_v fmt m =
+    Format.pp_print_string fmt start;
+    let first = ref true in
+    iter
+      (fun k v ->
+        if !first then first := false else Format.pp_print_string fmt sep;
+        pp_k fmt k;
+        Format.pp_print_string fmt arrow;
+        pp_v fmt v;
+        Format.pp_print_cut fmt ()
+      ) m;
+    Format.pp_print_string fmt stop
+end
+

core/CCMap.mli

@@ -1,6 +1,6 @@
 
 (*
-copyright (c) 2013, simon cruanes
+copyright (c) 2013-2014, simon cruanes
 all rights reserved.
 
 redistribution and use in source and binary forms, with or without
@@ -24,37 +24,42 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
-(** {1 Serialize Bencode on disk with persistency guarantees}
+(** {1 Extensions of Standard Map}
 
-    This module provides an append-only interface to some file, with
+Provide useful functions and iterators on [Map.S]
-    synchronized access and fsync() called after every write.
+@since NEXT_RELEASE *)
-    It needs {b Extunix} to compile (needs fsync).
-    *)
 
-type t
+type 'a sequence = ('a -> unit) -> unit
-  (** Handle to a file on which we can append values atomically *)
+type 'a printer = Buffer.t -> 'a -> unit
+type 'a formatter = Format.formatter -> 'a -> unit
 
-val open_out : ?lock:string -> string -> t
+module type S = sig
-  (** Open the given file for appending values. Creates the file
+  include Map.S
-      if it doesn't exist.
-      @param lock, if provided, is the name of the lock file used. By default,
-        the file that is provided for writing is also used for locking.
-      @raise Unix.Unix_error if some IO error occurs. *)
 
-val close_out : t -> unit
+  val get : key -> 'a t -> 'a option
-  (** Close the file descriptor *)
+  (** Safe version of {!find} *)
 
-val write : t -> Bencode.t -> unit
+  val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
-  (** Write "atomically" a value to the end of the file *)
+  (** [update k f m] calls [f (Some v)] if [find k m = v],
+      otherwise it calls [f None]. In any case, if the result is [None]
+      [k] is removed from [m], and if the result is [Some v'] then
+      [add k v' m] is returned. *)
 
-val write_batch : t -> Bencode.t list -> unit
+  val of_seq : (key * 'a) sequence -> 'a t
-  (** Write several values at once, at the end of the file *)
 
-type 'a result =
+  val to_seq : 'a t -> (key * 'a) sequence
-  | Ok of 'a
-  | Error of string
 
-val read : ?lock:string -> string -> 'a -> ('a -> Bencode.t -> 'a) -> 'a result
+  val of_list : (key * 'a) list -> 'a t
-  (** Fold on values serialized in the given file.
+
-      @param lock see {!open_out}.
+  val to_list : 'a t -> (key * 'a) list
-      @raise Unix.Unix_error if some IO error occurs. *)
+
+  val pp : ?start:string -> ?stop:string -> ?arrow:string -> ?sep:string ->
+            key printer -> 'a printer -> 'a t printer
+
+  val print : ?start:string -> ?stop:string -> ?arrow:string -> ?sep:string ->
+              key formatter -> 'a formatter -> 'a t formatter
+end
+
+module Make(O : Map.OrderedType) : S
+  with type 'a t = 'a Map.Make(O).t
+  and type key = O.t

core/CCMultiMap.ml

@@ -167,7 +167,7 @@ module Make(K : OrderedType)(V : OrderedType) = struct
 
   let union m1 m2 =
     M.merge
-      (fun k v1 v2 -> match v1, v2 with
+      (fun _k v1 v2 -> match v1, v2 with
         | None, None -> None
         | Some set1, Some set2 -> Some (S.union set1 set2)
         | Some set, None
@@ -176,7 +176,7 @@ module Make(K : OrderedType)(V : OrderedType) = struct
 
   let inter m1 m2 =
     M.merge
-      (fun k v1 v2 -> match v1, v2 with
+      (fun _k v1 v2 -> match v1, v2 with
         | None, _
         | _, None -> None
         | Some set1, Some set2 ->
@@ -188,7 +188,7 @@ module Make(K : OrderedType)(V : OrderedType) = struct
 
   let diff m1 m2 =
     M.merge
-      (fun k v1 v2 -> match v1, v2 with
+      (fun _k v1 v2 -> match v1, v2 with
         | None, _ -> None
         | Some set, None -> Some set
         | Some set1, Some set2 ->

core/CCMultiSet.ml

@@ -117,7 +117,7 @@ module Make(O : Set.OrderedType) = struct
 
   let union m1 m2 =
     M.merge
-      (fun x n1 n2 -> match n1, n2 with
+      (fun _x n1 n2 -> match n1, n2 with
         | None, None -> assert false
         | Some n, None
         | None, Some n -> Some n
@@ -134,7 +134,7 @@ module Make(O : Set.OrderedType) = struct
 
   let intersection m1 m2 =
     M.merge
-      (fun x n1 n2 -> match n1, n2 with
+      (fun _x n1 n2 -> match n1, n2 with
         | None, None -> assert false
         | Some _, None
         | None, Some _ -> None
@@ -143,10 +143,10 @@ module Make(O : Set.OrderedType) = struct
 
   let diff m1 m2 =
     M.merge
-      (fun x n1 n2 -> match n1, n2 with
+      (fun _x n1 n2 -> match n1, n2 with
         | None, None -> assert false
         | Some n1, None -> Some n1
-        | None, Some n2 -> None
+        | None, Some _n2 -> None
         | Some n1, Some n2 ->
           if n1 > n2
             then Some (n1 - n2)

core/CCOpt.ml

@@ -84,6 +84,10 @@ let map2 f o1 o2 = match o1, o2 with
   | _, None -> None
   | Some x, Some y -> Some (f x y)
 
+let filter p = function
+  | Some x as o when p x -> o
+  | o -> o
+
 let iter f o = match o with
   | None -> ()
   | Some x -> f x

core/CCOpt.mli

@@ -60,6 +60,11 @@ val iter : ('a -> unit) -> 'a t -> unit
 val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
 (** Fold on 0 or 1 elements *)
 
+val filter : ('a -> bool) -> 'a t -> 'a t
+(** Filter on 0 or 1 elements
+
+    @since NEXT_RELEASE *)
+
 val get : 'a -> 'a t -> 'a
 (** [get default x] unwraps [x], but if [x = None] it returns [default] instead.
     @since 0.4.1 *)

core/CCPersistentHashtbl.ml

@@ -294,7 +294,7 @@ module Make(H : HashedType) : S with type key = H.t = struct
       (fun k v2 ->
         if not (mem t1 k) then match f k None (Some v2) with
           | None -> ()
-          | Some v' -> Table.replace tbl k v2);
+          | Some _ -> Table.replace tbl k v2);
     ref (Table tbl)
 
   let add_seq init seq =

core/CCPrint.ml

@@ -38,7 +38,7 @@ type 'a t = Buffer.t -> 'a -> unit
 
 (** {2 Combinators} *)
 
-let silent buf _ = ()
+let silent _buf _ = ()
 
 let unit buf () = Buffer.add_string buf "()"
 let int buf i = Buffer.add_string buf (string_of_int i)
@@ -49,7 +49,7 @@ let float buf f = Buffer.add_string buf (string_of_float f)
 
 let list ?(start="[") ?(stop="]") ?(sep=", ") pp buf l =
   let rec pp_list l = match l with
-  | x::((y::xs) as l) ->
+  | x::((_::_) as l) ->
     pp buf x;
     Buffer.add_string buf sep;
     pp_list l
@@ -116,14 +116,14 @@ let to_string pp x =
 let sprintf format =
   let buffer = Buffer.create 64 in
   Printf.kbprintf
-    (fun fmt -> Buffer.contents buffer)
+    (fun _fmt -> Buffer.contents buffer)
     buffer
     format
 
 let fprintf oc format =
   let buffer = Buffer.create 64 in
   Printf.kbprintf
-    (fun fmt -> Buffer.output_buffer oc buffer)
+    (fun _fmt -> Buffer.output_buffer oc buffer)
     buffer
     format
 

core/CCSequence.mli

@@ -604,7 +604,15 @@ module IO : sig
       @param mode default [0o644]
       @param flags used by [open_out_gen]. Default: [[Open_creat;Open_wronly]]. *)
 
+  val write_bytes_to : ?mode:int -> ?flags:open_flag list ->
+                       string -> Bytes.t t -> unit
+  (** @since NEXT_RELEASE *)
+
   val write_lines : ?mode:int -> ?flags:open_flag list ->
                     string -> string t -> unit
   (** Same as {!write_to}, but intercales ['\n'] between each string *)
+
+  val write_bytes_lines : ?mode:int -> ?flags:open_flag list ->
+                    string -> Bytes.t t -> unit
+  (** @since NEXT_RELEASE *)
 end

core/CCString.cppo.ml

@@ -46,6 +46,7 @@ module type S = sig
   val to_list : t -> char list
 
   val pp : Buffer.t -> t -> unit
+  val print : Format.formatter -> t -> unit
 end
 
 let equal (a:string) b = a=b
@@ -54,10 +55,18 @@ let compare = String.compare
 
 let hash s = Hashtbl.hash s
 
+#if OCAML_MAJOR >= 4 && OCAML_MINOR >= 2
+
+let init = String.init
+
+#else
+
 let init n f =
-  let s = String.make n ' ' in
+  let buf = Buffer.create n in
-  for i = 0 to n-1 do s.[i] <- f i done;
+  for i = 0 to n-1 do Buffer.add_char buf (f i) done;
-  s
+  Buffer.contents buf
+
+#endif
 
 let length = String.length
 
@@ -167,11 +176,7 @@ let repeat s n =
   assert (n>=0);
   let len = String.length s in
   assert(len > 0);
-  let buf = String.create (len * n) in
+  init (len * n) (fun i -> s.[i mod len])
-  for i = 0 to n-1 do
-    String.blit s 0 buf (i * len) len;
-  done;
-  buf
 
 let prefix ~pre s =
   String.length pre <= String.length s &&
@@ -212,26 +217,23 @@ let rec _to_klist s i len () =
   else `Cons (s.[i], _to_klist s (i+1)(len-1))
 
 let of_klist l =
-  let rec aux acc n l = match l() with
+  let b = Buffer.create 15 in
+  let rec aux l = match l() with
     | `Nil ->
-        let s = String.create n in
+        Buffer.contents b
-        let acc = ref acc in
+    | `Cons (x,l') ->
-        for i=n-1 downto 0 do
+        Buffer.add_char b x;
-          s.[i] <- List.hd !acc;
+        aux l'
-          acc := List.tl !acc
+  in aux l
-        done;
-        s
-    | `Cons (x,l') -> aux (x::acc) (n+1) l'
-  in aux [] 0 l
 
 let to_klist s = _to_klist s 0 (String.length s)
 
 let to_list s = _to_list s [] 0 (String.length s)
 
 let of_list l =
-  let s = String.make (List.length l) ' ' in
+  let buf = Buffer.create (List.length l) in
-  List.iteri (fun i c -> s.[i] <- c) l;
+  List.iter (Buffer.add_char buf) l;
-  s
+  Buffer.contents buf
 
 (*$T
   of_list ['a'; 'b'; 'c'] = "abc"
@@ -239,9 +241,7 @@ let of_list l =
 *)
 
 let of_array a =
-  let s = String.make (Array.length a) ' ' in
+  init (Array.length a) (fun i -> a.(i))
-  Array.iteri (fun i c -> s.[i] <- c) a;
-  s
 
 let to_array s =
   Array.init (String.length s) (fun i -> s.[i])
@@ -251,6 +251,9 @@ let pp buf s =
   Buffer.add_string buf s;
   Buffer.add_char buf '"'
 
+let print fmt s =
+  Format.fprintf fmt "\"%s\"" s
+
 module Sub = struct
   type t = string * int * int
 
@@ -284,4 +287,7 @@ module Sub = struct
     Buffer.add_char buf '"';
     Buffer.add_substring buf s i len;
     Buffer.add_char buf '"'
+
+  let print fmt s =
+    Format.fprintf fmt "\"%s\"" (copy s)
 end

core/CCString.mli

@@ -50,6 +50,7 @@ module type S = sig
   val to_list : t -> char list
 
   val pp : Buffer.t -> t -> unit
+  val print : Format.formatter -> t -> unit
 end
 
 (** {2 Strings} *)

core/CCTrie.ml

@@ -211,7 +211,7 @@ module Make(W : WORD) = struct
   let _remove_sub c t = match t with
     | Empty -> t
     | Path ([], _) -> assert false
-    | Path (c'::l, t') ->
+    | Path (c'::_, _) ->
         if W.compare c c' = 0
           then Empty
           else t
@@ -357,7 +357,7 @@ module Make(W : WORD) = struct
           | Some v -> f acc v
         in
         M.fold
-          (fun c t' acc -> fold_values f acc t')
+          (fun _c t' acc -> fold_values f acc t')
           map acc
 
   let iter_values f t = fold_values (fun () x -> f x) () t
@@ -535,9 +535,9 @@ module String = Make(struct
   let compare = Char.compare
   let to_seq s k = String.iter k s
   let of_list l =
-    let s = String.create (List.length l) in
+    let buf = Buffer.create (List.length l) in
-    List.iteri (fun i c -> s.[i] <- c) l;
+    List.iter (fun c -> Buffer.add_char buf c) l;
-    s
+    Buffer.contents buf
 end)
 
 (*$T

core/CCVector.ml

@@ -139,6 +139,11 @@ let append a b =
     a.size <- a.size + b.size
   )
 
+(*$T
+  let v1 = init 5 (fun i->i) and v2 = init 5 (fun i->i+5) in \
+  append v1 v2; to_list v1 = CCList.(0--9)
+*)
+
 let get v i =
   if i < 0 || i >= v.size then failwith "Vector.get";
   Array.unsafe_get v.vec i
@@ -159,8 +164,14 @@ let append_seq a seq =
   seq (fun x -> push a x)
 
 let append_array a b =
+  ensure a (a.size + Array.length b);
   Array.iter (push a) b
 
+(*$T
+  let v1 = init 5 (fun i->i) and v2 = Array.init 5 (fun i->i+5) in \
+  append_array v1 v2; to_list v1 = CCList.(0--9)
+*)
+
 let equal eq v1 v2 =
   let n = min v1.size v2.size in
   let rec check i =
@@ -243,6 +254,11 @@ let uniq_sort cmp v =
     then traverse v.vec.(0) 1 1
     (* start at 1, to get the first element in hand *)
 
+(*$T
+  let v = of_list [1;4;5;3;2;4;1] in \
+  uniq_sort Pervasives.compare v; to_list v = [1;2;3;4;5]
+*)
+
 let iter k v =
   for i = 0 to v.size -1 do
     k (Array.unsafe_get v.vec i)
@@ -256,10 +272,18 @@ let iteri k v =
 let map f v =
   if _empty_array v
   then create ()
-  else {
+  else (
-    size=v.size;
+    let vec = Array.init v.size (fun i -> f (Array.unsafe_get v.vec i)) in
-    vec=Array.map f v.vec
+    {
-  }
+      size=v.size;
+      vec;
+    }
+  )
+
+(*$T
+  let v = create() in push v 1; push v 2; push v 3; \
+  to_list (map string_of_int v) = ["1"; "2"; "3"]
+  *)
 
 let filter' p v =
   let i = ref (v.size - 1) in
@@ -437,7 +461,7 @@ let of_array a =
 
 let of_list l = match l with
   | [] -> create()
-  | x::l' ->
+  | x::_ ->
       let v = create_with ~capacity:(List.length l + 5) x in
       List.iter (push v) l;
       v
@@ -464,6 +488,10 @@ let to_gen v =
         Some x
       ) else None
 
+(*$T
+  let v = (1--10) in to_list v = CCGen.to_list (to_gen v)
+  *)
+
 let of_klist ?(init=create ()) l =
   let rec aux l = match l() with
     | `Nil -> init

core/CCVector.mli

@@ -90,7 +90,7 @@ val append_seq : ('a, rw) t -> 'a sequence -> unit
 val equal : 'a equal -> ('a,_) t equal
 
 val compare : 'a ord -> ('a,_) t ord
-(** Lexicographic comparison *)
+(** Total ordering on vectors: Lexicographic comparison. *)
 
 val pop : ('a, rw) t -> 'a option
 (** Remove last element, or [None] *)

core/META

@@ -1,7 +1,8 @@
 # OASIS_START
-# DO NOT EDIT (digest: caeabec618f289bbaa0522b65bf421f3)
+# DO NOT EDIT (digest: e4ab50f4ef28e5ea06e4145c3414c218)
 version = "0.4.1"
 description = "A modular standard library focused on data structures."
+requires = "cppo"
 archive(byte) = "containers.cma"
 archive(byte, plugin) = "containers.cma"
 archive(native) = "containers.cmxa"

core/containers.mldylib

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: f5cc3719f4c5e3e210a649e32f08ebde)
+# DO NOT EDIT (digest: ce5ac7ea3a03a61e3ed7dc10a551b94e)
 CCVector
 CCDeque
 CCGen
@@ -30,4 +30,5 @@ CCString
 CCHashtbl
 CCFlatHashtbl
 CCSexp
+CCMap
 # OASIS_STOP

core/containers.mllib

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: f5cc3719f4c5e3e210a649e32f08ebde)
+# DO NOT EDIT (digest: ce5ac7ea3a03a61e3ed7dc10a551b94e)
 CCVector
 CCDeque
 CCGen
@@ -30,4 +30,5 @@ CCString
 CCHashtbl
 CCFlatHashtbl
 CCSexp
+CCMap
 # OASIS_STOP

misc/actionMan.ml

@@ -1,159 +0,0 @@
-
-(*
-copyright (c) 2013, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {6 Action Language for command line} *)
-
-module Action = struct
-  type trigger = string
-
-  type _ t =
-    | Return : 'a -> 'a t
-    | Bind : 'a t * ('a -> 'b t) -> 'b t
-    | Ignore : ('a t * 'b t) -> 'b t
-    | Any : string t
-    | ReadInt : (int -> 'a t) -> 'a t
-    | ReadString : (string -> 'a t) -> 'a t
-    | ReadBool : (bool -> 'a t) -> 'a t
-    | Choice : 'a t list -> 'a t
-    | Fail : string -> 'a t
-
-  let return x = Return x
-  
-  let (>>=) x f = Bind (x, f)
-
-  let (>>) x f = Bind (x, (fun _ -> f ()))
-
-  let ( *>) a b = Ignore (a, b)
-
-  let ignore x = x *> return ()
-
-  let any = Any
-
-  let accept trigger =
-    Any >>= fun x ->
-      if x = trigger
-        then return ()
-        else Fail ("expected trigger \"" ^ trigger ^ "\"")
-
-  let with_string ?trigger f =
-    match trigger with
-    | None -> ReadString f
-    | Some t -> accept t *> ReadString f
-
-  let with_int ?trigger f =
-    match trigger with
-    | None -> ReadInt f
-    | Some t -> accept t *> ReadInt f
-
-  let with_bool ?trigger f =
-    match trigger with
-    | None -> ReadBool f
-    | Some t -> accept t *> ReadBool f
-
-  let choice l = Choice l
-
-  let repeat act =
-    let rec try_next acc =
-      choice
-        [ act >>= (fun x -> try_next (x::acc))
-        ; return acc
-        ]
-    in
-    (try_next []) >>= (fun l -> return (List.rev l))
-
-  let opt act =
-    choice [ act >>= (fun x -> return (Some x)); return None ]
-    
-  let fail msg = Fail msg
-end
-
-type 'a result =
-  | Ok of 'a
-  | Error of string
-
-type 'a partial_result =
-  | POk of 'a * int   (* value and position in args *)
-  | PError of string  (* error message *)
-
-let parse_args args (act : 'a Action.t) : 'a result =
-  let module A = Action in
-  (* interpret recursively, with backtracking. Returns partial result *)
-  let rec interpret : type a. string array -> int -> a Action.t -> a partial_result
-  = fun args i act ->
-    let n = Array.length args in
-    match act with
-    | A.Return x -> POk (x, i)
-    | A.Bind (x, f) ->
-      begin match interpret args i x with
-      | POk (x, i') -> interpret args i' (f x)
-      | PError msg -> PError msg
-      end
-    | A.Ignore (a, b) ->
-      begin match interpret args i a with
-      | POk (_, i') -> interpret args i' b
-      | PError msg -> PError msg
-      end
-    | A.Any when i >= n -> mk_error i "expected [any], reached end"
-    | A.Any -> POk (args.(i), i+1)
-    | A.ReadInt f when i >= n -> mk_error i "expected [int], reached end"
-    | A.ReadInt f ->
-      begin try
-        let j = int_of_string args.(i) in
-        interpret args (i+1) (f j)
-      with Failure _ -> mk_error i "expected [int]"
-      end
-    | A.ReadString _ when i >= n -> mk_error i "expected [string], reached end"
-    | A.ReadString f -> interpret args (i+1) (f args.(i))
-    | A.ReadBool _ -> failwith "not implemented: read bool" (* TODO *)
-    | A.Fail msg -> mk_error i msg
-    | A.Choice l -> try_choices args i [] l
-  (* try the actions remaining in [l], whenre [errors] is the list
-      of errors in already tried branches *)
-  and try_choices : type a. string array -> int -> string list -> a Action.t list -> a partial_result 
-  = fun args i errors l ->
-    match l with
-    | [] ->
-      let msg = Printf.sprintf "choice failed: [%s]" (String.concat " | " errors) in
-      mk_error i msg
-    | act::l' ->
-      begin match interpret args i act with
-      | POk _ as res -> res   (* success! *)
-      | PError msg ->
-        try_choices args i (msg :: errors) l'
-      end
-  (* report error *)
-  and mk_error : type a. int -> string -> a partial_result
-  = fun i msg ->
-    PError (Printf.sprintf "at arg %d: %s" i msg)
-  in
-  match interpret args 1 act with
-  | POk (x,_) -> Ok x
-  | PError msg -> Error msg
-
-let parse act = parse_args Sys.argv act
-
-let print_doc oc act =
-  failwith "print_doc: not implemented"

misc/actionMan.mli

@@ -1,94 +0,0 @@
-
-(*
-copyright (c) 2013, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {6 Action Language for command line} *)
-
-(** {2 Command-line Actions} *)
-
-module Action : sig
-  type 'a t
-    (** Action returning a 'a *)
-
-  type trigger = string
-    (** Trigger a given action, based on the next token *)
-
-  val return : 'a -> 'a t
-    (** Return a pure value *)
-
-  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-    (** CCSequence of arguments *)
-
-  val (>>) : 'a t -> (unit -> 'b t) -> 'b t
-    (** Same as {! (>>=)}, but ignores the result of left side *)
-
-  val ( *>) : 'a t -> 'b t -> 'b t
-    (** Accept left, then returns right *)
-
-  val accept : trigger -> unit t
-    (** Accept the given trigger, fails otherwise *)
-
-  val any : string t
-    (** Any token *)
-
-  val with_string : ?trigger:trigger -> (string -> 'a t) -> 'a t
-    (** Command that takes a string *)
-
-  val with_int : ?trigger:trigger -> (int -> 'a t) -> 'a t
-    (** Command that takes an integer *)
-
-  val with_bool : ?trigger:trigger -> (bool -> 'a t) -> 'a t
-
-  val opt : 'a t -> 'a option t
-    (** Optional action *)
-
-  val repeat : 'a t -> 'a list t
-    (** Repeated action *)
-
-  val choice : 'a t list -> 'a t
-    (** Choice between options. The first option of the list that
-        does not fail will be the result (backtracking is used!) *)
-
-  val ignore : 'a t -> unit t
-    (** Ignore result *)
-
-  val fail : string -> 'a t
-    (** Fail with given message *)
-end
-
-(** {2 Main interface} *)
-
-type 'a result =
-  | Ok of 'a
-  | Error of string
-
-val parse_args : string array -> 'a Action.t -> 'a result
-  (** Parse given command line *)
-
-val parse : 'a Action.t -> 'a result
-  (** Parse Sys.argv *)
-
-val print_doc : out_channel -> 'a Action.t -> unit
-  (** Print documentation on given channel *)

misc/bencode.ml

@@ -1,363 +0,0 @@
-(*
-Copyright (c) 2013, Simon Cruanes
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-Redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  Redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {6 B-encoding} *)
-
-
-module SMap = Map.Make(String)
-
-type t =
-  | I of int
-  | S of string
-  | L of t list
-  | D of t SMap.t
-
-let rec eq t1 t2 = match t1, t2 with
-  | I i1, I i2 -> i1 = i2
-  | S s1, S s2 -> s1 = s2
-  | L l1, L l2 ->
-    (try List.for_all2 eq l1 l2 with Invalid_argument _ -> false)
-  | D d1, D d2 ->
-    SMap.equal eq d1 d2
-  | _ -> false
-
-let hash t = Hashtbl.hash t
-
-let dict_of_list l =
-  let d = List.fold_left
-    (fun d (k, v) -> SMap.add k v d)
-    SMap.empty l
-  in
-  D d
-
-(** {2 Serialization (encoding)} *)
-
-(* length of an encoded int, in bytes *)
-let _len_int i =
-  match i with
-  | 0 -> 1
-  | _ when i < 0 -> 2 + int_of_float (log10 (float_of_int ~-i))
-  | _ -> 1 + int_of_float (log10 (float_of_int i))
-
-(* length of an encoded string, in bytes *)
-let _len_str s =
-  _len_int (String.length s) + 1 + String.length s
-
-let rec size t = match t with
-  | I i -> 2 + _len_int i
-  | S s -> _len_str s
-  | L l -> List.fold_left (fun acc i -> acc + size i) 2 l
-  | D map -> SMap.fold (fun k v acc -> acc + _len_str k + size v) map 2
-
-let write_in_string t buf o =
-  let pos = ref o in
-  let rec append t = match t with
-  | I i -> write_char 'i'; write_int i; write_char 'e'
-  | S s -> write_str s
-  | L l ->
-    write_char 'l';
-    List.iter append l;
-    write_char 'e';
-  | D m ->
-    write_char 'd';
-    SMap.iter (fun key t' -> write_str key; append t') m;
-    write_char 'e'
-  and write_int i =
-    let s = string_of_int i in
-    String.blit s 0 buf !pos (String.length s);
-    pos := !pos + String.length s
-  and write_str s =
-    write_int (String.length s);
-    write_char ':';
-    String.blit s 0 buf !pos (String.length s);
-    pos := !pos + String.length s
-  and write_char c =
-    buf.[!pos] <- c;
-    incr pos
-  in
-  append t
-
-let to_string t =
-  let len = size t in
-  let s = String.create len in
-  write_in_string t s 0;
-  s
-
-let to_buf buf t =
-  Buffer.add_string buf (to_string t)
-
-let to_chan ch t =
-  let b = Buffer.create 25 in
-  to_buf b t;
-  Buffer.output_buffer ch b
-
-let fmt formatter t =
-  let b = Buffer.create 25 in
-  to_buf b t;
-  Format.pp_print_string formatter (Buffer.contents b)
-
-let rec pretty fmt t = match t with
-  | I i -> Format.fprintf fmt "%d" i
-  | S s -> Format.fprintf fmt "@[<h>\"%s\"@]" s
-  | L l ->
-    Format.fprintf fmt "@[<hov 2>[@,";
-    List.iteri (fun i t' -> (if i > 0 then Format.pp_print_char fmt ' '); pretty fmt t') l;
-    Format.fprintf fmt "]@]";
-  | D d ->
-    Format.fprintf fmt "@[<hov 2>{@,";
-    SMap.iter
-      (fun k t' -> Format.fprintf fmt "%a -> %a@ " pretty (S k) pretty t')
-      d;
-    Format.fprintf fmt "}@]";
-    ()
-
-let pretty_to_str t =
-  let b = Buffer.create 15 in
-  Format.fprintf (Format.formatter_of_buffer b) "%a@?" pretty t;
-  Buffer.contents b
-
-(** {2 Deserialization (decoding)} *)
-
-(** Deserialization is based on the {! decoder} type. Parsing can be
-    incremental, in which case the input is provided chunk by chunk and
-    the decoder contains the parsing state. Once a B-encoded value
-    has been parsed, other values can still be read. *)
-
-type decoder = {
-  mutable buf : string;  (* buffer *)
-  mutable i : int;  (* index in buf *)
-  mutable len : int;  (* length of substring to read *)
-  mutable c : int;  (* line *)
-  mutable l : int;  (* column *)
-  mutable state : parse_result;
-  mutable stack : partial_state list;
-}
-
-(** Result of parsing *)
-and parse_result =
-  | ParseOk of t
-  | ParseError of string
-  | ParsePartial
-
-(** Partial state of the parser *)
-and partial_state =
-  | PS_I of bool * int (* sign and integer *)
-  | PS_S of int ref * string   (* index in string, plus string *)
-  | PS_L of t list
-  | PS_D of t SMap.t  (* in dictionary *)
-  | PS_D_key of string * t SMap.t  (* parsed key, wait for value *) 
-  | PS_return of t  (* bottom of stack *)
-  | PS_error of string (* error *)
-
-let mk_decoder () =
-  let dec = {
-    buf = "";
-    i = 0;
-    len = 0;
-    c = 0;
-    l = 0;
-    state = ParsePartial;
-    stack = [];
-  } in
-  dec
-
-let is_empty dec = dec.len = 0
-let cur dec = dec.buf.[dec.i]
-
-let junk dec =
-  (* update line/column *)
-  (if cur dec = '\n'
-    then (dec.c <- 0; dec.l <- dec.l + 1)
-    else dec.c <- dec.c + 1);
-  dec.i <- dec.i + 1;
-  dec.len <- dec.len - 1
-
-let next dec =
-  let c = cur dec in
-  junk dec;
-  c
-
-(* parse value *)
-let rec parse_rec dec =
-  match dec.stack with
-  | [PS_return v] ->  (* return value *)
-    dec.stack <- [];
-    dec.state <- ParseOk v;
-    dec.state
-  | [PS_error s] -> (* failure *)
-    dec.stack <- [];
-    dec.state <- ParseError s;
-    dec.state
-  | _ ->
-    if is_empty dec then ParsePartial (* wait *)
-    else begin
-      let c = next dec in
-      (match dec.stack, c with
-      | (PS_I (sign, i)) :: stack, '0' .. '9' ->
-        dec.stack <- PS_I (sign, (Char.code c - Char.code '0') + 10 * i) :: stack;
-      | (PS_I (_, 0)) :: stack, '-' ->
-        dec.stack <- PS_I (false, 0) :: stack  (* negative number *)
-      | (PS_I (sign, i)) :: stack, 'e' ->
-        dec.stack <- stack;
-        push_value dec (I (if sign then i else ~- i))
-      | ((PS_D _ | PS_D_key _ | PS_L _) :: _ | []), '0' .. '9' ->
-        (* initial length of string *)
-        dec.stack <- (PS_I (true, Char.code c - Char.code '0')) :: dec.stack
-      | (PS_I (sign, i)) :: stack, ':' ->
-        if i < 0
-          then error dec "string length cannot be negative"
-        else if i = 0 then  (* empty string *)
-          let _ = dec.stack <- stack in
-          push_value dec (S "")
-        else (* prepare to parse a string *)
-          dec.stack <- (PS_S (ref 0, String.create i)) :: stack;
-      | (PS_S (n, s)) :: stack, _ ->
-        s.[!n] <- c;
-        incr n;
-        (* value completed *)
-        (if !n = String.length s
-          then
-            let _ = dec.stack <- stack in
-            push_value dec (S s));
-      | stack, 'i' ->
-        dec.stack <- (PS_I (true, 0)) :: stack
-      | stack, 'l' ->
-        dec.stack <- PS_L [] :: stack;
-      | stack, 'd' ->
-        dec.stack <- PS_D SMap.empty :: stack
-      | (PS_L l) :: stack, 'e' -> (* end of list *)
-        dec.stack <- stack;
-        push_value dec (L (List.rev l))
-      | (PS_D d) :: stack, 'e' -> (* end of dict *)
-        dec.stack <- stack;
-        push_value dec (D d)
-      | (PS_D_key _) :: _, 'e' -> (* error *)
-        error dec "missing value in dict"
-      | _ -> (* generic error *)
-        error dec (Printf.sprintf "expected value, got %c" c));
-      parse_rec dec
-    end
-(* When a value is parsed, push it on the stack (possibly collapsing it) *)
-and push_value dec v =
-  match v, dec.stack with
-  | _, [] ->
-    dec.stack <- [PS_return v] (* finished *)
-  | _, (PS_L l) :: stack ->
-    (* add to list *)
-    dec.stack <- (PS_L (v :: l)) :: stack;
-  | S key, ((PS_D d) :: stack) ->
-    (* new key for the map *)
-    dec.stack <- (PS_D_key (key, d)) :: stack;
-  | _, ((PS_D d) :: _) ->
-    (* error: key must be string *)
-    error dec "dict keys must be strings"
-  | _, (PS_D_key (key, d)) :: stack ->
-    (* new binding for the map *)
-    dec.stack <- (PS_D (SMap.add key v d)) :: stack;
-  | _ -> assert false
-(* signal error *)
-and error dec msg =
-  let msg = Printf.sprintf "Bencode: error at line %d, column %d: %s"
-    dec.l dec.c msg in
-  dec.stack <- [PS_error msg]
-
-(* exported parse function *)
-let parse dec s i len =
-  (if i < 0 || i+len > String.length s
-    then invalid_arg "Bencode.parse: not a valid substring");
-  (* add the input to [dec] *)
-  if dec.len = 0
-    then begin
-      dec.buf <- String.copy s;
-      dec.i <- i;
-      dec.len <- len;
-    end else begin
-      (* use a buffer to merge the stored input and the new input *)
-      let buf' = String.create (dec.len + len - dec.i) in
-      String.blit dec.buf dec.i buf' 0 dec.len;
-      String.blit s i buf' dec.len len;
-      dec.buf <- buf';
-      dec.i <- 0;
-      dec.len <- dec.len + len - dec.i;
-    end;
-  (* state machine *)
-  parse_rec dec
-
-let parse_resume d = parse_rec d
-
-let reset dec =
-  dec.l <- 0;
-  dec.c <- 0;
-  dec.i <- 0;
-  dec.len <- 0;
-  dec.state <- ParsePartial;
-  dec.stack <- [];
-  ()
-
-let state dec = dec.state
-
-let rest dec =
-  String.sub dec.buf dec.i dec.len
-
-let rest_size dec =
-  dec.len
-
-let parse_string s =
-  let dec = mk_decoder () in
-  parse dec s 0 (String.length s)
-
-let of_string s =
-  match parse_string s with
-  | ParseOk t -> t
-  | ParsePartial -> invalid_arg "Bencode: partial parse"
-  | ParseError msg -> invalid_arg msg
-
-(** {2 Iterator} *)
-
-type 'a sequence = ('a -> unit) -> unit
-
-let of_seq seq =
-  fun k ->
-    let decoder = mk_decoder () in
-    (* read a string *)
-    let rec read_chunk str =
-      match parse decoder str 0 (String.length str) with
-      | ParseOk v ->
-        k v;  (* yield, and parse the rest of the string *)
-        resume ()
-      | ParseError e -> raise (Invalid_argument e)
-      | ParsePartial -> ()  (* wait for next chunk *)
-    and resume () = match parse_resume decoder with
-      | ParseOk v ->
-        k v;
-        resume ()
-      | ParseError e -> raise (Invalid_argument e)
-      | ParsePartial -> ()  (* wait for next chunk *)
-    in
-    seq read_chunk
-
-let to_seq seq =
-  fun k -> seq (fun b -> k (to_string b))
-

misc/bencode.mli

@@ -1,130 +0,0 @@
-(*
-Copyright (c) 2013, Simon Cruanes
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-Redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  Redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {6 B-encoding} *)
-
-(** This implements encoding and decoding using the {i B-encode} format.
-    See {{: http://en.wikipedia.org/wiki/Bencode} wikipedia} for more details
-    *)
-
-module SMap : Map.S with type key = string
-
-type t =
-  | I of int
-  | S of string
-  | L of t list
-  | D of t SMap.t
-
-val eq : t -> t -> bool
-val hash : t -> int
-
-val dict_of_list : (string * t) list -> t
-
-(** {2 Serialization (encoding)} *)
-
-val size : t -> int
-  (** Size needed for serialization *)
-
-val write_in_string : t -> string -> int -> unit
-  (** [write_in_string v buf o] writes the value [v] in  the string,
-      starting at offset [o]. The portion of the string starting from [o]
-      must be big enough (ie >= [size v]) *)
-
-val to_buf : Buffer.t -> t -> unit
-val to_string : t -> string
-val to_chan : out_channel -> t -> unit
-val fmt : Format.formatter -> t -> unit
-
-val pretty : Format.formatter -> t -> unit
-  (** Print the tree itself, not its encoding *)
-
-val pretty_to_str : t -> string
-  (** Print the tree into a string *)
-
-(** {2 Deserialization (decoding)} *)
-
-(** Deserialization is based on the {! decoder} type. Parsing can be
-    incremental, in which case the input is provided chunk by chunk and
-    the decoder contains the parsing state. Once a B-encoded value
-    has been parsed, other values can still be read.
-    
-    This implementation does accept leading zeros, because it simplifies
-    the code. *)
-
-type decoder
-  (** Decoding state *)
-
-val mk_decoder : unit -> decoder
-  (** Create a new decoder *)
-
-type parse_result =
-  | ParseOk of t
-  | ParseError of string
-  | ParsePartial
-
-val parse : decoder -> string -> int -> int -> parse_result
-  (** [parse dec s i len] uses the partial state stored in [dec] and
-      the substring of [s] starting at index [i] with length [len].
-      It can return an error, a value or just [ParsePartial] if
-      more input is needed *)
-
-val parse_resume : decoder -> parse_result
-  (** Resume where the previous call to {!parse} stopped (may have
-      returned a value while some input is not processed) *)
-
-val reset : decoder -> unit
-  (** Reset the decoder to its pristine state, ready to parse something
-      different. Before that, {! rest} and {! rest_size} can be used
-      to recover the part of the input that has not been consumed yet. *)
-
-val state : decoder -> parse_result
-  (** Current state of the decoder *)
-
-val rest : decoder -> string
-  (** What remains after parsing (the additional, unused input) *)
-
-val rest_size : decoder -> int
-  (** Length of [rest d]. 0 indicates that the whole input has been consumed. *)
-
-val parse_string : string -> parse_result
-  (** Parse a full value from this string. *)
-
-val of_string : string -> t
-  (** Parse the string. @raise Invalid_argument if it fails to parse. *)
-
-(** {2 Iterator} *)
-
-type 'a sequence = ('a -> unit) -> unit
-
-val of_seq : string sequence -> t sequence
-  (** Given a sequence of strings into Bencode values. Strings can be
-      the result of {!Unix.read}, for instance, they don't need to be
-      valid bencode individually; Only their concatenation should
-      be a valid stream of Bencode values.
-      
-      @raise Invalid_argument if a parsing error occurs. *)
-
-val to_seq : t sequence -> string sequence
-  (** Serialize each value in the sequence of Bencode values *)

misc/bencodeOnDisk.ml

@@ -1,136 +0,0 @@
-
-(*
-copyright (c) 2013, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {1 Serialize Bencode on disk with persistency guarantees}
-
-    This module provides an append-only interface to some file, with
-    synchronized access and fsync() called after every write.
-
-    It currently uses [Unix.O_SYNC] to guarantee that writes are saved to
-    the disk, so {b WRITES ARE SLOW}. On the other hand, several
-    processes can access the same file and append data without risks of
-    losing written values or race conditions.
-    
-    Similarly, reads are atomic (require locking) and provide only
-    a fold interface.
-    *)
-
-type t = {
-  file : Unix.file_descr;
-  lock_file : Unix.file_descr;
-}
-
-let open_out ?lock filename =
-  let lock = match lock with
-  | None -> filename
-  | Some l -> l
-  in
-  let lock_file = Unix.openfile lock [Unix.O_CREAT; Unix.O_WRONLY] 0o644 in
-  let file = Unix.openfile filename
-    [Unix.O_CREAT; Unix.O_APPEND; Unix.O_WRONLY; Unix.O_SYNC] 0o644
-  in
-  { file; lock_file; }
-
-let close_out out =
-  Unix.close out.file
-
-let write_string out s =
-  Unix.lockf out.lock_file Unix.F_LOCK 0;
-  try
-    (* go to the end of the file *)
-    ignore (Unix.lseek out.file 0 Unix.SEEK_END);
-    (* call write() until everything is written *)
-    let rec write_all n =
-      if n >= String.length s
-        then ()
-        else
-          let n' = n + Unix.write out.file s n (String.length s - n) in
-          write_all n'
-    in
-    write_all 0;
-    Unix.lockf out.lock_file Unix.F_ULOCK 0;
-  with e ->
-    (* unlock in any case *)
-    Unix.lockf out.lock_file Unix.F_ULOCK 0;
-    raise e
-
-let write out b =
-  let s = Bencode.to_string b in
-  write_string out s
-
-let write_batch out l =
-  let buf = Buffer.create 255 in
-  List.iter (fun b -> Bencode.to_buf buf b) l;
-  let s = Buffer.contents buf in
-  write_string out s
-
-type 'a result =
-  | Ok of 'a
-  | Error of string
-
-let read ?lock filename acc f =
-  let lock = match lock with
-  | None -> filename
-  | Some l -> l
-  in
-  (* lock file before reading, to observe a consistent state *)
-  let lock_file = Unix.openfile lock [Unix.O_CREAT; Unix.O_RDONLY] 0o644 in
-  Unix.lockf lock_file Unix.F_RLOCK 0;
-  try
-    let file = Unix.openfile filename [Unix.O_RDONLY] 0o644 in
-    (* read bencode values *)
-    let decoder = Bencode.mk_decoder () in
-    let len = 256 in
-    let buf = String.create len in
-    (* read a chunk of input and parse it *)
-    let rec next_val acc =
-      let n = Unix.read file buf 0 len in
-      if n = 0
-        then Ok acc  (* finished *)
-        else match Bencode.parse decoder buf 0 n with
-          | Bencode.ParseOk v ->
-            let acc = f acc v in
-            resume acc
-          | Bencode.ParseError e -> Error e
-          | Bencode.ParsePartial -> next_val acc
-    (* consume what remains of input *)
-    and resume acc = match Bencode.parse_resume decoder with
-      | Bencode.ParseOk v ->
-        let acc = f acc v in
-        resume acc
-      | Bencode.ParseError e -> Error e
-      | Bencode.ParsePartial -> next_val acc
-    in
-    let res = next_val acc in
-    (* cleanup *)
-    Unix.close file;
-    Unix.lockf lock_file Unix.F_ULOCK 0;
-    Unix.close lock_file;
-    res
-  with e ->
-    Unix.lockf lock_file Unix.F_ULOCK 0;
-    Unix.close lock_file;
-    raise e

misc/bencodeStream.ml

@@ -1,156 +0,0 @@
-
-(*
-copyright (c) 2014, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {1 Full-Streaming API of Bencode} *)
-
-type token =
-  | Int of int
-  | String of string
-  | BeginDict
-  | BeginList
-  | End
-
-module Encode = struct
-  type sink =
-    [ `File of string
-    | `Out of out_channel
-    | `Buf of Buffer.t
-    ]
-
-  type t = {
-    write_string : string -> unit;
-    write_char : char -> unit;
-    on_close : unit -> unit;
-  }
-  
-  let nop() = ()
-
-  let create = function
-    | `Out o ->
-        { write_string=output_string o
-        ; write_char=output_char o
-        ; on_close = nop
-        }
-    | `File f ->
-        let o = open_out f in
-        { write_string=output_string o
-        ; write_char=output_char o
-        ; on_close = (fun () -> close_out o)
-        }
-    | `Buf b ->
-        { write_string=Buffer.add_string b
-        ; write_char=Buffer.add_char b
-        ; on_close =nop
-        }
-
-    let push out tok = match tok with
-      | Int i ->
-          out.write_char 'i';
-          out.write_string (string_of_int i);
-          out.write_char 'e'
-      | String s ->
-          out.write_string (string_of_int (String.length s));
-          out.write_char ':';
-          out.write_string s
-      | BeginDict ->
-          out.write_char 'd'
-      | End ->
-          out.write_char 'e'
-      | BeginList ->
-          out.write_char 'l'
-end
-
-module Decode = struct
-  type result =
-    | Yield of token
-    | Error of string
-    | Await  (** The user needs to call {!feed} with some input *)
-
-  type state =
-    | Start
-    | ParsingInt of int
-    | ParsingString of string
-
-  type t = {
-    mutable buf : string;  (* buffer *)
-    mutable i : int;  (* index in buf *)
-    mutable len : int;  (* length of substring to read *)
-    mutable c : int;  (* line *)
-    mutable l : int;  (* column *)
-    mutable state : state;
-  }
-
-  let create () = {
-    buf = "";
-    i = 0;
-    len = 0;
-    c = 0;
-    l = 0;
-    state = Start;
-  }
-
-  let is_empty dec = dec.len = 0
-  let cur dec = dec.buf.[dec.i]
-
-  let junk dec =
-    (* update line/column *)
-    (if cur dec = '\n'
-      then (dec.c <- 0; dec.l <- dec.l + 1)
-      else dec.c <- dec.c + 1);
-    dec.i <- dec.i + 1;
-    dec.len <- dec.len - 1
-
-  let next dec =
-    let c = cur dec in
-    junk dec;
-    c
-
-  (*
-  (* parse value *)
-  let rec parse_rec dec =
-    if is_empty dec then Await (* wait *)
-    else begin
-      let c = next dec in
-      match dec.state, c with
-      | Start, 'l' ->
-          Yield StartList
-      | Start, 'd' ->
-          Yield StartDict
-      | Start, 'e' ->
-          Yield End
-      | Start, 'i' ->
-          dec.state <- ParsingInt 0
-      | ParsingString i, 'e' ->
-          dec.state <- Start;
-          Yield (Int i)
-      | 
-  *)
-
-  let feed dec = assert false
-
-  let next dec = assert false
-end
-

misc/bencode_write_par.sh

@@ -1,13 +0,0 @@
-#!/bin/sh
-
-# call n instances of ./bencode_write.native on the same file
-
-N=$1
-FILE=$2
-
-echo "call script $N times on file $FILE"
-for i in `seq $N` ; do
-    ./bencode_write.native "$FILE" &
-done
-
-wait

misc/bij.ml

@@ -105,139 +105,3 @@ let hashtbl ma mb =
       List.iter (fun (k,v) -> Hashtbl.add h k v) l;
       h)
     (list_ (pair ma mb))
-
-(** {2 Translations} *)
-
-module TrBencode = struct
-  module B = Bencode
-
-  let rec encode: type a. bij:a t -> a -> B.t =
-  fun ~bij x -> match bij, x with
-  | Unit, () -> B.I 0
-  | String, s -> B.S s
-  | Int, i -> B.I i
-  | Float, f -> B.S (string_of_float f)
-  | Bool, b -> B.I (if b then 1 else 0)
-  | List bij', l ->
-    let l' = List.map (fun x -> encode ~bij:bij' x) l in
-    B.L l'
-  | Many bij', [] -> raise (EncodingError "many: got empty list")
-  | Many bij', l -> 
-    let l' = List.map (fun x -> encode ~bij:bij' x) l in
-    B.L l'
-  | Opt bij', None -> B.L []
-  | Opt bij', Some x -> B.L [encode ~bij:bij' x]
-  | Pair (bija, bijb), (a, b) ->
-    B.L [encode ~bij:bija a; encode ~bij:bijb b]
-  | Triple (bija, bijb, bijc), (a, b, c) ->
-    B.L [encode ~bij:bija a; encode ~bij:bijb b; encode ~bij:bijc c]
-  | Quad (bija, bijb, bijc, bijd), (a, b, c, d) ->
-    B.L [encode ~bij:bija a; encode ~bij:bijb b;
-         encode ~bij:bijc c; encode ~bij:bijd d]
-  | Quint (bija, bijb, bijc, bijd, bije), (a, b, c, d, e) ->
-    B.L [encode ~bij:bija a; encode ~bij:bijb b;
-         encode ~bij:bijc c; encode ~bij:bijd d;
-         encode ~bij:bije e]
-  | Guard (check, bij'), x ->
-    if not (check x) then raise (EncodingError "check failed");
-    encode ~bij:bij' x
-  | Map (inject, _, bij'), x ->
-    encode ~bij:bij' (inject x)
-  | Switch (inject, _), x ->
-    let key, BranchTo (bij',y) = inject x in
-    B.D (B.SMap.singleton key (encode ~bij:bij' y))
-  
-  let rec decode: type a. bij:a t -> B.t -> a
-  = fun ~bij b -> match bij, b with
-  | Unit, B.I 0 -> ()
-  | String, B.S s -> s
-  | Int, B.I i -> i
-  | Float, B.S s ->
-    begin try
-      let f = float_of_string s in
-      f
-    with Failure _ ->
-      raise (DecodingError "expected float")
-    end
-  | Bool, B.I 0 -> false
-  | Bool, B.I _ -> true
-  | List bij', B.L l ->
-    List.map (fun b -> decode ~bij:bij' b) l
-  | Many bij', B.L [] ->
-    raise (DecodingError "expected nonempty list")
-  | Many bij', B.L l ->
-    List.map (fun b -> decode ~bij:bij' b) l
-  | Opt bij', B.L [] -> None
-  | Opt bij', B.L [x] -> Some (decode ~bij:bij' x)
-  | Opt bij', B.L _ ->
-    raise (DecodingError "expected [] or [_]")
-  | Pair (bija, bijb), B.L [a; b] ->
-    decode ~bij:bija a, decode ~bij:bijb b
-  | Triple (bija, bijb, bijc), B.L [a; b; c] ->
-    decode ~bij:bija a, decode ~bij:bijb b, decode ~bij:bijc c
-  | Quad (bija, bijb, bijc, bijd), B.L [a; b; c; d] ->
-    decode ~bij:bija a, decode ~bij:bijb b,
-    decode ~bij:bijc c, decode ~bij:bijd d
-  | Quint (bija, bijb, bijc, bijd, bije), B.L [a; b; c; d; e] ->
-    decode ~bij:bija a, decode ~bij:bijb b,
-    decode ~bij:bijc c, decode ~bij:bijd d,
-    decode ~bij:bije e
-  | Guard (check, bij'), x ->
-    let y = decode ~bij:bij' x in
-    if not (check y) then raise (DecodingError "check failed");
-    y
-  | Map (_, extract, bij'), b ->
-    let x = decode ~bij:bij' b in
-    extract x
-  | Switch (_, extract), B.D d when B.SMap.cardinal d = 1 ->
-    let key, value = B.SMap.choose d in
-    let BranchFrom (bij', convert) = extract key in
-    convert (decode ~bij:bij' value)
-  | _ -> raise (DecodingError "bad case")
-
-  let to_string ~bij x = B.to_string (encode ~bij x)
-
-  let of_string ~bij s =
-    let b = B.of_string s in
-    decode ~bij b
-
-  let read ~bij ic =
-    let d = B.mk_decoder () in
-    let buf = String.create 256 in
-    let rec read_chunk() =
-      let n = input ic buf 0 (String.length buf) in
-      if n = 0
-        then raise (DecodingError "unexpected EOF")
-        else match B.parse d buf 0 n with
-          | B.ParsePartial -> read_chunk()
-          | B.ParseError s -> raise (DecodingError s)
-          | B.ParseOk b -> decode ~bij b
-    in
-    read_chunk()
-
-  let read_stream ~bij ic =
-    let d = B.mk_decoder () in
-    let buf = String.create 256 in
-    let rec try_parse n = match B.parse d buf 0 n with
-      | B.ParsePartial -> read_chunk()
-      | B.ParseError s -> raise (DecodingError s)
-      | B.ParseOk b -> Some (decode ~bij b)
-    and read_chunk() =
-      let n = input ic buf 0 (String.length buf) in
-      if n = 0
-        then match B.parse_resume d with
-        | B.ParsePartial -> None
-        | B.ParseError s -> raise (DecodingError s)
-        | B.ParseOk b -> Some (decode ~bij b)
-        else try_parse n
-    in
-    Stream.from (fun _ -> read_chunk())
-
-  let write ~bij oc x =
-    let b = encode ~bij x in
-    B.to_chan oc b;
-    flush oc
-
-  let write_stream ~bij oc str =
-    Stream.iter (fun x -> write ~bij oc x) str
-end

misc/bij.mli

@@ -163,25 +163,3 @@ exception EncodingError of string
 
 exception DecodingError of string
   (** Raised when decoding is impossible *)
-
-(** {2 Translations} *)
-
-module TrBencode : sig
-  val encode : bij:'a t -> 'a -> Bencode.t
-
-  val decode : bij:'a t -> Bencode.t -> 'a
-
-  val to_string : bij:'a t -> 'a -> string
-
-  val of_string : bij:'a t -> string -> 'a
-
-  val read : bij:'a t -> in_channel -> 'a
-    (** Read a single value from the channel *)
-
-  val read_stream : bij:'a t -> in_channel -> 'a Stream.t
-
-  val write : bij:'a t -> out_channel -> 'a -> unit
-
-  val write_stream : bij:'a t -> out_channel -> 'a Stream.t -> unit
-end
-

misc/containers_misc.mlpack

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 9851db0fe3105f1a9f67c941d62c467a)
+# DO NOT EDIT (digest: 77c9e2e3233437cee692be334bdaa224)
 Cache
 FHashtbl
 FlatHashtbl
@@ -14,14 +14,11 @@ SplayMap
 Univ
 Bij
 PiCalculus
-Bencode
 RAL
 UnionFind
 SmallSet
 AbsSet
 CSM
-ActionMan
-BencodeOnDisk
 TTree
 PrintBox
 HGraph
@@ -31,9 +28,6 @@ Bidir
 Iteratee
 BTree
 Ty
-Tell
-BencodeStream
-RatTerm
 Cause
 AVL
 ParseReact

misc/json.ml

@@ -79,7 +79,6 @@ let parse chars =
           read_list (t::acc)  (* next *)
         | Some (Genlex.Kwd "]") ->
           read_list (t::acc)  (* next *)
-        | Some (Genlex.Kwd "]") -> List.rev acc  (* yield *)
         | _ -> raise (Stream.Error "expected ','"))
   and read_pairs acc =
     match peek tokens with
@@ -163,7 +162,8 @@ let rec pp fmt t =
 
 let to_string t =
   let buf = Buffer.create 16 in
-  Format.bprintf buf "%a@?" pp t;
+  let fmt = Format.formatter_of_buffer buf in
+  Format.fprintf fmt "%a@?" pp t;
   Buffer.contents buf
 
 (** {2 Utils *)

misc/printBox.ml

@@ -36,7 +36,7 @@ let _minus pos1 pos2 = _move pos1 (- pos2.x) (- pos2.y)
 let _move_x pos x = _move pos x 0
 let _move_y pos y = _move pos 0 y
 
-let _string_len = ref String.length
+let _string_len = ref Bytes.length
 
 let set_string_len f = _string_len := f
 
@@ -61,11 +61,11 @@ module Output = struct
     mutable buf_len : int;
   }
   and buf_line = {
-    mutable bl_str : string;
+    mutable bl_str : Bytes.t;
     mutable bl_len : int;
   }
 
-  let _make_line _ = {bl_str=""; bl_len=0}
+  let _make_line _ = {bl_str=Bytes.empty; bl_len=0}
 
   let _ensure_lines buf i =
     if i >= Array.length buf.buf_lines
@@ -78,8 +78,8 @@ module Output = struct
   let _ensure_line line i =
     if i >= !_string_len line.bl_str
     then (
-      let str' = String.make (2 * i + 5) ' ' in
+      let str' = Bytes.make (2 * i + 5) ' ' in
-      String.blit line.bl_str 0 str' 0 line.bl_len;
+      Bytes.blit line.bl_str 0 str' 0 line.bl_len;
       line.bl_str <- str';
     )
 
@@ -88,7 +88,7 @@ module Output = struct
     _ensure_line buf.buf_lines.(pos.y) pos.x;
     buf.buf_len <- max buf.buf_len (pos.y+1);
     let line = buf.buf_lines.(pos.y) in
-    line.bl_str.[pos.x] <- c;
+    Bytes.set line.bl_str pos.x c;
     line.bl_len <- max line.bl_len (pos.x+1)
 
   let _buf_put_sub_string buf pos s s_i s_len =
@@ -100,7 +100,7 @@ module Output = struct
     line.bl_len <- max line.bl_len (pos.x+s_len)
 
   let _buf_put_string buf pos s =
-    _buf_put_sub_string buf pos s 0 (!_string_len s)
+    _buf_put_sub_string buf pos s 0 (!_string_len (Bytes.unsafe_of_string s))
 
   (* create a new buffer *)
   let make_buffer () =
@@ -121,7 +121,7 @@ module Output = struct
     for i = 0 to buf.buf_len - 1 do
       for k = 1 to indent do Buffer.add_char buffer ' ' done;
       let line = buf.buf_lines.(i) in
-      Buffer.add_substring buffer line.bl_str 0 line.bl_len;
+      Buffer.add_substring buffer (Bytes.unsafe_to_string line.bl_str) 0 line.bl_len;
       Buffer.add_char buffer '\n';
     done;
     Buffer.contents buffer
@@ -238,7 +238,7 @@ module Box = struct
     | Empty -> origin
     | Text l ->
         let width = List.fold_left
-          (fun acc line -> max acc (!_string_len line)) 0 l
+          (fun acc line -> max acc (!_string_len (Bytes.unsafe_of_string line))) 0 l
         in
         { x=width; y=List.length l; }
     | Frame t ->
@@ -337,7 +337,7 @@ let tree ?(indent=1) node children =
   let children =
     List.filter
     (function
-      | {Box.shape=Box.Empty} -> false
+      | {Box.shape=Box.Empty; _} -> false
       | _ -> true
     ) children
   in
@@ -384,10 +384,10 @@ let rec _render ?(offset=origin) ?expected_size ~out b pos =
         Output.put_char out (_move pos (x+1) (y+1)) '+';
         Output.put_char out (_move pos 0 (y+1)) '+';
         Output.put_char out (_move pos (x+1) 0) '+';
-        _write_hline out (_move_x pos 1) x;
+        _write_hline ~out (_move_x pos 1) x;
-        _write_hline out (_move pos 1 (y+1)) x;
+        _write_hline ~out (_move pos 1 (y+1)) x;
-        _write_vline out (_move_y pos 1) y;
+        _write_vline ~out (_move_y pos 1) y;
-        _write_vline out (_move pos (x+1) 1) y;
+        _write_vline ~out (_move pos (x+1) 1) y;
         _render ~out b' (_move pos 1 1)
     | Box.Pad (dim, b') ->
         let expected_size = Box.size b in

misc/printBox.mli

@@ -72,7 +72,7 @@ we go toward the bottom (same order as a printer) *)
 val origin : position
 (** Initial position *)
 
-val set_string_len : (string -> int) -> unit
+val set_string_len : (Bytes.t -> int) -> unit
 (** Set which function is used to compute string length. Typically
     to be used with a unicode-sensitive length function *)
 

misc/tell.ml

@@ -1,111 +0,0 @@
-
-(*
-copyright (c) 2014, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {1 Hierarchic logging} *)
-
-module BS = BencodeStream
-
-type t = {
-  name : string;
-  out : out_channel;
-  encoder : BS.Encode.t;
-  cleanup : bool;
-  mutable context : string list;
-}
-
-let __new_name =
-  let r = ref 0 in
-  fun () ->
-    let name = Printf.sprintf "Tell.log_%d" !r in
-    incr r;
-    name
-
-let to_chan ?(cleanup=false) o = {
-  name = __new_name ();
-  out = o;
-  encoder = BS.Encode.create (`Out o);
-  cleanup;
-  context = [];
-}
-
-let to_file filename =
-  let o = open_out filename in
-  to_chan ~cleanup:true o
-
-let close log =
-  if log.cleanup
-    then close_out log.out
-
-let step log msg =
-  BS.Encode.push log.encoder BS.BeginDict;
-  BS.Encode.push log.encoder (BS.String "step");
-  BS.Encode.push log.encoder (BS.String msg);
-  BS.Encode.push log.encoder BS.End
-  
-let enter log =
-  BS.Encode.push log.encoder BS.BeginList
-
-let exit log =
-  BS.Encode.push log.encoder BS.End
-
-let within ~log f =
-  BS.Encode.push log.encoder BS.BeginDict;
-  BS.Encode.push log.encoder (BS.String "section");
-  try
-    let x = f () in
-    BS.Encode.push log.encoder BS.End;
-    x
-  with e ->
-    BS.Encode.push log.encoder BS.End;
-    raise e
-
-module B = struct
-  let step ~log format =
-    exit log;
-    let b = Buffer.create 24 in
-    Printf.kbprintf
-      (fun b ->
-        BS.Encode.push log.encoder (BS.String (Buffer.contents b)))
-      b format
-
-  let enter ~log format =
-    let b = Buffer.create 24 in
-    let x = Printf.kbprintf
-      (fun b ->
-        BS.Encode.push log.encoder (BS.String (Buffer.contents b)))
-      b format
-    in
-    enter log;
-    x
-
-  let exit ~log format =
-    exit log;
-    let b = Buffer.create 24 in
-    Printf.kbprintf
-      (fun b ->
-        BS.Encode.push log.encoder (BS.String (Buffer.contents b)))
-      b format
-end

misc/tell.mli

@@ -1,73 +0,0 @@
-
-(*
-copyright (c) 2014, simon cruanes
-all rights reserved.
-
-redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
-form must reproduce the above copyright notice, this list of conditions and the
-following disclaimer in the documentation and/or other materials provided with
-the distribution.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*)
-
-(** {1 Hierarchic logging} *)
-
-type t
-
-val to_file : string -> t
-(** Create a logger that outputs to the given file *)
-
-val to_chan : ?cleanup:bool -> out_channel -> t
-(** Obtain a logger that outputs to the given channel.
-    @param cleanup if true, will close the channel on exit;
-    if false or not explicited, won't do anything. *)
-
-(** {2 Raw functions} *)
-
-val step : t -> string -> unit
-
-val close : t -> unit
-(** Close the logger. It will be unusable afterwards. *)
-
-(** {2 Hierarchy} *)
-
-val enter : t -> unit
-(** Enter a new subsection *)
-
-val exit : t -> unit
-(** Exit the current subsection *)
-
-val within : log:t -> (unit -> 'a) -> 'a
-(** Enter a new subsection, evaluate the given function,
-    exit the subsection and return the function's result.
-    Also protects against exceptions. *)
-
-(** {2 Buffer-formatting output}
-The following functions use a {!Buffer.t} to create the message,
-then send it to their logger. *)
-
-module B : sig
-  val enter : log:t -> ('a, Buffer.t, unit, unit) format4 -> 'a
-  (** Enter a new (sub-)section with the given message *)
-
-  val exit : log:t -> ('a, Buffer.t, unit, unit) format4 -> 'a
-  (** Exit (close) the current sub-section. *)
-
-  val step : log:t -> ('a, Buffer.t, unit, unit) format4 -> 'a
-  (** Unit step within the current section *)
-end
-

myocamlbuild.ml

@@ -1,5 +1,5 @@
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 2ec2194dcebadfa4593677936942ece3) *)
+(* DO NOT EDIT (digest: 533979157febab9fa15b0b406be9633e) *)
 module OASISGettext = struct
 (* # 22 "src/oasis/OASISGettext.ml" *)
 
@@ -249,6 +249,9 @@ module MyOCamlbuildFindlib = struct
     *)
   open Ocamlbuild_plugin
 
+  type conf =
+    { no_automatic_syntax: bool;
+    }
 
   (* these functions are not really officially exported *)
   let run_and_read =
@@ -315,7 +318,7 @@ module MyOCamlbuildFindlib = struct
 
   (* This lists all supported packages. *)
   let find_packages () =
-    List.map before_space (split_nl & run_and_read "ocamlfind list")
+    List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list"))
 
 
   (* Mock to list available syntaxes. *)
@@ -338,7 +341,7 @@ module MyOCamlbuildFindlib = struct
   ]
 
 
-  let dispatch =
+  let dispatch conf =
     function
       | After_options ->
           (* By using Before_options one let command line options have an higher
@@ -357,31 +360,39 @@ module MyOCamlbuildFindlib = struct
            * -linkpkg *)
           flag ["ocaml"; "link"; "program"] & A"-linkpkg";
 
-          (* For each ocamlfind package one inject the -package option when
+          if not (conf.no_automatic_syntax) then begin
-           * compiling, computing dependencies, generating documentation and
+            (* For each ocamlfind package one inject the -package option when
-           * linking. *)
+             * compiling, computing dependencies, generating documentation and
-          List.iter
+             * linking. *)
-            begin fun pkg ->
+            List.iter
-              let base_args = [A"-package"; A pkg] in
+              begin fun pkg ->
-              (* TODO: consider how to really choose camlp4o or camlp4r. *)
+                let base_args = [A"-package"; A pkg] in
-              let syn_args = [A"-syntax"; A "camlp4o"] in
+                (* TODO: consider how to really choose camlp4o or camlp4r. *)
-              let args =
+                let syn_args = [A"-syntax"; A "camlp4o"] in
-              (* Heuristic to identify syntax extensions: whether they end in
+                let (args, pargs) =
-                 ".syntax"; some might not.
+                  (* Heuristic to identify syntax extensions: whether they end in
-               *)
+                     ".syntax"; some might not.
-                if Filename.check_suffix pkg "syntax" ||
+                  *)
-                   List.mem pkg well_known_syntax then
+                  if Filename.check_suffix pkg "syntax" ||
-                  syn_args @ base_args
+                     List.mem pkg well_known_syntax then
-                else
+                    (syn_args @ base_args, syn_args)
-                  base_args
+                  else
-              in
+                    (base_args, [])
-              flag ["ocaml"; "compile";  "pkg_"^pkg] & S args;
+                in
-              flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
+                flag ["ocaml"; "compile";  "pkg_"^pkg] & S args;
-              flag ["ocaml"; "doc";      "pkg_"^pkg] & S args;
+                flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
-              flag ["ocaml"; "link";     "pkg_"^pkg] & S base_args;
+                flag ["ocaml"; "doc";      "pkg_"^pkg] & S args;
-              flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
+                flag ["ocaml"; "link";     "pkg_"^pkg] & S base_args;
-            end
+                flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
-            (find_packages ());
+
+                (* TODO: Check if this is allowed for OCaml < 3.12.1 *)
+                flag ["ocaml"; "compile";  "package("^pkg^")"] & S pargs;
+                flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs;
+                flag ["ocaml"; "doc";      "package("^pkg^")"] & S pargs;
+                flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs;
+              end
+              (find_packages ());
+          end;
 
           (* Like -package but for extensions syntax. Morover -syntax is useless
            * when linking. *)
@@ -546,12 +557,13 @@ module MyOCamlbuildBase = struct
 
                    (* When ocaml link something that use the C library, then one
                       need that file to be up to date.
+                      This holds both for programs and for libraries.
                     *)
-                   dep ["link"; "ocaml"; "program"; tag_libstubs lib]
+  		 dep ["link"; "ocaml"; tag_libstubs lib]
-                     [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
+  		     [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
 
-                   dep  ["compile"; "ocaml"; "program"; tag_libstubs lib]
+  		 dep  ["compile"; "ocaml"; tag_libstubs lib]
-                     [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
+  		      [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
 
                    (* TODO: be more specific about what depends on headers *)
                    (* Depends on .h files *)
@@ -580,18 +592,18 @@ module MyOCamlbuildBase = struct
             ()
 
 
-  let dispatch_default t =
+  let dispatch_default conf t =
     dispatch_combine
       [
         dispatch t;
-        MyOCamlbuildFindlib.dispatch;
+        MyOCamlbuildFindlib.dispatch conf;
       ]
 
 
 end
 
 
-# 594 "myocamlbuild.ml"
+# 606 "myocamlbuild.ml"
 open Ocamlbuild_plugin;;
 let package_default =
   {
@@ -613,6 +625,7 @@ let package_default =
           ("threads", ["core"]);
           ("tests/lwt", ["core"; "lwt"]);
           ("tests", ["core"; "misc"; "string"]);
+          ("qtest", ["core"; "misc"; "string"]);
           ("pervasives", ["core"]);
           ("misc", ["core"]);
           ("lwt", ["core"; "misc"]);
@@ -625,8 +638,54 @@ let package_default =
   }
   ;;
 
-let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;;
+let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
 
-# 631 "myocamlbuild.ml"
+let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
+
+# 646 "myocamlbuild.ml"
 (* OASIS_STOP *)
 Ocamlbuild_plugin.dispatch dispatch_default;;
+
+dispatch
+  (MyOCamlbuildBase.dispatch_combine [
+    begin function
+    | After_rules ->
+      (* replace with Ocamlbuild_cppo.dispatch when 4.00 is not supported
+         anymore *)
+      let dep = "%(name).cppo.ml" in
+      let prod1 = "%(name: <*> and not <*.cppo>).ml" in
+      let prod2 = "%(name: <**/*> and not <**/*.cppo>).ml" in
+      let f prod env _build =
+        let dep = env dep in
+        let prod = env prod in
+        let tags = tags_of_pathname prod ++ "cppo" in
+        Cmd (S[A "cppo"; T tags; S [A "-o"; P prod]; P dep ])
+      in
+      rule "cppo1" ~dep ~prod:prod1 (f prod1) ;
+      rule "cppo2" ~dep ~prod:prod2 (f prod2) ;
+      pflag ["cppo"] "cppo_D" (fun s -> S [A "-D"; A s]) ;
+      pflag ["cppo"] "cppo_U" (fun s -> S [A "-U"; A s]) ;
+      pflag ["cppo"] "cppo_I" (fun s ->
+        if Pathname.is_directory s then S [A "-I"; P s]
+        else S [A "-I"; P (Pathname.dirname s)]
+      ) ;
+      pdep ["cppo"] "cppo_I" (fun s ->
+        if Pathname.is_directory s then [] else [s]) ;
+      flag ["cppo"; "cppo_q"] (A "-q") ;
+      flag ["cppo"; "cppo_s"] (A "-s") ;
+      flag ["cppo"; "cppo_n"] (A "-n") ;
+      pflag ["cppo"] "cppo_x" (fun s -> S [A "-x"; A s]);
+      (* end replace *)
+
+      let major, minor = Scanf.sscanf Sys.ocaml_version "%d.%d.%d"
+        (fun major minor patchlevel -> major, minor)
+      in
+      let ocaml_major = "OCAML_MAJOR " ^ string_of_int major in
+      let ocaml_minor = "OCAML_MINOR " ^ string_of_int minor in
+
+      flag ["cppo"] & S[A"-D"; A ocaml_major; A"-D"; A ocaml_minor]
+    | _ -> ()
+    end;
+    dispatch_default
+  ])
+

pervasives/CCPervasives.ml

@@ -35,6 +35,11 @@ This module is meant to be opened if one doesn't want to use both, say,
 ]}
 
 @since 0.4
+
+Changed [Opt] to [Option] to better reflect that this module is about the
+['a option] type, with [module Option = CCOpt].
+
+@since NEXT_RELEASE
 *)
 
 module Array = struct include Array include CCArray end
@@ -43,7 +48,7 @@ module Error = CCError
 module Fun = CCFun
 module Int = CCInt
 module List = struct include List include CCList end
-module Opt = CCOpt
+module Option = CCOpt
 module Pair = CCPair
 module String = struct include String include CCString end
 module Vector = CCVector

sequence/.merlin

@@ -6,3 +6,4 @@ B _build/tests/
 B _build/bench/
 PKG oUnit
 PKG benchmark
+FLAG -safe-string

sequence/.ocamlinit

@@ -1,5 +1,9 @@
 #directory "_build";;
 #load "sequence.cma";;
+
 open Sequence.Infix;;
-(* vim:syntax=ocaml
+
-*)
+#directory "_build/bigarray/";;
+#load "bigarray.cma";;
+
+(* vim:syntax=ocaml *)

sequence/CHANGELOG.md

@@ -1,5 +1,11 @@
 # Changelog
 
+## 0.5.4
+
+- depend on `bytes`
+- compliance with `-safe-string`
+- `sequence.bigarray`
+
 ## 0.5.3
 
 - bugfix: interaction between `take` and `is_empty`
@@ -76,4 +82,4 @@
 - `zip`, `unzip` and `zip_i` to convert between `t` and `t2`
 - added `scan` combinator
 
-note: git log --no-merges previous_version..HEAD --pretty=%s
+note: git log --no-merges --pretty=%s previous_version..HEAD

sequence/META

@@ -1,14 +1,15 @@
 # OASIS_START
-# DO NOT EDIT (digest: 99194977427ba82f5912e81125f6cac0)
+# DO NOT EDIT (digest: 0c501104bbf1dfc40db58200fdbfdd57)
-version = "0.5.3"
+version = "0.5.4"
 description = "Simple sequence (iterator) datatype and combinators"
+requires = "bytes"
 archive(byte) = "sequence.cma"
 archive(byte, plugin) = "sequence.cma"
 archive(native) = "sequence.cmxa"
 archive(native, plugin) = "sequence.cmxs"
 exists_if = "sequence.cma"
 package "invert" (
- version = "0.5.3"
+ version = "0.5.4"
  description = "Simple sequence (iterator) datatype and combinators"
  requires = "sequence delimcc"
  archive(byte) = "invert.cma"
@@ -17,5 +18,16 @@ package "invert" (
  archive(native, plugin) = "invert.cmxs"
  exists_if = "invert.cma"
 )
+
+package "bigarray" (
+ version = "0.5.4"
+ description = "Simple sequence (iterator) datatype and combinators"
+ requires = "sequence bigarray"
+ archive(byte) = "bigarray.cma"
+ archive(byte, plugin) = "bigarray.cma"
+ archive(native) = "bigarray.cmxa"
+ archive(native, plugin) = "bigarray.cmxs"
+ exists_if = "bigarray.cma"
+)
 # OASIS_STOP
 

sequence/Makefile

@@ -59,9 +59,11 @@ push_stable: all
 
 VERSION=$(shell awk '/^Version:/ {print $$2}' _oasis)
 
+SOURCE=*.ml *.mli invert/*.ml invert/*.mli bigarray/*.ml bigarray/*.mli
+
 update_next_tag:
 	@echo "update version to $(VERSION)..."
-	sed -i "s/NEXT_VERSION/$(VERSION)/g" *.ml *.mli
+	sed -i "s/NEXT_VERSION/$(VERSION)/g" $(SOURCE)
-	sed -i "s/NEXT_RELEASE/$(VERSION)/g" *.ml *.mli
+	sed -i "s/NEXT_RELEASE/$(VERSION)/g" $(SOURCE)
 
 .PHONY: benchs tests examples update_next_tag push_doc push_stable

sequence/_oasis

@@ -1,6 +1,6 @@
 OASISFormat: 0.4
 Name:        sequence
-Version:     0.5.3
+Version:     0.5.4
 Homepage:    https://github.com/c-cube/sequence
 Authors:     Simon Cruanes
 License:     BSD-2-clause
@@ -23,9 +23,14 @@ Flag invert
     Description: build sequence.invert (requires Delimcc)
     Default: false
 
+Flag bigarray
+    Description: build sequence.bigarray (requires bigarray)
+    Default: true
+
 Library "sequence"
   Path:             .
   Modules:          Sequence
+  BuildDepends:     bytes
 
 Library "invert"
   Path:             invert
@@ -36,6 +41,15 @@ Library "invert"
   FindlibParent:    sequence
   BuildDepends:     sequence,delimcc
 
+Library "bigarray"
+  Path:             bigarray
+  Build$:           flag(bigarray)
+  Install$:         flag(bigarray)
+  Modules:          SequenceBigarray
+  FindlibName:      bigarray
+  FindlibParent:    sequence
+  BuildDepends:     sequence,bigarray
+
 Document sequence
   Title:                Sequence docs
   Type:                 ocamlbuild (0.3)

sequence/_tags

@@ -1,8 +1,9 @@
 # OASIS_START
-# DO NOT EDIT (digest: e8d5fe31ff471d3c0ec54943fe50d011)
+# DO NOT EDIT (digest: 29e0c9fc65daf16caa16466d6ff32bac)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
+true: annot, bin_annot
 <**/.svn>: -traverse
 <**/.svn>: not_hygienic
 ".bzr": -traverse
@@ -15,25 +16,38 @@
 "_darcs": not_hygienic
 # Library sequence
 "sequence.cmxs": use_sequence
+<*.ml{,i,y}>: pkg_bytes
 # Library invert
 "invert/invert.cmxs": use_invert
-<invert/*.ml{,i}>: pkg_delimcc
+<invert/*.ml{,i,y}>: pkg_bytes
-<invert/*.ml{,i}>: use_sequence
+<invert/*.ml{,i,y}>: pkg_delimcc
+<invert/*.ml{,i,y}>: use_sequence
+# Library bigarray
+"bigarray/bigarray.cmxs": use_bigarray
+<bigarray/*.ml{,i,y}>: pkg_bigarray
+<bigarray/*.ml{,i,y}>: pkg_bytes
+<bigarray/*.ml{,i,y}>: use_sequence
 # Executable run_tests
+"tests/run_tests.native": pkg_bytes
 "tests/run_tests.native": pkg_oUnit
 "tests/run_tests.native": use_sequence
-<tests/*.ml{,i}>: pkg_oUnit
+<tests/*.ml{,i,y}>: pkg_bytes
-<tests/*.ml{,i}>: use_sequence
+<tests/*.ml{,i,y}>: pkg_oUnit
+<tests/*.ml{,i,y}>: use_sequence
 # Executable benchs
 "bench/benchs.native": pkg_benchmark
+"bench/benchs.native": pkg_bytes
 "bench/benchs.native": use_sequence
 # Executable bench_persistent
 "bench/bench_persistent.native": pkg_benchmark
+"bench/bench_persistent.native": pkg_bytes
 "bench/bench_persistent.native": use_sequence
 # Executable bench_persistent_read
 "bench/bench_persistent_read.native": pkg_benchmark
+"bench/bench_persistent_read.native": pkg_bytes
 "bench/bench_persistent_read.native": use_sequence
-<bench/*.ml{,i}>: pkg_benchmark
+<bench/*.ml{,i,y}>: pkg_benchmark
-<bench/*.ml{,i}>: use_sequence
+<bench/*.ml{,i,y}>: pkg_bytes
+<bench/*.ml{,i,y}>: use_sequence
 # OASIS_STOP
 true: bin_annot

sequence/bigarray/bigarray.mldylib

@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: dca476c3b57e859aa3b1c75ec0959ed9)
+SequenceBigarray
+# OASIS_STOP

sequence/bigarray/bigarray.mllib

@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: dca476c3b57e859aa3b1c75ec0959ed9)
+SequenceBigarray
+# OASIS_STOP

sequence/bigarray/sequenceBigarray.ml

@@ -0,0 +1,45 @@
+(*
+Copyright (c) 2014, Simon Cruanes
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+Redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.  Redistributions in binary
+form must reproduce the above copyright notice, this list of conditions and the
+following disclaimer in the documentation and/or other materials provided with
+the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*)
+
+(** {1 Interface and Helpers for bigarrays} *)
+
+let of_bigarray b yield =
+  let len = Bigarray.Array1.dim b in
+  for i=0 to len-1 do
+    yield b.{i}
+  done
+
+let mmap filename =
+  fun yield ->
+    let fd = Unix.openfile filename [Unix.O_RDONLY] 0 in
+    let len = Unix.lseek fd 0 Unix.SEEK_END in
+    let _ = Unix.lseek fd 0 Unix.SEEK_SET in
+    let b = Bigarray.Array1.map_file fd Bigarray.Char Bigarray.C_layout false len in
+    try
+      of_bigarray b yield;
+      Unix.close fd
+    with e ->
+      Unix.close fd;
+      raise e

sequence/bigarray/sequenceBigarray.mli

@@ -1,13 +1,12 @@
-
 (*
-copyright (c) 2014, simon cruanes
+Copyright (c) 2014, Simon Cruanes
-all rights reserved.
+All rights reserved.
 
-redistribution and use in source and binary forms, with or without
+Redistribution and use in source and binary forms, with or without
 modification, are permitted provided that the following conditions are met:
 
-redistributions of source code must retain the above copyright notice, this
+Redistributions of source code must retain the above copyright notice, this
-list of conditions and the following disclaimer.  redistributions in binary
+list of conditions and the following disclaimer.  Redistributions in binary
 form must reproduce the above copyright notice, this list of conditions and the
 following disclaimer in the documentation and/or other materials provided with
 the distribution.
@@ -24,42 +23,12 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
-(** {1 Full-Streaming API of Bencode} *)
+(** {1 Interface and Helpers for bigarrays}
 
-type token =
+@since 0.5.4 *)
-  | Int of int
-  | String of string
-  | BeginDict
-  | BeginList
-  | End
 
-module Encode : sig
+val of_bigarray : ('a, _, _) Bigarray.Array1.t -> 'a Sequence.t
-  type t
+(** Iterate on the elements of a 1-D array *)
 
-  type sink =
+val mmap : string -> char Sequence.t
-    [ `File of string
+(** Map the file into memory, and read the characters. *)
-    | `Out of out_channel
-    | `Buf of Buffer.t
-    ]
-
-  val create : sink -> t
-
-  val push : t -> token -> unit
-end
-
-module Decode : sig
-  type t
-
-  val create : unit -> t
-  (** Create a new decoder with the given source. *)
-
-  val feed : t -> string -> unit
-  (** For manual mode, provide some input *)
-
-  type result =
-    | Yield of token
-    | Error of string (** Invalid B-encode *)
-    | Await  (** The user needs to call {!feed} with some input *)
-
-  val next : t -> result
-end

sequence/myocamlbuild.ml

@@ -1,5 +1,5 @@
 (* OASIS_START *)
-(* DO NOT EDIT (digest: c4bb6d2ca42efb069d5612eb2bbcf244) *)
+(* DO NOT EDIT (digest: 2ea21bad023bcdcb9626e204d039d0d2) *)
 module OASISGettext = struct
 (* # 22 "src/oasis/OASISGettext.ml" *)
 
@@ -249,6 +249,9 @@ module MyOCamlbuildFindlib = struct
     *)
   open Ocamlbuild_plugin
 
+  type conf =
+    { no_automatic_syntax: bool;
+    }
 
   (* these functions are not really officially exported *)
   let run_and_read =
@@ -315,7 +318,7 @@ module MyOCamlbuildFindlib = struct
 
   (* This lists all supported packages. *)
   let find_packages () =
-    List.map before_space (split_nl & run_and_read "ocamlfind list")
+    List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list"))
 
 
   (* Mock to list available syntaxes. *)
@@ -338,7 +341,7 @@ module MyOCamlbuildFindlib = struct
   ]
 
 
-  let dispatch =
+  let dispatch conf =
     function
       | After_options ->
           (* By using Before_options one let command line options have an higher
@@ -357,31 +360,39 @@ module MyOCamlbuildFindlib = struct
            * -linkpkg *)
           flag ["ocaml"; "link"; "program"] & A"-linkpkg";
 
-          (* For each ocamlfind package one inject the -package option when
+          if not (conf.no_automatic_syntax) then begin
-           * compiling, computing dependencies, generating documentation and
+            (* For each ocamlfind package one inject the -package option when
-           * linking. *)
+             * compiling, computing dependencies, generating documentation and
-          List.iter
+             * linking. *)
-            begin fun pkg ->
+            List.iter
-              let base_args = [A"-package"; A pkg] in
+              begin fun pkg ->
-              (* TODO: consider how to really choose camlp4o or camlp4r. *)
+                let base_args = [A"-package"; A pkg] in
-              let syn_args = [A"-syntax"; A "camlp4o"] in
+                (* TODO: consider how to really choose camlp4o or camlp4r. *)
-              let args =
+                let syn_args = [A"-syntax"; A "camlp4o"] in
-              (* Heuristic to identify syntax extensions: whether they end in
+                let (args, pargs) =
-                 ".syntax"; some might not.
+                  (* Heuristic to identify syntax extensions: whether they end in
-               *)
+                     ".syntax"; some might not.
-                if Filename.check_suffix pkg "syntax" ||
+                  *)
-                   List.mem pkg well_known_syntax then
+                  if Filename.check_suffix pkg "syntax" ||
-                  syn_args @ base_args
+                     List.mem pkg well_known_syntax then
-                else
+                    (syn_args @ base_args, syn_args)
-                  base_args
+                  else
-              in
+                    (base_args, [])
-              flag ["ocaml"; "compile";  "pkg_"^pkg] & S args;
+                in
-              flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
+                flag ["ocaml"; "compile";  "pkg_"^pkg] & S args;
-              flag ["ocaml"; "doc";      "pkg_"^pkg] & S args;
+                flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
-              flag ["ocaml"; "link";     "pkg_"^pkg] & S base_args;
+                flag ["ocaml"; "doc";      "pkg_"^pkg] & S args;
-              flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
+                flag ["ocaml"; "link";     "pkg_"^pkg] & S base_args;
-            end
+                flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
-            (find_packages ());
+
+                (* TODO: Check if this is allowed for OCaml < 3.12.1 *)
+                flag ["ocaml"; "compile";  "package("^pkg^")"] & S pargs;
+                flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs;
+                flag ["ocaml"; "doc";      "package("^pkg^")"] & S pargs;
+                flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs;
+              end
+              (find_packages ());
+          end;
 
           (* Like -package but for extensions syntax. Morover -syntax is useless
            * when linking. *)
@@ -546,12 +557,13 @@ module MyOCamlbuildBase = struct
 
                    (* When ocaml link something that use the C library, then one
                       need that file to be up to date.
+                      This holds both for programs and for libraries.
                     *)
-                   dep ["link"; "ocaml"; "program"; tag_libstubs lib]
+  		 dep ["link"; "ocaml"; tag_libstubs lib]
-                     [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
+  		     [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
 
-                   dep  ["compile"; "ocaml"; "program"; tag_libstubs lib]
+  		 dep  ["compile"; "ocaml"; tag_libstubs lib]
-                     [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
+  		      [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
 
                    (* TODO: be more specific about what depends on headers *)
                    (* Depends on .h files *)
@@ -580,31 +592,37 @@ module MyOCamlbuildBase = struct
             ()
 
 
-  let dispatch_default t =
+  let dispatch_default conf t =
     dispatch_combine
       [
         dispatch t;
-        MyOCamlbuildFindlib.dispatch;
+        MyOCamlbuildFindlib.dispatch conf;
       ]
 
 
 end
 
 
-# 594 "myocamlbuild.ml"
+# 606 "myocamlbuild.ml"
 open Ocamlbuild_plugin;;
 let package_default =
   {
      MyOCamlbuildBase.lib_ocaml =
-       [("sequence", [], []); ("invert", ["invert"], [])];
+       [
+          ("sequence", [], []);
+          ("invert", ["invert"], []);
+          ("bigarray", ["bigarray"], [])
+       ];
      lib_c = [];
      flags = [];
      includes = []
   }
   ;;
 
-let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;;
+let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
 
-# 609 "myocamlbuild.ml"
+let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
+
+# 627 "myocamlbuild.ml"
 (* OASIS_STOP *)
 Ocamlbuild_plugin.dispatch dispatch_default;;

sequence/sequence.ml

@@ -751,7 +751,7 @@ module IO = struct
     fun k ->
       let ic = open_in_gen flags mode filename in
       try
-        let buf = String.create size in
+        let buf = Bytes.create size in
         let n = ref 0 in
         let stop = ref false in
         while not !stop do
@@ -763,22 +763,29 @@ module IO = struct
             if n' = 0 then stop := true else n := !n + n';
           done;
           if !n > 0
-            then k (String.sub buf 0 !n)
+            then k (Bytes.sub_string buf 0 !n)
         done;
         close_in ic
       with e ->
         close_in_noerr ic;
         raise e
 
-  let write_to ?(mode=0o644) ?(flags=[Open_creat;Open_wronly]) filename seq =
+  let write_bytes_to ?(mode=0o644) ?(flags=[Open_creat;Open_wronly]) filename seq =
     let oc = open_out_gen flags mode filename in
     try
-      seq (fun s -> output oc s 0 (String.length s));
+      seq (fun s -> output oc s 0 (Bytes.length s));
       close_out oc
     with e ->
       close_out oc;
       raise e
 
+  let write_to ?mode ?flags filename seq =
+    write_bytes_to ?mode ?flags filename (map Bytes.unsafe_of_string seq)
+
+  let write_bytes_lines ?mode ?flags filename seq =
+    let ret = Bytes.unsafe_of_string "\n" in
+    write_bytes_to ?mode ?flags filename (snoc (intersperse ret seq) ret)
+
   let write_lines ?mode ?flags filename seq =
-    write_to ?mode ?flags filename (snoc (intersperse "\n" seq) "\n")
+    write_bytes_lines ?mode ?flags filename (map Bytes.unsafe_of_string seq)
 end

sequence/sequence.mli

@@ -558,6 +558,12 @@ By chunks of [4096] bytes:
   Sequence.IO.(chunks_of ~size:4096 "a" |> write_to "b");;
 ]}
 
+Read the lines of a file into a list:
+
+{[
+  Sequence.IO.lines "a" |> Sequence.to_list
+]}
+
 @since 0.5.1 *)
 
 module IO : sig
@@ -580,13 +586,21 @@ module IO : sig
       different iterations might return different results *)
 
   val write_to : ?mode:int -> ?flags:open_flag list ->
-                 string -> string t -> unit
+                     string -> string t -> unit
   (** [write_to filename seq] writes all strings from [seq] into the given
       file. It takes care of opening and closing the file.
       @param mode default [0o644]
       @param flags used by [open_out_gen]. Default: [[Open_creat;Open_wronly]]. *)
 
+  val write_bytes_to : ?mode:int -> ?flags:open_flag list ->
+                       string -> Bytes.t t -> unit
+  (** @since 0.5.4 *)
+
   val write_lines : ?mode:int -> ?flags:open_flag list ->
-                    string -> string t -> unit
+                        string -> string t -> unit
   (** Same as {!write_to}, but intercales ['\n'] between each string *)
+
+  val write_bytes_lines : ?mode:int -> ?flags:open_flag list ->
+                    string -> Bytes.t t -> unit
+  (** @since 0.5.4 *)
 end

sequence/setup.ml

@@ -1,9 +1,9 @@
 (* setup.ml generated for the first time by OASIS v0.4.4 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 1c260750474eb19b8e9212954217b6fd) *)
+(* DO NOT EDIT (digest: 99b277a969b94ce64e720af9e5ba6929) *)
 (*
-   Regenerated by OASIS v0.4.4
+   Regenerated by OASIS v0.4.5
    Visit http://oasis.forge.ocamlcore.org for more information and
    documentation about functions used in this file.
 *)
@@ -242,11 +242,9 @@ module OASISString = struct
 
 
   let replace_chars f s =
-    let buf = String.make (String.length s) 'X' in
+    let buf = Buffer.create (String.length s) in
-      for i = 0 to String.length s - 1 do
+    String.iter (fun c -> Buffer.add_char buf (f c)) s;
-        buf.[i] <- f s.[i]
+    Buffer.contents buf
-      done;
-      buf
 
 
 end
@@ -1729,6 +1727,13 @@ module OASISFeatures = struct
       (fun () ->
         s_ "Allows the OASIS section comments and digest to be omitted in \
             generated files.")
+
+  let no_automatic_syntax =
+    create "no_automatic_syntax" alpha
+      (fun () ->
+         s_ "Disable the automatic inclusion of -syntax camlp4o for packages \
+             that matches the internal heuristic (if a dependency ends with \
+             a .syntax or is a well known syntax).")
 end
 
 module OASISUnixPath = struct
@@ -2099,16 +2104,6 @@ module OASISLibrary = struct
         lst
     in
 
-    (* The headers that should be compiled along *)
-    let headers =
-      if lib.lib_pack then
-        []
-      else
-        find_modules
-          lib.lib_modules
-          "cmi"
-    in
-
     (* The .cmx that be compiled along *)
     let cmxs =
       let should_be_built =
@@ -2134,12 +2129,32 @@ module OASISLibrary = struct
       []
     in
 
+    (* The headers and annot/cmt files that should be compiled along *)
+    let headers =
+      let sufx =
+        if lib.lib_pack
+        then [".cmti"; ".cmt"; ".annot"]
+        else [".cmi"; ".cmti"; ".cmt"; ".annot"]
+      in
+      List.map
+        begin
+          List.fold_left
+            begin fun accu s ->
+              let dot = String.rindex s '.' in
+              let base = String.sub s 0 dot in
+              List.map ((^) base) sufx @ accu
+            end
+            []
+        end
+        (find_modules lib.lib_modules "cmi")
+    in
+
     (* Compute what libraries should be built *)
     let acc_nopath =
       (* Add the packed header file if required *)
       let add_pack_header acc =
         if lib.lib_pack then
-          [cs.cs_name^".cmi"] :: acc
+          [cs.cs_name^".cmi"; cs.cs_name^".cmti"; cs.cs_name^".cmt"] :: acc
         else
           acc
       in
@@ -2499,13 +2514,13 @@ module OASISFindlib = struct
     in
 
     let library_name_of_findlib_name =
-      Lazy.lazy_from_fun
+      lazy begin
-        (fun () ->
+        (* Revert findlib_name_of_library_name. *)
-           (* Revert findlib_name_of_library_name. *)
+        MapString.fold
-           MapString.fold
+          (fun k v mp -> MapString.add v k mp)
-             (fun k v mp -> MapString.add v k mp)
+          fndlb_name_of_lib_name
-             fndlb_name_of_lib_name
+          MapString.empty
-             MapString.empty)
+      end
     in
     let library_name_of_findlib_name fndlb_nm =
       try
@@ -2875,7 +2890,7 @@ module OASISFileUtil = struct
 end
 
 
-# 2878 "setup.ml"
+# 2893 "setup.ml"
 module BaseEnvLight = struct
 (* # 22 "src/base/BaseEnvLight.ml" *)
 
@@ -2980,7 +2995,7 @@ module BaseEnvLight = struct
 end
 
 
-# 2983 "setup.ml"
+# 2998 "setup.ml"
 module BaseContext = struct
 (* # 22 "src/base/BaseContext.ml" *)
 
@@ -5391,7 +5406,7 @@ module BaseSetup = struct
 end
 
 
-# 5394 "setup.ml"
+# 5409 "setup.ml"
 module InternalConfigurePlugin = struct
 (* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *)
 
@@ -5827,6 +5842,17 @@ module InternalInstallPlugin = struct
           lst
     in
 
+    let make_fnames modul sufx =
+      List.fold_right
+        begin fun sufx accu ->
+          (String.capitalize modul ^ sufx) ::
+          (String.uncapitalize modul ^ sufx) ::
+          accu
+        end
+        sufx
+        []
+    in
+
     (** Install all libraries *)
     let install_libs pkg =
 
@@ -5847,27 +5873,29 @@ module InternalInstallPlugin = struct
                   OASISHostPath.of_unix bs.bs_path
                 in
                   List.fold_left
-                    (fun acc modul ->
+                    begin fun acc modul ->
-                       try
+                      begin
-                         List.find
+                        try
-                           OASISFileUtil.file_exists_case
+                          [List.find
-                           (List.map
+                            OASISFileUtil.file_exists_case
-                              (Filename.concat path)
+                            (List.map
-                              [modul^".mli";
+                               (Filename.concat path)
-                               modul^".ml";
+                               (make_fnames modul [".mli"; ".ml"]))]
-                               String.uncapitalize modul^".mli";
+                        with Not_found ->
-                               String.capitalize   modul^".mli";
+                          warning
-                               String.uncapitalize modul^".ml";
+                            (f_ "Cannot find source header for module %s \
-                               String.capitalize   modul^".ml"])
+                                 in library %s")
-                         :: acc
+                            modul cs.cs_name;
-                       with Not_found ->
+                          []
-                         begin
+                      end
-                           warning
+                      @
-                             (f_ "Cannot find source header for module %s \
+                      List.filter
-                                  in library %s")
+                        OASISFileUtil.file_exists_case
-                             modul cs.cs_name;
+                        (List.map
-                           acc
+                           (Filename.concat path)
-                         end)
+                           (make_fnames modul [".annot";".cmti";".cmt"]))
+                      @ acc
+                    end
                     acc
                     lib.lib_modules
               in
@@ -5915,27 +5943,29 @@ module InternalInstallPlugin = struct
                   OASISHostPath.of_unix bs.bs_path
                 in
                   List.fold_left
-                    (fun acc modul ->
+                    begin fun acc modul ->
-                       try
+                      begin
-                         List.find
+                        try
-                           OASISFileUtil.file_exists_case
+                          [List.find
-                           (List.map
+                             OASISFileUtil.file_exists_case
-                              (Filename.concat path)
+                             (List.map
-                              [modul^".mli";
+                                (Filename.concat path)
-                               modul^".ml";
+                                (make_fnames modul [".mli"; ".ml"]))]
-                               String.uncapitalize modul^".mli";
+                        with Not_found ->
-                               String.capitalize   modul^".mli";
+                          warning
-                               String.uncapitalize modul^".ml";
+                            (f_ "Cannot find source header for module %s \
-                               String.capitalize   modul^".ml"])
+                                 in object %s")
-                         :: acc
+                            modul cs.cs_name;
-                       with Not_found ->
+                          []
-                         begin
+                      end
-                           warning
+                      @
-                             (f_ "Cannot find source header for module %s \
+                      List.filter
-                                  in object %s")
+                        OASISFileUtil.file_exists_case
-                             modul cs.cs_name;
+                        (List.map
-                           acc
+                           (Filename.concat path)
-                         end)
+                           (make_fnames modul [".annot";".cmti";".cmt"]))
+                      @ acc
+                    end
                     acc
                     obj.obj_modules
               in
@@ -6240,7 +6270,7 @@ module InternalInstallPlugin = struct
 end
 
 
-# 6243 "setup.ml"
+# 6273 "setup.ml"
 module OCamlbuildCommon = struct
 (* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
 
@@ -6298,6 +6328,11 @@ module OCamlbuildCommon = struct
         else
           [];
 
+        if bool_of_string (tests ()) then
+          ["-tag"; "tests"]
+        else
+          [];
+
         if bool_of_string (profile ()) then
           ["-tag"; "profile"]
         else
@@ -6613,7 +6648,7 @@ module OCamlbuildDocPlugin = struct
 end
 
 
-# 6616 "setup.ml"
+# 6651 "setup.ml"
 module CustomPlugin = struct
 (* # 22 "src/plugins/custom/CustomPlugin.ml" *)
 
@@ -6761,7 +6796,7 @@ module CustomPlugin = struct
 end
 
 
-# 6764 "setup.ml"
+# 6799 "setup.ml"
 open OASISTypes;;
 
 let setup_t =
@@ -6826,7 +6861,7 @@ let setup_t =
           alpha_features = [];
           beta_features = [];
           name = "sequence";
-          version = "0.5.3";
+          version = "0.5.4";
           license =
             OASISLicense.DEP5License
               (OASISLicense.DEP5Unit
@@ -6906,6 +6941,17 @@ let setup_t =
                         Some "build sequence.invert (requires Delimcc)";
                       flag_default = [(OASISExpr.EBool true, false)]
                    });
+               Flag
+                 ({
+                     cs_name = "bigarray";
+                     cs_data = PropList.Data.create ();
+                     cs_plugin_data = []
+                  },
+                   {
+                      flag_description =
+                        Some "build sequence.bigarray (requires bigarray)";
+                      flag_default = [(OASISExpr.EBool true, true)]
+                   });
                Library
                  ({
                      cs_name = "sequence";
@@ -6917,7 +6963,7 @@ let setup_t =
                       bs_install = [(OASISExpr.EBool true, true)];
                       bs_path = ".";
                       bs_compiled_object = Best;
-                      bs_build_depends = [];
+                      bs_build_depends = [FindlibPackage ("bytes", None)];
                       bs_build_tools = [ExternalTool "ocamlbuild"];
                       bs_c_sources = [];
                       bs_data_files = [];
@@ -6978,6 +7024,48 @@ let setup_t =
                       lib_findlib_name = Some "invert";
                       lib_findlib_containers = []
                    });
+               Library
+                 ({
+                     cs_name = "bigarray";
+                     cs_data = PropList.Data.create ();
+                     cs_plugin_data = []
+                  },
+                   {
+                      bs_build =
+                        [
+                           (OASISExpr.EBool true, false);
+                           (OASISExpr.EFlag "bigarray", true)
+                        ];
+                      bs_install =
+                        [
+                           (OASISExpr.EBool true, false);
+                           (OASISExpr.EFlag "bigarray", true)
+                        ];
+                      bs_path = "bigarray";
+                      bs_compiled_object = Best;
+                      bs_build_depends =
+                        [
+                           InternalLibrary "sequence";
+                           FindlibPackage ("bigarray", None)
+                        ];
+                      bs_build_tools = [ExternalTool "ocamlbuild"];
+                      bs_c_sources = [];
+                      bs_data_files = [];
+                      bs_ccopt = [(OASISExpr.EBool true, [])];
+                      bs_cclib = [(OASISExpr.EBool true, [])];
+                      bs_dlllib = [(OASISExpr.EBool true, [])];
+                      bs_dllpath = [(OASISExpr.EBool true, [])];
+                      bs_byteopt = [(OASISExpr.EBool true, [])];
+                      bs_nativeopt = [(OASISExpr.EBool true, [])]
+                   },
+                   {
+                      lib_modules = ["SequenceBigarray"];
+                      lib_pack = false;
+                      lib_internal_modules = [];
+                      lib_findlib_parent = Some "sequence";
+                      lib_findlib_name = Some "bigarray";
+                      lib_findlib_containers = []
+                   });
                Doc
                  ({
                      cs_name = "sequence";
@@ -7191,8 +7279,8 @@ let setup_t =
           plugin_data = []
        };
      oasis_fn = Some "_oasis";
-     oasis_version = "0.4.4";
+     oasis_version = "0.4.5";
-     oasis_digest = Some "\214\tqh\b\169>\243\237\213\012\180\162\155`L";
+     oasis_digest = Some "\143pX\233\t\217\232\\d\023B\027\020*\019W";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
@@ -7200,6 +7288,6 @@ let setup_t =
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 7204 "setup.ml"
+# 7292 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;

setup.ml

@@ -1,9 +1,9 @@
 (* setup.ml generated for the first time by OASIS v0.4.4 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: dcc76292b95f99702b08209614903f90) *)
+(* DO NOT EDIT (digest: 8965d4f752d8126e982e660646a7ec33) *)
 (*
-   Regenerated by OASIS v0.4.4
+   Regenerated by OASIS v0.4.5
    Visit http://oasis.forge.ocamlcore.org for more information and
    documentation about functions used in this file.
 *)
@@ -242,11 +242,9 @@ module OASISString = struct
 
 
   let replace_chars f s =
-    let buf = String.make (String.length s) 'X' in
+    let buf = Buffer.create (String.length s) in
-      for i = 0 to String.length s - 1 do
+    String.iter (fun c -> Buffer.add_char buf (f c)) s;
-        buf.[i] <- f s.[i]
+    Buffer.contents buf
-      done;
-      buf
 
 
 end
@@ -1729,6 +1727,13 @@ module OASISFeatures = struct
       (fun () ->
         s_ "Allows the OASIS section comments and digest to be omitted in \
             generated files.")
+
+  let no_automatic_syntax =
+    create "no_automatic_syntax" alpha
+      (fun () ->
+         s_ "Disable the automatic inclusion of -syntax camlp4o for packages \
+             that matches the internal heuristic (if a dependency ends with \
+             a .syntax or is a well known syntax).")
 end
 
 module OASISUnixPath = struct
@@ -2099,16 +2104,6 @@ module OASISLibrary = struct
         lst
     in
 
-    (* The headers that should be compiled along *)
-    let headers =
-      if lib.lib_pack then
-        []
-      else
-        find_modules
-          lib.lib_modules
-          "cmi"
-    in
-
     (* The .cmx that be compiled along *)
     let cmxs =
       let should_be_built =
@@ -2134,12 +2129,32 @@ module OASISLibrary = struct
       []
     in
 
+    (* The headers and annot/cmt files that should be compiled along *)
+    let headers =
+      let sufx =
+        if lib.lib_pack
+        then [".cmti"; ".cmt"; ".annot"]
+        else [".cmi"; ".cmti"; ".cmt"; ".annot"]
+      in
+      List.map
+        begin
+          List.fold_left
+            begin fun accu s ->
+              let dot = String.rindex s '.' in
+              let base = String.sub s 0 dot in
+              List.map ((^) base) sufx @ accu
+            end
+            []
+        end
+        (find_modules lib.lib_modules "cmi")
+    in
+
     (* Compute what libraries should be built *)
     let acc_nopath =
       (* Add the packed header file if required *)
       let add_pack_header acc =
         if lib.lib_pack then
-          [cs.cs_name^".cmi"] :: acc
+          [cs.cs_name^".cmi"; cs.cs_name^".cmti"; cs.cs_name^".cmt"] :: acc
         else
           acc
       in
@@ -2499,13 +2514,13 @@ module OASISFindlib = struct
     in
 
     let library_name_of_findlib_name =
-      Lazy.lazy_from_fun
+      lazy begin
-        (fun () ->
+        (* Revert findlib_name_of_library_name. *)
-           (* Revert findlib_name_of_library_name. *)
+        MapString.fold
-           MapString.fold
+          (fun k v mp -> MapString.add v k mp)
-             (fun k v mp -> MapString.add v k mp)
+          fndlb_name_of_lib_name
-             fndlb_name_of_lib_name
+          MapString.empty
-             MapString.empty)
+      end
     in
     let library_name_of_findlib_name fndlb_nm =
       try
@@ -2875,7 +2890,7 @@ module OASISFileUtil = struct
 end
 
 
-# 2878 "setup.ml"
+# 2893 "setup.ml"
 module BaseEnvLight = struct
 (* # 22 "src/base/BaseEnvLight.ml" *)
 
@@ -2980,7 +2995,7 @@ module BaseEnvLight = struct
 end
 
 
-# 2983 "setup.ml"
+# 2998 "setup.ml"
 module BaseContext = struct
 (* # 22 "src/base/BaseContext.ml" *)
 
@@ -5391,7 +5406,7 @@ module BaseSetup = struct
 end
 
 
-# 5394 "setup.ml"
+# 5409 "setup.ml"
 module InternalConfigurePlugin = struct
 (* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *)
 
@@ -5827,6 +5842,17 @@ module InternalInstallPlugin = struct
           lst
     in
 
+    let make_fnames modul sufx =
+      List.fold_right
+        begin fun sufx accu ->
+          (String.capitalize modul ^ sufx) ::
+          (String.uncapitalize modul ^ sufx) ::
+          accu
+        end
+        sufx
+        []
+    in
+
     (** Install all libraries *)
     let install_libs pkg =
 
@@ -5847,27 +5873,29 @@ module InternalInstallPlugin = struct
                   OASISHostPath.of_unix bs.bs_path
                 in
                   List.fold_left
-                    (fun acc modul ->
+                    begin fun acc modul ->
-                       try
+                      begin
-                         List.find
+                        try
-                           OASISFileUtil.file_exists_case
+                          [List.find
-                           (List.map
+                            OASISFileUtil.file_exists_case
-                              (Filename.concat path)
+                            (List.map
-                              [modul^".mli";
+                               (Filename.concat path)
-                               modul^".ml";
+                               (make_fnames modul [".mli"; ".ml"]))]
-                               String.uncapitalize modul^".mli";
+                        with Not_found ->
-                               String.capitalize   modul^".mli";
+                          warning
-                               String.uncapitalize modul^".ml";
+                            (f_ "Cannot find source header for module %s \
-                               String.capitalize   modul^".ml"])
+                                 in library %s")
-                         :: acc
+                            modul cs.cs_name;
-                       with Not_found ->
+                          []
-                         begin
+                      end
-                           warning
+                      @
-                             (f_ "Cannot find source header for module %s \
+                      List.filter
-                                  in library %s")
+                        OASISFileUtil.file_exists_case
-                             modul cs.cs_name;
+                        (List.map
-                           acc
+                           (Filename.concat path)
-                         end)
+                           (make_fnames modul [".annot";".cmti";".cmt"]))
+                      @ acc
+                    end
                     acc
                     lib.lib_modules
               in
@@ -5915,27 +5943,29 @@ module InternalInstallPlugin = struct
                   OASISHostPath.of_unix bs.bs_path
                 in
                   List.fold_left
-                    (fun acc modul ->
+                    begin fun acc modul ->
-                       try
+                      begin
-                         List.find
+                        try
-                           OASISFileUtil.file_exists_case
+                          [List.find
-                           (List.map
+                             OASISFileUtil.file_exists_case
-                              (Filename.concat path)
+                             (List.map
-                              [modul^".mli";
+                                (Filename.concat path)
-                               modul^".ml";
+                                (make_fnames modul [".mli"; ".ml"]))]
-                               String.uncapitalize modul^".mli";
+                        with Not_found ->
-                               String.capitalize   modul^".mli";
+                          warning
-                               String.uncapitalize modul^".ml";
+                            (f_ "Cannot find source header for module %s \
-                               String.capitalize   modul^".ml"])
+                                 in object %s")
-                         :: acc
+                            modul cs.cs_name;
-                       with Not_found ->
+                          []
-                         begin
+                      end
-                           warning
+                      @
-                             (f_ "Cannot find source header for module %s \
+                      List.filter
-                                  in object %s")
+                        OASISFileUtil.file_exists_case
-                             modul cs.cs_name;
+                        (List.map
-                           acc
+                           (Filename.concat path)
-                         end)
+                           (make_fnames modul [".annot";".cmti";".cmt"]))
+                      @ acc
+                    end
                     acc
                     obj.obj_modules
               in
@@ -6240,7 +6270,7 @@ module InternalInstallPlugin = struct
 end
 
 
-# 6243 "setup.ml"
+# 6273 "setup.ml"
 module OCamlbuildCommon = struct
 (* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
 
@@ -6298,6 +6328,11 @@ module OCamlbuildCommon = struct
         else
           [];
 
+        if bool_of_string (tests ()) then
+          ["-tag"; "tests"]
+        else
+          [];
+
         if bool_of_string (profile ()) then
           ["-tag"; "profile"]
         else
@@ -6613,7 +6648,7 @@ module OCamlbuildDocPlugin = struct
 end
 
 
-# 6616 "setup.ml"
+# 6651 "setup.ml"
 module CustomPlugin = struct
 (* # 22 "src/plugins/custom/CustomPlugin.ml" *)
 
@@ -6761,7 +6796,7 @@ module CustomPlugin = struct
 end
 
 
-# 6764 "setup.ml"
+# 6799 "setup.ml"
 open OASISTypes;;
 
 let setup_t =
@@ -6899,7 +6934,8 @@ let setup_t =
           build_type = (`Build, "ocamlbuild", Some "0.4");
           build_custom =
             {
-               pre_command = [(OASISExpr.EBool true, None)];
+               pre_command =
+                 [(OASISExpr.EBool true, Some (("make", ["qtest-gen"])))];
                post_command = [(OASISExpr.EBool true, None)]
             };
           install_type = (`Install, "internal", Some "0.4");
@@ -6993,7 +7029,7 @@ let setup_t =
                       bs_install = [(OASISExpr.EBool true, true)];
                       bs_path = "core";
                       bs_compiled_object = Best;
-                      bs_build_depends = [];
+                      bs_build_depends = [FindlibPackage ("bytes", None)];
                       bs_build_tools = [ExternalTool "ocamlbuild"];
                       bs_c_sources = [];
                       bs_data_files = [];
@@ -7036,7 +7072,8 @@ let setup_t =
                            "CCString";
                            "CCHashtbl";
                            "CCFlatHashtbl";
-                           "CCSexp"
+                           "CCSexp";
+                           "CCMap"
                         ];
                       lib_pack = false;
                       lib_internal_modules = [];
@@ -7177,14 +7214,11 @@ let setup_t =
                            "Univ";
                            "Bij";
                            "PiCalculus";
-                           "Bencode";
                            "RAL";
                            "UnionFind";
                            "SmallSet";
                            "AbsSet";
                            "CSM";
-                           "ActionMan";
-                           "BencodeOnDisk";
                            "TTree";
                            "PrintBox";
                            "HGraph";
@@ -7194,9 +7228,6 @@ let setup_t =
                            "Iteratee";
                            "BTree";
                            "Ty";
-                           "Tell";
-                           "BencodeStream";
-                           "RatTerm";
                            "Cause";
                            "AVL";
                            "ParseReact"
@@ -7687,6 +7718,40 @@ let setup_t =
                       bs_nativeopt = [(OASISExpr.EBool true, [])]
                    },
                    {exec_custom = false; exec_main_is = "test_Future.ml"});
+               Executable
+                 ({
+                     cs_name = "run_qtest";
+                     cs_data = PropList.Data.create ();
+                     cs_plugin_data = []
+                  },
+                   {
+                      bs_build =
+                        [
+                           (OASISExpr.EBool true, false);
+                           (OASISExpr.EFlag "tests", true)
+                        ];
+                      bs_install = [(OASISExpr.EBool true, false)];
+                      bs_path = "qtest/";
+                      bs_compiled_object = Native;
+                      bs_build_depends =
+                        [
+                           InternalLibrary "containers";
+                           InternalLibrary "containers_misc";
+                           InternalLibrary "containers_string";
+                           FindlibPackage ("oUnit", None);
+                           FindlibPackage ("QTest2Lib", None)
+                        ];
+                      bs_build_tools = [ExternalTool "ocamlbuild"];
+                      bs_c_sources = [];
+                      bs_data_files = [];
+                      bs_ccopt = [(OASISExpr.EBool true, [])];
+                      bs_cclib = [(OASISExpr.EBool true, [])];
+                      bs_dlllib = [(OASISExpr.EBool true, [])];
+                      bs_dllpath = [(OASISExpr.EBool true, [])];
+                      bs_byteopt = [(OASISExpr.EBool true, [])];
+                      bs_nativeopt = [(OASISExpr.EBool true, [])]
+                   },
+                   {exec_custom = false; exec_main_is = "run_qtest.ml"});
                Executable
                  ({
                      cs_name = "run_tests";
@@ -7745,13 +7810,16 @@ let setup_t =
                            (OASISExpr.EFlag "tests", false);
                            (OASISExpr.EAnd
                               (OASISExpr.EFlag "tests",
-                                OASISExpr.EFlag "tests"),
+                                OASISExpr.EAnd
+                                  (OASISExpr.EFlag "tests",
+                                    OASISExpr.EFlag "misc")),
                              true)
                         ];
                       test_tools =
                         [
                            ExternalTool "ocamlbuild";
-                           InternalExecutable "run_tests"
+                           InternalExecutable "run_tests";
+                           InternalExecutable "run_qtest"
                         ]
                    });
                Executable
@@ -7871,8 +7939,8 @@ let setup_t =
           plugin_data = []
        };
      oasis_fn = Some "_oasis";
-     oasis_version = "0.4.4";
+     oasis_version = "0.4.5";
-     oasis_digest = Some "\002\239\018\128\253~\185m\250\241H\193\205iK\000";
+     oasis_digest = Some "\191L\228>\028\226\240\230.\000\185\131\240[~4";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
@@ -7880,6 +7948,6 @@ let setup_t =
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 7884 "setup.ml"
+# 7952 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;

string/levenshtein.ml

@@ -98,7 +98,7 @@ module type S = sig
       (** Add a pair string/value to the index. If a value was already present
          for this string it is replaced. *)
 
-    val remove : 'b t -> string_ -> 'b -> 'b t
+    val remove : 'b t -> string_ -> 'b t
       (** Remove a string (and its associated value, if any) from the index. *)
 
     val retrieve : limit:int -> 'b t -> string_ -> 'b klist
@@ -338,7 +338,7 @@ module Make(Str : STRING) = struct
 
     let rec get_transitions_for_any nda acc transitions =
       match transitions with
-      | NDA.Upon (NDA.Char _, i, j) :: transitions' ->
+      | NDA.Upon (NDA.Char _, _, _) :: transitions' ->
           get_transitions_for_any nda acc transitions'
       | NDA.Upon (NDA.Any, i, j) :: transitions' ->
           let acc = NDAStateSet.add (i,j) acc in
@@ -558,7 +558,7 @@ module Make(Str : STRING) = struct
         (function
           | Node (_, m) -> Node (Some value, m))
 
-    let remove trie s value =
+    let remove trie s =
       goto_leaf s trie
         (function
           | Node (_, m) -> Node (None, m))
@@ -643,9 +643,9 @@ include Make(struct
   let length = String.length
   let get = String.get
   let of_list l =
-    let s = String.make (List.length l) ' ' in
+    let buf = Buffer.create (List.length l) in
-    List.iteri (fun i c -> s.[i] <- c) l;
+    List.iter (fun c -> Buffer.add_char buf c) l;
-    s
+    Buffer.contents buf
 end)
 
 let debug_print = debug_print output_char

string/levenshtein.mli

@@ -142,7 +142,7 @@ module type S = sig
       (** Add a pair string/value to the index. If a value was already present
          for this string it is replaced. *)
 
-    val remove : 'b t -> string_ -> 'b -> 'b t
+    val remove : 'b t -> string_ -> 'b t
       (** Remove a string (and its associated value, if any) from the index. *)
 
     val retrieve : limit:int -> 'b t -> string_ -> 'b klist

tests/run_tests.ml

@@ -6,11 +6,9 @@ let suite =
   "all_tests" >:::
     [ Test_pHashtbl.suite;
       Test_PersistentHashtbl.suite;
-      Test_bencode.suite;
       Test_bv.suite;
       Test_PiCalculus.suite;
       Test_splayMap.suite;
-      Test_bij.suite;
       Test_CCHeap.suite;
       Test_cc.suite;
       Test_puf.suite;
@@ -29,7 +27,6 @@ let props =
   QCheck.flatten
     [ Test_PersistentHashtbl.props
     ; Test_bv.props
-    ; Test_bencode.props
     ; Test_vector.props
     ]
 

tests/test_bencode.ml

@@ -1,71 +0,0 @@
-
-open OUnit
-open Containers_misc
-
-module B = Bencode
-
-let test1 () =
-  let s = "li42ei0ei-200ee" in
-  match B.parse_string s with
-  | B.ParseError msg ->
-    OUnit.assert_failure (Printf.sprintf "should parse, got %s" msg)
-  | B.ParsePartial ->
-    OUnit.assert_failure "should parse, got partial"
-  | B.ParseOk b ->
-    OUnit.assert_equal (B.L [B.I 42; B.I 0; B.I ~-200]) b
-
-let test2 () =
-  let b =
-    B.dict_of_list [
-      "foo", B.I 42;
-      "bar", B.L [B.I 0; B.S "caramba si"];
-      "", B.S "";
-    ]
-  in
-  let s = B.to_string b in
-  (* Printf.printf "serialized to %s\n" s; *)
-  let b' = B.of_string s in
-  OUnit.assert_equal ~cmp:B.eq ~printer:B.to_string b b'
-
-let test3 () =
-  let b = B.dict_of_list [
-    "a", B.I 1;
-    "b", B.S "bbbb";
-    "l", B.L [B.I 0; B.I 0; B.S "zero\n\t \x00"];
-    "d", B.dict_of_list ["foo", B.S "bar"];
-  ] in
-  let s = B.to_string b in
-  (* Printf.printf "serialized to %s\n" s; *)
-  let b' = B.of_string s in
-  OUnit.assert_equal ~cmp:B.eq ~printer:B.to_string b b'
-
-let suite =
-  "test_bencode" >:::
-    [ "test1" >:: test1;
-      "test2" >:: test2;
-      "test3" >:: test3;
-    ]
-
-open QCheck
-
-let check_decode_encode =
-  let gen = Arbitrary.(
-    let base = choose
-      [ lift (fun i -> B.I i) small_int
-      ; lift (fun s -> B.S s) string
-      ]
-    in
-    fix ~max:3 ~base (fun sub ->
-      choose
-        [ lift B.dict_of_list (list (pair string sub))
-        ; lift (fun l -> B.L l) (list sub)
-        ; sub
-        ]))
-  in
-  let prop b = B.eq (B.of_string (B.to_string b)) b in
-  let name = "bencode_decode_encode_bij" in
-  mk_test ~name gen prop
-
-let props =
-  [ check_decode_encode
-  ]

tests/test_bij.ml

@@ -1,91 +0,0 @@
-
-open OUnit
-open Containers_misc
-
-module Sequence = CCSequence
-
-let pp_int_list l =
-  let b = Buffer.create 4 in
-  CCList.pp CCInt.pp b l;
-  Buffer.contents b
-
-let test_intlist n () =
-  let bij = Bij.(list_ int_) in
-  let l = Sequence.to_list (Sequence.int_range ~start:0 ~stop:n) in
-  let s = Bij.TrBencode.to_string ~bij l in
-  let l' = Bij.TrBencode.of_string ~bij s in
-  OUnit.assert_equal ~printer:pp_int_list l l'
-
-type term =
-  | Const of string
-  | Int of int
-  | App of term list
-
-let bij_term =
-  let bij = Bij.fix
-    (fun bij ->
-    Bij.switch
-    ~inject:(function
-      | Const s -> "const", Bij.(BranchTo (string_, s))
-      | Int i -> "int", Bij.(BranchTo (int_, i))
-      | App l -> "app", Bij.(BranchTo (list_ (Lazy.force bij), l)))
-    ~extract:(function
-      | "const" -> Bij.(BranchFrom (string_, fun x -> Const x))
-      | "int" -> Bij.BranchFrom (Bij.int_, fun x -> Int x)
-      | "app" -> Bij.(BranchFrom (list_ (Lazy.force bij), fun l -> App l))
-      | _ -> raise Bij.(DecodingError "unexpected case switch"))
-    )
-  in
-  bij
-
-let test_rec () =
-  let t = App [Const "foo"; App [Const "bar"; Int 1; Int 2]; Int 3; Const "hello"] in
-  let s = Bij.TrBencode.to_string ~bij:bij_term t in
-  (* Printf.printf "to: %s\n" s; *)
-  let t' = Bij.TrBencode.of_string ~bij:bij_term s in
-  OUnit.assert_equal t t'
-
-let random_str len =
-  let s = String.make len ' ' in
-  for i = 0 to len - 1 do
-    s.[i] <- "abcdefghijklmnopqrstuvwxyz".[Random.int 26]
-  done;
-  s
-
-let rec random_term depth =
-  if depth = 0
-    then if Random.bool ()
-      then Const (random_str (1 + Random.int 5))
-      else Int (Random.int 20)
-    else
-      let len = Random.int (1 + Random.int 10) in
-      let seq = Sequence.map (fun _ -> random_term (depth-1))
-        (Sequence.int_range ~start:1 ~stop:len) in
-      App (Sequence.to_list seq)
-
-let test_term_random ?(depth=5) n () =
-  for i = 0 to n - 1 do
-    let t = random_term depth in
-    let s = Bij.TrBencode.to_string ~bij:bij_term t in
-    let t' = Bij.TrBencode.of_string ~bij:bij_term s in
-    OUnit.assert_equal t t'
-  done
-
-let test_complicated () =
-  let bij = Bij.(triple int_ (pair bool_ (many float_))
-    (map ~inject:(fun (a,b) -> (b,a)) ~extract:(fun (b,a) -> a,b) (pair int_ bool_))) in
-  let x = (1, (true, [1.; 2.; 3.]), (false, 42)) in
-  let s = Bij.TrBencode.to_string ~bij x in
-  let x' = Bij.TrBencode.of_string ~bij s in
-  OUnit.assert_equal x x'
-
-let suite =
-  "test_bij" >:::
-    [ "test_intlist10" >:: test_intlist 10
-    ; "test_intlist100" >:: test_intlist 100
-    ; "test_intlist10_000" >:: test_intlist 10_000
-    ; "test_rec" >:: test_rec
-    ; "test_term_random100" >:: test_term_random 100
-    ; "test_term_random100_depth10" >:: test_term_random ~depth:10 100
-    ; "test_complicated" >:: test_complicated
-    ]

tests/test_levenshtein.ml

@@ -26,10 +26,10 @@ let test_mutation =
     return (s,i,c)
   ) in
   let test (s,i,c) =
-    let s' = String.copy s in
+    let s' = Bytes.of_string s in
-    s'.[i] <- c;
+    Bytes.set s' i c;
     let a = Levenshtein.of_string ~limit:1 s in
-    Levenshtein.match_with a s'
+    Levenshtein.match_with a (Bytes.to_string s')
   in
   let name = "mutating s.[i] into s' still accepted by automaton(s)" in
   QCheck.mk_test ~name ~size:(fun (s,_,_)->String.length s) gen test