Serokell Grant 2 Milestone 3

src/js/common.ml

@@ -267,13 +267,14 @@ let js_parse_motoko_typed_with_scope_cache_impl enable_recovery paths scope_cach
            all. Hence, the use of [Obj.magic] is legitimate here. *)
         String_map_conversion.from_js scope_cache Js.to_string Obj.magic)
   in
-  let parse_fn = if Js.Opt.get enable_recovery (fun () -> false)
+  let recovery_enabled = Js.Opt.get enable_recovery (fun () -> false) in
+  let parse_fn = if recovery_enabled
     then Pipeline.parse_file_with_recovery
     else Pipeline.parse_file
   in
   let load_result =
     Mo_types.Cons.session (fun () ->
-      Pipeline.load_progs_cached
+      Pipeline.load_progs_cached ~enable_type_recovery:recovery_enabled
         parse_fn paths Pipeline.initial_stat_env scope_cache)
   in
   match load_result with

src/mo_frontend/dune

@@ -28,6 +28,6 @@
   (name test_recovery)
   (inline_tests)
   (modules test_recovery)
-  (libraries mo_frontend menhirLib lib lang_utils mo_config mo_def mo_types mo_values wasm_exts ocaml-recovery-parser.menhirRecoveryLib )
+  (libraries mo_frontend menhirLib lib lang_utils mo_config mo_def mo_types mo_values wasm_exts ocaml-recovery-parser.menhirRecoveryLib pipeline )
   (flags (:standard -w -40))
   (preprocess (pps ppx_inline_test ppx_expect)))

src/mo_frontend/parser.mly

@@ -250,7 +250,7 @@ and objblock eo s id ty dec_fields =
 %token<string> FLOAT
 %token<Mo_values.Value.unicode> CHAR
 %token<bool> BOOL
-%token<string> ID
+%token<string> ID [@recover.expr "__error_recovery_var__"]
 %token<string> TEXT
 %token PIPE
 %token PRIM

src/mo_frontend/test_recovery.ml

@@ -1,6 +1,8 @@
 (** Maintenance note:
     Update of the expected values could be done via [dune runtest --auto-promote].
 *)
+module Parser = Mo_frontend.Parser
+module Lexer = Mo_frontend.Lexer
 
 let parse_from_lexbuf lexbuf : Mo_def.Syntax.prog Diag.result =
   let open Mo_frontend in
@@ -27,6 +29,21 @@ let show  (r: Mo_def.Syntax.prog Diag.result) : String.t =
     ^ "\n with errors:\n" ^ show_msgs msgs
   | Error msgs -> "Errors:\n" ^ show_msgs msgs
 
+let show_with_types  (r: Mo_def.Syntax.prog Diag.result) : String.t =
+  let show_msgs msgs =
+    String.concat "\n" (List.map Diag.string_of_message msgs) in
+  match r with
+  | Ok (prog, msgs) ->
+    let module Arrange = Mo_def.Arrange.Make(
+      struct
+        include Mo_def.Arrange.Default
+        let include_types = true
+      end
+    ) in
+    "Ok: " ^ Wasm.Sexpr.to_string 80 (Arrange.prog prog)
+    ^ "\n with errors:\n" ^ show_msgs msgs
+  | Error msgs -> "Errors:\n" ^ show_msgs msgs
+
 
 let _parse_test input (expected : string) =
   let actual = parse_from_string input in
@@ -410,3 +427,269 @@ let%expect_test "test5" =
       module class <func_pat> <annot_opt> <class_body> (e.g. 'module class f(x : Int) : Int = {}')
       actor class <func_pat> <annot_opt> <class_body> (e.g. 'actor class f(x : Int) : Int = {}')
       persistent actor class <func_pat> <annot_opt> <class_body> (e.g. 'persistent actor class f(x : Int) : Int = {}') |}]
