better support for revised syntax

Ignore-this: a75d11960fc1daa6c8838f0e00747333

darcs-hash:20120223105439-c41ad-1904218737a1b71fdadc159f606f5c2ca58cfed9

src/lib/uTop.ml

@@ -454,32 +454,46 @@ let handle_findlib_error = function
   | exn ->
       raise exn
 
+let set_syntax syntax =
+  match get_syntax (), syntax with
+    | Normal, Normal
+    | Camlp4o, Camlp4o
+    | Camlp4r, Camlp4r ->
+        ()
+    | (Camlp4o | Camlp4r), _ ->
+        Lwt_main.run (print_error "Camlp4 already loaded, you cannot change the syntax now.\n")
+    | Normal, Camlp4o -> begin
+        set_syntax Camlp4o;
+        set_phrase_terminator ";;";
+        try
+          Topfind.syntax "camlp4o";
+          Topfind.load_deeply ["utop.camlp4"]
+        with exn ->
+          handle_findlib_error exn
+      end
+    | Normal, Camlp4r -> begin
+        set_syntax Camlp4r;
+        set_phrase_terminator ";";
+        add_keyword "value";
+        try
+          Topfind.syntax "camlp4r";
+          Topfind.load_deeply ["utop.camlp4"]
+        with exn ->
+          handle_findlib_error exn
+      end
+
 let () =
   Hashtbl.add
     Toploop.directive_table
     "camlp4o"
     (Toploop.Directive_none
-       (fun () ->
+       (fun () -> set_syntax Camlp4o));
-          set_syntax Camlp4o;
-          set_phrase_terminator ";;";
-          try
-            Topfind.syntax "camlp4o";
-            Topfind.load_deeply ["utop.camlp4"]
-          with exn ->
-            handle_findlib_error exn));
 
   Hashtbl.add
     Toploop.directive_table
     "camlp4r"
     (Toploop.Directive_none
-       (fun () ->
+       (fun () -> set_syntax Camlp4r))
-          set_syntax Camlp4r;
-          set_phrase_terminator ";";
-          try
-            Topfind.syntax "camlp4r";
-            Topfind.load_deeply ["utop.camlp4"]
-          with exn ->
-            handle_findlib_error exn))
 
 (* +-----------------------------------------------------------------+
    | Initialization                                                  |

src/lib/uTop.mli

@@ -41,13 +41,21 @@ type syntax =
 val syntax : syntax signal
   (** The syntax in use. If it is {!Camlp4o} or {!Camlp4r} quotations
       are recognized. It is modified when you type [#camlp4o] or
-      [#camlp4r]. *)
+      [#camlp4r]. At the beginning it is {!Normal}. *)
 
 val get_syntax : unit -> syntax
   (** Returns the current value of {!syntax}. *)
 
 val set_syntax : syntax -> unit
-  (** Modifies {!syntax}. *)
+  (** Changes the syntax used in utop. If the syntax is the same as
+      the current one, it does nothing. Otherwise it loads camlp4 and
+      setup several configuration variables.
+
+      Notes:
+      - the syntax can only be changed once. Once you set it to
+        {!Camlp4o} or {!Camlp4r} you cannot change it again.
+      - Typing [#camlp4o] is the same as calling [set_syntax Camlp4o].
+      - Typing [#camlp4r] is the same as calling [set_syntax Camlp4r]. *)
 
 val phrase_terminator : string signal
   (** The phrase terminator. It is ";;" by default and ";" when you

src/lib/uTop_complete.ml

@@ -514,6 +514,23 @@ let reset () =
   local_fields_by_path := Path_map.empty;
   local_fields_by_longident := Longident_map.empty
 
+let replace x y set =
+  if String_set.mem x set then
+    String_set.add y (String_set.remove x set)
+  else
+    set
+
+let global_names syntax =
+  let set = Lazy.force !global_names in
+  match syntax with
+    | UTop.Normal | UTop.Camlp4o ->
+        set
+    | UTop.Camlp4r ->
+        replace "true" "True" (replace "false" "False" set)
+
+let global_fields () =
+  Lazy.force !global_fields
+
 (* +-----------------------------------------------------------------+
    | Listing methods                                                 |
    +-----------------------------------------------------------------+ *)
@@ -676,6 +693,13 @@ and find_context_in_quotation = function
    +-----------------------------------------------------------------+ *)
 
 let complete ~syntax ~phrase_terminator ~input =
+  let true_name, false_name =
+    match syntax with
+      | UTop.Normal | UTop.Camlp4o ->
+          ("true", "false")
+      | UTop.Camlp4r ->
+          ("True", "False")
+  in
   let tokens = UTop_lexer.lex_string syntax input in
   (* Filter blanks and comments. *)
   let tokens = filter tokens in
@@ -765,9 +789,9 @@ let complete ~syntax ~phrase_terminator ~input =
          match try Some (Hashtbl.find Toploop.directive_table dir) with Not_found -> None with
            | Some (Toploop.Directive_none _) -> [(phrase_terminator, "")]
            | Some (Toploop.Directive_string _) -> [(" \"", "")]
-           | Some (Toploop.Directive_bool _) -> [("true", phrase_terminator); ("false", phrase_terminator)]
+           | Some (Toploop.Directive_bool _) -> [(true_name, phrase_terminator); (false_name, phrase_terminator)]
            | Some (Toploop.Directive_int _) -> []
-           | Some (Toploop.Directive_ident _) -> List.map (fun w -> (w, "")) (String_set.elements (Lazy.force !global_names))
+           | Some (Toploop.Directive_ident _) -> List.map (fun w -> (w, "")) (String_set.elements (global_names syntax))
            | None -> [])
     | (Symbol "#", _) :: ((Lident dir | Uident dir), _) :: tokens -> begin
         match try Some (Hashtbl.find Toploop.directive_table dir) with Not_found -> None with
@@ -778,7 +802,7 @@ let complete ~syntax ~phrase_terminator ~input =
           | Some (Toploop.Directive_bool _) -> begin
               match tokens with
                 | [(Lident id, { idx1 = start })] ->
-                    (start, lookup_assoc id [("true", phrase_terminator); ("false", phrase_terminator)])
+                    (start, lookup_assoc id [(true_name, phrase_terminator); (false_name, phrase_terminator)])
                 | _ ->
                     (0, [])
             end
@@ -787,7 +811,7 @@ let complete ~syntax ~phrase_terminator ~input =
           | Some (Toploop.Directive_ident _) -> begin
               match parse_longident (List.rev tokens) with
                 | Some (Value, None, start, id) ->
-                    (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (Lazy.force !global_names))))
+                    (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (global_names syntax))))
                 | Some (Value, Some longident, start, id) ->
                     (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (names_of_module longident))))
                 | _ ->
@@ -803,7 +827,7 @@ let complete ~syntax ~phrase_terminator ~input =
           | None ->
               (0, [])
           | Some [] ->
-              (0, List.map (fun w -> (w, "")) (String_set.elements (String_set.union !UTop.keywords (Lazy.force !global_names))))
+              (0, List.map (fun w -> (w, "")) (String_set.elements (String_set.union !UTop.keywords (global_names syntax))))
           | Some tokens ->
               match parse_method tokens with
                 | Some (longident, meths, start, meth) ->
@@ -823,10 +847,10 @@ let complete ~syntax ~phrase_terminator ~input =
                             | None ->
                                 (0, [])
                             | Some (Value, None, start, id) ->
-                                (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (String_set.union !UTop.keywords (Lazy.force !global_names)))))
+                                (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (String_set.union !UTop.keywords (global_names syntax)))))
                             | Some (Value, Some longident, start, id) ->
                                 (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (names_of_module longident))))
                             | Some (Field, None, start, id) ->
-                                (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (Lazy.force !global_fields))))
+                                (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (global_fields ()))))
                             | Some (Field, Some longident, start, id) ->
                                 (start, List.map (fun w -> (w, "")) (lookup id (String_set.elements (fields_of_module longident))))