X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsMeta.hs;h=92918a2f4320413aae60a2410c45f398c4803868;hp=e655635451d55139f88cecf7a7298103797cf928;hb=ff845ab59d1d465d874d3908fd0cdd61b8594da2;hpb=7e7c296af4d58fc1ae5d243ff1aa7d55cb1dcc23

diff --git a/ghc/compiler/deSugar/DsMeta.hs b/ghc/compiler/deSugar/DsMeta.hs
index e655635..92918a2 100644
--- a/ghc/compiler/deSugar/DsMeta.hs
+++ b/ghc/compiler/deSugar/DsMeta.hs
@@ -11,112 +11,75 @@
 -----------------------------------------------------------------------------
 
 
-module DsMeta( dsBracket, dsReify,
-	       templateHaskellNames, qTyConName, 
-	       liftName, exprTyConName, declTyConName, typeTyConName,
-	       decTyConName, typTyConName ) where
+module DsMeta( dsBracket, 
+	       templateHaskellNames, qTyConName, nameTyConName,
+	       liftName, expQTyConName, decQTyConName, typeQTyConName,
+	       decTyConName, typeTyConName, mkNameG_dName, mkNameG_vName, mkNameG_tcName
+	        ) where
 
 #include "HsVersions.h"
 
 import {-# SOURCE #-}	DsExpr ( dsExpr )
 
 import MatchLit	  ( dsLit )
-import DsUtils    ( mkListExpr, mkStringLit, mkCoreTup, mkIntExpr )
+import DsUtils    ( mkListExpr, mkStringExpr, mkCoreTup, mkIntExpr )
 import DsMonad
 
-import qualified Language.Haskell.THSyntax as M
-
-import HsSyn  	  ( Pat(..), HsExpr(..), Stmt(..), HsLit(..), HsOverLit(..),
-		    Match(..), GRHSs(..), GRHS(..), HsBracket(..),
-                    HsStmtContext(ListComp,DoExpr), ArithSeqInfo(..),
-		    HsBinds(..), MonoBinds(..), HsConDetails(..),
-		    TyClDecl(..), HsGroup(..),
-		    HsReify(..), ReifyFlavour(..), 
-		    HsType(..), HsContext(..), HsPred(..), HsTyOp(..),
-	 	    HsTyVarBndr(..), Sig(..), ForeignDecl(..),
-		    InstDecl(..), ConDecl(..), BangType(..),
-		    PendingSplice, splitHsInstDeclTy,
-		    placeHolderType, tyClDeclNames,
-		    collectHsBinders, collectPatBinders, collectPatsBinders,
-		    hsTyVarName, hsConArgs, getBangType,
-		    toHsType
-		  )
-
-import PrelNames  ( mETA_META_Name, rationalTyConName, negateName,
-		    parrTyConName )
-import MkIface	  ( ifaceTyThing )
-import Name       ( Name, nameOccName, nameModule )
+import qualified Language.Haskell.TH as TH
+
+import HsSyn
+import Class (FunDep)
+import PrelNames  ( rationalTyConName, integerTyConName, negateName )
 import OccName	  ( isDataOcc, isTvOcc, occNameUserString )
 -- To avoid clashes with DsMeta.varName we must make a local alias for OccName.varName
 -- we do this by removing varName from the import of OccName above, making
 -- a qualified instance of OccName and using OccNameAlias.varName where varName
 -- ws previously used in this file.
-import qualified OccName( varName, tcName )
+import qualified OccName
 
-import Module	  ( Module, mkThPkgModule, moduleUserString )
-import Id         ( Id, idType )
-import Name	  ( mkKnownKeyExternalName )
+import Module	  ( Module, mkModule, mkModuleName, moduleUserString )
+import Id         ( Id, mkLocalId )
 import OccName	  ( mkOccFS )
+import Name       ( Name, mkExternalName, localiseName, nameOccName, nameModule, 
+		    isExternalName, getSrcLoc )
 import NameEnv
-import NameSet
 import Type       ( Type, mkGenTyConApp )
-import TcType	  ( TyThing(..), tcTyConAppArgs )
-import TyCon	  ( DataConDetails(..) )
-import TysWiredIn ( stringTy )
+import TcType	  ( tcTyConAppArgs )
+import TyCon	  ( tyConName )
+import TysWiredIn ( parrTyCon )
 import CoreSyn
 import CoreUtils  ( exprType )
-import SrcLoc	  ( noSrcLoc )
-import Maybes	  ( orElse )
-import Maybe	  ( catMaybes, fromMaybe )
-import Panic	  ( panic )
-import Unique	  ( mkPreludeTyConUnique, mkPreludeMiscIdUnique )
-import BasicTypes ( NewOrData(..), StrictnessMark(..), isBoxed ) 
-
+import SrcLoc	  ( noSrcLoc, unLoc, Located(..), SrcSpan, srcLocSpan )
+import Maybe	  ( catMaybes )
+import Unique	  ( mkPreludeTyConUnique, mkPreludeMiscIdUnique, getKey, Uniquable(..) )
+import BasicTypes ( isBoxed ) 
+import Packages	  ( thPackage )
 import Outputable
-import FastString	( mkFastString )
+import Bag	  ( bagToList )
+import FastString ( unpackFS )
+import ForeignCall ( Safety(..), ForeignCall(..), CCallConv(..),
+                     CCallTarget(..) )
 
 import Monad ( zipWithM )
+import List ( sortBy )
  
 -----------------------------------------------------------------------------
 dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
--- Returns a CoreExpr of type M.Expr
+-- Returns a CoreExpr of type TH.ExpQ
 -- The quoted thing is parameterised over Name, even though it has
 -- been type checked.  We don't want all those type decorations!
 
 dsBracket brack splices
   = dsExtendMetaEnv new_bit (do_brack brack)
   where
-    new_bit = mkNameEnv [(n, Splice e) | (n,e) <- splices]
+    new_bit = mkNameEnv [(n, Splice (unLoc e)) | (n,e) <- splices]
 
-    do_brack (ExpBr e)  = do { MkC e1  <- repE e      ; return e1 }
-    do_brack (PatBr p)  = do { MkC p1  <- repP p      ; return p1 }
-    do_brack (TypBr t)  = do { MkC t1  <- repTy t     ; return t1 }
+    do_brack (VarBr n)  = do { MkC e1  <- lookupOcc n ; return e1 }
+    do_brack (ExpBr e)  = do { MkC e1  <- repLE e     ; return e1 }
+    do_brack (PatBr p)  = do { MkC p1  <- repLP p     ; return p1 }
+    do_brack (TypBr t)  = do { MkC t1  <- repLTy t    ; return t1 }
     do_brack (DecBr ds) = do { MkC ds1 <- repTopDs ds ; return ds1 }
 
------------------------------------------------------------------------------
-dsReify :: HsReify Id -> DsM CoreExpr
--- Returns a CoreExpr of type 	reifyType --> M.Type
---				reifyDecl --> M.Decl
---				reifyFixty --> Q M.Fix
-dsReify (ReifyOut ReifyType name)
-  = do { thing <- dsLookupGlobal name ;
-		-- By deferring the lookup until now (rather than doing it
-		-- in the type checker) we ensure that all zonking has
-		-- been done.
-	 case thing of
-	    AnId id -> do { MkC e <- repTy (toHsType (idType id)) ;
-			    return e }
-	    other   -> pprPanic "dsReify: reifyType" (ppr name)
-	}
-
-dsReify r@(ReifyOut ReifyDecl name)
-  = do { thing <- dsLookupGlobal name ;
-	 mb_d <- repTyClD (ifaceTyThing thing) ;
-	 case mb_d of
-	   Just (MkC d) -> return d 
-	   Nothing	-> pprPanic "dsReify" (ppr r)
-	}
-
 {- -------------- Examples --------------------
 
   [| \x -> x |]
@@ -136,10 +99,10 @@ dsReify r@(ReifyOut ReifyDecl name)
 -- 			Declarations
 -------------------------------------------------------
 
-repTopDs :: HsGroup Name -> DsM (Core (M.Q [M.Dec]))
+repTopDs :: HsGroup Name -> DsM (Core (TH.Q [TH.Dec]))
 repTopDs group
- = do { let { bndrs = groupBinders group } ;
-	ss    <- mkGenSyms bndrs ;
+ = do { let { bndrs = map unLoc (groupBinders group) } ;
+	ss <- mkGenSyms bndrs ;
 
 	-- Bind all the names mainly to avoid repeated use of explicit strings.
 	-- Thus	we get
@@ -150,13 +113,14 @@ repTopDs group
 
 	
 	decls <- addBinds ss (do {
-			val_ds <- rep_binds (hs_valds group) ;
+			val_ds  <- mapM rep_bind_group (hs_valds group) ;
 			tycl_ds <- mapM repTyClD (hs_tyclds group) ;
-			inst_ds <- mapM repInstD (hs_instds group) ;
+			inst_ds <- mapM repInstD' (hs_instds group) ;
+			for_ds <- mapM repForD (hs_fords group) ;
 			-- more needed
-			return (val_ds ++ catMaybes tycl_ds ++ inst_ds) }) ;
+			return (de_loc $ sort_by_loc $ concat val_ds ++ catMaybes tycl_ds ++ inst_ds ++ for_ds) }) ;
 
-	decl_ty <- lookupType declTyConName ;
+	decl_ty <- lookupType decQTyConName ;
 	let { core_list = coreList' decl_ty decls } ;
 
 	dec_ty <- lookupType decTyConName ;
@@ -169,9 +133,9 @@ repTopDs group
 groupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
 			hs_fords = foreign_decls })
 -- Collect the binders of a Group
-  = collectHsBinders val_decls ++
-    [n | d <- tycl_decls, (n,_) <- tyClDeclNames d] ++
-    [n | ForeignImport n _ _ _ _ <- foreign_decls]
+  = collectGroupBinders val_decls ++
+    [n | d <- tycl_decls, n <- tyClDeclNames (unLoc d)] ++
+    [n | L _ (ForeignImport n _ _ _) <- foreign_decls]
 
 
 {- 	Note [Binders and occurrences]
@@ -192,121 +156,204 @@ But if we see this:
 then we must desugar to
 	foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
 
-So in repTopDs we bring the binders into scope with mkGenSyms and addBinds,
-but in dsReify we do not.  And we use lookupOcc, rather than lookupBinder
+So in repTopDs we bring the binders into scope with mkGenSyms and addBinds.
+And we use lookupOcc, rather than lookupBinder
 in repTyClD and repC.
 
 -}
 
-repTyClD :: TyClDecl Name -> DsM (Maybe (Core M.Decl))
+repTyClD :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
 
-repTyClD (TyData { tcdND = DataType, tcdCtxt = [], 
-		   tcdName = tc, tcdTyVars = tvs, 
-		   tcdCons = DataCons cons, tcdDerivs = mb_derivs }) 
- = do { tc1 <- lookupOcc tc ;		-- See note [Binders and occurrences] 
+repTyClD (L loc (TyData { tcdND = DataType, tcdCtxt = cxt, 
+		    tcdLName = tc, tcdTyVars = tvs, 
+		    tcdCons = cons, tcdDerivs = mb_derivs }))
+ = do { tc1 <- lookupLOcc tc ;		-- See note [Binders and occurrences] 
         dec <- addTyVarBinds tvs $ \bndrs -> do {
-      	       cons1   <- mapM repC cons ;
-      	       cons2   <- coreList consTyConName cons1 ;
+      	       cxt1    <- repLContext cxt ;
+               cons1   <- mapM repC cons ;
+      	       cons2   <- coreList conQTyConName cons1 ;
       	       derivs1 <- repDerivs mb_derivs ;
-      	       repData tc1 (coreList' stringTy bndrs) cons2 derivs1 } ;
-        return $ Just dec }
+	       bndrs1  <- coreList nameTyConName bndrs ;
+      	       repData cxt1 tc1 bndrs1 cons2 derivs1 } ;
+        return $ Just (loc, dec) }
+
+repTyClD (L loc (TyData { tcdND = NewType, tcdCtxt = cxt, 
+		    tcdLName = tc, tcdTyVars = tvs, 
+		    tcdCons = [con], tcdDerivs = mb_derivs }))
+ = do { tc1 <- lookupLOcc tc ;		-- See note [Binders and occurrences] 
+        dec <- addTyVarBinds tvs $ \bndrs -> do {
+      	       cxt1   <- repLContext cxt ;
+               con1   <- repC con ;
+      	       derivs1 <- repDerivs mb_derivs ;
+	       bndrs1  <- coreList nameTyConName bndrs ;
+      	       repNewtype cxt1 tc1 bndrs1 con1 derivs1 } ;
+        return $ Just (loc, dec) }
 
-repTyClD (TySynonym { tcdName = tc, tcdTyVars = tvs, tcdSynRhs = ty })
- = do { tc1 <- lookupOcc tc ;		-- See note [Binders and occurrences] 
+repTyClD (L loc (TySynonym { tcdLName = tc, tcdTyVars = tvs, tcdSynRhs = ty }))
+ = do { tc1 <- lookupLOcc tc ;		-- See note [Binders and occurrences] 
         dec <- addTyVarBinds tvs $ \bndrs -> do {
-	       ty1 <- repTy ty ;
-	       repTySyn tc1 (coreList' stringTy bndrs) ty1 } ;
- 	return (Just dec) }
+	       ty1     <- repLTy ty ;
+	       bndrs1  <- coreList nameTyConName bndrs ;
+	       repTySyn tc1 bndrs1 ty1 } ;
+ 	return (Just (loc, dec)) }
 
-repTyClD (ClassDecl { tcdCtxt = cxt, tcdName = cls, 
+repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, 
 		      tcdTyVars = tvs, 
-		      tcdFDs = [], 	-- We don't understand functional dependencies
-		      tcdSigs = sigs, tcdMeths = mb_meth_binds })
- = do { cls1 <- lookupOcc cls ;		-- See note [Binders and occurrences] 
+		      tcdFDs = fds,
+		      tcdSigs = sigs, tcdMeths = meth_binds }))
+ = do { cls1 <- lookupLOcc cls ;		-- See note [Binders and occurrences] 
     	dec  <- addTyVarBinds tvs $ \bndrs -> do {
- 		  cxt1   <- repContext cxt ;
+ 		  cxt1   <- repLContext cxt ;
  		  sigs1  <- rep_sigs sigs ;
- 		  binds1 <- rep_monobind meth_binds ;
- 		  decls1 <- coreList declTyConName (sigs1 ++ binds1) ;
- 		  repClass cxt1 cls1 (coreList' stringTy bndrs) decls1 } ;
-    	return $ Just dec }
- where
-	-- If the user quotes a class decl, it'll have default-method 
-	-- bindings; but if we (reifyDecl C) where C is a class, we
-	-- won't be given the default methods (a definite infelicity).
-   meth_binds = mb_meth_binds `orElse` EmptyMonoBinds
+ 		  binds1 <- rep_binds meth_binds ;
+          fds1 <- repLFunDeps fds;
+ 		  decls1 <- coreList decQTyConName (sigs1 ++ binds1) ;
+	          bndrs1 <- coreList nameTyConName bndrs ;
+ 		  repClass cxt1 cls1 bndrs1 fds1 decls1 } ;
+    	return $ Just (loc, dec) }
 
 -- Un-handled cases
-repTyClD d = do { addDsWarn (hang msg 4 (ppr d)) ;
-	          return Nothing
-	     }
-  where
-    msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
-
-repInstD (InstDecl ty binds _ _ loc)
-	-- Ignore user pragmas for now
- = do { cxt1 <- repContext cxt ;
-	inst_ty1 <- repPred (HsClassP cls tys) ;
-	binds1 <- rep_monobind binds ;
-	decls1 <- coreList declTyConName binds1 ;
-	repInst cxt1 inst_ty1 decls1  }
+repTyClD (L loc d) = do { dsWarn (loc, hang ds_msg 4 (ppr d)) ;
+	          	   return Nothing
+	     		 }
+
+-- represent fundeps
+--
+repLFunDeps :: [Located (FunDep Name)] -> DsM (Core [TH.FunDep])
+repLFunDeps fds = do fds' <- mapM repLFunDep fds
+                     fdList <- coreList funDepTyConName fds'
+                     return fdList
+
+repLFunDep :: Located (FunDep Name) -> DsM (Core TH.FunDep)
+repLFunDep (L _ (xs, ys)) = do xs' <- mapM lookupBinder xs
+                               ys' <- mapM lookupBinder ys
+                               xs_list <- coreList nameTyConName xs'
+                               ys_list <- coreList nameTyConName ys'
+                               repFunDep xs_list ys_list
+
+repInstD' (L loc (InstDecl ty binds _))		-- Ignore user pragmas for now
+ = do	{ i <- addTyVarBinds tvs $ \tv_bndrs ->
+		-- We must bring the type variables into scope, so their occurrences
+		-- don't fail,  even though the binders don't appear in the resulting 
+		-- data structure
+		do {  cxt1 <- repContext cxt
+		   ; inst_ty1 <- repPred (HsClassP cls tys)
+		   ; ss <- mkGenSyms (collectHsBindBinders binds)
+		   ; binds1 <- addBinds ss (rep_binds binds)
+		   ; decls1 <- coreList decQTyConName binds1
+		   ; decls2 <- wrapNongenSyms ss decls1
+		   -- wrapNonGenSyms: do not clone the class op names!
+		   -- They must be called 'op' etc, not 'op34'
+		   ; repInst cxt1 inst_ty1 decls2 }
+
+	; return (loc, i)}
+ where
+   (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
+
+repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)
+repForD (L loc (ForeignImport name typ (CImport cc s ch cn cis) _))
+ = do MkC name' <- lookupLOcc name
+      MkC typ' <- repLTy typ
+      MkC cc' <- repCCallConv cc
+      MkC s' <- repSafety s
+      MkC str <- coreStringLit $ static
+                              ++ unpackFS ch ++ " "
+                              ++ unpackFS cn ++ " "
+                              ++ conv_cimportspec cis
+      dec <- rep2 forImpDName [cc', s', str, name', typ']
+      return (loc, dec)
  where
-   (tvs, cxt, cls, tys) = splitHsInstDeclTy ty
+    conv_cimportspec (CLabel cls) = panic "repForD': CLabel Not handled"
+    conv_cimportspec (CFunction DynamicTarget) = "dynamic"
+    conv_cimportspec (CFunction (StaticTarget fs)) = unpackFS fs
+    conv_cimportspec CWrapper = "wrapper"
+    static = case cis of
+                 CFunction (StaticTarget _) -> "static "
+                 _ -> ""
+
+repCCallConv :: CCallConv -> DsM (Core TH.Callconv)
+repCCallConv CCallConv = rep2 cCallName []
+repCCallConv StdCallConv = rep2 stdCallName []
 
+repSafety :: Safety -> DsM (Core TH.Safety)
+repSafety PlayRisky = rep2 unsafeName []
+repSafety (PlaySafe False) = rep2 safeName []
+repSafety (PlaySafe True) = rep2 threadsafeName []
+
+ds_msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
 
 -------------------------------------------------------
 -- 			Constructors
 -------------------------------------------------------
 
-repC :: ConDecl Name -> DsM (Core M.Cons)
-repC (ConDecl con [] [] details loc)
-  = do { con1     <- lookupOcc con ;		-- See note [Binders and occurrences] 
+repC :: LConDecl Name -> DsM (Core TH.ConQ)
+repC (L loc (ConDecl con [] (L _ []) details))
+  = do { con1 <- lookupLOcc con ;		-- See note [Binders and occurrences] 
 	 repConstr con1 details }
+repC (L loc (ConDecl con tvs (L cloc ctxt) details))
+  = do { addTyVarBinds tvs $ \bndrs -> do {
+             c' <- repC (L loc (ConDecl con [] (L cloc []) details));
+             ctxt' <- repContext ctxt;
+             bndrs' <- coreList nameTyConName bndrs;
+             rep2 forallCName [unC bndrs', unC ctxt', unC c']
+         }
+       }
+repC (L loc con_decl)
+  = do	{ dsWarn (loc, hang ds_msg 4 (ppr con_decl))
+	; return (panic "DsMeta:repC") }
+  where
+-- gaw 2004 FIX! Need a case for GadtDecl
 
-repBangTy :: BangType Name -> DsM (Core (M.Q (M.Strictness, M.Typ)))
-repBangTy (BangType str ty) = do MkC s <- rep2 strName []
-                                 MkC t <- repTy ty
-                                 rep2 strictTypeName [s, t]
-    where strName = case str of
-                        NotMarkedStrict -> nonstrictName
-                        _ -> strictName
+repBangTy :: LBangType Name -> DsM (Core (TH.StrictTypeQ))
+repBangTy ty= do 
+  MkC s <- rep2 str []
+  MkC t <- repLTy ty'
+  rep2 strictTypeName [s, t]
+  where 
+    (str, ty') = case ty of
+		   L _ (HsBangTy _ ty) -> (isStrictName,  ty)
+		   other	       -> (notStrictName, ty)
 
 -------------------------------------------------------
 -- 			Deriving clause
 -------------------------------------------------------
 
-repDerivs :: Maybe (HsContext Name) -> DsM (Core [String])
-repDerivs Nothing = return (coreList' stringTy [])
+repDerivs :: Maybe [LHsType Name] -> DsM (Core [TH.Name])
+repDerivs Nothing = coreList nameTyConName []
 repDerivs (Just ctxt)
   = do { strs <- mapM rep_deriv ctxt ; 
-	 return (coreList' stringTy strs) }
+	 coreList nameTyConName strs }
   where
-    rep_deriv :: HsPred Name -> DsM (Core String)
+    rep_deriv :: LHsType Name -> DsM (Core TH.Name)
 	-- Deriving clauses must have the simple H98 form
-    rep_deriv (HsClassP cls []) = lookupOcc cls
-    rep_deriv other		= panic "rep_deriv"
+    rep_deriv (L _ (HsPredTy (HsClassP cls []))) = lookupOcc cls
+    rep_deriv other		  		 = panic "rep_deriv"
 
 
 -------------------------------------------------------
 --   Signatures in a class decl, or a group of bindings
 -------------------------------------------------------
 
-rep_sigs :: [Sig Name] -> DsM [Core M.Decl]
+rep_sigs :: [LSig Name] -> DsM [Core TH.DecQ]
+rep_sigs sigs = do locs_cores <- rep_sigs' sigs
+                   return $ de_loc $ sort_by_loc locs_cores
+
+rep_sigs' :: [LSig Name] -> DsM [(SrcSpan, Core TH.DecQ)]
 	-- We silently ignore ones we don't recognise
-rep_sigs sigs = do { sigs1 <- mapM rep_sig sigs ;
+rep_sigs' sigs = do { sigs1 <- mapM rep_sig sigs ;
 		     return (concat sigs1) }
 
-rep_sig :: Sig Name -> DsM [Core M.Decl]
+rep_sig :: LSig Name -> DsM [(SrcSpan, Core TH.DecQ)]
 	-- Singleton => Ok
 	-- Empty     => Too hard, signature ignored
-rep_sig (ClassOpSig nm _ ty _) = rep_proto nm ty
-rep_sig (Sig nm ty _)	       = rep_proto nm ty
-rep_sig other		       = return []
+rep_sig (L loc (Sig nm ty)) = rep_proto nm ty loc
+rep_sig other		    = return []
 
-rep_proto nm ty = do { nm1 <- lookupOcc nm ; 
-		       ty1 <- repTy ty ; 
+rep_proto :: Located Name -> LHsType Name -> SrcSpan -> DsM [(SrcSpan, Core TH.DecQ)]
+rep_proto nm ty loc = do { nm1 <- lookupLOcc nm ; 
+		       ty1 <- repLTy ty ; 
 		       sig <- repProto nm1 ty1 ;
-		       return [sig] }
+		       return [(loc, sig)] }
 
 
 -------------------------------------------------------
@@ -317,12 +364,12 @@ rep_proto nm ty = do { nm1 <- lookupOcc nm ;
 -- the computations passed as the second argument is executed in that extended
 -- meta environment and gets the *new* names on Core-level as an argument
 --
-addTyVarBinds :: [HsTyVarBndr Name]	         -- the binders to be added
-	      -> ([Core String] -> DsM (Core (M.Q a))) -- action in the ext env
-	      -> DsM (Core (M.Q a))
+addTyVarBinds :: [LHsTyVarBndr Name]	         -- the binders to be added
+	      -> ([Core TH.Name] -> DsM (Core (TH.Q a))) -- action in the ext env
+	      -> DsM (Core (TH.Q a))
 addTyVarBinds tvs m =
   do
-    let names = map hsTyVarName tvs
+    let names = map (hsTyVarName.unLoc) tvs
     freshNames <- mkGenSyms names
     term       <- addBinds freshNames $ do
 		    bndrs <- mapM lookupBinder names 
@@ -331,35 +378,45 @@ addTyVarBinds tvs m =
 
 -- represent a type context
 --
-repContext :: HsContext Name -> DsM (Core M.Ctxt)
+repLContext :: LHsContext Name -> DsM (Core TH.CxtQ)
+repLContext (L _ ctxt) = repContext ctxt
+
+repContext :: HsContext Name -> DsM (Core TH.CxtQ)
 repContext ctxt = do 
-	            preds    <- mapM repPred ctxt
-		    predList <- coreList typeTyConName preds
+	            preds    <- mapM repLPred ctxt
+		    predList <- coreList typeQTyConName preds
 		    repCtxt predList
 
 -- represent a type predicate
 --
-repPred :: HsPred Name -> DsM (Core M.Type)
+repLPred :: LHsPred Name -> DsM (Core TH.TypeQ)
+repLPred (L _ p) = repPred p
+
+repPred :: HsPred Name -> DsM (Core TH.TypeQ)
 repPred (HsClassP cls tys) = do
 			       tcon <- repTy (HsTyVar cls)
-			       tys1 <- repTys tys
+			       tys1 <- repLTys tys
 			       repTapps tcon tys1
 repPred (HsIParam _ _)     = 
   panic "DsMeta.repTy: Can't represent predicates with implicit parameters"
 
 -- yield the representation of a list of types
 --
-repTys :: [HsType Name] -> DsM [Core M.Type]
-repTys tys = mapM repTy tys
+repLTys :: [LHsType Name] -> DsM [Core TH.TypeQ]
+repLTys tys = mapM repLTy tys
 
 -- represent a type
 --
-repTy :: HsType Name -> DsM (Core M.Type)
-repTy (HsForAllTy bndrs ctxt ty)  = 
-  addTyVarBinds (fromMaybe [] bndrs) $ \bndrs' -> do
-    ctxt'  <- repContext ctxt
-    ty'    <- repTy ty
-    repTForall (coreList' stringTy bndrs') ctxt' ty'
+repLTy :: LHsType Name -> DsM (Core TH.TypeQ)
+repLTy (L _ ty) = repTy ty
+
+repTy :: HsType Name -> DsM (Core TH.TypeQ)
+repTy (HsForAllTy _ tvs ctxt ty)  = 
+  addTyVarBinds tvs $ \bndrs -> do
+    ctxt1  <- repLContext ctxt
+    ty1    <- repLTy ty
+    bndrs1 <- coreList nameTyConName bndrs
+    repTForall bndrs1 ctxt1 ty1
 
 repTy (HsTyVar n)
   | isTvOcc (nameOccName n)       = do 
@@ -369,30 +426,29 @@ repTy (HsTyVar n)
 				      tc1 <- lookupOcc n
 				      repNamedTyCon tc1
 repTy (HsAppTy f a)               = do 
-				      f1 <- repTy f
-				      a1 <- repTy a
+				      f1 <- repLTy f
+				      a1 <- repLTy a
 				      repTapp f1 a1
 repTy (HsFunTy f a)               = do 
-				      f1   <- repTy f
-				      a1   <- repTy a
+				      f1   <- repLTy f
+				      a1   <- repLTy a
 				      tcon <- repArrowTyCon
 				      repTapps tcon [f1, a1]
 repTy (HsListTy t)		  = do
-				      t1   <- repTy t
+				      t1   <- repLTy t
 				      tcon <- repListTyCon
 				      repTapp tcon t1
 repTy (HsPArrTy t)                = do
-				      t1   <- repTy t
-				      tcon <- repTy (HsTyVar parrTyConName)
+				      t1   <- repLTy t
+				      tcon <- repTy (HsTyVar (tyConName parrTyCon))
 				      repTapp tcon t1
 repTy (HsTupleTy tc tys)	  = do
-				      tys1 <- repTys tys 
+				      tys1 <- repLTys tys 
 				      tcon <- repTupleTyCon (length tys)
 				      repTapps tcon tys1
-repTy (HsOpTy ty1 HsArrow ty2) 	  = repTy (HsFunTy ty1 ty2)
-repTy (HsOpTy ty1 (HsTyOp n) ty2) = repTy ((HsTyVar n `HsAppTy` ty1) 
-					   `HsAppTy` ty2)
-repTy (HsParTy t)  	       	  = repTy t
+repTy (HsOpTy ty1 n ty2) 	  = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1) 
+					   `nlHsAppTy` ty2)
+repTy (HsParTy t)  	       	  = repLTy t
 repTy (HsNumTy i)                 =
   panic "DsMeta.repTy: Can't represent number types (for generics)"
 repTy (HsPredTy pred)             = repPred pred
@@ -404,14 +460,17 @@ repTy (HsKindSig ty kind)	  =
 -- 		Expressions
 -----------------------------------------------------------------------------
 
-repEs :: [HsExpr Name] -> DsM (Core [M.Expr])
-repEs es = do { es'  <- mapM repE es ;
-		coreList exprTyConName es' }
+repLEs :: [LHsExpr Name] -> DsM (Core [TH.ExpQ])
+repLEs es = do { es'  <- mapM repLE es ;
+		 coreList expQTyConName es' }
 
 -- FIXME: some of these panics should be converted into proper error messages
 --	  unless we can make sure that constructs, which are plainly not
 --	  supported in TH already lead to error messages at an earlier stage
-repE :: HsExpr Name -> DsM (Core M.Expr)
+repLE :: LHsExpr Name -> DsM (Core TH.ExpQ)
+repLE (L _ e) = repE e
+
+repE :: HsExpr Name -> DsM (Core TH.ExpQ)
 repE (HsVar x)            =
   do { mb_val <- dsLookupMetaEnv x 
      ; case mb_val of
@@ -426,124 +485,144 @@ repE (HsIPVar x) = panic "DsMeta.repE: Can't represent implicit parameters"
 	-- HsOverlit can definitely occur
 repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
 repE (HsLit l)     = do { a <- repLiteral l;           repLit a }
-repE (HsLam m)     = repLambda m
-repE (HsApp x y)   = do {a <- repE x; b <- repE y; repApp a b}
+repE (HsLam (MatchGroup [m] _)) = repLambda m
+repE (HsApp x y)   = do {a <- repLE x; b <- repLE y; repApp a b}
 
 repE (OpApp e1 op fix e2) =
-  do { arg1 <- repE e1; 
-       arg2 <- repE e2; 
-       the_op <- repE op ;
+  do { arg1 <- repLE e1; 
+       arg2 <- repLE e2; 
+       the_op <- repLE op ;
        repInfixApp arg1 the_op arg2 } 
 repE (NegApp x nm)        = do
-			      a         <- repE x
+			      a         <- repLE x
 			      negateVar <- lookupOcc negateName >>= repVar
 			      negateVar `repApp` a
-repE (HsPar x)            = repE x
-repE (SectionL x y)       = do { a <- repE x; b <- repE y; repSectionL a b } 
-repE (SectionR x y)       = do { a <- repE x; b <- repE y; repSectionR a b } 
-repE (HsCase e ms loc)    = do { arg <- repE e
-			       ; ms2 <- mapM repMatchTup ms
-			       ; repCaseE arg (nonEmptyCoreList ms2) }
-repE (HsIf x y z loc)     = do
-			      a <- repE x
-			      b <- repE y
-			      c <- repE z
+repE (HsPar x)            = repLE x
+repE (SectionL x y)       = do { a <- repLE x; b <- repLE y; repSectionL a b } 
+repE (SectionR x y)       = do { a <- repLE x; b <- repLE y; repSectionR a b } 
+repE (HsCase e (MatchGroup ms _)) = do { arg <- repLE e
+				       ; ms2 <- mapM repMatchTup ms
+				       ; repCaseE arg (nonEmptyCoreList ms2) }
+repE (HsIf x y z)         = do
+			      a <- repLE x
+			      b <- repLE y
+			      c <- repLE z
 			      repCond a b c
 repE (HsLet bs e)         = do { (ss,ds) <- repBinds bs
-			       ; e2 <- addBinds ss (repE e)
+			       ; e2 <- addBinds ss (repLE e)
 			       ; z <- repLetE ds e2
 			       ; wrapGenSyns ss z }
 -- FIXME: I haven't got the types here right yet
-repE (HsDo DoExpr sts _ ty loc) 
- = do { (ss,zs) <- repSts sts; 
+repE (HsDo DoExpr sts _ ty) 
+ = do { (ss,zs) <- repLSts sts; 
         e       <- repDoE (nonEmptyCoreList zs);
         wrapGenSyns ss e }
-repE (HsDo ListComp sts _ ty loc) 
- = do { (ss,zs) <- repSts sts; 
+repE (HsDo ListComp sts _ ty) 
+ = do { (ss,zs) <- repLSts sts; 
         e       <- repComp (nonEmptyCoreList zs);
         wrapGenSyns ss e }
-repE (HsDo _ _ _ _ _) = panic "DsMeta.repE: Can't represent mdo and [: :] yet"
-repE (ExplicitList ty es) = do { xs <- repEs es; repListExp xs } 
+repE (HsDo _ _ _ _) = panic "DsMeta.repE: Can't represent mdo and [: :] yet"
+repE (ExplicitList ty es) = do { xs <- repLEs es; repListExp xs } 
 repE (ExplicitPArr ty es) = 
   panic "DsMeta.repE: No explicit parallel arrays yet"
 repE (ExplicitTuple es boxed) 
-  | isBoxed boxed         = do { xs <- repEs es; repTup xs }
+  | isBoxed boxed         = do { xs <- repLEs es; repTup xs }
   | otherwise		  = panic "DsMeta.repE: Can't represent unboxed tuples"
-repE (RecordConOut _ _ _) = panic "DsMeta.repE: No record construction yet"
-repE (RecordUpdOut _ _ _ _) = panic "DsMeta.repE: No record update yet"
-
-repE (ExprWithTySig e ty) = do { e1 <- repE e; t1 <- repTy ty; repSigExp e1 t1 }
+repE (RecordCon c flds)
+ = do { x <- lookupLOcc c;
+        fs <- repFields flds;
+        repRecCon x fs }
+repE (RecordUpd e flds)
+ = do { x <- repLE e;
+        fs <- repFields flds;
+        repRecUpd x fs }
+
+repE (ExprWithTySig e ty) = do { e1 <- repLE e; t1 <- repLTy ty; repSigExp e1 t1 }
 repE (ArithSeqIn aseq) =
   case aseq of
-    From e              -> do { ds1 <- repE e; repFrom ds1 }
+    From e              -> do { ds1 <- repLE e; repFrom ds1 }
     FromThen e1 e2      -> do 
-		             ds1 <- repE e1
-			     ds2 <- repE e2
+		             ds1 <- repLE e1
+			     ds2 <- repLE e2
 			     repFromThen ds1 ds2
     FromTo   e1 e2      -> do 
-			     ds1 <- repE e1
-			     ds2 <- repE e2
+			     ds1 <- repLE e1
+			     ds2 <- repLE e2
 			     repFromTo ds1 ds2
     FromThenTo e1 e2 e3 -> do 
-			     ds1 <- repE e1
-			     ds2 <- repE e2
-			     ds3 <- repE e3
+			     ds1 <- repLE e1
+			     ds2 <- repLE e2
+			     ds3 <- repLE e3
 			     repFromThenTo ds1 ds2 ds3
 repE (PArrSeqOut _ aseq)  = panic "DsMeta.repE: parallel array seq.s missing"
 repE (HsCoreAnn _ _)      = panic "DsMeta.repE: Can't represent CoreAnn" -- hdaume: core annotations
-repE (HsCCall _ _ _ _ _)  = panic "DsMeta.repE: Can't represent __ccall__"
 repE (HsSCC _ _)          = panic "DsMeta.repE: Can't represent SCC"
-repE (HsBracketOut _ _)   = 
-  panic "DsMeta.repE: Can't represent Oxford brackets"
-repE (HsSplice n e loc)   = do { mb_val <- dsLookupMetaEnv n
-			       ; case mb_val of
-				 Just (Splice e) -> do { e' <- dsExpr e
-						       ; return (MkC e') }
-				 other	     -> pprPanic "HsSplice" (ppr n) }
-repE (HsReify _)          = panic "DsMeta.repE: Can't represent reification"
-repE e                    = 
-  pprPanic "DsMeta.repE: Illegal expression form" (ppr e)
+repE (HsBracketOut _ _)   = panic "DsMeta.repE: Can't represent Oxford brackets"
+repE (HsSpliceE (HsSplice n _)) 
+  = do { mb_val <- dsLookupMetaEnv n
+       ; case mb_val of
+		 Just (Splice e) -> do { e' <- dsExpr e
+				       ; return (MkC e') }
+		 other	     -> pprPanic "HsSplice" (ppr n) }
+
+repE e = pprPanic "DsMeta.repE: Illegal expression form" (ppr e)
 
 -----------------------------------------------------------------------------
 -- Building representations of auxillary structures like Match, Clause, Stmt, 
 
-repMatchTup ::  Match Name -> DsM (Core M.Mtch) 
-repMatchTup (Match [p] ty (GRHSs guards wheres ty2)) = 
+repMatchTup ::  LMatch Name -> DsM (Core TH.MatchQ) 
+repMatchTup (L _ (Match [p] ty (GRHSs guards wheres))) =
   do { ss1 <- mkGenSyms (collectPatBinders p) 
      ; addBinds ss1 $ do {
-     ; p1 <- repP p
+     ; p1 <- repLP p
      ; (ss2,ds) <- repBinds wheres
      ; addBinds ss2 $ do {
      ; gs    <- repGuards guards
      ; match <- repMatch p1 gs ds
      ; wrapGenSyns (ss1++ss2) match }}}
 
-repClauseTup ::  Match Name -> DsM (Core M.Clse)
-repClauseTup (Match ps ty (GRHSs guards wheres ty2)) = 
+repClauseTup ::  LMatch Name -> DsM (Core TH.ClauseQ)
+repClauseTup (L _ (Match ps ty (GRHSs guards wheres))) =
   do { ss1 <- mkGenSyms (collectPatsBinders ps) 
      ; addBinds ss1 $ do {
-       ps1 <- repPs ps
+       ps1 <- repLPs ps
      ; (ss2,ds) <- repBinds wheres
      ; addBinds ss2 $ do {
        gs <- repGuards guards
      ; clause <- repClause ps1 gs ds
      ; wrapGenSyns (ss1++ss2) clause }}}
 
-repGuards ::  [GRHS Name] ->  DsM (Core M.Rihs)
-repGuards [GRHS [ResultStmt e loc] loc2] 
-  = do {a <- repE e; repNormal a }
+repGuards ::  [LGRHS Name] ->  DsM (Core TH.BodyQ)
+repGuards [L _ (GRHS [L _ (ResultStmt e)])]
+  = do {a <- repLE e; repNormal a }
 repGuards other 
-  = do { zs <- mapM process other; 
-	 repGuarded (nonEmptyCoreList (map corePair zs)) }
+  = do { zs <- mapM process other;
+     let {(xs, ys) = unzip zs};
+	 gd <- repGuarded (nonEmptyCoreList ys);
+     wrapGenSyns (concat xs) gd }
   where 
-    process (GRHS [ExprStmt e1 ty loc,ResultStmt e2 _] _)
-           = do { x <- repE e1; y <- repE e2; return (x, y) }
-    process other = panic "Non Haskell 98 guarded body"
+    process :: LGRHS Name -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
+    process (L _ (GRHS [])) = panic "No guards in guarded body"
+    process (L _ (GRHS [L _ (ExprStmt e1 ty),
+			L _ (ResultStmt e2)]))
+           = do { x <- repLNormalGE e1 e2;
+                  return ([], x) }
+    process (L _ (GRHS ss))
+           = do (gs, ss') <- repLSts ss
+                g <- repPatGE (nonEmptyCoreList ss')
+                return (gs, g)
+
+repFields :: [(Located Name, LHsExpr Name)] -> DsM (Core [TH.Q TH.FieldExp])
+repFields flds = do
+        fnames <- mapM lookupLOcc (map fst flds)
+        es <- mapM repLE (map snd flds)
+        fs <- zipWithM repFieldExp fnames es
+        coreList fieldExpQTyConName fs
 
 
 -----------------------------------------------------------------------------
 -- Representing Stmt's is tricky, especially if bound variables
--- shaddow each other. Consider:  [| do { x <- f 1; x <- f x; g x } |]
+-- shadow each other. Consider:  [| do { x <- f 1; x <- f x; g x } |]
 -- First gensym new names for every variable in any of the patterns.
 -- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
 -- if variables didn't shaddow, the static gensym wouldn't be necessary
@@ -566,16 +645,19 @@ repGuards other
 -- The helper function repSts computes the translation of each sub expression
 -- and a bunch of prefix bindings denoting the dynamic renaming.
 
-repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core M.Stmt])
-repSts [ResultStmt e loc] = 
-   do { a <- repE e
+repLSts :: [LStmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
+repLSts stmts = repSts (map unLoc stmts)
+
+repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
+repSts [ResultStmt e] = 
+   do { a <- repLE e
       ; e1 <- repNoBindSt a
       ; return ([], [e1]) }
-repSts (BindStmt p e loc : ss) =
-   do { e2 <- repE e 
+repSts (BindStmt p e : ss) =
+   do { e2 <- repLE e 
       ; ss1 <- mkGenSyms (collectPatBinders p) 
       ; addBinds ss1 $ do {
-      ; p1 <- repP p; 
+      ; p1 <- repLP p; 
       ; (ss2,zs) <- repSts ss
       ; z <- repBindSt p1 e2
       ; return (ss1++ss2, z : zs) }}
@@ -584,11 +666,12 @@ repSts (LetStmt bs : ss) =
       ; z <- repLetSt ds
       ; (ss2,zs) <- addBinds ss1 (repSts ss)
       ; return (ss1++ss2, z : zs) } 
-repSts (ExprStmt e ty loc : ss) =       
-   do { e2 <- repE e
+repSts (ExprStmt e ty : ss) =       
+   do { e2 <- repLE e
       ; z <- repNoBindSt e2 
       ; (ss2,zs) <- repSts ss
       ; return (ss2, z : zs) }
+repSts [] = panic "repSts ran out of statements"      
 repSts other = panic "Exotic Stmt in meta brackets"      
 
 
@@ -596,68 +679,79 @@ repSts other = panic "Exotic Stmt in meta brackets"
 --			Bindings
 -----------------------------------------------------------
 
-repBinds :: HsBinds Name -> DsM ([GenSymBind], Core [M.Decl]) 
+repBinds :: [HsBindGroup Name] -> DsM ([GenSymBind], Core [TH.DecQ]) 
 repBinds decs
- = do { let { bndrs = collectHsBinders decs } ;
-	ss	  <- mkGenSyms bndrs ;
-	core      <- addBinds ss (rep_binds decs) ;
-	core_list <- coreList declTyConName core ;
-	return (ss, core_list) }
-
-rep_binds :: HsBinds Name -> DsM [Core M.Decl] 
-rep_binds EmptyBinds = return []
-rep_binds (ThenBinds x y)
- = do { core1 <- rep_binds x
-      ; core2 <- rep_binds y
-      ; return (core1 ++ core2) }
-rep_binds (MonoBind bs sigs _)
- = do { core1 <- rep_monobind bs
-      ;	core2 <- rep_sigs sigs
+ = do	{ let { bndrs = map unLoc (collectGroupBinders decs) }
+		-- No need to worrry about detailed scopes within
+		-- the binding group, because we are talking Names
+		-- here, so we can safely treat it as a mutually 
+		-- recursive group
+	; ss        <- mkGenSyms bndrs
+	; core      <- addBinds ss (rep_bind_groups decs)
+	; core_list <- coreList decQTyConName core 
+	; return (ss, core_list) }
+
+rep_bind_groups :: [HsBindGroup Name] -> DsM [Core TH.DecQ]
+-- Assumes: all the binders of the binding are alrady in the meta-env
+rep_bind_groups binds = do 
+  locs_cores_s <- mapM rep_bind_group binds
+  return $ de_loc $ sort_by_loc (concat locs_cores_s)
+
+rep_bind_group :: HsBindGroup Name -> DsM [(SrcSpan, Core TH.DecQ)]
+-- Assumes: all the binders of the binding are alrady in the meta-env
+rep_bind_group (HsBindGroup bs sigs _)
+ = do { core1 <- mapM rep_bind (bagToList bs)
+      ;	core2 <- rep_sigs' sigs
       ;	return (core1 ++ core2) }
-rep_binds (IPBinds _ _)
+rep_bind_group (HsIPBinds _)
   = panic "DsMeta:repBinds: can't do implicit parameters"
 
-rep_monobind :: MonoBinds Name -> DsM [Core M.Decl]
-rep_monobind EmptyMonoBinds     = return []
-rep_monobind (AndMonoBinds x y) = do { x1 <- rep_monobind x; 
-				       y1 <- rep_monobind y; 
-				       return (x1 ++ y1) }
+rep_binds :: LHsBinds Name -> DsM [Core TH.DecQ]
+-- Assumes: all the binders of the binding are alrady in the meta-env
+rep_binds binds = do 
+  locs_cores <- mapM rep_bind (bagToList binds)
+  return $ de_loc $ sort_by_loc locs_cores
+
+rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
+-- Assumes: all the binders of the binding are alrady in the meta-env
 
 -- Note GHC treats declarations of a variable (not a pattern) 
 -- e.g.  x = g 5 as a Fun MonoBinds. This is indicated by a single match 
 -- with an empty list of patterns
-rep_monobind (FunMonoBind fn infx [Match [] ty (GRHSs guards wheres ty2)] loc) 
+rep_bind (L loc (FunBind fn infx (MatchGroup [L _ (Match [] ty (GRHSs guards wheres))] _)))
  = do { (ss,wherecore) <- repBinds wheres
 	; guardcore <- addBinds ss (repGuards guards)
-	; fn' <- lookupBinder fn
-	; p   <- repPvar fn'
-	; ans <- repVal p guardcore wherecore
-	; return [ans] }
+	; fn'  <- lookupLBinder fn
+	; p    <- repPvar fn'
+	; ans  <- repVal p guardcore wherecore
+	; ans' <- wrapGenSyns ss ans
+	; return (loc, ans') }
 
-rep_monobind (FunMonoBind fn infx ms loc)
+rep_bind (L loc (FunBind fn infx (MatchGroup ms _)))
  =   do { ms1 <- mapM repClauseTup ms
-	; fn' <- lookupBinder fn
+	; fn' <- lookupLBinder fn
         ; ans <- repFun fn' (nonEmptyCoreList ms1)
-        ; return [ans] }
+        ; return (loc, ans) }
 
-rep_monobind (PatMonoBind pat (GRHSs guards wheres ty2) loc)
- =   do { patcore <- repP pat 
+rep_bind (L loc (PatBind pat (GRHSs guards wheres) ty2))
+ =   do { patcore <- repLP pat 
         ; (ss,wherecore) <- repBinds wheres
 	; guardcore <- addBinds ss (repGuards guards)
-        ; ans <- repVal patcore guardcore wherecore
-        ; return [ans] }
+        ; ans  <- repVal patcore guardcore wherecore
+	; ans' <- wrapGenSyns ss ans
+        ; return (loc, ans') }
 
-rep_monobind (VarMonoBind v e)  
+rep_bind (L loc (VarBind v e))
  =   do { v' <- lookupBinder v 
-	; e2 <- repE e
+	; e2 <- repLE e
         ; x <- repNormal e2
         ; patcore <- repPvar v'
-	; empty_decls <- coreList declTyConName [] 
+	; empty_decls <- coreList decQTyConName [] 
         ; ans <- repVal patcore x empty_decls
-        ; return [ans] }
+        ; return (srcLocSpan (getSrcLoc v), ans) }
 
 -----------------------------------------------------------------------------
--- Since everything in a MonoBind is mutually recursive we need rename all
+-- Since everything in a Bind is mutually recursive we need rename all
 -- all the variables simultaneously. For example: 
 -- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
 -- do { f'1 <- gensym "f"
@@ -680,13 +774,12 @@ rep_monobind (VarMonoBind v e)
 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
 -- (\ p1 .. pn -> exp) by causing an error.  
 
-repLambda :: Match Name -> DsM (Core M.Expr)
-repLambda (Match ps _ (GRHSs [GRHS [ResultStmt e _ ] _ ] 
-		             EmptyBinds _))
+repLambda :: LMatch Name -> DsM (Core TH.ExpQ)
+repLambda (L _ (Match ps _ (GRHSs [L _ (GRHS [L _ (ResultStmt e)])] [])))
  = do { let bndrs = collectPatsBinders ps ;
-      ; ss <- mkGenSyms bndrs
+      ; ss  <- mkGenSyms bndrs
       ; lam <- addBinds ss (
-		do { xs <- repPs ps; body <- repE e; repLam xs body })
+		do { xs <- repLPs ps; body <- repLE e; repLam xs body })
       ; wrapGenSyns ss lam }
 
 repLambda z = panic "Can't represent a guarded lambda in Template Haskell"  
@@ -700,69 +793,87 @@ repLambda z = panic "Can't represent a guarded lambda in Template Haskell"
 -- variable should already appear in the environment.
 
 -- Process a list of patterns
-repPs :: [Pat Name] -> DsM (Core [M.Patt])
-repPs ps = do { ps' <- mapM repP ps ;
-		coreList pattTyConName ps' }
+repLPs :: [LPat Name] -> DsM (Core [TH.PatQ])
+repLPs ps = do { ps' <- mapM repLP ps ;
+		 coreList patQTyConName ps' }
+
+repLP :: LPat Name -> DsM (Core TH.PatQ)
+repLP (L _ p) = repP p
 
-repP :: Pat Name -> DsM (Core M.Patt)
+repP :: Pat Name -> DsM (Core TH.PatQ)
 repP (WildPat _)     = repPwild 
 repP (LitPat l)      = do { l2 <- repLiteral l; repPlit l2 }
 repP (VarPat x)      = do { x' <- lookupBinder x; repPvar x' }
-repP (LazyPat p)     = do { p1 <- repP p; repPtilde p1 }
-repP (AsPat x p)     = do { x' <- lookupBinder x; p1 <- repP p; repPaspat x' p1 }
-repP (ParPat p)      = repP p 
-repP (ListPat ps _)  = repListPat ps
-repP (TuplePat ps _) = do { qs <- repPs ps; repPtup qs }
+repP (LazyPat p)     = do { p1 <- repLP p; repPtilde p1 }
+repP (AsPat x p)     = do { x' <- lookupLBinder x; p1 <- repLP p; repPaspat x' p1 }
+repP (ParPat p)      = repLP p 
+repP (ListPat ps _)  = do { qs <- repLPs ps; repPlist qs }
+repP (TuplePat ps _) = do { qs <- repLPs ps; repPtup qs }
 repP (ConPatIn dc details)
- = do { con_str <- lookupOcc dc
+ = do { con_str <- lookupLOcc dc
       ; case details of
-         PrefixCon ps   -> do { qs <- repPs ps; repPcon con_str qs }
-         RecCon pairs   -> error "No records in template haskell yet"
-         InfixCon p1 p2 -> do { qs <- repPs [p1,p2]; repPcon con_str qs }
+         PrefixCon ps   -> do { qs <- repLPs ps; repPcon con_str qs }
+         RecCon pairs -> do { vs <- sequence $ map lookupLOcc (map fst pairs)
+                            ; ps <- sequence $ map repLP (map snd pairs)
+                            ; fps <- zipWithM (\x y -> rep2 fieldPatName [unC x,unC y]) vs ps
+                            ; fps' <- coreList fieldPatQTyConName fps
+                            ; repPrec con_str fps' }
+         InfixCon p1 p2 -> do { p1' <- repLP p1;
+                                p2' <- repLP p2;
+                                repPinfix p1' con_str p2' }
    }
 repP (NPatIn l (Just _)) = panic "Can't cope with negative overloaded patterns yet (repP (NPatIn _ (Just _)))"
 repP (NPatIn l Nothing) = do { a <- repOverloadedLiteral l; repPlit a }
+repP (SigPatIn p t)  = do { p' <- repLP p; t' <- repLTy t; repPsig p' t' }
 repP other = panic "Exotic pattern inside meta brackets"
 
-repListPat :: [Pat Name] -> DsM (Core M.Patt)     
-repListPat [] 	  = do { nil_con <- coreStringLit "[]"
-		       ; nil_args <- coreList pattTyConName [] 
-	               ; repPcon nil_con nil_args }
-repListPat (p:ps) = do { p2 <- repP p 
-		       ; ps2 <- repListPat ps
-		       ; cons_con <- coreStringLit ":"
-		       ; repPcon cons_con (nonEmptyCoreList [p2,ps2]) }
+----------------------------------------------------------
+-- Declaration ordering helpers
+
+sort_by_loc :: [(SrcSpan, a)] -> [(SrcSpan, a)]
+sort_by_loc xs = sortBy comp xs
+    where comp x y = compare (fst x) (fst y)
 
+de_loc :: [(a, b)] -> [b]
+de_loc = map snd
 
 ----------------------------------------------------------
 --	The meta-environment
 
 -- A name/identifier association for fresh names of locally bound entities
---
 type GenSymBind = (Name, Id)	-- Gensym the string and bind it to the Id
 				-- I.e.		(x, x_id) means
 				--	let x_id = gensym "x" in ...
 
 -- Generate a fresh name for a locally bound entity
---
-mkGenSym :: Name -> DsM GenSymBind
-mkGenSym nm = do { id <- newUniqueId nm stringTy; return (nm,id) }
 
--- Ditto for a list of names
---
 mkGenSyms :: [Name] -> DsM [GenSymBind]
-mkGenSyms ns = mapM mkGenSym ns
-	     
--- Add a list of fresh names for locally bound entities to the meta
--- environment (which is part of the state carried around by the desugarer
--- monad) 
+-- We can use the existing name.  For example:
+--	[| \x_77 -> x_77 + x_77 |]
+-- desugars to
+--	do { x_77 <- genSym "x"; .... }
+-- We use the same x_77 in the desugared program, but with the type Bndr
+-- instead of Int
 --
+-- We do make it an Internal name, though (hence localiseName)
+--
+-- Nevertheless, it's monadic because we have to generate nameTy
+mkGenSyms ns = do { var_ty <- lookupType nameTyConName
+		  ; return [(nm, mkLocalId (localiseName nm) var_ty) | nm <- ns] }
+
+	     
 addBinds :: [GenSymBind] -> DsM a -> DsM a
+-- Add a list of fresh names for locally bound entities to the 
+-- meta environment (which is part of the state carried around 
+-- by the desugarer monad) 
 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
 
 -- Look up a locally bound name
 --
-lookupBinder :: Name -> DsM (Core String)
+lookupLBinder :: Located Name -> DsM (Core TH.Name)
+lookupLBinder (L _ n) = lookupBinder n
+
+lookupBinder :: Name -> DsM (Core TH.Name)
 lookupBinder n 
   = do { mb_val <- dsLookupMetaEnv n;
 	 case mb_val of
@@ -774,9 +885,12 @@ lookupBinder n
 -- * If it is a global name, generate the "original name" representation (ie,
 --   the <module>:<name> form) for the associated entity
 --
-lookupOcc :: Name -> DsM (Core String)
+lookupLOcc :: Located Name -> DsM (Core TH.Name)
 -- Lookup an occurrence; it can't be a splice.
 -- Use the in-scope bindings if they exist
+lookupLOcc (L _ n) = lookupOcc n
+
+lookupOcc :: Name -> DsM (Core TH.Name)
 lookupOcc n
   = do {  mb_val <- dsLookupMetaEnv n ;
           case mb_val of
@@ -785,59 +899,74 @@ lookupOcc n
 		Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n) 
     }
 
-globalVar :: Name -> DsM (Core String)
-globalVar n = coreStringLit (name_mod ++ ":" ++ name_occ)
- 	    where
-	      name_mod = moduleUserString (nameModule n)
-	      name_occ = occNameUserString (nameOccName n)
-
-localVar :: Name -> DsM (Core String)
-localVar n = coreStringLit (occNameUserString (nameOccName n))
-
-lookupType :: Name 	-- Name of type constructor (e.g. M.Expr)
+globalVar :: Name -> DsM (Core TH.Name)
+-- Not bound by the meta-env
+-- Could be top-level; or could be local
+--	f x = $(g [| x |])
+-- Here the x will be local
+globalVar name
+  | isExternalName name
+  = do	{ MkC mod <- coreStringLit name_mod
+	; MkC occ <- occNameLit name
+	; rep2 mk_varg [mod,occ] }
+  | otherwise
+  = do 	{ MkC occ <- occNameLit name
+	; MkC uni <- coreIntLit (getKey (getUnique name))
+	; rep2 mkNameUName [occ,uni] }
+  where
+      name_mod = moduleUserString (nameModule name)
+      name_occ = nameOccName name
+      mk_varg | OccName.isDataOcc name_occ = mkNameG_dName
+	      | OccName.isVarOcc  name_occ = mkNameG_vName
+	      | OccName.isTcOcc   name_occ = mkNameG_tcName
+	      | otherwise 	           = pprPanic "DsMeta.globalVar" (ppr name)
+
+lookupType :: Name 	-- Name of type constructor (e.g. TH.ExpQ)
 	   -> DsM Type	-- The type
 lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
 		          return (mkGenTyConApp tc []) }
 
+wrapGenSyns :: [GenSymBind] 
+	    -> Core (TH.Q a) -> DsM (Core (TH.Q a))
 -- wrapGenSyns [(nm1,id1), (nm2,id2)] y 
 --	--> bindQ (gensym nm1) (\ id1 -> 
 --	    bindQ (gensym nm2 (\ id2 -> 
 --	    y))
 
-wrapGenSyns :: [GenSymBind] 
-	    -> Core (M.Q a) -> DsM (Core (M.Q a))
 wrapGenSyns binds body@(MkC b)
-  = go binds
+  = do  { var_ty <- lookupType nameTyConName
+	; go var_ty binds }
   where
     [elt_ty] = tcTyConAppArgs (exprType b) 
 	-- b :: Q a, so we can get the type 'a' by looking at the
 	-- argument type. NB: this relies on Q being a data/newtype,
 	-- not a type synonym
 
-    go [] = return body
-    go ((name,id) : binds)
-      = do { MkC body'  <- go binds
-	   ; lit_str    <- localVar name
+    go var_ty [] = return body
+    go var_ty ((name,id) : binds)
+      = do { MkC body'  <- go var_ty binds
+	   ; lit_str    <- occNameLit name
 	   ; gensym_app <- repGensym lit_str
-	   ; repBindQ stringTy elt_ty 
+	   ; repBindQ var_ty elt_ty 
 		      gensym_app (MkC (Lam id body')) }
 
 -- Just like wrapGenSym, but don't actually do the gensym
--- Instead use the existing name
--- Only used for [Decl]
+-- Instead use the existing name:
+--	let x = "x" in ...
+-- Only used for [Decl], and for the class ops in class 
+-- and instance decls
 wrapNongenSyms :: [GenSymBind] -> Core a -> DsM (Core a)
 wrapNongenSyms binds (MkC body)
   = do { binds' <- mapM do_one binds ;
 	 return (MkC (mkLets binds' body)) }
   where
     do_one (name,id) 
-	= do { MkC lit_str <- localVar name	-- No gensym
-	     ; return (NonRec id lit_str) }
-
-void = placeHolderType
+	= do { MkC lit_str <- occNameLit name
+	     ; MkC var <- rep2 mkNameName [lit_str]
+	     ; return (NonRec id var) }
 
-string :: String -> HsExpr Id
-string s = HsLit (HsString (mkFastString s))
+occNameLit :: Name -> DsM (Core String)
+occNameLit n = coreStringLit (occNameUserString (nameOccName n))
 
 
 -- %*********************************************************************
@@ -868,229 +997,283 @@ rep2 n xs = do { id <- dsLookupGlobalId n
 -- %*********************************************************************
 
 --------------- Patterns -----------------
-repPlit   :: Core M.Lit -> DsM (Core M.Patt) 
-repPlit (MkC l) = rep2 plitName [l]
+repPlit   :: Core TH.Lit -> DsM (Core TH.PatQ) 
+repPlit (MkC l) = rep2 litPName [l]
+
+repPvar :: Core TH.Name -> DsM (Core TH.PatQ)
+repPvar (MkC s) = rep2 varPName [s]
+
+repPtup :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
+repPtup (MkC ps) = rep2 tupPName [ps]
 
-repPvar :: Core String -> DsM (Core M.Patt)
-repPvar (MkC s) = rep2 pvarName [s]
+repPcon   :: Core TH.Name -> Core [TH.PatQ] -> DsM (Core TH.PatQ)
+repPcon (MkC s) (MkC ps) = rep2 conPName [s, ps]
 
-repPtup :: Core [M.Patt] -> DsM (Core M.Patt)
-repPtup (MkC ps) = rep2 ptupName [ps]
+repPrec   :: Core TH.Name -> Core [(TH.Name,TH.PatQ)] -> DsM (Core TH.PatQ)
+repPrec (MkC c) (MkC rps) = rep2 recPName [c,rps]
 
-repPcon   :: Core String -> Core [M.Patt] -> DsM (Core M.Patt)
-repPcon (MkC s) (MkC ps) = rep2 pconName [s, ps]
+repPinfix :: Core TH.PatQ -> Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
+repPinfix (MkC p1) (MkC n) (MkC p2) = rep2 infixPName [p1, n, p2]
 
-repPtilde :: Core M.Patt -> DsM (Core M.Patt)
-repPtilde (MkC p) = rep2 ptildeName [p]
+repPtilde :: Core TH.PatQ -> DsM (Core TH.PatQ)
+repPtilde (MkC p) = rep2 tildePName [p]
 
-repPaspat :: Core String -> Core M.Patt -> DsM (Core M.Patt)
-repPaspat (MkC s) (MkC p) = rep2 paspatName [s, p]
+repPaspat :: Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
+repPaspat (MkC s) (MkC p) = rep2 asPName [s, p]
 
-repPwild  :: DsM (Core M.Patt)
-repPwild = rep2 pwildName []
+repPwild  :: DsM (Core TH.PatQ)
+repPwild = rep2 wildPName []
+
+repPlist :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
+repPlist (MkC ps) = rep2 listPName [ps]
+
+repPsig :: Core TH.PatQ -> Core TH.TypeQ -> DsM (Core TH.PatQ)
+repPsig (MkC p) (MkC t) = rep2 sigPName [p, t]
 
 --------------- Expressions -----------------
-repVarOrCon :: Name -> Core String -> DsM (Core M.Expr)
+repVarOrCon :: Name -> Core TH.Name -> DsM (Core TH.ExpQ)
 repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
 	           | otherwise 		        = repVar str
 
-repVar :: Core String -> DsM (Core M.Expr)
-repVar (MkC s) = rep2 varName [s] 
+repVar :: Core TH.Name -> DsM (Core TH.ExpQ)
+repVar (MkC s) = rep2 varEName [s] 
 
-repCon :: Core String -> DsM (Core M.Expr)
-repCon (MkC s) = rep2 conName [s] 
+repCon :: Core TH.Name -> DsM (Core TH.ExpQ)
+repCon (MkC s) = rep2 conEName [s] 
 
-repLit :: Core M.Lit -> DsM (Core M.Expr)
-repLit (MkC c) = rep2 litName [c] 
+repLit :: Core TH.Lit -> DsM (Core TH.ExpQ)
+repLit (MkC c) = rep2 litEName [c] 
 
-repApp :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
-repApp (MkC x) (MkC y) = rep2 appName [x,y] 
+repApp :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
+repApp (MkC x) (MkC y) = rep2 appEName [x,y] 
 
-repLam :: Core [M.Patt] -> Core M.Expr -> DsM (Core M.Expr)
-repLam (MkC ps) (MkC e) = rep2 lamName [ps, e]
+repLam :: Core [TH.PatQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
+repLam (MkC ps) (MkC e) = rep2 lamEName [ps, e]
 
-repTup :: Core [M.Expr] -> DsM (Core M.Expr)
-repTup (MkC es) = rep2 tupName [es]
+repTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
+repTup (MkC es) = rep2 tupEName [es]
 
-repCond :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
-repCond (MkC x) (MkC y) (MkC z) =  rep2 condName [x,y,z] 
+repCond :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
+repCond (MkC x) (MkC y) (MkC z) =  rep2 condEName [x,y,z] 
 
-repLetE :: Core [M.Decl] -> Core M.Expr -> DsM (Core M.Expr)
+repLetE :: Core [TH.DecQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
 repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e] 
 
-repCaseE :: Core M.Expr -> Core [M.Mtch] -> DsM( Core M.Expr)
+repCaseE :: Core TH.ExpQ -> Core [TH.MatchQ] -> DsM( Core TH.ExpQ)
 repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
 
-repDoE :: Core [M.Stmt] -> DsM (Core M.Expr)
+repDoE :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
 repDoE (MkC ss) = rep2 doEName [ss]
 
-repComp :: Core [M.Stmt] -> DsM (Core M.Expr)
-repComp (MkC ss) = rep2 compName [ss]
+repComp :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
+repComp (MkC ss) = rep2 compEName [ss]
+
+repListExp :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
+repListExp (MkC es) = rep2 listEName [es]
+
+repSigExp :: Core TH.ExpQ -> Core TH.TypeQ -> DsM (Core TH.ExpQ)
+repSigExp (MkC e) (MkC t) = rep2 sigEName [e,t]
 
-repListExp :: Core [M.Expr] -> DsM (Core M.Expr)
-repListExp (MkC es) = rep2 listExpName [es]
+repRecCon :: Core TH.Name -> Core [TH.Q TH.FieldExp]-> DsM (Core TH.ExpQ)
+repRecCon (MkC c) (MkC fs) = rep2 recConEName [c,fs]
 
-repSigExp :: Core M.Expr -> Core M.Type -> DsM (Core M.Expr)
-repSigExp (MkC e) (MkC t) = rep2 sigExpName [e,t]
+repRecUpd :: Core TH.ExpQ -> Core [TH.Q TH.FieldExp] -> DsM (Core TH.ExpQ)
+repRecUpd (MkC e) (MkC fs) = rep2 recUpdEName [e,fs]
 
-repInfixApp :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
+repFieldExp :: Core TH.Name -> Core TH.ExpQ -> DsM (Core (TH.Q TH.FieldExp))
+repFieldExp (MkC n) (MkC x) = rep2 fieldExpName [n,x]
+
+repInfixApp :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
 repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
 
-repSectionL :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
+repSectionL :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
 repSectionL (MkC x) (MkC y) = rep2 sectionLName [x,y]
 
-repSectionR :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
+repSectionR :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
 repSectionR (MkC x) (MkC y) = rep2 sectionRName [x,y]
 
 ------------ Right hand sides (guarded expressions) ----
-repGuarded :: Core [(M.Expr, M.Expr)] -> DsM (Core M.Rihs)
-repGuarded (MkC pairs) = rep2 guardedName [pairs]
+repGuarded :: Core [TH.Q (TH.Guard, TH.Exp)] -> DsM (Core TH.BodyQ)
+repGuarded (MkC pairs) = rep2 guardedBName [pairs]
+
+repNormal :: Core TH.ExpQ -> DsM (Core TH.BodyQ)
+repNormal (MkC e) = rep2 normalBName [e]
+
+------------ Guards ----
+repLNormalGE :: LHsExpr Name -> LHsExpr Name -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
+repLNormalGE g e = do g' <- repLE g
+                      e' <- repLE e
+                      repNormalGE g' e'
+
+repNormalGE :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
+repNormalGE (MkC g) (MkC e) = rep2 normalGEName [g, e]
 
-repNormal :: Core M.Expr -> DsM (Core M.Rihs)
-repNormal (MkC e) = rep2 normalName [e]
+repPatGE :: Core [TH.StmtQ] -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
+repPatGE (MkC ss) = rep2 patGEName [ss]
 
-------------- Statements -------------------
-repBindSt :: Core M.Patt -> Core M.Expr -> DsM (Core M.Stmt)
-repBindSt (MkC p) (MkC e) = rep2 bindStName [p,e]
+------------- Stmts -------------------
+repBindSt :: Core TH.PatQ -> Core TH.ExpQ -> DsM (Core TH.StmtQ)
+repBindSt (MkC p) (MkC e) = rep2 bindSName [p,e]
 
-repLetSt :: Core [M.Decl] -> DsM (Core M.Stmt)
-repLetSt (MkC ds) = rep2 letStName [ds]
+repLetSt :: Core [TH.DecQ] -> DsM (Core TH.StmtQ)
+repLetSt (MkC ds) = rep2 letSName [ds]
 
-repNoBindSt :: Core M.Expr -> DsM (Core M.Stmt)
-repNoBindSt (MkC e) = rep2 noBindStName [e]
+repNoBindSt :: Core TH.ExpQ -> DsM (Core TH.StmtQ)
+repNoBindSt (MkC e) = rep2 noBindSName [e]
 
--------------- DotDot (Arithmetic sequences) -----------
-repFrom :: Core M.Expr -> DsM (Core M.Expr)
-repFrom (MkC x) = rep2 fromName [x]
+-------------- Range (Arithmetic sequences) -----------
+repFrom :: Core TH.ExpQ -> DsM (Core TH.ExpQ)
+repFrom (MkC x) = rep2 fromEName [x]
 
-repFromThen :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
-repFromThen (MkC x) (MkC y) = rep2 fromThenName [x,y]
+repFromThen :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
+repFromThen (MkC x) (MkC y) = rep2 fromThenEName [x,y]
 
-repFromTo :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
-repFromTo (MkC x) (MkC y) = rep2 fromToName [x,y]
+repFromTo :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
+repFromTo (MkC x) (MkC y) = rep2 fromToEName [x,y]
 
-repFromThenTo :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
-repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToName [x,y,z]
+repFromThenTo :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
+repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToEName [x,y,z]
 
 ------------ Match and Clause Tuples -----------
-repMatch :: Core M.Patt -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Mtch)
+repMatch :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.MatchQ)
 repMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]
 
-repClause :: Core [M.Patt] -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Clse)
+repClause :: Core [TH.PatQ] -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.ClauseQ)
 repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
 
 -------------- Dec -----------------------------
-repVal :: Core M.Patt -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Decl)
-repVal (MkC p) (MkC b) (MkC ds) = rep2 valName [p, b, ds]
+repVal :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
+repVal (MkC p) (MkC b) (MkC ds) = rep2 valDName [p, b, ds]
 
-repFun :: Core String -> Core [M.Clse] -> DsM (Core M.Decl)  
-repFun (MkC nm) (MkC b) = rep2 funName [nm, b]
+repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)  
+repFun (MkC nm) (MkC b) = rep2 funDName [nm, b]
 
-repData :: Core String -> Core [String] -> Core [M.Cons] -> Core [String] -> DsM (Core M.Decl)
-repData (MkC nm) (MkC tvs) (MkC cons) (MkC derivs) = rep2 dataDName [nm, tvs, cons, derivs]
+repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core [TH.ConQ] -> Core [TH.Name] -> DsM (Core TH.DecQ)
+repData (MkC cxt) (MkC nm) (MkC tvs) (MkC cons) (MkC derivs)
+    = rep2 dataDName [cxt, nm, tvs, cons, derivs]
 
-repTySyn :: Core String -> Core [String] -> Core M.Type -> DsM (Core M.Decl)
+repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core TH.ConQ -> Core [TH.Name] -> DsM (Core TH.DecQ)
+repNewtype (MkC cxt) (MkC nm) (MkC tvs) (MkC con) (MkC derivs)
+    = rep2 newtypeDName [cxt, nm, tvs, con, derivs]
+
+repTySyn :: Core TH.Name -> Core [TH.Name] -> Core TH.TypeQ -> DsM (Core TH.DecQ)
 repTySyn (MkC nm) (MkC tvs) (MkC rhs) = rep2 tySynDName [nm, tvs, rhs]
 
-repInst :: Core M.Ctxt -> Core M.Type -> Core [M.Decl] -> DsM (Core M.Decl)
-repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instName [cxt, ty, ds]
+repInst :: Core TH.CxtQ -> Core TH.TypeQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
+repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instanceDName [cxt, ty, ds]
+
+repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core [TH.FunDep] -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
+repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds) = rep2 classDName [cxt, cls, tvs, fds, ds]
 
-repClass :: Core M.Ctxt -> Core String -> Core [String] -> Core [M.Decl] -> DsM (Core M.Decl)
-repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC ds) = rep2 classDName [cxt, cls, tvs, ds]
+repFunDep :: Core [TH.Name] -> Core [TH.Name] -> DsM (Core TH.FunDep)
+repFunDep (MkC xs) (MkC ys) = rep2 funDepName [xs, ys]
 
-repProto :: Core String -> Core M.Type -> DsM (Core M.Decl)
-repProto (MkC s) (MkC ty) = rep2 protoName [s, ty]
+repProto :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
+repProto (MkC s) (MkC ty) = rep2 sigDName [s, ty]
 
-repCtxt :: Core [M.Type] -> DsM (Core M.Ctxt)
-repCtxt (MkC tys) = rep2 ctxtName [tys]
+repCtxt :: Core [TH.TypeQ] -> DsM (Core TH.CxtQ)
+repCtxt (MkC tys) = rep2 cxtName [tys]
 
-repConstr :: Core String -> HsConDetails Name (BangType Name)
-          -> DsM (Core M.Cons)
+repConstr :: Core TH.Name -> HsConDetails Name (LBangType Name)
+          -> DsM (Core TH.ConQ)
 repConstr con (PrefixCon ps)
     = do arg_tys  <- mapM repBangTy ps
-         arg_tys1 <- coreList strTypeTyConName arg_tys
-         rep2 constrName [unC con, unC arg_tys1]
+         arg_tys1 <- coreList strictTypeQTyConName arg_tys
+         rep2 normalCName [unC con, unC arg_tys1]
 repConstr con (RecCon ips)
-    = do arg_vs   <- mapM lookupOcc (map fst ips)
+    = do arg_vs   <- mapM lookupLOcc (map fst ips)
          arg_tys  <- mapM repBangTy (map snd ips)
          arg_vtys <- zipWithM (\x y -> rep2 varStrictTypeName [unC x, unC y])
                               arg_vs arg_tys
-         arg_vtys' <- coreList varStrTypeTyConName arg_vtys
-         rep2 recConstrName [unC con, unC arg_vtys']
+         arg_vtys' <- coreList varStrictTypeQTyConName arg_vtys
+         rep2 recCName [unC con, unC arg_vtys']
 repConstr con (InfixCon st1 st2)
     = do arg1 <- repBangTy st1
          arg2 <- repBangTy st2
-         rep2 infixConstrName [unC arg1, unC con, unC arg2]
+         rep2 infixCName [unC arg1, unC con, unC arg2]
 
 ------------ Types -------------------
 
-repTForall :: Core [String] -> Core M.Ctxt -> Core M.Type -> DsM (Core M.Type)
-repTForall (MkC tvars) (MkC ctxt) (MkC ty) = rep2 tforallName [tvars, ctxt, ty]
+repTForall :: Core [TH.Name] -> Core TH.CxtQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
+repTForall (MkC tvars) (MkC ctxt) (MkC ty)
+    = rep2 forallTName [tvars, ctxt, ty]
 
-repTvar :: Core String -> DsM (Core M.Type)
-repTvar (MkC s) = rep2 tvarName [s]
+repTvar :: Core TH.Name -> DsM (Core TH.TypeQ)
+repTvar (MkC s) = rep2 varTName [s]
 
-repTapp :: Core M.Type -> Core M.Type -> DsM (Core M.Type)
-repTapp (MkC t1) (MkC t2) = rep2 tappName [t1,t2]
+repTapp :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
+repTapp (MkC t1) (MkC t2) = rep2 appTName [t1,t2]
 
-repTapps :: Core M.Type -> [Core M.Type] -> DsM (Core M.Type)
+repTapps :: Core TH.TypeQ -> [Core TH.TypeQ] -> DsM (Core TH.TypeQ)
 repTapps f []     = return f
 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
 
 --------- Type constructors --------------
 
-repNamedTyCon :: Core String -> DsM (Core M.Type)
-repNamedTyCon (MkC s) = rep2 namedTyConName [s]
+repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
+repNamedTyCon (MkC s) = rep2 conTName [s]
 
-repTupleTyCon :: Int -> DsM (Core M.Type)
+repTupleTyCon :: Int -> DsM (Core TH.TypeQ)
 -- Note: not Core Int; it's easier to be direct here
-repTupleTyCon i = rep2 tupleTyConName [mkIntExpr (fromIntegral i)]
+repTupleTyCon i = rep2 tupleTName [mkIntExpr (fromIntegral i)]
 
-repArrowTyCon :: DsM (Core M.Type)
-repArrowTyCon = rep2 arrowTyConName []
+repArrowTyCon :: DsM (Core TH.TypeQ)
+repArrowTyCon = rep2 arrowTName []
 
-repListTyCon :: DsM (Core M.Type)
-repListTyCon = rep2 listTyConName []
+repListTyCon :: DsM (Core TH.TypeQ)
+repListTyCon = rep2 listTName []
 
 
 ----------------------------------------------------------
 --		Literals
 
-repLiteral :: HsLit -> DsM (Core M.Lit)
+repLiteral :: HsLit -> DsM (Core TH.Lit)
 repLiteral lit 
-  = do { lit_expr <- dsLit lit; rep2 lit_name [lit_expr] }
+  = do lit' <- case lit of
+                   HsIntPrim i    -> mk_integer i
+                   HsInt i        -> mk_integer i
+                   HsFloatPrim r  -> mk_rational r
+                   HsDoublePrim r -> mk_rational r
+                   _ -> return lit
+       lit_expr <- dsLit lit'
+       rep2 lit_name [lit_expr]
   where
     lit_name = case lit of
-		 HsInteger _ -> integerLName
-		 HsChar _    -> charLName
-		 HsString _  -> stringLName
-		 HsRat _ _   -> rationalLName
-		 other 	     -> uh_oh
+		 HsInteger _ _  -> integerLName
+		 HsInt     _    -> integerLName
+		 HsIntPrim _    -> intPrimLName
+		 HsFloatPrim _  -> floatPrimLName
+		 HsDoublePrim _ -> doublePrimLName
+		 HsChar _       -> charLName
+		 HsString _     -> stringLName
+		 HsRat _ _      -> rationalLName
+		 other 	        -> uh_oh
     uh_oh = pprPanic "DsMeta.repLiteral: trying to represent exotic literal"
 		    (ppr lit)
 
-repOverloadedLiteral :: HsOverLit -> DsM (Core M.Lit)
-repOverloadedLiteral (HsIntegral i _)   = repLiteral (HsInteger i)
-repOverloadedLiteral (HsFractional f _) = do { rat_ty <- lookupType rationalTyConName ;
-					       repLiteral (HsRat f rat_ty) }
+mk_integer  i = do integer_ty <- lookupType integerTyConName
+                   return $ HsInteger i integer_ty
+mk_rational r = do rat_ty <- lookupType rationalTyConName
+                   return $ HsRat r rat_ty
+
+repOverloadedLiteral :: HsOverLit -> DsM (Core TH.Lit)
+repOverloadedLiteral (HsIntegral i _)   = do { lit <- mk_integer  i; repLiteral lit }
+repOverloadedLiteral (HsFractional f _) = do { lit <- mk_rational f; repLiteral lit }
 	-- The type Rational will be in the environment, becuase 
-	-- the smart constructor 'THSyntax.rationalL' uses it in its type,
+	-- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
 	-- and rationalL is sucked in when any TH stuff is used
               
 --------------- Miscellaneous -------------------
 
-repLift :: Core e -> DsM (Core M.Expr)
-repLift (MkC x) = rep2 liftName [x]
-
-repGensym :: Core String -> DsM (Core (M.Q String))
-repGensym (MkC lit_str) = rep2 gensymName [lit_str]
+repGensym :: Core String -> DsM (Core (TH.Q TH.Name))
+repGensym (MkC lit_str) = rep2 newNameName [lit_str]
 
 repBindQ :: Type -> Type	-- a and b
-	 -> Core (M.Q a) -> Core (a -> M.Q b) -> DsM (Core (M.Q b))
+	 -> Core (TH.Q a) -> Core (a -> TH.Q b) -> DsM (Core (TH.Q b))
 repBindQ ty_a ty_b (MkC x) (MkC y) 
   = rep2 bindQName [Type ty_a, Type ty_b, x, y] 
 
-repSequenceQ :: Type -> Core [M.Q a] -> DsM (Core (M.Q [a]))
+repSequenceQ :: Type -> Core [TH.Q a] -> DsM (Core (TH.Q [a]))
 repSequenceQ ty_a (MkC list)
   = rep2 sequenceQName [Type ty_a, list]
 
@@ -1116,9 +1299,12 @@ corePair :: (Core a, Core b) -> Core (a,b)
 corePair (MkC x, MkC y) = MkC (mkCoreTup [x,y])
 
 coreStringLit :: String -> DsM (Core String)
-coreStringLit s = do { z <- mkStringLit s; return(MkC z) }
+coreStringLit s = do { z <- mkStringExpr s; return(MkC z) }
+
+coreIntLit :: Int -> DsM (Core Int)
+coreIntLit i = return (MkC (mkIntExpr (fromIntegral i)))
 
-coreVar :: Id -> Core String	-- The Id has type String
+coreVar :: Id -> Core TH.Name	-- The Id has type Name
 coreVar id = MkC (Var id)
 
 
@@ -1135,257 +1321,418 @@ coreVar id = MkC (Var id)
 --  2) Make a "Name"
 --  3) Add the name to knownKeyNames
 
-templateHaskellNames :: NameSet
+templateHaskellNames :: [Name]
 -- The names that are implicitly mentioned by ``bracket''
 -- Should stay in sync with the import list of DsMeta
-templateHaskellNames
-  = mkNameSet [ integerLName,charLName, stringLName, rationalLName,
-		plitName, pvarName, ptupName, 
-		pconName, ptildeName, paspatName, pwildName, 
-                varName, conName, litName, appName, infixEName, lamName,
-                tupName, doEName, compName, 
-                listExpName, sigExpName, condName, letEName, caseEName,
-                infixAppName, sectionLName, sectionRName,
-                guardedName, normalName, 
-		bindStName, letStName, noBindStName, parStName,
-		fromName, fromThenName, fromToName, fromThenToName,
-		funName, valName, liftName,
-	  	gensymName, returnQName, bindQName, sequenceQName,
-		matchName, clauseName, funName, valName, tySynDName, dataDName, classDName,
-		instName, protoName, tforallName, tvarName, tconName, tappName,
-		arrowTyConName, tupleTyConName, listTyConName, namedTyConName,
-		ctxtName, constrName, recConstrName, infixConstrName,
-		exprTyConName, declTyConName, pattTyConName, mtchTyConName, 
-		clseTyConName, stmtTyConName, consTyConName, typeTyConName,
-        strTypeTyConName, varStrTypeTyConName,
-		qTyConName, expTyConName, matTyConName, clsTyConName,
-		decTyConName, typTyConName, strictTypeName, varStrictTypeName,
-        strictName, nonstrictName ]
-
-
-varQual  = mk_known_key_name OccName.varName
-tcQual   = mk_known_key_name OccName.tcName
-
-thModule :: Module
--- NB: the THSyntax module comes from the "haskell-src" package
-thModule = mkThPkgModule mETA_META_Name
-
-mk_known_key_name space str uniq 
-  = mkKnownKeyExternalName thModule (mkOccFS space str) uniq 
-
-integerLName   = varQual FSLIT("integerL")      integerLIdKey
-charLName      = varQual FSLIT("charL")         charLIdKey
-stringLName    = varQual FSLIT("stringL")       stringLIdKey
-rationalLName  = varQual FSLIT("rationalL")     rationalLIdKey
-plitName       = varQual FSLIT("plit")          plitIdKey
-pvarName       = varQual FSLIT("pvar")          pvarIdKey
-ptupName       = varQual FSLIT("ptup")          ptupIdKey
-pconName       = varQual FSLIT("pcon")          pconIdKey
-ptildeName     = varQual FSLIT("ptilde")        ptildeIdKey
-paspatName     = varQual FSLIT("paspat")        paspatIdKey
-pwildName      = varQual FSLIT("pwild")         pwildIdKey
-varName        = varQual FSLIT("var")           varIdKey
-conName        = varQual FSLIT("con")           conIdKey
-litName        = varQual FSLIT("lit")           litIdKey
-appName        = varQual FSLIT("app")           appIdKey
-infixEName     = varQual FSLIT("infixE")        infixEIdKey
-lamName        = varQual FSLIT("lam")           lamIdKey
-tupName        = varQual FSLIT("tup")           tupIdKey
-doEName        = varQual FSLIT("doE")           doEIdKey
-compName       = varQual FSLIT("comp")          compIdKey
-listExpName    = varQual FSLIT("listExp")       listExpIdKey
-sigExpName     = varQual FSLIT("sigExp")        sigExpIdKey
-condName       = varQual FSLIT("cond")          condIdKey
-letEName       = varQual FSLIT("letE")          letEIdKey
-caseEName      = varQual FSLIT("caseE")         caseEIdKey
-infixAppName   = varQual FSLIT("infixApp")      infixAppIdKey
-sectionLName   = varQual FSLIT("sectionL")      sectionLIdKey
-sectionRName   = varQual FSLIT("sectionR")      sectionRIdKey
-guardedName    = varQual FSLIT("guarded")       guardedIdKey
-normalName     = varQual FSLIT("normal")        normalIdKey
-bindStName     = varQual FSLIT("bindSt")        bindStIdKey
-letStName      = varQual FSLIT("letSt")         letStIdKey
-noBindStName   = varQual FSLIT("noBindSt")      noBindStIdKey
-parStName      = varQual FSLIT("parSt")         parStIdKey
-fromName       = varQual FSLIT("from")          fromIdKey
-fromThenName   = varQual FSLIT("fromThen")      fromThenIdKey
-fromToName     = varQual FSLIT("fromTo")        fromToIdKey
-fromThenToName = varQual FSLIT("fromThenTo")    fromThenToIdKey
-liftName       = varQual FSLIT("lift")          liftIdKey
-gensymName     = varQual FSLIT("gensym")        gensymIdKey
-returnQName    = varQual FSLIT("returnQ")       returnQIdKey
-bindQName      = varQual FSLIT("bindQ")         bindQIdKey
-sequenceQName  = varQual FSLIT("sequenceQ")     sequenceQIdKey
-
--- type Mat = ...
-matchName      = varQual FSLIT("match")         matchIdKey
-			 
--- type Cls = ...	 
-clauseName     = varQual FSLIT("clause")        clauseIdKey
-			 
--- data Dec = ...	 
-funName        = varQual FSLIT("fun")           funIdKey
-valName        = varQual FSLIT("val")           valIdKey
-dataDName      = varQual FSLIT("dataD")         dataDIdKey
-tySynDName     = varQual FSLIT("tySynD")        tySynDIdKey
-classDName     = varQual FSLIT("classD")        classDIdKey
-instName       = varQual FSLIT("inst")          instIdKey
-protoName      = varQual FSLIT("proto")         protoIdKey
-			 
--- data Typ = ...	 
-tforallName    = varQual FSLIT("tforall")       tforallIdKey
-tvarName       = varQual FSLIT("tvar")          tvarIdKey
-tconName       = varQual FSLIT("tcon")          tconIdKey
-tappName       = varQual FSLIT("tapp")          tappIdKey
-			 
--- data Tag = ...	 
-arrowTyConName = varQual FSLIT("arrowTyCon")    arrowIdKey
-tupleTyConName = varQual FSLIT("tupleTyCon")    tupleIdKey
-listTyConName  = varQual FSLIT("listTyCon")     listIdKey
-namedTyConName = varQual FSLIT("namedTyCon")    namedTyConIdKey
+
+templateHaskellNames = [
+    returnQName, bindQName, sequenceQName, newNameName, liftName,
+    mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameUName, 
+
+    -- Lit
+    charLName, stringLName, integerLName, intPrimLName,
+    floatPrimLName, doublePrimLName, rationalLName,
+    -- Pat
+    litPName, varPName, tupPName, conPName, tildePName, infixPName,
+    asPName, wildPName, recPName, listPName, sigPName,
+    -- FieldPat
+    fieldPatName,
+    -- Match
+    matchName,
+    -- Clause
+    clauseName,
+    -- Exp
+    varEName, conEName, litEName, appEName, infixEName,
+    infixAppName, sectionLName, sectionRName, lamEName, tupEName,
+    condEName, letEName, caseEName, doEName, compEName,
+    fromEName, fromThenEName, fromToEName, fromThenToEName,
+    listEName, sigEName, recConEName, recUpdEName,
+    -- FieldExp
+    fieldExpName,
+    -- Body
+    guardedBName, normalBName,
+    -- Guard
+    normalGEName, patGEName,
+    -- Stmt
+    bindSName, letSName, noBindSName, parSName,
+    -- Dec
+    funDName, valDName, dataDName, newtypeDName, tySynDName,
+    classDName, instanceDName, sigDName, forImpDName,
+    -- Cxt
+    cxtName,
+    -- Strict
+    isStrictName, notStrictName,
+    -- Con
+    normalCName, recCName, infixCName, forallCName,
+    -- StrictType
+    strictTypeName,
+    -- VarStrictType
+    varStrictTypeName,
+    -- Type
+    forallTName, varTName, conTName, appTName,
+    tupleTName, arrowTName, listTName,
+    -- Callconv
+    cCallName, stdCallName,
+    -- Safety
+    unsafeName,
+    safeName,
+    threadsafeName,
+    -- FunDep
+    funDepName,
+
+    -- And the tycons
+    qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,
+    clauseQTyConName, expQTyConName, fieldExpTyConName, stmtQTyConName,
+    decQTyConName, conQTyConName, strictTypeQTyConName,
+    varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
+    typeTyConName, matchTyConName, clauseTyConName, patQTyConName,
+    fieldPatQTyConName, fieldExpQTyConName, funDepTyConName]
+
+tH_SYN_Name = mkModuleName "Language.Haskell.TH.Syntax"
+tH_LIB_Name = mkModuleName "Language.Haskell.TH.Lib"
+
+thSyn :: Module
+-- NB: the TH.Syntax module comes from the "template-haskell" package
+thSyn = mkModule thPackage  tH_SYN_Name
+thLib = mkModule thPackage  tH_LIB_Name
+
+mk_known_key_name mod space str uniq 
+  = mkExternalName uniq mod (mkOccFS space str) 
+	           Nothing noSrcLoc
+
+libFun = mk_known_key_name thLib OccName.varName
+libTc  = mk_known_key_name thLib OccName.tcName
+thFun  = mk_known_key_name thSyn OccName.varName
+thTc   = mk_known_key_name thSyn OccName.tcName
+
+-------------------- TH.Syntax -----------------------
+qTyConName        = thTc FSLIT("Q")            qTyConKey
+nameTyConName     = thTc FSLIT("Name")         nameTyConKey
+fieldExpTyConName = thTc FSLIT("FieldExp")     fieldExpTyConKey
+patTyConName      = thTc FSLIT("Pat")          patTyConKey
+fieldPatTyConName = thTc FSLIT("FieldPat")     fieldPatTyConKey
+expTyConName      = thTc FSLIT("Exp")          expTyConKey
+decTyConName      = thTc FSLIT("Dec")          decTyConKey
+typeTyConName     = thTc FSLIT("Type")         typeTyConKey
+matchTyConName    = thTc FSLIT("Match")        matchTyConKey
+clauseTyConName   = thTc FSLIT("Clause")       clauseTyConKey
+funDepTyConName   = thTc FSLIT("FunDep")       funDepTyConKey
+
+returnQName   = thFun FSLIT("returnQ")   returnQIdKey
+bindQName     = thFun FSLIT("bindQ")     bindQIdKey
+sequenceQName = thFun FSLIT("sequenceQ") sequenceQIdKey
+newNameName    = thFun FSLIT("newName")   newNameIdKey
+liftName      = thFun FSLIT("lift")      liftIdKey
+mkNameName     = thFun FSLIT("mkName")     mkNameIdKey
+mkNameG_vName  = thFun FSLIT("mkNameG_v")  mkNameG_vIdKey
+mkNameG_dName  = thFun FSLIT("mkNameG_d")  mkNameG_dIdKey
+mkNameG_tcName = thFun FSLIT("mkNameG_tc") mkNameG_tcIdKey
+mkNameUName    = thFun FSLIT("mkNameU")    mkNameUIdKey
+
+
+-------------------- TH.Lib -----------------------
+-- data Lit = ...
+charLName       = libFun FSLIT("charL")       charLIdKey
+stringLName     = libFun FSLIT("stringL")     stringLIdKey
+integerLName    = libFun FSLIT("integerL")    integerLIdKey
+intPrimLName    = libFun FSLIT("intPrimL")    intPrimLIdKey
+floatPrimLName  = libFun FSLIT("floatPrimL")  floatPrimLIdKey
+doublePrimLName = libFun FSLIT("doublePrimL") doublePrimLIdKey
+rationalLName   = libFun FSLIT("rationalL")     rationalLIdKey
+
+-- data Pat = ...
+litPName   = libFun FSLIT("litP")   litPIdKey
+varPName   = libFun FSLIT("varP")   varPIdKey
+tupPName   = libFun FSLIT("tupP")   tupPIdKey
+conPName   = libFun FSLIT("conP")   conPIdKey
+infixPName = libFun FSLIT("infixP") infixPIdKey
+tildePName = libFun FSLIT("tildeP") tildePIdKey
+asPName    = libFun FSLIT("asP")    asPIdKey
+wildPName  = libFun FSLIT("wildP")  wildPIdKey
+recPName   = libFun FSLIT("recP")   recPIdKey
+listPName  = libFun FSLIT("listP")  listPIdKey
+sigPName   = libFun FSLIT("sigP")   sigPIdKey
+
+-- type FieldPat = ...
+fieldPatName = libFun FSLIT("fieldPat") fieldPatIdKey
+
+-- data Match = ...
+matchName = libFun FSLIT("match") matchIdKey
+
+-- data Clause = ...	 
+clauseName = libFun FSLIT("clause") clauseIdKey
+
+-- data Exp = ...
+varEName        = libFun FSLIT("varE")        varEIdKey
+conEName        = libFun FSLIT("conE")        conEIdKey
+litEName        = libFun FSLIT("litE")        litEIdKey
+appEName        = libFun FSLIT("appE")        appEIdKey
+infixEName      = libFun FSLIT("infixE")      infixEIdKey
+infixAppName    = libFun FSLIT("infixApp")    infixAppIdKey
+sectionLName    = libFun FSLIT("sectionL")    sectionLIdKey
+sectionRName    = libFun FSLIT("sectionR")    sectionRIdKey
+lamEName        = libFun FSLIT("lamE")        lamEIdKey
+tupEName        = libFun FSLIT("tupE")        tupEIdKey
+condEName       = libFun FSLIT("condE")       condEIdKey
+letEName        = libFun FSLIT("letE")        letEIdKey
+caseEName       = libFun FSLIT("caseE")       caseEIdKey
+doEName         = libFun FSLIT("doE")         doEIdKey
+compEName       = libFun FSLIT("compE")       compEIdKey
+-- ArithSeq skips a level
+fromEName       = libFun FSLIT("fromE")       fromEIdKey
+fromThenEName   = libFun FSLIT("fromThenE")   fromThenEIdKey
+fromToEName     = libFun FSLIT("fromToE")     fromToEIdKey
+fromThenToEName = libFun FSLIT("fromThenToE") fromThenToEIdKey
+-- end ArithSeq
+listEName       = libFun FSLIT("listE")       listEIdKey
+sigEName        = libFun FSLIT("sigE")        sigEIdKey
+recConEName     = libFun FSLIT("recConE")     recConEIdKey
+recUpdEName     = libFun FSLIT("recUpdE")     recUpdEIdKey
+
+-- type FieldExp = ...
+fieldExpName = libFun FSLIT("fieldExp") fieldExpIdKey
+
+-- data Body = ...
+guardedBName = libFun FSLIT("guardedB") guardedBIdKey
+normalBName  = libFun FSLIT("normalB")  normalBIdKey
+
+-- data Guard = ...
+normalGEName = libFun FSLIT("normalGE") normalGEIdKey
+patGEName    = libFun FSLIT("patGE")    patGEIdKey
+
+-- data Stmt = ...
+bindSName   = libFun FSLIT("bindS")   bindSIdKey
+letSName    = libFun FSLIT("letS")    letSIdKey
+noBindSName = libFun FSLIT("noBindS") noBindSIdKey
+parSName    = libFun FSLIT("parS")    parSIdKey
+
+-- data Dec = ...
+funDName      = libFun FSLIT("funD")      funDIdKey
+valDName      = libFun FSLIT("valD")      valDIdKey
+dataDName     = libFun FSLIT("dataD")     dataDIdKey
+newtypeDName  = libFun FSLIT("newtypeD")  newtypeDIdKey
+tySynDName    = libFun FSLIT("tySynD")    tySynDIdKey
+classDName    = libFun FSLIT("classD")    classDIdKey
+instanceDName = libFun FSLIT("instanceD") instanceDIdKey
+sigDName      = libFun FSLIT("sigD")      sigDIdKey
+forImpDName   = libFun FSLIT("forImpD")   forImpDIdKey
 
 -- type Ctxt = ...
-ctxtName       = varQual FSLIT("ctxt")          ctxtIdKey
-			 
+cxtName = libFun FSLIT("cxt") cxtIdKey
+
+-- data Strict = ...
+isStrictName      = libFun  FSLIT("isStrict")      isStrictKey
+notStrictName     = libFun  FSLIT("notStrict")     notStrictKey
+
 -- data Con = ...	 
-constrName     = varQual FSLIT("constr")        constrIdKey
-recConstrName  = varQual FSLIT("recConstr")     recConstrIdKey
-infixConstrName = varQual FSLIT("infixConstr")  infixConstrIdKey
+normalCName = libFun FSLIT("normalC") normalCIdKey
+recCName    = libFun FSLIT("recC")    recCIdKey
+infixCName  = libFun FSLIT("infixC")  infixCIdKey
+forallCName  = libFun FSLIT("forallC")  forallCIdKey
 			 
-exprTyConName  = tcQual  FSLIT("Expr")  	       exprTyConKey
-declTyConName  = tcQual  FSLIT("Decl")  	       declTyConKey
-pattTyConName  = tcQual  FSLIT("Patt")  	       pattTyConKey
-mtchTyConName  = tcQual  FSLIT("Mtch")  	       mtchTyConKey
-clseTyConName  = tcQual  FSLIT("Clse")  	       clseTyConKey
-stmtTyConName  = tcQual  FSLIT("Stmt") 	       stmtTyConKey
-consTyConName  = tcQual  FSLIT("Cons")  	       consTyConKey
-typeTyConName  = tcQual  FSLIT("Type")  	       typeTyConKey
-strTypeTyConName  = tcQual  FSLIT("StrType")       strTypeTyConKey
-varStrTypeTyConName  = tcQual  FSLIT("VarStrType")       varStrTypeTyConKey
+-- type StrictType = ...
+strictTypeName    = libFun  FSLIT("strictType")    strictTKey
+
+-- type VarStrictType = ...
+varStrictTypeName = libFun  FSLIT("varStrictType") varStrictTKey
+
+-- data Type = ...
+forallTName = libFun FSLIT("forallT") forallTIdKey
+varTName    = libFun FSLIT("varT")    varTIdKey
+conTName    = libFun FSLIT("conT")    conTIdKey
+tupleTName  = libFun FSLIT("tupleT") tupleTIdKey
+arrowTName  = libFun FSLIT("arrowT") arrowTIdKey
+listTName   = libFun FSLIT("listT")  listTIdKey
+appTName    = libFun FSLIT("appT")    appTIdKey
 			 
-qTyConName     = tcQual  FSLIT("Q")  	       qTyConKey
-expTyConName   = tcQual  FSLIT("Exp")  	       expTyConKey
-decTyConName   = tcQual  FSLIT("Dec")  	       decTyConKey
-typTyConName   = tcQual  FSLIT("Typ")  	       typTyConKey
-matTyConName   = tcQual  FSLIT("Mat")  	       matTyConKey
-clsTyConName   = tcQual  FSLIT("Cls")  	       clsTyConKey
-
-strictTypeName = varQual  FSLIT("strictType")   strictTypeKey
-varStrictTypeName = varQual  FSLIT("varStrictType")   varStrictTypeKey
-strictName     = varQual  FSLIT("strict")       strictKey
-nonstrictName  = varQual  FSLIT("nonstrict")    nonstrictKey
-
---	TyConUniques available: 100-119
+-- data Callconv = ...
+cCallName = libFun FSLIT("cCall") cCallIdKey
+stdCallName = libFun FSLIT("stdCall") stdCallIdKey
+
+-- data Safety = ...
+unsafeName     = libFun FSLIT("unsafe") unsafeIdKey
+safeName       = libFun FSLIT("safe") safeIdKey
+threadsafeName = libFun FSLIT("threadsafe") threadsafeIdKey
+             
+-- data FunDep = ...
+funDepName     = libFun FSLIT("funDep") funDepIdKey
+
+matchQTyConName         = libTc FSLIT("MatchQ")        matchQTyConKey
+clauseQTyConName        = libTc FSLIT("ClauseQ")       clauseQTyConKey
+expQTyConName           = libTc FSLIT("ExpQ")          expQTyConKey
+stmtQTyConName          = libTc FSLIT("StmtQ")         stmtQTyConKey
+decQTyConName           = libTc FSLIT("DecQ")          decQTyConKey
+conQTyConName           = libTc FSLIT("ConQ")          conQTyConKey
+strictTypeQTyConName    = libTc FSLIT("StrictTypeQ")    strictTypeQTyConKey
+varStrictTypeQTyConName = libTc FSLIT("VarStrictTypeQ") varStrictTypeQTyConKey
+typeQTyConName          = libTc FSLIT("TypeQ")          typeQTyConKey
+fieldExpQTyConName      = libTc FSLIT("FieldExpQ")      fieldExpQTyConKey
+patQTyConName           = libTc FSLIT("PatQ")           patQTyConKey
+fieldPatQTyConName      = libTc FSLIT("FieldPatQ")      fieldPatQTyConKey
+
+--	TyConUniques available: 100-129
 -- 	Check in PrelNames if you want to change this
 
-expTyConKey  = mkPreludeTyConUnique 100
-matTyConKey  = mkPreludeTyConUnique 101
-clsTyConKey  = mkPreludeTyConUnique 102
-qTyConKey    = mkPreludeTyConUnique 103
-exprTyConKey = mkPreludeTyConUnique 104
-declTyConKey = mkPreludeTyConUnique 105
-pattTyConKey = mkPreludeTyConUnique 106
-mtchTyConKey = mkPreludeTyConUnique 107
-clseTyConKey = mkPreludeTyConUnique 108
-stmtTyConKey = mkPreludeTyConUnique 109
-consTyConKey = mkPreludeTyConUnique 110
-typeTyConKey = mkPreludeTyConUnique 111
-typTyConKey  = mkPreludeTyConUnique 112
-decTyConKey  = mkPreludeTyConUnique 113
-varStrTypeTyConKey = mkPreludeTyConUnique 114
-strTypeTyConKey = mkPreludeTyConUnique 115
-
-
-
--- 	IdUniques available: 200-299
+expTyConKey             = mkPreludeTyConUnique 100
+matchTyConKey           = mkPreludeTyConUnique 101
+clauseTyConKey          = mkPreludeTyConUnique 102
+qTyConKey               = mkPreludeTyConUnique 103
+expQTyConKey            = mkPreludeTyConUnique 104
+decQTyConKey            = mkPreludeTyConUnique 105
+patTyConKey             = mkPreludeTyConUnique 106
+matchQTyConKey          = mkPreludeTyConUnique 107
+clauseQTyConKey         = mkPreludeTyConUnique 108
+stmtQTyConKey           = mkPreludeTyConUnique 109
+conQTyConKey            = mkPreludeTyConUnique 110
+typeQTyConKey           = mkPreludeTyConUnique 111
+typeTyConKey            = mkPreludeTyConUnique 112
+decTyConKey             = mkPreludeTyConUnique 113
+varStrictTypeQTyConKey  = mkPreludeTyConUnique 114
+strictTypeQTyConKey     = mkPreludeTyConUnique 115
+fieldExpTyConKey        = mkPreludeTyConUnique 116
+fieldPatTyConKey        = mkPreludeTyConUnique 117
+nameTyConKey            = mkPreludeTyConUnique 118
+patQTyConKey            = mkPreludeTyConUnique 119
+fieldPatQTyConKey       = mkPreludeTyConUnique 120
+fieldExpQTyConKey       = mkPreludeTyConUnique 121
+funDepTyConKey          = mkPreludeTyConUnique 122
+
+-- 	IdUniques available: 200-399
 -- 	If you want to change this, make sure you check in PrelNames
-fromIdKey       = mkPreludeMiscIdUnique 200
-fromThenIdKey   = mkPreludeMiscIdUnique 201
-fromToIdKey     = mkPreludeMiscIdUnique 202
-fromThenToIdKey = mkPreludeMiscIdUnique 203
-liftIdKey       = mkPreludeMiscIdUnique 204
-gensymIdKey     = mkPreludeMiscIdUnique 205
-returnQIdKey    = mkPreludeMiscIdUnique 206
-bindQIdKey      = mkPreludeMiscIdUnique 207
-funIdKey        = mkPreludeMiscIdUnique 208
-valIdKey        = mkPreludeMiscIdUnique 209
-protoIdKey      = mkPreludeMiscIdUnique 210
-matchIdKey      = mkPreludeMiscIdUnique 211
-clauseIdKey     = mkPreludeMiscIdUnique 212
-integerLIdKey   = mkPreludeMiscIdUnique 213
-charLIdKey      = mkPreludeMiscIdUnique 214
-
-classDIdKey     = mkPreludeMiscIdUnique 215
-instIdKey       = mkPreludeMiscIdUnique 216
-dataDIdKey      = mkPreludeMiscIdUnique 217
-
-sequenceQIdKey  = mkPreludeMiscIdUnique 218
-tySynDIdKey      = mkPreludeMiscIdUnique 219
-
-plitIdKey       = mkPreludeMiscIdUnique 220
-pvarIdKey       = mkPreludeMiscIdUnique 221
-ptupIdKey       = mkPreludeMiscIdUnique 222
-pconIdKey       = mkPreludeMiscIdUnique 223
-ptildeIdKey     = mkPreludeMiscIdUnique 224
-paspatIdKey     = mkPreludeMiscIdUnique 225
-pwildIdKey      = mkPreludeMiscIdUnique 226
-varIdKey        = mkPreludeMiscIdUnique 227
-conIdKey        = mkPreludeMiscIdUnique 228
-litIdKey        = mkPreludeMiscIdUnique 229
-appIdKey        = mkPreludeMiscIdUnique 230
-infixEIdKey     = mkPreludeMiscIdUnique 231
-lamIdKey        = mkPreludeMiscIdUnique 232
-tupIdKey        = mkPreludeMiscIdUnique 233
-doEIdKey        = mkPreludeMiscIdUnique 234
-compIdKey       = mkPreludeMiscIdUnique 235
-listExpIdKey    = mkPreludeMiscIdUnique 237
-condIdKey       = mkPreludeMiscIdUnique 238
-letEIdKey       = mkPreludeMiscIdUnique 239
-caseEIdKey      = mkPreludeMiscIdUnique 240
-infixAppIdKey   = mkPreludeMiscIdUnique 241
--- 242 unallocated
-sectionLIdKey   = mkPreludeMiscIdUnique 243
-sectionRIdKey   = mkPreludeMiscIdUnique 244
-guardedIdKey    = mkPreludeMiscIdUnique 245
-normalIdKey     = mkPreludeMiscIdUnique 246
-bindStIdKey     = mkPreludeMiscIdUnique 247
-letStIdKey      = mkPreludeMiscIdUnique 248
-noBindStIdKey   = mkPreludeMiscIdUnique 249
-parStIdKey      = mkPreludeMiscIdUnique 250
-
-tforallIdKey	= mkPreludeMiscIdUnique 251
-tvarIdKey	= mkPreludeMiscIdUnique 252
-tconIdKey	= mkPreludeMiscIdUnique 253
-tappIdKey	= mkPreludeMiscIdUnique 254
-
-arrowIdKey	= mkPreludeMiscIdUnique 255
-tupleIdKey	= mkPreludeMiscIdUnique 256
-listIdKey	= mkPreludeMiscIdUnique 257
-namedTyConIdKey	= mkPreludeMiscIdUnique 258
-
-ctxtIdKey	= mkPreludeMiscIdUnique 259
-
-constrIdKey	= mkPreludeMiscIdUnique 260
-
-stringLIdKey	= mkPreludeMiscIdUnique 261
-rationalLIdKey	= mkPreludeMiscIdUnique 262
-
-sigExpIdKey     = mkPreludeMiscIdUnique 263
-
-strictTypeKey = mkPreludeMiscIdUnique 264
-strictKey = mkPreludeMiscIdUnique 265
-nonstrictKey = mkPreludeMiscIdUnique 266
-varStrictTypeKey = mkPreludeMiscIdUnique 267
-
-recConstrIdKey	= mkPreludeMiscIdUnique 268
-infixConstrIdKey	= mkPreludeMiscIdUnique 269
 
--- %************************************************************************
--- %*									*
---		Other utilities
--- %*									*
--- %************************************************************************
+returnQIdKey        = mkPreludeMiscIdUnique 200
+bindQIdKey          = mkPreludeMiscIdUnique 201
+sequenceQIdKey      = mkPreludeMiscIdUnique 202
+liftIdKey           = mkPreludeMiscIdUnique 203
+newNameIdKey         = mkPreludeMiscIdUnique 204
+mkNameIdKey          = mkPreludeMiscIdUnique 205
+mkNameG_vIdKey       = mkPreludeMiscIdUnique 206
+mkNameG_dIdKey       = mkPreludeMiscIdUnique 207
+mkNameG_tcIdKey      = mkPreludeMiscIdUnique 208
+mkNameUIdKey         = mkPreludeMiscIdUnique 209
+
+
+-- data Lit = ...
+charLIdKey        = mkPreludeMiscIdUnique 210
+stringLIdKey      = mkPreludeMiscIdUnique 211
+integerLIdKey     = mkPreludeMiscIdUnique 212
+intPrimLIdKey     = mkPreludeMiscIdUnique 213
+floatPrimLIdKey   = mkPreludeMiscIdUnique 214
+doublePrimLIdKey  = mkPreludeMiscIdUnique 215
+rationalLIdKey    = mkPreludeMiscIdUnique 216
+
+-- data Pat = ...
+litPIdKey         = mkPreludeMiscIdUnique 220
+varPIdKey         = mkPreludeMiscIdUnique 221
+tupPIdKey         = mkPreludeMiscIdUnique 222
+conPIdKey         = mkPreludeMiscIdUnique 223
+infixPIdKey       = mkPreludeMiscIdUnique 312
+tildePIdKey       = mkPreludeMiscIdUnique 224
+asPIdKey          = mkPreludeMiscIdUnique 225
+wildPIdKey        = mkPreludeMiscIdUnique 226
+recPIdKey         = mkPreludeMiscIdUnique 227
+listPIdKey        = mkPreludeMiscIdUnique 228
+sigPIdKey         = mkPreludeMiscIdUnique 229
+
+-- type FieldPat = ...
+fieldPatIdKey       = mkPreludeMiscIdUnique 230
+
+-- data Match = ...
+matchIdKey          = mkPreludeMiscIdUnique 231
+
+-- data Clause = ...
+clauseIdKey         = mkPreludeMiscIdUnique 232
+
+-- data Exp = ...
+varEIdKey         = mkPreludeMiscIdUnique 240
+conEIdKey         = mkPreludeMiscIdUnique 241
+litEIdKey         = mkPreludeMiscIdUnique 242
+appEIdKey         = mkPreludeMiscIdUnique 243
+infixEIdKey       = mkPreludeMiscIdUnique 244
+infixAppIdKey       = mkPreludeMiscIdUnique 245
+sectionLIdKey       = mkPreludeMiscIdUnique 246
+sectionRIdKey       = mkPreludeMiscIdUnique 247
+lamEIdKey         = mkPreludeMiscIdUnique 248
+tupEIdKey         = mkPreludeMiscIdUnique 249
+condEIdKey        = mkPreludeMiscIdUnique 250
+letEIdKey         = mkPreludeMiscIdUnique 251
+caseEIdKey        = mkPreludeMiscIdUnique 252
+doEIdKey          = mkPreludeMiscIdUnique 253
+compEIdKey        = mkPreludeMiscIdUnique 254
+fromEIdKey        = mkPreludeMiscIdUnique 255
+fromThenEIdKey    = mkPreludeMiscIdUnique 256
+fromToEIdKey      = mkPreludeMiscIdUnique 257
+fromThenToEIdKey  = mkPreludeMiscIdUnique 258
+listEIdKey        = mkPreludeMiscIdUnique 259
+sigEIdKey         = mkPreludeMiscIdUnique 260
+recConEIdKey      = mkPreludeMiscIdUnique 261
+recUpdEIdKey      = mkPreludeMiscIdUnique 262
+
+-- type FieldExp = ...
+fieldExpIdKey       = mkPreludeMiscIdUnique 265
+
+-- data Body = ...
+guardedBIdKey     = mkPreludeMiscIdUnique 266
+normalBIdKey      = mkPreludeMiscIdUnique 267
+
+-- data Guard = ...
+normalGEIdKey     = mkPreludeMiscIdUnique 310
+patGEIdKey        = mkPreludeMiscIdUnique 311
+
+-- data Stmt = ...
+bindSIdKey       = mkPreludeMiscIdUnique 268
+letSIdKey        = mkPreludeMiscIdUnique 269
+noBindSIdKey     = mkPreludeMiscIdUnique 270
+parSIdKey        = mkPreludeMiscIdUnique 271
+
+-- data Dec = ...
+funDIdKey         = mkPreludeMiscIdUnique 272
+valDIdKey         = mkPreludeMiscIdUnique 273
+dataDIdKey        = mkPreludeMiscIdUnique 274
+newtypeDIdKey     = mkPreludeMiscIdUnique 275
+tySynDIdKey       = mkPreludeMiscIdUnique 276
+classDIdKey       = mkPreludeMiscIdUnique 277
+instanceDIdKey    = mkPreludeMiscIdUnique 278
+sigDIdKey         = mkPreludeMiscIdUnique 279
+forImpDIdKey      = mkPreludeMiscIdUnique 297
+
+-- type Cxt = ...
+cxtIdKey            = mkPreludeMiscIdUnique 280
+
+-- data Strict = ...
+isStrictKey         = mkPreludeMiscIdUnique 281
+notStrictKey        = mkPreludeMiscIdUnique 282
+
+-- data Con = ...
+normalCIdKey      = mkPreludeMiscIdUnique 283
+recCIdKey         = mkPreludeMiscIdUnique 284
+infixCIdKey       = mkPreludeMiscIdUnique 285
+forallCIdKey      = mkPreludeMiscIdUnique 288
+
+-- type StrictType = ...
+strictTKey        = mkPreludeMiscIdUnique 286
+
+-- type VarStrictType = ...
+varStrictTKey     = mkPreludeMiscIdUnique 287
+
+-- data Type = ...
+forallTIdKey      = mkPreludeMiscIdUnique 290
+varTIdKey         = mkPreludeMiscIdUnique 291
+conTIdKey         = mkPreludeMiscIdUnique 292
+tupleTIdKey       = mkPreludeMiscIdUnique 294
+arrowTIdKey       = mkPreludeMiscIdUnique 295
+listTIdKey        = mkPreludeMiscIdUnique 296
+appTIdKey         = mkPreludeMiscIdUnique 293
+
+-- data Callconv = ...
+cCallIdKey      = mkPreludeMiscIdUnique 300
+stdCallIdKey    = mkPreludeMiscIdUnique 301
+
+-- data Safety = ...
+unsafeIdKey     = mkPreludeMiscIdUnique 305
+safeIdKey       = mkPreludeMiscIdUnique 306
+threadsafeIdKey = mkPreludeMiscIdUnique 307
+
+-- data FunDep = ...
+funDepIdKey = mkPreludeMiscIdUnique 320
 
--- It is rather usatisfactory that we don't have a SrcLoc
-addDsWarn :: SDoc -> DsM ()
-addDsWarn msg = dsWarn (noSrcLoc, msg)