let-no-escapes.
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module CoreToStg ( coreToStg, coreExprToStg ) where
#include "HsVersions.h"
import OccName ( occNameString, occNameFS )
import BasicTypes ( Arity )
import StaticFlags ( opt_RuntimeTypes )
-import PackageConfig ( PackageId )
+import Module
import Outputable
infixr 9 `thenLne`
ASSERT2(consistentCafInfo (head binders) bind, ppr binders)
(env', fvs' `unionFVInfo` body_fvs, bind)
-#ifdef DEBUG
-- Assertion helper: this checks that the CafInfo on the Id matches
-- what CoreToStg has figured out about the binding's SRT. The
-- CafInfo will be exact in all cases except when CorePrep has
exact = id_marked_caffy == binding_is_caffy
id_marked_caffy = mayHaveCafRefs (idCafInfo id)
binding_is_caffy = stgBindHasCafRefs bind
-#endif
\end{code}
\begin{code}
let
arg_ty = exprType arg
stg_arg_ty = stgArgType stg_arg
+ bad_args = (isUnLiftedType arg_ty && not (isUnLiftedType stg_arg_ty))
+ || (typePrimRep arg_ty /= typePrimRep stg_arg_ty)
+ -- In GHCi we coerce an argument of type BCO# (unlifted) to HValue (lifted),
+ -- and pass it to a function expecting an HValue (arg_ty). This is ok because
+ -- we can treat an unlifted value as lifted. But the other way round
+ -- we complain.
+ -- We also want to check if a pointer is cast to a non-ptr etc
in
- WARN( isUnLiftedType arg_ty /= isUnLiftedType stg_arg_ty,
- ptext SLIT("Dangerous-looking argument. Probable cause: bad unsafeCoerce#") $$ ppr arg)
+ WARN( bad_args, ptext SLIT("Dangerous-looking argument. Probable cause: bad unsafeCoerce#") $$ ppr arg )
returnLne (stg_arg : stg_args, fvs)
= ASSERT (id1 == id2 && hb1 `check_eq_how_bound` hb2)
(id1, hb1, combineStgBinderInfo info1 info2)
-#ifdef DEBUG
-- The HowBound info for a variable in the FVInfo should be consistent
check_eq_how_bound ImportBound ImportBound = True
check_eq_how_bound LambdaBound LambdaBound = True
check_eq_li (NestedLet _) (NestedLet _) = True
check_eq_li TopLet TopLet = True
check_eq_li li1 li2 = False
-#endif
\end{code}
Misc.