Commit f3c7ed72 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Implement GHCi command :kind! which normalises its type

   type family F a
   type instance F Int = Bool
   type instance F Bool = Char

In GHCi
   *TF> :kind (F Int, F Bool)
   (F Int, F Bool) :: *
   *TF> :kind! F Int
   (F Int, F Bool) :: *
   = (Bool, Char)

We could call it ":normalise" but it seemed quite nice to have an
eager version of :kind
parent 25881af0
......@@ -1409,12 +1409,13 @@ hscTcExpr hsc_env expr = runHsc hsc_env $ do
-- | Find the kind of a type
hscKcType
:: HscEnv
-> String -- ^ The type
-> IO Kind
-> Bool -- ^ Normalise the type
-> String -- ^ The type as a string
-> IO (Type, Kind) -- ^ Resulting type (possibly normalised) and kind
hscKcType hsc_env str = runHsc hsc_env $ do
hscKcType hsc_env normalise str = runHsc hsc_env $ do
ty <- hscParseType str
ioMsgMaybe $ tcRnType hsc_env (hsc_IC hsc_env) ty
ioMsgMaybe $ tcRnType hsc_env (hsc_IC hsc_env) normalise ty
#endif
\end{code}
......
......@@ -942,9 +942,9 @@ exprType expr = withSession $ \hsc_env -> do
-- Getting the kind of a type
-- | Get the kind of a type
typeKind :: GhcMonad m => String -> m Kind
typeKind str = withSession $ \hsc_env -> do
liftIO $ hscKcType hsc_env str
typeKind :: GhcMonad m => Bool -> String -> m (Type, Kind)
typeKind normalise str = withSession $ \hsc_env -> do
liftIO $ hscKcType hsc_env normalise str
-----------------------------------------------------------------------------
-- cmCompileExpr: compile an expression and deliver an HValue
......
......@@ -1408,19 +1408,28 @@ tcRnType just finds the kind of a type
\begin{code}
tcRnType :: HscEnv
-> InteractiveContext
-> InteractiveContext
-> Bool -- Normalise the returned type
-> LHsType RdrName
-> IO (Messages, Maybe Kind)
tcRnType hsc_env ictxt rdr_type
= initTcPrintErrors hsc_env iNTERACTIVE $
-> IO (Messages, Maybe (Type, Kind))
tcRnType hsc_env ictxt normalise rdr_type
= initTcPrintErrors hsc_env iNTERACTIVE $
setInteractiveContext hsc_env ictxt $ do {
rn_type <- rnLHsType doc rdr_type ;
failIfErrsM ;
-- Now kind-check the type
(_ty', kind) <- kcLHsType rn_type ;
return kind
ty <- tcHsSigType GenSigCtxt rn_type ;
ty' <- if normalise
then do { fam_envs <- tcGetFamInstEnvs
; return (snd (normaliseType fam_envs ty)) }
-- normaliseType returns a coercion
-- which we discard
else return ty ;
return (ty', typeKind ty)
}
where
doc = ptext (sLit "In GHCi input")
......
......@@ -17,7 +17,7 @@ module FamInstEnv (
lookupFamInstEnv, lookupFamInstEnvConflicts, lookupFamInstEnvConflicts',
-- Normalisation
topNormaliseType
topNormaliseType, normaliseType
) where
#include "HsVersions.h"
......@@ -550,8 +550,10 @@ topNormaliseType env ty
| isFamilyTyCon tc -- Expand open tycons
, (co, ty) <- normaliseTcApp env tc tys
-- Note that normaliseType fully normalises,
-- but it has do to so to be sure that
-- Note that normaliseType fully normalises 'tys',
-- It has do to so to be sure that nested calls like
-- F (G Int)
-- are correctly top-normalised
, not (isReflCo co)
= add_co co rec_nts ty
where
......
......@@ -47,7 +47,8 @@ import Panic hiding ( showException )
import Config
import StaticFlags
import Linker
import Util
import Util( on, global, toArgs, toCmdArgs, removeSpaces, getCmd,
filterOut, seqList, looksLikeModuleName, partitionWith )
import NameSet
import Maybes ( orElse, expectJust )
import FastString
......@@ -130,7 +131,8 @@ builtin_commands = [
("history", keepGoing historyCmd, noCompletion),
("info", keepGoing' info, completeIdentifier),
("issafe", keepGoing' isSafeCmd, completeModule),
("kind", keepGoing' kindOfType, completeIdentifier),
("kind", keepGoing' (kindOfType False), completeIdentifier),
("kind!", keepGoing' (kindOfType True), completeIdentifier),
("load", keepGoingPaths loadModule_, completeHomeModuleOrFile),
("list", keepGoing' listCmd, noCompletion),
("module", keepGoing moduleCmd, completeSetModule),
......@@ -1325,12 +1327,13 @@ typeOfExpr str
-----------------------------------------------------------------------------
-- :kind
kindOfType :: String -> InputT GHCi ()
kindOfType str
kindOfType :: Bool -> String -> InputT GHCi ()
kindOfType normalise str
= handleSourceError GHC.printException
$ do
ty <- GHC.typeKind str
printForUser $ text str <+> dcolon <+> ppr ty
(ty, kind) <- GHC.typeKind normalise str
printForUser $ vcat [ text str <+> dcolon <+> ppr kind
, ppWhen normalise $ equals <+> ppr ty ]
-----------------------------------------------------------------------------
......
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