v0.12-preview.120.18+252

LICENSE.md

@@ -1,6 +1,6 @@
 The MIT License
 
-Copyright (c) 2015--2018 Jane Street Group, LLC <opensource@janestreet.com>
+Copyright (c) 2015--2019 Jane Street Group, LLC <opensource@janestreet.com>
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal

Makefile

@@ -1,18 +1,17 @@
 INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),)
 
-# Default rule
 default:
-	jbuilder build @install
+	dune build
 
 install:
-	jbuilder install $(INSTALL_ARGS)
+	dune install $(INSTALL_ARGS)
 
 uninstall:
-	jbuilder uninstall $(INSTALL_ARGS)
+	dune uninstall $(INSTALL_ARGS)
 
 reinstall: uninstall install
 
 clean:
-	rm -rf _build
+	dune clean
 
 .PHONY: default install uninstall reinstall clean

dune-project

@@ -0,0 +1 @@
+(lang dune 1.5)

expander/dune

@@ -0,0 +1,2 @@
+(library (name ppx_let_expander) (public_name ppx_let.expander)
+ (libraries base ppxlib) (preprocess no_preprocessing))

expander/jbuild

@@ -1,7 +0,0 @@
-(library (
-  (name        ppx_let_expander)
-  (public_name ppx_let.expander)
-  (libraries  (base ppxlib))
-  (preprocess no_preprocessing)))
-
-(jbuild_version 1)

expander/ppx_let_expander.ml

@@ -9,6 +9,7 @@ module List = struct
     match l with
     | [] -> invalid_arg "List.reduce_exn"
     | hd :: tl -> fold_left tl ~init:hd ~f
+  ;;
 end
 
 module Extension_name = struct
@@ -20,22 +21,26 @@ module Extension_name = struct
 
   let operator_name = function
     | Bind | Bind_open -> "bind"
-    | Map  | Map_open  -> "map"
+    | Map | Map_open -> "map"
+  ;;
 
-  let to_string =  function
+  let to_string = function
-    | Bind      -> "bind"
+    | Bind -> "bind"
     | Bind_open -> "bind_open"
-    | Map       -> "map"
+    | Map -> "map"
-    | Map_open  -> "map_open"
+    | Map_open -> "map_open"
+  ;;
 end
 
 let let_syntax ~modul : Longident.t =
   match modul with
   | None -> Lident "Let_syntax"
   | Some id -> Ldot (id.txt, "Let_syntax")
+;;
 
 let open_on_rhs ~loc ~modul =
-  Located.mk ~loc (Longident.Ldot (let_syntax ~modul, "Open_on_rhs" ))
+  Located.mk ~loc (Longident.Ldot (let_syntax ~modul, "Open_on_rhs"))
+;;
 
 let eoperator ~loc ~modul func =
   let lid : Longident.t = Ldot (let_syntax ~modul, func) in
@@ -44,30 +49,33 @@ let eoperator ~loc ~modul func =
 
 let expand_with_tmp_vars ~loc bindings expr ~f =
   match bindings with
-  | [_] -> f ~loc bindings expr
+  | [ _ ] -> f ~loc bindings expr
   | _ ->
-    let tmp_vars = List.map bindings ~f:(fun _ -> gen_symbol ~prefix:"__let_syntax" ()) in
+    let tmp_vars =
+      List.map bindings ~f:(fun _ -> gen_symbol ~prefix:"__let_syntax" ())
+    in
     let s_rhs_tmp_var (* s/rhs/tmp_var *) =
       List.map2_exn bindings tmp_vars ~f:(fun vb var ->
         { vb with pvb_expr = evar ~loc:vb.pvb_expr.pexp_loc var })
     in
     let s_lhs_tmp_var (* s/lhs/tmp_var *) =
