X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FBasicTypes.lhs;h=25272764a8b776a6344688c53aa4b9d15fecdba8;hb=44713ec1fa30bab4b6e087d017ca8524f9792b34;hp=fbc6bc80917eadecf6183c829f27dc263cf5fa6b;hpb=69c5228776f837d5d7276ff2953c4a98b1908915;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/BasicTypes.lhs b/ghc/compiler/basicTypes/BasicTypes.lhs
index fbc6bc8..2527276 100644
--- a/ghc/compiler/basicTypes/BasicTypes.lhs
+++ b/ghc/compiler/basicTypes/BasicTypes.lhs
@@ -22,13 +22,11 @@ module BasicTypes(
 
 	Fixity(..), FixityDirection(..),
 	defaultFixity, maxPrecedence, 
-	negateFixity,
+	negateFixity, funTyFixity,
 	compareFixity,
 
 	IPName(..), ipNameName, mapIPName,
 
-	NewOrData(..), 
-
 	RecFlag(..), isRec, isNonRec, boolToRecFlag,
 
 	TopLevelFlag(..), isTopLevel, isNotTopLevel,
@@ -42,6 +40,7 @@ module BasicTypes(
 
 	InsideLam, insideLam, notInsideLam,
 	OneBranch, oneBranch, notOneBranch,
+	InterestingCxt,
 
         EP(..),
 
@@ -49,6 +48,7 @@ module BasicTypes(
 
 	CompilerPhase, 
 	Activation(..), isActive, isNeverActive, isAlwaysActive,
+	InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
 
 	SuccessFlag(..), succeeded, failed, successIf
    ) where
@@ -157,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
@@ -193,24 +192,6 @@ compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
 
 %************************************************************************
 %*									*
-\subsection[NewType/DataType]{NewType/DataType flag}
-%*									*
-%************************************************************************
-
-\begin{code}
-data NewOrData
-  = NewType  	-- "newtype Blah ..."
-  | DataType 	-- "data Blah ..."
-  deriving( Eq )	-- Needed because Demand derives Eq
-
-instance Outputable NewOrData where
-  ppr NewType  = ptext SLIT("newtype")
-  ppr DataType = ptext SLIT("data")
-\end{code}
-
-
-%************************************************************************
-%*									*
 \subsection[Top-level/local]{Top-level/not-top level flag}
 %*									*
 %************************************************************************
@@ -352,23 +333,29 @@ 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
 
 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
@@ -382,23 +369,29 @@ 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}
 instance Outputable OccInfo where
   -- only used for debugging; never parsed.  KSW 1999-07
   ppr NoOccInfo  			  	  = empty
-  ppr IAmALoopBreaker 				  = ptext SLIT("_Kx")
-  ppr IAmDead					  = ptext SLIT("_Kd")
-  ppr (OneOcc inside_lam one_branch) | inside_lam = ptext SLIT("_Kl")
-				     | one_branch = ptext SLIT("_Ks")
-				     | otherwise  = ptext SLIT("_Ks*")
+  ppr IAmALoopBreaker 				  = ptext SLIT("LoopBreaker")
+  ppr IAmDead					  = ptext SLIT("Dead")
+  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)
@@ -474,12 +467,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