From 5ebdc81f6214d6c2603d96b2e4a46a76a86a93ea Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Mon, 8 Apr 2024 09:44:09 -0500 Subject: [PATCH] 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 | 3 +- src/Disco/Context.hs | 4 -- src/Disco/Error.hs | 44 +++++++++++--------- src/Disco/Syntax/Operators.hs | 5 +++ src/Disco/Typecheck.hs | 69 ++++++++++++++++++-------------- src/Disco/Typecheck/Util.hs | 11 ++--- test/error-unbound/expected | 14 +++++++ test/error-unbound/input | 7 ++++ test/error-unboundtyvar/expected | 1 + 9 files changed, 97 insertions(+), 61 deletions(-) diff --git a/disco.cabal b/disco.cabal index 0cca2154..bc3f2fce 100644 --- a/disco.cabal +++ b/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 diff --git a/src/Disco/Context.hs b/src/Disco/Context.hs index 16efc4f6..69c391b1 100644 --- a/src/Disco/Context.hs +++ b/src/Disco/Context.hs @@ -1,9 +1,5 @@ {-# LANGUAGE DeriveTraversable #-} ------------------------------------------------------------------------------ - ------------------------------------------------------------------------------ - -- SPDX-License-Identifier: BSD-3-Clause -- | diff --git a/src/Disco/Error.hs b/src/Disco/Error.hs index c80fbf42..feaddf58 100644 --- a/src/Disco/Error.hs +++ b/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." diff --git a/src/Disco/Syntax/Operators.hs b/src/Disco/Syntax/Operators.hs index d40b52a7..441c2856 100644 --- a/src/Disco/Syntax/Operators.hs +++ b/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 !) diff --git a/src/Disco/Typecheck.hs b/src/Disco/Typecheck.hs index a2ff9b0d..35c9d298 100644 --- a/src/Disco/Typecheck.hs +++ b/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 diff --git a/src/Disco/Typecheck/Util.hs b/src/Disco/Typecheck/Util.hs index 258d6b9f..4db4ff42 100644 --- a/src/Disco/Typecheck/Util.hs +++ b/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 diff --git a/test/error-unbound/expected b/test/error-unbound/expected index ba3d2914..9fdbeb1f 100644 --- a/test/error-unbound/expected +++ b/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 diff --git a/test/error-unbound/input b/test/error-unbound/input index 24553358..43b8f6ec 100644 --- a/test/error-unbound/input +++ b/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 diff --git a/test/error-unboundtyvar/expected b/test/error-unboundtyvar/expected index 06cb5f2a..23711c19 100644 --- a/test/error-unboundtyvar/expected +++ b/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