feat: suggest conversions between primitive types

src/languageServer/declaration_index.ml

@@ -188,6 +188,7 @@ let empty : string -> t =
            package_urls = !Flags.package_urls;
            actor_aliases = !Flags.actor_aliases;
            actor_idl_path = !Flags.actor_idl_path;
+           include_all_libs = false (* TBR *);
          })
   in
   {

src/mo_frontend/suggest.ml

@@ -0,0 +1,102 @@
+
+(* Suggestions *)
+open Mo_types
+open Mo_config
+open Type
+
+let oneof sep lastsep ss =
+  let rest, last = Lib.List.split_last ss in
+  ((if rest <> [] then (String.concat sep rest) ^ lastsep else "") ^ last)
+
+let suggest_id desc id ids =
+  if !Flags.ai_errors then
+    Printf.sprintf
+      "\nThe %s %s is not available. Try something else?"
+      desc
+      id
+  else
+  let suggestions =
+    let limit = Lib.Int.log2 (String.length id) in
+    let distance = Lib.String.levenshtein_distance id in
+    let weighted_ids = List.filter_map (fun id0 ->
+      let d = distance id0 in
+      if Lib.String.starts_with id id0 || d <= limit then
+        Some (d, id0)
+      else None) ids in
+    List.sort compare weighted_ids |> List.map snd
+  in
+  if suggestions = [] then ""
+  else
+  Printf.sprintf "\nDid you mean %s %s?" desc (oneof ", " " or " suggestions)
+
+let search_obj desc path ty ty1 ty2 =
+  let suggestions = ref [] in
+  let seen = ref S.empty in
+  let rec go path ty =
+  if S.mem ty !seen then ()
+  else begin
+    seen := S.add ty (!seen);
+    match promote ty with
+    | Obj(_, tfs) ->
+      tfs |>
+      List.iter (fun {lab;typ;_} ->
+        match normalize typ with
+        | Func _ when
+          (Lib.String.starts_with "to" lab ||
+           Lib.String.starts_with "from" lab) &&
+           sub typ (Func(Local, Returns,  [], [ty1], [ty2])) ->
+          suggestions := Printf.sprintf "`%s.%s(_)`%s" path lab desc :: !suggestions
+        | Obj(_, tfs) as ty1  ->
+          go (path^"."^lab) ty1
+        | _ -> ())
+    | _ -> ()
+    end
+  in
+  go path ty;
+  !suggestions
+
+let suggest_conversion libs vals ty1 ty2 =
+  match promote ty1, promote ty2 with
+  | Prim p1, Prim p2 ->
+    let suggestions = ref [] in
+    Env.iter (fun filename ty ->
+      if Lib.String.starts_with "@" filename
+      then () (* skip prim etc *)
+      else
+      let imported_name =
+        (* try to determine imported name, if any *)
+        Env.fold (fun id (ty1, _, _, _) acc ->
+            if ty == ty1 (*HACK*)
+            then Some id
+            else acc)
+          vals None
+      in
+      let lib_opt = match imported_name with
+        | Some id -> Some (id, "")
+        | None ->
+          (* search libs for suggested import *)
+          Flags.M.fold (fun package path acc  ->
+              let base = Lib.FilePath.normalise path in
+              match Lib.FilePath.relative_to base filename with
+              | None -> acc
+              | Some rel_path ->
+                let rel_name = Filename.chop_extension rel_path in
+                let id = Filename.basename rel_name in
+                Some (
+                id,
+                Printf.sprintf  " after adding `import %s = \"mo:%s/%s\"`" id package rel_name))
+             !Flags.package_urls None
+      in
+      match lib_opt with
+      | None -> ()
+      | Some (id, desc) ->
+        suggestions := (search_obj desc id ty ty1 ty2) @ !suggestions)
+      libs;
+    if !suggestions = []
+    then ""
+    else
+      Printf.sprintf "\nMaybe try conversion:\n  %s?"
+      (oneof ",\n  " " or\n  " !suggestions)
+  (* not primitive types, make no suggestion *)
+  | _, _ -> ""
+

src/mo_frontend/suggest.mli

@@ -0,0 +1,5 @@
+open Mo_types
+
+val suggest_id : string (* desc *) -> string (* id *) -> string list (* ids *) -> string
+
+val suggest_conversion : Scope.lib_env -> (Type.typ * _ * _ * _) Type.Env.t -> Type.typ -> Type.typ -> string

src/mo_frontend/typing.ml

@@ -57,6 +57,7 @@ type env =
     unused_warnings : unused_warnings ref;
     reported_stable_memory : bool ref;
     viper_mode : bool;
+    errors_only : bool;
   }
 
 let env_of_scope ?(viper_mode=false) msgs scope =
