#endif /* GHCI */
import RnSource ( rnSrcDecls, findSplice )
-import RnBinds ( rnLocalBindsAndThen, rnValBindsLHS, rnValBindsRHS,
+import RnBinds ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,
rnMatchGroup, makeMiniFixityEnv)
import HsSyn
import TcRnMonad
import RnTypes ( rnHsTypeFVs, rnSplice, checkTH,
mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec)
import RnPat
-import DynFlags ( DynFlag(..) )
+import DynFlags
import BasicTypes ( FixityDirection(..) )
import PrelNames
rnExpr (HsLit lit@(HsString s))
= do {
- opt_OverloadedStrings <- doptM Opt_OverloadedStrings
+ opt_OverloadedStrings <- xoptM Opt_OverloadedStrings
; if opt_OverloadedStrings then
rnExpr (HsOverLit (mkHsIsString s placeHolderType))
else -- Same as below
where
doc = text "In an expression type signature"
-rnExpr (HsIf p b1 b2)
- = rnLExpr p `thenM` \ (p', fvP) ->
- rnLExpr b1 `thenM` \ (b1', fvB1) ->
- rnLExpr b2 `thenM` \ (b2', fvB2) ->
- return (HsIf p' b1' b2', plusFVs [fvP, fvB1, fvB2])
+rnExpr (HsIf _ p b1 b2)
+ = do { (p', fvP) <- rnLExpr p
+ ; (b1', fvB1) <- rnLExpr b1
+ ; (b2', fvB2) <- rnLExpr b2
+ ; rebind <- xoptM Opt_RebindableSyntax
+ ; if not rebind
+ then return (HsIf Nothing p' b1' b2', plusFVs [fvP, fvB1, fvB2])
+ else do { c <- liftM HsVar (lookupOccRn (mkVarUnqual (fsLit "ifThenElse")))
+ ; return (HsIf (Just c) p' b1' b2', plusFVs [fvP, fvB1, fvB2]) }}
rnExpr (HsType a)
= rnHsTypeFVs doc a `thenM` \ (t, fvT) ->
-- infix form
rnExpr (HsArrForm op (Just _) [arg1, arg2])
= escapeArrowScope (rnLExpr op)
- `thenM` \ (op'@(L _ (HsVar op_name)),fv_op) ->
+ `thenM` \ (op',fv_op) ->
+ let L _ (HsVar op_name) = op' in
rnCmdTop arg1 `thenM` \ (arg1',fv_arg1) ->
rnCmdTop arg2 `thenM` \ (arg2',fv_arg2) ->
convertOpFormsCmd (HsCase exp matches)
= HsCase exp (convertOpFormsMatch matches)
-convertOpFormsCmd (HsIf exp c1 c2)
- = HsIf exp (convertOpFormsLCmd c1) (convertOpFormsLCmd c2)
+convertOpFormsCmd (HsIf f exp c1 c2)
+ = HsIf f exp (convertOpFormsLCmd c1) (convertOpFormsLCmd c2)
convertOpFormsCmd (HsLet binds cmd)
= HsLet binds (convertOpFormsLCmd cmd)
methodNamesCmd (HsPar c) = methodNamesLCmd c
-methodNamesCmd (HsIf _ c1 c2)
+methodNamesCmd (HsIf _ _ c1 c2)
= methodNamesLCmd c1 `plusFV` methodNamesLCmd c2 `addOneFV` choiceAName
methodNamesCmd (HsLet _ c) = methodNamesLCmd c
= do { (group, mb_splice) <- findSplice decls
; case mb_splice of
Nothing -> return ()
- Just (SpliceDecl (L loc _), _)
+ Just (SpliceDecl (L loc _) _, _)
-> setSrcSpan loc $
addErr (ptext (sLit "Declaration splices are not permitted inside declaration brackets"))
-- Why not? See Section 7.3 of the TH paper.
setStage thRnBrack $
rnSrcDecls group
- -- Discard the tcg_env; it contains only extra info about fixity
- ; return (DecBrG group', allUses (tcg_dus tcg_env)) }
+ -- Discard the tcg_env; it contains only extra info about fixity
+ ; traceRn (text "rnBracket dec" <+> (ppr (tcg_dus tcg_env) $$ ppr (duUses (tcg_dus tcg_env))))
+ ; return (DecBrG group', duUses (tcg_dus tcg_env)) }
rnBracket (DecBrG _) = panic "rnBracket: unexpected DecBrG"
\end{code}
Just e -> do { (e', fvs) <- rnLExpr e; return (Just e', fvs) }
; (thing, fvs_thing) <- thing_inside bndrs
; let fvs = fvs_by `plusFV` fvs_thing
- used_bndrs = filter (`elemNameSet` fvs_thing) bndrs
+ used_bndrs = filter (`elemNameSet` fvs) bndrs
+ -- The paper (Fig 5) has a bug here; we must treat any free varaible of
+ -- the "thing inside", **or of the by-expression**, as used
; return ((by', used_bndrs, thing), fvs) }
; return (([L loc (TransformStmt stmts' used_bndrs using' by')], thing),
= failWith (badIpBinds (ptext (sLit "an mdo expression")) binds)
rn_rec_stmt_lhs fix_env (L loc (LetStmt (HsValBinds binds)))
- = do (_bound_names, binds') <- rnValBindsLHS fix_env binds
+ = do (_bound_names, binds') <- rnLocalValBindsLHS fix_env binds
return [(L loc (LetStmt (HsValBinds binds')),
-- Warning: this is bogus; see function invariant
emptyFVs
rn_rec_stmt all_bndrs (L loc (LetStmt (HsValBinds binds'))) _ = do
(binds', du_binds) <-
-- fixities and unused are handled above in rn_rec_stmts_and_then
- rnValBindsRHS (mkNameSet all_bndrs) binds'
- return [(duDefs du_binds, duUses du_binds,
- emptyNameSet, L loc (LetStmt (HsValBinds binds')))]
+ rnLocalValBindsRHS (mkNameSet all_bndrs) binds'
+ return [(duDefs du_binds, allUses du_binds,
+ emptyNameSet, L loc (LetStmt (HsValBinds binds')))]
-- no RecStmt case becuase they get flattened above when doing the LHSes
rn_rec_stmt _ stmt@(L _ (RecStmt {})) _
---------
checkParStmt :: HsStmtContext Name -> RnM ()
checkParStmt _
- = do { parallel_list_comp <- doptM Opt_ParallelListComp
+ = do { parallel_list_comp <- xoptM Opt_ParallelListComp
; checkErr parallel_list_comp msg }
where
msg = ptext (sLit "Illegal parallel list comprehension: use -XParallelListComp")
checkTransformStmt :: HsStmtContext Name -> RnM ()
checkTransformStmt ListComp -- Ensure we are really within a list comprehension because otherwise the
-- desugarer will break when we come to operate on a parallel array
- = do { transform_list_comp <- doptM Opt_TransformListComp
+ = do { transform_list_comp <- xoptM Opt_TransformListComp
; checkErr transform_list_comp msg }
where
msg = ptext (sLit "Illegal transform or grouping list comprehension: use -XTransformListComp")
---------
checkTupleSection :: [HsTupArg RdrName] -> RnM ()
checkTupleSection args
- = do { tuple_section <- doptM Opt_TupleSections
+ = do { tuple_section <- xoptM Opt_TupleSections
; checkErr (all tupArgPresent args || tuple_section) msg }
where
msg = ptext (sLit "Illegal tuple section: use -XTupleSections")