blob: 42d39e6afd53eafc06091791bd988addc35da4af (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
(* TEST
flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
*)
(* Sorry, we have to disable this as this requires accepting
potentially badly formed programs (after expliciting) *)
module Common0 =
struct
type msg = Msg
let handle_msg = ref (function _ -> failwith "Unable to handle message")
let extend_handle f =
let old = !handle_msg in
handle_msg := f old
let q : _ Queue.t = Queue.create ()
let add msg = Queue.add msg q
let handle_queue_messages () = Queue.iter !handle_msg q
end
let q' : Common0.msg Queue.t = Common0.q
module Common =
struct
type msg = ..
let handle_msg = ref (function _ -> failwith "Unable to handle message")
let extend_handle f =
let old = !handle_msg in
handle_msg := f old
let q : _ Queue.t = Queue.create ()
let add msg = Queue.add msg q
let handle_queue_messages () = Queue.iter !handle_msg q
end
module M1 =
struct
type Common.msg += Reload of string | Alert of string
let handle fallback = function
Reload s -> print_endline ("Reload "^s)
| Alert s -> print_endline ("Alert "^s)
| x -> fallback x
let () = Common.extend_handle handle
let () = Common.add (Reload "config.file")
let () = Common.add (Alert "Initialisation done")
end
|
