simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2026-01-24 01:56:41 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

merge from master for 0.7

Browse source
This commit is contained in:
Simon Cruanes 2014-12-19 20:23:08 +01:00
commit a8f5c3420f
287 changed files with 3031 additions and 17295 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
.merlin
View file

@ -1,20 +1,37 @@
S core
S misc
S string
S pervasives
S tests
S examples
S src/core
S src/data/
S src/io
S src/iter/
S src/advanced/
S src/lwt/
S src/sexp/
S src/threads/
S src/misc
S src/string
S src/bigarray
S src/pervasives
S benchs
B _build/core
B _build/misc
B _build/string
B _build/pervasives
B _build/tests
S examples
S tests
B _build/src/core
B _build/src/data/
B _build/src/io
B _build/src/iter/
B _build/src/advanced/
B _build/src/lwt/
B _build/src/sexp/
B _build/src/threads/
B _build/src/misc
B _build/src/string
B _build/src/bigarray
B _build/src/pervasives
B _build/benchs
B _build/examples
B _build/benchs/
B _build/tests
PKG oUnit
PKG benchmark
PKG threads
PKG threads.posix
PKG lwt
PKG bigarray
FLG -w +a -w -4 -w -44

29
.ocamlinit
View file

@ -1,24 +1,29 @@
#use "topfind";;
#thread
#directory "_build/core";;
#directory "_build/misc";;
#directory "_build/pervasives/";;
#directory "_build/string";;
#directory "_build/threads";;
#require "bigarray";;
#directory "_build/src/core";;
#directory "_build/src/misc";;
#directory "_build/src/pervasives/";;
#directory "_build/src/string";;
#directory "_build/src/io";;
#directory "_build/src/iter";;
#directory "_build/src/data";;
#directory "_build/src/sexp";;
#directory "_build/src/bigarray/";;
#directory "_build/src/threads";;
#directory "_build/tests/";;
#load "containers.cma";;
#load "containers_iter.cma";;
#load "containers_data.cma";;
#load "containers_io.cma";;
#load "containers_sexp.cma";;
#load "containers_string.cma";;
#load "containers_pervasives.cma";;
#load "containers_bigarray.cma";;
#load "containers_misc.cma";;
#thread;;
#load "containers_thread.cma";;
open Containers_misc;;
#install_printer Sexp.print;;
#install_printer Bencode.pretty;;
#install_printer HGraph.Default.fmt;;
#require "CamlGI";;
#load "containers_cgi.cma";;
let pp_html fmt h = Format.pp_print_string fmt (ToWeb.HTML.render h);;
#install_printer pp_html;;
#install_printer CCSexp.print;;
(* vim:syntax=ocaml:
*)

1
AUTHORS.md
View file

@ -7,3 +7,4 @@
- Whitequark (Peter Zotov)
- hcarty (Hezekiah M. Carty)
- struktured (Carmelo Piccione)
- Bernardo da Costa

30
CHANGELOG.md
View file

@ -1,5 +1,35 @@
# Changelog
## 0.7
### breaking
- remove `cgi`/
- removed useless Lwt-related module
- remove `CCGen` and `CCsequence` (use the separate libraries)
- split the library into smaller pieces (with `containers.io`, `containers.iter`,
`containers.sexp`, `containers.data`)
#### other changes
- cleanup: move sub-libraries to their own subdir each; mv everything into `src/`
- `sexp`:
* `CCSexp` now splitted into `CCSexp` (manipulating expressions) and `CCSexpStream`
* add `CCSexpM` for a simpler, monadic parser of S-expressions (deprecating `CCSexpStream`)
- `core`:
* `CCString.fold`
* `CCstring.suffix`
* more efficient `CCString.init`
* fix errors in documentation of `CCString` (slightly over-reaching sed)
* add `CCFloat.{fsign, sign_exn}` (thanks @bernardofpc)
- new `containers.bigarray`, with `CCBigstring`
- `CCHashtbl.map_list`
- `io`:
* `CCIO.read_all` now with ?size parameter
* use `Bytes.extend` (praise modernity!)
* bugfix in `CCIO.read_all` and `CCIO.read_chunks`
- use `-no-alias-deps`
## 0.6.1
- use subtree `gen/` for `CCGen` (symlink) rather than a copy.

33
Makefile
View file

