X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Ftypecheck%2FTcSplice.lhs;h=0bdcbbdc6d8bca8cabda330514edee078c9e210b;hb=7583384214ed6aa4a90d77c5975728a9b06149f2;hp=0ce334a5c67956e48349f4d108edcf2f4f7a3ba1;hpb=9bcd95bad83ee937c178970e8b729732e680fe1e;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index 0ce334a..0bdcbbd 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -381,7 +381,6 @@ runAnnotation target expr = do
     expr_ty <- newFlexiTyVarTy liftedTypeKind
     
     -- Find the classes we want instances for in order to call toAnnotationWrapper
-    typeable_class <- tcLookupClass typeableClassName
     data_class <- tcLookupClass dataClassName
     
     -- Check the instances we require live in another module (we want to execute it..)
@@ -566,7 +565,7 @@ kcTopSpliceType expr
 	; let doc = ptext (sLit "In the spliced type") <+> ppr hs_ty2
 	; hs_ty3 <- checkNoErrs (rnLHsType doc hs_ty2)
 
-	; kcHsType hs_ty3 }
+	; kcLHsType hs_ty3 }
 \end{code}
 
 %************************************************************************
@@ -826,11 +825,7 @@ lookupThName_maybe th_name
 	     ; rdr_env <- getLocalRdrEnv
   	     ; case lookupLocalRdrEnv rdr_env rdr_name of
 		 Just name -> return (Just name)
-	         Nothing | not (isSrcRdrName rdr_name)	-- Exact, Orig
-		         -> do { name <- lookupImportedName rdr_name
-			       ; return (Just name) }
-		    	 | otherwise			-- Unqual, Qual
-		    	 -> lookupSrcOcc_maybe rdr_name }
+	         Nothing   -> lookupGlobalOccRn_maybe rdr_name }
 
 tcLookupTh :: Name -> TcM TcTyThing
 -- This is a specialised version of TcEnv.tcLookup; specialised mainly in that
@@ -877,7 +872,7 @@ reifyThing (AGlobal (AnId id))
   = do	{ ty <- reifyType (idType id)
 	; fix <- reifyFixity (idName id)
 	; let v = reifyName id
-	; case globalIdDetails id of
+	; case idDetails id of
 	    ClassOpId cls    -> return (TH.ClassOpI v ty (reifyName cls) fix)
 	    _                -> return (TH.VarI     v ty Nothing fix)
     }
@@ -923,7 +918,7 @@ reifyTyCon tc
 	      r_tvs  = reifyTyVars tvs
 	      deriv = []	-- Don't know about deriving
 	      decl | isNewTyCon tc = TH.NewtypeD cxt name r_tvs (head cons) deriv
-		   | otherwise	   = TH.DataD    cxt name r_tvs cons 	  deriv
+		   | otherwise	   = TH.DataD    cxt name r_tvs cons 	    deriv
 	; return (TH.TyConI decl) }
 
 reifyDataCon :: [Type] -> DataCon -> TcM TH.Con
@@ -975,7 +970,8 @@ reifyType (PredTy {}) = panic "reifyType PredTy"
 
 reifyTypes :: [Type] -> TcM [TH.Type]
 reifyTypes = mapM reifyType
-reifyCxt :: [PredType] -> TcM [TH.Type]
+
+reifyCxt :: [PredType] -> TcM [TH.Pred]
 reifyCxt   = mapM reifyPred
 
 reifyFunDep :: ([TyVar], [TyVar]) -> TH.FunDep
@@ -988,10 +984,17 @@ reify_tc_app :: TH.Name -> [TypeRep.Type] -> TcM TH.Type
 reify_tc_app tc tys = do { tys' <- reifyTypes tys 
 			 ; return (foldl TH.AppT (TH.ConT tc) tys') }
 
-reifyPred :: TypeRep.PredType -> TcM TH.Type
-reifyPred (ClassP cls tys) = reify_tc_app (reifyName cls) tys
+reifyPred :: TypeRep.PredType -> TcM TH.Pred
+reifyPred (ClassP cls tys) 
+  = do { tys' <- reifyTypes tys 
+       ; return $ TH.ClassP (reifyName cls) tys'
+       }
 reifyPred p@(IParam _ _)   = noTH (sLit "implicit parameters") (ppr p)
-reifyPred (EqPred {})      = panic "reifyPred EqPred"
+reifyPred (EqPred ty1 ty2) 
+  = do { ty1' <- reifyType ty1
+       ; ty2' <- reifyType ty2
+       ; return $ TH.EqualP ty1' ty2'
+       }
 
 
 ------------------------------