-      List.map2_exn bindings tmp_vars  ~f:(fun vb var ->
+      List.map2_exn bindings tmp_vars ~f:(fun vb var ->
         { vb with pvb_pat = pvar ~loc:vb.pvb_pat.ppat_loc var })
     in
     pexp_let ~loc Nonrecursive s_lhs_tmp_var (f ~loc s_rhs_tmp_var expr)
 ;;
 
 let bind_apply ~loc ~modul extension_name ~arg ~fn =
-  pexp_apply ~loc
+  pexp_apply
+    ~loc
     (eoperator ~loc ~modul (Extension_name.operator_name extension_name))
-    [(Nolabel, arg); (Labelled "f", fn)]
+    [ Nolabel, arg; Labelled "f", fn ]
 ;;
 
 let maybe_open extension_name ~to_open:module_to_open expr =
   let loc = expr.pexp_loc in
   match (extension_name : Extension_name.t) with
-  | Bind      | Map      -> expr
+  | Bind | Map -> expr
   | Bind_open | Map_open -> pexp_open ~loc Override (module_to_open ~loc) expr
 ;;
 
@@ -79,30 +87,41 @@ let expand_let extension_name ~loc ~modul bindings body =
     let rev_boths = List.rev_map bindings ~f:(fun vb -> vb.pvb_expr) in
     List.reduce_exn rev_boths ~f:(fun acc e ->
       let loc = e.pexp_loc in
-      eapply ~loc (eoperator ~loc ~modul "both") [e; acc])
+      eapply ~loc (eoperator ~loc ~modul "both") [ e; acc ])
   in
   (* Build pattern [(P1, (P2, ...))] *)
   let nested_patterns =
     let rev_patts = List.rev_map bindings ~f:(fun vb -> vb.pvb_pat) in
     List.reduce_exn rev_patts ~f:(fun acc p ->
       let loc = p.ppat_loc in
-      ppat_tuple ~loc [p; acc])
+      ppat_tuple ~loc [ p; acc ])
   in
-  bind_apply ~loc ~modul extension_name ~arg:nested_boths
+  bind_apply
+    ~loc
+    ~modul
+    extension_name
+    ~arg:nested_boths
     ~fn:(pexp_fun ~loc Nolabel None nested_patterns body)
 ;;
 
 let expand_match extension_name ~loc ~modul expr cases =
-  bind_apply ~loc ~modul extension_name
+  bind_apply
+    ~loc
+    ~modul
+    extension_name
     ~arg:(maybe_open extension_name ~to_open:(open_on_rhs ~modul) expr)
     ~fn:(pexp_function ~loc cases)
 ;;
 
 let expand_if extension_name ~loc expr then_ else_ =
-  expand_match extension_name ~loc expr
+  expand_match
-    [ case ~lhs:(pbool ~loc true)  ~guard:None ~rhs:then_
+    extension_name
+    ~loc
+    expr
+    [ case ~lhs:(pbool ~loc true) ~guard:None ~rhs:then_
     ; case ~lhs:(pbool ~loc false) ~guard:None ~rhs:else_
     ]
+;;
 
 let expand ~modul extension_name expr =
   let loc = expr.pexp_loc in
@@ -118,32 +137,38 @@ let expand ~modul extension_name expr =
                For reference, here is the relevant part of the parser:
                https://github.com/ocaml/ocaml/blob/4.07/parsing/parser.mly#L1628 *)
             match vb.pvb_pat.ppat_desc, vb.pvb_expr.pexp_desc with
-            | Ppat_constraint (p, { ptyp_desc = Ptyp_poly ([], t1); _ }),
+            | ( Ppat_constraint (p, { ptyp_desc = Ptyp_poly ([], t1); _ })
-              Pexp_constraint (_, t2) when phys_equal t1 t2 -> p
+              , Pexp_constraint (_, t2) )
+              when phys_equal t1 t2 -> p
             | _ -> vb.pvb_pat
           in
           { vb with
-            pvb_pat;
+            pvb_pat
-            pvb_expr = maybe_open extension_name ~to_open:(open_on_rhs ~modul) vb.pvb_expr;
+          ; pvb_expr =
+              maybe_open extension_name ~to_open:(open_on_rhs ~modul) vb.pvb_expr
           })
       in
       expand_with_tmp_vars ~loc bindings expr ~f:(expand_let extension_name ~modul)
     | Pexp_let (Recursive, _, _) ->
-      Location.raise_errorf ~loc "'let%%%s' may not be recursive"
+      Location.raise_errorf
+        ~loc
+        "'let%%%s' may not be recursive"
         (Extension_name.to_string extension_name)
-    | Pexp_match (expr, cases) ->
+    | Pexp_match (expr, cases) -> expand_match extension_name ~loc ~modul expr cases
-      expand_match extension_name ~loc ~modul expr cases
     | Pexp_ifthenelse (expr, then_, else_) ->
       let else_ =
         match else_ with
         | Some else_ -> else_
         | None ->
