diff options
Diffstat (limited to 'compiler/deSugar')
| -rw-r--r-- | compiler/deSugar/DsBinds.hs | 2 | ||||
| -rw-r--r-- | compiler/deSugar/DsForeign.hs | 8 | ||||
| -rw-r--r-- | compiler/deSugar/DsUtils.hs | 4 |
3 files changed, 10 insertions, 4 deletions
diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs index 4f05d07942..420090db36 100644 --- a/compiler/deSugar/DsBinds.hs +++ b/compiler/deSugar/DsBinds.hs @@ -1067,7 +1067,7 @@ dsEvTerm (EvDelayedError ty msg) = return $ dsEvDelayedError ty msg dsEvDelayedError :: Type -> FastString -> CoreExpr dsEvDelayedError ty msg - = Var errorId `mkTyApps` [getLevity "dsEvTerm" ty, ty] `mkApps` [litMsg] + = Var errorId `mkTyApps` [getRuntimeRep "dsEvTerm" ty, ty] `mkApps` [litMsg] where errorId = tYPE_ERROR_ID litMsg = Lit (MachStr (fastStringToByteString msg)) diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs index a87526ff6c..26c84c764d 100644 --- a/compiler/deSugar/DsForeign.hs +++ b/compiler/deSugar/DsForeign.hs @@ -198,7 +198,10 @@ dsFCall fn_id co fcall mDeclHeader = do ty = pFst $ coercionKind co (all_bndrs, io_res_ty) = tcSplitPiTys ty (named_bndrs, arg_tys) = partitionBindersIntoBinders all_bndrs - tvs = map (binderVar "dsFCall") named_bndrs + tvs = ASSERT( fst (span isNamedBinder all_bndrs) + `equalLength` named_bndrs ) + -- ensure that the named binders all come first + map (binderVar "dsFCall") named_bndrs -- Must use tcSplit* functions because we want to -- see that (IO t) in the corner @@ -302,6 +305,7 @@ dsPrimCall fn_id co fcall = do -- Must use tcSplit* functions because we want to -- see that (IO t) in the corner + MASSERT( fst (span isNamedBinder bndrs) `equalLength` tvs ) args <- newSysLocalsDs arg_tys ccall_uniq <- newUnique @@ -412,6 +416,8 @@ dsFExportDynamic :: Id -> CCallConv -> DsM ([Binding], SDoc, SDoc) dsFExportDynamic id co0 cconv = do + MASSERT( fst (span isNamedBinder bndrs) `equalLength` tvs ) + -- make sure that the named binders all come first fe_id <- newSysLocalDs ty mod <- getModule dflags <- getDynFlags diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs index 0ddfb97529..ece50d877a 100644 --- a/compiler/deSugar/DsUtils.hs +++ b/compiler/deSugar/DsUtils.hs @@ -343,7 +343,7 @@ sort_alts = sortWith (dataConTag . alt_pat) mkPatSynCase :: Id -> Type -> CaseAlt PatSyn -> CoreExpr -> DsM CoreExpr mkPatSynCase var ty alt fail = do matcher <- dsLExpr $ mkLHsWrap wrapper $ - nlHsTyApp matcher [getLevity "mkPatSynCase" ty, ty] + nlHsTyApp matcher [getRuntimeRep "mkPatSynCase" ty, ty] let MatchResult _ mkCont = match_result cont <- mkCoreLams bndrs <$> mkCont fail return $ mkCoreAppsDs (text "patsyn" <+> ppr var) matcher [Var var, ensure_unstrict cont, Lam voidArgId fail] @@ -469,7 +469,7 @@ mkErrorAppDs err_id ty msg = do full_msg = showSDoc dflags (hcat [ppr src_loc, vbar, msg]) core_msg = Lit (mkMachString full_msg) -- mkMachString returns a result of type String# - return (mkApps (Var err_id) [Type (getLevity "mkErrorAppDs" ty), Type ty, core_msg]) + return (mkApps (Var err_id) [Type (getRuntimeRep "mkErrorAppDs" ty), Type ty, core_msg]) {- 'mkCoreAppDs' and 'mkCoreAppsDs' hand the special-case desugaring of 'seq'. |