Daniel Bünzli a écrit :
>>> let rec regular_schedule start_time period =
>>>  React.E.switch React.E.never begin React.E.map
>>>    begin fun () -> regular_schedule (Calendar.add (Calendar.now ())
>>> period) period end
>>>    begin schedule start_time end
>>>  end
> 
> Anyway don't do any recursive tricks unless you really know what you
> are doing (which you don't seem). You are asking for trouble (infinite
> loops and puzzling behaviour more precisely). The ONLY right way to
> define recursive events and signals is to use the fixed point
> operators. So in your case something like this should work :
> 
> let regular_schedule start_time period =
>   let define tick = (* tick is the value of tick' dt times ago *)
>     let tick' =
>       let reschedule () = Calendar.add (Calendar.now ()) period in
>       React.E.switch (schedule start_time) (E.map reschedule tick)
>     in
>     tick', tick'
>   in
>   E.fix define

Thanks. This works perfectly! (I mean, with the tweak you mentioned in 
your second email).

I still do not understand why there's the couple (tick', tick') and not 
simply tick', nevertheless...

> Note that in general I would avoid what you are doing altoghether by
> providing regular_schedule as a primitive as you do for schedule. If
> you are using too much ugly side effects and tricks in your event
> definitions then you loose all the benefits of frp.

Well, I do not fully agree. While I agree that keeping code clear and 
non-confusing is the best option, I do not really know if I can avoiding 
doing such magic.

My use case is the following: I'm writing a scheduler that I hope to 
extend smartly over time. It's a scheduler that is based on Calendar, 
and that runs in a Lwt.thread. Source code is given below, at the end of 
this email. There's a schedule function that somehow registers a task in 
the scheduler, and returns a React.E.event on which code using the 
library can hook to.

Making a regular_schedule in the way you suggested proved to be quite 
difficult without changing the code of the scheduler itself, which I'd 
like to keep clean and small.

Moreover, I also aim to make a auto_schedule function that does some 
rescheduling at with a delay that is know at the time of rescheduling.

Generally speaking, I want to keep the scheduler small and clean, and 
give flexibility to the user of the scheduling library. So providing 
regular_schedule as a primitive does not seem to me to fit this perspective.

> Best,
> 
> Daniel
> 
> P.S. You may want to have a look at rtime : http://erratique.ch/software/rtime

Cool. One criticism and one question.

Criticism: it doesn't use Calendar, which really a cool library.

Question: How well does Rtime interact with Lwt?

I'll have a look at what I can do with it.

Here's the code of the scheduler:

> open Lwt
> open CalendarLib
> 
> type task = {
>   schedule : Calendar.t;
>   trigger  : unit -> unit; }
> 
> let compare t1 t2 =
>   let n = Calendar.Date.compare
>     (Calendar.to_date t1.schedule)
>     (Calendar.to_date t2.schedule) in
>   if n = 0 then CalendarLib.Calendar.Time.compare
>     (Calendar.to_time t1.schedule)
>     (Calendar.to_time t2.schedule)
>   else n
> 
> let tasks : task list ref = ref []
>
> let register_new_task t =
>   let rec aux = function | [] -> t::[] | hd::tl ->
>     begin match compare hd t with
>     | 1 -> t::hd::tl | _ -> hd::(aux tl) end
>   in tasks := aux !tasks
> 
> let (read_control_fd, write_control_fd) = Lwt_unix.pipe ()
> 
> let task_channel = ref None
> let task_mutex = Lwt_mutex.create ()
> 
> let _ =
>   let rec receive_order = let buffer_command = " " in begin fun () ->
>     match Unix.read (Lwt_unix.unix_file_descr read_control_fd) buffer_command 0 1 with
>     | 1 -> begin match !task_channel with
>            | Some new_task -> begin
>                task_channel := None;
>                Lwt_mutex.unlock task_mutex;
>                register_new_task new_task;
>                loop () end
>            | None -> assert false
>            end
>     | _ -> assert false end
>   and loop () : unit Lwt.t = match !tasks with
>     | [] -> Lwt_unix.wait_read read_control_fd >>= fun () -> receive_order ()
>     | hd::tl -> let float_delay =
>         Calendar.Time.Second.to_float (
>         Calendar.Time.Period.to_seconds (
>         Calendar.Period.to_time (
>         Calendar.sub hd.schedule (
>         Calendar.now ())))) in
>         begin match float_delay > 0. with
>         | false -> tasks := tl; hd.trigger (); loop ()
>         | true -> Lwt.catch begin fun () ->
>                     Lwt_unix.with_timeout float_delay begin function () ->
>                       Lwt_unix.wait_read read_control_fd >>= fun () ->
>                       receive_order () end
>                   end begin function
>                   | Lwt_unix.Timeout -> tasks := tl; hd.trigger (); loop ()
>                   | _ -> assert false
>                   end end in
>   loop ()
> 
> let schedule date =
>   let aux () =
>     let (e, set_e) = React.E.create () in
>     Lwt_mutex.lock task_mutex >>= fun () ->
>     task_channel := Some {schedule = date; trigger = set_e;};
>     Lwt_unix.write write_control_fd "X" 0 1 >>= function
>     | 1 -> Lwt.return e | _ -> assert false in
>   Lwt_main.run (aux ())
> 
> let regular_schedule start period =
>   (* The let define tick in E.fix define is the proper way to
>      implement recursive events. define has type React.event ->
>      (React.event * React.event) and its argument is a placeholder
>      for the event at time t-dt. *)
>   let define tick =
>     let tick' = React.E.switch (schedule start) (React.E.map begin function () ->
>       schedule (Calendar.add (Calendar.now ()) period) end tick) in
>     tick', tick'
>   in
>   React.E.fix define

-- 
      Guillaume Yziquel
http://yziquel.homelinux.org/