@ -54,12 +54,24 @@ push_doc: doc
scp -r containers_misc.docdir/* cedeela.fr:~/simon/root/software/containers/misc/
scp -r containers_lwt.docdir/* cedeela.fr:~/simon/root/software/containers/lwt/
DONTTEST=myocamlbuild.ml setup.ml $(wildcard **/*.cppo*)
DONTTEST=myocamlbuild.ml setup.ml $(wildcard src/**/*.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) \
$(wildcard src/core/*.ml) \
$(wildcard src/core/*.mli) \
$(wildcard src/data/*.ml) \
$(wildcard src/data/*.mli) \
$(wildcard src/string/*.ml) \
$(wildcard src/string/*.mli) \
$(wildcard src/io/*.ml) \
$(wildcard src/io/*.mli) \
$(wildcard src/sexp/*.ml) \
$(wildcard src/sexp/*.mli) \
$(wildcard src/advanced/*.ml) \
$(wildcard src/advanced/*.mli) \
$(wildcard src/iter/*.ml) \
$(wildcard src/iter/*.mli) \
$(wildcard src/bigarray/*.ml) \
$(wildcard src/bigarray/*.mli) \
)
qtest-clean:
@ -78,11 +90,11 @@ QTEST_PREAMBLE='open CCFun;; '
qtest-gen: qtest-clean
@mkdir -p qtest
@if which qtest ; then \
@if which qtest > /dev/null ; then \
qtest extract --preamble $(QTEST_PREAMBLE) \
-o qtest/run_qtest.cppo.ml \
-o qtest/run_qtest.ml \
$(QTESTABLE) 2> /dev/null ; \
else touch qtest/run_qtest.cppo.ml ; \
else touch qtest/run_qtest.ml ; \
fi
push-stable:
@ -109,11 +121,10 @@ VERSION=$(shell awk '/^Version:/ {print $$2}' _oasis)
update_next_tag:
@echo "update version to $(VERSION)..."
sed -i "s/NEXT_VERSION/$(VERSION)/g" **/*.ml **/*.mli
sed -i "s/NEXT_RELEASE/$(VERSION)/g" **/*.ml **/*.mli
zsh -c 'sed -i "s/NEXT_VERSION/$(VERSION)/g" **/*.ml **/*.mli'
zsh -c 'sed -i "s/NEXT_RELEASE/$(VERSION)/g" **/*.ml **/*.mli'
udpate_sequence:
git subtree pull --prefix sequence sequence stable --squash
.PHONY: examples push_doc tags qtest clean update_sequence update_next_tag push-stable clean-generated

140
README.md
View file

@ -1,28 +1,37 @@
ocaml-containers
================
1. A usable, reasonably well-designed library that extends OCaml's standard
library (in `core/`, packaged under `containers` in ocamlfind. Modules
are totally independent and are prefixed with `CC` (for "containers-core"
or "companion-cube" because I'm megalomaniac). This part should be
usable and should work. For instance, `CCList` contains functions and
lists including safe versions of `map` and `append`.
2. A satellite library, `containers.string` (in directory `string`) with
![logo](media/logo.png)
What is _containers_?
- A usable, reasonably well-designed library that extends OCaml's standard
library (in `core/`, packaged under `containers` in ocamlfind. Modules
are totally independent and are prefixed with `CC` (for "containers-core"
or "companion-cube" because I'm megalomaniac). This part should be
usable and should work. For instance, `CCList` contains functions and
lists including safe versions of `map` and `append`.
- Several small additional libraries that complement it:
* `containers.data` with additional data structures that don't have an
equivalent in the standard library;
* `containers.io` with utils to handle files and I/O streams;
* `containers.iter` with list-like and tree-like iterators;
* `containers.string` (in directory `string`) with
a few packed modules that deal with strings (Levenshtein distance,
KMP search algorithm, and a few naive utils). Again, modules are independent
and sometimes parametric on the string and char types (so they should
be able to deal with your favorite unicode library).
3. A drop-in replacement to the standard library, `containers.pervasives`,
that defined a `CCPervasives` module intented to be opened to extend some
modules of the stdlib.
4. A sub-library with complicated abstractions, `containers.advanced` (with
a LINQ-like query module, batch operations using GADTs, and others)
5. A library using [Lwt](https://github.com/ocsigen/lwt/), `containers.lwt`.
Currently only contains experimental, unstable stuff.
6. Random stuff, with *NO* *GUARANTEE* of even being barely usable or tested,
in other dirs (mostly `misc` but also `lwt` and `threads`). It's where I
tend to write code when I want to test some idea, so half the modules (at
least) are unfinished or don't really work.
- A drop-in replacement to the standard library, `containers.pervasives`,
that defined a `CCPervasives` module intented to be opened to extend some
modules of the stdlib.
- A sub-library with complicated abstractions, `containers.advanced` (with
a LINQ-like query module, batch operations using GADTs, and others).
- A library using [Lwt](https://github.com/ocsigen/lwt/), `containers.lwt`.
Currently only contains experimental, unstable stuff.
- Random stuff, with *NO* *GUARANTEE* of even being barely usable or tested,
in other dirs (mostly `misc` but also `lwt` and `threads`). It's where I
tend to write code when I want to test some idea, so half the modules (at
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.
@ -52,12 +61,15 @@ If you have comments, requests, or bugfixes, please share them! :-)
This code is free, under the BSD license.
The logo (`media/logo.png`) is
CC-SA3 [wikimedia](http://en.wikipedia.org/wiki/File:Hypercube.svg).
## Contents
The design is mostly centered around polymorphism rather than functors. Such
structures comprise (some modules in `misc/`, some other in `core/`):
### Core Structures
### Core Modules (extension of the standard library)
the core library, `containers`, now depends on
[cppo](https://github.com/mjambon/cppo) and `base-bytes` (provided
@ -65,36 +77,50 @@ by ocamlfind).
Documentation [here](http://cedeela.fr/~simon/software/containers).
- `CCHeap`, a purely functional heap structure.
- `CCHeap`, a purely functional heap structure
- `CCVector`, a growable array (pure OCaml, no C) with mutability annotations
- `CCList`, functions on lists, including tail-recursive implementations of `map` and `append` and many other things
- `CCArray`, utilities on arrays and slices
- `CCHashtbl`, `CCMap` extensions of the standard modules `Hashtbl` and `Map`
- `CCInt`
- `CCString` (basic string operations)
- `CCPair` (cartesian products)
- `CCOpt` (options, very useful)
- `CCFun` (function combinators)
- `CCBool`
- `CCFloat`
- `CCOrd` (combinators for total orderings)
- `CCRandom` (combinators for random generators)
- `CCPrint` (printing combinators)
- `CCHash` (hashing combinators)
- `CCError` (monadic error handling, very useful)
### Containers.data
- `CCCache`, memoization caches, LRU, etc.
- `CCFlatHashtbl`, a flat (open-addressing) hashtable functorial implementation
- `CCTrie`, a prefix tree
- `CCMultimap` and `CCMultiset`, functors defining persistent structures
- `CCFQueue`, a purely functional double-ended queue structure
- `CCBV`, mutable bitvectors
- `CCPersistentHashtbl`, a semi-persistent hashtable (similar to [persistent arrays](https://www.lri.fr/~filliatr/ftp/ocaml/ds/parray.ml.html))
- `CCVector`, a growable array (pure OCaml, no C) with mutability annotations
- `CCGen` and `CCSequence`, generic iterators structures (with structural types so they can be defined in several places). They are also available in their own repository and opam packages (`gen` and `sequence`). Note that the `@since` annotations may not be accurate because of the use of `git subtree`.
- `CCKList`, a persistent iterator structure (akin to a lazy list)
- `CCList`, functions on lists, including tail-recursive implementations of `map` and `append` and many other things
- `CCArray`, utilities on arrays and slices
- `CCMultimap` and `CCMultiset`, functors defining persistent structures
- `CCHashtbl`, `CCMap` extensions of the standard modules `Hashtbl` and `Map`
- `CCFlatHashtbl`, a flat (open-addressing) hashtable functorial implementation
- `CCKTree`, an abstract lazy tree structure (similar to what `CCKlist` is to lists)
- `CCTrie`, a prefix tree
- small modules (basic types, utilities):
- `CCInt`
- `CCString` (basic string operations)
- `CCPair` (cartesian products)
- `CCOpt` (options, very useful)
- `CCFun` (function combinators)
- `CCBool`
- `CCFloat`
- `CCOrd` (combinators for total orderings)
- `CCRandom` (combinators for random generators)
- `CCPrint` (printing combinators)
- `CCHash` (hashing combinators)
- `CCError` (monadic error handling, very useful)
- `CCSexp`, a small S-expression library
### Containers.io
- `CCIO`, basic utilities for IO
- `CCCache`, memoization caches, LRU, etc.
### Containers.sexp
A small S-expression library.
- `CCSexp`, a small S-expression library
### Containers.iter
Iterators:
- `CCKList`, a persistent iterator structure (akin to a lazy list, without memoization)
- `CCKTree`, an abstract lazy tree structure
### String
@ -136,19 +162,14 @@ access to elements by their index.
- `Univ`, a universal type encoding with affectation
- `FlatHashtbl`, a (deprecated) open addressing hashtable with
a functorial interface (replaced by PHashtbl)
- `UnionFind`, a functorial imperative Union-Find structure.
- `UnionFind`, a functorial imperative Union-Find structure
### Others
- `Future`, a set of tools for preemptive threading, including a thread pool,
monadic futures, and MVars (concurrent boxes)
Some serialisation formats are also implemented, with a streaming, non-blocking
interface that allows the user to feed the input in chunk by chunk (useful
in combination with Lwt/Async). Currently, the modules are:
- `Bencode`, for the [B-encode format](http://en.wikipedia.org/wiki/Bencode),
- `Sexp`, for S-expressions.
- `containers.lwt` contains [Lwt](http://ocsigen.org/lwt/)-related modules (experimental)
There is a QuickCheck-like library called `QCheck` (now in its own repo).
@ -175,3 +196,18 @@ To build the small benchmarking suite (requires `benchmark`):
$ opam install benchmark
$ make bench
$ ./benchs.native
## Contributing
PRs on github are welcome (patches by email too, if you prefer so).
A few guidelines:
- no dependencies between basic modules (even just for signatures);
- add `@since` tags for new functions;
- add tests if possible (using `qtest`).
Powered by <a href="http://oasis.forge.ocamlcore.org/">
<img src="http://oasis.forge.ocamlcore.org/oasis-badge.png"
alt="OASIS" style="border: none;" />
</a>

179
_oasis
View file

@ -1,6 +1,6 @@
OASISFormat: 0.4
Name: containers
Version: 0.6.1
Version: 0.7
Homepage: https://github.com/c-cube/ocaml-containers
Authors: Simon Cruanes
License: BSD-2-clause
@ -8,6 +8,7 @@ LicenseFile: LICENSE
Plugins: META (0.3), DevFiles (0.3)
OCamlVersion: >= 4.00.1
BuildTools: ocamlbuild
AlphaFeatures: ocamlbuild_more_args
Synopsis: A modular standard library focused on data structures.
Description:
@ -24,10 +25,6 @@ Flag "misc"
Description: Build the misc library, containing everything from the rotating kitchen sink to automatic banana distributors
Default: false
Flag "cgi"
Description: Build modules related to FastCGI, depending on CamlGI
Default: false
Flag "lwt"
Description: Build modules which depend on Lwt
Default: false
@ -40,80 +37,105 @@ Flag "bench"
Description: Build and run benchmarks
Default: false
Flag "bigarray"
Description: Build modules that depend on bigarrays
Default: false
Library "containers"
Path: core
Modules: CCVector, CCDeque, CCGen, Gen_intf, CCSequence, CCFQueue, CCMultiMap,
CCMultiSet, CCBV, CCPrint, CCPersistentHashtbl, CCError,
CCHeap, CCList, CCOpt, CCPair, CCFun, CCHash,
CCKList, CCInt, CCBool, CCFloat, CCArray, CCOrd, CCIO,
CCRandom, CCKTree, CCTrie, CCString, CCHashtbl,
CCFlatHashtbl, CCSexp, CCMap, CCCache
Path: src/core
Modules: CCVector, CCPrint, CCError, CCHeap, CCList, CCOpt, CCPair,
CCFun, CCHash, CCInt, CCBool, CCFloat, CCArray,
CCOrd, CCRandom, CCString, CCHashtbl, CCMap
BuildDepends: bytes
Library "containers_io"
Path: src/io
Modules: CCIO
BuildDepends: bytes
FindlibParent: containers
FindlibName: io
Library "containers_sexp"
Path: src/sexp
Modules: CCSexp, CCSexpStream, CCSexpM
BuildDepends: bytes
FindlibParent: containers
FindlibName: sexp
Library "containers_data"
Path: src/data
Modules: CCMultiMap, CCMultiSet, CCTrie, CCFlatHashtbl, CCCache,
CCPersistentHashtbl, CCDeque, CCFQueue, CCBV, CCMixtbl
FindlibParent: containers
FindlibName: data
Library "containers_iter"
Path: src/iter
Modules: CCKTree, CCKList
FindlibParent: containers
FindlibName: iter
Library "containers_string"
Path: string
Path: src/string
Pack: true
Modules: KMP, Levenshtein
FindlibName: string
FindlibParent: containers
Library "containers_advanced"
Path: advanced
Path: src/advanced
Pack: true
Modules: CCLinq, CCBatch, CCCat, CCMonadIO
FindlibName: advanced
FindlibParent: containers
BuildDepends: containers
BuildDepends: containers, sequence
Library "containers_bigarray"
Path: src/bigarray
Modules: CCBigstring
FindlibName: bigarray
FindlibParent: containers
BuildDepends: containers, bigarray, bytes
Library "containers_pervasives"
Path: pervasives
Path: src/pervasives
Modules: CCPervasives
BuildDepends: containers
FindlibName: pervasives
FindlibParent: containers
Library "containers_misc"
Path: misc
Path: src/misc
Pack: true
Modules: FHashtbl, FlatHashtbl, Hashset,
Heap, LazyGraph, PersistentGraph,
PHashtbl, SkipList, SplayTree, SplayMap, Univ,
Bij, PiCalculus, RAL, UnionFind, SmallSet, AbsSet, CSM,
TTree, PrintBox, HGraph, Automaton, Conv, Bidir, Iteratee,
BTree, Ty, Cause, AVL, ParseReact, Mixtbl
BuildDepends: unix,containers
BTree, Ty, Cause, AVL, ParseReact
BuildDepends: containers, containers.data
FindlibName: misc
FindlibParent: containers
Library "containers_thread"
Path: threads/
Path: src/threads/
Modules: CCFuture
FindlibName: thread
FindlibParent: containers
Build$: flag(thread)
Install$: flag(thread)
BuildDepends: containers,threads
XMETARequires: containers,threads
BuildDepends: containers, threads
XMETARequires: containers, threads
Library "containers_lwt"
Path: lwt
Modules: Behavior, Lwt_automaton, Lwt_actor
Path: src/lwt
Modules: Lwt_automaton, Lwt_actor
Pack: true
FindlibName: lwt
FindlibParent: containers
Build$: flag(lwt) && flag(misc)
Install$: flag(lwt) && flag(misc)
BuildDepends: containers, lwt, lwt.unix, containers.misc
Library "containers_cgi"
Path: cgi
Modules: ToWeb
FindlibName: cgi
FindlibParent: containers
Build$: flag(cgi)
Install$: flag(cgi)
BuildDepends: containers,CamlGI
XMETARequires: containers,CamlGI
BuildDepends: containers, lwt, containers.misc
Document containers
Title: Containers docs
@ -121,39 +143,13 @@ Document containers
BuildTools+: ocamldoc
Install: true
XOCamlbuildPath: .
XOCamlbuildLibraries: containers,containers.string
Document containers_misc
Title: Containers_misc docs
Type: ocamlbuild (0.3)
BuildTools+: ocamldoc
Install: true
XOCamlbuildPath: .
XOCamlbuildLibraries: containers.misc
Document containers_string
Title: Containers_string docs
Type: ocamlbuild (0.3)
BuildTools+: ocamldoc
Install: true
XOCamlbuildPath: .
XOCamlbuildLibraries: containers.string
Document containers_advanced
Title: Containers_advanced docs
Type: ocamlbuild (0.3)
BuildTools+: ocamldoc
Install: true
XOCamlbuildPath: .
XOCamlbuildLibraries: containers.advanced
Document containers_lwt
Title: Containers_lwt docs
Type: ocamlbuild (0.3)
BuildTools+: ocamldoc
Install: true
XOCamlbuildPath: .
XOCamlbuildLibraries: containers.lwt
XOCamlbuildExtraArgs:
"-docflags '-colorize-code -short-functors -charset utf-8'"
XOCamlbuildLibraries:
containers, containers.misc, containers.iter, containers.data,
containers.string, containers.pervasives, containers.bigarray,
containers.advanced, containers.io, containers.sexp,
containers.lwt
Executable run_benchs
Path: benchs/
@ -162,7 +158,8 @@ Executable run_benchs
Build$: flag(bench) && flag(misc)
MainIs: run_benchs.ml
BuildDepends: containers, containers.misc, containers.advanced,
containers.string, benchmark
containers.data, containers.string, containers.iter,
sequence, gen, benchmark
Executable bench_hash
Path: benchs/
@ -170,7 +167,7 @@ Executable bench_hash
CompiledObject: native
Build$: flag(bench) && flag(misc)
MainIs: bench_hash.ml
BuildDepends: containers,containers.misc
BuildDepends: containers, containers.misc
Executable bench_conv
Path: benchs/
@ -178,7 +175,7 @@ Executable bench_conv
CompiledObject: native
Build$: flag(bench)
MainIs: bench_conv.ml
BuildDepends: containers,benchmark
BuildDepends: containers, benchmark, gen
Executable test_levenshtein
Path: tests/
@ -186,15 +183,7 @@ Executable test_levenshtein
CompiledObject: native
Build$: flag(tests)
MainIs: test_levenshtein.ml
BuildDepends: containers,qcheck,containers.string
Executable test_lwt
Path: tests/lwt/
Install: false
CompiledObject: best
Build$: flag(tests) && flag(lwt)
MainIs: test_Behavior.ml
BuildDepends: containers,lwt,lwt.unix,oUnit,containers.lwt
BuildDepends: containers, qcheck, containers.string
Executable test_threads
Path: tests/lwt/
@ -202,7 +191,7 @@ Executable test_threads
CompiledObject: best
Build$: flag(tests) && flag(thread)
MainIs: test_Future.ml
BuildDepends: containers,threads,oUnit,containers.lwt
BuildDepends: containers, threads, oUnit, containers.lwt
PreBuildCommand: make qtest-gen
@ -212,8 +201,10 @@ Executable run_qtest
CompiledObject: native
MainIs: run_qtest.ml
Build$: flag(tests)
BuildDepends: containers, containers.misc, containers.string,
oUnit, QTest2Lib
BuildDepends: containers, containers.misc, containers.string, containers.iter,
containers.io, containers.advanced, containers.sexp,
containers.bigarray,
sequence, gen, oUnit, QTest2Lib
Executable run_tests
Path: tests/
@ -221,26 +212,20 @@ Executable run_tests
CompiledObject: native
MainIs: run_tests.ml
Build$: flag(tests) && flag(misc)
BuildDepends: containers, oUnit, qcheck, containers.misc
BuildDepends: containers, containers.data, oUnit, sequence, gen,
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/
Install: false
MainIs: web_pwd.ml
Build$: flag(cgi)
BuildDepends: containers, containers.cgi, threads, CamlGI
Executable lambda
Path: examples/
Install: false
MainIs: lambda.ml
Build$: flag(misc)
BuildDepends: containers,containers.misc
BuildDepends: containers, containers.misc
Executable id_sexp
Path: examples/
@ -248,7 +233,15 @@ Executable id_sexp
CompiledObject: native
MainIs: id_sexp.ml
Build$: flag(misc)
BuildDepends: containers
BuildDepends: containers.sexp
Executable id_sexp2
Path: examples/
Install: false
CompiledObject: native
MainIs: id_sexp2.ml
Build$: flag(misc)
BuildDepends: containers.sexp
SourceRepository head
Type: git

236
_tags
View file

@ -1,5 +1,5 @@
# OASIS_START
# DO NOT EDIT (digest: 87b09f8c85905e63062b223fad9468e9)
# DO NOT EDIT (digest: 616ce46d4cb6f4ca580b6de54c9a1d70)
# 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
@ -15,104 +15,119 @@ true: annot, bin_annot
"_darcs": -traverse
"_darcs": not_hygienic
# Library containers
"core/containers.cmxs": use_containers
<core/*.ml{,i,y}>: package(bytes)
"src/core/containers.cmxs": use_containers
<src/core/*.ml{,i,y}>: package(bytes)
# Library containers_io
"src/io/containers_io.cmxs": use_containers_io
<src/io/*.ml{,i,y}>: package(bytes)
# Library containers_sexp
"src/sexp/containers_sexp.cmxs": use_containers_sexp
<src/sexp/*.ml{,i,y}>: package(bytes)
# Library containers_data
"src/data/containers_data.cmxs": use_containers_data
# Library containers_iter
"src/iter/containers_iter.cmxs": use_containers_iter
# Library containers_string
"string/containers_string.cmxs": use_containers_string
"string/KMP.cmx": for-pack(Containers_string)
"string/levenshtein.cmx": for-pack(Containers_string)
"src/string/containers_string.cmxs": use_containers_string
"src/string/KMP.cmx": for-pack(Containers_string)
"src/string/levenshtein.cmx": for-pack(Containers_string)
# Library containers_advanced
"advanced/containers_advanced.cmxs": use_containers_advanced
"advanced/CCLinq.cmx": for-pack(Containers_advanced)
"advanced/CCBatch.cmx": for-pack(Containers_advanced)
"advanced/CCCat.cmx": for-pack(Containers_advanced)
"advanced/CCMonadIO.cmx": for-pack(Containers_advanced)
<advanced/*.ml{,i,y}>: package(bytes)
<advanced/*.ml{,i,y}>: use_containers
"src/advanced/containers_advanced.cmxs": use_containers_advanced
"src/advanced/CCLinq.cmx": for-pack(Containers_advanced)
"src/advanced/CCBatch.cmx": for-pack(Containers_advanced)
"src/advanced/CCCat.cmx": for-pack(Containers_advanced)
"src/advanced/CCMonadIO.cmx": for-pack(Containers_advanced)
<src/advanced/*.ml{,i,y}>: package(bytes)
<src/advanced/*.ml{,i,y}>: package(sequence)
<src/advanced/*.ml{,i,y}>: use_containers
# Library containers_bigarray
"src/bigarray/containers_bigarray.cmxs": use_containers_bigarray
<src/bigarray/*.ml{,i,y}>: package(bigarray)
<src/bigarray/*.ml{,i,y}>: package(bytes)
<src/bigarray/*.ml{,i,y}>: use_containers
# Library containers_pervasives
"pervasives/containers_pervasives.cmxs": use_containers_pervasives
<pervasives/*.ml{,i,y}>: package(bytes)
<pervasives/*.ml{,i,y}>: use_containers
"src/pervasives/containers_pervasives.cmxs": use_containers_pervasives
<src/pervasives/*.ml{,i,y}>: package(bytes)
<src/pervasives/*.ml{,i,y}>: use_containers
# Library containers_misc
"misc/containers_misc.cmxs": use_containers_misc
"misc/fHashtbl.cmx": for-pack(Containers_misc)
"misc/flatHashtbl.cmx": for-pack(Containers_misc)
"misc/hashset.cmx": for-pack(Containers_misc)
"misc/heap.cmx": for-pack(Containers_misc)
"misc/lazyGraph.cmx": for-pack(Containers_misc)
"misc/persistentGraph.cmx": for-pack(Containers_misc)
"misc/pHashtbl.cmx": for-pack(Containers_misc)
"misc/skipList.cmx": for-pack(Containers_misc)
"misc/splayTree.cmx": for-pack(Containers_misc)
"misc/splayMap.cmx": for-pack(Containers_misc)
"misc/univ.cmx": for-pack(Containers_misc)
"misc/bij.cmx": for-pack(Containers_misc)
"misc/piCalculus.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/tTree.cmx": for-pack(Containers_misc)
"misc/printBox.cmx": for-pack(Containers_misc)
"misc/hGraph.cmx": for-pack(Containers_misc)
"misc/automaton.cmx": for-pack(Containers_misc)
"misc/conv.cmx": for-pack(Containers_misc)
"misc/bidir.cmx": for-pack(Containers_misc)
"misc/iteratee.cmx": for-pack(Containers_misc)
"misc/bTree.cmx": for-pack(Containers_misc)
"misc/ty.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/mixtbl.cmx": for-pack(Containers_misc)
<misc/*.ml{,i,y}>: package(bytes)
<misc/*.ml{,i,y}>: package(unix)
<misc/*.ml{,i,y}>: use_containers
"src/misc/containers_misc.cmxs": use_containers_misc
"src/misc/fHashtbl.cmx": for-pack(Containers_misc)
"src/misc/flatHashtbl.cmx": for-pack(Containers_misc)
"src/misc/hashset.cmx": for-pack(Containers_misc)
"src/misc/heap.cmx": for-pack(Containers_misc)
"src/misc/lazyGraph.cmx": for-pack(Containers_misc)
"src/misc/persistentGraph.cmx": for-pack(Containers_misc)
"src/misc/pHashtbl.cmx": for-pack(Containers_misc)
"src/misc/skipList.cmx": for-pack(Containers_misc)
"src/misc/splayTree.cmx": for-pack(Containers_misc)
"src/misc/splayMap.cmx": for-pack(Containers_misc)
"src/misc/univ.cmx": for-pack(Containers_misc)
"src/misc/bij.cmx": for-pack(Containers_misc)
"src/misc/piCalculus.cmx": for-pack(Containers_misc)
"src/misc/RAL.cmx": for-pack(Containers_misc)
"src/misc/unionFind.cmx": for-pack(Containers_misc)
"src/misc/smallSet.cmx": for-pack(Containers_misc)
"src/misc/absSet.cmx": for-pack(Containers_misc)
"src/misc/CSM.cmx": for-pack(Containers_misc)
"src/misc/tTree.cmx": for-pack(Containers_misc)
"src/misc/printBox.cmx": for-pack(Containers_misc)
"src/misc/hGraph.cmx": for-pack(Containers_misc)
"src/misc/automaton.cmx": for-pack(Containers_misc)
"src/misc/conv.cmx": for-pack(Containers_misc)
"src/misc/bidir.cmx": for-pack(Containers_misc)
"src/misc/iteratee.cmx": for-pack(Containers_misc)
"src/misc/bTree.cmx": for-pack(Containers_misc)
"src/misc/ty.cmx": for-pack(Containers_misc)
"src/misc/cause.cmx": for-pack(Containers_misc)
"src/misc/AVL.cmx": for-pack(Containers_misc)
"src/misc/parseReact.cmx": for-pack(Containers_misc)
<src/misc/*.ml{,i,y}>: package(bytes)
<src/misc/*.ml{,i,y}>: use_containers
<src/misc/*.ml{,i,y}>: use_containers_data
# Library containers_thread
"threads/containers_thread.cmxs": use_containers_thread
<threads/*.ml{,i,y}>: package(bytes)
<threads/*.ml{,i,y}>: package(threads)
<threads/*.ml{,i,y}>: use_containers
"src/threads/containers_thread.cmxs": use_containers_thread
<src/threads/*.ml{,i,y}>: package(bytes)
<src/threads/*.ml{,i,y}>: package(threads)
<src/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/lwt_actor.cmx": for-pack(Containers_lwt)
<lwt/*.ml{,i,y}>: package(bytes)
<lwt/*.ml{,i,y}>: package(lwt)
<lwt/*.ml{,i,y}>: package(lwt.unix)
<lwt/*.ml{,i,y}>: package(unix)
<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,y}>: package(CamlGI)
<cgi/*.ml{,i,y}>: package(bytes)
<cgi/*.ml{,i,y}>: use_containers
"src/lwt/containers_lwt.cmxs": use_containers_lwt
"src/lwt/lwt_automaton.cmx": for-pack(Containers_lwt)
"src/lwt/lwt_actor.cmx": for-pack(Containers_lwt)
<src/lwt/*.ml{,i,y}>: package(bytes)
<src/lwt/*.ml{,i,y}>: package(lwt)
<src/lwt/*.ml{,i,y}>: use_containers
<src/lwt/*.ml{,i,y}>: use_containers_data
<src/lwt/*.ml{,i,y}>: use_containers_misc
# Executable run_benchs
"benchs/run_benchs.native": package(benchmark)
"benchs/run_benchs.native": package(bytes)
"benchs/run_benchs.native": package(unix)
"benchs/run_benchs.native": package(gen)
"benchs/run_benchs.native": package(sequence)
"benchs/run_benchs.native": use_containers
"benchs/run_benchs.native": use_containers_advanced
"benchs/run_benchs.native": use_containers_data
"benchs/run_benchs.native": use_containers_iter
"benchs/run_benchs.native": use_containers_misc
"benchs/run_benchs.native": use_containers_string
<benchs/*.ml{,i,y}>: package(sequence)
<benchs/*.ml{,i,y}>: use_containers_advanced
<benchs/*.ml{,i,y}>: use_containers_iter
<benchs/*.ml{,i,y}>: use_containers_string
# 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_data
"benchs/bench_hash.native": use_containers_misc
<benchs/*.ml{,i,y}>: package(unix)
<benchs/*.ml{,i,y}>: use_containers_data
<benchs/*.ml{,i,y}>: use_containers_misc
# Executable bench_conv
"benchs/bench_conv.native": package(benchmark)
"benchs/bench_conv.native": package(bytes)
"benchs/bench_conv.native": package(gen)
"benchs/bench_conv.native": use_containers
<benchs/*.ml{,i,y}>: package(benchmark)
<benchs/*.ml{,i,y}>: package(bytes)
<benchs/*.ml{,i,y}>: package(gen)
<benchs/*.ml{,i,y}>: use_containers
# Executable test_levenshtein
"tests/test_levenshtein.native": package(bytes)
@ -120,89 +135,90 @@ true: annot, bin_annot
"tests/test_levenshtein.native": use_containers
"tests/test_levenshtein.native": 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)
<tests/lwt/test_Behavior.{native,byte}>: package(unix)
<tests/lwt/test_Behavior.{native,byte}>: use_containers
<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)
<tests/lwt/test_Future.{native,byte}>: package(threads)
<tests/lwt/test_Future.{native,byte}>: package(unix)
<tests/lwt/test_Future.{native,byte}>: use_containers
<tests/lwt/test_Future.{native,byte}>: use_containers_data
<tests/lwt/test_Future.{native,byte}>: use_containers_lwt
<tests/lwt/test_Future.{native,byte}>: use_containers_misc
<tests/lwt/*.ml{,i,y}>: package(bytes)
<tests/lwt/*.ml{,i,y}>: package(lwt)
<tests/lwt/*.ml{,i,y}>: package(lwt.unix)
<tests/lwt/*.ml{,i,y}>: package(oUnit)
<tests/lwt/*.ml{,i,y}>: package(threads)
<tests/lwt/*.ml{,i,y}>: package(unix)
<tests/lwt/*.ml{,i,y}>: use_containers
<tests/lwt/*.ml{,i,y}>: use_containers_data
<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(bigarray)
"qtest/run_qtest.native": package(bytes)
"qtest/run_qtest.native": package(gen)
"qtest/run_qtest.native": package(oUnit)
"qtest/run_qtest.native": package(unix)
"qtest/run_qtest.native": package(sequence)
"qtest/run_qtest.native": use_containers
"qtest/run_qtest.native": use_containers_advanced
"qtest/run_qtest.native": use_containers_bigarray
"qtest/run_qtest.native": use_containers_data
"qtest/run_qtest.native": use_containers_io
"qtest/run_qtest.native": use_containers_iter
"qtest/run_qtest.native": use_containers_misc
"qtest/run_qtest.native": use_containers_sexp
"qtest/run_qtest.native": use_containers_string
<qtest/*.ml{,i,y}>: package(QTest2Lib)
<qtest/*.ml{,i,y}>: package(bigarray)
<qtest/*.ml{,i,y}>: package(bytes)
<qtest/*.ml{,i,y}>: package(gen)
<qtest/*.ml{,i,y}>: package(oUnit)
<qtest/*.ml{,i,y}>: package(unix)
<qtest/*.ml{,i,y}>: package(sequence)
<qtest/*.ml{,i,y}>: use_containers
<qtest/*.ml{,i,y}>: use_containers_advanced
<qtest/*.ml{,i,y}>: use_containers_bigarray
<qtest/*.ml{,i,y}>: use_containers_data
<qtest/*.ml{,i,y}>: use_containers_io
<qtest/*.ml{,i,y}>: use_containers_iter
<qtest/*.ml{,i,y}>: use_containers_misc
<qtest/*.ml{,i,y}>: use_containers_sexp
<qtest/*.ml{,i,y}>: use_containers_string
# Executable run_tests
"tests/run_tests.native": package(bytes)
"tests/run_tests.native": package(gen)
"tests/run_tests.native": package(oUnit)
"tests/run_tests.native": package(qcheck)
"tests/run_tests.native": package(unix)
"tests/run_tests.native": package(sequence)
"tests/run_tests.native": use_containers
"tests/run_tests.native": use_containers_data
"tests/run_tests.native": use_containers_misc
<tests/*.ml{,i,y}>: package(bytes)
<tests/*.ml{,i,y}>: package(gen)
<tests/*.ml{,i,y}>: package(oUnit)
<tests/*.ml{,i,y}>: package(qcheck)
<tests/*.ml{,i,y}>: package(unix)
<tests/*.ml{,i,y}>: package(sequence)
<tests/*.ml{,i,y}>: use_containers
<tests/*.ml{,i,y}>: use_containers_data
<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,y}>: package(CamlGI)
<examples/cgi/*.ml{,i,y}>: package(bytes)
<examples/cgi/*.ml{,i,y}>: package(threads)
<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_data
"examples/lambda.byte": use_containers_misc
<examples/*.ml{,i,y}>: package(unix)
<examples/*.ml{,i,y}>: use_containers
<examples/*.ml{,i,y}>: use_containers_data
<examples/*.ml{,i,y}>: use_containers_misc
# Executable id_sexp
"examples/id_sexp.native": package(bytes)
"examples/id_sexp.native": use_containers
"examples/id_sexp.native": use_containers_sexp
# Executable id_sexp2
"examples/id_sexp2.native": package(bytes)
"examples/id_sexp2.native": use_containers_sexp
<examples/*.ml{,i,y}>: package(bytes)
<examples/*.ml{,i,y}>: use_containers
<examples/*.ml{,i,y}>: use_containers_sexp
# OASIS_STOP
<tests/*.ml{,i}>: thread
<threads/*.ml{,i}>: thread
<sequence>: -traverse
<gen>: -traverse
<core/CCVector.cmx>: inline(25)
<{string,core}/**/*.ml>: warn_A, warn(-4), warn(-44)
<src/threads/*.ml{,i}>: thread
<src/core/CCVector.cmx>: inline(25)
<src/**/*.ml> and not <src/misc/*.ml>: warn_A, warn(-4), warn(-44)
true: no_alias_deps

4
benchs/bench_conv.ml
View file

@ -79,11 +79,11 @@ let () =
bench_list [1,2; 3,4; 5,6; 7,8; 9,10];
let open CCFun in
let l = CCGen.(1 -- 100 |> map (fun x->x,x) |> to_rev_list) in
let l = Gen.(1 -- 100 |> map (fun x->x,x) |> to_rev_list) in
Printf.printf "list of %d elements...\n" (List.length l);
bench_list l;
let l = CCGen.(repeat Point.p |> take 10 |> to_rev_list) in
let l = Gen.(repeat Point.p |> take 10 |> to_rev_list) in
Printf.printf "list of %d points...\n" (List.length l);
bench_point_list l;

12
benchs/run_benchs.ml
View file

@ -480,8 +480,8 @@ module Iter = struct
(** {2 Sequence/Gen} *)
let bench_fold n =
let seq () = CCSequence.fold (+) 0 CCSequence.(0 --n) in
let gen () = CCGen.fold (+) 0 CCGen.(0 -- n) in
let seq () = Sequence.fold (+) 0 Sequence.(0 --n) in
let gen () = Gen.fold (+) 0 Gen.(0 -- n) in
let klist () = CCKList.fold (+) 0 CCKList.(0 -- n) in
CCBench.throughputN 3
[ "sequence.fold", seq, ();
@ -490,10 +490,10 @@ module Iter = struct
]
let bench_flat_map n =
let seq () = CCSequence.(
let seq () = Sequence.(
0 -- n |> flat_map (fun x -> x-- (x+10)) |> fold (+) 0
)
and gen () = CCGen.(
and gen () = Gen.(
0 -- n |> flat_map (fun x -> x-- (x+10)) |> fold (+) 0
)
and klist () = CCKList.(
@ -509,12 +509,12 @@ module Iter = struct
let bench_iter n =
let seq () =
let i = ref 2 in
CCSequence.(
Sequence.(
1 -- n |> iter (fun x -> i := !i * x)
)
and gen () =
let i = ref 2 in
CCGen.(
Gen.(
1 -- n |> iter (fun x -> i := !i * x)
)
and klist () =

358
cgi/toWeb.ml
View file

@ -1,358 +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 Expose the State of a Program to the Web}
We export some values (and associated functions for converting them to
html, and update them) as a FastCGI interface.
This module depends on CamlGI.
*)
(** {2 Some combinators to build HTML documents} *)
module HTML = struct
type t =
| Str of string (* content *)
| List of t list
| Url of url
| Img of image
| Concat of t list
| H of int * t
| Link of link
| Tag of string * t
| TagWith of string * (string * string) list * t
and url = {
url_alt : string option;
url_url : string;
url_descr : string;
}
and image = {
img_alt : string option;
img_url : string;
}
and link = {
link_rel : string;
link_url : string;
}
let str s = Str s
let bprintf format =
let buffer = Buffer.create 64 in
let r = ref (str "") in
Printf.kbprintf
(fun x -> r := str (Buffer.contents buffer))
buffer
format;
!r
let sprintf format =
let r = ref (str "") in
Printf.ksprintf
(fun s -> r := str s)
format;
!r
let list l = List l
let url ?alt ~url ~descr = Url {
url_alt = alt;
url_url = url;
url_descr = descr;
}
let img ?alt url = Img {
img_alt = alt;
img_url = url;
}
let append a b = Concat [a; b]
let concat l = Concat l
let h1 x = H (1, x)
let h2 x = H (2, x)
let h3 x = H (3, x)
let h n x = H (n, x)
let p x = Tag ("p", x)
let div ?id ?class_ x =
match id, class_ with
| None, None -> Tag ("div", x)
| Some i, None -> TagWith ("div", ["id", i], x)
| None, Some c -> TagWith ("div", ["class", c], x)
| Some i, Some c -> TagWith ("div", ["id", i; "class", c], x)
let span ?id ?class_ x =
match id, class_ with
| None, None -> Tag ("span", x)
| Some i, None -> TagWith ("span", ["id", i], x)
| None, Some c -> TagWith ("span", ["class", c], x)
| Some i, Some c -> TagWith ("span", ["id", i; "class", c], x)
let link ~rel ~url = Link {
link_rel = rel;
link_url = url;
}
let head x = Tag ("head", x)
let body x = Tag ("body", x)
let html x = Tag ("html", x)
let _to_hex n = match n with
| _ when n >= 0 && n < 10 -> Char.chr (Char.code '0' + n)
| 10 -> 'A'
| 11 -> 'B'
| 12 -> 'C'
| 13 -> 'D'
| 14 -> 'E'
| 15 -> 'F'
| _ -> failwith "not an hexadecimal digit"
let _encode_char buf c =
Buffer.add_string buf "&#x";
let h, l = Char.code c / 16, Char.code c mod 16 in
Buffer.add_char buf (_to_hex h);
Buffer.add_char buf (_to_hex l)
let encode str =
let b = Buffer.create (String.length str + 10) in
for i = 0 to String.length str - 1 do
match str.[i] with
| ';' | '/' | '?' | ':' | '@' | '&' | '=' | '+' | '$' | ',' | '<'
| '>' | '#' | '%' | '"' | '{' | '}' | '|' | '\\' | '^' | '[' | ']'
| '`' -> _encode_char b str.[i]
| c when Char.code c < 32 -> _encode_char b str.[i]
| c when Char.code c > 127 -> _encode_char b str.[i]
| _ -> Buffer.add_char b str.[i]
done;
Buffer.contents b
(* real rendering is always into a buffer (for now) *)
let rec to_buf buf x =
match x with
| Str s -> Buffer.add_string buf (encode s)
| List l ->
Buffer.add_string buf "<ul>";
List.iter
(fun y -> Printf.bprintf buf "<li>%a</li>" to_buf y)
l;
Buffer.add_string buf "</ul>"
| Url url ->
begin match url.url_alt with
| None ->
Printf.bprintf buf "<a href=\"%s\">%s</a>" url.url_url
(encode url.url_descr)
| Some alt ->
Printf.bprintf buf "<a href=\"%s\" alt=\"%s\">%s</a>"
url.url_url (encode alt) (encode url.url_descr)
end
| Img i -> failwith "img: not implemented"
| Concat l ->
List.iteri
(fun i y ->
if i > 0 then Buffer.add_char buf ' ';
to_buf buf y)
l
| H (n, y) ->
Printf.bprintf buf "<h%i> %a </h%i>" n to_buf y n
| Link _ -> failwith "link: not implemented"
| Tag (str, y) -> Printf.bprintf buf "<%s> %a </%s>" str to_buf y str
| TagWith (str, attrs, y) ->
Printf.bprintf buf "<%s " str;
List.iter (fun (name,attr) -> Printf.bprintf buf "%s=\"%s\"" name attr) attrs;
Printf.bprintf buf "> %a </%s>" to_buf y str
let render x =
let buf = Buffer.create 256 in
to_buf buf x;
Buffer.contents buf
let to_chan oc x =
let buf = Buffer.create 256 in
to_buf buf x;
Buffer.output_buffer oc buf
end
(** {2 Stateful Object on the Web} *)
module State = struct
type 'a t = {
mutable content : 'a;
mutable callbacks : ('a -> unit) list;
id : ('a -> string) option;
export : 'a -> HTML.t;
update : (string * string) list -> 'a -> 'a;
} (** A value that can be exposed to the Web.
The [export] function is used to print the current state of
the object into HTML (when requested).
The [update] optional function can be used to update
the value, given a query with parameters. *)
type wrap = Wrap : 'a t -> wrap
(** Hides the type parameter in a GADT. *)
let create ?(update=fun _ x -> x) ?id ~export content = {
content;
export;
id;
callbacks = [];
update;
}
let on_change st f =
st.callbacks <- f :: st.callbacks
let handle_request st req =
let cgi = new CamlGI.Cgi.cgi req in
(* update value? *)
try
let x = st.content in
let params = cgi#params in
(* update [x] using the parameters? *)
let y = st.update params x in
let changed = match st.id with
| None -> x != y
| Some id -> id x <> id y
in
(* notify callbacks that we have a new object *)
if changed then
List.iter (fun f -> f y) st.callbacks;
(* now print [y] *)
(* TODO: add a head, declaration, etc. *)
let html = st.export y in
let final_output = HTML.render html in
(* render output *)
let template = object
method output f = f final_output
end in
cgi#template template
with e ->
let msg = Printf.sprintf "error: %s" (Printexc.to_string e) in
cgi#log msg
end
(** {2 Routing} *)
module Router = struct
type t = {
mutable default : State.wrap;
log : out_channel option;
tbl : (string, State.wrap) Hashtbl.t;
}
let __default =
State.Wrap (State.create ~export:HTML.str "<no default handler>")
let _log router fmt = match router.log with
| None ->
Printf.ifprintf stdout fmt
| Some oc ->
Printf.kfprintf
(fun oc ->
output_char oc '\n';
flush oc)
oc
fmt
let create ?(default=__default) ?log () =
let router = {
default;
log;
tbl = Hashtbl.create 15;
} in
_log router "new router created";
router
let default router default =
router.default <- default
let unregister router name =
Hashtbl.remove router.tbl name
let register ?(weak=false) router name state =
if Hashtbl.mem router.tbl name
then failwith "Router: name already registered"
else begin
Hashtbl.add router.tbl name state;
if weak then match state with
| State.Wrap st ->
Gc.finalise (fun _ -> unregister router name) st.State.content
end
let add_list router l =
List.iter
(fun (name, state) -> register router name state)
l
let to_list router =
Hashtbl.fold
(fun name state acc -> (name,state) :: acc)
router.tbl []
let random_id () =
CamlGI.Cgi.random_sessionid ()
let handle_request router req =
let cgi = new CamlGI.Cgi.cgi req in
let url = cgi#url () in
let st =
try
let last_part_i = String.rindex url '/' in
let last_part = String.sub url (last_part_i+1) (String.length url -last_part_i-1) in
_log router "received request for url /%s" last_part;
Hashtbl.find router.tbl last_part
with Not_found ->
router.default
in
match st with
| State.Wrap st -> State.handle_request st req
end
(** {2 Main Interface} *)
let serve_state ?sockfile ?sockaddr st =
match sockfile with
| None ->
CamlGI.Cgi.register_script ?sockaddr (State.handle_request st)
| Some f ->
let sockaddr = Unix.ADDR_UNIX f in
CamlGI.Cgi.register_script ~sockaddr (State.handle_request st)
let serve_router ?sockfile ?sockaddr router =
match sockfile with
| None ->
CamlGI.Cgi.register_script ?sockaddr (Router.handle_request router)
| Some f ->
let sockaddr = Unix.ADDR_UNIX f in
CamlGI.Cgi.register_script ~sockaddr (Router.handle_request router)

208
cgi/toWeb.mli
View file

@ -1,208 +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 Expose the State of a Program to the Web}
We export some values (and associated functions for converting them to
html, and update them) as a FastCGI interface.
This module depends on CamlGI.
*)
(** {2 Some combinators to build HTML documents} *)
module HTML : sig
type t
(** A html document. Encoding is assumed to be UTF8 for now. *)
val str : string -> t
(** Simple string *)
val bprintf : ('a, Buffer.t, unit, unit) format4 -> t
(** Use a buffer printer to render a string. Shortcut for {!str} *)
val sprintf : ('a, unit, string, unit) format4 -> t
(** Use a string printer to render into a string. Shortcut for {!str} *)
val list : t list -> t
(** Build a list of items *)
val url : ?alt:string -> url:string -> descr:string -> t
(** build an URL tag. *)
val img : ?alt:string -> string -> t
(** Link to an image *)
val append : t -> t -> t
(** Concatenation of two documents *)
val concat : t list -> t
(** Concatenation of html documents *)
val h1 : t -> t
val h2 : t -> t
val h3 : t -> t
val h : int -> t -> t
(** Title of level parametrized by the integer *)
val p : t -> t
(** Paragraph *)
val div : ?id:string -> ?class_:string -> t -> t
(** Div tag, to specify a block *)
val span : ?id:string -> ?class_:string -> t -> t
(** Non semantic tag, mostly useful for CSS *)
val link : rel:string -> url:string -> t
(** Link (for head) *)
val head : t -> t
(** Head part of a document *)
val body : t -> t
(** Body part of a document *)
val html : t -> t
(** The whole document *)
val render : t -> string
(** Print into a string *)
val to_buf : Buffer.t -> t -> unit
(** Print in the buffer *)
val to_chan : out_channel -> t -> unit
(** Print on the channel *)
end
(** {2 Stateful Object on the Web} *)
(** This module defines how to bundle an OCaml value (possibly
stateful) with functions that export it to HTML,
and possibly update it from a CGI request.
*)
module State : sig
type 'a t
(** A value that can be exposed to the web. *)
type wrap = Wrap : 'a t -> wrap
(** Hides the type parameter in a GADT. Useful for {!Router}. *)
val create : ?update:((string*string) list -> 'a -> 'a) ->
?id:('a -> string) ->
export:('a -> HTML.t) ->
'a ->
'a t
(** Create a value that can be exposed to the Web.
@param export function used to print the current state of
the object into HTML (when requested).
@param update optional function that can be used to update
the value, given a query with parameters.
@param id optional function that maps a value to a (unique)
string. Can be used to obtain a unique URL for this value. *)
val on_change : 'a t -> ('a -> unit) -> unit
(** Register a callback that will be called everytime the value
is updated. Physical equality is used to determine whether
the value changed if no [id] function was provided;
otherwise, [id] is used to check whether the old and the new
strings are equal. *)
val handle_request : 'a t -> CamlGI.Cgi.Request.t -> unit
(** Handle the incoming request. It replies to the request by
possibly updating the local state, and
object. *)
end
(** {2 Routing} *)
module Router : sig
type t
(** An URL router. It dispatches incoming requests to registered
{!State.t} values depending on the request's URL. *)
val create : ?default:State.wrap -> ?log:out_channel -> unit -> t
(** New router.
@param log a channel on which to log events (incoming requests)
@param default a default object to expose, for incorrect routes
*)
val default : t -> State.wrap -> unit
(** Set the default handler, for incorrect routes (for which no
object is registered) or for routing the root url *)
val register : ?weak:bool -> t -> string -> State.wrap -> unit
(** Register a state object (see {!State}) under a given path.
Right now routing only dispatches at one level, there is no
tree-like structure, only a flat "directory" of objects.
@param weak (default false) if true, the object will unregister itself
when it's garbage collected. Only works if the type of the wrapped
object is heap allocated.
@raise Failure if the name is already taken
@raise Invalid_argument if [weak] is true and no finalizer can be
registered. *)
val unregister : t -> string -> unit
(** Remove a stateful value *)
val add_list : t -> (string * State.wrap) list -> unit
(** Register several handlers.
@raise Failure if it meets an already registered handler *)
val to_list : t -> (string * State.wrap) list
(** Currently registered objects *)
val random_id : unit -> string
(** Fresh, random ID that can be used for registering temporary objects *)
val handle_request : t -> CamlGI.Cgi.Request.t -> unit
(** Handle the incoming request, by routing to an appropriate
object. *)
end
(** {2 Main interface} *)
(* TODO: interface with {! LazyGraph}. A (string, html.t, string) graph
maps naturally to URLs and simplifies routing. *)
val serve_state : ?sockfile:string -> ?sockaddr:Unix.sockaddr ->
'a State.t -> unit
(** Serve incoming requests using a single object.
@param sockfile the unix file to use as a socket *)
val serve_router : ?sockfile:string -> ?sockaddr:Unix.sockaddr ->
Router.t -> unit
(** Shortcut. It calls {!CamlGI.Cgi.register_script} with a callback
that forwards requests to the given Router.
@param sockfile the unix file to use as a socket *)

112
containers.odocl
View file

@ -1,39 +1,77 @@
# OASIS_START
# DO NOT EDIT (digest: ce652946b9e4e3d4bbad78e220466df8)
core/CCVector
core/CCDeque
core/CCGen
core/Gen_intf
core/CCSequence
core/CCFQueue
core/CCMultiMap
core/CCMultiSet
core/CCBV
core/CCPrint
core/CCPersistentHashtbl
core/CCError
core/CCHeap
core/CCList
core/CCOpt
core/CCPair
core/CCFun
core/CCHash
core/CCKList
core/CCInt
core/CCBool
core/CCFloat
core/CCArray
core/CCOrd
core/CCIO
core/CCRandom
core/CCKTree
core/CCTrie
core/CCString
core/CCHashtbl
core/CCFlatHashtbl
core/CCSexp
core/CCMap
core/CCCache
string/KMP
string/Levenshtein
# DO NOT EDIT (digest: ffa47e180123d84227a563bc0c3e8534)
src/core/CCVector
src/core/CCPrint
src/core/CCError
src/core/CCHeap
src/core/CCList
src/core/CCOpt
src/core/CCPair
src/core/CCFun
src/core/CCHash
src/core/CCInt
src/core/CCBool
src/core/CCFloat
src/core/CCArray
src/core/CCOrd
src/core/CCRandom
src/core/CCString
src/core/CCHashtbl
src/core/CCMap
src/misc/FHashtbl
src/misc/FlatHashtbl
src/misc/Hashset
src/misc/Heap
src/misc/LazyGraph
src/misc/PersistentGraph
src/misc/PHashtbl
src/misc/SkipList
src/misc/SplayTree
src/misc/SplayMap
src/misc/Univ
src/misc/Bij
src/misc/PiCalculus
src/misc/RAL
src/misc/UnionFind
src/misc/SmallSet
src/misc/AbsSet
src/misc/CSM
src/misc/TTree
src/misc/PrintBox
src/misc/HGraph
src/misc/Automaton
src/misc/Conv
src/misc/Bidir
src/misc/Iteratee
src/misc/BTree
src/misc/Ty
src/misc/Cause
src/misc/AVL
src/misc/ParseReact
src/iter/CCKTree
src/iter/CCKList
src/data/CCMultiMap
src/data/CCMultiSet
src/data/CCTrie
src/data/CCFlatHashtbl
src/data/CCCache
src/data/CCPersistentHashtbl
src/data/CCDeque
src/data/CCFQueue
src/data/CCBV
src/data/CCMixtbl
src/string/KMP
src/string/Levenshtein
src/pervasives/CCPervasives
src/bigarray/CCBigstring
src/advanced/CCLinq
src/advanced/CCBatch
src/advanced/CCCat
src/advanced/CCMonadIO
src/io/CCIO
src/sexp/CCSexp
src/sexp/CCSexpStream
src/sexp/CCSexpM
src/lwt/Lwt_automaton
src/lwt/Lwt_actor
# OASIS_STOP

1
core/CCGen.ml
View file

@ -1 +0,0 @@
../gen/gen.ml

105
core/CCGen.mli
View file

@ -1,105 +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 Generators}
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. Most functions consume elements.
The submodule {!Restart} provides utilities to work with
{b restartable generators}, that is, functions [unit -> 'a Gen.t] that
allow to build as many generators from the same source as needed.
*)
(** {2 Global type declarations} *)
type 'a t = unit -> 'a option
(** A generator may be called several times, yielding the next value
each time. It returns [None] when no elements remain *)
type 'a gen = 'a t
(** {b NOTE}: version informations ("@since" annotations) in CCGen_intf
will not be reliable, for they will represent versions of Gen
rather than containers. *)
module type S = Gen_intf.S
(** {2 Transient generators} *)
val get : 'a t -> 'a option
(** Get the next value *)
val next : 'a t -> 'a option
(** Synonym for {!get} *)
val get_exn : 'a t -> 'a
(** Get the next value, or fails
@raise Invalid_argument if no element remains *)
val junk : 'a t -> unit
(** Drop the next value, discarding it. *)
val repeatedly : (unit -> 'a) -> 'a t
(** Call the same function an infinite number of times (useful for instance
if the function is a random generator). *)
include S with type 'a t := 'a gen
(** Operations on {b transient} generators *)
(** {2 Restartable generators} *)
module Restart : sig
type 'a t = unit -> 'a gen
type 'a restartable = 'a t
include S with type 'a t := 'a restartable
val cycle : 'a t -> 'a t
(** Cycle through the enum, endlessly. The enum must not be empty. *)
val lift : ('a gen -> 'b) -> 'a t -> 'b
val lift2 : ('a gen -> 'b gen -> 'c) -> 'a t -> 'b t -> 'c
end
(** {2 Utils} *)
val persistent : 'a t -> 'a Restart.t
(** Store content of the transient generator in memory, to be able to iterate
on it several times later. If possible, consider using combinators
from {!Restart} directly instead. *)
val persistent_lazy : 'a t -> 'a Restart.t
(** Same as {!persistent}, but consumes the generator on demand (by chunks).
This allows to make a restartable generator out of an ephemeral one,
without paying a big cost upfront (nor even consuming it fully).
@since 0.6.1 *)
val start : 'a Restart.t -> 'a t
(** Create a new transient generator.
[start gen] is the same as [gen ()] but is included for readability. *)

1
core/CCSequence.ml
View file

@ -1 +0,0 @@
../sequence/sequence.ml

624
core/CCSequence.mli
View file

@ -1,624 +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 Simple and Efficient Iterators} *)
(** The iterators are designed to allow easy transfer (mappings) between data
structures, without defining [n^2] conversions between the [n] types. The
implementation relies on the assumption that a sequence can be iterated
on as many times as needed; this choice allows for high performance
of many combinators. However, for transient iterators, the {!persistent}
function is provided, storing elements of a transient iterator
in memory; the iterator can then be used several times (See further).
Note that some combinators also return sequences (e.g. {!group}). The
transformation is computed on the fly every time one iterates over
the resulting sequence. If a transformation performs heavy computation,
{!persistent} can also be used as intermediate storage.
Most functions are {b lazy}, i.e. they do not actually use their arguments
until their result is iterated on. For instance, if one calls {!map}
on a sequence, one gets a new sequence, but nothing else happens until
this new sequence is used (by folding or iterating on it).
If a sequence is built from an iteration function that is {b repeatable}
(i.e. calling it several times always iterates on the same set of
elements, for instance List.iter or Map.iter), then
the resulting {!t} object is also repeatable. For {b one-time iter functions}
such as iteration on a file descriptor or a {!Stream},
the {!persistent} function can be used to iterate and store elements in
a memory structure; the result is a sequence that iterates on the elements
of this memory structure, cheaply and repeatably. *)
type +'a t = ('a -> unit) -> unit
(** A sequence of values of type ['a]. If you give it a function ['a -> unit]
it will be applied to every element of the sequence successively. *)
type +'a sequence = 'a t
type (+'a, +'b) t2 = ('a -> 'b -> unit) -> unit
(** Sequence of pairs of values of type ['a] and ['b]. *)
(** {2 Build a sequence} *)
val from_iter : (('a -> unit) -> unit) -> 'a t
(** Build a sequence from a iter function *)
val from_fun : (unit -> 'a option) -> 'a t
(** Call the function repeatedly until it returns None. This
sequence is transient, use {!persistent} if needed! *)
val empty : 'a t
(** Empty sequence. It contains no element. *)
val singleton : 'a -> 'a t
(** Singleton sequence, with exactly one element. *)
val doubleton : 'a -> 'a -> 'a t
(** Sequence with exactly two elements
@since 0.3.4 *)
val cons : 'a -> 'a t -> 'a t
(** [cons x l] yields [x], then yields from [l].
Same as [append (singleton x) l]
@since 0.3.4 *)
val snoc : 'a t -> 'a -> 'a t
(** Same as {!cons} but yields the element after iterating on [l]
@since 0.3.4 *)
val return : 'a -> 'a t
(** Synonym to {!singleton}
@since 0.3.4 *)
val pure : 'a -> 'a t
(** Synonym to {!singleton}
@since 0.3.4 *)
val repeat : 'a -> 'a t
(** Infinite sequence of the same element. You may want to look
at {!take} and the likes if you iterate on it. *)
val iterate : ('a -> 'a) -> 'a -> 'a t
(** [iterate f x] is the infinite sequence [x, f(x), f(f(x)), ...] *)
val forever : (unit -> 'b) -> 'b t
(** Sequence that calls the given function to produce elements.
The sequence may be transient (depending on the function), and definitely
is infinite. You may want to use {!take} and {!persistent}. *)
val cycle : 'a t -> 'a t
(** Cycle forever through the given sequence. Assume the given sequence can
be traversed any amount of times (not transient). This yields an
infinite sequence, you should use something like {!take} not to loop
forever. *)
(** {2 Consume a sequence} *)
val iter : ('a -> unit) -> 'a t -> unit
(** Consume the sequence, passing all its arguments to the function.
Basically [iter f seq] is just [seq f]. *)
val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** Iterate on elements and their index in the sequence *)
val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
(** Fold over elements of the sequence, consuming it *)
val foldi : ('b -> int -> 'a -> 'b) -> 'b -> 'a t -> 'b
(** Fold over elements of the sequence and their index, consuming it *)
val map : ('a -> 'b) -> 'a t -> 'b t
(** Map objects of the sequence into other elements, lazily *)
val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
(** Map objects, along with their index in the sequence *)
val for_all : ('a -> bool) -> 'a t -> bool
(** Do all elements satisfy the predicate? *)
val exists : ('a -> bool) -> 'a t -> bool
(** Exists there some element satisfying the predicate? *)
val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool
(** Is the value a member of the sequence?
@param eq the equality predicate to use (default [(=)])
@since 0.3.4 *)
val find : ('a -> 'b option) -> 'a t -> 'b option
(** Find the first element on which the function doesn't return [None]
@since 0.3.4 *)
val length : 'a t -> int
(** How long is the sequence? Forces the sequence. *)
val is_empty : 'a t -> bool
(** Is the sequence empty? Forces the sequence. *)
(** {2 Transform a sequence} *)
val filter : ('a -> bool) -> 'a t -> 'a t
(** Filter on elements of the sequence *)
val append : 'a t -> 'a t -> 'a t
(** Append two sequences. Iterating on the result is like iterating
on the first, then on the second. *)
val concat : 'a t t -> 'a t
(** Concatenate a sequence of sequences into one sequence. *)
val flatten : 'a t t -> 'a t
(** Alias for {!concat} *)
val flatMap : ('a -> 'b t) -> 'a t -> 'b t
(** Monadic bind. Intuitively, it applies the function to every element of the
initial sequence, and calls {!concat}. *)
val flat_map : ('a -> 'b t) -> 'a t -> 'b t
(** Alias to {!flatMap} with a more explicit name
@since 0.3.4 *)
val fmap : ('a -> 'b option) -> 'a t -> 'b t
(** Specialized version of {!flatMap} for options. *)
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
(** Alias to {!fmap} with a more explicit name
@since 0.3.4 *)
val intersperse : 'a -> 'a t -> 'a t
(** Insert the single element between every element of the sequence *)
(** {2 Caching} *)
val persistent : 'a t -> 'a t
(** Iterate on the sequence, storing elements in an efficient internal structure..
The resulting sequence can be iterated on as many times as needed.
{b Note}: calling persistent on an already persistent sequence
will still make a new copy of the sequence! *)
val persistent_lazy : 'a t -> 'a t
(** Lazy version of {!persistent}. When calling [persistent_lazy s],
a new sequence [s'] is immediately returned (without actually consuming
[s]) in constant time; the first time [s'] is iterated on,
it also consumes [s] and caches its content into a inner data
structure that will back [s'] for future iterations.
{b warning}: on the first traversal of [s'], if the traversal
is interrupted prematurely ({!take}, etc.) then [s'] will not be
memorized, and the next call to [s'] will traverse [s] again.
@since 0.3.4 *)
(** {2 Misc} *)
val sort : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
(** Sort the sequence. Eager, O(n) ram and O(n ln(n)) time.
It iterates on elements of the argument sequence immediately,
before it sorts them. *)
val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
(** Sort the sequence and remove duplicates. Eager, same as [sort] *)
val group : ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t
(** Group equal consecutive elements. *)
val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t
(** Remove consecutive duplicate elements. Basically this is
like [fun seq -> map List.hd (group seq)]. *)
val product : 'a t -> 'b t -> ('a * 'b) t
(** Cartesian product of the sequences. When calling [product a b],
the caller {b MUST} ensure that [b] can be traversed as many times
as required (several times), possibly by calling {!persistent} on it
beforehand. *)
val product2 : 'a t -> 'b t -> ('a, 'b) t2
(** Binary version of {!product}. Same requirements.
@since 0.3.4 *)
val join : join_row:('a -> 'b -> 'c option) -> 'a t -> 'b t -> 'c t
(** [join ~join_row a b] combines every element of [a] with every
element of [b] using [join_row]. If [join_row] returns None, then
the two elements do not combine. Assume that [b] allows for multiple
iterations. *)
val unfoldr : ('b -> ('a * 'b) option) -> 'b -> 'a t
(** [unfoldr f b] will apply [f] to [b]. If it
yields [Some (x,b')] then [x] is returned
and unfoldr recurses with [b']. *)
val scan : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b t
(** Sequence of intermediate results *)
val max : ?lt:('a -> 'a -> bool) -> 'a t -> 'a option
(** Max element of the sequence, using the given comparison function.
@return None if the sequence is empty, Some [m] where [m] is the maximal
element otherwise *)
val min : ?lt:('a -> 'a -> bool) -> 'a t -> 'a option
(** Min element of the sequence, using the given comparison function.
see {!max} for more details. *)
val head : 'a t -> 'a option
(** First element, if any, otherwise [None]
@since 0.3.4 *)
val head_exn : 'a t -> 'a
(** First element, if any, fails
@raise Invalid_argument if the sequence is empty
@since 0.3.4 *)
val take : int -> 'a t -> 'a t
(** Take at most [n] elements from the sequence. Works on infinite
sequences. *)
val take_while : ('a -> bool) -> 'a t -> 'a t
(** Take elements while they satisfy the predicate, then stops iterating.
Will work on an infinite sequence [s] if the predicate is false for at
least one element of [s].
@since 0.3.4 *)
val drop : int -> 'a t -> 'a t
(** Drop the [n] first elements of the sequence. Lazy. *)
val drop_while : ('a -> bool) -> 'a t -> 'a t
(** Predicate version of {!drop}
@since 0.3.4 *)
val rev : 'a t -> 'a t
(** Reverse the sequence. O(n) memory and time, needs the
sequence to be finite. The result is persistent and does
not depend on the input being repeatable. *)
(** {2 Binary sequences} *)
val empty2 : ('a, 'b) t2
val is_empty2 : (_, _) t2 -> bool
val length2 : (_, _) t2 -> int
val zip : ('a, 'b) t2 -> ('a * 'b) t
val unzip : ('a * 'b) t -> ('a, 'b) t2
val zip_i : 'a t -> (int, 'a) t2
(** Zip elements of the sequence with their index in the sequence *)
val fold2 : ('c -> 'a -> 'b -> 'c) -> 'c -> ('a, 'b) t2 -> 'c
val iter2 : ('a -> 'b -> unit) -> ('a, 'b) t2 -> unit
val map2 : ('a -> 'b -> 'c) -> ('a, 'b) t2 -> 'c t
val map2_2 : ('a -> 'b -> 'c) -> ('a -> 'b -> 'd) -> ('a, 'b) t2 -> ('c, 'd) t2
(** [map2_2 f g seq2] maps each [x, y] of seq2 into [f x y, g x y] *)
(** {2 Basic data structures converters} *)
val to_list : 'a t -> 'a list
(** Convert the sequence into a list. Preserves order of elements.
This function is tail-recursive, but consumes 2*n memory.
If order doesn't matter to you, consider {!to_rev_list}. *)
val to_rev_list : 'a t -> 'a list
(** Get the list of the reversed sequence (more efficient than {!to_list}) *)
val of_list : 'a list -> 'a t
val on_list : ('a t -> 'b t) -> 'a list -> 'b list
(** [on_list f l] is equivalent to [to_list @@ f @@ of_list l].
@since 0.3.4
*)
val to_opt : 'a t -> 'a option
(** Alias to {!head}
@since 0.3.4 *)
val to_array : 'a t -> 'a array
(** Convert to an array. Currently not very efficient because
an intermediate list is used. *)
val of_array : 'a array -> 'a t
val of_array_i : 'a array -> (int * 'a) t
(** Elements of the array, with their index *)
val of_array2 : 'a array -> (int, 'a) t2
val array_slice : 'a array -> int -> int -> 'a t
(** [array_slice a i j] Sequence of elements whose indexes range
from [i] to [j] *)
val of_opt : 'a option -> 'a t
(** Iterate on 0 or 1 values.
@since 0.3.4 *)
val of_stream : 'a Stream.t -> 'a t
(** Sequence of elements of a stream (usable only once) *)
val to_stream : 'a t -> 'a Stream.t
(** Convert to a stream. linear in memory and time (a copy is made in memory) *)
val to_stack : 'a Stack.t -> 'a t -> unit
(** Push elements of the sequence on the stack *)
val of_stack : 'a Stack.t -> 'a t
(** Sequence of elements of the stack (same order as [Stack.iter]) *)
val to_queue : 'a Queue.t -> 'a t -> unit
(** Push elements of the sequence into the queue *)
val of_queue : 'a Queue.t -> 'a t
(** Sequence of elements contained in the queue, FIFO order *)
val hashtbl_add : ('a, 'b) Hashtbl.t -> ('a * 'b) t -> unit
(** Add elements of the sequence to the hashtable, with
Hashtbl.add *)
val hashtbl_replace : ('a, 'b) Hashtbl.t -> ('a * 'b) t -> unit
(** Add elements of the sequence to the hashtable, with
Hashtbl.replace (erases conflicting bindings) *)
val to_hashtbl : ('a * 'b) t -> ('a, 'b) Hashtbl.t
(** Build a hashtable from a sequence of key/value pairs *)
val to_hashtbl2 : ('a, 'b) t2 -> ('a, 'b) Hashtbl.t
(** Build a hashtable from a sequence of key/value pairs *)
val of_hashtbl : ('a, 'b) Hashtbl.t -> ('a * 'b) t
(** Sequence of key/value pairs from the hashtable *)
val of_hashtbl2 : ('a, 'b) Hashtbl.t -> ('a, 'b) t2
(** Sequence of key/value pairs from the hashtable *)
val hashtbl_keys : ('a, 'b) Hashtbl.t -> 'a t
val hashtbl_values : ('a, 'b) Hashtbl.t -> 'b t
val of_str : string -> char t
val to_str : char t -> string
val concat_str : string t -> string
(** Concatenate strings together, eagerly.
Also see {!intersperse} to add a separator.
@since 0.3.4 *)
exception OneShotSequence
(** Raised when the user tries to iterate several times on
a transient iterator *)
val of_in_channel : in_channel -> char t
(** Iterates on characters of the input (can block when one
iterates over the sequence). If you need to iterate
several times on this sequence, use {!persistent}.
@raise OneShotSequence when used more than once. *)
val to_buffer : char t -> Buffer.t -> unit
(** Copy content of the sequence into the buffer *)
val int_range : start:int -> stop:int -> int t
(** Iterator on integers in [start...stop] by steps 1. Also see
{!(--)} for an infix version. *)
val int_range_dec : start:int -> stop:int -> int t
(** Iterator on decreasing integers in [stop...start] by steps -1.
See {!(--^)} for an infix version *)
val of_set : (module Set.S with type elt = 'a and type t = 'b) -> 'b -> 'a t
(** Convert the given set to a sequence. The set module must be provided. *)
val to_set : (module Set.S with type elt = 'a and type t = 'b) -> 'a t -> 'b
(** Convert the sequence to a set, given the proper set module *)
type 'a gen = unit -> 'a option
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
val of_gen : 'a gen -> 'a t
(** Traverse eagerly the generator and build a sequence from it *)
val to_gen : 'a t -> 'a gen
(** Make the sequence persistent (O(n)) and then iterate on it. Eager. *)
val of_klist : 'a klist -> 'a t
(** Iterate on the lazy list *)
val to_klist : 'a t -> 'a klist
(** Make the sequence persistent and then iterate on it. Eager. *)
(** {2 Functorial conversions between sets and sequences} *)
module Set : sig
module type S = sig
include Set.S
val of_seq : elt sequence -> t
val to_seq : t -> elt sequence
val to_list : t -> elt list
(** @since 0.3.4 *)
val of_list : elt list -> t
(** @since 0.3.4 *)
end
(** Create an enriched Set module from the given one *)
module Adapt(X : Set.S) : S with type elt = X.elt and type t = X.t
(** Functor to build an extended Set module from an ordered type *)
module Make(X : Set.OrderedType) : S with type elt = X.t
end
(** {2 Conversion between maps and sequences.} *)
module Map : sig
module type S = sig
include Map.S
val to_seq : 'a t -> (key * 'a) sequence
val of_seq : (key * 'a) sequence -> 'a t
val keys : 'a t -> key sequence
val values : 'a t -> 'a sequence
val to_list : 'a t -> (key * 'a) list
(** @since 0.3.4 *)
val of_list : (key * 'a) list -> 'a t
(** @since 0.3.4 *)
end
(** Adapt a pre-existing Map module to make it sequence-aware *)
module Adapt(M : Map.S) : S with type key = M.key and type 'a t = 'a M.t
(** Create an enriched Map module, with sequence-aware functions *)
module Make(V : Map.OrderedType) : S with type key = V.t
end
(** {2 Infinite sequences of random values} *)
val random_int : int -> int t
(** Infinite sequence of random integers between 0 and
the given higher bound (see Random.int) *)
val random_bool : bool t
(** Infinite sequence of random bool values *)
val random_float : float -> float t
val random_array : 'a array -> 'a t
(** Sequence of choices of an element in the array *)
val random_list : 'a list -> 'a t
(** Infinite sequence of random elements of the list. Basically the
same as {!random_array}. *)
(** {2 Infix functions} *)
module Infix : sig
val (--) : int -> int -> int t
(** [a -- b] is the range of integers from [a] to [b], both included,
in increasing order. It will therefore be empty if [a > b]. *)
val (--^) : int -> int -> int t
(** [a --^ b] is the range of integers from [b] to [a], both included,
in decreasing order (starts from [a]).
It will therefore be empty if [a < b]. *)
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
(** Monadic bind (infix version of {!flat_map}
@since 0.3.4 *)
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
(** Infix version of {!map}
@since 0.3.4 *)
val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
(** Applicative operator (product+application)
@since 0.3.4 *)
val (<+>) : 'a t -> 'a t -> 'a t
(** Concatenation of sequences
@since 0.3.4 *)
end
include module type of Infix
(** {2 Pretty printing of sequences} *)
val pp_seq : ?sep:string -> (Format.formatter -> 'a -> unit) ->
Format.formatter -> 'a t -> unit
(** Pretty print a sequence of ['a], using the given pretty printer
to print each elements. An optional separator string can be provided. *)
val pp_buf : ?sep:string -> (Buffer.t -> 'a -> unit) ->
Buffer.t -> 'a t -> unit
(** Print into a buffer *)
val to_string : ?sep:string -> ('a -> string) -> 'a t -> string
(** Print into a string *)
(** {2 Basic IO}
Very basic interface to manipulate files as sequence of chunks/lines. The
sequences take care of opening and closing files properly; every time
one iterates over a sequence, the file is opened/closed again.
Example: copy a file ["a"] into file ["b"], removing blank lines:
{[
Sequence.(IO.lines_of "a" |> filter (fun l-> l<> "") |> IO.write_lines "b");;
]}
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.3.4 *)
module IO : sig
val lines_of : ?mode:int -> ?flags:open_flag list ->
string -> string t
(** [lines_of filename] reads all lines of the given file. It raises the
same exception as would opening the file and read from it, except
from [End_of_file] (which is caught). The file is {b always} properly
closed.
Every time the sequence is iterated on, the file is opened again, so
different iterations might return different results
@param mode default [0o644]
@param flags default: [[Open_rdonly]] *)
val chunks_of : ?mode:int -> ?flags:open_flag list -> ?size:int ->
string -> string t
(** Read chunks of the given [size] from the file. The last chunk might be
smaller. Behaves like {!lines_of} regarding errors and options.
Every time the sequence is iterated on, the file is opened again, so
different iterations might return different results *)
val write_to : ?mode:int -> ?flags:open_flag list ->
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 *)
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 0.5 *)
end

1
core/Gen_intf.ml
View file

@ -1 +0,0 @@
../gen/gen_intf.ml

26
doc/build_deps.ml Executable file
View file

@ -0,0 +1,26 @@
#!/usr/bin/env ocaml
#use "topfind";;
#require "containers";;
#require "containers.io";;
#require "gen";;
#require "unix";;
let odoc_files =
CCIO.File.walk "_build"
|> Gen.filter_map
(function
| `File, f when CCString.suffix ~suf:".odoc" f -> Some f
| _ -> None
)
|> Gen.flat_map
(fun f -> Gen.of_list ["-load"; f])
|> Gen.to_list
;;
let cmd =
"ocamldoc -dot -o deps.dot " ^ String.concat " " odoc_files
;;
print_endline ("run: " ^ cmd);;
Unix.system cmd;;

137
doc/intro.txt Normal file
View file

@ -0,0 +1,137 @@
{1 Containers}
{2 Change Log}
See {{: https://github.com/c-cube/ocaml-containers/blob/master/CHANGELOG.md } this file}
{2 License}
This code is free, under the BSD license.
The logo (media/logo.png) is
CC-SA3 {{:http://en.wikipedia.org/wiki/File:Hypercube.svg} wikimedia}
{2 Contents}
The design is mostly centered around polymorphism rather than functors. Such
structures comprise (some modules in misc/, some other in core/):
the core library, containers, now depends on
{{:https://github.com/mjambon/cppo}cppo} and base-bytes (provided
by ocamlfind).
{4 Core Modules (extension of the standard library)}
{!modules:
CCArray
CCBool
CCError
CCFloat
CCFun
CCHash
CCHeap
CCInt
CCList
CCOpt
CCOrd
CCPair
CCPrint
CCRandom
CCString
CCVector
}
{4 Pervasives (aliases to Core Modules)}
Contains aliases to most modules from {i containers core}, and mixins
such as:
{[ module List = struct
include List
include CCList
end
]}
{!modules: CCPervasives}
{4 Containers.data}
Various data structures.
{!modules:
CCBV
CCCache
CCFQueue
CCFlatHashtbl
CCMixtbl
CCMultiMap
CCMultiSet
CCPersistentHashtbl
CCTrie
}
{4 Containers.io}
Helpers to perform simple IO (mostly on files) and iterate on channels.
{!modules: CCIO}
{4 Containers.sexp}
A small S-expression library. The interface is relatively unstable, but
the main type ([CCSexp.t]) isn't.
{!modules: CCSexp CCSexpStream CCSexpM}
{4 Containers.iter}
Iterators:
{!modules: CCKList CCKTree}
{4 String}
{!modules: Levenshtein KMP}
{4 Bigarrays}
Use bigarrays to hold large strings and map files directly into memory.
{!modules: CCBigstring}
{4 Advanced}
This module is qualified with [Containers_advanced].
{!modules: CCLinq CCCat CCBatch}
{4 Misc}
This list is not necessarily up-to-date.
{!modules:
AbsSet
Bij
FlatHashtbl
Hashset
Heap
Heap
LazyGraph
PHashtbl
PrintBox
RAL
SmallSet
SplayMap
SplayTree
UnionFind
Univ
}
{4 Others}
{!modules: CCFuture}
{2 Index}
{!indexlist}

4
examples/id_sexp.ml
View file

@ -3,11 +3,11 @@
let () =
if Array.length Sys.argv <> 2 then failwith "usage: id_sexp file";
let f = Sys.argv.(1) in
let s = CCSexp.L.of_file f in
let s = CCSexpStream.L.of_file f in
match s with
| `Ok l ->
List.iter
(fun s -> Format.printf "@[%a@]@." CCSexp.print s)
(fun s -> Format.printf "@[%a@]@." CCSexpStream.print s)
l
| `Error msg ->
Format.printf "error: %s@." msg

13
examples/id_sexp2.ml Normal file
View file

@ -0,0 +1,13 @@
let () =
if Array.length Sys.argv <> 2 then failwith "usage: id_sexp file";
let f = Sys.argv.(1) in
let s = CCSexpM.parse_file_list f in
match s with
| `Ok l ->
List.iter
(fun s -> Format.printf "@[%a@]@." CCSexpM.print s)
l
| `Error msg ->
Format.printf "error: %s@." msg

2
examples/mem_size.ml
View file

@ -1,7 +1,7 @@
(** Compute the memory footprint of a value (and its subvalues). Reference is
http://rwmj.wordpress.com/2009/08/05/ocaml-internals-part-2-strings-and-other-types/ *)
module Sequence = CCSequence
(** A graph vertex is an Obj.t value *)
let graph =

11
gen/.gitignore vendored
View file

@ -1,11 +0,0 @@
.*.swp
.*.swo
_build
*.native
*.byte
.session
TAGS
*.docdir
setup.log
setup.data
qtest

5
gen/.merlin
View file

@ -1,5 +0,0 @@
S .
B _build
S tests
B _build/tests
PKG oUnit

11
gen/META
View file

@ -1,11 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: c6b7b0973d898c3e8b7f565b701ee0d0)
version = "0.2.2"
description = "Simple, efficient iterators for OCaml"
archive(byte) = "gen.cma"
archive(byte, plugin) = "gen.cma"
archive(native) = "gen.cmxa"
archive(native, plugin) = "gen.cmxs"
exists_if = "gen.cma"
# OASIS_STOP

59
gen/Makefile
View file

@ -1,59 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: a3c674b4239234cbbe53afe090018954)
SETUP = ocaml setup.ml
build: setup.data
$(SETUP) -build $(BUILDFLAGS)
doc: setup.data build
$(SETUP) -doc $(DOCFLAGS)
test: setup.data build
$(SETUP) -test $(TESTFLAGS)
all:
$(SETUP) -all $(ALLFLAGS)
install: setup.data
$(SETUP) -install $(INSTALLFLAGS)
uninstall: setup.data
$(SETUP) -uninstall $(UNINSTALLFLAGS)
reinstall: setup.data
$(SETUP) -reinstall $(REINSTALLFLAGS)
clean:
$(SETUP) -clean $(CLEANFLAGS)
distclean:
$(SETUP) -distclean $(DISTCLEANFLAGS)
setup.data:
$(SETUP) -configure $(CONFIGUREFLAGS)
configure:
$(SETUP) -configure $(CONFIGUREFLAGS)
.PHONY: build doc test all install uninstall reinstall clean distclean configure
# OASIS_STOP
push_doc: all doc
scp -r gen.docdir/* cedeela.fr:~/simon/root/software/gen/
qtest-gen:
mkdir -p qtest
qtest extract gen.ml > qtest/run_qtest.ml
test-all:
./run_tests.native
./run_qtest.native
VERSION=$(shell awk '/^Version:/ {print $$2}' _oasis)
update_next_tag:
@echo "update version to $(VERSION)..."
sed -i "s/NEXT_VERSION/$(VERSION)/g" *.ml *.mli
sed -i "s/NEXT_RELEASE/$(VERSION)/g" *.ml *.mli

32
gen/README.md
View file

@ -1,32 +0,0 @@
Gen
===
Iterators for OCaml, both restartable and consumable. Performances should
be good, yet the code is simple and straightforward.
The documentation can be found [here](http://cedeela.fr/~simon/software/gen)
## Use
You can either build and install the library (see `Build`), or just copy
files to your own project. The last solution has the benefits that you
don't have additional dependencies nor build complications (and it may enable
more inlining). I therefore recommand it for its simplicity.
If you have comments, requests, or bugfixes, please share them! :-)
## Build
There are no dependencies. This should work with OCaml>=3.12.
$ make
To build and run tests (requires `oUnit`):
$ opam install oUnit
$ make tests
$ ./tests.native
## License
This code is free, under the BSD license.

65
gen/_oasis
View file

@ -1,65 +0,0 @@
OASISFormat: 0.3
Name: gen
Version: 0.2.2
Homepage: https://github.com/c-cube/gen
Authors: Simon Cruanes
License: BSD3
LicenseFile: LICENSE
Plugins: META (0.3), DevFiles (0.3)
BuildTools: ocamlbuild
Synopsis: Simple, efficient iterators for OCaml
Flag "bench"
Description: build benchmark
Default: false
Library "gen"
Path: .
Pack: false
Modules: Gen, Gen_intf
Document gen
Title: Containers docs
Type: ocamlbuild (0.3)
BuildTools+: ocamldoc
Install: true
XOCamlbuildPath: .
XOCamlbuildLibraries: gen
PreBuildCommand: make qtest-gen
Executable run_tests
Path: tests/
Install: false
CompiledObject: native
MainIs: run_tests.ml
Build$: flag(tests)
BuildDepends: gen,oUnit
Executable run_qtest
Path: qtest/
Install: false
CompiledObject: native
MainIs: run_qtest.ml
Build$: flag(tests)
BuildDepends: containers, containers.misc, containers.string,
oUnit, QTest2Lib
Test all
Command: make test-all
TestTools: run_tests, run_qtest
Run$: flag(tests)
Executable bench_persistent
Path: bench/
Install: false
CompiledObject: native
MainIs: bench_persistent.ml
Build$: flag(bench)
BuildDepends: gen,benchmark
SourceRepository head
Type: git
Location: https://github.com/c-cube/gen
Browser: https://github.com/c-cube/gen/tree/master/src

43
gen/_tags
View file

@ -1,43 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: a9f4ed4316e4221c9e3cad121ae7a8a9)
# 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
".bzr": not_hygienic
".hg": -traverse
".hg": not_hygienic
".git": -traverse
".git": not_hygienic
"_darcs": -traverse
"_darcs": not_hygienic
# Library gen
"gen.cmxs": use_gen
# Executable run_tests
"tests/run_tests.native": pkg_oUnit
"tests/run_tests.native": use_gen
<tests/*.ml{,i,y}>: pkg_oUnit
<tests/*.ml{,i,y}>: use_gen
# Executable run_qtest
"qtest/run_qtest.native": pkg_QTest2Lib
"qtest/run_qtest.native": pkg_containers
"qtest/run_qtest.native": pkg_containers.misc
"qtest/run_qtest.native": pkg_containers.string
"qtest/run_qtest.native": pkg_oUnit
<qtest/*.ml{,i,y}>: pkg_QTest2Lib
<qtest/*.ml{,i,y}>: pkg_containers
<qtest/*.ml{,i,y}>: pkg_containers.misc
<qtest/*.ml{,i,y}>: pkg_containers.string
<qtest/*.ml{,i,y}>: pkg_oUnit
# Executable bench_persistent
"bench/bench_persistent.native": pkg_benchmark
"bench/bench_persistent.native": use_gen
<bench/*.ml{,i,y}>: pkg_benchmark
<bench/*.ml{,i,y}>: use_gen
# OASIS_STOP
"qtest": include
<**/*.ml>: warn_A, warn(-4), warn(-44)

4
gen/bench/.merlin
View file

@ -1,4 +0,0 @@
S .
B ../_build/bench/
REC
PKG benchmark

161
gen/bench/bench_persistent.ml
View file

@ -1,161 +0,0 @@
let _sum g =
Gen.Restart.fold (+) 0 g
module MList = struct
type 'a t = 'a node option ref
and 'a node = {
content : 'a;
mutable prev : 'a node;
mutable next : 'a node;
}
let create () = ref None
let is_empty d =
match !d with
| None -> true
| Some _ -> false
let push_back d x =
match !d with
| None ->
let rec elt = {
content = x; prev = elt; next = elt; } in
d := Some elt
| Some first ->
let elt = { content = x; next=first; prev=first.prev; } in
first.prev.next <- elt;
first.prev <- elt
(* conversion to gen *)
let to_gen d =
fun () ->
match !d with
| None -> (fun () -> None)
| Some first ->
let cur = ref first in (* current element of the list *)
let stop = ref false in (* are we done yet? *)
fun () ->
if !stop then None
else begin
let x = (!cur).content in
cur := (!cur).next;
(if !cur == first then stop := true); (* EOG, we made a full cycle *)
Some x
end
end
(** Store content of the generator in an enum *)
let persistent_mlist gen =
let l = MList.create () in
Gen.iter (MList.push_back l) gen;
MList.to_gen l
let bench_mlist n =
for _i = 0 to 100 do
let g = persistent_mlist Gen.(1 -- n) in
ignore (_sum g)
done
(** {6 Unrolled mutable list} *)
module UnrolledList = struct
type 'a node =
| Nil
| Partial of 'a array * int
| Cons of 'a array * 'a node ref
let of_gen gen =
let start = ref Nil in
let chunk_size = ref 16 in
let rec fill prev cur =
match cur, gen() with
| Partial (a,n), None ->
prev := Cons (Array.sub a 0 n, ref Nil); () (* done *)
| _, None -> prev := cur; () (* done *)
| Nil, Some x ->
let n = !chunk_size in
if n < 4096 then chunk_size := 2 * !chunk_size;
fill prev (Partial (Array.make n x, 1))
| Partial (a, n), Some x ->
assert (n < Array.length a);
a.(n) <- x;
if n+1 = Array.length a
then begin
let r = ref Nil in
prev := Cons(a, r);
fill r Nil
end else fill prev (Partial (a, n+1))
| Cons _, _ -> assert false
in
fill start !start ;
!start
let to_gen l () =
let cur = ref l in
let i = ref 0 in
let rec next() = match !cur with
| Nil -> None
| Cons (a,l') ->
if !i = Array.length a
then begin
cur := !l';
i := 0;
next()
end else begin
let y = a.(!i) in
incr i;
Some y
end
| Partial _ -> assert false
in
next
end
(** Store content of the generator in an enum *)
let persistent_unrolled gen =
let l = UnrolledList.of_gen gen in
UnrolledList.to_gen l
let bench_unrolled n =
for _i = 0 to 100 do
let g = persistent_unrolled Gen.(1 -- n) in
ignore (_sum g)
done
let bench_naive n =
for _i = 0 to 100 do
let l = Gen.to_rev_list Gen.(1 -- n) in
let g = Gen.Restart.of_list (List.rev l) in
ignore (_sum g)
done
let bench_current n =
for _i = 0 to 100 do
let g = Gen.persistent Gen.(1 -- n) in
ignore (_sum g)
done
let bench_current_lazy n =
for _i = 0 to 100 do
let g = Gen.persistent_lazy Gen.(1 -- n) in
ignore (_sum g)
done
let () =
let bench_n n =
Printf.printf "BENCH for %d\n" n;
let res = Benchmark.throughputN 5
[ "mlist", bench_mlist, n
; "naive", bench_naive, n
; "unrolled", bench_unrolled, n
; "current", bench_current, n
; "current_lazy", bench_current_lazy, n
]
in Benchmark.tabulate res
in
bench_n 100;
bench_n 100_000;
()

27
gen/configure vendored
View file

@ -1,27 +0,0 @@
#!/bin/sh
# OASIS_START
# DO NOT EDIT (digest: dc86c2ad450f91ca10c931b6045d0499)
set -e
FST=true
for i in "$@"; do
if $FST; then
set --
FST=false
fi
case $i in
--*=*)
ARG=${i%%=*}
VAL=${i##*=}
set -- "$@" "$ARG" "$VAL"
;;
*)
set -- "$@" "$i"
;;
esac
done
ocaml setup.ml -configure "$@"
# OASIS_STOP

