Browse Source

initial commit

Spiros Eliopoulos 5 years ago
commit
ed5424428e
16 changed files with 8551 additions and 0 deletions
  1. 9 0
      .gitignore
  2. 8 0
      .merlin
  3. 30 0
      LICENSE
  4. 41 0
      Makefile
  5. 40 0
      README.md
  6. 29 0
      _oasis
  7. 24 0
      _tags
  8. 27 0
      configure
  9. 11 0
      lib/META
  10. 312 0
      lib/faraday.ml
  11. 4 0
      lib/faraday.mldylib
  12. 140 0
      lib/faraday.mli
  13. 4 0
      lib/faraday.mllib
  14. 52 0
      lib_test/test_faraday.ml
  15. 783 0
      myocamlbuild.ml
  16. 7037 0
      setup.ml

+ 9 - 0
.gitignore

@@ -0,0 +1,9 @@
+.*.sw[po]
+_build/
+_tests/
+lib_test/tests_
+setup.log
+setup.data
+*.native
+*.byte
+*.docdir

+ 8 - 0
.merlin

@@ -0,0 +1,8 @@
+S lib/**
+S lwt/**
+S async/**
+B _build/**
+
+PKG cstruct result
+PKG alcotest
+PKG lwt async core

+ 30 - 0
LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2016, Inhabited Type LLC
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. 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.
+
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS 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.

+ 41 - 0
Makefile

@@ -0,0 +1,41 @@
+# 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

+ 40 - 0
README.md

@@ -0,0 +1,40 @@
+# Faraday
+
+Faraday is a serialization library that makese it easy to write efficient and
+reusable serializers suitable for high-performance applications.
+
+## Installation
+
+Install the library and its depenencies via [OPAM][opam]:
+
+[opam]: http://opam.ocaml.org/
+
+```bash
+opam install angstrom
+```
+
+## Development
+
+To install development dependencies, pin the package from the root of the
+repository:
+
+```bash
+opam pin add -n faraday .
+opam install --deps-only faraday
+```
+
+After this, you may install a development version of the library using the
+install command as usual.
+
+For building and running the tests during development, you will need to install
+the `alcotest` package and reconfigure the build process to enable tests:
+
+```bash
+opam install alcotest
+./configure --enable-tests
+make && make test
+```
+
+## License
+
+BSD3, see LICENSE file for its text.

+ 29 - 0
_oasis

@@ -0,0 +1,29 @@
+OASISFormat: 0.4
+Name:        faraday
+Version:     dev
+Authors:     Spiros Eliopoulos <spiros@inhabitedtype.com>
+Maintainers: Spiros Eliopoulos <spiros@inhabitedtype.com>
+Copyrights:  (C) 2015 Inhabited Type LLC
+License:     BSD-3-clause
+Plugins:     META (0.4), DevFiles (0.4)
+BuildTools:  ocamlbuild
+Synopsis:    Serialization library built for speed and efficiency
+
+
+Library faraday
+  Path:         lib
+  Findlibname:  faraday
+  Modules:      Faraday
+
+Executable test_faraday
+  Path:             lib_test
+  MainIs:           test_faraday.ml
+  Build$:           flag(tests)
+  CompiledObject:   best
+  Install:          false
+  BuildDepends:     faraday, alcotest
+
+Test test_faraday
+  Run$:             flag(tests)
+  Command:          $test_faraday
+  WorkingDirectory: lib_test

+ 24 - 0
_tags

@@ -0,0 +1,24 @@
+# OASIS_START
+# DO NOT EDIT (digest: c04c6cafba8e674598bf75b717acdafa)
+# 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 faraday
+"lib/faraday.cmxs": use_faraday
+# Executable test_faraday
+<lib_test/test_faraday.{native,byte}>: pkg_alcotest
+<lib_test/test_faraday.{native,byte}>: use_faraday
+<lib_test/*.ml{,i,y}>: pkg_alcotest
+<lib_test/*.ml{,i,y}>: use_faraday
+# OASIS_STOP

+ 27 - 0
configure

@@ -0,0 +1,27 @@
+#!/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

+ 11 - 0
lib/META

@@ -0,0 +1,11 @@
+# OASIS_START
+# DO NOT EDIT (digest: 5e8180d828ac52aa9d6e8c5f28ee34d7)
+version = "dev"
+description = "Serialization library built for speed and efficiency"
+archive(byte) = "faraday.cma"
+archive(byte, plugin) = "faraday.cma"
+archive(native) = "faraday.cmxa"
+archive(native, plugin) = "faraday.cmxs"
+exists_if = "faraday.cma"
+# OASIS_STOP
+

+ 312 - 0
lib/faraday.ml

@@ -0,0 +1,312 @@
+type bigstring =
+  (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+
+module Deque : sig
+  type 'a t
+
+  val create : int -> 'a t
+
+  val is_empty : 'a t -> bool
+
+  val enqueue : 'a -> 'a t -> unit
+  val dequeue : 'a t -> 'a option
+  val enqueue_front : 'a -> 'a t -> unit
+
+  val map_to_list : 'a t -> f:('a -> 'b) -> 'b list
+end = struct
+  type 'a t =
+    { mutable elements : 'a option array
+    ; mutable front    : int
+    ; mutable back     : int
+    ; mutable size     : int }
+
+  let create size =
+    { elements = Array.make size None; front = 0; back = 0; size }
+
+  let is_empty t =
+    t.front = t.back
+
+  let ensure_space t =
+    if t.back < t.size - 1 then
+      let len = t.back - t.front in
+      if t.front > 0 then
+        Array.blit t.elements t.front t.elements 0 len
+      else begin
+        let old = t.elements in
+        t.size <- t.size * 2;
+        t.elements <- Array.make t.size None;
+        Array.blit old t.front t.elements 0 len;
+      end;
+      t.front <- 0;
+      t.back <- len
+
+  let enqueue e t =
+    ensure_space t;
+    t.elements.(t.back) <- Some e;
+    t.back <- t.back + 1
+
+  let dequeue t =
+    if is_empty t then
+      None
+    else
+      let result = t.elements.(t.front) in
+      t.front <- t.front + 1;
+      result
+
+  let enqueue_front e t =
+    (* This is in general not true for Deque data structures, but the usage
+     * below ensures that there is always space to push a new element back. A
+     * [enqueue_front] is always preceded by a [dequeue], with no intervening
+     * operations. *)
+    assert (t.front > 0);
+    t.front <- t.front - 1;
+    t.elements.(t.front) <- Some e
+
+  let map_to_list t ~f =
+    let result = ref [] in
+    for i = t.back - 1 downto t.front do
+      match t.elements.(i) with
+      | None   -> assert false
+      | Some e -> result := f e :: !result
+    done;
+    !result
+end
+
+type buffer =
+  [ `String    of string
+  | `Bytes     of Bytes.t
+  | `Bigstring of bigstring ]
+
+type 'a iovec =
+  { buffer : 'a
+  ; off : int
+  ; len : int }
+
+module IOVec = struct
+  type 'a t = 'a iovec
+
+  let create buffer ~off ~len =
+    { buffer; off; len }
+
+  let length t =
+    t.len
+
+  let shift { buffer; off; len } n =
+    assert (n < len);
+    { buffer; off = off + n; len = len - n }
+
+  let lengthv ts =
+    let rec loop ts acc =
+      match ts with
+      | []        -> acc
+      | iovec::ts -> loop ts (length iovec + acc)
+    in
+    loop ts 0
+end
+
+type free =
+  unit -> unit
+
+type t =
+  { mutable buffer         : bigstring
+  ; mutable scheduled_pos  : int
+  ; mutable write_pos      : int
+  ; scheduled              : (buffer iovec * free option) Deque.t
+  ; mutable closed         : bool
+  ; mutable yield          : bool
+  }
+
+type op =
+  | Writev of buffer iovec list * (int  -> op)
+  | Yield  of                     (unit -> op)
+  | Close
+
+let of_bigstring buffer =
+  { buffer
+  ; write_pos     = 0
+  ; scheduled_pos = 0
+  ; scheduled     = Deque.create 4
+  ; closed        = false
+  ; yield         = false }
+
+let create size =
+  of_bigstring (Bigarray.(Array1.create char c_layout size))
+
+let writable t =
+  if t.closed then
+    failwith "cannot write to closed writer"
+
+let schedule_iovec t ?free ?(off=0) ~len buffer =
+  Deque.enqueue (IOVec.create buffer ~off ~len, free) t.scheduled
+
+let flush_buffer t =
+  let len = t.write_pos - t.scheduled_pos in
+  if len > 0 then begin
+    let off = t.scheduled_pos in
+    t.scheduled_pos <- t.write_pos;
+    schedule_iovec t ~off ~len (`Bigstring t.buffer)
+  end
+
+let free_bytes_to_write t =
+  let buf_len = Bigarray.Array1.dim t.buffer in
+  buf_len - t.write_pos
+
+let sufficient_space t to_write =
+  to_write > free_bytes_to_write t
+
+let bigarray_blit_from_string dst dst_off src src_off src_len =
+  (* XXX(seliopou): Use Cstruct to turn this into a [memcpy]. *)
+  for i = 0 to src_len - 1 do
+    Bigarray.Array1.unsafe_set dst
+      (dst_off + i) (String.unsafe_get src (src_off + i))
+  done
+
+let bigarray_blit_from_bytes dst dst_off src src_off src_len =
+  (* XXX(seliopou): Use Cstruct to turn this into a [memcpy]. *)
+  for i = 0 to src_len - 1 do
+    Bigarray.Array1.unsafe_set dst
+      (dst_off + i) (Bytes.unsafe_get src (src_off + i))
+  done
+
+let schedule_string t ?(off=0) ?len str =
+  writable t;
+  flush_buffer t;
+  let len =
+    match len with
+    | None -> String.length str - off
+    | Some len -> len
+  in
+  schedule_iovec t ~off ~len (`String str)
+
+let schedule_bytes t ?free ?(off=0) ?len bytes =
+  writable t;
+  flush_buffer t;
+  let len =
+    match len with
+    | None -> Bytes.length bytes - off
+    | Some len -> len
+  in
+  let free =
+    match free with
+    | None -> None
+    | Some free -> Some (fun () -> free bytes)
+  in
+  schedule_iovec t ?free ~off ~len (`Bytes bytes)
+
+let schedule_bigstring t ?free ?(off=0) ?len bigstring =
+  writable t;
+  flush_buffer t;
+  let len =
+    match len with
+    | None -> Bigarray.Array1.dim bigstring - off
+    | Some len -> len
+  in
+  let free =
+    match free with
+    | None -> None
+    | Some free -> Some (fun () -> free bigstring)
+  in
+  schedule_iovec t ?free ~off ~len (`Bigstring bigstring)
+
+
+let write_string t ?(off=0) ?len str =
+  writable t;
+  let len =
+    match len with
+    | None -> String.length str - off
+    | Some len -> len
+  in
+  if sufficient_space t len then begin
+    bigarray_blit_from_string t.buffer t.write_pos str off len;
+    t.write_pos <- t.write_pos + len
+  end else
+    schedule_string t ~off ~len str
+
+let write_bytes t ?(off=0) ?len bytes =
+  writable t;
+  let len =
+    match len with
+    | None -> Bytes.length bytes - off
+    | Some len -> len
+  in
+  if sufficient_space t len then begin
+    bigarray_blit_from_bytes t.buffer t.write_pos bytes off len;
+    t.write_pos <- t.write_pos + len
+  end else
+    schedule_string t ~off ~len (Bytes.to_string bytes)
+
+let write_char t char =
+  writable t;
+  if sufficient_space t 1 then begin
+    Bigarray.Array1.unsafe_set t.buffer t.write_pos char;
+    t.write_pos <- t.write_pos + 1
+  end else
+    schedule_string t (String.make 1 char)
+
+let close t =
+  t.closed <- true;
+  flush_buffer t
+
+let yield t =
+  t.yield <- true
+
+let rec clear_written t written =
+  match Deque.dequeue t.scheduled with
+  | None               -> assert (written = 0);
+  | Some (iovec, free) ->
+    if iovec.len <= written then begin
+      begin match free with
+      | None -> ()
+      | Some free -> free ()
+      end;
+      clear_written t (written - iovec.len)
+    end else
+      Deque.enqueue_front (IOVec.shift iovec written, free) t.scheduled
+
+let rec serialize t =
+  if t.closed then begin
+    t.yield <- false
+  end;
+  flush_buffer t;
+  let nothing_to_do = Deque.is_empty t.scheduled in
+  if t.closed && nothing_to_do then
+    Close
+  else if t.yield || nothing_to_do then begin
+    t.yield <- false;
+    Yield(fun () -> serialize t)
+  end else begin
+    assert (not nothing_to_do);
+    let iovecs = Deque.map_to_list t.scheduled ~f:fst in
+    Writev(iovecs, fun written ->
+      clear_written t written;
+      if Deque.is_empty t.scheduled then begin
+        t.scheduled_pos <- 0;
+        t.write_pos <- 0
+      end;
+      serialize t)
+  end
+
+let serialize_to_string t =
+  close t;
+  match serialize t with
+  | Yield _ -> assert false
+  | Close   -> ""
+  | Writev (iovecs, k)  ->
+    let len = IOVec.lengthv iovecs in
+    let pos = ref 0 in
+    let bytes = Bytes.create len in
+    List.iter (function
+      | { buffer = `String buf; off; len } ->
+        Bytes.blit_string buf off bytes !pos len;
+        pos := !pos + len
+      | { buffer = `Bytes  buf; off; len } ->
+        Bytes.blit buf off bytes !pos len;
+        pos := !pos + len
+      | { buffer = `Bigstring buf; off; len } ->
+        for i = off to len - 1 do
+          Bytes.unsafe_set bytes (!pos + i) (Bigarray.Array1.unsafe_get buf i)
+        done;
+        pos := !pos + len)
+    iovecs;
+    assert (k len = Close);
+    Bytes.unsafe_to_string bytes

+ 4 - 0
lib/faraday.mldylib

@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: 8a2616385414d08a46c455359bf20f8e)
+Faraday
+# OASIS_STOP

+ 140 - 0
lib/faraday.mli

@@ -0,0 +1,140 @@
+(** Serialization primitives built for speed an memory-efficiency. *)
+
+type bigstring =
+  (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+
+type t
+(** The type of a serializer. *)
+
+
+(** {2 Constructors} *)
+
+val create : int -> t
+(** [create len] creates a serializer with a fixed-length internal buffer of
+    length [len]. *)
+
+val of_bigstring : bigstring -> t
+(** [of_bigstring buf] creates a serializer, using [buf] as its internal
+    buffer. The serializer takes ownership of [buf] until the serializer has
+    been closed and flushed of all output. *)
+
+
+(** {2 Buffered Writes}
+
+    Serializers manage an internal buffer for batching small writes. The size
+    of this buffer is determined when the serializer is created and does not
+    change throughout the lifetime of that serializer. If the buffer does not
+    contain sufficient space to service the buffered writes of the caller, it
+    will cease to batch writes and begin to allocate. See the documentation for
+    {!free_bytes_to_write} for additional details. *)
+
+val write_string : t -> ?off:int -> ?len:int -> string -> unit
+(** [write_string t ?off ?len str] copies [str] into the serializer's
+    internal write buffer. The contents of [str] will be batched with prior or
+    subsequent writes, if possible. *)
+
+val write_bytes : t -> ?off:int -> ?len:int -> Bytes.t -> unit
+(** [write_bytes t ?off ?len bytes] copies [bytes] into the serializer's
+    internal write buffer. The contents of [bytes] will be batched with prior
+    or subsequent writes, if possible. *)
+
+val write_char : t -> char -> unit
+(** [write_char t char] copies [char] into the serializer's internal buffer.
+    [char] will be batched with prior or subsequent writes, if possible. *)
+
+
+(** {2 Unbuffered Writes} *)
+
+val schedule_string : t -> ?off:int -> ?len:int -> string -> unit
+(** [schedule_string t ?off ?len str] schedules [str] to be written the next
+    time the serializer surfaces writes to the user. [str] is not copied in
+    this process. *)
+
+val schedule_bytes
+  :   t
+  -> ?free:(Bytes.t -> unit)
+  -> ?off:int
+  -> ?len:int
+  -> Bytes.t
+  -> unit
+  (** [schedule_bytes t ?free ?off ?len bytes] schedules [bytes] to be written
+      the next time the serializer surfaces writes to the user. [bytes] is not
+      copied in this process, so [bytes] should only be modified after the
+      [free] function has been called on [bytes], if provided. *)
+
+val schedule_bigstring
+  :  t
+  -> ?free:(bigstring -> unit)
+  -> ?off:int
+  -> ?len:int
+  -> bigstring
+  -> unit
+  (** [schedule_bigstring t ?free ?off ?len bigstring] schedules [bigstring] to
+      be written the next time the serializer surfaces writes to the user.
+      [bigstring] is not copied in this process, so [bigstring] should only be
+      modified after the [free] function has been called on [bigstring], if
+      provided. *)
+
+
+(** {2 Control Operations} *)
+
+val yield : t -> unit
+(** [yield t] causes the serializer to delay surfacing writes to the user,
+    instead returning a {!Yield} operation with an associated continuation [k].
+    This gives the serializer an opportunity to collect additional writes
+    before sending them to the underlying device, which will increase the write
+    batch size. Barring any intervening calls to [yield t], calling the
+    continuation [k] will surface writes to the user. *)
+
+val close : t -> unit
+(** [close t] closes the serializer. All subsequent write calls will raise, and
+    any pending or subsequent {yield} calls will be ignored. If the serializer
+    has any pending writes, user code will have an opportunity to service them
+    before it receives the {Close} operation. *)
+
+val free_bytes_to_write : t -> int
+(** [free_bytes_to_write t] returns the free space, in bytes, of the
+    serializer's write buffer. If a call to {!write_bytes} or {!write_char} has
+    a length that exceeds the serializer's free size, the serializer will
+    allocate an additional buffer, copy the contents of the write call into
+    that buffer, and schedule it as a separate {!iovec}. If a call to
+    {!write_string} has a length that exceeds the serializer's free size, the
+    serializer will schedule it as {!iovec}. *)
+
+
+(** {2 Running} *)
+
+type buffer =
+  [ `String    of string
+  | `Bytes     of Bytes.t
+  | `Bigstring of bigstring ]
+
+type 'a iovec =
+  { buffer : 'a
+  ; off : int
+  ; len : int }
+(** A view into {buffer} starting at {off} and with length {len}. *)
+
+type op =
+  | Writev of buffer iovec list * (int  -> op)
+    (** Write the {iovec}s, passing the continuation the number of bytes
+        successfully written. *)
+  | Yield  of                     (unit -> op)
+    (** Yield to other threads of control, whether logical or actual, and wait
+        for additional output before procedding. The method for achieving this
+        is application-specific. It is safe to call the continuation even no
+        additional output has been received. *)
+  | Close
+    (** Serialization is complete. No further output will be received. *)
+
+val serialize : t -> op
+(** [serialize t] runs [t], surfacing operations to the user, together with an
+    explicit continuation, as they become available. The continuation of the
+    {Writev} operation takes the number of bytes that were successfuly written
+    from the list of {iovec}s. When to call the continuations in the {Writev}
+    and {Yield} case are application-specific. *)
+
+val serialize_to_string : t -> string
+(** [serialize_to_string t] runs [t], collecting the output into a string and
+    returning it. [t] is immediately closed, and all calls to {yield} are
+    ignored. *)

+ 4 - 0
lib/faraday.mllib

@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: 8a2616385414d08a46c455359bf20f8e)
+Faraday
+# OASIS_STOP

+ 52 - 0
lib_test/test_faraday.ml

@@ -0,0 +1,52 @@
+open Faraday
+
+let bigstring_of_string str =
+  let len = String.length str in
+  let buf = Bigarray.(Array1.create char c_layout len) in
+  for i = 0 to len - 1 do
+    Bigarray.Array1.unsafe_set buf i (String.unsafe_get str i)
+  done;
+  buf
+
+let check ?(buf_size=0x100) ~msg f result =
+  let t = create buf_size in
+  f t;
+  Alcotest.(check string) msg result (serialize_to_string t)
+
+let empty =
+  let empty_bytes = Bytes.create 0 in
+  let empty_bigstring = bigstring_of_string "" in
+  [ "noop"       , `Quick, begin fun () -> check ~msg:"noop" (fun _ -> ()) "" end
+  ; "yield"      , `Quick, begin fun () -> check ~msg:"yield" yield "" end
+  ; "write", `Quick, begin fun () ->
+      check ~msg:"string" (fun t -> write_string t "") "";
+      check ~msg:"bytes"  (fun t -> write_bytes t empty_bytes) ""
+  end
+  ; "schedule", `Quick, begin fun () ->
+      check ~msg:"string"    (fun t -> schedule_string    t ""             ) "";
+      check ~msg:"bytes"     (fun t -> schedule_bytes     t empty_bytes    ) "";
+      check ~msg:"bigstring" (fun t -> schedule_bigstring t empty_bigstring) ""
+  end ]
+
+let write =
+  [ "single", `Quick, begin fun () ->
+      let test_bytes = Bytes.unsafe_of_string "test" in
+      check ~msg:"string" (fun t -> write_string t "test") "test";
+      check ~msg:"bytes"  (fun t -> write_bytes  t test_bytes) "test";
+      check ~msg:"char"   (fun t -> write_char   t 'A') "A"
+  end ]
+
+let schedule =
+  [ "single", `Quick, begin fun () ->
+      let test_bytes = Bytes.unsafe_of_string "test" in
+      let test_bigstring = bigstring_of_string "test" in
+      check ~msg:"string"    (fun t -> schedule_string t "test") "test";
+      check ~msg:"bytes"     (fun t -> schedule_bytes t test_bytes) "test";
+      check ~msg:"bigstring" (fun t -> schedule_bigstring t test_bigstring) "test"
+  end ]
+
+let () =
+  Alcotest.run "test suite"
+    [ "empty output", empty
+    ; "write"       , write
+    ; "schedule"    , schedule ]

+ 783 - 0
myocamlbuild.ml

@@ -0,0 +1,783 @@
+(* OASIS_START *)
+(* DO NOT EDIT (digest: 2e9cb3f11e0d76259892c09684914e83) *)
+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 OASISString = struct
+(* # 22 "src/oasis/OASISString.ml" *)
+
+
+  (** Various string utilities.
+
+      Mostly inspired by extlib and batteries ExtString and BatString libraries.
+
+      @author Sylvain Le Gall
+    *)
+
+
+  let nsplitf str f =
+    if str = "" then
+      []
+    else
+      let buf = Buffer.create 13 in
+      let lst = ref [] in
+      let push () =
+        lst := Buffer.contents buf :: !lst;
+        Buffer.clear buf
+      in
+      let str_len = String.length str in
+        for i = 0 to str_len - 1 do
+          if f str.[i] then
+            push ()
+          else
+            Buffer.add_char buf str.[i]
+        done;
+        push ();
+        List.rev !lst
+
+
+  (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
+      separator.
+    *)
+  let nsplit str c =
+    nsplitf str ((=) c)
+
+
+  let find ~what ?(offset=0) str =
+    let what_idx = ref 0 in
+    let str_idx = ref offset in
+      while !str_idx < String.length str &&
+            !what_idx < String.length what do
+        if str.[!str_idx] = what.[!what_idx] then
+          incr what_idx
+        else
+          what_idx := 0;
+        incr str_idx
+      done;
+      if !what_idx <> String.length what then
+        raise Not_found
+      else
+        !str_idx - !what_idx
+
+
+  let sub_start str len =
+    let str_len = String.length str in
+    if len >= str_len then
+      ""
+    else
+      String.sub str len (str_len - len)
+
+
+  let sub_end ?(offset=0) str len =
+    let str_len = String.length str in
+    if len >= str_len then
+      ""
+    else
+      String.sub str 0 (str_len - len)
+
+
+  let starts_with ~what ?(offset=0) str =
+    let what_idx = ref 0 in
+    let str_idx = ref offset in
+    let ok = ref true in
+      while !ok &&
+            !str_idx < String.length str &&
+            !what_idx < String.length what do
+        if str.[!str_idx] = what.[!what_idx] then
+          incr what_idx
+        else
+          ok := false;
+        incr str_idx
+      done;
+      if !what_idx = String.length what then
+        true
+      else
+        false
+
+
+  let strip_starts_with ~what str =
+    if starts_with ~what str then
+      sub_start str (String.length what)
+    else
+      raise Not_found
+
+
+  let ends_with ~what ?(offset=0) str =
+    let what_idx = ref ((String.length what) - 1) in
+    let str_idx = ref ((String.length str) - 1) in
+    let ok = ref true in
+      while !ok &&
+            offset <= !str_idx &&
+            0 <= !what_idx do
+        if str.[!str_idx] = what.[!what_idx] then
+          decr what_idx
+        else
+          ok := false;
+        decr str_idx
+      done;
+      if !what_idx = -1 then
+        true
+      else
+        false
+
+
+  let strip_ends_with ~what str =
+    if ends_with ~what str then
+      sub_end str (String.length what)
+    else
+      raise Not_found
+
+
+  let replace_chars f s =
+    let buf = Buffer.create (String.length s) in
+    String.iter (fun c -> Buffer.add_char buf (f c)) s;
+    Buffer.contents buf
+
+  let lowercase_ascii =
+    replace_chars
+      (fun c ->
+         if (c >= 'A' && c <= 'Z') then
+           Char.chr (Char.code c + 32)
+         else
+           c)
+
+  let uncapitalize_ascii s =
+    if s <> "" then
+      (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
+    else
+      s
+
+  let uppercase_ascii =
+    replace_chars
+      (fun c ->
+         if (c >= 'a' && c <= 'z') then
+           Char.chr (Char.code c - 32)
+         else
+           c)
+
+  let capitalize_ascii s =
+    if s <> "" then
+      (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
+    else
+      s
+
+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
+
+
+# 292 "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
+
+
+# 397 "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 -> (OASISString.uncapitalize_ascii 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^"/"^(OASISString.uncapitalize_ascii 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
+
+
+# 766 "myocamlbuild.ml"
+open Ocamlbuild_plugin;;
+let package_default =
+  {
+     MyOCamlbuildBase.lib_ocaml = [("faraday", ["lib"], [])];
+     lib_c = [];
+     flags = [];
+     includes = [("lib_test", ["lib"])]
+  }
+  ;;
+
+let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
+
+let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
+
+# 782 "myocamlbuild.ml"
+(* OASIS_STOP *)
+Ocamlbuild_plugin.dispatch dispatch_default;;

+ 7037 - 0
setup.ml

@@ -0,0 +1,7037 @@
+(* setup.ml generated for the first time by OASIS v0.4.6 *)
+
+(* OASIS_START *)
+(* DO NOT EDIT (digest: 3d5173006bf17ae5949f44135eaab4e6) *)
+(*
+   Regenerated by OASIS v0.4.6
+   Visit http://oasis.forge.ocamlcore.org for more information and
+   documentation about functions used in this file.
+*)
+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 OASISContext = struct
+(* # 22 "src/oasis/OASISContext.ml" *)
+
+
+  open OASISGettext
+
+
+  type level =
+    [ `Debug
+    | `Info
+    | `Warning
+    | `Error]
+
+
+  type t =
+    {
+      (* TODO: replace this by a proplist. *)
+      quiet:                 bool;
+      info:                  bool;
+      debug:                 bool;
+      ignore_plugins:        bool;
+      ignore_unknown_fields: bool;
+      printf:                level -> string -> unit;
+    }
+
+
+  let printf lvl str =
+    let beg =
+      match lvl with
+        | `Error -> s_ "E: "
+        | `Warning -> s_ "W: "
+        | `Info  -> s_ "I: "
+        | `Debug -> s_ "D: "
+    in
+      prerr_endline (beg^str)
+
+
+  let default =
+    ref
+      {
+        quiet                 = false;
+        info                  = false;
+        debug                 = false;
+        ignore_plugins        = false;
+        ignore_unknown_fields = false;
+        printf                = printf;
+      }
+
+
+  let quiet =
+    {!default with quiet = true}
+
+
+  let fspecs () =
+    (* TODO: don't act on default. *)
+    let ignore_plugins = ref false in
+    ["-quiet",
+     Arg.Unit (fun () -> default := {!default with quiet = true}),
+     s_ " Run quietly";
+
+     "-info",
+     Arg.Unit (fun () -> default := {!default with info = true}),
+     s_ " Display information message";
+
+
+     "-debug",
+     Arg.Unit (fun () -> default := {!default with debug = true}),
+     s_ " Output debug message";
+
+     "-ignore-plugins",
+     Arg.Set ignore_plugins,
+     s_ " Ignore plugin's field.";
+
+     "-C",
+     (* TODO: remove this chdir. *)
+     Arg.String (fun str -> Sys.chdir str),
+     s_ "dir Change directory before running."],
+    fun () -> {!default with ignore_plugins = !ignore_plugins}
+end
+
+module OASISString = struct
+(* # 22 "src/oasis/OASISString.ml" *)
+
+
+  (** Various string utilities.
+
+      Mostly inspired by extlib and batteries ExtString and BatString libraries.
+
+      @author Sylvain Le Gall
+    *)
+
+
+  let nsplitf str f =
+    if str = "" then
+      []
+    else
+      let buf = Buffer.create 13 in
+      let lst = ref [] in
+      let push () =
+        lst := Buffer.contents buf :: !lst;
+        Buffer.clear buf
+      in
+      let str_len = String.length str in
+        for i = 0 to str_len - 1 do
+          if f str.[i] then
+            push ()
+          else
+            Buffer.add_char buf str.[i]
+        done;
+        push ();
+        List.rev !lst
+
+
+  (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
+      separator.
+    *)
+  let nsplit str c =
+    nsplitf str ((=) c)
+
+
+  let find ~what ?(offset=0) str =
+    let what_idx = ref 0 in
+    let str_idx = ref offset in
+      while !str_idx < String.length str &&
+            !what_idx < String.length what do
+        if str.[!str_idx] = what.[!what_idx] then
+          incr what_idx
+        else
+          what_idx := 0;
+        incr str_idx
+      done;
+      if !what_idx <> String.length what then
+        raise Not_found
+      else
+        !str_idx - !what_idx
+
+
+  let sub_start str len =
+    let str_len = String.length str in
+    if len >= str_len then
+      ""
+    else
+      String.sub str len (str_len - len)
+
+
+  let sub_end ?(offset=0) str len =
+    let str_len = String.length str in
+    if len >= str_len then
+      ""
+    else
+      String.sub str 0 (str_len - len)
+
+
+  let starts_with ~what ?(offset=0) str =
+    let what_idx = ref 0 in
+    let str_idx = ref offset in
+    let ok = ref true in
+      while !ok &&
+            !str_idx < String.length str &&
+            !what_idx < String.length what do
+        if str.[!str_idx] = what.[!what_idx] then
+          incr what_idx
+        else
+          ok := false;
+        incr str_idx
+      done;
+      if !what_idx = String.length what then
+        true
+      else
+        false
+
+
+  let strip_starts_with ~what str =
+    if starts_with ~what str then
+      sub_start str (String.length what)
+    else
+      raise Not_found
+
+
+  let ends_with ~what ?(offset=0) str =
+    let what_idx = ref ((String.length what) - 1) in
+    let str_idx = ref ((String.length str) - 1) in
+    let ok = ref true in
+      while !ok &&
+            offset <= !str_idx &&
+            0 <= !what_idx do
+        if str.[!str_idx] = what.[!what_idx] then
+          decr what_idx
+        else
+          ok := false;
+        decr str_idx
+      done;
+      if !what_idx = -1 then
+        true
+      else
+        false
+
+
+  let strip_ends_with ~what str =
+    if ends_with ~what str then
+      sub_end str (String.length what)
+    else
+      raise Not_found
+
+
+  let replace_chars f s =
+    let buf = Buffer.create (String.length s) in
+    String.iter (fun c -> Buffer.add_char buf (f c)) s;
+    Buffer.contents buf
+
+  let lowercase_ascii =
+    replace_chars
+      (fun c ->
+         if (c >= 'A' && c <= 'Z') then
+           Char.chr (Char.code c + 32)
+         else
+           c)
+
+  let uncapitalize_ascii s =
+    if s <> "" then
+      (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
+    else
+      s
+
+  let uppercase_ascii =
+    replace_chars
+      (fun c ->
+         if (c >= 'a' && c <= 'z') then
+           Char.chr (Char.code c - 32)
+         else
+           c)
+
+  let capitalize_ascii s =
+    if s <> "" then
+      (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
+    else
+      s
+
+end
+
+module OASISUtils = struct
+(* # 22 "src/oasis/OASISUtils.ml" *)
+
+
+  open OASISGettext
+
+
+  module MapExt =
+  struct
+    module type S =
+    sig
+      include Map.S
+      val add_list: 'a t -> (key * 'a) list -> 'a t
+      val of_list: (key * 'a) list -> 'a t
+      val to_list: 'a t -> (key * 'a) list
+    end
+
+    module Make (Ord: Map.OrderedType) =
+    struct
+      include Map.Make(Ord)
+
+      let rec add_list t =
+        function
+          | (k, v) :: tl -> add_list (add k v t) tl
+          | [] -> t
+
+      let of_list lst = add_list empty lst
+
+      let to_list t = fold (fun k v acc -> (k, v) :: acc) t []
+    end
+  end
+
+
+  module MapString = MapExt.Make(String)
+
+
+  module SetExt  =
+  struct
+    module type S =
+    sig
+      include Set.S
+      val add_list: t -> elt list -> t
+      val of_list: elt list -> t
+      val to_list: t -> elt list
+    end
+
+    module Make (Ord: Set.OrderedType) =
+    struct
+      include Set.Make(Ord)
+
+      let rec add_list t =
+        function
+          | e :: tl -> add_list (add e t) tl
+          | [] -> t
+
+      let of_list lst = add_list empty lst
+
+      let to_list = elements
+    end
+  end
+
+
+  module SetString = SetExt.Make(String)
+
+
+  let compare_csl s1 s2 =
+    String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2)
+
+
+  module HashStringCsl =
+    Hashtbl.Make
+      (struct
+         type t = string
+         let equal s1 s2 = (compare_csl s1 s2) = 0
+         let hash s = Hashtbl.hash (OASISString.lowercase_ascii s)
+       end)
+
+  module SetStringCsl =
+    SetExt.Make
+      (struct
+         type t = string
+         let compare = compare_csl
+       end)
+
+
+  let varname_of_string ?(hyphen='_') s =
+    if String.length s = 0 then
+      begin
+        invalid_arg "varname_of_string"
+      end
+    else
+      begin
+        let buf =
+          OASISString.replace_chars
+            (fun c ->
+               if ('a' <= c && c <= 'z')
+                 ||
+                  ('A' <= c && c <= 'Z')
+                 ||
+                  ('0' <= c && c <= '9') then
+                 c
+               else
+                 hyphen)
+            s;
+        in
+        let buf =
+          (* Start with a _ if digit *)
+          if '0' <= s.[0] && s.[0] <= '9' then
+            "_"^buf
+          else
+            buf
+        in
+          OASISString.lowercase_ascii buf
+      end
+
+
+  let varname_concat ?(hyphen='_') p s =
+    let what = String.make 1 hyphen in
+    let p =
+      try
+        OASISString.strip_ends_with ~what p
+      with Not_found ->
+        p
+    in
+    let s =
+      try
+        OASISString.strip_starts_with ~what s
+      with Not_found ->
+        s
+    in
+      p^what^s
+
+
+  let is_varname str =
+    str = varname_of_string str
+
+
+  let failwithf fmt = Printf.ksprintf failwith fmt
+
+
+end
+
+module PropList = struct
+(* # 22 "src/oasis/PropList.ml" *)
+
+
+  open OASISGettext
+
+
+  type name = string
+
+
+  exception Not_set of name * string option
+  exception No_printer of name
+  exception Unknown_field of name * name
+
+
+  let () =
+    Printexc.register_printer
+      (function
+         | Not_set (nm, Some rsn) ->
+             Some
+               (Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn)
+         | Not_set (nm, None) ->
+             Some
+               (Printf.sprintf (f_ "Field '%s' is not set") nm)
+         | No_printer nm ->
+             Some
+               (Printf.sprintf (f_ "No default printer for value %s") nm)
+         | Unknown_field (nm, schm) ->
+             Some
+               (Printf.sprintf
+                  (f_ "Field %s is not defined in schema %s") nm schm)
+         | _ ->
+             None)
+
+
+  module Data =
+  struct
+    type t =
+        (name, unit -> unit) Hashtbl.t
+
+    let create () =
+      Hashtbl.create 13
+
+    let clear t =
+      Hashtbl.clear t
+
+
+(* # 78 "src/oasis/PropList.ml" *)
+  end
+
+
+  module Schema =
+  struct
+    type ('ctxt, 'extra) value =
+        {
+          get:   Data.t -> string;
+          set:   Data.t -> ?context:'ctxt -> string -> unit;
+          help:  (unit -> string) option;
+          extra: 'extra;
+        }
+
+    type ('ctxt, 'extra) t =
+        {
+          name:      name;
+          fields:    (name, ('ctxt, 'extra) value) Hashtbl.t;
+          order:     name Queue.t;
+          name_norm: string -> string;
+        }
+
+    let create ?(case_insensitive=false) nm =
+      {
+        name      = nm;
+        fields    = Hashtbl.create 13;
+        order     = Queue.create ();
+        name_norm =
+          (if case_insensitive then
+             OASISString.lowercase_ascii
+           else
+             fun s -> s);
+      }
+
+    let add t nm set get extra help =
+      let key =
+        t.name_norm nm
+      in
+
+        if Hashtbl.mem t.fields key then
+          failwith
+            (Printf.sprintf
+               (f_ "Field '%s' is already defined in schema '%s'")
+               nm t.name);
+        Hashtbl.add
+          t.fields
+          key
+          {
+            set   = set;
+            get   = get;
+            help  = help;
+            extra = extra;
+          };
+        Queue.add nm t.order
+
+    let mem t nm =
+      Hashtbl.mem t.fields nm
+
+    let find t nm =
+      try
+        Hashtbl.find t.fields (t.name_norm nm)
+      with Not_found ->
+        raise (Unknown_field (nm, t.name))
+
+    let get t data nm =
+      (find t nm).get data
+
+    let set t data nm ?context x =
+      (find t nm).set
+        data
+        ?context
+        x
+
+    let fold f acc t =
+      Queue.fold
+        (fun acc k ->
+           let v =
+             find t k
+           in
+             f acc k v.extra v.help)
+        acc
+        t.order
+
+    let iter f t =
+      fold
+        (fun () -> f)
+        ()
+        t
+
+    let name t =
+      t.name
+  end
+
+
+  module Field =
+  struct
+    type ('ctxt, 'value, 'extra) t =
+        {
+          set:    Data.t -> ?context:'ctxt -> 'value -> unit;
+          get:    Data.t -> 'value;
+          sets:   Data.t -> ?context:'ctxt -> string -> unit;
+          gets:   Data.t -> string;
+          help:   (unit -> string) option;
+          extra:  'extra;
+        }
+
+    let new_id =
+      let last_id =
+        ref 0
+      in
+        fun () -> incr last_id; !last_id
+
+    let create ?schema ?name ?parse ?print ?default ?update ?help extra =
+      (* Default value container *)
+      let v =
+        ref None
+      in
+
+      (* If name is not given, create unique one *)
+      let nm =
+        match name with
+          | Some s -> s
+          | None -> Printf.sprintf "_anon_%d" (new_id ())
+      in
+
+      (* Last chance to get a value: the default *)
+      let default () =
+        match default with
+          | Some d -> d
+          | None -> raise (Not_set (nm, Some (s_ "no default value")))
+      in
+
+      (* Get data *)
+      let get data =
+        (* Get value *)
+        try
+          (Hashtbl.find data nm) ();
+          match !v with
+            | Some x -> x
+            | None -> default ()
+        with Not_found ->
+          default ()
+      in
+
+      (* Set data *)
+      let set data ?context x =
+        let x =
+          match update with
+            | Some f ->
+                begin
+                  try
+                    f ?context (get data) x
+                  with Not_set _ ->
+                    x
+                end
+            | None ->
+                x
+        in
+          Hashtbl.replace
+            data
+            nm
+            (fun () -> v := Some x)
+      in
+
+      (* Parse string value, if possible *)
+      let parse =
+        match parse with
+          | Some f ->
+              f
+          | None ->
+              fun ?context s ->
+                failwith
+                  (Printf.sprintf
+                     (f_ "Cannot parse field '%s' when setting value %S")
+                     nm
+                     s)
+      in
+
+      (* Set data, from string *)
+      let sets data ?context s =
+        set ?context data (parse ?context s)
+      in
+
+      (* Output value as string, if possible *)
+      let print =
+        match print with
+          | Some f ->
+              f
+          | None ->
+              fun _ -> raise (No_printer nm)
+      in
+
+      (* Get data, as a string *)
+      let gets data =
+        print (get data)
+      in
+
+        begin
+          match schema with
+            | Some t ->
+                Schema.add t nm sets gets extra help
+            | None ->
+                ()
+        end;
+
+        {
+          set   = set;
+          get   = get;
+          sets  = sets;
+          gets  = gets;
+          help  = help;
+          extra = extra;
+        }
+
+    let fset data t ?context x =
+      t.set data ?context x
+
+    let fget data t =
+      t.get data
+
+    let fsets data t ?context s =
+      t.sets data ?context s
+
+    let fgets data t =
+      t.gets data
+  end
+
+
+  module FieldRO =
+  struct
+    let create ?schema ?name ?parse ?print ?default ?update ?help extra =
+      let fld =
+        Field.create ?schema ?name ?parse ?print ?default ?update ?help extra
+      in
+        fun data -> Field.fget data fld
+  end
+end
+
+module OASISMessage = struct
+(* # 22 "src/oasis/OASISMessage.ml" *)
+
+
+  open OASISGettext
+  open OASISContext
+
+
+  let generic_message ~ctxt lvl fmt =
+    let cond =
+      if ctxt.quiet then
+        false
+      else
+        match lvl with
+          | `Debug -> ctxt.debug
+          | `Info  -> ctxt.info
+          | _ -> true
+    in
+      Printf.ksprintf
+        (fun str ->
+           if cond then
+             begin
+               ctxt.printf lvl str
+             end)
+        fmt
+
+
+  let debug ~ctxt fmt =
+    generic_message ~ctxt `Debug fmt
+
+
+  let info ~ctxt fmt =
+    generic_message ~ctxt `Info fmt
+
+
+  let warning ~ctxt fmt =
+    generic_message ~ctxt `Warning fmt
+
+
+  let error ~ctxt fmt =
+    generic_message ~ctxt `Error fmt
+
+end
+
+module OASISVersion = struct
+(* # 22 "src/oasis/OASISVersion.ml" *)
+
+
+  open OASISGettext
+
+
+
+
+
+  type s = string
+
+
+  type t = string
+
+
+  type comparator =
+    | VGreater of t
+    | VGreaterEqual of t
+    | VEqual of t
+    | VLesser of t
+    | VLesserEqual of t
+    | VOr of  comparator * comparator
+    | VAnd of comparator * comparator
+
+
+
+  (* Range of allowed characters *)
+  let is_digit c =
+    '0' <= c && c <= '9'
+
+
+  let is_alpha c =
+    ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')
+
+
+  let is_special =
+    function
+      | '.' | '+' | '-' | '~' -> true
+      | _ -> false
+
+
+  let rec version_compare v1 v2 =
+    if v1 <> "" || v2 <> "" then
+      begin
+        (* Compare ascii string, using special meaning for version
+         * related char
+         *)
+        let val_ascii c =
+          if c = '~' then -1
+          else if is_digit c then 0
+          else if c = '\000' then 0
+          else if is_alpha c then Char.code c
+          else (Char.code c) + 256
+        in
+
+        let len1 = String.length v1 in
+        let len2 = String.length v2 in
+
+        let p = ref 0 in
+
+        (** Compare ascii part *)
+        let compare_vascii () =
+          let cmp = ref 0 in
+          while !cmp = 0 &&
+                !p < len1 && !p < len2 &&
+                not (is_digit v1.[!p] && is_digit v2.[!p]) do
+            cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]);
+            incr p
+          done;
+          if !cmp = 0 && !p < len1 && !p = len2 then
+            val_ascii v1.[!p]
+          else if !cmp = 0 && !p = len1 && !p < len2 then
+            - (val_ascii v2.[!p])
+          else
+            !cmp
+        in
+
+        (** Compare digit part *)
+        let compare_digit () =
+          let extract_int v p =
+            let start_p = !p in
+              while !p < String.length v && is_digit v.[!p] do
+                incr p
+              done;
+              let substr =
+                String.sub v !p ((String.length v) - !p)
+              in
+              let res =
+                match String.sub v start_p (!p - start_p) with
+                  | "" -> 0
+                  | s -> int_of_string s
+              in
+                res, substr
+          in
+          let i1, tl1 = extract_int v1 (ref !p) in
+          let i2, tl2 = extract_int v2 (ref !p) in
+            i1 - i2, tl1, tl2
+        in
+
+          match compare_vascii () with
+            | 0 ->
+                begin
+                  match compare_digit () with
+                    | 0, tl1, tl2 ->
+                        if tl1 <> "" && is_digit tl1.[0] then
+                          1
+                        else if tl2 <> "" && is_digit tl2.[0] then
+                          -1
+                        else
+                          version_compare tl1 tl2
+                    | n, _, _ ->
+                        n
+                end
+            | n ->
+                n
+      end
+    else
+      begin
+        0
+      end
+
+
+  let version_of_string str = str
+
+
+  let string_of_version t = t
+
+
+  let version_compare_string s1 s2 =
+    version_compare (version_of_string s1) (version_of_string s2)
+
+
+  let chop t =
+    try
+      let pos =
+        String.rindex t '.'
+      in
+        String.sub t 0 pos
+    with Not_found ->
+      t
+
+
+  let rec comparator_apply v op =
+    match op with
+      | VGreater cv ->
+          (version_compare v cv) > 0
+      | VGreaterEqual cv ->
+          (version_compare v cv) >= 0
+      | VLesser cv ->
+          (version_compare v cv) < 0
+      | VLesserEqual cv ->
+          (version_compare v cv) <= 0
+      | VEqual cv ->
+          (version_compare v cv) = 0
+      | VOr (op1, op2) ->
+          (comparator_apply v op1) || (comparator_apply v op2)
+      | VAnd (op1, op2) ->
+          (comparator_apply v op1) && (comparator_apply v op2)
+
+
+  let rec string_of_comparator =
+    function
+      | VGreater v  -> "> "^(string_of_version v)
+      | VEqual v    -> "= "^(string_of_version v)
+      | VLesser v   -> "< "^(string_of_version v)
+      | VGreaterEqual v -> ">= "^(string_of_version v)
+      | VLesserEqual v  -> "<= "^(string_of_version v)
+      | VOr (c1, c2)  ->
+          (string_of_comparator c1)^" || "^(string_of_comparator c2)
+      | VAnd (c1, c2) ->
+          (string_of_comparator c1)^" && "^(string_of_comparator c2)
+
+
+  let rec varname_of_comparator =
+    let concat p v =
+      OASISUtils.varname_concat
+        p
+        (OASISUtils.varname_of_string
+           (string_of_version v))
+    in
+      function
+        | VGreater v -> concat "gt" v
+        | VLesser v  -> concat "lt" v
+        | VEqual v   -> concat "eq" v
+        | VGreaterEqual v -> concat "ge" v
+        | VLesserEqual v  -> concat "le" v
+        | VOr (c1, c2) ->
+            (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2)
+        | VAnd (c1, c2) ->
+            (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2)
+
+
+  let rec comparator_ge v' =
+    let cmp v = version_compare v v' >= 0 in
+    function
+      | VEqual v
+      | VGreaterEqual v
+      | VGreater v -> cmp v
+      | VLesserEqual _
+      | VLesser _ -> false
+      | VOr (c1, c2) -> comparator_ge v' c1 || comparator_ge v' c2
+      | VAnd (c1, c2) -> comparator_ge v' c1 && comparator_ge v' c2
+
+
+end
+
+module OASISLicense = struct
+(* # 22 "src/oasis/OASISLicense.ml" *)
+
+
+  (** License for _oasis fields
+      @author Sylvain Le Gall
+    *)
+
+
+
+
+
+  type license = string
+
+
+  type license_exception = string
+
+
+  type license_version =
+    | Version of OASISVersion.t
+    | VersionOrLater of OASISVersion.t
+    | NoVersion
+
+
+
+  type license_dep_5_unit =
+    {
+      license:   license;
+      excption:  license_exception option;
+      version:   license_version;
+    }
+
+
+
+  type license_dep_5 =
+    | DEP5Unit of license_dep_5_unit
+    | DEP5Or of license_dep_5 list
+    | DEP5And of license_dep_5 list
+
+
+  type t =
+    | DEP5License of license_dep_5
+    | OtherLicense of string (* URL *)
+
+
+
+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
+
+module OASISText = struct
+(* # 22 "src/oasis/OASISText.ml" *)
+
+
+
+  type elt =
+    | Para of string
+    | Verbatim of string
+    | BlankLine
+
+
+  type t = elt list
+
+end
+
+module OASISTypes = struct
+(* # 22 "src/oasis/OASISTypes.ml" *)
+
+
+
+
+
+  type name          = string
+  type package_name  = string
+  type url           = string
+  type unix_dirname  = string
+  type unix_filename = string
+  type host_dirname  = string
+  type host_filename = string
+  type prog          = string
+  type arg           = string
+  type args          = string list
+  type command_line  = (prog * arg list)
+
+
+  type findlib_name = string
+  type findlib_full = string
+
+
+  type compiled_object =
+    | Byte
+    | Native
+    | Best
+
+
+
+  type dependency =
+    | FindlibPackage of findlib_full * OASISVersion.comparator option
+    | InternalLibrary of name
+
+
+
+  type tool =
+    | ExternalTool of name
+    | InternalExecutable of name
+
+
+
+  type vcs =
+    | Darcs
+    | Git
+    | Svn
+    | Cvs
+    | Hg
+    | Bzr
+    | Arch
+    | Monotone
+    | OtherVCS of url
+
+
+
+  type plugin_kind =
+      [  `Configure
+       | `Build
+       | `Doc
+       | `Test
+       | `Install
+       | `Extra
+      ]
+
+
+  type plugin_data_purpose =
+      [  `Configure
+       | `Build
+       | `Install
+       | `Clean
+       | `Distclean
+       | `Install
+       | `Uninstall
+       | `Test
+       | `Doc
+       | `Extra
+       | `Other of string
+      ]
+
+
+  type 'a plugin = 'a * name * OASISVersion.t option
+
+
+  type all_plugin = plugin_kind plugin
+
+
+  type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list
+
+
+(* # 115 "src/oasis/OASISTypes.ml" *)
+
+
+  type 'a conditional = 'a OASISExpr.choices
+
+
+  type custom =
+      {
+        pre_command:  (command_line option) conditional;
+        post_command: (command_line option) conditional;
+      }
+
+
+
+  type common_section =
+      {
+        cs_name: name;
+        cs_data: PropList.Data.t;
+        cs_plugin_data: plugin_data;
+      }
+
+
+
+  type build_section =
+      {
+        bs_build:           bool conditional;
+        bs_install:         bool conditional;
+        bs_path:            unix_dirname;
+        bs_compiled_object: compiled_object;
+        bs_build_depends:   dependency list;
+        bs_build_tools:     tool list;
+        bs_c_sources:       unix_filename list;
+        bs_data_files:      (unix_filename * unix_filename option) list;
+        bs_ccopt:           args conditional;
+        bs_cclib:           args conditional;
+        bs_dlllib:          args conditional;
+        bs_dllpath:         args conditional;
+        bs_byteopt:         args conditional;
+        bs_nativeopt:       args conditional;
+      }
+
+
+
+  type library =
+      {
+        lib_modules:            string list;
+        lib_pack:               bool;
+        lib_internal_modules:   string list;
+        lib_findlib_parent:     findlib_name option;
+        lib_findlib_name:       findlib_name option;
+        lib_findlib_containers: findlib_name list;
+      }
+
+
+  type object_ =
+      {
+        obj_modules:            string list;
+        obj_findlib_fullname:   findlib_name list option;
+      }
+
+
+  type executable =
+      {
+        exec_custom:          bool;
+        exec_main_is:         unix_filename;
+      }
+
+
+  type flag =
+      {
+        flag_description:  string option;
+        flag_default:      bool conditional;
+      }
+
+
+  type source_repository =
+      {
+        src_repo_type:        vcs;
+        src_repo_location:    url;
+        src_repo_browser:     url option;
+        src_repo_module:      string option;
+        src_repo_branch:      string option;
+        src_repo_tag:         string option;
+        src_repo_subdir:      unix_filename option;
+      }
+
+
+  type test =
+      {
+        test_type:               [`Test] plugin;
+        test_command:            command_line conditional;
+        test_custom:             custom;
+        test_working_directory:  unix_filename option;
+        test_run:                bool conditional;
+        test_tools:              tool list;
+      }
+
+
+  type doc_format =
+    | HTML of unix_filename
+    | DocText
+    | PDF
+    | PostScript
+    | Info of unix_filename
+    | DVI
+    | OtherDoc
+
+
+
+  type doc =
+      {
+        doc_type:        [`Doc] plugin;
+        doc_custom:      custom;
+        doc_build:       bool conditional;
+        doc_install:     bool conditional;
+        doc_install_dir: unix_filename;
+        doc_title:       string;
+        doc_authors:     string list;
+        doc_abstract:    string option;
+        doc_format:      doc_format;
+        doc_data_files:  (unix_filename * unix_filename option) list;
+        doc_build_tools: tool list;
+      }
+
+
+  type section =
+    | Library    of common_section * build_section * library
+    | Object     of common_section * build_section * object_
+    | Executable of common_section * build_section * executable
+    | Flag       of common_section * flag
+    | SrcRepo    of common_section * source_repository
+    | Test       of common_section * test
+    | Doc        of common_section * doc
+
+
+
+  type section_kind =
+      [ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ]
+
+
+  type package =
+      {
+        oasis_version:          OASISVersion.t;
+        ocaml_version:          OASISVersion.comparator option;
+        findlib_version:        OASISVersion.comparator option;
+        alpha_features:         string list;
+        beta_features:          string list;
+        name:                   package_name;
+        version:                OASISVersion.t;
+        license:                OASISLicense.t;
+        license_file:           unix_filename option;
+        copyrights:             string list;
+        maintainers:            string list;
+        authors:                string list;
+        homepage:               url option;
+        synopsis:               string;
+        description:            OASISText.t option;
+        categories:             url list;
+
+        conf_type:              [`Configure] plugin;
+        conf_custom:            custom;
+
+        build_type:             [`Build] plugin;
+        build_custom:           custom;
+
+        install_type:           [`Install] plugin;
+        install_custom:         custom;
+        uninstall_custom:       custom;
+
+        clean_custom:           custom;
+        distclean_custom:       custom;
+
+        files_ab:               unix_filename list;
+        sections:               section list;
+        plugins:                [`Extra] plugin list;
+        disable_oasis_section:  unix_filename list;
+        schema_data:            PropList.Data.t;
+        plugin_data:            plugin_data;
+      }
+
+
+end
+
+module OASISFeatures = struct
+(* # 22 "src/oasis/OASISFeatures.ml" *)
+
+  open OASISTypes
+  open OASISUtils
+  open OASISGettext
+  open OASISVersion
+
+  module MapPlugin =
+    Map.Make
+      (struct
+         type t = plugin_kind * name
+         let compare = Pervasives.compare
+       end)
+
+  module Data =
+  struct
+    type t =
+        {
+          oasis_version: OASISVersion.t;
+          plugin_versions: OASISVersion.t option MapPlugin.t;
+          alpha_features: string list;
+          beta_features: string list;
+        }
+
+    let create oasis_version alpha_features beta_features =
+      {
+        oasis_version = oasis_version;
+        plugin_versions = MapPlugin.empty;
+        alpha_features = alpha_features;
+        beta_features = beta_features
+      }
+
+    let of_package pkg =
+      create
+        pkg.OASISTypes.oasis_version
+        pkg.OASISTypes.alpha_features
+        pkg.OASISTypes.beta_features
+
+    let add_plugin (plugin_kind, plugin_name, plugin_version) t =
+      {t with
+           plugin_versions = MapPlugin.add
+                               (plugin_kind, plugin_name)
+                               plugin_version
+                               t.plugin_versions}
+
+    let plugin_version plugin_kind plugin_name t =
+      MapPlugin.find (plugin_kind, plugin_name) t.plugin_versions
+
+    let to_string t =
+      Printf.sprintf
+        "oasis_version: %s; alpha_features: %s; beta_features: %s; \
+         plugins_version: %s"
+        (OASISVersion.string_of_version t.oasis_version)
+        (String.concat ", " t.alpha_features)
+        (String.concat ", " t.beta_features)
+        (String.concat ", "
+           (MapPlugin.fold
+              (fun (_, plg) ver_opt acc ->
+                 (plg^
+                  (match ver_opt with
+                     | Some v ->
+                         " "^(OASISVersion.string_of_version v)
+                     | None -> ""))
+                 :: acc)
+              t.plugin_versions []))
+  end
+
+  type origin =
+    | Field of string * string
+    | Section of string
+    | NoOrigin
+
+  type stage = Alpha | Beta
+
+