swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2025-11-11 02:07:51 +01:00
parent aa2ff7b2f0
commit 2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

77
unikernel/duniverse/angstrom/.github/workflows/test.yml vendored Normal file
View file

@ -0,0 +1,77 @@
name: build
on:
- push
- pull_request
jobs:
builds:
name: Earliest Supported Version
strategy:
fail-fast: false
matrix:
os:
- ubuntu-latest
ocaml-version:
- 4.04.0
runs-on: ${{ matrix.os }}
steps:
- name: Checkout code
uses: actions/checkout@v2
- name: Use OCaml ${{ matrix.ocaml-version }}
uses: avsm/setup-ocaml@v1
with:
ocaml-version: ${{ matrix.ocaml-version }}
- name: Deps
run: |
opam pin add -n angstrom .
opam install --deps-only angstrom
- name: Build
run: opam exec -- dune build -p angstrom
tests:
name: Tests
strategy:
fail-fast: false
matrix:
os:
- ubuntu-latest
ocaml-version:
- 4.08.1
- 4.10.2
- 4.11.2
- 4.12.0
runs-on: ${{ matrix.os }}
steps:
- name: Checkout code
uses: actions/checkout@v2
- name: Use OCaml ${{ matrix.ocaml-version }}
uses: avsm/setup-ocaml@v1
with:
ocaml-version: ${{ matrix.ocaml-version }}
- name: Deps
run: |
opam pin add -n angstrom .
opam pin add -n angstrom-async .
opam pin add -n angstrom-lwt-unix .
opam install -t --deps-only .
- name: Build
run: opam exec -- dune build
- name: Test
run: opam exec -- dune runtest
- name: Examples
run: |
opam install -t angstrom-async angstrom-lwt-unix
opam exec -- make examples

12
unikernel/duniverse/angstrom/.gitignore vendored Normal file
View file

@ -0,0 +1,12 @@
.*.sw[a-z]
*~
_build/
_tests/
lib_test/tests_
setup.log
setup.data
*.native
*.byte
*.docdir
*.install
.merlin

30
unikernel/duniverse/angstrom/LICENSE Normal file
View file

@ -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.

16
unikernel/duniverse/angstrom/META.angstrom.template Normal file
View file

@ -0,0 +1,16 @@
# JBUILDER_GEN
package "unix" (
description = "Deprecated. Use angstrom-unix directly"
requires = "angstrom-unix"
)
package "lwt-unix" (
description = "Deprecated. Use angstrom-lwt-unix directly"
requires = "angstrom-lwt-unix"
)
package "async" (
description = "Deprecated. Use angstrom-async directly"
requires = "angstrom-async"
)

24
unikernel/duniverse/angstrom/Makefile Normal file
View file

@ -0,0 +1,24 @@
.PHONY: all build clean test install uninstall doc examples
build:
dune build
all: build
test:
dune runtest
examples:
dune build @examples
install:
dune install
uninstall:
dune uninstall
doc:
dune build @doc
clean:
rm -rf _build *.install

152
unikernel/duniverse/angstrom/README.md Normal file
View file

@ -0,0 +1,152 @@
# Angstrom
Angstrom is a parser-combinator library that makes it easy to write efficient,
expressive, and reusable parsers suitable for high-performance applications. It
exposes monadic and applicative interfaces for composition, and supports
incremental input through buffered and unbuffered interfaces. Both interfaces
give the user total control over the blocking behavior of their application,
with the unbuffered interface enabling zero-copy IO. Parsers are backtracking
by default and support unbounded lookahead.
[![Build Status](https://github.com/inhabitedtype/angstrom/workflows/build/badge.svg)](https://github.com/inhabitedtype/angstrom/actions?query=workflow%3A%22build%22)
## Installation
Install the library and its dependencies via [OPAM][opam]:
[opam]: http://opam.ocaml.org/
```bash
opam install angstrom
```
## Usage
Angstrom is written with network protocols and serialization formats in mind.
As such, its source distribution includes implementations of various RFCs that
are illustrative of real-world applications of the library. These include an
[HTTP parser][http] and a [JSON parser][json].
[http]: https://github.com/inhabitedtype/angstrom/blob/master/examples/rFC2616.ml
[json]: https://github.com/inhabitedtype/angstrom/blob/master/examples/rFC7159.ml
In addition, it is an informal tradition for OCaml parser-combinator libraries
to include in their READMEs a parser for a simple arithmetic expression
language. The code below implements a parser for such a language and computes
the numerical result of the expression as it is being parsed. Because Angstrom
is written with network protocols and serialization libraries in mind, it does
not include combinators for creating infix expression parsers. Such
combinators, e.g., `chainl1`, are nevertheless simple to define.
```ocaml
open Angstrom
let parens p = char '(' *> p <* char ')'
let add = char '+' *> return (+)
let sub = char '-' *> return (-)
let mul = char '*' *> return ( * )
let div = char '/' *> return (/)
let integer =
take_while1 (function '0' .. '9' -> true | _ -> false) >>| int_of_string
let chainl1 e op =
let rec go acc =
(lift2 (fun f x -> f acc x) op e >>= go) <|> return acc in
e >>= fun init -> go init
let expr : int t =
fix (fun expr ->
let factor = parens expr <|> integer in
let term = chainl1 factor (mul <|> div) in
chainl1 term (add <|> sub))
let eval (str:string) : int =
match parse_string ~consume:All expr str with
| Ok v -> v
| Error msg -> failwith msg
```
For an explanation of the infix operators and other combinators used in the
implementation of this example, see the documentation in the [`mli`][mli].
[mli]: https://github.com/inhabitedtype/angstrom/blob/master/lib/angstrom.mli
## Comparison to Other Libraries
There are several other parser-combinator libraries available for OCaml that
may suit your needs, and are worth considering. Most of them are derivatives of
or inspired by [Parsec][]. As such, they require the use of a `try` combinator
to achieve backtracking, rather than providing it by default. They also all use
something akin to a lazy character stream as the underlying input abstraction.
While this suits Haskell quite nicely, it requires blocking read calls when the
entire input is not immediately available&mdash;an approach that is inherently
incompatible with monadic concurrency libraries such as [Async] and [Lwt], and
writing high-performance, concurrent applications in general. Another
consequence of this approach to modeling and retrieving input is that the
parsers cannot iterate over sections of input in a tight loop, which adversely
affects performance.
Below is a table that compares the features of Angstrom against the those of
other parser-combinator libraries.
[parsec]: https://hackage.haskell.org/package/parsec
[async]: https://github.com/janestreet/async
[lwt]: https://ocsigen.org/lwt/
Feature \ Library | Angstrom | [mparser] | [planck] | [opal] |
------------------------------------|:--------:|:---------:|:--------:|:------:|
Monadic interface | ✅ | ✅ | ✅ | ✅ |
Backtracking by default | ✅ | ❌ | ❌ | ❌ |
Unbounded lookahead | ✅ | ✅ | ✅ | ❌ |
Reports line numbers in errors | ❌ | ✅ | ❌ | ❌ |
Efficient `take_while`/`skip_while` | ✅ | ❌ | ❌ | ❌ |
Unbuffered (zero-copy) interface | ✅ | ❌ | ❌ | ❌ |
Non-blocking incremental interface | ✅ | ❌ | ❌ | ❌ |
Async Support | ✅ | ❌ | ❌ | ❌ |
Lwt Support | ✅ | ❌ | ❌ | ❌ |
[mparser]: https://github.com/cakeplus/mparser
[opal]: https://github.com/pyrocat101/opal
[planck]: https://bitbucket.org/camlspotter/planck
## Development
To install development dependencies, pin the package from the root of the
repository:
```bash
opam pin add -n angstrom .
opam install --deps-only angstrom
```
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:
```bash
opam install alcotest
make test
```
## Acknowledgements
This library started off as a direct port of the inimitable [attoparsec][]
library. While the original approach of continuation-passing still survives in
the source code, several modifications have been made in order to adapt the
ideas to OCaml, and in the process allow for more efficient memory usage and
integration with monadic concurrency libraries. This library will undoubtedly
diverge further as time goes on, but its name will stand as an homage to its
origin.
[attoparsec]: https://github.com/bos/attoparsec
## License
BSD3, see LICENSE file for its text.

20
unikernel/duniverse/angstrom/angstrom-async.opam Normal file
View file

@ -0,0 +1,20 @@
version: "0.16.1"
opam-version: "2.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"
dev-repo: "git+https://github.com/inhabitedtype/angstrom.git"
build: [
["dune" "subst"] {dev}
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]
depends: [
"ocaml" {>= "4.04.1"}
"dune" {>= "1.8"}
"angstrom" {>= "0.9.0"}
"async" {>= "v0.10.0"}
]
synopsis: "Async support for Angstrom"

21
unikernel/duniverse/angstrom/angstrom-lwt-unix.opam Normal file
View file

@ -0,0 +1,21 @@
version: "0.16.1"
opam-version: "2.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"
dev-repo: "git+https://github.com/inhabitedtype/angstrom.git"
build: [
["dune" "subst"] {dev}
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]
depends: [
"ocaml" {>= "4.03.0"}
"dune" {>= "1.8"}
"angstrom"
"lwt"
"base-unix"
]
synopsis: "Lwt_unix support for Angstrom"

20
unikernel/duniverse/angstrom/angstrom-unix.opam Normal file
View file

@ -0,0 +1,20 @@
version: "0.16.1"
opam-version: "2.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"
dev-repo: "git+https://github.com/inhabitedtype/angstrom.git"
build: [
["dune" "subst"] {dev}
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]
depends: [
"ocaml" {>= "4.03.0"}
"dune" {>= "1.8"}
"angstrom"
"base-unix"
]
synopsis: "Unix support for Angstrom"

30
unikernel/duniverse/angstrom/angstrom.opam Normal file
View file

@ -0,0 +1,30 @@
version: "0.16.1"
opam-version: "2.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"
dev-repo: "git+https://github.com/inhabitedtype/angstrom.git"
build: [
["dune" "subst"] {dev}
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]
depends: [
"ocaml" {>= "4.04.0"}
"dune" {>= "1.8"}
"alcotest" {with-test & >= "0.8.1"}
"bigstringaf"
"ppx_let" {with-test & >= "v0.14.0"}
"ocaml-syntax-shims" {build}
]
synopsis: "Parser combinators built for speed and memory-efficiency"
description: """
Angstrom is a parser-combinator library that makes it easy to write efficient,
expressive, and reusable parsers suitable for high-performance applications. It
exposes monadic and applicative interfaces for composition, and supports
incremental input through buffered and unbuffered interfaces. Both interfaces
give the user total control over the blocking behavior of their application,
with the unbuffered interface enabling zero-copy IO. Parsers are backtracking by
default and support unbounded lookahead."""

85
unikernel/duniverse/angstrom/async/angstrom_async.ml Normal file
View file

@ -0,0 +1,85 @@
(*----------------------------------------------------------------------------
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.
----------------------------------------------------------------------------*)
open Angstrom.Unbuffered
open Core
open Async
let empty_bigstring = Bigstring.create 0
let rec finalize state result =
(* It is very important to understand the assumptions that go into the second
* case. If execution reaches that case, then that means that the parser has
* commited all the way up to the last byte that was read by the reader, and
* the reader's internal buffer is empty. If the parser hadn't committed up
* to the last byte, then the reader buffer would not be empty and execution
* would hit the first case rather than the second.
*
* In other words, the second case looks wrong but it's not. *)
match state, result with
| Partial p, `Eof_with_unconsumed_data s ->
let bigstring = Bigstring.of_string s in
finalize (p.continue bigstring ~off:0 ~len:(String.length s) Complete) `Eof
| Partial p, `Eof ->
finalize (p.continue empty_bigstring ~off:0 ~len:0 Complete) `Eof
| Partial _, `Stopped () -> assert false
| (Done _ | Fail _) , _ -> state_to_result state
let response = function
| Partial p -> `Consumed(p.committed, `Need_unknown)
| Done(c, _) -> `Stop_consumed((), c)
| Fail _ -> `Stop ()
let default_pushback () = Deferred.unit
let parse ?(pushback=default_pushback) p reader =
let state = ref (parse p) in
let handle_chunk buf ~pos ~len =
begin match !state with
| Partial p ->
state := p.continue buf ~off:pos ~len Incomplete;
| Done _ | Fail _ -> ()
end;
pushback () >>| fun () -> response !state
in
Reader.read_one_chunk_at_a_time reader ~handle_chunk >>| fun result ->
finalize !state result
let async_many e k =
Angstrom.(skip_many (e <* commit >>| k) <?> "async_many")
let parse_many p write reader =
let wait = ref (default_pushback ()) in
let k x = wait := write x in
let pushback () = !wait in
parse ~pushback (async_many p k) reader

48
unikernel/duniverse/angstrom/async/angstrom_async.mli Normal file
View file

@ -0,0 +1,48 @@
(*----------------------------------------------------------------------------
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.
----------------------------------------------------------------------------*)
open Angstrom
open Async
val parse :
?pushback:(unit -> unit Deferred.t)
-> 'a t
-> Reader.t
-> ('a, string) result Deferred.t
val parse_many :
'a t
-> ('a -> unit Deferred.t)
-> Reader.t
-> (unit, string) result Deferred.t

5
unikernel/duniverse/angstrom/async/dune Normal file
View file

@ -0,0 +1,5 @@
(library
(name angstrom_async)
(public_name angstrom-async)
(flags :standard -safe-string)
(libraries angstrom async))

20
unikernel/duniverse/angstrom/benchmarks/async_benchmark.ml Normal file
View file

@ -0,0 +1,20 @@
open Async
let main parser () =
let toss _ = Deferred.unit in
let reader = Lazy.force Reader.stdin in
let parser =
match parser with
| `Http -> Angstrom.(RFC2616.request >>| fun x -> `Http x)
| `Json -> Angstrom.(RFC7159.json >>| fun x -> `Json x)
in
Angstrom_async.parse_many parser toss reader
>>| function
| Ok () -> ()
| Error err -> failwith err
;;
let () =
let parser = Command.Arg_type.of_alist_exn ["http", `Http; "json", `Json] in
Command.(async_spec ~summary:"async benchmark"
Spec.(empty +> Param.(anon ("PARSER" %: parser))) main |> run)

2
unikernel/duniverse/angstrom/benchmarks/data/ACKNOWLEDGEMENTS Normal file
View file

@ -0,0 +1,2 @@
Several of the data files in this directory were taken from the attoparsec
repository on GitHub. The source of twitter.json has been forgotten.

494
unikernel/duniverse/angstrom/benchmarks/data/http-requests.txt Normal file
View file

@ -0,0 +1,494 @@
GET / HTTP/1.1
Host: www.reddit.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
GET /reddit.v_EZwRzV-Ns.css HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/css,*/*;q=0.1
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /reddit-init.en-us.O1zuMqOOQvY.js HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /reddit.en-us.31yAfSoTsfo.js HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /kill.png HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /icon.png HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
GET /favicon.ico HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
GET /AMZM4CWd6zstSC8y.jpg HTTP/1.1
Host: b.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /jz1d5Nm0w97-YyNm.jpg HTTP/1.1
Host: b.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /aWGO99I6yOcNUKXB.jpg HTTP/1.1
Host: a.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /rZ_rD5TjrJM0E9Aj.css HTTP/1.1
Host: e.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/css,*/*;q=0.1
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /tmsPwagFzyTvrGRx.jpg HTTP/1.1
Host: a.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /KYgUaLvXCK3TCEJx.jpg HTTP/1.1
Host: a.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /81pzxT5x2ozuEaxX.jpg HTTP/1.1
Host: e.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /MFqCUiUVPO5V8t6x.jpg HTTP/1.1
Host: a.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /TFpYTiAO5aEowokv.jpg HTTP/1.1
Host: e.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /eMWMpmm9APNeNqcF.jpg HTTP/1.1
Host: e.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /S-IpsJrOKuaK9GZ8.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /3V6dj9PDsNnheDXn.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /wQ3-VmNXhv8sg4SJ.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /ixd1C1njpczEWC22.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /nGsQj15VyOHMwmq8.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /zT4yQmDxQLbIxK1b.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /L5e1HcZLv1iu4nrG.jpg HTTP/1.1
Host: f.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /WJFFPxD8X4JO_lIG.jpg HTTP/1.1
Host: f.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /hVMVTDdjuY3bQox5.jpg HTTP/1.1
Host: f.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /rnWf8CjBcyPQs5y_.jpg HTTP/1.1
Host: f.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /gZJL1jNylKbGV4d-.jpg HTTP/1.1
Host: d.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /aNd2zNRLXiMnKUFh.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /droparrowgray.gif HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css
GET /sprite-reddit.an0Lnf61Ap4.png HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css
GET /ga.js HTTP/1.1
Host: www.google-analytics.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
If-Modified-Since: Tue, 29 Oct 2013 19:33:51 GMT
GET /reddit/ads.html?sr=-reddit.com&bust2 HTTP/1.1
Host: static.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /pixel/of_destiny.png?v=hOlmDALJCWWdjzfBV4ZxJPmrdCLWB%2Ftq7Z%2Ffp4Q%2FxXbVPPREuMJMVGzKraTuhhNWxCCwi6yFEZg%3D&r=783333388 HTTP/1.1
Host: pixel.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /UNcO-h_QcS9PD-Gn.jpg HTTP/1.1
Host: c.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://e.thumbs.redditmedia.com/rZ_rD5TjrJM0E9Aj.css
GET /welcome-lines.png HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css
GET /welcome-upvote.png HTTP/1.1
Host: www.redditstatic.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css
GET /__utm.gif?utmwv=5.5.1&utms=1&utmn=720496082&utmhn=www.reddit.com&utme=8(site*srpath*usertype*uitype)9(%20reddit.com*%20reddit.com-GET_listing*guest*web)11(3!2)&utmcs=UTF-8&utmsr=2560x1600&utmvp=1288x792&utmsc=24-bit&utmul=en-us&utmje=1&utmfl=13.0%20r0&utmdt=reddit%3A%20the%20front%20page%20of%20the%20internet&utmhid=2129416330&utmr=-&utmp=%2F&utmht=1400862512705&utmac=UA-12131688-1&utmcc=__utma%3D55650728.585571751.1400862513.1400862513.1400862513.1%3B%2B__utmz%3D55650728.1400862513.1.1.utmcsr%3D(direct)%7Cutmccn%3D(direct)%7Cutmcmd%3D(none)%3B&utmu=qR~ HTTP/1.1
Host: www.google-analytics.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /ImnpOQhbXUPkwceN.png HTTP/1.1
Host: a.thumbs.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /ajax/libs/jquery/1.7.1/jquery.min.js HTTP/1.1
Host: ajax.googleapis.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
GET /__utm.gif?utmwv=5.5.1&utms=2&utmn=1493472678&utmhn=www.reddit.com&utmt=event&utme=5(AdBlock*enabled*false)(0)8(site*srpath*usertype*uitype)9(%20reddit.com*%20reddit.com-GET_listing*guest*web)11(3!2)&utmcs=UTF-8&utmsr=2560x1600&utmvp=1288x792&utmsc=24-bit&utmul=en-us&utmje=1&utmfl=13.0%20r0&utmdt=reddit%3A%20the%20front%20page%20of%20the%20internet&utmhid=2129416330&utmr=-&utmp=%2F&utmht=1400862512708&utmac=UA-12131688-1&utmni=1&utmcc=__utma%3D55650728.585571751.1400862513.1400862513.1400862513.1%3B%2B__utmz%3D55650728.1400862513.1.1.utmcsr%3D(direct)%7Cutmccn%3D(direct)%7Cutmcmd%3D(none)%3B&utmu=6R~ HTTP/1.1
Host: www.google-analytics.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /ados.js?q=43 HTTP/1.1
Host: secure.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
GET /fetch-trackers?callback=jQuery111005268222517967478_1400862512407&ids%5B%5D=t3_25jzeq-t8_k2ii&_=1400862512408 HTTP/1.1
Host: tracker.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /ados?t=1400862512892&request={%22Placements%22:[{%22A%22:5146,%22S%22:24950,%22D%22:%22main%22,%22AT%22:5},{%22A%22:5146,%22S%22:24950,%22D%22:%22sponsorship%22,%22AT%22:8}],%22Keywords%22:%22-reddit.com%22,%22Referrer%22:%22http%3A%2F%2Fwww.reddit.com%2F%22,%22IsAsync%22:true,%22WriteResults%22:true} HTTP/1.1
Host: engine.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
GET /pixel/of_doom.png?id=t3_25jzeq-t8_k2ii&hash=da31d967485cdbd459ce1e9a5dde279fef7fc381&r=1738649500 HTTP/1.1
Host: pixel.redditmedia.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /Extensions/adFeedback.js HTTP/1.1
Host: static.adzrk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: */*
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
GET /Extensions/adFeedback.css HTTP/1.1
Host: static.adzrk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/css,*/*;q=0.1
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
GET /reddit/ads-load.html?bust2 HTTP/1.1
Host: static.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://www.reddit.com/
GET /Advertisers/a774d7d6148046efa89403a8db635a81.jpg HTTP/1.1
Host: static.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
GET /i.gif?e=eyJhdiI6NjIzNTcsImF0Ijo1LCJjbSI6MTE2MzUxLCJjaCI6Nzk4NCwiY3IiOjMzNzAxNSwiZGkiOiI4NmI2Y2UzYWM5NDM0MjhkOTk2ZTg4MjYwZDE5ZTE1YyIsImRtIjoxLCJmYyI6NDE2MTI4LCJmbCI6MjEwNDY0LCJrdyI6Ii1yZWRkaXQuY29tIiwibWsiOiItcmVkZGl0LmNvbSIsIm53Ijo1MTQ2LCJwYyI6MCwicHIiOjIwMzYyLCJydCI6MSwicmYiOiJodHRwOi8vd3d3LnJlZGRpdC5jb20vIiwic3QiOjI0OTUwLCJ1ayI6InVlMS01ZWIwOGFlZWQ5YTc0MDFjOTE5NWNiOTMzZWI3Yzk2NiIsInRzIjoxNDAwODYyNTkzNjQ1fQ&s=lwlbFf2Uywt7zVBFRj_qXXu7msY HTTP/1.1
Host: engine.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
Cookie: azk=ue1-5eb08aeed9a7401c9195cb933eb7c966
GET /BurstingPipe/adServer.bs?cn=tf&c=19&mc=imp&pli=9994987&PluID=0&ord=1400862593644&rtu=-1 HTTP/1.1
Host: bs.serving-sys.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2
GET /Advertisers/63cfd0044ffd49c0a71a6626f7a1d8f0.jpg HTTP/1.1
Host: static.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads-load.html?bust2
GET /BurstingPipe/adServer.bs?cn=tf&c=19&mc=imp&pli=9962555&PluID=0&ord=1400862593645&rtu=-1 HTTP/1.1
Host: bs.serving-sys.com
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads-load.html?bust2
Cookie: S_9994987=6754579095859875029; A4=01fmFvgRnI09SF00000; u2=d1263d39-874b-4a89-86cd-a2ab0860ed4e3Zl040
GET /i.gif?e=eyJhdiI6NjIzNTcsImF0Ijo4LCJjbSI6MTE2MzUxLCJjaCI6Nzk4NCwiY3IiOjMzNzAxOCwiZGkiOiI3OTdlZjU3OWQ5NjE0ODdiODYyMGMyMGJkOTE4YzNiMSIsImRtIjoxLCJmYyI6NDE2MTMxLCJmbCI6MjEwNDY0LCJrdyI6Ii1yZWRkaXQuY29tIiwibWsiOiItcmVkZGl0LmNvbSIsIm53Ijo1MTQ2LCJwYyI6MCwicHIiOjIwMzYyLCJydCI6MSwicmYiOiJodHRwOi8vd3d3LnJlZGRpdC5jb20vIiwic3QiOjI0OTUwLCJ1ayI6InVlMS01ZWIwOGFlZWQ5YTc0MDFjOTE5NWNiOTMzZWI3Yzk2NiIsInRzIjoxNDAwODYyNTkzNjQ2fQ&s=OjzxzXAgQksbdQOHNm-bjZcnZPA HTTP/1.1
Host: engine.adzerk.net
User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1
Accept: image/png,image/*;q=0.8,*/*;q=0.5
Accept-Language: en-us,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
Referer: http://static.adzerk.net/reddit/ads-load.html?bust2
Cookie: azk=ue1-5eb08aeed9a7401c9195cb933eb7c966
GET /subscribe?host_int=1042356184&ns_map=571794054_374233948806,464381511_13349283399&user_id=245722467&nid=1399334269710011966&ts=1400862514 HTTP/1.1
Host: notify8.dropbox.com
Accept-Encoding: identity
Connection: keep-alive
X-Dropbox-Locale: en_US
User-Agent: DropboxDesktopClient/2.7.54 (Macintosh; 10.8; ('i32',); en_US)

6
unikernel/duniverse/angstrom/benchmarks/data/replicate Executable file
View file

@ -0,0 +1,6 @@
#!/usr/bin/env bash
# `replicate f n` creates a new file called `f.n` containing n copies of f.
for i in `seq 1 $2`; do
cat $1 >> $1.$2
done

15482
unikernel/duniverse/angstrom/benchmarks/data/twitter.json Normal file
View file

File diff suppressed because it is too large Load diff

1
unikernel/duniverse/angstrom/benchmarks/data/twitter1.json Normal file
View file

@ -0,0 +1 @@
{"results":[{"from_user_id_str":"80430860","profile_image_url":"http://a2.twimg.com/profile_images/536455139/icon32_normal.png","created_at":"Wed, 26 Jan 2011 07:07:02 +0000","from_user":"kazu_yamamoto","id_str":"30159761706061824","metadata":{"result_type":"recent"},"to_user_id":null,"text":"Haskell Server Pages \u3063\u3066\u3001\u307e\u3060\u7d9a\u3044\u3066\u3044\u305f\u306e\u304b\uff01","id":30159761706061824,"from_user_id":80430860,"geo":null,"iso_language_code":"no","to_user_id_str":null,"source":"&lt;a href=&quot;http://twitter.com/&quot;&gt;web&lt;/a&gt;"}],"max_id":30159761706061824,"since_id":0,"refresh_url":"?since_id=30159761706061824&q=haskell","next_page":"?page=2&max_id=30159761706061824&rpp=1&q=haskell","results_per_page":1,"page":1,"completed_in":0.012606,"since_id_str":"0","max_id_str":"30159761706061824","query":"haskell"}

1
unikernel/duniverse/angstrom/benchmarks/data/twitter10.json Normal file
View file

File diff suppressed because one or more lines are too long

1
unikernel/duniverse/angstrom/benchmarks/data/twitter20.json Normal file
View file

File diff suppressed because one or more lines are too long

14
unikernel/duniverse/angstrom/benchmarks/dune Normal file
View file

@ -0,0 +1,14 @@
(executables
(libraries angstrom core_bench threads RFC2616 RFC7159)
(modules pure_benchmark)
(names pure_benchmark))
(executables
(libraries angstrom-async RFC2616 RFC7159)
(modules async_benchmark)
(names async_benchmark))
(executables
(libraries angstrom-lwt-unix RFC2616 RFC7159)
(modules lwt_benchmark)
(names lwt_benchmark))

18
unikernel/duniverse/angstrom/benchmarks/lwt_benchmark.ml Normal file
View file

@ -0,0 +1,18 @@
open Lwt
let main () =
let toss _ = Lwt.return_unit in
let parser =
match Sys.argv.(1) with
| "http" -> Angstrom.(RFC2616.request >>| fun x -> `Http x)
| "json" -> Angstrom.(RFC7159.json >>| fun x -> `Json x)
| _ -> print_endline "usage: lwt_json_benchmark.native PARSER"; exit 1
in
Lwt_io.resize_buffer Lwt_io.stdin 0x10000 >>= fun () ->
Angstrom_lwt_unix.parse_many parser toss Lwt_io.stdin
>|= function
| _, Ok () -> ()
| _, Error err -> failwith err
;;
Lwt_main.run (main ())

125
unikernel/duniverse/angstrom/benchmarks/pure_benchmark.ml Normal file
View file

@ -0,0 +1,125 @@
open Core
open Core_bench
let read file =
let open Unix in
let size = Int64.to_int_exn (stat file).st_size in
let buf = Bytes.create size in
let rec loop pos len fd =
let n = read ~pos ~len ~buf fd in
if n > 0 then loop (pos + n) (len - n) fd
in
with_file ~mode:[O_RDONLY] file ~f:(fun fd ->
loop 0 size fd);
Bigstring.of_bytes buf
;;
let zero =
let len = 65_536 in
Bigstring.of_string (String.make len '\x00')
;;
let make_bench name parser contents =
Bench.Test.create ~name (fun () ->
match Angstrom.(parse_bigstring ~consume:Consume.Prefix parser contents) with
| Ok _ -> ()
| Error err -> failwith err)
;;
let make_endian name p = make_bench name (Angstrom.skip_many p) zero
let make_json name contents = make_bench name RFC7159.json contents
let make_http name contents = make_bench name (Angstrom.skip_many RFC2616.request) contents
(* For input files involving trailing numbers, .e.g, [http-requests.txt.100],
* go into the [benchmarks/data] directory and use the [replicate] script to
* generate the file, i.e.,
*
* [./replicate http-requests.txt 100]
*
*)
let main () =
let twitter1 = read "benchmarks/data/twitter1.json" in
let twitter10 = read "benchmarks/data/twitter10.json" in
let twitter20 = read "benchmarks/data/twitter20.json" in
let twitter_big = read "benchmarks/data/twitter.json" in
let http_get = read "benchmarks/data/http-requests.txt.100" in
let json =
Bench.make_command [
make_json "twitter1" twitter1;
make_json "twitter10" twitter10;
make_json "twitter20" twitter20;
make_json "twitter-big" twitter_big;
]
in
let endian =
Bench.make_command [
make_endian "int64 le" Angstrom.LE.any_int64;
make_endian "int64 be" Angstrom.BE.any_int64;
]
in
let http =
Bench.make_command [ make_http "http" http_get ]
in
let numbers =
Bench.make_command [
Bench.Test.create ~name:"float" (fun () ->
float_of_string "1.7242915150166418e+36");
Bench.Test.create ~name:"int" (fun () ->
int_of_string "172429151501664");
Bench.Test.create ~name:"int-float" (fun () ->
float_of_string "172429151501664");
]
in
let characters =
let contents = Bigstring.of_string "a" in
let open Angstrom in
Bench.make_command [
make_bench "peek_char_fail" peek_char_fail contents;
make_bench "any_char" any_char contents;
make_bench "char" (char 'a') contents;
make_bench "not_char" (not_char 'b') contents;
make_bench "advance 1" (advance 1) contents;
]
in
let loops =
let contents = Bigstring.of_string (String.make 1024 'a') in
let open Angstrom in
Bench.make_command [
make_bench "skip_while true" (skip_while (fun _ -> true)) contents;
make_bench "take_while true" (take_while (fun _ -> true)) contents;
make_bench "take_while1 true" (take_while1 (fun _ -> true)) contents;
make_bench "many any_char " (many any_char) contents;
]
in
let short_strings =
let contents = Bigstring.of_string "\r\n\r\n\r\n" in
let old_style_be (n : int) =
Angstrom.(BE.any_int16 >>= fun i -> if i = n then return () else fail "not newline") in
Bench.make_command [
make_bench "string \"\\r\\n\"" (Angstrom.string "\r\n") contents;
make_bench "BE.any_int16 >>= f" (old_style_be 0x0d0a) contents;
make_bench "BE.int16 0x0d0a" (Angstrom.BE.int16 0x0d0a) contents;
make_bench "LE.int16 0x0a0d" (Angstrom.LE.int16 0x0a0d) contents;
]
in
let http_version =
let contents = Bigstring.of_string "HTTP/" in
Bench.make_command [
make_bench "string \"HTTP/\"" (Angstrom.string "HTTP/") contents;
make_bench "BE.int32 *> char" (Angstrom.(BE.int32 0x48545450l *> char '/')) contents;
make_bench "LE.int32 *> char" (Angstrom.(LE.int32 0x50545448l *> char '/')) contents;
]
in
Command.run
(Command.group ~summary:"various angstrom benchmarks"
[ "json" , json
; "endian" , endian
; "http" , http
; "numbers" , numbers
; "characters" , characters
; "loops" , loops
; "short-strings", short_strings
; "http-version" , http_version
])
let () = main ()

2
unikernel/duniverse/angstrom/dune-project Normal file
View file

@ -0,0 +1,2 @@
(lang dune 1.8)
(name angstrom)

16
unikernel/duniverse/angstrom/examples/dune Normal file
View file

@ -0,0 +1,16 @@
(library
(name RFC7159)
(wrapped false)
(modules RFC7159)
(libraries angstrom))
(library
(name RFC2616)
(wrapped false)
(modules RFC2616)
(libraries angstrom))
;; Build bytecode library just to make sure this compiles
(alias
(name examples)
(deps RFC7159.cma RFC2616.cma))

76
unikernel/duniverse/angstrom/examples/rFC2616.ml Normal file
View file

@ -0,0 +1,76 @@
open Angstrom
module P = struct
let is_space =
function | ' ' | '\t' -> true | _ -> false
let is_eol =
function | '\r' | '\n' -> true | _ -> false
let is_hex =
function | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true | _ -> false
let is_digit =
function '0' .. '9' -> true | _ -> false
let is_separator =
function
| ')' | '(' | '<' | '>' | '@' | ',' | ';' | ':' | '\\' | '"'
| '/' | '[' | ']' | '?' | '=' | '{' | '}' | ' ' | '\t' -> true
| _ -> false
let is_token =
(* The commented-out ' ' and '\t' are not necessary because of the range at
* the top of the match. *)
function
| '\000' .. '\031' | '\127'
| ')' | '(' | '<' | '>' | '@' | ',' | ';' | ':' | '\\' | '"'
| '/' | '[' | ']' | '?' | '=' | '{' | '}' (* | ' ' | '\t' *) -> false
| _ -> true
end
let token = take_while1 P.is_token
let digits = take_while1 P.is_digit
let spaces = skip_while P.is_space
let lex p = p <* spaces
let version =
string "HTTP/" *>
lift2 (fun major minor -> major, minor)
(digits <* char '.')
digits
let uri =
take_till P.is_space
let meth = token
let eol = string "\r\n"
let request_first_line =
lift3 (fun meth uri version -> (meth, uri, version))
(lex meth)
(lex uri)
version
let response_first_line =
lift3 (fun version status msg -> (version, status, msg))
(lex version)
(lex (take_till P.is_space))
(take_till P.is_eol)
let header =
let colon = char ':' <* spaces in
lift2 (fun key value -> (key, value))
token
(colon *> take_till P.is_eol)
let request =
lift2 (fun (meth, uri, version) headers -> (meth, uri, version, headers))
(request_first_line <* eol)
(many (header <* eol) <* eol)
let response =
lift2 (fun (version, status, msg) headers -> (version, status, msg, headers))
(response_first_line <* eol)
(many (header <* eol) <* eol)

169
unikernel/duniverse/angstrom/examples/rFC7159.ml Normal file
View file

@ -0,0 +1,169 @@
open Angstrom
type json =
[ `Null
| `False
| `True
| `String of string
| `Number of float
| `Object of (string * json) list
| `Array of json list ]
let ws = skip_while (function
| '\x20' | '\x0a' | '\x0d' | '\x09' -> true
| _ -> false)
let lchar c =
ws *> char c
let rsb = lchar ']'
let rcb = lchar '}'
let ns, vs = lchar ':', lchar ','
let quo = lchar '"'
let _false : json t = string "false" *> return `False
let _true : json t = string "true" *> return `True
let _null : json t = string "null" *> return `Null
let num =
take_while1 (function
| '\x20' | '\x0a' | '\x0d' | '\x09'
| '[' | ']' | '{' | '}' | ':' | ',' -> false
| _ -> true)
>>= fun s ->
try return (`Number (float_of_string s))
with _ -> fail "number"
module S = struct
type t =
[ `Unescaped
| `Escaped
| `UTF8 of char list
| `UTF16 of int * [`S | `U | `C of char list]
| `Error of string
| `Done ]
let to_string : [`Terminate | t] -> string = function
| `Unescaped -> "unescaped"
| `Escaped -> "escaped"
| `UTF8 _ -> "utf-8 _"
| `UTF16 _ -> "utf-16 _ _"
| `Error e -> Printf.sprintf "error %S" e
| `Terminate -> "terminate"
| `Done -> "done"
let unescaped buf = function
| '"' -> `Terminate
| '\\' -> `Escaped
| c ->
if c <= '\031'
then `Error (Printf.sprintf "unexpected character '%c'" c)
else begin Buffer.add_char buf c; `Unescaped end
let escaped buf = function
| '\x22' -> Buffer.add_char buf '\x22'; `Unescaped
| '\x5c' -> Buffer.add_char buf '\x5c'; `Unescaped
| '\x2f' -> Buffer.add_char buf '\x2f'; `Unescaped
| '\x62' -> Buffer.add_char buf '\x08'; `Unescaped
| '\x66' -> Buffer.add_char buf '\x0c'; `Unescaped
| '\x6e' -> Buffer.add_char buf '\x0a'; `Unescaped
| '\x72' -> Buffer.add_char buf '\x0d'; `Unescaped
| '\x74' -> Buffer.add_char buf '\x09'; `Unescaped
| '\x75' -> `UTF8 []
| _ -> `Error "invalid escape sequence"
let hex c =
match c with
| '0' .. '9' -> Char.code c - 0x30 (* '0' *)
| 'a' .. 'f' -> Char.code c - 87
| 'A' .. 'F' -> Char.code c - 55
| _ -> 255
let utf_8 buf d = function
| [c;b;a] ->
let a = hex a and b = hex b and c = hex c and d = hex d in
if a lor b lor c lor d = 255 then
`Error "invalid hex escape"
else
let cp = (a lsl 12) lor (b lsl 8) lor (c lsl 4) lor d in
if cp >= 0xd800 && cp <= 0xdbff then
`UTF16(cp, `S)
else begin
Buffer.add_char buf (Char.unsafe_chr (0b11100000 lor ((cp lsr 12) land 0b00001111)));
Buffer.add_char buf (Char.unsafe_chr (0b10000000 lor ((cp lsr 6) land 0b00111111)));
Buffer.add_char buf (Char.unsafe_chr (0b10000000 lor (cp land 0b00111111)));
`Unescaped
end
| cs -> `UTF8 (d::cs)
let utf_16 buf d x s =
match s, d with
| `S , '\\' -> `UTF16(x, `U)
| `U , 'u' -> `UTF16(x, `C [])
| `C [c;b;a], _ ->
let a = hex a and b = hex b and c = hex c and d = hex d in
if a lor b lor c lor d = 255 then
`Error "invalid hex escape"
else
let y = (a lsl 12) lor (b lsl 8) lor (c lsl 4) lor d in
if y >= 0xdc00 && y <= 0xdfff then begin
let hi = x - 0xd800 in
let lo = y - 0xdc00 in
let cp = 0x10000 + ((hi lsl 10) lor lo) in
Buffer.add_char buf (Char.unsafe_chr (0b11110000 lor ((cp lsr 18) land 0b00000111)));
Buffer.add_char buf (Char.unsafe_chr (0b10000000 lor ((cp lsr 12) land 0b00111111)));
Buffer.add_char buf (Char.unsafe_chr (0b10000000 lor ((cp lsr 6) land 0b00111111)));
Buffer.add_char buf (Char.unsafe_chr (0b10000000 lor (cp land 0b00111111)));
`Unescaped
end else
`Error "invalid escape sequence for utf-16 low surrogate"
| `C cs, _ -> `UTF16(x, `C (d::cs))
| _, _ -> `Error "invalid escape sequence for utf-16 low surrogate"
let str buf =
let state : t ref = ref `Unescaped in
skip_while (fun c ->
match
begin match !state with
| `Unescaped -> unescaped buf c
| `Escaped -> escaped buf c
| `UTF8 cs -> utf_8 buf c cs
| `UTF16(x, cs) -> utf_16 buf c x cs
| (`Error _ | `Done) as state -> state
end
with
| (`Error _) | `Done -> false
| `Terminate -> state := `Done; true
| #t as state' -> state := state'; true)
>>= fun () ->
match !state with
| `Done ->
let result = Buffer.contents buf in
Buffer.clear buf;
state := `Unescaped;
return result
| `Error msg ->
Buffer.clear buf; state := `Unescaped; fail msg
| `Unescaped | `Escaped | `UTF8 _ | `UTF16 _ ->
Buffer.clear buf; state := `Unescaped; fail "unterminated string"
end
let json =
let advance1 = advance 1 in
let pair x y = (x, y) in
let buf = Buffer.create 0x1000 in
let str = S.str buf in
fix (fun json ->
let mem = lift2 pair (quo *> str <* ns) json in
let obj = advance1 *> sep_by vs mem <* rcb >>| fun ms -> `Object ms in
let arr = advance1 *> sep_by vs json <* rsb >>| fun vs -> `Array vs in
let str = advance1 *> str >>| fun s -> `String s in
ws *> peek_char_fail
>>= function
| 'f' -> _false
| 'n' -> _null
| 't' -> _true
| '{' -> obj
| '[' -> arr
| '"' -> str
| _ -> num) <?> "json"

749
unikernel/duniverse/angstrom/lib/angstrom.ml Normal file
View file

@ -0,0 +1,749 @@
(*----------------------------------------------------------------------------
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.
----------------------------------------------------------------------------*)
module Bigarray = struct
(* Do not access Bigarray operations directly. If anything's needed, refer to
* the internal Bigstring module. *)
end
type bigstring = Bigstringaf.t
module Unbuffered = struct
include Parser
include Exported_state
type more = More.t =
| Complete
| Incomplete
end
include Unbuffered
include Parser.Monad
include Parser.Choice
module Buffered = struct
type unconsumed = Buffering.unconsumed =
{ buf : bigstring
; off : int
; len : int }
type input =
[ `Bigstring of bigstring
| `String of string ]
type 'a state =
| Partial of ([ input | `Eof ] -> 'a state)
| Done of unconsumed * 'a
| Fail of unconsumed * string list * string
let from_unbuffered_state ~f buffering = function
| Unbuffered.Partial p -> Partial (f p)
| Unbuffered.Done(consumed, v) ->
let unconsumed = Buffering.unconsumed ~shift:consumed buffering in
Done(unconsumed, v)
| Unbuffered.Fail(consumed, marks, msg) ->
let unconsumed = Buffering.unconsumed ~shift:consumed buffering in
Fail(unconsumed, marks, msg)
let parse ?(initial_buffer_size=0x1000) p =
if initial_buffer_size < 1 then
failwith "parse: invalid argument, initial_buffer_size < 1";
let buffering = Buffering.create initial_buffer_size in
let rec f p input =
Buffering.shift buffering p.committed;
let more : More.t =
match input with
| `Eof -> Complete
| #input as input ->
Buffering.feed_input buffering input;
Incomplete
in
let for_reading = Buffering.for_reading buffering in
p.continue for_reading ~off:0 ~len:(Bigstringaf.length for_reading) more
|> from_unbuffered_state buffering ~f
in
Unbuffered.parse p
|> from_unbuffered_state buffering ~f
let feed state input =
match state with
| Partial k -> k input
| Fail(unconsumed, marks, msg) ->
begin match input with
| `Eof -> state
| #input as input ->
let buffering = Buffering.of_unconsumed unconsumed in
Buffering.feed_input buffering input;
Fail(Buffering.unconsumed buffering, marks, msg)
end
| Done(unconsumed, v) ->
begin match input with
| `Eof -> state
| #input as input ->
let buffering = Buffering.of_unconsumed unconsumed in
Buffering.feed_input buffering input;
Done(Buffering.unconsumed buffering, v)
end
let state_to_option = function
| Done(_, v) -> Some v
| Partial _ -> None
| Fail _ -> None
let state_to_result = function
| Partial _ -> Error "incomplete input"
| Done(_, v) -> Ok v
| Fail(_, marks, msg) -> Error (Unbuffered.fail_to_string marks msg)
let state_to_unconsumed = function
| Done(unconsumed, _)
| Fail(unconsumed, _, _) -> Some unconsumed
| Partial _ -> None
end
(** BEGIN: getting input *)
let rec prompt input pos fail succ =
(* [prompt] should only call [succ] if it has received more input. If there
* is no chance that the input will grow, i.e., [more = Complete], then
* [prompt] should call [fail]. Otherwise (in the case where the input
* hasn't grown but [more = Incomplete] just prompt again. *)
let parser_uncommitted_bytes = Input.parser_uncommitted_bytes input in
let parser_committed_bytes = Input.parser_committed_bytes input in
(* The continuation should not hold any references to input above. *)
let continue input ~off ~len more =
if len < parser_uncommitted_bytes then
failwith "prompt: input shrunk!";
let input = Input.create input ~off ~len ~committed_bytes:parser_committed_bytes in
if len = parser_uncommitted_bytes then
match (more : More.t) with
| Complete -> fail input pos More.Complete
| Incomplete -> prompt input pos fail succ
else
succ input pos more
in
State.Partial { committed = Input.bytes_for_client_to_commit input; continue }
let demand_input =
{ run = fun input pos more fail succ ->
match (more : More.t) with
| Complete -> fail input pos more [] "not enough input"
| Incomplete ->
let succ' input' pos' more' = succ input' pos' more' ()
and fail' input' pos' more' = fail input' pos' more' [] "not enough input" in
prompt input pos fail' succ'
}
let ensure_suspended n input pos more fail succ =
let rec go =
{ run = fun input' pos' more' fail' succ' ->
if pos' + n <= Input.length input' then
succ' input' pos' more' ()
else
(demand_input *> go).run input' pos' more' fail' succ'
}
in
(demand_input *> go).run input pos more fail succ
let unsafe_apply len ~f =
{ run = fun input pos more _fail succ ->
succ input (pos + len) more (Input.apply input pos len ~f)
}
let unsafe_apply_opt len ~f =
{ run = fun input pos more fail succ ->
match Input.apply input pos len ~f with
| Error e -> fail input pos more [] e
| Ok x -> succ input (pos + len) more x
}
let ensure n p =
{ run = fun input pos more fail succ ->
if pos + n <= Input.length input
then p.run input pos more fail succ
else
let succ' input' pos' more' () = p.run input' pos' more' fail succ in
ensure_suspended n input pos more fail succ' }
(** END: getting input *)
let at_end_of_input =
{ run = fun input pos more _ succ ->
if pos < Input.length input then
succ input pos more false
else match more with
| Complete -> succ input pos more true
| Incomplete ->
let succ' input' pos' more' = succ input' pos' more' false
and fail' input' pos' more' = succ input' pos' more' true in
prompt input pos fail' succ'
}
let end_of_input =
at_end_of_input
>>= function
| true -> return ()
| false -> fail "end_of_input"
let advance n =
if n < 0
then fail "advance"
else
let p =
{ run = fun input pos more _fail succ -> succ input (pos + n) more () }
in
ensure n p
let pos =
{ run = fun input pos more _fail succ -> succ input pos more pos }
let available =
{ run = fun input pos more _fail succ ->
succ input pos more (Input.length input - pos)
}
let commit =
{ run = fun input pos more _fail succ ->
Input.commit input pos;
succ input pos more () }
(* Do not use this if [p] contains a [commit]. *)
let unsafe_lookahead p =
{ run = fun input pos more fail succ ->
let succ' input' _ more' v = succ input' pos more' v in
p.run input pos more fail succ' }
let peek_char =
{ run = fun input pos more _fail succ ->
if pos < Input.length input then
succ input pos more (Some (Input.unsafe_get_char input pos))
else if more = Complete then
succ input pos more None
else
let succ' input' pos' more' =
succ input' pos' more' (Some (Input.unsafe_get_char input' pos'))
and fail' input' pos' more' =
succ input' pos' more' None in
prompt input pos fail' succ'
}
(* This parser is too important to not be optimized. Do a custom job. *)
let rec peek_char_fail =
{ run = fun input pos more fail succ ->
if pos < Input.length input
then succ input pos more (Input.unsafe_get_char input pos)
else
let succ' input' pos' more' () =
peek_char_fail.run input' pos' more' fail succ in
ensure_suspended 1 input pos more fail succ' }
let satisfy f =
{ run = fun input pos more fail succ ->
if pos < Input.length input then
let c = Input.unsafe_get_char input pos in
if f c
then succ input (pos + 1) more c
else Printf.ksprintf (fail input pos more []) "satisfy: %C" c
else
let succ' input' pos' more' () =
let c = Input.unsafe_get_char input' pos' in
if f c
then succ input' (pos' + 1) more' c
else Printf.ksprintf (fail input' pos' more' []) "satisfy: %C" c
in
ensure_suspended 1 input pos more fail succ' }
let char c =
let p =
{ run = fun input pos more fail succ ->
if Input.unsafe_get_char input pos = c
then succ input (pos + 1) more c
else fail input pos more [] (Printf.sprintf "char %C" c) }
in
ensure 1 p
let not_char c =
let p =
{ run = fun input pos more fail succ ->
let c' = Input.unsafe_get_char input pos in
if c <> c'
then succ input (pos + 1) more c'
else fail input pos more [] (Printf.sprintf "not char %C" c) }
in
ensure 1 p
let any_char =
let p =
{ run = fun input pos more _fail succ ->
succ input (pos + 1) more (Input.unsafe_get_char input pos) }
in
ensure 1 p
let int8 i =
let p =
{ run = fun input pos more fail succ ->
let c = Char.code (Input.unsafe_get_char input pos) in
if c = i land 0xff
then succ input (pos + 1) more c
else fail input pos more [] (Printf.sprintf "int8 %d" i) }
in
ensure 1 p
let any_uint8 =
let p =
{ run = fun input pos more _fail succ ->
let c = Input.unsafe_get_char input pos in
succ input (pos + 1) more (Char.code c) }
in
ensure 1 p
let any_int8 =
(* https://graphics.stanford.edu/~seander/bithacks.html#VariableSignExtendRisky *)
let s = Sys.int_size - 8 in
let p =
{ run = fun input pos more _fail succ ->
let c = Input.unsafe_get_char input pos in
succ input (pos + 1) more ((Char.code c lsl s) asr s) }
in
ensure 1 p
let skip f =
let p =
{ run = fun input pos more fail succ ->
if f (Input.unsafe_get_char input pos)
then succ input (pos + 1) more ()
else fail input pos more [] "skip" }
in
ensure 1 p
let rec count_while ~init ~f ~with_buffer =
{ run = fun input pos more fail succ ->
let len = Input.count_while input (pos + init) ~f in
let input_len = Input.length input in
let init' = init + len in
(* Check if the loop terminated because it reached the end of the input
* buffer. If so, then prompt for additional input and continue. *)
if pos + init' < input_len || more = Complete
then succ input (pos + init') more (Input.apply input pos init' ~f:with_buffer)
else
let succ' input' pos' more' =
(count_while ~init:init' ~f ~with_buffer).run input' pos' more' fail succ
and fail' input' pos' more' =
succ input' (pos' + init') more' (Input.apply input' pos' init' ~f:with_buffer)
in
prompt input pos fail' succ'
}
let rec count_while1 ~f ~with_buffer =
{ run = fun input pos more fail succ ->
let len = Input.count_while input pos ~f in
let input_len = Input.length input in
(* Check if the loop terminated because it reached the end of the input
* buffer. If so, then prompt for additional input and continue. *)
if len < 1
then
if pos < input_len || more = Complete
then fail input pos more [] "count_while1"
else
let succ' input' pos' more' =
(count_while1 ~f ~with_buffer).run input' pos' more' fail succ
and fail' input' pos' more' =
fail input' pos' more' [] "count_while1"
in
prompt input pos fail' succ'
else if pos + len < input_len || more = Complete
then succ input (pos + len) more (Input.apply input pos len ~f:with_buffer)
else
let succ' input' pos' more' =
(count_while ~init:len ~f ~with_buffer).run input' pos' more' fail succ
and fail' input' pos' more' =
succ input' (pos' + len) more' (Input.apply input' pos' len ~f:with_buffer)
in
prompt input pos fail' succ'
}
let string_ f s =
(* XXX(seliopou): Inefficient. Could check prefix equality to short-circuit
* the io. *)
let len = String.length s in
ensure len (unsafe_apply_opt len ~f:(fun buffer ~off ~len ->
let i = ref 0 in
while !i < len && Char.equal (f (Bigstringaf.unsafe_get buffer (off + !i)))
(f (String.unsafe_get s !i))
do
incr i
done;
if len = !i
then Ok (Bigstringaf.substring buffer ~off ~len)
else Error "string"))
let string s = string_ (fun x -> x) s
let string_ci s = string_ Char.lowercase_ascii s
let skip_while f =
count_while ~init:0 ~f ~with_buffer:(fun _ ~off:_ ~len:_ -> ())
let take n =
if n < 0
then fail "take: n < 0"
else
let n = max n 0 in
ensure n (unsafe_apply n ~f:Bigstringaf.substring)
let take_bigstring n =
if n < 0
then fail "take_bigstring: n < 0"
else
let n = max n 0 in
ensure n (unsafe_apply n ~f:Bigstringaf.copy)
let take_bigstring_while f =
count_while ~init:0 ~f ~with_buffer:Bigstringaf.copy
let take_bigstring_while1 f =
count_while1 ~f ~with_buffer:Bigstringaf.copy
let take_bigstring_till f =
take_bigstring_while (fun c -> not (f c))
let peek_string n =
unsafe_lookahead (take n)
let take_while f =
count_while ~init:0 ~f ~with_buffer:Bigstringaf.substring
let take_while1 f =
count_while1 ~f ~with_buffer:Bigstringaf.substring
let take_till f =
take_while (fun c -> not (f c))
let choice ?(failure_msg="no more choices") ps =
List.fold_right (<|>) ps (fail failure_msg)
let notset = { run = fun _buf _pos _more _fail _succ -> failwith "Angstrom.fix_direct not set" }
let fix_direct f =
let rec p = ref notset
and r = { run = fun buf pos more fail succ ->
(!p).run buf pos more fail succ }
in
p := f r;
r
let fix_lazy ~max_steps f =
let steps = ref max_steps in
let rec p = lazy (f r)
and r = { run = fun buf pos more fail succ ->
decr steps;
if !steps < 0
then (
steps := max_steps;
State.Lazy (lazy ((Lazy.force p).run buf pos more fail succ)))
else
(Lazy.force p).run buf pos more fail succ
}
in
r
let fix = match Sys.backend_type with
| Native -> fix_direct
| Bytecode -> fix_direct
| Other _ -> fun f -> fix_lazy ~max_steps:20 f
let option x p =
p <|> return x
let cons x xs = x :: xs
let rec list ps =
match ps with
| [] -> return []
| p::ps -> lift2 cons p (list ps)
let count n p =
if n < 0
then fail "count: n < 0"
else
let rec loop = function
| 0 -> return []
| n -> lift2 cons p (loop (n - 1))
in
loop n
let many p =
fix (fun m ->
(lift2 cons p m) <|> return [])
let many1 p =
lift2 cons p (many p)
let many_till p t =
fix (fun m ->
(t *> return []) <|> (lift2 cons p m))
let sep_by1 s p =
fix (fun m ->
lift2 cons p ((s *> m) <|> return []))
let sep_by s p =
(lift2 cons p ((s *> sep_by1 s p) <|> return [])) <|> return []
let skip_many p =
fix (fun m ->
((p >>| fun _ -> true) <|> return false) >>= function
| true -> m
| false -> return ()
)
let skip_many1 p =
p *> skip_many p
let end_of_line =
(char '\n' *> return ()) <|> (string "\r\n" *> return ()) <?> "end_of_line"
let scan_ state f ~with_buffer =
{ run = fun input pos more fail succ ->
let state = ref state in
let parser =
count_while ~init:0 ~f:(fun c ->
match f !state c with
| None -> false
| Some state' -> state := state'; true)
~with_buffer
>>| fun x -> x, !state
in
parser.run input pos more fail succ }
let scan state f =
scan_ state f ~with_buffer:Bigstringaf.substring
let scan_state state f =
scan_ state f ~with_buffer:(fun _ ~off:_ ~len:_ -> ())
>>| fun ((), state) -> state
let scan_string state f =
scan state f >>| fst
let consume_with p f =
{ run = fun input pos more fail succ ->
let start = pos in
let parser_committed_bytes = Input.parser_committed_bytes input in
let succ' input' pos' more' _ =
if parser_committed_bytes <> Input.parser_committed_bytes input'
then fail input' pos' more' [] "consumed: parser committed"
else (
let len = pos' - start in
let consumed = Input.apply input' start len ~f in
succ input' pos' more' consumed)
in
p.run input pos more fail succ'
}
let consumed p = consume_with p Bigstringaf.substring
let consumed_bigstring p = consume_with p Bigstringaf.copy
let both a b = lift2 (fun a b -> a, b) a b
let map t ~f = t >>| f
let bind t ~f = t >>= f
let map2 a b ~f = lift2 f a b
let map3 a b c ~f = lift3 f a b c
let map4 a b c d ~f = lift4 f a b c d
module Let_syntax = struct
let return = return
let ( >>| ) = ( >>| )
let ( >>= ) = ( >>= )
module Let_syntax = struct
let return = return
let map = map
let bind = bind
let both = both
let map2 = map2
let map3 = map3
let map4 = map4
end
end
let ( let+ ) = ( >>| )
let ( let* ) = ( >>= )
let ( and+ ) = both
module BE = struct
(* XXX(seliopou): The pattern in both this module and [LE] are a compromise
* between efficiency and code reuse. By inlining [ensure] you can recover
* about 2 nanoseconds on average. That may add up in certain applications.
*
* This pattern does not allocate in the fast (success) path.
* *)
let int16 n =
let bytes = 2 in
let p =
{ run = fun input pos more fail succ ->
if Input.unsafe_get_int16_be input pos = (n land 0xffff)
then succ input (pos + bytes) more ()
else fail input pos more [] "BE.int16" }
in
ensure bytes p
let int32 n =
let bytes = 4 in
let p =
{ run = fun input pos more fail succ ->
if Int32.equal (Input.unsafe_get_int32_be input pos) n
then succ input (pos + bytes) more ()
else fail input pos more [] "BE.int32" }
in
ensure bytes p
let int64 n =
let bytes = 8 in
let p =
{ run = fun input pos more fail succ ->
if Int64.equal (Input.unsafe_get_int64_be input pos) n
then succ input (pos + bytes) more ()
else fail input pos more [] "BE.int64" }
in
ensure bytes p
let any_uint16 =
ensure 2 (unsafe_apply 2 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int16_be bs off))
let any_int16 =
ensure 2 (unsafe_apply 2 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int16_sign_extended_be bs off))
let any_int32 =
ensure 4 (unsafe_apply 4 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int32_be bs off))
let any_int64 =
ensure 8 (unsafe_apply 8 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int64_be bs off))
let any_float =
ensure 4 (unsafe_apply 4 ~f:(fun bs ~off ~len:_ -> Int32.float_of_bits (Bigstringaf.unsafe_get_int32_be bs off)))
let any_double =
ensure 8 (unsafe_apply 8 ~f:(fun bs ~off ~len:_ -> Int64.float_of_bits (Bigstringaf.unsafe_get_int64_be bs off)))
end
module LE = struct
let int16 n =
let bytes = 2 in
let p =
{ run = fun input pos more fail succ ->
if Input.unsafe_get_int16_le input pos = (n land 0xffff)
then succ input (pos + bytes) more ()
else fail input pos more [] "LE.int16" }
in
ensure bytes p
let int32 n =
let bytes = 4 in
let p =
{ run = fun input pos more fail succ ->
if Int32.equal (Input.unsafe_get_int32_le input pos) n
then succ input (pos + bytes) more ()
else fail input pos more [] "LE.int32" }
in
ensure bytes p
let int64 n =
let bytes = 8 in
let p =
{ run = fun input pos more fail succ ->
if Int64.equal (Input.unsafe_get_int64_le input pos) n
then succ input (pos + bytes) more ()
else fail input pos more [] "LE.int64" }
in
ensure bytes p
let any_uint16 =
ensure 2 (unsafe_apply 2 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int16_le bs off))
let any_int16 =
ensure 2 (unsafe_apply 2 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int16_sign_extended_le bs off))
let any_int32 =
ensure 4 (unsafe_apply 4 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int32_le bs off))
let any_int64 =
ensure 8 (unsafe_apply 8 ~f:(fun bs ~off ~len:_ -> Bigstringaf.unsafe_get_int64_le bs off))
let any_float =
ensure 4 (unsafe_apply 4 ~f:(fun bs ~off ~len:_ -> Int32.float_of_bits (Bigstringaf.unsafe_get_int32_le bs off)))
let any_double =
ensure 8 (unsafe_apply 8 ~f:(fun bs ~off ~len:_ -> Int64.float_of_bits (Bigstringaf.unsafe_get_int64_le bs off)))
end
module Unsafe = struct
let take n f =
let n = max n 0 in
ensure n (unsafe_apply n ~f)
let peek n f =
unsafe_lookahead (take n f)
let take_while check f =
count_while ~init:0 ~f:check ~with_buffer:f
let take_while1 check f =
count_while1 ~f:check ~with_buffer:f
let take_till check f =
take_while (fun c -> not (check c)) f
end
module Consume = struct
type t =
| Prefix
| All
end
let parse_bigstring ~consume p bs =
let p =
match (consume : Consume.t) with
| Prefix -> p
| All -> p <* end_of_input
in
Unbuffered.parse_bigstring p bs
let parse_string ~consume p s =
let len = String.length s in
let bs = Bigstringaf.create len in
Bigstringaf.unsafe_blit_from_string s ~src_off:0 bs ~dst_off:0 ~len;
parse_bigstring ~consume p bs

688
unikernel/duniverse/angstrom/lib/angstrom.mli Normal file
View file

@ -0,0 +1,688 @@
(*----------------------------------------------------------------------------
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.
----------------------------------------------------------------------------*)
(** Parser combinators built for speed and memory-efficiency.
Angstrom is a parser-combinator library that provides monadic and
applicative interfaces for constructing parsers with unbounded lookahead.
Its parsers can consume input incrementally, whether in a blocking or
non-blocking environment. To achieve efficient incremental parsing,
Angstrom offers both a buffered and unbuffered interface to input streams,
with the {!module:Unbuffered} interface enabling zero-copy IO. With these
features and low-level iteration parser primitives like {!take_while} and
{!skip_while}, Angstrom makes it easy to write efficient, expressive, and
reusable parsers suitable for high-performance applications. *)
type +'a t
(** A parser for values of type ['a]. *)
type bigstring = Bigstringaf.t
(** {2 Basic parsers} *)
val peek_char : char option t
(** [peek_char] accepts any char and returns it, or returns [None] if the end
of input has been reached.
This parser does not advance the input. Use it for lookahead. *)
val peek_char_fail : char t
(** [peek_char_fail] accepts any char and returns it. If end of input has been
reached, it will fail.
This parser does not advance the input. Use it for lookahead. *)
val peek_string : int -> string t
(** [peek_string n] accepts exactly [n] characters and returns them as a
string. If there is not enough input, it will fail.
This parser does not advance the input. Use it for lookahead. *)
val char : char -> char t
(** [char c] accepts [c] and returns it. *)
val not_char : char -> char t
(** [not_char] accepts any character that is not [c] and returns the matched
character. *)
val any_char : char t
(** [any_char] accepts any character and returns it. *)
val satisfy : (char -> bool) -> char t
(** [satisfy f] accepts any character for which [f] returns [true] and
returns the accepted character. In the case that none of the parser
succeeds, then the parser will fail indicating the offending
character. *)
val string : string -> string t
(** [string s] accepts [s] exactly and returns it. *)
val string_ci : string -> string t
(** [string_ci s] accepts [s], ignoring case, and returns the matched string,
preserving the case of the original input. *)
val skip : (char -> bool) -> unit t
(** [skip f] accepts any character for which [f] returns [true] and discards
the accepted character. [skip f] is equivalent to [satisfy f] but discards
the accepted character. *)
val skip_while : (char -> bool) -> unit t
(** [skip_while f] accepts input as long as [f] returns [true] and discards
the accepted characters. *)
val take : int -> string t
(** [take n] accepts exactly [n] characters of input and returns them as a
string. *)
val take_while : (char -> bool) -> string t
(** [take_while f] accepts input as long as [f] returns [true] and returns the
accepted 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_while1 f] accepts input as long as [f] returns [true] and returns the
accepted 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] accepts input as long as [f] returns [false] and returns the
accepted characters as a string.
This parser does not fail. If [f] returns [true] on the first character, it
will return the empty string. *)
val consumed : _ t -> string t
(** [consumed p] runs [p] and returns the contents that were consumed during the
parsing as a string *)
val take_bigstring : int -> bigstring t
(** [take_bigstring n] accepts exactly [n] characters of input and returns them
as a newly allocated bigstring. *)
val take_bigstring_while : (char -> bool) -> bigstring t
(** [take_bigstring_while f] accepts input as long as [f] returns [true] and
returns the accepted characters as a newly allocated bigstring.
This parser does not fail. If [f] returns [false] on the first character,
it will return the empty bigstring. *)
val take_bigstring_while1 : (char -> bool) -> bigstring t
(** [take_bigstring_while1 f] accepts input as long as [f] returns [true] and
returns the accepted characters as a newly allocated bigstring.
This parser requires that [f] return [true] for at least one character of
input, and will fail otherwise. *)
val take_bigstring_till : (char -> bool) -> bigstring t
(** [take_bigstring_till f] accepts input as long as [f] returns [false] and
returns the accepted characters as a newly allocated bigstring.
This parser does not fail. If [f] returns [true] on the first character, it
will return the empty bigstring. *)
val consumed_bigstring : _ t -> bigstring t
(** [consumed p] runs [p] and returns the contents that were consumed during the
parsing as a bigstring *)
val advance : int -> unit t
(** [advance n] advances the input [n] characters, failing if the remaining
input is less than [n]. *)
val end_of_line : unit t
(** [end_of_line] accepts either a line feed [\n], or a carriage return
followed by a line feed [\r\n] and returns unit. *)
val at_end_of_input : bool t
(** [at_end_of_input] returns whether the end of the end of input has been
reached. This parser always succeeds. *)
val end_of_input : unit t
(** [end_of_input] succeeds if all the input has been consumed, and fails
otherwise. *)
val scan : 'state -> ('state -> char -> 'state option) -> (string * 'state) t
(** [scan init f] consumes until [f] returns [None]. Returns the final state
before [None] and the accumulated string *)
val scan_state : 'state -> ('state -> char -> 'state option) -> 'state t
(** [scan_state init f] is like {!scan} but only returns the final state before
[None]. Much more efficient than {!scan}. *)
val scan_string : 'state -> ('state -> char -> 'state option) -> string t
(** [scan_string init f] is like {!scan} but discards the final state and returns
the accumulated string. *)
val int8 : int -> int t
(** [int8 i] accepts one byte that matches the lower-order byte of [i] and
returns unit. *)
val any_uint8 : int t
(** [any_uint8] accepts any byte and returns it as an unsigned int8. *)
val any_int8 : int t
(** [any_int8] accepts any byte and returns it as a signed int8. *)
(** Big endian parsers *)
module BE : sig
val int16 : int -> unit t
(** [int16 i] accept two bytes that match the two lower order bytes of [i]
and returns unit. *)
val int32 : int32 -> unit t
(** [int32 i] accept four bytes that match the four bytes of [i]
and returns unit. *)
val int64 : int64 -> unit t
(** [int64 i] accept eight bytes that match the eight bytes of [i] and
returns unit. *)
val any_int16 : int t
val any_int32 : int32 t
val any_int64 : int64 t
(** [any_intN] reads [N] bits and interprets them as big endian signed integers. *)
val any_uint16 : int t
(** [any_uint16] reads [16] bits and interprets them as a big endian unsigned
integer. *)
val any_float : float t
(** [any_float] reads 32 bits and interprets them as a big endian floating
point value. *)
val any_double : float t
(** [any_double] reads 64 bits and interprets them as a big endian floating
point value. *)
end
(** Little endian parsers *)
module LE : sig
val int16 : int -> unit t
(** [int16 i] accept two bytes that match the two lower order bytes of [i]
and returns unit. *)
val int32 : int32 -> unit t
(** [int32 i] accept four bytes that match the four bytes of [i]
and returns unit. *)
val int64 : int64 -> unit t
(** [int32 i] accept eight bytes that match the eight bytes of [i] and
returns unit. *)
val any_int16 : int t
val any_int32 : int32 t
val any_int64 : int64 t
(** [any_intN] reads [N] bits and interprets them as little endian signed
integers. *)
val any_uint16 : int t
(** [uint16] reads [16] bits and interprets them as a little endian unsigned
integer. *)
val any_float : float t
(** [any_float] reads 32 bits and interprets them as a little endian floating
point value. *)
val any_double : float t
(** [any_double] reads 64 bits and interprets them as a little endian floating
point value. *)
end
(** {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 both : 'a t -> 'b t -> ('a * 'b) t
(** [both p q] runs [p] followed by [q] and returns both results in a tuple *)
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 count : int -> 'a t -> 'a list t
(** [count n p] runs [p] [n] times, returning a list of the results. *)
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 -> _ 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 : _ t -> 'a t -> 'a list t
(** [sep_by s p] runs [p] {i zero} or more times, interspersing runs of [s] in between. *)
val sep_by1 : _ t -> 'a t -> 'a list t
(** [sep_by1 s p] runs [p] {i one} or more times, interspersing runs of [s] in between. *)
val skip_many : _ t -> unit t
(** [skip_many p] runs [p] {i zero} or more times, discarding the results. *)
val skip_many1 : _ t -> unit t
(** [skip_many1 p] runs [p] {i one} or more times, discarding the results. *)
val fix : ('a t -> 'a t) -> 'a t
(** [fix f] computes the fixpoint of [f] and runs the resultant parser. The
argument that [f] receives is the result of [fix f], which [f] must use,
paradoxically, to define [fix f].
[fix] is useful when constructing parsers for inductively-defined types
such as sequences, trees, etc. Consider for example the implementation of
the {!many} combinator defined in this library:
{[let many p =
fix (fun m ->
(cons <$> p <*> m) <|> return [])]}
[many p] is a parser that will run [p] zero or more times, accumulating the
result of every run into a list, returning the result. It's defined by
passing [fix] a function. This function assumes its argument [m] is a
parser that behaves exactly like [many p]. You can see this in the
expression comprising the left hand side of the alternative operator
[<|>]. This expression runs the parser [p] followed by the parser [m], and
after which the result of [p] is cons'd onto the list that [m] produces.
The right-hand side of the alternative operator provides a base case for
the combinator: if [p] fails and the parse cannot proceed, return an empty
list.
Another way to illustrate the uses of [fix] is to construct a JSON parser.
Assuming that parsers exist for the basic types such as [false], [true],
[null], strings, and numbers, the question then becomes how to define a
parser for objects and arrays? Both contain values that are themselves JSON
values, so it seems as though it's impossible to write a parser that will
accept JSON objects and arrays before writing a parser for JSON values as a
whole.
This is the exact situation that [fix] was made for. By defining the
parsers for arrays and objects within the function that you pass to [fix],
you will gain access to a parser that you can use to parse JSON values, the
very parser you are defining!
{[let json =
fix (fun json ->
let arr = char '[' *> sep_by (char ',') json <* char ']' in
let obj = char '{' *> ... json ... <* char '}' in
choice [str; num; arr json, ...])]} *)
(** [fix_lazy] is like [fix], but after the function reaches [max_steps]
deep, it wraps up the remaining computation and yields
back to the root of the parsing loop where it continues from there.
This is an effective way to break up the stack trace into more managable
chunks, which is important for Js_of_ocaml due to the lack of tailrec
optimizations for CPS-style tail calls. When compiling for Js_of_ocaml,
[fix] itself is defined as [fix_lazy ~max_steps:20]. *)
val fix_lazy : max_steps:int -> ('a t -> 'a t) -> 'a t
(** {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 : ?failure_msg:string -> 'a t list -> 'a t
(** [choice ?failure_msg ts] runs each parser in [ts] in order until one
succeeds and returns that result. In the case that none of the parser
succeeds, then the parser will fail with the message [failure_msg], if
provided, or a much less informative message otherwise. *)
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,
allowing the manager of the input buffer to reuse the preceding bytes for
other purposes.
The {!module:Unbuffered} parsing interface will report directly to the
caller the number of bytes committed to the when returning a
{!Unbuffered.state.Partial} state, allowing the caller to reuse those bytes
for any purpose. The {!module:Buffered} will keep track of the region of
committed bytes in its internal buffer and reuse that region to store
additional input when necessary. *)
(** {2 Monadic/Applicative interface} *)
val return : 'a -> 'a t
(** [return v] creates a parser that will always succeed and return [v] *)
val fail : string -> _ 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 bind : 'a t -> f:('a -> 'b t) -> 'b t
(** [bind] is a prefix version of [>>=] *)
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 ( *>) : _ t -> 'a t -> 'a t
(** [p *> q] runs [p], discards its result and then runs [q], and returns its
result. *)
val (<* ) : 'a t -> _ t -> 'a t
(** [p <* q] runs [p], then runs [q], discards its result, and returns the
result of [p]. *)
val lift : ('a -> 'b) -> 'a t -> 'b t
val lift2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
val lift3 : ('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t
val lift4 : ('a -> 'b -> 'c -> 'd -> 'e) -> 'a t -> 'b t -> 'c t -> 'd t -> 'e t
(** The [liftn] family of functions promote functions to the parser monad.
For any of these functions, the following equivalence holds:
{[liftn f p1 ... pn = f <$> p1 <*> ... <*> pn]}
These functions are more efficient than using the applicative interface
directly, mostly in terms of memory allocation but also in terms of speed.
Prefer them over the applicative interface, even when the arity of the
function to be lifted exceeds the maximum [n] for which there is an
implementation for [liftn]. In other words, if [f] has an arity of [5] but
only [lift4] is provided, do the following:
{[lift4 f m1 m2 m3 m4 <*> m5]}
Even with the partial application, it will be more efficient than the
applicative implementation. *)
val map : 'a t -> f:('a -> 'b) -> 'b t
val map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t
val map3 : 'a t -> 'b t -> 'c t -> f:('a -> 'b -> 'c -> 'd) -> 'd t
val map4 : 'a t -> 'b t -> 'c t -> 'd t -> f:('a -> 'b -> 'c -> 'd -> 'e) -> 'e t
(** The [mapn] family of functions are just like [liftn], with a slightly
different interface. *)
(** The [Let_syntax] module is intended to be used with the [ppx_let]
pre-processor, and just contains copies of functions described elsewhere. *)
module Let_syntax : sig
val return : 'a -> 'a t
val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t
val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
module Let_syntax : sig
val return : 'a -> 'a t
val map : 'a t -> f:('a -> 'b) -> 'b t
val bind : 'a t -> f:('a -> 'b t) -> 'b t
val both : 'a t -> 'b t -> ('a * 'b) t
val map2 : 'a t -> 'b t -> f:('a -> 'b -> 'c) -> 'c t
val map3 : 'a t -> 'b t -> 'c t -> f:('a -> 'b -> 'c -> 'd) -> 'd t
val map4 : 'a t -> 'b t -> 'c t -> 'd t -> f:('a -> 'b -> 'c -> 'd -> 'e) -> 'e t
end
end
val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
(** Unsafe Operations on Angstrom's Internal Buffer
These functions are considered {b unsafe} as they expose the input buffer
to client code without any protections against modification, or leaking
references. They are exposed to support performance-sensitive parsers that
want to avoid allocation at all costs. Client code should take care to
write the input buffer callback functions such that they:
{ul
{- do not modify the input buffer {i outside} of the range
[\[off, off + len)];}
{- do not modify the input buffer {i inside} of the range
[\[off, off + len)] if the parser might backtrack; and}
{- do not return any direct or indirect references to the input buffer.}}
If the input buffer callback functions do not do any of these things, then
the client may consider their use safe. *)
module Unsafe : sig
val take : int -> (bigstring -> off:int -> len:int -> 'a) -> 'a t
(** [take n f] accepts exactly [n] characters of input into the parser's
internal buffer then calls [f buffer ~off ~len]. [buffer] is the
parser's internal buffer. [off] is the offset from the start of [buffer]
containing the requested content. [len] is the length of the requested
content. [len] is guaranteed to be equal to [n]. *)
val take_while : (char -> bool) -> (bigstring -> off:int -> len:int -> 'a) -> 'a t
(** [take_while check f] accepts input into the parser's interal buffer as
long as [check] returns [true] then calls [f buffer ~off ~len]. [buffer]
is the parser's internal buffer. [off] is the offset from the start of
[buffer] containing the requested content. [len] is the length of the
content matched by [check].
This parser does not fail. If [check] returns [false] on the first
character, [len] will be [0]. *)
val take_while1 : (char -> bool) -> (bigstring -> off:int -> len:int -> 'a) -> 'a t
(** [take_while1 check f] accepts input into the parser's interal buffer as
long as [check] returns [true] then calls [f buffer ~off ~len]. [buffer]
is the parser's internal buffer. [off] is the offset from the start of
[buffer] containing the requested content. [len] is the length of the
content matched by [check].
This parser requires that [f] return [true] for at least one character of
input, and will fail otherwise. *)
val take_till : (char -> bool) -> (bigstring -> off:int -> len:int -> 'a) -> 'a t
(** [take_till check f] accepts input into the parser's interal buffer as
long as [check] returns [false] then calls [f buffer ~off ~len]. [buffer]
is the parser's internal buffer. [off] is the offset from the start of
[buffer] containing the requested content. [len] is the length of the
content matched by [check].
This parser does not fail. If [check] returns [true] on the first
character, [len] will be [0]. *)
val peek : int -> (bigstring -> off:int -> len:int -> 'a) -> 'a t
(** [peek n ~f] accepts exactly [n] characters and calls [f buffer ~off ~len]
with [len = n]. If there is not enough input, it will fail.
This parser does not advance the input. Use it for lookahead. *)
end
(** {2 Running} *)
module Consume : sig
type t =
| Prefix
| All
end
val parse_bigstring : consume:Consume.t -> 'a t -> bigstring -> ('a, string) result
(** [parse_bigstring ~consume t bs] runs [t] on [bs]. The parser will receive
an [`Eof] after all of [bs] has been consumed. Passing {!Prefix} in the
[consume] argument allows the parse to successfully complete without
reaching eof. To require the parser to reach eof, pass {!All} in the
[consume] argument.
For use-cases requiring that the parser be fed input incrementally, see the
{!module:Buffered} and {!module:Unbuffered} modules below. *)
val parse_string : consume:Consume.t -> 'a t -> string -> ('a, string) result
(** [parse_string ~consume t bs] runs [t] on [bs]. The parser will receive an
[`Eof] after all of [bs] has been consumed. Passing {!Prefix} in the
[consume] argument allows the parse to successfully complete without
reaching eof. To require the parser to reach eof, pass {!All} in the
[consume] argument.
For use-cases requiring that the parser be fed input incrementally, see the
{!module:Buffered} and {!module:Unbuffered} modules below. *)
(** Buffered parsing interface.
Parsers run through this module perform internal buffering of input. The
parser state will keep track of unconsumed input and attempt to minimize
memory allocation and copying. The {!Buffered.state.Partial} parser state
will accept newly-read, incremental input and copy it into the internal
buffer. Users can feed parser states using the {!feed} function. As a
result, the interface is much easier to use than the one exposed by the
{!Unbuffered} module.
On success or failure, any unconsumed input will be returned to the user
for additional processing. The buffer that the unconsumed input is returned
in can also be reused. *)
module Buffered : sig
type unconsumed =
{ buf : bigstring
; off : int
; len : int }
type input =
[ `Bigstring of bigstring
| `String of string ]
type 'a state =
| Partial of ([ input | `Eof ] -> 'a state) (** The parser requires more input. *)
| Done of unconsumed * 'a (** The parser succeeded. *)
| Fail of unconsumed * string list * string (** The parser failed. *)
val parse : ?initial_buffer_size:int -> 'a t -> 'a state
(** [parse ?initial_buffer_size t] runs [t] and awaits input if needed.
[parse] will allocate a buffer of size [initial_buffer_size] (defaulting
to 4k bytes) to do input buffering and automatically grows the buffer as
needed. *)
val feed : 'a state -> [ input | `Eof ] -> '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
(** [state_to_option state] returns [Some v] if the parser is in the
[Done (bs, v)] state and [None] otherwise. This function has no effect on
the current state of the parser. *)
val state_to_result : 'a state -> ('a, string) result
(** [state_to_result state] returns [Ok v] if the parser is in the [Done (bs, v)]
state and [Error msg] if it is in the [Fail] or [Partial] state.
This function has no effect on the current state of the parser. *)
val state_to_unconsumed : _ state -> unconsumed option
(** [state_to_unconsumed state] returns [Some bs] if [state = Done(bs, _)] or
[state = Fail(bs, _, _)] and [None] otherwise. *)
end
(** Unbuffered parsing interface.
Use this module for total control over memory allocation and copying.
Parsers run through this module perform no internal buffering. Instead, the
user is responsible for managing a buffer containing the entirety of the
input that has yet to be consumed by the parser. The
{!Unbuffered.state.Partial} parser state reports to the user how much input
the parser consumed during its last run, via the
{!Unbuffered.partial.committed} field. This area of input must be discarded
before parsing can resume. Once additional input has been collected, the
unconsumed input as well as new input must be passed to the parser state
via the {!Unbuffered.partial.continue} function, together with an
indication of whether there is {!Unbuffered.more} input to come.
The logic that must be implemented in order to make proper use of this
module is intricate and tied to your OS environment. It's advisable to use
the {!Buffered} module when initially developing and testing your parsers.
For production use-cases, consider the Async and Lwt support that this
library includes before attempting to use this module directly. *)
module Unbuffered : sig
type more =
| Complete
| Incomplete
type 'a state =
| Partial of 'a partial (** The parser requires more input. *)
| Done of int * 'a (** The parser succeeded, consuming specified bytes. *)
| Fail of int * string list * string (** The parser failed, consuming specified bytes. *)
and 'a partial =
{ committed : int
(** The number of bytes committed during the last input feeding.
Callers must drop this number of bytes from the beginning of the
input on subsequent calls. See {!commit} for additional details. *)
; continue : bigstring -> off:int -> len:int -> more -> 'a state
(** A continuation of a parse that requires additional input. The input
should include all uncommitted input (as reported by previous partial
states) in addition to any new input that has become available, as
well as an indication of whether there is {!more} input to come. *)
}
val parse : 'a t -> 'a state
(** [parse t] runs [t] and await input if needed. *)
val state_to_option : 'a state -> 'a option
(** [state_to_option state] returns [Some v] if the parser is in the
[Done (bs, v)] state and [None] otherwise. This function has no effect on the
current state of the parser. *)
val state_to_result : 'a state -> ('a, string) result
(** [state_to_result state] returns [Ok v] if the parser is in the
[Done (bs, v)] state and [Error msg] if it is in the [Fail] or [Partial]
state.
This function has no effect on the current state of the parser. *)
end
(** {2 Expert Parsers}
For people that know what they're doing. If you want to use them, read the
code. No further documentation will be provided. *)
val pos : int t
val available : int t

