X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FMkCore.lhs;h=f1d42738a2740631b13ed398896e80672e4600a9;hb=11b33eaeaef39fcba8ee9258213068ed90362aa7;hp=a4977474315c2cefad537b4ba62e2d8041cbc7a1;hpb=7fc01c4671980ea3c66d549c0ece4d82fd3f5ade;p=ghc-hetmet.git diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs index a497747..f1d4273 100644 --- a/compiler/coreSyn/MkCore.lhs +++ b/compiler/coreSyn/MkCore.lhs @@ -65,7 +65,6 @@ import Name import Outputable import FastString import UniqSupply -import Unique ( mkBuiltinUnique ) import BasicTypes import Util ( notNull, zipEqual ) import Constants @@ -156,8 +155,9 @@ mkWildEvBinder pred = mkWildValBinder (mkPredTy pred) -- that you expect to use only at a *binding* site. Do not use it at -- occurrence sites because it has a single, fixed unique, and it's very -- easy to get into difficulties with shadowing. That's why it is used so little. +-- See Note [WildCard binders] in SimplEnv mkWildValBinder :: Type -> Id -mkWildValBinder ty = mkSysLocal (fsLit "wild") (mkBuiltinUnique 1) ty +mkWildValBinder ty = mkLocalId wildCardName ty mkWildCase :: CoreExpr -> Type -> Type -> [CoreAlt] -> CoreExpr -- Make a case expression whose case binder is unused @@ -478,11 +478,11 @@ mkTupleCase uniqs vars body scrut_var scrut in mk_tuple_case us' (chunkify vars') body' one_tuple_case chunk_vars (us, vs, body) - = let (us1, us2) = splitUniqSupply us - scrut_var = mkSysLocal (fsLit "ds") (uniqFromSupply us1) + = let (uniq, us') = takeUniqFromSupply us + scrut_var = mkSysLocal (fsLit "ds") uniq (mkBoxedTupleTy (map idType chunk_vars)) body' = mkSmallTupleCase chunk_vars body scrut_var (Var scrut_var) - in (us2, scrut_var:vs, body') + in (us', scrut_var:vs, body') \end{code} \begin{code} @@ -648,6 +648,7 @@ err_nm str uniq id = mkWiredInIdName cONTROL_EXCEPTION_BASE (fsLit str) uniq id rEC_SEL_ERROR_ID, rUNTIME_ERROR_ID, iRREFUT_PAT_ERROR_ID, rEC_CON_ERROR_ID :: Id pAT_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID :: Id +aBSENT_ERROR_ID :: Id rEC_SEL_ERROR_ID = mkRuntimeErrorId recSelErrorName rUNTIME_ERROR_ID = mkRuntimeErrorId runtimeErrorName iRREFUT_PAT_ERROR_ID = mkRuntimeErrorId irrefutPatErrorName @@ -655,10 +656,7 @@ rEC_CON_ERROR_ID = mkRuntimeErrorId recConErrorName pAT_ERROR_ID = mkRuntimeErrorId patErrorName nO_METHOD_BINDING_ERROR_ID = mkRuntimeErrorId noMethodBindingErrorName nON_EXHAUSTIVE_GUARDS_ERROR_ID = mkRuntimeErrorId nonExhaustiveGuardsErrorName - -aBSENT_ERROR_ID :: Id --- Not bottoming; no unfolding! See Note [Absent error Id] in WwLib -aBSENT_ERROR_ID = mkVanillaGlobal absentErrorName runtimeErrorTy +aBSENT_ERROR_ID = mkRuntimeErrorId absentErrorName mkRuntimeErrorId :: Name -> Id mkRuntimeErrorId name = pc_bottoming_Id name runtimeErrorTy