Browse Source

add both native and ppx let-syntax support, and corresponding tests

Aaron Dufour 1 year ago
parent
commit
f29438e004
8 changed files with 109 additions and 5 deletions
  1. 2 1
      angstrom.opam
  2. 1 1
      dune-project
  3. 27 0
      lib/angstrom.ml
  4. 36 0
      lib/angstrom.mli
  5. 2 1
      lib/dune
  6. 12 2
      lib_test/dune
  7. 11 0
      lib_test/test_let_syntax_native.ml
  8. 18 0
      lib_test/test_let_syntax_ppx.ml

+ 2 - 1
angstrom.opam

@@ -12,10 +12,11 @@ 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"}
 ]
 synopsis: "Parser combinators built for speed and memory-efficiency"
 description: """

+ 1 - 1
dune-project

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

+ 27 - 0
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

+ 36 - 0
lib/angstrom.mli

@@ -426,6 +426,42 @@ 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 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. *)
+
+val bind : 'a t -> f:('a -> 'b t) -> 'b t
+(** [bind] is a prefix version of [>>=] *)
+
+val map : 'a t -> f:('a -> 'b) -> 'b t
+(** [map] is a prefix version of [>>|] *)
+
+val both : 'a t -> 'b t -> ('a * 'b) t
+(** [both p q] runs [p] followed by [q] and returns both results in a tuple *)
+
+(** 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
 

+ 2 - 1
lib/dune

@@ -2,4 +2,5 @@
  (name angstrom)
  (public_name angstrom)
  (libraries bigstringaf)
- (flags :standard -safe-string))
+ (flags :standard -safe-string)
+ (preprocess future_syntax))

+ 12 - 2
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 %{<})))

+ 11 - 0
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

+ 18 - 0
lib_test/test_let_syntax_ppx.ml

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