[Git][ghc/ghc][master] Add GHCi :instances command
Marge Bot
gitlab at gitlab.haskell.org
Tue Jun 4 18:41:35 UTC 2019
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
002594b7 by Xavier Denis at 2019-06-04T18:41:29Z
Add GHCi :instances command
This commit adds the `:instances` command to ghci following proosal
number 41.
This makes it possible to query which instances are available to a given
type.
The output of this command is all the possible instances with type
variables and constraints instantiated.
- - - - -
12 changed files:
- compiler/main/GHC.hs
- compiler/main/HscMain.hs
- compiler/main/InteractiveEval.hs
- compiler/typecheck/TcRnDriver.hs
- compiler/types/InstEnv.hs
- docs/users_guide/8.10.1-notes.rst
- docs/users_guide/ghci.rst
- ghc/GHCi/UI.hs
- testsuite/tests/ghci/scripts/all.T
- + testsuite/tests/ghci/scripts/ghci064.hs
- + testsuite/tests/ghci/scripts/ghci064.script
- + testsuite/tests/ghci/scripts/ghci064.stdout
Changes:
=====================================
compiler/main/GHC.hs
=====================================
@@ -219,6 +219,8 @@ module GHC (
Kind,
PredType,
ThetaType, pprForAll, pprThetaArrowTy,
+ parseInstanceHead,
+ getInstancesForType,
-- ** Entities
TyThing(..),
=====================================
compiler/main/HscMain.hs
=====================================
@@ -67,6 +67,7 @@ module HscMain
, hscDecls, hscParseDeclsWithLocation, hscDeclsWithLocation, hscParsedDecls
, hscTcExpr, TcRnExprMode(..), hscImport, hscKcType
, hscParseExpr
+ , hscParseType
, hscCompileCoreExpr
-- * Low-level exports for hooks
, hscCompileCoreExpr'
@@ -113,6 +114,7 @@ import SrcLoc
import TcRnDriver
import TcIface ( typecheckIface )
import TcRnMonad
+import TcHsSyn ( ZonkFlexi (DefaultFlexi) )
import NameCache ( initNameCache )
import LoadIface ( ifaceStats, initExternalPackageState )
import PrelInfo
@@ -1761,7 +1763,7 @@ hscKcType
hscKcType hsc_env0 normalise str = runInteractiveHsc hsc_env0 $ do
hsc_env <- getHscEnv
ty <- hscParseType str
- ioMsgMaybe $ tcRnType hsc_env normalise ty
+ ioMsgMaybe $ tcRnType hsc_env DefaultFlexi normalise ty
hscParseExpr :: String -> Hsc (LHsExpr GhcPs)
hscParseExpr expr = do
=====================================
compiler/main/InteractiveEval.hs
=====================================
@@ -30,6 +30,8 @@ module InteractiveEval (
exprType,
typeKind,
parseName,
+ parseInstanceHead,
+ getInstancesForType,
getDocs,
GetDocsFailure(..),
showModule,
@@ -102,6 +104,19 @@ import GHC.Exts
import Data.Array
import Exception
+import TcRnDriver ( runTcInteractive, tcRnType )
+import TcHsSyn ( ZonkFlexi (SkolemiseFlexi) )
+
+import TcEnv (tcGetInstEnvs)
+
+import Inst (instDFunType)
+import TcSimplify (solveWanteds)
+import TcRnMonad
+import TcEvidence
+import Data.Bifunctor (second)
+
+import TcSMonad (runTcS)
+
-- -----------------------------------------------------------------------------
-- running a statement interactively
@@ -937,6 +952,161 @@ typeKind :: GhcMonad m => Bool -> String -> m (Type, Kind)
typeKind normalise str = withSession $ \hsc_env -> do
liftIO $ hscKcType hsc_env normalise str
+-- ----------------------------------------------------------------------------
+-- Getting the class instances for a type
+
+{-
+ Note [Querying instances for a type]
+
+ Here is the implementation of GHC proposal 41.
+ (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0041-ghci-instances.rst)
+
+ The objective is to take a query string representing a (partial) type, and
+ report all the class single-parameter class instances available to that type.
+ Extending this feature to multi-parameter typeclasses is left as future work.
+
+ The general outline of how we solve this is:
+
+ 1. Parse the type, leaving skolems in the place of type-holes.
+ 2. For every class, get a list of all instances that match with the query type.
+ 3. For every matching instance, ask GHC for the context the instance dictionary needs.
+ 4. Format and present the results, substituting our query into the instance
+ and simplifying the context.
+
+ For example, given the query "Maybe Int", we want to return:
+
+ instance Show (Maybe Int)
+ instance Read (Maybe Int)
+ instance Eq (Maybe Int)
+ ....
+
+ [Holes in queries]
+
+ Often times we want to know what instances are available for a polymorphic type,
+ like `Maybe a`, and we'd like to return instances such as:
+
+ instance Show a => Show (Maybe a)
+ ....
+
+ These queries are expressed using type holes, so instead of `Maybe a` the user writes
+ `Maybe _`, we parse the type and during zonking, we skolemise it, replacing the holes
+ with (un-named) type variables.
+
+ When zonking the type holes we have two real choices: replace them with Any or replace
+ them with skolem typevars. Using skolem type variables ensures that the output is more
+ intuitive to end users, and there is no difference in the results between Any and skolems.
+
+-}
+
+-- Find all instances that match a provided type
+getInstancesForType :: GhcMonad m => Type -> m [ClsInst]
+getInstancesForType ty = withSession $ \hsc_env -> do
+ liftIO $ runInteractiveHsc hsc_env $ do
+ ioMsgMaybe $ runTcInteractive hsc_env $ do
+ matches <- findMatchingInstances ty
+ fmap catMaybes . forM matches $ uncurry checkForExistence
+
+-- Parse a type string and turn any holes into skolems
+parseInstanceHead :: GhcMonad m => String -> m Type
+parseInstanceHead str = withSession $ \hsc_env0 -> do
+ (ty, _) <- liftIO $ runInteractiveHsc hsc_env0 $ do
+ hsc_env <- getHscEnv
+ ty <- hscParseType str
+ ioMsgMaybe $ tcRnType hsc_env SkolemiseFlexi True ty
+
+ return ty
+
+-- Get all the constraints required of a dictionary binding
+getDictionaryBindings :: PredType -> TcM WantedConstraints
+getDictionaryBindings theta = do
+ dictName <- newName (mkDictOcc (mkVarOcc "magic"))
+ let dict_var = mkVanillaGlobal dictName theta
+ loc <- getCtLocM (GivenOrigin UnkSkol) Nothing
+ let wCs = mkSimpleWC [CtDerived
+ { ctev_pred = varType dict_var
+ , ctev_loc = loc
+ }]
+
+ return wCs
+
+{-
+ When we've found an instance that a query matches against, we still need to
+ check that all the instance's constraints are satisfiable. checkForExistence
+ creates an instance dictionary and verifies that any unsolved constraints
+ mention a type-hole, meaning it is blocked on an unknown.
+
+ If the instance satisfies this condition, then we return it with the query
+ substituted into the instance and all constraints simplified, for example given:
+
+ instance D a => C (MyType a b) where
+
+ and the query `MyType _ String`
+
+ the unsolved constraints will be [D _] so we apply the substitution:
+
+ { a -> _; b -> String}
+
+ and return the instance:
+
+ instance D _ => C (MyType _ String)
+
+-}
+
+checkForExistence :: ClsInst -> [DFunInstType] -> TcM (Maybe ClsInst)
+checkForExistence res mb_inst_tys = do
+ (tys, thetas) <- instDFunType (is_dfun res) mb_inst_tys
+
+ wanteds <- forM thetas getDictionaryBindings
+ (residuals, _) <- second evBindMapBinds <$> runTcS (solveWanteds (unionsWC wanteds))
+
+ let all_residual_constraints = bagToList $ wc_simple residuals
+ let preds = map ctPred all_residual_constraints
+ if all isSatisfiablePred preds && (null $ wc_impl residuals)
+ then return . Just $ substInstArgs tys preds res
+ else return Nothing
+
+ where
+
+ -- Stricter version of isTyVarClassPred that requires all TyConApps to have at least
+ -- one argument or for the head to be a TyVar. The reason is that we want to ensure
+ -- that all residual constraints mention a type-hole somewhere in the constraint,
+ -- meaning that with the correct choice of a concrete type it could be possible for
+ -- the constraint to be discharged.
+ isSatisfiablePred :: PredType -> Bool
+ isSatisfiablePred ty = case getClassPredTys_maybe ty of
+ Just (_, tys@(_:_)) -> all isTyVarTy tys
+ _ -> isTyVarTy ty
+
+ empty_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType (idType $ is_dfun res)))
+
+ {- Create a ClsInst with instantiated arguments and constraints.
+
+ The thetas are the list of constraints that couldn't be solved because
+ they mention a type-hole.
+ -}
+ substInstArgs :: [Type] -> [PredType] -> ClsInst -> ClsInst
+ substInstArgs tys thetas inst = let
+ subst = foldl' (\a b -> uncurry (extendTvSubstAndInScope a) b) empty_subst (zip dfun_tvs tys)
+ -- Build instance head with arguments substituted in
+ tau = mkClassPred cls (substTheta subst args)
+ -- Constrain the instance with any residual constraints
+ phi = mkPhiTy thetas tau
+ sigma = mkForAllTys (map (\v -> Bndr v Inferred) dfun_tvs) phi
+
+ in inst { is_dfun = (is_dfun inst) { varType = sigma }}
+ where
+ (dfun_tvs, _, cls, args) = instanceSig inst
+
+-- Find instances where the head unifies with the provided type
+findMatchingInstances :: Type -> TcM [(ClsInst, [DFunInstType])]
+findMatchingInstances ty = do
+ ies@(InstEnvs {ie_global = ie_global, ie_local = ie_local}) <- tcGetInstEnvs
+ let allClasses = instEnvClasses ie_global ++ instEnvClasses ie_local
+
+ concat <$> mapM (\cls -> do
+ let (matches, _, _) = lookupInstEnv True ies cls [ty]
+ return matches) allClasses
+
-----------------------------------------------------------------------------
-- Compile an expression, run it, and deliver the result
=====================================
compiler/typecheck/TcRnDriver.hs
=====================================
@@ -2418,10 +2418,11 @@ tcRnImportDecls hsc_env import_decls
-- tcRnType just finds the kind of a type
tcRnType :: HscEnv
+ -> ZonkFlexi
-> Bool -- Normalise the returned type
-> LHsType GhcPs
-> IO (Messages, Maybe (Type, Kind))
-tcRnType hsc_env normalise rdr_type
+tcRnType hsc_env flexi normalise rdr_type
= runTcInteractive hsc_env $
setXOptM LangExt.PolyKinds $ -- See Note [Kind-generalise in tcRnType]
do { (HsWC { hswc_ext = wcs, hswc_body = rn_type }, _fvs)
@@ -2444,7 +2445,9 @@ tcRnType hsc_env normalise rdr_type
-- Do kind generalisation; see Note [Kind-generalise in tcRnType]
; kind <- zonkTcType kind
; kvs <- kindGeneralize kind
- ; ty <- zonkTcTypeToType ty
+ ; e <- mkEmptyZonkEnv flexi
+
+ ; ty <- zonkTcTypeToTypeX e ty
-- Do validity checking on type
; checkValidType (GhciCtxt True) ty
=====================================
compiler/types/InstEnv.hs
=====================================
@@ -21,7 +21,7 @@ module InstEnv (
emptyInstEnv, extendInstEnv,
deleteFromInstEnv, deleteDFunFromInstEnv,
identicalClsInstHead,
- extendInstEnvList, lookupUniqueInstEnv, lookupInstEnv, instEnvElts,
+ extendInstEnvList, lookupUniqueInstEnv, lookupInstEnv, instEnvElts, instEnvClasses,
memberInstEnv,
instIsVisible,
classInstances, instanceBindFun,
@@ -427,6 +427,9 @@ instEnvElts :: InstEnv -> [ClsInst]
instEnvElts ie = [elt | ClsIE elts <- eltsUDFM ie, elt <- elts]
-- See Note [InstEnv determinism]
+instEnvClasses :: InstEnv -> [Class]
+instEnvClasses ie = [is_cls e | ClsIE (e : _) <- eltsUDFM ie]
+
-- | Test if an instance is visible, by checking that its origin module
-- is in 'VisibleOrphanModules'.
-- See Note [Instance lookup and orphan instances]
=====================================
docs/users_guide/8.10.1-notes.rst
=====================================
@@ -107,6 +107,11 @@ Compiler
only convenient workaround was to enable `-fobject-code` for all
modules.
+GHCi
+~~~~
+
+- Added a command `:instances` to show the class instances available for a type.
+
Runtime system
~~~~~~~~~~~~~~
=====================================
docs/users_guide/ghci.rst
=====================================
@@ -2539,6 +2539,38 @@ commonly used commands.
The ``:loc-at`` command requires :ghci-cmd:`:set +c` to be set.
+.. ghci-cmd:: :instances ⟨type⟩
+
+ Displays all the class instances available to the argument ⟨type⟩.
+ The command will match ⟨type⟩ with the first parameter of every
+ instance and then check that all constraints are satisfiable.
+
+ When combined with ``-XPartialTypeSignatures``, a user can insert
+ wildcards into a query and learn the constraints required of each
+ wildcard for ⟨type⟩ match with an instance.
+
+ The output is a listing of all matching instances, simplified and
+ instantiated as much as possible.
+
+ For example:
+
+ .. code-block:: none
+ >:instances Maybe (Maybe Int)
+ instance Eq (Maybe (Maybe Int)) -- Defined in ‘GHC.Maybe’
+ instance Ord (Maybe (Maybe Int)) -- Defined in ‘GHC.Maybe’
+ instance Show (Maybe (Maybe Int)) -- Defined in ‘GHC.Show’
+ instance Read (Maybe (Maybe Int)) -- Defined in ‘GHC.Read’
+
+ >:set -XPartialTypeSignatures -fno-warn-partial-type-signatures
+
+ >:instances Maybe _
+ instance Eq _ => Eq (Maybe _) -- Defined in ‘GHC.Maybe’
+ instance Semigroup _ => Monoid (Maybe _) -- Defined in ‘GHC.Base’
+ instance Ord _ => Ord (Maybe _) -- Defined in ‘GHC.Maybe’
+ instance Semigroup _ => Semigroup (Maybe _) -- Defined in ‘GHC.Base’
+ instance Show _ => Show (Maybe _) -- Defined in ‘GHC.Show’
+ instance Read _ => Read (Maybe _) -- Defined in ‘GHC.Read’
+
.. ghci-cmd:: :main; ⟨arg1⟩ ... ⟨argn⟩
When a program is compiled and executed, it can use the ``getArgs``
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -223,7 +223,8 @@ ghciCommands = map mkCmd [
("unadd", keepGoingPaths unAddModule, completeFilename),
("undef", keepGoing undefineMacro, completeMacro),
("unset", keepGoing unsetOptions, completeSetOptions),
- ("where", keepGoing whereCmd, noCompletion)
+ ("where", keepGoing whereCmd, noCompletion),
+ ("instances", keepGoing' instancesCmd, completeExpression)
] ++ map mkCmdHidden [ -- hidden commands
("all-types", keepGoing' allTypesCmd),
("complete", keepGoing completeCmd),
@@ -1779,6 +1780,19 @@ handleGetDocsFailure no_docs = do
NoDocsInIface {} -> InstallationError msg
InteractiveName -> ProgramError msg
+-----------------------------------------------------------------------------
+-- :instances
+
+instancesCmd :: String -> InputT GHCi ()
+instancesCmd "" =
+ throwGhcException (CmdLineError "syntax: ':instances <type-you-want-instances-for>'")
+instancesCmd s = do
+ handleSourceError GHC.printException $ do
+ ty <- GHC.parseInstanceHead s
+ res <- GHC.getInstancesForType ty
+
+ printForUser $ vcat $ map ppr res
+
-----------------------------------------------------------------------------
-- :load, :add, :reload
=====================================
testsuite/tests/ghci/scripts/all.T
=====================================
@@ -106,7 +106,7 @@ test('ghci062', [extra_files(['ghci062/', 'ghci062/Test.hs']),
when(config.have_ext_interp, extra_ways(['ghci-ext']))],
ghci_script, ['ghci062.script'])
test('ghci063', normal, ghci_script, ['ghci063.script'])
-
+test('ghci064', normal, ghci_script, ['ghci064.script'])
test('T2452', [extra_hc_opts("-fno-implicit-import-qualified")],
ghci_script, ['T2452.script'])
test('T2766', normal, ghci_script, ['T2766.script'])
=====================================
testsuite/tests/ghci/scripts/ghci064.hs
=====================================
@@ -0,0 +1,21 @@
+{-# LANGUAGE FlexibleInstances, TypeFamilies #-}
+import Data.Kind (Type)
+
+class MyShow a where
+ myshow :: a -> String
+
+instance MyShow a => MyShow [a] where
+ myshow xs = concatMap myshow xs
+
+data T = MkT
+
+instance MyShow T where
+ myshow x = "Used generic instance"
+
+instance MyShow [T] where
+ myshow xs = "Used more specific instance"
+
+
+type family F a :: Type
+type instance F [a] = a -> F a
+type instance F Int = Bool
=====================================
testsuite/tests/ghci/scripts/ghci064.script
=====================================
@@ -0,0 +1,21 @@
+-- Test :instances
+:instances Maybe
+
+:set -XPartialTypeSignatures -fno-warn-partial-type-signatures
+-- Test queries with holes
+:instances Maybe _
+
+:load ghci064
+
+-- Test that overlapping instances are all reported in the results
+:instances [_]
+:instances [T]
+
+-- Test that we can find instances for type families
+
+:instances F Int
+
+-- Test to make sure that the constraints of returned instances are all properly verified
+-- We don't want the command to return an Applicative or Monad instance for tuple because
+-- there is no Int Monoid instance.
+:instances (,) Int
=====================================
testsuite/tests/ghci/scripts/ghci064.stdout
=====================================
@@ -0,0 +1,35 @@
+instance GHC.Base.Alternative Maybe -- Defined in ‘GHC.Base’
+instance Applicative Maybe -- Defined in ‘GHC.Base’
+instance Functor Maybe -- Defined in ‘GHC.Base’
+instance Monad Maybe -- Defined in ‘GHC.Base’
+instance GHC.Base.MonadPlus Maybe -- Defined in ‘GHC.Base’
+instance Eq _ => Eq (Maybe _) -- Defined in ‘GHC.Maybe’
+instance Semigroup _ => Monoid (Maybe _) -- Defined in ‘GHC.Base’
+instance Ord _ => Ord (Maybe _) -- Defined in ‘GHC.Maybe’
+instance Semigroup _ => Semigroup (Maybe _)
+ -- Defined in ‘GHC.Base’
+instance Show _ => Show (Maybe _) -- Defined in ‘GHC.Show’
+instance Read _ => Read (Maybe _) -- Defined in ‘GHC.Read’
+instance Eq _ => Eq [_] -- Defined in ‘GHC.Classes’
+instance Monoid [_] -- Defined in ‘GHC.Base’
+instance Ord _ => Ord [_] -- Defined in ‘GHC.Classes’
+instance Semigroup [_] -- Defined in ‘GHC.Base’
+instance Show _ => Show [_] -- Defined in ‘GHC.Show’
+instance Read _ => Read [_] -- Defined in ‘GHC.Read’
+instance [safe] MyShow _ => MyShow [_]
+ -- Defined at ghci064.hs:7:10
+instance Monoid [T] -- Defined in ‘GHC.Base’
+instance Semigroup [T] -- Defined in ‘GHC.Base’
+instance [safe] MyShow [T] -- Defined at ghci064.hs:7:10
+instance [safe] MyShow [T] -- Defined at ghci064.hs:15:10
+instance Eq Bool -- Defined in ‘GHC.Classes’
+instance Ord Bool -- Defined in ‘GHC.Classes’
+instance Show Bool -- Defined in ‘GHC.Show’
+instance Read Bool -- Defined in ‘GHC.Read’
+instance Enum Bool -- Defined in ‘GHC.Enum’
+instance Bounded Bool -- Defined in ‘GHC.Enum’
+instance Data.Bits.Bits Bool -- Defined in ‘Data.Bits’
+instance Data.Bits.FiniteBits Bool -- Defined in ‘Data.Bits’
+instance GHC.Arr.Ix Bool -- Defined in ‘GHC.Arr’
+instance Functor ((,) Int) -- Defined in ‘GHC.Base’
+instance Foldable ((,) Int) -- Defined in ‘Data.Foldable’
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/002594b731c40334b33eb883275e9c274c68e9ac
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/002594b731c40334b33eb883275e9c274c68e9ac
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190604/a939674e/attachment-0001.html>
More information about the ghc-commits
mailing list