- = SimplEnv
- (SwitchChecker SimplifierSwitch)
-
- EnclosingCcDetails -- the enclosing cost-centre (when profiling)
-
- InTypeEnv -- For cloning types
- -- Domain is all in-scope type variables
-
- InIdEnv -- IdEnv
- -- Domain is
- -- *all*
- -- *in-scope*,
- -- *locally-defined*
- -- *InIds*
- -- (Could omit the exported top-level guys,
- -- since their names mustn't change; and ditto
- -- the non-exported top-level guys which you
- -- don't want to macro-expand, since their
- -- names need not change.)
- --
- -- Starts off empty
-
- UnfoldEnv -- Domain is any *OutIds*, including imports
- -- where we know something more than the
- -- interface file tells about their value (see
- -- below)
-
-nullSimplEnv :: SwitchChecker SimplifierSwitch -> SimplEnv
-
-nullSimplEnv sw_chkr
- = SimplEnv sw_chkr NoEnclosingCcDetails nullTyVarEnv nullIdEnv null_unfold_env
-
-pprSimplEnv (SimplEnv _ _ ty_env id_env (UFE unfold_env _ _))
- = ppAboves [
- ppStr "** Type Env ** ????????", -- ppr PprDebug ty_env,
- ppSP, ppStr "** Id Env ** ?????????",
--- ppAboves [ pp_id_entry x | x <- getIdEnvMapping id_env ],
- ppSP, ppStr "** Unfold Env **",
- ppAboves [ pp_uf_entry x | x <- rngIdEnv unfold_env ]
- ]
- where
- pp_id_entry (v, idval)
- = ppCat [ppr PprDebug v, ppStr "=>",
- case idval of
- InlineIt _ _ e -> ppCat [ppStr "InlineIt:", ppr PprDebug e]
- ItsAnAtom a -> ppCat [ppStr "Atom:", ppr PprDebug a]
- ]
-
- pp_uf_entry (UnfoldItem v form encl_cc)
- = ppCat [ppr PprDebug v, ppStr "=>",
- case form of
- NoUnfoldingDetails -> ppStr "NoUnfoldingDetails"
- LiteralForm l -> ppCat [ppStr "Lit:", ppr PprDebug l]
- OtherLiteralForm ls -> ppCat [ppStr "Other lit:", ppInterleave (ppStr ", ") [ppr PprDebug l | l <- ls]]
- ConstructorForm c t a -> ppCat [ppStr "Con:", ppr PprDebug c, ppr PprDebug a]
- OtherConstructorForm cs -> ppCat [ppStr "OtherCon:", ppInterleave (ppStr ", ")
- [ppr PprDebug c | c <- cs]]
- GeneralForm t w e g -> ppCat [ppStr "UF:",
- ppr PprDebug t,
- ppr PprDebug w,
- ppr PprDebug g, ppr PprDebug e]
- MagicForm s _ -> ppCat [ppStr "Magic:", ppPStr s]
- IWantToBeINLINEd _ -> ppStr "IWantToBeINLINEd"
- ]
-\end{code}
-
-%************************************************************************
-%* *
-\subsubsection{The @IdVal@ type (for the ``IdEnv'')}
-%* *
-%************************************************************************
-
-The unfoldings for imported things are mostly kept within the Id
-itself; nevertheless, they {\em can} get into the @UnfoldEnv@. For
-example, suppose \tr{x} is imported, and we have
-\begin{verbatim}
- case x of
- (p,q) -> <body>
-\end{verbatim}
-Then within \tr{<body>}, we know that \tr{x} is a pair with components
-\tr{p} and \tr{q}.
-
-\begin{code}
-type InIdEnv = IdEnv IdVal -- Maps InIds to their value
-
-data IdVal
- = InlineIt InIdEnv InTypeEnv InExpr
- -- No binding of the Id is left;
- -- You *have* to replace any occurences
- -- of the id with this expression.
- -- Rather like a macro, really
- -- NB: the InIdEnv/InTypeEnv is necessary to prevent
- -- name caputure. Consider:
- -- let y = ...
- -- x = ...y...
- -- y = ...
- -- in ...x...
- -- If x gets an InlineIt, we must remember
- -- the correct binding for y.
-
- | ItsAnAtom OutAtom -- Used either (a) to record the cloned Id
- -- or (b) if the orig defn is a let-binding, and
- -- the RHS of the let simplifies to an atom,
- -- we just bind the variable to that atom, and
- -- elide the let.
-\end{code}
-
-%************************************************************************
-%* *
-\subsubsection{The @UnfoldEnv@, @UnfoldingDetails@, and @UnfoldingGuidance@ types}
-%* *
-%************************************************************************
-
-The @UnfoldEnv@ contains information about the value of some of the
-in-scope identifiers. It obeys the following invariant:
-
- If the @UnfoldEnv@ contains information, it is safe to use it!
-
-In particular, if the @UnfoldEnv@ contains details of an unfolding of
-an Id, then it's safe to use the unfolding. If, for example, the Id
-is used many times, then its unfolding won't be put in the UnfoldEnv
-at all.
-
-The @UnfoldEnv@ (used to be [WDP 94/06]) a simple association list
-because (a)~it's small, and (b)~we need to search its {\em range} as
-well as its domain.
-
-\begin{code}
-data UnfoldItem -- a glorified triple...
- = UnfoldItem OutId -- key: used in lookForConstructor
- UnfoldingDetails -- for that Id
- EnclosingCcDetails -- so that if we do an unfolding,
- -- we can "wrap" it in the CC
- -- that was in force.
-
-data UnfoldConApp -- yet another glorified triple
- = UCA OutId -- same fields as ConstructorForm;
- [UniType] -- a new type so we can make
- [OutAtom] -- Ord work on it (instead of on
- -- UnfoldingDetails).
-
-data UnfoldEnv -- yup, a glorified triple...
- = UFE (IdEnv UnfoldItem) -- Maps an OutId => its UnfoldItem
- IdSet -- The Ids in the domain of the env
- -- which have details (GeneralForm True ...)
- -- i.e., they claim they are duplicatable.
- -- These are the ones we have to worry
- -- about when adding new items to the
- -- unfold env.
- (FiniteMap UnfoldConApp OutId)
- -- Maps applications of constructors (to
- -- types & atoms) back to OutIds that are
- -- bound to them; i.e., this is a reversed
- -- mapping for (part of) the main IdEnv
- -- (1st part of UFE)
-
-null_unfold_env = UFE nullIdEnv emptyUniqSet emptyFM
-\end{code}
-
-The @UnfoldEnv@ type. We expect on the whole that an @UnfoldEnv@ will
-be small, because it contains bindings only for those things whose
-form or unfolding is known. Basically it maps @Id@ to their
-@UnfoldingDetails@ (and @EnclosingCcDetails@---boring...), but we also
-need to search it associatively, to look for @Id@s which have a given
-constructor form.
-
-We implement it with @IdEnvs@, possibly overkill, but sometimes these
-things silently grow quite big.... Here are some local functions used
-elsewhere in the module:
-
-\begin{code}
-grow_unfold_env :: UnfoldEnv -> OutId -> UnfoldingDetails -> EnclosingCcDetails -> UnfoldEnv
-lookup_unfold_env :: UnfoldEnv -> OutId -> UnfoldingDetails
-lookup_unfold_env_encl_cc
- :: UnfoldEnv -> OutId -> EnclosingCcDetails
-
-grow_unfold_env full_u_env id NoUnfoldingDetails _ = full_u_env
-
-grow_unfold_env (UFE u_env interesting_ids con_apps) id
- uf_details@(GeneralForm True _ _ _) encl_cc
- -- Only interested in Ids which have a "dangerous" unfolding; that is
- -- one that claims to have a single occurrence.
- = UFE (addOneToIdEnv u_env id (UnfoldItem id uf_details encl_cc))
- (interesting_ids `unionUniqSets` singletonUniqSet id)
- con_apps
-
-grow_unfold_env (UFE u_env interesting_ids con_apps) id uf_details encl_cc
- = UFE (addOneToIdEnv u_env id (UnfoldItem id uf_details encl_cc))
- interesting_ids
- new_con_apps
- where
- new_con_apps
- = case uf_details of
- ConstructorForm con targs vargs
- -> case (lookupFM con_apps entry) of
- Just _ -> con_apps -- unchanged; we hang onto what we have
- Nothing -> addToFM con_apps entry id
- where
- entry = UCA con targs vargs
-
- not_a_constructor -> con_apps -- unchanged
-
-addto_unfold_env (UFE u_env interesting_ids con_apps) extra_items
- = ASSERT(not (any constructor_form_in_those extra_items))
- -- otherwise, we'd need to change con_apps
- UFE (growIdEnvList u_env extra_items) interesting_ids con_apps
- where
- constructor_form_in_those (_, UnfoldItem _ (ConstructorForm _ _ _) _) = True
- constructor_form_in_those _ = False
-
-rng_unfold_env (UFE u_env _ _) = rngIdEnv u_env
-
-get_interesting_ids (UFE _ interesting_ids _) = interesting_ids
-
-foldr_unfold_env fun (UFE u_env interesting_ids con_apps) stuff
- = UFE (foldr fun u_env stuff) interesting_ids con_apps
-
-lookup_unfold_env (UFE u_env _ _) id
- = case (lookupIdEnv u_env id) of
- Nothing -> NoUnfoldingDetails
- Just (UnfoldItem _ uf _) -> uf
-
-lookup_unfold_env_encl_cc (UFE u_env _ _) id
- = case (lookupIdEnv u_env id) of
- Nothing -> NoEnclosingCcDetails
- Just (UnfoldItem _ _ encl_cc) -> encl_cc
projects / ghc-hetmet.git / blobdiff