diff --git a/.travis.yml b/.travis.yml index cfb702e..359fa6b 100644 --- a/.travis.yml +++ b/.travis.yml @@ -10,6 +10,7 @@ env: - PINS="angstrom-async:. angstrom-lwt-unix:. angstrom:." - PACKAGE="angstrom" - TESTS=true + - EXTRA_DEPS="ppx_let" - POST_INSTALL_HOOK="opam install --with-test angstrom-async angstrom-lwt-unix && opam exec -- make examples" matrix: - OCAML_VERSION="4.08" diff --git a/angstrom.opam b/angstrom.opam index 2537e7e..721a437 100644 --- a/angstrom.opam +++ b/angstrom.opam @@ -12,10 +12,12 @@ build: [ ] depends: [ "ocaml" {>= "4.04.0"} - "dune" {>= "1.0"} + "dune" {>= "1.8"} "alcotest" {with-test & >= "0.8.1"} "bigstringaf" "result" + "ppx_let" {with-test & >= "0.14.0"} + "ocaml-syntax-shims" {build} ] synopsis: "Parser combinators built for speed and memory-efficiency" description: """ diff --git a/dune-project b/dune-project index b28bf05..5bfddd0 100644 --- a/dune-project +++ b/dune-project @@ -1,2 +1,2 @@ -(lang dune 1.0) +(lang dune 1.8) (name angstrom) diff --git a/lib/angstrom.ml b/lib/angstrom.ml index 6d9d851..b025121 100644 --- a/lib/angstrom.ml +++ b/lib/angstrom.ml @@ -571,6 +571,33 @@ let consume_with p f = 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 diff --git a/lib/angstrom.mli b/lib/angstrom.mli index e947699..b9fd964 100644 --- a/lib/angstrom.mli +++ b/lib/angstrom.mli @@ -271,6 +271,10 @@ 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]. *) @@ -387,6 +391,9 @@ 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] *) @@ -426,6 +433,34 @@ val lift4 : ('a -> 'b -> 'c -> 'd -> 'e) -> 'a t -> 'b t -> 'c t -> 'd t -> 'e t 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 diff --git a/lib/dune b/lib/dune index 0e6cc37..65b87bc 100644 --- a/lib/dune +++ b/lib/dune @@ -2,4 +2,5 @@ (name angstrom) (public_name angstrom) (libraries bigstringaf) - (flags :standard -safe-string)) + (flags :standard -safe-string) + (preprocess future_syntax)) diff --git a/lib_test/dune b/lib_test/dune index 2e30ab3..6e00fe3 100644 --- a/lib_test/dune +++ b/lib_test/dune @@ -1,5 +1,15 @@ +(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) + (libraries alcotest angstrom angstrom_test) (modules test_angstrom) (names test_angstrom)) @@ -14,4 +24,4 @@ (deps (:< test_angstrom.exe)) (action - (run %{<}))) + (run %{<}))) \ No newline at end of file diff --git a/lib_test/test_let_syntax_native.ml b/lib_test/test_let_syntax_native.ml new file mode 100644 index 0000000..46db480 --- /dev/null +++ b/lib_test/test_let_syntax_native.ml @@ -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 diff --git a/lib_test/test_let_syntax_ppx.ml b/lib_test/test_let_syntax_ppx.ml new file mode 100644 index 0000000..8640452 --- /dev/null +++ b/lib_test/test_let_syntax_ppx.ml @@ -0,0 +1,22 @@ +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 + +(* [mapn] support was introduced in ppx_let.v0.14.0, which CI does not reliably + install. *) +(* +let (_ : int t) = + let%mapn (_ : char) = any_char + and (_ : string) = string "foo" + in + 2 +*)