+
+@okToUnfoldInHifile@ is used when emitting unfolding info into an interface
+file to determine whether an unfolding candidate really should be unfolded.
+The predicate is needed to prevent @_casm_@s (+ lit-lits) from being emitted
+into interface files.
+
+The reason for inlining expressions containing _casm_s into interface files
+is that these fragments of C are likely to mention functions/#defines that
+will be out-of-scope when inlined into another module. This is not an
+unfixable problem for the user (just need to -#include the approp. header
+file), but turning it off seems to the simplest thing to do.
+
+\begin{code}
+okToUnfoldInHiFile :: CoreExpr -> Bool
+okToUnfoldInHiFile e = go e
+ where
+ -- Race over an expression looking for CCalls..
+ go (Var _) = True
+ go (Lit lit) = not (isLitLitLit lit)
+ go (Note _ body) = go body
+ go (App fun arg) = go fun
+ go (Con con args) = True
+ go (Prim op args) = okToUnfoldPrimOp op
+ go (Lam _ body) = go body
+ go (Let (NonRec binder rhs) body) = go rhs && go body
+ go (Let (Rec pairs) body) = and (map go (body:rhses))
+ where
+ rhses = [ rhs | (_, rhs) <- pairs ]
+ go (Case scrut alts) = and (map go (scrut:rhses))
+ where
+ rhses = getAltRhs alts
+
+ getAltRhs (PrimAlts alts deflt) =
+ let ls = map snd alts in
+ case deflt of
+ NoDefault -> ls
+ BindDefault _ rhs -> rhs:ls
+ getAltRhs (AlgAlts alts deflt) =
+ let ls = map (\ (_,_,r) -> r) alts in
+ case deflt of
+ NoDefault -> ls
+ BindDefault _ rhs -> rhs:ls
+
+ -- ok to unfold a PrimOp as long as it's not a _casm_
+ okToUnfoldPrimOp (CCallOp _ is_casm _ _ _) = not is_casm
+ okToUnfoldPrimOp _ = True
+
+\end{code}