-          Location.raise_errorf ~loc "'if%%%s' must include an else branch"
+          Location.raise_errorf
+            ~loc
+            "'if%%%s' must include an else branch"
             (Extension_name.to_string extension_name)
       in
       expand_if extension_name ~loc ~modul expr then_ else_
     | _ ->
-      Location.raise_errorf ~loc
+      Location.raise_errorf
+        ~loc
         "'%%%s' can only be used with 'let', 'match', and 'if'"
         (Extension_name.to_string extension_name)
   in

expander/ppx_let_expander.mli

@@ -6,12 +6,8 @@ module Extension_name : sig
     | Bind_open
     | Map
     | Map_open
+
   val to_string : t -> string
 end
 
-val expand
+val expand : modul:longident loc option -> Extension_name.t -> expression -> expression
-  : modul:longident loc option
-  -> Extension_name.t
-  -> expression
-  -> expression
-

jbuild

@@ -1,2 +0,0 @@
-
-(jbuild_version 1)

ppx_let.opam

@@ -1,21 +1,21 @@
-opam-version: "1.2"
+opam-version: "2.0"
 maintainer: "opensource@janestreet.com"
 authors: ["Jane Street Group, LLC <opensource@janestreet.com>"]
 homepage: "https://github.com/janestreet/ppx_let"
 bug-reports: "https://github.com/janestreet/ppx_let/issues"
 dev-repo: "git+https://github.com/janestreet/ppx_let.git"
+doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/ppx_let/index.html"
 license: "MIT"
 build: [
-  ["jbuilder" "build" "-p" name "-j" jobs]
+  ["dune" "build" "-p" name "-j" jobs]
 ]
 depends: [
+  "ocaml" {>= "4.04.2"}
   "base"
-  "jbuilder" {build & >= "1.0+beta18.1"}
+  "dune"   {build & >= "1.5.1"}
-  "ppxlib"   {>= "0.1.0"}
+  "ppxlib" {>= "0.4.0"}
 ]
-available: [ ocaml-version >= "4.04.2" ]
+synopsis: "Monadic let-bindings"
-descr: "
+description: "
-Monadic let-bindings
-
 Part of the Jane Street's PPX rewriters collection.
 "

src/dune

@@ -0,0 +1,2 @@
+(library (name ppx_let) (public_name ppx_let) (kind ppx_rewriter)
+ (libraries base ppxlib ppx_let_expander) (preprocess no_preprocessing))

src/jbuild

@@ -1,8 +0,0 @@
-(library (
-  (name        ppx_let)
-  (public_name ppx_let)
-  (kind      ppx_rewriter)
-  (libraries            (base ppxlib ppx_let_expander))
-  (preprocess no_preprocessing)))
-
-(jbuild_version 1)

src/ppx_let.ml

@@ -10,11 +10,7 @@ let ext extension_name =
 ;;
 
 let () =
-  Driver.register_transformation "let"
+  Driver.register_transformation
-    ~extensions:[
+    "let"
-      ext Bind;
+    ~extensions:[ ext Bind; ext Bind_open; ext Map; ext Map_open ]
-      ext Bind_open;
-      ext Map;
-      ext Map_open;
-    ]
 ;;

src/ppx_let.mli

@@ -0,0 +1 @@
+

test/dune

@@ -0,0 +1 @@
+(executables (names test) (preprocess (pps ppx_let)))

test/jbuild

@@ -1,6 +0,0 @@
-(executables (
-  (names (test))
-  (preprocess (pps (ppx_let ppxlib.runner)))))
-
-
-(jbuild_version 1)

test/test-locations.mlt

@@ -2,17 +2,26 @@
 
 module Let_syntax = struct
   type 'a t = T of 'a
+
   let map (T x) ~f = T (f x)
   let both (T x) (T y) = T (x, y)
+
   module Open_on_rhs = struct
     let return x = T x
-    let f x ~(doc:string) = T (x, doc)
+    let f x ~(doc : string) = T (x, doc)
   end
 end
 
-let _ = [%map_open let x = return 42 and y = f 42 in ()]
+let _ =
-[%%expect{|
+  [%map_open
-Line _, characters 45-49:
+    let x = return 42
+    and y = f 42 in
+    ()]
+;;
+
+[%%expect
+  {|
+Line _, characters 12-16:
 Error: This expression has type doc:string -> (int * string) Let_syntax.t
        but an expression was expected of type 'a Let_syntax.t
 |}]

test/test.ml

@@ -1,31 +1,41 @@
 module Monad_example = struct
-
   module X : sig
     type 'a t
+
     module Let_syntax : sig
       val return : 'a -> 'a t
+
       module Let_syntax : sig
         val return : 'a -> 'a t
-        val bind   : 'a t -> f:('a -> 'b t) -> 'b t
+        val bind : 'a t -> f:('a -> 'b t) -> 'b t
-        val map    : 'a t -> f:('a -> 'b) -> 'b t
+        val map : 'a t -> f:('a -> 'b) -> 'b t
-        val both   : 'a t -> 'b t -> ('a * 'b) t
+        val both : 'a t -> 'b t -> ('a * 'b) t
-        module Open_on_rhs  : sig val return : 'a -> 'a t end
+
+        module Open_on_rhs : sig
+          val return : 'a -> 'a t
+        end
       end
     end
   end = struct
     type 'a t = 'a
+
     let return x = x
     let bind x ~f = f x
     let map x ~f = f x
-    let both x y = (x, y)
+    let both x y = x, y
+
     module Let_syntax = struct
       let return = return
+
       module Let_syntax = struct
         let return = return
-        let bind   = bind
+        let bind = bind
-        let map    = map
+        let map = map
-        let both   = both
+        let both = both
-        module Open_on_rhs  = struct let return = return end
+
+        module Open_on_rhs = struct
+          let return = return
+        end
       end
     end
   end
@@ -35,50 +45,55 @@ module Monad_example = struct
   let _mf a : _ X.t =
     let%bind_open x = a in
     return (x + 1)
+  ;;
 
   let _mf' a b c : _ X.t =
-    let%bind_open x = a and y = b and (u, v) = c in
+    let%bind_open x = a
+    and y = b
+    and u, v = c in
     return (x + y + (u * v))
+  ;;
 
   let _mg a : _ X.t =
     let%map x : int X.t = a in
     x + 1
+  ;;
 
   let _mg' a b c : _ X.t =
-    let%map x = a and y = b and (u, v) = c in
+    let%map x = a
+    and y = b
+    and u, v = c in
     x + y + (u * v)
+  ;;
 
   let _mh a : _ X.t =
     match%bind_open a with
     | 0 -> return true
     | _ -> return false
+  ;;
 
   let _mi a : _ X.t =
     match%map a with
     | 0 -> true
     | _ -> false
+  ;;
 
-  let _mif a : _ X.t =
+  let _mif a : _ X.t = if%bind_open a then return true else return false
-    if%bind_open a
+  let _mif' a : _ X.t = if%map a then true else false
-    then return true
-    else return false
-
-  let _mif' a : _ X.t =
-    if%map a
-    then true
-    else false
 end
 
 module Applicative_example = struct
-
   module X : sig
     type 'a t
+
     module Let_syntax : sig
       val return : 'a -> 'a t
+
       module Let_syntax : sig
         val return : 'a -> 'a t
-        val map    : 'a t -> f:('a -> 'b) -> 'b t
+        val map : 'a t -> f:('a -> 'b) -> 'b t
-        val both   : 'a t -> 'b t -> ('a * 'b) t
+        val both : 'a t -> 'b t -> ('a * 'b) t
+
         module Open_on_rhs : sig
           val flag : int t
           val anon : int t
@@ -87,15 +102,19 @@ module Applicative_example = struct
     end
   end = struct
     type 'a t = 'a
+
     let return x = x
     let map x ~f = f x
-    let both x y = (x, y)
+    let both x y = x, y
+
     module Let_syntax = struct
       let return = return
+
       module Let_syntax = struct
         let return = return
-        let map    = map
+        let map = map
-        let both   = both
+        let both = both
+
         module Open_on_rhs = struct
           let flag = 66
           let anon = 77
@@ -121,10 +140,14 @@ module Applicative_example = struct
   let _ag a : _ X.t =
     let%map x = a in
     x + 1
+  ;;
 
   let _ag' a b c : _ X.t =
-    let%map x = a and y = b and (u, v) = c in
+    let%map x = a
+    and y = b
+    and u, v = c in
     x + y + (u * v)
+  ;;
 
   (* {[
        let _ah a : _ X.t =
@@ -137,10 +160,12 @@ module Applicative_example = struct
     match%map a with
     | 0 -> true
     | _ -> false
+  ;;
 end
 
 module Example_without_open = struct
   let _ag a : _ Applicative_example.X.t =
     let%map.Applicative_example.X.Let_syntax x = a in
     x + 1
+  ;;
 end