X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FstgSyn%2FCoreToStg.lhs;h=b5484a44d39b8e13ee1578d8c63aca1bfe93e7d1;hp=d8c63b6cb71c7b1acff1776e22b5e3c3f35a177d;hb=388e3356f71daffa62f1d4157e1e07e4c68f218a;hpb=9ffadf219cbc4f8ec57264786df936a3cee88aec diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs index d8c63b6..b5484a4 100644 --- a/compiler/stgSyn/CoreToStg.lhs +++ b/compiler/stgSyn/CoreToStg.lhs @@ -12,7 +12,8 @@ module CoreToStg ( coreToStg, coreExprToStg ) where #include "HsVersions.h" import CoreSyn -import CoreUtils ( rhsIsStatic, manifestArity, exprType, findDefault ) +import CoreUtils ( rhsIsStatic, exprType, findDefault ) +import CoreArity ( manifestArity ) import StgSyn import Type @@ -33,6 +34,8 @@ import Outputable import MonadUtils import FastString import Util +import ForeignCall +import PrimOp ( PrimCall(..) ) \end{code} %************************************************************************ @@ -434,7 +437,7 @@ mkStgAltType bndr alts | isUnLiftedTyCon tc -> PrimAlt tc | isHiBootTyCon tc -> look_for_better_tycon | isAlgTyCon tc -> AlgAlt tc - | otherwise -> ASSERT( _is_poly_alt_tycon tc ) + | otherwise -> ASSERT2( _is_poly_alt_tycon tc, ppr tc ) PolyAlt Nothing -> PolyAlt @@ -527,6 +530,11 @@ coreToStgApp _ f args = do DataConWorkId dc | saturated -> StgConApp dc args' PrimOpId op -> ASSERT( saturated ) StgOpApp (StgPrimOp op) args' res_ty + FCallId (CCall (CCallSpec (StaticTarget lbl) PrimCallConv _)) + -- prim calls are represented as FCalls in core, + -- but in stg we distinguish them + -> ASSERT( saturated ) + StgOpApp (StgPrimCallOp (PrimCall lbl)) args' res_ty FCallId call -> ASSERT( saturated ) StgOpApp (StgFCallOp call (idUnique f)) args' res_ty TickBoxOpId {} -> pprPanic "coreToStg TickBox" $ ppr (f,args')