balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

113.43+70

Browse Source
This commit is contained in:
Jeremie Dimino 2016-05-20 12:01:06 +01:00
parent 505f76ad99
commit e3c12d9dd2
7 changed files with 46 additions and 169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
META.ab
View File

@ -1,6 +1,6 @@
version = "$(pkg_version)"
description = "Monadic let-bindings"
requires = "ppx_core ppx_driver"
requires = "compiler-libs.common ppx_core ppx_driver"
archive(ppx_driver, byte ) = "ppx_let.cma"
archive(ppx_driver, native) = "ppx_let.cmxa"
plugin(ppx_driver, byte ) = "ppx_let.cma"

2
Makefile
View File

@ -2,7 +2,7 @@
SETUP := setup.exe
NAME := ppx_let
PREFIX = $(shell grep ^prefix= setup.data | cut -d\" -f 2)
PREFIX ?= $(shell grep ^prefix= setup.data | cut -d\" -f 2)
# Default rule
default: build

21
README.md
View File

@ -132,25 +132,18 @@ module Let_syntax : sig
val map : 'a t -> f:('a -> 'b) -> 'b t
val both : 'a t -> 'b t -> ('a * 'b) t
module Open_on_rhs : << some signature >>
module Open_in_body : << some signature >>
end
```
The `Open_on_rhs` and `Open_in_body` submodules are used by variants
of `%map` and `%bind` called `%map_open` and `%bind_open`.
The `Open_on_rhs` submodule is used by variants of `%map` and `%bind`
called `%map_open` and `%bind_open`. It is locally opened on the
right hand sides of the rewritten let bindings in `%map_open` and
`%bind_open` expressions. For `match%map_open` and `match%bind_open`
expressions, `Open_on_rhs` is opened for the expression being matched
on.
The `Open_on_rhs` submodule is locally opened on the right hand sides
of the rewritten let bindings in `%map_open` and `%bind_open`
expressions. This is useful when programming with applicatives, which
`Open_on_rhs` is useful when programming with applicatives, which
operate in a staged manner where the operators used to construct the
applicatives are distinct from the operators used to manipulate the
values those applicatives produce. For monads, `Open_on_rhs` contains
`return`.
The `Open_in_body` submodule is locally opened in the body of either a
`let%map_open` or `let%bind_open`. It is often empty for
applicatives. For monads in `Core`, it contains `return`.
For `match%map_open` and `match%bind_open` expressions, `Open_on_rhs`
is opened for the expression being matched on, and `Open_in_body` is
opened in the body of each pattern match clause.

5
_oasis
View File

@ -2,7 +2,7 @@ OASISFormat: 0.4
OCamlVersion: >= 4.02.3
FindlibVersion: >= 1.3.2
Name: ppx_let
Version: 113.33.03
Version: 113.43+70
Synopsis: Monadic let-bindings
Authors: Jane Street Group, LLC <opensource@janestreet.com>
Copyrights: (C) 2015-2016 Jane Street Group LLC <opensource@janestreet.com>
@ -25,7 +25,8 @@ Library ppx_let
Path: src
Pack: false
Modules: Ppx_let
BuildDepends: ppx_core,
BuildDepends: compiler-libs.common,
ppx_core,
ppx_driver
Executable ppx

12
src/ppx_let.ml
View File

@ -33,7 +33,6 @@ end
let let_syntax = "Let_syntax"
let open_on_rhs ~loc = Located.mk ~loc (Longident.Ldot (Lident let_syntax, "Open_on_rhs" ))
let open_in_body ~loc = Located.mk ~loc (Longident.Ldot (Lident let_syntax, "Open_in_body"))
let eoperator ~loc func =
let lid : Longident.t = Ldot (Longident.Lident let_syntax, func) in
@ -90,17 +89,10 @@ let expand_let extension_name ~loc bindings body =
ppat_tuple ~loc [p; acc])
in
bind_apply ~loc extension_name ~arg:nested_boths
~fn:(pexp_fun ~loc "" None nested_patterns
(maybe_open extension_name ~to_open:open_in_body body))
~fn:(pexp_fun ~loc "" None nested_patterns body)
;;
let expand_match extension_name ~loc expr cases =
let cases =
List.map cases ~f:(fun case ->
{ case with
pc_rhs = maybe_open extension_name ~to_open:open_in_body case.pc_rhs;
})
in
bind_apply ~loc extension_name
~arg:(maybe_open extension_name ~to_open:open_on_rhs expr)
~fn:(pexp_function ~loc cases)
@ -132,7 +124,7 @@ let expand ~loc:_ ~path:_ extension_name expr =
;;
let ext extension_name =
Extension.V2.declare
Extension.declare
(Extension_name.to_string extension_name)
Extension.Context.expression
Ast_pattern.(single_expr_payload __)

1
test/test-locations.mlt
View File

@ -8,7 +8,6 @@ module Let_syntax = struct
let return x = T x
let f x ~(doc:string) = T (x, doc)
end
module Open_in_body = struct end
end
let _ = [%map_open let x = return 42 and y = f 42 in ()]

136
test/test.ml
View File

@ -2,13 +2,15 @@ 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 -> ('a -> 'b t) -> 'b t
val map : 'a t -> f:('a -> 'b) -> 'b t
val both : 'a t -> 'b t -> ('a * 'b) t
module Open_on_rhs : sig val return : 'a -> 'a t end
module Open_in_body : sig val return : 'a -> 'a t end
end
end
end = struct
type 'a t = 'a
@ -16,17 +18,19 @@ module Monad_example = struct
let bind x f = f x
let map x ~f = f x
let both x y = (x, y)
module Let_syntax = struct
let return = return
module Let_syntax = struct
let return = return
let bind = bind
let map = map
let both = both
module Open_on_rhs = struct let return = return end
module Open_in_body = struct let return = return end
end
end
end
module Let_syntax = X.Let_syntax
open X.Let_syntax
let _mf a : _ X.t =
let%bind_open x = a in
@ -59,6 +63,8 @@ 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
@ -67,13 +73,15 @@ module Applicative_example = struct
val flag : int t
val anon : int t
end
module Open_in_body : sig end
end
end
end = struct
type 'a t = 'a
let return x = x
let map x ~f = f x
let both x y = (x, y)
module Let_syntax = struct
let return = return
module Let_syntax = struct
let return = return
let map = map
@ -82,11 +90,11 @@ module Applicative_example = struct
let flag = 66
let anon = 77
end
module Open_in_body = struct end
end
end
end
module Let_syntax = X.Let_syntax
open X.Let_syntax
(* {[
let _af a : _ X.t =
@ -120,119 +128,3 @@ module Applicative_example = struct
| 0 -> true
| _ -> false
end
module Async_command_override_example = struct
module Deferred : sig
type 'a t
val return : 'a -> 'a t
module Let_syntax : sig
module Let_syntax : sig
type 'a t
val return : 'a -> 'a t
val map : 'a t -> f:('a -> 'b) -> 'b t
val both : 'a t -> 'b t -> ('a * 'b) t
module Open_on_rhs : sig val return : 'a -> 'a t end
module Open_in_body : sig val return : 'a -> 'a t end
end with type 'a t := 'a t
end
end = struct
type 'a t = 'a
let return x = x
module Let_syntax = struct
module Let_syntax = struct
let return = return
let map x ~f = f x
let both x y = (x, y)
module Open_on_rhs = struct let return = return end
module Open_in_body = struct let return = return end
end
end
end
module Command : sig
module Param : sig
type 'a t
val return : 'a -> 'a t
val flag : 'a -> int t
val anon : 'a -> int t
end
module Let_syntax : sig
module Let_syntax : sig
type 'a t
val return : 'a -> 'a t
val map : 'a t -> f:('a -> 'b) -> 'b t
val both : 'a t -> 'b t -> ('a * 'b) t
module Open_on_rhs = Param
module Open_in_body : sig end
end with type 'a t := 'a Param.t
end
end = struct
module Param = struct
type 'a t = 'a
let return x = x
let map x ~f = f x
let both x y = (x, y)
let flag _ = 66
let anon _ = 77
end
module Let_syntax = struct
module Let_syntax = struct
include Param
module Open_on_rhs = Param
module Open_in_body = struct end
end
end
end
module Command_override = struct
module Param = struct
include Command.Param
let special_flag = flag 88
end
module Let_syntax = struct
open Command.Let_syntax
module Let_syntax = struct
include (Let_syntax : module type of Let_syntax
with module Open_on_rhs := Let_syntax.Open_on_rhs
and module Open_in_body := Let_syntax.Open_in_body)
module Open_on_rhs = Param
module Open_in_body = Deferred.Let_syntax
end
end
end
let _1 : int Command.Param.t =
let open Command.Let_syntax in
[%map_open
let x = flag "foo"
and y = anon "bar"
in
x + y
]
;;
let _1 : (unit -> int Deferred.t) Command_override.Param.t =
let open Command_override.Let_syntax in
[%map_open
let x = flag "foo"
and y = anon "bar"
and z = special_flag
in
(fun () ->
let%map () = Deferred.return () in
x + y + z)
]
;;
let _1 : (unit -> unit Deferred.t) Command.Param.t =
let open Command_override.Let_syntax in
[%map_open
let () = return () in
fun () ->
let%map () = Deferred.return () in
()
]
;;
end