X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2Fcompiler%2FcoreSyn%2FCoreUnfold.lhs;h=39893059856b1fba1a22d2f1a847b948ffe22cf1;hp=146b1f31c47545eb5a2d78e67300557f0eca8f3b;hb=f01a8e8c9c53bfb5ab3393ed3457ebf25390efa1;hpb=cc051dd76d01b61caae6f4e1fc177c9815716961 diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs index 146b1f3..3989305 100644 --- a/ghc/compiler/coreSyn/CoreUnfold.lhs +++ b/ghc/compiler/coreSyn/CoreUnfold.lhs @@ -78,7 +78,7 @@ data UnfoldingDetails | ConForm Id -- The constructor - [CoreArg] -- Value arguments; NB OutArgs, already cloned + [CoreArg] -- Type/value arguments; NB OutArgs, already cloned | OtherConForm [Id] -- It definitely isn't one of these constructors @@ -289,6 +289,8 @@ sizeExpr scc_s_OK bOMB_OUT_SIZE args expr size_up (SCC lbl body) = if scc_s_OK then size_up body else Nothing + size_up (Coerce _ _ body) = size_up body + size_up (Con con args) = -- 1 + # of val args sizeN (1 + numValArgs args) size_up (Prim op args) = sizeN op_cost -- NB: no charge for PrimOp args @@ -582,6 +584,8 @@ ment_expr (SCC cc expr) ) `thenUf_` ment_expr expr +ment_expr (Coerce _ _ _) = panic "ment_expr:Coerce" + ------------- ment_ty ty = let @@ -739,6 +743,8 @@ ppr_uf_Expr in_scopes (SCC cc body) = ASSERT(not (noCostCentreAttached cc)) ASSERT(not (currentOrSubsumedCosts cc)) ppBesides [ppStr "_scc_ { ", ppStr (showCostCentre ppr_Unfolding False{-not as string-} cc), ppStr " } ", ppr_uf_Expr in_scopes body] + +ppr_uf_Expr in_scopes (Coerce _ _ _) = panic "ppr_uf_Expr:Coerce" \end{code} \begin{code}