Tidy up the handling of wild-card binders, and make Lint check it

See Note [WildCard binders] in SimplEnv.  Spotted by Roman.

diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs
index 0ca5c43..428cda8 100644 (file)
--- 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"))
 
   = 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') }
 
        ; var' <- lookupIdInScope var
         ; return (idType var') }
 

diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs
index f345b89..583f314 100644 (file)
--- a/compiler/coreSyn/MkCore.lhs
+++ b/compiler/coreSyn/MkCore.lhs
@@ -65,7 +65,6 @@ import Name
 import Outputable
 import FastString
 import UniqSupply
 import Outputable
 import FastString
 import UniqSupply

-import Unique          ( mkBuiltinUnique )

 import BasicTypes
 import Util             ( notNull, zipEqual )
 import Constants
 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.
 -- 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 :: 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
 
 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 40910f6..4d3c446 100644 (file)
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -58,7 +58,7 @@ import Unique   ( Unique, Uniquable(..), hasKey,
                    mkTupleTyConUnique
                  ) 
 import BasicTypes ( Boxity(..), Arity )
                    mkTupleTyConUnique
                  ) 
 import BasicTypes ( Boxity(..), Arity )

-import Name      ( Name, mkInternalName, mkExternalName )
+import Name       ( Name, mkInternalName, mkExternalName, mkSystemVarName )

 import SrcLoc
 import FastString
 \end{code}
 import SrcLoc
 import FastString
 \end{code}

@@ -542,6 +542,9 @@ and it's convenient to write them all down in one place.
 
 
 \begin{code}
 
 
 \begin{code}

+wildCardName :: Name
+wildCardName = mkSystemVarName wildCardKey (fsLit "wild")
+

 runMainIOName :: Name
 runMainIOName = varQual gHC_TOP_HANDLER (fsLit "runMainIO") runMainKey
 
 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,
     noMethodBindingErrorIdKey, nonExhaustiveGuardsErrorIdKey,
     runtimeErrorIdKey, parErrorIdKey, parIdKey, patErrorIdKey,
     realWorldPrimIdKey, recConErrorIdKey, recUpdErrorIdKey,

-    traceIdKey,
+    traceIdKey, wildCardKey,

     unpackCStringUtf8IdKey, unpackCStringAppendIdKey,
     unpackCStringFoldrIdKey, unpackCStringIdKey :: Unique
     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
 augmentIdKey                 = mkPreludeMiscIdUnique  3
 appendIdKey                  = mkPreludeMiscIdUnique  4
 buildIdKey                   = mkPreludeMiscIdUnique  5

diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index 9f424cd..896fe97 100644 (file)
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -46,6 +46,8 @@ import VarEnv
 import VarSet
 import OrdList
 import Id
 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 )
 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
 \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".
 
        -- 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
 
 getMode :: SimplEnv -> SimplifierMode
 getMode env = seMode env