import BasicTypes ( Arity, StrictnessMark(..), isMarkedUnboxed, isMarkedStrict )
+import Rules ( mkSpecInfo )
import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy,
realWorldStatePrimTy, addrPrimTy
)
import TysWiredIn ( charTy, mkListTy )
import PrelRules ( primOpRules )
-import Rules ( addRule )
import Type ( TyThing(..) )
import TcType ( Type, ThetaType, mkDictTy, mkPredTys, mkPredTy,
mkTyConApp, mkTyVarTys, mkClassPred, tcEqPred,
tcSplitFunTys, tcSplitForAllTys
)
import CoreUtils ( exprType )
-import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon )
+import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding )
import Literal ( nullAddrLit, mkStringLit )
import TyCon ( TyCon, isNewTyCon, tyConTyVars, tyConDataCons,
tyConStupidTheta, isProductTyCon, isDataTyCon, isRecursiveTyCon )
import ForeignCall ( ForeignCall )
import DataCon ( DataCon, DataConIds(..), dataConTyVars,
dataConFieldLabels, dataConRepArity,
- dataConRepArgTys, dataConRepType,
- dataConStupidTheta, dataConOrigArgTys,
+ dataConRepArgTys, dataConRepType, dataConStupidTheta,
dataConSig, dataConStrictMarks, dataConExStricts,
splitProductType, isVanillaDataCon
)
import Unique ( mkBuiltinUnique, mkPrimOpIdUnique )
import Maybes
import PrelNames
-import Maybe ( isJust )
import Util ( dropList, isSingleton )
import Outputable
import FastString
wkr_info = noCafIdInfo
`setArityInfo` wkr_arity
`setAllStrictnessInfo` Just wkr_sig
+ `setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated,
+ -- even if arity = 0
wkr_sig = mkStrictSig (mkTopDmdType (replicate wkr_arity topDmd) cpr_info)
-- Notice that we do *not* say the worker is strict
-- If we pretend it is strict then when we see
-- case x of y -> $wMkT y
-- the simplifier thinks that y is "sure to be evaluated" (because
- -- $wMkT is strict) and drops the case. No, $wMkT is not strict.
+ -- $wMkT is strict) and drops the case. No, $wMkT is not strict.
--
-- When the simplifer sees a pattern
-- case e of MkT x -> ...
MarkedStrict
| isUnLiftedType (idType arg) -> body i (arg:rep_args)
| otherwise ->
--- gaw 2004
Case (Var arg) arg result_ty [(DEFAULT,[], body i (arg:rep_args))]
MarkedUnboxed
-> case splitProductType "do_unbox" (idType arg) of
(tycon, tycon_args, con, tys) ->
--- gaw 2004
- Case (Var arg) arg result_ty [(DataAlt con, con_args,
- body i' (reverse con_args ++ rep_args))]
+ Case (Var arg) arg result_ty
+ [(DataAlt con,
+ con_args,
+ body i' (reverse con_args ++ rep_args))]
where
(con_args, i') = mkLocals i tys
arg_base = dict_id_base + 1
alts = map mk_maybe_alt data_cons
- the_alts = catMaybes alts
+ the_alts = catMaybes alts -- Already sorted by data-con
no_default = all isJust alts -- No default needed
default_alt | no_default = []
id = mkGlobalId (PrimOpId prim_op) name ty info
info = noCafIdInfo
- `setSpecInfo` rules
- `setArityInfo` arity
+ `setSpecInfo` mkSpecInfo (primOpRules prim_op name)
+ `setArityInfo` arity
`setAllStrictnessInfo` Just strict_sig
- rules = foldl (addRule id) emptyCoreRules (primOpRules prim_op)
-
-
-- For each ccall we manufacture a separate CCallOpId, giving it
-- a fresh unique, a type that is correct for this particular ccall,
-- and a CCall structure that gives the correct details about calling
involves user-written code, so we can't figure out their strictness etc
based on fixed info, as we can for constructors and record selectors (say).
-We build them as GlobalIds, but when in the module where they are
-bound, we turn the Id at the *binding site* into an exported LocalId.
-This ensures that they are taken to account by free-variable finding
-and dependency analysis (e.g. CoreFVs.exprFreeVars). The simplifier
-will propagate the LocalId to all occurrence sites.
+We build them as LocalIds, but with External Names. This ensures that
+they are taken to account by free-variable finding and dependency
+analysis (e.g. CoreFVs.exprFreeVars).
Why shouldn't they be bound as GlobalIds? Because, in particular, if
they are globals, the specialiser floats dict uses above their defns,
pass on to the next module (md_insts) in CoreTidy, afer tidying
and globalising the top-level Ids.
-BUT make sure they are *exported* LocalIds (setIdLocalExported) so
+BUT make sure they are *exported* LocalIds (mkExportedLocalId) so
that they aren't discarded by the occurrence analyser.
\begin{code}
\begin{code}
realWorldPrimId -- :: State# RealWorld
= pcMiscPrelId realWorldName realWorldStatePrimTy
- (noCafIdInfo `setUnfoldingInfo` mkOtherCon [])
- -- The mkOtherCon makes it look that realWorld# is evaluated
+ (noCafIdInfo `setUnfoldingInfo` evaldUnfolding)
+ -- The evaldUnfolding makes it look that realWorld# is evaluated
-- which in turn makes Simplify.interestingArg return True,
-- which in turn makes INLINE things applied to realWorld# likely
-- to be inlined