X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FBasicTypes.lhs;h=c43280fbd43ef148efff519931ebb1dd736cb6ce;hb=805edf6e400001f6e11b4721b285ecd51e0c2445;hp=ab6d46347dca800e6c3d3f0953e38406a8b19629;hpb=d5bba9ee196f64a077e922680b16fe6f28fb79db;p=ghc-hetmet.git diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs index ab6d463..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} @@ -295,6 +289,7 @@ data OverlapFlag -- Without the Incoherent flag, we'd complain that -- instantiating 'b' would change which instance -- was chosen + deriving( Eq ) instance Outputable OverlapFlag where ppr NoOverlap = empty @@ -370,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 @@ -408,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 @@ -426,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