[project @ 1999-07-12 14:40:08 by simonmar]

[ghc-hetmet.git] / ghc / compiler / basicTypes / Id.lhs

diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 75e27aa..aa086a1 100644 (file)
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -22,6 +22,7 @@ module Id (
 
        -- Predicates
        omitIfaceSigForId,
+       exportWithOrigOccName,
        externallyVisibleId,
        idFreeTyVars, 
 
@@ -34,6 +35,9 @@ module Id (
        isConstantId, isBottomingId, idAppIsBottom,
        isExportedId, isUserExportedId,
 
+       -- One shot lambda stuff
+       isOneShotLambda, setOneShotLambda,
+
        -- IdInfo stuff
        setIdUnfolding,
        setIdArity,
@@ -80,6 +84,7 @@ import Name           ( Name, OccName,
 import Const           ( Con(..) )
 import PrimRep         ( PrimRep )
 import PrimOp          ( PrimOp )
+import TysPrim         ( realWorldStatePrimTy )
 import FieldLabel      ( FieldLabel(..) )
 import SrcLoc          ( SrcLoc )
 import Unique          ( Unique, mkBuiltinUnique, getBuiltinUniques )
@@ -244,6 +249,12 @@ omitIfaceSigForId id
                -- the instance decl
 
        other          -> False -- Don't omit!
+
+-- Certain names must be exported with their original occ names, because
+-- these names are bound by either a class declaration or a data declaration
+-- or an explicit user export.
+exportWithOrigOccName :: Id -> Bool
+exportWithOrigOccName id = omitIfaceSigForId id || isUserExportedId id
 \end{code}
 
 
@@ -360,3 +371,30 @@ idMustBeINLINEd id =  case getInlinePragma id of
                        IMustBeINLINEd -> True
                        other          -> False
 \end{code}
+
+
+       ---------------------------------
+       -- ONE-SHOT LAMBDAS
+\begin{code}
+isOneShotLambda :: Id -> Bool
+isOneShotLambda id = case lbvarInfo (idInfo id) of
+                       IsOneShotLambda -> True
+                       NoLBVarInfo     -> idType id == realWorldStatePrimTy
+       -- The last clause is a gross hack.  It claims that 
+       -- every function over realWorldStatePrimTy is a one-shot
+       -- function.  This is pretty true in practice, and makes a big
+       -- difference.  For example, consider
+       --      a `thenST` \ r -> ...E...
+       -- The early full laziness pass, if it doesn't know that r is one-shot
+       -- will pull out E (let's say it doesn't mention r) to give
+       --      let lvl = E in a `thenST` \ r -> ...lvl...
+       -- When `thenST` gets inlined, we end up with
+       --      let lvl = E in \s -> case a s of (r, s') -> ...lvl...
+       -- and we don't re-inline E.
+       --      
+       -- It would be better to spot that r was one-shot to start with, but
+       -- I don't want to rely on that.
+
+setOneShotLambda :: Id -> Id
+setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
+\end{code}