X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FBasicTypes.lhs;h=6b662bd6a64c18c590d9dc541187fe88e13d1c79;hb=ac10f8408520a30e8437496d320b8b86afda2e8f;hp=b0b3bc18ed845a116f0e11259ba0bdc0beb3ef6a;hpb=36d22a1cb608e8572776ab6d402fd0c1a9287dc5;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/BasicTypes.lhs b/ghc/compiler/basicTypes/BasicTypes.lhs
index b0b3bc1..6b662bd 100644
--- a/ghc/compiler/basicTypes/BasicTypes.lhs
+++ b/ghc/compiler/basicTypes/BasicTypes.lhs
@@ -22,7 +22,7 @@ module BasicTypes(
 
 	Fixity(..), FixityDirection(..),
 	defaultFixity, maxPrecedence, 
-	negateFixity,
+	negateFixity, funTyFixity,
 	compareFixity,
 
 	IPName(..), ipNameName, mapIPName,
@@ -36,10 +36,11 @@ module BasicTypes(
 	TupCon(..), tupleParens,
 
 	OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc, 
-	isDeadOcc, isLoopBreaker,
+	isDeadOcc, isLoopBreaker, isNoOcc,
 
 	InsideLam, insideLam, notInsideLam,
 	OneBranch, oneBranch, notOneBranch,
+	InterestingCxt,
 
         EP(..),
 
@@ -47,6 +48,7 @@ module BasicTypes(
 
 	CompilerPhase, 
 	Activation(..), isActive, isNeverActive, isAlwaysActive,
+	InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
 
 	SuccessFlag(..), succeeded, failed, successIf
    ) where
@@ -155,11 +157,10 @@ instance Outputable FixityDirection where
 maxPrecedence = (9::Int)
 defaultFixity = Fixity maxPrecedence InfixL
 
-negateFixity :: Fixity
-negateFixity     = Fixity negatePrecedence InfixL  	-- Precedence of unary negate is wired in as infixl 6!
-
-negatePrecedence :: Int
-negatePrecedence = 6
+negateFixity, funTyFixity :: Fixity
+-- Wired-in fixities
+negateFixity = Fixity 6 InfixL 	-- Fixity of unary negate
+funTyFixity  = Fixity 0	InfixR	-- Fixity of '->'
 \end{code}
 
 Consider
@@ -332,23 +333,33 @@ data OccInfo
   | IAmDead		-- Marks unused variables.  Sometimes useful for
 			-- lambda and case-bound variables.
 
-  | OneOcc InsideLam
-
- 	   OneBranch
+  | OneOcc !InsideLam
+ 	   !OneBranch
+	   !InterestingCxt
 
   | IAmALoopBreaker	-- Used by the occurrence analyser to mark loop-breakers
 			-- in a group of recursive definitions
 
+isNoOcc :: OccInfo -> Bool
+isNoOcc NoOccInfo = True
+isNoOcc other     = False
+
 seqOccInfo :: OccInfo -> ()
-seqOccInfo (OneOcc in_lam once) = in_lam `seq` once `seq` ()
-seqOccInfo occ			= ()
+seqOccInfo occ = occ `seq` ()
+
+-----------------
+type InterestingCxt = Bool	-- True <=> Function: is applied
+				--	    Data value: scrutinised by a case with
+				--			at least one non-DEFAULT branch
 
+-----------------
 type InsideLam = Bool	-- True <=> Occurs inside a non-linear lambda
 			-- Substituting a redex for this occurrence is
 			-- dangerous because it might duplicate work.
 insideLam    = True
 notInsideLam = False
 
+-----------------
 type OneBranch = Bool	-- True <=> Occurs in only one case branch
 			--	so no code-duplication issue to worry about
 oneBranch    = True
@@ -362,12 +373,12 @@ isDeadOcc :: OccInfo -> Bool
 isDeadOcc IAmDead = True
 isDeadOcc other	  = False
 
-isOneOcc (OneOcc _ _) = True
-isOneOcc other	      = False
+isOneOcc (OneOcc _ _ _) = True
+isOneOcc other	        = False
 
 isFragileOcc :: OccInfo -> Bool
-isFragileOcc (OneOcc _ _) = True
-isFragileOcc other	  = False
+isFragileOcc (OneOcc _ _ _) = True
+isFragileOcc other	    = False
 \end{code}
 
 \begin{code}
@@ -376,9 +387,15 @@ instance Outputable OccInfo where
   ppr NoOccInfo  			  	  = empty
   ppr IAmALoopBreaker 				  = ptext SLIT("LoopBreaker")
   ppr IAmDead					  = ptext SLIT("Dead")
-  ppr (OneOcc inside_lam one_branch) | inside_lam = ptext SLIT("OnceInLam")
-				     | one_branch = ptext SLIT("Once")
-				     | otherwise  = ptext SLIT("OnceEachBranch")
+  ppr (OneOcc inside_lam one_branch int_cxt)
+	= ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
+	where
+	  pp_lam | inside_lam = char 'L'
+		 | otherwise  = empty
+	  pp_br  | one_branch = empty
+		 | otherwise  = char '*'
+	  pp_args | int_cxt   = char '!'
+		  | otherwise = empty
 
 instance Show OccInfo where
   showsPrec p occ = showsPrecSDoc p (ppr occ)
@@ -454,12 +471,27 @@ data Activation = NeverActive
 		| ActiveAfter CompilerPhase	-- Active in this phase and later
 		deriving( Eq )			-- Eq used in comparing rules in HsDecls
 
+data InlineSpec
+  = Inline 
+	Activation	-- Says during which phases inlining is allowed
+	Bool 		-- True <=> make the RHS look small, so that when inlining
+			--	    is enabled, it will definitely actually happen
+  deriving( Eq )
+
+defaultInlineSpec = Inline AlwaysActive False	-- Inlining is OK, but not forced
+alwaysInlineSpec  = Inline AlwaysActive True	-- INLINE always
+neverInlineSpec   = Inline NeverActive  False	-- NOINLINE 
+
 instance Outputable Activation where
    ppr AlwaysActive     = empty		-- The default
    ppr (ActiveBefore n) = brackets (char '~' <> int n)
    ppr (ActiveAfter n)  = brackets (int n)
    ppr NeverActive      = ptext SLIT("NEVER")
     
+instance Outputable InlineSpec where
+   ppr (Inline act True)  = ptext SLIT("INLINE") <> ppr act
+   ppr (Inline act False) = ptext SLIT("NOINLINE") <> ppr act
+
 isActive :: CompilerPhase -> Activation -> Bool
 isActive p NeverActive      = False
 isActive p AlwaysActive     = True