compiler/ghci/DebuggerTys.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- GHCi Interactive debugging commands
   4 --
   5 -- Pepe Iborra (supported by Google SoC) 2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module DebuggerTys (instantiateTyVarsToUnknown) where
  10
  11 import HscTypes
  12 import Type
  13 import TcRnDriver
  14 import Var
  15 import PrelNames
  16 import TyCon
  17 import DataCon
  18
  19 import Control.Monad
  20
  21 ----------------------------------------------------------------------------
  22 -- | Replace all the tyvars in a Term with the opaque type GHC.Base.Unknown
  23 ----------------------------------------------------------------------------
  24 instantiateTyVarsToUnknown :: HscEnv -> Type -> IO Type
  25 instantiateTyVarsToUnknown hsc_env ty
  26 -- We have a GADT, so just fix its tyvars
  27     | Just (tycon, args) <- splitTyConApp_maybe ty
  28     , tycon /= funTyCon
  29     , isGADT tycon
  30     = mapM fixTyVars args >>= return . mkTyConApp tycon
  31 -- We have a regular TyCon, so map recursively to its args
  32     | Just (tycon, args) <- splitTyConApp_maybe ty
  33     , tycon /= funTyCon
  34     = do unknownTyVar <- unknownTV
  35          args' <- mapM (instantiateTyVarsToUnknown hsc_env) args
  36          return$ mkTyConApp tycon args'
  37 -- we have a tyvar of kind *
  38     | Just tyvar <- getTyVar_maybe ty
  39     , ([],_) <- splitKindFunTys (tyVarKind tyvar)
  40     = unknownTV
  41 -- we have a higher kind tyvar, so insert an unknown of the appropriate kind
  42     | Just tyvar <- getTyVar_maybe ty
  43     , (args,_) <- splitKindFunTys (tyVarKind tyvar)
  44     = liftM mkTyConTy $ unknownTC !! length args
  45 -- Base case
  46     | otherwise    = return ty
  47
  48  where unknownTV = do
  49          Just (ATyCon unknown_tc) <- tcRnLookupName hsc_env unknownTyConName
  50          return$ mkTyConTy unknown_tc
  51        unknownTC = [undefined, unknownTC1, unknownTC2, unknownTC3]
  52        unknownTC1 = do
  53          Just (ATyCon unknown_tc) <- tcRnLookupName hsc_env unknown1TyConName
  54          return unknown_tc
  55        unknownTC2 = do
  56          Just (ATyCon unknown_tc) <- tcRnLookupName hsc_env unknown2TyConName
  57          return unknown_tc
  58        unknownTC3 = do
  59          Just (ATyCon unknown_tc) <- tcRnLookupName hsc_env unknown3TyConName
  60          return unknown_tc
  61 --       isGADT ty | pprTrace' "isGADT" (ppr ty <> colon <> ppr(isGadtSyntaxTyCon ty)) False = undefined
  62        isGADT tc | Just dcs <- tyConDataCons_maybe tc = any (not . null . dataConEqSpec) dcs
  63                  | otherwise = False
  64        fixTyVars ty
  65            | Just (tycon, args) <- splitTyConApp_maybe ty
  66            = mapM fixTyVars args >>= return . mkTyConApp tycon
  67 -- Fix the tyvar so that the interactive environment doesn't choke on it TODO
  68            | Just tv <- getTyVar_maybe ty = return ty --TODO
  69            | otherwise = return ty
  70