Commit c3cf0419 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Merge branch 'master' of darcs.haskell.org:/srv/darcs//ghc

Fix conflicts in:
	compiler/main/DynFlags.hs
parents bfe94012 96a37685
......@@ -63,7 +63,7 @@ intsToBitmap size slots{- must be sorted -}
-- eg. @[0,1,3], size 4 ==> 0x4@ (we leave any bits outside the size as zero,
-- just to make the bitmap easier to read).
--
-- The list of @Int@s /must/ be already sorted.
-- The list of @Int@s /must/ be already sorted and duplicate-free.
intsToReverseBitmap :: Int -> [Int] -> Bitmap
intsToReverseBitmap size slots{- must be sorted -}
| size <= 0 = []
......
......@@ -379,10 +379,8 @@ schemeE d s p e@(AnnLit lit) = returnUnboxedAtom d s p e (typeCgRep (literal
schemeE d s p e@(AnnCoercion {}) = returnUnboxedAtom d s p e VoidArg
schemeE d s p e@(AnnVar v)
| isUnLiftedType v_type = returnUnboxedAtom d s p e (typeCgRep v_type)
| otherwise = schemeT d s p e
where
v_type = idType v
| isUnLiftedType (idType v) = returnUnboxedAtom d s p e (bcIdCgRep v)
| otherwise = schemeT d s p e
schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body))
| (AnnVar v, args_r_to_l) <- splitApp rhs,
......@@ -489,8 +487,9 @@ schemeE d s p (AnnTick _ (_, rhs)) = schemeE d s p rhs
schemeE d s p (AnnCase (_,scrut) _ _ []) = schemeE d s p scrut
-- no alts: scrut is guaranteed to diverge
schemeE d s p (AnnCase scrut _ _ [(DataAlt dc, [bind1, bind2], rhs)])
| isUnboxedTupleCon dc, UnaryRep rep_ty <- repType (idType bind1), VoidRep <- typePrimRep rep_ty
schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)])
| isUnboxedTupleCon dc
, UnaryRep rep_ty1 <- repType (idType bind1), UnaryRep rep_ty2 <- repType (idType bind2)
-- Convert
-- case .... of x { (# VoidArg'd-thing, a #) -> ... }
-- to
......@@ -499,25 +498,47 @@ schemeE d s p (AnnCase scrut _ _ [(DataAlt dc, [bind1, bind2], rhs)])
--
-- Note that it does not matter losing the void-rep thing from the
-- envt (it won't be bound now) because we never look such things up.
= --trace "automagic mashing of case alts (# VoidArg, a #)" $
doCase d s p scrut bind2 [(DEFAULT, [], rhs)] True{-unboxed tuple-}
| isUnboxedTupleCon dc, UnaryRep rep_ty <- repType (idType bind2), VoidRep <- typePrimRep rep_ty
= --trace "automagic mashing of case alts (# a, VoidArg #)" $
doCase d s p scrut bind1 [(DEFAULT, [], rhs)] True{-unboxed tuple-}
schemeE d s p (AnnCase scrut _ _ [(DataAlt dc, [bind1], rhs)])
, Just res <- case () of
_ | VoidRep <- typePrimRep rep_ty1
-> Just $ doCase d s p scrut bind2 [(DEFAULT, [], rhs)] (Just bndr){-unboxed tuple-}
| VoidRep <- typePrimRep rep_ty2
-> Just $ doCase d s p scrut bind1 [(DEFAULT, [], rhs)] (Just bndr){-unboxed tuple-}
| otherwise
-> Nothing
= res
schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1], rhs)])
| isUnboxedTupleCon dc, UnaryRep _ <- repType (idType bind1)
-- Similarly, convert
-- case .... of x { (# a #) -> ... }
-- to
-- case .... of a { DEFAULT -> ... }
= --trace "automagic mashing of case alts (# a #)" $
doCase d s p scrut bind1 [(DEFAULT, [], rhs)] True{-unboxed tuple-}
doCase d s p scrut bind1 [(DEFAULT, [], rhs)] (Just bndr){-unboxed tuple-}
schemeE d s p (AnnCase scrut bndr _ [(DEFAULT, [], rhs)])
| Just (tc, tys) <- splitTyConApp_maybe (idType bndr)
, isUnboxedTupleTyCon tc
, Just res <- case tys of
[ty] | UnaryRep _ <- repType ty
, let bind = bndr `setIdType` ty
-> Just $ doCase d s p scrut bind [(DEFAULT, [], rhs)] (Just bndr){-unboxed tuple-}
[ty1, ty2] | UnaryRep rep_ty1 <- repType ty1
, UnaryRep rep_ty2 <- repType ty2
-> case () of
_ | VoidRep <- typePrimRep rep_ty1
, let bind2 = bndr `setIdType` ty2
-> Just $ doCase d s p scrut bind2 [(DEFAULT, [], rhs)] (Just bndr){-unboxed tuple-}
| VoidRep <- typePrimRep rep_ty2
, let bind1 = bndr `setIdType` ty1
-> Just $ doCase d s p scrut bind1 [(DEFAULT, [], rhs)] (Just bndr){-unboxed tuple-}
| otherwise
-> Nothing
_ -> Nothing
= res
schemeE d s p (AnnCase scrut bndr _ alts)
= doCase d s p scrut bndr alts False{-not an unboxed tuple-}
= doCase d s p scrut bndr alts Nothing{-not an unboxed tuple-}
schemeE _ _ _ expr
= pprPanic "ByteCodeGen.schemeE: unhandled case"
......@@ -679,11 +700,7 @@ mkConAppCode orig_d _ p con args_r_to_l
unboxedTupleReturn
:: Word -> Sequel -> BCEnv
-> AnnExpr' Id VarSet -> BcM BCInstrList
unboxedTupleReturn d s p arg = do
(push, sz) <- pushAtom d p arg
return (push `appOL`
mkSLIDE sz (d - s) `snocOL`
RETURN_UBX (atomRep arg))
unboxedTupleReturn d s p arg = returnUnboxedAtom d s p arg (atomRep arg)
-- -----------------------------------------------------------------------------
-- Generate code for a tail-call
......@@ -748,7 +765,7 @@ findPushSeq _
doCase :: Word -> Sequel -> BCEnv
-> AnnExpr Id VarSet -> Id -> [AnnAlt Id VarSet]
-> Bool -- True <=> is an unboxed tuple case, don't enter the result
-> Maybe Id -- Just x <=> is an unboxed tuple case with scrut binder, don't enter the result
-> BcM BCInstrList
doCase d s p (_,scrut) bndr alts is_unboxed_tuple
| UbxTupleRep _ <- repType (idType bndr)
......@@ -778,10 +795,14 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
-- Env in which to compile the alts, not including
-- any vars bound by the alts themselves
p_alts = Map.insert bndr (fromIntegral d_bndr - 1) p
d_bndr' = fromIntegral d_bndr - 1
p_alts0 = Map.insert bndr d_bndr' p
p_alts = case is_unboxed_tuple of
Just ubx_bndr -> Map.insert ubx_bndr d_bndr' p_alts0
Nothing -> p_alts0
bndr_ty = idType bndr
isAlgCase = not (isUnLiftedType bndr_ty) && not is_unboxed_tuple
isAlgCase = not (isUnLiftedType bndr_ty) && isNothing is_unboxed_tuple
-- given an alt, return a discr and code for it.
codeAlt (DEFAULT, _, (_,rhs))
......@@ -857,10 +878,11 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
(sortLe (<=) (filter (< bitmap_size') rel_slots))
where
binds = Map.toList p
rel_slots = map fromIntegral $ concat (map spread binds)
spread (id, offset)
| isFollowableArg (idCgRep id) = [ rel_offset ]
| otherwise = []
-- NB: unboxed tuple cases bind the scrut binder to the same offset
-- as one of the alt binders, so we have to remove any duplicates here:
rel_slots = nub $ map fromIntegral $ concat (map spread binds)
spread (id, offset) | isFollowableArg (bcIdCgRep id) = [ rel_offset ]
| otherwise = []
where rel_offset = trunc16 $ d - fromIntegral offset - 1
in do
......@@ -1178,7 +1200,8 @@ pushAtom _ _ (AnnCoercion {}) -- Coercions are zero-width things,
= return (nilOL, 0) -- treated just like a variable VoidArg
pushAtom d p (AnnVar v)
| idCgRep v == VoidArg
| UnaryRep rep_ty <- repType (idType v)
, VoidArg <- typeCgRep rep_ty
= return (nilOL, 0)
| isFCallId v
......@@ -1422,7 +1445,22 @@ lookupBCEnv_maybe :: Id -> BCEnv -> Maybe Word
lookupBCEnv_maybe = Map.lookup
idSizeW :: Id -> Int
idSizeW id = cgRepSizeW (typeCgRep (idType id))
idSizeW = cgRepSizeW . bcIdCgRep
bcIdCgRep :: Id -> CgRep
bcIdCgRep = primRepToCgRep . bcIdPrimRep
bcIdPrimRep :: Id -> PrimRep
bcIdPrimRep = typePrimRep . bcIdUnaryType
bcIdUnaryType :: Id -> UnaryType
bcIdUnaryType x = case repType (idType x) of
UnaryRep rep_ty -> rep_ty
UbxTupleRep [rep_ty] -> rep_ty
UbxTupleRep [rep_ty1, rep_ty2]
| VoidRep <- typePrimRep rep_ty1 -> rep_ty2
| VoidRep <- typePrimRep rep_ty2 -> rep_ty1
_ -> pprPanic "bcIdUnaryType" (ppr x $$ ppr (idType x))
-- See bug #1257
unboxedTupleException :: a
......@@ -1473,13 +1511,13 @@ bcView _ = Nothing
isVoidArgAtom :: AnnExpr' Var ann -> Bool
isVoidArgAtom e | Just e' <- bcView e = isVoidArgAtom e'
isVoidArgAtom (AnnVar v) = typePrimRep (idType v) == VoidRep
isVoidArgAtom (AnnVar v) = bcIdCgRep v == VoidArg
isVoidArgAtom (AnnCoercion {}) = True
isVoidArgAtom _ = False
atomPrimRep :: AnnExpr' Id ann -> PrimRep
atomPrimRep e | Just e' <- bcView e = atomPrimRep e'
atomPrimRep (AnnVar v) = typePrimRep (idType v)
atomPrimRep (AnnVar v) = bcIdPrimRep v
atomPrimRep (AnnLit l) = typePrimRep (literalType l)
atomPrimRep (AnnCoercion {}) = VoidRep
atomPrimRep other = pprPanic "atomPrimRep" (ppr (deAnnotate (undefined,other)))
......
......@@ -377,7 +377,7 @@ data SafeHaskellMode
| Sf_Unsafe
| Sf_Trustworthy
| Sf_Safe
| Sf_SafeInfered
| Sf_SafeInferred
deriving (Eq)
instance Show SafeHaskellMode where
......@@ -455,7 +455,6 @@ data ExtensionFlag
| Opt_MonadComprehensions
| Opt_GeneralizedNewtypeDeriving
| Opt_RecursiveDo
| Opt_DoRec
| Opt_PostfixOperators
| Opt_TupleSections
| Opt_PatternGuards
......@@ -957,7 +956,7 @@ defaultDynFlags mySettings =
warningFlags = IntSet.fromList (map fromEnum standardWarnings),
ghciScripts = [],
language = Nothing,
safeHaskell = Sf_SafeInfered,
safeHaskell = Sf_SafeInferred,
thOnLoc = noSrcSpan,
newDerivOnLoc = noSrcSpan,
pkgTrustOnLoc = noSrcSpan,
......@@ -1159,7 +1158,7 @@ safeLanguageOn dflags = safeHaskell dflags == Sf_Safe
-- | Is the Safe Haskell safe inference mode active
safeInferOn :: DynFlags -> Bool
safeInferOn dflags = safeHaskell dflags == Sf_SafeInfered
safeInferOn dflags = safeHaskell dflags == Sf_SafeInferred
-- | Test if Safe Imports are on in some form
safeImportsOn :: DynFlags -> Bool
......@@ -1190,12 +1189,12 @@ safeImplicitImpsReq d = safeLanguageOn d
-- want to export this functionality from the module but do want to export the
-- type constructors.
combineSafeFlags :: SafeHaskellMode -> SafeHaskellMode -> DynP SafeHaskellMode
combineSafeFlags a b | a == Sf_SafeInfered = return b
| b == Sf_SafeInfered = return a
| a == Sf_None = return b
| b == Sf_None = return a
| a == b = return a
| otherwise = addErr errm >> return (panic errm)
combineSafeFlags a b | a == Sf_SafeInferred = return b
| b == Sf_SafeInferred = return a
| a == Sf_None = return b
| b == Sf_None = return a
| a == b = return a
| otherwise = addErr errm >> return (panic errm)
where errm = "Incompatible Safe Haskell flags! ("
++ show a ++ ", " ++ show b ++ ")"
......@@ -1445,7 +1444,7 @@ safeFlagCheck cmdl dflags =
| otherwise
-> (dflags' { safeHaskell = Sf_None }, [])
-- Have we infered Unsafe?
-- Have we inferred Unsafe?
-- See Note [HscMain . Safe Haskell Inference]
where
-- TODO: Can we do better than this for inference?
......@@ -2049,9 +2048,9 @@ xFlags = [
( "ImpredicativeTypes", Opt_ImpredicativeTypes, nop),
( "TypeOperators", Opt_TypeOperators, nop ),
( "ExplicitNamespaces", Opt_ExplicitNamespaces, nop ),
( "RecursiveDo", Opt_RecursiveDo, -- Enables 'mdo'
deprecatedForExtension "DoRec"),
( "DoRec", Opt_DoRec, nop ), -- Enables 'rec' keyword
( "RecursiveDo", Opt_RecursiveDo, nop ), -- Enables 'mdo' and 'rec'
( "DoRec", Opt_RecursiveDo,
deprecatedForExtension "RecursiveDo" ),
( "Arrows", Opt_Arrows, nop ),
( "ParallelArrays", Opt_ParallelArrays, nop ),
( "TemplateHaskell", Opt_TemplateHaskell, checkTemplateHaskellOk ),
......@@ -2297,7 +2296,7 @@ glasgowExtsFlags = [
, Opt_RankNTypes
, Opt_TypeOperators
, Opt_ExplicitNamespaces
, Opt_DoRec
, Opt_RecursiveDo
, Opt_ParallelListComp
, Opt_EmptyDataDecls
, Opt_KindSignatures
......
......@@ -447,7 +447,7 @@ tcRnModule' hsc_env sum save_rn_syntax mod = do
return tcg_res'
where
pprMod t = ppr $ moduleName $ tcg_mod t
errSafe t = quotes (pprMod t) <+> text "has been infered as safe!"
errSafe t = quotes (pprMod t) <+> text "has been inferred as safe!"
-- | Convert a typechecked module to Core
hscDesugar :: HscEnv -> ModSummary -> TcGblEnv -> IO ModGuts
......@@ -928,7 +928,7 @@ hscCheckSafeImports tcg_env = do
safeHaskell dflags == Sf_None
-> wipeTrust tcg_env' $ warns dflags (tcg_rules tcg_env')
-- trustworthy OR safe infered with no RULES
-- trustworthy OR safe inferred with no RULES
| otherwise
-> return tcg_env'
......@@ -1050,7 +1050,7 @@ hscCheckSafe' dflags m l = do
let trust = getSafeMode $ mi_trust iface'
trust_own_pkg = mi_trust_pkg iface'
-- check module is trusted
safeM = trust `elem` [Sf_SafeInfered, Sf_Safe, Sf_Trustworthy]
safeM = trust `elem` [Sf_SafeInferred, Sf_Safe, Sf_Trustworthy]
-- check package is trusted
safeP = packageTrusted trust trust_own_pkg m
-- pkg trust reqs
......@@ -1080,9 +1080,9 @@ hscCheckSafe' dflags m l = do
-- otherwise we check the package trust flag.
packageTrusted :: SafeHaskellMode -> Bool -> Module -> Bool
packageTrusted _ _ _
| not (packageTrustOn dflags) = True
packageTrusted Sf_Safe False _ = True
packageTrusted Sf_SafeInfered False _ = True
| not (packageTrustOn dflags) = True
packageTrusted Sf_Safe False _ = True
packageTrusted Sf_SafeInferred False _ = True
packageTrusted _ _ m
| isHomePkg m = True
| otherwise = trusted $ getPackageDetails (pkgState dflags)
......@@ -1131,7 +1131,7 @@ checkPkgTrust dflags pkgs =
-- | Set module to unsafe and wipe trust information.
--
-- Make sure to call this method to set a module to infered unsafe,
-- Make sure to call this method to set a module to inferred unsafe,
-- it should be a central and single failure method.
wipeTrust :: TcGblEnv -> WarningMessages -> Hsc TcGblEnv
wipeTrust tcg_env whyUnsafe = do
......@@ -1147,7 +1147,7 @@ wipeTrust tcg_env whyUnsafe = do
where
wiped_trust = (tcg_imports tcg_env) { imp_trust_pkgs = [] }
pprMod = ppr $ moduleName $ tcg_mod tcg_env
whyUnsafe' df = vcat [ quotes pprMod <+> text "has been infered as unsafe!"
whyUnsafe' df = vcat [ quotes pprMod <+> text "has been inferred as unsafe!"
, text "Reason:"
, nest 4 $ (vcat $ badFlags df) $+$
(vcat $ pprErrMsgBagWithLoc whyUnsafe)
......
......@@ -2059,26 +2059,26 @@ noIfaceTrustInfo = setSafeMode Sf_None
trustInfoToNum :: IfaceTrustInfo -> Word8
trustInfoToNum it
= case getSafeMode it of
Sf_None -> 0
Sf_Unsafe -> 1
Sf_Trustworthy -> 2
Sf_Safe -> 3
Sf_SafeInfered -> 4
Sf_None -> 0
Sf_Unsafe -> 1
Sf_Trustworthy -> 2
Sf_Safe -> 3
Sf_SafeInferred -> 4
numToTrustInfo :: Word8 -> IfaceTrustInfo
numToTrustInfo 0 = setSafeMode Sf_None
numToTrustInfo 1 = setSafeMode Sf_Unsafe
numToTrustInfo 2 = setSafeMode Sf_Trustworthy
numToTrustInfo 3 = setSafeMode Sf_Safe
numToTrustInfo 4 = setSafeMode Sf_SafeInfered
numToTrustInfo 4 = setSafeMode Sf_SafeInferred
numToTrustInfo n = error $ "numToTrustInfo: bad input number! (" ++ show n ++ ")"
instance Outputable IfaceTrustInfo where
ppr (TrustInfo Sf_None) = ptext $ sLit "none"
ppr (TrustInfo Sf_Unsafe) = ptext $ sLit "unsafe"
ppr (TrustInfo Sf_Trustworthy) = ptext $ sLit "trustworthy"
ppr (TrustInfo Sf_Safe) = ptext $ sLit "safe"
ppr (TrustInfo Sf_SafeInfered) = ptext $ sLit "safe-infered"
ppr (TrustInfo Sf_None) = ptext $ sLit "none"
ppr (TrustInfo Sf_Unsafe) = ptext $ sLit "unsafe"
ppr (TrustInfo Sf_Trustworthy) = ptext $ sLit "trustworthy"
ppr (TrustInfo Sf_Safe) = ptext $ sLit "safe"
ppr (TrustInfo Sf_SafeInferred) = ptext $ sLit "safe-inferred"
\end{code}
%************************************************************************
......
......@@ -658,7 +658,8 @@ reservedWordsFM = listToUFM $
( "capi", ITcapiconv, bit cApiFfiBit),
( "prim", ITprimcallconv, bit ffiBit),
( "rec", ITrec, bit recBit),
( "rec", ITrec, bit arrowsBit .|.
bit recursiveDoBit),
( "proc", ITproc, bit arrowsBit)
]
......@@ -1826,8 +1827,6 @@ inRulePragBit :: Int
inRulePragBit = 19
rawTokenStreamBit :: Int
rawTokenStreamBit = 20 -- producing a token stream with all comments included
recBit :: Int
recBit = 22 -- rec
alternativeLayoutRuleBit :: Int
alternativeLayoutRuleBit = 23
relaxedLayoutBit :: Int
......@@ -1937,8 +1936,6 @@ mkPState flags buf loc =
.|. magicHashBit `setBitIf` xopt Opt_MagicHash flags
.|. kindSigsBit `setBitIf` xopt Opt_KindSignatures flags
.|. recursiveDoBit `setBitIf` xopt Opt_RecursiveDo flags
.|. recBit `setBitIf` xopt Opt_DoRec flags
.|. recBit `setBitIf` xopt Opt_Arrows flags
.|. unicodeSyntaxBit `setBitIf` xopt Opt_UnicodeSyntax flags
.|. unboxedTuplesBit `setBitIf` xopt Opt_UnboxedTuples flags
.|. datatypeContextsBit `setBitIf` xopt Opt_DatatypeContexts flags
......
......@@ -753,7 +753,7 @@ rnStmt ctxt (L _ (RecStmt { recS_stmts = rec_stmts })) thing_inside
-- Step 3: Group together the segments to make bigger segments
-- Invariant: in the result, no segment uses a variable
-- bound in a later segment
grouped_segs = glomSegments segs_w_fwd_refs
grouped_segs = glomSegments ctxt segs_w_fwd_refs
-- Step 4: Turn the segments into Stmts
-- Use RecStmt when and only when there are fwd refs
......@@ -1101,15 +1101,20 @@ addFwdRefs pairs
-- { rec { x <- ...y...; p <- z ; y <- ...x... ;
-- q <- x ; z <- y } ;
-- r <- x }
--
-- NB. June 7 2012: We only glom segments that appear in
-- an explicit mdo; and leave those found in "do rec"'s intact.
-- See http://hackage.haskell.org/trac/ghc/ticket/4148 for
-- the discussion leading to this design choice.
glomSegments :: [Segment (LStmt Name)] -> [Segment [LStmt Name]]
glomSegments :: HsStmtContext Name -> [Segment (LStmt Name)] -> [Segment [LStmt Name]]
glomSegments [] = []
glomSegments ((defs,uses,fwds,stmt) : segs)
glomSegments _ [] = []
glomSegments ctxt ((defs,uses,fwds,stmt) : segs)
-- Actually stmts will always be a singleton
= (seg_defs, seg_uses, seg_fwds, seg_stmts) : others
where
segs' = glomSegments segs
segs' = glomSegments ctxt segs
(extras, others) = grab uses segs'
(ds, us, fs, ss) = unzip4 extras
......@@ -1127,7 +1132,9 @@ glomSegments ((defs,uses,fwds,stmt) : segs)
= (reverse yeses, reverse noes)
where
(noes, yeses) = span not_needed (reverse dus)
not_needed (defs,_,_,_) = not (intersectsNameSet defs uses)
not_needed (defs,_,_,_) = case ctxt of
MDoExpr -> not (intersectsNameSet defs uses)
_ -> False -- unless we're in mdo, we *need* everything
----------------------------------------------------
......@@ -1299,9 +1306,9 @@ okParStmt dflags ctxt stmt
okDoStmt dflags ctxt stmt
= case stmt of
RecStmt {}
| Opt_DoRec `xopt` dflags -> isOK
| ArrowExpr <- ctxt -> isOK -- Arrows allows 'rec'
| otherwise -> Just (ptext (sLit "Use -XDoRec"))
| Opt_RecursiveDo `xopt` dflags -> isOK
| ArrowExpr <- ctxt -> isOK -- Arrows allows 'rec'
| otherwise -> Just (ptext (sLit "Use -XRecursiveDo"))
BindStmt {} -> isOK
LetStmt {} -> isOK
ExprStmt {} -> isOK
......
......@@ -323,8 +323,9 @@ data TcGblEnv
tcg_main :: Maybe Name, -- ^ The Name of the main
-- function, if this module is
-- the main module.
tcg_safeInfer :: TcRef Bool -- Has the typechecker infered this
-- module as -XSafe (Safe Haskell)
tcg_safeInfer :: TcRef Bool -- Has the typechecker
-- inferred this module
-- as -XSafe (Safe Haskell)
}
data RecFieldEnv
......
......@@ -1168,12 +1168,17 @@ chooseBoxingStrategy arg_ty bang
else return HsStrict }
HsNoUnpack -> return HsStrict
HsUnpack -> do { omit_prags <- doptM Opt_OmitInterfacePragmas
; let bang = can_unbox HsUnpackFailed arg_ty
; if omit_prags && bang == HsUnpack
then return HsStrict
else return bang }
-- Do not respect UNPACK pragmas if OmitInterfacePragmas is on
-- See Trac #5252: unpacking means we must not conceal the
-- representation of the argument type
; if omit_prags then return HsStrict
else return (can_unbox HsUnpackFailed arg_ty) }
HsUnpackFailed -> pprPanic "chooseBoxingStrategy" (ppr arg_ty)
-- However: even when OmitInterfacePragmas is on, we still want
-- to know if we have HsUnpackFailed, because we omit a
-- warning in that case (#3676)
HsUnpackFailed -> pprPanic "chooseBoxingStrategy" (ppr arg_ty)
-- Source code never has shtes
where
can_unbox :: HsBang -> TcType -> HsBang
......
......@@ -110,7 +110,7 @@ identifiers, expressions, rules, and their operations.</strong>
</ul></tt>
<p><li> <strong>That is the end of the infrastructure. Now we get the
main layer of mdoules that perform useful work.</strong>
main layer of modules that perform useful work.</strong>
<tt><ul>
<p><li>
......
......@@ -1011,15 +1011,9 @@
<entry>dynamic</entry>
<entry><option>-XNoExplicitNamespaces</option></entry>
</row>
<row>
<entry><option>-XDoRec</option></entry>
<entry>Enable <link linkend="recursive-do-notation">recursive do notation</link>.</entry>
<entry>dynamic</entry>
<entry><option>-XNoDoRec</option></entry>
</row>
<row>
<entry><option>-XRecursiveDo</option></entry>
<entry>Enable <link linkend="mdo-notation">recursive do (mdo) notation</link>. This is deprecated; please use <link linkend="recursive-do-notation">recursive do notation</link> instead.</entry>
<entry>Enable <link linkend="recursive-do-notation">recursive do (mdo) notation</link>.</entry>
<entry>dynamic</entry>
<entry><option>-XNoRecursiveDo</option></entry>
</row>
......
......@@ -857,152 +857,203 @@ To disable it, you can use the <option>-XNoTraditionalRecordSyntax</option> flag
</title>
<para>
The do-notation of Haskell 98 does not allow <emphasis>recursive bindings</emphasis>,
that is, the variables bound in a do-expression are visible only in the textually following
code block. Compare this to a let-expression, where bound variables are visible in the entire binding
group. It turns out that several applications can benefit from recursive bindings in
the do-notation. The <option>-XDoRec</option> flag provides the necessary syntactic support.
The do-notation of Haskell 98 does not allow <emphasis>recursive bindings</emphasis>,
that is, the variables bound in a do-expression are visible only in the textually following
code block. Compare this to a let-expression, where bound variables are visible in the entire binding
group.
</para>
<para>
It turns out that such recursive bindings do indeed make sense for a variety of monads, but
not all. In particular, recursion in this sense requires a fixed-point operator for the underlying
monad, captured by the <literal>mfix</literal> method of the <literal>MonadFix</literal> class, defined in <literal>Control.Monad.Fix</literal> as follows:
<programlisting>
class Monad m => MonadFix m where
mfix :: (a -> m a) -> m a
</programlisting>
Haskell's
<literal>Maybe</literal>, <literal>[]</literal> (list), <literal>ST</literal> (both strict and lazy versions),
<literal>IO</literal>, and many other monads have <literal>MonadFix</literal> instances. On the negative
side, the continuation monad, with the signature <literal>(a -> r) -> r</literal>, does not.
</para>
<para>
Here is a simple (albeit contrived) example:
For monads that do belong to the <literal>MonadFix</literal> class, GHC provides
an extended version of the do-notation that allows recursive bindings.
The <option>-XRecursiveDo</option> (language pragma: <literal>RecursiveDo</literal>)
provides the necessary syntactic support, introducing the keywords <literal>mdo</literal> and
<literal>rec</literal> for higher and lower levels of the notation respectively. Unlike
bindings in a <literal>do</literal> expression, those introduced by <literal>mdo</literal> and <literal>rec</literal>
are recursively defined, much like in an ordinary let-expression. Due to the new
keyword <literal>mdo</literal>, we also call this notation the <emphasis>mdo-notation</emphasis>.
</para>
<para>
Here is a simple (albeit contrived) example:
<programlisting>
{-# LANGUAGE RecursiveDo #-}
justOnes = mdo { xs &lt;- Just (1:xs)
; return (map negate xs) }
</programlisting>
or equivalently
<programlisting>
{-# LANGUAGE DoRec #-}
{-# LANGUAGE RecursiveDo #-}
justOnes = do { rec { xs &lt;- Just (1:xs) }
; return (map negate xs) }
</programlisting>
As you can guess <literal>justOnes</literal> will evaluate to <literal>Just [-1,-1,-1,...</literal>.
</para>
<para>
The background and motivation for recursive do-notation is described in
<ulink url="http://sites.google.com/site/leventerkok/">A recursive do for Haskell</ulink>,
by Levent Erkok, John Launchbury,
Haskell Workshop 2002, pages: 29-37. Pittsburgh, Pennsylvania.
The theory behind monadic value recursion is explained further in Erkok's thesis
<ulink url="http://sites.google.com/site/leventerkok/erkok-thesis.pdf">Value Recursion in Monadic Computations</ulink>.
However, note that GHC uses a different syntax than the one described in these documents.
<para>
GHC's implementation the mdo-notation closely follows the original translation as described in the paper
<ulink url="https://sites.google.com/site/leventerkok/recdo.pdf">A recursive do for Haskell</ulink>, which
in turn is based on the work <ulink url="http://sites.google.com/site/leventerkok/erkok-thesis.pdf">Value Recursion
in Monadic Computations</ulink>. Furthermore, GHC extends the syntax described in the former paper
with a lower level syntax flagged by the <literal>rec</literal> keyword, as we describe next.
</para>
<sect3>
<title>Details of recursive do-notation</title>
<title>Recursive binding groups</title>
<para>
The recursive do-notation is enabled with the flag <option>-XDoRec</option> or, equivalently,
the LANGUAGE pragma <option>DoRec</option>. It introduces the single new keyword "<literal>rec</literal>",
which wraps a mutually-recursive group of monadic statements,
producing a single statement.
</para>
<para>Similar to a <literal>let</literal>
statement, the variables bound in the <literal>rec</literal> are
visible throughout the <literal>rec</literal> group, and below it.
For example, compare
The flag <option>-XRecursiveDo</option> also introduces a new keyword <literal>rec</literal>, which wraps a
mutually-recursive group of monadic statements inside a <literal>do</literal> expression, producing a single statement.
Similar to a <literal>let</literal> statement inside a <literal>do</literal>, variables bound in
the <literal>rec</literal> are visible throughout the <literal>rec</literal> group, and below it. For example, compare
<programlisting>
do { a &lt;- getChar do { a &lt;- getChar
; let { r1 = f a r2 ; rec { r1 &lt;- f a r2
; r2 = g r1 } ; r2 &lt;- g r1 }
; return (r1 ++ r2) } ; return (r1 ++ r2) }
do { a &lt;- getChar do { a &lt;- getChar
; let { r1 = f a r2 ; rec { r1 &lt;- f a r2
; ; r2 = g r1 } ; ; r2 &lt;- g r1 }
; return (r1 ++ r2) } ; return (r1 ++ r2) }
</programlisting>
In both cases, <literal>r1</literal> and <literal>r2</literal> are
available both throughout the <literal>let</literal> or <literal>rec</literal> block, and
in the statements that follow it. The difference is that <literal>let</literal> is non-monadic,
while <literal>rec</literal> is monadic. (In Haskell <literal>let</literal> is
really <literal>letrec</literal>, of course.)
In both cases, <literal>r1</literal> and <literal>r2</literal> are available both throughout
the <literal>let</literal> or <literal>rec</literal> block, and in the statements that follow it.
The difference is that <literal>let</literal> is non-monadic, while <literal>rec</literal> is monadic.
(In Haskell <literal>let</literal> is really <literal>letrec</literal>, of course.)