Last active
May 2, 2018 09:23
-
-
Save andrejbauer/82199684294e0a398e1cf569f8d39a15 to your computer and use it in GitHub Desktop.
Experiments in using multicore OCaml effects to simulate dynamically created local effects.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(** * General support for creation of dynamic effects *) | |
(** We show how to use the multicore Ocaml effects to dynamically generate local | |
effects. Such effects are akin to the Eff resources, and they can be used to | |
implement ML references. | |
The code is based on "Eff directly in OCaml" by Oleg Kiselyov and KC | |
Sivaramakrishnan (http://kcsrk.info/papers/caml-eff17.pdf). It was written by | |
Andrej Bauer, Oleg Kiselyov, and Stephen Dolan at the Dagstuhl seminar | |
"Algebraic Effect Handlers go Mainstream". *) | |
(** A _resource_ is an instance of an effect that is handled at the top level in | |
a specific fashion. It looks a lot like an effect with a "default" handler, | |
although it is not (for reasons explained in some talk). Resources can be | |
dynamically created at will, with no bound on their number (so they are _not_ | |
the lift/inject thing). | |
We show here how to simulate resources in multicore OCaml, using the | |
generative features of first-class modules. *) | |
(** A resource handler takes a computation [unit -> 'a] and handles it, without | |
changing its type. *) | |
type resource_handler = { hand : 'a . ((unit -> 'a) -> 'a) } | |
(** An effect for installing a new resource handler. *) | |
effect Install : resource_handler -> unit | |
(** The handler for [Install]. Multicore OCaml does not have first-class | |
handlers (why?), so we simulate it as a function which accepts a thunked | |
computation and handles it. The handler is a lot like the delimited-control | |
reset handler. *) | |
let handle_new computation = | |
try | |
computation () | |
with | |
| effect (Install {hand}) k -> hand (fun x -> continue k x) | |
(** This completes the generalities. Below we will install the [handle_new] just | |
once, on the outside of the main program. (That is, we need _not_ install any | |
new handlers when we introduce new local effects.) | |
We demonstrate two examples: ML-style references and clocks. | |
Both of these are state-like effects that behave like Eff resources. Thus | |
they are well-behaved. It's possible to also implement other kinds of local | |
effects (because unlike Eff resources we have access to the continuation | |
here), for instance backtracking. That sounds pretty scary. | |
*) | |
(** ** Example: local state *) | |
(** Our first example is ML-style references. In order to avoid naming conflicts | |
with OCaml, we call them "cells". *) | |
(** The signature which describes what it means to have state. The handler is | |
parametrized by the initial value of the state. *) | |
module type STATE = sig | |
type t | |
effect Get : t | |
effect Put : t -> unit | |
val handler : t -> resource_handler | |
end | |
(** We implement state in the standard way. *) | |
module State (T : sig type t end) : STATE with type t = T.t = | |
struct | |
type t = T.t | |
effect Get : t | |
effect Put : t -> unit | |
let handler x = | |
{ hand = (fun computation -> | |
(match computation () with | |
| v -> (fun _ -> v) | |
| effect Get k -> (fun (s : t) -> (continue k s) s) | |
| effect (Put s) k -> (fun _ -> (continue k ()) s) | |
) x) | |
} | |
end | |
(** Now we *localize* the state effect. First we define _instances_ of the local | |
state effect, which we call _cells_ to avoid naming conflicts with OCaml. *) | |
(** An instance of an effect is just the module for that effect *) | |
type 'a cell = (module STATE with type t = 'a) | |
(** Convenience access functions *) | |
let get (type a) ((module C) : a cell) = (perform C.Get) | |
let put (type a) ((module C) : a cell) x = (perform (C.Put x)) | |
(** The function [new_cell x] creates a new instance of state initialized to | |
[x], and installs a handler for it. Notice that it is polymorphic in the type | |
of the state. *) | |
let new_cell (type a) (x : a) : a cell = | |
let module Local = State (struct type t = a end) in | |
perform (Install (Local.handler x)) ; | |
(module Local) | |
(** ** Example: clock *) | |
(** The second example is just a simple clock which starts at [0]. The clock | |
keeps [Time] and progresses with every [Tick]. *) | |
module type CLOCK = | |
sig | |
effect Tick : unit | |
effect Time : int | |
val handler : resource_handler | |
end | |
(** A functor which creates a clock effect *) | |
module WatchMaker () : CLOCK = | |
struct | |
effect Tick : unit | |
effect Time : int | |
let handler = | |
{ hand = (fun computation -> | |
(match computation () with | |
| v -> (fun _ -> v) | |
| effect Tick k -> (fun c -> (continue k ()) (c + 1)) | |
| effect Time k -> (fun c -> (continue k c) c) | |
) 0) | |
} | |
end | |
(** Again, instance of an effect is just the module for that effect *) | |
type clock = (module CLOCK) | |
(** Convenience access functions *) | |
let tick (type a) ((module C) : clock) = (perform C.Tick) | |
let time (type a) ((module C) : clock) = (perform C.Time) | |
(** The function [new_clock] creates a new instance of a clock. It is essentially | |
the same as the one for cells, except that it is not polymorphic. *) | |
let new_clock () : clock = | |
let module Local = WatchMaker () in | |
perform (Install Local.handler) ; | |
(module Local) | |
(** ** Demo *) | |
(** The main demonstrates demonstrates the use of cells and clock. *) | |
let main = | |
(** We only ever need one handle_new at the top level. It takes care of all | |
resources of all types. If somehow an instance escapes this handler, it | |
will go unhandled. *) | |
handle_new begin fun () -> | |
(** Testing cells: *) | |
begin | |
let x = new_cell 10 in | |
put x (4 + get x) ; | |
let y = new_cell 3 in | |
put y (get x * get y) ; | |
Format.printf "y = %d@." (get y) | |
end ; | |
(** We can create any number of cells: *) | |
begin | |
let rec many_cells = function | |
| 0 -> [] | |
| n -> (new_cell n) :: many_cells (n - 1) | |
in | |
(** A list of 100 cells *) | |
let xs = many_cells 100 in | |
(** Double every cell *) | |
List.iter (fun r -> put r (2 * get r)) xs ; | |
(** Sum them up *) | |
let s = List.fold_left (fun a r -> a + get r) 0 xs in | |
Format.printf "s = %d@." s | |
end ; | |
(** The cells are and higher-order: *) | |
begin | |
let x = new_cell 42 in | |
let y = new_cell "foo" in | |
let z = new_cell (fun x -> let r = new_cell [x] in get r @ get r) in | |
let w = new_cell [] in (* of type '_a list cell *) | |
let _ = (get x, get y, get z [2], get w) in | |
Format.printf "something happened@." | |
end ; | |
(** Do we get a polymorphic function in the following case? *) | |
begin | |
let f x = get (new_cell x) in | |
let a = f 42 in | |
let b = f "foo" in | |
Format.printf "a = %d, b = %s@." a b | |
end ; | |
(** By performing a little dance around the OCaml module system, | |
we can handle resources. They can be intercepted! *) | |
begin | |
(** A handler which intercepts [Get]. *) | |
let always_42 (module S : STATE with type t = int) computation = | |
try | |
computation () | |
with | |
| effect S.Get k -> continue k 42 | |
in | |
let x = new_cell 10 in | |
Format.printf "1. non-intercepted x = %d@." (get x) ; | |
(** Now we handle the instance [x] with the [always_42] handler *) | |
always_42 x (fun () -> | |
Format.printf "1. intercepted x = %d@." (get x) ; | |
put x 17 ; (** Did it _really_ change? *) | |
Format.printf "2. intercepted x = %d@." (get x) | |
) ; | |
(** Puzzle: what is the value of [x]? *) | |
Format.printf "2. non-intercepted x = %d@." (get x) | |
end ; | |
(** And finally, here are some clocks. To make life interesting we count how | |
many recursive calls are performed when we compute a Fibonacci number the | |
wrong way. *) | |
begin | |
let leonardo = new_clock () in | |
let rec fibonacci n = | |
tick leonardo ; | |
match n with | |
| 0 -> 0 | |
| 1 -> 1 | |
| n -> fibonacci (n - 1) + fibonacci (n - 2) | |
in | |
let x = fibonacci 8 in | |
let t = time leonardo in | |
Format.printf "fibonacci 8 = %d (with %d recursive calls so far)@." x t ; | |
(** the clock is cummulative *) | |
let x = fibonacci 8 in | |
let t = time leonardo in | |
Format.printf "fibonacci 8 = %d (with %d recursive calls so far)@." x t | |
end | |
end (* main *) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(** * Resource management with guaranteed finalization *) | |
(** | |
Multicore OCaml requires that an effect continuation be used exactly once. | |
A second activation of a continuation is a run-time error. | |
If a handler wants to dicard a continuation, it must do so explicitly | |
with the [discontinue k exn] construction which reactivates [k] by | |
triggering the exception [exn] in it. This way the continuation [k] | |
gets a chance to clean up its resources. | |
Using this discipline, we can create a generic [with] handler that | |
guarantees finalization of all resources. | |
*) | |
(** We consider handlers that do not change the type of the computation. *) | |
type with_handler = { wither : 'a . (unit -> 'a) -> 'a } | |
(** A finalizing effect is one that has a [Finalize] operation. *) | |
module type FINALIZING = | |
sig | |
effect Finalize : unit | |
val handler : with_handler | |
end | |
(** A handler for handling a finalizing resource that makes sure that | |
the resource will be finalized. *) | |
let with_resource (module R : FINALIZING) computation = | |
R.handler.wither | |
(fun () -> | |
try | |
computation () | |
with | |
| exn -> perform R.Finalize ; raise exn) | |
(** As an example we show how to implement buffered output channels. *) | |
module type CHANNEL = | |
sig | |
include FINALIZING | |
effect Write : string -> unit | |
effect Flush : unit | |
end | |
(** A channel value is just a channel module *) | |
type channel = (module CHANNEL) | |
(** Convenience functions for channels *) | |
let write (module C : CHANNEL) msg = perform (C.Write msg) | |
let flush (module C : CHANNEL) = perform C.Flush | |
let close (module C : CHANNEL) = perform C.Finalize | |
(** A buffered string printer *) | |
module BufferedPrinter () : CHANNEL = | |
struct | |
effect Write : string -> unit | |
effect Flush : unit | |
effect Finalize : unit | |
type buffer = | |
| Closed | |
| Buffered of string list | |
let rec flush = function | |
| [] -> () | |
| msg :: msgs -> flush msgs ; Format.printf "%s@." msg | |
let handler = | |
{ wither = fun computation -> | |
(match | |
computation () | |
with | |
| v -> | |
(function | |
| Closed -> v | |
| Buffered msgs -> flush msgs ; v) | |
| effect (Write msg) k -> | |
(function | |
| Closed -> discontinue k (Failure "cannot write on a closed channel") Closed | |
| Buffered msgs -> continue k () (Buffered (msg :: msgs))) | |
| effect Flush k -> | |
(function | |
| Closed -> discontinue k (Failure "cannot flush a closed channel") Closed | |
| Buffered msgs -> flush msgs ; continue k () (Buffered [])) | |
| effect Finalize k -> | |
(function | |
| Closed -> discontinue k (Failure "cannot close a closed channel") Closed | |
| Buffered msgs -> flush msgs ; continue k () Closed) | |
) (Buffered []) | |
} | |
end | |
let new_printer () : channel = | |
let module Local = BufferedPrinter () in | |
(module Local : CHANNEL) | |
let main = | |
(** Here we have a minor OCaml ugliness, it would be better if we could | |
use only the value [p] throughout. The [with_resource] will make sure | |
that everything up to the exception is printed out, even though it | |
has not been explicitly flushed. *) | |
let ((module P) as p) = new_printer () in | |
with_resource (module P) | |
begin fun () -> | |
write p "1 Od nékdej lepé so Ljubljanke slovele," ; | |
write p "2 al lepši od Urške bilo ni nobene," ; | |
flush p ; (** flush lines 1 and 2 *) | |
write p "3 nobene očem bilo bolj zaželene" ; | |
write p "4 ob času nje cvetja dekleta ne žene. -" ; | |
write p "5 Ko nárbolj iz zvezd je danica svetla," ; | |
raise Not_found ; (** lines 3, 4, 5 are not flushed, but will be finalized *) | |
write p "6 narlepši iz deklic je Urška bila." (** we never get here, not printed *) | |
end |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Hi, how about putting these examples into the rosetta stone?