Browse Source

Move infix operators to a separate module Lwd_infix

pull/3/head
Frédéric Bour 2 years ago
parent
commit
ace4e064a0
  1. 15
      lib/lwd/dune
  2. 11
      lib/lwd/lwd.ml
  3. 8
      lib/lwd/lwd.mli
  4. 2
      lib/lwd/lwd_infix_compat.ml
  5. 2
      lib/lwd/lwd_infix_compat.mli
  6. 6
      lib/lwd/lwd_infix_letop.ml
  7. 6
      lib/lwd/lwd_infix_letop.mli
  8. 3
      lib/lwd/lwd_table.ml
  9. 4
      lib/lwd/lwd_table.mli
  10. 18
      lib/lwd/select_version.ml
  11. 2
      lib/nottui-widgets/nottui_widgets.ml

15
lib/lwd/dune

@ -1,5 +1,18 @@
(library
(name lwd)
(public_name lwd)
(modules lwd lwd_table lwd_utils)
(modules lwd lwd_table lwd_infix lwd_utils)
(wrapped false))
(rule
(targets lwd_infix.ml lwd_infix.mli)
(deps lwd_infix_compat.ml lwd_infix_compat.mli
lwd_infix_letop.ml lwd_infix_letop.mli)
(action
(progn
(with-stdout-to lwd_infix.mli (run ./select_version.exe intf))
(with-stdout-to lwd_infix.ml (run ./select_version.exe impl)))))
(executable
(modules select_version)
(name select_version))

11
lib/lwd/lwd.ml

@ -458,14 +458,3 @@ let set_on_invalidate x f =
match x with
| Pure _ | Impure _ | Operator _ -> assert false
| Root t -> t.on_invalidate <- f
(*let unsafe_peek = function
| Pure x -> Some x
| Operator t -> t.value
| Root t -> t.value*)
module Infix = struct
let (let$) = bind
let (and$) = pair
let ($=) = set
end

8
lib/lwd/lwd.mli

@ -33,11 +33,3 @@ val set_on_invalidate : 'a root -> ('a -> unit) -> unit
val sample : 'a root -> 'a
val is_damaged : 'a root -> bool
val release : 'a root -> unit
(*val unsafe_peek : 'a t -> 'a option*)
module Infix : sig
val (let$) : 'a t -> ('a -> 'b t) -> 'b t
val (and$) : 'a t -> 'b t -> ('a * 'b) t
val ($=) : 'a var -> 'a -> unit
end

2
lib/lwd/lwd_infix_compat.ml

@ -0,0 +1,2 @@
let ($=) : 'a Lwd.var -> 'a -> unit = Lwd.set
let ($<-) : 'a Lwd_table.row -> 'a -> unit = Lwd_table.set

2
lib/lwd/lwd_infix_compat.mli

@ -0,0 +1,2 @@
val ($=) : 'a Lwd.var -> 'a -> unit
val ($<-) : 'a Lwd_table.row -> 'a -> unit

6
lib/lwd/lwd_infix_letop.ml

@ -0,0 +1,6 @@
let (let$) : 'a Lwd.t -> ('a -> 'b) -> 'b Lwd.t = Lwd.map'
let (and$) : 'a Lwd.t -> 'b Lwd.t -> ('a * 'b) Lwd.t = Lwd.pair
let (let$*) : 'a Lwd.t -> ('a -> 'b Lwd.t) -> 'b Lwd.t = Lwd.bind
let ($=) : 'a Lwd.var -> 'a -> unit = Lwd.set
let ($<-) : 'a Lwd_table.row -> 'a -> unit = Lwd_table.set

6
lib/lwd/lwd_infix_letop.mli

@ -0,0 +1,6 @@
val (let$) : 'a Lwd.t -> ('a -> 'b) -> 'b Lwd.t
val (let$*) : 'a Lwd.t -> ('a -> 'b Lwd.t) -> 'b Lwd.t
val (and$) : 'a Lwd.t -> 'b Lwd.t -> ('a * 'b) Lwd.t
val ($=) : 'a Lwd.var -> 'a -> unit
val ($<-) : 'a Lwd_table.row -> 'a -> unit

3
lib/lwd/lwd_table.ml

@ -517,9 +517,6 @@ let rec iter f = function
| Root t ->
iter f t.child
module Infix = struct
let ($<-) = set
end
let rec left_most : 'a row -> 'a row option = function
| Root _ -> assert false
| Leaf -> None

4
lib/lwd/lwd_table.mli

@ -27,7 +27,3 @@ val reduce : 'a Lwd_utils.monoid -> 'a t -> 'a Lwd.t
val map_reduce : ('a row -> 'a -> 'b) -> 'b Lwd_utils.monoid -> 'a t -> 'b Lwd.t
val iter : ('a -> unit) -> 'a t -> unit
module Infix : sig
val ($<-) : 'a row -> 'a -> unit
end

18
lib/lwd/select_version.ml

@ -0,0 +1,18 @@
let () =
let version =
Scanf.sscanf Sys.ocaml_version "%d.%d" (fun major minor -> (major, minor))
in
let basename =
if version < (4, 08) then "lwd_infix_compat" else "lwd_infix_letop"
in
let file =
match Sys.argv.(1) with
| "intf" -> basename ^ ".mli"
| "impl" -> basename ^ ".ml"
| _ -> assert false
in
let ic = open_in_bin file in
let length = in_channel_length ic in
let content = really_input_string ic length in
close_in ic;
print_string content

2
lib/nottui-widgets/nottui_widgets.ml

@ -1,6 +1,6 @@
open Lwd_infix
open Notty
open Nottui
open Lwd.Infix
let (!$) x = Lwd.join (Lwd.get x)
let empty_lwd = Lwd.return Ui.empty

Loading…
Cancel
Save