import RnBinds ( rnLocalBindsAndThen, rnValBinds,
rnMatchGroup, trimWith )
import HsSyn
-import RnHsSyn
import TcRnMonad
import RnEnv
import HscTypes ( availNames )
-import OccName ( plusOccEnv )
import RnNames ( getLocalDeclBinders, extendRdrEnvRn )
import RnTypes ( rnHsTypeFVs, rnLPat, rnOverLit, rnPatsAndThen, rnLit,
mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec,
- dupFieldErr, checkTupSize )
+ rnHsRecFields, checkTupSize )
import DynFlags ( DynFlag(..) )
import BasicTypes ( FixityDirection(..) )
import SrcLoc ( SrcSpan )
rnExpr (HsVar v)
= do name <- lookupOccRn v
- localRdrEnv <- getLocalRdrEnv
- lclEnv <- getLclEnv
ignore_asserts <- doptM Opt_IgnoreAsserts
- ignore_breakpoints <- doptM Opt_IgnoreBreakpoints
- ghcMode <- getGhcMode
- let conds = [ (name `hasKey` assertIdKey
- && not ignore_asserts,
- do (e, fvs) <- mkAssertErrorExpr
- return (e, fvs `addOneFV` name))
- ]
- case lookup True conds of
- Just action -> action
- Nothing -> return (HsVar name, unitFV name)
+ finish_var ignore_asserts name
+ where
+ finish_var ignore_asserts name
+ | ignore_asserts || not (name `hasKey` assertIdKey)
+ = return (HsVar name, unitFV name)
+ | otherwise
+ = do { (e, fvs) <- mkAssertErrorExpr
+ ; return (e, fvs `addOneFV` name) }
rnExpr (HsIPVar v)
= newIPNameRn v `thenM` \ name ->
returnM (HsIPVar name, emptyFVs)
+rnExpr (HsLit lit@(HsString s))
+ = do {
+ opt_OverloadedStrings <- doptM Opt_OverloadedStrings
+ ; if opt_OverloadedStrings then
+ rnExpr (HsOverLit (mkHsIsString s))
+ else -- Same as below
+ rnLit lit `thenM_`
+ returnM (HsLit lit, emptyFVs)
+ }
+
rnExpr (HsLit lit)
= rnLit lit `thenM_`
returnM (HsLit lit, emptyFVs)
rnExpr (HsSCC lbl expr)
= rnLExpr expr `thenM` \ (expr', fvs_expr) ->
returnM (HsSCC lbl expr', fvs_expr)
+rnExpr (HsTickPragma info expr)
+ = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
+ returnM (HsTickPragma info expr', fvs_expr)
rnExpr (HsLam matches)
= rnMatchGroup LambdaExpr matches `thenM` \ (matches', fvMatch) ->
rnExpr (ExplicitList _ exps)
= rnExprs exps `thenM` \ (exps', fvs) ->
- returnM (ExplicitList placeHolderType exps', fvs `addOneFV` listTyCon_name)
+ returnM (ExplicitList placeHolderType exps', fvs)
rnExpr (ExplicitPArr _ exps)
= rnExprs exps `thenM` \ (exps', fvs) ->
returnM (ExplicitPArr placeHolderType exps', fvs)
rnExpr e@(ExplicitTuple exps boxity)
- = checkTupSize tup_size `thenM_`
+ = checkTupSize (length exps) `thenM_`
rnExprs exps `thenM` \ (exps', fvs) ->
- returnM (ExplicitTuple exps' boxity, fvs `addOneFV` tycon_name)
- where
- tup_size = length exps
- tycon_name = tupleTyCon_name boxity tup_size
+ returnM (ExplicitTuple exps' boxity, fvs)
rnExpr (RecordCon con_id _ rbinds)
- = lookupLocatedOccRn con_id `thenM` \ conname ->
- rnRbinds "construction" rbinds `thenM` \ (rbinds', fvRbinds) ->
- returnM (RecordCon conname noPostTcExpr rbinds',
- fvRbinds `addOneFV` unLoc conname)
-
-rnExpr (RecordUpd expr rbinds _ _)
- = rnLExpr expr `thenM` \ (expr', fvExpr) ->
- rnRbinds "update" rbinds `thenM` \ (rbinds', fvRbinds) ->
- returnM (RecordUpd expr' rbinds' placeHolderType placeHolderType,
- fvExpr `plusFV` fvRbinds)
+ = do { conname <- lookupLocatedOccRn con_id
+ ; (rbinds', fvRbinds) <- rnHsRecFields "construction" (Just conname)
+ rnLExpr HsVar rbinds
+ ; return (RecordCon conname noPostTcExpr rbinds',
+ fvRbinds `addOneFV` unLoc conname) }
+
+rnExpr (RecordUpd expr rbinds _ _ _)
+ = do { (expr', fvExpr) <- rnLExpr expr
+ ; (rbinds', fvRbinds) <- rnHsRecFields "update" Nothing rnLExpr HsVar rbinds
+ ; return (RecordUpd expr' rbinds' [] [] [],
+ fvExpr `plusFV` fvRbinds) }
rnExpr (ExprWithTySig expr pty)
= do { (pty', fvTy) <- rnHsTypeFVs doc pty
plusFVs [fvExpr1, fvExpr2, fvExpr3])
\end{code}
-
-%************************************************************************
-%* *
-\subsubsection{@Rbinds@s and @Rpats@s: in record expressions}
-%* *
-%************************************************************************
-
-\begin{code}
-rnRbinds str rbinds
- = mappM_ field_dup_err dup_fields `thenM_`
- mapFvRn rn_rbind rbinds `thenM` \ (rbinds', fvRbind) ->
- returnM (rbinds', fvRbind)
- where
- (_, dup_fields) = removeDups cmpLocated [ f | (f,_) <- rbinds ]
-
- field_dup_err dups = mappM_ (\f -> addLocErr f (dupFieldErr str)) dups
-
- rn_rbind (field, expr)
- = lookupLocatedGlobalOccRn field `thenM` \ fieldname ->
- rnLExpr expr `thenM` \ (expr', fvExpr) ->
- returnM ((fieldname, expr'), fvExpr `addOneFV` unLoc fieldname)
-\end{code}
-
%************************************************************************
%* *
Template Haskell brackets