Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 360 lines (275 sloc) 12.938 kB
fccc685 Initial open-source release
MLstate authored
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 (**
20 Runtime library for continuations and concurrency.
21
22 The role of this library is to provide the necessary primitives introduced by the Cps transformation,
23 to be used at runtime.
24
25 This library is meant to be used
26 - directly by low-level libraries (appserver, db3)
27 - transparently by the QML CPS-based compiler
28
29 Beware, by hacking this lib, you should update QmlCpsRewriter consistently
30
31 @author David Rajchenbach-Teller
32 @author Mathieu Barbin
33 *)
34
35 (**
36 {6 Continuations}
37 *)
38
39 type continuation_options =
40 {
41 movable : bool;
42 (**[true] if the continuation may be stolen by another server,
43 [false] otherwise*)
44 atomic : bool;
45 (**[true] if the continuation should not be scheduled.
46 This can cause runtime errors if the continuation contains [wait].*)
47 _lazy : bool;
48 (**[true] if the continuation should be evaluated rather than scheduled.*)
49 }
50
51 (**A mechanism for returning values of type ['a].
52 Optimized implementations should make this a [goto].*)
53 type 'a continuation
54
55 type 'a func0 = 'a continuation -> unit
56 (**The implementation of a function with type ['a -> 'b], after cps-transfo*)
57 type ('a, 'b) func = 'a -> 'b func0
58
59 (**The default options for continuations: movable.*)
60 val default_options : continuation_options
61
62 (** create a cont from its fields : not used currently by the generated code *)
63 val make_cont: continuation_options -> QmlClosureRuntime.t -> 'a continuation
64 val make_cont_ml: continuation_options -> ('a -> unit) -> 'a continuation
65
978b7c4 @akoprow [fix] typo: occurence->occurrence, occured->occurred
akoprow authored
66 (** a short name because of the number of occurrences in the generated code *)
fccc685 Initial open-source release
MLstate authored
67 val cont: QmlClosureRuntime.t -> 'a continuation
68 val cont_ml: ('a -> unit) -> 'a continuation
69
70 (** creating a cont from an other cont, changing nothing but the payload
71 this function is used in the generated code to be able to pass the thread context *)
72 val ccont : 'b continuation -> QmlClosureRuntime.t -> 'a continuation
73 val ccont_ml : 'b continuation -> ('a -> unit) -> 'a continuation
74
75 (**Return a value using a continuation : apply the continuation to the value *)
76 val return : 'a continuation -> 'a -> unit
77
78 (** Like [return] but can't be schedule before return value to
79 continuation. *)
80 val execute : 'a continuation -> 'a -> unit
81
82 val update_cont : 'a continuation -> _ continuation option -> string -> string -> _ -> 'a continuation
83 val print_trace : 'a continuation -> unit
84
85 (** [push_cont k x] Like return but asynchronous. Create a task that
86 apply the continuation to the value, and push it to the cps
87 scheduler. *)
88 val push_cont : 'a continuation -> 'a -> unit
89
90 (** {6 thread context} *)
91
92 (**
93 Setting and accessing the \@thread_context from a continuation. If the thread_context has not been set with
94 [with_thread_context], the returned value is [None]. Otherwise, [thread_context] returns the
95 last context set by [with_thread_context].
96
97 Implementation uses type [Obj.t], which means that you should carrefully use the pair [thread_context/with_thread_context].
98 In practice, these two functions are not used directly, but are exported in the bsl with the tag [restricted:cps],
99 which means that they can be used only be code generated by [QmlCpsRewriter], from the 2 following directives (available
100 in opa and qml) :
101 + \@thread_context
102 + \@with_thread_context
103
104 @see "thread_context.opa" from the stdlib of opa to see how the final user can use this feature.
105 *)
106 (** *)
107 val thread_context : 'a continuation -> 'thread_context option
108 val with_thread_context : 'thread_context -> 'a continuation -> 'a continuation
109
110 (** Similar to thread_context, but for a specific purpose *)
111 val transaction_context : 'a continuation -> 'transaction_context option
112 val with_transaction_context : 'transaction_context -> 'a continuation -> 'a continuation
113
114 (** {6 exceptions} *)
115
116 (** Used to get the exception-handling continuation *)
117 val handler_cont: 'a continuation -> 'exc continuation
118
119 (** Catches exceptions thrown within the continuation *)
120 val catch : QmlClosureRuntime.t -> 'a continuation -> 'a continuation
121 val catch_ml : ('exc -> 'a continuation -> unit) -> 'a continuation -> 'a continuation
122
123 (** Stores and retrieves backtrace data on a cyclic queue. *)
124 val bt_add : string -> unit
125 val bt_take : unit -> string
126 (** Prints a function name and value of its arguments (treated by obj.magic) *)
127 (* TODO: due to limitation of libbsl, it's only the first argument for now *)
128 val fun_args2string : string -> 'a -> string
129 (* The argument is the first world displayed, e.g. "Raised" or "Interrupted" *)
130 val display_backtrace : string -> unit
131
132 (** FROM HERE, PRIMITIVES HAVE AN INTERACTION WITH THE SCHEDULER *)
133
134 (** {6 Call-cc : uncps} *)
135
136 val uncps : string -> 'a continuation -> QmlClosureRuntime.t -> 'b
137
138 val uncps_ml:
139 string ->
140 'a continuation ->
141 ('b continuation -> unit) -> 'b
142
143 (**callcc_directive : the real version of call-cc (used in resolution of directive \@callcc) *)
144 val callcc_directive : (* (('a continuation, unit) func, 'a) func *)
145 (* f : *) ( 'a continuation -> 'unit continuation -> unit ) ->
146 'a continuation ->
147 unit
148
149 (** Apply a function to an argument.
150
151 In concurrent implementations, this application can also
152 have an effect on scheduling and/or garbage-collection.
153
154 @TODO When a prototype is complete, add hand-optimized
155 [apply2], [apply3]...*)
156 val apply: ('a, 'b) func -> 'a -> 'b continuation -> unit
157 (*val apply: ('a, 'b) func -> 'b continuation -> 'a -> unit*)
158
159 (**
160 Instead of apply2, apply3, we use apply0 :
161
162 apply3 f x y z k ==> apply0 (fun () -> f x y z k) k
163
164 The ml closure is created anyway inside apply-n.
165 K is repassed because we need some other infos from it.
166 *)
167 val apply0: QmlClosureRuntime.t -> 'b continuation -> unit
168 val apply0_ml : (unit -> unit) -> 'b continuation -> unit
169
170 (**
171 {6 Futures}
172 *)
173
174 (**
175 Future are used for evaluation in pseudo-concurrency.
176 *)
177
178 (**A value of type ['a], which may already have been computed
179 or may be computed as a background task.*)
180 type 'a future
181
182 val spawn: (unit -> 'a continuation -> unit) -> 'a future
183
184 val wait: 'a future -> 'a continuation -> unit
185
186 (** exported low-level barrier management for top level value *)
187
188 (**
189 Creating a new barrier.
190 ignored argument : because QmlServerLib.empty is not unit.
191 For optimization purpose, we does not want to project this bypass *)
192 val make_barrier : string -> 'a future
193
194 (** Print a barrier *)
195 val print_barrier : Format.formatter -> 'a future -> unit
196
197 (**
198 Releasing a barrier means provide its terminaison value.
199 + <!> Barrier should be released only once, or it would cause
200 an internal error.
201 + <!> Releasing a barrier leads to compute all pending continuation
202 related to this barrier. The function returns only when all pending
203 continuation have been computed. In practice, a pending continuation
204 of a barrier is a continuation which only {e push} a task using the
205 release value in the main queue, but does not do real computation.
206 *)
207 val release_barrier : 'a future -> 'a -> unit
208
209 (**
210 Check if a barrier has been released.
211 Used for rewritting the top-level.
212 The function returns [true] if the barrier is computed,
978b7c4 @akoprow [fix] typo: occurence->occurrence, occured->occurred
akoprow authored
213 or if an exception occurred during the computation of the barrier.
fccc685 Initial open-source release
MLstate authored
214 *)
215 val is_released : _ future -> bool
216
edfd810 [cleanup] cps: blocking_wait was replaced by toplevel_wait
Mathieu Barbin authored
217 (** Initialize some structure for a future use of [toplevel_wait]. *)
fccc685 Initial open-source release
MLstate authored
218 val before_wait : 'projection_friendly -> unit
219
220 (**
edfd810 [cleanup] cps: blocking_wait was replaced by toplevel_wait
Mathieu Barbin authored
221 Check if the barrier was realeased and returns the computed value
222 else raise a [Failure].
fccc685 Initial open-source release
MLstate authored
223 This function is specially used only for toplevel rewritting.
224 *)
225 val toplevel_wait : 'a future -> 'a
226
227 (** {6 Magic} *)
228
229 (**
230 Because of ocaml generalization error on value restriction, we need to
231 deal with black_barrier to evoid the apparition of Obj.magic everywhere
232 using these [black_*] function is the default behavior of back-ends,
233 using MLSTATE_QMLC_NO_MAGIC (debug env toggle) will make the back-ends
234 not use them.
235
236 Essentially, these function are implemented with Obj.magic,
237 but the type transformation is more specific, to loose less type informations,
238 and potentially catch more errors.
239 *)
240
241 (** *)
242 val magic_cont : 'a continuation -> 'b continuation
243 val magic_func : ('a, 'b) func -> ('c, 'd) func
244 val magic_func0 : (_ func0) -> _ func0
245 val magic_func1 : (_ -> _ func0) -> (_ -> _ func0)
246 val magic_func2 : (_ -> _ -> _ func0) -> (_ -> _ -> _ func0)
247 val magic_func3 : (_ -> _ -> _ -> _ func0) -> (_ -> _ -> _ -> _ func0)
248 val magic_func4 : (_ -> _ -> _ -> _ -> _ func0) -> (_ -> _ -> _ -> _ -> _ func0)
249 val magic_func5 : (_ -> _ -> _ -> _ -> _ -> _ func0) -> (_ -> _ -> _ -> _ -> _ -> _ func0)
250 val magic_func_more : _ -> _
251
252 type black_future
253 val black_make_barrier : string -> black_future
254 val black_release_barrier : black_future -> 'a -> unit
255 val black_toplevel_wait : black_future -> 'a
256
257 (** {6 A few useful functions} *)
258
259 (** Open this module for duck-style cps-programming©. This is a variant from
260 libbase/Cps that assumes your continuations are QmlCps-continuations, not
261 functions.
262
263 See guidelines in libbase/Cps; as an exception, when we need conversion
264 between functions and continuations, we write: {[
265 f @> ccont_ml k
266 @> fun x -> x+1 |> k
267 ]}
268 While this forces us to relax the type of [@>], it keeps the readability
269 and avoids added parentheses.
270 *)
271 module Ops : sig
272 (** Duck operator: apply a cps-function to a continuation (['a] should normally
273 be a continuation and ['b] unit, but keeping it polymorph is easier when
274 dealing with continuations-as-functions *)
275 val (@>) : ('a -> 'b) -> 'a -> 'b
276
277 (** The pipe operator: pass a computed value to your continuation *)
278 val (|>) : 'a -> 'a continuation -> unit
279 end
280
281 (** Just like List.fold_left, but in Cps. While coding a cps-fold based on
282 List.fold is a fun exercise, it's less efficient. *)
283 val fold_list : ('acc -> 'a -> 'acc continuation -> unit) -> 'acc -> 'a list -> 'acc continuation -> unit
284
0fbf161 [feature] CpsServerLib: parallel iter and map on lists
Louis Gesbert authored
285 (** Maps the given cps function on the elements of the list, in parallel *)
286 val map_list : ('a -> 'b continuation -> unit) -> 'a list -> 'b list continuation -> unit
287
288 (** Iters the given cps function on the elements of the list, in parallel *)
289 val iter_list : ('a -> unit continuation -> unit) -> 'a list -> unit continuation -> unit
290
fccc685 Initial open-source release
MLstate authored
291 val fold_array : ('acc -> 'a -> 'acc continuation -> unit) -> 'acc -> 'a array -> 'acc continuation -> unit
0fbf161 [feature] CpsServerLib: parallel iter and map on lists
Louis Gesbert authored
292
fccc685 Initial open-source release
MLstate authored
293 (*
294 (*
295 {6 Tasks}
296 *)
297
298 type task (*A very lightweight thread.*)
299 val task_of_fun: unit continuation -> task (*Create a new task.*)
300 val push: task -> unit (*Schedule a task for execution.*)
301
302 (*If a task is waiting to be executed, remove it from the queue
303 and return it.*)
304 val steal: unit -> task option
305
306 *)
307 (*
308 {6 Interaction with asynchronous I/O}
309
310 These functions provide support for interacting
311 with the asynchronous IO features provided
312 by most operating systems.
313 *)
314
315 (*
316 Prepare a callback for a function which may be called non-deterministically.
317
318 Use [callback_of_fun] whenever you intend to invoke
319 an asynchronous function that will only
320 inform the system of its termination by calling a callback.
321
322 For instance, assume the existence of a function
323 [async_read_contents: file -> (string -> unit)].
324 This function, provided by the Operating System,
325 opens a file for reading, reads in the background
326 and eventually sends the result of reading to some callback.
327 In order to ensure nice cooperation
328 with the scheduler, we wish this function
329 to be seen as [read_contents: file -> string future].
330
331 Calling [callback_of_fun f] produces a pair [(cb, future)],
332 where [cb] does the same computation
333 as [f] but the result may be consulted from [future].
334
335 To adapt [async_read_contents], we may just define [read_contents] as
336
337 {[
338 let read_contents file =
339 let (cb, future) = callback_of_fun (fun x -> x) in
340 callback_of_fun file cb;
341 future
342 ]}
343 *)
344
345 (*
346 type ('a, 'b) pair = {f_0: 'a; f_1: 'b}(*TODO: Get rid of this?*)
347
348 val callback_of_fun: ('a -> 'b) -> (('a -> unit), 'b future) pair
349
350
351 (*
352 Simplified version of [callback_of_fun] for most common cases.
353
354 This is equivalent to [callback_of_fun (fun x -> x)], just slightly faster.
355 *)
356 val callback_post: unit -> (('a -> unit), 'a future) pair
357
358
359 *)
Something went wrong with that request. Please try again.