require OCaml 5.3

Author: mikeshulman

.ocamlformat

@@ -1,5 +1,6 @@
 profile = default
 version = 0.27.0
+ocaml-version = 5.3
 margin=100
 break-before-in=auto
 break-infix=fit-or-vertical

docs/source/installation.rst

@@ -78,7 +78,7 @@ The static binary does not work on a Mac, but you can compile Narya from source
 Compiling from source
 ---------------------
 
-If the static binary does not work for you (such as if you are on MacOS), or if you want to edit the Narya code, you will have to compile it yourself.  This requires a recent version of OCaml and various libraries.  Currently Narya is developed with OCaml 5.3.0; as far as I know, it also compiles with any version after 5.2.1, but this is not regularly verified.  You can set up a :ref:`Manual development environment` or look into :ref:`Compiling with nix`.
+If the static binary does not work for you (such as if you are on MacOS), or if you want to edit the Narya code, you will have to compile it yourself.  This requires a recent version of OCaml and various libraries.  Narya requires OCaml 5.3.0 or later.  You can set up a :ref:`Manual development environment` or look into :ref:`Compiling with nix`.
 
 
 Manual development environment

lib/core/annotate.ml

@@ -27,30 +27,15 @@ type ty_handler = printable located -> unit
 
 let trivial_ctx_handler : ctx_handler = { handle = (fun _ _ _ -> ()) }
 
-let handler : type b a.
-    ctx:ctx_handler ->
-    tm:tm_handler ->
-    ty:ty_handler ->
-    b Effect.t ->
-    ((b, a) continuation -> a) option =
- fun ~ctx ~tm ~ty -> function
-  | Tm p ->
-      Some
-        (fun k ->
-          tm p;
-          continue k ())
-  | Ty p ->
-      Some
-        (fun k ->
-          ty p;
-          continue k ())
-  | Ctx (s, c, tm) ->
-      Some
-        (fun k ->
-          ctx.handle s c tm;
-          continue k ())
-  | _ -> None
-
 let run (type a) ?(ctx = trivial_ctx_handler) ?(tm = fun _ -> ()) ?(ty = fun _ -> ())
     (f : unit -> a) =
-  try_with f () { effc = (fun e -> handler ~ctx ~tm ~ty e) }
+  try f () with
+  | effect Tm p, k ->
+      tm p;
+      continue k ()
+  | effect Ty p, k ->
+      ty p;
+      continue k ()
+  | effect Ctx (s, c, tm), k ->
+      ctx.handle s c tm;
+      continue k ()

lib/top/execute.ml

@@ -77,24 +77,18 @@ module Loaded = struct
     let loaded_files : (FilePath.filename, data * float) Hashtbl.t = Hashtbl.create 20 in
     (* The complete merged namespace of all the files explicitly given on the command line so far.  Imported into -e and -i.  We compute it lazily because if there is no -e or -i we don't need it.  (And also so that we won't try to read the flags before they're set.)  It starts as the "current" namespace, which should be the top-level one. *)
     let loaded_contents : Scope.trie Lazy.t ref = ref (Lazy.from_val (Scope.get_visible ())) in
-    let effc : type b a. b Effect.t -> ((b, a) continuation -> a) option = function
-      | Add_to_files (file, data) ->
-          let mtime = (FileUtil.stat file).modification_time in
-          Some
-            (fun k ->
-              Hashtbl.add loaded_files file (data, mtime);
-              continue k ())
-      | Get_file file -> Some (fun k -> continue k (Hashtbl.find_opt loaded_files file))
-      | Add_to_scope trie ->
-          Some
-            (fun k ->
-              let old = !loaded_contents in
-              loaded_contents := lazy (Scope.Mod.union ~prefix:Emp (Lazy.force old) trie);
-              continue k ())
-      (* Add something to the complete merged namespace. *)
-      | Get_scope -> Some (fun k -> continue k (Lazy.force !loaded_contents))
-      | _ -> None in
-    try_with f () { effc }
+    try f () with
+    | effect Add_to_files (file, data), k ->
+        let mtime = (FileUtil.stat file).modification_time in
+        Hashtbl.add loaded_files file (data, mtime);
+        continue k ()
+    | effect Get_file file, k -> continue k (Hashtbl.find_opt loaded_files file)
+    | effect Add_to_scope trie, k ->
+        let old = !loaded_contents in
+        loaded_contents := lazy (Scope.Mod.union ~prefix:Emp (Lazy.force old) trie);
+        continue k ()
+    (* Add something to the complete merged namespace. *)
+    | effect Get_scope, k -> continue k (Lazy.force !loaded_contents)
 
   let add_to_scope trie = Effect.perform (Add_to_scope trie)
   let get_scope () = Effect.perform Get_scope

lib/top/top.ml

@@ -196,15 +196,6 @@ module Pauseable (R : Signatures.Type) = struct
   (* The stored continuation, which points into the callback inside run_top. *)
   let cont : (unit -> R.t, R.t) continuation option ref = ref None
 
-  (* The effect handler that saves the continuation and returns the output passed to 'Yield'. *)
-  let effc : type b. b Effect.t -> ((b, R.t) continuation -> R.t) option = function
-    | Yield output ->
-        Some
-          (fun k ->
-            cont := Some k;
-            output)
-    | _ -> None
-
   (* The coroutine.  This calls itself with an infinite recursion and so never actually returns in an ordinary way, only by performing effects.  But it is declared to have a return type of R.t, to match that of the effects. *)
   let rec corun_top (f : unit -> R.t) : R.t =
     (* The "Yield" effect returns control to the caller until we are continued.  At that point execution resumes here with a new callback, which we then pass off to ourselves recursively. *)
@@ -224,9 +215,10 @@ module Pauseable (R : Signatures.Type) = struct
   let init ?use_ansi ?onechar_ops ?digit_vars ?ascii_symbols f =
     (* First we discontinue any existing continuation, to avoid leaks. *)
     halt ();
-    try_with
-      (fun () -> run_top ?use_ansi ?onechar_ops ?digit_vars ?ascii_symbols @@ fun () -> corun_top f)
-      () { effc }
+    try run_top ?use_ansi ?onechar_ops ?digit_vars ?ascii_symbols @@ fun () -> corun_top f
+    with effect Yield output, k ->
+      cont := Some k;
+      output
 
   (* After startup, the caller calls "next" with a callback to be executed inside the run_top handlers and return a value. *)
   let next (f : unit -> R.t) : R.t =

lib/util/query.ml

@@ -11,14 +11,7 @@ struct
 
   let run ~(ask : Q.question -> Q.answer) f =
     let open Effect.Deep in
-    try_with f ()
-      {
-        effc =
-          (fun (type a) (eff : a Effect.t) ->
-            match eff with
-            | Ask q -> Option.some @@ fun (k : (a, _) continuation) -> continue k (ask q)
-            | _ -> None);
-      }
+    try f () with effect Ask q, k -> continue k (ask q)
 
   let register_printer f =
     Printexc.register_printer @@ function

lib/util/state.ml

@@ -12,33 +12,19 @@ struct
   let run ~(init : State.t) f =
     let open Effect.Deep in
     let st = ref init in
-    try_with f ()
-      {
-        effc =
-          (fun (type a) (eff : a Effect.t) ->
-            match eff with
-            | Get -> Option.some @@ fun (k : (a, _) continuation) -> continue k !st
-            | Set v ->
-                Option.some @@ fun (k : (a, _) continuation) ->
-                st := v;
-                continue k ()
-            | _ -> None);
-      }
+    try f () with
+    | effect Get, k -> continue k !st
+    | effect Set v, k ->
+        st := v;
+        continue k ()
 
   let try_with ?(get = get) ?(set = set) f =
     let open Effect.Deep in
-    try_with f ()
-      {
-        effc =
-          (fun (type a) (eff : a Effect.t) ->
-            match eff with
-            | Get -> Option.some @@ fun (k : (a, _) continuation) -> continue k (get ())
-            | Set v ->
-                Option.some @@ fun (k : (a, _) continuation) ->
-                set v;
-                continue k ()
-            | _ -> None);
-      }
+    try f () with
+    | effect Get, k -> continue k (get ())
+    | effect Set v, k ->
+        set v;
+        continue k ()
 
   let modify f = set @@ f @@ get ()