import StgSyn
import Type
-import Coercion ( mkUnsafeCoercion )
-import TyCon ( isAlgTyCon )
+import TyCon
import Id
import Var ( Var, globalIdDetails, idType )
-import TyCon ( isUnboxedTupleTyCon, isPrimTyCon, isFunTyCon, isHiBootTyCon )
-#ifdef ILX
-import MkId ( unsafeCoerceId )
-#endif
import IdInfo
import DataCon
import CostCentre ( noCCS )
= coreToStgExpr expr `thenLne` ( \ (expr2, fvs, escs) ->
returnLne (StgSCC cc expr2, fvs, escs) )
-#ifdef ILX
--- For ILX, convert (__coerce__ to_ty from_ty e)
--- into (coerce to_ty from_ty e)
--- where coerce is real function
-coreToStgExpr (Cast expr co)
- = let (from_ty, ty_ty) = coercionKind co in
- coreToStgExpr (mkApps (Var unsafeCoerceId)
- [Type from_ty, Type to_ty, expr])
-#endif
+coreToStgExpr (Case (Var id) _bndr ty [(DEFAULT,[],expr)])
+ | Just (TickBox m n) <- isTickBoxOp_maybe id
+ = coreToStgExpr expr `thenLne` ( \ (expr2, fvs, escs) ->
+ returnLne (StgTick m n expr2, fvs, escs) )
coreToStgExpr (Note other_note expr)
= coreToStgExpr expr
mkStgAltType scrut_ty alts
= case splitTyConApp_maybe (repType scrut_ty) of
Just (tc,_) | isUnboxedTupleTyCon tc -> UbxTupAlt tc
- | isPrimTyCon tc -> PrimAlt tc
+ | isUnLiftedTyCon tc -> PrimAlt tc
| isHiBootTyCon tc -> look_for_better_tycon
| isAlgTyCon tc -> AlgAlt tc
| isFunTyCon tc -> PolyAlt
+ | isPrimTyCon tc -> PolyAlt -- for "Any"
| otherwise -> pprPanic "mkStgAlts" (ppr tc)
Nothing -> PolyAlt
-> [CoreArg] -- Arguments
-> LneM (StgExpr, FreeVarsInfo, EscVarsSet)
+
coreToStgApp maybe_thunk_body f args
= coreToStgArgs args `thenLne` \ (args', args_fvs) ->
lookupVarLne f `thenLne` \ how_bound ->
res_ty = exprType (mkApps (Var f) args)
app = case globalIdDetails f of
DataConWorkId dc | saturated -> StgConApp dc args'
- PrimOpId op -> ASSERT( saturated )
- StgOpApp (StgPrimOp op) args' res_ty
+ PrimOpId op -> ASSERT( saturated )
+ StgOpApp (StgPrimOp op) args' res_ty
FCallId call -> ASSERT( saturated )
StgOpApp (StgFCallOp call (idUnique f)) args' res_ty
+ TickBoxOpId {} -> pprPanic "coreToStg TickBox" $ ppr (f,args')
_other -> StgApp f args'
in
StgLit lit -> StgLitArg lit
_ -> pprPanic "coreToStgArgs" (ppr arg)
in
+ -- WARNING: what if we have an argument like (v `cast` co)
+ -- where 'co' changes the representation type?
+ -- (This really only happens if co is unsafe.)
+ -- Then all the getArgAmode stuff in CgBindery will set the
+ -- cg_rep of the CgIdInfo based on the type of v, rather
+ -- than the type of 'co'.
+ -- This matters particularly when the function is a primop
+ -- or foreign call.
+ -- Wanted: a better solution than this hacky warning
+ let
+ arg_ty = exprType arg
+ stg_arg_ty = stgArgType stg_arg
+ in
+ WARN( isUnLiftedType arg_ty /= isUnLiftedType stg_arg_ty,
+ ptext SLIT("Dangerous-looking argument. Probable cause: bad unsafeCoerce#") $$ ppr arg)
returnLne (stg_arg : stg_args, fvs)