Composition and algebraic effects?

Learning
1

Not quite sure the title makes sense but: I’m trying to figure out how to use algebraic effects when I have subcomputations with their own effects. As an example, suppose I have to different stateful computations:

module Make_state (State : sig
    type t
  end) =
struct
  type _ Effect.t += Get : State.t Effect.t | Put : State.t -> unit Effect.t

  let get () = Effect.perform Get
  let put st = Effect.perform (Put st)

  let run comp st =
    let st_ref = ref st in
    Effect.Deep.match_with
      comp
      ()
      { effc =
          (fun (type a) (eff : a Effect.t) ->
            match eff with
            | Get -> Some (fun (k : (a, _) Effect.Deep.continuation) -> Effect.Deep.continue k (!st_ref : State.t))
            | Put st ->
              st_ref := st;
              Some (fun (k : (a, _) Effect.Deep.continuation) -> Effect.Deep.continue k ())
            | _ -> None)
      ; retc = (fun res -> res, !st_ref)
      ; exnc = (fun exn -> raise exn)
      }
  ;;
end

module Sub_one = struct
  module State = struct
    type t = int
  end

  module Effect = Make_state (State)

  let multiply_by factor () =
    Effect.(
      let st = get () in
      let st = st * factor in
      put st)
  ;;
end

module Sub_two = struct
  module State = struct
    type t = string
  end

  module Effect = Make_state (State)

  let append suffix () =
    Effect.(
      let st = get () in
      let st = st ^ suffix in
      put st)
  ;;
end

Then let’s say I have some larger computation which makes use of them. As I have it now, I have to reimplement my handler:

module Whole = struct
  module State = struct
    type t =
      { sub_one : Sub_one.State.t
      ; sub_two : Sub_two.State.t
      }
  end

  module Effect = struct
    let run comp (st : State.t) =
      let st_ref = ref st in
      Effect.Deep.match_with
        comp
        ()
        { effc =
            (fun (type a) (eff : a Effect.t) ->
              match eff with
              | Sub_one.Effect.Get ->
                Some
                  (fun (k : (a, _) Effect.Deep.continuation) ->
                    Effect.Deep.continue k (!st_ref.sub_one : Sub_one.State.t))
              | Sub_one.Effect.Put sub_one ->
                st_ref := { !st_ref with sub_one };
                Some (fun (k : (a, _) Effect.Deep.continuation) -> Effect.Deep.continue k ())
              | Sub_two.Effect.Get ->
                Some
                  (fun (k : (a, _) Effect.Deep.continuation) ->
                    Effect.Deep.continue k (!st_ref.sub_two : Sub_two.State.t))
              | Sub_two.Effect.Put sub_two ->
                st_ref := { !st_ref with sub_two };
                Some (fun (k : (a, _) Effect.Deep.continuation) -> Effect.Deep.continue k ())
              | _ -> None)
        ; retc = (fun res -> res, !st_ref)
        ; exnc = (fun exn -> raise exn)
        }
    ;;

    let get_one () = Sub_one.Effect.get ()
    let get_two () = Sub_two.Effect.get ()
    let put_one st = Sub_one.Effect.put st
    let put_two st = Sub_two.Effect.put st
  end

  let comp () =
    let _ : unit = Sub_one.multiply_by 10 () in
    let _ : unit = Sub_two.append "world!" () in
    let num = Effect.get_one () in
    let str = Effect.get_two () in
    Format.sprintf {|%s %n|} str num
  ;;
 
end

Is there a better way to do this?

2

You could run your computation using the handlers from both Sub_one and Sub_two:

let run comp (st : State.t) =
  Sub_one.Effect.run 
    (fun () -> Sub_two.Effect.run comp st.sub_two)
    st.sub_one
2 Likes
3

Ah, of course! Thank you so much!