Commit 3909a13c authored by panne's avatar panne
Browse files

[project @ 2000-02-21 18:55:19 by panne]

Write deprecations into interface files.
parent 6cce4a58
......@@ -186,9 +186,9 @@ doIt (core_cmds, stg_cmds)
-- simplifier, which for reasons I don't understand, persists
-- thoroughout code generation
ifaceDecls if_handle local_tycons local_classes
inst_info final_ids tidy_binds imp_rule_ids >>
endIface if_handle >>
ifaceDecls if_handle local_tycons local_classes inst_info
final_ids tidy_binds imp_rule_ids iface_file_stuff >>
endIface if_handle >>
-- We are definitely done w/ interface-file stuff at this point:
-- (See comments near call to "startIface".)
......
......@@ -76,6 +76,10 @@ We then have one-function-per-block-of-interface-stuff, e.g.,
@ifaceExportList@ produces the @__exports__@ section; it appends
to the handle provided by @startIface@.
NOTE: ALWAYS remember that ghc-iface.lprl rewrites the interface file,
so you have to keep it in synch with the code below. Otherwise you'll
lose the happiest years of your life, believe me... -- SUP
\begin{code}
startIface :: Module -> InterfaceDetails
-> IO (Maybe Handle) -- Nothing <=> don't do an interface
......@@ -86,6 +90,7 @@ ifaceDecls :: Maybe Handle
-> [Id] -- Ids used at code-gen time; they have better pragma info!
-> [CoreBind] -- In dependency order, later depend on earlier
-> [ProtoCoreRule] -- Rules
-> InterfaceDetails
-> IO ()
endIface :: Maybe Handle -> IO ()
......@@ -115,12 +120,14 @@ endIface (Just if_hdl) = hPutStr if_hdl "\n" >> hClose if_hdl
\begin{code}
ifaceDecls Nothing tycons classes inst_info final_ids simplified rules = return ()
ifaceDecls Nothing tycons classes inst_info final_ids simplified rules _ = return ()
ifaceDecls (Just hdl)
tycons classes
inst_infos
final_ids binds
final_ids
binds
orphan_rules -- Rules defined locally for an Id that is *not* defined locally
(InterfaceDetails _ _ _ deprecations)
| null_decls = return ()
-- You could have a module with just (re-)exports/instances in it
| otherwise
......@@ -130,19 +137,21 @@ ifaceDecls (Just hdl)
ifaceBinds hdl (inst_ids `unionVarSet` orphan_rule_ids)
final_ids binds >>= \ emitted_ids ->
ifaceRules hdl orphan_rules emitted_ids >>
return ()
ifaceDeprecations hdl deprecations
where
orphan_rule_ids = unionVarSets [ ruleSomeFreeVars interestingId rule
| ProtoCoreRule _ _ rule <- orphan_rules]
null_decls = null binds &&
null tycons &&
null classes &&
isEmptyBag inst_infos &&
null orphan_rules
null_decls = null binds &&
null tycons &&
null classes &&
isEmptyBag inst_infos &&
null orphan_rules &&
null deprecations
\end{code}
\begin{code}
ifaceImports :: Handle -> VersionInfo Name -> IO ()
ifaceImports if_hdl import_usages
= hPutCol if_hdl upp_uses (sortLt lt_imp_vers import_usages)
where
......@@ -162,6 +171,7 @@ ifaceImports if_hdl import_usages
upp_import_versions (Specifically nvs)
= dcolon <+> hsep [ hsep [ppr_unqual_name n, int v] | (n,v) <- sort_versions nvs ]
{- SUP: What's this??
ifaceModuleDeps if_hdl [] = return ()
ifaceModuleDeps if_hdl mod_deps
= let
......@@ -172,7 +182,9 @@ ifaceModuleDeps if_hdl mod_deps
in
printForIface if_hdl (ptext SLIT("__depends") <+> vcat lines <> ptext SLIT(" ;")) >>
hPutStr if_hdl "\n"
-}
ifaceExports :: Handle -> Avails -> IO ()
ifaceExports if_hdl [] = return ()
ifaceExports if_hdl avails
= hPutCol if_hdl do_one_module (fmToList export_fm)
......@@ -193,25 +205,22 @@ ifaceExports if_hdl avails
hsep (map upp_avail (sortLt lt_avail avails))
] <> semi
ifaceFixities :: Handle -> Fixities -> IO ()
ifaceFixities if_hdl [] = return ()
ifaceFixities if_hdl fixities
= hPutCol if_hdl upp_fixity fixities
ifaceRules :: Handle -> [ProtoCoreRule] -> IdSet -> IO ()
ifaceRules if_hdl rules emitted
| null orphan_rule_pretties && null local_id_pretties
= return ()
| otherwise
= do printForIface if_hdl (vcat [
= printForIface if_hdl (vcat [
ptext SLIT("{-## __R"),
vcat orphan_rule_pretties,
vcat local_id_pretties,
ptext SLIT("##-}")
])
return ()
])
where
orphan_rule_pretties = [ pprCoreRule (Just fn) rule
| ProtoCoreRule _ fn rule <- rules
......@@ -220,8 +229,20 @@ ifaceRules if_hdl rules emitted
| fn <- varSetElems emitted,
rule <- rulesRules (getIdSpecialisation fn),
all (`elemVarSet` emitted) (varSetElems (ruleSomeLhsFreeVars interestingId rule))
-- Spit out a rule only if all its lhs free vars are eemitted
-- Spit out a rule only if all its lhs free vars are emitted
]
ifaceDeprecations :: Handle -> [Deprecation Name] -> IO ()
ifaceDeprecations if_hdl [] = return ()
ifaceDeprecations if_hdl deprecations
= printForIface if_hdl (vcat [
ptext SLIT("{-## __D"),
vcat [ pprIfaceDeprec d <> semi | d <- deprecations ],
ptext SLIT("##-}")
])
where
pprIfaceDeprec (DeprecMod txt) = doubleQuotes (ppr txt)
pprIfaceDeprec (DeprecName n txt) = ppr n <+> doubleQuotes (ppr txt)
\end{code}
%************************************************************************
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment