Extensible Interpreter with Algebraic Effects

extensible_interpreter_with_algebraic_effects.ml.ml

type 'a expr = ..
type 'a expr +=
  | Int: int -> int expr
  | Add: int expr * int expr -> int expr
  | Sub: int expr * int expr -> int expr

effect Extension: 'a expr -> 'a

let rec eval1: type a. a expr -> a = function
  | Int n0 -> n0
  | Add (e0, e1) ->
    let n1 = eval1 e1 in
    let n0 = eval1 e0 in
    n0 + n1
  | Sub (e0, e1) ->
    let n1 = eval1 e1 in
    let n0 = eval1 e0 in
    n0 - n1
  | e0 ->
    perform (Extension e0)


type 'a expr +=
  | Mul: int expr * int expr -> int expr
  | Div: int expr * int expr -> int expr

let rec eval2: type a. a expr -> a = fun e ->
  match eval1 e with
  | c0 -> c0
  | effect (Extension (Mul (e0, e1))) k ->
    let n1 = eval2 e1 in
    let n0 = eval2 e0 in
    continue k (n0 * n1)
  | effect (Extension (Div (e0, e1))) k ->
    let n1 = eval2 e1 in
    let n0 = eval2 e0 in
    continue k (n0 / n1)


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

let rec eval3: type a. a expr -> a = fun e ->
  match eval2 e with
  | c0 -> c0
  | effect (Extension (Eq (e0, e1))) k ->
    let n1 = eval3 e1 in
    let n0 = eval3 e0 in
    continue k (n0 = n1)
  | effect (Extension (Gt (e0, e1))) k ->
    let n1 = eval3 e1 in
    let n0 = eval3 e0 in
    continue k (n0 > n1)


let _ =
  match eval3 (Gt (Mul (Int 2, Int 3), Add (Int 2, Int 3))) with
  | b0 -> print_endline @@ string_of_bool b0
  | effect (Extension _) _ ->
    failwith "Unknown Syntax"