module RnTypes (
-- Type related stuff
rnHsType, rnLHsType, rnLHsTypes, rnContext,
- rnHsSigType, rnHsTypeFVs,
+ rnHsSigType, rnHsTypeFVs, rnConDeclFields,
-- Precence related stuff
mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,
) where
import {-# SOURCE #-} RnExpr( rnLExpr )
+#ifdef GHCI
+import {-# SOURCE #-} TcSplice( runQuasiQuoteType )
+#endif /* GHCI */
import DynFlags
import HsSyn
import RdrHsSyn ( extractHsRhoRdrTyVars )
import RnHsSyn ( extractHsTyNames )
-import RnHsDoc ( rnLHsDoc )
+import RnHsDoc ( rnLHsDoc, rnMbLHsDoc )
import RnEnv
import TcRnMonad
import RdrName
ty' <- rnLHsType doc ty
return (HsParTy ty')
-rnHsType doc (HsBangTy b ty) = do
- ty' <- rnLHsType doc ty
- return (HsBangTy b ty')
+rnHsType doc (HsBangTy b ty)
+ = do { ty' <- rnLHsType doc ty
+ ; return (HsBangTy b ty') }
+
+rnHsType doc (HsRecTy flds)
+ = do { flds' <- rnConDeclFields doc flds
+ ; return (HsRecTy flds') }
rnHsType _ (HsNumTy i)
| i == 1 = return (HsNumTy i)
rnHsType doc (HsKindSig ty k)
= do { kind_sigs_ok <- doptM Opt_KindSignatures
- ; checkM kind_sigs_ok (addErr (kindSigErr ty))
+ ; unless kind_sigs_ok (addErr (kindSigErr ty))
; ty' <- rnLHsType doc ty
; return (HsKindSig ty' k) }
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')
+#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
+
rnLHsTypes :: SDoc -> [LHsType RdrName]
-> IOEnv (Env TcGblEnv TcLclEnv) [LHsType Name]
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
-- of kind *.
rnForAll doc exp forall_tyvars ctxt ty
- = bindTyVarsRn doc forall_tyvars $ \ new_tyvars -> do
+ = bindTyVarsRn forall_tyvars $ \ new_tyvars -> do
new_ctxt <- rnContext doc ctxt
new_ty <- rnLHsType doc ty
return (HsForAllTy exp new_tyvars new_ctxt new_ty)
-- Retain the same implicit/explicit flag as before
-- so that we can later print it correctly
+
+rnConDeclFields :: SDoc -> [ConDeclField RdrName] -> RnM [ConDeclField Name]
+rnConDeclFields doc fields = mapM (rnField doc) fields
+
+rnField :: SDoc -> ConDeclField RdrName -> RnM (ConDeclField Name)
+rnField doc (ConDeclField name ty haddock_doc)
+ = do { new_name <- lookupLocatedTopBndrRn name
+ ; new_ty <- rnLHsType doc ty
+ ; new_haddock_doc <- rnMbLHsDoc haddock_doc
+ ; return (ConDeclField new_name new_ty new_haddock_doc) }
\end{code}
%*********************************************************
not_op_pat _ = True
--------------------------------------
-checkPrecMatch :: Bool -> Name -> MatchGroup Name -> RnM ()
- -- True indicates an infix lhs
- -- See comments with rnExpr (OpApp ...) about "deriving"
+checkPrecMatch :: Name -> MatchGroup Name -> RnM ()
+ -- Check precedence of a function binding written infix
+ -- eg a `op` b `C` c = ...
+ -- See comments with rnExpr (OpApp ...) about "deriving"
-checkPrecMatch False _ _
- = return ()
-checkPrecMatch True op (MatchGroup ms _)
+checkPrecMatch op (MatchGroup ms _)
= mapM_ check ms
where
- check (L _ (Match (p1:p2:_) _ _))
- = do checkPrec op (unLoc p1) False
- checkPrec op (unLoc p2) True
+ check (L _ (Match (L l1 p1 : L l2 p2 :_) _ _))
+ = setSrcSpan (combineSrcSpans l1 l2) $
+ do checkPrec op p1 False
+ checkPrec op p2 True
check _ = return ()
-- This can happen. Consider
rnSplice (HsSplice n expr)
= do { checkTH expr "splice"
; loc <- getSrcSpanM
- ; [n'] <- newLocalsRn [L loc n]
+ ; n' <- newLocalBndrRn (L loc n)
; (expr', fvs) <- rnLExpr expr
-- Ugh! See Note [Splices] above