Effets algébriques en OCaml 5

Florian Angeletti
Cambium/Inriasoft

Effets algébriques

Une nouveauté expérimentale dans OCaml 5:

Des exceptions résumables 


def integers():
  i = 0
  while True:
    i += 1
    yield i


g = integers()
for i in range(10):
  print (next(g))
      

0
1
2
3
4
5
6
7
8
9
      

my_gen =
map(
  (lambda i: yield i),
  [10,20,30,40])
)


def do_yield(acc,i):
  yield i
  import functools
my_gen = functools.reduce(
  do_yield,
  [10,20,30,40]
  0)
print (next(my_gen))
      

40

Retourner vers le passé 

g = integers()
print (next(g))
print (prev(g))

Apprendre à attendre 

def slow_prims():
  prims = [];
  i = 1
  while True:
      for j in range(10):
          i+=1
          if all(i % x != 0 for x in prims):
              prims.append(i)
              yield i
              break
      else:
          wait ()
  1. Définir un effet Yield 
    type 'a Effect.t += Yield: int -> unit Effect.t
let yield x = Effect.perform (Yield x)
  2. Écrire des générateurs 
    let integers () =
  let i = ref 0 in
  while true do
    i := !i + 1;
    yield !i
  done; 0
  3. ???
  4. Utiliser le générateur 
     let g = init integers
  let () =
    for _ = 0 to 100 do
      Format.printf "g=%d@." (next g)
    done

let init f = ref (Effect.Shallow.fiber f)

let yield_handler (r:(unit,int) Effect.Shallow.continuation ref) =
  let effc (type a) (eff:a Effect.t) = match eff with
    | Yield x -> Some (fun (cont: (a,_) Effect.Shallow.continuation)  ->
        r:= cont;
        x
      )
    | _ -> None
 in
 {
    Effect.Shallow.retc = (fun _ -> raise (Invalid_argument "Finite generator"));
    exnc = raise;
    effc;
  }

let next f = Effect.Shallow.continue_with !f () (yield_handler f)




def slow_prims():
  prims = [];
  i = 1
  while True:
      for j in range(10):
          i+=1
          if all(i % x != 0 for x in prims):
              prims.append(i)
              yield i
              break
      else:
          wait ()

type _ Effect.t += Wait: unit Effect.t
let wait () = Effect.perform Wait

let slow_prims () =
  let primes = ref [] in
  let i = ref 1 in
  while true do
    match for j = 1 to 10 do
      incr i;
      if List.for_all (fun p -> !i mod p <> 0) !primes then
       (primes := !i :: !primes;
        yield !i;
        raise Exit)
    done with exception Exit -> ()
    | () -> wait ()
  done; 0


let yield_or_wait (r:(unit,int) Effect.Shallow.continuation ref) =
    let effc (type a) (eff:a Effect.t) = match eff with
      | Yield x -> Some (fun (cont: (a,_) Effect.Shallow.continuation)  ->
          r:= cont;
          Some x
        )
      | Wait -> Some (fun (cont: (a,_) Effect.Shallow.continuation)  ->
          r:= cont;
          None
        )
      | _ -> None
    in
    {
      Effect.Shallow.retc = (fun _ -> raise (Invalid_argument "Finite generator"));
      exnc = raise;
      effc;
    }

let try_next f = Effect.Shallow.continue_with !f () (yield_or_wait f)

let () =
    let primes = init slow_prims in
    for _ = 1 to 100 do
      match try_next primes with
      | Some prime -> Format.printf "%d@." prime
      | None -> Format.printf "Waiting on next prime@."
    done

let () =
    let gen = init integers in
    for _ = 1 to 100 do
      match try_next gen with
      | Some prime -> Format.printf "%d@." prime
      | None -> Format.printf "Waiting on next prime@."
    done

type dir = Next | Previous
type _ Effect.t += Dir_yield: int -> dir Effect.t

let directional_yield x = Effect.perform (Dir_yield x)

let rec integers current dir =
  let current = match dir with
    | Next -> current + 1
    | Previous -> current - 1
  in
  let next_dir = directional_yield current in
  integers current next_dir

let () =
let generator = init (integers 0) in
for _=1 to 100 do
  Format.printf "%d@."
  (if Random.bool () then next generator else prev generator)
done

let dir_yield (r:(dir,int) Effect.Shallow.continuation ref) =
  let effc (type a) (eff:a Effect.t) = match eff with
    | Dir_yield x -> Some (fun (cont: (a,_) Effect.Shallow.continuation)  ->
        r:= cont;
        x
      )
    | _ -> None
  in
  {
    Effect.Shallow.retc = (fun _ -> raise (Invalid_argument "Finite generator"));
    exnc = raise;
    effc;
  }

let step f dir = Effect.Shallow.continue_with !f dir (dir_yield f)
let next f = step f Next
let prev f = step f Previous

Effets algébriques