)
import Literal ( mkMachInt, Literal(..) )
import Name ( isExported )
-import PrelInfo ( unpackCStringId, unpackCString2Id, stringTy,
- integerTy, rationalTy, ratioDataCon,
+import PrelVals ( unpackCStringId, unpackCString2Id,
integerZeroId, integerPlusOneId,
integerPlusTwoId, integerMinusOneId
)
import PrimOp ( PrimOp(..) )
import SpecUtils ( mkSpecialisedCon )
import SrcLoc ( mkUnknownSrcLoc )
-import Type ( getAppDataTyCon )
+import Type ( getAppDataTyConExpandingDicts )
+import TysWiredIn ( stringTy, integerTy, rationalTy, ratioDataCon )
import UniqSupply -- all of it, really
import Util ( panic )
-isLeakFreeType = panic "CoreToStg.isLeakFreeType (ToDo)"
+isLeakFreeType x y = False -- safe option; ToDo
\end{code}
= let
(_,_, binders, body) = collectBinders expr
in
- coreExprToStg env body `thenUs` \ (stg_body, binds) ->
- newStgVar (coreExprType expr) `thenUs` \ var ->
- returnUs
- (StgLet (StgNonRec var (StgRhsClosure noCostCentre
- stgArgOcc
- bOGUS_FVs
- ReEntrant -- binders is non-empty
- binders
- stg_body))
- (StgApp (StgVarArg var) [] bOGUS_LVs),
- binds)
+ coreExprToStg env body `thenUs` \ stuff@(stg_body, binds) ->
+
+ if null binders then -- it was all type/usage binders; tossed
+ returnUs stuff
+ else
+ newStgVar (coreExprType expr) `thenUs` \ var ->
+ returnUs
+ (StgLet (StgNonRec var (StgRhsClosure noCostCentre
+ stgArgOcc
+ bOGUS_FVs
+ ReEntrant -- binders is non-empty
+ binders
+ stg_body))
+ (StgApp (StgVarArg var) [] bOGUS_LVs),
+ binds)
\end{code}
%************************************************************************
)
where
discrim_ty = coreExprType discrim
- (_, discrim_ty_args, _) = getAppDataTyCon discrim_ty
+ (_, discrim_ty_args, _) = getAppDataTyConExpandingDicts discrim_ty
alts_to_stg discrim (AlgAlts alts deflt)
= default_to_stg discrim deflt `thenUs` \ (stg_deflt, deflt_binds) ->
returnUs (StgSCC (coreExprType expr) cc stg_expr, binds)
\end{code}
+\begin{code}
+coreExprToStg env (Coerce c ty expr)
+ = coreExprToStg env expr -- `thenUs` \ (stg_expr, binds) ->
+-- returnUs (StgSCC (coreExprType expr) cc stg_expr, binds)
+\end{code}
+
%************************************************************************
%* *