Skip to content

Instantly share code, notes, and snippets.

Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save zehnpaard/9700e3a828d882ed15809228b9390f5d to your computer and use it in GitHub Desktop.
Save zehnpaard/9700e3a828d882ed15809228b9390f5d to your computer and use it in GitHub Desktop.
Extensible interpreter using OCaml 5.0's effect handlers with some isolation between handlers and eval functions, based on https://gist.github.com/takahisa/e5d3b012a11081302489d29bf417575c
module D = Effect.Deep
type 'a expr = ..
type _ Effect.t += Extension : 'a expr -> 'a Effect.t
(* Base interpreter *)
let eval_base e = Effect.perform (Extension 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 rec handler1 : 'a. 'a D.effect_handler =
{ 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 = D.try_with eval_base e1 handler1 in
let n2 = D.try_with eval_base e2 handler1 in
D.continue k (n1 + n2))
| Extension (Sub(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
let n1 = D.try_with eval_base e1 handler1 in
let n2 = D.try_with eval_base e2 handler1 in
D.continue k (n1 - n2))
| _ -> None
}
let eval1 e = D.try_with eval_base e handler1
(* Extension 2 *)
type 'a expr +=
| Mul : int expr * int expr -> int expr
| Div : int expr * int expr -> int expr
let rec handler2 : 'a. 'a D.effect_handler =
{ D.effc = fun (type b) (eff : b Effect.t) ->
match eff with
| Extension (Mul(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
let n1 = D.try_with eval1 e1 handler2 in
let n2 = D.try_with eval1 e2 handler2 in
D.continue k (n1 * n2))
| Extension (Div(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
let n1 = D.try_with eval1 e1 handler2 in
let n2 = D.try_with eval1 e2 handler2 in
D.continue k (n1 / n2))
| _ -> None
}
let eval2 e = D.try_with eval1 e handler2
(* Extension 3 *)
type 'a expr +=
| Bool : bool -> bool expr
| Eq : int expr * int expr -> bool expr
| Gt : int expr * int expr -> bool expr
let rec handler3 : 'a. 'a D.effect_handler =
{ 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 = D.try_with eval2 e1 handler3 in
let n2 = D.try_with eval2 e2 handler3 in
D.continue k (n1 = n2))
| Extension (Gt(e1,e2)) -> Some (fun (k: (b,_) D.continuation) ->
let n1 = D.try_with eval2 e1 handler3 in
let n2 = D.try_with eval2 e2 handler3 in
D.continue k (n1 > n2))
| _ -> None
}
let eval3 e = D.try_with eval2 e handler3
(* 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 eval3 e handler in
print_endline @@ string_of_bool b
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment