From: Simon Marlow <simonmar@microsoft.com>
Date: Wed, 18 Apr 2007 12:41:24 +0000 (+0000)
Subject: add missing module
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=22e7be5ffc35fd36de65955bb2a5ab79ed04ec5e

add missing module
---

diff --git a/compiler/ghci/DebuggerTys.hs b/compiler/ghci/DebuggerTys.hs
new file mode 100644
index 0000000..5ea3a6a
--- /dev/null
+++ b/compiler/ghci/DebuggerTys.hs
@@ -0,0 +1,70 @@
+-----------------------------------------------------------------------------
+--
+-- GHCi Interactive debugging commands 
+--
+-- Pepe Iborra (supported by Google SoC) 2006
+--
+-----------------------------------------------------------------------------
+
+module DebuggerTys (instantiateTyVarsToUnknown) where
+
+import HscTypes
+import Type
+import TcRnDriver
+import Var
+import PrelNames
+import TyCon
+import DataCon
+
+import Control.Monad
+
+----------------------------------------------------------------------------
+-- | Replace all the tyvars in a Term with the opaque type GHC.Base.Unknown
+----------------------------------------------------------------------------
+instantiateTyVarsToUnknown :: HscEnv -> Type -> IO Type
+instantiateTyVarsToUnknown hsc_env ty
+-- We have a GADT, so just fix its tyvars
+    | Just (tycon, args) <- splitTyConApp_maybe ty
+    , tycon /= funTyCon
+    , isGADT tycon
+    = mapM fixTyVars args >>= return . mkTyConApp tycon
+-- We have a regular TyCon, so map recursively to its args
+    | Just (tycon, args) <- splitTyConApp_maybe ty
+    , tycon /= funTyCon
+    = do unknownTyVar <- unknownTV
+         args' <- mapM (instantiateTyVarsToUnknown hsc_env) args
+         return$ mkTyConApp tycon args'
+-- we have a tyvar of kind *
+    | Just tyvar <- getTyVar_maybe ty
+    , ([],_) <- splitKindFunTys (tyVarKind tyvar) 
+    = unknownTV
+-- we have a higher kind tyvar, so insert an unknown of the appropriate kind
+    | Just tyvar <- getTyVar_maybe ty
+    , (args,_) <- splitKindFunTys (tyVarKind tyvar)
+    = liftM mkTyConTy $ unknownTC !! length args
+-- Base case
+    | otherwise    = return ty 
+
+ where unknownTV = do 
+         Just (ATyCon unknown_tc) <- tcRnLookupName hsc_env unknownTyConName
+         return$ mkTyConTy unknown_tc
+       unknownTC = [undefined, unknownTC1, unknownTC2, unknownTC3]
+       unknownTC1 = do 
+         Just (ATyCon unknown_tc) <- tcRnLookupName hsc_env unknown1TyConName
+         return unknown_tc
+       unknownTC2 = do 
+         Just (ATyCon unknown_tc) <- tcRnLookupName hsc_env unknown2TyConName
+         return unknown_tc
+       unknownTC3 = do 
+         Just (ATyCon unknown_tc) <- tcRnLookupName hsc_env unknown3TyConName
+         return unknown_tc
+--       isGADT ty | pprTrace' "isGADT" (ppr ty <> colon <> ppr(isGadtSyntaxTyCon ty)) False = undefined
+       isGADT tc | Just dcs <- tyConDataCons_maybe tc = any (not . null . dataConEqSpec) dcs
+                 | otherwise = False
+       fixTyVars ty 
+           | Just (tycon, args) <- splitTyConApp_maybe ty
+           = mapM fixTyVars args >>= return . mkTyConApp tycon
+-- Fix the tyvar so that the interactive environment doesn't choke on it TODO 
+           | Just tv <- getTyVar_maybe ty = return ty --TODO
+           | otherwise = return ty
+