1669
gen/gen.ml
View file

File diff suppressed because it is too large Load diff

5
gen/gen.mldylib
View file

@ -1,5 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: f69818d114f140be18d72c90abdc60e8)
Gen
Gen_intf
# OASIS_STOP

102
gen/gen.mli
View file

@ -1,102 +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 Generators}
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.
The submodule {!Restart} provides utilities to work with
{b restartable generators}, that is, functions [unit -> 'a Gen.t] that
allow to build as many generators from the same source as needed.
*)
(** {2 Global type declarations} *)
type 'a t = unit -> 'a option
(** A generator may be called several times, yielding the next value
each time. It returns [None] when no elements remain *)
type 'a gen = 'a t
module type S = Gen_intf.S
(** {2 Transient generators} *)
val get : 'a t -> 'a option
(** Get the next value *)
val next : 'a t -> 'a option
(** Synonym for {!get} *)
val get_exn : 'a t -> 'a
(** Get the next value, or fails
@raise Invalid_argument if no element remains *)
val junk : 'a t -> unit
(** Drop the next value, discarding it. *)
val repeatedly : (unit -> 'a) -> 'a t
(** Call the same function an infinite number of times (useful for instance
if the function is a random generator). *)
include S with type 'a t := 'a gen
(** Operations on {b transient} generators *)
(** {2 Restartable generators} *)
module Restart : sig
type 'a t = unit -> 'a gen
type 'a restartable = 'a t
include S with type 'a t := 'a restartable
val cycle : 'a t -> 'a t
(** Cycle through the enum, endlessly. The enum must not be empty. *)
val lift : ('a gen -> 'b) -> 'a t -> 'b
val lift2 : ('a gen -> 'b gen -> 'c) -> 'a t -> 'b t -> 'c
end
(** {2 Utils} *)
val persistent : 'a t -> 'a Restart.t
(** Store content of the transient generator in memory, to be able to iterate
on it several times later. If possible, consider using combinators
from {!Restart} directly instead. *)
val persistent_lazy : 'a t -> 'a Restart.t
(** Same as {!persistent}, but consumes the generator on demand (by chunks).
This allows to make a restartable generator out of an ephemeral one,
without paying a big cost upfront (nor even consuming it fully).
@since 0.2.2 *)
val start : 'a Restart.t -> 'a t
(** Create a new transient generator.
[start gen] is the same as [gen ()] but is included for readability. *)

5
gen/gen.mllib
View file

@ -1,5 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: f69818d114f140be18d72c90abdc60e8)
Gen
Gen_intf
# OASIS_STOP

5
gen/gen.odocl
View file

@ -1,5 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: f69818d114f140be18d72c90abdc60e8)
Gen
Gen_intf
# OASIS_STOP

321
gen/gen_intf.ml
View file

@ -1,321 +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 Common signature for transient and restartable generators}
The signature {!S} abstracts on a type ['a t], where the [t] can be
the type of transient or restartable generators. Some functions specify
explicitely that they use ['a gen] (transient generators). *)
type 'a gen = unit -> 'a option
module type S = sig
type 'a t
val empty : 'a t
(** Empty generator, with no elements *)
val singleton : 'a -> 'a t
(** One-element generator *)
val repeat : 'a -> 'a t
(** Repeat same element endlessly *)
val iterate : 'a -> ('a -> 'a) -> 'a t
(** [iterate x f] is [[x; f x; f (f x); f (f (f x)); ...]] *)
val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t
(** Dual of {!fold}, with a deconstructing operation. It keeps on
unfolding the ['b] value into a new ['b], and a ['a] which is yielded,
until [None] is returned. *)
val init : ?limit:int -> (int -> 'a) -> 'a t
(** Calls the function, starting from 0, on increasing indices.
If [limit] is provided and is a positive int, iteration will
stop at the limit (excluded).
For instance [init ~limit:4 id] will yield 0, 1, 2, and 3. *)
(** {2 Basic combinators} *)
val is_empty : _ t -> bool
(** Check whether the enum is empty. Pops an element, if any *)
val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
(** Fold on the generator, tail-recursively. Consumes the generator. *)
val reduce : ('a -> 'a -> 'a) -> 'a t -> 'a
(** Fold on non-empty sequences. Consumes the generator.
@raise Invalid_argument on an empty gen *)
val scan : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b t
(** Like {!fold}, but keeping successive values of the accumulator.
Consumes the generator. *)
val unfold_scan : ('b -> 'a -> 'b * 'c) -> 'b -> 'a t -> 'c t
(** A mix of {!unfold} and {!scan}. The current state is combined with
the current element to produce a new state, and an output value
of type 'c.
@since 0.2.2 *)
val iter : ('a -> unit) -> 'a t -> unit
(** Iterate on the enum, consumes it. *)
val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** Iterate on elements with their index in the enum, from 0, consuming it. *)
val length : _ t -> int
(** Length of an enum (linear time), consuming it *)
val map : ('a -> 'b) -> 'a t -> 'b t
(** Lazy map. No iteration is performed now, the function will be called
when the result is traversed. *)
val append : 'a t -> 'a t -> 'a t
(** Append the two enums; the result contains the elements of the first,
then the elements of the second enum. *)
val flatten : 'a gen t -> 'a t
(** Flatten the enumeration of generators *)
val flat_map : ('a -> 'b gen) -> 'a t -> 'b t
(** Monadic bind; each element is transformed to a sub-enum
which is then iterated on, before the next element is processed,
and so on. *)
val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool
(** Is the given element, member of the enum? *)
val take : int -> 'a t -> 'a t
(** Take at most n elements *)
val drop : int -> 'a t -> 'a t
(** Drop n elements *)
val nth : int -> 'a t -> 'a
(** n-th element, or Not_found
@raise Not_found if the generator contains less than [n] arguments *)
val take_nth : int -> 'a t -> 'a t
(** [take_nth n g] returns every element of [g] whose index
is a multiple of [n]. For instance [take_nth 2 (1--10) |> to_list]
will return [1;3;5;7;9] *)
val filter : ('a -> bool) -> 'a t -> 'a t
(** Filter out elements that do not satisfy the predicate. *)
val take_while : ('a -> bool) -> 'a t -> 'a t
(** Take elements while they satisfy the predicate *)
val drop_while : ('a -> bool) -> 'a t -> 'a t
(** Drop elements while they satisfy the predicate *)
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
(** Maps some elements to 'b, drop the other ones *)
val zip_index : 'a t -> (int * 'a) t
(** Zip elements with their index in the enum *)
val unzip : ('a * 'b) t -> 'a t * 'b t
(** Unzip into two sequences, splitting each pair *)
val partition : ('a -> bool) -> 'a t -> 'a t * 'a t
(** [partition p l] returns the elements that satisfy [p],
and the elements that do not satisfy [p] *)
val for_all : ('a -> bool) -> 'a t -> bool
(** Is the predicate true for all elements? *)
val exists : ('a -> bool) -> 'a t -> bool
(** Is the predicate true for at least one element? *)
val min : ?lt:('a -> 'a -> bool) -> 'a t -> 'a
(** Minimum element, according to the given comparison function.
@raise Invalid_argument if the generator is empty *)
val max : ?lt:('a -> 'a -> bool) -> 'a t -> 'a
(** Maximum element, see {!min}
@raise Invalid_argument if the generator is empty *)
val eq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
(** Equality of generators. *)
val lexico : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
(** Lexicographic comparison of generators. If a generator is a prefix
of the other one, it is considered smaller. *)
val compare : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int
(** Synonym for {! lexico} *)
val find : ('a -> bool) -> 'a t -> 'a option
(** [find p e] returns the first element of [e] to satisfy [p],
or None. *)
val sum : int t -> int
(** Sum of all elements *)
(** {2 Multiple iterators} *)
val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Map on the two sequences. Stops once one of them is exhausted.*)
val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit
(** Iterate on the two sequences. Stops once one of them is exhausted.*)
val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc
(** Fold the common prefix of the two iterators *)
val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
(** Succeeds if all pairs of elements satisfy the predicate.
Ignores elements of an iterator if the other runs dry. *)
val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool
(** Succeeds if some pair of elements satisfy the predicate.
Ignores elements of an iterator if the other runs dry. *)
val zip_with : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
(** Combine common part of the enums (stops when one is exhausted) *)
val zip : 'a t -> 'b t -> ('a * 'b) t
(** Zip together the common part of the enums *)
(** {2 Complex combinators} *)
val merge : 'a gen t -> 'a t
(** Pick elements fairly in each sub-generator. The merge of enums
[e1, e2, ... ] picks elements in [e1], [e2],
in [e3], [e1], [e2] .... Once a generator is empty, it is skipped;
when they are all empty, and none remains in the input,
their merge is also empty.
For instance, [merge [1;3;5] [2;4;6]] will be, in disorder, [1;2;3;4;5;6]. *)
val intersection : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> 'a t
(** Intersection of two sorted sequences. Only elements that occur in both
inputs appear in the output *)
val sorted_merge : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> 'a t
(** Merge two sorted sequences into a sorted sequence *)
val sorted_merge_n : ?cmp:('a -> 'a -> int) -> 'a t list -> 'a t
(** Sorted merge of multiple sorted sequences *)
val tee : ?n:int -> 'a t -> 'a gen list
(** Duplicate the enum into [n] generators (default 2). The generators
share the same underlying instance of the enum, so the optimal case is
when they are consumed evenly *)
val round_robin : ?n:int -> 'a t -> 'a gen list
(** Split the enum into [n] generators in a fair way. Elements with
[index = k mod n] with go to the k-th enum. [n] default value
is 2. *)
val interleave : 'a t -> 'a t -> 'a t
(** [interleave a b] yields an element of [a], then an element of [b],
and so on. When a generator is exhausted, this behaves like the
other generator. *)
val intersperse : 'a -> 'a t -> 'a t
(** Put the separator element between all elements of the given enum *)
val product : 'a t -> 'b t -> ('a * 'b) t
(** Cartesian product, in no predictable order. Works even if some of the
arguments are infinite. *)
val group : ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t
(** Group equal consecutive elements together. *)
val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t
(** Remove consecutive duplicate elements. Basically this is
like [fun e -> map List.hd (group e)]. *)
val sort : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
(** Sort according to the given comparison function. The enum must be finite. *)
val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
(** Sort and remove duplicates. The enum must be finite. *)
val chunks : int -> 'a t -> 'a array t
(** [chunks n e] returns a generator of arrays of length [n], composed
of successive elements of [e]. The last array may be smaller
than [n] *)
val permutations : 'a t -> 'a list t
(** Permutations of the enum.
@since 0.2.2 *)
val combinations : int -> 'a t -> 'a list t
(** Combinations of given length. The ordering of the elements within
each combination is unspecified.
Example (ignoring ordering):
[combinations 2 (1--3) |> to_list = [[1;2]; [1;3]; [2;3]]]
@since 0.2.2 *)
val power_set : 'a t -> 'a list t
(** All subsets of the enum (in no particular order). The ordering of
the elements within each subset is unspecified.
@since 0.2.2 *)
(** {2 Basic conversion functions} *)
val of_list : 'a list -> 'a t
(** Enumerate elements of the list *)
val to_list : 'a t -> 'a list
(** non tail-call trasnformation to list, in the same order *)
val to_rev_list : 'a t -> 'a list
(** Tail call conversion to list, in reverse order (more efficient) *)
val to_array : 'a t -> 'a array
(** Convert the enum to an array (not very efficient) *)
val of_array : ?start:int -> ?len:int -> 'a array -> 'a t
(** Iterate on (a slice of) the given array *)
val rand_int : int -> int t
(** Random ints in the given range. *)
val int_range : int -> int -> int t
(** [int_range a b] enumerates integers between [a] and [b], included. [a]
is assumed to be smaller than [b]. *)
module Infix : sig
val (--) : int -> int -> int t
(** Synonym for {! int_range} *)
val (>>=) : 'a t -> ('a -> 'b gen) -> 'b t
(** Monadic bind operator *)
end
val (--) : int -> int -> int t
(** Synonym for {! int_range} *)
val (>>=) : 'a t -> ('a -> 'b gen) -> 'b t
(** Monadic bind operator *)
val pp : ?start:string -> ?stop:string -> ?sep:string -> ?horizontal:bool ->
(Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit
(** Pretty print the content of the generator on a formatter. *)
end

623
gen/myocamlbuild.ml
View file

@ -1,623 +0,0 @@
(* OASIS_START *)
(* DO NOT EDIT (digest: 8b03085ed54d5ff9a8cbd756150607bd) *)
module OASISGettext = struct
(* # 22 "src/oasis/OASISGettext.ml" *)
let ns_ str =
str
let s_ str =
str
let f_ (str: ('a, 'b, 'c, 'd) format4) =
str
let fn_ fmt1 fmt2 n =
if n = 1 then
fmt1^^""
else
fmt2^^""
let init =
[]
end
module OASISExpr = struct
(* # 22 "src/oasis/OASISExpr.ml" *)
open OASISGettext
type test = string
type flag = string
type t =
| EBool of bool
| ENot of t
| EAnd of t * t
| EOr of t * t
| EFlag of flag
| ETest of test * string
type 'a choices = (t * 'a) list
let eval var_get t =
let rec eval' =
function
| EBool b ->
b
| ENot e ->
not (eval' e)
| EAnd (e1, e2) ->
(eval' e1) && (eval' e2)
| EOr (e1, e2) ->
(eval' e1) || (eval' e2)
| EFlag nm ->
let v =
var_get nm
in
assert(v = "true" || v = "false");
(v = "true")
| ETest (nm, vl) ->
let v =
var_get nm
in
(v = vl)
in
eval' t
let choose ?printer ?name var_get lst =
let rec choose_aux =
function
| (cond, vl) :: tl ->
if eval var_get cond then
vl
else
choose_aux tl
| [] ->
let str_lst =
if lst = [] then
s_ "<empty>"
else
String.concat
(s_ ", ")
(List.map
(fun (cond, vl) ->
match printer with
| Some p -> p vl
| None -> s_ "<no printer>")
lst)
in
match name with
| Some nm ->
failwith
(Printf.sprintf
(f_ "No result for the choice list '%s': %s")
nm str_lst)
| None ->
failwith
(Printf.sprintf
(f_ "No result for a choice list: %s")
str_lst)
in
choose_aux (List.rev lst)
end
# 132 "myocamlbuild.ml"
module BaseEnvLight = struct
(* # 22 "src/base/BaseEnvLight.ml" *)
module MapString = Map.Make(String)
type t = string MapString.t
let default_filename =
Filename.concat
(Sys.getcwd ())
"setup.data"
let load ?(allow_empty=false) ?(filename=default_filename) () =
if Sys.file_exists filename then
begin
let chn =
open_in_bin filename
in
let st =
Stream.of_channel chn
in
let line =
ref 1
in
let st_line =
Stream.from
(fun _ ->
try
match Stream.next st with
| '\n' -> incr line; Some '\n'
| c -> Some c
with Stream.Failure -> None)
in
let lexer =
Genlex.make_lexer ["="] st_line
in
let rec read_file mp =
match Stream.npeek 3 lexer with
| [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
Stream.junk lexer;
Stream.junk lexer;
Stream.junk lexer;
read_file (MapString.add nm value mp)
| [] ->
mp
| _ ->
failwith
(Printf.sprintf
"Malformed data file '%s' line %d"
filename !line)
in
let mp =
read_file MapString.empty
in
close_in chn;
mp
end
else if allow_empty then
begin
MapString.empty
end
else
begin
failwith
(Printf.sprintf
"Unable to load environment, the file '%s' doesn't exist."
filename)
end
let rec var_expand str env =
let buff =
Buffer.create ((String.length str) * 2)
in
Buffer.add_substitute
buff
(fun var ->
try
var_expand (MapString.find var env) env
with Not_found ->
failwith
(Printf.sprintf
"No variable %s defined when trying to expand %S."
var
str))
str;
Buffer.contents buff
let var_get name env =
var_expand (MapString.find name env) env
let var_choose lst env =
OASISExpr.choose
(fun nm -> var_get nm env)
lst
end
# 237 "myocamlbuild.ml"
module MyOCamlbuildFindlib = struct
(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
(** OCamlbuild extension, copied from
* http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild
* by N. Pouillard and others
*
* Updated on 2009/02/28
*
* Modified by Sylvain Le Gall
*)
open Ocamlbuild_plugin
type conf =
{ no_automatic_syntax: bool;
}
(* these functions are not really officially exported *)
let run_and_read =
Ocamlbuild_pack.My_unix.run_and_read
let blank_sep_strings =
Ocamlbuild_pack.Lexers.blank_sep_strings
let exec_from_conf exec =
let exec =
let env_filename = Pathname.basename BaseEnvLight.default_filename in
let env = BaseEnvLight.load ~filename:env_filename ~allow_empty:true () in
try
BaseEnvLight.var_get exec env
with Not_found ->
Printf.eprintf "W: Cannot get variable %s\n" exec;
exec
in
let fix_win32 str =
if Sys.os_type = "Win32" then begin
let buff = Buffer.create (String.length str) in
(* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'.
*)
String.iter
(fun c -> Buffer.add_char buff (if c = '\\' then '/' else c))
str;
Buffer.contents buff
end else begin
str
end
in
fix_win32 exec
let split s ch =
let buf = Buffer.create 13 in
let x = ref [] in
let flush () =
x := (Buffer.contents buf) :: !x;
Buffer.clear buf
in
String.iter
(fun c ->
if c = ch then
flush ()
else
Buffer.add_char buf c)
s;
flush ();
List.rev !x
let split_nl s = split s '\n'
let before_space s =
try
String.before s (String.index s ' ')
with Not_found -> s
(* ocamlfind command *)
let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x]
(* This lists all supported packages. *)
let find_packages () =
List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list"))
(* Mock to list available syntaxes. *)
let find_syntaxes () = ["camlp4o"; "camlp4r"]
let well_known_syntax = [
"camlp4.quotations.o";
"camlp4.quotations.r";
"camlp4.exceptiontracer";
"camlp4.extend";
"camlp4.foldgenerator";
"camlp4.listcomprehension";
"camlp4.locationstripper";
"camlp4.macro";
"camlp4.mapgenerator";
"camlp4.metagenerator";
"camlp4.profiler";
"camlp4.tracer"
]
let dispatch conf =
function
| After_options ->
(* By using Before_options one let command line options have an higher
* priority on the contrary using After_options will guarantee to have
* the higher priority override default commands by ocamlfind ones *)
Options.ocamlc := ocamlfind & A"ocamlc";
Options.ocamlopt := ocamlfind & A"ocamlopt";
Options.ocamldep := ocamlfind & A"ocamldep";
Options.ocamldoc := ocamlfind & A"ocamldoc";
Options.ocamlmktop := ocamlfind & A"ocamlmktop";
Options.ocamlmklib := ocamlfind & A"ocamlmklib"
| After_rules ->
(* When one link an OCaml library/binary/package, one should use
* -linkpkg *)
flag ["ocaml"; "link"; "program"] & A"-linkpkg";
if not (conf.no_automatic_syntax) then begin
(* For each ocamlfind package one inject the -package option when
* compiling, computing dependencies, generating documentation and
* linking. *)
List.iter
begin fun pkg ->
let base_args = [A"-package"; A pkg] in
(* TODO: consider how to really choose camlp4o or camlp4r. *)
let syn_args = [A"-syntax"; A "camlp4o"] in
let (args, pargs) =
(* 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
(syn_args @ base_args, syn_args)
else
(base_args, [])
in
flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
(* 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. *)
List.iter begin fun syntax ->
flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "infer_interface"; "syntax_"^syntax] &
S[A"-syntax"; A syntax];
end (find_syntaxes ());
(* The default "thread" tag is not compatible with ocamlfind.
* Indeed, the default rules add the "threads.cma" or "threads.cmxa"
* options when using this tag. When using the "-linkpkg" option with
* ocamlfind, this module will then be added twice on the command line.
*
* To solve this, one approach is to add the "-thread" option when using
* the "threads" package using the previous plugin.
*)
flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]);
flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]);
| _ ->
()
end
module MyOCamlbuildBase = struct
(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
(** Base functions for writing myocamlbuild.ml
@author Sylvain Le Gall
*)
open Ocamlbuild_plugin
module OC = Ocamlbuild_pack.Ocaml_compiler
type dir = string
type file = string
type name = string
type tag = string
(* # 62 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
type t =
{
lib_ocaml: (name * dir list * string list) list;
lib_c: (name * dir * file list) list;
flags: (tag list * (spec OASISExpr.choices)) list;
(* Replace the 'dir: include' from _tags by a precise interdepends in
* directory.
*)
includes: (dir * dir list) list;
}
let env_filename =
Pathname.basename
BaseEnvLight.default_filename
let dispatch_combine lst =
fun e ->
List.iter
(fun dispatch -> dispatch e)
lst
let tag_libstubs nm =
"use_lib"^nm^"_stubs"
let nm_libstubs nm =
nm^"_stubs"
let dispatch t e =
let env =
BaseEnvLight.load
~filename:env_filename
~allow_empty:true
()
in
match e with
| Before_options ->
let no_trailing_dot s =
if String.length s >= 1 && s.[0] = '.' then
String.sub s 1 ((String.length s) - 1)
else
s
in
List.iter
(fun (opt, var) ->
try
opt := no_trailing_dot (BaseEnvLight.var_get var env)
with Not_found ->
Printf.eprintf "W: Cannot get variable %s\n" var)
[
Options.ext_obj, "ext_obj";
Options.ext_lib, "ext_lib";
Options.ext_dll, "ext_dll";
]
| After_rules ->
(* Declare OCaml libraries *)
List.iter
(function
| nm, [], intf_modules ->
ocaml_lib nm;
let cmis =
List.map (fun m -> (String.uncapitalize m) ^ ".cmi")
intf_modules in
dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis
| nm, dir :: tl, intf_modules ->
ocaml_lib ~dir:dir (dir^"/"^nm);
List.iter
(fun dir ->
List.iter
(fun str ->
flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir]))
["compile"; "infer_interface"; "doc"])
tl;
let cmis =
List.map (fun m -> dir^"/"^(String.uncapitalize m)^".cmi")
intf_modules in
dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"]
cmis)
t.lib_ocaml;
(* Declare directories dependencies, replace "include" in _tags. *)
List.iter
(fun (dir, include_dirs) ->
Pathname.define_context dir include_dirs)
t.includes;
(* Declare C libraries *)
List.iter
(fun (lib, dir, headers) ->
(* Handle C part of library *)
flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib]
(S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib";
A("-l"^(nm_libstubs lib))]);
flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib]
(S[A"-cclib"; A("-l"^(nm_libstubs lib))]);
flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
(S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
(* 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"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
dep ["compile"; "ocaml"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
(* TODO: be more specific about what depends on headers *)
(* Depends on .h files *)
dep ["compile"; "c"]
headers;
(* Setup search path for lib *)
flag ["link"; "ocaml"; "use_"^lib]
(S[A"-I"; P(dir)]);
)
t.lib_c;
(* Add flags *)
List.iter
(fun (tags, cond_specs) ->
let spec = BaseEnvLight.var_choose cond_specs env in
let rec eval_specs =
function
| S lst -> S (List.map eval_specs lst)
| A str -> A (BaseEnvLight.var_expand str env)
| spec -> spec
in
flag tags & (eval_specs spec))
t.flags
| _ ->
()
let dispatch_default conf t =
dispatch_combine
[
dispatch t;
MyOCamlbuildFindlib.dispatch conf;
]
end
# 606 "myocamlbuild.ml"
open Ocamlbuild_plugin;;
let package_default =
{
MyOCamlbuildBase.lib_ocaml = [("gen", [], [])];
lib_c = [];
flags = [];
includes = []
}
;;
let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
# 622 "myocamlbuild.ml"
(* OASIS_STOP *)
Ocamlbuild_plugin.dispatch dispatch_default;;

7150
gen/setup.ml
View file

File diff suppressed because it is too large Load diff

4
gen/tests/run_tests.ml
View file

@ -1,4 +0,0 @@
let () =
let _ = OUnit.run_test_tt_main Test_gen.suite in
()

146
gen/tests/test_gen.ml
View file

@ -1,146 +0,0 @@
open OUnit
open Gen.Infix
module GR = Gen.Restart
let pint i = string_of_int i
let pilist l =
let b = Buffer.create 15 in
let fmt = Format.formatter_of_buffer b in
Format.fprintf fmt "%a@?"
(Gen.pp Format.pp_print_int) (Gen.of_list l);
Buffer.contents b
let pi2list l =
let b = Buffer.create 15 in
let fmt = Format.formatter_of_buffer b in
Format.fprintf fmt "%a@?"
(Gen.pp (fun fmt (a,b) -> Format.fprintf fmt "%d,%d" a b))
(Gen.of_list l);
Buffer.contents b
let pstrlist l =
let b = Buffer.create 15 in
let fmt = Format.formatter_of_buffer b in
Format.fprintf fmt "%a@?"
(Gen.pp Format.pp_print_string) (Gen.of_list l);
Buffer.contents b
let test_singleton () =
let gen = Gen.singleton 42 in
OUnit.assert_equal (Some 42) (Gen.get gen);
OUnit.assert_equal None (Gen.get gen);
let gen = Gen.singleton 42 in
OUnit.assert_equal 1 (Gen.length gen);
()
let test_iter () =
let e = GR.(1 -- 10) in
OUnit.assert_equal ~printer:pint 10 (GR.length e);
OUnit.assert_equal [1;2] GR.(to_list (1 -- 2));
OUnit.assert_equal [1;2;3;4;5] (GR.to_list (GR.take 5 e));
()
let test_map () =
let e = 1 -- 10 in
let e' = Gen.map string_of_int e in
OUnit.assert_equal ~printer:pstrlist ["9"; "10"] (Gen.to_list (Gen.drop 8 e'));
()
let test_append () =
let e = Gen.append (1 -- 5) (6 -- 10) in
OUnit.assert_equal [10;9;8;7;6;5;4;3;2;1] (Gen.to_rev_list e);
()
let test_flat_map () =
let e = 1 -- 3 in
let e' = e >>= (fun x -> x -- (x+1)) in
OUnit.assert_equal [1;2;2;3;3;4] (Gen.to_list e');
()
let test_zip () =
let e = Gen.zip_with (+) (Gen.repeat 1) (4--7) in
OUnit.assert_equal [5;6;7;8] (Gen.to_list e);
()
let test_filter_map () =
let f x = if x mod 2 = 0 then Some (string_of_int x) else None in
let e = Gen.filter_map f (1 -- 10) in
OUnit.assert_equal ["2"; "4"; "6"; "8"; "10"] (Gen.to_list e);
()
let test_merge () =
let e = Gen.of_list [1--3; 4--6; 7--9] in
let e' = Gen.merge e in
OUnit.assert_equal [1;2;3;4;5;6;7;8;9] (Gen.to_list e' |> List.sort compare);
()
let test_persistent () =
let i = ref 0 in
let gen () =
let j = !i in
if j > 5 then None else (incr i; Some j)
in
let e = Gen.persistent gen in
OUnit.assert_equal [0;1;2;3;4;5] (GR.to_list e);
OUnit.assert_equal [0;1;2;3;4;5] (GR.to_list e);
OUnit.assert_equal [0;1;2;3;4;5] (GR.to_list e);
()
let test_round_robin () =
let e = GR.round_robin ~n:2 GR.(1--10) in
match e with
| [a;b] ->
OUnit.assert_equal [1;3;5;7;9] (Gen.to_list a);
OUnit.assert_equal [2;4;6;8;10] (Gen.to_list b)
| _ -> OUnit.assert_failure "wrong list lenght"
let test_big_rr () =
let e = GR.round_robin ~n:3 GR.(1 -- 999) in
let l = List.map Gen.length e in
OUnit.assert_equal [333;333;333] l;
()
let test_merge_sorted () =
[Gen.of_list [1;3;5]; Gen.of_list [0;1;1;3;4;6;10]; Gen.of_list [2;2;11]]
|> Gen.sorted_merge_n ?cmp:None
|> Gen.to_list
|> OUnit.assert_equal ~printer:pilist [0;1;1;1;2;2;3;3;4;5;6;10;11]
let test_interleave () =
let e1 = Gen.of_list [1;3;5;7;9] in
let e2 = Gen.of_list [2;4;6;8;10] in
let e = Gen.interleave e1 e2 in
OUnit.assert_equal [1;2;3;4;5;6;7;8;9;10] (Gen.to_list e);
()
let test_intersperse () =
let e = 1 -- 5 in
let e' = Gen.intersperse 0 e in
OUnit.assert_equal [1;0;2;0;3;0;4;0;5] (Gen.to_list e');
()
let test_product () =
let printer = pi2list in
let e = Gen.product (1--3) (4--5) in
OUnit.assert_equal ~printer [1,4; 1,5; 2,4; 2,5; 3,4; 3,5]
(List.sort compare (Gen.to_list e));
()
let suite =
"test_gen" >:::
[ "test_singleton" >:: test_singleton;
"test_iter" >:: test_iter;
"test_map" >:: test_map;
"test_append" >:: test_append;
"test_flat_map" >:: test_flat_map;
"test_zip" >:: test_zip;
"test_filter_map" >:: test_filter_map;
"test_merge" >:: test_merge;
"test_persistent" >:: test_persistent;
"test_round_robin" >:: test_round_robin;
"test_big_rr" >:: test_big_rr;
"test_merge_sorted" >:: test_merge_sorted;
"test_interleave" >:: test_interleave;
"test_intersperse" >:: test_intersperse;
"test_product" >:: test_product;
]

164
lwt/behavior.ml
View file

@ -1,164 +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 Behavior Trees for React} *)
(** {2 Behavior tree} *)
type tree =
| Test of (unit -> bool) (* call and test value *)
| Wait of (unit -> bool Lwt.t) (* wait for the future to complete *)
| Do of (unit -> bool) (* perform an action *)
| If of (unit -> bool) * tree * tree (* switch *)
| Sequence of bool * tree list (* yield to subtrees sequentially. bool: loop? *)
| Select of select_strategy * tree list (* select one subtree *)
| Parallel of parallel_strategy * tree list (* run all subtrees in parallel *)
| Closure of (unit -> tree) (* build a tree dynamically *)
| Succeed (* always succeed *)
| Fail (* always fail *)
(** A behavior tree *)
and select_strategy = tree list -> (unit -> tree option)
(** How to select a subtree to run. It yields a subtree until it
decides to fail *)
and parallel_strategy =
| PSForall (** succeeds when all subtrees succeed *)
| PSExists (** succeeds when some subtree succeeds *)
let strategy_inorder l =
let cur = ref l in
fun () -> match !cur with
| [] -> None
| t::l' ->
cur := l';
Some t
let strategy_random ?(proba_fail=0.05) l =
let a = Array.of_list l in
fun () ->
if Random.float 1. < proba_fail
then None
else (* choose in array *)
let t = a.(Random.int (Array.length a)) in
Some t
let succeed = Succeed
let fail = Fail
let test f = Test f
let wait fut = Wait (fun () -> fut)
let wait_ fut = Wait (fun () -> Lwt.bind fut (fun () -> Lwt.return_true))
let wait_closure f = Wait f
let timeout f = Wait (fun () -> Lwt.bind (Lwt_unix.sleep f) (fun () -> Lwt.return_false))
let delay f = Wait (fun () -> Lwt.bind (Lwt_unix.sleep f) (fun () -> Lwt.return_true))
let do_ act = Do act
let do_succeed act = Do (fun () -> act (); true)
let if_ s then_ else_ = If (s, then_, else_)
let when_ s t = if_ s t succeed
let while_ f l = Sequence (true, (test f) :: l)
let sequence ?(loop=false) l =
assert (l <> []);
Sequence (loop, l)
let repeat t = sequence ~loop:true [t]
let select ?(strat=strategy_inorder) l =
assert (l <> []);
Select (strat, l)
let or_else t1 t2 =
select ~strat:strategy_inorder [t1; t2]
let parallel ?(strat=PSForall) l =
assert (l <> []);
Parallel (strat, l)
let closure f =
Closure f
(** {2 Run a tree} *)
type result = bool Lwt.t
let run tree =
let (>>=) = Lwt.(>>=) in
(* run given tree *)
let rec run tree =
match tree with
| Test f -> Lwt.return (f ())
| Wait f -> f ()
| Do act -> if act () then Lwt.return_true else Lwt.return_false
| If (s, then_, else_) -> (* depends on value returned by [s] *)
if s () then run then_ else run else_
| Sequence (loop, l) -> run_sequence ~loop l
| Select (strat, l) -> run_select ~strat l
| Parallel (strat, l) -> run_parallel ~strat l
| Closure f -> let tree' = f () in run tree'
| Succeed -> Lwt.return_true
| Fail -> Lwt.return_false
and run_sequence ~loop start =
let rec process l = match l with
| [] when loop -> run_sequence ~loop start
| [] -> Lwt.return_true (* success *)
| t::l' ->
let res_t = run t in
res_t >>= fun t_succeeded ->
if t_succeeded
then process l'
else Lwt.return_false
in
process start
and run_select ~strat l =
(* choice function *)
let choose = strat l in
(* try a subtree *)
let rec try_one () =
match choose () with
| None -> Lwt.return_false (* failure *)
| Some t ->
run t >>= fun t_succeeded ->
if t_succeeded
then Lwt.return_true
else try_one ()
in
try_one ()
and run_parallel ~strat l =
let results = List.map run l in
match strat with
| PSExists -> Lwt_list.exists_p (fun x -> x) results
| PSForall -> Lwt_list.for_all_p (fun x -> x) results
in
run tree

142
lwt/behavior.mli
View file

@ -1,142 +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 Behavior Trees for Lwt} *)
(** Behavior trees are a modular alternative to state machines for controlling
dynamic behavior in time. They are primarily used in video games to
implement non-player AI.
A tree is composed of basic actions, basic tests, and combinators. During
execution, some subset of the nodes of a tree may be {b running}; at some
point the execution of a given node will terminate with either
{b success} or {b failure}. Depending on the kind of node, this result
may propagate to parent nodes, or set other nodes running.
For instance, a {i sequence} node runs its subtrees one by one. If a
subtree succeeds, the next one is activated; if it fails, the whole
sequence will fail.
Here, we build them on top of
{{: http://ocsigen.org/lwt/} Lwt}.
Documentation source:
{{: http://aigamedev.com/open/article/bt-overview/} aigamedev (and links)}
*)
(** {2 Behavior tree} *)
(** A behavior tree *)
type tree = private
| Test of (unit -> bool) (* call and test value *)
| Wait of (unit -> bool Lwt.t) (* wait for the future to complete *)
| Do of (unit -> bool) (* perform an action *)
| If of (unit -> bool) * tree * tree (* switch *)
| Sequence of bool * tree list (* yield to subtrees sequentially. bool: loop? *)
| Select of select_strategy * tree list (* select one subtree *)
| Parallel of parallel_strategy * tree list (* run all subtrees in parallel *)
| Closure of (unit -> tree) (* build a tree dynamically *)
| Succeed (* always succeed *)
| Fail (* always fail *)
and select_strategy = tree list -> (unit -> tree option)
(** How to select a subtree to run. It may yield a different result each
time it is called. *)
and parallel_strategy =
| PSForall (** succeeds when all subtrees succeed *)
| PSExists (** succeeds when some subtree succeeds (kill the others) *)
val strategy_inorder : select_strategy
(** Select subnodes one after the other, then fails *)
val strategy_random : ?proba_fail:float -> select_strategy
(** Randomly chooses a subtree. May fail at each point with
a probability of [proba_fail]. *)
val succeed : tree
(** Behavior that always succeeds *)
val fail : tree
(** Behavior that always fails *)
val test : (unit -> bool) -> tree
(** Fails or succeeds based on the next occurrence of the event *)
val wait : bool Lwt.t -> tree
(** Returns the same result as the future *)
val wait_ : unit Lwt.t -> tree
(** Wait for the future to complete, then succeed *)
val wait_closure : (unit -> bool Lwt.t) -> tree
val timeout : float -> tree
(** Fails after the given amount of seconds *)
val delay : float -> tree
(** Wait for the given amount of seconds, then succeed *)
val do_ : (unit -> bool) -> tree
(** Perform an action, then succeed iff it returned true *)
val do_succeed : (unit -> unit) -> tree
(** Perform an action and succeed (unless it raises an exception) *)
val if_ : (unit -> bool) -> tree -> tree -> tree
(** Conditional choice, based on the current value of the signal *)
val when_ : (unit -> bool) -> tree -> tree
(** Run the given tree if the signal is true, else succeed *)
val while_ : (unit -> bool) -> tree list -> tree
(** While the signal is true, run the subtrees *)
val sequence : ?loop:bool -> tree list -> tree
(** Sequence of sub-trees to run *)
val repeat : tree -> tree
(** Repeat the same tree indefinitely *)
val select : ?strat:select_strategy -> tree list -> tree
(** Choice among the subtrees. The strategy defines in which order subtrees
are tried. *)
val or_else : tree -> tree -> tree
(** Binary choice, favoring the left one *)
val parallel : ?strat:parallel_strategy -> tree list -> tree
(** Run subtrees in parallel (default strat: PSForall) *)
val closure : (unit -> tree) -> tree
(** Produce a tree dynamically, at each call. *)
(** {2 Run a tree} *)
type result = bool Lwt.t
val run : tree -> result
(** Run the tree. It returns a {! result}, which wraps
either true (success) or false (failure). *)

BIN
media/logo.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 89 KiB

86
myocamlbuild.ml
View file

@ -1,5 +1,5 @@
(* OASIS_START *)
(* DO NOT EDIT (digest: 533979157febab9fa15b0b406be9633e) *)
(* DO NOT EDIT (digest: e3363561f51c33bc1d07d0c9f2bd631a) *)
module OASISGettext = struct
(* # 22 "src/oasis/OASISGettext.ml" *)
@ -609,31 +609,52 @@ let package_default =
{
MyOCamlbuildBase.lib_ocaml =
[
("containers", ["core"], []);
("containers_string", ["string"], []);
("containers_advanced", ["advanced"], []);
("containers_pervasives", ["pervasives"], []);
("containers_misc", ["misc"], []);
("containers_thread", ["threads"], []);
("containers_lwt", ["lwt"], []);
("containers_cgi", ["cgi"], [])
("containers", ["src/core"], []);
("containers_io", ["src/io"], []);
("containers_sexp", ["src/sexp"], []);
("containers_data", ["src/data"], []);
("containers_iter", ["src/iter"], []);
("containers_string", ["src/string"], []);
("containers_advanced", ["src/advanced"], []);
("containers_bigarray", ["src/bigarray"], []);
("containers_pervasives", ["src/pervasives"], []);
("containers_misc", ["src/misc"], []);
("containers_thread", ["src/threads"], []);
("containers_lwt", ["src/lwt"], [])
];
lib_c = [];
flags = [];
includes =
[
("threads", ["core"]);
("tests/lwt", ["core"; "lwt"]);
("tests", ["core"; "misc"; "string"]);
("qtest", ["core"; "misc"; "string"]);
("pervasives", ["core"]);
("misc", ["core"]);
("lwt", ["core"; "misc"]);
("examples/cgi", ["cgi"; "core"]);
("examples", ["core"; "misc"]);
("cgi", ["core"]);
("benchs", ["advanced"; "core"; "misc"; "string"]);
("advanced", ["core"])
("tests/lwt", ["src/core"; "src/lwt"]);
("tests", ["src/core"; "src/data"; "src/misc"; "src/string"]);
("src/threads", ["src/core"]);
("src/pervasives", ["src/core"]);
("src/misc", ["src/core"; "src/data"]);
("src/lwt", ["src/core"; "src/misc"]);
("src/bigarray", ["src/core"]);
("src/advanced", ["src/core"]);
("qtest",
[
"src/advanced";
"src/bigarray";
"src/core";
"src/io";
"src/iter";
"src/misc";
"src/sexp";
"src/string"
]);
("examples", ["src/core"; "src/misc"; "src/sexp"]);
("benchs",
[
"src/advanced";
"src/core";
"src/data";
"src/iter";
"src/misc";
"src/string"
])
]
}
;;
@ -642,8 +663,11 @@ let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
# 646 "myocamlbuild.ml"
# 667 "myocamlbuild.ml"
(* OASIS_STOP *)
let doc_intro = "doc/intro.txt" ;;
Ocamlbuild_plugin.dispatch dispatch_default;;
dispatch
@ -652,17 +676,17 @@ dispatch
| After_rules ->
(* replace with Ocamlbuild_cppo.dispatch when 4.00 is not supported
anymore *)
let dep = "%(name).cppo.ml" in
let dep_cppo = "%(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 dep = env dep_cppo 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) ;
rule "cppo1" ~dep:dep_cppo ~prod:prod1 (f prod1) ;
rule "cppo2" ~dep:dep_cppo ~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 ->
@ -683,7 +707,15 @@ dispatch
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]
flag ["cppo"] & S[A"-D"; A ocaml_major; A"-D"; A ocaml_minor] ;
(* Documentation index *)
dep ["ocaml"; "doc"; "extension:html"] & [doc_intro] ;
flag ["ocaml"; "doc"; "extension:html"] &
(S[A"-t"; A"Containers doc";
A"-intro"; P doc_intro;
]);
| _ -> ()
end;
dispatch_default

8
opam
View file

@ -3,7 +3,8 @@ author: "Simon Cruanes"
maintainer: "simon.cruanes@inria.fr"
build: [
["./configure" "--prefix" prefix "--disable-thread" "--disable-bench"
"--disable-tests" "--disable-cgi" "--%{lwt:enable}%-lwt"
"--disable-tests" "--%{lwt:enable}%-lwt"
"--%{base-bigarray:enable}%-bigarray"
"--enable-docs" "--enable-misc"]
[make "build"]
]
@ -16,7 +17,10 @@ remove: [
["ocamlfind" "remove" "containers"]
]
post-messages: [
"in containers, modules start with 'CC' (stands for 'core containers')"
"containers is now split into finer-grained sub-libraries, including
`containers.io`, `containers.iter`, `containers.sexp`, `containers.data`.
CCGen and CCSequence have been removed, consider using the libraries
`gen` and `sequence` on opam."
]
depends: [
"ocamlfind" {build}

9
sequence/.gitignore vendored
View file

@ -1,9 +0,0 @@
.*.swp
_build
*.native
*.docdir
*.html
man/
sequence.install
setup.log
setup.data

9
sequence/.merlin
View file

@ -1,9 +0,0 @@
S .
S bench/
S tests/
B _build
B _build/tests/
B _build/bench/
PKG oUnit
PKG benchmark
FLAG -safe-string

9
sequence/.ocamlinit
View file

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

65
sequence/CHANGELOG.md
View file

@ -1,65 +0,0 @@
# Changelog
## 0.5
- conversion with `klist`
- add monadic, choice and applicative infix operators and `>|=`
- add several functions:
* `product2`
* `find`, `mem`
* `doubleton`, `cons`, `snoc`
* `drop_while`, `take_while`...
* `concat_str`
- aliases to existing functions
- use `delimcc` in a new module, `SequenceInvert`, in order to reverse the
control flow (here with conversion to Gen)
- fix examples, tests and doc (about `product`)
- reading benchmark for persistent sequences.
- replace `Bench` with `Benchmark`
## 0.4.1
- `persistent_lazy`
- use bin_annot
## 0.4
- API change for `persistent`
- more efficient implementation for `persistent`
- remove `TypeClass`
- API change for `min`/`max` (in case the sequence is empty)
- conversion with `Gen`
- use Oasis
## 0.3.7
- decreasing int range
- printing functions
## 0.3.6.1
- documentation
- bugfixes
## 0.3.6
- `fmap`
- functors to adapt `Set` and `Map`
## 0.3.5
- tests and benchmarks
- `join` combinator
- optimization for `Sequence.persistent`
## 0.3.4
- `sort`, `uniq`, `group` and `sort_uniq` combinators implemented
- some conversion functions that use `Sequence.t2`
- infix operators in `Sequence.Infix`
- `Sequence.t2` type for efficient iteration on pairs of elements
- some combinators are adapted to `Sequence.t2`
- `zip`, `unzip` and `zip_i` to convert between `t` and `t2`
- added `scan` combinator
note: git log --no-merges previous_version..HEAD --pretty=%s

22
sequence/LICENSE
View file

@ -1,22 +0,0 @@
Copyright (c) 2012, 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.

11
sequence/META
View file

@ -1,11 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: 1e28d93f3671e8db9acf63b73cdbca82)
version = "0.4.1"
description = "Simple sequence (iterator) datatype and combinators"
archive(byte) = "sequence.cma"
archive(byte, plugin) = "sequence.cma"
archive(native) = "sequence.cmxa"
archive(native, plugin) = "sequence.cmxs"
exists_if = "sequence.cma"
# OASIS_STOP

67
sequence/Makefile
View file

@ -1,67 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: a3c674b4239234cbbe53afe090018954)
SETUP = ocaml setup.ml
build: setup.data
$(SETUP) -build $(BUILDFLAGS)
doc: setup.data build
$(SETUP) -doc $(DOCFLAGS)
test: setup.data build
$(SETUP) -test $(TESTFLAGS)
all:
$(SETUP) -all $(ALLFLAGS)
install: setup.data
$(SETUP) -install $(INSTALLFLAGS)
uninstall: setup.data
$(SETUP) -uninstall $(UNINSTALLFLAGS)
reinstall: setup.data
$(SETUP) -reinstall $(REINSTALLFLAGS)
clean:
$(SETUP) -clean $(CLEANFLAGS)
distclean:
$(SETUP) -distclean $(DISTCLEANFLAGS)
setup.data:
$(SETUP) -configure $(CONFIGUREFLAGS)
configure:
$(SETUP) -configure $(CONFIGUREFLAGS)
.PHONY: build doc test all install uninstall reinstall clean distclean configure
# OASIS_STOP
run-tests:
./run_tests.native
examples:
ocamlbuild examples/test_sexpr.native
push_doc: all doc
scp -r sequence.docdir/* cedeela.fr:~/simon/root/software/sequence/
push_stable: all
git checkout stable
git merge master -m 'merge from master'
oasis setup
git commit -a -m 'oasis files'
git push origin
git checkout master
VERSION=$(shell awk '^/Version:/ {print $$2}' _oasis)
update_next_tag:
@echo "update version to $(VERSION)..."
sed -i "s/NEXT_VERSION/$(VERSION)/g" *.ml *.mli
sed -i "s/NEXT_RELEASE/$(VERSION)/g" *.ml *.mli
.PHONY: benchs tests examples update_next_tag push_doc push_stable

50
sequence/README.md
View file

@ -1,50 +0,0 @@
Sequence
========
Simple sequence abstract datatype, intended to transfer a finite number of
elements from one data structure to another. Some transformations on sequences,
like `filter`, `map`, `take`, `drop` and `append` can be performed before the
sequence is iterated/folded on.
Sequence is not designed to be as general-purpose or flexible as, say,
Batteries' `Enum.t`. Rather, it aims at providing a very simple and efficient
way of iterating on a finite number of values, only allocating (most of the time)
one intermediate closure to do so. For instance, iterating on keys, or values,
of a `Hashtbl.t`, without creating a list.
Documentation
=============
See [the online API](http://cedeela.fr/~simon/software/sequence/Sequence.html).
Build
=====
1. via opam `opam install sequence`
2. manually (need OCaml >= 3.12): `make all install`
If you have `OUnit` installed, you can build and run tests with
$ make tests
$ ./run_tests.native
If you have `Bench` installed, you can build and run benchmarks with
$ make benchs
$ ./benchs.native
To see how to use the library, check the `examples` directory.
`tests.ml` has a few examples of how to convert basic data structures into
sequences, and conversely.
Examples
========
The module `examples/sexpr.mli` exposes the interface of the S-expression
example library. It requires OCaml>=4.0 to compile, because of the GADT
structure used in the monadic parser combinators part of `examples/sexpr.ml`.
License
=======
Sequence is available under the BSD license.

102
sequence/_oasis
View file

@ -1,102 +0,0 @@
OASISFormat: 0.4
Name: sequence
Version: dev
Homepage: https://github.com/c-cube/sequence
Authors: Simon Cruanes
License: BSD-2-clause
LicenseFile: LICENSE
Plugins: META (0.3), DevFiles (0.3)
BuildTools: ocamlbuild
Synopsis: Simple sequence (iterator) datatype and combinators
Description:
Simple sequence datatype, intended to transfer a finite number of
elements from one data structure to another. Some transformations on sequences,
like `filter`, `map`, `take`, `drop` and `append` can be performed before the
sequence is iterated/folded on.
Flag bench
Description: enable benchmarks (require library Benchmark)
Default: false
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
Build$: flag(invert)
Install$: flag(invert)
Modules: SequenceInvert
FindlibName: 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)
BuildTools+: ocamldoc
Install: true
XOCamlbuildPath: .
XOCamlbuildLibraries: sequence
Test all
Type: custom
Command: make run-tests
TestTools: run_tests
Run$: flag(tests)
Executable run_tests
Path: tests/
Install: false
CompiledObject: native
MainIs: run_tests.ml
Build$: flag(tests)
BuildDepends: sequence,oUnit
Executable benchs
Path: bench
Install: false
CompiledObject: native
Build$: flag(bench)
BuildDepends: sequence,benchmark
MainIs: benchs.ml
Executable bench_persistent
Path: bench
Install: false
CompiledObject: native
Build$: flag(bench)
BuildDepends: sequence,benchmark
MainIs: bench_persistent.ml
Executable bench_persistent_read
Path: bench
Install: false
CompiledObject: native
Build$: flag(bench)
BuildDepends: sequence,benchmark
MainIs: bench_persistent_read.ml
SourceRepository head
Type: git
Location: https://github.com/c-cube/sequence
Browser: https://github.com/c-cube/sequence/tree/master/src

31
sequence/_tags
View file

@ -1,31 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: ffd3fbaf00b431777fea1b8279203bf9)
# 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
<**/.svn>: -traverse
<**/.svn>: not_hygienic
".bzr": -traverse
".bzr": not_hygienic
".hg": -traverse
".hg": not_hygienic
".git": -traverse
".git": not_hygienic
"_darcs": -traverse
"_darcs": not_hygienic
# Library sequence
"sequence.cmxs": use_sequence
# Executable benchs
"bench/benchs.native": pkg_benchmark
"bench/benchs.native": use_sequence
# Executable bench_persistent
"bench/bench_persistent.native": pkg_benchmark
"bench/bench_persistent.native": use_sequence
# Executable bench_persistent_read
"bench/bench_persistent_read.native": pkg_benchmark
"bench/bench_persistent_read.native": use_sequence
<bench/*.ml{,i}>: pkg_benchmark
<bench/*.ml{,i}>: use_sequence
# OASIS_STOP
true: bin_annot
<**/*.ml>: warn_A, warn(-4)

128
sequence/bench/bench_persistent.ml
View file

@ -1,128 +0,0 @@
module MList = struct
type 'a t = {
content : 'a array; (* elements of the node *)
mutable len : int; (* number of elements in content *)
mutable tl : 'a t; (* tail *)
} (** A list that contains some elements, and may point to another list *)
let _empty () : 'a t = Obj.magic 0
(** Empty list, for the tl field *)
let make n =
assert (n > 0);
{ content = Array.make n (Obj.magic 0);
len = 0;
tl = _empty ();
}
let rec is_empty l =
l.len = 0 && (l.tl == _empty () || is_empty l.tl)
let rec iter f l =
for i = 0 to l.len - 1 do f l.content.(i); done;
if l.tl != _empty () then iter f l.tl
let iteri f l =
let rec iteri i f l =
for j = 0 to l.len - 1 do f (i+j) l.content.(j); done;
if l.tl != _empty () then iteri (i+l.len) f l.tl
in iteri 0 f l
let rec iter_rev f l =
(if l.tl != _empty () then iter_rev f l.tl);
for i = l.len - 1 downto 0 do f l.content.(i); done
let length l =
let rec len acc l =
if l.tl == _empty () then acc+l.len else len (acc+l.len) l.tl
in len 0 l
(** Get element by index *)
let rec get l i =
if i < l.len then l.content.(i)
else if i >= l.len && l.tl == _empty () then raise (Invalid_argument "MList.get")
else get l.tl (i - l.len)
(** Push [x] at the end of the list. It returns the block in which the
element is inserted. *)
let rec push x l =
if l.len = Array.length l.content
then begin (* insert in the next block *)
(if l.tl == _empty () then
let n = Array.length l.content in
l.tl <- make (n + n lsr 1));
push x l.tl
end else begin (* insert in l *)
l.content.(l.len) <- x;
l.len <- l.len + 1;
l
end
(** Reverse list (in place), and returns the new head *)
let rev l =
let rec rev prev l =
(* reverse array *)
for i = 0 to (l.len-1) / 2 do
let x = l.content.(i) in
l.content.(i) <- l.content.(l.len - i - 1);
l.content.(l.len - i - 1) <- x;
done;
(* reverse next block *)
let l' = l.tl in
l.tl <- prev;
if l' == _empty () then l else rev l l'
in
rev (_empty ()) l
(** Build a MList of elements of the Seq. The optional argument indicates
the size of the blocks *)
let of_seq ?(size=8) seq =
(* read sequence into a MList.t *)
let start = make size in
let l = ref start in
seq (fun x -> l := push x !l);
start
let to_seq l =
fun k -> iter k l
end
(** Store content of the seqerator in an enum *)
let persistent_mlist seq =
let l = MList.of_seq seq in
MList.to_seq l
let bench_mlist n =
for i = 0 to 100 do
let _ = persistent_mlist Sequence.(1 -- n) in
()
done
let bench_naive n =
for i = 0 to 100 do
let l = Sequence.to_rev_list Sequence.(1 -- n) in
let _ = Sequence.of_list (List.rev l) in
()
done
let bench_current n =
for i = 0 to 100 do
let _ = Sequence.persistent Sequence.(1 -- n) in
()
done
let () =
let bench_n n =
Printf.printf "BENCH for %d\n" n;
let res = Benchmark.throughputN 5
[ "mlist", bench_mlist, n
; "naive", bench_naive, n
; "current", bench_current, n
]
in Benchmark.tabulate res
in
bench_n 100;
bench_n 100_000;
()
(* vim:Use benchmark: *)

139
sequence/bench/bench_persistent_read.ml
View file

@ -1,139 +0,0 @@
module MList = struct
type 'a t = {
content : 'a array; (* elements of the node *)
mutable len : int; (* number of elements in content *)
mutable tl : 'a t; (* tail *)
} (** A list that contains some elements, and may point to another list *)
let _empty () : 'a t = Obj.magic 0
(** Empty list, for the tl field *)
let make n =
assert (n > 0);
{ content = Array.make n (Obj.magic 0);
len = 0;
tl = _empty ();
}
let rec is_empty l =
l.len = 0 && (l.tl == _empty () || is_empty l.tl)
let rec iter f l =
for i = 0 to l.len - 1 do f l.content.(i); done;
if l.tl != _empty () then iter f l.tl
let iteri f l =
let rec iteri i f l =
for j = 0 to l.len - 1 do f (i+j) l.content.(j); done;
if l.tl != _empty () then iteri (i+l.len) f l.tl
in iteri 0 f l
let rec iter_rev f l =
(if l.tl != _empty () then iter_rev f l.tl);
for i = l.len - 1 downto 0 do f l.content.(i); done
let length l =
let rec len acc l =
if l.tl == _empty () then acc+l.len else len (acc+l.len) l.tl
in len 0 l
(** Get element by index *)
let rec get l i =
if i < l.len then l.content.(i)
else if i >= l.len && l.tl == _empty () then raise (Invalid_argument "MList.get")
else get l.tl (i - l.len)
(** Push [x] at the end of the list. It returns the block in which the
element is inserted. *)
let rec push x l =
if l.len = Array.length l.content
then begin (* insert in the next block *)
(if l.tl == _empty () then
let n = Array.length l.content in
l.tl <- make (n + n lsr 1));
push x l.tl
end else begin (* insert in l *)
l.content.(l.len) <- x;
l.len <- l.len + 1;
l
end
(** Reverse list (in place), and returns the new head *)
let rev l =
let rec rev prev l =
(* reverse array *)
for i = 0 to (l.len-1) / 2 do
let x = l.content.(i) in
l.content.(i) <- l.content.(l.len - i - 1);
l.content.(l.len - i - 1) <- x;
done;
(* reverse next block *)
let l' = l.tl in
l.tl <- prev;
if l' == _empty () then l else rev l l'
in
rev (_empty ()) l
(** Build a MList of elements of the Seq. The optional argument indicates
the size of the blocks *)
let of_seq ?(size=8) seq =
(* read sequence into a MList.t *)
let start = make size in
let l = ref start in
seq (fun x -> l := push x !l);
start
let to_seq l =
fun k -> iter k l
end
(** Store content of the seqerator in an enum *)
let persistent_mlist seq =
let l = MList.of_seq seq in
MList.to_seq l
let bench_mlist n =
persistent_mlist Sequence.(1 -- n)
let bench_list n =
let l = Sequence.to_rev_list Sequence.(1 -- n) in
Sequence.of_list (List.rev l)
let bench_naive n =
let s = Sequence.(1 -- n) in
Sequence.iter ignore s ;
s
let bench_current n =
Sequence.persistent Sequence.(1 -- n)
let bench_array n =
let a = Sequence.to_array Sequence.(1 -- n) in
Sequence.of_array a
let read s =
Sequence.map (fun x -> x + 1) s
let () =
let bench_n n =
Printf.printf "BENCH for %d\n" n;
let res =
let mlist = bench_mlist n in
let list = bench_list n in
let current = bench_current n in
let array = bench_current n in
let naive = bench_naive n in
Benchmark.throughputN 5
[ "mlist", read, mlist
; "list", read, list
; "current", read, current
; "array", read, array
; "naive", read, naive
]
in Benchmark.tabulate res
in
bench_n 100;
bench_n 100_000;
()
(* vim:Use benchmark: *)

34
sequence/bench/benchs.ml
View file

@ -1,34 +0,0 @@
module S = Sequence
open Sequence.Infix
let small = [10;20;50;100;500]
let medium = small @ [1000;10_000;100_000]
let big = medium @ [500_000; 1_000_000; 2_000_000]
let bench_fold n =
0 -- n |> S.fold (+) 0 |> ignore
let bench_flatmap n =
0 -- n |> S.flatMap (fun i -> i -- (i+5)) |> (fun _ -> ())
let bench_product n =
S.product (0 -- n) (0 -- n) (fun (i,j) -> ())
let _ =
List.iter
(fun (name,bench,sizes) ->
Format.printf "-------------------------------------------------------@.";
Format.printf "bench %s@." name;
List.iter
(fun n ->
let name = name ^ " on " ^ string_of_int n in
let res = Benchmark.throughput1 2 ~name bench n in
Benchmark.tabulate res;
) sizes
)
[ "fold", bench_fold, big
; "flatmap", bench_flatmap, medium
; "product", bench_product, small
];
()

11
sequence/bench/simple_bench.ml
View file

@ -1,11 +0,0 @@
open Sequence.Infix
let _ =
let n = int_of_string Sys.argv.(1) in
let seq = 0 -- n in
let start = Unix.gettimeofday () in
seq |> Sequence.persistent |> Sequence.fold (+) 0 |> ignore;
let stop = Unix.gettimeofday () in
Format.printf "iter on %d: %.4f@." n (stop -. start);
()

45
sequence/bigarray/sequenceBigarray.ml
View file

@ -1,45 +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 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

34
sequence/bigarray/sequenceBigarray.mli
View file

@ -1,34 +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 Interface and Helpers for bigarrays}
@since 0.5.4 *)
val of_bigarray : ('a, _, _) Bigarray.Array1.t -> 'a Sequence.t
(** Iterate on the elements of a 1-D array *)
val mmap : string -> char Sequence.t
(** Map the file into memory, and read the characters. *)

27
sequence/configure vendored
View file

@ -1,27 +0,0 @@
#!/bin/sh
# OASIS_START
# DO NOT EDIT (digest: dc86c2ad450f91ca10c931b6045d0499)
set -e
FST=true
for i in "$@"; do
if $FST; then
set --
FST=false
fi
case $i in
--*=*)
ARG=${i%%=*}
VAL=${i##*=}
set -- "$@" "$ARG" "$VAL"
;;
*)
set -- "$@" "$i"
;;
esac
done
ocaml setup.ml -configure "$@"
# OASIS_STOP

305
sequence/examples/sexpr.ml
View file

@ -1,305 +0,0 @@
(*
Zipperposition: a functional superposition prover for prototyping
Copyright (C) 2012 Simon Cruanes
This is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301 USA.
*)
(* {1 Basic S-expressions, with printing and parsing} *)
(** S-expression *)
type t =
| Atom of string (** An atom *)
| List of t list (** A list of S-expressions *)
(** Token that compose a Sexpr once serialized *)
type token = [`Open | `Close | `Atom of string]
(** {2 Traverse a sequence of tokens} *)
(** Iterate on the S-expression, calling the callback with tokens *)
let rec iter f s = match s with
| Atom a -> f (`Atom a)
| List l -> f `Open; iter_list f l; f `Close
and iter_list f l = match l with
| [] -> ()
| x::l' -> iter f x; iter_list f l'
(** Traverse. This yields a sequence of tokens *)
let traverse s = Sequence.from_iter (fun k -> iter k s)
(** Returns the same sequence of tokens, but during iteration, if
the structure of the Sexpr corresponding to the sequence
is wrong (bad parenthesing), Invalid_argument is raised
and iteration is stoped *)
let validate seq =
let depth = ref 0 in
Sequence.map
(fun tok -> match tok with
| `Open -> incr depth; tok
| `Close -> if !depth = 0
then raise (Invalid_argument "wrong parenthesing")
else decr depth; tok
| _ -> tok)
seq
(** {2 Text <-> tokens} *)
(** Lex: create a sequence of tokens from the given in_channel. *)
let lex input =
let seq_fun k =
let in_word = ref false in
let buf = Buffer.create 128 in
(* loop. TODO handle escaping of (), and "" *)
let rec next c =
match c with
| '(' -> k `Open
| ')' -> flush_word(); k `Close
| ' ' | '\t' | '\n' -> flush_word ()
| c -> in_word := true; Buffer.add_char buf c
(* finish the previous word token *)
and flush_word () =
if !in_word then begin
(* this whitespace follows a word *)
let word = Buffer.contents buf in
Buffer.clear buf;
in_word := false;
k (`Atom word)
end
in
Sequence.iter next input
in
Sequence.from_iter seq_fun
(** Build a Sexpr from a sequence of tokens *)
let of_seq seq =
(* called on every token *)
let rec k stack token = match token with
| `Open -> `Open :: stack
| `Close -> collapse [] stack
| `Atom a -> (`Expr (Atom a)) :: stack
(* collapse last list into an `Expr *)
and collapse acc stack = match stack with
| `Open::stack' -> `Expr (List acc) :: stack'
| `Expr a::stack' -> collapse (a :: acc) stack'
| _ -> assert false
in
(* iterate on the sequence, given an empty initial stack *)
let stack = Sequence.fold k [] seq in
(* stack should contain exactly one expression *)
match stack with
| [`Expr expr] -> expr
| [] -> failwith "no Sexpr could be parsed"
| _ -> failwith "too many elements on the stack"
(** {2 Printing} *)
(** Print a token on the given formatter *)
let pp_token formatter token = match token with
| `Open -> Format.fprintf formatter "@[("
| `Close -> Format.fprintf formatter ")@]"
| `Atom s -> Format.pp_print_string formatter s
(** Print a sequence of Sexpr tokens on the given formatter *)
let pp_tokens formatter tokens =
let first = ref true in
let last = ref false in
Sequence.iter
(fun token ->
(match token with
| `Open -> (if not !first then Format.fprintf formatter " "); first := true
| `Close -> first := false; last := true
| _ -> if !first then first := false else Format.fprintf formatter " ");
pp_token formatter token;
if !last then last := false)
tokens
(** Pretty-print the S-expr. If [indent] is true, the S-expression
is printed with indentation. *)
let pp_sexpr ?(indent=false) formatter s =
if indent
then Format.fprintf formatter "@[<hov 4>%a@]" pp_tokens (traverse s)
else pp_tokens formatter (traverse s)
(** {2 Serializing} *)
let output_seq name subexpr k =
k `Open;
k (`Atom name);
Sequence.iter k subexpr;
k `Close
let output_str name str k =
k `Open;
k (`Atom name);
k (`Atom str);
k `Close
(** {2 Parsing} *)
(** Monadic combinators for parsing data from a sequence of tokens,
without converting to concrete S-expressions.
The [one] parser can raise ParseFailure if it fails to parse
the atomic type. *)
(** parser that returns a 'a *)
type 'a parser =
| Return : 'a -> 'a parser
| One : (token -> 'a) -> 'a parser
| Zero : (token -> 'a parser) -> 'a parser
(* | Maybe of (token -> 'a option) *)
| Bind : ('b parser * ('b -> 'a parser)) -> 'a parser
| Fail : string -> 'a parser
exception ParseFailure of string
let (>>=) p f = Bind (p, f)
let (>>) p p' = p >>= fun _ -> p'
let return x = Return x
let fail reason = Fail reason
let one f = One f
let skip = One (fun _ -> ())
let lookahead f = Zero f
let left = One (function | `Open -> ()
| _ -> raise (ParseFailure "expected '('"))
let right = One (function | `Close -> ()
| _ -> raise (ParseFailure "expected ')'"))
let pair f g =
f >>= fun x ->
g >>= fun y ->
return (x, y)
let triple f g h =
f >>= fun x ->
g >>= fun y ->
h >>= fun z ->
return (x, y, z)
(** [(name,p) ^|| p'] behaves as p if the next token is [`Atom name], and
like [p'] otherwise *)
let (^||) (name,p) p' =
lookahead
(fun token -> match token with
| `Atom s when s = name -> skip >> p ()
| _ -> p')
(** Maps the value returned by the parser *)
let map p f = p >>= fun x -> return (f x)
let p_str = one
(function | `Atom s -> s | _ -> raise (ParseFailure "expected string"))
let p_int = one
(function | `Atom s -> (try int_of_string s
with Failure _ -> raise (ParseFailure "expected int"))
| _ -> raise (ParseFailure "expected int"))
let p_bool = one
(function | `Atom s -> (try bool_of_string s
with Failure _ -> raise (ParseFailure "expected bool"))
| _ -> raise (ParseFailure "expected bool"))
let p_float = one
(function | `Atom s -> (try float_of_string s
with Failure _ -> raise (ParseFailure "expected float"))
| _ -> raise (ParseFailure "expected float"))
let many p =
let rec elements token =
match token with
| `Close -> return []
| _ ->
p >>= fun x ->
lookahead elements >>= fun l ->
return (x :: l)
in
left >> lookahead elements >>= fun l -> right >> return l
let many1 p =
p >>= fun x ->
many p >>= fun l ->
return (x::l)
(** parsing state that returns a 'a *)
type 'a state =
| Bottom : 'a state
| Push : ('b parser * ('b -> 'a state)) -> 'a state
(** Actually parse the sequence of tokens, with a callback to be called
on every parsed value. The callback decides whether to push another
state or whether to continue. *)
let parse_k p tokens k =
let rec state = Push(p, fun x -> match k x with `Stop -> Bottom | `Continue -> state) in
(* Token handler. It also takes the current parser. *)
let rec one_step state token =
match reduce state with
| Bottom -> (* should not happen, unless there are too many tokens *)
raise (ParseFailure "unexpected ')'")
| Push (Return _, cont) ->
assert false (* should be reduced *)
| Push (Zero f, cont) ->
let p' = f token in
let state' = Push (p', cont) in
one_step state' token (* do not consume token *)
| Push (One f, cont) ->
let x = f token in
let state' = cont x in
reduce state' (* consume token *)
(* | Maybe f, _ -> let x = f token in (Obj.magic cont) x *)
| Push (Bind (p', cont'), cont) ->
let cont'' x =
let p'' = cont' x in
Push (p'', cont)
in
let state' = Push (p', cont'') in
one_step state' token (* do not consume token *)
| Push (Fail reason, _) -> raise (ParseFailure reason)
(* Reduce parser state *)
and reduce state = match state with
| Push (Return x, cont) ->
let state' = cont x in
reduce state'
| _ -> state
in
(* iterate on the tokens *)
ignore (Sequence.fold one_step state tokens)
(** Parse one value *)
let parse p tokens =
let res = ref None in
parse_k p tokens (fun x -> res := Some x; `Stop);
(* return result *)
match !res with
| None -> raise (ParseFailure "incomplete input")
| Some x -> x
(** Parse a sequence of values *)
let parse_seq p tokens =
let seq_fun k =
parse_k p tokens (fun x -> k x; `Continue)
in
Sequence.from_iter seq_fun

132
sequence/examples/sexpr.mli
View file

@ -1,132 +0,0 @@
(*
Zipperposition: a functional superposition prover for prototyping
Copyright (C) 2012 Simon Cruanes
This is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301 USA.
*)
(* {1 Basic S-expressions, with printing and parsing} *)
type t =
| Atom of string (** An atom *)
| List of t list (** A list of S-expressions *)
(** S-expression *)
type token = [`Open | `Close | `Atom of string]
(** Token that compose a Sexpr once serialized *)
(** {2 Traverse a sequence of tokens} *)
val iter : (token -> unit) -> t -> unit
(** Iterate on the S-expression, calling the callback with tokens *)
val traverse : t -> token Sequence.t
(** Traverse. This yields a sequence of tokens *)
val validate : token Sequence.t -> token Sequence.t
(** Returns the same sequence of tokens, but during iteration, if
the structure of the Sexpr corresponding to the sequence
is wrong (bad parenthesing), Invalid_argument is raised
and iteration is stoped *)
(** {2 Text <-> tokens} *)
val lex : char Sequence.t -> token Sequence.t
(** Lex: create a sequence of tokens from the given sequence of chars. *)
val of_seq : token Sequence.t -> t
(** Build a Sexpr from a sequence of tokens, or raise Failure *)
(** {2 Printing} *)
val pp_token : Format.formatter -> token -> unit
(** Print a token on the given formatter *)
val pp_tokens : Format.formatter -> token Sequence.t -> unit
(** Print a sequence of Sexpr tokens on the given formatter *)
val pp_sexpr : ?indent:bool -> Format.formatter -> t -> unit
(** Pretty-print the S-expr. If [indent] is true, the S-expression
is printed with indentation. *)
(** {2 Serializing} *)
val output_seq : string -> token Sequence.t -> (token -> unit) -> unit
(** print a pair "(name @,sequence)" *)
val output_str : string -> string -> (token -> unit) -> unit
(** print a pair "(name str)" *)
(** {2 Parsing} *)
(** Monadic combinators for parsing data from a sequence of tokens,
without converting to concrete S-expressions. *)
type 'a parser
exception ParseFailure of string
val (>>=) : 'a parser -> ('a -> 'b parser) -> 'b parser
(** Monadic bind: computes a parser from the result of
the first parser *)
val (>>) : 'a parser -> 'b parser -> 'b parser
(** Like (>>=), but ignores the result of the first parser *)
val return : 'a -> 'a parser
(** Parser that consumes no input and return the given value *)
val fail : string -> 'a parser
(** Fails parsing with the given message *)
val one : (token -> 'a) -> 'a parser
(** consumes one token with the function *)
val skip : unit parser
(** Skip the token *)
val lookahead : (token -> 'a parser) -> 'a parser
(** choose parser given current token *)
val left : unit parser
(** Parses a `Open *)
val right : unit parser
(** Parses a `Close *)
val pair : 'a parser -> 'b parser -> ('a * 'b) parser
val triple : 'a parser -> 'b parser -> 'c parser -> ('a * 'b * 'c) parser
val (^||) : (string * (unit -> 'a parser)) -> 'a parser -> 'a parser
(** [(name,p) ^|| p'] behaves as [p ()] if the next token is [`Atom name], and
like [p'] otherwise *)
val map : 'a parser -> ('a -> 'b) -> 'b parser
(** Maps the value returned by the parser *)
val p_str : string parser
val p_int : int parser
val p_bool : bool parser
val many : 'a parser -> 'a list parser
val many1 : 'a parser -> 'a list parser
val parse : 'a parser -> token Sequence.t -> 'a
(** Parses exactly one value from the sequence of tokens. Raises
ParseFailure if anything goes wrong. *)
val parse_seq : 'a parser -> token Sequence.t -> 'a Sequence.t
(** Parses a sequence of values *)

131
sequence/examples/test_sexpr.ml
View file

@ -1,131 +0,0 @@
(** {2 Test sequences} *)
(** print a list of items using the printing function *)
let pp_list ?(sep=", ") pp_item formatter l =
Sequence.pp_seq ~sep pp_item formatter (Sequence.of_list l)
(** Set of integers *)
module ISet = Set.Make(struct type t = int let compare = compare end)
let iset = (module ISet : Set.S with type elt = int and type t = ISet.t)
module OrderedString = struct type t = string let compare = compare end
module SMap = Sequence.Map.Make(OrderedString)
let my_map = SMap.of_seq (Sequence.of_list ["1", 1; "2", 2; "3", 3; "answer", 42])
let sexpr = "(foo bar (bazz quux hello 42) world (zoo foo bar (1 2 (3 4))))"
type term = | Lambda of term | Const of string | Var of int | Apply of term * term
let random_term () =
let max = 10
and num = ref 0 in
let rec build depth =
if depth > 4 || !num > max then Const (random_const ()) else
match Random.int 6 with
| 0 -> if depth > 0 then Var (Random.int depth) else Const (random_const ())
| 1 -> incr num; Lambda (build (depth+1))
| 2 -> Const (random_const ())
| _ -> incr num; Apply ((build depth), (build depth))
and random_const () = [|"a"; "b"; "c"; "f"; "g"; "h"|].(Random.int 6)
in build 0
let rec sexpr_of_term t =
let f t k = match t with
| Var i -> Sexpr.output_str "var" (string_of_int i) k
| Lambda t' -> Sexpr.output_seq "lambda" (sexpr_of_term t') k
| Apply (t1, t2) -> Sexpr.output_seq "apply" (Sequence.append (sexpr_of_term t1) (sexpr_of_term t2)) k
| Const s -> Sexpr.output_str "const" s k
in Sequence.from_iter (f t)
let term_parser =
let open Sexpr in
let rec p_term () =
left >>
(("lambda", p_lambda) ^|| ("var", p_var) ^|| ("const", p_const) ^||
("apply", p_apply) ^|| fail "bad term") >>= fun x ->
right >> return x
and p_apply () =
p_term () >>= fun x ->
p_term () >>= fun y ->
return (Apply (x,y))
and p_var () = p_int >>= fun i -> return (Var i)
and p_const () = p_str >>= fun s -> return (Const s)
and p_lambda () = p_term () >>= fun t -> return (Lambda t)
in p_term ()
let term_of_sexp seq = Sexpr.parse term_parser seq
let test_term () =
let t = random_term () in
Format.printf "@[<h>random term: %a@]@." Sexpr.pp_tokens (sexpr_of_term t);
let tokens = sexpr_of_term t in
let t' = term_of_sexp tokens in
Format.printf "@[<h>parsed: %a@]@." Sexpr.pp_tokens (sexpr_of_term t');
()
let _ =
(* lists *)
let l = [0;1;2;3;4;5;6] in
let l' = Sequence.to_list
(Sequence.filter (fun x -> x mod 2 = 0) (Sequence.of_list l)) in
let l'' = Sequence.to_list
(Sequence.take 3 (Sequence.drop 1 (Sequence.of_list l))) in
let h = Hashtbl.create 3 in
for i = 0 to 5 do
Hashtbl.add h i (i*i);
done;
let l2 = Sequence.to_list
(Sequence.map (fun (x, y) -> (string_of_int x) ^ " -> " ^ (string_of_int y))
(Sequence.of_hashtbl h))
in
let l3 = Sequence.to_list (Sequence.rev (Sequence.int_range ~start:0 ~stop:42)) in
let set = List.fold_left (fun set x -> ISet.add x set) ISet.empty [4;3;100;42] in
let l4 = Sequence.to_list (Sequence.of_set iset set) in
Format.printf "l=@[<h>[%a]@]@." (pp_list Format.pp_print_int) l;
Format.printf "l'=@[<h>[%a]@]@." (pp_list Format.pp_print_int) l';
Format.printf "l''=@[<h>[%a]@]@." (pp_list Format.pp_print_int) l'';
Format.printf "l2=@[<h>[%a]@]@." (pp_list Format.pp_print_string) l2;
Format.printf "l3=@[<h>[%a]@]@." (pp_list Format.pp_print_int) l3;
Format.printf "s={@[<h>%a@]}@." (Sequence.pp_seq Format.pp_print_int) (Sequence.of_set iset set);
Format.printf "l4=@[<h>[%a]@]@." (pp_list Format.pp_print_int) l4;
Format.printf "l3[:5]+l4=@[<h>[%a]@]@." (Sequence.pp_seq Format.pp_print_int)
(Sequence.of_array
(Sequence.to_array (Sequence.append
(Sequence.take 5 (Sequence.of_list l3)) (Sequence.of_list l4))));
(* sequence, persistent, etc *)
let seq = Sequence.int_range ~start:0 ~stop:100000 in
let seq' = Sequence.persistent seq in
let stream = Sequence.to_stream seq' in
Format.printf "test length [0..100000]: persistent1 %d, stream %d, persistent2 %d"
(Sequence.length seq') (Sequence.length (Sequence.of_stream stream)) (Sequence.length seq');
(* maps *)
Format.printf "@[<h>map: %a@]@."
(Sequence.pp_seq (fun formatter (k,v) -> Format.fprintf formatter "\"%s\" -> %d" k v))
(SMap.to_seq my_map);
let module MyMapSeq = Sequence.Map.Adapt(Map.Make(OrderedString)) in
let my_map' = MyMapSeq.of_seq (Sequence.of_list ["1", 1; "2", 2; "3", 3; "answer", 42]) in
Format.printf "@[<h>map: %a@]@."
(Sequence.pp_seq (fun formatter (k,v) -> Format.fprintf formatter "\"%s\" -> %d" k v))
(MyMapSeq.to_seq my_map');
(* sum *)
let n = 1000000 in
let sum = Sequence.fold (+) 0 (Sequence.take n (Sequence.repeat 1)) in
Format.printf "%dx1 = %d@." n sum;
assert (n=sum);
(* sexpr *)
let s = Sexpr.of_seq (Sexpr.lex (Sequence.of_str sexpr)) in
let s = Sexpr.of_seq (Sequence.map
(function | `Atom s -> `Atom (String.capitalize s) | tok -> tok)
(Sexpr.traverse s))
in
Format.printf "@[<hov2>transform @[<h>%s@] into @[<h>%a@]@]@." sexpr (Sexpr.pp_sexpr ~indent:false) s;
Format.printf "@[<hv2> cycle:%a@]@." Sexpr.pp_tokens
(Sequence.concat (Sequence.take 10 (Sequence.repeat (Sexpr.traverse s))));
(* sexpr parsing/printing *)
for i = 0 to 20 do
Format.printf "%d-th term test@." i;
test_term ();
done;
()

2
sequence/invert/.merlin
View file

@ -1,2 +0,0 @@
REC
PKG delimcc

62
sequence/invert/sequenceInvert.ml
View file

@ -1,62 +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 Interface to Delimcc (Invert control flow)} *)
type 'a gen = unit -> 'a option
type 'a res =
| Start
| Yield of 'a
| Stop
let _ret_none () = None
let _ret_unit () = ()
let to_gen seq =
let p = Delimcc.new_prompt () in
let _next = ref None in
ignore (Delimcc.push_prompt p
(fun () ->
Delimcc.take_subcont p (fun c () -> _next := Some c; Start);
seq
(fun x ->
Delimcc.take_subcont p (fun c () -> _next := Some c; Yield x)
);
_next := None;
Stop
));
(* call next subcont *)
let rec next () =
match !_next with
| None -> None
| Some f ->
begin match Delimcc.push_delim_subcont f _ret_unit with
| Start -> next ()
| Yield x -> Some x
| Stop -> None
end
in
next

32
sequence/invert/sequenceInvert.mli
View file

@ -1,32 +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 Interface to Delimcc (Invert control flow)} *)
type 'a gen = unit -> 'a option
val to_gen : 'a Sequence.t -> 'a gen
(** Use delimited continuations to iterate on the sequence step by step.
Relatively costly but still useful *)

609
sequence/myocamlbuild.ml
View file

@ -1,609 +0,0 @@
(* OASIS_START *)
(* DO NOT EDIT (digest: 958ece46307b808952e439e1cc47a739) *)
module OASISGettext = struct
(* # 22 "src/oasis/OASISGettext.ml" *)
let ns_ str =
str
let s_ str =
str
let f_ (str: ('a, 'b, 'c, 'd) format4) =
str
let fn_ fmt1 fmt2 n =
if n = 1 then
fmt1^^""
else
fmt2^^""
let init =
[]
end
module OASISExpr = struct
(* # 22 "src/oasis/OASISExpr.ml" *)
open OASISGettext
type test = string
type flag = string
type t =
| EBool of bool
| ENot of t
| EAnd of t * t
| EOr of t * t
| EFlag of flag
| ETest of test * string
type 'a choices = (t * 'a) list
let eval var_get t =
let rec eval' =
function
| EBool b ->
b
| ENot e ->
not (eval' e)
| EAnd (e1, e2) ->
(eval' e1) && (eval' e2)
| EOr (e1, e2) ->
(eval' e1) || (eval' e2)
| EFlag nm ->
let v =
var_get nm
in
assert(v = "true" || v = "false");
(v = "true")
| ETest (nm, vl) ->
let v =
var_get nm
in
(v = vl)
in
eval' t
let choose ?printer ?name var_get lst =
let rec choose_aux =
function
| (cond, vl) :: tl ->
if eval var_get cond then
vl
else
choose_aux tl
| [] ->
let str_lst =
if lst = [] then
s_ "<empty>"
else
String.concat
(s_ ", ")
(List.map
(fun (cond, vl) ->
match printer with
| Some p -> p vl
| None -> s_ "<no printer>")
lst)
in
match name with
| Some nm ->
failwith
(Printf.sprintf
(f_ "No result for the choice list '%s': %s")
nm str_lst)
| None ->
failwith
(Printf.sprintf
(f_ "No result for a choice list: %s")
str_lst)
in
choose_aux (List.rev lst)
end
# 132 "myocamlbuild.ml"
module BaseEnvLight = struct
(* # 22 "src/base/BaseEnvLight.ml" *)
module MapString = Map.Make(String)
type t = string MapString.t
let default_filename =
Filename.concat
(Sys.getcwd ())
"setup.data"
let load ?(allow_empty=false) ?(filename=default_filename) () =
if Sys.file_exists filename then
begin
let chn =
open_in_bin filename
in
let st =
Stream.of_channel chn
in
let line =
ref 1
in
let st_line =
Stream.from
(fun _ ->
try
match Stream.next st with
| '\n' -> incr line; Some '\n'
| c -> Some c
with Stream.Failure -> None)
in
let lexer =
Genlex.make_lexer ["="] st_line
in
let rec read_file mp =
match Stream.npeek 3 lexer with
| [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
Stream.junk lexer;
Stream.junk lexer;
Stream.junk lexer;
read_file (MapString.add nm value mp)
| [] ->
mp
| _ ->
failwith
(Printf.sprintf
"Malformed data file '%s' line %d"
filename !line)
in
let mp =
read_file MapString.empty
in
close_in chn;
mp
end
else if allow_empty then
begin
MapString.empty
end
else
begin
failwith
(Printf.sprintf
"Unable to load environment, the file '%s' doesn't exist."
filename)
end
let rec var_expand str env =
let buff =
Buffer.create ((String.length str) * 2)
in
Buffer.add_substitute
buff
(fun var ->
try
var_expand (MapString.find var env) env
with Not_found ->
failwith
(Printf.sprintf
"No variable %s defined when trying to expand %S."
var
str))
str;
Buffer.contents buff
let var_get name env =
var_expand (MapString.find name env) env
let var_choose lst env =
OASISExpr.choose
(fun nm -> var_get nm env)
lst
end
# 237 "myocamlbuild.ml"
module MyOCamlbuildFindlib = struct
(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
(** OCamlbuild extension, copied from
* http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild
* by N. Pouillard and others
*
* Updated on 2009/02/28
*
* Modified by Sylvain Le Gall
*)
open Ocamlbuild_plugin
(* these functions are not really officially exported *)
let run_and_read =
Ocamlbuild_pack.My_unix.run_and_read
let blank_sep_strings =
Ocamlbuild_pack.Lexers.blank_sep_strings
let exec_from_conf exec =
let exec =
let env_filename = Pathname.basename BaseEnvLight.default_filename in
let env = BaseEnvLight.load ~filename:env_filename ~allow_empty:true () in
try
BaseEnvLight.var_get exec env
with Not_found ->
Printf.eprintf "W: Cannot get variable %s\n" exec;
exec
in
let fix_win32 str =
if Sys.os_type = "Win32" then begin
let buff = Buffer.create (String.length str) in
(* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'.
*)
String.iter
(fun c -> Buffer.add_char buff (if c = '\\' then '/' else c))
str;
Buffer.contents buff
end else begin
str
end
in
fix_win32 exec
let split s ch =
let buf = Buffer.create 13 in
let x = ref [] in
let flush () =
x := (Buffer.contents buf) :: !x;
Buffer.clear buf
in
String.iter
(fun c ->
if c = ch then
flush ()
else
Buffer.add_char buf c)
s;
flush ();
List.rev !x
let split_nl s = split s '\n'
let before_space s =
try
String.before s (String.index s ' ')
with Not_found -> s
(* ocamlfind command *)
let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x]
(* This lists all supported packages. *)
let find_packages () =
List.map before_space (split_nl & run_and_read "ocamlfind list")
(* Mock to list available syntaxes. *)
let find_syntaxes () = ["camlp4o"; "camlp4r"]
let well_known_syntax = [
"camlp4.quotations.o";
"camlp4.quotations.r";
"camlp4.exceptiontracer";
"camlp4.extend";
"camlp4.foldgenerator";
"camlp4.listcomprehension";
"camlp4.locationstripper";
"camlp4.macro";
"camlp4.mapgenerator";
"camlp4.metagenerator";
"camlp4.profiler";
"camlp4.tracer"
]
let dispatch =
function
| After_options ->
(* By using Before_options one let command line options have an higher
* priority on the contrary using After_options will guarantee to have
* the higher priority override default commands by ocamlfind ones *)
Options.ocamlc := ocamlfind & A"ocamlc";
Options.ocamlopt := ocamlfind & A"ocamlopt";
Options.ocamldep := ocamlfind & A"ocamldep";
Options.ocamldoc := ocamlfind & A"ocamldoc";
Options.ocamlmktop := ocamlfind & A"ocamlmktop";
Options.ocamlmklib := ocamlfind & A"ocamlmklib"
| After_rules ->
(* When one link an OCaml library/binary/package, one should use
* -linkpkg *)
flag ["ocaml"; "link"; "program"] & A"-linkpkg";
(* For each ocamlfind package one inject the -package option when
* compiling, computing dependencies, generating documentation and
* linking. *)
List.iter
begin fun pkg ->
let base_args = [A"-package"; A pkg] in
(* TODO: consider how to really choose camlp4o or camlp4r. *)
let syn_args = [A"-syntax"; A "camlp4o"] in
let args =
(* 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
syn_args @ base_args
else
base_args
in
flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
end
(find_packages ());
(* Like -package but for extensions syntax. Morover -syntax is useless
* when linking. *)
List.iter begin fun syntax ->
flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "infer_interface"; "syntax_"^syntax] &
S[A"-syntax"; A syntax];
end (find_syntaxes ());
(* The default "thread" tag is not compatible with ocamlfind.
* Indeed, the default rules add the "threads.cma" or "threads.cmxa"
* options when using this tag. When using the "-linkpkg" option with
* ocamlfind, this module will then be added twice on the command line.
*
* To solve this, one approach is to add the "-thread" option when using
* the "threads" package using the previous plugin.
*)
flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]);
flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]);
| _ ->
()
end
module MyOCamlbuildBase = struct
(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
(** Base functions for writing myocamlbuild.ml
@author Sylvain Le Gall
*)
open Ocamlbuild_plugin
module OC = Ocamlbuild_pack.Ocaml_compiler
type dir = string
type file = string
type name = string
type tag = string
(* # 62 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
type t =
{
lib_ocaml: (name * dir list * string list) list;
lib_c: (name * dir * file list) list;
flags: (tag list * (spec OASISExpr.choices)) list;
(* Replace the 'dir: include' from _tags by a precise interdepends in
* directory.
*)
includes: (dir * dir list) list;
}
let env_filename =
Pathname.basename
BaseEnvLight.default_filename
let dispatch_combine lst =
fun e ->
List.iter
(fun dispatch -> dispatch e)
lst
let tag_libstubs nm =
"use_lib"^nm^"_stubs"
let nm_libstubs nm =
nm^"_stubs"
let dispatch t e =
let env =
BaseEnvLight.load
~filename:env_filename
~allow_empty:true
()
in
match e with
| Before_options ->
let no_trailing_dot s =
if String.length s >= 1 && s.[0] = '.' then
String.sub s 1 ((String.length s) - 1)
else
s
in
List.iter
(fun (opt, var) ->
try
opt := no_trailing_dot (BaseEnvLight.var_get var env)
with Not_found ->
Printf.eprintf "W: Cannot get variable %s\n" var)
[
Options.ext_obj, "ext_obj";
Options.ext_lib, "ext_lib";
Options.ext_dll, "ext_dll";
]
| After_rules ->
(* Declare OCaml libraries *)
List.iter
(function
| nm, [], intf_modules ->
ocaml_lib nm;
let cmis =
List.map (fun m -> (String.uncapitalize m) ^ ".cmi")
intf_modules in
dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis
| nm, dir :: tl, intf_modules ->
ocaml_lib ~dir:dir (dir^"/"^nm);
List.iter
(fun dir ->
List.iter
(fun str ->
flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir]))
["compile"; "infer_interface"; "doc"])
tl;
let cmis =
List.map (fun m -> dir^"/"^(String.uncapitalize m)^".cmi")
intf_modules in
dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"]
cmis)
t.lib_ocaml;
(* Declare directories dependencies, replace "include" in _tags. *)
List.iter
(fun (dir, include_dirs) ->
Pathname.define_context dir include_dirs)
t.includes;
(* Declare C libraries *)
List.iter
(fun (lib, dir, headers) ->
(* Handle C part of library *)
flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib]
(S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib";
A("-l"^(nm_libstubs lib))]);
flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib]
(S[A"-cclib"; A("-l"^(nm_libstubs lib))]);
flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
(S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
(* When ocaml link something that use the C library, then one
need that file to be up to date.
*)
dep ["link"; "ocaml"; "program"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
dep ["compile"; "ocaml"; "program"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
(* TODO: be more specific about what depends on headers *)
(* Depends on .h files *)
dep ["compile"; "c"]
headers;
(* Setup search path for lib *)
flag ["link"; "ocaml"; "use_"^lib]
(S[A"-I"; P(dir)]);
)
t.lib_c;
(* Add flags *)
List.iter
(fun (tags, cond_specs) ->
let spec = BaseEnvLight.var_choose cond_specs env in
let rec eval_specs =
function
| S lst -> S (List.map eval_specs lst)
| A str -> A (BaseEnvLight.var_expand str env)
| spec -> spec
in
flag tags & (eval_specs spec))
t.flags
| _ ->
()
let dispatch_default t =
dispatch_combine
[
dispatch t;
MyOCamlbuildFindlib.dispatch;
]
end
# 594 "myocamlbuild.ml"
open Ocamlbuild_plugin;;
let package_default =
{
MyOCamlbuildBase.lib_ocaml = [("sequence", [], [])];
lib_c = [];
flags = [];
includes = []
}
;;
let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;;
# 608 "myocamlbuild.ml"
(* OASIS_STOP *)
Ocamlbuild_plugin.dispatch dispatch_default;;

787
sequence/sequence.ml
View file

@ -1,787 +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 Transient iterators, that abstract on a finite sequence of elements.} *)
(** Sequence abstract iterator type *)
type 'a t = ('a -> unit) -> unit
type 'a sequence = 'a t
type (+'a, +'b) t2 = ('a -> 'b -> unit) -> unit
(** Sequence of pairs of values of type ['a] and ['b]. *)
(** Build a sequence from a iter function *)
let from_iter f = f
let rec from_fun f k = match f () with
| None -> ()
| Some x -> k x; from_fun f k
let empty _ = ()
let singleton x k = k x
let return x k = k x
let pure f k = k f
let doubleton x y k = k x; k y
let cons x l k = k x; l k
let snoc l x k = l k; k x
let repeat x k = while true do k x done
let rec iterate f x k =
k x;
iterate f (f x) k
let rec forever f k =
k (f ());
forever f k
let cycle s k = while true do s k; done
let iter f seq = seq f
let iteri f seq =
let r = ref 0 in
seq
(fun x ->
f !r x;
incr r)
let fold f init seq =
let r = ref init in
seq (fun elt -> r := f !r elt);
!r
let foldi f init seq =
let i = ref 0 in
let r = ref init in
seq
(fun elt ->
r := f !r !i elt;
incr i);
!r
let map f seq k = seq (fun x -> k (f x))
let mapi f seq k =
let i = ref 0 in
seq (fun x -> k (f !i x); incr i)
let filter p seq k = seq (fun x -> if p x then k x)
let append s1 s2 k = s1 k; s2 k
let concat s k = s (fun s' -> s' k)
let flatten s = concat s
let flatMap f seq k = seq (fun x -> f x k)
let flat_map = flatMap
let fmap f seq k =
seq (fun x -> match f x with
| None -> ()
| Some y -> k y
)
let filter_map = fmap
let intersperse elem seq k =
let first = ref true in
seq (fun x -> (if !first then first := false else k elem); k x)
(** Mutable unrolled list to serve as intermediate storage *)
module MList = struct
type 'a node =
| Nil
| Cons of 'a array * int ref * 'a node ref
(* build and call callback on every element *)
let of_seq_with seq k =
let start = ref Nil in
let chunk_size = ref 8 in
(* fill the list. prev: tail-reference from previous node *)
let prev, cur = ref start, ref Nil in
seq
(fun x ->
k x; (* callback *)
match !cur with
| Nil ->
let n = !chunk_size in
if n < 4096 then chunk_size := 2 * !chunk_size;
cur := Cons (Array.make n x, ref 1, ref Nil)
| Cons (a,n,next) ->
assert (!n < Array.length a);
a.(!n) <- x;
incr n;
if !n = Array.length a then begin
!prev := !cur;
prev := next;
cur := Nil
end
);
!prev := !cur;
!start
let of_seq seq =
of_seq_with seq (fun _ -> ())
let rec iter f l = match l with
| Nil -> ()
| Cons (a, n, tl) ->
for i=0 to !n - 1 do f a.(i) done;
iter f !tl
let iteri f l =
let rec iteri i f l = match l with
| Nil -> ()
| Cons (a, n, tl) ->
for j=0 to !n - 1 do f (i+j) a.(j) done;
iteri (i+ !n) f !tl
in iteri 0 f l
let rec iter_rev f l = match l with
| Nil -> ()
| Cons (a, n, tl) ->
iter_rev f !tl;
for i = !n-1 downto 0 do f a.(i) done
let length l =
let rec len acc l = match l with
| Nil -> acc
| Cons (_, n, tl) -> len (acc+ !n) !tl
in len 0 l
(** Get element by index *)
let rec get l i = match l with
| Nil -> raise (Invalid_argument "MList.get")
| Cons (a, n, _) when i < !n -> a.(i)
| Cons (_, n, tl) -> get !tl (i- !n)
let to_seq l k = iter k l
let _to_next arg l =
let cur = ref l in
let i = ref 0 in (* offset in cons *)
let rec get_next _ = match !cur with
| Nil -> None
| Cons (_, n, tl) when !i = !n ->
cur := !tl;
i := 0;
get_next arg
| Cons (a, _, _) ->
let x = a.(!i) in
incr i;
Some x
in get_next
let to_gen l = _to_next () l
let to_stream l =
Stream.from (_to_next 42 l) (* 42=magic cookiiiiiie *)
let to_klist l =
let rec make (l,i) () = match l with
| Nil -> `Nil
| Cons (_, n, tl) when i = !n -> make (!tl,0) ()
| Cons (a, _, _) -> `Cons (a.(i), make (l,i+1))
in make (l,0)
end
let persistent seq =
let l = MList.of_seq seq in
MList.to_seq l
type 'a lazy_state =
| LazySuspend
| LazyCached of 'a t
let persistent_lazy (seq:'a t) =
let r = ref LazySuspend in
fun k ->
match !r with
| LazyCached seq' -> seq' k
| LazySuspend ->
(* here if this traversal is interruted, no caching occurs *)
let seq' = MList.of_seq_with seq k in
r := LazyCached (MList.to_seq seq')
let sort ?(cmp=Pervasives.compare) seq =
(* use an intermediate list, then sort the list *)
let l = fold (fun l x -> x::l) [] seq in
let l = List.fast_sort cmp l in
fun k -> List.iter k l
let group ?(eq=fun x y -> x = y) seq k =
let cur = ref [] in
seq (fun x ->
match !cur with
| [] -> cur := [x]
| (y::_) as l when eq x y ->
cur := x::l (* [x] belongs to the group *)
| (_::_) as l ->
k l; (* yield group, and start another one *)
cur := [x]);
(* last list *)
if !cur <> [] then k !cur
let uniq ?(eq=fun x y -> x = y) seq k =
let has_prev = ref false
and prev = ref (Obj.magic 0) in (* avoid option type, costly *)
seq (fun x ->
if !has_prev && eq !prev x
then () (* duplicate *)
else begin
has_prev := true;
prev := x;
k x
end)
let sort_uniq (type elt) ?(cmp=Pervasives.compare) seq =
let module S = Set.Make(struct
type t = elt
let compare = cmp
end) in
let set = fold (fun acc x -> S.add x acc) S.empty seq in
fun k -> S.iter k set
let product outer inner k =
outer (fun x ->
inner (fun y -> k (x,y))
)
let product2 outer inner k =
outer (fun x ->
inner (fun y -> k x y)
)
let join ~join_row s1 s2 k =
s1 (fun a ->
s2 (fun b ->
match join_row a b with
| None -> ()
| Some c -> k c
)
) (* yield the combination of [a] and [b] *)
let rec unfoldr f b k = match f b with
| None -> ()
| Some (x, b') ->
k x;
unfoldr f b' k
let scan f acc seq k =
k acc;
let acc = ref acc in
seq (fun elt -> let acc' = f !acc elt in k acc'; acc := acc')
let max ?(lt=fun x y -> x < y) seq =
let ret = ref None in
seq (fun x -> match !ret with
| None -> ret := Some x
| Some y -> if lt y x then ret := Some x);
!ret
let min ?(lt=fun x y -> x < y) seq =
let ret = ref None in
seq (fun x -> match !ret with
| None -> ret := Some x
| Some y -> if lt x y then ret := Some x);
!ret
exception ExitHead
let head seq =
let r = ref None in
try
seq (fun x -> r := Some x; raise ExitHead); None
with ExitHead -> !r
let head_exn seq =
match head seq with
| None -> invalid_arg "Sequence.head_exn"
| Some x -> x
exception ExitTake
let take n seq k =
let count = ref 0 in
try
seq (fun x ->
if !count = n then raise ExitTake;
incr count;
k x;
)
with ExitTake -> ()
exception ExitTakeWhile
let take_while p seq k =
try
seq (fun x -> if p x then k x else raise ExitTakeWhile)
with ExitTakeWhile -> ()
let drop n seq k =
let count = ref 0 in
seq (fun x -> if !count >= n then k x else incr count)
let drop_while p seq k =
let drop = ref true in
seq (fun x ->
if !drop
then if p x then () else (drop := false; k x)
else k x)
let rev seq =
let l = MList.of_seq seq in
fun k -> MList.iter_rev k l
exception ExitForall
let for_all p seq =
try
seq (fun x -> if not (p x) then raise ExitForall);
true
with ExitForall -> false
exception ExitExists
(** Exists there some element satisfying the predicate? *)
let exists p seq =
try
seq (fun x -> if p x then raise ExitExists);
false
with ExitExists -> true
let mem ?(eq=(=)) x seq = exists (eq x) seq
exception ExitFind
let find f seq =
let r = ref None in
begin try
seq (fun x -> match f x with
| None -> ()
| Some _ as res -> r := res; raise ExitFind
);
with ExitFind -> ()
end;
!r
let length seq =
let r = ref 0 in
seq (fun _ -> incr r);
!r
exception ExitIsEmpty
let is_empty seq =
try seq (fun _ -> raise ExitIsEmpty); true
with ExitIsEmpty -> false
(** {2 Transform a sequence} *)
let empty2 _ = ()
let is_empty2 seq2 =
try ignore (seq2 (fun _ _ -> raise ExitIsEmpty)); true
with ExitIsEmpty -> false
let length2 seq2 =
let r = ref 0 in
seq2 (fun _ _ -> incr r);
!r
let zip seq2 k = seq2 (fun x y -> k (x,y))
let unzip seq k = seq (fun (x,y) -> k x y)
let zip_i seq k =
let r = ref 0 in
seq (fun x -> let n = !r in incr r; k n x)
let fold2 f acc seq2 =
let acc = ref acc in
seq2 (fun x y -> acc := f !acc x y);
!acc
let iter2 f seq2 = seq2 f
let map2 f seq2 k = seq2 (fun x y -> k (f x y))
let map2_2 f g seq2 k =
seq2 (fun x y -> k (f x y) (g x y))
(** {2 Basic data structures converters} *)
let to_list seq = List.rev (fold (fun y x -> x::y) [] seq)
let to_rev_list seq = fold (fun y x -> x :: y) [] seq
let of_list l k = List.iter k l
let on_list f l =
to_list (f (of_list l))
let to_opt = head
let of_opt o k = match o with
| None -> ()
| Some x -> k x
let to_array seq =
let l = MList.of_seq seq in
let n = MList.length l in
if n = 0
then [||]
else begin
let a = Array.make n (MList.get l 0) in
MList.iteri (fun i x -> a.(i) <- x) l;
a
end
let of_array a k =
for i = 0 to Array.length a - 1 do
k (Array.unsafe_get a i)
done
let of_array_i a k =
for i = 0 to Array.length a - 1 do
k (i, Array.unsafe_get a i)
done
let of_array2 a k =
for i = 0 to Array.length a - 1 do
k i (Array.unsafe_get a i)
done
let array_slice a i j k =
assert (i >= 0 && j < Array.length a);
for idx = i to j do
k a.(idx); (* iterate on sub-array *)
done
let of_stream s k = Stream.iter k s
let to_stream seq =
let l = MList.of_seq seq in
MList.to_stream l
let to_stack s seq = iter (fun x -> Stack.push x s) seq
let of_stack s k = Stack.iter k s
let to_queue q seq = seq (fun x -> Queue.push x q)
let of_queue q k = Queue.iter k q
let hashtbl_add h seq =
seq (fun (k,v) -> Hashtbl.add h k v)
let hashtbl_replace h seq =
seq (fun (k,v) -> Hashtbl.replace h k v)
let to_hashtbl seq =
let h = Hashtbl.create 3 in
hashtbl_replace h seq;
h
let to_hashtbl2 seq2 =
let h = Hashtbl.create 3 in
seq2 (fun k v -> Hashtbl.replace h k v);
h
let of_hashtbl h k = Hashtbl.iter (fun a b -> k (a, b)) h
let of_hashtbl2 h k = Hashtbl.iter k h
let hashtbl_keys h k = Hashtbl.iter (fun a _ -> k a) h
let hashtbl_values h k = Hashtbl.iter (fun _ b -> k b) h
let of_str s k = String.iter k s
let to_str seq =
let b = Buffer.create 64 in
iter (fun c -> Buffer.add_char b c) seq;
Buffer.contents b
let concat_str seq =
let b = Buffer.create 64 in
iter (Buffer.add_string b) seq;
Buffer.contents b
exception OneShotSequence
let of_in_channel ic =
let first = ref true in
fun k ->
if not !first
then raise OneShotSequence
else (
first := false;
try
while true do
let c = input_char ic in k c
done
with End_of_file -> ()
)
let to_buffer seq buf =
seq (fun c -> Buffer.add_char buf c)
(** Iterator on integers in [start...stop] by steps 1 *)
let int_range ~start ~stop k =
for i = start to stop do k i done
let int_range_dec ~start ~stop k =
for i = start downto stop do k i done
let of_set (type s) (type v) m set =
let module S = (val m : Set.S with type t = s and type elt = v) in
fun k -> S.iter k set
let to_set (type s) (type v) m seq =
let module S = (val m : Set.S with type t = s and type elt = v) in
fold
(fun set x -> S.add x set)
S.empty seq
type 'a gen = unit -> 'a option
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
let of_gen g =
(* consume the generator to build a MList *)
let rec iter1 k = match g () with
| None -> ()
| Some x -> k x; iter1 k
in
let l = MList.of_seq iter1 in
MList.to_seq l
let to_gen seq =
let l = MList.of_seq seq in
MList.to_gen l
let rec of_klist l k = match l() with
| `Nil -> ()
| `Cons (x,tl) -> k x; of_klist tl k
let to_klist seq =
let l = MList.of_seq seq in
MList.to_klist l
(** {2 Functorial conversions between sets and sequences} *)
module Set = struct
module type S = sig
include Set.S
val of_seq : elt sequence -> t
val to_seq : t -> elt sequence
val to_list : t -> elt list
val of_list : elt list -> t
end
(** Create an enriched Set module from the given one *)
module Adapt(X : Set.S) : S with type elt = X.elt and type t = X.t = struct
let to_seq set k = X.iter k set
let of_seq seq = fold (fun set x -> X.add x set) X.empty seq
let to_list set = to_list (to_seq set)
include X
let of_list l = List.fold_left (fun set x -> add x set) empty l
end
(** Functor to build an extended Set module from an ordered type *)
module Make(X : Set.OrderedType) = struct
module MySet = Set.Make(X)
include Adapt(MySet)
end
end
(** {2 Conversion between maps and sequences.} *)
module Map = struct
module type S = sig
include Map.S
val to_seq : 'a t -> (key * 'a) sequence
val of_seq : (key * 'a) sequence -> 'a t
val keys : 'a t -> key sequence
val values : 'a t -> 'a sequence
val to_list : 'a t -> (key * 'a) list
val of_list : (key * 'a) list -> 'a t
end
(** Adapt a pre-existing Map module to make it sequence-aware *)
module Adapt(M : Map.S) = struct
let to_seq m = from_iter (fun k -> M.iter (fun x y -> k (x,y)) m)
let of_seq seq = fold (fun m (k,v) -> M.add k v m) M.empty seq
let keys m = from_iter (fun k -> M.iter (fun x _ -> k x) m)
let values m = from_iter (fun k -> M.iter (fun _ y -> k y) m)
let of_list l = of_seq (of_list l)
let to_list x = to_list (to_seq x)
include M
end
(** Create an enriched Map module, with sequence-aware functions *)
module Make(V : Map.OrderedType) : S with type key = V.t = struct
module M = Map.Make(V)
include Adapt(M)
end
end
(** {2 Infinite sequences of random values} *)
let random_int bound = forever (fun () -> Random.int bound)
let random_bool = forever Random.bool
let random_float bound = forever (fun () -> Random.float bound)
let random_array a k =
assert (Array.length a > 0);
while true do
let i = Random.int (Array.length a) in
k a.(i);
done
let random_list l = random_array (Array.of_list l)
(** {2 Infix functions} *)
module Infix = struct
let (--) i j = int_range ~start:i ~stop:j
let (--^) i j = int_range_dec ~start:i ~stop:j
let (>>=) x f = flat_map f x
let (>|=) x f = map f x
let (<*>) funs args k =
funs (fun f -> args (fun x -> k (f x)))
let (<+>) = append
end
include Infix
(** {2 Pretty printing of sequences} *)
(** Pretty print a sequence of ['a], using the given pretty printer
to print each elements. An optional separator string can be provided. *)
let pp_seq ?(sep=", ") pp_elt formatter seq =
let first = ref true in
seq
(fun x ->
(if !first then first := false
else begin
Format.pp_print_string formatter sep;
Format.pp_print_cut formatter ();
end);
pp_elt formatter x)
let pp_buf ?(sep=", ") pp_elt buf seq =
let first = ref true in
seq
(fun x ->
if !first then first := false else Buffer.add_string buf sep;
pp_elt buf x)
let to_string ?sep pp_elt seq =
let buf = Buffer.create 25 in
pp_buf ?sep (fun buf x -> Buffer.add_string buf (pp_elt x)) buf seq;
Buffer.contents buf
(** {2 Basic IO} *)
module IO = struct
let lines_of ?(mode=0o644) ?(flags=[Open_rdonly]) filename =
fun k ->
let ic = open_in_gen flags mode filename in
try
while true do
let line = input_line ic in
k line
done
with
| End_of_file -> close_in ic
| e -> close_in_noerr ic; raise e
let chunks_of ?(mode=0o644) ?(flags=[]) ?(size=1024) filename =
fun k ->
let ic = open_in_gen flags mode filename in
try
let buf = Bytes.create size in
let n = ref 0 in
let stop = ref false in
while not !stop do
n := 0;
(* try to read [size] chars. If [input] returns [0] it means
the end of file, so we stop, but first we yield the current chunk *)
while !n < size && not !stop do
let n' = input ic buf !n (size - !n) in
if n' = 0 then stop := true else n := !n + n';
done;
if !n > 0
then k (Bytes.sub_string buf 0 !n)
done;
close_in ic
with e ->
close_in_noerr ic;
raise e
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 (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_bytes_lines ?mode ?flags filename (map Bytes.unsafe_of_string seq)
end

4
sequence/sequence.mldylib
View file

@ -1,4 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: 3ff39d3acb327553070a64ef0cb321d5)
Sequence
# OASIS_STOP

606
sequence/sequence.mli
View file

@ -1,606 +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 Simple and Efficient Iterators} *)
(** The iterators are designed to allow easy transfer (mappings) between data
structures, without defining [n^2] conversions between the [n] types. The
implementation relies on the assumption that a sequence can be iterated
on as many times as needed; this choice allows for high performance
of many combinators. However, for transient iterators, the {!persistent}
function is provided, storing elements of a transient iterator
in memory; the iterator can then be used several times (See further).
Note that some combinators also return sequences (e.g. {!group}). The
transformation is computed on the fly every time one iterates over
the resulting sequence. If a transformation performs heavy computation,
{!persistent} can also be used as intermediate storage.
Most functions are {b lazy}, i.e. they do not actually use their arguments
until their result is iterated on. For instance, if one calls {!map}
on a sequence, one gets a new sequence, but nothing else happens until
this new sequence is used (by folding or iterating on it).
If a sequence is built from an iteration function that is {b repeatable}
(i.e. calling it several times always iterates on the same set of
elements, for instance List.iter or Map.iter), then
the resulting {!t} object is also repeatable. For {b one-time iter functions}
such as iteration on a file descriptor or a {!Stream},
the {!persistent} function can be used to iterate and store elements in
a memory structure; the result is a sequence that iterates on the elements
of this memory structure, cheaply and repeatably. *)
type +'a t = ('a -> unit) -> unit
(** A sequence of values of type ['a]. If you give it a function ['a -> unit]
it will be applied to every element of the sequence successively. *)
type +'a sequence = 'a t
type (+'a, +'b) t2 = ('a -> 'b -> unit) -> unit
(** Sequence of pairs of values of type ['a] and ['b]. *)
(** {2 Build a sequence} *)
val from_iter : (('a -> unit) -> unit) -> 'a t
(** Build a sequence from a iter function *)
val from_fun : (unit -> 'a option) -> 'a t
(** Call the function repeatedly until it returns None. This
sequence is transient, use {!persistent} if needed! *)
val empty : 'a t
(** Empty sequence. It contains no element. *)
val singleton : 'a -> 'a t
(** Singleton sequence, with exactly one element. *)
val doubleton : 'a -> 'a -> 'a t
(** Sequence with exactly two elements *)
val cons : 'a -> 'a t -> 'a t
(** [cons x l] yields [x], then yields from [l].
Same as [append (singleton x) l] *)
val snoc : 'a t -> 'a -> 'a t
(** Same as {!cons} but yields the element after iterating on [l] *)
val return : 'a -> 'a t
(** Synonym to {!singleton} *)
val pure : 'a -> 'a t
(** Synonym to {!singleton} *)
val repeat : 'a -> 'a t
(** Infinite sequence of the same element. You may want to look
at {!take} and the likes if you iterate on it. *)
val iterate : ('a -> 'a) -> 'a -> 'a t
(** [iterate f x] is the infinite sequence [x, f(x), f(f(x)), ...] *)
val forever : (unit -> 'b) -> 'b t
(** Sequence that calls the given function to produce elements.
The sequence may be transient (depending on the function), and definitely
is infinite. You may want to use {!take} and {!persistent}. *)
val cycle : 'a t -> 'a t
(** Cycle forever through the given sequence. Assume the given sequence can
be traversed any amount of times (not transient). This yields an
infinite sequence, you should use something like {!take} not to loop
forever. *)
(** {2 Consume a sequence} *)
val iter : ('a -> unit) -> 'a t -> unit
(** Consume the sequence, passing all its arguments to the function.
Basically [iter f seq] is just [seq f]. *)
val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** Iterate on elements and their index in the sequence *)
val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
(** Fold over elements of the sequence, consuming it *)
val foldi : ('b -> int -> 'a -> 'b) -> 'b -> 'a t -> 'b
(** Fold over elements of the sequence and their index, consuming it *)
val map : ('a -> 'b) -> 'a t -> 'b t
(** Map objects of the sequence into other elements, lazily *)
val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
(** Map objects, along with their index in the sequence *)
val for_all : ('a -> bool) -> 'a t -> bool
(** Do all elements satisfy the predicate? *)
val exists : ('a -> bool) -> 'a t -> bool
(** Exists there some element satisfying the predicate? *)
val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool
(** Is the value a member of the sequence?
@param eq the equality predicate to use (default [(=)])
@since 0.5 *)
val find : ('a -> 'b option) -> 'a t -> 'b option
(** Find the first element on which the function doesn't return [None]
@since 0.5 *)
val length : 'a t -> int
(** How long is the sequence? Forces the sequence. *)
val is_empty : 'a t -> bool
(** Is the sequence empty? Forces the sequence. *)
(** {2 Transform a sequence} *)
val filter : ('a -> bool) -> 'a t -> 'a t
(** Filter on elements of the sequence *)
val append : 'a t -> 'a t -> 'a t
(** Append two sequences. Iterating on the result is like iterating
on the first, then on the second. *)
val concat : 'a t t -> 'a t
(** Concatenate a sequence of sequences into one sequence. *)
val flatten : 'a t t -> 'a t
(** Alias for {!concat} *)
val flatMap : ('a -> 'b t) -> 'a t -> 'b t
(** Monadic bind. Intuitively, it applies the function to every element of the
initial sequence, and calls {!concat}. *)
val flat_map : ('a -> 'b t) -> 'a t -> 'b t
(** Alias to {!flatMap} with a more explicit name
@since 0.5 *)
val fmap : ('a -> 'b option) -> 'a t -> 'b t
(** Specialized version of {!flatMap} for options. *)
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
(** Alias to {!fmap} with a more explicit name
@since 0.5 *)
val intersperse : 'a -> 'a t -> 'a t
(** Insert the single element between every element of the sequence *)
(** {2 Caching} *)
val persistent : 'a t -> 'a t
(** Iterate on the sequence, storing elements in an efficient internal structure..
The resulting sequence can be iterated on as many times as needed.
{b Note}: calling persistent on an already persistent sequence
will still make a new copy of the sequence! *)
val persistent_lazy : 'a t -> 'a t
(** Lazy version of {!persistent}. When calling [persistent_lazy s],
a new sequence [s'] is immediately returned (without actually consuming
[s]) in constant time; the first time [s'] is iterated on,
it also consumes [s] and caches its content into a inner data
structure that will back [s'] for future iterations.
{b warning}: on the first traversal of [s'], if the traversal
is interrupted prematurely ({!take}, etc.) then [s'] will not be
memorized, and the next call to [s'] will traverse [s] again. *)
(** {2 Misc} *)
val sort : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
(** Sort the sequence. Eager, O(n) ram and O(n ln(n)) time.
It iterates on elements of the argument sequence immediately,
before it sorts them. *)
val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
(** Sort the sequence and remove duplicates. Eager, same as [sort] *)
val group : ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t
(** Group equal consecutive elements. *)
val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t
(** Remove consecutive duplicate elements. Basically this is
like [fun seq -> map List.hd (group seq)]. *)
val product : 'a t -> 'b t -> ('a * 'b) t
(** Cartesian product of the sequences. When calling [product a b],
the caller {b MUST} ensure that [b] can be traversed as many times
as required (several times), possibly by calling {!persistent} on it
beforehand. *)
val product2 : 'a t -> 'b t -> ('a, 'b) t2
(** Binary version of {!product}. Same requirements.
@since 0.5 *)
val join : join_row:('a -> 'b -> 'c option) -> 'a t -> 'b t -> 'c t
(** [join ~join_row a b] combines every element of [a] with every
element of [b] using [join_row]. If [join_row] returns None, then
the two elements do not combine. Assume that [b] allows for multiple
iterations. *)
val unfoldr : ('b -> ('a * 'b) option) -> 'b -> 'a t
(** [unfoldr f b] will apply [f] to [b]. If it
yields [Some (x,b')] then [x] is returned
and unfoldr recurses with [b']. *)
val scan : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b t
(** Sequence of intermediate results *)
val max : ?lt:('a -> 'a -> bool) -> 'a t -> 'a option
(** Max element of the sequence, using the given comparison function.
@return None if the sequence is empty, Some [m] where [m] is the maximal
element otherwise *)
val min : ?lt:('a -> 'a -> bool) -> 'a t -> 'a option
(** Min element of the sequence, using the given comparison function.
see {!max} for more details. *)
val head : 'a t -> 'a option
(** First element, if any, otherwise [None]
@since 0.5.1 *)
val head_exn : 'a t -> 'a
(** First element, if any, fails
@raise Invalid_argument if the sequence is empty
@since 0.5.1 *)
val take : int -> 'a t -> 'a t
(** Take at most [n] elements from the sequence. Works on infinite
sequences. *)
val take_while : ('a -> bool) -> 'a t -> 'a t
(** Take elements while they satisfy the predicate, then stops iterating.
Will work on an infinite sequence [s] if the predicate is false for at
least one element of [s]. *)
val drop : int -> 'a t -> 'a t
(** Drop the [n] first elements of the sequence. Lazy. *)
val drop_while : ('a -> bool) -> 'a t -> 'a t
(** Predicate version of {!drop} *)
val rev : 'a t -> 'a t
(** Reverse the sequence. O(n) memory and time, needs the
sequence to be finite. The result is persistent and does
not depend on the input being repeatable. *)
(** {2 Binary sequences} *)
val empty2 : ('a, 'b) t2
val is_empty2 : (_, _) t2 -> bool
val length2 : (_, _) t2 -> int
val zip : ('a, 'b) t2 -> ('a * 'b) t
val unzip : ('a * 'b) t -> ('a, 'b) t2
val zip_i : 'a t -> (int, 'a) t2
(** Zip elements of the sequence with their index in the sequence *)
val fold2 : ('c -> 'a -> 'b -> 'c) -> 'c -> ('a, 'b) t2 -> 'c
val iter2 : ('a -> 'b -> unit) -> ('a, 'b) t2 -> unit
val map2 : ('a -> 'b -> 'c) -> ('a, 'b) t2 -> 'c t
val map2_2 : ('a -> 'b -> 'c) -> ('a -> 'b -> 'd) -> ('a, 'b) t2 -> ('c, 'd) t2
(** [map2_2 f g seq2] maps each [x, y] of seq2 into [f x y, g x y] *)
(** {2 Basic data structures converters} *)
val to_list : 'a t -> 'a list
(** Convert the sequence into a list. Preserves order of elements.
This function is tail-recursive, but consumes 2*n memory.
If order doesn't matter to you, consider {!to_rev_list}. *)
val to_rev_list : 'a t -> 'a list
(** Get the list of the reversed sequence (more efficient than {!to_list}) *)
val of_list : 'a list -> 'a t
val on_list : ('a t -> 'b t) -> 'a list -> 'b list
(** [on_list f l] is equivalent to [to_list @@ f @@ of_list l].
@since 0.5.2
*)
val to_opt : 'a t -> 'a option
(** Alias to {!head}
@since 0.5.1 *)
val to_array : 'a t -> 'a array
(** Convert to an array. Currently not very efficient because
an intermediate list is used. *)
val of_array : 'a array -> 'a t
val of_array_i : 'a array -> (int * 'a) t
(** Elements of the array, with their index *)
val of_array2 : 'a array -> (int, 'a) t2
val array_slice : 'a array -> int -> int -> 'a t
(** [array_slice a i j] Sequence of elements whose indexes range
from [i] to [j] *)
val of_opt : 'a option -> 'a t
(** Iterate on 0 or 1 values.
@since 0.5.1 *)
val of_stream : 'a Stream.t -> 'a t
(** Sequence of elements of a stream (usable only once) *)
val to_stream : 'a t -> 'a Stream.t
(** Convert to a stream. linear in memory and time (a copy is made in memory) *)
val to_stack : 'a Stack.t -> 'a t -> unit
(** Push elements of the sequence on the stack *)
val of_stack : 'a Stack.t -> 'a t
(** Sequence of elements of the stack (same order as [Stack.iter]) *)
val to_queue : 'a Queue.t -> 'a t -> unit
(** Push elements of the sequence into the queue *)
val of_queue : 'a Queue.t -> 'a t
(** Sequence of elements contained in the queue, FIFO order *)
val hashtbl_add : ('a, 'b) Hashtbl.t -> ('a * 'b) t -> unit
(** Add elements of the sequence to the hashtable, with
Hashtbl.add *)
val hashtbl_replace : ('a, 'b) Hashtbl.t -> ('a * 'b) t -> unit
(** Add elements of the sequence to the hashtable, with
Hashtbl.replace (erases conflicting bindings) *)
val to_hashtbl : ('a * 'b) t -> ('a, 'b) Hashtbl.t
(** Build a hashtable from a sequence of key/value pairs *)
val to_hashtbl2 : ('a, 'b) t2 -> ('a, 'b) Hashtbl.t
(** Build a hashtable from a sequence of key/value pairs *)
val of_hashtbl : ('a, 'b) Hashtbl.t -> ('a * 'b) t
(** Sequence of key/value pairs from the hashtable *)
val of_hashtbl2 : ('a, 'b) Hashtbl.t -> ('a, 'b) t2
(** Sequence of key/value pairs from the hashtable *)
val hashtbl_keys : ('a, 'b) Hashtbl.t -> 'a t
val hashtbl_values : ('a, 'b) Hashtbl.t -> 'b t
val of_str : string -> char t
val to_str : char t -> string
val concat_str : string t -> string
(** Concatenate strings together, eagerly.
Also see {!intersperse} to add a separator.
@since 0.5 *)
exception OneShotSequence
(** Raised when the user tries to iterate several times on
a transient iterator *)
val of_in_channel : in_channel -> char t
(** Iterates on characters of the input (can block when one
iterates over the sequence). If you need to iterate
several times on this sequence, use {!persistent}.
@raise OneShotSequence when used more than once. *)
val to_buffer : char t -> Buffer.t -> unit
(** Copy content of the sequence into the buffer *)
val int_range : start:int -> stop:int -> int t
(** Iterator on integers in [start...stop] by steps 1. Also see
{!(--)} for an infix version. *)
val int_range_dec : start:int -> stop:int -> int t
(** Iterator on decreasing integers in [stop...start] by steps -1.
See {!(--^)} for an infix version *)
val of_set : (module Set.S with type elt = 'a and type t = 'b) -> 'b -> 'a t
(** Convert the given set to a sequence. The set module must be provided. *)
val to_set : (module Set.S with type elt = 'a and type t = 'b) -> 'a t -> 'b
(** Convert the sequence to a set, given the proper set module *)
type 'a gen = unit -> 'a option
type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
val of_gen : 'a gen -> 'a t
(** Traverse eagerly the generator and build a sequence from it *)
val to_gen : 'a t -> 'a gen
(** Make the sequence persistent (O(n)) and then iterate on it. Eager. *)
val of_klist : 'a klist -> 'a t
(** Iterate on the lazy list *)
val to_klist : 'a t -> 'a klist
(** Make the sequence persistent and then iterate on it. Eager. *)
(** {2 Functorial conversions between sets and sequences} *)
module Set : sig
module type S = sig
include Set.S
val of_seq : elt sequence -> t
val to_seq : t -> elt sequence
val to_list : t -> elt list
val of_list : elt list -> t
end
(** Create an enriched Set module from the given one *)
module Adapt(X : Set.S) : S with type elt = X.elt and type t = X.t
(** Functor to build an extended Set module from an ordered type *)
module Make(X : Set.OrderedType) : S with type elt = X.t
end
(** {2 Conversion between maps and sequences.} *)
module Map : sig
module type S = sig
include Map.S
val to_seq : 'a t -> (key * 'a) sequence
val of_seq : (key * 'a) sequence -> 'a t
val keys : 'a t -> key sequence
val values : 'a t -> 'a sequence
val to_list : 'a t -> (key * 'a) list
val of_list : (key * 'a) list -> 'a t
end
(** Adapt a pre-existing Map module to make it sequence-aware *)
module Adapt(M : Map.S) : S with type key = M.key and type 'a t = 'a M.t
(** Create an enriched Map module, with sequence-aware functions *)
module Make(V : Map.OrderedType) : S with type key = V.t
end
(** {2 Infinite sequences of random values} *)
val random_int : int -> int t
(** Infinite sequence of random integers between 0 and
the given higher bound (see Random.int) *)
val random_bool : bool t
(** Infinite sequence of random bool values *)
val random_float : float -> float t
val random_array : 'a array -> 'a t
(** Sequence of choices of an element in the array *)
val random_list : 'a list -> 'a t
(** Infinite sequence of random elements of the list. Basically the
same as {!random_array}. *)
(** {2 Infix functions} *)
module Infix : sig
val (--) : int -> int -> int t
(** [a -- b] is the range of integers from [a] to [b], both included,
in increasing order. It will therefore be empty if [a > b]. *)
val (--^) : int -> int -> int t
(** [a --^ b] is the range of integers from [b] to [a], both included,
in decreasing order (starts from [a]).
It will therefore be empty if [a < b]. *)
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
(** Monadic bind (infix version of {!flat_map}
@since 0.5 *)
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
(** Infix version of {!map}
@since 0.5 *)
val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
(** Applicative operator (product+application)
@since 0.5 *)
val (<+>) : 'a t -> 'a t -> 'a t
(** Concatenation of sequences
@since 0.5 *)
end
include module type of Infix
(** {2 Pretty printing of sequences} *)
val pp_seq : ?sep:string -> (Format.formatter -> 'a -> unit) ->
Format.formatter -> 'a t -> unit
(** Pretty print a sequence of ['a], using the given pretty printer
to print each elements. An optional separator string can be provided. *)
val pp_buf : ?sep:string -> (Buffer.t -> 'a -> unit) ->
Buffer.t -> 'a t -> unit
(** Print into a buffer *)
val to_string : ?sep:string -> ('a -> string) -> 'a t -> string
(** Print into a string *)
(** {2 Basic IO}
Very basic interface to manipulate files as sequence of chunks/lines. The
sequences take care of opening and closing files properly; every time
one iterates over a sequence, the file is opened/closed again.
Example: copy a file ["a"] into file ["b"], removing blank lines:
{[
Sequence.(IO.lines_of "a" |> filter (fun l-> l<> "") |> IO.write_lines "b");;
]}
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
val lines_of : ?mode:int -> ?flags:open_flag list ->
string -> string t
(** [lines_of filename] reads all lines of the given file. It raises the
same exception as would opening the file and read from it, except
from [End_of_file] (which is caught). The file is {b always} properly
closed.
Every time the sequence is iterated on, the file is opened again, so
different iterations might return different results
@param mode default [0o644]
@param flags default: [[Open_rdonly]] *)
val chunks_of : ?mode:int -> ?flags:open_flag list -> ?size:int ->
string -> string t
(** Read chunks of the given [size] from the file. The last chunk might be
smaller. Behaves like {!lines_of} regarding errors and options.
Every time the sequence is iterated on, the file is opened again, so
different iterations might return different results *)
val write_to : ?mode:int -> ?flags:open_flag list ->
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
(** 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

4
sequence/sequence.mllib
View file

@ -1,4 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: 3ff39d3acb327553070a64ef0cb321d5)
Sequence
# OASIS_STOP

4
sequence/sequence.odocl
View file

@ -1,4 +0,0 @@
# OASIS_START
# DO NOT EDIT (digest: 3ff39d3acb327553070a64ef0cb321d5)
Sequence
# OASIS_STOP

37
sequence/setup.ml
View file

@ -1,37 +0,0 @@
(* setup.ml generated for the first time by OASIS v0.4.4 *)
(* OASIS_START *)
(* DO NOT EDIT (digest: 9852805d5c19ca1cb6abefde2dcea323) *)
(******************************************************************************)
(* OASIS: architecture for building OCaml libraries and applications *)
(* *)
(* Copyright (C) 2011-2013, Sylvain Le Gall *)
(* Copyright (C) 2008-2011, OCamlCore SARL *)
(* *)
(* This library is free software; you can redistribute it and/or modify it *)
(* under the terms of the GNU Lesser General Public License as published by *)
(* the Free Software Foundation; either version 2.1 of the License, or (at *)
(* your option) any later version, with the OCaml static compilation *)
(* exception. *)
(* *)
(* This library is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *)
(* or FITNESS FOR A PARTICULAR PURPOSE. See the file COPYING for more *)
(* details. *)
(* *)
(* You should have received a copy of the GNU Lesser General Public License *)
(* along with this library; if not, write to the Free Software Foundation, *)
(* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *)
(******************************************************************************)
let () =
try
Topdirs.dir_directory (Sys.getenv "OCAML_TOPLEVEL_PATH")
with Not_found -> ()
;;
#use "topfind";;
#require "oasis.dynrun";;
open OASISDynRun;;
(* OASIS_STOP *)
let () = setup ();;

9
sequence/tests/run_tests.ml
View file

@ -1,9 +0,0 @@
open OUnit
let suite =
"run_tests" >:::
[ Test_sequence.suite; ]
let _ =
OUnit.run_test_tt_main suite

235
sequence/tests/test_sequence.ml
View file

@ -1,235 +0,0 @@
open OUnit
module S = Sequence
let pp_ilist l =
let b = Buffer.create 15 in
let fmt = Format.formatter_of_buffer b in
Format.fprintf fmt "@[<h>%a@]" (S.pp_seq Format.pp_print_int) (S.of_list l);
Buffer.contents b
let test_empty () =
let seq = S.empty in
OUnit.assert_bool "empty" (S.is_empty seq);
OUnit.assert_bool "empty"
(try S.iter (fun _ -> raise Exit) seq; true with Exit -> false);
()
let test_repeat () =
let seq = S.repeat "hello" in
OUnit.assert_equal ["hello"; "hello"; "hello"]
(seq |> S.take 3 |> S.to_list);
()
let test_concat () =
let s1 = S.(1 -- 5) in
let s2 = S.(6 -- 10) in
let l = [1;2;3;4;5;6;7;8;9;10] in
OUnit.assert_equal l (S.to_list (S.append s1 s2));
()
let test_fold () =
let n = S.(1 -- 10)
|> S.fold (+) 0 in
OUnit.assert_equal 55 n;
()
let test_foldi () =
let l = ["hello"; "world"]
|> S.of_list
|> S.foldi (fun acc i x -> (i,x) :: acc) [] in
OUnit.assert_equal [1, "world"; 0, "hello"] l;
()
let test_exists () =
S.(1 -- 100)
|> S.exists (fun x -> x = 59)
|> OUnit.assert_bool "exists";
S.(1 -- 100)
|> S.exists (fun x -> x < 0)
|> (fun x -> not x)
|> OUnit.assert_bool "not exists";
()
let test_length () =
S.(1 -- 1000) |> S.length |> OUnit.assert_equal 1000
let test_concat2 () =
S.(1 -- 1000)
|> S.map (fun i -> S.(i -- (i+1)))
|> S.concat
|> S.length
|> OUnit.assert_equal 2000
let test_flatMap () =
S.(1 -- 1000)
|> S.flatMap (fun i -> S.(i -- (i+1)))
|> S.length
|> OUnit.assert_equal 2000
let test_intersperse () =
S.(1 -- 100)
|> (fun seq -> S.intersperse 0 seq)
|> S.take 10
|> S.to_list
|> OUnit.assert_equal [1;0;2;0;3;0;4;0;5;0]
let test_not_persistent () =
let printer = pp_ilist in
let stream = Stream.from (fun i -> if i < 5 then Some i else None) in
let seq = S.of_stream stream in
OUnit.assert_equal ~printer [0;1;2;3;4] (seq |> S.to_list);
OUnit.assert_equal ~printer [] (seq |> S.to_list);
()
let test_persistent () =
let printer = pp_ilist in
let stream = Stream.from (fun i -> if i < 5 then Some i else None) in
let seq = S.of_stream stream in
(* consume seq into a persistent version of itself *)
let seq' = S.persistent seq in
OUnit.assert_equal ~printer [] (seq |> S.to_list);
OUnit.assert_equal ~printer [0;1;2;3;4] (seq' |> S.to_list);
OUnit.assert_equal ~printer [0;1;2;3;4] (seq' |> S.to_list);
OUnit.assert_equal ~printer [0;1;2;3;4] (seq' |> S.to_stream |> S.of_stream |> S.to_list);
()
let test_big_persistent () =
let printer = pp_ilist in
let seq = S.(0 -- 10_000) in
let seq' = S.persistent seq in
OUnit.assert_equal 10_001 (S.length seq');
OUnit.assert_equal 10_001 (S.length seq');
OUnit.assert_equal ~printer [0;1;2;3] (seq' |> S.take 4 |> S.to_list);
()
let test_sort () =
S.(1 -- 100)
|> S.sort ~cmp:(fun i j -> j - i)
|> S.take 4
|> S.to_list
|> OUnit.assert_equal [100;99;98;97]
let test_sort_uniq () =
[42;1;2;3;4;5;4;3;2;1]
|> S.of_list
|> S.sort_uniq ?cmp:None
|> S.to_list
|> OUnit.assert_equal [1;2;3;4;5;42]
let test_group () =
[1;2;3;3;2;2;3;4]
|> S.of_list |> S.group ?eq:None |> S.to_list
|> OUnit.assert_equal [[1];[2];[3;3];[2;2];[3];[4]]
let test_uniq () =
[1;2;2;3;4;4;4;3;3]
|> S.of_list |> S.uniq ?eq:None |> S.to_list
|> OUnit.assert_equal [1;2;3;4;3]
let test_product () =
let stream = Stream.from (fun i -> if i < 3 then Some i else None) in
let a = S.of_stream stream in
let b = S.of_list ["a";"b";"c"] in
let s = S.product a b |> S.map (fun (x,y) -> y,x)
|> S.to_list |> List.sort compare in
OUnit.assert_equal ["a",0; "a", 1; "a", 2;
"b",0; "b", 1; "b", 2;
"c",0; "c", 1; "c", 2;] s
let test_join () =
let s1 = S.(1 -- 3) in
let s2 = S.of_list ["1"; "2"] in
let join_row i j =
if string_of_int i = j then Some (string_of_int i ^ " = " ^ j) else None
in
let s = S.join ~join_row s1 s2 in
OUnit.assert_equal ["1 = 1"; "2 = 2"] (S.to_list s);
()
let test_scan () =
S.(1 -- 5)
|> S.scan (+) 0
|> S.to_list
|> OUnit.assert_equal ~printer:pp_ilist [0;1;3;6;10;15]
let test_drop () =
S.(1 -- 5) |> S.drop 2 |> S.to_list |> OUnit.assert_equal [3;4;5]
let test_rev () =
S.(1 -- 5) |> S.rev |> S.to_list |> OUnit.assert_equal [5;4;3;2;1]
let test_unfoldr () =
let f x = if x < 5 then Some (string_of_int x,x+1) else None in
S.unfoldr f 0
|> S.to_list
|> OUnit.assert_equal ["0"; "1"; "2"; "3"; "4"]
let test_hashtbl () =
let h = S.(1 -- 5)
|> S.zip_i
|> S.to_hashtbl2 in
S.(0 -- 4)
|> S.iter (fun i -> OUnit.assert_equal (i+1) (Hashtbl.find h i));
OUnit.assert_equal [0;1;2;3;4] (S.hashtbl_keys h |> S.sort ?cmp:None |> S.to_list);
()
let test_buff () =
let b = Buffer.create 4 in
"hello world"
|> S.of_str |> S.rev |> S.map Char.uppercase
|> (fun seq -> S.to_buffer seq b);
OUnit.assert_equal "DLROW OLLEH" (Buffer.contents b);
()
let test_int_range () =
OUnit.assert_equal ~printer:pp_ilist [1;2;3;4] S.(to_list (1--4));
OUnit.assert_equal ~printer:pp_ilist [10;9;8;7;6] S.(to_list (10 --^ 6));
OUnit.assert_equal ~printer:pp_ilist [] S.(to_list (10--4));
OUnit.assert_equal ~printer:pp_ilist [] S.(to_list (10 --^ 60));
()
let test_take () =
let l = S.(to_list (take 0 (of_list [1]))) in
OUnit.assert_equal ~printer:pp_ilist [] l;
let l = S.(to_list (take 5 (of_list [1;2;3;4;5;6;7;8;9;10]))) in
OUnit.assert_equal ~printer:pp_ilist [1;2;3;4;5] l;
()
let test_regression1 () =
let s = S.(take 10 (repeat 1)) in
OUnit.assert_bool "not empty" (not (S.is_empty s));
()
let suite =
"test_sequence" >:::
[ "test_empty" >:: test_empty;
"test_repeat" >:: test_repeat;
"test_concat" >:: test_concat;
"test_concat2" >:: test_concat2;
"test_fold" >:: test_fold;
"test_foldi" >:: test_foldi;
"test_exists" >:: test_exists;
"test_length" >:: test_length;
"test_concat" >:: test_concat;
"test_flatMap" >:: test_flatMap;
"test_intersperse" >:: test_intersperse;
"test_not_persistent" >:: test_not_persistent;
"test_persistent" >:: test_persistent;
"test_big_persistent" >:: test_big_persistent;
"test_sort" >:: test_sort;
"test_sort_uniq" >:: test_sort;
"test_group" >:: test_group;
"test_uniq" >:: test_uniq;
"test_product" >:: test_product;
"test_join" >:: test_join;
"test_scan" >:: test_scan;
"test_drop" >:: test_drop;
"test_rev" >:: test_rev;
"test_unfoldr" >:: test_unfoldr;
"test_hashtbl" >:: test_hashtbl;
"test_int_range" >:: test_int_range;
"test_take" >:: test_take;
"test_regression1" >:: test_regression1;
]

579
setup.ml
View file

@ -1,7 +1,7 @@
(* setup.ml generated for the first time by OASIS v0.4.4 *)
(* OASIS_START *)
(* DO NOT EDIT (digest: 4828f89967677c4737a4a949042a8d4c) *)
(* DO NOT EDIT (digest: 43c616e040b0bb8b601c67da9e06ec15) *)
(*
Regenerated by OASIS v0.4.5
Visit http://oasis.forge.ocamlcore.org for more information and
@ -6819,31 +6819,11 @@ let setup_t =
("containers",
OCamlbuildDocPlugin.doc_build
{
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
run_path = "."
});
("containers_misc",
OCamlbuildDocPlugin.doc_build
{
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
run_path = "."
});
("containers_string",
OCamlbuildDocPlugin.doc_build
{
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
run_path = "."
});
("containers_advanced",
OCamlbuildDocPlugin.doc_build
{
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
run_path = "."
});
("containers_lwt",
OCamlbuildDocPlugin.doc_build
{
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
OCamlbuildDocPlugin.extra_args =
[
"-use-ocamlfind";
"-docflags '-colorize-code -short-functors -charset utf-8'"
];
run_path = "."
})
];
@ -6866,31 +6846,11 @@ let setup_t =
("containers",
OCamlbuildDocPlugin.doc_clean
{
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
run_path = "."
});
("containers_misc",
OCamlbuildDocPlugin.doc_clean
{
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
run_path = "."
});
("containers_string",
OCamlbuildDocPlugin.doc_clean
{
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
run_path = "."
});
("containers_advanced",
OCamlbuildDocPlugin.doc_clean
{
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
run_path = "."
});
("containers_lwt",
OCamlbuildDocPlugin.doc_clean
{
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
OCamlbuildDocPlugin.extra_args =
[
"-use-ocamlfind";
"-docflags '-colorize-code -short-functors -charset utf-8'"
];
run_path = "."
})
];
@ -6912,10 +6872,10 @@ let setup_t =
oasis_version = "0.4";
ocaml_version = Some (OASISVersion.VGreaterEqual "4.00.1");
findlib_version = None;
alpha_features = [];
alpha_features = ["ocamlbuild_more_args"];
beta_features = [];
name = "containers";
version = "0.6.1";
version = "0.7";
license =
OASISLicense.DEP5License
(OASISLicense.DEP5Unit
@ -6986,18 +6946,6 @@ let setup_t =
"Build the misc library, containing everything from the rotating kitchen sink to automatic banana distributors";
flag_default = [(OASISExpr.EBool true, false)]
});
Flag
({
cs_name = "cgi";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
flag_description =
Some
"Build modules related to FastCGI, depending on CamlGI";
flag_default = [(OASISExpr.EBool true, false)]
});
Flag
({
cs_name = "lwt";
@ -7030,6 +6978,17 @@ let setup_t =
flag_description = Some "Build and run benchmarks";
flag_default = [(OASISExpr.EBool true, false)]
});
Flag
({
cs_name = "bigarray";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
flag_description =
Some "Build modules that depend on bigarrays";
flag_default = [(OASISExpr.EBool true, false)]
});
Library
({
cs_name = "containers";
@ -7039,7 +6998,7 @@ let setup_t =
{
bs_build = [(OASISExpr.EBool true, true)];
bs_install = [(OASISExpr.EBool true, true)];
bs_path = "core";
bs_path = "src/core";
bs_compiled_object = Best;
bs_build_depends = [FindlibPackage ("bytes", None)];
bs_build_tools = [ExternalTool "ocamlbuild"];
@ -7056,16 +7015,7 @@ let setup_t =
lib_modules =
[
"CCVector";
"CCDeque";
"CCGen";
"Gen_intf";
"CCSequence";
"CCFQueue";
"CCMultiMap";
"CCMultiSet";
"CCBV";
"CCPrint";
"CCPersistentHashtbl";
"CCError";
"CCHeap";
"CCList";
@ -7073,22 +7023,15 @@ let setup_t =
"CCPair";
"CCFun";
"CCHash";
"CCKList";
"CCInt";
"CCBool";
"CCFloat";
"CCArray";
"CCOrd";
"CCIO";
"CCRandom";
"CCKTree";
"CCTrie";
"CCString";
"CCHashtbl";
"CCFlatHashtbl";
"CCSexp";
"CCMap";
"CCCache"
"CCMap"
];
lib_pack = false;
lib_internal_modules = [];
@ -7096,6 +7039,138 @@ let setup_t =
lib_findlib_name = None;
lib_findlib_containers = []
});
Library
({
cs_name = "containers_io";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
bs_build = [(OASISExpr.EBool true, true)];
bs_install = [(OASISExpr.EBool true, true)];
bs_path = "src/io";
bs_compiled_object = Best;
bs_build_depends = [FindlibPackage ("bytes", 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 = ["CCIO"];
lib_pack = false;
lib_internal_modules = [];
lib_findlib_parent = Some "containers";
lib_findlib_name = Some "io";
lib_findlib_containers = []
});
Library
({
cs_name = "containers_sexp";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
bs_build = [(OASISExpr.EBool true, true)];
bs_install = [(OASISExpr.EBool true, true)];
bs_path = "src/sexp";
bs_compiled_object = Best;
bs_build_depends = [FindlibPackage ("bytes", 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 = ["CCSexp"; "CCSexpStream"; "CCSexpM"];
lib_pack = false;
lib_internal_modules = [];
lib_findlib_parent = Some "containers";
lib_findlib_name = Some "sexp";
lib_findlib_containers = []
});
Library
({
cs_name = "containers_data";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
bs_build = [(OASISExpr.EBool true, true)];
bs_install = [(OASISExpr.EBool true, true)];
bs_path = "src/data";
bs_compiled_object = Best;
bs_build_depends = [];
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 =
[
"CCMultiMap";
"CCMultiSet";
"CCTrie";
"CCFlatHashtbl";
"CCCache";
"CCPersistentHashtbl";
"CCDeque";
"CCFQueue";
"CCBV";
"CCMixtbl"
];
lib_pack = false;
lib_internal_modules = [];
lib_findlib_parent = Some "containers";
lib_findlib_name = Some "data";
lib_findlib_containers = []
});
Library
({
cs_name = "containers_iter";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
bs_build = [(OASISExpr.EBool true, true)];
bs_install = [(OASISExpr.EBool true, true)];
bs_path = "src/iter";
bs_compiled_object = Best;
bs_build_depends = [];
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 = ["CCKTree"; "CCKList"];
lib_pack = false;
lib_internal_modules = [];
lib_findlib_parent = Some "containers";
lib_findlib_name = Some "iter";
lib_findlib_containers = []
});
Library
({
cs_name = "containers_string";
@ -7105,7 +7180,7 @@ let setup_t =
{
bs_build = [(OASISExpr.EBool true, true)];
bs_install = [(OASISExpr.EBool true, true)];
bs_path = "string";
bs_path = "src/string";
bs_compiled_object = Best;
bs_build_depends = [];
bs_build_tools = [ExternalTool "ocamlbuild"];
@ -7135,9 +7210,13 @@ let setup_t =
{
bs_build = [(OASISExpr.EBool true, true)];
bs_install = [(OASISExpr.EBool true, true)];
bs_path = "advanced";
bs_path = "src/advanced";
bs_compiled_object = Best;
bs_build_depends = [InternalLibrary "containers"];
bs_build_depends =
[
InternalLibrary "containers";
FindlibPackage ("sequence", None)
];
bs_build_tools = [ExternalTool "ocamlbuild"];
bs_c_sources = [];
bs_data_files = [];
@ -7157,6 +7236,41 @@ let setup_t =
lib_findlib_name = Some "advanced";
lib_findlib_containers = []
});
Library
({
cs_name = "containers_bigarray";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
bs_build = [(OASISExpr.EBool true, true)];
bs_install = [(OASISExpr.EBool true, true)];
bs_path = "src/bigarray";
bs_compiled_object = Best;
bs_build_depends =
[
InternalLibrary "containers";
FindlibPackage ("bigarray", None);
FindlibPackage ("bytes", 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 = ["CCBigstring"];
lib_pack = false;
lib_internal_modules = [];
lib_findlib_parent = Some "containers";
lib_findlib_name = Some "bigarray";
lib_findlib_containers = []
});
Library
({
cs_name = "containers_pervasives";
@ -7166,7 +7280,7 @@ let setup_t =
{
bs_build = [(OASISExpr.EBool true, true)];
bs_install = [(OASISExpr.EBool true, true)];
bs_path = "pervasives";
bs_path = "src/pervasives";
bs_compiled_object = Best;
bs_build_depends = [InternalLibrary "containers"];
bs_build_tools = [ExternalTool "ocamlbuild"];
@ -7196,12 +7310,12 @@ let setup_t =
{
bs_build = [(OASISExpr.EBool true, true)];
bs_install = [(OASISExpr.EBool true, true)];
bs_path = "misc";
bs_path = "src/misc";
bs_compiled_object = Best;
bs_build_depends =
[
FindlibPackage ("unix", None);
InternalLibrary "containers"
InternalLibrary "containers";
InternalLibrary "containers_data"
];
bs_build_tools = [ExternalTool "ocamlbuild"];
bs_c_sources = [];
@ -7245,8 +7359,7 @@ let setup_t =
"Ty";
"Cause";
"AVL";
"ParseReact";
"Mixtbl"
"ParseReact"
];
lib_pack = true;
lib_internal_modules = [];
@ -7271,7 +7384,7 @@ let setup_t =
(OASISExpr.EBool true, false);
(OASISExpr.EFlag "thread", true)
];
bs_path = "threads/";
bs_path = "src/threads/";
bs_compiled_object = Best;
bs_build_depends =
[
@ -7317,13 +7430,12 @@ let setup_t =
(OASISExpr.EFlag "lwt", OASISExpr.EFlag "misc"),
true)
];
bs_path = "lwt";
bs_path = "src/lwt";
bs_compiled_object = Best;
bs_build_depends =
[
InternalLibrary "containers";
FindlibPackage ("lwt", None);
FindlibPackage ("lwt.unix", None);
InternalLibrary "containers_misc"
];
bs_build_tools = [ExternalTool "ocamlbuild"];
@ -7337,55 +7449,13 @@ let setup_t =
bs_nativeopt = [(OASISExpr.EBool true, [])]
},
{
lib_modules = ["Behavior"; "Lwt_automaton"; "Lwt_actor"];
lib_modules = ["Lwt_automaton"; "Lwt_actor"];
lib_pack = true;
lib_internal_modules = [];
lib_findlib_parent = Some "containers";
lib_findlib_name = Some "lwt";
lib_findlib_containers = []
});
Library
({
cs_name = "containers_cgi";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
bs_build =
[
(OASISExpr.EBool true, false);
(OASISExpr.EFlag "cgi", true)
];
bs_install =
[
(OASISExpr.EBool true, false);
(OASISExpr.EFlag "cgi", true)
];
bs_path = "cgi";
bs_compiled_object = Best;
bs_build_depends =
[
InternalLibrary "containers";
FindlibPackage ("CamlGI", 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 = ["ToWeb"];
lib_pack = false;
lib_internal_modules = [];
lib_findlib_parent = Some "containers";
lib_findlib_name = Some "cgi";
lib_findlib_containers = []
});
Doc
({
cs_name = "containers";
@ -7414,118 +7484,6 @@ let setup_t =
doc_build_tools =
[ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]
});
Doc
({
cs_name = "containers_misc";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
doc_type = (`Doc, "ocamlbuild", Some "0.3");
doc_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
post_command = [(OASISExpr.EBool true, None)]
};
doc_build =
[
(OASISExpr.ENot (OASISExpr.EFlag "docs"), false);
(OASISExpr.EFlag "docs", true)
];
doc_install = [(OASISExpr.EBool true, true)];
doc_install_dir = "$docdir";
doc_title = "Containers_misc docs";
doc_authors = [];
doc_abstract = None;
doc_format = OtherDoc;
doc_data_files = [];
doc_build_tools =
[ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]
});
Doc
({
cs_name = "containers_string";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
doc_type = (`Doc, "ocamlbuild", Some "0.3");
doc_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
post_command = [(OASISExpr.EBool true, None)]
};
doc_build =
[
(OASISExpr.ENot (OASISExpr.EFlag "docs"), false);
(OASISExpr.EFlag "docs", true)
];
doc_install = [(OASISExpr.EBool true, true)];
doc_install_dir = "$docdir";
doc_title = "Containers_string docs";
doc_authors = [];
doc_abstract = None;
doc_format = OtherDoc;
doc_data_files = [];
doc_build_tools =
[ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]
});
Doc
({
cs_name = "containers_advanced";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
doc_type = (`Doc, "ocamlbuild", Some "0.3");
doc_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
post_command = [(OASISExpr.EBool true, None)]
};
doc_build =
[
(OASISExpr.ENot (OASISExpr.EFlag "docs"), false);
(OASISExpr.EFlag "docs", true)
];
doc_install = [(OASISExpr.EBool true, true)];
doc_install_dir = "$docdir";
doc_title = "Containers_advanced docs";
doc_authors = [];
doc_abstract = None;
doc_format = OtherDoc;
doc_data_files = [];
doc_build_tools =
[ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]
});
Doc
({
cs_name = "containers_lwt";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
doc_type = (`Doc, "ocamlbuild", Some "0.3");
doc_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
post_command = [(OASISExpr.EBool true, None)]
};
doc_build =
[
(OASISExpr.ENot (OASISExpr.EFlag "docs"), false);
(OASISExpr.EFlag "docs", true)
];
doc_install = [(OASISExpr.EBool true, true)];
doc_install_dir = "$docdir";
doc_title = "Containers_lwt docs";
doc_authors = [];
doc_abstract = None;
doc_format = OtherDoc;
doc_data_files = [];
doc_build_tools =
[ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]
});
Executable
({
cs_name = "run_benchs";
@ -7549,7 +7507,11 @@ let setup_t =
InternalLibrary "containers";
InternalLibrary "containers_misc";
InternalLibrary "containers_advanced";
InternalLibrary "containers_data";
InternalLibrary "containers_string";
InternalLibrary "containers_iter";
FindlibPackage ("sequence", None);
FindlibPackage ("gen", None);
FindlibPackage ("benchmark", None)
];
bs_build_tools = [ExternalTool "ocamlbuild"];
@ -7615,7 +7577,8 @@ let setup_t =
bs_build_depends =
[
InternalLibrary "containers";
FindlibPackage ("benchmark", None)
FindlibPackage ("benchmark", None);
FindlibPackage ("gen", None)
];
bs_build_tools = [ExternalTool "ocamlbuild"];
bs_c_sources = [];
@ -7661,43 +7624,6 @@ let setup_t =
},
{exec_custom = false; exec_main_is = "test_levenshtein.ml"
});
Executable
({
cs_name = "test_lwt";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
bs_build =
[
(OASISExpr.EBool true, false);
(OASISExpr.EAnd
(OASISExpr.EFlag "tests",
OASISExpr.EFlag "lwt"),
true)
];
bs_install = [(OASISExpr.EBool true, false)];
bs_path = "tests/lwt/";
bs_compiled_object = Best;
bs_build_depends =
[
InternalLibrary "containers";
FindlibPackage ("lwt", None);
FindlibPackage ("lwt.unix", None);
FindlibPackage ("oUnit", None);
InternalLibrary "containers_lwt"
];
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 = "test_Behavior.ml"});
Executable
({
cs_name = "test_threads";
@ -7754,6 +7680,13 @@ let setup_t =
InternalLibrary "containers";
InternalLibrary "containers_misc";
InternalLibrary "containers_string";
InternalLibrary "containers_iter";
InternalLibrary "containers_io";
InternalLibrary "containers_advanced";
InternalLibrary "containers_sexp";
InternalLibrary "containers_bigarray";
FindlibPackage ("sequence", None);
FindlibPackage ("gen", None);
FindlibPackage ("oUnit", None);
FindlibPackage ("QTest2Lib", None)
];
@ -7789,7 +7722,10 @@ let setup_t =
bs_build_depends =
[
InternalLibrary "containers";
InternalLibrary "containers_data";
FindlibPackage ("oUnit", None);
FindlibPackage ("sequence", None);
FindlibPackage ("gen", None);
FindlibPackage ("qcheck", None);
InternalLibrary "containers_misc"
];
@ -7838,39 +7774,6 @@ let setup_t =
InternalExecutable "run_qtest"
]
});
Executable
({
cs_name = "web_pwd";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
bs_build =
[
(OASISExpr.EBool true, false);
(OASISExpr.EFlag "cgi", true)
];
bs_install = [(OASISExpr.EBool true, false)];
bs_path = "examples/cgi/";
bs_compiled_object = Byte;
bs_build_depends =
[
InternalLibrary "containers";
InternalLibrary "containers_cgi";
FindlibPackage ("threads", None);
FindlibPackage ("CamlGI", 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 = "web_pwd.ml"});
Executable
({
cs_name = "lambda";
@ -7917,7 +7820,7 @@ let setup_t =
bs_install = [(OASISExpr.EBool true, false)];
bs_path = "examples/";
bs_compiled_object = Native;
bs_build_depends = [InternalLibrary "containers"];
bs_build_depends = [InternalLibrary "containers_sexp"];
bs_build_tools = [ExternalTool "ocamlbuild"];
bs_c_sources = [];
bs_data_files = [];
@ -7929,6 +7832,33 @@ let setup_t =
bs_nativeopt = [(OASISExpr.EBool true, [])]
},
{exec_custom = false; exec_main_is = "id_sexp.ml"});
Executable
({
cs_name = "id_sexp2";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
bs_build =
[
(OASISExpr.EBool true, false);
(OASISExpr.EFlag "misc", true)
];
bs_install = [(OASISExpr.EBool true, false)];
bs_path = "examples/";
bs_compiled_object = Native;
bs_build_depends = [InternalLibrary "containers_sexp"];
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 = "id_sexp2.ml"});
SrcRepo
({
cs_name = "head";
@ -7956,7 +7886,8 @@ let setup_t =
};
oasis_fn = Some "_oasis";
oasis_version = "0.4.5";
oasis_digest = Some "\224Im\201\235\195\005\221\244\022\209\165\168XI>";
oasis_digest =
Some "\031\146\017A\213\149\236\192\252\238\156-\202*`\143";
oasis_exec = None;
oasis_setup_args = [];
setup_update = false
@ -7964,6 +7895,6 @@ let setup_t =
let setup () = BaseSetup.setup setup_t;;
# 7968 "setup.ml"
# 7899 "setup.ml"
(* OASIS_STOP *)
let () = setup ();;

0
advanced/CCBatch.ml → src/advanced/CCBatch.ml
View file

0
advanced/CCBatch.mli → src/advanced/CCBatch.mli
View file

0
advanced/CCCat.ml → src/advanced/CCCat.ml
View file

0
advanced/CCCat.mli → src/advanced/CCCat.mli
View file

112
advanced/CCLinq.ml → src/advanced/CCLinq.ml
View file

@ -38,12 +38,12 @@ let _id x = x
exception ExitWithError of string
let _exit_with_error s = raise (ExitWithError s)
let _error_of_exn f = try `Ok (f ()) with ExitWithError s -> `Error
let _error_of_exn f = try `Ok (f ()) with ExitWithError s -> `Error s
type 'a collection =
| Seq : 'a sequence -> 'a collection
| List : 'a list -> 'a collection
| Set : (module CCSequence.Set.S
| Set : (module Sequence.Set.S
with type elt = 'a and type t = 'b) * 'b -> 'a collection
module PMap = struct
@ -103,7 +103,7 @@ module PMap = struct
}
let make_cmp (type key) ?(cmp=Pervasives.compare) () =
let module M = CCSequence.Map.Make(struct
let module M = Sequence.Map.Make(struct
type t = key
let compare = cmp
end) in
@ -167,26 +167,26 @@ module PMap = struct
| None -> None
| Some v -> Some (f v)
);
to_seq = CCSequence.map (fun (x,y) -> x, f y) m.to_seq;
to_seq = Sequence.map (fun (x,y) -> x, f y) m.to_seq;
fold = (fun f' acc ->
m.fold (fun acc x y -> f' acc x (f y)) acc
);
}
let to_list m = CCSequence.to_rev_list m.to_seq
let to_list m = Sequence.to_rev_list m.to_seq
let to_coll m = Seq m.to_seq
let reverse ~build m =
let build = make ~build () in
let seq = CCSequence.map (fun (x,y) -> y,x) (to_seq m) in
let seq = Sequence.map (fun (x,y) -> y,x) (to_seq m) in
multimap_of_seq ~build seq
let reverse_multimap ~build m =
let build = make ~build () in
let seq = to_seq m in
let seq = CCSequence.flat_map
(fun (x,l) -> CCSequence.map (fun y -> y,x) (CCSequence.of_list l)
let seq = Sequence.flat_map
(fun (x,l) -> Sequence.map (fun y -> y,x) (Sequence.of_list l)
) seq
in
multimap_of_seq ~build seq
@ -211,10 +211,10 @@ type ('a,'b) group_join_descr = {
module Coll = struct
let of_seq s = Seq s
let of_list l = List l
let of_array a = Seq (CCSequence.of_array a)
let of_array a = Seq (Sequence.of_array a)
let set_of_seq (type elt) ?(cmp=Pervasives.compare) seq =
let module S = CCSequence.Set.Make(struct
let module S = Sequence.Set.Make(struct
type t = elt
let compare = cmp
end) in
@ -225,15 +225,15 @@ module Coll = struct
| Seq s -> s
| List l -> (fun k -> List.iter k l)
| Set (m, set) ->
let module S = (val m : CCSequence.Set.S
let module S = (val m : Sequence.Set.S
with type elt = elt and type t = 'b) in
S.to_seq set
let to_list (type elt) = function
| Seq s -> CCSequence.to_list s
| Seq s -> Sequence.to_list s
| List l -> l
| Set (m, set) ->
let module S = (val m : CCSequence.Set.S
let module S = (val m : Sequence.Set.S
with type elt = elt and type t = 'b) in
S.elements set
@ -245,30 +245,30 @@ module Coll = struct
let fold (type elt) f acc c = match c with
| List l -> List.fold_left f acc l
| Seq s -> CCSequence.fold f acc s
| Seq s -> Sequence.fold f acc s
| Set (m, set) ->
let module S = (val m : CCSequence.Set.S
let module S = (val m : Sequence.Set.S
with type elt = elt and type t = 'b) in
S.fold (fun x acc -> f acc x) set acc
let map f c =
_fmap ~lst:(List.map f) ~seq:(CCSequence.map f) c
_fmap ~lst:(List.map f) ~seq:(Sequence.map f) c
let filter p c =
_fmap ~lst:(List.filter p) ~seq:(CCSequence.filter p) c
_fmap ~lst:(List.filter p) ~seq:(Sequence.filter p) c
let flat_map f c =
let c' = to_seq c in
Seq (CCSequence.flatMap (fun x -> to_seq (f x)) c')
Seq (Sequence.flatMap (fun x -> to_seq (f x)) c')
let filter_map f c =
_fmap ~lst:(CCList.filter_map f) ~seq:(CCSequence.fmap f) c
_fmap ~lst:(CCList.filter_map f) ~seq:(Sequence.fmap f) c
let size (type elt) = function
| List l -> List.length l
| Seq s -> CCSequence.length s
| Seq s -> Sequence.length s
| Set (m, set) ->
let module S = (val m : CCSequence.Set.S
let module S = (val m : Sequence.Set.S
with type elt = elt and type t = 'b) in
S.cardinal set
@ -278,12 +278,12 @@ module Coll = struct
| List [] -> fail ()
| List (x::_) -> x
| Seq s ->
begin match CCSequence.to_list (CCSequence.take 1 s) with
begin match Sequence.to_list (Sequence.take 1 s) with
| [x] -> x
| _ -> fail ()
end
| Set (m, set) ->
let module S = (val m : CCSequence.Set.S
let module S = (val m : Sequence.Set.S
with type elt = elt and type t = 'b) in
try S.choose set with Not_found -> fail ()
@ -292,7 +292,7 @@ module Coll = struct
with ExitWithError s -> `Error s
let take n c =
_fmap ~lst:(CCList.take n) ~seq:(CCSequence.take n) c
_fmap ~lst:(CCList.take n) ~seq:(Sequence.take n) c
exception MySurpriseExit
@ -308,7 +308,7 @@ module Coll = struct
let sort cmp c = match c with
| List l -> List (List.sort cmp l)
| Seq s -> List (List.sort cmp (CCSequence.to_rev_list s))
| Seq s -> List (List.sort cmp (Sequence.to_rev_list s))
| _ -> set_of_seq ~cmp (to_seq c)
let search obj c =
@ -328,9 +328,9 @@ module Coll = struct
let contains (type elt) ~eq x c = match c with
| List l -> List.exists (eq x) l
| Seq s -> CCSequence.exists (eq x) s
| Seq s -> Sequence.exists (eq x) s
| Set (m, set) ->
let module S = (val m : CCSequence.Set.S
let module S = (val m : Sequence.Set.S
with type elt = elt and type t = 'b) in
(* XXX: here we don't use the equality relation *)
S.mem x set
@ -338,10 +338,10 @@ module Coll = struct
let do_join ~join c1 c2 =
let build1 =
let seq = to_seq c1 in
let seq = CCSequence.map (fun x -> join.join_key1 x, x) seq in
let seq = Sequence.map (fun x -> join.join_key1 x, x) seq in
PMap.multimap_of_seq ~build:(PMap.make ~build:join.join_build ()) seq
in
let l = CCSequence.fold
let l = Sequence.fold
(fun acc y ->
let key = join.join_key2 y in
match PMap.get build1 key with
@ -373,14 +373,14 @@ module Coll = struct
let do_product c1 c2 =
let s1 = to_seq c1 and s2 = to_seq c2 in
of_seq (CCSequence.product s1 s2)
of_seq (Sequence.product s1 s2)
let do_union ~build c1 c2 =
let build = PMap.make ~build () in
to_seq c1 (fun x -> PMap.add build x ());
to_seq c2 (fun x -> PMap.add build x ());
let seq = PMap.to_seq (PMap.build_get build) in
of_seq (CCSequence.map fst seq)
of_seq (Sequence.map fst seq)
type inter_status =
| InterLeft
@ -408,7 +408,7 @@ module Coll = struct
let map = PMap.build_get build in
(* output elements of [c1] not in [map] *)
let seq = to_seq c1 in
of_seq (CCSequence.filter (fun x -> not (PMap.mem map x)) seq)
of_seq (Sequence.filter (fun x -> not (PMap.mem map x)) seq)
end
(** {2 Query operators} *)
@ -478,22 +478,22 @@ let of_array a =
Start (Coll.of_array a)
let of_array_i a =
Start (Coll.of_seq (CCSequence.of_array_i a))
Start (Coll.of_seq (Sequence.of_array_i a))
let of_hashtbl h =
Start (Coll.of_seq (CCSequence.of_hashtbl h))
Start (Coll.of_seq (Sequence.of_hashtbl h))
let of_seq seq =
Start (Coll.of_seq seq)
let of_queue q =
Start (Coll.of_seq (CCSequence.of_queue q))
Start (Coll.of_seq (Sequence.of_queue q))
let of_stack s =
Start (Coll.of_seq (CCSequence.of_stack s))
Start (Coll.of_seq (Sequence.of_stack s))
let of_string s =
Start (Coll.of_seq (CCSequence.of_str s))
Start (Coll.of_seq (Sequence.of_str s))
(** {6 Execution} *)
@ -519,9 +519,9 @@ and _optimize_unary : type a b. (a,b) unary -> a t -> b t
_optimize_unary
(FilterMap (fun x -> if p x then Some (f x) else None))
cont
| PMap f, Binary (Append, q1, q2) ->
| PMap _, Binary (Append, q1, q2) ->
_optimize_binary Append (Unary (u, q1)) (Unary (u, q2))
| Filter p, Binary (Append, q1, q2) ->
| Filter _, Binary (Append, q1, q2) ->
_optimize_binary Append (Unary (u, q1)) (Unary (u, q2))
| Fold (f,acc), Unary (PMap f', cont) ->
_optimize_unary
@ -553,7 +553,7 @@ let _do_unary : type a b. (a,b) unary -> a -> b
| Fold (f, acc) -> Coll.fold f acc c
| FoldMap (f, acc) -> PMap.fold f acc c
| Reduce (safety, start, mix, stop) ->
let acc = CCSequence.fold
let acc = Sequence.fold
(fun acc x -> match acc with
| None -> Some (start x)
| Some acc -> Some (mix x acc)
@ -578,7 +578,7 @@ let _do_unary : type a b. (a,b) unary -> a -> b
| Get (Implicit, k) -> PMap.get_exn c k
| Get (Explicit, k) -> PMap.get_err c k
| GroupBy (build,f) ->
let seq = CCSequence.map (fun x -> f x, x) (Coll.to_seq c) in
let seq = Sequence.map (fun x -> f x, x) (Coll.to_seq c) in
PMap.multimap_of_seq ~build:(PMap.make ~build ()) seq
| Contains (eq, x) -> Coll.contains ~eq x c
| Count build ->
@ -591,7 +591,7 @@ let _do_binary : type a b c. (a, b, c) binary -> a -> b -> c
| GroupJoin gjoin -> Coll.do_group_join ~gjoin c1 c2
| Product -> Coll.do_product c1 c2
| Append ->
Coll.of_seq (CCSequence.append (Coll.to_seq c1) (Coll.to_seq c2))
Coll.of_seq (Sequence.append (Coll.to_seq c1) (Coll.to_seq c2))
| SetOp (Inter,build) -> Coll.do_inter ~build c1 c2
| SetOp (Union,build) -> Coll.do_union ~build c1 c2
| SetOp (Diff,build) -> Coll.do_diff ~build c1 c2
@ -695,8 +695,8 @@ module M = struct
let flatten q =
let f m =
let seq = CCSequence.flat_map
(fun (k,v) -> CCSequence.map (fun v' -> k,v') (Coll.to_seq v))
let seq = Sequence.flat_map
(fun (k,v) -> Sequence.map (fun v' -> k,v') (Coll.to_seq v))
m.PMap.to_seq
in Coll.of_seq seq
in
@ -704,8 +704,8 @@ module M = struct
let flatten' q =
let f m =
let seq = CCSequence.flatMap
(fun (k,v) -> CCSequence.map (fun v' -> k,v') (CCSequence.of_list v))
let seq = Sequence.flatMap
(fun (k,v) -> Sequence.map (fun v' -> k,v') (Sequence.of_list v))
m.PMap.to_seq
in Coll.of_seq seq
in
@ -739,7 +739,7 @@ let group_by ?cmp ?eq ?hash f q =
Unary (GroupBy (_make_build ?cmp ?eq ?hash (),f), q)
let group_by' ?cmp ?eq ?hash f q =
M.iter (group_by ?cmp f q)
M.iter (group_by ?cmp ?eq ?hash f q)
let count ?cmp ?eq ?hash () q =
Unary (Count (_make_build ?cmp ?eq ?hash ()), q)
@ -885,16 +885,16 @@ let to_array q =
QueryMap ((fun c -> Array.of_list (Coll.to_list c)), q)
let to_seq q =
QueryMap ((fun c -> CCSequence.persistent (Coll.to_seq c)), q)
QueryMap ((fun c -> Sequence.persistent (Coll.to_seq c)), q)
let to_hashtbl q =
QueryMap ((fun c -> CCSequence.to_hashtbl (Coll.to_seq c)), q)
QueryMap ((fun c -> Sequence.to_hashtbl (Coll.to_seq c)), q)
let to_queue q =
QueryMap ((fun c q -> CCSequence.to_queue q (Coll.to_seq c)), q)
QueryMap ((fun c q -> Sequence.to_queue q (Coll.to_seq c)), q)
let to_stack q =
QueryMap ((fun c s -> CCSequence.to_stack s (Coll.to_seq c)), q)
QueryMap ((fun c s -> Sequence.to_stack s (Coll.to_seq c)), q)
module L = struct
let of_list l = Start (Coll.of_list l)
@ -909,7 +909,7 @@ module AdaptSet(S : Set.S) = struct
return (Coll.of_seq (fun k -> S.iter k set))
let to_set q =
let f c = CCSequence.fold (fun set x -> S.add x set) S.empty (Coll.to_seq c) in
let f c = Sequence.fold (fun set x -> S.add x set) S.empty (Coll.to_seq c) in
query_map f q
let run q = run (to_set q)
@ -932,7 +932,7 @@ module AdaptMap(M : Map.S) = struct
let to_map q =
let f c =
CCSequence.fold (fun m (x,y) -> M.add x y m) M.empty (Coll.to_seq c)
Sequence.fold (fun m (x,y) -> M.add x y m) M.empty (Coll.to_seq c)
in
query_map f q
@ -1008,13 +1008,13 @@ module IO = struct
query_map f q
let lines' q =
let f s = lazy (CCSequence.to_list (_lines s 0)) in
let f s = lazy (Sequence.to_list (_lines s 0)) in
lazy_ (query_map f q)
let _join ~sep ?(stop="") l =
let buf = Buffer.create 128 in
let seq = Coll.to_seq l in
CCSequence.iteri
Sequence.iteri
(fun i x ->
if i>0 then Buffer.add_string buf sep;
Buffer.add_string buf x)
@ -1035,7 +1035,7 @@ module IO = struct
let out_lines oc q =
let x = run_exn q in
CCSequence.iter (fun l -> output_string oc l; output_char oc '\n') (Coll.to_seq x)
Sequence.iter (fun l -> output_string oc l; output_char oc '\n') (Coll.to_seq x)
let to_file_exn filename q =
_with_file_out filename (fun oc -> out oc q)

0
advanced/CCLinq.mli → src/advanced/CCLinq.mli
View file

0
advanced/CCMonadIO.ml → src/advanced/CCMonadIO.ml
View file

0
advanced/CCMonadIO.mli → src/advanced/CCMonadIO.mli
View file

4
src/advanced/containers_advanced.mldylib Normal file
View file

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

4
src/advanced/containers_advanced.mllib Normal file
View file

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

7
src/advanced/containers_advanced.mlpack Normal file
View file

@ -0,0 +1,7 @@
# OASIS_START
# DO NOT EDIT (digest: 5a399cd532edb84596f3034081578694)
CCLinq
CCBatch
CCCat
CCMonadIO
# OASIS_STOP

223
src/bigarray/CCBigstring.ml Normal file
View file

@ -0,0 +1,223 @@
(*
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 Interface to 1-dimension Bigarrays of bytes (char)} *)
module B = Bigarray.Array1
type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
let create size = B.create Bigarray.char Bigarray.c_layout size
let empty = create 0
let init size f =
let a = create size in
for i = 0 to size-1 do
B.unsafe_set a i (f i)
done;
a
let fill = B.fill
let get = B.get
let set = B.set
let size = B.dim
let sub = B.sub
let blit a i b j len =
let a' = sub a i len in
let b' = sub b j len in
B.blit a' b'
let copy a =
let b = create (size a) in
B.blit a b;
b
(*$T
copy (of_string "abcd") |> to_string = "abcd"
*)
let fold f acc a =
let rec fold' f acc a i len =
if i = len then acc
else
let acc = f acc (get a i) in
fold' f acc a (i+1) len
in
fold' f acc a 0 (size a)
let iter f a =
let n = size a in
for i = 0 to n-1 do
f (get a i)
done
let rec equal_rec a b i len =
i = len
||
( get a i = get b i && equal_rec a b (i+1) len)
let equal a b =
size a = size b
&&
equal_rec a b 0 (size a)
(*$Q
Q.(pair printable_string printable_string) (fun (s1, s2) -> \
let a1 = of_string s1 and a2 = of_string s2 in \
equal a1 a2 = (s1 = s2))
*)
let rec compare_rec a b i len_a len_b =
if i=len_a && i=len_b then 0
else if i=len_a then -1
else if i=len_b then 1
else
match Char.compare (get a i) (get b i) with
| 0 -> compare_rec a b (i+1) len_a len_b
| n -> n
let compare a b =
compare_rec a b 0 (size a) (size b)
(*$T
compare (of_string "abc") (of_string "abd") < 0
compare (of_string "abc") (of_string "abcd") < 0
compare (of_string "abcd") (of_string "abc") > 0
compare (of_string "abc") (of_string "b") < 0
*)
(*$Q
Q.(pair string string) (fun (s1, s2) -> \
let a1 = of_string s1 and a2 = of_string s2 in \
CCInt.sign (compare a1 a2) = CCInt.sign (String.compare s1 s2))
*)
(** {2 Conversions} *)
let to_bytes a =
Bytes.init (size a) (fun i -> B.unsafe_get a i)
let of_bytes b =
init (Bytes.length b) (fun i -> Bytes.get b i)
let of_bytes_slice b i len =
if i < 0 || i+len > Bytes.length b then invalid_arg "CCBigstring";
init len (fun j -> Bytes.get b (i+j))
let sub_bytes a i len =
if i < 0 || i+len > size a then invalid_arg "CCBigstring";
Bytes.init len (fun j -> B.get a (i+j))
let blit_to_bytes a i b j len =
if i < 0 || j < 0 || i+len > size a || j+len > Bytes.length b
then invalid_arg "CCBigstring";
for x=0 to len-1 do
Bytes.set b (j+x) (B.get a (i+x))
done
let blit_of_bytes a i b j len =
if i < 0 || j < 0 || i+len > Bytes.length a || j+len > size b
then invalid_arg "CCBigstring";
for x=0 to len-1 do
B.set b (j+x) (Bytes.get a (i+x))
done
let to_string a =
CCString.init (size a) (fun i -> B.unsafe_get a i)
let of_string s =
init (String.length s) (fun i -> String.get s i)
let of_string_slice s i len =
if i < 0 || i+len > String.length s then invalid_arg "CCBigstring";
init len (fun j -> String.get s (i+j))
let sub_string a i len =
if i < 0 || i+len > size a then invalid_arg "CCBigstring";
CCString.init len (fun j -> B.get a (i+j))
(*$T
of_string_slice "abcde" 1 3 |> to_string = "bcd"
*)
let blit_of_string a i b j len =
if i < 0 || j < 0 || i+len > String.length a || j+len > size b
then invalid_arg "CCBigstring";
for x=0 to len-1 do
B.set b (j+x) (String.get a (i+x))
done
type 'a gen = unit -> 'a option
type 'a sequence = ('a -> unit) -> unit
let to_seq a k = iter k a
let to_gen a =
let i = ref 0 in
let n = size a in
fun () ->
if !i = n then None
else (
let x = get a !i in
incr i;
Some x
)
(*$T
of_string "abcd" |> to_gen |> Gen.to_string = "abcd"
*)
let to_seq_slice a i len =
to_seq (sub a i len)
let to_gen_slice a i len =
to_gen (sub a i len)
(** {2 Memory-map} *)
let map_file_descr ?pos ?(shared=false) fd len =
B.map_file fd ?pos Bigarray.char Bigarray.c_layout shared len
let with_map_file ?pos ?len ?(mode=0o644) ?(flags=[Open_rdonly]) ?shared name f =
let ic = open_in_gen flags mode name in
let len = match len with
| None -> in_channel_length ic
| Some n -> n
in
let a = map_file_descr ?pos ?shared (Unix.descr_of_in_channel ic) len in
try
let x = f a in
close_in ic;
x
with e ->
close_in ic;
raise e

127
src/bigarray/CCBigstring.mli Normal file
View file

@ -0,0 +1,127 @@
(*
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 Interface to 1-dimension Bigarrays of bytes (char)}
@since 0.7 *)
type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
val create : int -> t
(** Create a new bigstring of the given size. *)
val empty : t
(** Empty string *)
val init : int -> (int -> char) -> t
(** Initialize with the given function (called at every index) *)
val fill : t -> char -> unit
(** Fill with a single byte *)
val size : t -> int
(** Number of bytes *)
val get : t -> int -> char
val set : t -> int -> char -> unit
val blit : t -> int -> t -> int -> int -> unit
(** Blit a slice of the bigstring into another *)
val copy : t -> t
(** Copy of the string *)
val sub : t -> int -> int -> t
(** [sub s i len] takes a slice of length [len] from the string [s], starting
at offset [i].
@raise Invalid_argument if [i, len] doesn't designate a valid substring *)
val fold : ('a -> char -> 'a) -> 'a -> t -> 'a
val iter : (char -> unit) -> t -> unit
val equal : t -> t -> bool
val compare : t -> t -> int
(** Lexicographic order *)
(** {2 Conversions} *)
val to_bytes : t -> Bytes.t
val of_bytes : Bytes.t -> t
val of_bytes_slice : Bytes.t -> int -> int -> t
val sub_bytes : t -> int -> int -> Bytes.t
val blit_to_bytes : t -> int -> Bytes.t -> int -> int -> unit
val blit_of_bytes : Bytes.t -> int -> t -> int -> int -> unit
val to_string : t -> string
val of_string : string -> t
val of_string_slice : string -> int -> int -> t
val sub_string : t -> int -> int -> string
val blit_of_string : string -> int -> t -> int -> int -> unit
type 'a gen = unit -> 'a option
type 'a sequence = ('a -> unit) -> unit
val to_seq : t -> char sequence
val to_gen : t -> char gen
val to_seq_slice : t -> int -> int -> char sequence
val to_gen_slice : t -> int -> int -> char gen
(** {2 Memory-map} *)
val with_map_file :
?pos:int64 -> ?len:int -> ?mode:int -> ?flags:open_flag list -> ?shared:bool ->
string -> (t -> 'a) -> 'a
(** [with_map_file name f] maps the file into memory, opening it, and
call [f] with a slice [pos.... pos+len] of the bytes of the file
where [len] is the length of the file if not provided.
When [f] returns, the file is closed.
@param pos offset in the file (default 0)
@param shared if true, modifications are shared between processes that
have mapped this file (requires the filedescr to be open in write mode).
@param mode the mode for the file, if it's created
@param flags opening flags (default rdonly)
see {!Bigarray.Array1.map_file} for more details *)
val map_file_descr : ?pos:int64 -> ?shared:bool -> Unix.file_descr -> int -> t
(** [map_file_descr descr len] is a lower-level access to an underlying file descriptor.
@param shared if true, modifications are shared between processes that
have mapped this file (requires the filedescr to be open in write mode).
see {!Bigarray.Array1.map_file} for more details *)

4
src/bigarray/containers_bigarray.mldylib Normal file
View file

@ -0,0 +1,4 @@
# OASIS_START
# DO NOT EDIT (digest: 6398fca785a51b3ad28defb36820d456)
CCBigstring
# OASIS_STOP

4
src/bigarray/containers_bigarray.mllib Normal file
View file

@ -0,0 +1,4 @@
# OASIS_START
# DO NOT EDIT (digest: 6398fca785a51b3ad28defb36820d456)
CCBigstring
# OASIS_STOP

0
core/CCArray.ml → src/core/CCArray.ml
View file

0
core/CCArray.mli → src/core/CCArray.mli
View file

0
core/CCBool.ml → src/core/CCBool.ml
View file

0
core/CCBool.mli → src/core/CCBool.mli
View file

Some files were not shown because too many files have changed in this diff Show more