@@ -79,6 +80,7 @@ let env_of_scope ?(viper_mode=false) msgs scope =
     used_identifiers = ref S.empty;
     unused_warnings = ref [];
     reported_stable_memory = ref false;
+    errors_only = false;
     viper_mode;
   }
 
@@ -114,32 +116,6 @@ let kind_of_field_pattern pf = match pf.it with
   | { id; pat = { it = VarP pat_id; _ } } when id = pat_id -> Scope.FieldReference
   | _ -> Scope.Declaration
 
-(* Suggestions *)
-
-let suggest desc id ids =
-  if !Flags.ai_errors then
-    Printf.sprintf
-      "\nThe %s %s is not available. Try something else?"
-      desc
-      id
-  else
-  let suggestions =
-    let limit = Lib.Int.log2 (String.length id) in
-    let distance = Lib.String.levenshtein_distance id in
-    let weighted_ids = List.filter_map (fun id0 ->
-      let d = distance id0 in
-      if Lib.String.starts_with id id0 || d <= limit then
-        Some (d, id0)
-      else None) ids in
-    List.sort compare weighted_ids |> List.map snd
-  in
-  if suggestions = [] then ""
-  else
-    let rest, last = Lib.List.split_last suggestions in
-    Printf.sprintf "\nDid you mean %s %s?"
-      desc
-      ((if rest <> [] then (String.concat ", " rest) ^ " or " else "") ^ last)
-
 (* Error bookkeeping *)
 
 exception Recover
@@ -219,10 +195,12 @@ let local_error env at code fmt =
   Format.kasprintf (fun s -> Diag.add_msg env.msgs (type_error at code s)) fmt
 
 let warn env at code fmt =
-  Format.kasprintf (fun s -> Diag.add_msg env.msgs (type_warning at code s)) fmt
+  Format.kasprintf (fun s ->
+    if not env.errors_only then Diag.add_msg env.msgs (type_warning at code s)) fmt
 
 let info env at fmt =
-  Format.kasprintf (fun s -> Diag.add_msg env.msgs (type_info at s)) fmt
+  Format.kasprintf (fun s ->
+    if not env.errors_only then Diag.add_msg env.msgs (type_info at s)) fmt
 
 let check_deprecation env at desc id depr =
   match depr with
@@ -476,7 +454,7 @@ and check_obj_path' env path : T.typ =
      | None ->
        error env id.at "M0026" "unbound variable %s%a%s" id.it
          display_vals env.vals