88
unikernel/duniverse/angstrom/lib/buffering.ml Normal file
View file

@ -0,0 +1,88 @@
type t =
{ mutable buf : Bigstringaf.t
; mutable off : int
; mutable len : int }
let of_bigstring ~off ~len buf =
assert (off >= 0);
assert (Bigstringaf.length buf >= len - off);
{ buf; off; len }
let create len =
of_bigstring ~off:0 ~len:0 (Bigstringaf.create len)
let writable_space t =
Bigstringaf.length t.buf - t.len
let trailing_space t =
Bigstringaf.length t.buf - (t.off + t.len)
let compress t =
Bigstringaf.unsafe_blit t.buf ~src_off:t.off t.buf ~dst_off:0 ~len:t.len;
t.off <- 0
let grow t to_copy =
let old_len = Bigstringaf.length t.buf in
let new_len = ref old_len in
let space = writable_space t in
while space + !new_len - old_len < to_copy do
new_len := (3 * !new_len) / 2
done;
let new_buf = Bigstringaf.create !new_len in
Bigstringaf.unsafe_blit t.buf ~src_off:t.off new_buf ~dst_off:0 ~len:t.len;
t.buf <- new_buf;
t.off <- 0
let ensure t to_copy =
if trailing_space t < to_copy then
if writable_space t >= to_copy
then compress t
else grow t to_copy
let write_pos t =
t.off + t.len
let feed_string t ~off ~len str =
assert (off >= 0);
assert (String.length str >= len - off);
ensure t len;
Bigstringaf.unsafe_blit_from_string str ~src_off:off t.buf ~dst_off:(write_pos t) ~len;
t.len <- t.len + len
let feed_bigstring t ~off ~len b =
assert (off >= 0);
assert (Bigstringaf.length b >= len - off);
ensure t len;
Bigstringaf.unsafe_blit b ~src_off:off t.buf ~dst_off:(write_pos t) ~len;
t.len <- t.len + len
let feed_input t = function
| `String s -> feed_string t ~off:0 ~len:(String .length s) s
| `Bigstring b -> feed_bigstring t ~off:0 ~len:(Bigstringaf.length b) b
let shift t n =
assert (t.len >= n);
t.off <- t.off + n;
t.len <- t.len - n
let for_reading { buf; off; len } =
Bigstringaf.sub ~off ~len buf
module Unconsumed = struct
type t =
{ buf : Bigstringaf.t
; off : int
; len : int }
end
let unconsumed ?(shift=0) { buf; off; len } =
assert (len >= shift);
{ Unconsumed.buf; off = off + shift; len = len - shift }
let of_unconsumed { Unconsumed.buf; off; len } =
{ buf; off; len }
type unconsumed = Unconsumed.t =
{ buf : Bigstringaf.t
; off : int
; len : int }

