X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnTypes.lhs;h=be90d7d0a99760447e7e54073c07e962abbbeb91;hp=cb60b934d2907c1f387706be0f4886c74b63e237;hb=cbd7463c986d54422de15cb3b56184de116ef7ba;hpb=354d1eb692be9fa5683dab82258062ebc61fdb2d

diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index cb60b93..be90d7d 100644
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -7,7 +7,7 @@
 module RnTypes ( 
 	-- Type related stuff
 	rnHsType, rnLHsType, rnLHsTypes, rnContext,
-	rnHsSigType, rnHsTypeFVs, rnConDeclFields,
+	rnHsSigType, rnHsTypeFVs, rnConDeclFields, rnLPred,
 
 	-- Precence related stuff
 	mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,
@@ -18,6 +18,9 @@ module RnTypes (
   ) where
 
 import {-# SOURCE #-} RnExpr( rnLExpr )
+#ifdef GHCI
+import {-# SOURCE #-} TcSplice( runQuasiQuoteType )
+#endif 	/* GHCI */
 
 import DynFlags
 import HsSyn
@@ -28,7 +31,7 @@ import RnEnv
 import TcRnMonad
 import RdrName
 import PrelNames
-import TypeRep		( funTyConName )
+import TysPrim          ( funTyConName )
 import Name
 import SrcLoc
 import NameSet
@@ -113,7 +116,7 @@ rnHsType _ (HsTyVar tyvar) = do
 -- Hence the jiggery pokery with ty1
 rnHsType doc ty@(HsOpTy ty1 (L loc op) ty2)
   = setSrcSpan loc $ 
-    do	{ ops_ok <- doptM Opt_TypeOperators
+    do	{ ops_ok <- xoptM Opt_TypeOperators
 	; op' <- if ops_ok
 		 then lookupOccRn op 
 		 else do { addErr (opTyErr op ty)
@@ -136,13 +139,6 @@ rnHsType doc (HsRecTy flds)
   = do { flds' <- rnConDeclFields doc flds
        ; return (HsRecTy flds') }
 
-rnHsType _ (HsNumTy i)
-  | i == 1    = return (HsNumTy i)
-  | otherwise = addErr err_msg >> return (HsNumTy i)
-  where
-    err_msg = ptext (sLit "Only unit numeric type pattern is valid")
-			   
-
 rnHsType doc (HsFunTy ty1 ty2) = do
     ty1' <- rnLHsType doc ty1
 	-- Might find a for-all as the arg of a function type
@@ -158,7 +154,7 @@ rnHsType doc (HsListTy ty) = do
     return (HsListTy ty')
 
 rnHsType doc (HsKindSig ty k)
-  = do { kind_sigs_ok <- doptM Opt_KindSignatures
+  = do { kind_sigs_ok <- xoptM Opt_KindSignatures
        ; unless kind_sigs_ok (addErr (kindSigErr ty))
        ; ty' <- rnLHsType doc ty
        ; return (HsKindSig ty' k) }
@@ -182,17 +178,24 @@ rnHsType doc (HsPredTy pred) = do
     pred' <- rnPred doc pred
     return (HsPredTy pred')
 
-rnHsType _ (HsSpliceTy sp)
-  = do { (sp', _fvs) <- rnSplice sp	-- ToDo: deal with fvs
-       ; return (HsSpliceTy sp') }
+rnHsType _ (HsSpliceTy sp _ k)
+  = do { (sp', fvs) <- rnSplice sp	-- ToDo: deal with fvs
+       ; return (HsSpliceTy sp' fvs k) }
 
 rnHsType doc (HsDocTy ty haddock_doc) = do
     ty' <- rnLHsType doc ty
     haddock_doc' <- rnLHsDoc haddock_doc
     return (HsDocTy ty' haddock_doc')
 
-rnHsType _ (HsSpliceTyOut {}) = panic "rnHsType"
+#ifndef GHCI
+rnHsType _ ty@(HsQuasiQuoteTy _) = pprPanic "Can't do quasiquotation without GHCi" (ppr ty)
+#else
+rnHsType doc (HsQuasiQuoteTy qq) = do { ty <- runQuasiQuoteType qq
+                                      ; rnHsType doc (unLoc ty) }
+#endif
+rnHsType _ (HsCoreTy ty) = return (HsCoreTy ty)
 
+--------------
 rnLHsTypes :: SDoc -> [LHsType RdrName]
            -> IOEnv (Env TcGblEnv TcLclEnv) [LHsType Name]
 rnLHsTypes doc tys = mapM (rnLHsType doc) tys
@@ -200,7 +203,7 @@ rnLHsTypes doc tys = mapM (rnLHsType doc) tys
 
 
 \begin{code}
-rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName]
+rnForAll :: SDoc -> HsExplicitFlag -> [LHsTyVarBndr RdrName]
 	 -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
 
 rnForAll doc _ [] (L _ []) (L _ ty) = rnHsType doc ty
@@ -560,7 +563,7 @@ ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity)
 forAllWarn :: SDoc -> LHsType RdrName -> Located RdrName
            -> TcRnIf TcGblEnv TcLclEnv ()
 forAllWarn doc ty (L loc tyvar)
-  = ifOptM Opt_WarnUnusedMatches 	$
+  = ifDOptM Opt_WarnUnusedMatches 	$
     addWarnAt loc (sep [ptext (sLit "The universally quantified type variable") <+> quotes (ppr tyvar),
 		 	nest 4 (ptext (sLit "does not appear in the type") <+> quotes (ppr ty))]
 		   $$