Commit 002594b7 authored by xldenis's avatar xldenis Committed by Marge Bot

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.
parent 114b014f
......@@ -219,6 +219,8 @@ module GHC (
Kind,
PredType,
ThetaType, pprForAll, pprThetaArrowTy,
parseInstanceHead,
getInstancesForType,
-- ** Entities
TyThing(..),
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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]
......
......@@ -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
~~~~~~~~~~~~~~
......
......@@ -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``
......
......@@ -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
......
......@@ -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'])
......
{-# 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
-- 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
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’
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment