X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSplice.lhs;h=a99bf8b9e24ef1f5247cc31abbc8d149d21dad3c;hb=84923cc7de2a93c22a2f72daf9ac863959efae13;hp=a823884b96aeb7dd50db5538105314c2ea92229d;hpb=e8a591c1a3dbdeccec2dd2aacccd7435004b0d51;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index a823884..a99bf8b 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -1,77 +1,69 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-\section[TcSplice]{Template Haskell splices}
+
+TcSplice: Template Haskell splices
 
 \begin{code}
 module TcSplice( tcSpliceExpr, tcSpliceDecls, tcBracket ) where
 
 #include "HsVersions.h"
 
-import HscMain		( compileExpr )
-import TcRnDriver	( tcTopSrcDecls )
+import HscMain
+import TcRnDriver
 	-- These imports are the reason that TcSplice 
 	-- is very high up the module hierarchy
 
-import qualified Language.Haskell.TH as TH
--- THSyntax gives access to internal functions and data types
-import qualified Language.Haskell.TH.Syntax as TH
-
-import HsSyn		( HsBracket(..), HsExpr(..), HsSplice(..), LHsExpr, LHsDecl, 
-		   	  HsType, LHsType )
-import Convert		( convertToHsExpr, convertToHsDecls, convertToHsType, thRdrName )
-import RnExpr		( rnLExpr )
-import RnEnv		( lookupFixityRn, lookupSrcOcc_maybe, lookupImportedName )
-import RdrName		( RdrName, lookupLocalRdrEnv, isSrcRdrName )
-import RnTypes		( rnLHsType )
-import TcExpr		( tcMonoExpr )
-import TcHsSyn		( mkHsDictLet, zonkTopLExpr )
-import TcSimplify	( tcSimplifyTop, tcSimplifyBracket )
-import TcUnify		( boxyUnify, unBox )
-import TcType		( TcType, TcKind, BoxyRhoType, liftedTypeKind, mkAppTy, tcSplitSigmaTy )
-import TcEnv		( spliceOK, tcMetaTy, bracketOK )
-import TcMType		( newFlexiTyVarTy, newKindVar, UserTypeCtxt(ExprSigCtxt), zonkTcType )
-import TcHsType		( tcHsSigType, kcHsType )
-import TcIface		( tcImportDecl )
-import TypeRep		( Type(..), PredType(..), TyThing(..) )	-- For reification
-import PrelNames	( thFAKE )
-import Name		( Name, NamedThing(..), nameOccName, nameModule, isExternalName, 
-			  nameIsLocalOrFrom )
-import NameEnv		( lookupNameEnv )
-import HscTypes		( lookupType, ExternalPackageState(..), emptyModDetails )
+import HsSyn
+import Convert
+import RnExpr
+import RnEnv
+import RdrName
+import RnTypes
+import TcExpr
+import TcHsSyn
+import TcSimplify
+import TcUnify
+import TcType
+import TcEnv
+import TcMType
+import TcHsType
+import TcIface
+import TypeRep
+import Name
+import NameEnv
+import HscTypes
 import OccName
-import Var		( Id, TyVar, idType )
-import Module		( moduleName, moduleNameString, modulePackageId )
+import Var
+import Module
 import TcRnMonad
-import IfaceEnv		( lookupOrig )
-import Class		( Class, classExtraBigSig )
-import TyCon		( TyCon, tyConTyVars, synTyConDefn, 
-			  isSynTyCon, isNewTyCon, tyConDataCons, isPrimTyCon, isFunTyCon,
-			  tyConArity, tyConStupidTheta, isUnLiftedTyCon )
-import DataCon		( DataCon, dataConTyCon, dataConOrigArgTys, dataConStrictMarks, 
-			  dataConName, dataConFieldLabels, dataConWrapId, dataConIsInfix, 
-			  isVanillaDataCon )
-import Id		( idName, globalIdDetails )
-import IdInfo		( GlobalIdDetails(..) )
-import TysWiredIn	( mkListTy )
-import DsMeta		( expQTyConName, typeQTyConName, decTyConName, qTyConName, nameTyConName )
-import DsExpr		( dsLExpr )
-import DsMonad		( initDsTc )
-import ErrUtils		( Message )
-import SrcLoc		( SrcSpan, noLoc, unLoc, getLoc )
+import IfaceEnv
+import Class
+import TyCon
+import DataCon
+import Id
+import IdInfo
+import TysWiredIn
+import DsMeta
+import DsExpr
+import DsMonad hiding (Splice)
+import ErrUtils
+import SrcLoc
 import Outputable
-import Unique		( Unique, Uniquable(..), getKey, mkUniqueGrimily )
-import PackageConfig    ( packageIdString )
-import BasicTypes	( StrictnessMark(..), Fixity(..), FixityDirection(..) )
-import Panic		( showException )
-import FastString	( LitString )
+import Unique
+import DynFlags
+import PackageConfig
+import BasicTypes
+import Panic
+import FastString
 
-import GHC.Base		( unsafeCoerce#, Int#, Int(..) )	-- Should have a better home in the module hierarchy
-import Monad 		( liftM )
+import qualified Language.Haskell.TH as TH
+-- THSyntax gives access to internal functions and data types
+import qualified Language.Haskell.TH.Syntax as TH
 
-#ifdef GHCI
-import FastString	( mkFastString )
-#endif
+import GHC.Exts		( unsafeCoerce#, Int#, Int(..) )
+import Control.Monad	( liftM )
 \end{code}
 
 
@@ -85,6 +77,7 @@ import FastString	( mkFastString )
 tcSpliceDecls :: LHsExpr Name -> TcM [LHsDecl RdrName]
 tcSpliceExpr  :: HsSplice Name -> BoxyRhoType -> TcM (HsExpr TcId)
 kcSpliceType  :: HsSplice Name -> TcM (HsType Name, TcKind)
+	-- None of these functions add constraints to the LIE
 
 #ifndef GHCI
 tcSpliceExpr n e ty = pprPanic "Cant do tcSpliceExpr without GHCi" (ppr e)
@@ -371,8 +364,11 @@ runMeta :: (SrcSpan -> th_syn -> Either Message hs_syn)
 	-> TcM hs_syn		-- Of type t
 runMeta convert expr
   = do	{ 	-- Desugar
+#if defined(GHCI) && defined(DEBUGGER)
+	  ds_expr <- unsetOptM Opt_Debugging $ initDsTc (dsLExpr expr)
+#else 
 	  ds_expr <- initDsTc (dsLExpr expr)
-
+#endif
 	-- Compile and link it; might fail if linking fails
 	; hsc_env <- getTopEnv
 	; src_span <- getSrcSpanM
@@ -585,12 +581,10 @@ reifyTyCon tc
   | isFunTyCon tc  = return (TH.PrimTyConI (reifyName tc) 2 		  False)
   | isPrimTyCon tc = return (TH.PrimTyConI (reifyName tc) (tyConArity tc) (isUnLiftedTyCon tc))
   | isSynTyCon tc
-  = case synTyConDefn tc of
-      Nothing         -> noTH SLIT("type family") (ppr tc)
-      Just (tvs, rhs) -> 
-        do { rhs' <- reifyType rhs
-	   ; return (TH.TyConI $ 
-		       TH.TySynD (reifyName tc) (reifyTyVars tvs) rhs') }
+  = do { let (tvs, rhs) = synTyConDefn tc 
+       ; rhs' <- reifyType rhs
+       ; return (TH.TyConI $ 
+		   TH.TySynD (reifyName tc) (reifyTyVars tvs) rhs') }
 
 reifyTyCon tc
   = do 	{ cxt <- reifyCxt (tyConStupidTheta tc)
@@ -631,7 +625,7 @@ reifyClass cls
 	; ops <- mapM reify_op op_stuff
 	; return (TH.ClassI $ TH.ClassD cxt (reifyName cls) (reifyTyVars tvs) fds' ops) }
   where
-    (tvs, fds, theta, _, op_stuff) = classExtraBigSig cls
+    (tvs, fds, theta, _, _, op_stuff) = classExtraBigSig cls
     fds' = map reifyFunDep fds
     reify_op (op, _) = do { ty <- reifyType (idType op)
 			  ; return (TH.SigD (reifyName op) ty) }