74 lines
1.9 KiB
OCaml
74 lines
1.9 KiB
OCaml
(* Lightweight thread library for Objective Caml
|
|
* http://www.ocsigen.org/lwt
|
|
* Module Lwt_switch
|
|
* Copyright (C) 2010 Jérémie Dimino
|
|
*
|
|
* This program is free software; you can redistribute it and/or modify
|
|
* it under the terms of the GNU Lesser General Public License as
|
|
* published by the Free Software Foundation, with linking exceptions;
|
|
* either version 2.1 of the License, or (at your option) any later
|
|
* version. See COPYING file for details.
|
|
*
|
|
* This program is distributed in the hope that it will be useful, but
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
* Lesser General Public License for more details.
|
|
*
|
|
* You should have received a copy of the GNU Lesser General Public
|
|
* License along with this program; if not, write to the Free Software
|
|
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
* 02111-1307, USA.
|
|
*)
|
|
|
|
open Lwt
|
|
|
|
exception Off
|
|
|
|
type on_switch = {
|
|
mutable hooks : (unit -> unit Lwt.t) list;
|
|
}
|
|
|
|
type state =
|
|
| St_on of on_switch
|
|
| St_off
|
|
|
|
type t = { mutable state : state }
|
|
|
|
let create () = { state = St_on { hooks = [] } }
|
|
|
|
let is_on switch =
|
|
match switch.state with
|
|
| St_on _ -> true
|
|
| St_off -> false
|
|
|
|
let check = function
|
|
| Some{ state = St_off } -> raise Off
|
|
| _ -> ()
|
|
|
|
let add_hook switch hook =
|
|
match switch with
|
|
| Some{ state = St_on os } ->
|
|
os.hooks <- hook :: os.hooks
|
|
| Some{ state = St_off } ->
|
|
raise Off
|
|
| None ->
|
|
()
|
|
|
|
let add_hook_or_exec switch hook =
|
|
match switch with
|
|
| Some{ state = St_on os } ->
|
|
os.hooks <- hook :: os.hooks;
|
|
return ()
|
|
| Some{ state = St_off } ->
|
|
hook ()
|
|
| None ->
|
|
return ()
|
|
|
|
let turn_off switch =
|
|
match switch.state with
|
|
| St_on { hooks = hooks } ->
|
|
switch.state <- St_off;
|
|
Lwt_list.iter_p (fun hook -> apply hook ()) hooks
|
|
| St_off ->
|
|
return ()
|