[project @ 2005-08-11 13:11:52 by simonpj]

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

diff --git a/ghc/compiler/basicTypes/BasicTypes.lhs b/ghc/compiler/basicTypes/BasicTypes.lhs
index bce1fa0..4497bfd 100644 (file)
--- 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,
@@ -40,6 +40,7 @@ module BasicTypes(
 
        InsideLam, insideLam, notInsideLam,
        OneBranch, oneBranch, notOneBranch,
+       InterestingCxt,
 
         EP(..),
 
@@ -155,11 +156,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 +332,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
@@ -362,23 +368,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)