Skip to content
This repository
Newer
Older
100644 82 lines (68 sloc) 1.972 kb
fccc6851 » MLstate
2011-06-21 Initial open-source release
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (*
19 @author Louis Gesbert
20 **)
21
22 type 'a t = ('a -> unit) -> unit
23
24 module Ops = struct
25 let (@>) f k = f k
26 let (|>) x k = k x
27 end
28 open Ops
29
30 module List = struct
31 let rec map f l k = match l with
32 | [] -> [] |> k
33 | hd::tl -> f hd @> fun hd -> map f tl @> fun tl -> hd::tl |> k
34
35 let rec fold f acc l k = match l with
36 | [] -> acc |> k
37 | hd::tl -> f acc hd @> fun acc -> fold f acc tl @> k
38 end
39
40 module Option = struct
ce8dc443 » Mathieu Baudet
2012-01-05 [cleanup] libbase/cps: removed useless keyword rec
41 let map f opt k = match opt with
fccc6851 » MLstate
2011-06-21 Initial open-source release
42 | None -> None |> k
43 | Some x -> f x @> fun x -> Some x |> k
44 end
45
46 module Lazy = struct
47 type 'a t = {
48 push : (unit -> unit) -> unit;
49 mutable value : 'a option;
50 mutable waiters : ('a -> unit) list;
51 cps : ('a -> unit) -> unit;
52 }
53
54 let make push cps = {
55 push = push;
56 value = None;
57 waiters = [];
58 cps = cps;
59 }
60
61 let force l k =
62 match l.value with
63 | Some x -> x |> k
64 | None when l.waiters != [] ->
65 l.waiters <- k::l.waiters
66 | None ->
67 l.waiters <- k::l.waiters;
68 l.cps
69 @> function x ->
70 Base.List.iter (fun k -> l.push (fun () -> k x)) l.waiters;
71 l.value <- Some x;
72 l.waiters <- []
73
74 let get_state cps = cps.value
75
76 let lazy_from_val x = {
77 push = (fun _ -> ());
78 value = Some x;
79 waiters = [];
80 cps = fun k -> k x;
81 }
82 end
Something went wrong with that request. Please try again.