+
+let%expect_test "test type recovery 1" =
+  let s = "func test_func () {
+  let x = Counter(0);
+  x.
+  let a = 1;
+}
+
+class Counter(n: Nat) {
+  var counter : Nat = n;
+  func inc() {counter +=1;};
+  func get() : Nat {counter};
+}" in
+  match (parse_from_string s) with
+  | Ok (prog, _) -> begin
+    let open Mo_frontend in
+    let async_cap = Pipeline.async_cap_of_prog prog in
+    match (Typing.infer_prog ~enable_type_recovery:true Pipeline.initial_stat_env None async_cap prog) with
+    | Ok (_, msgs) ->
+      Printf.printf "%s" @@ show_with_types (Ok (prog, msgs));
+      [%expect {|
+        Ok: (Prog
+          (LetD
+            (: (VarP (ID test_func)) () -> ())
+            (:
+              (FuncE
+                () -> ()
+                Local
+                test_func
+                (: (TupP) ())
+                _
+
+                (:
+                  (BlockE
+                    (LetD
+                      (: (VarP (ID x)) {})
+                      (:
+                        (CallE
+                          _
+                          (: (VarE (ID Counter)) (n : Nat) -> Counter)
+                          (: (LitE (NatLit 0)) Nat)
+                        )
+                        {}
+                      )
+                    )
+                    (ExpD
+                      (: (DotE (: (VarE (ID x)) {}) (ID __error_recovery_var__)) ???)
+                    )
+                    (LetD (: (VarP (ID a)) Nat) (: (LitE (NatLit 1)) Nat))
+                  )
+                  ()
+                )
+              )
+              () -> ()
+            )
+          )
+          (ClassD
+            _
+            Local
+            (ID Counter)
+            (:
+              (ParP
+                (: (AnnotP (: (VarP (ID n)) Nat) (: (PathT (IdH (ID Nat))) Nat)) Nat)
+              )
+              Nat
+            )
+            _
+            Object
+            (ID @anon-object-7.23)
+            (DecField
+              (VarD
+                (ID counter)
+                (: (AnnotE (: (VarE (ID n)) Nat) (: (PathT (IdH (ID Nat))) Nat)) Nat)
+              )
+              Private
+              (Flexible)
+            )
+            (DecField
+              (LetD
+                (: (VarP (ID inc)) () -> ())
+                (:
+                  (FuncE
+                    () -> ()
+                    Local
+                    inc
+                    (: (TupP) ())
+                    _
+
+                    (:
+                      (BlockE
+                        (ExpD
+                          (:
+                            (AssignE
+                              (: (VarE (ID counter)) var Nat)
+                              (:
+                                (BinE
+                                  Nat
+                                  (: (VarE (ID counter)) Nat)
+                                  AddOp
+                                  (: (LitE (NatLit 1)) Nat)
+                                )
+                                Nat
+                              )
+                            )
+                            ()
+                          )
+                        )
+                      )
+                      ()
+                    )
+                  )
+                  () -> ()
+                )
+              )
+              Private
+              (Flexible)
+            )
+            (DecField
+              (LetD
+                (: (VarP (ID get)) () -> Nat)
+                (:
+                  (FuncE
+                    () -> Nat
+                    Local
+                    get
+                    (: (TupP) ())
+                    (: (PathT (IdH (ID Nat))) Nat)
+
+                    (: (BlockE (ExpD (: (VarE (ID counter)) Nat))) Nat)
+                  )
+                  () -> Nat
+                )
+              )
+              Private
+              (Flexible)
+            )
+          )
+        )
+
+         with errors:
+        (unknown location): type error [M0072], field __error_recovery_var__ does not exist in type:
+          {}
+      |}]
+    | Error msgs -> Printf.printf "%s" @@ show (Error msgs)
+    end
+  | Error _ as r -> Printf.printf "%s" @@ show r;
+  [%expect.unreachable]
+
+let%expect_test "test type recovery 2" =
+  let s = "module M {};
+let _x = M.
+" in
+  match (parse_from_string s) with
+  | Ok (prog, _) -> begin
+    let open Mo_frontend in
+    let async_cap = Pipeline.async_cap_of_prog prog in
+    match (Typing.infer_prog ~enable_type_recovery:true Pipeline.initial_stat_env None async_cap prog) with
+    | Ok (_, msgs) ->
+      Printf.printf "%s" @@ show_with_types (Ok (prog, msgs));
+      [%expect {|
+        Ok: (Prog
+          (LetD (: (VarP (ID M)) module {}) (: (ObjBlockE _ Module _) ???))
+          (LetD
+            (: (VarP (ID _x)) ???)
+            (: (DotE (: (VarE (ID M)) ???) (ID __error_recovery_var__)) ???)
+          )
+        )
+
+         with errors:
+        (unknown location): type error [M0072], field __error_recovery_var__ does not exist in type:
+          module {}
+      |}]
+    | Error msgs -> Printf.printf "%s" @@ show (Error msgs)
+    end
+  | Error _ as r -> Printf.printf "%s" @@ show r;
+  [%expect.unreachable]
+
+let%expect_test "test type recovery 3" =
+  let s = "let _x = (1 +
+" in
+  match (parse_from_string s) with
+  | Ok (prog, _) -> begin
+    let open Mo_frontend in
+    let async_cap = Pipeline.async_cap_of_prog prog in
+    match (Typing.infer_prog ~enable_type_recovery:true Pipeline.initial_stat_env None async_cap prog) with
+    | Ok (_, msgs) ->
+      Printf.printf "%s" @@ show_with_types (Ok (prog, msgs));
+      [%expect {|
+        Ok: (Prog
+          (LetD
+            (: (VarP (ID _x)) Nat)
+            (:
+              (BinE
+                Nat
+                (: (LitE (NatLit 1)) Nat)
+                AddOp
+                (: (LoopE (: (BlockE) ())) None)
+              )
+              Nat
+            )
+          )
+        )
+
+         with errors:
+      |}]
+    | Error msgs -> Printf.printf "%s" @@ show (Error msgs)
+    end
+  | Error _ as r -> Printf.printf "%s" @@ show r;
+  [%expect.unreachable]
+
+let%expect_test "test type recovery 4" =
+  let s = "f(x
+" in
+  match (parse_from_string s) with
+  | Ok (prog, _) -> begin
+    let open Mo_frontend in
+    let async_cap = Pipeline.async_cap_of_prog prog in
+    match (Typing.infer_prog ~enable_type_recovery:true Pipeline.initial_stat_env None async_cap prog) with
+    | Ok (_, msgs) ->
+      Printf.printf "%s" @@ show_with_types (Ok (prog, msgs));
+      [%expect {|
+        Ok: (Prog (ExpD (: (CallE _ (: (VarE (ID f)) ???) (: (VarE (ID x)) ???)) ???)))
+
+         with errors:
+        (unknown location): type error [M0057], unbound variable f
+      |}]
+    | Error msgs -> Printf.printf "%s" @@ show (Error msgs)
+    end
+  | Error _ as r -> Printf.printf "%s" @@ show r;
+  [%expect.unreachable]
+
+let%expect_test "test type recovery 5" =
+  let s = "import A \"a\";
+  A.f(x
+" in
+  match (parse_from_string s) with
+  | Ok (prog, _) -> begin
+    let open Mo_frontend in
+    let async_cap = Pipeline.async_cap_of_prog prog in
+    match (Typing.infer_prog ~enable_type_recovery:true Pipeline.initial_stat_env None async_cap prog) with
+    | Ok (_, msgs) ->
+      Printf.printf "%s" @@ show_with_types (Ok (prog, msgs));
+      [%expect {|
+        Ok: (Prog
+          (LetD (: (VarP (ID A)) ???) (: (ImportE a) ???))
+          (ExpD
+            (:
+              (CallE
+                _
+                (: (DotE (: (VarE (ID A)) ???) (ID f)) ???)
+                (: (VarE (ID x)) ???)
+              )
+              ???
+            )
+          )
+        )
+
+         with errors:
+        (unknown location): type error [M0020], unresolved import a
+      |}]
+    | Error msgs -> Printf.printf "%s" @@ show (Error msgs)
+    end
+  | Error _ as r -> Printf.printf "%s" @@ show r;
+  [%expect.unreachable]
+
+

src/mo_frontend/typing.ml

@@ -4575,12 +4575,16 @@ and infer_dec_valdecs env dec : Scope.t =
     }
 
 (* Programs *)
