X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FBasicTypes.lhs;h=c43280fbd43ef148efff519931ebb1dd736cb6ce;hb=805edf6e400001f6e11b4721b285ecd51e0c2445;hp=0dbd0f6c0991e9fd0d41948e5f5475d5a5bf84f8;hpb=00c8e4f56dff60984a892da9c976c080031a16b2;p=ghc-hetmet.git diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs index 0dbd0f6..c43280f 100644 --- a/compiler/basicTypes/BasicTypes.lhs +++ b/compiler/basicTypes/BasicTypes.lhs @@ -38,7 +38,7 @@ module BasicTypes( TupCon(..), tupleParens, OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc, - isDeadOcc, isLoopBreaker, isNoOcc, + isDeadOcc, isLoopBreaker, isNonRuleLoopBreaker, isNoOcc, InsideLam, insideLam, notInsideLam, OneBranch, oneBranch, notOneBranch, @@ -109,24 +109,18 @@ The @IPName@ type is here because it is used in TypeRep (i.e. very early in the hierarchy), but also in HsSyn. \begin{code} -data IPName name - = Dupable name -- ?x: you can freely duplicate this implicit parameter - | Linear name -- %x: you must use the splitting function to duplicate it +newtype IPName name = IPName name -- ?x deriving( Eq, Ord ) -- Ord is used in the IP name cache finite map -- (used in HscTypes.OrigIParamCache) - ipNameName :: IPName name -> name -ipNameName (Dupable n) = n -ipNameName (Linear n) = n +ipNameName (IPName n) = n mapIPName :: (a->b) -> IPName a -> IPName b -mapIPName f (Dupable n) = Dupable (f n) -mapIPName f (Linear n) = Linear (f n) +mapIPName f (IPName n) = IPName (f n) instance Outputable name => Outputable (IPName name) where - ppr (Dupable n) = char '?' <> ppr n -- Ordinary implicit parameters - ppr (Linear n) = char '%' <> ppr n -- Splittable implicit parameters + ppr (IPName n) = char '?' <> ppr n -- Ordinary implicit parameters \end{code} @@ -371,18 +365,28 @@ defn of OccInfo here, safely at the bottom \begin{code} data OccInfo - = NoOccInfo + = NoOccInfo -- Many occurrences, or unknown | IAmDead -- Marks unused variables. Sometimes useful for -- lambda and case-bound variables. - | OneOcc !InsideLam - !OneBranch - !InterestingCxt + | OneOcc -- Occurs exactly once, not inside a rule + !InsideLam + !OneBranch + !InterestingCxt | IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers -- in a group of recursive definitions + !RulesOnly -- True <=> This loop breaker mentions the other binders + -- in its recursive group only in its RULES, not + -- in its rhs + -- See OccurAnal Note [RulesOnly] + +type RulesOnly = Bool +\end{code} + +\begin{code} isNoOcc :: OccInfo -> Bool isNoOcc NoOccInfo = True isNoOcc other = False @@ -409,8 +413,12 @@ oneBranch = True notOneBranch = False isLoopBreaker :: OccInfo -> Bool -isLoopBreaker IAmALoopBreaker = True -isLoopBreaker other = False +isLoopBreaker (IAmALoopBreaker _) = True +isLoopBreaker other = False + +isNonRuleLoopBreaker :: OccInfo -> Bool +isNonRuleLoopBreaker (IAmALoopBreaker False) = True -- Loop-breaker that breaks a non-rule cycle +isNonRuleLoopBreaker other = False isDeadOcc :: OccInfo -> Bool isDeadOcc IAmDead = True @@ -427,9 +435,9 @@ isFragileOcc other = False \begin{code} instance Outputable OccInfo where -- only used for debugging; never parsed. KSW 1999-07 - ppr NoOccInfo = empty - ppr IAmALoopBreaker = ptext SLIT("LoopBreaker") - ppr IAmDead = ptext SLIT("Dead") + ppr NoOccInfo = empty + ppr (IAmALoopBreaker ro) = ptext SLIT("LoopBreaker") <> if ro then char '!' else empty + ppr IAmDead = ptext SLIT("Dead") ppr (OneOcc inside_lam one_branch int_cxt) = ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args where