-         (suggest "variable" id.it (T.Env.keys env.vals))
+         (Suggest.suggest_id "variable" id.it (T.Env.keys env.vals))
     )
   | DotH (path', id) ->
     let s, fs = check_obj_path env path' in
@@ -488,7 +466,7 @@ and check_obj_path' env path : T.typ =
       error env id.at "M0028" "field %s does not exist in %a%s"
         id.it
         display_obj (s, fs)
-        (suggest "field" id.it
+        (Suggest.suggest_id "field" id.it
           (List.filter_map
             (function
               {T.typ=T.Typ _;_} -> None
@@ -508,7 +486,7 @@ and check_typ_path' env path : T.con =
     | None ->
       error env id.at "M0029" "unbound type %s%a%s" id.it
         display_typs env.typs
-        (suggest "type" id.it (T.Env.keys env.typs))
+        (Suggest.suggest_id "type" id.it (T.Env.keys env.typs))
     )
   | DotH (path', id) ->
     let s, fs = check_obj_path env path' in
@@ -519,7 +497,7 @@ and check_typ_path' env path : T.con =
       | exception Invalid_argument _ ->
         error env id.at "M0030" "type field %s does not exist in type%a%s"
           id.it display_typ_expand (T.Obj (s, fs))
-          (suggest "type field" id.it
+          (Suggest.suggest_id "type field" id.it
              (List.filter_map
                (function { T.lab; T.typ=T.Typ _;_ } -> Some lab
                |  _ -> None) fs))
@@ -1126,7 +1104,7 @@ let infer_lit env lit at : T.prim =
   | PreLit _ ->
     assert false
 
-let check_lit env t lit at =
+let check_lit env t lit at suggest =
   match t, !lit with
   | T.Prim T.Nat, PreLit (s, T.Nat) ->
     lit := NatLit (check_nat env at s)
@@ -1155,11 +1133,11 @@ let check_lit env t lit at =
   | t, _ ->
     let t' = T.Prim (infer_lit env lit at) in
     if not (T.sub t' t) then
-      error env at "M0050"
-        "literal of type%a\ndoes not have expected type%a"
-        display_typ t'
-        display_typ_expand t
-
+    error env at "M0050"
+      "literal of type%a\ndoes not have expected type%a%s"
+      display_typ t'
+      display_typ_expand t
+      (if suggest then Suggest.suggest_conversion env.libs env.vals t' t else "")
 
 (* Coercions *)
 
@@ -1251,7 +1229,7 @@ and infer_exp'' env exp : T.typ =
     | None ->
       error env id.at "M0057" "unbound variable %s%a%s" id.it
         display_vals env.vals
-        (suggest "variable" id.it (T.Env.keys env.vals))
+        (Suggest.suggest_id "variable" id.it (T.Env.keys env.vals))
     )
   | LitE lit ->
     T.Prim (infer_lit env lit exp.at)
@@ -1490,7 +1468,7 @@ and infer_exp'' env exp : T.typ =
         "field %s does not exist in %a%s"
         id.it
         display_obj (s, tfs)
-        (suggest "field" id.it
+        (Suggest.suggest_id "field" id.it
           (List.filter_map
              (function
                { T.typ=T.Typ _;_} -> None
@@ -1694,7 +1672,7 @@ and infer_exp'' env exp : T.typ =
         | _ -> id.it
       in local_error env id.at "M0083" "unbound label %s%a%s" name
          display_labs env.labs
-         (suggest "label" id.it (T.Env.keys env.labs))
+         (Suggest.suggest_id "label" id.it (T.Env.keys env.labs))
     );
     T.Non
   | RetE exp1 ->
@@ -1818,7 +1796,7 @@ and check_exp' env0 t exp : T.typ =
   | PrimE s, T.Func _ ->
     t
   | LitE lit, _ ->
-    check_lit env t lit exp.at;
+    check_lit env t lit exp.at true;
     t
   | ActorUrlE exp', t' ->
     check_exp_strong env T.text exp';
@@ -1992,10 +1970,13 @@ and check_exp' env0 t exp : T.typ =
   | _ ->
     let t' = infer_exp env0 exp in
     if not (T.sub t' t) then
+    begin
       local_error env0 exp.at "M0096"
-        "expression of type%a\ncannot produce expected type%a"
+        "expression of type%a\ncannot produce expected type%a%s"
         display_typ_expand t'
-        display_typ_expand t;
+        display_typ_expand t
+        (Suggest.suggest_conversion env.libs env.vals t' t)
+    end;
     t'
 
 and check_exp_field env (ef : exp_field) fts =
@@ -2268,7 +2249,7 @@ and check_pat_aux' env t pat val_kind : Scope.val_env =
           display_typ_expand t;
       if T.sub t' T.Non
       then ignore (infer_lit env lit pat.at)
-      else check_lit env t' lit pat.at
+      else check_lit env t' lit pat.at false
     end;
     T.Env.empty
   | SignP (op, lit) ->
@@ -2279,7 +2260,7 @@ and check_pat_aux' env t pat val_kind : Scope.val_env =
           display_typ_expand t;
       if T.sub t' T.Non
       then ignore (infer_lit env lit pat.at)
-      else check_lit env t' lit pat.at
+      else check_lit env t' lit pat.at false
     end;
     T.Env.empty
   | TupP pats ->
@@ -3107,7 +3088,7 @@ let check_lib scope pkg_opt lib : Scope.t Diag.result =
     (fun msgs ->
       recover_opt
         (fun lib ->
-          let env = env_of_scope msgs scope in
+          let env = { (env_of_scope msgs scope) with errors_only = (pkg_opt <> None) } in
           let { imports; body = cub; _ } = lib.it in
           let (imp_ds, ds) = CompUnit.decs_of_lib lib in
           let typ, _ = infer_block env (imp_ds @ ds) lib.at false in

src/pipeline/pipeline.ml

@@ -142,7 +142,8 @@ let resolve_flags () =
   ResolveImport.{
     package_urls = !Flags.package_urls;
     actor_aliases = !Flags.actor_aliases;
-    actor_idl_path = !Flags.actor_idl_path
+    actor_idl_path = !Flags.actor_idl_path;
+    include_all_libs = !Flags.ai_errors;
   }
 
 let resolve_prog (prog, base) : resolve_result =