Extensible and composable interpreter using OCaml 5.0's effect handlers + print function demonstrating solution to Expression Problem, based on https://gist.github.com/takahisa/e5d3b012a11081302489d29bf417575c

composable_interpreter_and_print_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

(* Add print *)
type _ Effect.t +=
| PExtension : 'a expr -> string Effect.t
| Print : 'a expr -> string Effect.t

let print_effect e = Effect.perform (Print e)

let print_handler1 =
  { D.effc = fun (type b) (eff : b Effect.t) ->
      match eff with
      | PExtension (Int n) -> Some (fun (k: (b,_) D.continuation) ->
          D.continue k (string_of_int n))
      | PExtension (Add(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
          let n1 = print_effect e1 in
          let n2 = print_effect e2 in
          D.continue k (Printf.sprintf "(+ %s %s)" n1 n2))
      | PExtension (Sub(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
          let n1 = print_effect e1 in
          let n2 = print_effect e2 in
          D.continue k (Printf.sprintf "(- %s %s)" n1 n2))
      | PExtension (Mul(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
          let n1 = print_effect e1 in
          let n2 = print_effect e2 in
          D.continue k (Printf.sprintf "(* %s %s)" n1 n2))
      | PExtension (Div(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
          let n1 = print_effect e1 in
          let n2 = print_effect e2 in
          D.continue k (Printf.sprintf "(/ %s %s)" n1 n2))
      | PExtension (Bool b1) -> Some (fun (k: (b,_) D.continuation) ->
          D.continue k (string_of_bool b1))
      | PExtension (Eq(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
          let n1 = print_effect e1 in
          let n2 = print_effect e2 in
          D.continue k (Printf.sprintf "(= %s %s)" n1 n2))
      | PExtension (Gt(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
          let n1 = print_effect e1 in
          let n2 = print_effect e2 in
          D.continue k (Printf.sprintf "(> %s %s)" n1 n2))
      | _ -> None
  }

let print_base e = Effect.perform (PExtension e)
let print1 e = D.try_with print_base e print_handler1

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

(* Adding if expression *)
type 'a expr +=
  | If : bool expr * 'a expr * 'a expr -> 'a expr

let handler_if =
  { D.effc = fun (type b) (eff : b Effect.t) ->
      match eff with
      | Extension (If(e1, e2, e3)) -> Some (fun (k: (b,_) D.continuation) ->
          let b = eval_effect e1 in
          let x = eval_effect (if b then e2 else e3) in
          D.continue k x)
      | _ -> None
  }

let eval4 e = D.try_with eval e handler_if

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 eval4 e handler))
      | _ -> None
  } in
  D.try_with eval_effect e handler

let print_handler_if =
  { D.effc = fun (type b) (eff : b Effect.t) ->
      match eff with
      | PExtension (If(e1, e2, e3)) -> Some (fun (k: (b,_) D.continuation) ->
          let n1 = print_effect e1 in
          let n2 = print_effect e2 in
          let n3 = print_effect e3 in
          D.continue k (Printf.sprintf "(if %s %s %s)" n1 n2 n3))
      | _ -> None
  }

let print2 e = D.try_with print e print_handler_if

let print e =
  let rec handler : 'a. 'a D.effect_handler =
  { D.effc = fun (type b) (eff : b Effect.t) ->
      match eff with
      | Print e -> Some (fun (k: (b,_) D.continuation) ->
          D.continue k (D.try_with print2 e handler))
      | _ -> None
  } in
  D.try_with print_effect e handler
  
(* Running the interpreter *)
let _ =
  let e = If(Gt(Mul(Int 2, Int 3), Add(Int 2, Int 3)),Int 0, Int 1) in
  let handler =
  { D.effc = fun (type b) (eff : b Effect.t) ->
      match eff with
      | Extension _ -> failwith "Unknown syntax"
      | _ -> None
  } in
  let n = D.try_with eval e handler in
  print_endline @@ string_of_int n;
  let print_handler =
  { D.effc = fun (type b) (eff : b Effect.t) ->
      match eff with
      | PExtension _ -> Some (fun (k: (b,_) D.continuation) ->
          D.continue k "???")
      | _ -> None
  } in
  let s = D.try_with print e print_handler in
  print_endline s