20
unikernel/duniverse/angstrom/lib/buffering.mli Normal file
View file

@ -0,0 +1,20 @@
type t
val create : int -> t
val of_bigstring : off:int -> len:int -> Bigstringaf.t -> t
val feed_string : t -> off:int -> len:int -> string -> unit
val feed_bigstring : t -> off:int -> len:int -> Bigstringaf.t -> unit
val feed_input : t -> [ `String of string | `Bigstring of Bigstringaf.t ] -> unit
val shift : t -> int -> unit
val for_reading : t -> Bigstringaf.t
type unconsumed =
{ buf : Bigstringaf.t
; off : int
; len : int }
val unconsumed : ?shift:int -> t -> unconsumed
val of_unconsumed : unconsumed -> t

6
unikernel/duniverse/angstrom/lib/dune Normal file
View file

@ -0,0 +1,6 @@
(library
(name angstrom)
(public_name angstrom)
(libraries bigstringaf)
(flags :standard -safe-string)
(preprocess future_syntax))

22
unikernel/duniverse/angstrom/lib/exported_state.ml Normal file
View file

@ -0,0 +1,22 @@
type 'a state =
| Partial of 'a partial
| Done of int * 'a
| Fail of int * string list * string
and 'a partial =
{ committed : int
; continue : Bigstringaf.t -> off:int -> len:int -> More.t -> 'a state }
let state_to_option x = match x with
| Done(_, v) -> Some v
| Fail _ -> None
| Partial _ -> None
let fail_to_string marks err =
String.concat " > " marks ^ ": " ^ err
let state_to_result x = match x with
| Done(_, v) -> Ok v
| Partial _ -> Error "incomplete input"
| Fail(_, marks, err) -> Error (fail_to_string marks err)

111
unikernel/duniverse/angstrom/lib/input.ml Normal file
View file

@ -0,0 +1,111 @@
(*----------------------------------------------------------------------------
Copyright (c) 2017 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.
----------------------------------------------------------------------------*)
type t =
{ mutable parser_committed_bytes : int
; client_committed_bytes : int
; off : int
; len : int
; buffer : Bigstringaf.t
}
let create buffer ~off ~len ~committed_bytes =
{ parser_committed_bytes = committed_bytes
; client_committed_bytes = committed_bytes
; off
; len
; buffer }
let length t = t.client_committed_bytes + t.len
let client_committed_bytes t = t.client_committed_bytes
let parser_committed_bytes t = t.parser_committed_bytes
let committed_bytes_discrepancy t = t.parser_committed_bytes - t.client_committed_bytes
let bytes_for_client_to_commit t = committed_bytes_discrepancy t
let parser_uncommitted_bytes t = t.len - bytes_for_client_to_commit t
let invariant t =
assert (parser_committed_bytes t + parser_uncommitted_bytes t = length t);
assert (parser_committed_bytes t - client_committed_bytes t = bytes_for_client_to_commit t);
;;
let offset_in_buffer t pos =
t.off + pos - t.client_committed_bytes
let apply t pos len ~f =
let off = offset_in_buffer t pos in
f t.buffer ~off ~len
let unsafe_get_char t pos =
let off = offset_in_buffer t pos in
Bigstringaf.unsafe_get t.buffer off
let unsafe_get_int16_le t pos =
let off = offset_in_buffer t pos in
Bigstringaf.unsafe_get_int16_le t.buffer off
let unsafe_get_int32_le t pos =
let off = offset_in_buffer t pos in
Bigstringaf.unsafe_get_int32_le t.buffer off
let unsafe_get_int64_le t pos =
let off = offset_in_buffer t pos in
Bigstringaf.unsafe_get_int64_le t.buffer off
let unsafe_get_int16_be t pos =
let off = offset_in_buffer t pos in
Bigstringaf.unsafe_get_int16_be t.buffer off
let unsafe_get_int32_be t pos =
let off = offset_in_buffer t pos in
Bigstringaf.unsafe_get_int32_be t.buffer off
let unsafe_get_int64_be t pos =
let off = offset_in_buffer t pos in
Bigstringaf.unsafe_get_int64_be t.buffer off
let count_while t pos ~f =
let buffer = t.buffer in
let off = offset_in_buffer t pos in
let i = ref off in
let limit = t.off + t.len in
while !i < limit && f (Bigstringaf.unsafe_get buffer !i) do
incr i
done;
!i - off
;;
let commit t pos =
t.parser_committed_bytes <- pos
;;

88
unikernel/duniverse/angstrom/lib/input.mli Normal file
View file

@ -0,0 +1,88 @@
(*----------------------------------------------------------------------------
Copyright (c) 2017 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.
----------------------------------------------------------------------------*)
(** An [Input.t] represents a series of buffers, of which we only have access
to one, and a pointer to how much has been committed, which is in the
current buffer.
parser commit point
V
+--------------------------------------+
|#################'####################| current buffer
+-----------------+--------------------------------------+-----
|#################|#################'####################|###.. input
+-----------------+--------------------------------------+-----
' ' ' '
|--------------------------------------------------------|
' ' length ' '
|-----------------| ' '
client_committed_bytes ' '
' ' |--------------------|
' ' parser_uncommitted_bytes
' |-----------------|
' bytes_for_client_to_commit
|-----------------------------------|
parser_committed_bytes
Note that a buffer is a subsequence of a [Bigstringaf.t], defined by [off] and [len].
All [int] position arguments should be relative to the beginning of the
whole input. *)
type t
val create : Bigstringaf.t -> off:int -> len:int -> committed_bytes:int -> t
val length : t -> int
val client_committed_bytes : t -> int
val parser_committed_bytes : t -> int
val parser_uncommitted_bytes : t -> int
val bytes_for_client_to_commit : t -> int
val unsafe_get_char : t -> int -> char
val unsafe_get_int16_le : t -> int -> int
val unsafe_get_int32_le : t -> int -> int32
val unsafe_get_int64_le : t -> int -> int64
val unsafe_get_int16_be : t -> int -> int
val unsafe_get_int32_be : t -> int -> int32
val unsafe_get_int64_be : t -> int -> int64
val count_while : t -> int -> f:(char -> bool) -> int
val apply : t -> int -> int -> f:(Bigstringaf.t -> off:int -> len:int -> 'a) -> 'a
val commit : t -> int -> unit
val invariant : t -> unit

3
unikernel/duniverse/angstrom/lib/more.ml Normal file
View file

@ -0,0 +1,3 @@
type t =
| Complete
| Incomplete

3
unikernel/duniverse/angstrom/lib/more.mli Normal file
View file

@ -0,0 +1,3 @@
type t =
| Complete
| Incomplete

173
unikernel/duniverse/angstrom/lib/parser.ml Normal file
View file

@ -0,0 +1,173 @@
module State = struct
type 'a t =
| Partial of 'a partial
| Lazy of 'a t Lazy.t
| Done of int * 'a
| Fail of int * string list * string
and 'a partial =
{ committed : int
; continue : Bigstringaf.t -> off:int -> len:int -> More.t -> 'a t }
end
type 'a with_state = Input.t -> int -> More.t -> 'a
type 'a failure = (string list -> string -> 'a State.t) with_state
type ('a, 'r) success = ('a -> 'r State.t) with_state
type 'a t =
{ run : 'r. ('r failure -> ('a, 'r) success -> 'r State.t) with_state }
let fail_k input pos _ marks msg =
State.Fail(pos - Input.client_committed_bytes input, marks, msg)
let succeed_k input pos _ v =
State.Done(pos - Input.client_committed_bytes input, v)
let rec to_exported_state = function
| State.Partial {committed;continue} ->
Exported_state.Partial
{ committed
; continue =
fun bs ~off ~len more ->
to_exported_state (continue bs ~off ~len more)}
| State.Done (i,x) -> Exported_state.Done (i,x)
| State.Fail (i, sl, s) -> Exported_state.Fail (i, sl, s)
| State.Lazy x -> to_exported_state (Lazy.force x)
let parse p =
let input = Input.create Bigstringaf.empty ~committed_bytes:0 ~off:0 ~len:0 in
to_exported_state (p.run input 0 Incomplete fail_k succeed_k)
let parse_bigstring p input =
let input = Input.create input ~committed_bytes:0 ~off:0 ~len:(Bigstringaf.length input) in
Exported_state.state_to_result (to_exported_state (p.run input 0 Complete fail_k succeed_k))
module Monad = struct
let return v =
{ run = fun input pos more _fail succ ->
succ input pos more v
}
let fail msg =
{ run = fun input pos more fail _succ ->
fail input pos more [] msg
}
let (>>=) p f =
{ run = fun input pos more fail succ ->
let succ' input' pos' more' v = (f v).run input' pos' more' fail succ in
p.run input pos more fail succ'
}
let (>>|) p f =
{ run = fun input pos more fail succ ->
let succ' input' pos' more' v = succ input' pos' more' (f v) in
p.run input pos more fail succ'
}
let (<$>) f m =
m >>| f
let (<*>) f m =
(* f >>= fun f -> m >>| f *)
{ run = fun input pos more fail succ ->
let succ0 input0 pos0 more0 f =
let succ1 input1 pos1 more1 m = succ input1 pos1 more1 (f m) in
m.run input0 pos0 more0 fail succ1
in
f.run input pos more fail succ0 }
let lift f m =
f <$> m
let lift2 f m1 m2 =
{ run = fun input pos more fail succ ->
let succ1 input1 pos1 more1 m1 =
let succ2 input2 pos2 more2 m2 = succ input2 pos2 more2 (f m1 m2) in
m2.run input1 pos1 more1 fail succ2
in
m1.run input pos more fail succ1 }
let lift3 f m1 m2 m3 =
{ run = fun input pos more fail succ ->
let succ1 input1 pos1 more1 m1 =
let succ2 input2 pos2 more2 m2 =
let succ3 input3 pos3 more3 m3 =
succ input3 pos3 more3 (f m1 m2 m3) in
m3.run input2 pos2 more2 fail succ3 in
m2.run input1 pos1 more1 fail succ2
in
m1.run input pos more fail succ1 }
let lift4 f m1 m2 m3 m4 =
{ run = fun input pos more fail succ ->
let succ1 input1 pos1 more1 m1 =
let succ2 input2 pos2 more2 m2 =
let succ3 input3 pos3 more3 m3 =
let succ4 input4 pos4 more4 m4 =
succ input4 pos4 more4 (f m1 m2 m3 m4) in
m4.run input3 pos3 more3 fail succ4 in
m3.run input2 pos2 more2 fail succ3 in
m2.run input1 pos1 more1 fail succ2
in
m1.run input pos more fail succ1 }
let ( *>) a b =
(* a >>= fun _ -> b *)
{ run = fun input pos more fail succ ->
let succ' input' pos' more' _ = b.run input' pos' more' fail succ in
a.run input pos more fail succ'
}
let (<* ) a b =
(* a >>= fun x -> b >>| fun _ -> x *)
{ run = fun input pos more fail succ ->
let succ0 input0 pos0 more0 x =
let succ1 input1 pos1 more1 _ = succ input1 pos1 more1 x in
b.run input0 pos0 more0 fail succ1
in
a.run input pos more fail succ0 }
end
module Choice = struct
let (<?>) p mark =
{ run = fun input pos more fail succ ->
let fail' input' pos' more' marks msg =
fail input' pos' more' (mark::marks) msg in
p.run input pos more fail' succ
}
let (<|>) p q =
{ run = fun input pos more fail succ ->
let fail' input' pos' more' marks msg =
(* The only two constructors that introduce new failure continuations are
* [<?>] and [<|>]. If the initial input position is less than the length
* of the committed input, then calling the failure continuation will
* have the effect of unwinding all choices and collecting marks along
* the way. *)
if pos < Input.parser_committed_bytes input' then
fail input' pos' more marks msg
else
q.run input' pos more' fail succ in
p.run input pos more fail' succ
}
end
module Monad_use_for_debugging = struct
let return = Monad.return
let fail = Monad.fail
let (>>=) = Monad.(>>=)
let (>>|) m f = m >>= fun x -> return (f x)
let (<$>) f m = m >>| f
let (<*>) f m = f >>= fun f -> m >>| f
let lift = (>>|)
let lift2 f m1 m2 = f <$> m1 <*> m2
let lift3 f m1 m2 m3 = f <$> m1 <*> m2 <*> m3
let lift4 f m1 m2 m3 m4 = f <$> m1 <*> m2 <*> m3 <*> m4
let ( *>) a b = a >>= fun _ -> b
let (<* ) a b = a >>= fun x -> b >>| fun _ -> x
end

27
unikernel/duniverse/angstrom/lib_test/dune Normal file
View file

@ -0,0 +1,27 @@
(library
(name angstrom_test)
(libraries angstrom)
(flags :standard -safe-string)
(modules test_let_syntax_native test_let_syntax_ppx)
(preprocess
(per_module
(future_syntax test_let_syntax_native)
((pps ppx_let) test_let_syntax_ppx))))
(executables
(libraries alcotest angstrom angstrom_test)
(modules test_angstrom)
(names test_angstrom))
(executables
(libraries bigstringaf angstrom RFC7159)
(modules test_json)
(names test_json))
(alias
(name runtest)
(package angstrom)
(deps
(:< test_angstrom.exe))
(action
(run %{<})))

449
unikernel/duniverse/angstrom/lib_test/test_angstrom.ml Normal file
View file

@ -0,0 +1,449 @@
open Angstrom
module Alcotest = struct
include Alcotest
let bigstring =
Alcotest.testable
(fun fmt _bs -> Fmt.pf fmt "<bigstring>")
( = )
end
let check ?size f p is =
let open Buffered in
let state =
List.fold_left (fun state chunk ->
feed state (`String chunk))
(parse ?initial_buffer_size:size p) is
in
f (state_to_result (feed state `Eof))
let check_ok ?size ~msg test p is r =
let r = Ok r in
check ?size (fun result -> Alcotest.(check (result test string)) msg r result)
p is
let check_fail ?size ~msg p is =
let r = Error "" in
check ?size (fun result -> Alcotest.(check (result reject pass)) msg r result)
p is
let check_c ?size ~msg p is r = check_ok ?size ~msg Alcotest.char p is r
let check_lc ?size ~msg p is r = check_ok ?size ~msg Alcotest.(list char) p is r
let check_co ?size ~msg p is r = check_ok ?size ~msg Alcotest.(option char) p is r
let check_s ?size ~msg p is r = check_ok ?size ~msg Alcotest.string p is r
let check_bs ?size ~msg p is r = check_ok ?size ~msg Alcotest.bigstring p is r
let check_ls ?size ~msg p is r = check_ok ?size ~msg Alcotest.(list string) p is r
let check_int ?size ~msg p is r = check_ok ?size ~msg Alcotest.int p is r
let bigstring_of_string s = Bigstringaf.of_string s ~off:0 ~len:(String.length s)
let basic_constructors =
[ "peek_char", `Quick, begin fun () ->
check_co ~msg:"singleton input" peek_char ["t"] (Some 't');
check_co ~msg:"longer input" peek_char ["true"] (Some 't');
check_co ~msg:"empty input" peek_char [""] None;
end
; "peek_char_fail", `Quick, begin fun () ->
check_c ~msg:"singleton input" peek_char_fail ["t"] 't';
check_c ~msg:"longer input" peek_char_fail ["true"] 't';
check_fail ~msg:"empty input" peek_char_fail [""]
end
; "char", `Quick, begin fun () ->
check_c ~msg:"singleton 'a'" (char 'a') ["a"] 'a';
check_c ~msg:"prefix 'a'" (char 'a') ["asdf"] 'a';
check_fail ~msg:"'a' failure" (char 'a') ["b"];
check_fail ~msg:"empty buffer" (char 'a') [""]
end
; "int8", `Quick, begin fun () ->
check_int ~msg:"singleton 'a'" (int8 0x0061) ["a"] 0x61;
check_int ~msg:"prefix 'a'" (int8 0xff61) ["asdf"] 0x61;
check_fail ~msg:"'a' failure" (int8 0xff61) ["b"];
check_fail ~msg:"empty buffer" (int8 0xff61) [""];
end
; "not_char", `Quick, begin fun () ->
check_c ~msg:"not 'a' singleton" (not_char 'a') ["b"] 'b';
check_c ~msg:"not 'a' prefix" (not_char 'a') ["baba"] 'b';
check_fail ~msg:"not 'a' failure" (not_char 'a') ["a"];
check_fail ~msg:"empty buffer" (not_char 'a') [""]
end
; "any_char", `Quick, begin fun () ->
check_c ~msg:"non-empty buffer" any_char ["a"] 'a';
check_fail ~msg:"empty buffer" any_char [""]
end
; "any_{,u}int8", `Quick, begin fun () ->
check_int ~msg:"positive sign preserved" any_int8 ["\127"] 127;
check_int ~msg:"negative sign preserved" any_int8 ["\129"] (-127);
check_int ~msg:"sign invariant" any_uint8 ["\127"] 127;
check_int ~msg:"sign invariant" any_uint8 ["\129"] (129)
end
; "string", `Quick, begin fun () ->
check_s ~msg:"empty string, non-empty buffer" (string "") ["asdf"] "";
check_s ~msg:"empty string, empty buffer" (string "") [""] "";
check_s ~msg:"exact string match" (string "asdf") ["asdf"] "asdf";
check_s ~msg:"string is prefix of input" (string "as") ["asdf"] "as";
check_fail ~msg:"input is prefix of string" (string "asdf") ["asd"];
check_fail ~msg:"non-empty string, empty input" (string "test") [""]
end
; "string_ci", `Quick, begin fun () ->
check_s ~msg:"empty string, non-empty input" (string_ci "") ["asdf"] "";
check_s ~msg:"empty string, empty input" (string_ci "") [""] "";
check_s ~msg:"exact string match" (string_ci "asdf") ["AsDf"] "AsDf";
check_s ~msg:"string is prefix of input" (string_ci "as") ["AsDf"] "As";
check_fail ~msg:"input is prefix of string" (string_ci "asdf") ["Asd"];
check_fail ~msg:"non-empty string, empty input" (string_ci "test") [""]
end
; "take_bigstring", `Quick, begin fun () ->
check_bs ~msg:"empty bigstring" (take_bigstring 0) ["asdf"] (bigstring_of_string "");
check_bs ~msg:"bigstring" (take_bigstring 2) ["asdf"] (bigstring_of_string "as");
check_fail ~msg:"asking for too much" (take_bigstring 5) ["asdf"];
end
; "take_while", `Quick, begin fun () ->
check_s ~msg:"true, non-empty input" (take_while (fun _ -> true)) ["asdf"] "asdf";
check_s ~msg:"true, empty input" (take_while (fun _ -> true)) [""] "";
check_s ~msg:"false, non-empty input" (take_while (fun _ -> false)) ["asdf"] "";
check_s ~msg:"false, empty input" (take_while (fun _ -> false)) [""] "";
end
; "take_while1", `Quick, begin fun () ->
check_s ~msg:"true, non-empty input" (take_while1 (fun _ -> true)) ["asdf"] "asdf";
check_fail ~msg:"false, non-empty input" (take_while1 (fun _ -> false)) ["asdf"];
check_fail ~msg:"true, empty input" (take_while1 (fun _ -> true)) [""];
check_fail ~msg:"false, empty input" (take_while1 (fun _ -> false)) [""];
end
; "advance", `Quick, begin fun () ->
check_s ~msg:"non-empty input" (advance 3 >>= fun () -> take 1) ["asdf"] "f";
check_fail ~msg:"advance more than available" (advance 5) ["asdf"];
check_fail ~msg:"advance on empty input" (advance 3) [""];
end
]
module type EndianBigstring = sig
val set_int16 : Bigstringaf.t -> int -> int -> unit
val set_int32 : Bigstringaf.t -> int -> int32 -> unit
val set_int64 : Bigstringaf.t -> int -> int64 -> unit
val set_float : Bigstringaf.t -> int -> float -> unit
val set_double : Bigstringaf.t -> int -> float -> unit
end
module Endian(Es : EndianBigstring) = struct
type 'a endian = {
name : string;
size : int;
zero : 'a;
min : 'a;
max : 'a;
dump : Bigstringaf.t -> int -> 'a -> unit;
testable : 'a Alcotest.testable
}
let int16 = {
name = "int16";
size = 2;
zero = 0;
min = ~-32768;
max = 32767;
dump = Es.set_int16;
testable = Alcotest.int
}
let int32 = {
name = "int32";
size = 4;
zero = Int32.zero;
min = Int32.min_int;
max = Int32.max_int;
dump = Es.set_int32;
testable = Alcotest.int32
}
let int64 = {
name = "int64";
size = 8;
zero = Int64.zero;
min = Int64.min_int;
max = Int64.max_int;
dump = Es.set_int64;
testable = Alcotest.int64
}
let float = {
name = "float";
size = 4;
zero = 0.0;
(* XXX: Not really min/max *)
min = ~-.2e10;
max = 2e10;
dump = Es.set_float;
testable = Alcotest.float 0.0
}
let double = {
name = "double";
size = 8;
zero = 0.0;
(* XXX: Not really min/max *)
min = ~-.2e30;
max = 2e30;
dump = Es.set_double;
testable = Alcotest.float 0.0
}
let uint16 = { int16 with name = "uint16"; min = 0; max = 65535 }
let uint32 = { int32 with name = "uint32" }
let dump actual size value =
let buf = Bigstringaf.of_string ~off:0 ~len:size (String.make size '\xff') in
actual buf 0 value;
Bigstringaf.substring ~off:0 ~len:size buf
let make_tests e parse = e.name, `Quick, begin fun () ->
check_ok ~msg:"zero" e.testable parse [dump e.dump e.size e.zero] e.zero;
check_ok ~msg:"min" e.testable parse [dump e.dump e.size e.min ] e.min;
check_ok ~msg:"max" e.testable parse [dump e.dump e.size e.max ] e.max;
check_ok ~msg:"trailing" e.testable parse [dump e.dump (e.size + 1) e.zero] e.zero;
end
module type EndianSig = module type of LE
let tests (module E : EndianSig) = [
make_tests int16 E.any_int16;
make_tests int32 E.any_int32;
make_tests int64 E.any_int64;
make_tests uint16 E.any_uint16;
make_tests float E.any_float;
make_tests double E.any_double;
]
end
let little_endian =
let module E = Endian(struct
let set_int16 = Bigstringaf.unsafe_set_int16_le
let set_int32 = Bigstringaf.unsafe_set_int32_le
let set_int64 = Bigstringaf.unsafe_set_int64_le
let set_float bs off f = Bigstringaf.unsafe_set_int32_le bs off (Int32.bits_of_float f)
let set_double bs off d = Bigstringaf.unsafe_set_int64_le bs off (Int64.bits_of_float d)
end) in
E.tests (module LE)
let big_endian =
let module E = Endian(struct
let set_int16 = Bigstringaf.unsafe_set_int16_be
let set_int32 = Bigstringaf.unsafe_set_int32_be
let set_int64 = Bigstringaf.unsafe_set_int64_be
let set_float bs off f = Bigstringaf.unsafe_set_int32_be bs off (Int32.bits_of_float f)
let set_double bs off d = Bigstringaf.unsafe_set_int64_be bs off (Int64.bits_of_float d)
end) in
E.tests (module BE)
let monadic =
[ "fail", `Quick, begin fun () ->
check_fail ~msg:"non-empty input" (fail "<msg>") ["asdf"];
check_fail ~msg:"empty input" (fail "<msg>") [""]
end
; "return", `Quick, begin fun () ->
check_s ~msg:"non-empty input" (return "test") ["asdf"] "test";
check_s ~msg:"empty input" (return "test") [""] "test";
end
; "bind", `Quick, begin fun () ->
check_s ~msg:"data dependency" (take 2 >>= fun s -> string s) ["asas"] "as";
end
]
let applicative =
[ "applicative", `Quick, begin fun () ->
check_s ~msg:"`foo *> bar` returns bar" (string "foo" *> string "bar") ["foobar"] "bar";
check_s ~msg:"`foo <* bar` returns bar" (string "foo" <* string "bar") ["foobar"] "foo";
end
]
let alternative =
[ "alternative", `Quick, begin fun () ->
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';
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";
end ]
let combinators =
[ "many", `Quick, begin fun () ->
check_lc ~msg:"empty input" (many (char 'a')) [""] [];
check_lc ~msg:"single char" (many (char 'a')) ["a"] ['a'];
check_lc ~msg:"two chars" (many (char 'a')) ["aa"] ['a'; 'a'];
end
; "many_till", `Quick, begin fun () ->
check_lc ~msg:"not greedy" (many_till any_char (char '-')) ["ab-ab-"] ['a'; 'b'];
end
; "sep_by1", `Quick, begin fun () ->
let parser = sep_by1 (char ',') (char 'a') in
check_lc ~msg:"single char" parser ["a"] ['a'];
check_lc ~msg:"many chars" parser ["a,a"] ['a'; 'a'];
check_lc ~msg:"no trailing sep" parser ["a,"] ['a'];
end
; "count", `Quick, begin fun () ->
check_lc ~msg:"empty input" (count 0 (char 'a')) [""] [];
check_lc ~msg:"exact input" (count 1 (char 'a')) ["a"] ['a'];
check_lc ~msg:"additonal input" (count 2 (char 'a')) ["aaa"] ['a'; 'a'];
check_fail ~msg:"bad input" (count 2 (char 'a')) ["abb"];
end
; "scan_state", `Quick, begin fun () ->
check_s ~msg:"scan_state" (scan_state "" (fun s -> function
| 'a' -> Some s
| '.' -> None
| c -> Some ((String.make 1 c) ^ s)
)) ["abaacba."] "bcb";
let p =
count 2 (scan_state "" (fun s -> function
| '.' -> None
| c -> Some (s ^ String.make 1 c)
))
>>| String.concat "" in
check_s ~msg:"state reset between runs" p ["bcd."] "bcd";
end
; "consumed", `Quick, begin fun () ->
check_s ~msg:"from beginning" (consumed any_char)
["abc"] "a";
check_s ~msg:"from middle" (any_char *> consumed any_char)
["abc"] "b";
check_c ~msg:"advances input" (any_char *> consumed any_char *> any_char)
["abc"] 'c';
check_s ~msg:"with backtracking" (consumed (char 'a' *> (char 'c' <|> char 'b')))
["abc"] "ab";
check_s ~msg:"with more input" (consumed (string "abc"))
["a"; "bc"] "abc";
check_fail ~msg:"with commit" (consumed (char 'a' *> commit *> char 'b'))
["a"; "b"];
let integer =
option '+' (char '-') *> take_while (function '0'..'9' -> true | _ -> false)
in
check_int ~msg:"parsing an integer" (consumed integer >>| int_of_string)
["-12345"] (-12345);
check_bs ~msg:"bigstring variant" (consumed_bigstring (string "ab"))
["abc"] (bigstring_of_string "ab");
end
]
let incremental =
[ "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
; "peek_char and empty chunks", `Quick, begin fun () ->
let decoder len =
let open Angstrom in
let buf = Buffer.create len in
fix @@ fun m ->
available >>= function
| 0 -> peek_char >>= (function
| Some _ -> commit *> m
| None ->
let ret = Buffer.contents buf in
Buffer.clear buf;
commit *> return ret)
| n -> take n >>= fun chunk -> Buffer.add_string buf chunk; commit *> m
in
check_s ~msg:"empty input multiple times and peek_char"
(decoder 0xFF) [ "Whole Lotta Love"; ""; ""; "" ] "Whole Lotta Love"
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 count_while_regression =
[ "proper position set after count_while", `Quick, begin fun () ->
check_s ~msg:"take_while then eof"
(take_while (fun _ -> true) <* end_of_input) ["asdf"; ""] "asdf";
check_s ~msg:"take_while1 then eof"
(take_while1 (fun _ -> true) <* end_of_input) ["asdf"; ""] "asdf";
end ]
let choice_commit =
[ "", `Quick, begin fun () ->
let p =
choice [ string "@@" *> commit *> char '*'
; string "@" *> commit *> char '!' ]
in
Alcotest.(check (result reject string))
"commit to branch"
(Error ": char '*'")
(parse_string ~consume:All p "@@^");
end ]
let input =
let test p input ~off ~len expect =
match Angstrom.Unbuffered.parse p with
| Done _ | Fail _ -> assert false
| Partial { continue; committed } ->
Alcotest.(check int) "committed is zero" 0 committed;
let bs = Bigstringaf.of_string input ~off:0 ~len:(String.length input) in
let state = continue bs ~off ~len Complete in
Alcotest.(check (result string string))
"offset and length respected"
(Ok expect)
(Angstrom.Unbuffered.state_to_result state);
in
[ "offset and length respected", `Quick, begin fun () ->
let open Angstrom in
let take_all = take_while (fun _ -> true) in
test take_all "abcd" ~off:1 ~len:2 "bc";
test (take 4 *> take_all) "abcdefg" ~off:0 ~len:7 "efg";
end ]
;;
let consume =
[ "consume with choice matching prefix", `Quick, begin fun () ->
let open Angstrom in
let parse ~consume =
parse_string ~consume (many (char 'a')) "aaabbb"
in
Alcotest.(check (result (list char) string))
"consume prefix passes"
(parse ~consume:Prefix)
(Ok [ 'a'; 'a'; 'a' ])
;
Alcotest.(check (result (list char) string))
"consume all fails"
(parse ~consume:All)
(Error ": end_of_input");
end
]
;;
let () =
Alcotest.run "test suite"
[ "basic constructors" , basic_constructors
; "little endian" , little_endian
; "big endian" , big_endian
; "monadic interface" , monadic
; "applicative interface" , applicative
; "alternative" , alternative
; "combinators" , combinators
; "incremental input" , incremental
; "count_while regression", count_while_regression
; "choice and commit" , choice_commit
; "input" , input
; "consume" , consume
]

19
unikernel/duniverse/angstrom/lib_test/test_json.ml Normal file
View file

@ -0,0 +1,19 @@
let read f =
try
let ic = open_in_bin f in
let n = in_channel_length ic in
let s = Bytes.create n in
really_input ic s 0 n;
close_in ic;
let b = Bigstringaf.create n in
Bigstringaf.blit_from_bytes s ~src_off:0 b ~dst_off:0 ~len:n;
b
with e ->
failwith (Printf.sprintf "Cannot read content of %s.\n%s" f (Printexc.to_string e))
;;
let () =
let twitter_big = read Sys.argv.(1) in
match Angstrom.(parse_bigstring ~consume:Consume.Prefix RFC7159.json twitter_big) with
| Ok _ -> ()
| Error err -> failwith err

11
unikernel/duniverse/angstrom/lib_test/test_let_syntax_native.ml Normal file
View file

@ -0,0 +1,11 @@
open Angstrom
let (_ : int t) =
let* () = end_of_input in
return 1
let (_ : int t) =
let+ (_ : char) = any_char
and+ (_ : string) = string "foo"
in
2

18
unikernel/duniverse/angstrom/lib_test/test_let_syntax_ppx.ml Normal file
View file

@ -0,0 +1,18 @@
open Angstrom
open Let_syntax
let (_ : int t) =
let%bind () = end_of_input in
return 1
let (_ : int t) =
let%map (_ : char) = any_char
and (_ : string) = string "foo"
in
2
let (_ : int t) =
let%mapn (_ : char) = any_char
and (_ : string) = string "foo"
in
2

81
unikernel/duniverse/angstrom/lwt/angstrom_lwt_unix.ml Normal file
View file

@ -0,0 +1,81 @@
(*----------------------------------------------------------------------------
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.
----------------------------------------------------------------------------*)
open Angstrom.Buffered
open Lwt
let default_pushback () = return_unit
let rec buffered_state_loop pushback state in_chan bytes =
let size = Bytes.length bytes in
match state with
| Partial k ->
Lwt_io.read_into in_chan bytes 0 size
>|= begin function
| 0 -> k `Eof
| len ->
assert (len > 0);
k (`String (Bytes.(unsafe_to_string (sub bytes 0 len))))
end
>>= fun state' -> pushback ()
>>= fun () -> buffered_state_loop pushback state' in_chan bytes
| state -> return state
let handle_parse_result state =
match state_to_unconsumed state with
| None -> assert false
| Some us -> us, state_to_result state
let parse ?(pushback=default_pushback) p in_chan =
let size = Lwt_io.buffer_size in_chan in
let bytes = Bytes.create size in
buffered_state_loop pushback (parse ~initial_buffer_size:size p) in_chan bytes
>|= handle_parse_result
let with_buffered_parse_state ?(pushback=default_pushback) state in_chan =
let size = Lwt_io.buffer_size in_chan in
let bytes = Bytes.create size in
begin match state with
| Partial _ -> buffered_state_loop pushback state in_chan bytes
| _ -> return state
end
>|= handle_parse_result
let async_many e k =
Angstrom.(skip_many (e <* commit >>| k) <?> "async_many")
let parse_many p write in_chan =
let wait = ref (default_pushback ()) in
let k x = wait := write x in
let pushback () = !wait in
parse ~pushback (async_many p k) in_chan

72
unikernel/duniverse/angstrom/lwt/angstrom_lwt_unix.mli Normal file
View file

@ -0,0 +1,72 @@
(*---------------------------------------------------------------------------
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.
----------------------------------------------------------------------------*)
open Angstrom
val parse
: ?pushback:(unit -> unit Lwt.t)
-> 'a t
-> Lwt_io.input_channel
-> (Buffered.unconsumed * ('a, string) result) Lwt.t
val parse_many
: 'a t
-> ('a -> unit Lwt.t)
-> Lwt_io.input_channel
-> (Buffered.unconsumed * (unit, string) result) Lwt.t
(** Useful for resuming a {!parse} that returns unconsumed data. Construct a
[Buffered.state] by using [Buffered.parse] and provide it into this
function. This is essentially what {!parse_many} does, so consider using
that if you don't require fine-grained control over how many times you want
the parser to succeed.
Usage example:
{[
parse parser in_channel >>= fun (unconsumed, result) ->
match result with
| Ok a ->
let { buf; off; len } = unconsumed in
let state = Buffered.parse parser in
let state = Buffered.feed state (`Bigstring (Bigstringaf.sub ~off ~len buf)) in
with_buffered_parse_state state in_channel
| Error err -> failwith err
]} *)
val with_buffered_parse_state
: ?pushback:(unit -> unit Lwt.t)
-> 'a Buffered.state
-> Lwt_io.input_channel
-> (Buffered.unconsumed * ('a, string) result) Lwt.t

5
unikernel/duniverse/angstrom/lwt/dune Normal file
View file

@ -0,0 +1,5 @@
(library
(name angstrom_lwt_unix)
(public_name angstrom-lwt-unix)
(flags :standard -safe-string)
(libraries angstrom lwt.unix))

52
unikernel/duniverse/angstrom/unix/angstrom_unix.ml Normal file
View file

@ -0,0 +1,52 @@
(*----------------------------------------------------------------------------
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.
----------------------------------------------------------------------------*)
open Angstrom.Buffered
let parse ?(buf_size=0x1000) p in_chan =
let bytes = Bytes.create buf_size in
let rec loop = function
| Partial k ->
begin match input in_chan bytes 0 buf_size with
| 0 -> loop (k `Eof)
| n -> loop (k (`String (Bytes.(unsafe_to_string (sub bytes 0 n)))))
end
| state -> state
in
let state = loop (parse p) in
match state_to_unconsumed state with
| None -> assert false
| Some us -> us, state_to_result state
let parse_many ?buf_size p k in_chan =
parse ?buf_size Angstrom.(skip_many (p <* commit >>| k)) in_chan

48
unikernel/duniverse/angstrom/unix/angstrom_unix.mli Normal file
View file

@ -0,0 +1,48 @@
(*----------------------------------------------------------------------------
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.
----------------------------------------------------------------------------*)
open Angstrom
val parse :
?buf_size:int
-> 'a t
-> in_channel
-> Buffered.unconsumed * ('a, string) result
val parse_many :
?buf_size:int
-> 'a t
-> ('a -> unit)
-> in_channel
-> Buffered.unconsumed * (unit, string) result

4
unikernel/duniverse/angstrom/unix/dune Normal file
View file

@ -0,0 +1,4 @@
(library
(name angstrom_unix)
(public_name angstrom-unix)
(libraries angstrom unix))