Browse Source

initial commit

Spiros Eliopoulos 7 years ago
commit
aa6c1ae57c
18 changed files with 8634 additions and 0 deletions
  1. 9 0
      .gitignore
  2. 5 0
      .merlin
  3. 30 0
      LICENSE
  4. 41 0
      Makefile
  5. 30 0
      _oasis
  6. 30 0
      _tags
  7. 27 0
      configure
  8. 13 0
      lib/META
  9. 468 0
      lib/angstrom.ml
  10. 4 0
      lib/angstrom.mldylib
  11. 211 0
      lib/angstrom.mli
  12. 4 0
      lib/angstrom.mllib
  13. 91 0
      lib_test/test_angstrom.ml
  14. 623 0
      myocamlbuild.ml
  15. 1 0
      opam/descr
  16. 1 0
      opam/findlib
  17. 27 0
      opam/opam
  18. 7019 0
      setup.ml

+ 9 - 0
.gitignore

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

+ 5 - 0
.merlin

@@ -0,0 +1,5 @@
+S lib/**
+B _build/**
+
+PKG cstruct result
+PKG alcotest cohttp uri

+ 30 - 0
LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2015, 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

+ 30 - 0
_oasis

@@ -0,0 +1,30 @@
+OASISFormat: 0.4
+Name:        angstrom
+Version:     0.1.0
+Synopsis:    Parser combinator library built for speed and memory efficiency
+Authors:     Spiros Eliopoulos <spiros@inhabitedtype.com>
+Maintainers: Spiros Eliopoulos <spiros@inhabitedtype.com>
+Homepage:    https://github.com/inhabitedtype/angstrom
+Copyrights:  (C) 2015 Inhabited Type LLC
+License:     BSD-3-clause
+Plugins:     META (0.4), DevFiles (0.4)
+BuildTools: ocamlbuild
+
+Library angstrom
+  Path:         lib
+  Findlibname:  angstrom
+  BuildDepends: cstruct, result
+  Modules:      Angstrom
+
+Executable test_angstrom
+  Path:             lib_test
+  MainIs:           test_angstrom.ml
+  Build$:           flag(tests)
+  CompiledObject:   best
+  Install:          false
+  BuildDepends:     angstrom, alcotest
+
+Test test_angstrom
+  Run$:             flag(tests)
+  Command:          $test_angstrom
+  WorkingDirectory: lib_test

+ 30 - 0
_tags

@@ -0,0 +1,30 @@
+# OASIS_START
+# DO NOT EDIT (digest: 52096af436a8b9b39a698a9d95ee17d1)
+# 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 angstrom
+"lib/angstrom.cmxs": use_angstrom
+<lib/*.ml{,i,y}>: pkg_cstruct
+<lib/*.ml{,i,y}>: pkg_result
+# Executable test_angstrom
+<lib_test/test_angstrom.{native,byte}>: pkg_alcotest
+<lib_test/test_angstrom.{native,byte}>: pkg_cstruct
+<lib_test/test_angstrom.{native,byte}>: pkg_result
+<lib_test/test_angstrom.{native,byte}>: use_angstrom
+<lib_test/*.ml{,i,y}>: pkg_alcotest
+<lib_test/*.ml{,i,y}>: pkg_cstruct
+<lib_test/*.ml{,i,y}>: pkg_result
+<lib_test/*.ml{,i,y}>: use_angstrom
+# 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

+ 13 - 0
lib/META

@@ -0,0 +1,13 @@
+# OASIS_START
+# DO NOT EDIT (digest: df2d187895e25b3acdbdc108d7296ad1)
+version = "0.1.0"
+description =
+"Parser combinator library built for speed and memory efficiency"
+requires = "cstruct result"
+archive(byte) = "angstrom.cma"
+archive(byte, plugin) = "angstrom.cma"
+archive(native) = "angstrom.cmxa"
+archive(native, plugin) = "angstrom.cmxs"
+exists_if = "angstrom.cma"
+# OASIS_STOP
+

+ 468 - 0
lib/angstrom.ml

@@ -0,0 +1,468 @@
+module A = Bigarray.Array1
+module B = struct
+  (** XXX(seliopou): Look into replacing this with a circular buffer. *)
+  type t =
+    { mutable buffer : Cstruct.t
+    ; mutable offset : int
+    }
+
+  let reuse buffer =
+    { buffer; offset = 0 }
+
+  let of_string str =
+    let buffer = Cstruct.of_string str in
+    reuse buffer
+
+  let of_bigarray ?off ?len bytes =
+    let buffer = Cstruct.of_bigarray ?off ?len bytes in
+    reuse buffer
+
+  let create ?(size=0x1000) () =
+    let buffer = Cstruct.(set_len (create size) 0) in
+    reuse buffer
+
+  let _writable_space t =
+    A.dim t.buffer.Cstruct.buffer - t.buffer.Cstruct.len
+
+  let _trailing_space t =
+    A.dim t.buffer.Cstruct.buffer - Cstruct.(t.buffer.off + t.buffer.len)
+
+  let debug t =
+    Printf.sprintf "debug - buf: %s, trailing: %d, writable: %d\n%!"
+      (Cstruct.debug t.buffer) (_trailing_space t) (_writable_space t)
+
+  let _compress t =
+    let off, len = 0, Cstruct.len t.buffer in
+    let buffer = Cstruct.of_bigarray ~off ~len t.buffer.Cstruct.buffer in
+    Cstruct.blit t.buffer 0 buffer 0 len;
+    t.buffer <- buffer
+
+  let _grow t to_copy =
+    let init_size = A.dim t.buffer.Cstruct.buffer in
+    let size  = ref init_size in
+    let space = _writable_space t in
+    while space + !size - init_size < to_copy do
+      size := (3 * !size) / 2
+    done;
+    let buffer = Cstruct.(set_len (create !size) t.buffer.Cstruct.len) in
+    Cstruct.blit t.buffer 0 buffer 0 t.buffer.Cstruct.len;
+    t.buffer <- buffer
+  ;;
+
+  let _ensure_space t len =
+    begin if _trailing_space t >= len then
+      () (* there is enough room at the end *)
+    else if _writable_space t >= len then
+      _compress t
+    else
+      _grow t len
+    end;
+    t.buffer <- Cstruct.add_len t.buffer len
+  ;;
+
+  let copy_in t =
+    function
+    | `String str ->
+      let len = String.length str in
+      _ensure_space t len;
+      let len' = Cstruct.len t.buffer - len in
+      let allocator _ = Cstruct.sub t.buffer len' len in
+      ignore (Cstruct.of_string ~allocator str)
+    | `Cstruct cs ->
+      let len = Cstruct.len cs in
+      _ensure_space t len;
+      let len' = Cstruct.len t.buffer - len in
+      Cstruct.blit cs 0 t.buffer len' len
+
+  let commit t pos =
+    t.buffer <- Cstruct.shift t.buffer (pos - t.offset);
+    t.offset <- pos
+
+  let input_length t =
+    Cstruct.len t.buffer + t.offset
+
+  let get t i =
+    Cstruct.get_char t.buffer (i - t.offset)
+
+  let substring t pos len =
+    Cstruct.copy t.buffer (pos - t.offset) len
+
+  let count_while t pos f =
+    let i = ref pos in
+    let len = input_length t in
+    while !i < len && f (get t !i) do
+      incr i
+    done;
+    !i - pos
+
+  let unread t pos =
+    Cstruct.shift t.buffer (pos - t.offset)
+end
+
+type more =
+  | Complete
+  | Incomplete
+
+type input =
+  [ `String  of string
+  | `Cstruct of Cstruct.t ]
+
+type 'a state =
+  | Fail    of Cstruct.t * string list * string
+  | Partial of (input option -> 'a state)
+  | Done    of Cstruct.t * 'a
+
+type 'a failure = B.t -> int -> more -> string list -> string -> 'a state
+type ('a, 'r) success = B.t -> int -> more -> 'a -> 'r state
+
+let fail_k    buf pos _ marks msg = Fail(B.unread buf pos, marks, msg)
+let succeed_k buf pos _       v   = Done(B.unread buf pos, v)
+
+type 'a t =
+  { run : 'r. B.t -> int -> more -> 'r failure -> ('a, 'r) success -> 'r state }
+
+let return : type a. a -> a t =
+  fun v -> { run = fun buf pos more _fail succ -> succ buf pos more v }
+
+let fail msg =
+  { run = fun buf pos more fail succ ->
+    fail buf pos more [] msg
+  }
+
+let (>>=) p f =
+  { run = fun buf pos more fail succ ->
+    let succ' buf' pos' more' v = (f v).run buf' pos' more' fail succ in
+    p.run buf pos more fail succ'
+  }
+
+let (>>|) p f =
+  { run = fun buf pos more fail succ ->
+    let succ' buf' pos' more' v = succ buf' pos' more' (f v) in
+    p.run buf pos more fail succ'
+  }
+
+let (<$>) f m =
+  m >>| f
+
+let (<*>) f m =
+  f >>= fun f ->
+  m >>| f
+
+let ( *>) a b =
+  a >>= fun _ -> b
+
+let (<* ) a b =
+  a >>= fun x ->
+  b >>| fun _ -> x
+
+let (<?>) p mark =
+  { run = fun buf pos more fail succ ->
+    let fail' buf' pos' more' marks msg = fail buf' pos' more' (mark::marks) msg in
+    p.run buf pos more fail' succ
+  }
+
+let (<|>) p q =
+  { run = fun buf pos more fail succ ->
+    let fail' buf' pos' more' _marks _msg = q.run buf' pos more' fail succ in
+    p.run buf pos more fail' succ
+  }
+
+(** BEGIN: getting input *)
+
+let prompt buf pos fail succ =
+  let k = function
+    | None       -> fail buf pos Complete
+    | Some input ->
+      B.copy_in buf input;
+      succ buf pos Incomplete
+  in
+  Partial k
+
+let demand_input =
+  { run = fun buf pos more fail succ ->
+    match more with
+    | Complete   -> fail buf pos more [] "not enough input"
+    | Incomplete ->
+      let succ' buf' pos' more' = succ buf' pos' more' ()
+      and fail' buf' pos' more' = fail buf' pos' more' [] "not enough input" in
+      prompt buf pos fail' succ'
+  }
+
+let want_input =
+  { run = fun buf pos more _fail succ ->
+    if pos < B.input_length buf then
+      succ buf pos more true
+    else if more = Complete then
+      succ buf pos more false
+    else
+      let succ' buf' pos' more' = succ buf' pos' more' true
+      and fail' buf' pos' more' = succ buf' pos' more' false in
+      prompt buf pos fail' succ'
+  }
+
+let ensure_suspended n buf pos more fail succ =
+  let rec go =
+    { run = fun buf' pos' more' fail' succ' ->
+      if pos' + n <= B.input_length buf' then
+        succ' buf' pos' more' ()
+      else
+        (demand_input >>= fun () -> go).run buf' pos' more' fail' succ'
+    }
+  in
+  (demand_input >>= fun () -> go).run buf pos more fail succ
+
+let unsafe_substring n =
+  { run = fun buf pos more fail succ ->
+    succ buf pos more (B.substring buf pos n)
+  }
+
+let ensure n =
+  { run = fun buf pos more fail succ ->
+    if pos + n <= B.input_length buf then
+      succ buf pos more ()
+    else
+      ensure_suspended n buf pos more fail succ
+  }
+  >>= fun () -> unsafe_substring n
+
+
+(** END: getting input *)
+
+let end_of_input =
+  { run = fun buf pos more fail succ ->
+    if pos < B.input_length buf then
+      fail buf pos more [] "end_of_input"
+    else if more = Complete then
+      succ buf pos more ()
+    else
+      let succ' buf' pos' more' = fail buf' pos' more' [] "end_of_input"
+      and fail' buf' pos' more' = succ buf' pos' more' () in
+      prompt buf pos fail' succ'
+  }
+
+let end_of_buffer =
+  { run = fun buf pos more fail succ ->
+    succ buf pos more (pos = B.input_length buf)
+  }
+
+let spans_chunks n =
+  { run = fun buf pos more fail succ ->
+    if pos + n < B.input_length buf || more = Complete then
+      succ buf pos more false
+    else
+      let succ' buf' pos' more' = succ buf' pos' more' true
+      and fail' buf' pos' more' = succ buf' pos' more' false in
+      prompt buf pos fail' succ'
+  }
+
+let advance n =
+  { run = fun buf pos more _fail succ -> succ buf (pos + n) more () }
+
+let pos =
+  { run = fun buf pos more _fail succ -> succ buf pos more pos }
+
+let available =
+  { run = fun buf pos more _fail succ ->
+    succ buf pos more (B.input_length buf - pos)
+  }
+
+let get_buffer_and_pos =
+  { run = fun buf pos more _fail succ -> succ buf pos more (buf, pos) }
+
+let commit =
+  { run = fun buf pos more _fail succ ->
+    B.commit buf pos;
+    succ buf pos more ()
+  }
+
+let peek_char =
+  { run = fun buf pos more fail succ ->
+    if pos < B.input_length buf then
+      succ buf pos more (Some (B.get buf pos))
+    else if more = Complete then
+      succ buf pos more None
+    else
+      let succ' buf' pos' more' = succ buf' pos' more' (Some (B.get buf' pos'))
+      and fail' buf' pos' more' = succ buf' pos' more' None in
+      prompt buf pos fail' succ'
+  }
+
+let peek_char_fail =
+  { run = fun buf pos more fail succ ->
+    if pos < B.input_length buf then
+      succ buf pos more (B.get buf pos)
+    else
+      let succ' buf' pos' more' () = succ buf' pos' more' (B.get buf' pos') in
+      ensure_suspended 1 buf pos more fail succ'
+  }
+
+let satisfy f =
+  peek_char_fail >>= fun c ->
+    if f c
+      then advance 1 >>| fun () -> c
+      else fail "satisfy"
+
+let skip f =
+  peek_char_fail >>= fun c ->
+    if f c
+      then advance 1
+      else fail "skip"
+
+let count_while ?(init=0) f =
+  (* NB: does not advance position. *)
+  let rec go acc =
+    get_buffer_and_pos >>= fun (buf, pos) ->
+      let n = B.count_while buf (pos + acc) f in
+      spans_chunks n
+      >>= function
+        | true  -> go (n + acc)
+        | false -> return (n + acc)
+  in
+  go init
+
+let string_ f s =
+  (* XXX(seliopou): Inefficient. Could check prefix equality to short-circuit
+   * the io. *)
+  let len = String.length s in
+  ensure len >>= fun s'->
+    if f s = f s'
+      then advance len *> return s'
+      else fail "string"
+
+let string s    = string_ (fun x -> x) s
+let string_ci s = string_ String.lowercase s
+
+let skip_while f =
+  count_while f >>= advance
+
+let take n =
+  let n = max n 0 in
+  ensure  n >>= fun str ->
+  advance n >>| fun () ->
+    str
+
+let take_while f =
+  count_while f >>= fun n ->
+  unsafe_substring n >>= fun str ->
+  advance n >>| fun () ->
+    str
+
+let take_while1 f =
+  end_of_buffer
+  >>= begin function
+    | true  -> demand_input
+    | false -> return ()
+  end >>= fun () ->
+  get_buffer_and_pos
+  >>= fun (buf, pos) ->
+    let init = B.count_while buf pos f in
+    if init = 0 then
+      fail "take_while1"
+    else
+      count_while ~init f >>= fun n ->
+      unsafe_substring n >>= fun str ->
+      advance n >>| fun () ->
+        str
+
+let take_till f =
+  take_while (fun c -> not (f c))
+
+let take_rest =
+  let rec go acc =
+    want_input >>= function
+      | true  ->
+        available >>= fun n ->
+        unsafe_substring n >>= fun str ->
+        advance n >>= fun () ->
+          go (str::acc)
+      | false ->
+        return (List.rev acc)
+  in
+  go []
+
+let char c =
+  satisfy (fun c' -> c = c') <?> (String.init 1 (fun _ -> c))
+
+let not_char c =
+  satisfy (fun c' -> c <> c') <?> ("not " ^ String.init 1 (fun _ -> c))
+
+let any_char =
+  satisfy (fun _ -> true)
+
+let choice ps =
+  List.fold_right (<|>) ps (fail "empty")
+
+let fix f =
+  let rec p = lazy (f r)
+  and r = { run = fun buf pos more fail succ ->
+    Lazy.(force p).run buf pos more fail succ }
+  in
+  r
+
+let option x p =
+  p <|> return x
+
+let cons x xs = x :: xs
+
+let many p =
+  fix (fun m ->
+    (return cons <*> p <*> m) <|> return [])
+
+let many1 p =
+  return cons <*> p <*> many p
+
+let many_till p t =
+  fix (fun m ->
+    (return cons <*> p <*> m) <|> (t *> return []))
+
+let sep_by1 p s =
+  fix (fun m ->
+    return cons <*> p <*> ((s *> m) <|> return []))
+
+let sep_by p s =
+  (return cons <*> p <*> (s *> (sep_by1 p s <|> return []))) <|> return []
+
+let rec list ps =
+  match ps with
+  | []    -> return []
+  | p::ps -> return cons <*> p <*> list ps
+
+let end_of_line =
+  (char '\n' *> return ()) <|> (string "\r\n" *> return ()) <?> "end_of_line"
+
+let parse ?(initial_buffer_size=0x1000) ?(input=`String "") p =
+  let buf  = B.create ~size:initial_buffer_size () in
+  B.copy_in buf input;
+  p.run buf 0 Incomplete fail_k succeed_k
+
+let parse_with_buffer p buf =
+  p.run (B.reuse buf) 0 Incomplete fail_k succeed_k
+
+let parse_only p input =
+  let buf = B.create () in
+  B.copy_in buf input;
+  match p.run buf 0 Complete fail_k succeed_k with
+  | Fail(_, []   , err) -> Result.Error err
+  | Fail(_, marks, err) -> Result.Error (String.concat " > " marks ^ ": " ^ err)
+  | Done(_, v)          -> Result.Ok v
+  | Partial _           -> assert false
+
+let copy_into_leftover l bytes =
+  let buf  = B.reuse l in
+  B.copy_in buf bytes;
+  buf.B.buffer
+
+let feed state bytes =
+  match state with
+  | Fail (l, marks, msg) -> Fail(copy_into_leftover l bytes, marks, msg)
+  | Partial k            -> k (Some bytes)
+  | Done (l, v)          -> Done(copy_into_leftover l bytes, v)
+
+let state_to_option = function
+  | Done (_, v) -> Some v
+  | _           -> None
+
+let state_to_result = function
+  | Done (buf', v)          -> Result.Ok v
+  | Partial _               -> Result.Error "incomplete input"
+  | Fail (buf', marks, err) -> Result.Error (String.concat " > " marks ^ ": " ^ err)

+ 4 - 0
lib/angstrom.mldylib

@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: 101b1bc4549b55eff7cd72a37bf05289)
+Angstrom
+# OASIS_STOP

+ 211 - 0
lib/angstrom.mli

@@ -0,0 +1,211 @@
+type 'a t
+(** A parser for values of type ['a]. *)
+
+
+(** {2 Basic parsers} *)
+
+val peek_char : char option t
+(** [peek_char] matches any char and returns it, or returns [None] if the end
+    of input has been reached.
+
+    This parser does not consume any input. Use it for lookahead. *)
+
+val peek_char_fail : char t
+(** [peek_char_fail] matches any char and returns it. If end of input has been
+    reached, it will fail.
+
+    This parser does not consume any input. Use it for lookahead. *)
+
+val char : char -> char t
+(** [char c] matches [c] and returns it. *)
+
+val not_char : char -> char t
+(** [not_char] matches any character that is not [c] and returns the matched
+    character. *)
+
+val any_char : char t
+(** [any_char] matches any character and returns it. *)
+
+val string : string -> string t
+(** [string s] matches [s] exactly and returns it. *)
+
+val string_ci : string -> string t
+(** [string_ci s] matches [s], ignoring case, and returns the matched string,
+    preserving the case of the original input. *)
+
+val satisfy : (char -> bool) -> char t
+(** [satisfy f] matches any character for which [f] returns [true] and returns
+    the matched character. *)
+
+val skip : (char -> bool) -> unit t
+(** [skip f] matches any character for which [f] returns [true] and discards
+    the matched character. [skip f] equivalent to [satisfy f] but discards the
+    matched character. *)
+
+val skip_while : (char -> bool) -> unit t
+(** [skip_while f] consumes input as long as [f] returns [true] and discards
+    the matched characters. *)
+
+val take : int -> string t
+(** [take n] matches exactly [n] characters of input and returns them as a
+    string. *)
+
+val take_while : (char -> bool) -> string t
+(** [take_while f] consumes input as long as [f] returns [true] and returns the
+    matched characters as a string.
+
+    This parser does not fail. If [f] returns [false] on the first character,
+    it will return the empty string. *)
+
+val take_while1 : (char -> bool) -> string t
+(** [take_while f] consumes input as long as [f] returns [true] and returns the
+    matched characters as a string.
+
+    This parser requires that [f] return [true] for at least one character of
+    input, and will fail otherwise. *)
+
+val take_till : (char -> bool) -> string t
+(** [take_till f] consumes input as long as [f] returns [false] and returns the
+    matched characters as a string.
+
+    This parser does not fail. If [f] returns [true] on the first character, it
+    will return the empty string. *)
+
+val take_rest : string list t
+(** [take_rest] consumes the rest of the input and returns it as chunks. *)
+
+val end_of_input : unit t
+(** [end_of_input] succeeds if all the input has been consumed, and fails
+    otherwise. *)
+
+val end_of_line : unit t
+(** [end_of_input] matches either a line feed, or a carriage return followed by
+    a line feed and returns unit. *)
+
+
+(** {2 Combinators} *)
+
+val option : 'a -> 'a t -> 'a t
+(** [option v p] runs [p], returning the result of [p] if it succeeds and [v]
+    if it fails. *)
+
+val list : 'a t list -> 'a list t
+(** [list ps] runs each [p] in [ps] in sequence, returning a list of results of
+    each [p]. *)
+
+val many : 'a t -> 'a list t
+(** [many p] runs [p] {i zero} or more times and returns a list of results from
+    the runs of [p]. *)
+
+val many1 : 'a t -> 'a list t
+(** [many1 p] runs [p] {i one} or more times and returns a list of results from
+    the runs of [p]. *)
+
+val many_till : 'a t -> 'b t -> 'a list t
+(** [many_till p e] runs parser [p] {i zero} or more times until action [e]
+    succeeds and returns the list of result from the runs of [p]. *)
+
+val sep_by : 'a t -> 'b t -> 'a list t
+(** [sep_by p s] runs [p] {i zero} or more times, interspersing runs of [s] in between. *)
+
+val sep_by1 : 'a t -> 'b t -> 'a list t
+(** [sep_by1 p s] runs [p] {i one} or more times, interspersing runs of [s] in between. *)
+
+val fix : ('a t -> 'a t) -> 'a t
+(** [fix f] computes the fixpoint of [f] and runs the resultant parser,
+    returning its result. *)
+
+
+(** {2 Alternatives} *)
+
+val (<|>) : 'a t -> 'a t -> 'a t
+(** [p <|> q] runs [p] and returns the result if succeeds. If [p] fails, then
+    the input will be reset and [q] will run instead. *)
+
+val choice : 'a t list -> 'a t
+(** [choice ts] runs each parser in [ts] in order until one succeeds and
+    returns that result. *)
+
+val (<?>) : 'a t -> string -> 'a t
+(** [p <?> name] associates [name] with the parser [p], which will be reported
+    in the case of failure. *)
+
+val commit : unit t
+(** [commit] prevents backtracking beyond the current position of the input.
+    Any consumed input that is still buffered will potentially be overridden to
+    make room for new incremental input. *)
+
+
+(** {2 Monadic/Applicative interface} *)
+
+val return : 'a -> 'a t
+(** [return v] creates a parser that will always succeed and return [v] *)
+
+val fail : string -> 'a t
+(** [fail msg] creates a parser that will always fail with the message [msg] *)
+
+val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
+(** [p >>= f] creates a parser that will run [p], pass its result to [f], run
+    the parser that [f] produces, and return its result. *)
+
+val (>>|) : 'a t -> ('a -> 'b) -> 'b t
+(** [p >>| f] creates a parser that will run [p], and if it succeeds with
+    result [v], will return [f v] *)
+
+val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
+(** [f <*> p] is equivalent to [f >>= fun f -> p >>| f]. *)
+
+val (<$>) : ('a -> 'b) -> 'a t -> 'b t
+(** [f <$> p] is equivalent to [p >>| f] *)
+
+val ( *>) : 'a t -> 'b t -> 'b t
+(** [p *> q] runs [p], discards its result and then runs [q]. *)
+
+val (<* ) : 'a t -> 'b t -> 'a t
+(** [p <* q] runs [p], then runs [q], discards its result, and returns the
+    result of [p]. *)
+
+
+(** {2 Running} *)
+
+type input =
+  [ `String  of string
+  | `Cstruct of Cstruct.t ]
+
+type 'a state =
+  | Fail    of Cstruct.t * string list * string
+  | Partial of (input option -> 'a state)
+  | Done    of Cstruct.t * 'a
+
+val parse : ?initial_buffer_size:int -> ?input:input -> 'a t -> 'a state
+(** [parse ?initial_buffer_size ?input t] runs [t] on [input], if present, and
+    and await input if needed. [parse] will allocate a buffer of size
+    [initial_buffer_size] (defaulting to 4k bytes) to do input buffering and
+    automatically grow the buffer as needed. *)
+
+val parse_with_buffer : 'a t -> Cstruct.t -> 'a state
+(** [parse_with_buffer t buffer] runs [t] with a user-allocated buffer [buffer]
+    that the parser can take total ownership of. The view into [buffers] should
+    be set to the bytes that can be used as input. The remainder of the space
+    will be used as the user suppliese additional input to the parser. *)
+
+val parse_only : 'a t -> input -> ('a, string) Result.result
+(** [parse_only t input] runs [t] on [input]. *)
+
+val feed : 'a state -> input -> 'a state
+(** [feed state input] supplies the parser state with more input. If [state] is
+    [Partial], then parsing will continue where it left off. Otherwise, the
+    parser is in a [Fail] or [Done] state, in which case the [input] will be
+    copied into the state's buffer for later use by the caller. *)
+
+val state_to_option : 'a state -> 'a option
+val state_to_result : 'a state -> ('a, string) Result.result
+
+
+(** {2 State introspection}
+
+    These functions are not part of the public API. *)
+
+val pos : int t
+val want_input : bool t
+val available : int t

+ 4 - 0
lib/angstrom.mllib

@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: 101b1bc4549b55eff7cd72a37bf05289)
+Angstrom
+# OASIS_STOP

+ 91 - 0
lib_test/test_angstrom.ml

@@ -0,0 +1,91 @@
+open Angstrom
+
+module Alcotest = struct
+  include Alcotest
+
+  let result (type a) (type e) a e =
+    let (module A: TESTABLE with type t = a) = a in
+    let (module E: TESTABLE with type t = e) = e in
+    let module M = struct
+      type t = (a, e) Result.result
+      let pp fmt t = match t with
+        | Result.Ok    t -> Format.fprintf fmt "Ok @[(%a)@]" A.pp t
+        | Result.Error e -> Format.fprintf fmt "Error @[(%a)@]" E.pp e
+      let equal x y = match x, y with
+        | Result.Ok    x, Result.Ok    y -> A.equal x y
+        | Result.Error x, Result.Error y -> E.equal x y
+        | _             , _              -> false
+    end in
+    (module M: TESTABLE with type t = M.t)
+end
+
+let check ?size ~msg test p is r =
+  let p = p <* end_of_input in
+  let state =
+    List.fold_left (fun state chunk ->
+      feed state (`String chunk))
+    (parse ?initial_buffer_size:size p) is
+  in
+  let result =
+    match state with
+    | Partial k -> state_to_result (k None)
+    | _         -> state_to_result state
+  in
+  Alcotest.(check (result test string)) msg
+    (Result.Ok r) result
+
+let complete =
+  let check_c ~msg p s r = check ~msg Alcotest.char   p [s] r in
+  let check_s ~msg p s r = check ~msg Alcotest.string p [s] r in
+  [ "single 'a' as char", `Quick, begin fun () ->
+      check_c ~msg:"any_char" any_char "a" 'a';
+      check_c ~msg:"not 'b'" (not_char 'b') "a" 'a';
+      check_c ~msg:"char a" (char 'a') "a" 'a';
+      check_c ~msg:"char a | char b" (char 'a' <|> char 'b') "a" 'a';
+      check_c ~msg:"char b | char a" (char 'b' <|> char 'a') "a" 'a';
+    end
+  ; "single 'a' as string", `Quick, begin fun () ->
+      check_s ~msg:"take 1" (take 1) "a" "a";
+      check_s ~msg:"take_while (='a')" (take_while (fun c -> c = 'a')) "a" "a";
+      check_s ~msg:"take_while1 (='a')" (take_while1 (fun c -> c = 'a')) "a" "a";
+      check_s ~msg:"string 'a'" (string "a") "a" "a";
+      check_s ~msg:"string 'a' | string 'b'" (string "a" <|> string "b") "a" "a";
+      check_s ~msg:"string 'b' | string 'a'" (string "b" <|> string "a") "a" "a";
+      check_s ~msg:"string_ci 'a'" (string_ci "a") "a" "a";
+      check_s ~msg:"string_ci 'A'" (string_ci "A") "a" "a";
+    end ]
+;;
+
+let incremental =
+  let check_s ?size ~msg p ss r = check ?size ~msg Alcotest.string p ss r in
+  [ "within chunk boundary", `Quick, begin fun () ->
+      check_s ~msg:"string on each side of 2 inputs"
+        (string "this" *> string "that") ["this"; "that"] "that";
+      check_s ~msg:"string on each side of 3 inputs"
+        (string "thi" *> string "st" *> string "hat") ["thi"; "st"; "hat"] "hat";
+      check_s ~msg:"string straddling 2 inputs"
+        (string "thisthat") ["this"; "that"] "thisthat";
+      check_s ~msg:"string straddling 3 inputs"
+        (string "thisthat") ["thi"; "st"; "hat"] "thisthat";
+    end
+  ; "across chunk boundary", `Quick, begin fun () ->
+      check_s ~size:4 ~msg:"string on each side of 2 chunks"
+        (string "this" *> string "that") ["this"; "that"] "that";
+      check_s ~size:3 ~msg:"string on each side of 3 chunks"
+        (string "thi" *> string "st" *> string "hat") ["thi"; "st"; "hat"] "hat";
+      check_s ~size:4 ~msg:"string straddling 2 chunks"
+        (string "thisthat") ["this"; "that"] "thisthat";
+      check_s ~size:3 ~msg:"string straddling 3 chunks"
+        (string "thisthat") ["thi"; "st"; "hat"] "thisthat";
+    end
+  ; "across chunk boundary with commit", `Quick, begin fun () ->
+      check_s ~size:4 ~msg:"string on each side of 2 chunks"
+        (string "this" *> commit *> string "that") ["this"; "that"] "that";
+      check_s ~size:3 ~msg:"string on each side of 3 chunks"
+        (string "thi" *> string "st" *> commit *> string "hat") ["thi"; "st"; "hat"] "hat";
+    end ]
+
+let () =
+  Alcotest.run "test suite"
+    [ "complete input"   , complete
+    ; "incremental input", incremental ]

+ 623 - 0
myocamlbuild.ml

@@ -0,0 +1,623 @@
+(* OASIS_START *)
+(* DO NOT EDIT (digest: 706d45bc2996e64e98f4680905edfca7) *)
+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 = [("angstrom", ["lib"], [])];
+     lib_c = [];
+     flags = [];
+     includes = [("lib_test", ["lib"])]
+  }
+  ;;
+
+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;;

+ 1 - 0
opam/descr

@@ -0,0 +1 @@
+Parser combinator library built for speed and memory efficiency

+ 1 - 0
opam/findlib

@@ -0,0 +1 @@
+angstrom

+ 27 - 0
opam/opam

@@ -0,0 +1,27 @@
+opam-version: "1.2"
+name: "angstrom"
+version: "0.1.0"
+maintainer: "Spiros Eliopoulos <spiros@inhabitedtype.com>"
+authors: [ "Spiros Eliopoulos <spiros@inhabitedtype.com>" ]
+license: "BSD-3-clause"
+homepage: "https://github.com/inhabitedtype/angstrom"
+bug-reports: "https://github.com/inhabitedtype/angstrom/issues"
+build: [
+  ["ocaml" "setup.ml" "-configure" "--prefix" prefix]
+  ["ocaml" "setup.ml" "-build"]
+]
+install: ["ocaml" "setup.ml" "-install"]
+remove: [
+  ["ocamlfind" "remove" "angstrom"]
+]
+build-test: [
+  ["ocaml" "setup.ml" "-configure" "--enable-tests"]
+  ["ocaml" "setup.ml" "-build"]
+  ["ocaml" "setup.ml" "-test"]
+]
+depends: [
+  "alcotest" {test}
+  "cstruct"
+  "ocamlfind" {build}
+  "result"
+]

+ 7019 - 0
setup.ml

@@ -0,0 +1,7019 @@
+(* setup.ml generated for the first time by OASIS v0.4.5 *)
+
+(* OASIS_START *)
+(* DO NOT EDIT (digest: 5ac3bc25e16f4a7c7dc7b51aa00f4a14) *)
+(*
+   Regenerated by OASIS v0.4.5
+   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
+
+
+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 (String.lowercase s1) (String.lowercase s2)
+
+
+  module HashStringCsl =
+    Hashtbl.Make
+      (struct
+         type t = string
+
+         let equal s1 s2 =
+             (String.lowercase s1) = (String.lowercase s2)
+
+         let hash s =
+           Hashtbl.hash (String.lowercase 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
+          String.lowercase 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
+             String.lowercase
+           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;
+