Get rid of lwt.syntax.

_oasis

@@ -45,7 +45,7 @@ Library utop
     UTop_token,
     UTop_complete,
     UTop_styles
-  BuildDepends: findlib, lambda-term (>= 1.2), lwt.syntax, threads
+  BuildDepends: threads, findlib, lambda-term (>= 1.2)
   XMETADescription: utop configuration
   XMETARequires: findlib, lambda-term
 
@@ -65,7 +65,7 @@ Executable utop
   Path: src/top
   CompiledObject: byte
   MainIs: uTop_top.ml
-  BuildDepends: utop, findlib, lambda-term, lwt.syntax, threads
+  BuildDepends: threads, findlib, lambda-term, utop
   DataFiles: utop.el ($datadir/emacs/site-lisp)
 
 Executable "utop-full"
@@ -73,7 +73,7 @@ Executable "utop-full"
   Path: src/top
   CompiledObject: byte
   MainIs: uTop_top_full.ml
-  BuildDepends: utop, findlib, lambda-term, lwt.syntax, threads
+  BuildDepends: threads, findlib, lambda-term, utop
   DataFiles: utop.el ($datadir/emacs/site-lisp)
 
 # +-------------------------------------------------------------------+

_tags

@@ -1,8 +1,5 @@
 # -*- conf -*-
 
-# Use camlp4 on all files
-<**/*.ml>: syntax_camlp4o, pkg_lwt.syntax
-
 # Use compiler interfaces
 <src/**/*.ml{,i}>: use_compiler_libs
 

src/lib/uTop.cppo.ml

@@ -13,6 +13,8 @@ open LTerm_text
 open LTerm_geom
 open LTerm_style
 
+let (>>=) = Lwt.(>>=)
+
 module String_set = Set.Make(String)
 
 let version = UTop_version.version
@@ -595,10 +597,10 @@ For a complete description of utop, look at the utop(1) manual page."));
    +-----------------------------------------------------------------+ *)
 
 let print_error msg =
-  lwt term = Lazy.force LTerm.stdout in
+  Lazy.force LTerm.stdout >>= fun term ->
-  lwt () = LTerm.set_style term !UTop_private.error_style in
+  LTerm.set_style term !UTop_private.error_style >>= fun () ->
-  lwt () = Lwt_io.print msg in
+  Lwt_io.print msg >>= fun () ->
-  lwt () = LTerm.set_style term LTerm_style.none in
+  LTerm.set_style term LTerm_style.none >>= fun () ->
   LTerm.flush term
 
 let handle_findlib_error = function

src/lib/uTop_main.cppo.ml

@@ -8,7 +8,6 @@
  *)
 
 open CamomileLibraryDyn.Camomile
-open Lwt
 open Lwt_react
 open LTerm_text
 open LTerm_geom
@@ -16,6 +15,8 @@ open UTop_token
 open UTop_styles
 open UTop_private
 
+let return, (>>=) = Lwt.return, Lwt.(>>=)
+
 module String_set = Set.Make(String)
 
 exception Term of int
@@ -29,10 +30,14 @@ let save_history () =
     | None ->
         return ()
     | Some fn ->
-        try_lwt
+        Lwt.catch
-          LTerm_history.save UTop.history ?max_size:!UTop.history_file_max_size ?max_entries:!UTop.history_file_max_entries fn
+          (fun () -> LTerm_history.save UTop.history
-        with Unix.Unix_error (error, func, arg) ->
+                        ?max_size:!UTop.history_file_max_size
-          Lwt_log.error_f "cannot save history to %S: %s: %s" fn func (Unix.error_message error)
+                        ?max_entries:!UTop.history_file_max_entries fn)
+          (function
+          | Unix.Unix_error (error, func, arg) ->
+              Lwt_log.error_f "cannot save history to %S: %s: %s" fn func (Unix.error_message error)
+          | exn -> Lwt.fail exn)
 
 let init_history () =
   (* Save history on exit. *)
@@ -42,10 +47,13 @@ let init_history () =
     | None ->
         return ()
     | Some fn ->
-        try_lwt
+        Lwt.catch
-          LTerm_history.load UTop.history fn
+          (fun () -> LTerm_history.load UTop.history fn)
-        with Unix.Unix_error (error, func, arg) ->
+          (function
-          Lwt_log.error_f "cannot load history from %S: %s: %s" fn func (Unix.error_message error)
+          | Unix.Unix_error (error, func, arg) ->
+              Lwt_log.error_f "cannot load history from %S: %s: %s"
+                              fn func (Unix.error_message error)
+          | exn -> Lwt.fail exn)
 
 (* +-----------------------------------------------------------------+
    | offset --> index                                                |
@@ -553,20 +561,22 @@ let rewrite phrase =
    +-----------------------------------------------------------------+ *)
 
 let rec read_phrase term =
-  try_lwt
+  Lwt.catch
-    (new read_phrase ~term)#run
+    (fun () -> (new read_phrase ~term)#run)
-  with Sys.Break ->
+    (function
-    lwt () = LTerm.fprintl term "Interrupted." in
+    | Sys.Break ->
-    read_phrase term
+      LTerm.fprintl term "Interrupted." >>= fun () ->
+      read_phrase term
+    | exn -> Lwt.fail exn)
 
 let update_margin pp cols =
   if Format.pp_get_margin pp () <> cols then
     Format.pp_set_margin pp cols
 
 let print_error term msg =
-  lwt () = LTerm.set_style term styles.style_error in
+  LTerm.set_style term styles.style_error >>= fun () ->
-  lwt () = Lwt_io.print msg in
+  Lwt_io.print msg >>= fun () ->
-  lwt () = LTerm.set_style term LTerm_style.none in
+  LTerm.set_style term LTerm_style.none >>= fun () ->
   LTerm.flush term
 
 let rec loop term =
@@ -582,18 +592,18 @@ let rec loop term =
   (* Read interactively user input. *)
   let phrase_opt =
     Lwt_main.run (
-      try_lwt
+      Lwt.finalize
-        lwt result, warnings = read_phrase term in
+        (fun () ->
-        (* Print warnings before errors. *)
+          read_phrase term >>= fun (result, warnings) ->
-        lwt () = Lwt_io.print warnings in
+          (* Print warnings before errors. *)
-        match result with
+          Lwt_io.print warnings >>= fun () ->
-          | UTop.Value phrase ->
+          match result with
-              return (Some phrase)
+            | UTop.Value phrase ->
-          | UTop.Error (_, msg) ->
+                return (Some phrase)
-              lwt () = print_error term msg in
+            | UTop.Error (_, msg) ->
-              return None
+                print_error term msg >>= fun () ->
-      finally
+                return None)
-        LTerm.flush term
+        (fun () -> LTerm.flush term)
     )
   in
 
@@ -677,10 +687,10 @@ let welcome term =
   LTerm_draw.draw_styled ctx 1 ((size.cols - String.length message) / 2) (eval [B_fg LTerm_style.yellow; S message]);
 
   (* Render to the screen. *)
-  lwt () = LTerm.print_box term matrix in
+  LTerm.print_box term matrix >>= fun () ->
 
   (* Move to after the box. *)
-  lwt () = LTerm.fprint term "\n" in
+  LTerm.fprint term "\n" >>= fun () ->
 
   LTerm.flush term
 
@@ -707,7 +717,7 @@ let read_input_classic prompt buffer len =
         | None ->
             return (i, true)
   in
-  Lwt_main.run (Lwt_io.write Lwt_io.stdout prompt >> loop 0)
+  Lwt_main.run (Lwt_io.write Lwt_io.stdout prompt >>= fun () -> loop 0)
 
 (* +-----------------------------------------------------------------+
    | Emacs mode                                                      |
@@ -1272,13 +1282,14 @@ let common_init () =
   catch Sys.sigterm
 
 let load_inputrc () =
-  try_lwt
+  Lwt.catch
-    LTerm_inputrc.load ()
+    LTerm_inputrc.load
-  with
+    (function
-  | Unix.Unix_error (error, func, arg) ->
+    | Unix.Unix_error (error, func, arg) ->
-    Lwt_log.error_f "cannot load key bindings from %S: %s: %s" LTerm_inputrc.default func (Unix.error_message error)
+      Lwt_log.error_f "cannot load key bindings from %S: %s: %s" LTerm_inputrc.default func (Unix.error_message error)
-  | LTerm_inputrc.Parse_error (fname, line, msg) ->
+    | LTerm_inputrc.Parse_error (fname, line, msg) ->
-    Lwt_log.error_f "error in key bindings file %S, line %d: %s" fname line msg
+      Lwt_log.error_f "error in key bindings file %S, line %d: %s" fname line msg
+    | exn -> Lwt.fail exn)
 
 let main_aux () =
   Arg.parse args file_argument usage;
@@ -1296,7 +1307,7 @@ let main_aux () =
       (* Set the initial size. *)
       UTop_private.set_size (S.const (LTerm.size term));
       (* Load user data. *)
-      Lwt_main.run (join [UTop_styles.load (); load_inputrc ()]);
+      Lwt_main.run (Lwt.join [UTop_styles.load (); load_inputrc ()]);
       (* Display a welcome message. *)
       Lwt_main.run (welcome term);
       (* Common initialization. *)

src/lib/uTop_styles.ml

@@ -7,9 +7,10 @@
  * This file is a part of utop.
  *)
 
-open Lwt
 open UTop_token
 
+let return, (>>=) = Lwt.return, Lwt.(>>=)
+
 module String_set = Set.Make (String)
 
 type styles = {
@@ -56,41 +57,43 @@ let styles = {
 
 let load () =
   let fn = Filename.concat LTerm_resources.home ".utoprc" in
-  try_lwt
+  Lwt.catch
-    lwt res = LTerm_resources.load fn in
+    (fun () ->
-    styles.style_keyword <- LTerm_resources.get_style "keyword" res;
+      LTerm_resources.load fn >>= fun res ->
-    styles.style_symbol <- LTerm_resources.get_style "symbol" res;
+      styles.style_keyword <- LTerm_resources.get_style "keyword" res;
-    styles.style_ident <- LTerm_resources.get_style "identifier" res;
+      styles.style_symbol <- LTerm_resources.get_style "symbol" res;
-    styles.style_module <- LTerm_resources.get_style "module" res;
+      styles.style_ident <- LTerm_resources.get_style "identifier" res;
-    styles.style_constant <- LTerm_resources.get_style "constant" res;
+      styles.style_module <- LTerm_resources.get_style "module" res;
-    styles.style_char <- LTerm_resources.get_style "char" res;
+      styles.style_constant <- LTerm_resources.get_style "constant" res;
-    styles.style_string <- LTerm_resources.get_style "string" res;
+      styles.style_char <- LTerm_resources.get_style "char" res;
-    styles.style_quotation <- LTerm_resources.get_style "quotation" res;
+      styles.style_string <- LTerm_resources.get_style "string" res;
-    styles.style_comment <- LTerm_resources.get_style "comment" res;
+      styles.style_quotation <- LTerm_resources.get_style "quotation" res;
-    styles.style_doc <- LTerm_resources.get_style "doc" res;
+      styles.style_comment <- LTerm_resources.get_style "comment" res;
-    styles.style_blanks <- LTerm_resources.get_style "blanks" res;
+      styles.style_doc <- LTerm_resources.get_style "doc" res;
-    styles.style_error <- LTerm_resources.get_style "error" res;
+      styles.style_blanks <- LTerm_resources.get_style "blanks" res;
-    styles.style_directive <- LTerm_resources.get_style "directive" res;
+      styles.style_error <- LTerm_resources.get_style "error" res;
-    styles.style_paren <- LTerm_resources.get_style "parenthesis" res;
+      styles.style_directive <- LTerm_resources.get_style "directive" res;
-    styles.style_font <- (match LTerm_resources.get "font" res with
+      styles.style_paren <- LTerm_resources.get_style "parenthesis" res;
-                            | "" -> None
+      styles.style_font <- (match LTerm_resources.get "font" res with
-                            | str -> Some str);
+                              | "" -> None
-    styles.style_foreground <- LTerm_resources.get_color "foreground" res;
+                              | str -> Some str);
-    styles.style_background <- LTerm_resources.get_color "background" res;
+      styles.style_foreground <- LTerm_resources.get_color "foreground" res;
-    styles.style_cursor <- LTerm_resources.get_color "cursor" res;
+      styles.style_background <- LTerm_resources.get_color "background" res;
-    (match String.lowercase (LTerm_resources.get "profile" res) with
+      styles.style_cursor <- LTerm_resources.get_color "cursor" res;
-       | "light" -> UTop.set_profile UTop.Light
+      (match String.lowercase (LTerm_resources.get "profile" res) with
-       | "dark" -> UTop.set_profile UTop.Dark
+         | "light" -> UTop.set_profile UTop.Light
-       | "" -> ()
+         | "dark" -> UTop.set_profile UTop.Dark
-       | str -> raise (LTerm_resources.Error (Printf.sprintf "invalid profile %S" str)));
+         | "" -> ()
-    UTop_private.error_style := styles.style_error;
+         | str -> raise (LTerm_resources.Error (Printf.sprintf "invalid profile %S" str)));
-    UTop_private.autoload := LTerm_resources.get_bool "autoload" res <> Some false;
+      UTop_private.error_style := styles.style_error;
-    return ()
+      UTop_private.autoload := LTerm_resources.get_bool "autoload" res <> Some false;
-  with
+      return ())
+    (function
     | Unix.Unix_error(Unix.ENOENT, _, _) ->
         return ()
     | Unix.Unix_error (error, func, arg) ->
         Lwt_log.error_f "cannot load styles from %S: %s: %s" fn func (Unix.error_message error)
+    | exn -> Lwt.fail exn)
 
 let rec stylise_filter_layout stylise tokens =
   match tokens with