add editor mode to compiler that lets you continue past certain type errors to produce more type information

Author: zth

compiler/bsc/rescript_compiler_main.ml

@@ -369,6 +369,9 @@ let buckle_script_flags : (string * Bsc_args.spec * string) array =
     ( "-ignore-parse-errors",
       set Clflags.ignore_parse_errors,
       "*internal* continue after parse errors" );
+    ( "-editor-mode",
+      set Clflags.editor_mode,
+      "*internal* editor mode. Adapts compilation for editors." );
     ( "-where",
       unit_call print_standard_library,
       "*internal* Print location of standard library and exit" );

compiler/ml/clflags.ml

@@ -42,6 +42,10 @@ and only_parse = ref false (* -only-parse *)
 
 and ignore_parse_errors = ref false (* -ignore-parse-errors *)
 
+and editor_mode = ref true
+(* -editor-mode *)
+(* true for easy testing *)
+
 let dont_write_files = ref false (* set to true under ocamldoc *)
 
 let reset_dump_state () =

compiler/ml/clflags.mli

@@ -25,6 +25,7 @@ val dont_write_files : bool ref
 val keep_locs : bool ref
 val only_parse : bool ref
 val ignore_parse_errors : bool ref
+val editor_mode : bool ref
 
 val parse_color_setting : string -> Misc.Color.setting option
 val color : Misc.Color.setting option ref

compiler/ml/predef.ml

@@ -65,6 +65,8 @@ and ident_promise = ident_create "promise"
 
 and ident_uncurried = ident_create "function$"
 
+and ident_tainted = ident_create "tainted$"
+
 type test = For_sure_yes | For_sure_no | NA
 
 let type_is_builtin_path_but_option (p : Path.t) : test =
@@ -112,6 +114,8 @@ and path_promise = Pident ident_promise
 
 and path_uncurried = Pident ident_uncurried
 
+and path_tainted = Pident ident_tainted
+
 let type_int = newgenty (Tconstr (path_int, [], ref Mnil))
 
 and type_char = newgenty (Tconstr (path_char, [], ref Mnil))

compiler/ml/predef.mli

@@ -52,6 +52,7 @@ val path_lazy_t : Path.t
 val path_extension_constructor : Path.t
 val path_promise : Path.t
 val path_uncurried : Path.t
+val path_tainted : Path.t
 
 val path_match_failure : Path.t
 val path_assert_failure : Path.t

compiler/ml/typecore.ml

@@ -84,6 +84,14 @@ exception Error_forward of Location.error
 
 (* Forward declaration, to be filled in by Typemod.type_module *)
 
+let delayed_typechecking_errors = ref []
+
+let add_delayed_error e =
+  delayed_typechecking_errors := e :: !delayed_typechecking_errors
+
+let get_first_delayed_error () =
+  List.nth_opt (!delayed_typechecking_errors |> List.rev) 0
+
 let type_module =
   ref
     (fun _env _md -> assert false
@@ -264,6 +272,18 @@ let option_none ty loc =
   let cnone = Env.lookup_constructor lid env in
   mkexp (Texp_construct (mknoloc lid, cnone, [])) ty loc env
 
+let tainted () =
+  let lid = Longident.Lident "None" and env = Env.initial_safe_string in
+  let cnone = Env.lookup_constructor lid env in
+  {
+    exp_desc = Texp_construct (mknoloc lid, cnone, []);
+    exp_type = newconstr Predef.path_tainted [];
+    exp_loc = Location.none;
+    exp_env = env;
+    exp_extra = [];
+    exp_attributes = [(Location.mknoloc "tainted", PStr [])];
+  }
+
 let option_some texp =
   let lid = Longident.Lident "Some" in
   let csome = Env.lookup_constructor lid Env.initial_safe_string in
@@ -2249,6 +2269,11 @@ and type_expect ?type_clash_context ?in_function ?recarg env sexp ty_expected =
   in
   Cmt_format.set_saved_types
     (Cmt_format.Partial_expression exp :: previous_saved_types);
+
+  (match get_first_delayed_error () with
+  | None -> ()
+  | Some e -> raise e);
+
   exp
 
 and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp
@@ -3537,7 +3562,15 @@ and type_application ?type_clash_context total_app env funct (sargs : sargs) :
         ( List.map
             (function
               | l, None -> (l, None)
-              | l, Some f -> (l, Some (f ())))
+              | l, Some f ->
+                ( l,
+                  Some
+                    (if !Clflags.editor_mode then (
+                       try f ()
+                       with e ->
+                         add_delayed_error e;
+                         tainted ())
+                     else f ()) ))
             (List.rev args),
           instance env (result_type omitted ty_fun) )
       in