Extensible and composable interpreter using OCaml 5.0's effect handlers, based on https://gist.github.com/takahisa/e5d3b012a11081302489d29bf417575c

composable_interpreter_with_ocaml_effect_handlers.ml

module D = Effect.Deep

type 'a expr = ..
type _ Effect.t +=
| Extension : 'a expr -> 'a Effect.t
| Evaluate : 'a expr -> 'a Effect.t

let eval_effect e = Effect.perform (Evaluate e)

(* Extension 1 *)
type 'a expr +=
  | Int : int -> int expr
  | Add : int expr * int expr -> int expr
  | Sub : int expr * int expr -> int expr

let handler1 =
  { D.effc = fun (type b) (eff : b Effect.t) ->
      match eff with
      | Extension (Int n) -> Some (fun (k: (b,_) D.continuation) ->
          D.continue k n)
      | Extension (Add(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
          let n1 = eval_effect e1 in
          let n2 = eval_effect e2 in
          D.continue k (n1 + n2))
      | Extension (Sub(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
          let n1 = eval_effect e1 in
          let n2 = eval_effect e2 in
          D.continue k (n1 - n2))
      | _ -> None
  }

(* Extension 2 *)
type 'a expr +=
  | Mul : int expr * int expr -> int expr
  | Div : int expr * int expr -> int expr

let handler2 =
  { D.effc = fun (type b) (eff : b Effect.t) ->
      match eff with
      | Extension (Mul(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
          let n1 = eval_effect e1 in
          let n2 = eval_effect e2 in
          D.continue k (n1 * n2))
      | Extension (Div(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
          let n1 = eval_effect e1 in
          let n2 = eval_effect e2 in
          D.continue k (n1 / n2))
      | _ -> None
  }

(* Extension 3 *)
type 'a expr +=
  | Bool : bool -> bool expr
  | Eq : int expr * int expr -> bool expr
  | Gt : int expr * int expr -> bool expr

let handler3 =
  { D.effc = fun (type b) (eff : b Effect.t) ->
      match eff with
      | Extension (Bool b1) -> Some (fun (k: (b,_) D.continuation) ->
          D.continue k b1)
      | Extension (Eq(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
          let n1 = eval_effect e1 in
          let n2 = eval_effect e2 in
          D.continue k (n1 = n2))
      | Extension (Gt(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
          let n1 = eval_effect e1 in
          let n2 = eval_effect e2 in
          D.continue k (n1 > n2))
      | _ -> None
  }

(* Composing the interpreter *)
let eval_base e = Effect.perform (Extension e)
let eval1 e = D.try_with eval_base e handler1
let eval2 e = D.try_with eval1 e handler2
let eval3 e = D.try_with eval2 e handler3

let eval e =
  let rec handler : 'a. 'a D.effect_handler =
  { D.effc = fun (type b) (eff : b Effect.t) ->
      match eff with
      | Evaluate e -> Some (fun (k: (b,_) D.continuation) ->
          D.continue k (D.try_with eval3 e handler))
      | _ -> None
  } in
  D.try_with eval_effect e handler

(* Running the interpreter *)
let _ =
  let e = Gt(Mul(Int 2, Int 3), Add(Int 2, Int 3)) in
  let handler =
  { D.effc = fun (type b) (eff : b Effect.t) ->
      match eff with
      | Extension _ -> failwith "Unknown syntax"
      | _ -> None
  } in
  let b = D.try_with eval e handler in
  print_endline @@ string_of_bool b