diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/coreSyn/CoreLint.lhs | 6 | ||||
| -rw-r--r-- | compiler/coreSyn/MkCore.lhs | 4 | ||||
| -rw-r--r-- | compiler/prelude/PrelNames.lhs | 10 | ||||
| -rw-r--r-- | compiler/simplCore/SimplEnv.lhs | 30 |
4 files changed, 39 insertions, 11 deletions
diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs index 0ca5c4365a..428cda8dec 100644 --- a/compiler/coreSyn/CoreLint.lhs +++ b/compiler/coreSyn/CoreLint.lhs @@ -227,7 +227,11 @@ lintCoreExpr (Var var) = do { checkL (not (var == oneTupleDataConId)) (ptext (sLit "Illegal one-tuple")) - ; checkDeadIdOcc var + ; checkL (not (var `hasKey` wildCardKey)) + (ptext (sLit "Occurence of a wild-card binder") <+> ppr var) + -- See Note [WildCard binders] in SimplEnv + + ; checkDeadIdOcc var ; var' <- lookupIdInScope var ; return (idType var') } diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs index f345b89c88..583f31498d 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 diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 40910f6c67..4d3c446a62 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -58,7 +58,7 @@ import Unique ( Unique, Uniquable(..), hasKey, mkTupleTyConUnique ) import BasicTypes ( Boxity(..), Arity ) -import Name ( Name, mkInternalName, mkExternalName ) +import Name ( Name, mkInternalName, mkExternalName, mkSystemVarName ) import SrcLoc import FastString \end{code} @@ -542,6 +542,9 @@ and it's convenient to write them all down in one place. \begin{code} +wildCardName :: Name +wildCardName = mkSystemVarName wildCardKey (fsLit "wild") + runMainIOName :: Name runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey @@ -1127,10 +1130,11 @@ absentErrorIdKey, augmentIdKey, appendIdKey, buildIdKey, errorIdKey, noMethodBindingErrorIdKey, nonExhaustiveGuardsErrorIdKey, runtimeErrorIdKey, parErrorIdKey, parIdKey, patErrorIdKey, realWorldPrimIdKey, recConErrorIdKey, recUpdErrorIdKey, - traceIdKey, + traceIdKey, wildCardKey, unpackCStringUtf8IdKey, unpackCStringAppendIdKey, unpackCStringFoldrIdKey, unpackCStringIdKey :: Unique -absentErrorIdKey = mkPreludeMiscIdUnique 1 +wildCardKey = mkPreludeMiscIdUnique 0 -- See Note [WildCard] +absentErrorIdKey = mkPreludeMiscIdUnique 1 augmentIdKey = mkPreludeMiscIdUnique 3 appendIdKey = mkPreludeMiscIdUnique 4 buildIdKey = mkPreludeMiscIdUnique 5 diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs index 9f424cd09f..896fe97626 100644 --- a/compiler/simplCore/SimplEnv.lhs +++ b/compiler/simplCore/SimplEnv.lhs @@ -46,6 +46,8 @@ import VarEnv import VarSet import OrdList import Id +import MkCore +import TysWiredIn import qualified CoreSubst import qualified Type ( substTy, substTyVarBndr, substTyVar ) import Type hiding ( substTy, substTyVarBndr, substTyVar ) @@ -220,13 +222,31 @@ seIdSubst: \begin{code} mkSimplEnv :: SimplifierMode -> SimplEnv mkSimplEnv mode - = SimplEnv { seCC = subsumedCCS, - seMode = mode, seInScope = emptyInScopeSet, - seFloats = emptyFloats, - seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv } + = SimplEnv { seCC = subsumedCCS + , seMode = mode + , seInScope = init_in_scope + , seFloats = emptyFloats + , seTvSubst = emptyVarEnv + , seIdSubst = emptyVarEnv } -- The top level "enclosing CC" is "SUBSUMED". ---------------------- +init_in_scope :: InScopeSet +init_in_scope = mkInScopeSet (unitVarSet (mkWildValBinder unitTy)) + -- See Note [WildCard binders] +\end{code} + +Note [WildCard binders] +~~~~~~~~~~~~~~~~~~~~~~~ +The program to be simplified may have wild binders + case e of wild { p -> ... } +We want to *rename* them away, so that there are no +occurrences of 'wild' (with wildCardKey). The easy +way to do that is to start of with a representative +Id in the in-scope set + +There should be no *occurrences* of wild. + +\begin{code} getMode :: SimplEnv -> SimplifierMode getMode env = seMode env |