-let infer_prog ?(viper_mode=false) scope pkg_opt async_cap prog
+let infer_prog ?(viper_mode=false) ?(enable_type_recovery=false) scope pkg_opt async_cap prog
     : (T.typ * Scope.t) Diag.result
   =
-  Diag.with_message_store
+  let recovery_fn = if enable_type_recovery then
+    fun f y -> recover_with (Some (T.unit, Scope.empty)) (fun y -> Some (f y)) y;
+    else recover_opt;
+  in
+  Diag.with_message_store ~allow_errors:enable_type_recovery
     (fun msgs ->
-      recover_opt
+      recovery_fn
         (fun prog ->
           let env0 = env_of_scope ~viper_mode msgs scope in
           let env = {

src/mo_frontend/typing.mli

@@ -6,7 +6,14 @@ open Scope
 
 val initial_scope : scope
 
-val infer_prog : ?viper_mode:bool -> scope -> string option -> Async_cap.async_cap -> Syntax.prog -> (typ * scope) Diag.result
+val infer_prog :
+  ?viper_mode:bool ->
+  ?enable_type_recovery:bool ->
+  scope ->
+  string option ->
+  Async_cap.async_cap ->
+  Syntax.prog ->
+  (typ * scope) Diag.result
 
 val check_lib : scope -> string option -> Syntax.lib -> scope Diag.result
 val check_actors : ?viper_mode:bool -> ?check_actors:bool -> scope -> Syntax.prog list -> unit Diag.result