Suggest alternate variable names based on edit distance (#378)

Closes #180. For both type variables and term variables, when an unbound variable is encountered we now suggest any in-scope variables or constants which are an edit distance of 1 away (i.e. one transposition, insertion, deletion, or replacement).

disco.cabal

@@ -495,7 +495,8 @@ library
                        -- oeis2 < 1.1,
                        algebraic-graphs >= 0.5 && < 0.8,
                        pretty-show >= 1.10 && < 1.11,
-                       boxes >= 0.1.5 && < 0.2
+                       boxes >= 0.1.5 && < 0.2,
+                       edit-distance >= 0.2 && < 0.3,
 
   hs-source-dirs:      src
   default-language:    Haskell2010

src/Disco/Context.hs

@@ -1,9 +1,5 @@
 {-# LANGUAGE DeriveTraversable #-}
 
------------------------------------------------------------------------------
-
------------------------------------------------------------------------------
-
 -- SPDX-License-Identifier: BSD-3-Clause
 
 -- |

src/Disco/Error.hs

@@ -93,10 +93,11 @@ instance Pretty DiscoError where
     CyclicImport ms -> cyclicImportError ms
     TypeCheckErr (LocTCError Nothing te) -> prettyTCError te
     TypeCheckErr (LocTCError (Just n) te) ->
-      nest 2 $ vcat
-        [ "While checking " <> pretty' n <> ":"
-        , prettyTCError te
-        ]
+      nest 2 $
+        vcat
+          [ "While checking " <> pretty' n <> ":"
+          , prettyTCError te
+          ]
     ParseErr pe -> text (errorBundlePretty pe)
     EvalErr ee -> prettyEvalError ee
     Panic s ->
@@ -111,15 +112,19 @@ rtd page = "https://disco-lang.readthedocs.io/en/latest/reference/" <> text page
 issue :: Int -> Sem r (Doc ann)
 issue n = "See https://github.com/disco-lang/disco/issues/" <> text (show n)
 
+squote :: String -> String
+squote x = "'" ++ x ++ "'"
+
 cyclicImportError ::
   Members '[Reader PA, LFresh] r =>
   [ModuleName] ->
   Sem r (Doc ann)
 cyclicImportError ms =
-  nest 2 $ vcat
-    [ "Error: module imports form a cycle:"
-    , intercalate " ->" (map pretty ms)
-    ]
+  nest 2 $
+    vcat
+      [ "Error: module imports form a cycle:"
+      , intercalate " ->" (map pretty ms)
+      ]
 
 prettyEvalError :: Members '[Reader PA, LFresh] r => EvalError -> Sem r (Doc ann)
 prettyEvalError = \case
@@ -142,11 +147,11 @@ prettyTCError :: Members '[Reader PA, LFresh] r => TCError -> Sem r (Doc ann)
 prettyTCError = \case
   -- XXX include some potential misspellings along with Unbound
   --   see https://github.com/disco-lang/disco/issues/180
-  Unbound x ->
-    vcat
-      [ "Error: there is nothing named" <+> pretty' x <> "."
-      , rtd "unbound"
-      ]
+  Unbound x suggestions ->
+    vcat $
+      ["Error: there is nothing named" <+> pretty' x <> "."]
+        ++ ["Perhaps you meant" <+> intercalate " or" (map (text . squote) suggestions) <> "?" | not (null suggestions)]
+        ++ [rtd "unbound"]
   Ambiguous x ms ->
     vcat
       [ "Error: the name" <+> pretty' x <+> "is ambiguous. It could refer to:"
@@ -249,13 +254,12 @@ prettyTCError = \case
       [ "Error: too many arguments for the type '" <> pretty' con <> "'."
       , rtd "num-args-type"
       ]
-  -- XXX Mention the definition in which it was found, suggest adding the variable
-  --     as a parameter
-  UnboundTyVar v ->
-    vcat
-      [ "Error: Unknown type variable '" <> pretty' v <> "'."
-      , rtd "unbound-tyvar"
-      ]
+  -- XXX Mention the definition in which it was found
+  UnboundTyVar v suggestions ->
+    vcat $
+      ["Error: Unknown type variable '" <> pretty' v <> "'."]
+        ++ ["Perhaps you meant" <+> intercalate " or" (map (text . squote) suggestions) <> "?" | not (null suggestions)]
+        ++ [rtd "unbound-tyvar"]
   NoPolyRec s ss tys ->
     vcat
       [ "Error: in the definition of " <> text s <> parens (intercalate "," (map text ss)) <> ": recursive occurrences of" <+> text s <+> "may only have type variables as arguments."

src/Disco/Syntax/Operators.hs

@@ -26,6 +26,7 @@ module Disco.Syntax.Operators (
   opTable,
   uopMap,
   bopMap,
+  opNames,
   uPrec,
   bPrec,
   assoc,
@@ -36,6 +37,7 @@ import Data.Data (Data)
 import GHC.Generics (Generic)
 import Unbound.Generics.LocallyNameless
 
+import Data.Char (isAlpha)
 import Data.Map (Map, (!))
 import qualified Data.Map as M
 
@@ -264,6 +266,9 @@ bopMap =
   M.fromList $
     [(op, info) | opLevel <- opTable, info@(OpInfo (BOpF _ op) _ _) <- opLevel]
 
+opNames :: [String]
+opNames = [syn | OpInfo _ syns _ <- concat opTable, syn <- filter (all isAlpha) syns]
+
 -- | A convenient function for looking up the precedence of a unary operator.
 uPrec :: UOp -> Int
 uPrec = opPrec . (uopMap !)

src/Disco/Typecheck.hs

@@ -2,10 +2,6 @@
 {-# LANGUAGE NondecreasingIndentation #-}
 {-# LANGUAGE OverloadedStrings #-}
 
------------------------------------------------------------------------------
-
------------------------------------------------------------------------------
-
 -- |
 -- Module      :  Disco.Typecheck
 -- Copyright   :  disco team and contributors
@@ -30,32 +26,11 @@ import qualified Data.Map as M
 import Data.Maybe (isJust)
 import Data.Set (Set)
 import qualified Data.Set as S
-import Prelude as P hiding (lookup)
-
-import Unbound.Generics.LocallyNameless (
-  Alpha,
-  Bind,
-  Name,
-  bind,
-  embed,
-  name2String,
-  string2Name,
-  substs,
-  unembed,
- )
-import Unbound.Generics.LocallyNameless.Unsafe (unsafeUnbind)
-
-import Disco.Effects.Fresh
-import Polysemy hiding (embed)
-import Polysemy.Error
-import Polysemy.Output
-import Polysemy.Reader
-import Polysemy.Writer
-
 import Disco.AST.Surface
 import Disco.AST.Typed
 import Disco.Context hiding (filter)
 import qualified Disco.Context as Ctx
+import Disco.Effects.Fresh
 import Disco.Messages
 import Disco.Module
 import Disco.Names
@@ -67,6 +42,25 @@ import Disco.Typecheck.Constraints
 import Disco.Typecheck.Util
 import Disco.Types
 import Disco.Types.Rules
+import Polysemy hiding (embed)
+import Polysemy.Error
+import Polysemy.Output
+import Polysemy.Reader
+import Polysemy.Writer
+import Text.EditDistance (defaultEditCosts, restrictedDamerauLevenshteinDistance)
+import Unbound.Generics.LocallyNameless (
+  Alpha,
+  Bind,
+  Name,
+  bind,
+  embed,
+  name2String,
+  string2Name,
+  substs,
+  unembed,
+ )
+import Unbound.Generics.LocallyNameless.Unsafe (unsafeUnbind)
+import Prelude as P hiding (lookup)
 
 ------------------------------------------------------------
 -- Container utilities
@@ -104,6 +98,13 @@ inferTelescope inferOne tel = do
       (tybs, ctx') <- go bs
       return (tyb : tybs, ctx <> ctx')
 
+------------------------------------------------------------
+-- Variable name utilities
+------------------------------------------------------------
+
+suggestionsFrom :: String -> [String] -> [String]
+suggestionsFrom x = filter ((<= 1) . restrictedDamerauLevenshteinDistance defaultEditCosts x)
+
 ------------------------------------------------------------
 -- Modules
 ------------------------------------------------------------
@@ -214,8 +215,11 @@ checkUnboundVars :: Members '[Reader TyDefCtx, Error TCError] r => TypeDefn -> S
 checkUnboundVars (TypeDefn _ args body) = go body
  where
   go (TyAtom (AVar (U x)))
-    | name2String x `elem` args = return ()
-    | otherwise = throw $ UnboundTyVar x
+    | xn `elem` args = return ()
+    | otherwise = throw $ UnboundTyVar x suggestions
+   where
+    xn = name2String x
+    suggestions = suggestionsFrom xn args
   go (TyAtom _) = return ()
   go (TyUser name tys) = lookupTyDefn name tys >> mapM_ go tys
   go (TyCon _ tys) = mapM_ go tys
@@ -539,7 +543,10 @@ typecheck Infer (TVar x) = do
   -- Pick the first method that succeeds; if none do, throw an unbound
   -- variable error.
   mt <- runMaybeT . F.asum . map MaybeT $ [tryLocal, tryModule, tryPrim]
-  maybe (throw (Unbound x)) return mt
+  ctx <- ask @TyCtx
+  let inScope = map name2String (Ctx.names ctx) ++ opNames ++ [syn | PrimInfo _ syn _ <- M.elems primMap]
+      suggestions = suggestionsFrom (name2String x) inScope
+  maybe (throw $ Unbound x suggestions) return mt
  where
   -- 1. See if the variable name is bound locally.
   tryLocal = do
@@ -559,13 +566,13 @@ typecheck Infer (TVar x) = do
         (_, ty) <- unbind sig
         return . Just $ ATVar ty (m .- coerce x)
       [] -> return Nothing
-      _ -> throw $ Ambiguous x (map fst bs)
+      _nonEmpty -> throw $ Ambiguous x (map fst bs)
 
   -- 3. See if we should convert it to a primitive.
   tryPrim =
     case toPrim (name2String x) of
       (prim : _) -> Just <$> typecheck Infer (TPrim prim)
-      _ -> return Nothing
+      [] -> return Nothing
 
 --------------------------------------------------
 -- Primitives

src/Disco/Typecheck/Util.hs

@@ -1,4 +1,3 @@
-
 -- |
 -- Module      :  Disco.Typecheck.Util
 -- Copyright   :  (c) 2016 disco team (see LICENSE)
@@ -52,8 +51,10 @@ noLoc = LocTCError Nothing
 
 -- | Potential typechecking errors.
 data TCError
-  = -- | Encountered an unbound variable
-    Unbound (Name Term)
+  = -- | Encountered an unbound variable.  The offending variable
+    --   together with some suggested in-scope names with small edit
+    --   distance.
+    Unbound (Name Term) [String]
   | -- | Encountered an ambiguous name.
     Ambiguous (Name Term) [ModuleName]
   | -- | No type is specified for a definition
@@ -91,8 +92,8 @@ data TCError
     NotEnoughArgs Con
   | -- | Too many arguments provided to type constructor.
     TooManyArgs Con
-  | -- | Unbound type variable
-    UnboundTyVar (Name Type)
+  | -- | Unbound type variable, together with suggested edits
+    UnboundTyVar (Name Type) [String]
   | -- | Polymorphic recursion is not allowed
     NoPolyRec String [String] [Type]
   | -- | Not an error.  The identity of the

test/error-unbound/expected

@@ -1 +1,15 @@
 Error: encountered undefined name REPL.even. Maybe you haven't defined it yet?
+Error: there is nothing named fo.
+Perhaps you meant 'foo'?
+https://disco-lang.readthedocs.io/en/latest/reference/unbound.html
+Error: there is nothing named ofo.
+Perhaps you meant 'foo'?
+https://disco-lang.readthedocs.io/en/latest/reference/unbound.html
+Error: there is nothing named for.
+Perhaps you meant 'foo' or 'or'?
+https://disco-lang.readthedocs.io/en/latest/reference/unbound.html
+Error: there is nothing named oof.
+https://disco-lang.readthedocs.io/en/latest/reference/unbound.html
+Error: there is nothing named Foo.
+Perhaps you meant 'foo'?
+https://disco-lang.readthedocs.io/en/latest/reference/unbound.html

test/error-unbound/input

@@ -1,2 +1,9 @@
 even : Z -> Bool
 even(2)
+foo : N
+foo = 3
+fo + 1
+ofo + 1
+for + 1
+oof + 1
+Foo + 1

test/error-unboundtyvar/expected

@@ -1,4 +1,5 @@
 Loading unboundtyvar.disco...
 While checking unboundtyvar.Ty:
   Error: Unknown type variable 'b'.
+  Perhaps you meant 'a'?
   https://disco-lang.readthedocs.io/en/latest/reference/unbound-tyvar.html